From 899900555d669c545519a5cb3010b3ae88d648a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 28 Mar 2023 16:56:35 +0200
Subject: [PATCH 001/481] Wasm AST

---
 compiler/lib/dune           |   2 +
 compiler/lib/wasm/wa_ast.ml | 123 ++++++++++++++++++++++++++++++++++++
 2 files changed, 125 insertions(+)
 create mode 100644 compiler/lib/wasm/wa_ast.ml

diff --git a/compiler/lib/dune b/compiler/lib/dune
index b03e41bdf8..04d44f7053 100644
--- a/compiler/lib/dune
+++ b/compiler/lib/dune
@@ -41,6 +41,8 @@
  (modules annot_parser)
  (flags --explain))
 
+(include_subdirs unqualified)
+
 (rule
  (targets compiler_version.ml)
  (deps
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
new file mode 100644
index 0000000000..2c1d817547
--- /dev/null
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -0,0 +1,123 @@
+type var = Code.Var.t
+
+type symbol =
+  | V of var
+  | S of string
+
+type value_type =
+  | I32
+  | I64
+  | F64
+
+type func_type =
+  { params : value_type list
+  ; result : value_type list
+  }
+
+type ('i32, 'i64, 'f64) op =
+  | I32 of 'i32
+  | I64 of 'i64
+  | F64 of 'f64
+
+type int_un_op =
+  | Clz
+  | Ctz
+  | Popcnt
+  | Eqz
+
+type signage =
+  | S
+  | U
+
+type int_bin_op =
+  | Add
+  | Sub
+  | Mul
+  | Div of signage
+  | Rem of signage
+  | And
+  | Or
+  | Xor
+  | Shl
+  | Shr of signage
+  | Rotl
+  | Rotr
+  | Eq
+  | Ne
+  | Lt of signage
+  | Gt of signage
+  | Le of signage
+  | Ge of signage
+
+type float_un_op =
+  | Neg
+  | Abs
+  | Ceil
+  | Floor
+  | Trunc
+  | Nearest
+  | Sqrt
+
+type float_bin_op =
+  | Add
+  | Sub
+  | Mul
+  | Div
+  | Min
+  | Max
+  | CopySign
+  | Eq
+  | Ne
+  | Lt
+  | Gt
+  | Le
+  | Ge
+
+type memarg = int32
+
+type expression =
+  | Const of (int32, int64, float) op
+  | ConstSym of symbol * int
+  | UnOp of (int_un_op, int_un_op, float_un_op) op * expression
+  | BinOp of (int_bin_op, int_bin_op, float_bin_op) op * expression * expression
+  | Load of (memarg, memarg, memarg) op * expression
+  | Load8 of signage * (memarg, memarg, memarg) op * expression
+  | LocalGet of int
+  | LocalTee of int * expression
+  | GlobalGet of symbol
+  | Call_indirect of func_type * expression * expression list
+  | Call of symbol * expression list
+  | MemoryGrow of int * expression
+  | Seq of instruction list * expression
+  | Pop of value_type
+
+and instruction =
+  | Drop of expression
+  | Store of (memarg, memarg, memarg) op * expression * expression
+  | Store8 of signage * (memarg, memarg, memarg) op * expression * expression
+  | LocalSet of int * expression
+  | GlobalSet of symbol * expression
+  | Loop of func_type * instruction list
+  | Block of func_type * instruction list
+  | If of func_type * expression * instruction list * instruction list
+  | Br_table of expression * int list * int
+  | Br of int * expression option
+  | Return of expression option
+  | CallInstr of symbol * expression list
+  | Nop
+  | Push of expression
+
+type import_desc = Fun of func_type
+
+type module_field =
+  | Function of
+      { name : var
+      ; exported_name : string option
+      ; typ : func_type
+      ; locals : value_type list
+      ; body : instruction list
+      }
+  | Import of
+      { name : string
+      ; desc : import_desc
+      }

From e419de7be09f34eb1f2a76c1129dbecc533d17e8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 28 Mar 2023 17:22:52 +0200
Subject: [PATCH 002/481] Ouput assembly code for LLVM

---
 compiler/lib/wasm/wa_asm_output.ml  | 338 ++++++++++++++++++++++++++++
 compiler/lib/wasm/wa_asm_output.mli |   1 +
 2 files changed, 339 insertions(+)
 create mode 100644 compiler/lib/wasm/wa_asm_output.ml
 create mode 100644 compiler/lib/wasm/wa_asm_output.mli

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
new file mode 100644
index 0000000000..033b179bf5
--- /dev/null
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -0,0 +1,338 @@
+open! Stdlib
+
+module PP : sig
+  type t
+
+  val empty : t
+
+  val ( ^^ ) : t -> t -> t
+
+  val string : string -> t
+
+  val line : t -> t
+
+  val indent : t -> t
+
+  val concat_map : ('a -> t) -> 'a list -> t
+
+  val separate_map : t -> ('a -> t) -> 'a list -> t
+
+  val to_channel : out_channel -> t -> unit
+
+  (*  val to_buffer : Buffer.t -> t -> unit *)
+end = struct
+  let spaces = "\t" ^ String.make 80 ' '
+
+  type st =
+    { mutable indent : int
+    ; output : string -> int -> int -> unit
+    }
+
+  type t = st -> unit
+
+  let empty _ = ()
+
+  let string s st = st.output s 0 (String.length s)
+
+  let ( ^^ ) s s' st =
+    s st;
+    s' st
+
+  let line l st =
+    st.output spaces 0 (min (String.length spaces) st.indent);
+    l st;
+    st.output "\n" 0 1
+
+  let indent x st =
+    st.indent <- st.indent + 1;
+    x st;
+    st.indent <- st.indent - 1
+
+  let concat_map f l st = List.iter ~f:(fun x -> f x st) l
+
+  let separate_map sep f l st =
+    List.iteri
+      ~f:(fun i x ->
+        if i > 0 then sep st;
+        f x st)
+      l
+
+  let to_channel ch doc = doc { indent = 0; output = output_substring ch }
+
+  (*
+  let to_buffer b doc =
+    doc { indent = 0; output = (fun s i l -> Buffer.add_substring b s i l) }
+  *)
+end
+
+open PP
+open Wa_ast
+
+let value_type (t : value_type) =
+  string
+    (match t with
+    | I32 -> "i32"
+    | I64 -> "i64"
+    | F64 -> "f64")
+
+let func_type { params; result } =
+  assert (List.length result <= 1);
+  string "("
+  ^^ separate_map (string ", ") value_type params
+  ^^ string ") -> ("
+  ^^ separate_map (string ", ") value_type result
+  ^^ string ")"
+
+let block_type ty =
+  match ty with
+  | { params = []; result = [] } -> empty
+  | { params = []; result = [ res ] } -> string " " ^^ value_type res
+  | _ -> assert false
+
+let type_prefix op =
+  match op with
+  | I32 _ -> string "i32."
+  | I64 _ -> string "i64."
+  | F64 _ -> string "f64."
+
+let int_un_op op =
+  match op with
+  | Clz -> "clz"
+  | Ctz -> "ctz"
+  | Popcnt -> "popcnt"
+  | Eqz -> "eqz"
+
+let signage op (s : Wa_ast.signage) =
+  op
+  ^
+  match s with
+  | S -> "_s"
+  | U -> "_u"
+
+let int_bin_op (op : int_bin_op) =
+  match op with
+  | Add -> "add"
+  | Sub -> "sub"
+  | Mul -> "mul"
+  | Div s -> signage "div" s
+  | Rem s -> signage "rem" s
+  | And -> "and"
+  | Or -> "or"
+  | Xor -> "xor"
+  | Shl -> "shl"
+  | Shr s -> signage "shr" s
+  | Rotl -> "rotl"
+  | Rotr -> "rotr"
+  | Eq -> "eq"
+  | Ne -> "ne"
+  | Lt s -> signage "lt" s
+  | Gt s -> signage "gt" s
+  | Le s -> signage "le" s
+  | Ge s -> signage "ge" s
+
+let float_un_op op =
+  match op with
+  | Neg -> "neg"
+  | Abs -> "abs"
+  | Ceil -> "ceil"
+  | Floor -> "floor"
+  | Trunc -> "trunc"
+  | Nearest -> "nearest"
+  | Sqrt -> "sqrt"
+
+let float_bin_op op =
+  match op with
+  | Add -> "add"
+  | Sub -> "sub"
+  | Mul -> "mul"
+  | Div -> "div"
+  | Min -> "min"
+  | Max -> "max"
+  | CopySign -> "copysign"
+  | Eq -> "eq"
+  | Ne -> "ne"
+  | Lt -> "lt"
+  | Gt -> "gt"
+  | Le -> "le"
+  | Ge -> "ge"
+
+let select i32 i64 f64 op =
+  match op with
+  | I32 x -> i32 x
+  | I64 x -> i64 x
+  | F64 x -> f64 x
+
+let integer i = string (string_of_int i)
+
+let integer32 i =
+  string
+    (if Poly.(i > -10000l && i < 10000l)
+     then Int32.to_string i
+     else Printf.sprintf "0x%lx" i)
+
+let integer64 i =
+  string
+    (if Poly.(i > -10000L && i < 10000L)
+     then Int64.to_string i
+     else Printf.sprintf "0x%Lx" i)
+
+let symbol name offset =
+  string
+    (match name with
+    | V name -> Code.Var.to_string name
+    | S name -> name)
+  ^^
+  if offset = 0
+  then empty
+  else (if offset < 0 then empty else string "+") ^^ integer offset
+
+let rec expression e =
+  match e with
+  | Const op ->
+      line
+        (type_prefix op
+        ^^ string "const "
+        ^^ select integer32 integer64 (fun f -> string (string_of_float f (*ZZZ*))) op)
+  | ConstSym (name, offset) ->
+      line (type_prefix (I32 ()) ^^ string "const " ^^ symbol name offset)
+  | UnOp (op, e') ->
+      expression e'
+      ^^ line (type_prefix op ^^ string (select int_un_op int_un_op float_un_op op))
+  | BinOp (op, e1, e2) ->
+      expression e1
+      ^^ expression e2
+      ^^ line (type_prefix op ^^ string (select int_bin_op int_bin_op float_bin_op op))
+  | Load (offset, e') ->
+      expression e'
+      ^^ line
+           (type_prefix offset
+           ^^ string "load "
+           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+  | Load8 (s, offset, e') ->
+      expression e'
+      ^^ line
+           (type_prefix offset
+           ^^ string (signage "load8" s)
+           ^^ string " "
+           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+  | LocalGet i -> line (string "local.get " ^^ integer i)
+  | LocalTee (i, e') -> expression e' ^^ line (string "local.tee " ^^ integer i)
+  | GlobalGet nm -> line (string "global.get " ^^ symbol nm 0)
+  | Call_indirect (typ, f, l) ->
+      concat_map expression l
+      ^^ expression f
+      ^^ line (string "call_indirect " ^^ func_type typ)
+  | Call (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
+  | MemoryGrow (mem, e) -> expression e ^^ line (string "memory.grow " ^^ integer mem)
+  | Seq (l, e') -> concat_map instruction l ^^ expression e'
+  | Pop _ -> empty
+
+and instruction i =
+  match i with
+  | Drop e -> expression e ^^ line (string "drop")
+  | Store (offset, e, e') ->
+      expression e
+      ^^ expression e'
+      ^^ line
+           (type_prefix offset
+           ^^ string "store "
+           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+  | Store8 (s, offset, e, e') ->
+      expression e
+      ^^ expression e'
+      ^^ line
+           (type_prefix offset
+           ^^ string (signage "store8" s)
+           ^^ string " "
+           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+  | LocalSet (i, e) -> expression e ^^ line (string "local.set " ^^ integer i)
+  | GlobalSet (nm, e) -> expression e ^^ line (string "global.set " ^^ symbol nm 0)
+  | Loop (ty, l) ->
+      line (string "loop" ^^ block_type ty)
+      ^^ indent (concat_map instruction l)
+      ^^ line (string "end_loop")
+  | Block (ty, l) ->
+      line (string "block" ^^ block_type ty)
+      ^^ indent (concat_map instruction l)
+      ^^ line (string "end_block")
+  | If (ty, e, l1, l2) ->
+      expression e
+      ^^ line (string "if" ^^ block_type ty)
+      ^^ indent (concat_map instruction l1)
+      ^^ line (string "else")
+      ^^ indent (concat_map instruction l2)
+      ^^ line (string "end_if")
+  | Br_table (e, l, i) ->
+      expression e
+      ^^ line
+           (string "br_table {"
+           ^^ separate_map (string ", ") integer (l @ [ i ])
+           ^^ string "}")
+  | Br (i, Some e) -> expression e ^^ instruction (Br (i, None))
+  | Br (i, None) -> line (string "br " ^^ integer i)
+  | Return (Some e) -> expression e ^^ instruction (Return None)
+  | Return None -> line (string "return")
+  | CallInstr (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
+  | Nop -> empty
+  | Push e -> expression e
+
+let section_header kind name =
+  line
+    (string ".section ." ^^ string kind ^^ string "." ^^ string name ^^ string ",\"\",@")
+
+let f fields =
+  List.iter
+    ~f:(fun f ->
+      match f with
+      | Import { name; _ } -> Var_printer.add_reserved name
+      | Function _ -> ())
+    fields;
+  to_channel stdout
+  @@
+  let types =
+    List.filter_map
+      ~f:(fun f ->
+        match f with
+        | Function { name; typ; _ } -> Some (Code.Var.to_string name, typ)
+        | Import { name; desc = Fun typ } -> Some (name, typ))
+      fields
+  in
+  let define_symbol name =
+    line (string ".hidden " ^^ string name) ^^ line (string ".globl " ^^ string name)
+  in
+  let declare_func_type name typ =
+    line (string ".functype " ^^ string name ^^ string " " ^^ func_type typ)
+  in
+  let function_section =
+    concat_map
+      (fun f ->
+        match f with
+        | Function { name; exported_name; typ; locals; body } ->
+            let name = Code.Var.to_string name in
+            indent
+              (section_header "text" name
+              ^^ define_symbol name
+              ^^
+              match exported_name with
+              | None -> empty
+              | Some exported_name ->
+                  line
+                    (string ".export_name "
+                    ^^ string name
+                    ^^ string ","
+                    ^^ string exported_name))
+            ^^ line (string name ^^ string ":")
+            ^^ indent
+                 (declare_func_type name typ
+                 ^^ (if List.is_empty locals
+                     then empty
+                     else
+                       line
+                         (string ".local " ^^ separate_map (string ", ") value_type locals))
+                 ^^ concat_map instruction body
+                 ^^ line (string "end_function"))
+        | Import _ -> empty)
+      fields
+  in
+  indent (concat_map (fun (name, typ) -> declare_func_type name typ) types)
+  ^^ function_section
diff --git a/compiler/lib/wasm/wa_asm_output.mli b/compiler/lib/wasm/wa_asm_output.mli
new file mode 100644
index 0000000000..a2cbc9164d
--- /dev/null
+++ b/compiler/lib/wasm/wa_asm_output.mli
@@ -0,0 +1 @@
+val f : Wa_ast.module_field list -> unit

From b49f56960bac88f1a5fe36afd082106a31fe08c4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 29 Mar 2023 16:31:03 +0200
Subject: [PATCH 003/481] Structured control flow + simple instructions

---
 compiler/lib/driver.ml                   |   1 +
 compiler/lib/wasm/wa_code_generation.ml  | 185 ++++++++++++++
 compiler/lib/wasm/wa_code_generation.mli |  65 +++++
 compiler/lib/wasm/wa_core_target.ml      |  53 ++++
 compiler/lib/wasm/wa_core_target.mli     |   1 +
 compiler/lib/wasm/wa_generate.ml         | 308 +++++++++++++++++++++++
 compiler/lib/wasm/wa_generate.mli        |   1 +
 compiler/lib/wasm/wa_structure.ml        | 147 +++++++++++
 compiler/lib/wasm/wa_target_sig.ml       |  53 ++++
 9 files changed, 814 insertions(+)
 create mode 100644 compiler/lib/wasm/wa_code_generation.ml
 create mode 100644 compiler/lib/wasm/wa_code_generation.mli
 create mode 100644 compiler/lib/wasm/wa_core_target.ml
 create mode 100644 compiler/lib/wasm/wa_core_target.mli
 create mode 100644 compiler/lib/wasm/wa_generate.ml
 create mode 100644 compiler/lib/wasm/wa_generate.mli
 create mode 100644 compiler/lib/wasm/wa_structure.ml
 create mode 100644 compiler/lib/wasm/wa_target_sig.ml

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index b1c2b93b57..e0561b9c6e 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -178,6 +178,7 @@ let generate
     ((p, live_vars), cps_calls) =
   if times () then Format.eprintf "Start Generation...@.";
   let should_export = should_export wrap_with_fun in
+  Wa_generate.f ~live_vars p;
   Generate.f
     p
     ~exported_runtime
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
new file mode 100644
index 0000000000..8144f9f9dd
--- /dev/null
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -0,0 +1,185 @@
+open! Stdlib
+open Code
+module W = Wa_ast
+
+(*
+LLVM type checker does not work well. It does not handle 'br', and
+there is a bug with `return` in clang 15.
+Use 'clang-16 --target=wasm32 -Wa,--no-type-check' to disable it.
+https://github.com/llvm/llvm-project/issues/56935
+https://github.com/llvm/llvm-project/issues/58438
+*)
+
+(* binaryen does not support block input parameters
+   https://github.com/WebAssembly/binaryen/issues/5047 *)
+
+type var = int
+
+and state =
+  { var_count : int
+  ; vars : var Var.Map.t
+  ; instrs : W.instruction list
+  }
+
+and 'a t = state -> 'a * state
+
+type expression = Wa_ast.expression t
+
+let ( let* ) (type a b) (e : a t) (f : a -> b t) : b t =
+ fun st ->
+  let v, st = e st in
+  f v st
+
+let return x st = x, st
+
+let expression_list f l =
+  let rec loop acc l =
+    match l with
+    | [] -> return (List.rev acc)
+    | x :: r ->
+        let* x = f x in
+        loop (x :: acc) r
+  in
+  loop [] l
+
+let var x st =
+  try Var.Map.find x st.vars, st
+  with Not_found ->
+    Format.eprintf "ZZZ %a@." Var.print x;
+    0, st
+
+let add_var x ({ var_count; vars; _ } as st) =
+  match Var.Map.find_opt x vars with
+  | Some i -> i, st
+  | None ->
+      let i = var_count in
+      let vars = Var.Map.add x i vars in
+      i, { st with var_count = var_count + 1; vars }
+
+let instr i : unit t = fun st -> (), { st with instrs = i :: st.instrs }
+
+let blk l st =
+  let instrs = st.instrs in
+  let (), st = l { st with instrs = [] } in
+  List.rev st.instrs, { st with instrs }
+
+module Arith = struct
+  let binary op e e' =
+    let* e = e in
+    let* e' = e' in
+    return (W.BinOp (I32 op, e, e'))
+
+  let unary op e =
+    let* e = e in
+    return (W.UnOp (I32 op, e))
+
+  let ( + ) e e' =
+    let* e = e in
+    let* e' = e' in
+    return
+      (match e, e' with
+      | W.BinOp (I32 Add, e1, W.Const (I32 n)), W.Const (I32 n') ->
+          let n'' = Int32.add n n' in
+          if Int32.equal n'' 0l
+          then e1
+          else W.BinOp (I32 Add, e1, W.Const (I32 (Int32.add n n')))
+      | W.Const (I32 n), W.Const (I32 n') -> W.Const (I32 (Int32.add n n'))
+      | W.Const (I32 0l), _ -> e'
+      | _, W.Const (I32 0l) -> e
+      | W.ConstSym (sym, offset), W.Const (I32 n) ->
+          W.ConstSym (sym, offset + Int32.to_int n)
+      | W.Const _, _ -> W.BinOp (I32 Add, e', e)
+      | _ -> W.BinOp (I32 Add, e, e'))
+
+  let ( - ) e e' =
+    let* e = e in
+    let* e' = e' in
+    return
+      (match e, e' with
+      | W.BinOp (I32 Add, e1, W.Const (I32 n)), W.Const (I32 n') ->
+          let n'' = Int32.sub n n' in
+          if Int32.equal n'' 0l then e1 else W.BinOp (I32 Add, e1, W.Const (I32 n''))
+      | W.Const (I32 n), W.Const (I32 n') -> W.Const (I32 (Int32.sub n n'))
+      | _, W.Const (I32 n) ->
+          if Int32.equal n 0l then e else W.BinOp (I32 Add, e, W.Const (I32 (Int32.neg n)))
+      | _ -> W.BinOp (I32 Sub, e, e'))
+
+  let ( * ) = binary Mul
+
+  let ( lsl ) e e' =
+    let* e = e in
+    let* e' = e' in
+    return
+      (match e, e' with
+      | W.Const (I32 n), W.Const (I32 n') when Poly.(n' < 31l) ->
+          W.Const (I32 (Int32.shift_left n (Int32.to_int n')))
+      | _ -> W.BinOp (I32 Shl, e, e'))
+
+  let ( lsr ) = binary (Shr U)
+
+  let ( asr ) = binary (Shr S)
+
+  let ( land ) = binary And
+
+  let ( lor ) = binary Or
+
+  let ( lxor ) = binary Xor
+
+  let ( < ) = binary (Lt S)
+
+  let ( <= ) = binary (Le S)
+
+  let ( = ) = binary Eq
+
+  let ( <> ) = binary Ne
+
+  let ult = binary (Lt U)
+
+  let eqz = unary Eqz
+
+  let const n = return (W.Const (I32 n))
+end
+
+let load x =
+  let* x = var x in
+  return (W.LocalGet x)
+
+let tee x e =
+  let* e = e in
+  let* i = add_var x in
+  return (W.LocalTee (i, e))
+
+let store x e =
+  let* e = e in
+  let* i = add_var x in
+  instr (LocalSet (i, e))
+
+let assign x e =
+  let* x = var x in
+  let* e = e in
+  instr (W.LocalSet (x, e))
+
+let drop e =
+  let* e = e in
+  instr (Drop e)
+
+let loop ty l =
+  let* instrs = blk l in
+  instr (Loop (ty, instrs))
+
+let block ty l =
+  let* instrs = blk l in
+  instr (Block (ty, instrs))
+
+let if_ ty e l1 l2 =
+  let* e = e in
+  let* instrs1 = blk l1 in
+  let* instrs2 = blk l2 in
+  match e with
+  | W.UnOp (I32 Eqz, e') -> instr (If (ty, e', instrs2, instrs1))
+  | _ -> instr (If (ty, e, instrs1, instrs2))
+
+let function_body ~body =
+  let st = { var_count = 0; vars = Var.Map.empty; instrs = [] } in
+  let (), st = body st in
+  st.var_count, List.rev st.instrs
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
new file mode 100644
index 0000000000..b8327b676e
--- /dev/null
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -0,0 +1,65 @@
+type 'a t
+
+type expression = Wa_ast.expression t
+
+val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+
+val return : 'a -> 'a t
+
+val instr : Wa_ast.instruction -> unit t
+
+val expression_list : ('a -> expression) -> 'a list -> Wa_ast.expression list t
+
+module Arith : sig
+  val const : int32 -> expression
+
+  val ( + ) : expression -> expression -> expression
+
+  val ( - ) : expression -> expression -> expression
+
+  val ( * ) : expression -> expression -> expression
+
+  val ( lsl ) : expression -> expression -> expression
+
+  val ( lsr ) : expression -> expression -> expression
+
+  val ( asr ) : expression -> expression -> expression
+
+  val ( land ) : expression -> expression -> expression
+
+  val ( lor ) : expression -> expression -> expression
+
+  val ( lxor ) : expression -> expression -> expression
+
+  val ( < ) : expression -> expression -> expression
+
+  val ( <= ) : expression -> expression -> expression
+
+  val ( = ) : expression -> expression -> expression
+
+  val ( <> ) : expression -> expression -> expression
+
+  val ult : expression -> expression -> expression
+
+  val eqz : expression -> expression
+end
+
+val load : Wa_ast.var -> expression
+
+val tee : Wa_ast.var -> expression -> expression
+
+val store : Wa_ast.var -> expression -> unit t
+
+val assign : Wa_ast.var -> expression -> unit t
+
+val drop : expression -> unit t
+
+val loop : Wa_ast.func_type -> unit t -> unit t
+
+val block : Wa_ast.func_type -> unit t -> unit t
+
+val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
+
+val add_var : Wa_ast.var -> int t
+
+val function_body : body:unit t -> int * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
new file mode 100644
index 0000000000..1c69984395
--- /dev/null
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -0,0 +1,53 @@
+open! Stdlib
+module W = Wa_ast
+open Wa_code_generation
+
+type expression = Wa_ast.expression Wa_code_generation.t
+
+module Value = struct
+  let value : W.value_type = I32
+
+  let unit = Arith.const 1l
+
+  let val_int i = Arith.((i lsl const 1l) + const 1l)
+
+  let int_val i = Arith.(i asr const 1l)
+
+  let check_is_not_zero i = Arith.(i <> const 1l)
+
+  let check_is_int i = Arith.(i land const 1l)
+
+  let not b = Arith.(const 4l - b)
+
+  let lt i i' = val_int Arith.(i < i')
+
+  let le i i' = val_int Arith.(i <= i')
+
+  let eq i i' = val_int Arith.(i = i')
+
+  let neq i i' = val_int Arith.(i <> i')
+
+  let ult i i' = val_int Arith.(ult i i')
+
+  let is_int i = val_int Arith.(i land const 1l)
+
+  let int_add i i' = Arith.(i + i' - const 1l)
+
+  let int_sub i i' = Arith.(i - i' + const 1l)
+
+  let int_mul i i' = val_int Arith.(int_val i * int_val i')
+
+  let int_neg i = Arith.(const 2l - i)
+
+  let int_or i i' = Arith.(i lor i')
+
+  let int_and i i' = Arith.(i land i')
+
+  let int_xor i i' = Arith.(i lxor i' lor const 1l)
+
+  let int_lsl i i' = Arith.(((i - const 1l) lsl int_val i') + const 1l)
+
+  let int_lsr i i' = Arith.((i lsr int_val i') lor const 1l)
+
+  let int_asr i i' = Arith.((i asr int_val i') lor const 1l)
+end
diff --git a/compiler/lib/wasm/wa_core_target.mli b/compiler/lib/wasm/wa_core_target.mli
new file mode 100644
index 0000000000..97ae000338
--- /dev/null
+++ b/compiler/lib/wasm/wa_core_target.mli
@@ -0,0 +1 @@
+include Wa_target_sig.S
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
new file mode 100644
index 0000000000..1a47090d3b
--- /dev/null
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -0,0 +1,308 @@
+open! Stdlib
+open Code
+module W = Wa_ast
+open Wa_code_generation
+open Wa_core_target
+
+let transl_prim_arg x =
+  match x with
+  | Pv x -> load x
+  | Pc _ -> (*ZZZ*) Arith.const 0l
+
+type ctx =
+  { live : int array
+  ; blocks : block Addr.Map.t
+  ; mutable primitives : W.func_type StringMap.t
+  }
+
+let register_primitive ctx nm typ =
+  (*ZZZ check type*)
+  if not (StringMap.mem nm ctx.primitives)
+  then ctx.primitives <- StringMap.add nm typ ctx.primitives
+
+let func_type n =
+  { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
+
+let rec translate_expr ctx e =
+  match e with
+  | Apply _ | Block _ | Field _ | Closure _ | Constant _ -> (*ZZZ*) Arith.const 0l
+  | Prim (p, l) -> (
+      let l = List.map ~f:transl_prim_arg l in
+      match p, l with
+      | Extern "%int_add", [ x; y ] -> Value.int_add x y
+      | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
+      | Extern "%int_mul", [ x; y ] -> Value.int_mul x y
+      | Extern "%int_neg", [ x ] -> Value.int_neg x
+      | Extern "%int_or", [ x; y ] -> Value.int_or x y
+      | Extern "%int_and", [ x; y ] -> Value.int_and x y
+      | Extern "%int_xor", [ x; y ] -> Value.int_xor x y
+      | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y
+      | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
+      | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
+      | Extern nm, l ->
+          (*ZZZ Different calling convention when large number of parameters *)
+          register_primitive ctx nm (func_type (List.length l));
+          let rec loop acc l =
+            match l with
+            | [] -> return (W.Call (S nm, List.rev acc))
+            | x :: r ->
+                let* x = x in
+                loop (x :: acc) r
+          in
+          loop [] l
+      | Not, [ x ] -> Value.not x
+      | Lt, [ x; y ] -> Value.lt x y
+      | Le, [ x; y ] -> Value.le x y
+      | Eq, [ x; y ] -> Value.eq x y
+      | Neq, [ x; y ] -> Value.neq x y
+      | Ult, [ x; y ] -> Value.ult x y
+      | Array_get, [ _x; _y ] -> (*ZZZ*) Arith.const 0l
+      | IsInt, [ x ] -> Value.is_int x
+      | Vectlength, [ _x ] -> (*ZZZ*) Arith.const 0l
+      | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
+          assert false)
+
+and translate_instr ctx (i, _) =
+  match i with
+  | Assign (x, y) -> assign x (load y)
+  | Let (x, e) ->
+      if ctx.live.(Var.idx x) = 0
+      then drop (translate_expr ctx e)
+      else store x (translate_expr ctx e)
+  | Set_field _ | Offset_ref _ | Array_set _ -> (*ZZZ*) return ()
+
+and translate_instrs ctx l =
+  match l with
+  | [] -> return ()
+  | i :: rem ->
+      let* () = translate_instr ctx i in
+      translate_instrs ctx rem
+
+let parallel_renaming params args =
+  let rec visit visited prev s m x l =
+    if not (Var.Set.mem x visited)
+    then
+      let visited = Var.Set.add x visited in
+      let y = Var.Map.find x m in
+      if Code.Var.compare x y = 0
+      then visited, None, l
+      else if Var.Set.mem y prev
+      then
+        let t = Code.Var.fresh () in
+        visited, Some (y, t), (x, t) :: l
+      else if Var.Set.mem y s
+      then
+        let visited, aliases, l = visit visited (Var.Set.add x prev) s m y l in
+        match aliases with
+        | Some (a, b) when Code.Var.compare a x = 0 ->
+            visited, None, (b, a) :: (x, y) :: l
+        | _ -> visited, aliases, (x, y) :: l
+      else visited, None, (x, y) :: l
+    else visited, None, l
+  in
+  let visit_all params args =
+    let m = Subst.build_mapping params args in
+    let s = List.fold_left params ~init:Var.Set.empty ~f:(fun s x -> Var.Set.add x s) in
+    let _, l =
+      Var.Set.fold
+        (fun x (visited, l) ->
+          let visited, _, l = visit visited Var.Set.empty s m x l in
+          visited, l)
+        s
+        (Var.Set.empty, [])
+    in
+    l
+  in
+  let l = List.rev (visit_all params args) in
+  List.fold_left
+    l
+    ~f:(fun continuation (y, x) ->
+      let* () = continuation in
+      store y (load x))
+    ~init:(return ())
+
+let extend_context fall_through context =
+  match fall_through with
+  | `Block _ as b -> b :: context
+  | `Return -> `Skip :: context
+
+let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
+  let g = Wa_structure.build_graph ctx.blocks pc in
+  let idom = Wa_structure.dominator_tree g in
+  let dom = Wa_structure.reverse_tree idom in
+  let rec index pc i context =
+    match context with
+    | `Block pc' :: _ when pc = pc' -> i
+    | (`Block _ | `Skip) :: rem -> index pc (i + 1) rem
+    | [] -> assert false
+  in
+  let rec translate_tree result_typ fall_through pc context =
+    let block = Addr.Map.find pc ctx.blocks in
+    let is_switch =
+      match fst block.branch with
+      | Switch _ -> true
+      | _ -> false
+    in
+    let code ~context =
+      translate_node_within
+        ~result_typ
+        ~fall_through
+        ~pc
+        ~l:
+          (List.filter
+             ~f:(fun pc' -> is_switch || Wa_structure.is_merge_node g pc')
+             (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc))))
+        ~context
+    in
+    if Wa_structure.is_loop_header g pc
+    then loop { params = []; result = result_typ } (code ~context:(`Block pc :: context))
+    else code ~context
+  and translate_node_within ~result_typ ~fall_through ~pc ~l ~context =
+    match l with
+    | pc' :: rem ->
+        let* () =
+          let code ~context =
+            translate_node_within
+              ~result_typ:[]
+              ~fall_through:(`Block pc')
+              ~pc
+              ~l:rem
+              ~context
+          in
+          (* Do not insert a block if the inner code contains a
+             structured control flow instruction ([if] or [try] *)
+          if (not (List.is_empty rem))
+             ||
+             let block = Addr.Map.find pc ctx.blocks in
+             match fst block.branch with
+             | Cond _ | Pushtrap _ -> false (*ZZZ also some Switch*)
+             | _ -> true
+          then
+            block
+              { params = []; result = result_typ }
+              (code ~context:(`Block pc' :: context))
+          else code ~context
+        in
+        translate_tree result_typ fall_through pc' context
+    | [] -> (
+        let block = Addr.Map.find pc ctx.blocks in
+        let* () = translate_instrs ctx block.body in
+        match fst block.branch with
+        | Branch cont -> translate_branch result_typ fall_through pc cont context
+        | Return x -> (
+            let* e = load x in
+            match fall_through with
+            | `Return -> instr (Push e)
+            | `Block _ -> instr (Return (Some e)))
+        | Cond (x, cont1, cont2) ->
+            let context' = extend_context fall_through context in
+            if_
+              { params = []; result = result_typ }
+              (Value.check_is_not_zero (load x))
+              (translate_branch result_typ fall_through pc cont1 context')
+              (translate_branch result_typ fall_through pc cont2 context')
+        | Stop -> (
+            let* e = Value.unit in
+            match fall_through with
+            | `Return -> instr (Push e)
+            | `Block _ -> instr (Return (Some e)))
+        | Switch _ | Raise _ | Pushtrap _ | Poptrap _ -> return ())
+  and translate_branch result_typ fall_through src (dst, args) context =
+    let* () =
+      if List.is_empty args
+      then return ()
+      else
+        let block = Addr.Map.find dst ctx.blocks in
+        parallel_renaming block.params args
+    in
+    if (src >= 0 && Wa_structure.is_backward g src dst)
+       || Wa_structure.is_merge_node g dst
+    then
+      match fall_through with
+      | `Block dst' when dst = dst' -> return ()
+      | _ -> instr (Br (index dst 0 context, None))
+    else translate_tree result_typ fall_through dst context
+  in
+  let bind_parameters =
+    List.fold_left
+      ~f:(fun l x ->
+        let* _ = l in
+        let* _ = add_var x in
+        return ())
+      ~init:(return ())
+      params
+  in
+  let build_initial_env =
+    let* () = bind_parameters in
+    let* _ = add_var (Code.Var.fresh ()) in
+    return ()
+  in
+  (*
+  Format.eprintf "=== %d ===@." pc;
+*)
+  let param_count =
+    match name_opt with
+    | None -> 0
+    | Some _ -> List.length params + 1
+  in
+  let local_count, body =
+    function_body
+      ~body:
+        (let* () = build_initial_env in
+         translate_branch [ Value.value ] `Return (-1) cont [])
+  in
+  W.Function
+    { name =
+        (match name_opt with
+        | None -> toplevel_name
+        | Some x -> x)
+    ; exported_name = None
+    ; typ = func_type param_count
+    ; locals = List.init ~len:(local_count - param_count) ~f:(fun _ -> Value.value)
+    ; body
+    }
+  :: acc
+
+let entry_point toplevel_fun entry_name =
+  let body = drop (return (W.Call (V toplevel_fun, []))) in
+  let _, body = function_body ~body in
+  W.Function
+    { name = Var.fresh_n "entry_point"
+    ; exported_name = Some entry_name
+    ; typ = { W.params = []; result = [] }
+    ; locals = []
+    ; body
+    }
+
+let f
+    (p : Code.program)
+    ~live_vars
+     (*
+    ~cps_calls
+    ~should_export
+    ~warn_on_unhandled_effect
+      _debug *) =
+  (*
+  Code.Print.program (fun _ _ -> "") p;
+*)
+  let ctx = { live = live_vars; blocks = p.blocks; primitives = StringMap.empty } in
+  let toplevel_name = Var.fresh_n "toplevel" in
+  let functions =
+    Code.fold_closures
+      p
+      (fun name_opt params cont ->
+        translate_function ctx name_opt toplevel_name params cont)
+      []
+  in
+  let primitives =
+    List.map
+      ~f:(fun (name, ty) -> W.Import { name; desc = Fun ty })
+      (StringMap.bindings ctx.primitives)
+  in
+  let start_function = entry_point toplevel_name "kernel_run" in
+  let fields = primitives @ functions @ [ start_function ] in
+  fields
+
+let f (p : Code.program) ~live_vars =
+  let fields = f ~live_vars p in
+  Wa_asm_output.f fields
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
new file mode 100644
index 0000000000..b2d60bc2a5
--- /dev/null
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -0,0 +1 @@
+val f : Code.program -> live_vars:int array -> unit
diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
new file mode 100644
index 0000000000..28c45c6f85
--- /dev/null
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -0,0 +1,147 @@
+open Stdlib
+open Code
+
+let get_edges g src = try Hashtbl.find g src with Not_found -> Addr.Set.empty
+
+let add_edge g src dst = Hashtbl.replace g src (Addr.Set.add dst (get_edges g src))
+
+let reverse_graph g =
+  let g' = Hashtbl.create 16 in
+  Hashtbl.iter
+    (fun child parents -> Addr.Set.iter (fun parent -> add_edge g' parent child) parents)
+    g;
+  g'
+
+let reverse_tree t =
+  let g = Hashtbl.create 16 in
+  Hashtbl.iter (fun child parent -> add_edge g parent child) t;
+  g
+
+let rec leave_try_body blocks pc =
+  match Addr.Map.find pc blocks with
+  | { body = []; branch = (Return _ | Stop), _; _ } -> false
+  | { body = []; branch = Branch (pc', _), _; _ } -> leave_try_body blocks pc'
+  | _ -> true
+
+type control_flow_graph =
+  { succs : (Addr.t, Addr.Set.t) Hashtbl.t
+  ; preds : (Addr.t, Addr.Set.t) Hashtbl.t
+  ; reverse_post_order : Addr.t list
+  ; block_order : (Addr.t, int) Hashtbl.t
+  }
+
+let build_graph blocks pc =
+  let succs = Hashtbl.create 16 in
+  let l = ref [] in
+  let visited = Hashtbl.create 16 in
+  let rec traverse ~englobing_exn_handlers pc =
+    if not (Hashtbl.mem visited pc)
+    then (
+      Hashtbl.add visited pc ();
+      let successors = Code.fold_children blocks pc Addr.Set.add Addr.Set.empty in
+      Hashtbl.add succs pc successors;
+      let block = Addr.Map.find pc blocks in
+      Addr.Set.iter
+        (fun pc' ->
+          let englobing_exn_handlers =
+            match fst block.branch with
+            | Pushtrap ((body_pc, _), _, _, _) when pc' = body_pc ->
+                pc :: englobing_exn_handlers
+            | Poptrap (leave_pc, _) -> (
+                match englobing_exn_handlers with
+                | [] -> assert false
+                | enter_pc :: rem ->
+                    if leave_try_body blocks leave_pc
+                    then
+                      (* Add an edge to limit the [try] body *)
+                      Hashtbl.add
+                        succs
+                        enter_pc
+                        (Addr.Set.add leave_pc (Hashtbl.find succs enter_pc));
+                    rem)
+            | _ -> englobing_exn_handlers
+          in
+          traverse ~englobing_exn_handlers pc')
+        successors;
+      l := pc :: !l)
+  in
+  traverse ~englobing_exn_handlers:[] pc;
+  let block_order = Hashtbl.create 16 in
+  List.iteri !l ~f:(fun i pc -> Hashtbl.add block_order pc i);
+  let preds = reverse_graph succs in
+  { succs; preds; reverse_post_order = !l; block_order }
+
+let dominator_tree g =
+  (* A Simple, Fast Dominance Algorithm
+     Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy *)
+  let dom = Hashtbl.create 16 in
+  let rec inter pc pc' =
+    (* Compute closest common ancestor *)
+    if pc = pc'
+    then pc
+    else if Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+    then inter pc (Hashtbl.find dom pc')
+    else inter (Hashtbl.find dom pc) pc'
+  in
+  List.iter g.reverse_post_order ~f:(fun pc ->
+      let l = Hashtbl.find g.succs pc in
+      Addr.Set.iter
+        (fun pc' ->
+          if Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+          then
+            let d = try inter pc (Hashtbl.find dom pc') with Not_found -> pc in
+            Hashtbl.replace dom pc' d)
+        l);
+  (* Check we have reached a fixed point (reducible graph) *)
+  List.iter g.reverse_post_order ~f:(fun pc ->
+      let l = Hashtbl.find g.succs pc in
+      Addr.Set.iter
+        (fun pc' ->
+          if Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+          then
+            let d = Hashtbl.find dom pc' in
+            assert (inter pc d = d))
+        l);
+  dom
+
+(* pc dominates pc' *)
+let rec dominates g idom pc pc' =
+  pc = pc'
+  || Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+     && dominates g idom pc (Hashtbl.find idom pc')
+
+(* pc has at least two forward edges moving into it *)
+let is_merge_node g pc =
+  let s = try Hashtbl.find g.preds pc with Not_found -> Addr.Set.empty in
+  let o = Hashtbl.find g.block_order pc in
+  let n =
+    Addr.Set.fold
+      (fun pc' n -> if Hashtbl.find g.block_order pc' < o then n + 1 else n)
+      s
+      0
+  in
+  n > 1
+
+let is_loop_header g pc =
+  let s = try Hashtbl.find g.preds pc with Not_found -> Addr.Set.empty in
+  let o = Hashtbl.find g.block_order pc in
+  Addr.Set.exists (fun pc' -> Hashtbl.find g.block_order pc' >= o) s
+
+let is_backward g pc pc' = Hashtbl.find g.block_order pc >= Hashtbl.find g.block_order pc'
+
+let dominance_frontier g idom =
+  let frontiers = Hashtbl.create 16 in
+  Hashtbl.iter
+    (fun pc preds ->
+      if Addr.Set.cardinal preds > 1
+      then
+        let dom = Hashtbl.find idom pc in
+        let rec loop runner =
+          if runner <> dom
+          then (
+            add_edge frontiers runner pc;
+            loop (Hashtbl.find idom runner))
+        in
+        Addr.Set.iter loop preds)
+    g.preds;
+  frontiers
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
new file mode 100644
index 0000000000..b591350166
--- /dev/null
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -0,0 +1,53 @@
+module type S = sig
+  type expression = Wa_code_generation.expression
+
+  module Value : sig
+    val value : Wa_ast.value_type
+
+    val unit : expression
+
+    val val_int : expression -> expression
+
+    val int_val : expression -> expression
+
+    val check_is_not_zero : expression -> expression
+    (** Returns an int32 value *)
+
+    val check_is_int : expression -> expression
+    (** Returns an int32 value *)
+
+    val not : expression -> expression
+
+    val lt : expression -> expression -> expression
+
+    val le : expression -> expression -> expression
+
+    val eq : expression -> expression -> expression
+
+    val neq : expression -> expression -> expression
+
+    val ult : expression -> expression -> expression
+
+    val is_int : expression -> expression
+
+    val int_add : expression -> expression -> expression
+
+    val int_sub : expression -> expression -> expression
+
+    val int_mul : expression -> expression -> expression
+
+    val int_neg : expression -> expression
+
+    val int_or : expression -> expression -> expression
+
+    val int_and : expression -> expression -> expression
+
+    val int_xor : expression -> expression -> expression
+
+    val int_lsl : expression -> expression -> expression
+
+    val int_lsr : expression -> expression -> expression
+
+    val int_asr : expression -> expression -> expression
+  end
+end

From c686d2482f0cd68ae9172124c87073062707a32a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 29 Mar 2023 18:35:20 +0200
Subject: [PATCH 004/481] Memory operations

---
 compiler/lib/wasm/wa_asm_output.ml       | 29 +++++++-
 compiler/lib/wasm/wa_ast.ml              | 12 +++
 compiler/lib/wasm/wa_code_generation.ml  | 19 ++++-
 compiler/lib/wasm/wa_code_generation.mli | 10 ++-
 compiler/lib/wasm/wa_core_target.ml      | 95 ++++++++++++++++++++++++
 compiler/lib/wasm/wa_generate.ml         | 79 +++++++++++++++++---
 compiler/lib/wasm/wa_target_sig.ml       | 24 ++++++
 7 files changed, 250 insertions(+), 18 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 033b179bf5..3d1f4fd0cc 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -285,7 +285,7 @@ let f fields =
     ~f:(fun f ->
       match f with
       | Import { name; _ } -> Var_printer.add_reserved name
-      | Function _ -> ())
+      | Function _ | Global _ -> ())
     fields;
   to_channel stdout
   @@
@@ -294,12 +294,31 @@ let f fields =
       ~f:(fun f ->
         match f with
         | Function { name; typ; _ } -> Some (Code.Var.to_string name, typ)
-        | Import { name; desc = Fun typ } -> Some (name, typ))
+        | Import { name; desc = Fun typ } -> Some (name, typ)
+        | Global _ -> None)
+      fields
+  in
+  let globals =
+    List.filter_map
+      ~f:(fun f ->
+        match f with
+        | Function _ | Import _ -> None
+        | Global { name; typ; init } ->
+            assert (Poly.equal init (Const (I32 0l)));
+            Some (name, typ))
       fields
   in
   let define_symbol name =
     line (string ".hidden " ^^ string name) ^^ line (string ".globl " ^^ string name)
   in
+  let declare_global name { mut; typ } =
+    line
+      (string ".globaltype "
+      ^^ symbol name 0
+      ^^ string ", "
+      ^^ value_type typ
+      ^^ if mut then empty else string ", immutable")
+  in
   let declare_func_type name typ =
     line (string ".functype " ^^ string name ^^ string " " ^^ func_type typ)
   in
@@ -331,8 +350,10 @@ let f fields =
                          (string ".local " ^^ separate_map (string ", ") value_type locals))
                  ^^ concat_map instruction body
                  ^^ line (string "end_function"))
-        | Import _ -> empty)
+        | Import _ | Global _ -> empty)
       fields
   in
-  indent (concat_map (fun (name, typ) -> declare_func_type name typ) types)
+  indent
+    (concat_map (fun (name, typ) -> declare_global name typ) globals
+    ^^ concat_map (fun (name, typ) -> declare_func_type name typ) types)
   ^^ function_section
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 2c1d817547..8d7a343207 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -9,6 +9,13 @@ type value_type =
   | I64
   | F64
 
+type 'typ mut_type =
+  { mut : bool
+  ; typ : 'typ
+  }
+
+type global_type = value_type mut_type
+
 type func_type =
   { params : value_type list
   ; result : value_type list
@@ -117,6 +124,11 @@ type module_field =
       ; locals : value_type list
       ; body : instruction list
       }
+  | Global of
+      { name : symbol
+      ; typ : global_type
+      ; init : expression
+      }
   | Import of
       { name : string
       ; desc : import_desc
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 8144f9f9dd..5a9b179dc9 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -13,12 +13,17 @@ https://github.com/llvm/llvm-project/issues/58438
 (* binaryen does not support block input parameters
    https://github.com/WebAssembly/binaryen/issues/5047 *)
 
+type context = { mutable other_fields : W.module_field list }
+
+let make_context () = { other_fields = [] }
+
 type var = int
 
 and state =
   { var_count : int
   ; vars : var Var.Map.t
   ; instrs : W.instruction list
+  ; context : context
   }
 
 and 'a t = state -> 'a * state
@@ -42,6 +47,11 @@ let expression_list f l =
   in
   loop [] l
 
+let register_global name typ init st =
+  st.context.other_fields <-
+    W.Global { name = S name; typ; init } :: st.context.other_fields;
+  (), st
+
 let var x st =
   try Var.Map.find x st.vars, st
   with Not_found ->
@@ -159,6 +169,11 @@ let assign x e =
   let* e = e in
   instr (W.LocalSet (x, e))
 
+let seq l e =
+  let* instrs = blk l in
+  let* e = e in
+  return (W.Seq (instrs, e))
+
 let drop e =
   let* e = e in
   instr (Drop e)
@@ -179,7 +194,7 @@ let if_ ty e l1 l2 =
   | W.UnOp (I32 Eqz, e') -> instr (If (ty, e', instrs2, instrs1))
   | _ -> instr (If (ty, e, instrs1, instrs2))
 
-let function_body ~body =
-  let st = { var_count = 0; vars = Var.Map.empty; instrs = [] } in
+let function_body ~context ~body =
+  let st = { var_count = 0; vars = Var.Map.empty; instrs = []; context } in
   let (), st = body st in
   st.var_count, List.rev st.instrs
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index b8327b676e..547dc5d217 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -1,3 +1,7 @@
+type context = { mutable other_fields : Wa_ast.module_field list }
+
+val make_context : unit -> context
+
 type 'a t
 
 type expression = Wa_ast.expression t
@@ -8,6 +12,8 @@ val return : 'a -> 'a t
 
 val instr : Wa_ast.instruction -> unit t
 
+val seq : unit t -> expression -> expression
+
 val expression_list : ('a -> expression) -> 'a list -> Wa_ast.expression list t
 
 module Arith : sig
@@ -62,4 +68,6 @@ val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
 val add_var : Wa_ast.var -> int t
 
-val function_body : body:unit t -> int * Wa_ast.instruction list
+val register_global : string -> Wa_ast.global_type -> Wa_ast.expression -> unit t
+
+val function_body : context:context -> body:unit t -> int * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 1c69984395..738c015fbc 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -4,6 +4,86 @@ open Wa_code_generation
 
 type expression = Wa_ast.expression Wa_code_generation.t
 
+module Memory = struct
+  let mem_load ?(offset = 0) e =
+    assert (offset >= 0);
+    let* e = e in
+    return (W.Load (I32 (Int32.of_int offset), e))
+
+  let mem_init ?(offset = 0) e e' =
+    assert (offset >= 0);
+    let* e = e in
+    let* e' = e' in
+    instr (Store (I32 (Int32.of_int offset), e, e'))
+
+  let mem_store ?(offset = 0) e e' =
+    assert (offset >= 0);
+    let* e = Arith.(e + const (Int32.of_int offset)) in
+    let* e' = e' in
+    instr (CallInstr (S "caml_modify", [ e; e' ]))
+
+  (*ZZZ
+    p = young_ptr - size;
+    if (p < young_limit) {caml_call_gc(); p = young_ptr - size}
+    ...
+    return p + 4
+  *)
+  let header ?(const = false) ~tag ~len () =
+    Int32.(add (shift_left (of_int len) 10) (of_int (tag + if const then 3 * 256 else 0)))
+
+  let allocate ~tag l =
+    let len = List.length l in
+    let p = Code.Var.fresh_n "p" in
+    let size = (len + 1) * 4 in
+    seq
+      (let* v =
+         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
+       in
+       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
+       let* () = mem_init (load p) (Arith.const (header ~tag ~len ())) in
+       snd
+         (List.fold_right
+            ~init:(len, return ())
+            ~f:(fun v (i, cont) ->
+              ( i - 1
+              , let* () =
+                  mem_init
+                    ~offset:(4 * i)
+                    (load p)
+                    (match v with
+                    | `Var y -> load y
+                    | `Expr e -> return e)
+                in
+                cont ))
+            l))
+      Arith.(load p + const 4l)
+  (*ZZZ Float array?*)
+
+  let tag e = Arith.(mem_load (e - const 4l) land const 0xffl)
+
+  (*
+  let length e = Arith.(mem_load (e - const 4l) lsr const 10l)
+*)
+  let block_length e = Arith.((mem_load (e - const 4l) lsr const 9l) lor const 1l)
+
+  let array_get e e' = mem_load Arith.(e + ((e' - const 1l) lsl const 1l))
+
+  let array_set e e' e'' = mem_store Arith.(e + ((e' - const 1l) lsl const 1l)) e''
+
+  let bytes_get e e' =
+    let* addr = Arith.(e + e' - const 1l) in
+    return (W.Load8 (U, I32 (Int32.of_int 0), addr))
+
+  let bytes_set e e' e'' =
+    let* addr = Arith.(e + e' - const 1l) in
+    let* e'' = e'' in
+    instr (W.Store8 (U, I32 (Int32.of_int 0), addr, e''))
+
+  let field e idx = mem_load ~offset:(4 * idx) e
+
+  let set_field e idx e' = mem_store ~offset:(4 * idx) e e'
+end
+
 module Value = struct
   let value : W.value_type = I32
 
@@ -51,3 +131,18 @@ module Value = struct
 
   let int_asr i i' = Arith.((i asr int_val i') lor const 1l)
 end
+
+let entry_point ~register_primitive =
+  let declare_global name =
+    register_global name { mut = true; typ = I32 } (Const (I32 0l))
+  in
+  let* () = declare_global "young_ptr" in
+  let* () = declare_global "young_limit" in
+  register_primitive "caml_modify" { W.params = [ I32; I32 ]; result = [] };
+  register_primitive "__wasm_call_ctors" { W.params = []; result = [] };
+  let* () = instr (W.CallInstr (S "__wasm_call_ctors", [])) in
+  let* sz = Arith.const 3l in
+  let* high = Arith.((return (W.MemoryGrow (0, sz)) + const 3l) lsl const 16l) in
+  let* () = instr (W.GlobalSet (S "young_ptr", high)) in
+  let low = W.ConstSym (S "__heap_base", 0) in
+  instr (W.GlobalSet (S "young_limit", low))
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 1a47090d3b..056bb1a844 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -13,6 +13,7 @@ type ctx =
   { live : int array
   ; blocks : block Addr.Map.t
   ; mutable primitives : W.func_type StringMap.t
+  ; global_context : Wa_code_generation.context
   }
 
 let register_primitive ctx nm typ =
@@ -25,10 +26,23 @@ let func_type n =
 
 let rec translate_expr ctx e =
   match e with
-  | Apply _ | Block _ | Field _ | Closure _ | Constant _ -> (*ZZZ*) Arith.const 0l
+  | Apply _ -> (*ZZZ*) Arith.const 0l
+  | Block (tag, a, _) ->
+      Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
+  | Field (x, n) -> Memory.field (load x) n
+  | Closure _ | Constant _ -> (*ZZZ*) Arith.const 0l
   | Prim (p, l) -> (
       let l = List.map ~f:transl_prim_arg l in
       match p, l with
+      | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.array_get x y
+      | Extern "caml_array_unsafe_set", [ x; y; z ] ->
+          seq (Memory.array_set x y z) Value.unit
+      | Extern "caml_string_unsafe_get", [ x; y ] -> Memory.bytes_get x y
+      | Extern "caml_string_unsafe_set", [ x; y; z ] ->
+          seq (Memory.bytes_set x y z) Value.unit
+      | Extern "caml_bytes_unsafe_get", [ x; y ] -> Memory.bytes_get x y
+      | Extern "caml_bytes_unsafe_set", [ x; y; z ] ->
+          seq (Memory.bytes_set x y z) Value.unit
       | Extern "%int_add", [ x; y ] -> Value.int_add x y
       | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
       | Extern "%int_mul", [ x; y ] -> Value.int_mul x y
@@ -56,9 +70,9 @@ let rec translate_expr ctx e =
       | Eq, [ x; y ] -> Value.eq x y
       | Neq, [ x; y ] -> Value.neq x y
       | Ult, [ x; y ] -> Value.ult x y
-      | Array_get, [ _x; _y ] -> (*ZZZ*) Arith.const 0l
+      | Array_get, [ x; y ] -> Memory.array_get x y
       | IsInt, [ x ] -> Value.is_int x
-      | Vectlength, [ _x ] -> (*ZZZ*) Arith.const 0l
+      | Vectlength, [ x ] -> Memory.block_length x
       | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
           assert false)
 
@@ -69,7 +83,14 @@ and translate_instr ctx (i, _) =
       if ctx.live.(Var.idx x) = 0
       then drop (translate_expr ctx e)
       else store x (translate_expr ctx e)
-  | Set_field _ | Offset_ref _ | Array_set _ -> (*ZZZ*) return ()
+  | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
+  | Offset_ref (x, n) ->
+      Memory.set_field
+        (load x)
+        0
+        (Value.val_int
+           Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
+  | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
 
 and translate_instrs ctx l =
   match l with
@@ -206,7 +227,29 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
             match fall_through with
             | `Return -> instr (Push e)
             | `Block _ -> instr (Return (Some e)))
-        | Switch _ | Raise _ | Pushtrap _ | Poptrap _ -> return ())
+        | Switch (x, a1, a2) -> (
+            let br_table e a context =
+              let len = Array.length a in
+              let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
+              let dest (pc, args) =
+                assert (List.is_empty args);
+                index pc 0 context
+              in
+              let* e = e in
+              instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
+            in
+            match a1, a2 with
+            | [||], _ -> br_table (Memory.tag (load x)) a2 context
+            | _, [||] -> br_table (Value.int_val (load x)) a1 context
+            | _ ->
+                (*ZZZ Use Br_on_cast *)
+                let context' = extend_context fall_through context in
+                if_
+                  { params = []; result = result_typ }
+                  (Value.check_is_int (load x))
+                  (br_table (Value.int_val (load x)) a1 context')
+                  (br_table (Memory.tag (load x)) a2 context'))
+        | Raise _ | Pushtrap _ | Poptrap _ -> return ())
   and translate_branch result_typ fall_through src (dst, args) context =
     let* () =
       if List.is_empty args
@@ -247,6 +290,7 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
   in
   let local_count, body =
     function_body
+      ~context:ctx.global_context
       ~body:
         (let* () = build_initial_env in
          translate_branch [ Value.value ] `Return (-1) cont [])
@@ -263,9 +307,12 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
     }
   :: acc
 
-let entry_point toplevel_fun entry_name =
-  let body = drop (return (W.Call (V toplevel_fun, []))) in
-  let _, body = function_body ~body in
+let entry_point ctx toplevel_fun entry_name =
+  let body =
+    let* () = entry_point ~register_primitive:(register_primitive ctx) in
+    drop (return (W.Call (V toplevel_fun, [])))
+  in
+  let _, body = function_body ~context:ctx.global_context ~body in
   W.Function
     { name = Var.fresh_n "entry_point"
     ; exported_name = Some entry_name
@@ -285,7 +332,13 @@ let f
   (*
   Code.Print.program (fun _ _ -> "") p;
 *)
-  let ctx = { live = live_vars; blocks = p.blocks; primitives = StringMap.empty } in
+  let ctx =
+    { live = live_vars
+    ; blocks = p.blocks
+    ; primitives = StringMap.empty
+    ; global_context = make_context ()
+    }
+  in
   let toplevel_name = Var.fresh_n "toplevel" in
   let functions =
     Code.fold_closures
@@ -299,8 +352,12 @@ let f
       ~f:(fun (name, ty) -> W.Import { name; desc = Fun ty })
       (StringMap.bindings ctx.primitives)
   in
-  let start_function = entry_point toplevel_name "kernel_run" in
-  let fields = primitives @ functions @ [ start_function ] in
+  let start_function = entry_point ctx toplevel_name "kernel_run" in
+  let fields =
+    List.rev_append
+      ctx.global_context.other_fields
+      (primitives @ functions @ [ start_function ])
+  in
   fields
 
 let f (p : Code.program) ~live_vars =
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index b591350166..883b200746 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -1,6 +1,27 @@
 module type S = sig
   type expression = Wa_code_generation.expression
 
+  module Memory : sig
+    val allocate :
+      tag:int -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list -> expression
+
+    val tag : expression -> expression
+
+    val field : expression -> int -> expression
+
+    val set_field : expression -> int -> expression -> unit Wa_code_generation.t
+
+    val array_get : expression -> expression -> expression
+
+    val array_set : expression -> expression -> expression -> unit Wa_code_generation.t
+
+    val bytes_get : expression -> expression -> expression
+
+    val bytes_set : expression -> expression -> expression -> unit Wa_code_generation.t
+
+    val block_length : expression -> expression
+  end
+
   module Value : sig
     val value : Wa_ast.value_type
 
@@ -50,4 +71,7 @@ module type S = sig
 
     val int_asr : expression -> expression -> expression
   end
+
+  val entry_point :
+    register_primitive:(string -> Wa_ast.func_type -> unit) -> unit Wa_code_generation.t
 end

From 7ec6bc3bb087583a816d13f0d4aea084ab49f6f1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 30 Mar 2023 13:02:30 +0200
Subject: [PATCH 005/481] Constants

---
 compiler/lib/wasm/wa_asm_output.ml       | 71 ++++++++++++++++++++++--
 compiler/lib/wasm/wa_ast.ml              | 14 +++++
 compiler/lib/wasm/wa_code_generation.ml  |  9 ++-
 compiler/lib/wasm/wa_code_generation.mli |  7 ++-
 compiler/lib/wasm/wa_core_target.ml      | 60 ++++++++++++++++++++
 compiler/lib/wasm/wa_generate.ml         | 13 ++++-
 compiler/lib/wasm/wa_target_sig.ml       |  4 ++
 7 files changed, 168 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 3d1f4fd0cc..8d2e1e3235 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -276,6 +276,16 @@ and instruction i =
   | Nop -> empty
   | Push e -> expression e
 
+let escape_string s =
+  let b = Buffer.create (String.length s + 2) in
+  for i = 0 to String.length s - 1 do
+    let c = s.[i] in
+    if Poly.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\')
+    then Buffer.add_char b c
+    else Printf.bprintf b "\\x%02x" (Char.code c)
+  done;
+  Buffer.contents b
+
 let section_header kind name =
   line
     (string ".section ." ^^ string kind ^^ string "." ^^ string name ^^ string ",\"\",@")
@@ -285,7 +295,7 @@ let f fields =
     ~f:(fun f ->
       match f with
       | Import { name; _ } -> Var_printer.add_reserved name
-      | Function _ | Global _ -> ())
+      | Function _ | Data _ | Global _ -> ())
     fields;
   to_channel stdout
   @@
@@ -295,14 +305,14 @@ let f fields =
         match f with
         | Function { name; typ; _ } -> Some (Code.Var.to_string name, typ)
         | Import { name; desc = Fun typ } -> Some (name, typ)
-        | Global _ -> None)
+        | Data _ | Global _ -> None)
       fields
   in
   let globals =
     List.filter_map
       ~f:(fun f ->
         match f with
-        | Function _ | Import _ -> None
+        | Function _ | Import _ | Data _ -> None
         | Global { name; typ; init } ->
             assert (Poly.equal init (Const (I32 0l)));
             Some (name, typ))
@@ -322,6 +332,58 @@ let f fields =
   let declare_func_type name typ =
     line (string ".functype " ^^ string name ^^ string " " ^^ func_type typ)
   in
+  let data_sections =
+    concat_map
+      (fun f ->
+        match f with
+        | Function _ | Import _ -> empty
+        | Data { name; read_only; active; contents } ->
+            assert active;
+            (* Not supported *)
+            let name = Code.Var.to_string name in
+            let size =
+              List.fold_left
+                ~init:0
+                ~f:(fun s d ->
+                  s
+                  +
+                  match d with
+                  | DataI8 _ -> 1
+                  | DataI32 _ | DataSym _ -> 4
+                  | DataI64 _ -> 8
+                  | DataBytes b -> String.length b
+                  | DataSpace n -> n)
+                contents
+            in
+            indent
+              (section_header (if read_only then "rodata" else "data") name
+              ^^ define_symbol name
+              ^^ line (string ".p2align 2")
+              ^^ line (string ".size " ^^ string name ^^ string ", " ^^ integer size))
+            ^^ line (string name ^^ string ":")
+            ^^ indent
+                 (concat_map
+                    (fun d ->
+                      line
+                        (match d with
+                        | DataI8 i -> string ".int8 " ^^ integer i
+                        | DataI32 i -> string ".int32 " ^^ integer32 i
+                        | DataI64 i -> string ".int64 " ^^ integer64 i
+                        | DataBytes b ->
+                            string ".ascii \"" ^^ string (escape_string b) ^^ string "\""
+                        | DataSym (name, offset) -> string ".int32 " ^^ symbol name offset
+                        | DataSpace n -> string ".space " ^^ integer n))
+                    contents)
+        | Global { name; _ } ->
+            let name =
+              match name with
+              | V name -> Code.Var.to_string name
+              | S name -> name
+            in
+            indent (section_header "data" name ^^ define_symbol name)
+            ^^ line (string name ^^ string ":"))
+      fields
+  in
   let function_section =
     concat_map
       (fun f ->
@@ -350,10 +412,11 @@ let f fields =
                          (string ".local " ^^ separate_map (string ", ") value_type locals))
                  ^^ concat_map instruction body
                  ^^ line (string "end_function"))
-        | Import _ | Global _ -> empty)
+        | Import _ | Data _ | Global _ -> empty)
       fields
   in
   indent
     (concat_map (fun (name, typ) -> declare_global name typ) globals
     ^^ concat_map (fun (name, typ) -> declare_func_type name typ) types)
   ^^ function_section
+  ^^ data_sections
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 8d7a343207..81535bdf16 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -116,6 +116,14 @@ and instruction =
 
 type import_desc = Fun of func_type
 
+type data =
+  | DataI8 of int
+  | DataI32 of int32
+  | DataI64 of int64
+  | DataBytes of string
+  | DataSym of symbol * int
+  | DataSpace of int
+
 type module_field =
   | Function of
       { name : var
@@ -124,6 +132,12 @@ type module_field =
       ; locals : value_type list
       ; body : instruction list
       }
+  | Data of
+      { name : var
+      ; active : bool
+      ; read_only : bool
+      ; contents : data list
+      }
   | Global of
       { name : symbol
       ; typ : global_type
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 5a9b179dc9..6ff8c61f6d 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -13,9 +13,12 @@ https://github.com/llvm/llvm-project/issues/58438
 (* binaryen does not support block input parameters
    https://github.com/WebAssembly/binaryen/issues/5047 *)
 
-type context = { mutable other_fields : W.module_field list }
+type context =
+  { mutable data_segments : (bool * W.data list) Var.Map.t
+  ; mutable other_fields : W.module_field list
+  }
 
-let make_context () = { other_fields = [] }
+let make_context () = { data_segments = Var.Map.empty; other_fields = [] }
 
 type var = int
 
@@ -47,6 +50,8 @@ let expression_list f l =
   in
   loop [] l
 
+let get_context st = st.context, st
+
 let register_global name typ init st =
   st.context.other_fields <-
     W.Global { name = S name; typ; init } :: st.context.other_fields;
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 547dc5d217..7f79745369 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -1,4 +1,7 @@
-type context = { mutable other_fields : Wa_ast.module_field list }
+type context =
+  { mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
+  ; mutable other_fields : Wa_ast.module_field list
+  }
 
 val make_context : unit -> context
 
@@ -70,4 +73,6 @@ val add_var : Wa_ast.var -> int t
 
 val register_global : string -> Wa_ast.global_type -> Wa_ast.expression -> unit t
 
+val get_context : context t
+
 val function_body : context:context -> body:unit t -> int * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 738c015fbc..2dbbf182e1 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -132,6 +132,66 @@ module Value = struct
   let int_asr i i' = Arith.((i asr int_val i') lor const 1l)
 end
 
+module Constant = struct
+  let rec translate_rec context c =
+    match c with
+    | Code.Int i -> W.DataI32 Int32.(add (add i i) 1l)
+    | Tuple (tag, a, _) ->
+        let h = Memory.header ~const:true ~tag ~len:(Array.length a) () in
+        let name = Code.Var.fresh_n "block" in
+        let block =
+          W.DataI32 h :: List.map ~f:(fun c -> translate_rec context c) (Array.to_list a)
+        in
+        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
+        W.DataSym (V name, 4)
+    | NativeString (Byte s | Utf (Utf8 s)) | String s ->
+        let l = String.length s in
+        let len = (l + 4) / 4 in
+        let h = Memory.header ~const:true ~tag:Obj.string_tag ~len () in
+        let name = Code.Var.fresh_n "str" in
+        let extra = (4 * len) - l - 1 in
+        let string =
+          W.DataI32 h
+          :: DataBytes s
+          :: (if extra = 0 then [ DataI8 0 ] else [ DataSpace extra; DataI8 extra ])
+        in
+        context.data_segments <-
+          Code.Var.Map.add name (true, string) context.data_segments;
+        W.DataSym (V name, 4)
+    | Float f ->
+        let h = Memory.header ~const:true ~tag:Obj.double_tag ~len:2 () in
+        let name = Code.Var.fresh_n "float" in
+        let block = [ W.DataI32 h; DataI64 (Int64.bits_of_float f) ] in
+        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
+        W.DataSym (V name, 4)
+    | Float_array l ->
+        (*ZZZ Boxed array? *)
+        let l = Array.to_list l in
+        let h =
+          Memory.header ~const:true ~tag:Obj.double_array_tag ~len:(List.length l) ()
+        in
+        let name = Code.Var.fresh_n "float_array" in
+        let block =
+          W.DataI32 h :: List.map ~f:(fun f -> translate_rec context (Float f)) l
+        in
+        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
+        W.DataSym (V name, 4)
+    | Int64 i ->
+        let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:3 () in
+        let name = Code.Var.fresh_n "int64" in
+        let block = [ W.DataI32 h; DataSym (S "caml_int64_ops", 0); DataI64 i ] in
+        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
+        W.DataSym (V name, 4)
+
+  let translate c =
+    let* context = get_context in
+    return
+      (match translate_rec context c with
+      | W.DataSym (V name, offset) -> W.ConstSym (V name, offset)
+      | W.DataI32 i -> W.Const (I32 i)
+      | _ -> assert false)
+end
+
 let entry_point ~register_primitive =
   let declare_global name =
     register_global name { mut = true; typ = I32 } (Const (I32 0l))
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 056bb1a844..0e8c1edd2d 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -7,7 +7,7 @@ open Wa_core_target
 let transl_prim_arg x =
   match x with
   | Pv x -> load x
-  | Pc _ -> (*ZZZ*) Arith.const 0l
+  | Pc c -> Constant.translate c
 
 type ctx =
   { live : int array
@@ -30,7 +30,8 @@ let rec translate_expr ctx e =
   | Block (tag, a, _) ->
       Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
   | Field (x, n) -> Memory.field (load x) n
-  | Closure _ | Constant _ -> (*ZZZ*) Arith.const 0l
+  | Closure _ -> (*ZZZ*) Arith.const 0l
+  | Constant c -> Constant.translate c
   | Prim (p, l) -> (
       let l = List.map ~f:transl_prim_arg l in
       match p, l with
@@ -352,11 +353,17 @@ let f
       ~f:(fun (name, ty) -> W.Import { name; desc = Fun ty })
       (StringMap.bindings ctx.primitives)
   in
+  let constant_data =
+    List.map
+      ~f:(fun (name, (active, contents)) ->
+        W.Data { name; read_only = true; active; contents })
+      (Var.Map.bindings ctx.global_context.data_segments)
+  in
   let start_function = entry_point ctx toplevel_name "kernel_run" in
   let fields =
     List.rev_append
       ctx.global_context.other_fields
-      (primitives @ functions @ [ start_function ])
+      (primitives @ functions @ (start_function :: constant_data))
   in
   fields
 
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 883b200746..dd03c7633e 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -72,6 +72,10 @@ module type S = sig
     val int_asr : expression -> expression -> expression
   end
 
+  module Constant : sig
+    val translate : Code.constant -> expression
+  end
+
   val entry_point :
     register_primitive:(string -> Wa_ast.func_type -> unit) -> unit Wa_code_generation.t
 end

From 61ac73f60fef5436b9391b91cb775d1a16df5c7f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 30 Mar 2023 16:57:45 +0200
Subject: [PATCH 006/481] Closure conversion

---
 compiler/lib/wasm/wa_closure_conversion.ml  | 155 ++++++++++++++++++++
 compiler/lib/wasm/wa_closure_conversion.mli |   6 +
 compiler/lib/wasm/wa_code_generation.ml     |  37 +++--
 compiler/lib/wasm/wa_code_generation.mli    |   7 +-
 compiler/lib/wasm/wa_core_target.ml         | 132 +++++++++++++++++
 compiler/lib/wasm/wa_generate.ml            |  34 ++++-
 compiler/lib/wasm/wa_target_sig.ml          |  17 +++
 7 files changed, 370 insertions(+), 18 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_closure_conversion.ml
 create mode 100644 compiler/lib/wasm/wa_closure_conversion.mli

diff --git a/compiler/lib/wasm/wa_closure_conversion.ml b/compiler/lib/wasm/wa_closure_conversion.ml
new file mode 100644
index 0000000000..d00ad741fd
--- /dev/null
+++ b/compiler/lib/wasm/wa_closure_conversion.ml
@@ -0,0 +1,155 @@
+open! Stdlib
+open Code
+
+type closure =
+  { functions : (Var.t * int) list
+  ; free_variables : Var.t list
+  }
+
+module SCC = Strongly_connected_components.Make (Var)
+
+let iter_closures ~f instrs =
+  let rec iter_closures_rec f instr_acc clos_acc instrs =
+    let push_closures clos_acc instr_acc =
+      if Var.Map.is_empty clos_acc
+      then instr_acc
+      else
+        let l = f clos_acc in
+        List.rev_map
+          ~f:(fun g ->
+            let params, cont, loc = Var.Map.find g clos_acc in
+            Let (g, Closure (params, cont)), loc)
+          l
+        @ instr_acc
+    in
+    match instrs with
+    | [] -> List.rev (push_closures clos_acc instr_acc)
+    | (Let (g, Closure (params, cont)), loc) :: rem ->
+        iter_closures_rec f instr_acc (Var.Map.add g (params, cont, loc) clos_acc) rem
+    | i :: rem ->
+        iter_closures_rec f (i :: push_closures clos_acc instr_acc) Var.Map.empty rem
+  in
+  iter_closures_rec f [] Var.Map.empty instrs
+
+let collect_free_vars program var_depth depth pc closures =
+  let vars = ref Var.Set.empty in
+  let add_if_free_variable x =
+    let idx = Var.idx x in
+    let d = var_depth.(idx) in
+    assert (d >= 0);
+    if d < depth then vars := Var.Set.add x !vars
+  in
+  Code.preorder_traverse
+    { fold = Code.fold_children }
+    (fun pc () ->
+      let block = Code.Addr.Map.find pc program.blocks in
+      Freevars.iter_block_free_vars add_if_free_variable block;
+      List.iter block.body ~f:(fun (i, _) ->
+          match i with
+          | Let (f, Closure _) -> (
+              match Var.Map.find_opt f closures with
+              | Some { functions = (g, _) :: _; free_variables; _ } when Var.equal f g ->
+                  List.iter ~f:add_if_free_variable free_variables
+              | Some _ | None -> ())
+          | _ -> ()))
+    pc
+    program.blocks
+    ();
+  !vars
+
+let mark_bound_variables var_depth block depth =
+  Freevars.iter_block_bound_vars (fun x -> var_depth.(Var.idx x) <- depth) block;
+  List.iter block.body ~f:(fun( i,_) ->
+      match i with
+      | Let (_, Closure (params, _)) ->
+          List.iter params ~f:(fun x -> var_depth.(Var.idx x) <- depth + 1)
+      | _ -> ())
+
+let rec traverse var_depth closures program pc depth =
+  Code.preorder_traverse
+    { fold = Code.fold_children }
+    (fun pc (program : Code.program) ->
+      let block = Code.Addr.Map.find pc program.blocks in
+      mark_bound_variables var_depth block depth;
+      let program =
+        List.fold_left
+          ~f:(fun program (i, _) ->
+            match i with
+            | Let (_, Closure (_, (pc', _))) ->
+                traverse var_depth closures program pc' (depth + 1)
+            | _ -> program)
+          ~init:program
+          block.body
+      in
+      let body =
+        iter_closures block.body ~f:(fun l ->
+            let free_vars =
+              Var.Map.fold
+                (fun f (_, (pc', _), _) free_vars ->
+                  Var.Map.add
+                    f
+                    (collect_free_vars program var_depth (depth + 1) pc' !closures)
+                    free_vars)
+                l
+                Var.Map.empty
+            in
+            let domain = Var.Map.fold (fun f _ s -> Var.Set.add f s) l Var.Set.empty in
+            let graph = Var.Map.map (fun s -> Var.Set.inter s domain) free_vars in
+            let components = SCC.connected_components_sorted_from_roots_to_leaf graph in
+            let l =
+              Array.map
+                ~f:(fun component ->
+                  let fun_lst =
+                    match component with
+                    | SCC.No_loop x -> [ x ]
+                    | SCC.Has_loop l -> l
+                  in
+                  let free_variables =
+                    Var.Set.elements
+                      (List.fold_left
+                         ~f:(fun fv x -> Var.Set.remove x fv)
+                         ~init:
+                           (List.fold_left
+                              ~f:(fun fv x -> Var.Set.union fv (Var.Map.find x free_vars))
+                              ~init:Var.Set.empty
+                              fun_lst)
+                         fun_lst)
+                  in
+                  let functions =
+                    let arities =
+                      Var.Map.fold
+                        (fun f (params, _, _) m -> Var.Map.add f (List.length params) m)
+                        l
+                        Var.Map.empty
+                    in
+                    List.map ~f:(fun f -> f, Var.Map.find f arities) fun_lst
+                  in
+                  (*
+                  Format.eprintf "AAA";
+                  List.iter
+                    ~f:(fun (f, _) -> Format.eprintf " %a" Code.Var.print f)
+                    functions;
+                  Format.eprintf "@.";
+*)
+                  List.iter
+                    ~f:(fun (f, _) ->
+                      closures := Var.Map.add f { functions; free_variables } !closures)
+                    functions;
+                  fun_lst)
+                components
+            in
+            List.concat (List.rev (Array.to_list l)))
+      in
+      { program with blocks = Code.Addr.Map.add pc { block with body } program.blocks })
+    pc
+    program.blocks
+    program
+
+let f p =
+  let t = Timer.make () in
+  let nv = Var.count () in
+  let var_depth = Array.make nv (-1) in
+  let closures = ref Var.Map.empty in
+  let p = traverse var_depth closures p p.start 0 in
+  if Debug.find "times" () then Format.eprintf "  closure conversion: %a@." Timer.print t;
+  p, !closures
diff --git a/compiler/lib/wasm/wa_closure_conversion.mli b/compiler/lib/wasm/wa_closure_conversion.mli
new file mode 100644
index 0000000000..3e97d0eff5
--- /dev/null
+++ b/compiler/lib/wasm/wa_closure_conversion.mli
@@ -0,0 +1,6 @@
+type closure =
+  { functions : (Code.Var.t * int) list
+  ; free_variables : Code.Var.t list
+  }
+
+val f : Code.program -> Code.program * closure Code.Var.Map.t
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 6ff8c61f6d..ea4641b26f 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -14,13 +14,17 @@ https://github.com/llvm/llvm-project/issues/58438
    https://github.com/WebAssembly/binaryen/issues/5047 *)
 
 type context =
-  { mutable data_segments : (bool * W.data list) Var.Map.t
+  { constants : (Var.t, W.expression) Hashtbl.t
+  ; mutable data_segments : (bool * W.data list) Var.Map.t
   ; mutable other_fields : W.module_field list
   }
 
-let make_context () = { data_segments = Var.Map.empty; other_fields = [] }
+let make_context () =
+  { constants = Hashtbl.create 128; data_segments = Var.Map.empty; other_fields = [] }
 
-type var = int
+type var =
+  | Local of int
+  | Expr of W.expression t
 
 and state =
   { var_count : int
@@ -50,6 +54,10 @@ let expression_list f l =
   in
   loop [] l
 
+let register_data_segment x ~active v st =
+  st.context.data_segments <- Var.Map.add x (active, v) st.context.data_segments;
+  (), st
+
 let get_context st = st.context, st
 
 let register_global name typ init st =
@@ -59,18 +67,23 @@ let register_global name typ init st =
 
 let var x st =
   try Var.Map.find x st.vars, st
-  with Not_found ->
-    Format.eprintf "ZZZ %a@." Var.print x;
-    0, st
+  with Not_found -> (
+    try Expr (return (Hashtbl.find st.context.constants x)), st
+    with Not_found ->
+      Format.eprintf "ZZZ %a@." Var.print x;
+      Local 0, st)
 
 let add_var x ({ var_count; vars; _ } as st) =
   match Var.Map.find_opt x vars with
-  | Some i -> i, st
+  | Some (Local i) -> i, st
+  | Some (Expr _) -> assert false
   | None ->
       let i = var_count in
-      let vars = Var.Map.add x i vars in
+      let vars = Var.Map.add x (Local i) vars in
       i, { st with var_count = var_count + 1; vars }
 
+let define_var x e st = (), { st with vars = Var.Map.add x (Expr e) st.vars }
+
 let instr i : unit t = fun st -> (), { st with instrs = i :: st.instrs }
 
 let blk l st =
@@ -157,7 +170,9 @@ end
 
 let load x =
   let* x = var x in
-  return (W.LocalGet x)
+  match x with
+  | Local x -> return (W.LocalGet x)
+  | Expr e -> e
 
 let tee x e =
   let* e = e in
@@ -172,7 +187,9 @@ let store x e =
 let assign x e =
   let* x = var x in
   let* e = e in
-  instr (W.LocalSet (x, e))
+  match x with
+  | Local x -> instr (W.LocalSet (x, e))
+  | Expr _ -> assert false
 
 let seq l e =
   let* instrs = blk l in
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 7f79745369..4f2c059aca 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -1,5 +1,6 @@
 type context =
-  { mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
+  { constants : (Wa_ast.var, Wa_ast.expression) Hashtbl.t
+  ; mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
   ; mutable other_fields : Wa_ast.module_field list
   }
 
@@ -71,8 +72,12 @@ val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
 val add_var : Wa_ast.var -> int t
 
+val define_var : Wa_ast.var -> expression -> unit t
+
 val register_global : string -> Wa_ast.global_type -> Wa_ast.expression -> unit t
 
 val get_context : context t
 
+val register_data_segment : Code.Var.t -> active:bool -> Wa_ast.data list -> unit t
+
 val function_body : context:context -> body:unit t -> int * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 2dbbf182e1..f573852d55 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -82,6 +82,8 @@ module Memory = struct
   let field e idx = mem_load ~offset:(4 * idx) e
 
   let set_field e idx e' = mem_store ~offset:(4 * idx) e e'
+
+  let load_function_pointer ~arity closure = field closure (if arity = 1 then 0 else 2)
 end
 
 module Value = struct
@@ -192,6 +194,136 @@ module Constant = struct
       | _ -> assert false)
 end
 
+module Closure = struct
+  let get_free_variables ~context info =
+    List.filter
+      ~f:(fun x -> not (Hashtbl.mem context.constants x))
+      info.Wa_closure_conversion.free_variables
+
+  let closure_stats =
+    let s = ref 0 in
+    let n = ref 0 in
+    fun context info ->
+      let free_variables = get_free_variables ~context info in
+      if false && not (List.is_empty free_variables)
+      then
+        (incr n;
+         s := !s + List.length free_variables;
+         Format.eprintf
+           "OOO %d %f %s@."
+           (List.length free_variables)
+           (float !s /. float !n))
+          (Code.Var.to_string (fst (List.hd info.functions)))
+
+  let closure_env_start info =
+    List.fold_left
+      ~f:(fun i (_, arity) -> i + if arity > 1 then 4 else 3)
+      ~init:(-1)
+      info.Wa_closure_conversion.functions
+
+  let function_offset_in_closure info f =
+    let rec index i l =
+      match l with
+      | [] -> assert false
+      | (g, arity) :: r ->
+          if Code.Var.equal f g then i else index (i + if arity > 1 then 4 else 3) r
+    in
+    index 0 info.Wa_closure_conversion.functions
+
+  let closure_info ~arity ~sz =
+    W.Const (I32 Int32.(add (shift_left (of_int arity) 24) (of_int ((sz lsl 1) + 1))))
+
+  let translate ~context ~closures x =
+    let info = Code.Var.Map.find x closures in
+    let f, _ = List.hd info.Wa_closure_conversion.functions in
+    if Code.Var.equal x f
+    then (
+      let start_env = closure_env_start info in
+      let* _, start =
+        List.fold_left
+          ~f:(fun accu (f, arity) ->
+            let* i, start = accu in
+            let* curry_fun = return f in
+            let start =
+              if i = 0
+              then start
+              else W.Const (I32 (Memory.header ~tag:Obj.infix_tag ~len:i ())) :: start
+            in
+            let clos_info = closure_info ~arity ~sz:(start_env - i) in
+            let start = clos_info :: W.ConstSym (V curry_fun, 0) :: start in
+            return
+              (if arity > 1 then i + 4, W.ConstSym (V f, 0) :: start else i + 3, start))
+          ~init:(return (0, []))
+          info.functions
+      in
+      closure_stats context info;
+      let free_variables = get_free_variables ~context info in
+      if List.is_empty free_variables
+      then
+        let l =
+          List.rev_map
+            ~f:(fun e ->
+              match e with
+              | W.Const (I32 i) -> W.DataI32 i
+              | ConstSym (sym, offset) -> DataSym (sym, offset)
+              | _ -> assert false)
+            start
+        in
+        let h = Memory.header ~const:true ~tag:Obj.closure_tag ~len:(List.length l) () in
+        let name = Code.Var.fresh_n "closure" in
+        let* () = register_data_segment name ~active:true (W.DataI32 h :: l) in
+        return (W.ConstSym (V name, 4))
+      else
+        Memory.allocate
+          ~tag:Obj.closure_tag
+          (List.rev_map ~f:(fun e -> `Expr e) start
+          @ List.map ~f:(fun x -> `Var x) free_variables))
+    else
+      let offset = Int32.of_int (4 * function_offset_in_closure info x) in
+      Arith.(load f + const offset)
+
+  let bind_environment ~context ~closures f =
+    if Hashtbl.mem context.constants f
+    then
+      (* The closures are all constants and the environment is empty. *)
+      let* _ = add_var (Code.Var.fresh ()) in
+      return ()
+    else
+      let info = Code.Var.Map.find f closures in
+      let funct_index = function_offset_in_closure info f in
+      let* _ = add_var f in
+      let* () =
+        snd
+          (List.fold_left
+             ~f:(fun (i, prev) (x, arity) ->
+               ( (i + if arity > 1 then 4 else 3)
+               , let* () = prev in
+                 if i = 0
+                 then return ()
+                 else
+                   define_var
+                     x
+                     (let offset = 4 * i in
+                      Arith.(load f + const (Int32.of_int offset))) ))
+             ~init:(-funct_index, return ())
+             info.functions)
+      in
+      let start_env = closure_env_start info in
+      let offset = start_env - funct_index in
+      let free_variables = get_free_variables ~context info in
+      snd
+        (List.fold_left
+           ~f:(fun (i, prev) x ->
+             ( i + 1
+             , let* () = prev in
+               define_var
+                 x
+                 (let* f = load f in
+                  return (W.Load (I32 (Int32.of_int (4 * i)), f))) ))
+           ~init:(offset, return ())
+           free_variables)
+end
+
 let entry_point ~register_primitive =
   let declare_global name =
     register_global name { mut = true; typ = I32 } (Const (I32 0l))
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 0e8c1edd2d..7feae9de80 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -12,6 +12,7 @@ let transl_prim_arg x =
 type ctx =
   { live : int array
   ; blocks : block Addr.Map.t
+  ; closures : Wa_closure_conversion.closure Var.Map.t
   ; mutable primitives : W.func_type StringMap.t
   ; global_context : Wa_code_generation.context
   }
@@ -24,13 +25,28 @@ let register_primitive ctx nm typ =
 let func_type n =
   { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
 
-let rec translate_expr ctx e =
+let rec translate_expr ctx x e =
   match e with
-  | Apply _ -> (*ZZZ*) Arith.const 0l
+  | Apply { f; args; _ } ->
+      (*ZZZ*)
+      let rec loop acc l =
+        match l with
+        | [] ->
+            let arity = List.length args in
+            let funct = Var.fresh () in
+            let* closure = tee funct (load f) in
+            let* funct = Memory.load_function_pointer ~arity (load funct) in
+            return
+              (W.Call_indirect (func_type (arity + 1), funct, List.rev (closure :: acc)))
+        | x :: r ->
+            let* x = load x in
+            loop (x :: acc) r
+      in
+      loop [] args
   | Block (tag, a, _) ->
       Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
   | Field (x, n) -> Memory.field (load x) n
-  | Closure _ -> (*ZZZ*) Arith.const 0l
+  | Closure _ -> Closure.translate ~context:ctx.global_context ~closures:ctx.closures x
   | Constant c -> Constant.translate c
   | Prim (p, l) -> (
       let l = List.map ~f:transl_prim_arg l in
@@ -82,8 +98,8 @@ and translate_instr ctx (i, _) =
   | Assign (x, y) -> assign x (load y)
   | Let (x, e) ->
       if ctx.live.(Var.idx x) = 0
-      then drop (translate_expr ctx e)
-      else store x (translate_expr ctx e)
+      then drop (translate_expr ctx x e)
+      else store x (translate_expr ctx x e)
   | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
   | Offset_ref (x, n) ->
       Memory.set_field
@@ -278,8 +294,10 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
   in
   let build_initial_env =
     let* () = bind_parameters in
-    let* _ = add_var (Code.Var.fresh ()) in
-    return ()
+    match name_opt with
+    | Some f ->
+        Closure.bind_environment ~context:ctx.global_context ~closures:ctx.closures f
+    | None -> return ()
   in
   (*
   Format.eprintf "=== %d ===@." pc;
@@ -330,12 +348,14 @@ let f
     ~should_export
     ~warn_on_unhandled_effect
       _debug *) =
+  let p, closures = Wa_closure_conversion.f p in
   (*
   Code.Print.program (fun _ _ -> "") p;
 *)
   let ctx =
     { live = live_vars
     ; blocks = p.blocks
+    ; closures
     ; primitives = StringMap.empty
     ; global_context = make_context ()
     }
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index dd03c7633e..79a44525d3 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -5,6 +5,9 @@ module type S = sig
     val allocate :
       tag:int -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list -> expression
 
+    val load_function_pointer :
+      arity:int -> expression -> Wa_ast.expression Wa_code_generation.t
+
     val tag : expression -> expression
 
     val field : expression -> int -> expression
@@ -76,6 +79,20 @@ module type S = sig
     val translate : Code.constant -> expression
   end
 
+  module Closure : sig
+    val translate :
+         context:Wa_code_generation.context
+      -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+      -> Code.Var.t
+      -> expression
+
+    val bind_environment :
+         context:Wa_code_generation.context
+      -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+      -> Code.Var.t
+      -> unit Wa_code_generation.t
+  end
+
   val entry_point :
     register_primitive:(string -> Wa_ast.func_type -> unit) -> unit Wa_code_generation.t
 end

From 1a6be26d4c181e6b4705af871a1d73269f3454d1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 31 Mar 2023 12:06:54 +0200
Subject: [PATCH 007/481] Constant propagation

---
 compiler/lib/code.ml                     | 19 ++++++++++
 compiler/lib/code.mli                    |  6 ++++
 compiler/lib/wasm/wa_code_generation.ml  | 44 ++++++++++++++++++++----
 compiler/lib/wasm/wa_code_generation.mli | 10 ++++--
 compiler/lib/wasm/wa_core_target.ml      | 15 +++++++-
 compiler/lib/wasm/wa_generate.ml         | 17 ++++++---
 6 files changed, 95 insertions(+), 16 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 4ca07e2f8c..03e9678650 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -662,6 +662,25 @@ let fold_closures_innermost_first { start; blocks; _ } f accu =
   let accu = visit blocks start f accu in
   f None [] (start, []) accu
 
+let fold_closures_outermost_first { start; blocks; _ } f accu =
+  let rec visit blocks pc f accu =
+    traverse
+      { fold = fold_children }
+      (fun pc accu ->
+        let block = Addr.Map.find pc blocks in
+        List.fold_left block.body ~init:accu ~f:(fun accu i ->
+            match i with
+            | Let (x, Closure (params, cont)), _ ->
+                let accu = f (Some x) params cont accu in
+                visit blocks (fst cont) f accu
+            | _ -> accu))
+      pc
+      blocks
+      accu
+  in
+  let accu = f None [] (start, []) accu in
+  visit blocks start f accu
+
 let eq p1 p2 =
   p1.start = p2.start
   && Addr.Map.cardinal p1.blocks = Addr.Map.cardinal p2.blocks
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 4f72ee7e68..554631adbe 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -256,6 +256,12 @@ val fold_closures_innermost_first :
     innermost closures first. Unlike with {!fold_closures}, only the closures
     reachable from [p.start] are considered. *)
 
+val fold_closures_outermost_first :
+  program -> (Var.t option -> Var.t list -> cont -> 'd -> 'd) -> 'd -> 'd
+(** Similar to {!fold_closures}, but applies the fold function to the
+    outermost closures first. Unlike with {!fold_closures}, only the closures
+    reachable from [p.start] are considered. *)
+
 val fold_children : 'c fold_blocs
 
 val traverse :
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index ea4641b26f..5d6e2e164c 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -58,8 +58,14 @@ let register_data_segment x ~active v st =
   st.context.data_segments <- Var.Map.add x (active, v) st.context.data_segments;
   (), st
 
+let get_data_segment x st = Var.Map.find x st.context.data_segments, st
+
 let get_context st = st.context, st
 
+let register_constant x e st =
+  Hashtbl.add st.context.constants x e;
+  (), st
+
 let register_global name typ init st =
   st.context.other_fields <-
     W.Global { name = S name; typ; init } :: st.context.other_fields;
@@ -86,6 +92,8 @@ let define_var x e st = (), { st with vars = Var.Map.add x (Expr e) st.vars }
 
 let instr i : unit t = fun st -> (), { st with instrs = i :: st.instrs }
 
+let instrs l : unit t = fun st -> (), { st with instrs = List.rev_append l st.instrs }
+
 let blk l st =
   let instrs = st.instrs in
   let (), st = l { st with instrs = [] } in
@@ -168,6 +176,11 @@ module Arith = struct
   let const n = return (W.Const (I32 n))
 end
 
+let is_small_constant e =
+  match e with
+  | W.ConstSym _ | W.Const _ -> return true
+  | _ -> return false
+
 let load x =
   let* x = var x in
   match x with
@@ -176,13 +189,28 @@ let load x =
 
 let tee x e =
   let* e = e in
-  let* i = add_var x in
-  return (W.LocalTee (i, e))
-
-let store x e =
+  let* b = is_small_constant e in
+  if b
+  then
+    let* () = register_constant x e in
+    return e
+  else
+    let* i = add_var x in
+    return (W.LocalTee (i, e))
+
+let rec store ?(always = false) x e =
   let* e = e in
-  let* i = add_var x in
-  instr (LocalSet (i, e))
+  match e with
+  | W.Seq (l, e') ->
+      let* () = instrs l in
+      store ~always x (return e')
+  | _ ->
+      let* b = is_small_constant e in
+      if b && not always
+      then register_constant x e
+      else
+        let* i = add_var x in
+        instr (LocalSet (i, e))
 
 let assign x e =
   let* x = var x in
@@ -198,7 +226,9 @@ let seq l e =
 
 let drop e =
   let* e = e in
-  instr (Drop e)
+  match e with
+  | W.Seq (l, Const _) -> instrs l
+  | _ -> instr (Drop e)
 
 let loop ty l =
   let* instrs = blk l in
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 4f2c059aca..1fe6db034d 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -58,7 +58,7 @@ val load : Wa_ast.var -> expression
 
 val tee : Wa_ast.var -> expression -> expression
 
-val store : Wa_ast.var -> expression -> unit t
+val store : ?always:bool -> Wa_ast.var -> expression -> unit t
 
 val assign : Wa_ast.var -> expression -> unit t
 
@@ -74,10 +74,14 @@ val add_var : Wa_ast.var -> int t
 
 val define_var : Wa_ast.var -> expression -> unit t
 
-val register_global : string -> Wa_ast.global_type -> Wa_ast.expression -> unit t
+val is_small_constant : Wa_ast.expression -> bool t
 
-val get_context : context t
+val register_global : string -> Wa_ast.global_type -> Wa_ast.expression -> unit t
 
 val register_data_segment : Code.Var.t -> active:bool -> Wa_ast.data list -> unit t
 
+val get_data_segment : Code.Var.t -> (bool * Wa_ast.data list) t
+
+val get_context : context t
+
 val function_body : context:context -> body:unit t -> int * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index f573852d55..0f30fab88e 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -8,7 +8,20 @@ module Memory = struct
   let mem_load ?(offset = 0) e =
     assert (offset >= 0);
     let* e = e in
-    return (W.Load (I32 (Int32.of_int offset), e))
+    match e with
+    | W.ConstSym (V x, offset') ->
+        let rec get_data offset l =
+          match l with
+          | [] -> assert false
+          | W.DataI32 i :: _ when offset = 0 -> W.Const (I32 i)
+          | W.DataSym (sym, ofs) :: _ when offset = 0 -> W.ConstSym (sym, ofs)
+          | (W.DataI32 _ | DataSym _) :: r -> get_data (offset - 4) r
+          | (DataI8 _ | DataBytes _ | DataSpace _ | DataI64 _) :: _ -> assert false
+        in
+        let* _, l = get_data_segment x in
+        let data = get_data (offset + offset') l in
+        return data
+    | _ -> return (W.Load (I32 (Int32.of_int offset), e))
 
   let mem_init ?(offset = 0) e e' =
     assert (offset >= 0);
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 7feae9de80..76bc79b95a 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -31,13 +31,20 @@ let rec translate_expr ctx x e =
       (*ZZZ*)
       let rec loop acc l =
         match l with
-        | [] ->
+        | [] -> (
             let arity = List.length args in
             let funct = Var.fresh () in
             let* closure = tee funct (load f) in
             let* funct = Memory.load_function_pointer ~arity (load funct) in
-            return
-              (W.Call_indirect (func_type (arity + 1), funct, List.rev (closure :: acc)))
+            match funct with
+            | W.ConstSym (g, 0) ->
+                (* Functions with constant closures ignore their
+                   environment *)
+                return (W.Call (g, List.rev (W.Const (I32 0l) :: acc)))
+            | _ ->
+                return
+                  (W.Call_indirect
+                     (func_type (arity + 1), funct, List.rev (closure :: acc))))
         | x :: r ->
             let* x = load x in
             loop (x :: acc) r
@@ -156,7 +163,7 @@ let parallel_renaming params args =
     l
     ~f:(fun continuation (y, x) ->
       let* () = continuation in
-      store y (load x))
+      store ~always:true y (load x))
     ~init:(return ())
 
 let extend_context fall_through context =
@@ -362,7 +369,7 @@ let f
   in
   let toplevel_name = Var.fresh_n "toplevel" in
   let functions =
-    Code.fold_closures
+    Code.fold_closures_outermost_first
       p
       (fun name_opt params cont ->
         translate_function ctx name_opt toplevel_name params cont)

From ad2e7ef93179b5dfab283c16e8a49120dfa1f59e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 31 Mar 2023 18:17:03 +0200
Subject: [PATCH 008/481] Curryfication

---
 compiler/lib/wasm/wa_code_generation.ml  |  27 +++-
 compiler/lib/wasm/wa_code_generation.mli |   6 +
 compiler/lib/wasm/wa_core_target.ml      |  16 ++-
 compiler/lib/wasm/wa_curry.ml            | 158 +++++++++++++++++++++++
 compiler/lib/wasm/wa_curry.mli           |   3 +
 compiler/lib/wasm/wa_generate.ml         |  11 +-
 compiler/lib/wasm/wa_target_sig.ml       |  13 ++
 7 files changed, 230 insertions(+), 4 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_curry.ml
 create mode 100644 compiler/lib/wasm/wa_curry.mli

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 5d6e2e164c..ff641cd8e2 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -17,10 +17,17 @@ type context =
   { constants : (Var.t, W.expression) Hashtbl.t
   ; mutable data_segments : (bool * W.data list) Var.Map.t
   ; mutable other_fields : W.module_field list
+  ; mutable apply_funs : Var.t IntMap.t
+  ; mutable curry_funs : Var.t IntMap.t
   }
 
 let make_context () =
-  { constants = Hashtbl.create 128; data_segments = Var.Map.empty; other_fields = [] }
+  { constants = Hashtbl.create 128
+  ; data_segments = Var.Map.empty
+  ; other_fields = []
+  ; apply_funs = IntMap.empty
+  ; curry_funs = IntMap.empty
+  }
 
 type var =
   | Local of int
@@ -246,6 +253,24 @@ let if_ ty e l1 l2 =
   | W.UnOp (I32 Eqz, e') -> instr (If (ty, e', instrs2, instrs1))
   | _ -> instr (If (ty, e, instrs1, instrs2))
 
+let need_apply_fun ~arity st =
+  let ctx = st.context in
+  ( (try IntMap.find arity ctx.apply_funs
+     with Not_found ->
+       let x = Var.fresh_n (Printf.sprintf "apply_%d" arity) in
+       ctx.apply_funs <- IntMap.add arity x ctx.apply_funs;
+       x)
+  , st )
+
+let need_curry_fun ~arity st =
+  let ctx = st.context in
+  ( (try IntMap.find arity ctx.curry_funs
+     with Not_found ->
+       let x = Var.fresh_n (Printf.sprintf "curry_%d" arity) in
+       ctx.curry_funs <- IntMap.add arity x ctx.curry_funs;
+       x)
+  , st )
+
 let function_body ~context ~body =
   let st = { var_count = 0; vars = Var.Map.empty; instrs = []; context } in
   let (), st = body st in
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 1fe6db034d..2d8bbfb243 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -2,6 +2,8 @@ type context =
   { constants : (Wa_ast.var, Wa_ast.expression) Hashtbl.t
   ; mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
   ; mutable other_fields : Wa_ast.module_field list
+  ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
+  ; mutable curry_funs : Code.Var.t Stdlib.IntMap.t
   }
 
 val make_context : unit -> context
@@ -84,4 +86,8 @@ val get_data_segment : Code.Var.t -> (bool * Wa_ast.data list) t
 
 val get_context : context t
 
+val need_apply_fun : arity:int -> Code.Var.t t
+
+val need_curry_fun : arity:int -> Code.Var.t t
+
 val function_body : context:context -> body:unit t -> int * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 0f30fab88e..962fdaa418 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -97,6 +97,8 @@ module Memory = struct
   let set_field e idx e' = mem_store ~offset:(4 * idx) e e'
 
   let load_function_pointer ~arity closure = field closure (if arity = 1 then 0 else 2)
+
+  let load_function_arity closure = Arith.(field closure 1 lsr const 24l)
 end
 
 module Value = struct
@@ -256,7 +258,7 @@ module Closure = struct
         List.fold_left
           ~f:(fun accu (f, arity) ->
             let* i, start = accu in
-            let* curry_fun = return f in
+            let* curry_fun = if arity > 1 then need_curry_fun ~arity else return f in
             let start =
               if i = 0
               then start
@@ -335,6 +337,18 @@ module Closure = struct
                   return (W.Load (I32 (Int32.of_int (4 * i)), f))) ))
            ~init:(offset, return ())
            free_variables)
+
+  let curry_allocate ~arity _ ~f ~closure ~arg =
+    Memory.allocate
+      ~tag:Obj.closure_tag
+      [ `Expr (W.ConstSym (f, 0))
+      ; `Expr (closure_info ~arity ~sz:2)
+      ; `Var closure
+      ; `Var arg
+      ]
+
+  let curry_load ~arity:_ _ closure =
+    return (Memory.field (load closure) 3, Memory.field (load closure) 4)
 end
 
 let entry_point ~register_primitive =
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
new file mode 100644
index 0000000000..6fe5d43e0d
--- /dev/null
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -0,0 +1,158 @@
+open! Stdlib
+open Code
+module W = Wa_ast
+open Wa_code_generation
+
+module Make (Target : Wa_target_sig.S) = struct
+  open Target
+
+  let func_type n =
+    { W.params = List.init ~len:(n + 1) ~f:(fun _ -> Value.value)
+    ; result = [ Value.value ]
+    }
+
+  let bind_parameters l =
+    List.fold_left
+      ~f:(fun l x ->
+        let* _ = l in
+        let* _ = add_var x in
+        return ())
+      ~init:(return ())
+      l
+
+  let call ~arity closure args =
+    let funct = Var.fresh () in
+    let* closure = tee funct closure in
+    let args = args @ [ closure ] in
+    let* funct = Memory.load_function_pointer ~arity (load funct) in
+    return (W.Call_indirect (func_type (List.length args), funct, args))
+
+  let curry_app_name n m = Printf.sprintf "curry_app %d_%d" n m
+
+  (* ZZZ
+          curry_app: load m arguments from the env;
+          get (m - n) arguments as parameters;
+          apply to f
+     parameters : closure_{n - m}
+
+     local.set closure_(n -1) (field 4 (local.get closure_n))
+
+     local.set closure_(n - 1) (field 4 (local.get closure_n))
+     call
+        (load_func (local.get closure_0)) (field 3 (local.get closure_1)) (field 3 (local.get closure_2)) ... (local.get closure_{n - m})) (local.get x1) ... (local.get xm) (local.get closure_0))
+  *)
+  let curry_app ~context ~arity m ~name =
+    let body =
+      let args =
+        List.init ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x_%d" i)) ~len:m
+      in
+      let* () = bind_parameters args in
+      let f = Code.Var.fresh_n "f" in
+      let* _ = add_var f in
+      let* args' = expression_list load args in
+      let* _f = load f in
+      let rec loop m args closure =
+        if m = arity
+        then
+          let* e = call ~arity (load closure) (List.append args args') in
+          instr (W.Push e)
+        else
+          let* load_arg, load_closure = Closure.curry_load ~arity m closure in
+          let* x = load_arg in
+          let closure' = Code.Var.fresh_n "f" in
+          let* () = store closure' load_closure in
+          loop (m + 1) (x :: args) closure'
+      in
+      loop m [] f
+    in
+    let local_count, body = function_body ~context ~body in
+    W.Function
+      { name
+      ; exported_name = None
+      ; typ = func_type 1
+      ; locals = List.init ~len:(local_count - m - 1) ~f:(fun _ -> Value.value)
+      ; body
+      }
+
+  let curry_name n m = Printf.sprintf "curry_%d_%d" n m
+
+  let rec curry ~context ~arity m ~name =
+    assert (m > 1);
+    let name', functions =
+      if m = 2
+      then
+        let nm = Var.fresh_n (curry_app_name arity 1) in
+        let func = curry_app ~context ~arity 1 ~name:nm in
+        nm, [ func ]
+      else
+        let nm = Var.fresh_n (curry_name arity (m - 1)) in
+        let functions = curry ~context ~arity (m - 1) ~name:nm in
+        nm, functions
+    in
+    let body =
+      let x = Code.Var.fresh_n "x" in
+      let* _ = add_var x in
+      let f = Code.Var.fresh_n "f" in
+      let* _ = add_var f in
+      let* e = Closure.curry_allocate ~arity m ~f:(V name') ~closure:f ~arg:x in
+      instr (Push e)
+    in
+    let local_count, body = function_body ~context ~body in
+    W.Function
+      { name
+      ; exported_name = None
+      ; typ = func_type 1
+      ; locals = List.init ~len:(local_count - 2) ~f:(fun _ -> Value.value)
+      ; body
+      }
+    :: functions
+
+  let curry ~arity ~name = curry ~arity arity ~name
+
+  let apply ~context ~arity ~name =
+    assert (arity > 1);
+    let body =
+      let l =
+        List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i))
+      in
+      let* () = bind_parameters l in
+      let f = Code.Var.fresh_n "f" in
+      let* _ = add_var f in
+      let func_arity = Memory.load_function_arity (load f) in
+      if_
+        { params = []; result = [ Value.value ] }
+        Arith.(func_arity = const (Int32.of_int arity))
+        (let* l = expression_list load l in
+         let* res = call ~arity (load f) l in
+         instr (Push res))
+        (let* e =
+           List.fold_left
+             ~f:(fun e x ->
+               let* x = load x in
+               call ~arity:1 e [ x ])
+             ~init:(load f)
+             l
+         in
+         instr (Push e))
+    in
+    let local_count, body = function_body ~context ~body in
+    W.Function
+      { name
+      ; exported_name = None
+      ; typ = func_type arity
+      ; locals = List.init ~len:(local_count - arity - 1) ~f:(fun _ -> Value.value)
+      ; body
+      }
+
+  let f ~context =
+    IntMap.iter
+      (fun arity name ->
+        let f = apply ~context ~arity ~name in
+        context.other_fields <- f :: context.other_fields)
+      context.apply_funs;
+    IntMap.iter
+      (fun arity name ->
+        let l = curry ~context ~arity ~name in
+        context.other_fields <- List.rev_append l context.other_fields)
+      context.curry_funs
+end
diff --git a/compiler/lib/wasm/wa_curry.mli b/compiler/lib/wasm/wa_curry.mli
new file mode 100644
index 0000000000..c76a44afdb
--- /dev/null
+++ b/compiler/lib/wasm/wa_curry.mli
@@ -0,0 +1,3 @@
+module Make (_ : Wa_target_sig.S) : sig
+  val f : context:Wa_code_generation.context -> unit
+end
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 76bc79b95a..8aeab9382a 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -27,8 +27,7 @@ let func_type n =
 
 let rec translate_expr ctx x e =
   match e with
-  | Apply { f; args; _ } ->
-      (*ZZZ*)
+  | Apply { f; args; exact } when exact || List.length args = 1 ->
       let rec loop acc l =
         match l with
         | [] -> (
@@ -50,6 +49,11 @@ let rec translate_expr ctx x e =
             loop (x :: acc) r
       in
       loop [] args
+  | Apply { f; args; _ } ->
+      let* apply = need_apply_fun ~arity:(List.length args) in
+      let* args = expression_list load args in
+      let* closure = load f in
+      return (W.Call (V apply, args @ [ closure ]))
   | Block (tag, a, _) ->
       Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
   | Field (x, n) -> Memory.field (load x) n
@@ -347,6 +351,8 @@ let entry_point ctx toplevel_fun entry_name =
     ; body
     }
 
+module Curry = Wa_curry.Make (Wa_core_target)
+
 let f
     (p : Code.program)
     ~live_vars
@@ -386,6 +392,7 @@ let f
         W.Data { name; read_only = true; active; contents })
       (Var.Map.bindings ctx.global_context.data_segments)
   in
+  Curry.f ~context:ctx.global_context;
   let start_function = entry_point ctx toplevel_name "kernel_run" in
   let fields =
     List.rev_append
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 79a44525d3..493fa0dd38 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -8,6 +8,8 @@ module type S = sig
     val load_function_pointer :
       arity:int -> expression -> Wa_ast.expression Wa_code_generation.t
 
+    val load_function_arity : expression -> expression
+
     val tag : expression -> expression
 
     val field : expression -> int -> expression
@@ -91,6 +93,17 @@ module type S = sig
       -> closures:Wa_closure_conversion.closure Code.Var.Map.t
       -> Code.Var.t
       -> unit Wa_code_generation.t
+
+    val curry_allocate :
+         arity:int
+      -> int
+      -> f:Wa_ast.symbol
+      -> closure:Code.Var.t
+      -> arg:Code.Var.t
+      -> Wa_ast.expression Wa_code_generation.t
+
+    val curry_load :
+      arity:int -> int -> Code.Var.t -> (expression * expression) Wa_code_generation.t
   end
 
   val entry_point :

From 741405138aca3781b02b631124acd10a4c5e83a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 11 Apr 2023 17:28:21 +0200
Subject: [PATCH 009/481] Shadow stack

---
 compiler/lib/freevars.mli           |   4 +
 compiler/lib/wasm/wa_core_target.ml |  34 +-
 compiler/lib/wasm/wa_curry.ml       |  71 ++-
 compiler/lib/wasm/wa_generate.ml    | 111 ++--
 compiler/lib/wasm/wa_liveness.ml    | 232 ++++++++
 compiler/lib/wasm/wa_liveness.mli   |  20 +
 compiler/lib/wasm/wa_spilling.ml    | 791 ++++++++++++++++++++++++++++
 compiler/lib/wasm/wa_spilling.mli   |  71 +++
 compiler/lib/wasm/wa_target_sig.ml  |  61 ++-
 9 files changed, 1348 insertions(+), 47 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_liveness.ml
 create mode 100644 compiler/lib/wasm/wa_liveness.mli
 create mode 100644 compiler/lib/wasm/wa_spilling.ml
 create mode 100644 compiler/lib/wasm/wa_spilling.mli

diff --git a/compiler/lib/freevars.mli b/compiler/lib/freevars.mli
index f1751afe2b..3a41483741 100644
--- a/compiler/lib/freevars.mli
+++ b/compiler/lib/freevars.mli
@@ -23,4 +23,8 @@ val iter_block_free_vars : (Code.Var.t -> unit) -> Code.block -> unit
 
 val iter_block_bound_vars : (Code.Var.t -> unit) -> Code.block -> unit
 
+val iter_instr_free_vars : (Code.Var.t -> unit) -> Code.instr -> unit
+
+val iter_last_free_var : (Code.Var.t -> unit) -> Code.last -> unit
+
 val f : Code.program -> Code.Var.Set.t Code.Addr.Map.t
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 962fdaa418..6d5b8e9748 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -4,6 +4,8 @@ open Wa_code_generation
 
 type expression = Wa_ast.expression Wa_code_generation.t
 
+module Stack = Wa_spilling
+
 module Memory = struct
   let mem_load ?(offset = 0) e =
     assert (offset >= 0);
@@ -44,16 +46,30 @@ module Memory = struct
   let header ?(const = false) ~tag ~len () =
     Int32.(add (shift_left (of_int len) 10) (of_int (tag + if const then 3 * 256 else 0)))
 
-  let allocate ~tag l =
+  let allocate stack_ctx x ~tag l =
     let len = List.length l in
     let p = Code.Var.fresh_n "p" in
     let size = (len + 1) * 4 in
     seq
-      (let* v =
+      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+       let* v =
          tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
        in
        let* () = instr (W.GlobalSet (S "young_ptr", v)) in
        let* () = mem_init (load p) (Arith.const (header ~tag ~len ())) in
+       Stack.kill_variables stack_ctx;
+       let* () =
+         Stack.perform_reloads
+           stack_ctx
+           (`Vars
+             (List.fold_left
+                ~f:(fun s v ->
+                  match v with
+                  | `Expr _ -> s
+                  | `Var x -> Code.Var.Set.add x s)
+                ~init:Code.Var.Set.empty
+                l))
+       in
        snd
          (List.fold_right
             ~init:(len, return ())
@@ -248,7 +264,7 @@ module Closure = struct
   let closure_info ~arity ~sz =
     W.Const (I32 Int32.(add (shift_left (of_int arity) 24) (of_int ((sz lsl 1) + 1))))
 
-  let translate ~context ~closures x =
+  let translate ~context ~closures ~stack_ctx x =
     let info = Code.Var.Map.find x closures in
     let f, _ = List.hd info.Wa_closure_conversion.functions in
     if Code.Var.equal x f
@@ -287,9 +303,16 @@ module Closure = struct
         let h = Memory.header ~const:true ~tag:Obj.closure_tag ~len:(List.length l) () in
         let name = Code.Var.fresh_n "closure" in
         let* () = register_data_segment name ~active:true (W.DataI32 h :: l) in
+        let* () =
+          (* In case we did not detect that this closure was constant
+             during the spilling analysis *)
+          Stack.perform_spilling stack_ctx (`Instr x)
+        in
         return (W.ConstSym (V name, 4))
       else
         Memory.allocate
+          stack_ctx
+          x
           ~tag:Obj.closure_tag
           (List.rev_map ~f:(fun e -> `Expr e) start
           @ List.map ~f:(fun x -> `Var x) free_variables))
@@ -338,8 +361,10 @@ module Closure = struct
            ~init:(offset, return ())
            free_variables)
 
-  let curry_allocate ~arity _ ~f ~closure ~arg =
+  let curry_allocate ~stack_ctx ~x ~arity _ ~f ~closure ~arg =
     Memory.allocate
+      stack_ctx
+      x
       ~tag:Obj.closure_tag
       [ `Expr (W.ConstSym (f, 0))
       ; `Expr (closure_info ~arity ~sz:2)
@@ -355,6 +380,7 @@ let entry_point ~register_primitive =
   let declare_global name =
     register_global name { mut = true; typ = I32 } (Const (I32 0l))
   in
+  let* () = declare_global "sp" in
   let* () = declare_global "young_ptr" in
   let* () = declare_global "young_limit" in
   register_primitive "caml_modify" { W.params = [ I32; I32 ]; result = [] };
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index 6fe5d43e0d..4d6b599337 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -94,8 +94,32 @@ module Make (Target : Wa_target_sig.S) = struct
       let* _ = add_var x in
       let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
-      let* e = Closure.curry_allocate ~arity m ~f:(V name') ~closure:f ~arg:x in
-      instr (Push e)
+      let res = Code.Var.fresh_n "res" in
+      let stack_info, stack =
+        Stack.make_info ()
+        |> fun info ->
+        Stack.add_spilling
+          info
+          ~location:res
+          ~stack:[]
+          ~live_vars:Var.Set.empty
+          ~spilled_vars:(Var.Set.of_list [ x; f ])
+      in
+      let ret = Code.Var.fresh_n "ret" in
+      let stack_info, _ =
+        Stack.add_spilling
+          stack_info
+          ~location:ret
+          ~stack
+          ~live_vars:Var.Set.empty
+          ~spilled_vars:Var.Set.empty
+      in
+      let stack_ctx = Stack.start_function ~context stack_info in
+      let* e =
+        Closure.curry_allocate ~stack_ctx ~x:res ~arity m ~f:(V name') ~closure:f ~arg:x
+      in
+      let* () = instr (Push e) in
+      Stack.perform_spilling stack_ctx (`Instr ret)
     in
     let local_count, body = function_body ~context ~body in
     W.Function
@@ -113,7 +137,8 @@ module Make (Target : Wa_target_sig.S) = struct
     assert (arity > 1);
     let body =
       let l =
-        List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i))
+        List.rev
+          (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
       in
       let* () = bind_parameters l in
       let f = Code.Var.fresh_n "f" in
@@ -125,15 +150,41 @@ module Make (Target : Wa_target_sig.S) = struct
         (let* l = expression_list load l in
          let* res = call ~arity (load f) l in
          instr (Push res))
-        (let* e =
-           List.fold_left
-             ~f:(fun e x ->
+        (let rec build_spilling_info stack_info stack live_vars acc l =
+           match l with
+           | [] -> stack_info, List.rev acc
+           | x :: rem ->
+               let live_vars = Var.Set.remove x live_vars in
+               let y = Var.fresh () in
+               let stack_info, stack =
+                 Stack.add_spilling
+                   stack_info
+                   ~location:y
+                   ~stack
+                   ~live_vars
+                   ~spilled_vars:
+                     (if List.is_empty stack then live_vars else Var.Set.empty)
+               in
+               build_spilling_info stack_info stack live_vars ((x, y) :: acc) rem
+         in
+         let stack_info, l =
+           build_spilling_info (Stack.make_info ()) [] (Var.Set.of_list l) [] l
+         in
+         let stack_ctx = Stack.start_function ~context stack_info in
+         let rec build_applies y l =
+           match l with
+           | [] ->
+               let* y = y in
+               instr (Push y)
+           | (x, y') :: rem ->
+               let* () = Stack.perform_reloads stack_ctx (`Vars (Var.Set.singleton x)) in
+               let* () = Stack.perform_spilling stack_ctx (`Instr y') in
                let* x = load x in
-               call ~arity:1 e [ x ])
-             ~init:(load f)
-             l
+               Stack.kill_variables stack_ctx;
+               let* () = store y' (call ~arity:1 y [ x ]) in
+               build_applies (load y') rem
          in
-         instr (Push e))
+         build_applies (load f) l)
     in
     let local_count, body = function_body ~context ~body in
     W.Function
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 8aeab9382a..68ce1128dd 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -25,9 +25,10 @@ let register_primitive ctx nm typ =
 let func_type n =
   { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
 
-let rec translate_expr ctx x e =
+let rec translate_expr ctx stack_ctx x e =
   match e with
   | Apply { f; args; exact } when exact || List.length args = 1 ->
+      let* () = Stack.perform_spilling stack_ctx (`Instr x) in
       let rec loop acc l =
         match l with
         | [] -> (
@@ -35,6 +36,7 @@ let rec translate_expr ctx x e =
             let funct = Var.fresh () in
             let* closure = tee funct (load f) in
             let* funct = Memory.load_function_pointer ~arity (load funct) in
+            Stack.kill_variables stack_ctx;
             match funct with
             | W.ConstSym (g, 0) ->
                 (* Functions with constant closures ignore their
@@ -50,14 +52,17 @@ let rec translate_expr ctx x e =
       in
       loop [] args
   | Apply { f; args; _ } ->
+      let* () = Stack.perform_spilling stack_ctx (`Instr x) in
       let* apply = need_apply_fun ~arity:(List.length args) in
       let* args = expression_list load args in
       let* closure = load f in
+      Stack.kill_variables stack_ctx;
       return (W.Call (V apply, args @ [ closure ]))
   | Block (tag, a, _) ->
-      Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
+      Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
   | Field (x, n) -> Memory.field (load x) n
-  | Closure _ -> Closure.translate ~context:ctx.global_context ~closures:ctx.closures x
+  | Closure _ ->
+      Closure.translate ~context:ctx.global_context ~closures:ctx.closures ~stack_ctx x
   | Constant c -> Constant.translate c
   | Prim (p, l) -> (
       let l = List.map ~f:transl_prim_arg l in
@@ -84,9 +89,12 @@ let rec translate_expr ctx x e =
       | Extern nm, l ->
           (*ZZZ Different calling convention when large number of parameters *)
           register_primitive ctx nm (func_type (List.length l));
+          let* () = Stack.perform_spilling stack_ctx (`Instr x) in
           let rec loop acc l =
             match l with
-            | [] -> return (W.Call (S nm, List.rev acc))
+            | [] ->
+                Stack.kill_variables stack_ctx;
+                return (W.Call (S nm, List.rev acc))
             | x :: r ->
                 let* x = x in
                 loop (x :: acc) r
@@ -104,13 +112,15 @@ let rec translate_expr ctx x e =
       | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
           assert false)
 
-and translate_instr ctx (i, _) =
+and translate_instr ctx stack_ctx (i, _) =
   match i with
-  | Assign (x, y) -> assign x (load y)
+  | Assign (x, y) ->
+      let* () = assign x (load y) in
+      Stack.assign stack_ctx x
   | Let (x, e) ->
       if ctx.live.(Var.idx x) = 0
-      then drop (translate_expr ctx x e)
-      else store x (translate_expr ctx x e)
+      then drop (translate_expr ctx stack_ctx x e)
+      else store x (translate_expr ctx stack_ctx x e)
   | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
   | Offset_ref (x, n) ->
       Memory.set_field
@@ -120,12 +130,13 @@ and translate_instr ctx (i, _) =
            Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
   | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
 
-and translate_instrs ctx l =
+and translate_instrs ctx stack_ctx l =
   match l with
   | [] -> return ()
   | i :: rem ->
-      let* () = translate_instr ctx i in
-      translate_instrs ctx rem
+      let* () = Stack.perform_reloads stack_ctx (`Instr (fst i)) in
+      let* () = translate_instr ctx stack_ctx i in
+      translate_instrs ctx stack_ctx rem
 
 let parallel_renaming params args =
   let rec visit visited prev s m x l =
@@ -175,7 +186,19 @@ let extend_context fall_through context =
   | `Block _ as b -> b :: context
   | `Return -> `Skip :: context
 
-let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
+let translate_function p ctx name_opt toplevel_name params ((pc, _) as cont) acc =
+  let stack_info =
+    Stack.generate_spilling_information
+      p
+      ~context:ctx.global_context
+      ~closures:ctx.closures
+      ~env:
+        (match name_opt with
+        | Some name -> name
+        | None -> Var.fresh ())
+      ~pc
+      ~params
+  in
   let g = Wa_structure.build_graph ctx.blocks pc in
   let idom = Wa_structure.dominator_tree g in
   let dom = Wa_structure.reverse_tree idom in
@@ -235,9 +258,14 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
         translate_tree result_typ fall_through pc' context
     | [] -> (
         let block = Addr.Map.find pc ctx.blocks in
-        let* () = translate_instrs ctx block.body in
+        let* global_context = get_context in
+        let stack_ctx = Stack.start_block ~context:global_context stack_info pc in
+        let* () = translate_instrs ctx stack_ctx block.body in
+        let* () = Stack.perform_reloads stack_ctx (`Branch (fst block.branch)) in
+        let* () = Stack.perform_spilling stack_ctx (`Block pc) in
         match fst block.branch with
-        | Branch cont -> translate_branch result_typ fall_through pc cont context
+        | Branch cont ->
+            translate_branch result_typ fall_through pc cont context stack_ctx
         | Return x -> (
             let* e = load x in
             match fall_through with
@@ -248,14 +276,19 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
             if_
               { params = []; result = result_typ }
               (Value.check_is_not_zero (load x))
-              (translate_branch result_typ fall_through pc cont1 context')
-              (translate_branch result_typ fall_through pc cont2 context')
+              (translate_branch result_typ fall_through pc cont1 context' stack_ctx)
+              (translate_branch result_typ fall_through pc cont2 context' stack_ctx)
         | Stop -> (
             let* e = Value.unit in
             match fall_through with
             | `Return -> instr (Push e)
             | `Block _ -> instr (Return (Some e)))
-        | Switch (x, a1, a2) -> (
+        | Switch (x, a1, a2) ->
+            let l =
+              List.filter
+                ~f:(fun pc' -> Stack.stack_adjustment_needed stack_ctx ~src:pc ~dst:pc')
+                (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc)))
+            in
             let br_table e a context =
               let len = Array.length a in
               let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
@@ -266,19 +299,32 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
               let* e = e in
               instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
             in
-            match a1, a2 with
-            | [||], _ -> br_table (Memory.tag (load x)) a2 context
-            | _, [||] -> br_table (Value.int_val (load x)) a1 context
-            | _ ->
-                (*ZZZ Use Br_on_cast *)
-                let context' = extend_context fall_through context in
-                if_
-                  { params = []; result = result_typ }
-                  (Value.check_is_int (load x))
-                  (br_table (Value.int_val (load x)) a1 context')
-                  (br_table (Memory.tag (load x)) a2 context'))
+            let rec nest l context =
+              match l with
+              | pc' :: rem ->
+                  let* () =
+                    Wa_code_generation.block
+                      { params = []; result = [] }
+                      (nest rem (`Block pc' :: context))
+                  in
+                  let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
+                  instr (Br (index pc' 0 context, None))
+              | [] -> (
+                  match a1, a2 with
+                  | [||], _ -> br_table (Memory.tag (load x)) a2 context
+                  | _, [||] -> br_table (Value.int_val (load x)) a1 context
+                  | _ ->
+                      (*ZZZ Use Br_on_cast *)
+                      let context' = extend_context fall_through context in
+                      if_
+                        { params = []; result = result_typ }
+                        (Value.check_is_int (load x))
+                        (br_table (Value.int_val (load x)) a1 context')
+                        (br_table (Memory.tag (load x)) a2 context'))
+            in
+            nest l context
         | Raise _ | Pushtrap _ | Poptrap _ -> return ())
-  and translate_branch result_typ fall_through src (dst, args) context =
+  and translate_branch result_typ fall_through src (dst, args) context stack_ctx =
     let* () =
       if List.is_empty args
       then return ()
@@ -286,6 +332,7 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
         let block = Addr.Map.find dst ctx.blocks in
         parallel_renaming block.params args
     in
+    let* () = Stack.adjust_stack stack_ctx ~src ~dst in
     if (src >= 0 && Wa_structure.is_backward g src dst)
        || Wa_structure.is_merge_node g dst
     then
@@ -323,7 +370,9 @@ let translate_function ctx name_opt toplevel_name params ((pc, _) as cont) acc =
       ~context:ctx.global_context
       ~body:
         (let* () = build_initial_env in
-         translate_branch [ Value.value ] `Return (-1) cont [])
+         let stack_ctx = Stack.start_function ~context:ctx.global_context stack_info in
+         let* () = Stack.perform_spilling stack_ctx `Function in
+         translate_branch [ Value.value ] `Return (-1) cont [] stack_ctx)
   in
   W.Function
     { name =
@@ -378,7 +427,7 @@ let f
     Code.fold_closures_outermost_first
       p
       (fun name_opt params cont ->
-        translate_function ctx name_opt toplevel_name params cont)
+        translate_function p ctx name_opt toplevel_name params cont)
       []
   in
   let primitives =
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
new file mode 100644
index 0000000000..ab54e955d4
--- /dev/null
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -0,0 +1,232 @@
+(*
+ZZZ If live in exception handler, live any place we may raise in the body
+*)
+
+open! Stdlib
+open Code
+
+module Domain = struct
+  type t =
+    { input : Var.Set.t
+    ; output : Var.Set.t
+    }
+
+  let bot = { input = Var.Set.empty; output = Var.Set.empty }
+
+  let equal v v' = Var.Set.equal v.input v'.input
+end
+
+(*ZZZ from wa_generate *)
+let get_free_variables ~context info =
+  List.filter
+    ~f:(fun x -> not (Hashtbl.mem context.Wa_code_generation.constants x))
+    info.Wa_closure_conversion.free_variables
+
+let function_free_variables ~context ~closures x =
+  let info = Var.Map.find x closures in
+  let f, _ = List.hd info.Wa_closure_conversion.functions in
+  if Var.equal x f then get_free_variables ~context info else []
+
+let get_set h x = try Hashtbl.find h x with Not_found -> Addr.Set.empty
+
+let cont_deps (deps, rev_deps) pc (pc', _) =
+  Hashtbl.replace deps pc' (Addr.Set.add pc (get_set deps pc'));
+  Hashtbl.replace rev_deps pc (Addr.Set.add pc' (get_set rev_deps pc))
+
+let block_deps deps block pc =
+  match fst block.branch with
+  | Return _ | Raise _ | Stop -> ()
+  | Branch cont | Poptrap cont -> cont_deps deps pc cont
+  | Cond (_, cont1, cont2) ->
+      cont_deps deps pc cont1;
+      cont_deps deps pc cont2
+  | Switch (_, a1, a2) ->
+      Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont);
+      Array.iter a2 ~f:(fun cont -> cont_deps deps pc cont)
+  | Pushtrap (cont, _, cont_h, _) ->
+      cont_deps deps pc cont;
+      cont_deps deps pc cont_h
+
+let function_deps blocks pc =
+  let deps = Hashtbl.create 16, Hashtbl.create 16 in
+  Code.traverse
+    { fold = fold_children }
+    (fun pc () ->
+      let block = Addr.Map.find pc blocks in
+      block_deps deps block pc)
+    pc
+    blocks
+    ();
+  deps
+
+type ctx =
+  { env : Var.t
+  ; bound_vars : Var.Set.t
+  ; spilled_vars : Var.Set.t
+  ; context : Wa_code_generation.context
+  }
+
+let add_var ~ctx s x =
+  if Hashtbl.mem ctx.context.Wa_code_generation.constants x
+  then s
+  else
+    let x = if Var.Set.mem x ctx.bound_vars then x else ctx.env in
+    if Var.Set.mem x ctx.spilled_vars then Var.Set.add x s else s
+
+let add_list ~ctx s l = List.fold_left ~f:(fun s x -> add_var ~ctx s x) ~init:s l
+
+let add_prim_args ~ctx s l =
+  List.fold_left
+    ~f:(fun s x ->
+      match x with
+      | Pc _ -> s
+      | Pv x -> add_var ~ctx s x)
+    ~init:s
+    l
+
+let add_array ~ctx s a = Array.fold_left ~f:(fun s x -> add_var ~ctx s x) ~init:s a
+
+let expr_used ~context ~closures ~ctx x e s =
+  match e with
+  | Apply { f; args; _ } -> add_list ~ctx s (f :: args)
+  | Block (_, a, _) -> add_array ~ctx s a
+  | Prim (_, l) -> add_prim_args ~ctx s l
+  | Closure _ -> add_list ~ctx s (function_free_variables ~context ~closures x)
+  | Constant _ -> s
+  | Field (x, _) -> add_var ~ctx s x
+
+let propagate_through_instr ~context ~closures ~ctx (i, _) s =
+  match i with
+  | Let (x, e) -> expr_used ~context ~closures ~ctx x e (Var.Set.remove x s)
+  | Set_field (x, _, y) -> add_var ~ctx (add_var ~ctx s x) y
+  | Assign (_, x) | Offset_ref (x, _) -> add_var ~ctx s x
+  | Array_set (x, y, z) -> add_var ~ctx (add_var ~ctx (add_var ~ctx s x) y) z
+
+let cont_used ~ctx (_, args) s = add_list ~ctx s args
+
+let propagate_through_branch ~ctx (b, _) s =
+  match b with
+  | Return x | Raise (x, _) -> add_var ~ctx s x
+  | Stop -> s
+  | Branch cont | Poptrap cont -> cont_used ~ctx cont s
+  | Cond (_, cont1, cont2) -> s |> cont_used ~ctx cont1 |> cont_used ~ctx cont2
+  | Switch (_, a1, a2) ->
+      let s = Array.fold_right a1 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s in
+      Array.fold_right a2 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s
+  | Pushtrap (cont, x, cont_h, _) ->
+      s |> cont_used ~ctx cont |> cont_used ~ctx cont_h |> Var.Set.remove x
+
+let propagate blocks ~context ~closures ~ctx rev_deps st pc =
+  let input =
+    pc
+    |> get_set rev_deps
+    |> Addr.Set.elements
+    |> List.map ~f:(fun pc' -> (Addr.Map.find pc' st).Domain.output)
+    |> List.fold_left ~f:Var.Set.union ~init:Var.Set.empty
+  in
+  let b = Addr.Map.find pc blocks in
+  let s = propagate_through_branch ~ctx b.branch input in
+  let output =
+    List.fold_right
+      ~f:(fun i s -> propagate_through_instr ~context ~closures ~ctx i s)
+      ~init:s
+      b.body
+  in
+  let output = Var.Set.diff output (Var.Set.of_list b.params) in
+  { Domain.input; output }
+
+module G = Dgraph.Make (Int) (Addr.Set) (Addr.Map)
+module Solver = G.Solver (Domain)
+
+type block_info =
+  { initially_live : Var.Set.t (* Live at start of block *)
+  ; live_before_branch : Var.Set.t
+  }
+
+type info =
+  { instr : Var.Set.t Var.Map.t (* Live variables at spilling point *)
+  ; block : block_info Addr.Map.t
+  }
+
+let compute_instr_info ~blocks ~context ~closures ~domain ~ctx st =
+  Addr.Set.fold
+    (fun pc live_info ->
+      let live_vars = (Addr.Map.find pc st).Domain.input in
+      let block = Addr.Map.find pc blocks in
+      let live_vars = propagate_through_branch ~ctx block.Code.branch live_vars in
+      let _, live_info =
+        List.fold_right
+          ~f:(fun i (live_vars, live_info) ->
+            let live_vars' =
+              propagate_through_instr ~context ~closures ~ctx i live_vars
+            in
+            let live_info =
+              match fst i with
+              | Let (x, e) -> (
+                  match e with
+                  | Apply _ | Prim _ ->
+                      Var.Map.add x (Var.Set.remove x live_vars) live_info
+                  | Block _ | Closure _ -> Var.Map.add x live_vars' live_info
+                  | Constant _ | Field _ -> live_info)
+              | Assign _ | Offset_ref _ | Set_field _ | Array_set _ -> live_info
+            in
+            live_vars', live_info)
+          ~init:(live_vars, live_info)
+          block.body
+      in
+      live_info)
+    domain
+    Var.Map.empty
+
+let compute_block_info ~blocks ~ctx st =
+  Addr.Map.mapi
+    (fun pc { Domain.input; output } ->
+      let block = Addr.Map.find pc blocks in
+      let live_before_branch = propagate_through_branch ~ctx block.Code.branch input in
+      { initially_live = output; live_before_branch })
+    st
+
+let f ~blocks ~context ~closures ~domain ~env ~bound_vars ~spilled_vars ~pc =
+  let ctx = { env; bound_vars; spilled_vars; context } in
+  let deps, rev_deps = function_deps blocks pc in
+  let fold_children f pc acc = Addr.Set.fold f (get_set deps pc) acc in
+  let g = { G.domain; fold_children } in
+  let st =
+    Solver.f g (fun st pc -> propagate blocks ~context ~closures ~ctx rev_deps st pc)
+  in
+  let instr = compute_instr_info ~blocks ~context ~closures ~domain ~ctx st in
+  let block = compute_block_info ~blocks ~ctx st in
+  (*
+  Addr.Set.iter
+    (fun pc ->
+      let { Domain.input; output } = Addr.Map.find pc st in
+      Format.eprintf "input:";
+      Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) input;
+      Format.eprintf "@.";
+      Format.eprintf "output:";
+      Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) output;
+      Format.eprintf "@.";
+      let b = Addr.Map.find pc blocks in
+      let print_vars s =
+        Format.asprintf
+          "{%a}"
+          (fun f l ->
+            Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f " ") Var.print f l)
+          (Var.Set.elements s)
+      in
+      Code.Print.block
+        (fun _pc loc ->
+          match loc with
+          | Instr (Let (x, _), _) -> (
+              match Var.Map.find_opt x instr with
+              | Some s -> print_vars s
+              | None -> "")
+          | Instr _ -> ""
+          | Last _ ->
+              let s = Addr.Map.find pc block in
+              print_vars s.live_before_branch)
+        pc
+        b)
+    domain;
+  *)
+  { block; instr }
diff --git a/compiler/lib/wasm/wa_liveness.mli b/compiler/lib/wasm/wa_liveness.mli
new file mode 100644
index 0000000000..6e4b5ed946
--- /dev/null
+++ b/compiler/lib/wasm/wa_liveness.mli
@@ -0,0 +1,20 @@
+type block_info =
+  { initially_live : Code.Var.Set.t (* Live at start of block *)
+  ; live_before_branch : Code.Var.Set.t
+  }
+
+type info =
+  { instr : Code.Var.Set.t Code.Var.Map.t (* Live variables at spilling point *)
+  ; block : block_info Code.Addr.Map.t
+  }
+
+val f :
+     blocks:Code.block Code.Addr.Map.t
+  -> context:Wa_code_generation.context
+  -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+  -> domain:Code.Addr.Set.t
+  -> env:Code.Var.t
+  -> bound_vars:Code.Var.Set.t
+  -> spilled_vars:Code.Var.Set.t
+  -> pc:int
+  -> info
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
new file mode 100644
index 0000000000..bb7a95c5fa
--- /dev/null
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -0,0 +1,791 @@
+(*
+We add spilling points at the end of each block and before each
+possible GC: function calls and allocations. Local variables are
+spilled at most once, at the first following spilling points.
+
+We first compute which local variables contain valid values at the
+beginning of each block: either there has been no GC since their
+definition or they have been accessed since the last GC point (so they
+must have been reloaded).
+Then, we compute which variables neeeds to be spilled at some point
+(we access the local variable while it does not contain any valid
+value).
+From this, we can compute what need to be spilled at each spilling
+point, and the stack contents at any point in the program.
+
+When allocating, we currently always spill everything. We should
+probably spill everything only when a GC takes place. To keep the code
+short, we should always spill variables that are still live after the
+allocation, but variables that are no longer live after the allocation
+only need to be spilled when a GC takes place.
+
+We should find a way to reuse local variables while they are spilled,
+to minimize the number of local variables used.
+*)
+
+let debug = Debug.find "spilling"
+
+open! Stdlib
+open Code
+
+module Domain = struct
+  type t =
+    | Bot
+    | Set of
+        { input : Var.Set.t
+        ; output : Var.Set.t
+        }
+
+  let bot = Bot
+
+  let equal v v' =
+    match v, v' with
+    | Bot, Bot -> true
+    | Bot, Set _ | Set _, Bot -> false
+    | Set { input; _ }, Set { input = input'; _ } -> Var.Set.equal input input'
+end
+
+let make_table l =
+  let h = Hashtbl.create 16 in
+  List.iter ~f:(fun s -> Hashtbl.add h s ()) l;
+  h
+
+(*ZZZ See lambda/translprim.ml + stdlib *)
+let no_alloc_tbl =
+  make_table
+    [ "caml_array_unsafe_set"
+    ; "caml_string_unsafe_get"
+    ; "caml_string_unsafe_set"
+    ; "caml_bytes_unsafe_get"
+    ; "caml_bytes_unsafe_set"
+    ; "%int_add"
+    ; "%int_sub"
+    ; "%int_mul"
+    ; "%int_neg"
+    ; "%int_or"
+    ; "%int_and"
+    ; "%int_xor"
+    ; "%int_lsl"
+    ; "%int_lsr"
+    ; "%int_asr"
+    ]
+
+let no_pointer_tbl =
+  make_table
+    [ "caml_string_unsafe_get"
+    ; "caml_string_unsafe_set"
+    ; "caml_bytes_unsafe_get"
+    ; "caml_bytes_unsafe_set"
+    ; "%int_add"
+    ; "%int_sub"
+    ; "%int_mul"
+    ; "%int_neg"
+    ; "%int_or"
+    ; "%int_and"
+    ; "%int_xor"
+    ; "%int_lsl"
+    ; "%int_lsr"
+    ; "%int_asr"
+    ]
+
+let no_alloc p =
+  match p with
+  | Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult -> true
+  | Extern nm -> Hashtbl.mem no_alloc_tbl nm (* ZZZ Refine *)
+
+let no_pointer p =
+  match p with
+  | Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult -> true
+  | Extern nm -> Hashtbl.mem no_pointer_tbl nm (* ZZZ Refine *)
+  | Array_get -> false
+
+(*ZZZ from wa_generate *)
+let get_free_variables ~context info =
+  List.filter
+    ~f:(fun x -> not (Hashtbl.mem context.Wa_code_generation.constants x))
+    info.Wa_closure_conversion.free_variables
+
+let function_free_variables ~context ~closures x =
+  let info = Code.Var.Map.find x closures in
+  let f, _ = List.hd info.Wa_closure_conversion.functions in
+  if Code.Var.equal x f then get_free_variables ~context info else []
+
+let get_set h x = try Hashtbl.find h x with Not_found -> Addr.Set.empty
+
+let get_list h x = try Hashtbl.find h x with Not_found -> []
+
+let cont_deps (deps, rev_deps) pc ?exn (pc', _) =
+  Hashtbl.replace deps pc (Addr.Set.add pc' (get_set deps pc));
+  Hashtbl.replace rev_deps pc' ((pc, exn) :: get_list rev_deps pc')
+
+let block_deps bound_vars deps block pc =
+  match fst block.branch with
+  | Return _ | Raise _ | Stop -> ()
+  | Branch cont | Poptrap cont -> cont_deps deps pc cont
+  | Cond (_, cont1, cont2) ->
+      cont_deps deps pc cont1;
+      cont_deps deps pc cont2
+  | Switch (_, a1, a2) ->
+      Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont);
+      Array.iter a2 ~f:(fun cont -> cont_deps deps pc cont)
+  | Pushtrap (cont, exn, cont_h, _) ->
+      cont_deps deps pc cont;
+      bound_vars := Var.Set.add exn !bound_vars;
+      cont_deps deps pc ~exn cont_h
+
+let function_deps blocks ~context ~closures pc params =
+  let bound_vars = ref params in
+  let non_spillable_vars = ref Var.Set.empty in
+  let domain = ref Addr.Set.empty in
+  let deps = Hashtbl.create 16, Hashtbl.create 16 in
+  let mark_non_spillable x = non_spillable_vars := Var.Set.add x !non_spillable_vars in
+  Code.traverse
+    { fold = fold_children }
+    (fun pc () ->
+      domain := Addr.Set.add pc !domain;
+      let block = Addr.Map.find pc blocks in
+      List.iter
+        ~f:(fun (i, _) ->
+          match i with
+          | Let (x, e) -> (
+              match e with
+              | Constant _ -> mark_non_spillable x
+              | Prim (p, _) when no_pointer p -> mark_non_spillable x
+              | Closure _
+                when List.is_empty (function_free_variables ~context ~closures x) ->
+                  mark_non_spillable x
+              | Prim _ | Closure _ | Apply _ | Block _ | Field _ -> ())
+          | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> ())
+        block.body;
+      bound_vars :=
+        List.fold_left
+          ~f:(fun vars (i, _) ->
+            match i with
+            | Let (x, _) -> Var.Set.add x vars
+            | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> vars)
+          ~init:!bound_vars
+          block.body;
+      bound_vars := Var.Set.union !bound_vars (Var.Set.of_list block.params);
+      block_deps bound_vars deps block pc)
+    pc
+    blocks
+    ();
+  !domain, deps, !bound_vars, Var.Set.diff !bound_vars !non_spillable_vars
+
+let inter s s' =
+  match s, s' with
+  | None, None -> None
+  | _, None -> s
+  | None, _ -> s'
+  | Some s, Some s' -> Some (Var.Set.inter s s')
+
+let propagate_through_expr ~context ~closures s x e =
+  match e with
+  | Apply _ | Block _ -> Var.Set.empty
+  | Prim (p, _) -> if no_alloc p then s else Var.Set.empty
+  | Closure _ ->
+      if List.is_empty (function_free_variables ~context ~closures x)
+      then s
+      else Var.Set.empty
+  | Constant _ | Field _ -> s
+
+let propagate_through_instr ~context ~closures s (i, _) =
+  match i with
+  | Let (x, e) -> Var.Set.add x (propagate_through_expr ~context ~closures s x e)
+  | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> s
+
+let propagate blocks ~context ~closures rev_deps pc0 params st pc =
+  let input =
+    pc
+    |> get_list rev_deps
+    |> List.map ~f:(fun (pc', exn_opt) ->
+           match Addr.Map.find pc' st with
+           | Domain.Bot -> None
+           | Set { output; _ } ->
+               Some
+                 (match exn_opt with
+                 | None -> output
+                 | Some x -> Var.Set.add x output))
+    |> List.fold_left ~f:inter ~init:None
+  in
+  let input = if pc = pc0 then inter input (Some params) else input in
+  match input with
+  | None -> Domain.Bot
+  | Some input ->
+      let b = Addr.Map.find pc blocks in
+      let input = Var.Set.union input (Var.Set.of_list b.params) in
+      let output =
+        List.fold_left
+          ~f:(fun s i -> propagate_through_instr ~context ~closures s i)
+          ~init:input
+          b.body
+      in
+      Set { input; output }
+
+module G = Dgraph.Make (Int) (Addr.Set) (Addr.Map)
+module Solver = G.Solver (Domain)
+
+type spill_ctx =
+  { env : Var.t
+  ; bound_vars : Var.Set.t
+  ; spillable_vars : Var.Set.t
+  ; context : Wa_code_generation.context
+  }
+
+let check_spilled ~ctx loaded x spilled =
+  if Hashtbl.mem ctx.context.Wa_code_generation.constants x
+  then spilled
+  else
+    let x = if Var.Set.mem x ctx.bound_vars then x else ctx.env in
+    if Var.Set.mem x loaded || not (Var.Set.mem x ctx.spillable_vars)
+    then spilled
+    else Var.Set.add x spilled
+
+let spilled_variables
+    ~blocks
+    ~context
+    ~closures
+    ~domain
+    ~env
+    ~bound_vars
+    ~spillable_vars
+    st =
+  let spilled = Var.Set.empty in
+  let ctx = { env; bound_vars; spillable_vars; context } in
+  Addr.Set.fold
+    (fun pc spilled ->
+      let loaded =
+        match Addr.Map.find pc st with
+        | Domain.Bot -> assert false
+        | Domain.Set { input; _ } -> input
+      in
+      let block = Addr.Map.find pc blocks in
+      let loaded, spilled =
+        List.fold_left
+          ~f:(fun (loaded, spilled) i ->
+            let loaded' = propagate_through_instr ~context ~closures loaded i in
+            let reloaded =
+              match fst i with
+              | Let (x, e) -> (
+                  match e with
+                  | Apply { f; args; _ } ->
+                      List.fold_left
+                        ~f:(fun reloaded x -> check_spilled ~ctx loaded x reloaded)
+                        (f :: args)
+                        ~init:Var.Set.empty
+                  | Block (_, l, _) ->
+                      Array.fold_left
+                        ~f:(fun reloaded x -> check_spilled ~ctx loaded' x reloaded)
+                        l
+                        ~init:Var.Set.empty
+                  | Prim (_, args) ->
+                      List.fold_left
+                        ~f:(fun reloaded x ->
+                          match x with
+                          | Pv x -> check_spilled ~ctx loaded x reloaded
+                          | Pc _ -> reloaded)
+                        args
+                        ~init:Var.Set.empty
+                  | Closure _ ->
+                      let fv = function_free_variables ~context ~closures x in
+                      List.fold_left
+                        ~f:(fun reloaded x -> check_spilled ~ctx loaded' x reloaded)
+                        fv
+                        ~init:Var.Set.empty
+                  | Constant _ -> Var.Set.empty
+                  | Field (x, _) -> check_spilled ~ctx loaded x Var.Set.empty)
+              | Assign (_, x) | Offset_ref (x, _) ->
+                  check_spilled ~ctx loaded x Var.Set.empty
+              | Set_field (x, _, y) ->
+                  Var.Set.empty
+                  |> check_spilled ~ctx loaded x
+                  |> check_spilled ~ctx loaded y
+              | Array_set (x, y, z) ->
+                  Var.Set.empty
+                  |> check_spilled ~ctx loaded x
+                  |> check_spilled ~ctx loaded y
+                  |> check_spilled ~ctx loaded z
+            in
+            Var.Set.union loaded' reloaded, Var.Set.union spilled reloaded)
+          ~init:(loaded, spilled)
+          block.body
+      in
+      let handle_cont (_, args) spilled =
+        List.fold_left
+          ~f:(fun spilled x -> check_spilled ~ctx loaded x spilled)
+          args
+          ~init:spilled
+      in
+      match fst block.branch with
+      | Return x | Raise (x, _) -> check_spilled ~ctx loaded x spilled
+      | Stop -> spilled
+      | Branch cont | Poptrap cont -> handle_cont cont spilled
+      | Cond (_, cont1, cont2) -> spilled |> handle_cont cont1 |> handle_cont cont2
+      | Switch (_, a1, a2) ->
+          let spilled = Array.fold_right a1 ~f:handle_cont ~init:spilled in
+          Array.fold_right a2 ~f:handle_cont ~init:spilled
+      | Pushtrap (cont, _, cont_h, _) -> spilled |> handle_cont cont |> handle_cont cont_h)
+    domain
+    spilled
+
+let traverse ~f pc blocks input =
+  let rec traverse_rec f pc visited blocks inp =
+    if not (Addr.Set.mem pc visited)
+    then
+      let visited = Addr.Set.add pc visited in
+      let out = f pc inp in
+      Code.fold_children
+        blocks
+        pc
+        (fun pc visited -> traverse_rec f pc visited blocks out)
+        visited
+    else visited
+  in
+  ignore (traverse_rec f pc Addr.Set.empty blocks input)
+
+let filter_stack live stack =
+  List.fold_right
+    ~f:(fun v rem ->
+      match v, rem with
+      | Some x, _ when Var.Set.mem x live -> v :: rem
+      | _, [] -> []
+      | _ -> None :: rem)
+    stack
+    ~init:[]
+
+let rec spill i x stack =
+  match stack with
+  | None :: rem -> i, Some x :: rem
+  | [] -> i, [ Some x ]
+  | v :: rem ->
+      let i, rem = spill (i + 1) x rem in
+      i, v :: rem
+
+let spill_vars live vars stack =
+  let stack = filter_stack live stack in
+  let stack, spills =
+    Var.Set.fold
+      (fun x (stack, spills) ->
+        let i, stack = spill 0 x stack in
+        stack, (x, i) :: spills)
+      vars
+      (stack, [])
+  in
+  let last = List.length stack - 1 in
+  stack, List.map ~f:(fun (x, i) -> x, last - i) spills
+
+let print_stack s =
+  if List.is_empty s
+  then ""
+  else
+    Format.asprintf
+      "{%a}"
+      (fun f l ->
+        Format.pp_print_list
+          ~pp_sep:(fun f () -> Format.fprintf f " ")
+          (fun f v ->
+            match v with
+            | None -> Format.fprintf f "*"
+            | Some x -> Var.print f x)
+          f
+          l)
+      s
+
+type stack = Var.t option list
+
+type spilling_info =
+  { depth_change : int
+  ; spills : (Var.t * int) list
+  ; stack : stack
+  }
+
+let print_spilling { depth_change; spills; stack; _ } =
+  let print_actions f l =
+    Format.pp_print_list
+      ~pp_sep:(fun f () -> Format.fprintf f " ")
+      (fun f (x, i) -> Format.fprintf f "%d:%a" i Var.print x)
+      f
+      l
+  in
+  if false
+  then print_stack stack
+  else Format.asprintf "%d %s {%a}" depth_change (print_stack stack) print_actions spills
+
+type block_info =
+  { initial_stack : stack (* Stack at beginning of block *)
+  ; loaded_variables : Var.Set.t (* Values in local variables at beginning of block *)
+  ; spilling : spilling_info (* Spilling at end of block *)
+  }
+
+type info =
+  { max_depth : int
+  ; subcalls : bool
+  ; env : Var.t
+  ; bound_vars : Var.Set.t
+  ; initial_spilling : spilling_info
+  ; block : block_info Addr.Map.t
+  ; instr : spilling_info Var.Map.t
+  }
+
+let update_stack ~max_depth live_vars vars stack =
+  let stack', spills = spill_vars live_vars vars stack in
+  max_depth := max !max_depth (List.length stack);
+  { depth_change = List.length stack' - List.length stack; stack = stack'; spills }
+
+let spilling blocks st env bound_vars spilled_vars live_info pc params =
+  let stack = [] in
+  let max_depth = ref 0 in
+  let subcalls = ref false in
+  let vars = Var.Set.inter params spilled_vars in
+  let stack, spills = spill_vars Var.Set.empty vars stack in
+  let initial_spilling = { depth_change = List.length stack; stack; spills } in
+  let instr_info = ref Var.Map.empty in
+  let block_info = ref Addr.Map.empty in
+  traverse pc blocks stack ~f:(fun pc stack ->
+      let block = Addr.Map.find pc blocks in
+      let block_live_vars = Addr.Map.find pc live_info.Wa_liveness.block in
+      let initial_stack, _ =
+        spill_vars block_live_vars.initially_live Var.Set.empty stack
+      in
+      let vars = Var.Set.inter (Var.Set.of_list block.params) spilled_vars in
+      let stack, vars =
+        List.fold_left
+          ~f:(fun (stack, vars) (i, _) ->
+            let stack, vars =
+              match i with
+              | Let (x, e) -> (
+                  match e with
+                  | Apply _ | Block _ | Closure _ ->
+                      let live_vars = Var.Map.find x live_info.instr in
+                      let ({ stack; _ } as sp) =
+                        update_stack ~max_depth live_vars vars stack
+                      in
+                      instr_info := Var.Map.add x sp !instr_info;
+                      (match e with
+                      | Apply _ when not (List.is_empty stack) -> subcalls := true
+                      | _ -> ());
+                      stack, Var.Set.empty
+                  | Prim (p, _) when not (no_alloc p) ->
+                      let live_vars = Var.Map.find x live_info.instr in
+                      let ({ stack; _ } as sp) =
+                        update_stack ~max_depth live_vars vars stack
+                      in
+                      instr_info := Var.Map.add x sp !instr_info;
+                      stack, Var.Set.empty
+                  | Prim _ | Constant _ | Field _ -> stack, vars)
+              | Assign _ | Offset_ref _ | Set_field _ | Array_set _ -> stack, vars
+            in
+            let vars =
+              match i with
+              | Let (x, _) when Var.Set.mem x spilled_vars -> Var.Set.add x vars
+              | _ -> vars
+            in
+            stack, vars)
+          ~init:(initial_stack, vars)
+          block.body
+      in
+      (* ZZZ Spilling at end of block *)
+      let ({ stack; _ } as sp) =
+        update_stack ~max_depth block_live_vars.live_before_branch vars stack
+      in
+      let loaded_variables =
+        match Addr.Map.find pc st with
+        | Domain.Bot -> assert false
+        | Domain.Set { input; _ } -> input
+      in
+      block_info :=
+        Addr.Map.add pc { initial_stack; loaded_variables; spilling = sp } !block_info;
+      stack);
+  { max_depth = !max_depth
+  ; subcalls = !subcalls
+  ; env
+  ; bound_vars
+  ; initial_spilling
+  ; block = !block_info
+  ; instr = !instr_info
+  }
+
+let generate_spilling_information { blocks; _ } ~context ~closures ~pc:pc0 ~env ~params =
+  let params = Var.Set.add env (Var.Set.of_list params) in
+  let domain, (deps, rev_deps), bound_vars, spillable_vars =
+    function_deps blocks ~context ~closures pc0 params
+  in
+  let fold_children f pc acc = Addr.Set.fold f (get_set deps pc) acc in
+  let g = { G.domain; fold_children } in
+  let st =
+    Solver.f g (fun st pc ->
+        propagate blocks ~context ~closures rev_deps pc0 params st pc)
+  in
+  let spilled_vars =
+    spilled_variables
+      ~blocks
+      ~context
+      ~closures
+      ~domain
+      ~env
+      ~bound_vars
+      ~spillable_vars
+      st
+  in
+  if debug ()
+  then (
+    Format.eprintf "PARAMS: (%a)" Var.print env;
+    Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) params;
+    Format.eprintf "@.";
+    Format.eprintf "SPILLED:";
+    Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) spilled_vars;
+    Format.eprintf "@.");
+  (*
+  Addr.Set.iter
+    (fun pc ->
+      let s = Addr.Map.find pc st in
+      (match s with
+      | Domain.Bot -> ()
+      | Domain.Set { input; output } ->
+          Format.eprintf "INPUT:";
+          Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) input;
+          Format.eprintf "@.";
+          Format.eprintf "OUTPUT:";
+          Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) output;
+          Format.eprintf "@.");
+      let block = Addr.Map.find pc blocks in
+      Code.Print.block (fun _ _ -> "") pc block)
+    domain;
+  *)
+  let live_info =
+    Wa_liveness.f
+      ~blocks
+      ~context
+      ~closures
+      ~domain
+      ~env
+      ~bound_vars
+      ~spilled_vars
+      ~pc:pc0
+  in
+  let info = spilling blocks st env bound_vars spilled_vars live_info pc0 params in
+  if debug ()
+  then (
+    Format.eprintf "== %d == depth %d calls %b@." pc0 info.max_depth info.subcalls;
+    Format.eprintf "%s@." (print_spilling info.initial_spilling);
+    Addr.Set.iter
+      (fun pc ->
+        let block = Addr.Map.find pc blocks in
+        let _print_vars s =
+          if Var.Set.is_empty s
+          then ""
+          else
+            Format.asprintf
+              "{%a}"
+              (fun f l ->
+                Format.pp_print_list
+                  ~pp_sep:(fun f () -> Format.fprintf f " ")
+                  Var.print
+                  f
+                  l)
+              (Var.Set.elements s)
+        in
+        Code.Print.block
+          (fun _pc loc ->
+            match loc with
+            | Instr (Let (x, _), _) -> (
+                match Var.Map.find_opt x info.instr with
+                | Some s -> print_spilling s
+                | None -> "")
+            | Instr _ -> ""
+            | Last _ ->
+                let s = Addr.Map.find pc info.block in
+                print_spilling s.spilling)
+          pc
+          block)
+      domain);
+  info
+
+type context =
+  { loaded_variables : Var.Set.t
+  ; loaded_sp : Code.Var.t option
+  ; stack : stack
+  ; info : info
+  ; context : Wa_code_generation.context
+  }
+
+type ctx = context ref
+
+open Wa_code_generation
+module W = Wa_ast
+
+let rec find_in_stack x stack =
+  match stack with
+  | [] -> raise Not_found
+  | Some y :: rem when Var.equal x y -> List.length rem
+  | _ :: rem -> find_in_stack x rem
+
+let load_sp ctx =
+  match !ctx.loaded_sp with
+  | Some sp -> return sp
+  | None ->
+      let sp = Var.fresh_n "sp" in
+      ctx := { !ctx with loaded_sp = Some sp };
+      let* () = store sp (return (W.GlobalGet (S "sp"))) in
+      return sp
+
+let perform_reloads ctx l =
+  let vars = ref Var.Map.empty in
+  let add_var x =
+    if not (Hashtbl.mem !ctx.context.Wa_code_generation.constants x)
+    then
+      let x = if Var.Set.mem x !ctx.info.bound_vars then x else !ctx.info.env in
+      if not (Var.Set.mem x !ctx.loaded_variables)
+      then
+        try
+          let i = find_in_stack x !ctx.stack in
+          vars := Var.Map.add x i !vars
+        with Not_found -> ()
+  in
+  (match l with
+  | `Instr i -> Freevars.iter_instr_free_vars add_var i
+  | `Branch l -> Freevars.iter_last_free_var add_var l
+  | `Vars s -> Var.Set.iter add_var s);
+  if Var.Map.is_empty !vars
+  then return ()
+  else
+    let* sp = load_sp ctx in
+    let* () =
+      List.fold_left
+        ~f:(fun before (x, i) ->
+          let* () = before in
+          let* sp = load sp in
+          let offset = 4 * i in
+          store x (return (W.Load (I32 (Int32.of_int offset), sp))))
+        (List.sort ~cmp:(fun (_, i) (_, j) -> compare i j) (Var.Map.bindings !vars))
+        ~init:(return ())
+    in
+    ctx :=
+      { !ctx with
+        loaded_variables =
+          Var.Set.union
+            !ctx.loaded_variables
+            (Var.Map.fold (fun x _ s -> Var.Set.add x s) !vars Var.Set.empty)
+      };
+    return ()
+
+let assign ctx x =
+  match find_in_stack x !ctx.stack with
+  | exception Not_found -> return ()
+  | i ->
+      let* sp = load_sp ctx in
+      let* sp = load sp in
+      let* x = load x in
+      let offset = 4 * i in
+      instr (W.Store (I32 (Int32.of_int offset), sp, x))
+
+let perform_spilling ctx loc =
+  match
+    match loc with
+    | `Function -> !ctx.info.initial_spilling
+    | `Instr x -> Var.Map.find x !ctx.info.instr
+    | `Block pc -> (Addr.Map.find pc !ctx.info.block).spilling
+  with
+  | exception Not_found -> return ()
+  | spilling ->
+      if spilling.depth_change = 0 && List.is_empty spilling.spills
+      then return ()
+      else
+        let* sp = load_sp ctx in
+        let* sp =
+          if spilling.depth_change = 0
+          then return sp
+          else
+            let sp' = Var.fresh_n "sp" in
+            let delta = -4 * spilling.depth_change in
+            let* sp = tee sp' Arith.(load sp + const (Int32.of_int delta)) in
+            ctx := { !ctx with loaded_sp = Some sp' };
+            let* () = instr (W.GlobalSet (S "sp", sp)) in
+            return sp'
+        in
+        let* () =
+          List.fold_left
+            ~f:(fun before (x, i) ->
+              let* () = before in
+              let* sp = load sp in
+              let* x = load x in
+              let offset = 4 * i in
+              instr (W.Store (I32 (Int32.of_int offset), sp, x)))
+            spilling.spills
+            ~init:(return ())
+        in
+        ctx := { !ctx with stack = spilling.stack };
+        return ()
+
+let adjust_stack ctx ~src ~dst =
+  let src_stack =
+    if src = -1 then !ctx.stack else (Addr.Map.find src !ctx.info.block).spilling.stack
+  in
+  let dst_info = Addr.Map.find dst !ctx.info.block in
+  let delta = List.length dst_info.initial_stack - List.length src_stack in
+  if delta = 0
+  then return ()
+  else
+    let* sp = load_sp ctx in
+    let delta = -4 * delta in
+    let* sp = Arith.(load sp + const (Int32.of_int delta)) in
+    instr (W.GlobalSet (S "sp", sp))
+
+let stack_adjustment_needed ctx ~src ~dst =
+  let src_stack =
+    if src = -1 then !ctx.stack else (Addr.Map.find src !ctx.info.block).spilling.stack
+  in
+  let dst_info = Addr.Map.find dst !ctx.info.block in
+  let delta = List.length dst_info.initial_stack - List.length src_stack in
+  delta <> 0
+
+let start_block ~context spilling_info pc =
+  let info = Addr.Map.find pc spilling_info.block in
+  ref
+    { loaded_variables = info.loaded_variables
+    ; loaded_sp = None
+    ; stack = info.initial_stack
+    ; info = spilling_info
+    ; context
+    }
+
+let start_function ~context (spilling_info : info) =
+  (*ZZZ Check stack depth *)
+  ref
+    { loaded_variables = Var.Set.empty
+    ; loaded_sp = None
+    ; stack = []
+    ; info = spilling_info
+    ; context
+    }
+
+let kill_variables ctx =
+  ctx := { !ctx with loaded_variables = Var.Set.empty; loaded_sp = None }
+
+let make_info () =
+  { max_depth = 0
+  ; subcalls = false
+  ; env = Var.fresh ()
+  ; bound_vars = Var.Set.empty
+  ; initial_spilling = { depth_change = 0; spills = []; stack = [] }
+  ; block = Addr.Map.empty
+  ; instr = Var.Map.empty
+  }
+
+let add_spilling info ~location:x ~stack ~live_vars ~spilled_vars =
+  let max_depth = ref info.max_depth in
+  let spilling = update_stack ~max_depth live_vars spilled_vars stack in
+  ( { info with
+      max_depth = !max_depth
+    ; instr = Var.Map.add x spilling info.instr
+    ; bound_vars = Var.Set.union info.bound_vars spilled_vars
+    }
+  , spilling.stack )
+
+(*
+ZZZ TODO
+- We could improve the code generated for stack adjustment after a switch
+- We need to deal with exceptions...
+- Check available stack depth at beginning of function (also for curry/apply)
+- We could zero-out no longer used stack slots to avoid memory leaks
+*)
diff --git a/compiler/lib/wasm/wa_spilling.mli b/compiler/lib/wasm/wa_spilling.mli
new file mode 100644
index 0000000000..65cee35222
--- /dev/null
+++ b/compiler/lib/wasm/wa_spilling.mli
@@ -0,0 +1,71 @@
+(*
+type stack = Code.Var.t option list
+
+type spilling_info =
+  { reloads : (Code.Var.t * int) list
+  ; depth_change : int
+  ; spills : (Code.Var.t * int) list
+  ; stack : stack
+  }
+
+type block_info =
+  { initial_depth : int
+  ; loaded_variables : Code.Var.Set.t
+  ; spilling : spilling_info
+  }
+
+type info =
+  { max_depth : int
+  ; subcalls : bool
+  ; initial_spilling : spilling_info
+  ; block : block_info Code.Addr.Map.t
+  ; instr : spilling_info Code.Var.Map.t
+  }
+*)
+
+type stack = Code.Var.t option list
+
+type info
+
+val generate_spilling_information :
+     Code.program
+  -> context:Wa_code_generation.context
+  -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+  -> pc:Code.Addr.t
+  -> env:Code.Var.t
+  -> params:Code.Var.t list
+  -> info
+
+val make_info : unit -> info
+
+val add_spilling :
+     info
+  -> location:Code.Var.t
+  -> stack:stack
+  -> live_vars:Code.Var.Set.t
+  -> spilled_vars:Code.Var.Set.t
+  -> info * stack
+
+type ctx
+
+val start_function : context:Wa_code_generation.context -> info -> ctx
+
+val start_block : context:Wa_code_generation.context -> info -> Code.Addr.t -> ctx
+
+val perform_reloads :
+     ctx
+  -> [ `Branch of Code.last | `Instr of Code.instr | `Vars of Code.Var.Set.t ]
+  -> unit Wa_code_generation.t
+
+val perform_spilling :
+     ctx
+  -> [ `Function | `Instr of Code.Var.t | `Block of Code.Addr.t ]
+  -> unit Wa_code_generation.t
+
+val kill_variables : ctx -> unit
+
+val assign : ctx -> Code.Var.t -> unit Wa_code_generation.t
+
+val adjust_stack : ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> unit Wa_code_generation.t
+
+val stack_adjustment_needed : ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> bool
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 493fa0dd38..abbf8216c5 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -1,9 +1,63 @@
 module type S = sig
   type expression = Wa_code_generation.expression
 
+  module Stack : sig
+    type stack = Code.Var.t option list
+
+    type info
+
+    val generate_spilling_information :
+         Code.program
+      -> context:Wa_code_generation.context
+      -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+      -> pc:Code.Addr.t
+      -> env:Code.Var.t
+      -> params:Code.Var.t list
+      -> info
+
+    val make_info : unit -> info
+
+    val add_spilling :
+         info
+      -> location:Code.Var.t
+      -> stack:stack
+      -> live_vars:Code.Var.Set.t
+      -> spilled_vars:Code.Var.Set.t
+      -> info * stack
+
+    type ctx
+
+    val start_function : context:Wa_code_generation.context -> info -> ctx
+
+    val start_block : context:Wa_code_generation.context -> info -> Code.Addr.t -> ctx
+
+    val perform_reloads :
+         ctx
+      -> [ `Branch of Code.last | `Instr of Code.instr | `Vars of Code.Var.Set.t ]
+      -> unit Wa_code_generation.t
+
+    val perform_spilling :
+         ctx
+      -> [ `Function | `Instr of Code.Var.t | `Block of Code.Addr.t ]
+      -> unit Wa_code_generation.t
+
+    val kill_variables : ctx -> unit
+
+    val assign : ctx -> Code.Var.t -> unit Wa_code_generation.t
+
+    val adjust_stack :
+      ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> unit Wa_code_generation.t
+
+    val stack_adjustment_needed : ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> bool
+  end
+
   module Memory : sig
     val allocate :
-      tag:int -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list -> expression
+         Stack.ctx
+      -> Code.Var.t
+      -> tag:int
+      -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list
+      -> expression
 
     val load_function_pointer :
       arity:int -> expression -> Wa_ast.expression Wa_code_generation.t
@@ -85,6 +139,7 @@ module type S = sig
     val translate :
          context:Wa_code_generation.context
       -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+      -> stack_ctx:Stack.ctx
       -> Code.Var.t
       -> expression
 
@@ -95,7 +150,9 @@ module type S = sig
       -> unit Wa_code_generation.t
 
     val curry_allocate :
-         arity:int
+         stack_ctx:Stack.ctx
+      -> x:Code.Var.t
+      -> arity:int
       -> int
       -> f:Wa_ast.symbol
       -> closure:Code.Var.t

From 5a25ace0c5a295b9c5f52f0b660547dc67f84ae8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 13 Apr 2023 15:59:51 +0200
Subject: [PATCH 010/481] Disable mutual tail call optimization for now

---
 compiler/lib/driver.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index e0561b9c6e..f5d8cc8fa2 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -581,7 +581,7 @@ let full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map formatter d p
        | O3 -> o3)
     +> exact_calls profile
     +> effects
-    +> map_fst (Generate_closure.f +> deadcode')
+    +> map_fst (*Generate_closure.f +>*) deadcode'
   in
   let emit =
     generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone

From e0b475a4bf5481c4c139f8fbeb79aef60ee9eb53 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 13 Apr 2023 16:43:26 +0200
Subject: [PATCH 011/481] Wasm AST: additional features

---
 compiler/lib/wasm/wa_asm_output.ml | 831 +++++++++++++++++------------
 compiler/lib/wasm/wa_ast.ml        |  71 +++
 2 files changed, 550 insertions(+), 352 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 8d2e1e3235..315e191d57 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -17,6 +17,8 @@ module PP : sig
 
   val separate_map : t -> ('a -> t) -> 'a list -> t
 
+  val delayed : (unit -> t) -> t
+
   val to_channel : out_channel -> t -> unit
 
   (*  val to_buffer : Buffer.t -> t -> unit *)
@@ -57,6 +59,8 @@ end = struct
         f x st)
       l
 
+  let delayed f st = f () st
+
   let to_channel ch doc = doc { indent = 0; output = output_substring ch }
 
   (*
@@ -65,358 +69,481 @@ end = struct
   *)
 end
 
-open PP
-open Wa_ast
-
-let value_type (t : value_type) =
-  string
-    (match t with
-    | I32 -> "i32"
-    | I64 -> "i64"
-    | F64 -> "f64")
-
-let func_type { params; result } =
-  assert (List.length result <= 1);
-  string "("
-  ^^ separate_map (string ", ") value_type params
-  ^^ string ") -> ("
-  ^^ separate_map (string ", ") value_type result
-  ^^ string ")"
-
-let block_type ty =
-  match ty with
-  | { params = []; result = [] } -> empty
-  | { params = []; result = [ res ] } -> string " " ^^ value_type res
-  | _ -> assert false
-
-let type_prefix op =
-  match op with
-  | I32 _ -> string "i32."
-  | I64 _ -> string "i64."
-  | F64 _ -> string "f64."
-
-let int_un_op op =
-  match op with
-  | Clz -> "clz"
-  | Ctz -> "ctz"
-  | Popcnt -> "popcnt"
-  | Eqz -> "eqz"
-
-let signage op (s : Wa_ast.signage) =
-  op
-  ^
-  match s with
-  | S -> "_s"
-  | U -> "_u"
-
-let int_bin_op (op : int_bin_op) =
-  match op with
-  | Add -> "add"
-  | Sub -> "sub"
-  | Mul -> "mul"
-  | Div s -> signage "div" s
-  | Rem s -> signage "rem" s
-  | And -> "and"
-  | Or -> "or"
-  | Xor -> "xor"
-  | Shl -> "shl"
-  | Shr s -> signage "shr" s
-  | Rotl -> "rotl"
-  | Rotr -> "rotr"
-  | Eq -> "eq"
-  | Ne -> "ne"
-  | Lt s -> signage "lt" s
-  | Gt s -> signage "gt" s
-  | Le s -> signage "le" s
-  | Ge s -> signage "ge" s
-
-let float_un_op op =
-  match op with
-  | Neg -> "neg"
-  | Abs -> "abs"
-  | Ceil -> "ceil"
-  | Floor -> "floor"
-  | Trunc -> "trunc"
-  | Nearest -> "nearest"
-  | Sqrt -> "sqrt"
-
-let float_bin_op op =
-  match op with
-  | Add -> "add"
-  | Sub -> "sub"
-  | Mul -> "mul"
-  | Div -> "div"
-  | Min -> "min"
-  | Max -> "max"
-  | CopySign -> "copysign"
-  | Eq -> "eq"
-  | Ne -> "ne"
-  | Lt -> "lt"
-  | Gt -> "gt"
-  | Le -> "le"
-  | Ge -> "ge"
-
-let select i32 i64 f64 op =
-  match op with
-  | I32 x -> i32 x
-  | I64 x -> i64 x
-  | F64 x -> f64 x
-
-let integer i = string (string_of_int i)
-
-let integer32 i =
-  string
-    (if Poly.(i > -10000l && i < 10000l)
-     then Int32.to_string i
-     else Printf.sprintf "0x%lx" i)
-
-let integer64 i =
-  string
-    (if Poly.(i > -10000L && i < 10000L)
-     then Int64.to_string i
-     else Printf.sprintf "0x%Lx" i)
-
-let symbol name offset =
-  string
-    (match name with
-    | V name -> Code.Var.to_string name
-    | S name -> name)
-  ^^
-  if offset = 0
-  then empty
-  else (if offset < 0 then empty else string "+") ^^ integer offset
-
-let rec expression e =
-  match e with
-  | Const op ->
-      line
-        (type_prefix op
-        ^^ string "const "
-        ^^ select integer32 integer64 (fun f -> string (string_of_float f (*ZZZ*))) op)
-  | ConstSym (name, offset) ->
-      line (type_prefix (I32 ()) ^^ string "const " ^^ symbol name offset)
-  | UnOp (op, e') ->
-      expression e'
-      ^^ line (type_prefix op ^^ string (select int_un_op int_un_op float_un_op op))
-  | BinOp (op, e1, e2) ->
-      expression e1
-      ^^ expression e2
-      ^^ line (type_prefix op ^^ string (select int_bin_op int_bin_op float_bin_op op))
-  | Load (offset, e') ->
-      expression e'
-      ^^ line
-           (type_prefix offset
-           ^^ string "load "
-           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
-  | Load8 (s, offset, e') ->
-      expression e'
-      ^^ line
-           (type_prefix offset
-           ^^ string (signage "load8" s)
-           ^^ string " "
-           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
-  | LocalGet i -> line (string "local.get " ^^ integer i)
-  | LocalTee (i, e') -> expression e' ^^ line (string "local.tee " ^^ integer i)
-  | GlobalGet nm -> line (string "global.get " ^^ symbol nm 0)
-  | Call_indirect (typ, f, l) ->
-      concat_map expression l
-      ^^ expression f
-      ^^ line (string "call_indirect " ^^ func_type typ)
-  | Call (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
-  | MemoryGrow (mem, e) -> expression e ^^ line (string "memory.grow " ^^ integer mem)
-  | Seq (l, e') -> concat_map instruction l ^^ expression e'
-  | Pop _ -> empty
-
-and instruction i =
-  match i with
-  | Drop e -> expression e ^^ line (string "drop")
-  | Store (offset, e, e') ->
-      expression e
-      ^^ expression e'
-      ^^ line
-           (type_prefix offset
-           ^^ string "store "
-           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
-  | Store8 (s, offset, e, e') ->
-      expression e
-      ^^ expression e'
-      ^^ line
-           (type_prefix offset
-           ^^ string (signage "store8" s)
-           ^^ string " "
-           ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
-  | LocalSet (i, e) -> expression e ^^ line (string "local.set " ^^ integer i)
-  | GlobalSet (nm, e) -> expression e ^^ line (string "global.set " ^^ symbol nm 0)
-  | Loop (ty, l) ->
-      line (string "loop" ^^ block_type ty)
-      ^^ indent (concat_map instruction l)
-      ^^ line (string "end_loop")
-  | Block (ty, l) ->
-      line (string "block" ^^ block_type ty)
-      ^^ indent (concat_map instruction l)
-      ^^ line (string "end_block")
-  | If (ty, e, l1, l2) ->
-      expression e
-      ^^ line (string "if" ^^ block_type ty)
-      ^^ indent (concat_map instruction l1)
-      ^^ line (string "else")
-      ^^ indent (concat_map instruction l2)
-      ^^ line (string "end_if")
-  | Br_table (e, l, i) ->
-      expression e
-      ^^ line
-           (string "br_table {"
-           ^^ separate_map (string ", ") integer (l @ [ i ])
-           ^^ string "}")
-  | Br (i, Some e) -> expression e ^^ instruction (Br (i, None))
-  | Br (i, None) -> line (string "br " ^^ integer i)
-  | Return (Some e) -> expression e ^^ instruction (Return None)
-  | Return None -> line (string "return")
-  | CallInstr (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
-  | Nop -> empty
-  | Push e -> expression e
-
-let escape_string s =
-  let b = Buffer.create (String.length s + 2) in
-  for i = 0 to String.length s - 1 do
-    let c = s.[i] in
-    if Poly.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\')
-    then Buffer.add_char b c
-    else Printf.bprintf b "\\x%02x" (Char.code c)
-  done;
-  Buffer.contents b
-
-let section_header kind name =
-  line
-    (string ".section ." ^^ string kind ^^ string "." ^^ string name ^^ string ",\"\",@")
+module Feature : sig
+  type set
 
-let f fields =
-  List.iter
-    ~f:(fun f ->
-      match f with
-      | Import { name; _ } -> Var_printer.add_reserved name
-      | Function _ | Data _ | Global _ -> ())
-    fields;
-  to_channel stdout
-  @@
-  let types =
-    List.filter_map
-      ~f:(fun f ->
-        match f with
-        | Function { name; typ; _ } -> Some (Code.Var.to_string name, typ)
-        | Import { name; desc = Fun typ } -> Some (name, typ)
-        | Data _ | Global _ -> None)
-      fields
-  in
-  let globals =
-    List.filter_map
-      ~f:(fun f ->
-        match f with
-        | Function _ | Import _ | Data _ -> None
-        | Global { name; typ; init } ->
-            assert (Poly.equal init (Const (I32 0l)));
-            Some (name, typ))
-      fields
-  in
-  let define_symbol name =
-    line (string ".hidden " ^^ string name) ^^ line (string ".globl " ^^ string name)
-  in
-  let declare_global name { mut; typ } =
+  val make : unit -> set
+
+  val get : set -> string list
+
+  type t
+
+  val register : set -> string -> t
+
+  val require : t -> unit
+end = struct
+  type t = string * bool ref
+
+  type set = t list ref
+
+  let make () = ref []
+
+  let get l = !l |> List.filter ~f:(fun (_, b) -> !b) |> List.map ~f:fst
+
+  let register l name =
+    let f = name, ref false in
+    l := f :: !l;
+    f
+
+  let require (_, b) = b := true
+end
+
+module Output () = struct
+  open PP
+  open Wa_ast
+
+  let features = Feature.make ()
+
+  let exception_handling = Feature.register features "exception-handling"
+
+  let tail_call = Feature.register features "tail-call"
+
+  let value_type (t : value_type) =
+    string
+      (match t with
+      | I32 -> "i32"
+      | I64 -> "i64"
+      | F64 -> "f64"
+      | Ref _ -> assert false (* Not supported*))
+
+  let func_type { params; result } =
+    assert (List.length result <= 1);
+    string "("
+    ^^ separate_map (string ", ") value_type params
+    ^^ string ") -> ("
+    ^^ separate_map (string ", ") value_type result
+    ^^ string ")"
+
+  let block_type ty =
+    match ty with
+    | { params = []; result = [] } -> empty
+    | { params = []; result = [ res ] } -> string " " ^^ value_type res
+    | _ -> assert false
+
+  let type_prefix op =
+    match op with
+    | I32 _ -> string "i32."
+    | I64 _ -> string "i64."
+    | F64 _ -> string "f64."
+
+  let int_un_op op =
+    match op with
+    | Clz -> "clz"
+    | Ctz -> "ctz"
+    | Popcnt -> "popcnt"
+    | Eqz -> "eqz"
+
+  let signage op (s : Wa_ast.signage) =
+    op
+    ^
+    match s with
+    | S -> "_s"
+    | U -> "_u"
+
+  let int_bin_op (op : int_bin_op) =
+    match op with
+    | Add -> "add"
+    | Sub -> "sub"
+    | Mul -> "mul"
+    | Div s -> signage "div" s
+    | Rem s -> signage "rem" s
+    | And -> "and"
+    | Or -> "or"
+    | Xor -> "xor"
+    | Shl -> "shl"
+    | Shr s -> signage "shr" s
+    | Rotl -> "rotl"
+    | Rotr -> "rotr"
+    | Eq -> "eq"
+    | Ne -> "ne"
+    | Lt s -> signage "lt" s
+    | Gt s -> signage "gt" s
+    | Le s -> signage "le" s
+    | Ge s -> signage "ge" s
+
+  let float_un_op op =
+    match op with
+    | Neg -> "neg"
+    | Abs -> "abs"
+    | Ceil -> "ceil"
+    | Floor -> "floor"
+    | Trunc -> "trunc"
+    | Nearest -> "nearest"
+    | Sqrt -> "sqrt"
+
+  let float_bin_op op =
+    match op with
+    | Add -> "add"
+    | Sub -> "sub"
+    | Mul -> "mul"
+    | Div -> "div"
+    | Min -> "min"
+    | Max -> "max"
+    | CopySign -> "copysign"
+    | Eq -> "eq"
+    | Ne -> "ne"
+    | Lt -> "lt"
+    | Gt -> "gt"
+    | Le -> "le"
+    | Ge -> "ge"
+
+  let select i32 i64 f64 op =
+    match op with
+    | I32 x -> i32 x
+    | I64 x -> i64 x
+    | F64 x -> f64 x
+
+  let integer i = string (string_of_int i)
+
+  let integer32 i =
+    string
+      (if Poly.(i > -10000l && i < 10000l)
+       then Int32.to_string i
+       else Printf.sprintf "0x%lx" i)
+
+  let integer64 i =
+    string
+      (if Poly.(i > -10000L && i < 10000L)
+       then Int64.to_string i
+       else Printf.sprintf "0x%Lx" i)
+
+  let symbol name offset =
+    string
+      (match name with
+      | V name -> Code.Var.to_string name
+      | S name -> name)
+    ^^
+    if offset = 0
+    then empty
+    else (if offset < 0 then empty else string "+") ^^ integer offset
+
+  let rec expression e =
+    match e with
+    | Const op ->
+        line
+          (type_prefix op
+          ^^ string "const "
+          ^^ select integer32 integer64 (fun f -> string (string_of_float f (*ZZZ*))) op)
+    | ConstSym (name, offset) ->
+        line (type_prefix (I32 ()) ^^ string "const " ^^ symbol name offset)
+    | UnOp (op, e') ->
+        expression e'
+        ^^ line (type_prefix op ^^ string (select int_un_op int_un_op float_un_op op))
+    | BinOp (op, e1, e2) ->
+        expression e1
+        ^^ expression e2
+        ^^ line (type_prefix op ^^ string (select int_bin_op int_bin_op float_bin_op op))
+    | Load (offset, e') ->
+        expression e'
+        ^^ line
+             (type_prefix offset
+             ^^ string "load "
+             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+    | Load8 (s, offset, e') ->
+        expression e'
+        ^^ line
+             (type_prefix offset
+             ^^ string (signage "load8" s)
+             ^^ string " "
+             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+    | LocalGet i -> line (string "local.get " ^^ integer i)
+    | LocalTee (i, e') -> expression e' ^^ line (string "local.tee " ^^ integer i)
+    | GlobalGet nm -> line (string "global.get " ^^ symbol nm 0)
+    | Call_indirect (typ, f, l) ->
+        concat_map expression l
+        ^^ expression f
+        ^^ line (string "call_indirect " ^^ func_type typ)
+    | Call (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
+    | MemoryGrow (mem, e) -> expression e ^^ line (string "memory.grow " ^^ integer mem)
+    | Seq (l, e') -> concat_map instruction l ^^ expression e'
+    | Pop _ -> empty
+    | RefFunc _
+    | Call_ref _
+    | I31New _
+    | I31Get _
+    | ArrayNew _
+    | ArrayNewFixed _
+    | ArrayNewData _
+    | ArrayGet _
+    | ArrayLen _
+    | StructNew _
+    | StructGet _
+    | RefCast _
+    | RefTest _
+    | RefEq _
+    | RefNull
+    | ExternExternalize _
+    | ExternInternalize _ -> assert false (* Not supported *)
+
+  and instruction i =
+    match i with
+    | Drop e -> expression e ^^ line (string "drop")
+    | Store (offset, e, e') ->
+        expression e
+        ^^ expression e'
+        ^^ line
+             (type_prefix offset
+             ^^ string "store "
+             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+    | Store8 (s, offset, e, e') ->
+        expression e
+        ^^ expression e'
+        ^^ line
+             (type_prefix offset
+             ^^ string (signage "store8" s)
+             ^^ string " "
+             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+    | LocalSet (i, e) -> expression e ^^ line (string "local.set " ^^ integer i)
+    | GlobalSet (nm, e) -> expression e ^^ line (string "global.set " ^^ symbol nm 0)
+    | Loop (ty, l) ->
+        line (string "loop" ^^ block_type ty)
+        ^^ indent (concat_map instruction l)
+        ^^ line (string "end_loop")
+    | Block (ty, l) ->
+        line (string "block" ^^ block_type ty)
+        ^^ indent (concat_map instruction l)
+        ^^ line (string "end_block")
+    | If (ty, e, l1, l2) ->
+        expression e
+        ^^ line (string "if" ^^ block_type ty)
+        ^^ indent (concat_map instruction l1)
+        ^^ line (string "else")
+        ^^ indent (concat_map instruction l2)
+        ^^ line (string "end_if")
+    | Br_table (e, l, i) ->
+        expression e
+        ^^ line
+             (string "br_table {"
+             ^^ separate_map (string ", ") integer (l @ [ i ])
+             ^^ string "}")
+    | Br (i, Some e) -> expression e ^^ instruction (Br (i, None))
+    | Br (i, None) -> line (string "br " ^^ integer i)
+    | Return (Some e) -> expression e ^^ instruction (Return None)
+    | Return None -> line (string "return")
+    | CallInstr (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
+    | Nop -> empty
+    | Push e -> expression e
+    | Try (ty, body, catches, catch_all) ->
+        Feature.require exception_handling;
+        line (string "try" ^^ block_type ty)
+        ^^ indent (concat_map instruction body)
+        ^^ concat_map
+             (fun (tag, l) ->
+               line (string "catch " ^^ string tag) ^^ indent (concat_map instruction l))
+             catches
+        ^^ (match catch_all with
+           | None -> empty
+           | Some l -> line (string "catch_all") ^^ indent (concat_map instruction l))
+        ^^ line (string "end_try")
+    | Throw (i, e) ->
+        Feature.require exception_handling;
+        expression e ^^ line (string "throw " ^^ symbol (S i) 0)
+    | Rethrow i ->
+        Feature.require exception_handling;
+        line (string "rethrow " ^^ integer i)
+    | Return_call_indirect (typ, f, l) ->
+        Feature.require tail_call;
+        concat_map expression l
+        ^^ expression f
+        ^^ line (string "return_call_indirect " ^^ func_type typ)
+    | Return_call (x, l) ->
+        Feature.require tail_call;
+        concat_map expression l ^^ line (string "return_call " ^^ symbol x 0)
+    | ArraySet _ | StructSet _ | Br_on_cast _ | Br_on_cast_fail _ | Return_call_ref _ ->
+        assert false (* Not supported *)
+
+  let escape_string s =
+    let b = Buffer.create (String.length s + 2) in
+    for i = 0 to String.length s - 1 do
+      let c = s.[i] in
+      if Poly.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\')
+      then Buffer.add_char b c
+      else Printf.bprintf b "\\x%02x" (Char.code c)
+    done;
+    Buffer.contents b
+
+  let section_header kind name =
     line
-      (string ".globaltype "
-      ^^ symbol name 0
-      ^^ string ", "
-      ^^ value_type typ
-      ^^ if mut then empty else string ", immutable")
-  in
-  let declare_func_type name typ =
-    line (string ".functype " ^^ string name ^^ string " " ^^ func_type typ)
-  in
-  let data_sections =
-    concat_map
-      (fun f ->
-        match f with
-        | Function _ | Import _ -> empty
-        | Data { name; read_only; active; contents } ->
-            assert active;
-            (* Not supported *)
-            let name = Code.Var.to_string name in
-            let size =
-              List.fold_left
-                ~init:0
-                ~f:(fun s d ->
-                  s
-                  +
-                  match d with
-                  | DataI8 _ -> 1
-                  | DataI32 _ | DataSym _ -> 4
-                  | DataI64 _ -> 8
-                  | DataBytes b -> String.length b
-                  | DataSpace n -> n)
-                contents
-            in
-            indent
-              (section_header (if read_only then "rodata" else "data") name
-              ^^ define_symbol name
-              ^^ line (string ".p2align 2")
-              ^^ line (string ".size " ^^ string name ^^ string ", " ^^ integer size))
-            ^^ line (string name ^^ string ":")
-            ^^ indent
-                 (concat_map
-                    (fun d ->
-                      line
-                        (match d with
-                        | DataI8 i -> string ".int8 " ^^ integer i
-                        | DataI32 i -> string ".int32 " ^^ integer32 i
-                        | DataI64 i -> string ".int64 " ^^ integer64 i
-                        | DataBytes b ->
-                            string ".ascii \"" ^^ string (escape_string b) ^^ string "\""
-                        | DataSym (name, offset) -> string ".int32 " ^^ symbol name offset
-                        | DataSpace n -> string ".space " ^^ integer n))
-                    contents)
-        | Global { name; _ } ->
-            let name =
-              match name with
-              | V name -> Code.Var.to_string name
-              | S name -> name
-            in
-            indent (section_header "data" name ^^ define_symbol name)
-            ^^ line (string name ^^ string ":"))
-      fields
-  in
-  let function_section =
-    concat_map
-      (fun f ->
+      (string ".section ." ^^ string kind ^^ string "." ^^ string name ^^ string ",\"\",@")
+
+  let vector l =
+    line (string ".int8 " ^^ integer (List.length l)) ^^ concat_map (fun x -> x) l
+
+  let len_string s =
+    line (string ".int8 " ^^ integer (String.length s))
+    ^^ line (string ".ascii \"" ^^ string (escape_string s) ^^ string "\"")
+
+  let target_features =
+    delayed
+    @@ fun () ->
+    indent
+      (section_header "custom_section" "target_features"
+      ^^ vector
+           (List.map
+              ~f:(fun f -> line (string ".ascii \"+\"") ^^ len_string f)
+              (Feature.get features)))
+
+  let f fields =
+    List.iter
+      ~f:(fun f ->
         match f with
-        | Function { name; exported_name; typ; locals; body } ->
-            let name = Code.Var.to_string name in
-            indent
-              (section_header "text" name
-              ^^ define_symbol name
-              ^^
-              match exported_name with
-              | None -> empty
-              | Some exported_name ->
-                  line
-                    (string ".export_name "
-                    ^^ string name
-                    ^^ string ","
-                    ^^ string exported_name))
-            ^^ line (string name ^^ string ":")
-            ^^ indent
-                 (declare_func_type name typ
-                 ^^ (if List.is_empty locals
-                     then empty
-                     else
-                       line
-                         (string ".local " ^^ separate_map (string ", ") value_type locals))
-                 ^^ concat_map instruction body
-                 ^^ line (string "end_function"))
-        | Import _ | Data _ | Global _ -> empty)
-      fields
-  in
-  indent
-    (concat_map (fun (name, typ) -> declare_global name typ) globals
-    ^^ concat_map (fun (name, typ) -> declare_func_type name typ) types)
-  ^^ function_section
-  ^^ data_sections
+        | Import { name; _ } -> Var_printer.add_reserved name
+        | Function _ | Data _ | Global _ | Tag _ | Type _ -> ())
+      fields;
+    to_channel stdout
+    @@
+    let types =
+      List.filter_map
+        ~f:(fun f ->
+          match f with
+          | Function { name; typ; _ } -> Some (Code.Var.to_string name, typ)
+          | Import { name; desc = Fun typ } -> Some (name, typ)
+          | Data _ | Global _ | Tag _ | Type _ -> None)
+        fields
+    in
+    let globals =
+      List.filter_map
+        ~f:(fun f ->
+          match f with
+          | Function _ | Import _ | Data _ | Tag _ | Type _ -> None
+          | Global { name; typ; init } ->
+              assert (Poly.equal init (Const (I32 0l)));
+              Some (name, typ))
+        fields
+    in
+    let tags =
+      List.filter_map
+        ~f:(fun f ->
+          match f with
+          | Function _ | Import _ | Data _ | Global _ | Type _ -> None
+          | Tag { name; typ } ->
+              Feature.require exception_handling;
+              Some (name, typ))
+        fields
+    in
+    let define_symbol name =
+      line (string ".hidden " ^^ string name) ^^ line (string ".globl " ^^ string name)
+    in
+    let declare_global name { mut; typ } =
+      line
+        (string ".globaltype "
+        ^^ symbol name 0
+        ^^ string ", "
+        ^^ value_type typ
+        ^^ if mut then empty else string ", immutable")
+    in
+    let declare_tag name typ =
+      line (string ".tagtype " ^^ symbol name 0 ^^ string " " ^^ value_type typ)
+    in
+    let declare_func_type name typ =
+      line (string ".functype " ^^ string name ^^ string " " ^^ func_type typ)
+    in
+    let data_sections =
+      concat_map
+        (fun f ->
+          match f with
+          | Function _ | Import _ | Type _ -> empty
+          | Data { name; read_only; active; contents } ->
+              assert active;
+              (* Not supported *)
+              let name = Code.Var.to_string name in
+              let size =
+                List.fold_left
+                  ~init:0
+                  ~f:(fun s d ->
+                    s
+                    +
+                    match d with
+                    | DataI8 _ -> 1
+                    | DataI32 _ | DataSym _ -> 4
+                    | DataI64 _ -> 8
+                    | DataBytes b -> String.length b
+                    | DataSpace n -> n)
+                  contents
+              in
+              indent
+                (section_header (if read_only then "rodata" else "data") name
+                ^^ define_symbol name
+                ^^ line (string ".p2align 2")
+                ^^ line (string ".size " ^^ string name ^^ string ", " ^^ integer size))
+              ^^ line (string name ^^ string ":")
+              ^^ indent
+                   (concat_map
+                      (fun d ->
+                        line
+                          (match d with
+                          | DataI8 i -> string ".int8 " ^^ integer i
+                          | DataI32 i -> string ".int32 " ^^ integer32 i
+                          | DataI64 i -> string ".int64 " ^^ integer64 i
+                          | DataBytes b ->
+                              string ".ascii \""
+                              ^^ string (escape_string b)
+                              ^^ string "\""
+                          | DataSym (name, offset) ->
+                              string ".int32 " ^^ symbol name offset
+                          | DataSpace n -> string ".space " ^^ integer n))
+                      contents)
+          | Global { name; _ } | Tag { name; _ } ->
+              let name =
+                match name with
+                | V name -> Code.Var.to_string name
+                | S name -> name
+              in
+              indent (section_header "data" name ^^ define_symbol name)
+              ^^ line (string name ^^ string ":"))
+        fields
+    in
+    let function_section =
+      concat_map
+        (fun f ->
+          match f with
+          | Function { name; exported_name; typ; locals; body } ->
+              let name = Code.Var.to_string name in
+              indent
+                (section_header "text" name
+                ^^ define_symbol name
+                ^^
+                match exported_name with
+                | None -> empty
+                | Some exported_name ->
+                    line
+                      (string ".export_name "
+                      ^^ string name
+                      ^^ string ","
+                      ^^ string exported_name))
+              ^^ line (string name ^^ string ":")
+              ^^ indent
+                   (declare_func_type name typ
+                   ^^ (if List.is_empty locals
+                       then empty
+                       else
+                         line
+                           (string ".local "
+                           ^^ separate_map (string ", ") value_type locals))
+                   ^^ concat_map instruction body
+                   ^^ line (string "end_function"))
+          | Import _ | Data _ | Global _ | Tag _ | Type _ -> empty)
+        fields
+    in
+    indent
+      (concat_map (fun (name, typ) -> declare_global name typ) globals
+      ^^ concat_map (fun (name, typ) -> declare_func_type name typ) types
+      ^^ concat_map (fun (name, typ) -> declare_tag name typ) tags)
+    ^^ function_section
+    ^^ data_sections
+    ^^ target_features
+end
+
+let f fields =
+  let module O = Output () in
+  O.f fields
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 81535bdf16..4ac127dbc1 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -4,16 +4,39 @@ type symbol =
   | V of var
   | S of string
 
+type packed_type =
+  | I8
+  | I16
+
+type heap_type =
+  | Func
+  | Extern
+  | Eq
+  | I31
+  | Type of var
+
+type ref_type =
+  { nullable : bool
+  ; typ : heap_type
+  }
+
 type value_type =
   | I32
   | I64
   | F64
+  | Ref of ref_type
+
+type storage_type =
+  | Value of value_type
+  | Packed of packed_type
 
 type 'typ mut_type =
   { mut : bool
   ; typ : 'typ
   }
 
+type field_type = storage_type mut_type
+
 type global_type = value_type mut_type
 
 type func_type =
@@ -21,6 +44,11 @@ type func_type =
   ; result : value_type list
   }
 
+type str_type =
+  | Struct of field_type list
+  | Array of field_type
+  | Func of func_type
+
 type ('i32, 'i64, 'f64) op =
   | I32 of 'i32
   | I64 of 'i64
@@ -97,6 +125,23 @@ type expression =
   | MemoryGrow of int * expression
   | Seq of instruction list * expression
   | Pop of value_type
+  | RefFunc of symbol
+  | Call_ref of var * expression * expression list
+  | I31New of expression
+  | I31Get of signage * expression
+  | ArrayNew of var * expression * expression
+  | ArrayNewFixed of var * expression list
+  | ArrayNewData of var * var * expression * expression
+  | ArrayGet of signage option * var * expression * expression
+  | ArrayLen of expression
+  | StructNew of var * expression list
+  | StructGet of signage option * var * int * expression
+  | RefCast of ref_type * expression
+  | RefTest of ref_type * expression
+  | RefEq of expression * expression
+  | RefNull
+  | ExternInternalize of expression
+  | ExternExternalize of expression
 
 and instruction =
   | Drop of expression
@@ -113,6 +158,20 @@ and instruction =
   | CallInstr of symbol * expression list
   | Nop
   | Push of expression
+  | Try of
+      func_type
+      * instruction list
+      * (string * instruction list) list
+      * instruction list option
+  | Throw of string * expression
+  | Rethrow of int
+  | ArraySet of signage option * var * expression * expression * expression
+  | StructSet of signage option * var * int * expression * expression
+  | Br_on_cast of int * ref_type * ref_type * expression
+  | Br_on_cast_fail of int * ref_type * ref_type * expression
+  | Return_call_indirect of func_type * expression * expression list
+  | Return_call of symbol * expression list
+  | Return_call_ref of var * expression * expression list
 
 type import_desc = Fun of func_type
 
@@ -124,6 +183,13 @@ type data =
   | DataSym of symbol * int
   | DataSpace of int
 
+type type_field =
+  { name : var
+  ; typ : str_type
+  ; supertype : var option
+  ; final : bool
+  }
+
 type module_field =
   | Function of
       { name : var
@@ -143,7 +209,12 @@ type module_field =
       ; typ : global_type
       ; init : expression
       }
+  | Tag of
+      { name : symbol
+      ; typ : value_type
+      }
   | Import of
       { name : string
       ; desc : import_desc
       }
+  | Type of type_field list

From 8038c4325bbcd7cfaaf389489f956f89d0fbed22 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 13 Apr 2023 16:45:04 +0200
Subject: [PATCH 012/481] Assembly code output: add producer section

---
 compiler/lib/wasm/wa_asm_output.ml | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 315e191d57..48f1e451ed 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -383,6 +383,24 @@ module Output () = struct
     line (string ".int8 " ^^ integer (String.length s))
     ^^ line (string ".ascii \"" ^^ string (escape_string s) ^^ string "\"")
 
+  let producer_section =
+    delayed
+    @@ fun () ->
+    indent
+      (section_header "custom_section" "producers"
+      ^^ vector
+           [ len_string "language"
+             ^^ vector [ len_string "OCaml" ^^ len_string Sys.ocaml_version ]
+           ; len_string "processed-by"
+             ^^ vector
+                  [ len_string "wasm_of_ocaml"
+                    ^^ len_string
+                         (match Compiler_version.git_version with
+                         | "" -> Compiler_version.s
+                         | v -> Printf.sprintf "%s+git-%s" Compiler_version.s v)
+                  ]
+           ])
+
   let target_features =
     delayed
     @@ fun () ->
@@ -541,6 +559,7 @@ module Output () = struct
       ^^ concat_map (fun (name, typ) -> declare_tag name typ) tags)
     ^^ function_section
     ^^ data_sections
+    ^^ producer_section
     ^^ target_features
 end
 

From 82c20156f20238874129f68ecbf68ac2fed4e9f5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 13 Apr 2023 16:56:47 +0200
Subject: [PATCH 013/481] Generate some code for exception handling

---
 compiler/lib/wasm/wa_code_generation.ml  | 11 +++++++++++
 compiler/lib/wasm/wa_code_generation.mli |  5 +++++
 compiler/lib/wasm/wa_generate.ml         | 22 ++++++++++++++++++++--
 3 files changed, 36 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index ff641cd8e2..8724ac73c4 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -17,6 +17,7 @@ type context =
   { constants : (Var.t, W.expression) Hashtbl.t
   ; mutable data_segments : (bool * W.data list) Var.Map.t
   ; mutable other_fields : W.module_field list
+  ; mutable use_exceptions : bool
   ; mutable apply_funs : Var.t IntMap.t
   ; mutable curry_funs : Var.t IntMap.t
   }
@@ -25,6 +26,7 @@ let make_context () =
   { constants = Hashtbl.create 128
   ; data_segments = Var.Map.empty
   ; other_fields = []
+  ; use_exceptions = false
   ; apply_funs = IntMap.empty
   ; curry_funs = IntMap.empty
   }
@@ -253,6 +255,15 @@ let if_ ty e l1 l2 =
   | W.UnOp (I32 Eqz, e') -> instr (If (ty, e', instrs2, instrs1))
   | _ -> instr (If (ty, e, instrs1, instrs2))
 
+let try_ ty body exception_name handler =
+  let* body = blk body in
+  let* handler = blk handler in
+  instr (Try (ty, body, [ exception_name, handler ], None))
+
+let use_exceptions st =
+  st.context.use_exceptions <- true;
+  (), st
+
 let need_apply_fun ~arity st =
   let ctx = st.context in
   ( (try IntMap.find arity ctx.apply_funs
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 2d8bbfb243..0335e495b8 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -2,6 +2,7 @@ type context =
   { constants : (Wa_ast.var, Wa_ast.expression) Hashtbl.t
   ; mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
   ; mutable other_fields : Wa_ast.module_field list
+  ; mutable use_exceptions : bool
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable curry_funs : Code.Var.t Stdlib.IntMap.t
   }
@@ -72,6 +73,8 @@ val block : Wa_ast.func_type -> unit t -> unit t
 
 val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
+val try_ : Wa_ast.func_type -> unit t -> string -> unit t -> unit t
+
 val add_var : Wa_ast.var -> int t
 
 val define_var : Wa_ast.var -> expression -> unit t
@@ -86,6 +89,8 @@ val get_data_segment : Code.Var.t -> (bool * Wa_ast.data list) t
 
 val get_context : context t
 
+val use_exceptions : unit t
+
 val need_apply_fun : arity:int -> Code.Var.t t
 
 val need_curry_fun : arity:int -> Code.Var.t t
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 68ce1128dd..c323086095 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -181,6 +181,8 @@ let parallel_renaming params args =
       store ~always:true y (load x))
     ~init:(return ())
 
+let exception_name = "ocaml_exception"
+
 let extend_context fall_through context =
   match fall_through with
   | `Block _ as b -> b :: context
@@ -323,7 +325,21 @@ let translate_function p ctx name_opt toplevel_name params ((pc, _) as cont) acc
                         (br_table (Memory.tag (load x)) a2 context'))
             in
             nest l context
-        | Raise _ | Pushtrap _ | Poptrap _ -> return ())
+        | Raise (x, _) ->
+            let* () = use_exceptions in
+            let* e = load x in
+            instr (Throw (exception_name, e))
+        | Pushtrap (cont, x, cont', _) ->
+            let context' = extend_context fall_through context in
+            let* () = use_exceptions in
+            try_
+              { params = []; result = result_typ }
+              (translate_branch result_typ fall_through pc cont context' stack_ctx)
+              exception_name
+              (let* () = store ~always:true x (return (W.Pop Value.value)) in
+               translate_branch result_typ fall_through pc cont' context' stack_ctx)
+        | Poptrap cont ->
+            translate_branch result_typ fall_through pc cont context stack_ctx)
   and translate_branch result_typ fall_through src (dst, args) context stack_ctx =
     let* () =
       if List.is_empty args
@@ -448,7 +464,9 @@ let f
       ctx.global_context.other_fields
       (primitives @ functions @ (start_function :: constant_data))
   in
-  fields
+  if ctx.global_context.use_exceptions
+  then W.Tag { name = S exception_name; typ = Value.value } :: fields
+  else fields
 
 let f (p : Code.program) ~live_vars =
   let fields = f ~live_vars p in

From bec3f1029bff318526f63f1e3313e75fa57d40c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 19 Apr 2023 16:05:16 +0200
Subject: [PATCH 014/481] Output Wasm in text format

---
 compiler/lib/wasm/wa_wat_output.ml  | 651 ++++++++++++++++++++++++++++
 compiler/lib/wasm/wa_wat_output.mli |   1 +
 2 files changed, 652 insertions(+)
 create mode 100644 compiler/lib/wasm/wa_wat_output.ml
 create mode 100644 compiler/lib/wasm/wa_wat_output.mli

diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
new file mode 100644
index 0000000000..4a8bbc9c00
--- /dev/null
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -0,0 +1,651 @@
+open! Stdlib
+open Wa_ast
+
+let target = `Binaryen (*`Reference*)
+
+type sexp =
+  | Atom of string
+  | List of sexp list
+
+let rec format_sexp f s =
+  match s with
+  | Atom s -> Format.fprintf f "%s" s
+  | List l ->
+      Format.fprintf f "@[<2>(";
+      Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f "@ ") format_sexp f l;
+      Format.fprintf f ")@]"
+
+let index (symb : symbol) =
+  Atom
+    ("$"
+    ^
+    match symb with
+    | S s -> s
+    | V x -> Code.Var.to_string x)
+
+let heap_type (ty : heap_type) =
+  match ty with
+  | Func -> Atom "func"
+  | Extern -> Atom "extern"
+  | Eq -> Atom "eq"
+  | I31 -> Atom "i31"
+  | Type symb -> index (V symb)
+
+let ref_type' { nullable; typ } =
+  let r = [ heap_type typ ] in
+  if nullable then Atom "null" :: r else r
+
+let ref_type r = List (Atom "ref" :: ref_type' r)
+
+let value_type (t : value_type) =
+  match t with
+  | I32 -> Atom "i32"
+  | I64 -> Atom "i64"
+  | F64 -> Atom "f64"
+  | Ref ty -> ref_type ty
+
+let packed_type t =
+  match t with
+  | I8 -> Atom "i8"
+  | I16 -> Atom "i16"
+
+let list ?(always = false) name f l =
+  if (not always) && List.is_empty l then [] else [ List (Atom name :: f l) ]
+
+let value_type_list name tl = list name (fun tl -> List.map ~f:value_type tl) tl
+
+let funct_type { params; result } =
+  value_type_list "param" params @ value_type_list "result" result
+
+let storage_type typ =
+  match typ with
+  | Value typ -> value_type typ
+  | Packed typ -> packed_type typ
+
+let mut_type f { mut; typ } = if mut then List [ Atom "mut"; f typ ] else f typ
+
+let field_type typ = mut_type storage_type typ
+
+let global_type typ = mut_type value_type typ
+
+let str_type typ =
+  match typ with
+  | Func ty -> List (Atom "func" :: funct_type ty)
+  | Struct l -> (
+      match target with
+      | `Binaryen ->
+          List
+            (Atom "struct" :: List.map ~f:(fun f -> List [ Atom "field"; field_type f ]) l)
+      | `Reference ->
+          List [ Atom "struct"; List (Atom "field" :: List.map ~f:field_type l) ])
+  | Array ty -> List [ Atom "array"; field_type ty ]
+
+let block_type = funct_type
+
+let quoted_name name = Atom ("\"" ^ name ^ "\"")
+
+let export name =
+  match name with
+  | None -> []
+  | Some name -> [ List [ Atom "export"; quoted_name name ] ]
+
+let type_prefix op nm =
+  (match op with
+  | I32 _ -> "i32."
+  | I64 _ -> "i64."
+  | F64 _ -> "f64.")
+  ^ nm
+
+let int_un_op op =
+  match op with
+  | Clz -> "clz"
+  | Ctz -> "ctz"
+  | Popcnt -> "popcnt"
+  | Eqz -> "eqz"
+
+let signage op (s : Wa_ast.signage) =
+  op
+  ^
+  match s with
+  | S -> "_s"
+  | U -> "_u"
+
+let int_bin_op (op : int_bin_op) =
+  match op with
+  | Add -> "add"
+  | Sub -> "sub"
+  | Mul -> "mul"
+  | Div s -> signage "div" s
+  | Rem s -> signage "rem" s
+  | And -> "and"
+  | Or -> "or"
+  | Xor -> "xor"
+  | Shl -> "shl"
+  | Shr s -> signage "shr" s
+  | Rotl -> "rotl"
+  | Rotr -> "rotr"
+  | Eq -> "eq"
+  | Ne -> "ne"
+  | Lt s -> signage "lt" s
+  | Gt s -> signage "gt" s
+  | Le s -> signage "le" s
+  | Ge s -> signage "ge" s
+
+let float_un_op op =
+  match op with
+  | Neg -> "neg"
+  | Abs -> "abs"
+  | Ceil -> "ceil"
+  | Floor -> "floor"
+  | Trunc -> "trunc"
+  | Nearest -> "nearest"
+  | Sqrt -> "sqrt"
+
+let float_bin_op op =
+  match op with
+  | Add -> "add"
+  | Sub -> "sub"
+  | Mul -> "mul"
+  | Div -> "div"
+  | Min -> "min"
+  | Max -> "max"
+  | CopySign -> "copysign"
+  | Eq -> "eq"
+  | Ne -> "ne"
+  | Lt -> "lt"
+  | Gt -> "gt"
+  | Le -> "le"
+  | Ge -> "ge"
+
+let select i32 i64 f64 op =
+  match op with
+  | I32 x -> i32 x
+  | I64 x -> i64 x
+  | F64 x -> f64 x
+
+type ctx =
+  { addresses : int Code.Var.Map.t
+  ; constants : int StringMap.t
+  ; mutable functions : int Code.Var.Map.t
+  ; mutable function_refs : Code.Var.Set.t
+  ; mutable function_count : int
+  }
+
+let reference_function ctx (f : symbol) =
+  match f with
+  | S _ -> assert false
+  | V f -> ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
+
+let lookup_symbol ctx (symb : symbol) =
+  match symb with
+  | S nm -> (
+      try StringMap.find nm ctx.constants
+      with Not_found ->
+        prerr_endline nm;
+        assert false)
+  | V x -> (
+      try Code.Var.Map.find x ctx.addresses
+      with Not_found -> (
+        try Code.Var.Map.find x ctx.functions
+        with Not_found ->
+          let i = ctx.function_count in
+          ctx.functions <- Code.Var.Map.add x i ctx.functions;
+          ctx.function_count <- ctx.function_count + 1;
+          i))
+
+let remove_nops l = List.filter ~f:(fun i -> not (Poly.equal i Nop)) l
+
+let expression_or_instructions ctx in_function =
+  let rec expression e =
+    match e with
+    | Const op ->
+        [ List
+            [ Atom (type_prefix op "const")
+            ; Atom (select Int32.to_string Int64.to_string string_of_float (*ZZZ*) op)
+            ]
+        ]
+    | ConstSym (symb, ofs) ->
+        let i = lookup_symbol ctx symb in
+        [ List [ Atom "i32.const"; Atom (string_of_int (i + ofs)) ] ]
+    | UnOp (op, e') ->
+        [ List
+            (Atom (type_prefix op (select int_un_op int_un_op float_un_op op))
+            :: expression e')
+        ]
+    | BinOp (op, e1, e2) ->
+        [ List
+            (Atom (type_prefix op (select int_bin_op int_bin_op float_bin_op op))
+            :: (expression e1 @ expression e2))
+        ]
+    | Load (offset, e') ->
+        let offs i =
+          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
+        in
+        [ List
+            ((Atom (type_prefix offset "load") :: select offs offs offs offset)
+            @ expression e')
+        ]
+    | Load8 (s, offset, e') ->
+        let offs i =
+          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
+        in
+        [ List
+            ((Atom (type_prefix offset (signage "load" s)) :: select offs offs offs offset)
+            @ expression e')
+        ]
+    | LocalGet i -> [ List [ Atom "local.get"; Atom (string_of_int i) ] ]
+    | LocalTee (i, e') ->
+        [ List (Atom "local.tee" :: Atom (string_of_int i) :: expression e') ]
+    | GlobalGet nm -> [ List [ Atom "global.get"; index nm ] ]
+    | Call_indirect (typ, e, l) ->
+        [ List
+            ((Atom "call_indirect" :: funct_type typ)
+            @ List.concat (List.map ~f:expression (l @ [ e ])))
+        ]
+    | Call (f, l) ->
+        [ List (Atom "call" :: index f :: List.concat (List.map ~f:expression l)) ]
+    | MemoryGrow (_, e) -> [ List (Atom "memory.grow" :: expression e) ]
+    | Seq (l, e) -> instructions l @ expression e
+    | Pop ty -> (
+        match target with
+        | `Binaryen -> [ List [ Atom "pop"; value_type ty ] ]
+        | `Reference -> [])
+    | RefFunc symb ->
+        if in_function then reference_function ctx symb;
+        [ List [ Atom "ref.func"; index symb ] ]
+    | Call_ref (symb, e, l) ->
+        [ List
+            (Atom "call_ref"
+            :: index (V symb)
+            :: List.concat (List.map ~f:expression (l @ [ e ])))
+        ]
+    | I31New e -> [ List (Atom "i31.new" :: expression e) ]
+    | I31Get (s, e) -> [ List (Atom (signage "i31.get" s) :: expression e) ]
+    | ArrayNew (symb, e, e') ->
+        [ List (Atom "array.new" :: index (V symb) :: (expression e @ expression e')) ]
+    | ArrayNewFixed (symb, l) ->
+        [ List
+            (Atom "array.new_fixed"
+            :: index (V symb)
+            :: ((match target with
+                | `Binaryen -> []
+                | `Reference -> [ Atom (string_of_int (List.length l)) ])
+               @ List.concat (List.map ~f:expression l)))
+        ]
+    | ArrayNewData (symb, symb', e, e') ->
+        [ List
+            (Atom "array.new_data"
+            :: index (V symb)
+            :: index (V symb')
+            :: (expression e @ expression e'))
+        ]
+    | ArrayGet (None, symb, e, e') ->
+        [ List (Atom "array.get" :: index (V symb) :: (expression e @ expression e')) ]
+    | ArrayGet (Some s, symb, e, e') ->
+        [ List
+            (Atom (signage "array.get" s)
+            :: index (V symb)
+            :: (expression e @ expression e'))
+        ]
+    | ArrayLen e -> [ List (Atom "array.len" :: expression e) ]
+    | StructNew (symb, l) ->
+        [ List
+            (Atom "struct.new" :: index (V symb) :: List.concat (List.map ~f:expression l))
+        ]
+    | StructGet (None, symb, i, e) ->
+        [ List
+            (Atom "struct.get" :: index (V symb) :: Atom (string_of_int i) :: expression e)
+        ]
+    | StructGet (Some s, symb, i, e) ->
+        [ List
+            (Atom (signage "struct.get" s)
+            :: index (V symb)
+            :: Atom (string_of_int i)
+            :: expression e)
+        ]
+    | RefCast (ty, e) -> (
+        match target with
+        | `Binaryen -> [ List (Atom "ref.cast" :: (ref_type' ty @ expression e)) ]
+        | `Reference -> [ List (Atom "ref.cast" :: ref_type ty :: expression e) ])
+    | RefTest (ty, e) -> (
+        match target with
+        | `Binaryen -> [ List (Atom "ref.test" :: (ref_type' ty @ expression e)) ]
+        | `Reference -> [ List (Atom "ref.test" :: ref_type ty :: expression e) ])
+    | RefEq (e, e') -> [ List (Atom "ref.eq" :: (expression e @ expression e')) ]
+    | RefNull -> [ Atom "ref.null" ]
+    | ExternInternalize e -> [ List (Atom "extern.internalize" :: expression e) ]
+    | ExternExternalize e -> [ List (Atom "extern.externalize" :: expression e) ]
+  and instruction i =
+    match i with
+    | Drop e -> [ List (Atom "drop" :: expression e) ]
+    | Store (offset, e1, e2) ->
+        let offs i =
+          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
+        in
+        [ List
+            (Atom (type_prefix offset "store")
+            :: (select offs offs offs offset @ expression e1 @ expression e2))
+        ]
+    | Store8 (s, offset, e1, e2) ->
+        let offs i =
+          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
+        in
+        [ List
+            (Atom (type_prefix offset (signage "store8" s))
+            :: (select offs offs offs offset @ expression e1 @ expression e2))
+        ]
+    | LocalSet (i, Seq (l, e)) when Poly.equal target `Binaryen ->
+        instructions (l @ [ LocalSet (i, e) ])
+    | LocalSet (i, e) ->
+        [ List (Atom "local.set" :: Atom (string_of_int i) :: expression e) ]
+    | GlobalSet (nm, e) -> [ List (Atom "global.set" :: index nm :: expression e) ]
+    | Loop (ty, l) -> [ List (Atom "loop" :: (block_type ty @ instructions l)) ]
+    | Block (ty, l) -> [ List (Atom "block" :: (block_type ty @ instructions l)) ]
+    | If (ty, e, l1, l2) ->
+        [ List
+            (Atom "if"
+            :: (block_type ty
+               @ expression e
+               @ (let l1 = remove_nops l1 in
+                  if Poly.equal target `Binaryen && List.is_empty l1
+                  then [ List [ Atom "then"; Atom "nop" ] ]
+                  else list ~always:true "then" instructions l1)
+               @ list "else" instructions (remove_nops l2)))
+        ]
+    | Try (ty, body, catches, catch_all) ->
+        [ List
+            (Atom "try"
+            :: (block_type ty
+               @ List (Atom "do" :: instructions body)
+                 :: (List.map
+                       ~f:(fun (tag, l) ->
+                         List (Atom "catch" :: index (S tag) :: instructions l))
+                       catches
+                    @
+                    match catch_all with
+                    | None -> []
+                    | Some l -> [ List (Atom "catch_all" :: instructions l) ])))
+        ]
+    | Br_table (e, l, i) ->
+        [ List
+            (Atom "br_table"
+            :: (List.map ~f:(fun i -> Atom (string_of_int i)) (l @ [ i ]) @ expression e)
+            )
+        ]
+    | Br (i, e) ->
+        [ List
+            (Atom "br"
+            :: Atom (string_of_int i)
+            ::
+            (match e with
+            | None -> []
+            | Some e -> expression e))
+        ]
+    | Return e ->
+        [ List
+            (Atom "return"
+            ::
+            (match e with
+            | None -> []
+            | Some e -> expression e))
+        ]
+    | Throw (i, e) -> [ List (Atom "throw" :: index (S i) :: expression e) ]
+    | Rethrow i -> [ List [ Atom "rethrow"; Atom (string_of_int i) ] ]
+    | CallInstr (f, l) ->
+        [ List (Atom "call" :: index f :: List.concat (List.map ~f:expression l)) ]
+    | Nop -> []
+    | Push e -> expression e
+    | ArraySet (None, symb, e, e', e'') ->
+        [ List
+            (Atom "array.set"
+            :: index (V symb)
+            :: (expression e @ expression e' @ expression e''))
+        ]
+    | ArraySet (Some s, symb, e, e', e'') ->
+        [ List
+            (Atom (signage "array.set" s)
+            :: index (V symb)
+            :: (expression e @ expression e' @ expression e''))
+        ]
+    | StructSet (None, symb, i, e, e') ->
+        [ List
+            (Atom "struct.set"
+            :: index (V symb)
+            :: Atom (string_of_int i)
+            :: (expression e @ expression e'))
+        ]
+    | StructSet (Some s, symb, i, e, e') ->
+        [ List
+            (Atom (signage "struct.set" s)
+            :: index (V symb)
+            :: Atom (string_of_int i)
+            :: (expression e @ expression e'))
+        ]
+    | Br_on_cast (i, ty, ty', e) -> (
+        match target with
+        | `Binaryen ->
+            [ List
+                (Atom "br_on_cast"
+                :: Atom (string_of_int i)
+                :: (ref_type' ty' @ expression e))
+            ]
+        | `Reference ->
+            [ List
+                (Atom "br_on_cast"
+                :: Atom (string_of_int i)
+                :: ref_type ty
+                :: ref_type ty'
+                :: expression e)
+            ])
+    | Br_on_cast_fail (i, ty, ty', e) -> (
+        match target with
+        | `Binaryen ->
+            [ List
+                (Atom "br_on_cast_fail"
+                :: Atom (string_of_int i)
+                :: (ref_type' ty' @ expression e))
+            ]
+        | `Reference ->
+            [ List
+                (Atom "br_on_cast_fail"
+                :: Atom (string_of_int i)
+                :: ref_type ty
+                :: ref_type ty'
+                :: expression e)
+            ])
+    | Return_call_indirect (typ, e, l) ->
+        [ List
+            ((Atom "return_call_indirect" :: funct_type typ)
+            @ List.concat (List.map ~f:expression (l @ [ e ])))
+        ]
+    | Return_call (f, l) ->
+        [ List (Atom "return_call" :: index f :: List.concat (List.map ~f:expression l)) ]
+    | Return_call_ref (symb, e, l) ->
+        [ List
+            (Atom "return_call_ref"
+            :: index (V symb)
+            :: List.concat (List.map ~f:expression (l @ [ e ])))
+        ]
+  and instructions l = List.concat (List.map ~f:instruction l) in
+  expression, instructions
+
+let expression ctx = fst (expression_or_instructions ctx false)
+
+let instructions ctx = snd (expression_or_instructions ctx true)
+
+let funct ctx name exported_name typ locals body =
+  List
+    ((Atom "func" :: index (V name) :: export exported_name)
+    @ funct_type typ
+    @ value_type_list "local" locals
+    @ instructions ctx body)
+
+let import f =
+  match f with
+  | Function _ | Global _ | Data _ | Tag _ | Type _ -> []
+  | Import { name; desc } ->
+      [ List
+          [ Atom "import"
+          ; quoted_name "env"
+          ; quoted_name name
+          ; List
+              (match desc with
+              | Fun typ -> Atom "func" :: index (S name) :: funct_type typ)
+          ]
+      ]
+
+let escape_string s =
+  let b = Buffer.create (String.length s + 2) in
+  for i = 0 to String.length s - 1 do
+    let c = s.[i] in
+    if Poly.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\')
+    then Buffer.add_char b c
+    else Printf.bprintf b "\\%02x" (Char.code c)
+  done;
+  Buffer.contents b
+
+let data_contents ctx contents =
+  let b = Buffer.create 16 in
+  List.iter
+    ~f:(fun d ->
+      match d with
+      | DataI8 c -> Buffer.add_uint8 b c
+      | DataI32 i -> Buffer.add_int32_le b i
+      | DataI64 i -> Buffer.add_int64_le b i
+      | DataBytes s -> Buffer.add_string b s
+      | DataSym (symb, ofs) ->
+          Buffer.add_int32_le b (Int32.of_int (lookup_symbol ctx symb + ofs))
+      | DataSpace n -> Buffer.add_string b (String.make n '\000'))
+    contents;
+  escape_string (Buffer.contents b)
+
+let type_field { name; typ; supertype; final } =
+  match target with
+  | `Binaryen ->
+      List
+        (Atom "type"
+        :: index (V name)
+        :: str_type typ
+        ::
+        (match supertype with
+        | Some supertype -> [ List [ Atom "extends"; index (V supertype) ] ]
+        | None -> []))
+  | `Reference ->
+      List
+        [ Atom "type"
+        ; index (V name)
+        ; List
+            (Atom "sub"
+            :: ((if final then [ Atom "final" ] else [])
+               @ (match supertype with
+                 | Some supertype -> [ index (V supertype) ]
+                 | None -> [])
+               @ [ str_type typ ]))
+        ]
+
+let field ctx f =
+  match f with
+  | Function { name; exported_name; typ; locals; body } ->
+      [ funct ctx name exported_name typ locals body ]
+  | Global { name; typ; init } ->
+      [ List (Atom "global" :: index name :: global_type typ :: expression ctx init) ]
+  | Tag { name; typ } ->
+      [ List [ Atom "tag"; index name; List [ Atom "param"; value_type typ ] ] ]
+  | Import _ -> []
+  | Data { name; active; contents; _ } ->
+      [ List
+          (Atom "data"
+          :: index (V name)
+          :: ((if active
+               then
+                 expression ctx (Const (I32 (Int32.of_int (lookup_symbol ctx (V name)))))
+               else [])
+             @ [ Atom ("\"" ^ data_contents ctx contents ^ "\"") ]))
+      ]
+  | Type [ t ] -> [ type_field t ]
+  | Type l -> [ List (Atom "rec" :: List.map ~f:type_field l) ]
+
+let data_size contents =
+  List.fold_left
+    ~f:(fun sz d ->
+      sz
+      +
+      match d with
+      | DataI8 _ -> 1
+      | DataI32 _ -> 4
+      | DataI64 _ -> 8
+      | DataBytes s -> String.length s
+      | DataSym _ -> 4
+      | DataSpace n -> n)
+    ~init:0
+    contents
+
+let data_offsets fields =
+  List.fold_left
+    ~f:(fun (i, addresses) f ->
+      match f with
+      | Data { name; contents; active = true; _ } ->
+          i + data_size contents, Code.Var.Map.add name i addresses
+      | Function _ | Global _ | Tag _ | Import _ | Data { active = false; _ } | Type _ ->
+          i, addresses)
+    ~init:(0, Code.Var.Map.empty)
+    fields
+
+let f fields =
+  let heap_base, addresses = data_offsets fields in
+  let ctx =
+    { addresses
+    ; functions = Code.Var.Map.empty
+    ; function_refs = Code.Var.Set.empty
+    ; function_count = 0
+    ; constants = StringMap.singleton "__heap_base" heap_base
+    }
+  in
+  let other_fields = List.concat (List.map ~f:(fun f -> field ctx f) fields) in
+  let funct_table =
+    let functions =
+      List.map
+        ~f:fst
+        (List.sort
+           ~cmp:(fun (_, i) (_, j) -> compare i j)
+           (Code.Var.Map.bindings ctx.functions))
+    in
+    if List.is_empty functions
+    then []
+    else
+      [ List
+          [ Atom "table"
+          ; Atom "funcref"
+          ; List (Atom "elem" :: List.map ~f:(fun f -> index (V f)) functions)
+          ]
+      ]
+  in
+  let funct_decl =
+    let functions =
+      Code.Var.Set.elements
+        (Code.Var.Set.filter
+           (fun f -> not (Code.Var.Map.mem f ctx.functions))
+           ctx.function_refs)
+    in
+    if List.is_empty functions
+    then []
+    else
+      [ List
+          (Atom "elem"
+          :: Atom "declare"
+          :: Atom "func"
+          :: List.map ~f:(fun f -> index (V f)) functions)
+      ]
+  in
+  Format.printf
+    "%a@."
+    format_sexp
+    (List
+       (Atom "module"
+       :: (List.concat (List.map ~f:import fields)
+          @ [ List
+                [ Atom "memory"; Atom (string_of_int ((heap_base + 0xffff) / 0x10000)) ]
+            ]
+          @ funct_table
+          @ funct_decl
+          @ other_fields)))
diff --git a/compiler/lib/wasm/wa_wat_output.mli b/compiler/lib/wasm/wa_wat_output.mli
new file mode 100644
index 0000000000..a2cbc9164d
--- /dev/null
+++ b/compiler/lib/wasm/wa_wat_output.mli
@@ -0,0 +1 @@
+val f : Wa_ast.module_field list -> unit

From 2314e7c94e053ab87270049b05c8e46f7d46333e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 19 Apr 2023 16:18:47 +0200
Subject: [PATCH 015/481] More primitives

---
 compiler/lib/wasm/wa_code_generation.ml  |  6 ++++++
 compiler/lib/wasm/wa_code_generation.mli |  6 ++++++
 compiler/lib/wasm/wa_core_target.ml      |  9 +++++----
 compiler/lib/wasm/wa_generate.ml         | 17 +++++++++++++++--
 compiler/lib/wasm/wa_target_sig.ml       |  4 ++++
 5 files changed, 36 insertions(+), 6 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 8724ac73c4..7732de3049 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -151,6 +151,10 @@ module Arith = struct
 
   let ( * ) = binary Mul
 
+  let ( / ) = binary (Div S)
+
+  let ( mod ) = binary (Rem S)
+
   let ( lsl ) e e' =
     let* e = e in
     let* e' = e' in
@@ -180,6 +184,8 @@ module Arith = struct
 
   let ult = binary (Lt U)
 
+  let uge = binary (Ge U)
+
   let eqz = unary Eqz
 
   let const n = return (W.Const (I32 n))
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 0335e495b8..cb76cd6c19 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -32,6 +32,10 @@ module Arith : sig
 
   val ( * ) : expression -> expression -> expression
 
+  val ( / ) : expression -> expression -> expression
+
+  val ( mod ) : expression -> expression -> expression
+
   val ( lsl ) : expression -> expression -> expression
 
   val ( lsr ) : expression -> expression -> expression
@@ -54,6 +58,8 @@ module Arith : sig
 
   val ult : expression -> expression -> expression
 
+  val uge : expression -> expression -> expression
+
   val eqz : expression -> expression
 end
 
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 6d5b8e9748..74c0ef45d7 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -90,10 +90,7 @@ module Memory = struct
 
   let tag e = Arith.(mem_load (e - const 4l) land const 0xffl)
 
-  (*
-  let length e = Arith.(mem_load (e - const 4l) lsr const 10l)
-*)
-  let block_length e = Arith.((mem_load (e - const 4l) lsr const 9l) lor const 1l)
+  let block_length e = Arith.(mem_load (e - const 4l) lsr const 1l)
 
   let array_get e e' = mem_load Arith.(e + ((e' - const 1l) lsl const 1l))
 
@@ -150,6 +147,10 @@ module Value = struct
 
   let int_mul i i' = val_int Arith.(int_val i * int_val i')
 
+  let int_div i i' = val_int Arith.(int_val i / int_val i')
+
+  let int_mod i i' = val_int Arith.(int_val i mod int_val i')
+
   let int_neg i = Arith.(const 2l - i)
 
   let int_or i i' = Arith.(i lor i')
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index c323086095..5c25920ded 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -67,6 +67,7 @@ let rec translate_expr ctx stack_ctx x e =
   | Prim (p, l) -> (
       let l = List.map ~f:transl_prim_arg l in
       match p, l with
+      (*ZZZ array operations need to deal with array of unboxed floats *)
       | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.array_get x y
       | Extern "caml_array_unsafe_set", [ x; y; z ] ->
           seq (Memory.array_set x y z) Value.unit
@@ -78,7 +79,9 @@ let rec translate_expr ctx stack_ctx x e =
           seq (Memory.bytes_set x y z) Value.unit
       | Extern "%int_add", [ x; y ] -> Value.int_add x y
       | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
-      | Extern "%int_mul", [ x; y ] -> Value.int_mul x y
+      | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
+      | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y
+      | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
       | Extern "%int_neg", [ x ] -> Value.int_neg x
       | Extern "%int_or", [ x; y ] -> Value.int_or x y
       | Extern "%int_and", [ x; y ] -> Value.int_and x y
@@ -86,6 +89,16 @@ let rec translate_expr ctx stack_ctx x e =
       | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y
       | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
       | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
+      | Extern "caml_check_bound", [ x; y ] ->
+          let nm = "caml_array_bound_error" in
+          register_primitive ctx nm { params = []; result = [] };
+          seq
+            (if_
+               { params = []; result = [] }
+               (Arith.uge (Value.int_val y) (Memory.block_length x))
+               (instr (CallInstr (S nm, [])))
+               (return ()))
+            x
       | Extern nm, l ->
           (*ZZZ Different calling convention when large number of parameters *)
           register_primitive ctx nm (func_type (List.length l));
@@ -108,7 +121,7 @@ let rec translate_expr ctx stack_ctx x e =
       | Ult, [ x; y ] -> Value.ult x y
       | Array_get, [ x; y ] -> Memory.array_get x y
       | IsInt, [ x ] -> Value.is_int x
-      | Vectlength, [ x ] -> Memory.block_length x
+      | Vectlength, [ x ] -> Value.val_int (Memory.block_length x)
       | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
           assert false)
 
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index abbf8216c5..a26041f13c 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -116,6 +116,10 @@ module type S = sig
 
     val int_mul : expression -> expression -> expression
 
+    val int_div : expression -> expression -> expression
+
+    val int_mod : expression -> expression -> expression
+
     val int_neg : expression -> expression
 
     val int_or : expression -> expression -> expression

From cdcafa20c7257e59280a0a73c14eceb512af0dab Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 19 Apr 2023 18:53:49 +0200
Subject: [PATCH 016/481] Target the GC proposal

---
 compiler/lib/wasm/wa_code_generation.ml  | 149 +++-
 compiler/lib/wasm/wa_code_generation.mli |  51 +-
 compiler/lib/wasm/wa_core_target.ml      |  11 +-
 compiler/lib/wasm/wa_curry.ml            |  62 +-
 compiler/lib/wasm/wa_gc_target.ml        | 657 ++++++++++++++++
 compiler/lib/wasm/wa_gc_target.mli       |   1 +
 compiler/lib/wasm/wa_generate.ml         | 935 ++++++++++++-----------
 compiler/lib/wasm/wa_target_sig.ml       |  14 +-
 8 files changed, 1363 insertions(+), 517 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_gc_target.ml
 create mode 100644 compiler/lib/wasm/wa_gc_target.mli

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 7732de3049..f8f3d5f928 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -13,26 +13,40 @@ https://github.com/llvm/llvm-project/issues/58438
 (* binaryen does not support block input parameters
    https://github.com/WebAssembly/binaryen/issues/5047 *)
 
+type constant_global =
+  { init : W.expression option
+  ; constant : bool
+  }
+
 type context =
   { constants : (Var.t, W.expression) Hashtbl.t
   ; mutable data_segments : (bool * W.data list) Var.Map.t
+  ; mutable constant_globals : constant_global Var.Map.t
   ; mutable other_fields : W.module_field list
+  ; types : (string, Var.t) Hashtbl.t
+  ; mutable closure_envs : Var.t Var.Map.t
+        (** GC: mapping of recursive functions to their shared environment *)
   ; mutable use_exceptions : bool
   ; mutable apply_funs : Var.t IntMap.t
   ; mutable curry_funs : Var.t IntMap.t
+  ; mutable init_code : W.instruction list
   }
 
 let make_context () =
   { constants = Hashtbl.create 128
   ; data_segments = Var.Map.empty
+  ; constant_globals = Var.Map.empty
   ; other_fields = []
+  ; types = Hashtbl.create 128
+  ; closure_envs = Var.Map.empty
   ; use_exceptions = false
   ; apply_funs = IntMap.empty
   ; curry_funs = IntMap.empty
+  ; init_code = []
   }
 
 type var =
-  | Local of int
+  | Local of int * W.value_type option
   | Expr of W.expression t
 
 and state =
@@ -75,26 +89,86 @@ let register_constant x e st =
   Hashtbl.add st.context.constants x e;
   (), st
 
-let register_global name typ init st =
-  st.context.other_fields <-
-    W.Global { name = S name; typ; init } :: st.context.other_fields;
+type type_def =
+  { supertype : Wa_ast.var option
+  ; final : bool
+  ; typ : Wa_ast.str_type
+  }
+
+let register_type nm gen_typ st =
+  let context = st.context in
+  let { supertype; final; typ }, st = gen_typ () st in
+  ( (try Hashtbl.find context.types nm
+     with Not_found ->
+       let name = Var.fresh_n nm in
+       context.other_fields <-
+         Type [ { name; typ; supertype; final } ] :: context.other_fields;
+       Hashtbl.add context.types nm name;
+       name)
+  , st )
+
+let register_global name ?(constant = false) typ init st =
+  st.context.other_fields <- W.Global { name; typ; init } :: st.context.other_fields;
+  (match name with
+  | S _ -> ()
+  | V nm ->
+      st.context.constant_globals <-
+        Var.Map.add
+          nm
+          { init = (if not typ.mut then Some init else None)
+          ; constant = (not typ.mut) || constant
+          }
+          st.context.constant_globals);
+  (), st
+
+let global_is_constant name =
+  let* ctx = get_context in
+  return
+    (match Var.Map.find_opt name ctx.constant_globals with
+    | Some { constant = true; _ } -> true
+    | _ -> false)
+
+let get_global (name : Wa_ast.symbol) =
+  match name with
+  | S _ -> return None
+  | V name ->
+      let* ctx = get_context in
+      return
+        (match Var.Map.find_opt name ctx.constant_globals with
+        | Some { init; _ } -> init
+        | _ -> None)
+
+let register_init_code code st =
+  let st' = { var_count = 0; vars = Var.Map.empty; instrs = []; context = st.context } in
+  let (), st' = code st' in
+  st.context.init_code <- st'.instrs @ st.context.init_code;
   (), st
 
+let set_closure_env f env st =
+  st.context.closure_envs <- Var.Map.add f env st.context.closure_envs;
+  (), st
+
+let get_closure_env f st = Var.Map.find f st.context.closure_envs, st
+
+let is_closure f st = Var.Map.mem f st.context.closure_envs, st
+
 let var x st =
   try Var.Map.find x st.vars, st
   with Not_found -> (
     try Expr (return (Hashtbl.find st.context.constants x)), st
     with Not_found ->
       Format.eprintf "ZZZ %a@." Var.print x;
-      Local 0, st)
+      Local (0, None), st)
 
-let add_var x ({ var_count; vars; _ } as st) =
+let add_var ?typ x ({ var_count; vars; _ } as st) =
   match Var.Map.find_opt x vars with
-  | Some (Local i) -> i, st
+  | Some (Local (i, typ')) ->
+      assert (Poly.equal typ typ');
+      i, st
   | Some (Expr _) -> assert false
   | None ->
       let i = var_count in
-      let vars = Var.Map.add x (Local i) vars in
+      let vars = Var.Map.add x (Local (i, typ)) vars in
       i, { st with var_count = var_count + 1; vars }
 
 let define_var x e st = (), { st with vars = Var.Map.add x (Expr e) st.vars }
@@ -108,6 +182,12 @@ let blk l st =
   let (), st = l { st with instrs = [] } in
   List.rev st.instrs, { st with instrs }
 
+let cast ?(nullable = false) typ e =
+  let* e = e in
+  match typ, e with
+  | W.I31, W.I31New _ -> return e
+  | _ -> return (W.RefCast ({ W.nullable; typ }, e))
+
 module Arith = struct
   let binary op e e' =
     let* e = e in
@@ -189,20 +269,33 @@ module Arith = struct
   let eqz = unary Eqz
 
   let const n = return (W.Const (I32 n))
+
+  let to_int31 n =
+    let* n = n in
+    match n with
+    | W.I31Get (S, n') -> return n'
+    | _ -> return (W.I31New n)
+
+  let of_int31 n =
+    let* n = n in
+    match n with
+    | W.I31New (Const (I32 _) as c) -> return c (*ZZZ Overflow *)
+    | _ -> return (W.I31Get (S, n))
 end
 
 let is_small_constant e =
   match e with
-  | W.ConstSym _ | W.Const _ -> return true
+  | W.ConstSym _ | W.Const _ | W.I31New (W.Const _) | W.RefFunc _ -> return true
+  | W.GlobalGet (V name) -> global_is_constant name
   | _ -> return false
 
 let load x =
   let* x = var x in
   match x with
-  | Local x -> return (W.LocalGet x)
+  | Local (x, _) -> return (W.LocalGet x)
   | Expr e -> e
 
-let tee x e =
+let tee ?typ x e =
   let* e = e in
   let* b = is_small_constant e in
   if b
@@ -210,28 +303,28 @@ let tee x e =
     let* () = register_constant x e in
     return e
   else
-    let* i = add_var x in
+    let* i = add_var ?typ x in
     return (W.LocalTee (i, e))
 
-let rec store ?(always = false) x e =
+let rec store ?(always = false) ?typ x e =
   let* e = e in
   match e with
   | W.Seq (l, e') ->
       let* () = instrs l in
-      store ~always x (return e')
+      store ~always ?typ x (return e')
   | _ ->
       let* b = is_small_constant e in
       if b && not always
       then register_constant x e
       else
-        let* i = add_var x in
+        let* i = add_var ?typ x in
         instr (LocalSet (i, e))
 
 let assign x e =
   let* x = var x in
   let* e = e in
   match x with
-  | Local x -> instr (W.LocalSet (x, e))
+  | Local (x, _) -> instr (W.LocalSet (x, e))
   | Expr _ -> assert false
 
 let seq l e =
@@ -242,7 +335,9 @@ let seq l e =
 let drop e =
   let* e = e in
   match e with
-  | W.Seq (l, Const _) -> instrs l
+  | W.Seq (l, e') ->
+      let* b = is_small_constant e' in
+      if b then instrs l else instr (Drop e)
   | _ -> instr (Drop e)
 
 let loop ty l =
@@ -288,7 +383,23 @@ let need_curry_fun ~arity st =
        x)
   , st )
 
-let function_body ~context ~body =
+let init_code context = instrs context.init_code
+
+let function_body ~context ~value_type ~param_count ~body =
   let st = { var_count = 0; vars = Var.Map.empty; instrs = []; context } in
   let (), st = body st in
-  st.var_count, List.rev st.instrs
+  let local_count, body = st.var_count, List.rev st.instrs in
+  let local_types = Array.make local_count None in
+  Var.Map.iter
+    (fun _ v ->
+      match v with
+      | Local (i, typ) -> local_types.(i) <- typ
+      | Expr _ -> ())
+    st.vars;
+  let locals =
+    local_types
+    |> Array.map ~f:(fun v -> Option.value ~default:value_type v)
+    |> (fun a -> Array.sub a ~pos:param_count ~len:(Array.length a - param_count))
+    |> Array.to_list
+  in
+  locals, body
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index cb76cd6c19..9b17c58957 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -1,10 +1,17 @@
+type constant_global
+
 type context =
-  { constants : (Wa_ast.var, Wa_ast.expression) Hashtbl.t
+  { constants : (Code.Var.t, Wa_ast.expression) Hashtbl.t
   ; mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
+  ; mutable constant_globals : constant_global Code.Var.Map.t
   ; mutable other_fields : Wa_ast.module_field list
+  ; types : (string, Code.Var.t) Hashtbl.t
+  ; mutable closure_envs : Code.Var.t Code.Var.Map.t
+        (** GC: mapping of recursive functions to their shared environment *)
   ; mutable use_exceptions : bool
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable curry_funs : Code.Var.t Stdlib.IntMap.t
+  ; mutable init_code : Wa_ast.instruction list
   }
 
 val make_context : unit -> context
@@ -26,6 +33,10 @@ val expression_list : ('a -> expression) -> 'a list -> Wa_ast.expression list t
 module Arith : sig
   val const : int32 -> expression
 
+  val to_int31 : expression -> expression
+
+  val of_int31 : expression -> expression
+
   val ( + ) : expression -> expression -> expression
 
   val ( - ) : expression -> expression -> expression
@@ -63,11 +74,13 @@ module Arith : sig
   val eqz : expression -> expression
 end
 
+val cast : ?nullable:bool -> Wa_ast.heap_type -> expression -> expression
+
 val load : Wa_ast.var -> expression
 
-val tee : Wa_ast.var -> expression -> expression
+val tee : ?typ:Wa_ast.value_type -> Wa_ast.var -> expression -> expression
 
-val store : ?always:bool -> Wa_ast.var -> expression -> unit t
+val store : ?always:bool -> ?typ:Wa_ast.value_type -> Wa_ast.var -> expression -> unit t
 
 val assign : Wa_ast.var -> expression -> unit t
 
@@ -81,24 +94,50 @@ val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
 val try_ : Wa_ast.func_type -> unit t -> string -> unit t -> unit t
 
-val add_var : Wa_ast.var -> int t
+val add_var : ?typ:Wa_ast.value_type -> Wa_ast.var -> int t
 
 val define_var : Wa_ast.var -> expression -> unit t
 
 val is_small_constant : Wa_ast.expression -> bool t
 
-val register_global : string -> Wa_ast.global_type -> Wa_ast.expression -> unit t
+type type_def =
+  { supertype : Wa_ast.var option
+  ; final : bool
+  ; typ : Wa_ast.str_type
+  }
+
+val register_type : string -> (unit -> type_def t) -> Wa_ast.var t
+
+val register_global :
+  Wa_ast.symbol -> ?constant:bool -> Wa_ast.global_type -> Wa_ast.expression -> unit t
+
+val get_global : Wa_ast.symbol -> Wa_ast.expression option t
 
 val register_data_segment : Code.Var.t -> active:bool -> Wa_ast.data list -> unit t
 
 val get_data_segment : Code.Var.t -> (bool * Wa_ast.data list) t
 
+val register_init_code : unit t -> unit t
+
+val init_code : context -> unit t
+
 val get_context : context t
 
+val set_closure_env : Code.Var.t -> Code.Var.t -> unit t
+
+val get_closure_env : Code.Var.t -> Code.Var.t t
+
+val is_closure : Code.Var.t -> bool t
+
 val use_exceptions : unit t
 
 val need_apply_fun : arity:int -> Code.Var.t t
 
 val need_curry_fun : arity:int -> Code.Var.t t
 
-val function_body : context:context -> body:unit t -> int * Wa_ast.instruction list
+val function_body :
+     context:context
+  -> value_type:Wa_ast.value_type
+  -> param_count:int
+  -> body:unit t
+  -> Wa_ast.value_type list * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 74c0ef45d7..cba1d70e84 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -109,7 +109,9 @@ module Memory = struct
 
   let set_field e idx e' = mem_store ~offset:(4 * idx) e e'
 
-  let load_function_pointer ~arity closure = field closure (if arity = 1 then 0 else 2)
+  let load_function_pointer ~arity ?skip_cast:_ closure =
+    let* e = field closure (if arity = 1 then 0 else 2) in
+    return (`Index, e)
 
   let load_function_arity closure = Arith.(field closure 1 lsr const 24l)
 end
@@ -268,6 +270,7 @@ module Closure = struct
   let translate ~context ~closures ~stack_ctx x =
     let info = Code.Var.Map.find x closures in
     let f, _ = List.hd info.Wa_closure_conversion.functions in
+    let* () = set_closure_env x x in
     if Code.Var.equal x f
     then (
       let start_env = closure_env_start info in
@@ -374,12 +377,12 @@ module Closure = struct
       ]
 
   let curry_load ~arity:_ _ closure =
-    return (Memory.field (load closure) 3, Memory.field (load closure) 4)
+    return (Memory.field (load closure) 3, Memory.field (load closure) 4, None)
 end
 
-let entry_point ~register_primitive =
+let entry_point ~context:_ ~register_primitive =
   let declare_global name =
-    register_global name { mut = true; typ = I32 } (Const (I32 0l))
+    register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
   in
   let* () = declare_global "sp" in
   let* () = declare_global "young_ptr" in
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index 4d6b599337..a85ef43cba 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -20,12 +20,16 @@ module Make (Target : Wa_target_sig.S) = struct
       ~init:(return ())
       l
 
-  let call ~arity closure args =
+  let call ?typ ~arity closure args =
     let funct = Var.fresh () in
-    let* closure = tee funct closure in
+    let* closure = tee ?typ funct closure in
     let args = args @ [ closure ] in
-    let* funct = Memory.load_function_pointer ~arity (load funct) in
-    return (W.Call_indirect (func_type (List.length args), funct, args))
+    let* kind, funct =
+      Memory.load_function_pointer ~arity ~skip_cast:(Option.is_some typ) (load funct)
+    in
+    match kind with
+    | `Index -> return (W.Call_indirect (func_type (List.length args), funct, args))
+    | `Ref ty -> return (W.Call_ref (ty, funct, args))
 
   let curry_app_name n m = Printf.sprintf "curry_app %d_%d" n m
 
@@ -51,28 +55,26 @@ module Make (Target : Wa_target_sig.S) = struct
       let* _ = add_var f in
       let* args' = expression_list load args in
       let* _f = load f in
-      let rec loop m args closure =
+      let rec loop m args closure closure_typ =
         if m = arity
         then
-          let* e = call ~arity (load closure) (List.append args args') in
+          let* e = call ?typ:closure_typ ~arity (load closure) (List.append args args') in
           instr (W.Push e)
         else
-          let* load_arg, load_closure = Closure.curry_load ~arity m closure in
+          let* load_arg, load_closure, closure_typ =
+            Closure.curry_load ~arity m closure
+          in
           let* x = load_arg in
           let closure' = Code.Var.fresh_n "f" in
-          let* () = store closure' load_closure in
-          loop (m + 1) (x :: args) closure'
+          let* () = store ?typ:closure_typ closure' load_closure in
+          loop (m + 1) (x :: args) closure' closure_typ
       in
-      loop m [] f
+      loop m [] f None
+    in
+    let locals, body =
+      function_body ~context ~value_type:Value.value ~param_count:2 ~body
     in
-    let local_count, body = function_body ~context ~body in
-    W.Function
-      { name
-      ; exported_name = None
-      ; typ = func_type 1
-      ; locals = List.init ~len:(local_count - m - 1) ~f:(fun _ -> Value.value)
-      ; body
-      }
+    W.Function { name; exported_name = None; typ = func_type 1; locals; body }
 
   let curry_name n m = Printf.sprintf "curry_%d_%d" n m
 
@@ -121,14 +123,10 @@ module Make (Target : Wa_target_sig.S) = struct
       let* () = instr (Push e) in
       Stack.perform_spilling stack_ctx (`Instr ret)
     in
-    let local_count, body = function_body ~context ~body in
-    W.Function
-      { name
-      ; exported_name = None
-      ; typ = func_type 1
-      ; locals = List.init ~len:(local_count - 2) ~f:(fun _ -> Value.value)
-      ; body
-      }
+    let locals, body =
+      function_body ~context ~value_type:Value.value ~param_count:2 ~body
+    in
+    W.Function { name; exported_name = None; typ = func_type 1; locals; body }
     :: functions
 
   let curry ~arity ~name = curry ~arity arity ~name
@@ -186,14 +184,10 @@ module Make (Target : Wa_target_sig.S) = struct
          in
          build_applies (load f) l)
     in
-    let local_count, body = function_body ~context ~body in
-    W.Function
-      { name
-      ; exported_name = None
-      ; typ = func_type arity
-      ; locals = List.init ~len:(local_count - arity - 1) ~f:(fun _ -> Value.value)
-      ; body
-      }
+    let locals, body =
+      function_body ~context ~value_type:Value.value ~param_count:(arity + 1) ~body
+    in
+    W.Function { name; exported_name = None; typ = func_type arity; locals; body }
 
   let f ~context =
     IntMap.iter
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
new file mode 100644
index 0000000000..88d481f021
--- /dev/null
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -0,0 +1,657 @@
+open! Stdlib
+module W = Wa_ast
+open Wa_code_generation
+
+type expression = Wa_ast.expression Wa_code_generation.t
+
+module Type = struct
+  let value = W.Ref { nullable = false; typ = Eq }
+
+  let block_type =
+    register_type "block" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Array { mut = true; typ = Value value }
+          })
+
+  let string_type =
+    register_type "string" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Array { mut = true; typ = Packed I8 }
+          })
+
+  let float_type =
+    register_type "float" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Struct [ { mut = false; typ = Value F64 } ]
+          })
+
+  let int64_type =
+    register_type "int64" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Struct [ { mut = false; typ = Value I64 } ]
+          })
+
+  let func_type n =
+    { W.params = List.init ~len:(n + 1) ~f:(fun _ -> value); result = [ value ] }
+
+  let function_type n =
+    register_type (Printf.sprintf "function_%d" n) (fun () ->
+        return { supertype = None; final = true; typ = W.Func (func_type n) })
+
+  let closure_type_1 =
+    register_type "closure" (fun () ->
+        let* fun_ty = function_type 1 in
+        return
+          { supertype = None
+          ; final = false
+          ; typ =
+              W.Struct
+                [ { mut = false; typ = Value I32 }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
+                  }
+                ]
+          })
+
+  let closure_type arity =
+    if arity = 1
+    then closure_type_1
+    else
+      register_type (Printf.sprintf "closure_%d" arity) (fun () ->
+          let* cl_typ = closure_type_1 in
+          let* fun_ty = function_type 1 in
+          let* fun_ty' = function_type arity in
+          return
+            { supertype = Some cl_typ
+            ; final = false
+            ; typ =
+                W.Struct
+                  [ { mut = false; typ = Value I32 }
+                  ; { mut = false
+                    ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
+                    }
+                  ; { mut = false
+                    ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                    }
+                  ]
+            })
+
+  let env_type ~arity n =
+    register_type (Printf.sprintf "env_%d_%d" arity n) (fun () ->
+        let* cl_typ = closure_type arity in
+        let* fun_ty = function_type 1 in
+        let* fun_ty' = function_type arity in
+        return
+          { supertype = Some cl_typ
+          ; final = true
+          ; typ =
+              W.Struct
+                ((if arity = 1
+                  then
+                    [ { W.mut = false; typ = W.Value I32 }
+                    ; { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
+                      }
+                    ]
+                  else
+                    [ { mut = false; typ = Value I32 }
+                    ; { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
+                      }
+                    ; { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                      }
+                    ])
+                @ List.init
+                    ~f:(fun _ ->
+                      { W.mut = false
+                      ; typ = W.Value (Ref { nullable = false; typ = Eq })
+                      })
+                    ~len:n)
+          })
+
+  let rec_env_type ~function_count ~free_variable_count =
+    register_type
+      (Printf.sprintf "rec_env_%d_%d" function_count free_variable_count)
+      (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ =
+              W.Struct
+                (List.init
+                   ~f:(fun i ->
+                     { W.mut = i < function_count
+                     ; typ = W.Value (Ref { nullable = false; typ = Eq })
+                     })
+                   ~len:(function_count + free_variable_count))
+          })
+
+  let rec_closure_type ~arity ~function_count ~free_variable_count =
+    register_type
+      (Printf.sprintf "closure_rec_%d_%d_%d" arity function_count free_variable_count)
+      (fun () ->
+        let* cl_typ = closure_type arity in
+        let* fun_ty = function_type 1 in
+        let* fun_ty' = function_type arity in
+        let* env_ty = rec_env_type ~function_count ~free_variable_count in
+        return
+          { supertype = Some cl_typ
+          ; final = true
+          ; typ =
+              W.Struct
+                ((if arity = 1
+                  then
+                    [ { W.mut = false; typ = W.Value I32 }
+                    ; { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                      }
+                    ]
+                  else
+                    [ { mut = false; typ = Value I32 }
+                    ; { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
+                      }
+                    ; { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                      }
+                    ])
+                @ [ { W.mut = false
+                    ; typ = W.Value (Ref { nullable = false; typ = Type env_ty })
+                    }
+                  ])
+          })
+
+  let rec curry_type arity m =
+    register_type (Printf.sprintf "curry_%d_%d" arity m) (fun () ->
+        let* cl_typ = closure_type 1 in
+        let* fun_ty = function_type 1 in
+        let* cl_ty = if m = arity then closure_type arity else curry_type arity (m + 1) in
+        return
+          { supertype = Some cl_typ
+          ; final = true
+          ; typ =
+              W.Struct
+                [ { W.mut = false; typ = W.Value I32 }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
+                  }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type cl_ty })
+                  }
+                ; { W.mut = false; typ = Value value }
+                ]
+          })
+end
+
+module Value = struct
+  let value = Type.value
+
+  let unit = return (W.I31New (Const (I32 0l)))
+
+  let val_int = Arith.to_int31
+
+  let int_val i = Arith.of_int31 (cast I31 i)
+
+  let check_is_not_zero i =
+    let* i = i in
+    return (W.UnOp (I32 Eqz, RefEq (i, W.I31New (Const (I32 0l)))))
+
+  let check_is_int i =
+    let* i = i in
+    return (W.RefTest ({ nullable = false; typ = I31 }, i))
+
+  let not i = val_int (Arith.eqz (int_val i))
+
+  let binop op i i' = val_int (op (int_val i) (int_val i'))
+
+  let lt = binop Arith.( < )
+
+  let le = binop Arith.( <= )
+
+  let eq i i' =
+    let* i = i in
+    let* i' = i' in
+    val_int (return (W.RefEq (i, i')))
+
+  let neq i i' =
+    let* i = i in
+    let* i' = i' in
+    val_int (Arith.eqz (return (W.RefEq (i, i'))))
+
+  let ult = binop Arith.(ult)
+
+  let is_int i =
+    let* i = i in
+    val_int (return (W.RefTest ({ nullable = false; typ = I31 }, i)))
+
+  let int_add = binop Arith.( + )
+
+  let int_sub = binop Arith.( - )
+
+  let int_mul = binop Arith.( * )
+
+  let int_div = binop Arith.( / )
+
+  let int_mod = binop Arith.( mod )
+
+  let int_neg i = val_int Arith.(const 0l - int_val i)
+
+  let int_or = binop Arith.( lor )
+
+  let int_and = binop Arith.( land )
+
+  let int_xor = binop Arith.( lxor )
+
+  let int_lsl = binop Arith.( lsl )
+
+  let int_lsr = binop Arith.( lsr )
+
+  let int_asr = binop Arith.( asr )
+end
+
+module Memory = struct
+  let allocate _ _ ~tag l =
+    let* l =
+      expression_list
+        (fun v ->
+          match v with
+          | `Var y -> load y
+          | `Expr e -> return e)
+        l
+    in
+    let* ty = Type.block_type in
+    return (W.ArrayNewFixed (ty, I31New (Const (I32 (Int32.of_int tag))) :: l))
+  (*ZZZ Float array?*)
+
+  let wasm_cast ty e =
+    let* e = e in
+    return (W.RefCast ({ nullable = false; typ = Type ty }, e))
+
+  let wasm_struct_get ty e i =
+    let* e = e in
+    match e with
+    | W.RefCast (_, GlobalGet nm) -> (
+        let* init = get_global nm in
+        match init with
+        | Some (W.StructNew (_, l)) ->
+            let e = List.nth l i in
+            let* b = is_small_constant e in
+            if b then return e else return (W.StructGet (None, ty, i, e))
+        | _ -> return (W.StructGet (None, ty, i, e)))
+    | _ -> return (W.StructGet (None, ty, i, e))
+
+  let wasm_struct_set ty e i e' =
+    let* e = e in
+    let* e' = e' in
+    instr (W.StructSet (None, ty, i, e, e'))
+
+  let wasm_array_get ?(ty = Type.block_type) e e' =
+    let* ty = ty in
+    let* e = wasm_cast ty e in
+    let* e' = e' in
+    return (W.ArrayGet (None, ty, e, e'))
+
+  let wasm_array_set ?(ty = Type.block_type) e e' e'' =
+    let* ty = ty in
+    let* e = wasm_cast ty e in
+    let* e' = e' in
+    let* e'' = e'' in
+    instr (W.ArraySet (None, ty, e, e', e''))
+
+  let tag e = Value.int_val (wasm_array_get e (Arith.const 0l))
+
+  let block_length e =
+    let* ty = Type.block_type in
+    let* e = wasm_cast ty e in
+    Arith.(return (W.ArrayLen e) - const 1l)
+
+  let array_get e e' = wasm_array_get e Arith.(Value.int_val e' + const 1l)
+
+  let array_set e e' e'' = wasm_array_set e Arith.(Value.int_val e' + const 1l) e''
+
+  let bytes_get e e' =
+    Value.val_int (wasm_array_get ~ty:Type.string_type e (Value.int_val e'))
+
+  let bytes_set e e' e'' =
+    wasm_array_set ~ty:Type.string_type e (Value.int_val e') (Value.int_val e'')
+
+  let field e idx = wasm_array_get e (Arith.const (Int32.of_int (idx + 1)))
+
+  let set_field e idx e' = wasm_array_set e (Arith.const (Int32.of_int (idx + 1))) e'
+
+  let load_function_pointer ~arity ?(skip_cast = false) closure =
+    let* ty = Type.closure_type arity in
+    let* fun_ty = Type.function_type arity in
+    let casted_closure = if skip_cast then closure else wasm_cast ty closure in
+    let* e = wasm_struct_get ty casted_closure (if arity = 1 then 1 else 2) in
+    return (`Ref fun_ty, e)
+
+  let load_function_arity closure =
+    let* ty = Type.closure_type_1 in
+    wasm_struct_get ty (wasm_cast ty closure) 0
+end
+
+module Constant = struct
+  let string_length_threshold = 100
+
+  let store_in_global c =
+    let name = Code.Var.fresh_n "const" in
+    let* () = register_global (V name) { mut = false; typ = Type.value } c in
+    return (W.GlobalGet (V name))
+
+  let rec translate_rec c =
+    match c with
+    | Code.Int i -> return (true, W.I31New (Const (I32 i))) (*ZZZ 32 bit integers *)
+    | Tuple (tag, a, _) ->
+        let* ty = Type.block_type in
+        let* l =
+          Array.fold_left
+            ~f:(fun prev c ->
+              let* acc = prev in
+              let* c = translate_rec c in
+              return (c :: acc))
+            ~init:(return [])
+            a
+        in
+        let l' =
+          List.map ~f:(fun (const, v) -> if const then v else W.I31New (Const (I32 0l))) l
+        in
+        let c =
+          W.ArrayNewFixed (ty, I31New (Const (I32 (Int32.of_int tag))) :: List.rev l')
+        in
+        if List.exists ~f:(fun (const, _) -> not const) l
+        then
+          let* c = store_in_global c in
+          let* () =
+            register_init_code
+              (snd
+                 (List.fold_left
+                    ~f:(fun (i, before) (const, v) ->
+                      ( i + 1
+                      , let* () = before in
+                        if const
+                        then return ()
+                        else
+                          Memory.wasm_array_set
+                            (return c)
+                            (Arith.const (Int32.of_int i))
+                            (return v) ))
+                    ~init:(1, return ())
+                    l))
+          in
+          return (true, c)
+        else return (true, c)
+    | NativeString (Byte s | Utf (Utf8 s)) | String s ->
+        let* ty = Type.string_type in
+        if String.length s > string_length_threshold
+        then
+          let name = Code.Var.fresh_n "string" in
+          let* () = register_data_segment name ~active:false [ DataBytes s ] in
+          return
+            ( false
+            , W.ArrayNewData
+                (ty, name, Const (I32 0l), Const (I32 (Int32.of_int (String.length s))))
+            )
+        else
+          let l =
+            String.fold_right
+              ~f:(fun c r -> W.Const (I32 (Int32.of_int (Char.code c))) :: r)
+              s
+              ~init:[]
+          in
+          return (true, W.ArrayNewFixed (ty, l))
+    | Float f ->
+        let* ty = Type.float_type in
+        return (true, W.StructNew (ty, [ Const (F64 f) ]))
+    | Float_array l ->
+        let l = Array.to_list l in
+        let* bl_ty = Type.block_type in
+        let* ty = Type.float_type in
+        (*ZZZ Boxed array? *)
+        return
+          ( true
+          , W.ArrayNewFixed
+              ( bl_ty
+              , I31New (Const (I32 (Int32.of_int Obj.double_array_tag)))
+                :: List.map ~f:(fun f -> W.StructNew (ty, [ Const (F64 f) ])) l ) )
+    | Int64 i ->
+        let* ty = Type.int64_type in
+        return (true, W.StructNew (ty, [ Const (I64 i) ]))
+
+  let translate c =
+    let* const, c = translate_rec c in
+    if const
+    then
+      let* b = is_small_constant c in
+      if b then return c else store_in_global c
+    else
+      let name = Code.Var.fresh_n "const" in
+      let* () =
+        register_global
+          ~constant:true
+          (V name)
+          { mut = true; typ = Type.value }
+          (W.I31New (Const (I32 0l)))
+      in
+      let* () = register_init_code (instr (W.GlobalSet (V name, c))) in
+      return (W.GlobalGet (V name))
+end
+
+module Closure = struct
+  let get_free_variables ~context info =
+    List.filter
+      ~f:(fun x -> not (Hashtbl.mem context.constants x))
+      info.Wa_closure_conversion.free_variables
+
+  let rec is_last_fun l f =
+    match l with
+    | [] -> false
+    | [ (g, _) ] -> Code.Var.equal f g
+    | _ :: r -> is_last_fun r f
+
+  let translate ~context ~closures ~stack_ctx:_ f =
+    let info = Code.Var.Map.find f closures in
+    let free_variables = get_free_variables ~context info in
+    let arity = List.assoc f info.functions in
+    let* curry_fun = if arity > 1 then need_curry_fun ~arity else return f in
+    if List.is_empty free_variables
+    then
+      let* typ = Type.closure_type arity in
+      let name = Code.Var.fresh_n "closure" in
+      let* () =
+        register_global
+          (V name)
+          { mut = false; typ = Type.value }
+          (W.StructNew
+             ( typ
+             , if arity = 1
+               then [ Const (I32 1l); RefFunc (V f) ]
+               else
+                 [ Const (I32 (Int32.of_int arity))
+                 ; RefFunc (V curry_fun)
+                 ; RefFunc (V f)
+                 ] ))
+      in
+      return (W.GlobalGet (V name))
+    else
+      let free_variable_count = List.length free_variables in
+      match info.Wa_closure_conversion.functions with
+      | [] -> assert false
+      | [ _ ] ->
+          let* typ = Type.env_type ~arity free_variable_count in
+          let* l = expression_list load free_variables in
+          return
+            (W.StructNew
+               ( typ
+               , (if arity = 1
+                  then [ W.Const (I32 1l); RefFunc (V f) ]
+                  else
+                    [ Const (I32 (Int32.of_int arity))
+                    ; RefFunc (V curry_fun)
+                    ; RefFunc (V f)
+                    ])
+                 @ l ))
+      | (g, _) :: _ as functions ->
+          let function_count = List.length functions in
+          let* env_typ = Type.rec_env_type ~function_count ~free_variable_count in
+          let env =
+            if Code.Var.equal f g
+            then
+              let env = Code.Var.fresh () in
+              let* () = set_closure_env f env in
+              let* l = expression_list load free_variables in
+              tee
+                ~typ:(W.Ref { nullable = false; typ = Type env_typ })
+                env
+                (return
+                   (W.StructNew
+                      ( env_typ
+                      , List.init ~len:function_count ~f:(fun _ ->
+                            W.I31New (W.Const (I32 0l)))
+                        @ l )))
+            else
+              let* env = get_closure_env g in
+              let* () = set_closure_env f env in
+              load env
+          in
+          let* typ = Type.rec_closure_type ~arity ~function_count ~free_variable_count in
+          let res =
+            let* env = env in
+            return
+              (W.StructNew
+                 ( typ
+                 , (if arity = 1
+                    then [ W.Const (I32 1l); RefFunc (V f) ]
+                    else
+                      [ Const (I32 (Int32.of_int arity))
+                      ; RefFunc (V curry_fun)
+                      ; RefFunc (V f)
+                      ])
+                   @ [ env ] ))
+          in
+          if is_last_fun functions f
+          then
+            seq
+              (snd
+                 (List.fold_left
+                    ~f:(fun (i, prev) (g, _) ->
+                      ( i + 1
+                      , let* () = prev in
+                        Memory.wasm_struct_set
+                          env_typ
+                          env
+                          i
+                          (if Code.Var.equal f g then tee f res else load g) ))
+                    ~init:(0, return ())
+                    functions))
+              (load f)
+          else res
+
+  let bind_environment ~context ~closures f =
+    if Hashtbl.mem context.constants f
+    then
+      (* The closures are all constants and the environment is empty. *)
+      let* _ = add_var (Code.Var.fresh ()) in
+      return ()
+    else
+      let info = Code.Var.Map.find f closures in
+      let free_variables = get_free_variables ~context info in
+      let free_variable_count = List.length free_variables in
+      let arity = List.assoc f info.functions in
+      let offset = if arity = 1 then 2 else 3 in
+      match info.Wa_closure_conversion.functions with
+      | [ _ ] ->
+          let* typ = Type.env_type ~arity free_variable_count in
+          let* _ = add_var f in
+          (*ZZZ Store env with right type in local variable? *)
+          snd
+            (List.fold_left
+               ~f:(fun (i, prev) x ->
+                 ( i + 1
+                 , let* () = prev in
+                   define_var x Memory.(wasm_struct_get typ (wasm_cast typ (load f)) i) ))
+               ~init:(offset, return ())
+               free_variables)
+      | functions ->
+          let function_count = List.length functions in
+          let* typ = Type.rec_closure_type ~arity ~function_count ~free_variable_count in
+          let* _ = add_var f in
+          let env = Code.Var.fresh_n "env" in
+          let* env_typ = Type.rec_env_type ~function_count ~free_variable_count in
+          let* () =
+            store
+              ~typ:(W.Ref { nullable = false; typ = Type env_typ })
+              env
+              Memory.(wasm_struct_get typ (wasm_cast typ (load f)) offset)
+          in
+          snd
+            (List.fold_left
+               ~f:(fun (i, prev) x ->
+                 ( i + 1
+                 , let* () = prev in
+                   define_var x Memory.(wasm_struct_get env_typ (load env) i) ))
+               ~init:(0, return ())
+               (List.map ~f:fst functions @ free_variables))
+
+  let curry_allocate ~stack_ctx:_ ~x:_ ~arity m ~f ~closure ~arg =
+    let* ty = Type.curry_type arity m in
+    let* cl_ty =
+      if m = arity then Type.closure_type arity else Type.curry_type arity (m + 1)
+    in
+    let* closure = Memory.wasm_cast cl_ty (load closure) in
+    let* arg = load arg in
+    return (W.StructNew (ty, [ Const (I32 1l); RefFunc f; closure; arg ]))
+
+  let curry_load ~arity m closure =
+    let m = m + 1 in
+    let* ty = Type.curry_type arity m in
+    let* cl_ty =
+      if m = arity then Type.closure_type arity else Type.curry_type arity (m + 1)
+    in
+    let cast e = if m = 2 then Memory.wasm_cast ty e else e in
+    return
+      ( Memory.wasm_struct_get ty (cast (load closure)) 3
+      , Memory.wasm_struct_get ty (cast (load closure)) 2
+      , Some (W.Ref { nullable = false; typ = Type cl_ty }) )
+end
+
+module Stack = struct
+  type stack = Code.Var.t option list
+
+  type info = unit
+
+  let generate_spilling_information _ ~context:_ ~closures:_ ~pc:_ ~env:_ ~params:_ = ()
+
+  let add_spilling _ ~location:_ ~stack:_ ~live_vars:_ ~spilled_vars:_ = (), []
+
+  type ctx = unit
+
+  let start_function ~context:_ _ = ()
+
+  let start_block ~context:_ _ _ = ()
+
+  let perform_reloads _ _ = return ()
+
+  let perform_spilling _ _ = return ()
+
+  let kill_variables _ = ()
+
+  let assign _ _ = return ()
+
+  let make_info () = ()
+
+  let adjust_stack _ ~src:_ ~dst:_ = return ()
+
+  let stack_adjustment_needed _ ~src:_ ~dst:_ = false
+end
+
+let entry_point ~context ~register_primitive:_ = init_code context
diff --git a/compiler/lib/wasm/wa_gc_target.mli b/compiler/lib/wasm/wa_gc_target.mli
new file mode 100644
index 0000000000..97ae000338
--- /dev/null
+++ b/compiler/lib/wasm/wa_gc_target.mli
@@ -0,0 +1 @@
+include Wa_target_sig.S
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 5c25920ded..2c8c184050 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -2,485 +2,518 @@ open! Stdlib
 open Code
 module W = Wa_ast
 open Wa_code_generation
-open Wa_core_target
 
-let transl_prim_arg x =
-  match x with
-  | Pv x -> load x
-  | Pc c -> Constant.translate c
+let target = `GC (*`Core*)
 
-type ctx =
-  { live : int array
-  ; blocks : block Addr.Map.t
-  ; closures : Wa_closure_conversion.closure Var.Map.t
-  ; mutable primitives : W.func_type StringMap.t
-  ; global_context : Wa_code_generation.context
-  }
+module Generate (Target : Wa_target_sig.S) = struct
+  open Target
 
-let register_primitive ctx nm typ =
-  (*ZZZ check type*)
-  if not (StringMap.mem nm ctx.primitives)
-  then ctx.primitives <- StringMap.add nm typ ctx.primitives
+  let transl_prim_arg x =
+    match x with
+    | Pv x -> load x
+    | Pc c -> Constant.translate c
 
-let func_type n =
-  { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
+  type ctx =
+    { live : int array
+    ; blocks : block Addr.Map.t
+    ; closures : Wa_closure_conversion.closure Var.Map.t
+    ; mutable primitives : W.func_type StringMap.t
+    ; global_context : Wa_code_generation.context
+    }
 
-let rec translate_expr ctx stack_ctx x e =
-  match e with
-  | Apply { f; args; exact } when exact || List.length args = 1 ->
-      let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-      let rec loop acc l =
-        match l with
-        | [] -> (
-            let arity = List.length args in
-            let funct = Var.fresh () in
-            let* closure = tee funct (load f) in
-            let* funct = Memory.load_function_pointer ~arity (load funct) in
-            Stack.kill_variables stack_ctx;
-            match funct with
-            | W.ConstSym (g, 0) ->
-                (* Functions with constant closures ignore their
-                   environment *)
-                return (W.Call (g, List.rev (W.Const (I32 0l) :: acc)))
-            | _ ->
-                return
-                  (W.Call_indirect
-                     (func_type (arity + 1), funct, List.rev (closure :: acc))))
-        | x :: r ->
-            let* x = load x in
-            loop (x :: acc) r
-      in
-      loop [] args
-  | Apply { f; args; _ } ->
-      let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-      let* apply = need_apply_fun ~arity:(List.length args) in
-      let* args = expression_list load args in
-      let* closure = load f in
-      Stack.kill_variables stack_ctx;
-      return (W.Call (V apply, args @ [ closure ]))
-  | Block (tag, a, _) ->
-      Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
-  | Field (x, n) -> Memory.field (load x) n
-  | Closure _ ->
-      Closure.translate ~context:ctx.global_context ~closures:ctx.closures ~stack_ctx x
-  | Constant c -> Constant.translate c
-  | Prim (p, l) -> (
-      let l = List.map ~f:transl_prim_arg l in
-      match p, l with
-      (*ZZZ array operations need to deal with array of unboxed floats *)
-      | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.array_get x y
-      | Extern "caml_array_unsafe_set", [ x; y; z ] ->
-          seq (Memory.array_set x y z) Value.unit
-      | Extern "caml_string_unsafe_get", [ x; y ] -> Memory.bytes_get x y
-      | Extern "caml_string_unsafe_set", [ x; y; z ] ->
-          seq (Memory.bytes_set x y z) Value.unit
-      | Extern "caml_bytes_unsafe_get", [ x; y ] -> Memory.bytes_get x y
-      | Extern "caml_bytes_unsafe_set", [ x; y; z ] ->
-          seq (Memory.bytes_set x y z) Value.unit
-      | Extern "%int_add", [ x; y ] -> Value.int_add x y
-      | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
-      | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
-      | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y
-      | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
-      | Extern "%int_neg", [ x ] -> Value.int_neg x
-      | Extern "%int_or", [ x; y ] -> Value.int_or x y
-      | Extern "%int_and", [ x; y ] -> Value.int_and x y
-      | Extern "%int_xor", [ x; y ] -> Value.int_xor x y
-      | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y
-      | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
-      | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
-      | Extern "caml_check_bound", [ x; y ] ->
-          let nm = "caml_array_bound_error" in
-          register_primitive ctx nm { params = []; result = [] };
-          seq
-            (if_
-               { params = []; result = [] }
-               (Arith.uge (Value.int_val y) (Memory.block_length x))
-               (instr (CallInstr (S nm, [])))
-               (return ()))
-            x
-      | Extern nm, l ->
-          (*ZZZ Different calling convention when large number of parameters *)
-          register_primitive ctx nm (func_type (List.length l));
-          let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-          let rec loop acc l =
-            match l with
-            | [] ->
-                Stack.kill_variables stack_ctx;
-                return (W.Call (S nm, List.rev acc))
-            | x :: r ->
-                let* x = x in
-                loop (x :: acc) r
-          in
-          loop [] l
-      | Not, [ x ] -> Value.not x
-      | Lt, [ x; y ] -> Value.lt x y
-      | Le, [ x; y ] -> Value.le x y
-      | Eq, [ x; y ] -> Value.eq x y
-      | Neq, [ x; y ] -> Value.neq x y
-      | Ult, [ x; y ] -> Value.ult x y
-      | Array_get, [ x; y ] -> Memory.array_get x y
-      | IsInt, [ x ] -> Value.is_int x
-      | Vectlength, [ x ] -> Value.val_int (Memory.block_length x)
-      | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
-          assert false)
+  let register_primitive ctx nm typ =
+    (*ZZZ check type*)
+    if not (StringMap.mem nm ctx.primitives)
+    then ctx.primitives <- StringMap.add nm typ ctx.primitives
+
+  let func_type n =
+    { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
+
+  let rec translate_expr ctx stack_ctx x e =
+    match e with
+    | Apply { f; args; exact } when exact || List.length args = 1 ->
+        let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+        let rec loop acc l =
+          match l with
+          | [] -> (
+              let arity = List.length args in
+              let funct = Var.fresh () in
+              let* closure = tee funct (load f) in
+              let* kind, funct = Memory.load_function_pointer ~arity (load funct) in
+              Stack.kill_variables stack_ctx;
+              let* b = is_closure f in
+              if b
+              then return (W.Call (V f, List.rev (closure :: acc)))
+              else
+                match kind, funct with
+                | `Index, W.ConstSym (g, 0) | `Ref _, W.RefFunc g ->
+                    (* Functions with constant closures ignore their
+                       environment *)
+                    let* unit = Value.unit in
+                    return (W.Call (g, List.rev (unit :: acc)))
+                | `Index, _ ->
+                    return
+                      (W.Call_indirect
+                         (func_type (arity + 1), funct, List.rev (closure :: acc)))
+                | `Ref ty, _ -> return (W.Call_ref (ty, funct, List.rev (closure :: acc)))
+              )
+          | x :: r ->
+              let* x = load x in
+              loop (x :: acc) r
+        in
+        loop [] args
+    | Apply { f; args; _ } ->
+        let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+        let* apply = need_apply_fun ~arity:(List.length args) in
+        let* args = expression_list load args in
+        let* closure = load f in
+        Stack.kill_variables stack_ctx;
+        return (W.Call (V apply, args @ [ closure ]))
+    | Block (tag, a, _) ->
+        Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
+    | Field (x, n) -> Memory.field (load x) n
+    | Closure _ ->
+        Closure.translate ~context:ctx.global_context ~closures:ctx.closures ~stack_ctx x
+    | Constant c -> Constant.translate c
+    | Prim (p, l) -> (
+        let l = List.map ~f:transl_prim_arg l in
+        match p, l with
+        (*ZZZ array operations need to deal with array of unboxed floats *)
+        | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.array_get x y
+        | Extern "caml_array_unsafe_set", [ x; y; z ] ->
+            seq (Memory.array_set x y z) Value.unit
+        | Extern "caml_string_unsafe_get", [ x; y ] -> Memory.bytes_get x y
+        | Extern "caml_string_unsafe_set", [ x; y; z ] ->
+            seq (Memory.bytes_set x y z) Value.unit
+        | Extern "caml_bytes_unsafe_get", [ x; y ] -> Memory.bytes_get x y
+        | Extern "caml_bytes_unsafe_set", [ x; y; z ] ->
+            seq (Memory.bytes_set x y z) Value.unit
+        | Extern "%int_add", [ x; y ] -> Value.int_add x y
+        | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
+        | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
+        | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y
+        | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
+        | Extern "%int_neg", [ x ] -> Value.int_neg x
+        | Extern "%int_or", [ x; y ] -> Value.int_or x y
+        | Extern "%int_and", [ x; y ] -> Value.int_and x y
+        | Extern "%int_xor", [ x; y ] -> Value.int_xor x y
+        | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y
+        | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
+        | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
+        | Extern "caml_check_bound", [ x; y ] ->
+            let nm = "caml_array_bound_error" in
+            register_primitive ctx nm { params = []; result = [] };
+            seq
+              (if_
+                 { params = []; result = [] }
+                 (Arith.uge (Value.int_val y) (Memory.block_length x))
+                 (instr (CallInstr (S nm, [])))
+                 (return ()))
+              x
+        | Extern nm, l ->
+            (*ZZZ Different calling convention when large number of parameters *)
+            register_primitive ctx nm (func_type (List.length l));
+            let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+            let rec loop acc l =
+              match l with
+              | [] ->
+                  Stack.kill_variables stack_ctx;
+                  return (W.Call (S nm, List.rev acc))
+              | x :: r ->
+                  let* x = x in
+                  loop (x :: acc) r
+            in
+            loop [] l
+        | Not, [ x ] -> Value.not x
+        | Lt, [ x; y ] -> Value.lt x y
+        | Le, [ x; y ] -> Value.le x y
+        | Eq, [ x; y ] -> Value.eq x y
+        | Neq, [ x; y ] -> Value.neq x y
+        | Ult, [ x; y ] -> Value.ult x y
+        | Array_get, [ x; y ] -> Memory.array_get x y
+        | IsInt, [ x ] -> Value.is_int x
+        | Vectlength, [ x ] -> Value.val_int (Memory.block_length x)
+        | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
+            assert false)
 
-and translate_instr ctx stack_ctx (i, _) =
-  match i with
-  | Assign (x, y) ->
-      let* () = assign x (load y) in
-      Stack.assign stack_ctx x
-  | Let (x, e) ->
-      if ctx.live.(Var.idx x) = 0
-      then drop (translate_expr ctx stack_ctx x e)
-      else store x (translate_expr ctx stack_ctx x e)
-  | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
-  | Offset_ref (x, n) ->
-      Memory.set_field
-        (load x)
-        0
-        (Value.val_int
-           Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
-  | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
+  and translate_instr ctx stack_ctx (i, _) =
+    match i with
+    | Assign (x, y) ->
+        let* () = assign x (load y) in
+        Stack.assign stack_ctx x
+    | Let (x, e) ->
+        if ctx.live.(Var.idx x) = 0
+        then drop (translate_expr ctx stack_ctx x e)
+        else store x (translate_expr ctx stack_ctx x e)
+    | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
+    | Offset_ref (x, n) ->
+        Memory.set_field
+          (load x)
+          0
+          (Value.val_int
+             Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
+    | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
 
-and translate_instrs ctx stack_ctx l =
-  match l with
-  | [] -> return ()
-  | i :: rem ->
-      let* () = Stack.perform_reloads stack_ctx (`Instr (fst i)) in
-      let* () = translate_instr ctx stack_ctx i in
-      translate_instrs ctx stack_ctx rem
+  and translate_instrs ctx stack_ctx l =
+    match l with
+    | [] -> return ()
+    | i :: rem ->
+        let* () = Stack.perform_reloads stack_ctx (`Instr (fst i)) in
+        let* () = translate_instr ctx stack_ctx i in
+        translate_instrs ctx stack_ctx rem
 
-let parallel_renaming params args =
-  let rec visit visited prev s m x l =
-    if not (Var.Set.mem x visited)
-    then
-      let visited = Var.Set.add x visited in
-      let y = Var.Map.find x m in
-      if Code.Var.compare x y = 0
-      then visited, None, l
-      else if Var.Set.mem y prev
+  let parallel_renaming params args =
+    let rec visit visited prev s m x l =
+      if not (Var.Set.mem x visited)
       then
-        let t = Code.Var.fresh () in
-        visited, Some (y, t), (x, t) :: l
-      else if Var.Set.mem y s
-      then
-        let visited, aliases, l = visit visited (Var.Set.add x prev) s m y l in
-        match aliases with
-        | Some (a, b) when Code.Var.compare a x = 0 ->
-            visited, None, (b, a) :: (x, y) :: l
-        | _ -> visited, aliases, (x, y) :: l
-      else visited, None, (x, y) :: l
-    else visited, None, l
-  in
-  let visit_all params args =
-    let m = Subst.build_mapping params args in
-    let s = List.fold_left params ~init:Var.Set.empty ~f:(fun s x -> Var.Set.add x s) in
-    let _, l =
-      Var.Set.fold
-        (fun x (visited, l) ->
-          let visited, _, l = visit visited Var.Set.empty s m x l in
-          visited, l)
-        s
-        (Var.Set.empty, [])
+        let visited = Var.Set.add x visited in
+        let y = Var.Map.find x m in
+        if Code.Var.compare x y = 0
+        then visited, None, l
+        else if Var.Set.mem y prev
+        then
+          let t = Code.Var.fresh () in
+          visited, Some (y, t), (x, t) :: l
+        else if Var.Set.mem y s
+        then
+          let visited, aliases, l = visit visited (Var.Set.add x prev) s m y l in
+          match aliases with
+          | Some (a, b) when Code.Var.compare a x = 0 ->
+              visited, None, (b, a) :: (x, y) :: l
+          | _ -> visited, aliases, (x, y) :: l
+        else visited, None, (x, y) :: l
+      else visited, None, l
+    in
+    let visit_all params args =
+      let m = Subst.build_mapping params args in
+      let s = List.fold_left params ~init:Var.Set.empty ~f:(fun s x -> Var.Set.add x s) in
+      let _, l =
+        Var.Set.fold
+          (fun x (visited, l) ->
+            let visited, _, l = visit visited Var.Set.empty s m x l in
+            visited, l)
+          s
+          (Var.Set.empty, [])
+      in
+      l
     in
-    l
-  in
-  let l = List.rev (visit_all params args) in
-  List.fold_left
-    l
-    ~f:(fun continuation (y, x) ->
-      let* () = continuation in
-      store ~always:true y (load x))
-    ~init:(return ())
+    let l = List.rev (visit_all params args) in
+    List.fold_left
+      l
+      ~f:(fun continuation (y, x) ->
+        let* () = continuation in
+        store ~always:true y (load x))
+      ~init:(return ())
 
-let exception_name = "ocaml_exception"
+  let exception_name = "ocaml_exception"
 
-let extend_context fall_through context =
-  match fall_through with
-  | `Block _ as b -> b :: context
-  | `Return -> `Skip :: context
+  let extend_context fall_through context =
+    match fall_through with
+    | `Block _ as b -> b :: context
+    | `Return -> `Skip :: context
 
-let translate_function p ctx name_opt toplevel_name params ((pc, _) as cont) acc =
-  let stack_info =
-    Stack.generate_spilling_information
-      p
-      ~context:ctx.global_context
-      ~closures:ctx.closures
-      ~env:
-        (match name_opt with
-        | Some name -> name
-        | None -> Var.fresh ())
-      ~pc
-      ~params
-  in
-  let g = Wa_structure.build_graph ctx.blocks pc in
-  let idom = Wa_structure.dominator_tree g in
-  let dom = Wa_structure.reverse_tree idom in
-  let rec index pc i context =
-    match context with
-    | `Block pc' :: _ when pc = pc' -> i
-    | (`Block _ | `Skip) :: rem -> index pc (i + 1) rem
-    | [] -> assert false
-  in
-  let rec translate_tree result_typ fall_through pc context =
-    let block = Addr.Map.find pc ctx.blocks in
-    let is_switch =
-      match fst block.branch with
-      | Switch _ -> true
-      | _ -> false
-    in
-    let code ~context =
-      translate_node_within
-        ~result_typ
-        ~fall_through
+  let translate_function p ctx name_opt toplevel_name params ((pc, _) as cont) acc =
+    let stack_info =
+      Stack.generate_spilling_information
+        p
+        ~context:ctx.global_context
+        ~closures:ctx.closures
+        ~env:
+          (match name_opt with
+          | Some name -> name
+          | None -> Var.fresh ())
         ~pc
-        ~l:
-          (List.filter
-             ~f:(fun pc' -> is_switch || Wa_structure.is_merge_node g pc')
-             (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc))))
-        ~context
+        ~params
     in
-    if Wa_structure.is_loop_header g pc
-    then loop { params = []; result = result_typ } (code ~context:(`Block pc :: context))
-    else code ~context
-  and translate_node_within ~result_typ ~fall_through ~pc ~l ~context =
-    match l with
-    | pc' :: rem ->
-        let* () =
-          let code ~context =
-            translate_node_within
-              ~result_typ:[]
-              ~fall_through:(`Block pc')
-              ~pc
-              ~l:rem
-              ~context
-          in
-          (* Do not insert a block if the inner code contains a
-             structured control flow instruction ([if] or [try] *)
-          if (not (List.is_empty rem))
-             ||
-             let block = Addr.Map.find pc ctx.blocks in
-             match fst block.branch with
-             | Cond _ | Pushtrap _ -> false (*ZZZ also some Switch*)
-             | _ -> true
-          then
-            block
-              { params = []; result = result_typ }
-              (code ~context:(`Block pc' :: context))
-          else code ~context
-        in
-        translate_tree result_typ fall_through pc' context
-    | [] -> (
-        let block = Addr.Map.find pc ctx.blocks in
-        let* global_context = get_context in
-        let stack_ctx = Stack.start_block ~context:global_context stack_info pc in
-        let* () = translate_instrs ctx stack_ctx block.body in
-        let* () = Stack.perform_reloads stack_ctx (`Branch (fst block.branch)) in
-        let* () = Stack.perform_spilling stack_ctx (`Block pc) in
+    let g = Wa_structure.build_graph ctx.blocks pc in
+    let idom = Wa_structure.dominator_tree g in
+    let dom = Wa_structure.reverse_tree idom in
+    let rec index pc i context =
+      match context with
+      | `Block pc' :: _ when pc = pc' -> i
+      | (`Block _ | `Skip) :: rem -> index pc (i + 1) rem
+      | [] -> assert false
+    in
+    let rec translate_tree result_typ fall_through pc context =
+      let block = Addr.Map.find pc ctx.blocks in
+      let is_switch =
         match fst block.branch with
-        | Branch cont ->
-            translate_branch result_typ fall_through pc cont context stack_ctx
-        | Return x -> (
-            let* e = load x in
-            match fall_through with
-            | `Return -> instr (Push e)
-            | `Block _ -> instr (Return (Some e)))
-        | Cond (x, cont1, cont2) ->
-            let context' = extend_context fall_through context in
-            if_
-              { params = []; result = result_typ }
-              (Value.check_is_not_zero (load x))
-              (translate_branch result_typ fall_through pc cont1 context' stack_ctx)
-              (translate_branch result_typ fall_through pc cont2 context' stack_ctx)
-        | Stop -> (
-            let* e = Value.unit in
-            match fall_through with
-            | `Return -> instr (Push e)
-            | `Block _ -> instr (Return (Some e)))
-        | Switch (x, a1, a2) ->
-            let l =
-              List.filter
-                ~f:(fun pc' -> Stack.stack_adjustment_needed stack_ctx ~src:pc ~dst:pc')
-                (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc)))
+        | Switch _ -> true
+        | _ -> false
+      in
+      let code ~context =
+        translate_node_within
+          ~result_typ
+          ~fall_through
+          ~pc
+          ~l:
+            (List.filter
+               ~f:(fun pc' -> is_switch || Wa_structure.is_merge_node g pc')
+               (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc))))
+          ~context
+      in
+      if Wa_structure.is_loop_header g pc
+      then
+        loop { params = []; result = result_typ } (code ~context:(`Block pc :: context))
+      else code ~context
+    and translate_node_within ~result_typ ~fall_through ~pc ~l ~context =
+      match l with
+      | pc' :: rem ->
+          let* () =
+            let code ~context =
+              translate_node_within
+                ~result_typ:[]
+                ~fall_through:(`Block pc')
+                ~pc
+                ~l:rem
+                ~context
             in
-            let br_table e a context =
-              let len = Array.length a in
-              let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
-              let dest (pc, args) =
-                assert (List.is_empty args);
-                index pc 0 context
+            (* Do not insert a block if the inner code contains a
+               structured control flow instruction ([if] or [try] *)
+            if (not (List.is_empty rem))
+               ||
+               let block = Addr.Map.find pc ctx.blocks in
+               match fst block.branch with
+               | Cond _ | Pushtrap _ -> false (*ZZZ also some Switch*)
+               | _ -> true
+            then
+              block
+                { params = []; result = result_typ }
+                (code ~context:(`Block pc' :: context))
+            else code ~context
+          in
+          translate_tree result_typ fall_through pc' context
+      | [] -> (
+          let block = Addr.Map.find pc ctx.blocks in
+          let* global_context = get_context in
+          let stack_ctx = Stack.start_block ~context:global_context stack_info pc in
+          let* () = translate_instrs ctx stack_ctx block.body in
+          let* () = Stack.perform_reloads stack_ctx (`Branch (fst block.branch)) in
+          let* () = Stack.perform_spilling stack_ctx (`Block pc) in
+          match fst block.branch with
+          | Branch cont ->
+              translate_branch result_typ fall_through pc cont context stack_ctx
+          | Return x -> (
+              let* e = load x in
+              match fall_through with
+              | `Return -> instr (Push e)
+              | `Block _ -> instr (Return (Some e)))
+          | Cond (x, cont1, cont2) ->
+              let context' = extend_context fall_through context in
+              if_
+                { params = []; result = result_typ }
+                (Value.check_is_not_zero (load x))
+                (translate_branch result_typ fall_through pc cont1 context' stack_ctx)
+                (translate_branch result_typ fall_through pc cont2 context' stack_ctx)
+          | Stop -> (
+              let* e = Value.unit in
+              match fall_through with
+              | `Return -> instr (Push e)
+              | `Block _ -> instr (Return (Some e)))
+          | Switch (x, a1, a2) ->
+              let l =
+                List.filter
+                  ~f:(fun pc' -> Stack.stack_adjustment_needed stack_ctx ~src:pc ~dst:pc')
+                  (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc)))
               in
-              let* e = e in
-              instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
-            in
-            let rec nest l context =
-              match l with
-              | pc' :: rem ->
-                  let* () =
-                    Wa_code_generation.block
-                      { params = []; result = [] }
-                      (nest rem (`Block pc' :: context))
-                  in
-                  let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
-                  instr (Br (index pc' 0 context, None))
-              | [] -> (
-                  match a1, a2 with
-                  | [||], _ -> br_table (Memory.tag (load x)) a2 context
-                  | _, [||] -> br_table (Value.int_val (load x)) a1 context
-                  | _ ->
-                      (*ZZZ Use Br_on_cast *)
-                      let context' = extend_context fall_through context in
-                      if_
-                        { params = []; result = result_typ }
-                        (Value.check_is_int (load x))
-                        (br_table (Value.int_val (load x)) a1 context')
-                        (br_table (Memory.tag (load x)) a2 context'))
-            in
-            nest l context
-        | Raise (x, _) ->
-            let* () = use_exceptions in
-            let* e = load x in
-            instr (Throw (exception_name, e))
-        | Pushtrap (cont, x, cont', _) ->
-            let context' = extend_context fall_through context in
-            let* () = use_exceptions in
-            try_
-              { params = []; result = result_typ }
-              (translate_branch result_typ fall_through pc cont context' stack_ctx)
-              exception_name
-              (let* () = store ~always:true x (return (W.Pop Value.value)) in
-               translate_branch result_typ fall_through pc cont' context' stack_ctx)
-        | Poptrap cont ->
-            translate_branch result_typ fall_through pc cont context stack_ctx)
-  and translate_branch result_typ fall_through src (dst, args) context stack_ctx =
-    let* () =
-      if List.is_empty args
-      then return ()
-      else
-        let block = Addr.Map.find dst ctx.blocks in
-        parallel_renaming block.params args
+              let br_table e a context =
+                let len = Array.length a in
+                let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
+                let dest (pc, args) =
+                  assert (List.is_empty args);
+                  index pc 0 context
+                in
+                let* e = e in
+                instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
+              in
+              let rec nest l context =
+                match l with
+                | pc' :: rem ->
+                    let* () =
+                      Wa_code_generation.block
+                        { params = []; result = [] }
+                        (nest rem (`Block pc' :: context))
+                    in
+                    let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
+                    instr (Br (index pc' 0 context, None))
+                | [] -> (
+                    match a1, a2 with
+                    | [||], _ -> br_table (Memory.tag (load x)) a2 context
+                    | _, [||] -> br_table (Value.int_val (load x)) a1 context
+                    | _ ->
+                        (*ZZZ Use Br_on_cast *)
+                        let context' = extend_context fall_through context in
+                        if_
+                          { params = []; result = result_typ }
+                          (Value.check_is_int (load x))
+                          (br_table (Value.int_val (load x)) a1 context')
+                          (br_table (Memory.tag (load x)) a2 context'))
+              in
+              nest l context
+          | Raise (x, _) ->
+              let* () = use_exceptions in
+              let* e = load x in
+              instr (Throw (exception_name, e))
+          | Pushtrap (cont, x, cont', _) ->
+              let context' = extend_context fall_through context in
+              let* () = use_exceptions in
+              try_
+                { params = []; result = result_typ }
+                (translate_branch result_typ fall_through pc cont context' stack_ctx)
+                exception_name
+                (let* () = store ~always:true x (return (W.Pop Value.value)) in
+                 translate_branch result_typ fall_through pc cont' context' stack_ctx)
+          | Poptrap cont ->
+              translate_branch result_typ fall_through pc cont context stack_ctx)
+    and translate_branch result_typ fall_through src (dst, args) context stack_ctx =
+      let* () =
+        if List.is_empty args
+        then return ()
+        else
+          let block = Addr.Map.find dst ctx.blocks in
+          parallel_renaming block.params args
+      in
+      let* () = Stack.adjust_stack stack_ctx ~src ~dst in
+      if (src >= 0 && Wa_structure.is_backward g src dst)
+         || Wa_structure.is_merge_node g dst
+      then
+        match fall_through with
+        | `Block dst' when dst = dst' -> return ()
+        | _ -> instr (Br (index dst 0 context, None))
+      else translate_tree result_typ fall_through dst context
     in
-    let* () = Stack.adjust_stack stack_ctx ~src ~dst in
-    if (src >= 0 && Wa_structure.is_backward g src dst)
-       || Wa_structure.is_merge_node g dst
-    then
-      match fall_through with
-      | `Block dst' when dst = dst' -> return ()
-      | _ -> instr (Br (index dst 0 context, None))
-    else translate_tree result_typ fall_through dst context
-  in
-  let bind_parameters =
-    List.fold_left
-      ~f:(fun l x ->
-        let* _ = l in
-        let* _ = add_var x in
-        return ())
-      ~init:(return ())
-      params
-  in
-  let build_initial_env =
-    let* () = bind_parameters in
-    match name_opt with
-    | Some f ->
-        Closure.bind_environment ~context:ctx.global_context ~closures:ctx.closures f
-    | None -> return ()
-  in
-  (*
+    let bind_parameters =
+      List.fold_left
+        ~f:(fun l x ->
+          let* _ = l in
+          let* _ = add_var x in
+          return ())
+        ~init:(return ())
+        params
+    in
+    let build_initial_env =
+      let* () = bind_parameters in
+      match name_opt with
+      | Some f ->
+          Closure.bind_environment ~context:ctx.global_context ~closures:ctx.closures f
+      | None -> return ()
+    in
+    (*
   Format.eprintf "=== %d ===@." pc;
 *)
-  let param_count =
-    match name_opt with
-    | None -> 0
-    | Some _ -> List.length params + 1
-  in
-  let local_count, body =
-    function_body
-      ~context:ctx.global_context
-      ~body:
-        (let* () = build_initial_env in
-         let stack_ctx = Stack.start_function ~context:ctx.global_context stack_info in
-         let* () = Stack.perform_spilling stack_ctx `Function in
-         translate_branch [ Value.value ] `Return (-1) cont [] stack_ctx)
-  in
-  W.Function
-    { name =
-        (match name_opt with
-        | None -> toplevel_name
-        | Some x -> x)
-    ; exported_name = None
-    ; typ = func_type param_count
-    ; locals = List.init ~len:(local_count - param_count) ~f:(fun _ -> Value.value)
-    ; body
-    }
-  :: acc
+    let param_count =
+      match name_opt with
+      | None -> 0
+      | Some _ -> List.length params + 1
+    in
+    let locals, body =
+      function_body
+        ~context:ctx.global_context
+        ~value_type:Value.value
+        ~param_count
+        ~body:
+          (let* () = build_initial_env in
+           let stack_ctx = Stack.start_function ~context:ctx.global_context stack_info in
+           let* () = Stack.perform_spilling stack_ctx `Function in
+           translate_branch [ Value.value ] `Return (-1) cont [] stack_ctx)
+    in
+    W.Function
+      { name =
+          (match name_opt with
+          | None -> toplevel_name
+          | Some x -> x)
+      ; exported_name = None
+      ; typ = func_type param_count
+      ; locals
+      ; body
+      }
+    :: acc
 
-let entry_point ctx toplevel_fun entry_name =
-  let body =
-    let* () = entry_point ~register_primitive:(register_primitive ctx) in
-    drop (return (W.Call (V toplevel_fun, [])))
-  in
-  let _, body = function_body ~context:ctx.global_context ~body in
-  W.Function
-    { name = Var.fresh_n "entry_point"
-    ; exported_name = Some entry_name
-    ; typ = { W.params = []; result = [] }
-    ; locals = []
-    ; body
-    }
+  let entry_point ctx toplevel_fun entry_name =
+    let body =
+      let* () =
+        entry_point
+          ~context:ctx.global_context
+          ~register_primitive:(register_primitive ctx)
+      in
+      drop (return (W.Call (V toplevel_fun, [])))
+    in
+    let locals, body =
+      function_body
+        ~context:ctx.global_context
+        ~value_type:Value.value
+        ~param_count:0
+        ~body
+    in
+    W.Function
+      { name = Var.fresh_n "entry_point"
+      ; exported_name = Some entry_name
+      ; typ = { W.params = []; result = [] }
+      ; locals
+      ; body
+      }
 
-module Curry = Wa_curry.Make (Wa_core_target)
+  module Curry = Wa_curry.Make (Target)
 
-let f
-    (p : Code.program)
-    ~live_vars
-     (*
+  let f
+      (p : Code.program)
+      ~live_vars
+       (*
     ~cps_calls
     ~should_export
     ~warn_on_unhandled_effect
-      _debug *) =
-  let p, closures = Wa_closure_conversion.f p in
-  (*
+      _debug *)
+      =
+    let p, closures = Wa_closure_conversion.f p in
+    (*
   Code.Print.program (fun _ _ -> "") p;
 *)
-  let ctx =
-    { live = live_vars
-    ; blocks = p.blocks
-    ; closures
-    ; primitives = StringMap.empty
-    ; global_context = make_context ()
-    }
-  in
-  let toplevel_name = Var.fresh_n "toplevel" in
-  let functions =
-    Code.fold_closures_outermost_first
-      p
-      (fun name_opt params cont ->
-        translate_function p ctx name_opt toplevel_name params cont)
-      []
-  in
-  let primitives =
-    List.map
-      ~f:(fun (name, ty) -> W.Import { name; desc = Fun ty })
-      (StringMap.bindings ctx.primitives)
-  in
-  let constant_data =
-    List.map
-      ~f:(fun (name, (active, contents)) ->
-        W.Data { name; read_only = true; active; contents })
-      (Var.Map.bindings ctx.global_context.data_segments)
-  in
-  Curry.f ~context:ctx.global_context;
-  let start_function = entry_point ctx toplevel_name "kernel_run" in
-  let fields =
-    List.rev_append
-      ctx.global_context.other_fields
-      (primitives @ functions @ (start_function :: constant_data))
-  in
-  if ctx.global_context.use_exceptions
-  then W.Tag { name = S exception_name; typ = Value.value } :: fields
-  else fields
+    let ctx =
+      { live = live_vars
+      ; blocks = p.blocks
+      ; closures
+      ; primitives = StringMap.empty
+      ; global_context = make_context ()
+      }
+    in
+    let toplevel_name = Var.fresh_n "toplevel" in
+    let functions =
+      Code.fold_closures_outermost_first
+        p
+        (fun name_opt params cont ->
+          translate_function p ctx name_opt toplevel_name params cont)
+        []
+    in
+    let primitives =
+      List.map
+        ~f:(fun (name, ty) -> W.Import { name; desc = Fun ty })
+        (StringMap.bindings ctx.primitives)
+    in
+    let constant_data =
+      List.map
+        ~f:(fun (name, (active, contents)) ->
+          W.Data { name; read_only = true; active; contents })
+        (Var.Map.bindings ctx.global_context.data_segments)
+    in
+    Curry.f ~context:ctx.global_context;
+    let start_function = entry_point ctx toplevel_name "kernel_run" in
+    let fields =
+      List.rev_append
+        ctx.global_context.other_fields
+        (primitives @ functions @ (start_function :: constant_data))
+    in
+    if ctx.global_context.use_exceptions
+    then W.Tag { name = S exception_name; typ = Value.value } :: fields
+    else fields
+end
 
 let f (p : Code.program) ~live_vars =
-  let fields = f ~live_vars p in
-  Wa_asm_output.f fields
+  match target with
+  | `Core ->
+      let module G = Generate (Wa_core_target) in
+      let fields = G.f ~live_vars p in
+      Wa_asm_output.f fields
+  | `GC ->
+      let module G = Generate (Wa_gc_target) in
+      let fields = G.f ~live_vars p in
+      Wa_wat_output.f fields
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index a26041f13c..fa99629ec3 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -60,7 +60,10 @@ module type S = sig
       -> expression
 
     val load_function_pointer :
-      arity:int -> expression -> Wa_ast.expression Wa_code_generation.t
+         arity:int
+      -> ?skip_cast:bool
+      -> expression
+      -> ([ `Index | `Ref of Wa_ast.var ] * Wa_ast.expression) Wa_code_generation.t
 
     val load_function_arity : expression -> expression
 
@@ -164,9 +167,14 @@ module type S = sig
       -> Wa_ast.expression Wa_code_generation.t
 
     val curry_load :
-      arity:int -> int -> Code.Var.t -> (expression * expression) Wa_code_generation.t
+         arity:int
+      -> int
+      -> Code.Var.t
+      -> (expression * expression * Wa_ast.value_type option) Wa_code_generation.t
   end
 
   val entry_point :
-    register_primitive:(string -> Wa_ast.func_type -> unit) -> unit Wa_code_generation.t
+       context:Wa_code_generation.context
+    -> register_primitive:(string -> Wa_ast.func_type -> unit)
+    -> unit Wa_code_generation.t
 end

From 20d26db4a63b185cf513310bc3aa462c58a66726 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 21 Apr 2023 16:11:29 +0200
Subject: [PATCH 017/481] AST changes

---
 compiler/lib/wasm/wa_asm_output.ml       | 110 ++++++++++-------
 compiler/lib/wasm/wa_ast.ml              |  24 ++--
 compiler/lib/wasm/wa_code_generation.ml  |  49 +++++---
 compiler/lib/wasm/wa_code_generation.mli |  13 +-
 compiler/lib/wasm/wa_core_target.ml      |  36 +++---
 compiler/lib/wasm/wa_curry.ml            |   2 +-
 compiler/lib/wasm/wa_gc_target.ml        |  27 ++---
 compiler/lib/wasm/wa_generate.ml         |  76 +++++-------
 compiler/lib/wasm/wa_target_sig.ml       |   7 +-
 compiler/lib/wasm/wa_wat_output.ml       | 147 ++++++++++-------------
 10 files changed, 248 insertions(+), 243 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 48f1e451ed..91b0c94a41 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -217,6 +217,8 @@ module Output () = struct
        then Int64.to_string i
        else Printf.sprintf "0x%Lx" i)
 
+  let index name = string (Code.Var.to_string name)
+
   let symbol name offset =
     string
       (match name with
@@ -263,7 +265,7 @@ module Output () = struct
         concat_map expression l
         ^^ expression f
         ^^ line (string "call_indirect " ^^ func_type typ)
-    | Call (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
+    | Call (x, l) -> concat_map expression l ^^ line (string "call " ^^ index x)
     | MemoryGrow (mem, e) -> expression e ^^ line (string "memory.grow " ^^ integer mem)
     | Seq (l, e') -> concat_map instruction l ^^ expression e'
     | Pop _ -> empty
@@ -330,7 +332,7 @@ module Output () = struct
     | Br (i, None) -> line (string "br " ^^ integer i)
     | Return (Some e) -> expression e ^^ instruction (Return None)
     | Return None -> line (string "return")
-    | CallInstr (x, l) -> concat_map expression l ^^ line (string "call " ^^ symbol x 0)
+    | CallInstr (x, l) -> concat_map expression l ^^ line (string "call " ^^ index x)
     | Nop -> empty
     | Push e -> expression e
     | Try (ty, body, catches, catch_all) ->
@@ -339,7 +341,7 @@ module Output () = struct
         ^^ indent (concat_map instruction body)
         ^^ concat_map
              (fun (tag, l) ->
-               line (string "catch " ^^ string tag) ^^ indent (concat_map instruction l))
+               line (string "catch " ^^ index tag) ^^ indent (concat_map instruction l))
              catches
         ^^ (match catch_all with
            | None -> empty
@@ -347,7 +349,7 @@ module Output () = struct
         ^^ line (string "end_try")
     | Throw (i, e) ->
         Feature.require exception_handling;
-        expression e ^^ line (string "throw " ^^ symbol (S i) 0)
+        expression e ^^ line (string "throw " ^^ index i)
     | Rethrow i ->
         Feature.require exception_handling;
         line (string "rethrow " ^^ integer i)
@@ -358,7 +360,7 @@ module Output () = struct
         ^^ line (string "return_call_indirect " ^^ func_type typ)
     | Return_call (x, l) ->
         Feature.require tail_call;
-        concat_map expression l ^^ line (string "return_call " ^^ symbol x 0)
+        concat_map expression l ^^ line (string "return_call " ^^ index x)
     | ArraySet _ | StructSet _ | Br_on_cast _ | Br_on_cast_fail _ | Return_call_ref _ ->
         assert false (* Not supported *)
 
@@ -374,7 +376,11 @@ module Output () = struct
 
   let section_header kind name =
     line
-      (string ".section ." ^^ string kind ^^ string "." ^^ string name ^^ string ",\"\",@")
+      (string ".section ."
+      ^^ string kind
+      ^^ string "."
+      ^^ symbol name 0
+      ^^ string ",\"\",@")
 
   let vector l =
     line (string ".int8 " ^^ integer (List.length l)) ^^ concat_map (fun x -> x) l
@@ -387,7 +393,7 @@ module Output () = struct
     delayed
     @@ fun () ->
     indent
-      (section_header "custom_section" "producers"
+      (section_header "custom_section" (S "producers")
       ^^ vector
            [ len_string "language"
              ^^ vector [ len_string "OCaml" ^^ len_string Sys.ocaml_version ]
@@ -405,7 +411,7 @@ module Output () = struct
     delayed
     @@ fun () ->
     indent
-      (section_header "custom_section" "target_features"
+      (section_header "custom_section" (S "target_features")
       ^^ vector
            (List.map
               ~f:(fun f -> line (string ".ascii \"+\"") ^^ len_string f)
@@ -415,8 +421,8 @@ module Output () = struct
     List.iter
       ~f:(fun f ->
         match f with
-        | Import { name; _ } -> Var_printer.add_reserved name
-        | Function _ | Data _ | Global _ | Tag _ | Type _ -> ())
+        | Global { name = S name; _ } -> Var_printer.add_reserved name
+        | Import _ | Function _ | Data _ | Global { name = V _; _ } | Tag _ | Type _ -> ())
       fields;
     to_channel stdout
     @@
@@ -424,47 +430,65 @@ module Output () = struct
       List.filter_map
         ~f:(fun f ->
           match f with
-          | Function { name; typ; _ } -> Some (Code.Var.to_string name, typ)
-          | Import { name; desc = Fun typ } -> Some (name, typ)
-          | Data _ | Global _ | Tag _ | Type _ -> None)
+          | Function { name; typ; _ } -> Some (name, typ, None)
+          | Import { import_module; import_name; name; desc = Fun typ } ->
+              Some (name, typ, Some (import_module, import_name))
+          | Import { desc = Tag _; _ } | Data _ | Global _ | Tag _ | Type _ -> None)
         fields
     in
     let globals =
       List.filter_map
         ~f:(fun f ->
           match f with
-          | Function _ | Import _ | Data _ | Tag _ | Type _ -> None
+          | Function _ | Import { desc = Fun _ | Tag _; _ } | Data _ | Tag _ | Type _ ->
+              None
           | Global { name; typ; init } ->
               assert (Poly.equal init (Const (I32 0l)));
-              Some (name, typ))
+              Some (name, typ, None))
         fields
     in
     let tags =
       List.filter_map
         ~f:(fun f ->
           match f with
-          | Function _ | Import _ | Data _ | Global _ | Type _ -> None
+          | Function _ | Import { desc = Fun _; _ } | Data _ | Global _ | Type _ -> None
+          | Import { import_module; import_name; name; desc = Tag typ } ->
+              Some (name, typ, Some (import_module, import_name))
           | Tag { name; typ } ->
               Feature.require exception_handling;
-              Some (name, typ))
+              Some (name, typ, None))
         fields
     in
     let define_symbol name =
-      line (string ".hidden " ^^ string name) ^^ line (string ".globl " ^^ string name)
+      line (string ".hidden " ^^ symbol name 0) ^^ line (string ".globl " ^^ symbol name 0)
+    in
+    let name_import name import =
+      (match import with
+      | None | Some ("env", _) -> empty
+      | Some (m, _) ->
+          line (string ".import_module " ^^ symbol name 0 ^^ string ", " ^^ string m))
+      ^^
+      match import with
+      | None -> empty
+      | Some (_, nm) ->
+          line (string ".import_name " ^^ symbol name 0 ^^ string ", " ^^ string nm)
     in
-    let declare_global name { mut; typ } =
+    let declare_global name { mut; typ } import =
       line
         (string ".globaltype "
         ^^ symbol name 0
         ^^ string ", "
         ^^ value_type typ
         ^^ if mut then empty else string ", immutable")
+      ^^ name_import name import
     in
-    let declare_tag name typ =
-      line (string ".tagtype " ^^ symbol name 0 ^^ string " " ^^ value_type typ)
+    let declare_tag name typ import =
+      line (string ".tagtype " ^^ index name ^^ string " " ^^ value_type typ)
+      ^^ name_import (V name) import
     in
-    let declare_func_type name typ =
-      line (string ".functype " ^^ string name ^^ string " " ^^ func_type typ)
+    let declare_func_type name typ import =
+      line (string ".functype " ^^ index name ^^ string " " ^^ func_type typ)
+      ^^ name_import (V name) import
     in
     let data_sections =
       concat_map
@@ -474,7 +498,6 @@ module Output () = struct
           | Data { name; read_only; active; contents } ->
               assert active;
               (* Not supported *)
-              let name = Code.Var.to_string name in
               let size =
                 List.fold_left
                   ~init:0
@@ -490,11 +513,11 @@ module Output () = struct
                   contents
               in
               indent
-                (section_header (if read_only then "rodata" else "data") name
-                ^^ define_symbol name
+                (section_header (if read_only then "rodata" else "data") (V name)
+                ^^ define_symbol (V name)
                 ^^ line (string ".p2align 2")
-                ^^ line (string ".size " ^^ string name ^^ string ", " ^^ integer size))
-              ^^ line (string name ^^ string ":")
+                ^^ line (string ".size " ^^ index name ^^ string ", " ^^ integer size))
+              ^^ line (index name ^^ string ":")
               ^^ indent
                    (concat_map
                       (fun d ->
@@ -508,17 +531,15 @@ module Output () = struct
                               ^^ string (escape_string b)
                               ^^ string "\""
                           | DataSym (name, offset) ->
-                              string ".int32 " ^^ symbol name offset
+                              string ".int32 " ^^ symbol (V name) offset
                           | DataSpace n -> string ".space " ^^ integer n))
                       contents)
-          | Global { name; _ } | Tag { name; _ } ->
-              let name =
-                match name with
-                | V name -> Code.Var.to_string name
-                | S name -> name
-              in
+          | Global { name; _ } ->
               indent (section_header "data" name ^^ define_symbol name)
-              ^^ line (string name ^^ string ":"))
+              ^^ line (symbol name 0 ^^ string ":")
+          | Tag { name; _ } ->
+              indent (section_header "data" (V name) ^^ define_symbol (V name))
+              ^^ line (index name ^^ string ":"))
         fields
     in
     let function_section =
@@ -526,22 +547,21 @@ module Output () = struct
         (fun f ->
           match f with
           | Function { name; exported_name; typ; locals; body } ->
-              let name = Code.Var.to_string name in
               indent
-                (section_header "text" name
-                ^^ define_symbol name
+                (section_header "text" (V name)
+                ^^ define_symbol (V name)
                 ^^
                 match exported_name with
                 | None -> empty
                 | Some exported_name ->
                     line
                       (string ".export_name "
-                      ^^ string name
+                      ^^ index name
                       ^^ string ","
                       ^^ string exported_name))
-              ^^ line (string name ^^ string ":")
+              ^^ line (index name ^^ string ":")
               ^^ indent
-                   (declare_func_type name typ
+                   (declare_func_type name typ None
                    ^^ (if List.is_empty locals
                        then empty
                        else
@@ -554,9 +574,9 @@ module Output () = struct
         fields
     in
     indent
-      (concat_map (fun (name, typ) -> declare_global name typ) globals
-      ^^ concat_map (fun (name, typ) -> declare_func_type name typ) types
-      ^^ concat_map (fun (name, typ) -> declare_tag name typ) tags)
+      (concat_map (fun (name, typ, import) -> declare_global name typ import) globals
+      ^^ concat_map (fun (name, typ, import) -> declare_func_type name typ import) types
+      ^^ concat_map (fun (name, typ, import) -> declare_tag name typ import) tags)
     ^^ function_section
     ^^ data_sections
     ^^ producer_section
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 4ac127dbc1..dcd0385df6 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -121,11 +121,11 @@ type expression =
   | LocalTee of int * expression
   | GlobalGet of symbol
   | Call_indirect of func_type * expression * expression list
-  | Call of symbol * expression list
+  | Call of var * expression list
   | MemoryGrow of int * expression
   | Seq of instruction list * expression
   | Pop of value_type
-  | RefFunc of symbol
+  | RefFunc of var
   | Call_ref of var * expression * expression list
   | I31New of expression
   | I31Get of signage * expression
@@ -155,32 +155,34 @@ and instruction =
   | Br_table of expression * int list * int
   | Br of int * expression option
   | Return of expression option
-  | CallInstr of symbol * expression list
+  | CallInstr of var * expression list
   | Nop
   | Push of expression
   | Try of
       func_type
       * instruction list
-      * (string * instruction list) list
+      * (var * instruction list) list
       * instruction list option
-  | Throw of string * expression
+  | Throw of var * expression
   | Rethrow of int
   | ArraySet of signage option * var * expression * expression * expression
   | StructSet of signage option * var * int * expression * expression
   | Br_on_cast of int * ref_type * ref_type * expression
   | Br_on_cast_fail of int * ref_type * ref_type * expression
   | Return_call_indirect of func_type * expression * expression list
-  | Return_call of symbol * expression list
+  | Return_call of var * expression list
   | Return_call_ref of var * expression * expression list
 
-type import_desc = Fun of func_type
+type import_desc =
+  | Fun of func_type
+  | Tag of value_type
 
 type data =
   | DataI8 of int
   | DataI32 of int32
   | DataI64 of int64
   | DataBytes of string
-  | DataSym of symbol * int
+  | DataSym of var * int
   | DataSpace of int
 
 type type_field =
@@ -210,11 +212,13 @@ type module_field =
       ; init : expression
       }
   | Tag of
-      { name : symbol
+      { name : var
       ; typ : value_type
       }
   | Import of
-      { name : string
+      { import_module : string
+      ; import_name : string
+      ; name : var
       ; desc : import_desc
       }
   | Type of type_field list
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index f8f3d5f928..b96c826916 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -23,10 +23,10 @@ type context =
   ; mutable data_segments : (bool * W.data list) Var.Map.t
   ; mutable constant_globals : constant_global Var.Map.t
   ; mutable other_fields : W.module_field list
+  ; mutable imports : (Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
   ; types : (string, Var.t) Hashtbl.t
   ; mutable closure_envs : Var.t Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
-  ; mutable use_exceptions : bool
   ; mutable apply_funs : Var.t IntMap.t
   ; mutable curry_funs : Var.t IntMap.t
   ; mutable init_code : W.instruction list
@@ -37,9 +37,9 @@ let make_context () =
   ; data_segments = Var.Map.empty
   ; constant_globals = Var.Map.empty
   ; other_fields = []
+  ; imports = StringMap.empty
   ; types = Hashtbl.create 128
   ; closure_envs = Var.Map.empty
-  ; use_exceptions = false
   ; apply_funs = IntMap.empty
   ; curry_funs = IntMap.empty
   ; init_code = []
@@ -111,10 +111,10 @@ let register_global name ?(constant = false) typ init st =
   st.context.other_fields <- W.Global { name; typ; init } :: st.context.other_fields;
   (match name with
   | S _ -> ()
-  | V nm ->
+  | V name ->
       st.context.constant_globals <-
         Var.Map.add
-          nm
+          name
           { init = (if not typ.mut then Some init else None)
           ; constant = (not typ.mut) || constant
           }
@@ -128,15 +128,34 @@ let global_is_constant name =
     | Some { constant = true; _ } -> true
     | _ -> false)
 
-let get_global (name : Wa_ast.symbol) =
-  match name with
-  | S _ -> return None
-  | V name ->
-      let* ctx = get_context in
-      return
-        (match Var.Map.find_opt name ctx.constant_globals with
-        | Some { init; _ } -> init
-        | _ -> None)
+let get_global name =
+  let* ctx = get_context in
+  return
+    (match Var.Map.find_opt name ctx.constant_globals with
+    | Some { init; _ } -> init
+    | _ -> None)
+
+let register_import ?(import_module = "env") ~name typ st =
+  ( (try
+       let x, typ' =
+         StringMap.find name (StringMap.find import_module st.context.imports)
+       in
+       (*ZZZ error message*)
+       assert (Poly.equal typ typ');
+       x
+     with Not_found ->
+       let x = Var.fresh_n name in
+       st.context.imports <-
+         StringMap.update
+           import_module
+           (fun m ->
+             Some
+               (match m with
+               | None -> StringMap.singleton name (x, typ)
+               | Some m -> StringMap.add name (x, typ) m))
+           st.context.imports;
+       x)
+  , st )
 
 let register_init_code code st =
   let st' = { var_count = 0; vars = Var.Map.empty; instrs = []; context = st.context } in
@@ -361,10 +380,6 @@ let try_ ty body exception_name handler =
   let* handler = blk handler in
   instr (Try (ty, body, [ exception_name, handler ], None))
 
-let use_exceptions st =
-  st.context.use_exceptions <- true;
-  (), st
-
 let need_apply_fun ~arity st =
   let ctx = st.context in
   ( (try IntMap.find arity ctx.apply_funs
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 9b17c58957..2cba13ae29 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -1,3 +1,5 @@
+open Stdlib
+
 type constant_global
 
 type context =
@@ -5,10 +7,10 @@ type context =
   ; mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
   ; mutable constant_globals : constant_global Code.Var.Map.t
   ; mutable other_fields : Wa_ast.module_field list
+  ; mutable imports : (Code.Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
   ; types : (string, Code.Var.t) Hashtbl.t
   ; mutable closure_envs : Code.Var.t Code.Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
-  ; mutable use_exceptions : bool
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable curry_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable init_code : Wa_ast.instruction list
@@ -92,7 +94,7 @@ val block : Wa_ast.func_type -> unit t -> unit t
 
 val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
-val try_ : Wa_ast.func_type -> unit t -> string -> unit t -> unit t
+val try_ : Wa_ast.func_type -> unit t -> Code.Var.t -> unit t -> unit t
 
 val add_var : ?typ:Wa_ast.value_type -> Wa_ast.var -> int t
 
@@ -108,10 +110,13 @@ type type_def =
 
 val register_type : string -> (unit -> type_def t) -> Wa_ast.var t
 
+val register_import :
+  ?import_module:string -> name:string -> Wa_ast.import_desc -> Wa_ast.var t
+
 val register_global :
   Wa_ast.symbol -> ?constant:bool -> Wa_ast.global_type -> Wa_ast.expression -> unit t
 
-val get_global : Wa_ast.symbol -> Wa_ast.expression option t
+val get_global : Code.Var.t -> Wa_ast.expression option t
 
 val register_data_segment : Code.Var.t -> active:bool -> Wa_ast.data list -> unit t
 
@@ -129,8 +134,6 @@ val get_closure_env : Code.Var.t -> Code.Var.t t
 
 val is_closure : Code.Var.t -> bool t
 
-val use_exceptions : unit t
-
 val need_apply_fun : arity:int -> Code.Var.t t
 
 val need_curry_fun : arity:int -> Code.Var.t t
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index cba1d70e84..63fb97482e 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -16,7 +16,7 @@ module Memory = struct
           match l with
           | [] -> assert false
           | W.DataI32 i :: _ when offset = 0 -> W.Const (I32 i)
-          | W.DataSym (sym, ofs) :: _ when offset = 0 -> W.ConstSym (sym, ofs)
+          | W.DataSym (sym, ofs) :: _ when offset = 0 -> W.ConstSym (V sym, ofs)
           | (W.DataI32 _ | DataSym _) :: r -> get_data (offset - 4) r
           | (DataI8 _ | DataBytes _ | DataSpace _ | DataI64 _) :: _ -> assert false
         in
@@ -35,7 +35,10 @@ module Memory = struct
     assert (offset >= 0);
     let* e = Arith.(e + const (Int32.of_int offset)) in
     let* e' = e' in
-    instr (CallInstr (S "caml_modify", [ e; e' ]))
+    let* f =
+      register_import ~name:"caml_modify" (Fun { W.params = [ I32; I32 ]; result = [] })
+    in
+    instr (CallInstr (f, [ e; e' ]))
 
   (*ZZZ
     p = young_ptr - size;
@@ -179,7 +182,7 @@ module Constant = struct
           W.DataI32 h :: List.map ~f:(fun c -> translate_rec context c) (Array.to_list a)
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
+        W.DataSym (name, 4)
     | NativeString (Byte s | Utf (Utf8 s)) | String s ->
         let l = String.length s in
         let len = (l + 4) / 4 in
@@ -193,13 +196,13 @@ module Constant = struct
         in
         context.data_segments <-
           Code.Var.Map.add name (true, string) context.data_segments;
-        W.DataSym (V name, 4)
+        W.DataSym (name, 4)
     | Float f ->
         let h = Memory.header ~const:true ~tag:Obj.double_tag ~len:2 () in
         let name = Code.Var.fresh_n "float" in
         let block = [ W.DataI32 h; DataI64 (Int64.bits_of_float f) ] in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
+        W.DataSym (name, 4)
     | Float_array l ->
         (*ZZZ Boxed array? *)
         let l = Array.to_list l in
@@ -211,19 +214,21 @@ module Constant = struct
           W.DataI32 h :: List.map ~f:(fun f -> translate_rec context (Float f)) l
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
+        W.DataSym (name, 4)
     | Int64 i ->
         let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:3 () in
         let name = Code.Var.fresh_n "int64" in
-        let block = [ W.DataI32 h; DataSym (S "caml_int64_ops", 0); DataI64 i ] in
+        let block =
+          [ W.DataI32 h; DataI32 0l (*ZZZ DataSym (S "caml_int64_ops", 0)*); DataI64 i ]
+        in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
+        W.DataSym (name, 4)
 
   let translate c =
     let* context = get_context in
     return
       (match translate_rec context c with
-      | W.DataSym (V name, offset) -> W.ConstSym (V name, offset)
+      | W.DataSym (name, offset) -> W.ConstSym (V name, offset)
       | W.DataI32 i -> W.Const (I32 i)
       | _ -> assert false)
 end
@@ -300,7 +305,7 @@ module Closure = struct
             ~f:(fun e ->
               match e with
               | W.Const (I32 i) -> W.DataI32 i
-              | ConstSym (sym, offset) -> DataSym (sym, offset)
+              | ConstSym (V sym, offset) -> DataSym (sym, offset)
               | _ -> assert false)
             start
         in
@@ -370,7 +375,7 @@ module Closure = struct
       stack_ctx
       x
       ~tag:Obj.closure_tag
-      [ `Expr (W.ConstSym (f, 0))
+      [ `Expr (W.ConstSym (V f, 0))
       ; `Expr (closure_info ~arity ~sz:2)
       ; `Var closure
       ; `Var arg
@@ -380,16 +385,17 @@ module Closure = struct
     return (Memory.field (load closure) 3, Memory.field (load closure) 4, None)
 end
 
-let entry_point ~context:_ ~register_primitive =
+let entry_point ~context:_ =
   let declare_global name =
     register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
   in
   let* () = declare_global "sp" in
   let* () = declare_global "young_ptr" in
   let* () = declare_global "young_limit" in
-  register_primitive "caml_modify" { W.params = [ I32; I32 ]; result = [] };
-  register_primitive "__wasm_call_ctors" { W.params = []; result = [] };
-  let* () = instr (W.CallInstr (S "__wasm_call_ctors", [])) in
+  let* call_ctors =
+    register_import ~name:"__wasm_call_ctors" (Fun { W.params = []; result = [] })
+  in
+  let* () = instr (W.CallInstr (call_ctors, [])) in
   let* sz = Arith.const 3l in
   let* high = Arith.((return (W.MemoryGrow (0, sz)) + const 3l) lsl const 16l) in
   let* () = instr (W.GlobalSet (S "young_ptr", high)) in
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index a85ef43cba..79f82582d9 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -118,7 +118,7 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       let stack_ctx = Stack.start_function ~context stack_info in
       let* e =
-        Closure.curry_allocate ~stack_ctx ~x:res ~arity m ~f:(V name') ~closure:f ~arg:x
+        Closure.curry_allocate ~stack_ctx ~x:res ~arity m ~f:name' ~closure:f ~arg:x
       in
       let* () = instr (Push e) in
       Stack.perform_spilling stack_ctx (`Instr ret)
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 88d481f021..c0677463a3 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -279,7 +279,7 @@ module Memory = struct
   let wasm_struct_get ty e i =
     let* e = e in
     match e with
-    | W.RefCast (_, GlobalGet nm) -> (
+    | W.RefCast (_, GlobalGet (V nm)) -> (
         let* init = get_global nm in
         match init with
         | Some (W.StructNew (_, l)) ->
@@ -474,12 +474,8 @@ module Closure = struct
           (W.StructNew
              ( typ
              , if arity = 1
-               then [ Const (I32 1l); RefFunc (V f) ]
-               else
-                 [ Const (I32 (Int32.of_int arity))
-                 ; RefFunc (V curry_fun)
-                 ; RefFunc (V f)
-                 ] ))
+               then [ Const (I32 1l); RefFunc f ]
+               else [ Const (I32 (Int32.of_int arity)); RefFunc curry_fun; RefFunc f ] ))
       in
       return (W.GlobalGet (V name))
     else
@@ -493,12 +489,8 @@ module Closure = struct
             (W.StructNew
                ( typ
                , (if arity = 1
-                  then [ W.Const (I32 1l); RefFunc (V f) ]
-                  else
-                    [ Const (I32 (Int32.of_int arity))
-                    ; RefFunc (V curry_fun)
-                    ; RefFunc (V f)
-                    ])
+                  then [ W.Const (I32 1l); RefFunc f ]
+                  else [ Const (I32 (Int32.of_int arity)); RefFunc curry_fun; RefFunc f ])
                  @ l ))
       | (g, _) :: _ as functions ->
           let function_count = List.length functions in
@@ -530,12 +522,9 @@ module Closure = struct
               (W.StructNew
                  ( typ
                  , (if arity = 1
-                    then [ W.Const (I32 1l); RefFunc (V f) ]
+                    then [ W.Const (I32 1l); RefFunc f ]
                     else
-                      [ Const (I32 (Int32.of_int arity))
-                      ; RefFunc (V curry_fun)
-                      ; RefFunc (V f)
-                      ])
+                      [ Const (I32 (Int32.of_int arity)); RefFunc curry_fun; RefFunc f ])
                    @ [ env ] ))
           in
           if is_last_fun functions f
@@ -654,4 +643,4 @@ module Stack = struct
   let stack_adjustment_needed _ ~src:_ ~dst:_ = false
 end
 
-let entry_point ~context ~register_primitive:_ = init_code context
+let entry_point ~context = init_code context
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 2c8c184050..e2156d8289 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -17,15 +17,9 @@ module Generate (Target : Wa_target_sig.S) = struct
     { live : int array
     ; blocks : block Addr.Map.t
     ; closures : Wa_closure_conversion.closure Var.Map.t
-    ; mutable primitives : W.func_type StringMap.t
     ; global_context : Wa_code_generation.context
     }
 
-  let register_primitive ctx nm typ =
-    (*ZZZ check type*)
-    if not (StringMap.mem nm ctx.primitives)
-    then ctx.primitives <- StringMap.add nm typ ctx.primitives
-
   let func_type n =
     { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
 
@@ -43,10 +37,10 @@ module Generate (Target : Wa_target_sig.S) = struct
               Stack.kill_variables stack_ctx;
               let* b = is_closure f in
               if b
-              then return (W.Call (V f, List.rev (closure :: acc)))
+              then return (W.Call (f, List.rev (closure :: acc)))
               else
                 match kind, funct with
-                | `Index, W.ConstSym (g, 0) | `Ref _, W.RefFunc g ->
+                | `Index, W.ConstSym (V g, 0) | `Ref _, W.RefFunc g ->
                     (* Functions with constant closures ignore their
                        environment *)
                     let* unit = Value.unit in
@@ -68,7 +62,7 @@ module Generate (Target : Wa_target_sig.S) = struct
         let* args = expression_list load args in
         let* closure = load f in
         Stack.kill_variables stack_ctx;
-        return (W.Call (V apply, args @ [ closure ]))
+        return (W.Call (apply, args @ [ closure ]))
     | Block (tag, a, _) ->
         Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
     | Field (x, n) -> Memory.field (load x) n
@@ -101,24 +95,27 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
         | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
         | Extern "caml_check_bound", [ x; y ] ->
-            let nm = "caml_array_bound_error" in
-            register_primitive ctx nm { params = []; result = [] };
+            let* f =
+              register_import
+                ~name:"caml_array_bound_error"
+                (Fun { params = []; result = [] })
+            in
             seq
               (if_
                  { params = []; result = [] }
                  (Arith.uge (Value.int_val y) (Memory.block_length x))
-                 (instr (CallInstr (S nm, [])))
+                 (instr (CallInstr (f, [])))
                  (return ()))
               x
-        | Extern nm, l ->
+        | Extern name, l ->
             (*ZZZ Different calling convention when large number of parameters *)
-            register_primitive ctx nm (func_type (List.length l));
+            let* f = register_import ~name (Fun (func_type (List.length l))) in
             let* () = Stack.perform_spilling stack_ctx (`Instr x) in
             let rec loop acc l =
               match l with
               | [] ->
                   Stack.kill_variables stack_ctx;
-                  return (W.Call (S nm, List.rev acc))
+                  return (W.Call (f, List.rev acc))
               | x :: r ->
                   let* x = x in
                   loop (x :: acc) r
@@ -351,16 +348,16 @@ module Generate (Target : Wa_target_sig.S) = struct
               in
               nest l context
           | Raise (x, _) ->
-              let* () = use_exceptions in
               let* e = load x in
-              instr (Throw (exception_name, e))
+              let* tag = register_import ~name:exception_name (Tag Value.value) in
+              instr (Throw (tag, e))
           | Pushtrap (cont, x, cont', _) ->
               let context' = extend_context fall_through context in
-              let* () = use_exceptions in
+              let* tag = register_import ~name:exception_name (Tag Value.value) in
               try_
                 { params = []; result = result_typ }
                 (translate_branch result_typ fall_through pc cont context' stack_ctx)
-                exception_name
+                tag
                 (let* () = store ~always:true x (return (W.Pop Value.value)) in
                  translate_branch result_typ fall_through pc cont' context' stack_ctx)
           | Poptrap cont ->
@@ -431,12 +428,8 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   let entry_point ctx toplevel_fun entry_name =
     let body =
-      let* () =
-        entry_point
-          ~context:ctx.global_context
-          ~register_primitive:(register_primitive ctx)
-      in
-      drop (return (W.Call (V toplevel_fun, [])))
+      let* () = entry_point ~context:ctx.global_context in
+      drop (return (W.Call (toplevel_fun, [])))
     in
     let locals, body =
       function_body
@@ -469,12 +462,7 @@ module Generate (Target : Wa_target_sig.S) = struct
   Code.Print.program (fun _ _ -> "") p;
 *)
     let ctx =
-      { live = live_vars
-      ; blocks = p.blocks
-      ; closures
-      ; primitives = StringMap.empty
-      ; global_context = make_context ()
-      }
+      { live = live_vars; blocks = p.blocks; closures; global_context = make_context () }
     in
     let toplevel_name = Var.fresh_n "toplevel" in
     let functions =
@@ -484,10 +472,15 @@ module Generate (Target : Wa_target_sig.S) = struct
           translate_function p ctx name_opt toplevel_name params cont)
         []
     in
-    let primitives =
-      List.map
-        ~f:(fun (name, ty) -> W.Import { name; desc = Fun ty })
-        (StringMap.bindings ctx.primitives)
+    let imports =
+      List.concat
+        (List.map
+           ~f:(fun (import_module, m) ->
+             List.map
+               ~f:(fun (import_name, (name, desc)) ->
+                 W.Import { import_module; import_name; name; desc })
+               (StringMap.bindings m))
+           (StringMap.bindings ctx.global_context.imports))
     in
     let constant_data =
       List.map
@@ -496,15 +489,10 @@ module Generate (Target : Wa_target_sig.S) = struct
         (Var.Map.bindings ctx.global_context.data_segments)
     in
     Curry.f ~context:ctx.global_context;
-    let start_function = entry_point ctx toplevel_name "kernel_run" in
-    let fields =
-      List.rev_append
-        ctx.global_context.other_fields
-        (primitives @ functions @ (start_function :: constant_data))
-    in
-    if ctx.global_context.use_exceptions
-    then W.Tag { name = S exception_name; typ = Value.value } :: fields
-    else fields
+    let start_function = entry_point ctx toplevel_name "_initialize" in
+    List.rev_append
+      ctx.global_context.other_fields
+      (imports @ functions @ (start_function :: constant_data))
 end
 
 let f (p : Code.program) ~live_vars =
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index fa99629ec3..ae154b69d2 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -161,7 +161,7 @@ module type S = sig
       -> x:Code.Var.t
       -> arity:int
       -> int
-      -> f:Wa_ast.symbol
+      -> f:Code.Var.t
       -> closure:Code.Var.t
       -> arg:Code.Var.t
       -> Wa_ast.expression Wa_code_generation.t
@@ -173,8 +173,5 @@ module type S = sig
       -> (expression * expression * Wa_ast.value_type option) Wa_code_generation.t
   end
 
-  val entry_point :
-       context:Wa_code_generation.context
-    -> register_primitive:(string -> Wa_ast.func_type -> unit)
-    -> unit Wa_code_generation.t
+  val entry_point : context:Wa_code_generation.context -> unit Wa_code_generation.t
 end
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 4a8bbc9c00..95cbf1203b 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -15,13 +15,12 @@ let rec format_sexp f s =
       Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f "@ ") format_sexp f l;
       Format.fprintf f ")@]"
 
-let index (symb : symbol) =
-  Atom
-    ("$"
-    ^
-    match symb with
-    | S s -> s
-    | V x -> Code.Var.to_string x)
+let index x = Atom ("$" ^ Code.Var.to_string x)
+
+let symbol name =
+  match name with
+  | V name -> index name
+  | S name -> Atom ("$" ^ name)
 
 let heap_type (ty : heap_type) =
   match ty with
@@ -29,7 +28,7 @@ let heap_type (ty : heap_type) =
   | Extern -> Atom "extern"
   | Eq -> Atom "eq"
   | I31 -> Atom "i31"
-  | Type symb -> index (V symb)
+  | Type t -> index t
 
 let ref_type' { nullable; typ } =
   let r = [ heap_type typ ] in
@@ -54,7 +53,7 @@ let list ?(always = false) name f l =
 
 let value_type_list name tl = list name (fun tl -> List.map ~f:value_type tl) tl
 
-let funct_type { params; result } =
+let func_type { params; result } =
   value_type_list "param" params @ value_type_list "result" result
 
 let storage_type typ =
@@ -70,7 +69,7 @@ let global_type typ = mut_type value_type typ
 
 let str_type typ =
   match typ with
-  | Func ty -> List (Atom "func" :: funct_type ty)
+  | Func ty -> List (Atom "func" :: func_type ty)
   | Struct l -> (
       match target with
       | `Binaryen ->
@@ -80,7 +79,7 @@ let str_type typ =
           List [ Atom "struct"; List (Atom "field" :: List.map ~f:field_type l) ])
   | Array ty -> List [ Atom "array"; field_type ty ]
 
-let block_type = funct_type
+let block_type = func_type
 
 let quoted_name name = Atom ("\"" ^ name ^ "\"")
 
@@ -165,24 +164,16 @@ let select i32 i64 f64 op =
 
 type ctx =
   { addresses : int Code.Var.Map.t
-  ; constants : int StringMap.t
   ; mutable functions : int Code.Var.Map.t
   ; mutable function_refs : Code.Var.Set.t
   ; mutable function_count : int
   }
 
-let reference_function ctx (f : symbol) =
-  match f with
+let reference_function ctx f = ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
+
+let lookup_symbol ctx (x : symbol) =
+  match x with
   | S _ -> assert false
-  | V f -> ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
-
-let lookup_symbol ctx (symb : symbol) =
-  match symb with
-  | S nm -> (
-      try StringMap.find nm ctx.constants
-      with Not_found ->
-        prerr_endline nm;
-        assert false)
   | V x -> (
       try Code.Var.Map.find x ctx.addresses
       with Not_found -> (
@@ -236,10 +227,10 @@ let expression_or_instructions ctx in_function =
     | LocalGet i -> [ List [ Atom "local.get"; Atom (string_of_int i) ] ]
     | LocalTee (i, e') ->
         [ List (Atom "local.tee" :: Atom (string_of_int i) :: expression e') ]
-    | GlobalGet nm -> [ List [ Atom "global.get"; index nm ] ]
+    | GlobalGet nm -> [ List [ Atom "global.get"; symbol nm ] ]
     | Call_indirect (typ, e, l) ->
         [ List
-            ((Atom "call_indirect" :: funct_type typ)
+            ((Atom "call_indirect" :: func_type typ)
             @ List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | Call (f, l) ->
@@ -253,53 +244,49 @@ let expression_or_instructions ctx in_function =
     | RefFunc symb ->
         if in_function then reference_function ctx symb;
         [ List [ Atom "ref.func"; index symb ] ]
-    | Call_ref (symb, e, l) ->
+    | Call_ref (f, e, l) ->
         [ List
             (Atom "call_ref"
-            :: index (V symb)
+            :: index f
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | I31New e -> [ List (Atom "i31.new" :: expression e) ]
     | I31Get (s, e) -> [ List (Atom (signage "i31.get" s) :: expression e) ]
-    | ArrayNew (symb, e, e') ->
-        [ List (Atom "array.new" :: index (V symb) :: (expression e @ expression e')) ]
-    | ArrayNewFixed (symb, l) ->
+    | ArrayNew (typ, e, e') ->
+        [ List (Atom "array.new" :: index typ :: (expression e @ expression e')) ]
+    | ArrayNewFixed (typ, l) ->
         [ List
             (Atom "array.new_fixed"
-            :: index (V symb)
+            :: index typ
             :: ((match target with
                 | `Binaryen -> []
                 | `Reference -> [ Atom (string_of_int (List.length l)) ])
                @ List.concat (List.map ~f:expression l)))
         ]
-    | ArrayNewData (symb, symb', e, e') ->
+    | ArrayNewData (typ, data, e, e') ->
         [ List
             (Atom "array.new_data"
-            :: index (V symb)
-            :: index (V symb')
+            :: index typ
+            :: index data
             :: (expression e @ expression e'))
         ]
-    | ArrayGet (None, symb, e, e') ->
-        [ List (Atom "array.get" :: index (V symb) :: (expression e @ expression e')) ]
-    | ArrayGet (Some s, symb, e, e') ->
+    | ArrayGet (None, typ, e, e') ->
+        [ List (Atom "array.get" :: index typ :: (expression e @ expression e')) ]
+    | ArrayGet (Some s, typ, e, e') ->
         [ List
-            (Atom (signage "array.get" s)
-            :: index (V symb)
-            :: (expression e @ expression e'))
+            (Atom (signage "array.get" s) :: index typ :: (expression e @ expression e'))
         ]
     | ArrayLen e -> [ List (Atom "array.len" :: expression e) ]
-    | StructNew (symb, l) ->
-        [ List
-            (Atom "struct.new" :: index (V symb) :: List.concat (List.map ~f:expression l))
+    | StructNew (typ, l) ->
+        [ List (Atom "struct.new" :: index typ :: List.concat (List.map ~f:expression l))
         ]
-    | StructGet (None, symb, i, e) ->
-        [ List
-            (Atom "struct.get" :: index (V symb) :: Atom (string_of_int i) :: expression e)
+    | StructGet (None, typ, i, e) ->
+        [ List (Atom "struct.get" :: index typ :: Atom (string_of_int i) :: expression e)
         ]
-    | StructGet (Some s, symb, i, e) ->
+    | StructGet (Some s, typ, i, e) ->
         [ List
             (Atom (signage "struct.get" s)
-            :: index (V symb)
+            :: index typ
             :: Atom (string_of_int i)
             :: expression e)
         ]
@@ -338,7 +325,7 @@ let expression_or_instructions ctx in_function =
         instructions (l @ [ LocalSet (i, e) ])
     | LocalSet (i, e) ->
         [ List (Atom "local.set" :: Atom (string_of_int i) :: expression e) ]
-    | GlobalSet (nm, e) -> [ List (Atom "global.set" :: index nm :: expression e) ]
+    | GlobalSet (nm, e) -> [ List (Atom "global.set" :: symbol nm :: expression e) ]
     | Loop (ty, l) -> [ List (Atom "loop" :: (block_type ty @ instructions l)) ]
     | Block (ty, l) -> [ List (Atom "block" :: (block_type ty @ instructions l)) ]
     | If (ty, e, l1, l2) ->
@@ -359,7 +346,7 @@ let expression_or_instructions ctx in_function =
                @ List (Atom "do" :: instructions body)
                  :: (List.map
                        ~f:(fun (tag, l) ->
-                         List (Atom "catch" :: index (S tag) :: instructions l))
+                         List (Atom "catch" :: index tag :: instructions l))
                        catches
                     @
                     match catch_all with
@@ -389,35 +376,35 @@ let expression_or_instructions ctx in_function =
             | None -> []
             | Some e -> expression e))
         ]
-    | Throw (i, e) -> [ List (Atom "throw" :: index (S i) :: expression e) ]
+    | Throw (tag, e) -> [ List (Atom "throw" :: index tag :: expression e) ]
     | Rethrow i -> [ List [ Atom "rethrow"; Atom (string_of_int i) ] ]
     | CallInstr (f, l) ->
         [ List (Atom "call" :: index f :: List.concat (List.map ~f:expression l)) ]
     | Nop -> []
     | Push e -> expression e
-    | ArraySet (None, symb, e, e', e'') ->
+    | ArraySet (None, typ, e, e', e'') ->
         [ List
             (Atom "array.set"
-            :: index (V symb)
+            :: index typ
             :: (expression e @ expression e' @ expression e''))
         ]
-    | ArraySet (Some s, symb, e, e', e'') ->
+    | ArraySet (Some s, typ, e, e', e'') ->
         [ List
             (Atom (signage "array.set" s)
-            :: index (V symb)
+            :: index typ
             :: (expression e @ expression e' @ expression e''))
         ]
-    | StructSet (None, symb, i, e, e') ->
+    | StructSet (None, typ, i, e, e') ->
         [ List
             (Atom "struct.set"
-            :: index (V symb)
+            :: index typ
             :: Atom (string_of_int i)
             :: (expression e @ expression e'))
         ]
-    | StructSet (Some s, symb, i, e, e') ->
+    | StructSet (Some s, typ, i, e, e') ->
         [ List
             (Atom (signage "struct.set" s)
-            :: index (V symb)
+            :: index typ
             :: Atom (string_of_int i)
             :: (expression e @ expression e'))
         ]
@@ -455,15 +442,15 @@ let expression_or_instructions ctx in_function =
             ])
     | Return_call_indirect (typ, e, l) ->
         [ List
-            ((Atom "return_call_indirect" :: funct_type typ)
+            ((Atom "return_call_indirect" :: func_type typ)
             @ List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | Return_call (f, l) ->
         [ List (Atom "return_call" :: index f :: List.concat (List.map ~f:expression l)) ]
-    | Return_call_ref (symb, e, l) ->
+    | Return_call_ref (typ, e, l) ->
         [ List
             (Atom "return_call_ref"
-            :: index (V symb)
+            :: index typ
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
   and instructions l = List.concat (List.map ~f:instruction l) in
@@ -475,22 +462,23 @@ let instructions ctx = snd (expression_or_instructions ctx true)
 
 let funct ctx name exported_name typ locals body =
   List
-    ((Atom "func" :: index (V name) :: export exported_name)
-    @ funct_type typ
+    ((Atom "func" :: index name :: export exported_name)
+    @ func_type typ
     @ value_type_list "local" locals
     @ instructions ctx body)
 
 let import f =
   match f with
   | Function _ | Global _ | Data _ | Tag _ | Type _ -> []
-  | Import { name; desc } ->
+  | Import { import_module; import_name; name; desc } ->
       [ List
           [ Atom "import"
-          ; quoted_name "env"
-          ; quoted_name name
+          ; quoted_name import_module
+          ; quoted_name import_name
           ; List
               (match desc with
-              | Fun typ -> Atom "func" :: index (S name) :: funct_type typ)
+              | Fun typ -> Atom "func" :: index name :: func_type typ
+              | Tag ty -> [ Atom "tag"; index name; List [ Atom "param"; value_type ty ] ])
           ]
       ]
 
@@ -514,7 +502,7 @@ let data_contents ctx contents =
       | DataI64 i -> Buffer.add_int64_le b i
       | DataBytes s -> Buffer.add_string b s
       | DataSym (symb, ofs) ->
-          Buffer.add_int32_le b (Int32.of_int (lookup_symbol ctx symb + ofs))
+          Buffer.add_int32_le b (Int32.of_int (lookup_symbol ctx (V symb) + ofs))
       | DataSpace n -> Buffer.add_string b (String.make n '\000'))
     contents;
   escape_string (Buffer.contents b)
@@ -524,21 +512,21 @@ let type_field { name; typ; supertype; final } =
   | `Binaryen ->
       List
         (Atom "type"
-        :: index (V name)
+        :: index name
         :: str_type typ
         ::
         (match supertype with
-        | Some supertype -> [ List [ Atom "extends"; index (V supertype) ] ]
+        | Some supertype -> [ List [ Atom "extends"; index supertype ] ]
         | None -> []))
   | `Reference ->
       List
         [ Atom "type"
-        ; index (V name)
+        ; index name
         ; List
             (Atom "sub"
             :: ((if final then [ Atom "final" ] else [])
                @ (match supertype with
-                 | Some supertype -> [ index (V supertype) ]
+                 | Some supertype -> [ index supertype ]
                  | None -> [])
                @ [ str_type typ ]))
         ]
@@ -548,14 +536,14 @@ let field ctx f =
   | Function { name; exported_name; typ; locals; body } ->
       [ funct ctx name exported_name typ locals body ]
   | Global { name; typ; init } ->
-      [ List (Atom "global" :: index name :: global_type typ :: expression ctx init) ]
+      [ List (Atom "global" :: symbol name :: global_type typ :: expression ctx init) ]
   | Tag { name; typ } ->
       [ List [ Atom "tag"; index name; List [ Atom "param"; value_type typ ] ] ]
   | Import _ -> []
   | Data { name; active; contents; _ } ->
       [ List
           (Atom "data"
-          :: index (V name)
+          :: index name
           :: ((if active
                then
                  expression ctx (Const (I32 (Int32.of_int (lookup_symbol ctx (V name)))))
@@ -598,7 +586,6 @@ let f fields =
     ; functions = Code.Var.Map.empty
     ; function_refs = Code.Var.Set.empty
     ; function_count = 0
-    ; constants = StringMap.singleton "__heap_base" heap_base
     }
   in
   let other_fields = List.concat (List.map ~f:(fun f -> field ctx f) fields) in
@@ -616,7 +603,7 @@ let f fields =
       [ List
           [ Atom "table"
           ; Atom "funcref"
-          ; List (Atom "elem" :: List.map ~f:(fun f -> index (V f)) functions)
+          ; List (Atom "elem" :: List.map ~f:index functions)
           ]
       ]
   in
@@ -630,11 +617,7 @@ let f fields =
     if List.is_empty functions
     then []
     else
-      [ List
-          (Atom "elem"
-          :: Atom "declare"
-          :: Atom "func"
-          :: List.map ~f:(fun f -> index (V f)) functions)
+      [ List (Atom "elem" :: Atom "declare" :: Atom "func" :: List.map ~f:index functions)
       ]
   in
   Format.printf

From f62102087876472c91fac0e23c4adb7dc99d7aa9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 21 Apr 2023 17:10:40 +0200
Subject: [PATCH 018/481] Implement some float operations

---
 compiler/lib/generate.ml            |  4 +-
 compiler/lib/specialize_js.ml       |  3 ++
 compiler/lib/wasm/wa_asm_output.ml  | 24 ++++-----
 compiler/lib/wasm/wa_ast.ml         | 11 +++--
 compiler/lib/wasm/wa_core_target.ml | 58 ++++++++++++++++++++++
 compiler/lib/wasm/wa_gc_target.ml   | 37 ++++++++++++++
 compiler/lib/wasm/wa_generate.ml    | 76 +++++++++++++++++++++++++++++
 compiler/lib/wasm/wa_target_sig.ml  | 18 +++++++
 compiler/lib/wasm/wa_wat_output.ml  | 24 ++++++---
 9 files changed, 231 insertions(+), 24 deletions(-)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index caef5e7462..b5092a7af4 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -2167,7 +2167,9 @@ let init () =
     ; "caml_int64_to_int", "caml_int64_to_int32"
     ; "caml_int64_of_nativeint", "caml_int64_of_int32"
     ; "caml_int64_to_nativeint", "caml_int64_to_int32"
-    ; "caml_float_of_int", "%identity"
+      (* ZZZ
+          ; "caml_float_of_int", "%identity"
+      *)
     ; "caml_array_get_float", "caml_array_get"
     ; "caml_floatarray_get", "caml_array_get"
     ; "caml_array_get_addr", "caml_array_get"
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 69bba0a5f0..2578168001 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -159,6 +159,7 @@ let specialize_instrs info l =
         match i with
         | Let (x, Prim (Extern "caml_array_get", [ y; z ]))
         | Let (x, Prim (Extern "caml_array_get_float", [ y; z ]))
+        | Let (x, Prim (Extern "caml_floatarray_get", [ y; z ]))
         | Let (x, Prim (Extern "caml_array_get_addr", [ y; z ])) ->
             let idx =
               match the_int info z with
@@ -181,6 +182,7 @@ let specialize_instrs info l =
               aux info ((y, idx) :: checks) r acc
         | Let (x, Prim (Extern "caml_array_set", [ y; z; t ]))
         | Let (x, Prim (Extern "caml_array_set_float", [ y; z; t ]))
+        | Let (x, Prim (Extern "caml_floatarray_set", [ y; z; t ]))
         | Let (x, Prim (Extern "caml_array_set_addr", [ y; z; t ])) ->
             let idx =
               match the_int info z with
@@ -232,6 +234,7 @@ let f_once p =
                      ( "caml_array_set"
                      | "caml_array_unsafe_set"
                      | "caml_array_set_float"
+                     | "caml_floatarray_set"
                      | "caml_array_set_addr"
                      | "caml_array_unsafe_set_float"
                      | "caml_floatarray_unsafe_set" )
diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 91b0c94a41..da3fdccd41 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -136,13 +136,6 @@ module Output () = struct
     | I64 _ -> string "i64."
     | F64 _ -> string "f64."
 
-  let int_un_op op =
-    match op with
-    | Clz -> "clz"
-    | Ctz -> "ctz"
-    | Popcnt -> "popcnt"
-    | Eqz -> "eqz"
-
   let signage op (s : Wa_ast.signage) =
     op
     ^
@@ -150,6 +143,14 @@ module Output () = struct
     | S -> "_s"
     | U -> "_u"
 
+  let int_un_op op =
+    match op with
+    | Clz -> "clz"
+    | Ctz -> "ctz"
+    | Popcnt -> "popcnt"
+    | Eqz -> "eqz"
+    | TruncF64 s -> signage "trunc_f64" s
+
   let int_bin_op (op : int_bin_op) =
     match op with
     | Add -> "add"
@@ -180,6 +181,8 @@ module Output () = struct
     | Trunc -> "trunc"
     | Nearest -> "nearest"
     | Sqrt -> "sqrt"
+    | ConvertI32 s -> signage "convert_i32" s
+    | ConvertI64 s -> signage "convert_i64" s
 
   let float_bin_op op =
     match op with
@@ -217,6 +220,8 @@ module Output () = struct
        then Int64.to_string i
        else Printf.sprintf "0x%Lx" i)
 
+  let float64 f = string (Printf.sprintf "%h" f) (*ZZZ nan with payload*)
+
   let index name = string (Code.Var.to_string name)
 
   let symbol name offset =
@@ -232,10 +237,7 @@ module Output () = struct
   let rec expression e =
     match e with
     | Const op ->
-        line
-          (type_prefix op
-          ^^ string "const "
-          ^^ select integer32 integer64 (fun f -> string (string_of_float f (*ZZZ*))) op)
+        line (type_prefix op ^^ string "const " ^^ select integer32 integer64 float64 op)
     | ConstSym (name, offset) ->
         line (type_prefix (I32 ()) ^^ string "const " ^^ symbol name offset)
     | UnOp (op, e') ->
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index dcd0385df6..2d113353f7 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -54,15 +54,16 @@ type ('i32, 'i64, 'f64) op =
   | I64 of 'i64
   | F64 of 'f64
 
+type signage =
+  | S
+  | U
+
 type int_un_op =
   | Clz
   | Ctz
   | Popcnt
   | Eqz
-
-type signage =
-  | S
-  | U
+  | TruncF64 of signage
 
 type int_bin_op =
   | Add
@@ -92,6 +93,8 @@ type float_un_op =
   | Trunc
   | Nearest
   | Sqrt
+  | ConvertI32 of signage
+  | ConvertI64 of signage
 
 type float_bin_op =
   | Add
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 63fb97482e..d5e4ca78fc 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -117,6 +117,36 @@ module Memory = struct
     return (`Index, e)
 
   let load_function_arity closure = Arith.(field closure 1 lsr const 24l)
+
+  let box_float stack_ctx x e =
+    let p = Code.Var.fresh_n "p" in
+    let size = 12 in
+    seq
+      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+       let* v =
+         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
+       in
+       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
+       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
+       Stack.kill_variables stack_ctx;
+       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
+       let* p = load p in
+       let* e = e in
+       instr (Store (F64 (Int32.of_int 4), p, e)))
+      Arith.(load p + const 4l)
+
+  let unbox_float e =
+    let* e = e in
+    match e with
+    | W.ConstSym (V x, 4) ->
+        let get_data l =
+          match l with
+          | [ W.DataI32 _; W.DataI64 f ] -> W.Const (F64 (Int64.float_of_bits f))
+          | _ -> assert false
+        in
+        let* _, l = get_data_segment x in
+        return (get_data l)
+    | _ -> return (W.Load (F64 0l, e))
 end
 
 module Value = struct
@@ -385,6 +415,34 @@ module Closure = struct
     return (Memory.field (load closure) 3, Memory.field (load closure) 4, None)
 end
 
+module Math = struct
+  let float_func_type n =
+    { W.params = List.init ~len:n ~f:(fun _ : W.value_type -> F64); result = [ F64 ] }
+
+  let unary name x =
+    let* f = register_import ~name (Fun (float_func_type 1)) in
+    let* x = x in
+    return (W.Call (f, [ x ]))
+
+  let cos f = unary "cos" f
+
+  let sin f = unary "sin" f
+
+  let asin f = unary "asin" f
+
+  let binary name x y =
+    let* f = register_import ~name (Fun (float_func_type 2)) in
+    let* x = x in
+    let* y = y in
+    return (W.Call (f, [ x; y ]))
+
+  let atan2 f g = binary "atan2" f g
+
+  let power f g = binary "pow" f g
+
+  let fmod f g = binary "fmod" f g
+end
+
 let entry_point ~context:_ =
   let declare_global name =
     register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index c0677463a3..2dde30f954 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -338,6 +338,15 @@ module Memory = struct
   let load_function_arity closure =
     let* ty = Type.closure_type_1 in
     wasm_struct_get ty (wasm_cast ty closure) 0
+
+  let box_float _ _ e =
+    let* ty = Type.float_type in
+    let* e = e in
+    return (W.StructNew (ty, [ e ]))
+
+  let unbox_float e =
+    let* ty = Type.float_type in
+    wasm_struct_get ty (wasm_cast ty e) 0
 end
 
 module Constant = struct
@@ -643,4 +652,32 @@ module Stack = struct
   let stack_adjustment_needed _ ~src:_ ~dst:_ = false
 end
 
+module Math = struct
+  let float_func_type n =
+    { W.params = List.init ~len:n ~f:(fun _ : W.value_type -> F64); result = [ F64 ] }
+
+  let unary name x =
+    let* f = register_import ~import_module:"Math" ~name (Fun (float_func_type 1)) in
+    let* x = x in
+    return (W.Call (f, [ x ]))
+
+  let cos f = unary "cos" f
+
+  let sin f = unary "sin" f
+
+  let asin f = unary "asin" f
+
+  let binary name x y =
+    let* f = register_import ~import_module:"Math" ~name (Fun (float_func_type 2)) in
+    let* x = x in
+    let* y = y in
+    return (W.Call (f, [ x; y ]))
+
+  let atan2 f g = binary "atan2" f g
+
+  let power f g = binary "pow" f g
+
+  let fmod f g = binary "fmod" f g
+end
+
 let entry_point ~context = init_code context
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index e2156d8289..30d2ed2469 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -23,6 +23,26 @@ module Generate (Target : Wa_target_sig.S) = struct
   let func_type n =
     { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
 
+  let float_bin_op' stack_ctx x op f g =
+    Memory.box_float stack_ctx x (op (Memory.unbox_float f) (Memory.unbox_float g))
+
+  let float_bin_op stack_ctx x op f g =
+    let* f = Memory.unbox_float f in
+    let* g = Memory.unbox_float g in
+    Memory.box_float stack_ctx x (return (W.BinOp (F64 op, f, g)))
+
+  let float_un_op' stack_ctx x op f =
+    Memory.box_float stack_ctx x (op (Memory.unbox_float f))
+
+  let float_un_op stack_ctx x op f =
+    let* f = Memory.unbox_float f in
+    Memory.box_float stack_ctx x (return (W.UnOp (F64 op, f)))
+
+  let float_comparison op f g =
+    let* f = Memory.unbox_float f in
+    let* g = Memory.unbox_float g in
+    Value.val_int (return (W.BinOp (F64 op, f, g)))
+
   let rec translate_expr ctx stack_ctx x e =
     match e with
     | Apply { f; args; exact } when exact || List.length args = 1 ->
@@ -86,7 +106,33 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
         | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
         | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y
+        | Extern "%int_div", [ x; y ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            seq
+              (if_
+                 { params = []; result = [] }
+                 (Arith.eqz (Value.int_val y))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              (Value.int_div x y)
         | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
+        | Extern "%int_mod", [ x; y ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            seq
+              (if_
+                 { params = []; result = [] }
+                 (Arith.eqz (Value.int_val y))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              (Value.int_mod x y)
         | Extern "%int_neg", [ x ] -> Value.int_neg x
         | Extern "%int_or", [ x; y ] -> Value.int_or x y
         | Extern "%int_and", [ x; y ] -> Value.int_and x y
@@ -107,6 +153,36 @@ module Generate (Target : Wa_target_sig.S) = struct
                  (instr (CallInstr (f, [])))
                  (return ()))
               x
+        | Extern "caml_add_float", [ f; g ] -> float_bin_op stack_ctx x Add f g
+        | Extern "caml_sub_float", [ f; g ] -> float_bin_op stack_ctx x Sub f g
+        | Extern "caml_mul_float", [ f; g ] -> float_bin_op stack_ctx x Mul f g
+        | Extern "caml_div_float", [ f; g ] -> float_bin_op stack_ctx x Div f g
+        | Extern "caml_copysign_float", [ f; g ] -> float_bin_op stack_ctx x CopySign f g
+        | Extern "caml_neg_float", [ f ] -> float_un_op stack_ctx x Neg f
+        | Extern "caml_abs_float", [ f ] -> float_un_op stack_ctx x Abs f
+        | Extern "caml_ceil_float", [ f ] -> float_un_op stack_ctx x Ceil f
+        | Extern "caml_floor_float", [ f ] -> float_un_op stack_ctx x Floor f
+        | Extern "caml_trunc_float", [ f ] -> float_un_op stack_ctx x Trunc f
+        | Extern "caml_round_float", [ f ] -> float_un_op stack_ctx x Nearest f
+        | Extern "caml_sqrt_float", [ f ] -> float_un_op stack_ctx x Sqrt f
+        | Extern "caml_eq_float", [ f; g ] -> float_comparison Eq f g
+        | Extern "caml_neq_float", [ f; g ] -> float_comparison Ne f g
+        | Extern "caml_ge_float", [ f; g ] -> float_comparison Ge f g
+        | Extern "caml_le_float", [ f; g ] -> float_comparison Le f g
+        | Extern "caml_gt_float", [ f; g ] -> float_comparison Gt f g
+        | Extern "caml_lt_float", [ f; g ] -> float_comparison Lt f g
+        | Extern "caml_int_of_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            Value.val_int (return (W.UnOp (I32 (TruncF64 S), f)))
+        | Extern "caml_float_of_int", [ n ] ->
+            let* n = Value.int_val n in
+            Memory.box_float stack_ctx x (return (W.UnOp (F64 (ConvertI32 S), n)))
+        | Extern "caml_cos_float", [ f ] -> float_un_op' stack_ctx x Math.cos f
+        | Extern "caml_sin_float", [ f ] -> float_un_op' stack_ctx x Math.sin f
+        | Extern "caml_asin_float", [ f ] -> float_un_op' stack_ctx x Math.asin f
+        | Extern "caml_atan2_float", [ f; g ] -> float_bin_op' stack_ctx x Math.atan2 f g
+        | Extern "caml_power_float", [ f; g ] -> float_bin_op' stack_ctx x Math.power f g
+        | Extern "caml_fmod_float", [ f; g ] -> float_bin_op' stack_ctx x Math.fmod f g
         | Extern name, l ->
             (*ZZZ Different calling convention when large number of parameters *)
             let* f = register_import ~name (Fun (func_type (List.length l))) in
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index ae154b69d2..e8ca769942 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -82,6 +82,10 @@ module type S = sig
     val bytes_set : expression -> expression -> expression -> unit Wa_code_generation.t
 
     val block_length : expression -> expression
+
+    val box_float : Stack.ctx -> Code.Var.t -> expression -> expression
+
+    val unbox_float : expression -> expression
   end
 
   module Value : sig
@@ -173,5 +177,19 @@ module type S = sig
       -> (expression * expression * Wa_ast.value_type option) Wa_code_generation.t
   end
 
+  module Math : sig
+    val cos : expression -> expression
+
+    val sin : expression -> expression
+
+    val asin : expression -> expression
+
+    val atan2 : expression -> expression -> expression
+
+    val power : expression -> expression -> expression
+
+    val fmod : expression -> expression -> expression
+  end
+
   val entry_point : context:Wa_code_generation.context -> unit Wa_code_generation.t
 end
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 95cbf1203b..f7ee4c723f 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -95,13 +95,6 @@ let type_prefix op nm =
   | F64 _ -> "f64.")
   ^ nm
 
-let int_un_op op =
-  match op with
-  | Clz -> "clz"
-  | Ctz -> "ctz"
-  | Popcnt -> "popcnt"
-  | Eqz -> "eqz"
-
 let signage op (s : Wa_ast.signage) =
   op
   ^
@@ -109,6 +102,14 @@ let signage op (s : Wa_ast.signage) =
   | S -> "_s"
   | U -> "_u"
 
+let int_un_op op =
+  match op with
+  | Clz -> "clz"
+  | Ctz -> "ctz"
+  | Popcnt -> "popcnt"
+  | Eqz -> "eqz"
+  | TruncF64 s -> signage "trunc_f64" s
+
 let int_bin_op (op : int_bin_op) =
   match op with
   | Add -> "add"
@@ -139,6 +140,8 @@ let float_un_op op =
   | Trunc -> "trunc"
   | Nearest -> "nearest"
   | Sqrt -> "sqrt"
+  | ConvertI32 s -> signage "convert_i32" s
+  | ConvertI64 s -> signage "convert_i64" s
 
 let float_bin_op op =
   match op with
@@ -186,13 +189,18 @@ let lookup_symbol ctx (x : symbol) =
 
 let remove_nops l = List.filter ~f:(fun i -> not (Poly.equal i Nop)) l
 
+let float64 f =
+  if Float.equal (1. /. f) 0.
+  then if Float.( < ) f 0. then "-inf" else "inf"
+  else Printf.sprintf "%h" f (*ZZZ nan with payload*)
+
 let expression_or_instructions ctx in_function =
   let rec expression e =
     match e with
     | Const op ->
         [ List
             [ Atom (type_prefix op "const")
-            ; Atom (select Int32.to_string Int64.to_string string_of_float (*ZZZ*) op)
+            ; Atom (select Int32.to_string Int64.to_string float64 op)
             ]
         ]
     | ConstSym (symb, ofs) ->

From 7376bbfa708a7a0dcf6f1394131f35a7343767db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 21 Apr 2023 17:45:32 +0200
Subject: [PATCH 019/481] Minimal runtime

---
 runtime/wasm/run.js      |  21 ++++++++
 runtime/wasm/runtime.wat | 106 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 127 insertions(+)
 create mode 100644 runtime/wasm/run.js
 create mode 100644 runtime/wasm/runtime.wat

diff --git a/runtime/wasm/run.js b/runtime/wasm/run.js
new file mode 100644
index 0000000000..703f2fc47b
--- /dev/null
+++ b/runtime/wasm/run.js
@@ -0,0 +1,21 @@
+const fs = require('fs/promises');
+const path = require('path');
+
+async function main() {
+    const runtimePath =
+          path.resolve(path.dirname(process.argv[1]), 'runtime.wasm');
+    const runtime = fs.readFile(runtimePath);
+    const code = fs.readFile(process.argv[2]);
+    let math =
+        {cos:Math.cos, sin:Math.sin, asin:Math.asin, atan2:Math.atan2,
+         pow:Math.pow, fmod:(x, y) => x%y}
+    const runtimeModule =
+          await WebAssembly.instantiate(await runtime, {Math:math});
+    const wasmModule =
+          await WebAssembly.instantiate(await code,
+                                        {env:runtimeModule.instance.exports,
+                                         Math:math})
+    wasmModule.instance.exports._initialize()
+}
+
+main ()
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
new file mode 100644
index 0000000000..a08616d8ad
--- /dev/null
+++ b/runtime/wasm/runtime.wat
@@ -0,0 +1,106 @@
+(module
+   (tag (export "ocaml_exception") (param (ref eq)))
+
+   (type $block (array (mut (ref eq))))
+
+   (type $string (array (mut i8)))
+
+   (func (export "caml_make_vect")
+      (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
+      ;; ZZZ check that $n >= 0
+      (local $sz i32) (local $b (ref $block))
+      (local.set $sz (i32.add (i31.get_s (ref.cast i31 (local.get $n)))
+                              (i32.const 1)))
+      (local.set $b (array.new $block (local.get $v) (local.get $sz)))
+      (array.set $block (local.get $b) (i32.const 0) (i31.new (i32.const 0)))
+      (local.get $b))
+
+   (func (export "caml_fs_init") (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_flush") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_open_descriptor_in")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_open_descriptor_out")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_out_channels_list")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_register_global")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_register_named_value")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_int_of_string")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_array_bound_error")
+      ;; ZZZ
+      (unreachable))
+
+   (func (export "caml_raise_zero_divide")
+      ;; ZZZ
+      (unreachable))
+
+   (global $caml_oo_last_id (mut i32) (i32.const 0))
+
+   (func (export "caml_fresh_oo_id") (param (ref eq)) (result (ref eq))
+      (local $id i32)
+      (local.set $id (global.get $caml_oo_last_id))
+      (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
+      (i31.new (local.get $id)))
+
+   (func (export "caml_obj_dup") (param (ref eq)) (result (ref eq))
+      ;; ZZZ Deal with non-block values?
+      (local $orig (ref $block))
+      (local $res (ref $block))
+      (local $len i32)
+      (local $i i32)
+      (local.set $orig (ref.cast $block (local.get 0)))
+      (local.set $len (array.len (local.get $orig)))
+      (local.set $res
+         (array.new $block (array.get $block (local.get $orig) (i32.const 0))
+            (local.get $len)))
+      (local.set $i (i32.const 1))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (array.set $block (local.get $res) (local.get $i)
+                  (array.get $block (local.get $orig) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $res))
+
+   (func (export "caml_string_equal")
+      (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
+      (local $s1 (ref $string)) (local $s2 (ref $string))
+      (local $len i32) (local $i i32)
+      (if (ref.eq (local.get $p1) (local.get $p2))
+         (then (return (i31.new (i32.const 1)))))
+      (local.set $s1 (ref.cast $string (local.get $p1)))
+      (local.set $s2 (ref.cast $string (local.get $p2)))
+      (local.set $len (array.len $string (local.get $s1)))
+      (if (i32.ne (local.get $len) (array.len $string (local.get $s2)))
+         (then (return (i31.new (i32.const 0)))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (if (i32.ne (array.get_u $string (local.get $s1) (local.get $i))
+                           (array.get_u $string (local.get $s2) (local.get $i)))
+                  (then (return (i31.new (i32.const 0)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (i32.const 1)))
+)

From 8ff4ba6c274ffa03dbfad934c439f019a4f27219 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 5 May 2023 13:34:15 +0200
Subject: [PATCH 020/481] AST fixes

---
 compiler/lib/wasm/wa_asm_output.ml  | 24 ++++++++++++-------
 compiler/lib/wasm/wa_ast.ml         | 17 +++++++------
 compiler/lib/wasm/wa_core_target.ml | 18 +++++++-------
 compiler/lib/wasm/wa_gc_target.ml   |  4 ++--
 compiler/lib/wasm/wa_generate.ml    |  4 ++--
 compiler/lib/wasm/wa_wat_output.ml  | 37 +++++++++++------------------
 6 files changed, 53 insertions(+), 51 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index da3fdccd41..949ff74348 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -104,6 +104,8 @@ module Output () = struct
 
   let features = Feature.make ()
 
+  let nontrapping_fptoint = Feature.register features "nontrapping-fptoint"
+
   let exception_handling = Feature.register features "exception-handling"
 
   let tail_call = Feature.register features "tail-call"
@@ -114,7 +116,7 @@ module Output () = struct
       | I32 -> "i32"
       | I64 -> "i64"
       | F64 -> "f64"
-      | Ref _ -> assert false (* Not supported*))
+      | Ref _ -> assert false (* Not supported *))
 
   let func_type { params; result } =
     assert (List.length result <= 1);
@@ -149,7 +151,10 @@ module Output () = struct
     | Ctz -> "ctz"
     | Popcnt -> "popcnt"
     | Eqz -> "eqz"
-    | TruncF64 s -> signage "trunc_f64" s
+    | TruncSatF64 s ->
+        Feature.require nontrapping_fptoint;
+        signage "trunc_sat_f64" s
+    | ReinterpretF64 -> "reinterpret_f64"
 
   let int_bin_op (op : int_bin_op) =
     match op with
@@ -181,8 +186,10 @@ module Output () = struct
     | Trunc -> "trunc"
     | Nearest -> "nearest"
     | Sqrt -> "sqrt"
-    | ConvertI32 s -> signage "convert_i32" s
-    | ConvertI64 s -> signage "convert_i64" s
+    | Convert (`I32, s) -> signage "convert_i32" s
+    | Convert (`I64, s) -> signage "convert_i64" s
+    | Reinterpret `I32 -> "reinterpret_i32"
+    | Reinterpret `I64 -> "reinterpret_i64"
 
   let float_bin_op op =
     match op with
@@ -247,6 +254,8 @@ module Output () = struct
         expression e1
         ^^ expression e2
         ^^ line (type_prefix op ^^ string (select int_bin_op int_bin_op float_bin_op op))
+    | I32WrapI64 e -> expression e ^^ line (string "i32.wrap_i64")
+    | I64ExtendI32 (s, e) -> expression e ^^ line (string (signage "i64.extend_i32" s))
     | Load (offset, e') ->
         expression e'
         ^^ line
@@ -299,13 +308,12 @@ module Output () = struct
              (type_prefix offset
              ^^ string "store "
              ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
-    | Store8 (s, offset, e, e') ->
+    | Store8 (offset, e, e') ->
         expression e
         ^^ expression e'
         ^^ line
              (type_prefix offset
-             ^^ string (signage "store8" s)
-             ^^ string " "
+             ^^ string "store8 "
              ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
     | LocalSet (i, e) -> expression e ^^ line (string "local.set " ^^ integer i)
     | GlobalSet (nm, e) -> expression e ^^ line (string "global.set " ^^ symbol nm 0)
@@ -533,7 +541,7 @@ module Output () = struct
                               ^^ string (escape_string b)
                               ^^ string "\""
                           | DataSym (name, offset) ->
-                              string ".int32 " ^^ symbol (V name) offset
+                              string ".int32 " ^^ symbol name offset
                           | DataSpace n -> string ".space " ^^ integer n))
                       contents)
           | Global { name; _ } ->
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 2d113353f7..df610a5052 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -63,7 +63,8 @@ type int_un_op =
   | Ctz
   | Popcnt
   | Eqz
-  | TruncF64 of signage
+  | TruncSatF64 of signage
+  | ReinterpretF64
 
 type int_bin_op =
   | Add
@@ -93,8 +94,8 @@ type float_un_op =
   | Trunc
   | Nearest
   | Sqrt
-  | ConvertI32 of signage
-  | ConvertI64 of signage
+  | Convert of [ `I32 | `I64 ] * signage
+  | Reinterpret of [ `I32 | `I64 ]
 
 type float_bin_op =
   | Add
@@ -118,6 +119,8 @@ type expression =
   | ConstSym of symbol * int
   | UnOp of (int_un_op, int_un_op, float_un_op) op * expression
   | BinOp of (int_bin_op, int_bin_op, float_bin_op) op * expression * expression
+  | I32WrapI64 of expression
+  | I64ExtendI32 of signage * expression
   | Load of (memarg, memarg, memarg) op * expression
   | Load8 of signage * (memarg, memarg, memarg) op * expression
   | LocalGet of int
@@ -149,7 +152,7 @@ type expression =
 and instruction =
   | Drop of expression
   | Store of (memarg, memarg, memarg) op * expression * expression
-  | Store8 of signage * (memarg, memarg, memarg) op * expression * expression
+  | Store8 of (memarg, memarg, memarg) op * expression * expression
   | LocalSet of int * expression
   | GlobalSet of symbol * expression
   | Loop of func_type * instruction list
@@ -168,8 +171,8 @@ and instruction =
       * instruction list option
   | Throw of var * expression
   | Rethrow of int
-  | ArraySet of signage option * var * expression * expression * expression
-  | StructSet of signage option * var * int * expression * expression
+  | ArraySet of var * expression * expression * expression
+  | StructSet of var * int * expression * expression
   | Br_on_cast of int * ref_type * ref_type * expression
   | Br_on_cast_fail of int * ref_type * ref_type * expression
   | Return_call_indirect of func_type * expression * expression list
@@ -185,7 +188,7 @@ type data =
   | DataI32 of int32
   | DataI64 of int64
   | DataBytes of string
-  | DataSym of var * int
+  | DataSym of symbol * int
   | DataSpace of int
 
 type type_field =
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index d5e4ca78fc..e1c7bc892c 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -16,7 +16,7 @@ module Memory = struct
           match l with
           | [] -> assert false
           | W.DataI32 i :: _ when offset = 0 -> W.Const (I32 i)
-          | W.DataSym (sym, ofs) :: _ when offset = 0 -> W.ConstSym (V sym, ofs)
+          | W.DataSym (sym, ofs) :: _ when offset = 0 -> W.ConstSym (sym, ofs)
           | (W.DataI32 _ | DataSym _) :: r -> get_data (offset - 4) r
           | (DataI8 _ | DataBytes _ | DataSpace _ | DataI64 _) :: _ -> assert false
         in
@@ -106,7 +106,7 @@ module Memory = struct
   let bytes_set e e' e'' =
     let* addr = Arith.(e + e' - const 1l) in
     let* e'' = e'' in
-    instr (W.Store8 (U, I32 (Int32.of_int 0), addr, e''))
+    instr (W.Store8 (I32 (Int32.of_int 0), addr, e''))
 
   let field e idx = mem_load ~offset:(4 * idx) e
 
@@ -212,7 +212,7 @@ module Constant = struct
           W.DataI32 h :: List.map ~f:(fun c -> translate_rec context c) (Array.to_list a)
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (name, 4)
+        W.DataSym (V name, 4)
     | NativeString (Byte s | Utf (Utf8 s)) | String s ->
         let l = String.length s in
         let len = (l + 4) / 4 in
@@ -226,13 +226,13 @@ module Constant = struct
         in
         context.data_segments <-
           Code.Var.Map.add name (true, string) context.data_segments;
-        W.DataSym (name, 4)
+        W.DataSym (V name, 4)
     | Float f ->
         let h = Memory.header ~const:true ~tag:Obj.double_tag ~len:2 () in
         let name = Code.Var.fresh_n "float" in
         let block = [ W.DataI32 h; DataI64 (Int64.bits_of_float f) ] in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (name, 4)
+        W.DataSym (V name, 4)
     | Float_array l ->
         (*ZZZ Boxed array? *)
         let l = Array.to_list l in
@@ -244,7 +244,7 @@ module Constant = struct
           W.DataI32 h :: List.map ~f:(fun f -> translate_rec context (Float f)) l
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (name, 4)
+        W.DataSym (V name, 4)
     | Int64 i ->
         let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:3 () in
         let name = Code.Var.fresh_n "int64" in
@@ -252,13 +252,13 @@ module Constant = struct
           [ W.DataI32 h; DataI32 0l (*ZZZ DataSym (S "caml_int64_ops", 0)*); DataI64 i ]
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (name, 4)
+        W.DataSym (V name, 4)
 
   let translate c =
     let* context = get_context in
     return
       (match translate_rec context c with
-      | W.DataSym (name, offset) -> W.ConstSym (V name, offset)
+      | W.DataSym (name, offset) -> W.ConstSym (name, offset)
       | W.DataI32 i -> W.Const (I32 i)
       | _ -> assert false)
 end
@@ -335,7 +335,7 @@ module Closure = struct
             ~f:(fun e ->
               match e with
               | W.Const (I32 i) -> W.DataI32 i
-              | ConstSym (V sym, offset) -> DataSym (sym, offset)
+              | ConstSym (sym, offset) -> DataSym (sym, offset)
               | _ -> assert false)
             start
         in
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 2dde30f954..02ad31d114 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -292,7 +292,7 @@ module Memory = struct
   let wasm_struct_set ty e i e' =
     let* e = e in
     let* e' = e' in
-    instr (W.StructSet (None, ty, i, e, e'))
+    instr (W.StructSet (ty, i, e, e'))
 
   let wasm_array_get ?(ty = Type.block_type) e e' =
     let* ty = ty in
@@ -305,7 +305,7 @@ module Memory = struct
     let* e = wasm_cast ty e in
     let* e' = e' in
     let* e'' = e'' in
-    instr (W.ArraySet (None, ty, e, e', e''))
+    instr (W.ArraySet (ty, e, e', e''))
 
   let tag e = Value.int_val (wasm_array_get e (Arith.const 0l))
 
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 30d2ed2469..95852d65be 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -173,10 +173,10 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_lt_float", [ f; g ] -> float_comparison Lt f g
         | Extern "caml_int_of_float", [ f ] ->
             let* f = Memory.unbox_float f in
-            Value.val_int (return (W.UnOp (I32 (TruncF64 S), f)))
+            Value.val_int (return (W.UnOp (I32 (TruncSatF64 S), f)))
         | Extern "caml_float_of_int", [ n ] ->
             let* n = Value.int_val n in
-            Memory.box_float stack_ctx x (return (W.UnOp (F64 (ConvertI32 S), n)))
+            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I32, S)), n)))
         | Extern "caml_cos_float", [ f ] -> float_un_op' stack_ctx x Math.cos f
         | Extern "caml_sin_float", [ f ] -> float_un_op' stack_ctx x Math.sin f
         | Extern "caml_asin_float", [ f ] -> float_un_op' stack_ctx x Math.asin f
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index f7ee4c723f..5f20c5651f 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -108,7 +108,8 @@ let int_un_op op =
   | Ctz -> "ctz"
   | Popcnt -> "popcnt"
   | Eqz -> "eqz"
-  | TruncF64 s -> signage "trunc_f64" s
+  | TruncSatF64 s -> signage "trunc_sat_f64" s
+  | ReinterpretF64 -> "reinterpret_f64"
 
 let int_bin_op (op : int_bin_op) =
   match op with
@@ -140,8 +141,10 @@ let float_un_op op =
   | Trunc -> "trunc"
   | Nearest -> "nearest"
   | Sqrt -> "sqrt"
-  | ConvertI32 s -> signage "convert_i32" s
-  | ConvertI64 s -> signage "convert_i64" s
+  | Convert (`I32, s) -> signage "convert_i32" s
+  | Convert (`I64, s) -> signage "convert_i64" s
+  | Reinterpret `I32 -> "reinterpret_i32"
+  | Reinterpret `I64 -> "reinterpret_i64"
 
 let float_bin_op op =
   match op with
@@ -216,6 +219,8 @@ let expression_or_instructions ctx in_function =
             (Atom (type_prefix op (select int_bin_op int_bin_op float_bin_op op))
             :: (expression e1 @ expression e2))
         ]
+    | I32WrapI64 e -> [ List (Atom "i32.wrap_i64" :: expression e) ]
+    | I64ExtendI32 (s, e) -> [ List (Atom (signage "i64.extend_i32" s) :: expression e) ]
     | Load (offset, e') ->
         let offs i =
           if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
@@ -321,16 +326,15 @@ let expression_or_instructions ctx in_function =
             (Atom (type_prefix offset "store")
             :: (select offs offs offs offset @ expression e1 @ expression e2))
         ]
-    | Store8 (s, offset, e1, e2) ->
+    | Store8 (offset, e1, e2) ->
         let offs i =
           if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
         in
         [ List
-            (Atom (type_prefix offset (signage "store8" s))
+            (Atom (type_prefix offset "store8")
             :: (select offs offs offs offset @ expression e1 @ expression e2))
         ]
-    | LocalSet (i, Seq (l, e)) when Poly.equal target `Binaryen ->
-        instructions (l @ [ LocalSet (i, e) ])
+    | LocalSet (i, Seq (l, e)) -> instructions (l @ [ LocalSet (i, e) ])
     | LocalSet (i, e) ->
         [ List (Atom "local.set" :: Atom (string_of_int i) :: expression e) ]
     | GlobalSet (nm, e) -> [ List (Atom "global.set" :: symbol nm :: expression e) ]
@@ -390,32 +394,19 @@ let expression_or_instructions ctx in_function =
         [ List (Atom "call" :: index f :: List.concat (List.map ~f:expression l)) ]
     | Nop -> []
     | Push e -> expression e
-    | ArraySet (None, typ, e, e', e'') ->
+    | ArraySet (typ, e, e', e'') ->
         [ List
             (Atom "array.set"
             :: index typ
             :: (expression e @ expression e' @ expression e''))
         ]
-    | ArraySet (Some s, typ, e, e', e'') ->
-        [ List
-            (Atom (signage "array.set" s)
-            :: index typ
-            :: (expression e @ expression e' @ expression e''))
-        ]
-    | StructSet (None, typ, i, e, e') ->
+    | StructSet (typ, i, e, e') ->
         [ List
             (Atom "struct.set"
             :: index typ
             :: Atom (string_of_int i)
             :: (expression e @ expression e'))
         ]
-    | StructSet (Some s, typ, i, e, e') ->
-        [ List
-            (Atom (signage "struct.set" s)
-            :: index typ
-            :: Atom (string_of_int i)
-            :: (expression e @ expression e'))
-        ]
     | Br_on_cast (i, ty, ty', e) -> (
         match target with
         | `Binaryen ->
@@ -510,7 +501,7 @@ let data_contents ctx contents =
       | DataI64 i -> Buffer.add_int64_le b i
       | DataBytes s -> Buffer.add_string b s
       | DataSym (symb, ofs) ->
-          Buffer.add_int32_le b (Int32.of_int (lookup_symbol ctx (V symb) + ofs))
+          Buffer.add_int32_le b (Int32.of_int (lookup_symbol ctx symb + ofs))
       | DataSpace n -> Buffer.add_string b (String.make n '\000'))
     contents;
   escape_string (Buffer.contents b)

From d8f117023b06cfed96e8d82c5f520fa9c86e6061 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 5 May 2023 13:55:30 +0200
Subject: [PATCH 021/481] Implement some int64 operations

---
 compiler/lib/wasm/wa_asm_output.ml  | 12 ++++-
 compiler/lib/wasm/wa_ast.ml         |  1 +
 compiler/lib/wasm/wa_core_target.ml | 35 ++++++++++++--
 compiler/lib/wasm/wa_gc_target.ml   | 72 +++++++++++++++++++++++++++--
 compiler/lib/wasm/wa_generate.ml    | 71 ++++++++++++++++++++++++++++
 compiler/lib/wasm/wa_target_sig.ml  |  4 ++
 compiler/lib/wasm/wa_wat_output.ml  |  1 +
 runtime/wasm/runtime.wat            | 47 +++++++++++++++++++
 8 files changed, 233 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 949ff74348..aec7b7e4cc 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -104,6 +104,8 @@ module Output () = struct
 
   let features = Feature.make ()
 
+  let mutable_globals = Feature.register features "mutable-globals"
+
   let nontrapping_fptoint = Feature.register features "nontrapping-fptoint"
 
   let exception_handling = Feature.register features "exception-handling"
@@ -443,7 +445,8 @@ module Output () = struct
           | Function { name; typ; _ } -> Some (name, typ, None)
           | Import { import_module; import_name; name; desc = Fun typ } ->
               Some (name, typ, Some (import_module, import_name))
-          | Import { desc = Tag _; _ } | Data _ | Global _ | Tag _ | Type _ -> None)
+          | Import { desc = Global _ | Tag _; _ } | Data _ | Global _ | Tag _ | Type _ ->
+              None)
         fields
     in
     let globals =
@@ -452,6 +455,9 @@ module Output () = struct
           match f with
           | Function _ | Import { desc = Fun _ | Tag _; _ } | Data _ | Tag _ | Type _ ->
               None
+          | Import { import_module; import_name; name; desc = Global typ } ->
+              if typ.mut then Feature.require mutable_globals;
+              Some (V name, typ, Some (import_module, import_name))
           | Global { name; typ; init } ->
               assert (Poly.equal init (Const (I32 0l)));
               Some (name, typ, None))
@@ -461,7 +467,9 @@ module Output () = struct
       List.filter_map
         ~f:(fun f ->
           match f with
-          | Function _ | Import { desc = Fun _; _ } | Data _ | Global _ | Type _ -> None
+          | Function _
+          | Import { desc = Fun _ | Global _; _ }
+          | Data _ | Global _ | Type _ -> None
           | Import { import_module; import_name; name; desc = Tag typ } ->
               Some (name, typ, Some (import_module, import_name))
           | Tag { name; typ } ->
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index df610a5052..cf495886c2 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -181,6 +181,7 @@ and instruction =
 
 type import_desc =
   | Fun of func_type
+  | Global of global_type
   | Tag of value_type
 
 type data =
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index e1c7bc892c..6e5519a752 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -147,6 +147,37 @@ module Memory = struct
         let* _, l = get_data_segment x in
         return (get_data l)
     | _ -> return (W.Load (F64 0l, e))
+
+  let box_int64 stack_ctx x e =
+    let p = Code.Var.fresh_n "p" in
+    let size = 16 in
+    seq
+      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+       let* v =
+         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
+       in
+       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
+       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
+       Stack.kill_variables stack_ctx;
+       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
+       let* p = load p in
+       let* () = instr (Store (I32 4l, p, ConstSym (S "int64_ops", 0))) in
+       let* e = e in
+       instr (Store (I64 8l, p, e)))
+      Arith.(load p + const 4l)
+
+  let unbox_int64 e =
+    let* e = e in
+    match e with
+    | W.ConstSym (V x, 4) ->
+        let get_data l =
+          match l with
+          | [ W.DataI32 _; W.DataSym _; W.DataI64 f ] -> W.Const (I64 f)
+          | _ -> assert false
+        in
+        let* _, l = get_data_segment x in
+        return (get_data l)
+    | _ -> return (W.Load (F64 4l, e))
 end
 
 module Value = struct
@@ -248,9 +279,7 @@ module Constant = struct
     | Int64 i ->
         let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:3 () in
         let name = Code.Var.fresh_n "int64" in
-        let block =
-          [ W.DataI32 h; DataI32 0l (*ZZZ DataSym (S "caml_int64_ops", 0)*); DataI64 i ]
-        in
+        let block = [ W.DataI32 h; DataSym (S "caml_int64_ops", 0); DataI64 i ] in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
         W.DataSym (V name, 4)
 
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 02ad31d114..b46a7ded40 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -31,12 +31,56 @@ module Type = struct
           ; typ = W.Struct [ { mut = false; typ = Value F64 } ]
           })
 
-  let int64_type =
-    register_type "int64" (fun () ->
+  let compare_ext_type =
+    register_type "compare_ext" (fun () ->
         return
           { supertype = None
           ; final = true
-          ; typ = W.Struct [ { mut = false; typ = Value I64 } ]
+          ; typ = W.Func { W.params = [ value; value ]; result = [ I32 ] }
+          })
+
+  let custom_operations_type =
+    register_type "custom_operations" (fun () ->
+        let* compare_ext = compare_ext_type in
+        return
+          { supertype = None
+          ; final = true
+          ; typ =
+              W.Struct
+                [ { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type compare_ext })
+                  }
+                ]
+          })
+
+  let custom_type =
+    register_type "custom" (fun () ->
+        let* custom_operations = custom_operations_type in
+        return
+          { supertype = None
+          ; final = false
+          ; typ =
+              W.Struct
+                [ { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type custom_operations })
+                  }
+                ]
+          })
+
+  let int64_type =
+    register_type "int64" (fun () ->
+        let* custom_operations = custom_operations_type in
+        let* custom = custom_type in
+        return
+          { supertype = Some custom
+          ; final = false
+          ; typ =
+              W.Struct
+                [ { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type custom_operations })
+                  }
+                ; { mut = false; typ = Value I64 }
+                ]
           })
 
   let func_type n =
@@ -347,6 +391,24 @@ module Memory = struct
   let unbox_float e =
     let* ty = Type.float_type in
     wasm_struct_get ty (wasm_cast ty e) 0
+
+  let make_int64 e =
+    let* custom_operations = Type.custom_operations_type in
+    let* int64_ops =
+      register_import
+        ~name:"int64_ops"
+        (Global
+           { mut = false; typ = Ref { nullable = false; typ = Type custom_operations } })
+    in
+    let* ty = Type.int64_type in
+    let* e = e in
+    return (W.StructNew (ty, [ GlobalGet (V int64_ops); e ]))
+
+  let box_int64 _ _ e = make_int64 e
+
+  let unbox_int64 e =
+    let* ty = Type.int64_type in
+    wasm_struct_get ty (wasm_cast ty e) 1
 end
 
 module Constant = struct
@@ -433,8 +495,8 @@ module Constant = struct
               , I31New (Const (I32 (Int32.of_int Obj.double_array_tag)))
                 :: List.map ~f:(fun f -> W.StructNew (ty, [ Const (F64 f) ])) l ) )
     | Int64 i ->
-        let* ty = Type.int64_type in
-        return (true, W.StructNew (ty, [ Const (I64 i) ]))
+        let* e = Memory.make_int64 (return (W.Const (I64 i))) in
+        return (true, e)
 
   let translate c =
     let* const, c = translate_rec c in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 95852d65be..3f22ad7de8 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -43,6 +43,11 @@ module Generate (Target : Wa_target_sig.S) = struct
     let* g = Memory.unbox_float g in
     Value.val_int (return (W.BinOp (F64 op, f, g)))
 
+  let int64_bin_op stack_ctx x op f g =
+    let* f = Memory.unbox_int64 f in
+    let* g = Memory.unbox_int64 g in
+    Memory.box_int64 stack_ctx x (return (W.BinOp (I64 op, f, g)))
+
   let rec translate_expr ctx stack_ctx x e =
     match e with
     | Apply { f; args; exact } when exact || List.length args = 1 ->
@@ -183,6 +188,72 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_atan2_float", [ f; g ] -> float_bin_op' stack_ctx x Math.atan2 f g
         | Extern "caml_power_float", [ f; g ] -> float_bin_op' stack_ctx x Math.power f g
         | Extern "caml_fmod_float", [ f; g ] -> float_bin_op' stack_ctx x Math.fmod f g
+        | Extern "caml_int64_add", [ i; j ] -> int64_bin_op stack_ctx x Add i j
+        | Extern "caml_int64_mul", [ i; j ] -> int64_bin_op stack_ctx x Mul i j
+        | Extern "caml_int64_div", [ i; j ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            let res = Var.fresh () in
+            (*ZZZ Can we do better?*)
+            let i' = Var.fresh () in
+            let j' = Var.fresh () in
+            seq
+              (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
+               let* () =
+                 if_
+                   { params = []; result = [] }
+                   (let* j = load j' in
+                    return (W.UnOp (I64 Eqz, j)))
+                   (instr (CallInstr (f, [])))
+                   (return ())
+               in
+               let* () = store ~typ:I64 i' (Memory.unbox_int64 i) in
+               if_
+                 { params = []; result = [] }
+                 Arith.(
+                   (let* j = load j' in
+                    return (W.BinOp (I64 Eq, j, Const (I64 (-1L)))))
+                   land let* i = load i' in
+                        return (W.BinOp (I64 Eq, i, Const (I64 Int64.min_int))))
+                 (store ~always:true ~typ:I64 res (return (W.Const (I64 Int64.min_int))))
+                 (store
+                    ~always:true
+                    ~typ:I64
+                    res
+                    (let* i = load i' in
+                     let* j = load j' in
+                     return (W.BinOp (I64 (Div S), i, j)))))
+              (Memory.box_int64 stack_ctx x (load res))
+        | Extern "caml_int64_mod", [ i; j ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            let j' = Var.fresh () in
+            seq
+              (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
+               if_
+                 { params = []; result = [] }
+                 (let* j = load j' in
+                  return (W.UnOp (I64 Eqz, j)))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              (let* i = Memory.unbox_int64 i in
+               let* j = load j' in
+               Memory.box_int64 stack_ctx x (return (W.BinOp (I64 (Rem S), i, j))))
+        | Extern "caml_int64_of_int", [ i ] ->
+            let* i = Value.int_val i in
+            Memory.box_int64
+              stack_ctx
+              x
+              (return
+                 (match i with
+                 | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i))
+                 | _ -> W.I64ExtendI32 (S, i)))
         | Extern name, l ->
             (*ZZZ Different calling convention when large number of parameters *)
             let* f = register_import ~name (Fun (func_type (List.length l))) in
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index e8ca769942..a07e4f89c2 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -86,6 +86,10 @@ module type S = sig
     val box_float : Stack.ctx -> Code.Var.t -> expression -> expression
 
     val unbox_float : expression -> expression
+
+    val box_int64 : Stack.ctx -> Code.Var.t -> expression -> expression
+
+    val unbox_int64 : expression -> expression
   end
 
   module Value : sig
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 5f20c5651f..c37567b277 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -477,6 +477,7 @@ let import f =
           ; List
               (match desc with
               | Fun typ -> Atom "func" :: index name :: func_type typ
+              | Global ty -> [ Atom "global"; index name; global_type ty ]
               | Tag ty -> [ Atom "tag"; index name; List [ Atom "param"; value_type ty ] ])
           ]
       ]
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index a08616d8ad..9dcd5580e4 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -5,6 +5,53 @@
 
    (type $string (array (mut i8)))
 
+   (type $compare_ext (func (param (ref eq)) (param (ref eq)) (result i32)))
+
+   (type $custom_operations
+      (struct
+         (field (ref $compare_ext))
+         ;; ZZZ
+      ))
+
+   (type $custom (struct (field (ref $custom_operations))))
+
+   (global $int64_ops (export "int64_ops") (ref $custom_operations)
+      (struct.new $custom_operations (ref.func $int64_cmp)))
+
+   (type $int64
+      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
+
+   (func $int64_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
+      (local $i1 i64) (local $i2 i64)
+      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get $v1))))
+      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get $v2))))
+      (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
+               (i64.lt_s (local.get $i1) (local.get $i2))))
+
+   (func $caml_copy_int64 (param $i i64) (result (ref eq))
+      (struct.new $int64 (global.get $int64_ops) (local.get $i)))
+
+   (func (export "caml_int64_of_string") (param $v (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $i i32) (local $len i32)
+      (local $res i64)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $res (i64.const 0))
+      (local.set $i (i32.const 0))
+      (local.set $len (array.len (local.get $s)))
+      ;; ZZZ validation / negative numbers / ...
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $res
+                  (i64.add (i64.mul (local.get $res) (i64.const 10))
+                     (i64.extend_i32_s
+                        (i32.sub
+                           (array.get_u $string (local.get $s) (local.get $i))
+                           (i32.const 48)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (return_call $caml_copy_int64 (local.get $res)))
+
    (func (export "caml_make_vect")
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
       ;; ZZZ check that $n >= 0

From c2ae363e2e7b0a03062669840e6bd837cfdf2d0a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 5 May 2023 14:01:08 +0200
Subject: [PATCH 022/481] Runtime: raising exceptions

---
 runtime/wasm/runtime.wat | 65 +++++++++++++++++++++++++++++++---------
 1 file changed, 51 insertions(+), 14 deletions(-)

diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index 9dcd5580e4..9024eb773c 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -1,5 +1,5 @@
 (module
-   (tag (export "ocaml_exception") (param (ref eq)))
+   (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
 
    (type $block (array (mut (ref eq))))
 
@@ -15,6 +15,49 @@
 
    (type $custom (struct (field (ref $custom_operations))))
 
+   (global $caml_global_data (mut (ref $block))
+      (array.new $block (i31.new (i32.const 0)) (i32.const 12)))
+
+   (func (export "caml_register_global")
+      (param (ref eq)) (param $v (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local.set $i (i31.get_u (ref.cast i31 (local.get 0))))
+      (if (i32.lt_u (local.get $i) (array.len (global.get $caml_global_data)))
+         (then
+            (array.set $block (global.get $caml_global_data)
+               (local.get $i) (local.get $v))))
+      (i31.new (i32.const 0)))
+
+   (func $caml_raise_constant (param (ref eq))
+      (throw $ocaml_exception (local.get 0)))
+
+   (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))
+      (throw $ocaml_exception
+         (array.new_fixed $block
+            (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
+
+   (global $INVALID_EXN i32 (i32.const 3))
+
+   (func $caml_invalid_argument (param $arg (ref eq))
+       (call $caml_raise_with_arg
+           (array.get $block (global.get $caml_global_data)
+              (global.get $INVALID_EXN))
+           (local.get 0)))
+
+   (data $index_out_of_bounds "index out of bounds")
+
+   (func $caml_array_bound_error (export "caml_array_bound_error")
+      (call $caml_invalid_argument
+         (array.new_data $string $index_out_of_bounds
+            (i32.const 0) (i32.const 19))))
+
+   (global $ZERO_DIVIDE_EXN i32 (i32.const 5))
+
+   (func (export "caml_raise_zero_divide")
+      (call $caml_raise_constant
+         (array.get $block (global.get $caml_global_data)
+                    (global.get $ZERO_DIVIDE_EXN))))
+
    (global $int64_ops (export "int64_ops") (ref $custom_operations)
       (struct.new $custom_operations (ref.func $int64_cmp)))
 
@@ -52,12 +95,18 @@
                (br $loop))))
       (return_call $caml_copy_int64 (local.get $res)))
 
+   (data $Array_make "Array.make")
+
    (func (export "caml_make_vect")
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
-      ;; ZZZ check that $n >= 0
       (local $sz i32) (local $b (ref $block))
       (local.set $sz (i32.add (i31.get_s (ref.cast i31 (local.get $n)))
                               (i32.const 1)))
+      (if (i32.lt_s (local.get $sz) (i32.const 1))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Array_make
+                               (i32.const 0) (i32.const 10)))))
       (local.set $b (array.new $block (local.get $v) (local.get $sz)))
       (array.set $block (local.get $b) (i32.const 0) (i31.new (i32.const 0)))
       (local.get $b))
@@ -80,10 +129,6 @@
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_register_global")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
    (func (export "caml_register_named_value")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
@@ -92,14 +137,6 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_array_bound_error")
-      ;; ZZZ
-      (unreachable))
-
-   (func (export "caml_raise_zero_divide")
-      ;; ZZZ
-      (unreachable))
-
    (global $caml_oo_last_id (mut i32) (i32.const 0))
 
    (func (export "caml_fresh_oo_id") (param (ref eq)) (result (ref eq))

From 166e2605bbc70d6c09e493e619184a2a624f72ed Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 5 May 2023 14:08:15 +0200
Subject: [PATCH 023/481] Runtime: started implementing polymorphic compare
 function

---
 runtime/wasm/runtime.wat | 402 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 401 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index 9024eb773c..dc4a6ff899 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -5,6 +5,8 @@
 
    (type $string (array (mut i8)))
 
+   (type $float (struct (field f64)))
+
    (type $compare_ext (func (param (ref eq)) (param (ref eq)) (result i32)))
 
    (type $custom_operations
@@ -166,7 +168,15 @@
                (br $loop))))
       (local.get $res))
 
-   (func (export "caml_string_equal")
+   (global $closure_tag i32 (i32.const 247))
+   (global $object_tag i32 (i32.const 248))
+   (global $forward_tag i32 (i32.const 250))
+   (global $string_tag i32 (i32.const 252))
+   (global $float_tag i32 (i32.const 253))
+   (global $double_array_tag i32 (i32.const 254))
+   (global $custom_tag i32 (i32.const 255))
+
+   (func $caml_string_equal (export "caml_string_equal")
       (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
       (local $s1 (ref $string)) (local $s2 (ref $string))
       (local $len i32) (local $i i32)
@@ -187,4 +197,394 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
       (i31.new (i32.const 1)))
+
+   (func (export "caml_string_notequal")
+      (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
+      (return
+         (i31.new (i32.eqz (i31.get_u (ref.cast i31
+            (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
+
+   (type $int_array (array (mut i32)))
+   (type $block_array (array (mut (ref $block))))
+   (type $compare_stack
+      (struct (field (mut i32))          ;; position in stack
+              (field (ref $block_array)) ;; first value
+              (field (ref $block_array)) ;; second value
+              (field (ref $int_array)))) ;; position in value
+
+   (global $dummy_block (ref $block)
+      (array.new $block (i31.new (i32.const 0)) (i32.const 0)))
+
+   (global $default_compare_stack (ref $compare_stack)
+      (struct.new $compare_stack (i32.const -1)
+         (array.new $block_array (global.get $dummy_block) (i32.const 8))
+         (array.new $block_array (global.get $dummy_block) (i32.const 8))
+         (array.new $int_array (i32.const 0) (i32.const 8))))
+
+   (func $compare_stack_is_not_empty
+      (param $stack (ref $compare_stack)) (result i32)
+      (i32.ge_s (struct.get $compare_stack 0 (local.get $stack)) (i32.const 0)))
+
+   (func $pop_compare_stack (param $stack (ref $compare_stack))
+      (result (ref eq)) (result (ref eq))
+      (local $i i32) (local $p i32) (local $p' i32)
+      (local $v1 (ref $block)) (local $v2 (ref $block))
+      (local.set $i (struct.get $compare_stack 0 (local.get $stack)))
+      (local.set $p
+         (array.get $int_array (struct.get $compare_stack 3 (local.get $stack))
+            (local.get $i)))
+      (local.set $p' (i32.add (local.get $p) (i32.const 1)))
+      (array.set $int_array (struct.get $compare_stack 3 (local.get $stack))
+            (local.get $i) (local.get $p'))
+      (local.set $v1
+         (array.get $block_array
+            (struct.get $compare_stack 1 (local.get $stack)) (local.get $i)))
+      (local.set $v2
+         (array.get $block_array
+            (struct.get $compare_stack 2 (local.get $stack)) (local.get $i)))
+      (if (i32.eq (local.get $p') (array.len (local.get $v1)))
+         (then
+            (array.set $block_array
+               (struct.get $compare_stack 1 (local.get $stack))
+               (local.get $i) (global.get $dummy_block))
+            (array.set $block_array
+               (struct.get $compare_stack 2 (local.get $stack))
+               (local.get $i) (global.get $dummy_block))
+            (struct.set $compare_stack 0 (local.get $stack)
+               (i32.sub (local.get $i) (i32.const 1)))))
+      (tuple.make (array.get $block (local.get $v1) (local.get $p))
+                  (array.get $block (local.get $v2) (local.get $p))))
+
+   (func $push_compare_stack (param $stack (ref $compare_stack))
+      (param $v1 (ref $block)) (param $v2 (ref $block)) (param $p i32)
+      (result (ref $compare_stack))
+      (local $i i32)
+      (local.set $i
+         (i32.add (struct.get $compare_stack 0 (local.get $stack))
+            (i32.const 1)))
+      ;; ZZZ Allocate a larger stack if necessary
+      (if (i32.ge_u (local.get $i)
+             (array.len (struct.get $compare_stack 1 (local.get $stack))))
+         (then (unreachable)))
+      (struct.set $compare_stack 0 (local.get $stack) (local.get $i))
+      (array.set $block_array (struct.get $compare_stack 1 (local.get $stack))
+         (local.get $i) (local.get $v1))
+      (array.set $block_array (struct.get $compare_stack 2 (local.get $stack))
+         (local.get $i) (local.get $v2))
+      (array.set $int_array (struct.get $compare_stack 3 (local.get $stack))
+         (local.get $i) (local.get $p))
+      (local.get $stack))
+
+   (global $unordered i32 (i32.const 0x80000000))
+
+   (func $compare_strings
+      (param $s1 (ref $string)) (param $s2 (ref $string)) (result i32)
+      (local $l1 i32) (local $l2 i32) (local $len i32) (local $i i32)
+      (local $c1 i32) (local $c2 i32)
+      (if (ref.eq (local.get $s1) (local.get $s2))
+         (then (return (i32.const 0))))
+      (local.set $l1 (array.len $string (local.get $s1)))
+      (local.set $l2 (array.len $string (local.get $s2)))
+      (local.set $len (select (local.get $l1) (local.get $l2)
+                         (i32.le_u (local.get $l1) (local.get $l2))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $c1
+                  (array.get_u $string (local.get $s1) (local.get $i)))
+               (local.set $c2
+                  (array.get_u $string (local.get $s2) (local.get $i)))
+               (if (i32.ne (local.get $c1) (local.get $c2))
+                  (then
+                     (if (i32.le_u (local.get $c1) (local.get $c2))
+                        (then (return (i32.const -1)))
+                        (else (return (i32.const 1))))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i32.sub (local.get $l1) (local.get $l2)))
+
+   (func $compare_val
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32)
+      (result i32)
+      (local $stack (ref $compare_stack)) (local $i i32) (local $res i32)
+      (local.set $stack (global.get $default_compare_stack))
+      (struct.set $compare_stack 0 (local.get $stack) (i32.const -1))
+      (local.set $res
+         (call $do_compare_val
+            (local.get $stack) (local.get $v1) (local.get $v2)
+            (local.get $total)))
+;;      (if (i32.gt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const 1))))
+;;      (if (i32.lt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const -1))))
+;;      (call $log (local.get $res))
+      (local.set $i (struct.get $compare_stack 0 (local.get $stack)))
+      ;; clear stack (to avoid memory leaks)
+      (loop $loop
+         (if (i32.ge_s (local.get $i) (i32.const 0))
+            (then
+               (array.set $block_array
+                  (struct.get $compare_stack 1 (local.get $stack))
+                  (local.get $i) (global.get $dummy_block))
+               (array.set $block_array
+                  (struct.get $compare_stack 2 (local.get $stack))
+                  (local.get $i) (global.get $dummy_block))
+               (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $res))
+
+   (func $do_compare_val
+      (param $stack (ref $compare_stack))
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32)
+      (local $i1 (ref i31)) (local $i2 (ref i31))
+      (local $b1 (ref $block)) (local $b2 (ref $block))
+      (local $t1 i32) (local $t2 i32)
+      (local $s1 i32) (local $s2 i32)
+      (local $f1 f64) (local $f2 f64)
+      (local $str1 (ref $string)) (local $str2 (ref $string))
+      (local $c1 (ref $custom)) (local $c2 (ref $custom))
+      (local $tuple ((ref eq) (ref eq)))
+      (local $res i32)
+      (loop $loop
+         (block $next_item
+            (br_if $next_item
+               (i32.and (ref.eq (local.get $v1) (local.get $v2))
+                        (local.get $total)))
+            (drop (block $v1_is_not_int (result (ref eq))
+               (local.set $i1
+                  (br_on_cast_fail $v1_is_not_int i31 (local.get $v1)))
+               (br_if $next_item (ref.eq (local.get $v1) (local.get $v2)))
+               (drop (block $v2_is_not_int (result (ref eq))
+                  (local.set $i2
+                     (br_on_cast_fail $v2_is_not_int i31 (local.get $v2)))
+                  ;; v1 and v2 are both integers
+                  (return (i32.sub (i31.get_s (local.get $i1))
+                                   (i31.get_s (local.get $i2))))))
+               ;; check for forward tag
+               (drop (block $v2_not_forward (result (ref eq))
+                  (local.set $b2
+                     (br_on_cast_fail $v2_not_forward $block (local.get $v2)))
+                  (local.set $t2
+                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
+                                                 (i32.const 0)))))
+                  (if (i32.eq (local.get $t2) (global.get $forward_tag))
+                     (then
+                        (local.set $v2
+                           (array.get $block (local.get $b2) (i32.const 1)))
+                        (br $loop)))
+                  (i31.new (i32.const 1))))
+               ;; ZZZ custom tag
+               ;; v1 long < v2 block
+               (return (i32.const -1))))
+            (if (ref.test i31 (local.get $v2))
+               (then
+                  ;; check for forward tag
+                  (drop (block $v1_not_forward (result (ref eq))
+                     (local.set $b1
+                        (br_on_cast_fail
+                           $v1_not_forward $block (local.get $v1)))
+                     (local.set $t1
+                        (i31.get_u (ref.cast i31
+                                      (array.get $block (local.get $b1)
+                                         (i32.const 0)))))
+                     (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                        (then
+                           (local.set $v1
+                              (array.get $block (local.get $b1) (i32.const 1)))
+                           (br $loop)))
+                     (i31.new (i32.const 1))))
+                  ;; ZZZ custom tag
+                  ;; v1 block > v1 long
+                  (return (i32.const 1))))
+            (drop (block $v1_not_block (result (ref eq))
+               (local.set $b1
+                  (br_on_cast_fail $v1_not_block $block (local.get $v1)))
+               (local.set $t1
+                  (i31.get_u (ref.cast i31 (array.get $block (local.get $b1)
+                                              (i32.const 0)))))
+               (drop (block $v2_not_block (result (ref eq))
+                  (local.set $b2
+                     (br_on_cast_fail $v2_not_block $block (local.get $v2)))
+                  (local.set $t2
+                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
+                                                 (i32.const 0)))))
+                  (if (i32.ne (local.get $t1) (local.get $t2))
+                     (then
+                        ;; check for forward tag
+                        (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                           (then
+                              (local.set $v1
+                                 (array.get $block
+                                    (local.get $b1) (i32.const 1)))
+                              (br $loop)))
+                        (if (i32.eq (local.get $t2) (global.get $forward_tag))
+                           (then
+                              (local.set $v2
+                                 (array.get
+                                    $block (local.get $b2) (i32.const 1)))
+                              (br $loop)))
+                        ;; compare tags
+                        (return (i32.sub (local.get $t1) (local.get $t2)))))
+                  ;; forward tag
+                  (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                     (then
+                        (local.set $v1
+                           (array.get $block (local.get $b1) (i32.const 1)))
+                        (local.set $v2
+                           (array.get $block (local.get $b2) (i32.const 1)))
+                        (br $loop)))
+                  ;; ZZZ object tag
+                  (local.set $s1 (array.len (local.get $b1)))
+                  (local.set $s2 (array.len (local.get $b2)))
+                  ;; compare size first
+                  (if (i32.ne (local.get $s1) (local.get $s2))
+                     (then (return (i32.sub (local.get $s1) (local.get $s2)))))
+                  (br_if $next_item (i32.eq (local.get $s1) (i32.const 1)))
+                  (if (i32.gt_u (local.get $s1) (i32.const 2))
+                     (then
+                       (local.set $stack
+                          (call $push_compare_stack (local.get $stack)
+                             (local.get $b1) (local.get $b2) (i32.const 2)))))
+                  (local.set $v1
+                     (array.get $block (local.get $b1) (i32.const 1)))
+                  (local.set $v2
+                     (array.get $block (local.get $b2) (i32.const 1)))
+                  (br $loop)))
+               ;; check for forward tag
+               (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                  (then
+                     (local.set $v1
+                        (array.get $block (local.get $b1) (i32.const 1)))
+                     (br $loop)))
+               ;; v1 float array > v2 not represented as block
+               (if (i32.eq (local.get $t1) (global.get $double_array_tag))
+                   (then (return (i32.const 1))))
+               (return (i32.const -1))))
+            (drop (block $v1_not_float (result (ref eq))
+               (local.set $f1
+                  (struct.get $float 0
+                     (br_on_cast_fail $v1_not_float $float (local.get $v1))))
+               (drop (block $v2_not_float (result (ref eq))
+                  (local.set $f2
+                     (struct.get $float 0
+                        (br_on_cast_fail $v2_not_float $float (local.get $v2))))
+                  (if (f64.lt (local.get $f1) (local.get $f2))
+                     (then (return (i32.const -1))))
+                  (if (f64.gt (local.get $f1) (local.get $f2))
+                     (then (return (i32.const 1))))
+                  (if (f64.ne (local.get $f1) (local.get $f2))
+                     (then
+                        (if (i32.eqz (local.get $total))
+                           (then (return (global.get $unordered))))
+                        (if (f64.eq (local.get $f1) (local.get $f1))
+                           (then (return (i32.const 1))))
+                        (if (f64.eq (local.get $f2) (local.get $f2))
+                           (then (return (i32.const -1))))))
+                  (br $next_item)))
+               ;; ZZZ forward tag
+               ;; ZZZ float array
+               (unreachable)
+               (return (i32.const 1))))
+            (if (ref.test $float (local.get $v2))
+               (then
+                  ;; ZZZ forward tag
+                  ;; ZZZ float array
+                  (unreachable)
+                  (return (i32.const -1))))
+            (drop (block $v1_not_string (result (ref eq))
+               (local.set $str1
+                  (br_on_cast_fail $v1_not_string $string (local.get $v1)))
+               (drop (block $v2_not_string (result (ref eq))
+                  (local.set $str2
+                      (br_on_cast_fail $v2_not_string $string (local.get $v2)))
+                  (local.set $res
+                     (call $compare_strings
+                        (local.get $str1) (local.get $str2)))
+                  (br_if $next_item (i32.eqz (local.get $res)))
+                  (return (local.get $res))))
+               ;; ZZZ forward tag
+               ;; ZZZ float array
+               (unreachable)
+               (return (i32.const 1))))
+            (drop (block $v1_not_custom (result (ref eq))
+               (local.set $c1
+                  (br_on_cast_fail $v1_not_custom $custom (local.get $v1)))
+               (drop (block $v2_not_custom (result (ref eq))
+                  (local.set $c2
+                      (br_on_cast_fail $v2_not_custom $custom (local.get $v2)))
+                  ;; ZZZ compare types
+                  ;; ZZZ abstract value?
+                  (local.set $res
+                     (call_ref $compare_ext
+                        (local.get $v1) (local.get $v2)
+                        (struct.get $custom_operations 0
+                           (struct.get $custom 0 (local.get $c1)))
+                        ))
+                  (br_if $next_item (i32.eqz (local.get $res)))
+                  (return (local.get $res))))
+               ;; ZZZ forward tag
+               ;; ZZZ float array
+               (unreachable)
+               (return (i32.const 1))))
+            (unreachable)
+            ;; ZZZ forward tag
+            ;; ZZZ float array
+            (return (i32.const 1)))
+         (if (call $compare_stack_is_not_empty (local.get $stack))
+            (then
+               (local.set $tuple (call $pop_compare_stack (local.get $stack)))
+               (local.set $v1 (tuple.extract 0 (local.get $tuple)))
+               (local.set $v2 (tuple.extract 1 (local.get $tuple)))
+               (br $loop))))
+     (i32.const 0))
+
+   (func (export "caml_compare")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (local $res i32)
+      (local.set $res
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 1)))
+      (if (i32.lt_s (local.get $res) (i32.const 0))
+         (then (return (i31.new (i32.const -1)))))
+      (if (i32.gt_s (local.get $res) (i32.const 0))
+         (then (return (i31.new (i32.const 1)))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_equal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new
+         (i32.eqz
+            (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+
+   (func (export "caml_notequal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new
+         (i32.ne (i32.const 0)
+            (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+
+   (func (export "caml_lessthan")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (local $res i32)
+      (local.set $res
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
+      (i31.new
+         (i32.and (i32.lt_s (local.get $res) (i32.const 0))
+                  (i32.ne (local.get $res) (global.get $unordered)))))
+
+   (func (export "caml_lessequal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (local $res i32)
+      (local.set $res
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
+      (i31.new
+         (i32.and (i32.le_s (local.get $res) (i32.const 0))
+                  (i32.ne (local.get $res) (global.get $unordered)))))
+
+   (func (export "caml_greaterthan")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new (i32.lt_s (i32.const 0)
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+
+   (func (export "caml_greaterequal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new (i32.le_s (i32.const 0)
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
 )

From d679b6c3b587cc2b2a67aa874cbf6c593318cba4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 5 May 2023 14:13:40 +0200
Subject: [PATCH 024/481] More runtime functions

---
 runtime/wasm/run.js      |   9 ++-
 runtime/wasm/runtime.wat | 125 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 133 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/run.js b/runtime/wasm/run.js
index 703f2fc47b..cfa767e047 100644
--- a/runtime/wasm/run.js
+++ b/runtime/wasm/run.js
@@ -15,7 +15,14 @@ async function main() {
           await WebAssembly.instantiate(await code,
                                         {env:runtimeModule.instance.exports,
                                          Math:math})
-    wasmModule.instance.exports._initialize()
+    try {
+      wasmModule.instance.exports._initialize()
+    } catch (e) {
+        if (e instanceof WebAssembly.Exception &&
+            e.is(runtimeModule.instance.exports.ocaml_exit))
+            process.exit(e.getArg(runtimeModule.instance.exports.ocaml_exit, 0));
+        throw e;
+    }
 }
 
 main ()
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index dc4a6ff899..f6b6260564 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -1,5 +1,6 @@
 (module
    (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
+   (tag $ocaml_exit (export "ocaml_exit") (param i32))
 
    (type $block (array (mut (ref eq))))
 
@@ -7,6 +8,10 @@
 
    (type $float (struct (field f64)))
 
+   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+
+   (type $closure (struct (field i32) (field (ref $function_1))))
+
    (type $compare_ext (func (param (ref eq)) (param (ref eq)) (result i32)))
 
    (type $custom_operations
@@ -137,8 +142,12 @@
 
    (func (export "caml_int_of_string")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
       (i31.new (i32.const 0)))
 
+   (func (export "caml_sys_exit") (param (ref eq)) (result (ref eq))
+      (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get $0)))))
+
    (global $caml_oo_last_id (mut i32) (i32.const 0))
 
    (func (export "caml_fresh_oo_id") (param (ref eq)) (result (ref eq))
@@ -176,6 +185,57 @@
    (global $double_array_tag i32 (i32.const 254))
    (global $custom_tag i32 (i32.const 255))
 
+   (func (export "caml_obj_tag") (param $v (ref eq)) (result (ref eq))
+      (if (ref.test i31 (local.get $v))
+         (then (return (i31.new (i32.const 1000)))))
+      (drop (block $not_block (result (ref eq))
+         (return (array.get $block
+                    (br_on_cast_fail $not_block $block (local.get $v))
+                    (i32.const 0)))))
+      (if (ref.test $string (local.get $v))
+         (then (return (i31.new (global.get $string_tag)))))
+      (if (ref.test $float (local.get $v))
+         (then (return (i31.new (global.get $float_tag)))))
+      (if (ref.test $custom (local.get $v))
+         (then (return (i31.new (global.get $custom_tag)))))
+      (if (ref.test $closure (local.get $v))
+         (then (return (i31.new (global.get $closure_tag)))))
+      ;; ZZZ float array
+      ;; ZZZ others?
+      (unreachable))
+
+   (func (export "caml_obj_make_forward")
+      (param $b (ref eq)) (param $v (ref eq)) (result (ref eq))
+      (local $block (ref $block))
+      (local.set $block (ref.cast $block (local.get $b)))
+      (array.set $block (local.get $block)
+         (i32.const 0) (i31.new (global.get $forward_tag)))
+      (array.set $block (local.get $block) (i32.const 1) (local.get $v))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_alloc_dummy") (param $size (ref eq)) (result (ref eq))
+      (array.new $block (i31.new (i32.const 0))
+                 (i32.add (i31.get_u (ref.cast i31 (local.get $size)))
+                          (i32.const 1))))
+
+   (func (export "caml_update_dummy")
+      (param $dummy (ref eq)) (param $newval (ref eq)) (result (ref eq))
+      (local $i i32) (local $len i32)
+      (local $dst (ref $block)) (local $src (ref $block))
+      ;; ZZZ check for closure or float array
+      (local.set $src (ref.cast $block (local.get $newval)))
+      (local.set $dst (ref.cast $block (local.get $dummy)))
+      (local.set $len (array.len (local.get $dst)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (array.set $block (local.get $dst) (local.get $i)
+                  (array.get $block (local.get $src) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (i32.const 0)))
+
    (func $caml_string_equal (export "caml_string_equal")
       (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
       (local $s1 (ref $string)) (local $s2 (ref $string))
@@ -204,6 +264,71 @@
          (i31.new (i32.eqz (i31.get_u (ref.cast i31
             (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
 
+   (func (export "caml_string_of_bytes") (param $v (ref eq)) (result (ref eq))
+      (local.get $v))
+
+   (func (export "caml_string_get")
+      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.ge_u (local.get $p) (array.len (local.get $s)))
+         (then (call $caml_array_bound_error)))
+      (i31.new (array.get_u $string (local.get $s) (local.get $p))))
+
+   (data $Bytes_create "Bytes.create")
+
+   (func (export "caml_create_bytes")
+      (param $len (ref eq)) (result (ref eq))
+      (local $l i32)
+      (local.set $l (i31.get_u (ref.cast i31 (local.get $len))))
+      (if (i32.lt_s (local.get $l) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Bytes_create
+                               (i32.const 0) (i32.const 12)))))
+      (array.new $string (i32.const 0) (local.get $l)))
+
+   (export "caml_blit_bytes" (func $caml_blit_string))
+   (func $caml_blit_string (export "caml_blit_string")
+      (param $v1 (ref eq)) (param $i1 (ref eq))
+      (param $v2 (ref eq)) (param $i2 (ref eq))
+      (param $n (ref eq)) (result (ref eq))
+      (local $s1 (ref $string)) (local $p1 i32)
+      (local $s2 (ref $string)) (local $p2 i32)
+      (local $i i32) (local $l i32)
+      (local.set $l (i31.get_s (ref.cast i31 (local.get $n))))
+      (block $return
+         (br_if $return (i32.eqz (local.get $l)))
+         (local.set $s1 (ref.cast $string (local.get $v1)))
+         (local.set $p1 (i31.get_s (ref.cast i31 (local.get $i1))))
+         (local.set $s2 (ref.cast $string (local.get $v2)))
+         (local.set $p2 (i31.get_s (ref.cast i31 (local.get $i2))))
+         (if (ref.eq (local.get $v1) (local.get $v2))
+            (br_if $return (i32.eq (local.get $p1) (local.get $p2)))
+            (if (i32.gt_u (i32.add (local.get $p2) (local.get $l))
+                          (local.get $p1))
+               (then
+                  (local.set $i (i32.sub (local.get $l) (i32.const 1)))
+                  (loop $loop1
+                     (br_if $return (i32.lt_s (local.get $i) (i32.const 0l)))
+                     (array.set $string (local.get $s2)
+                        (i32.add (local.get $p2) (local.get $i))
+                        (array.get_u $string (local.get $s1)
+                           (i32.add (local.get $p1) (local.get $i))))
+                     (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+                     (br $loop1)))))
+         (local.set $i (i32.const 0))
+         (loop $loop2
+            (br_if $return (i32.eq (local.get $i) (local.get $l)))
+            (array.set $string (local.get $s2)
+               (i32.add (local.get $p2) (local.get $i))
+                        (array.get_u $string (local.get $s1)
+                           (i32.add (local.get $p1) (local.get $i))))
+            (local.set $i (i32.add (local.get $i) (i32.const 1)))
+            (br $loop2)))
+      (i31.new (i32.const 0)))
+
    (type $int_array (array (mut i32)))
    (type $block_array (array (mut (ref $block))))
    (type $compare_stack

From 651452d75f13661f9b9997dd264ce4bf274ce313 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 10 May 2023 11:02:37 +0200
Subject: [PATCH 025/481] Some JavaScript bindings + more runtime functions

---
 compiler/lib/generate.ml            |   6 +-
 compiler/lib/inline.ml              |   3 +-
 compiler/lib/specialize_js.ml       |   2 +
 compiler/lib/wasm/wa_core_target.ml |   9 +-
 compiler/lib/wasm/wa_gc_target.ml   |   5 +
 compiler/lib/wasm/wa_generate.ml    |  49 +++-
 compiler/lib/wasm/wa_target_sig.ml  |   2 +
 compiler/lib/wasm/wa_wat_output.ml  |  13 +
 runtime/wasm/index.js               |  63 +++++
 runtime/wasm/run.js                 |  54 +++-
 runtime/wasm/runtime.wat            | 418 +++++++++++++++++++++++++++-
 11 files changed, 590 insertions(+), 34 deletions(-)
 create mode 100644 runtime/wasm/index.js

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index b5092a7af4..eb27842268 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -2183,8 +2183,10 @@ let init () =
     ; "caml_alloc_dummy_float", "caml_alloc_dummy"
     ; "caml_make_array", "%identity"
     ; "caml_ensure_stack_capacity", "%identity"
-    ; "caml_js_from_float", "%identity"
-    ; "caml_js_to_float", "%identity"
+      (*ZZZ
+          ; "caml_js_from_float", "%identity"
+          ; "caml_js_to_float", "%identity"
+      *)
     ];
   Hashtbl.iter
     (fun name (k, _) -> Primitive.register name k None None)
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index d567b0725c..43b786b2ea 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -241,7 +241,8 @@ let inline live_vars closures pc (outer, blocks, free_pc) =
                   let outer = { outer with size = outer.size + f_size } in
                   [], (outer, (Branch (free_pc + 1, args), loc), blocks, free_pc + 2)
                 else i :: rem, state)
-        | Let (x, Closure (l, (pc, []))), loc when not (Config.Flag.effects ()) -> (
+        | Let (x, Closure (l, (pc, []))), loc when false && not (Config.Flag.effects ())
+          -> (
             let block = Addr.Map.find pc blocks in
             match block with
             | { body = [ (Let (y, Prim (Extern prim, args)), _loc) ]
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 2578168001..6c9b17e2d9 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -51,6 +51,7 @@ let specialize_instr info i =
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
       | Some _ -> Let (x, Constant (Int 0l))
       | None -> i)
+  (*
   | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])) -> (
       match the_def_of info a with
       | Some (Block (_, a, _)) ->
@@ -130,6 +131,7 @@ let specialize_instr info i =
       match the_string_of info y with
       | Some s -> Let (x, Constant (NativeString (Native_string.of_bytestring s)))
       | None -> i)
+*)
   | Let (x, Prim (Extern "%int_mul", [ y; z ])) -> (
       match the_int info y, the_int info z with
       | Some j, _ when Int32.(abs j < 0x200000l) ->
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 6e5519a752..07442489ab 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -93,12 +93,19 @@ module Memory = struct
 
   let tag e = Arith.(mem_load (e - const 4l) land const 0xffl)
 
-  let block_length e = Arith.(mem_load (e - const 4l) lsr const 1l)
+  let block_length e = Arith.(mem_load (e - const 4l) lsr const 10l)
 
   let array_get e e' = mem_load Arith.(e + ((e' - const 1l) lsl const 1l))
 
   let array_set e e' e'' = mem_store Arith.(e + ((e' - const 1l) lsl const 1l)) e''
 
+  let bytes_length e =
+    let l = Code.Var.fresh () in
+    Arith.(
+      tee l ((block_length e lsl const 2l) - const 1l)
+      - let* tail = e + load l in
+        return (W.Load8 (U, I32 0l, tail)))
+
   let bytes_get e e' =
     let* addr = Arith.(e + e' - const 1l) in
     return (W.Load8 (U, I32 (Int32.of_int 0), addr))
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index b46a7ded40..ec80b5a928 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -362,6 +362,11 @@ module Memory = struct
 
   let array_set e e' e'' = wasm_array_set e Arith.(Value.int_val e' + const 1l) e''
 
+  let bytes_length e =
+    let* ty = Type.string_type in
+    let* e = wasm_cast ty e in
+    return (W.ArrayLen e)
+
   let bytes_get e e' =
     Value.val_int (wasm_array_get ~ty:Type.string_type e (Value.int_val e'))
 
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 3f22ad7de8..1e38330cf6 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -101,12 +101,41 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.array_get x y
         | Extern "caml_array_unsafe_set", [ x; y; z ] ->
             seq (Memory.array_set x y z) Value.unit
-        | Extern "caml_string_unsafe_get", [ x; y ] -> Memory.bytes_get x y
-        | Extern "caml_string_unsafe_set", [ x; y; z ] ->
-            seq (Memory.bytes_set x y z) Value.unit
-        | Extern "caml_bytes_unsafe_get", [ x; y ] -> Memory.bytes_get x y
-        | Extern "caml_bytes_unsafe_set", [ x; y; z ] ->
+        | Extern ("caml_string_unsafe_get" | "caml_bytes_unsafe_get"), [ x; y ] ->
+            Memory.bytes_get x y
+        | Extern ("caml_string_unsafe_set" | "caml_bytes_unsafe_set"), [ x; y; z ] ->
             seq (Memory.bytes_set x y z) Value.unit
+        | Extern ("caml_string_get" | "caml_bytes_get"), [ x; y ] ->
+            seq
+              (let* f =
+                 register_import
+                   ~name:"caml_bound_error"
+                   (Fun { params = []; result = [] })
+               in
+               if_
+                 { params = []; result = [] }
+                 (Arith.uge (Value.int_val y) (Memory.bytes_length x))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              (Memory.bytes_get x y)
+        | Extern ("caml_string_set" | "caml_bytes_set"), [ x; y; z ] ->
+            seq
+              (let* f =
+                 register_import
+                   ~name:"caml_bound_error"
+                   (Fun { params = []; result = [] })
+               in
+               let* () =
+                 if_
+                   { params = []; result = [] }
+                   (Arith.uge (Value.int_val y) (Memory.bytes_length x))
+                   (instr (CallInstr (f, [])))
+                   (return ())
+               in
+               Memory.bytes_set x y z)
+              Value.unit
+        | Extern ("caml_ml_string_length" | "caml_ml_bytes_length"), [ x ] ->
+            Value.val_int (Memory.bytes_length x)
         | Extern "%int_add", [ x; y ] -> Value.int_add x y
         | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
         | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
@@ -124,7 +153,6 @@ module Generate (Target : Wa_target_sig.S) = struct
                  (instr (CallInstr (f, [])))
                  (return ()))
               (Value.int_div x y)
-        | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
         | Extern "%int_mod", [ x; y ] ->
             let* f =
               register_import
@@ -138,6 +166,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                  (instr (CallInstr (f, [])))
                  (return ()))
               (Value.int_mod x y)
+        | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
         | Extern "%int_neg", [ x ] -> Value.int_neg x
         | Extern "%int_or", [ x; y ] -> Value.int_or x y
         | Extern "%int_and", [ x; y ] -> Value.int_and x y
@@ -147,9 +176,7 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
         | Extern "caml_check_bound", [ x; y ] ->
             let* f =
-              register_import
-                ~name:"caml_array_bound_error"
-                (Fun { params = []; result = [] })
+              register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
             in
             seq
               (if_
@@ -254,6 +281,10 @@ module Generate (Target : Wa_target_sig.S) = struct
                  (match i with
                  | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i))
                  | _ -> W.I64ExtendI32 (S, i)))
+        | Extern "caml_int_compare", [ i; j ] ->
+            Value.val_int
+              Arith.(
+                (Value.int_val j < Value.int_val i) - (Value.int_val i < Value.int_val j))
         | Extern name, l ->
             (*ZZZ Different calling convention when large number of parameters *)
             let* f = register_import ~name (Fun (func_type (List.length l))) in
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index a07e4f89c2..dde876f017 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -77,6 +77,8 @@ module type S = sig
 
     val array_set : expression -> expression -> expression -> unit Wa_code_generation.t
 
+    val bytes_length : expression -> expression
+
     val bytes_get : expression -> expression -> expression
 
     val bytes_set : expression -> expression -> expression -> unit Wa_code_generation.t
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index c37567b277..737ec4cdf8 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -200,6 +200,19 @@ let float64 f =
 let expression_or_instructions ctx in_function =
   let rec expression e =
     match e with
+    | RefEq (LocalGet x, I31New (Const (I32 n))) ->
+        (*ZZZ Chrome bug *)
+        instruction
+          (If
+             ( { params = []; result = [ I32 ] }
+             , RefTest ({ nullable = false; typ = I31 }, LocalGet x)
+             , [ Push
+                   (BinOp
+                      ( I32 Eq
+                      , I31Get (S, RefCast ({ nullable = false; typ = I31 }, LocalGet x))
+                      , Const (I32 n) ))
+               ]
+             , [ Push (Const (I32 0l)) ] ))
     | Const op ->
         [ List
             [ Atom (type_prefix op "const")
diff --git a/runtime/wasm/index.js b/runtime/wasm/index.js
new file mode 100644
index 0000000000..66d7ee5e15
--- /dev/null
+++ b/runtime/wasm/index.js
@@ -0,0 +1,63 @@
+(async function () {
+    const runtime = fetch('runtime.wasm');
+    const code = fetch('a.wasm');
+
+    var caml_callback;
+
+    let math =
+        {cos:Math.cos, sin:Math.sin, asin:Math.asin, atan2:Math.atan2,
+         pow:Math.pow, fmod:(x, y) => x%y,
+         log:(x)=>console.log('ZZZZZ', x)}
+    let bindings =
+        {identity:(x)=>x,
+         from_bool:(x)=>!!x,
+         get:(x,y)=>x[y],
+         set:(x,y,z)=>x[y]=z,
+         eval:eval,
+         strict_equals:(x,y)=>x===y,
+         fun_call:(f,args)=>f.apply(null,args),
+         meth_call:(o,f,args)=>o[f].apply(o,args),
+         new_array:(n)=>new Array(n),
+         new_obj:()=>({}),
+         new:(c,args)=>{return new c(...args)},
+         array_length:(a)=>a.length,
+         array_get:(a,i)=>a[i],
+         array_set:(a,i,v)=>a[i]=v,
+         get_int:(a,i)=>a[i],
+         wrap_callback_strict:(arity,f)=>function (){
+             var n = arguments.length;
+             var args = new Array(arity);
+             var len = Math.min(arguments.length, arity)
+             for (var i = 0; i < len; i++) args[i] = arguments[i];
+             return caml_callback(f, arity, args);
+         },
+         format:(f)=>""+f
+        }
+    const runtimeModule =
+          await WebAssembly.instantiateStreaming(runtime,
+                                                 {Math:math,bindings:bindings});
+
+    caml_callback = runtimeModule.instance.exports.caml_callback;
+
+    const wasmModule =
+          await WebAssembly.instantiateStreaming(
+              code,
+              {env:runtimeModule.instance.exports,
+               Math:math}
+          )
+
+    try {
+        wasmModule.instance.exports._initialize()
+    } catch (e) {
+        if (e instanceof WebAssembly.Exception &&
+            e.is(runtimeModule.instance.exports.ocaml_exit))
+            process.exit(e.getArg(runtimeModule.instance.exports.ocaml_exit, 0));
+        if (e instanceof WebAssembly.Exception &&
+            e.is(runtimeModule.instance.exports.ocaml_exception)) {
+            console.log('Uncaught exception')
+            process.exit(1)
+        }
+        throw e;
+    }
+
+})()
diff --git a/runtime/wasm/run.js b/runtime/wasm/run.js
index cfa767e047..a66c37e23d 100644
--- a/runtime/wasm/run.js
+++ b/runtime/wasm/run.js
@@ -1,28 +1,64 @@
-const fs = require('fs/promises');
-const path = require('path');
-
-async function main() {
+(async function () {
+    const fs = require('fs/promises');
+    const path = require('path');
     const runtimePath =
           path.resolve(path.dirname(process.argv[1]), 'runtime.wasm');
     const runtime = fs.readFile(runtimePath);
     const code = fs.readFile(process.argv[2]);
+
+    var caml_callback;
+
     let math =
         {cos:Math.cos, sin:Math.sin, asin:Math.asin, atan2:Math.atan2,
-         pow:Math.pow, fmod:(x, y) => x%y}
+         pow:Math.pow, fmod:(x, y) => x%y,
+         log:(x)=>console.log('ZZZZZ', x)}
+    let bindings =
+        {identity:(x)=>x,
+         from_bool:(x)=>!!x,
+         get:(x,y)=>x[y],
+         set:(x,y,z)=>x[y]=z,
+         eval:eval,
+         strict_equals:(x,y)=>x===y,
+         fun_call:(f,args)=>f.apply(null,args),
+         meth_call:(o,f,args)=>o[f].apply(o,args),
+         new_array:(n)=>new Array(n),
+         new_obj:()=>({}),
+         new:(c,args)=>{return new c(...args)},
+         array_length:(a)=>a.length,
+         array_get:(a,i)=>a[i],
+         array_set:(a,i,v)=>a[i]=v,
+         get_int:(a,i)=>a[i],
+         wrap_callback_strict:(arity,f)=>function (){
+             var n = arguments.length;
+             var args = new Array(arity);
+             var len = Math.min(arguments.length, arity)
+             for (var i = 0; i < len; i++) args[i] = arguments[i];
+             return caml_callback(f, arity, args);
+         },
+         format:(f)=>""+f
+        }
     const runtimeModule =
-          await WebAssembly.instantiate(await runtime, {Math:math});
+          await WebAssembly.instantiate(await runtime,
+                                        {Math:math,bindings:bindings});
+
+    caml_callback = runtimeModule.instance.exports.caml_callback;
+
     const wasmModule =
           await WebAssembly.instantiate(await code,
                                         {env:runtimeModule.instance.exports,
                                          Math:math})
     try {
-      wasmModule.instance.exports._initialize()
+        wasmModule.instance.exports._initialize()
     } catch (e) {
         if (e instanceof WebAssembly.Exception &&
             e.is(runtimeModule.instance.exports.ocaml_exit))
             process.exit(e.getArg(runtimeModule.instance.exports.ocaml_exit, 0));
+        if (e instanceof WebAssembly.Exception &&
+            e.is(runtimeModule.instance.exports.ocaml_exception)) {
+            console.log('Uncaught exception')
+            process.exit(1)
+        }
         throw e;
     }
-}
 
-main ()
+})()
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index f6b6260564..0c1a958861 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -2,12 +2,15 @@
    (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
    (tag $ocaml_exit (export "ocaml_exit") (param i32))
 
+   (import "Math" "log" (func $log (param i32)))
+   (import "Math" "log" (func $log_js (param anyref)))
+
+   (type $float (struct (field f64)))
+
    (type $block (array (mut (ref eq))))
 
    (type $string (array (mut i8)))
 
-   (type $float (struct (field f64)))
-
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
 
    (type $closure (struct (field i32) (field (ref $function_1))))
@@ -53,7 +56,7 @@
 
    (data $index_out_of_bounds "index out of bounds")
 
-   (func $caml_array_bound_error (export "caml_array_bound_error")
+   (func $caml_bound_error (export "caml_bound_error")
       (call $caml_invalid_argument
          (array.new_data $string $index_out_of_bounds
             (i32.const 0) (i32.const 19))))
@@ -136,17 +139,42 @@
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_register_named_value")
+   (func (export "caml_ml_output")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_output_char")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_int_of_string")
+   (func (export "caml_register_named_value")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
       (i31.new (i32.const 0)))
 
+   (func (export "caml_int_of_string")
+      (param $v (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $i i32) (local $len i32)
+      (local $res i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $res (i32.const 0))
+      (local.set $i (i32.const 0))
+      (local.set $len (array.len (local.get $s)))
+      ;; ZZZ validation / negative numbers / ...
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $res
+                  (i32.add (i32.mul (local.get $res) (i32.const 10))
+                     (i32.sub
+                        (array.get_u $string (local.get $s) (local.get $i))
+                        (i32.const 48))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (local.get $res)))
+
    (func (export "caml_sys_exit") (param (ref eq)) (result (ref eq))
-      (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get $0)))))
+      (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get 0)))))
 
    (global $caml_oo_last_id (mut i32) (i32.const 0))
 
@@ -202,6 +230,9 @@
          (then (return (i31.new (global.get $closure_tag)))))
       ;; ZZZ float array
       ;; ZZZ others?
+      (if (ref.test $js (local.get $v))
+         (then (return (i31.new (global.get $custom_tag))))) ;; ZZZ ???
+      (call $log (i32.const 0))
       (unreachable))
 
    (func (export "caml_obj_make_forward")
@@ -264,7 +295,9 @@
          (i31.new (i32.eqz (i31.get_u (ref.cast i31
             (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
 
-   (func (export "caml_string_of_bytes") (param $v (ref eq)) (result (ref eq))
+   (export "caml_bytes_of_string" (func $caml_string_of_bytes))
+   (func $caml_string_of_bytes (export "caml_string_of_bytes")
+      (param $v (ref eq)) (result (ref eq))
       (local.get $v))
 
    (func (export "caml_string_get")
@@ -273,7 +306,7 @@
       (local.set $s (ref.cast $string (local.get $v)))
       (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
       (if (i32.ge_u (local.get $p) (array.len (local.get $s)))
-         (then (call $caml_array_bound_error)))
+         (then (call $caml_bound_error)))
       (i31.new (array.get_u $string (local.get $s) (local.get $p))))
 
    (data $Bytes_create "Bytes.create")
@@ -323,12 +356,29 @@
             (br_if $return (i32.eq (local.get $i) (local.get $l)))
             (array.set $string (local.get $s2)
                (i32.add (local.get $p2) (local.get $i))
-                        (array.get_u $string (local.get $s1)
-                           (i32.add (local.get $p1) (local.get $i))))
+               (array.get_u $string (local.get $s1)
+                  (i32.add (local.get $p1) (local.get $i))))
             (local.set $i (i32.add (local.get $i) (i32.const 1)))
             (br $loop2)))
       (i31.new (i32.const 0)))
 
+   (func (export "caml_fill_bytes")
+      (param $v (ref eq)) (param $offset (ref eq))
+      (param $len (ref eq)) (param $init (ref eq))
+      (result (ref eq))
+      (local $s (ref $string)) (local $i i32) (local $limit i32) (local $c i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get $offset))))
+      (local.set $limit (i32.add (local.get $i) (i31.get_u (ref.cast i31 (local.get $len)))))
+      (local.set $c (i31.get_u (ref.cast i31 (local.get $init))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $limit))
+            (then
+               (array.set $string (local.get $s) (local.get $i) (local.get $c))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (i32.const 0)))
+
    (type $int_array (array (mut i32)))
    (type $block_array (array (mut (ref $block))))
    (type $compare_stack
@@ -390,7 +440,8 @@
       ;; ZZZ Allocate a larger stack if necessary
       (if (i32.ge_u (local.get $i)
              (array.len (struct.get $compare_stack 1 (local.get $stack))))
-         (then (unreachable)))
+         (then       (call $log (i32.const 1))
+(unreachable)))
       (struct.set $compare_stack 0 (local.get $stack) (local.get $i))
       (array.set $block_array (struct.get $compare_stack 1 (local.get $stack))
          (local.get $i) (local.get $v1))
@@ -607,12 +658,14 @@
                   (br $next_item)))
                ;; ZZZ forward tag
                ;; ZZZ float array
+      (call $log (i32.const 2))
                (unreachable)
                (return (i32.const 1))))
             (if (ref.test $float (local.get $v2))
                (then
                   ;; ZZZ forward tag
                   ;; ZZZ float array
+      (call $log (i32.const 3))
                   (unreachable)
                   (return (i32.const -1))))
             (drop (block $v1_not_string (result (ref eq))
@@ -628,6 +681,7 @@
                   (return (local.get $res))))
                ;; ZZZ forward tag
                ;; ZZZ float array
+      (call $log (i32.const 4))
                (unreachable)
                (return (i32.const 1))))
             (drop (block $v1_not_custom (result (ref eq))
@@ -648,8 +702,10 @@
                   (return (local.get $res))))
                ;; ZZZ forward tag
                ;; ZZZ float array
+      (call $log (i32.const 5))
                (unreachable)
                (return (i32.const 1))))
+      (call $log (i32.const 6))
             (unreachable)
             ;; ZZZ forward tag
             ;; ZZZ float array
@@ -712,4 +768,342 @@
       (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
       (i31.new (i32.le_s (i32.const 0)
          (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+
+   ;; ZZZ
+   (func $dummy_format_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (array.new_fixed $string (i32.const 64)))
+   (func (export "%caml_format_int_special") (param (ref eq)) (result (ref eq))
+      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 0)))))
+   (func (export "caml_format_int") (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 1)))))
+   (export "caml_int32_format" (func $dummy_format_fun))
+   (export "caml_int64_format" (func $dummy_format_fun))
+   (export "caml_nativeint_format" (func $dummy_format_fun))
+   (func (export "caml_hexstring_of_float")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (array.new_fixed $string (i32.const 64)))
+   (func (export "caml_format_float")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $caml_string_of_jsstring (call $wrap (call $format_float (struct.get $float 0 (ref.cast $float (local.get 1)))))))
+
+   (func (export "caml_get_exception_raw_backtrace")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_convert_raw_backtrace")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_ml_debug_info_status")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_max_wosize")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0xfffffff)))
+
+   (global $bigarray_ops (ref $custom_operations)
+      ;; ZZZ
+      (struct.new $custom_operations (ref.func $int64_cmp)))
+
+   (type $bigarray
+      (sub $custom
+         (struct
+            (field (ref $custom_operations))
+            (field (ref array)) ;; data
+            (field (ref $int_array)) ;; size in each dimension
+            (field i8) ;; number of dimensions
+            (field i8) ;; kind
+            (field i8)))) ;; layout
+
+   (func (export "caml_ba_create")
+      (param $kind (ref eq)) (param $layout (ref eq)) (param $d (ref eq))
+      (result (ref eq))
+      (local $dims (ref $block))
+      (local $num_dims i32)
+      (local $len i32)
+      (local $data (ref $string))
+      (local.set $dims (ref.cast $block (local.get $d)))
+      (local.set $num_dims (i32.sub (array.len (local.get $dims)) (i32.const 1)))
+      (if (i32.eqz (i32.eq (local.get $num_dims) (i32.const 1)))
+         (then (unreachable))) ;;ZZZ
+      (local.set $len
+         (i31.get_u (ref.cast i31
+            (array.get $block (local.get $dims) (i32.const 1)))))
+      (local.set $data (array.new $string (i32.const 0) (local.get $len)))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (local.get $data)
+         (array.new_fixed $int_array (i32.const 1))
+         (local.get $num_dims)
+         (i31.get_s (ref.cast i31 (local.get $kind)))
+         (i31.get_s (ref.cast i31 (local.get $layout)))))
+
+   (func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq))
+      (local $ta externref)
+      (local $len i32) (local $i i32)
+      (local $data (ref $string))
+      ;; ZZZ
+      (local.set $ta (extern.externalize (call $unwrap (local.get 0))))
+      (local.set $len (call $array_length (local.get $ta)))
+      (local.set $data (array.new $string (i32.const 0) (local.get $len)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (array.set $string (local.get $data) (local.get $i)
+                  (call $get_int (local.get $ta) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (local.get $data)
+         (array.new_fixed $int_array (i32.const 1))
+         (i32.const 1)
+         (i32.const 0)
+         (i32.const 0)))
+
+   (func (export "caml_ba_get_1")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local.set $ba (ref.cast $bigarray (local.get 0)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
+      ;; ZZZ bound check / kind / layout
+      (i31.new (array.get_u $string
+                  (ref.cast $string (struct.get $bigarray 1 (local.get $ba)))
+                  (local.get $i))))
+
+   (func (export "caml_ba_set_1")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local.set $ba (ref.cast $bigarray (local.get 0)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
+      ;; ZZZ bound check / kind / layout
+      (array.set $string
+         (ref.cast $string (struct.get $bigarray 1 (local.get $ba)))
+         (local.get $i) (i31.get_u (ref.cast i31 (local.get 2))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log (i32.const 26))
+      (unreachable)
+      (i31.new (i32.const 0)))
+
+   (type $js (struct (field anyref)))
+
+   (func $wrap (param anyref) (result (ref eq))
+      (block $is_eq (result (ref eq))
+         (return (struct.new $js (br_on_cast $is_eq eq (local.get 0))))))
+
+   (func $unwrap (param (ref eq)) (result anyref)
+      (block $not_js (result anyref)
+         (return (struct.get $js 0
+                    (br_on_cast_fail $not_js $js (local.get 0))))))
+
+   (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
+   (import "bindings" "identity" (func $from_float (param f64) (result anyref)))
+   (import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
+   (import "bindings" "identity" (func $ref_cast_string (param anyref) (result stringref)))
+   (import "bindings" "from_bool" (func $from_bool (param i32) (result anyref)))
+   (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
+   (import "bindings" "get" (func $get (param externref) (param anyref) (result anyref)))
+   (import "bindings" "set" (func $set (param anyref) (param anyref) (param anyref)))
+   (import "bindings" "strict_equals" (func $strict_equals (param anyref) (param anyref) (result i32)))
+   (import "bindings" "fun_call" (func $fun_call (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "meth_call" (func $meth_call (param anyref) (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "new" (func $new (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "new_obj" (func $new_obj (result anyref)))
+   (import "bindings" "new_array" (func $new_array (param i32) (result externref)))
+   (import "bindings" "array_length"
+      (func $array_length (param externref) (result i32)))
+   (import "bindings" "array_get"
+      (func $array_get (param externref) (param i32) (result anyref)))
+   (import "bindings" "array_set"
+      (func $array_set (param externref) (param i32) (param anyref)))
+   (import "bindings" "wrap_callback_strict"
+      (func $wrap_callback_strict (param i32) (param (ref eq)) (result anyref)))
+   (import "bindings" "get_int" (func $get_int (param externref) (param i32) (result i32)))
+   (import "bindings" "format" (func $format_float (param f64) (result anyref)))
+   (import "bindings" "format" (func $format_int (param (ref eq)) (result anyref)))
+
+   (func (export "caml_js_strict_equals")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $strict_equals
+                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
+
+   ;; ZZZ We should generate JavaScript code instead of using 'eval'
+   (export "caml_pure_js_expr" (func $caml_js_expr))
+   (func $caml_js_expr (export "caml_js_expr")
+      (param (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local.set $s (ref.cast $string (local.get 0)))
+      (call $wrap (call $eval (string.new_wtf8_array wtf8 (local.get $s) (i32.const 0) (array.len (local.get $s))))))
+
+   (func (export "caml_js_to_float") (param (ref eq)) (result (ref eq))
+      (struct.new $float (call $to_float (call $unwrap (local.get 0)))))
+
+   (func (export "caml_js_from_float") (param (ref eq)) (result (ref eq))
+      (call $wrap
+         (call $from_float
+            (struct.get $float 0 (ref.cast $float (local.get 0))))))
+
+   (func (export "caml_js_to_bool") (param (ref eq)) (result (ref eq))
+      (i31.new (call $to_bool (struct.get $js 0 (ref.cast $js (local.get 0))))))
+
+   (func (export "caml_js_from_bool") (param (ref eq)) (result (ref eq))
+      (struct.new $js
+         (call $from_bool (i31.get_s (ref.cast i31 (local.get 0))))))
+
+   (func (export "caml_js_fun_call")
+      (param $f (ref eq)) (param $args (ref eq)) (result (ref eq))
+      (call $wrap
+         (call $fun_call (call $unwrap (local.get $f))
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_js_meth_call")
+      (param $o (ref eq)) (param $f (ref eq)) (param $args (ref eq))
+      (result (ref eq))
+      (call $wrap
+         (call $meth_call (call $unwrap (local.get $o))
+            (call $unwrap (call $caml_jsstring_of_string (local.get $f)))
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_js_get")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (if (ref.test $string (local.get 1))
+         (then
+            ;; ZZZ jsbytes
+            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+      (call $wrap
+         (call $get (extern.externalize (call $unwrap (local.get 0)))
+            (call $unwrap (local.get 1)))))
+
+   (func (export "caml_js_set")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (if (ref.test $string (local.get 1))
+         (then
+            ;; ZZZ jsbytes
+            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+      (call $set (call $unwrap (local.get 0)) (call $unwrap (local.get 1))
+         (call $unwrap (local.get 2)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_js_new")
+      (param $c (ref eq)) (param $args (ref eq)) (result (ref eq))
+      (call $wrap
+         (call $new (call $unwrap (local.get $c))
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_js_object")
+      (param (ref eq)) (result (ref eq))
+      (local $a (ref $block)) (local $p (ref $block))
+      (local $i i32) (local $l i32)
+      (local $o anyref)
+      (local.set $a (ref.cast $block (local.get 0)))
+      (local.set $l (array.len (local.get $a)))
+      (local.set $i (i32.const 1))
+      (local.set $o (call $new_obj))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $p
+                  (ref.cast $block
+                     (array.get $block (local.get $a) (local.get $i))))
+               (call $set (local.get $o)
+                  (call $unwrap
+                     (call $caml_jsstring_of_string
+                        (array.get $block (local.get $p) (i32.const 1))))
+                  (call $unwrap
+                        (array.get $block (local.get $p) (i32.const 2))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.new $js (local.get $o)))
+
+   (func $caml_js_from_array (export "caml_js_from_array")
+      (param (ref eq)) (result (ref eq))
+      (local $a (ref $block))
+      (local $a' externref)
+      (local $i i32) (local $l i32)
+      (local.set $a (ref.cast $block (local.get 0)))
+      (local.set $l (i32.sub (array.len (local.get $a)) (i32.const 1)))
+      (local.set $a' (call $new_array (local.get $l)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (call $array_set (local.get $a') (local.get $i)
+                  (call $unwrap (array.get $block (local.get $a)
+                                   (i32.add (local.get $i) (i32.const 1)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.new $js (extern.internalize (local.get $a'))))
+
+   (func (export "caml_js_to_array")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log (i32.const 16))
+(unreachable)
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_js_wrap_callback_strict")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $wrap (call $wrap_callback_strict
+                     (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+
+   (func (export "caml_callback")
+      (param $f (ref eq)) (param $count i32) (param $args (ref extern))
+      (result anyref)
+      (local $acc (ref eq)) (local $i i32)
+      (local.set $acc (local.get $f))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $count))
+            (then
+               (local.set $acc
+                  (call_ref $function_1
+                     (call $wrap
+                        (call $get (local.get $args) (i31.new (local.get $i))))
+                     (local.get $acc)
+                     (struct.get $closure 1
+                        (ref.cast $closure (local.get $acc)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (call $unwrap (local.get $acc)))
+
+   (func $caml_jsstring_of_string (export "caml_jsstring_of_string")
+      (param (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local.set $s (ref.cast $string (local.get 0)))
+      ;; ZZZ string.new_wtf8_array replace
+      (struct.new $js
+         (string.new_wtf8_array wtf8 (local.get $s) (i32.const 0)
+           (array.len (local.get $s)))))
+
+   (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
+      (param (ref eq)) (result (ref eq))
+      (local $s stringref)
+      (local $l i32)
+      (local $s' (ref $string))
+      ;; ZZZ ref.cast string not yet implemented by V8
+      (local.set $s
+         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
+      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
+      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
+      (drop (string.encode_wtf8_array wtf8
+               (local.get $s) (local.get $s') (i32.const 0)))
+      (local.get $s'))
+
+   (func (export "caml_list_to_js_array")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log (i32.const 20))
+(unreachable)
+      (i31.new (i32.const 0)))
 )
+

From 1f9e5e8a4e6f8d78a5817a0299c29c3825b1a370 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 10 May 2023 16:29:36 +0200
Subject: [PATCH 026/481] Update script to execute Wasm code

---
 runtime/wasm/dune   | 9 +++++++++
 runtime/wasm/run.js | 1 +
 2 files changed, 10 insertions(+)
 create mode 100644 runtime/wasm/dune
 mode change 100644 => 100755 runtime/wasm/run.js

diff --git a/runtime/wasm/dune b/runtime/wasm/dune
new file mode 100644
index 0000000000..72f6fbfd26
--- /dev/null
+++ b/runtime/wasm/dune
@@ -0,0 +1,9 @@
+(rule
+   (target runtime.wasm)
+   (deps runtime.wat)
+   (action
+      (run wasm-opt --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{deps} -O  -o %{target})))
+
+(alias
+ (name all)
+ (deps (glob_files *.js)))
diff --git a/runtime/wasm/run.js b/runtime/wasm/run.js
old mode 100644
new mode 100755
index a66c37e23d..95e6f46ddd
--- a/runtime/wasm/run.js
+++ b/runtime/wasm/run.js
@@ -1,3 +1,4 @@
+#!/usr/bin/env -S node --experimental-wasm-stringref  --experimental-wasm-gc
 (async function () {
     const fs = require('fs/promises');
     const path = require('path');

From a6bea343b9044d3fab03967eaedd9a49d1694a3a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 15 May 2023 13:37:32 +0200
Subject: [PATCH 027/481] Tail calls

---
 compiler/lib/wasm/wa_code_generation.ml |  1 +
 compiler/lib/wasm/wa_tail_call.ml       | 62 +++++++++++++++++++++++++
 compiler/lib/wasm/wa_tail_call.mli      |  1 +
 3 files changed, 64 insertions(+)
 create mode 100644 compiler/lib/wasm/wa_tail_call.ml
 create mode 100644 compiler/lib/wasm/wa_tail_call.mli

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index b96c826916..2fb711f360 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -411,6 +411,7 @@ let function_body ~context ~value_type ~param_count ~body =
       | Local (i, typ) -> local_types.(i) <- typ
       | Expr _ -> ())
     st.vars;
+  let body = Wa_tail_call.f body in
   let locals =
     local_types
     |> Array.map ~f:(fun v -> Option.value ~default:value_type v)
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
new file mode 100644
index 0000000000..94d249b8a2
--- /dev/null
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -0,0 +1,62 @@
+open! Stdlib
+
+let rec instruction ~tail i =
+  match i with
+  | Wa_ast.Loop (ty, l) -> Wa_ast.Loop (ty, instructions ~tail l)
+  | Block (ty, l) -> Block (ty, instructions ~tail l)
+  | If (ty, e, l1, l2) -> If (ty, e, instructions ~tail l1, instructions ~tail l2)
+  | Try (ty, l, catches, catch_all) ->
+      Try
+        ( ty
+        , instructions ~tail:false l
+        , List.map ~f:(fun (tag, l) -> tag, instructions ~tail l) catches
+        , Option.map ~f:(fun l -> instructions ~tail l) catch_all )
+  | Return (Some (Call (symb, l))) -> Return_call (symb, l)
+  | Return (Some (Call_indirect (ty, e, l))) -> Return_call_indirect (ty, e, l)
+  | Return (Some (Call_ref (ty, e, l))) -> Return_call_ref (ty, e, l)
+  | Push (Call (symb, l)) when tail -> Return_call (symb, l)
+  | Push (Call_indirect (ty, e, l)) when tail -> Return_call_indirect (ty, e, l)
+  | Push (Call_ref (ty, e, l)) when tail -> Return_call_ref (ty, e, l)
+  | Push (Call_ref _) -> i
+  | Drop _
+  | Store _
+  | Store8 _
+  | LocalSet _
+  | GlobalSet _
+  | Br_table _
+  | Br _
+  | Return _
+  | Throw _
+  | Rethrow _
+  | CallInstr _
+  | Nop
+  | Push _
+  | ArraySet _
+  | StructSet _
+  | Br_on_cast _
+  | Br_on_cast_fail _
+  | Return_call_indirect _
+  | Return_call _
+  | Return_call_ref _ -> i
+
+and instructions ~tail l =
+  match l with
+  | [] -> []
+  | [ i ] -> [ instruction ~tail i ]
+  | [ LocalSet (x, Call (symb, l)); Return (Some (LocalGet y)) ] when x = y ->
+      [ Return_call (symb, l) ]
+  | [ LocalSet (x, Call_indirect (ty, e, l)); Return (Some (LocalGet y)) ] when x = y ->
+      [ Return_call_indirect (ty, e, l) ]
+  | [ LocalSet (x, Call_ref (ty, e, l)); Return (Some (LocalGet y)) ] when x = y ->
+      [ Return_call_ref (ty, e, l) ]
+  | [ LocalSet (x, Call (symb, l)); Push (LocalGet y) ] when tail && x = y ->
+      [ Return_call (symb, l) ]
+  | [ LocalSet (x, Call_indirect (ty, e, l)); Push (LocalGet y) ] when tail && x = y ->
+      [ Return_call_indirect (ty, e, l) ]
+  | [ LocalSet (x, Call_ref (ty, e, l)); Push (LocalGet y) ] when tail && x = y ->
+      [ Return_call_ref (ty, e, l) ]
+  | i :: Nop :: rem -> instructions ~tail (i :: rem)
+  | i :: i' :: Nop :: rem -> instructions ~tail (i :: i' :: rem)
+  | i :: rem -> instruction ~tail:false i :: instructions ~tail rem
+
+let f l = instructions ~tail:true l
diff --git a/compiler/lib/wasm/wa_tail_call.mli b/compiler/lib/wasm/wa_tail_call.mli
new file mode 100644
index 0000000000..2c65525ff5
--- /dev/null
+++ b/compiler/lib/wasm/wa_tail_call.mli
@@ -0,0 +1 @@
+val f : Wa_ast.instruction list -> Wa_ast.instruction list

From 4bb54dfcf295776948b9bdd1d726d1ca240cd1da Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 14:28:20 +0200
Subject: [PATCH 028/481] Fix generated code

---
 compiler/lib/wasm/wa_gc_target.ml | 5 ++---
 compiler/lib/wasm/wa_generate.ml  | 4 +---
 2 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ec80b5a928..a651fec213 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -438,12 +438,11 @@ module Constant = struct
             ~init:(return [])
             a
         in
+        let l = List.rev l in
         let l' =
           List.map ~f:(fun (const, v) -> if const then v else W.I31New (Const (I32 0l))) l
         in
-        let c =
-          W.ArrayNewFixed (ty, I31New (Const (I32 (Int32.of_int tag))) :: List.rev l')
-        in
+        let c = W.ArrayNewFixed (ty, I31New (Const (I32 (Int32.of_int tag))) :: l') in
         if List.exists ~f:(fun (const, _) -> not const) l
         then
           let* c = store_in_global c in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 1e38330cf6..ef4d92073f 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -452,9 +452,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                | Cond _ | Pushtrap _ -> false (*ZZZ also some Switch*)
                | _ -> true
             then
-              block
-                { params = []; result = result_typ }
-                (code ~context:(`Block pc' :: context))
+              block { params = []; result = [] } (code ~context:(`Block pc' :: context))
             else code ~context
           in
           translate_tree result_typ fall_through pc' context

From 5f637978867c301be3e0890d6d21be910c6e4991 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 10:53:35 +0200
Subject: [PATCH 029/481] Standalone wasm_of_ocaml binary

---
 compiler/bin-js_of_ocaml/build_fs.ml          |   2 +-
 compiler/bin-js_of_ocaml/compile.ml           |   4 +-
 compiler/bin-wasm_of_ocaml/cmd_arg.ml         |  69 ++++++++
 compiler/bin-wasm_of_ocaml/cmd_arg.mli        |  31 ++++
 compiler/bin-wasm_of_ocaml/compile.ml         | 167 ++++++++++++++++++
 compiler/bin-wasm_of_ocaml/compile.mli        |  25 +++
 compiler/bin-wasm_of_ocaml/dune               |  44 +++++
 .../findlib_support.empty.ml                  |  18 ++
 compiler/bin-wasm_of_ocaml/gen/dune           |   2 +
 compiler/bin-wasm_of_ocaml/gen/gen.ml         |   7 +
 compiler/bin-wasm_of_ocaml/info.ml            |  49 +++++
 compiler/bin-wasm_of_ocaml/info.mli           |  20 +++
 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml   | 112 ++++++++++++
 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli  |  18 ++
 compiler/lib/driver.ml                        |  33 ++--
 compiler/lib/driver.mli                       |   4 +-
 compiler/lib/wasm/wa_asm_output.ml            |   8 +-
 compiler/lib/wasm/wa_asm_output.mli           |   2 +-
 compiler/lib/wasm/wa_generate.ml              |   6 +-
 compiler/lib/wasm/wa_generate.mli             |   2 +-
 compiler/lib/wasm/wa_wat_output.ml            |   5 +-
 compiler/lib/wasm/wa_wat_output.mli           |   2 +-
 dune-project                                  |  24 +++
 runtime/wasm/index.js                         |   8 +-
 wasm_of_ocaml-compiler.opam                   |  48 +++++
 25 files changed, 678 insertions(+), 32 deletions(-)
 create mode 100644 compiler/bin-wasm_of_ocaml/cmd_arg.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/cmd_arg.mli
 create mode 100644 compiler/bin-wasm_of_ocaml/compile.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/compile.mli
 create mode 100644 compiler/bin-wasm_of_ocaml/dune
 create mode 100644 compiler/bin-wasm_of_ocaml/findlib_support.empty.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/gen/dune
 create mode 100644 compiler/bin-wasm_of_ocaml/gen/gen.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/info.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/info.mli
 create mode 100644 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli
 create mode 100644 wasm_of_ocaml-compiler.opam

diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml
index 8c30bdc6f4..0acc861ff8 100644
--- a/compiler/bin-js_of_ocaml/build_fs.ml
+++ b/compiler/bin-js_of_ocaml/build_fs.ml
@@ -75,9 +75,9 @@ function jsoo_create_file_extern(name,content){
       let pfs_fmt = Pretty_print.to_out_channel chan in
       let (_ : Source_map.t option) =
         Driver.f
+          ~target:(`JavaScript pfs_fmt)
           ~standalone:true
           ~wrap_with_fun:`Iife
-          pfs_fmt
           (Parse_bytecode.Debug.create ~include_cmis:false false)
           code
       in
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 2d825e1b50..173257404b 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -190,12 +190,12 @@ let run
           in
           let code = Code.prepend one.code instr in
           Driver.f
+            ~target:(`JavaScript fmt)
             ~standalone
             ?profile
             ~linkall
             ~wrap_with_fun
             ?source_map
-            fmt
             one.debug
             code
       | `File, fmt ->
@@ -214,12 +214,12 @@ let run
           let code = Code.prepend one.code instr in
           let res =
             Driver.f
+              ~target:(`JavaScript fmt)
               ~standalone
               ?profile
               ~linkall
               ~wrap_with_fun
               ?source_map
-              fmt
               one.debug
               code
           in
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
new file mode 100644
index 0000000000..f2d507ed5b
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -0,0 +1,69 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2014 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open! Js_of_ocaml_compiler.Stdlib
+open Js_of_ocaml_compiler
+open Cmdliner
+
+type t =
+  { common : Jsoo_cmdline.Arg.t
+  ; (* compile option *)
+    profile : Driver.profile option
+  ; output_file : string * bool
+  ; input_file : string
+  ; params : (string * string) list
+  }
+
+let options =
+  let output_file =
+    let doc = "Set output file name to [$(docv)]." in
+    Arg.(value & opt (some string) None & info [ "o" ] ~docv:"FILE" ~doc)
+  in
+  let input_file =
+    let doc = "Compile the bytecode program [$(docv)]. " in
+    Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv:"PROGRAM" ~doc)
+  in
+  let profile =
+    let doc = "Set optimization profile : [$(docv)]." in
+    let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in
+    Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc)
+  in
+  let set_param =
+    let doc = "Set compiler options." in
+    let all = List.map (Config.Param.all ()) ~f:(fun (x, _) -> x, x) in
+    Arg.(
+      value
+      & opt_all (list (pair ~sep:'=' (enum all) string)) []
+      & info [ "set" ] ~docv:"PARAM=VALUE" ~doc)
+  in
+  let build_t common set_param profile output_file input_file =
+    let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
+    let output_file =
+      match output_file with
+      | Some s -> s, true
+      | None -> chop_extension input_file ^ ".wasm", false
+    in
+    let params : (string * string) list = List.flatten set_param in
+    `Ok { common; params; profile; output_file; input_file }
+  in
+  let t =
+    Term.(
+      const build_t $ Jsoo_cmdline.Arg.t $ set_param $ profile $ output_file $ input_file)
+  in
+  Term.ret t
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
new file mode 100644
index 0000000000..281b89b62f
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
@@ -0,0 +1,31 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2014 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open Js_of_ocaml_compiler
+
+type t =
+  { common : Jsoo_cmdline.Arg.t
+  ; (* compile option *)
+    profile : Driver.profile option
+  ; output_file : string * bool
+  ; input_file : string
+  ; params : (string * string) list
+  }
+
+val options : t Cmdliner.Term.t
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
new file mode 100644
index 0000000000..48887fc105
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -0,0 +1,167 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open! Js_of_ocaml_compiler.Stdlib
+open Js_of_ocaml_compiler
+
+let times = Debug.find "times"
+
+let debug_mem = Debug.find "mem"
+
+let () = Sys.catch_break true
+
+let command cmdline =
+  let cmdline = String.concat ~sep:" " cmdline in
+  let res = Sys.command cmdline in
+  if res = 127 then raise (Sys_error cmdline);
+  assert (res = 0)
+(*ZZZ*)
+
+let write_file name contents =
+  let ch = open_out name in
+  output_string ch contents;
+  close_out ch
+
+let remove_file filename =
+  try if Sys.file_exists filename then Sys.remove filename with Sys_error _msg -> ()
+
+let with_intermediate_file ?(keep = false) name f =
+  match f name with
+  | _ -> if not keep then remove_file name
+  | exception e ->
+      remove_file name;
+      raise e
+
+let output_gen output_file f =
+  Code.Var.set_pretty true;
+  Code.Var.set_stable (Config.Flag.stable_var ());
+  Filename.gen_file output_file f
+
+let common_binaryen_options =
+  [ "--enable-gc"
+  ; "--enable-multivalue"
+  ; "--enable-exception-handling"
+  ; "--enable-reference-types"
+  ; "--enable-tail-call"
+  ; "--enable-bulk-memory"
+  ; "--enable-nontrapping-float-to-int"
+  ; "--enable-strings"
+  ; "-g"
+  ; "-n"
+  ]
+
+let link runtime_file input_file output_file =
+  command
+    (("wasm-merge" :: common_binaryen_options)
+    @ [ Filename.quote runtime_file
+      ; "env"
+      ; Filename.quote input_file
+      ; "exec"
+      ; "-o"
+      ; Filename.quote output_file
+      ])
+
+let optimize in_file out_file =
+  command
+    (("wasm-opt" :: common_binaryen_options)
+    @ [ "-O3"; "--gufa"; "-O3"; Filename.quote in_file; "-o"; Filename.quote out_file ])
+
+let link_and_optimize wat_file output_file =
+  with_intermediate_file (Filename.temp_file "funtime" ".wasm")
+  @@ fun runtime_file ->
+  write_file runtime_file Wa_runtime.runtime;
+  with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
+  @@ fun temp_file ->
+  link runtime_file wat_file temp_file;
+  optimize temp_file output_file
+
+let run { Cmd_arg.common; profile; input_file; output_file; params } =
+  Jsoo_cmdline.Arg.eval common;
+  (match output_file with
+  | name, _ when debug_mem () -> Debug.start_profiling name
+  | _, _ -> ());
+  List.iter params ~f:(fun (s, v) -> Config.Param.set s v);
+  let t = Timer.make () in
+  let include_dirs = List.filter_map [ "+stdlib/" ] ~f:(fun d -> Findlib.find [] d) in
+  let t1 = Timer.make () in
+  let builtin = Js_of_ocaml_compiler_runtime_files.runtime in
+  List.iter builtin ~f:(fun t ->
+      let filename = Builtins.File.name t in
+      let runtimes = Linker.Fragment.parse_builtin t in
+      Linker.load_fragments ~target_env:Target_env.Isomorphic ~filename runtimes);
+  Linker.check_deps ();
+  if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
+  if times () then Format.eprintf "Start parsing...@.";
+  let need_debug = Config.Flag.debuginfo () in
+  let output (one : Parse_bytecode.one) ~standalone ch =
+    let code = one.code in
+    let _ =
+      Driver.f
+        ~target:(`Wasm ch)
+        ~standalone
+        ?profile
+        ~linkall:false
+        ~wrap_with_fun:`Iife
+        one.debug
+        code
+    in
+    if times () then Format.eprintf "compilation: %a@." Timer.print t
+  in
+  (let kind, ic, close_ic, include_dirs =
+     let ch = open_in_bin input_file in
+     let res = Parse_bytecode.from_channel ch in
+     let include_dirs = Filename.dirname input_file :: include_dirs in
+     res, ch, (fun () -> close_in ch), include_dirs
+   in
+   (match kind with
+   | `Exe ->
+       let t1 = Timer.make () in
+       (* The OCaml compiler can generate code using the
+          "caml_string_greaterthan" primitive but does not use it
+          itself. This is (was at some point at least) the only primitive
+          in this case.  Ideally, Js_of_ocaml should parse the .mli files
+          for primitives as well as marking this primitive as potentially
+          used. But the -linkall option is probably good enough. *)
+       let code =
+         Parse_bytecode.from_exe
+           ~includes:include_dirs
+           ~include_cmis:false
+           ~link_info:false
+           ~linkall:false
+           ~debug:need_debug
+           ic
+       in
+       if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
+       let wat_file = Filename.chop_extension (fst output_file) ^ ".wat" in
+       output_gen wat_file (output code ~standalone:true);
+       link_and_optimize wat_file (fst output_file)
+   | `Cmo _ | `Cma _ -> assert false);
+   close_ic ());
+  Debug.stop_profiling ()
+
+let info name =
+  Info.make
+    ~name
+    ~doc:"Wasm_of_ocaml compiler"
+    ~description:"Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly."
+
+let term = Cmdliner.Term.(const run $ Cmd_arg.options)
+
+let command =
+  let t = Cmdliner.Term.(const run $ Cmd_arg.options) in
+  Cmdliner.Cmd.v (info "compile") t
diff --git a/compiler/bin-wasm_of_ocaml/compile.mli b/compiler/bin-wasm_of_ocaml/compile.mli
new file mode 100644
index 0000000000..56b262fd23
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/compile.mli
@@ -0,0 +1,25 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val run : Cmd_arg.t -> unit
+
+val command : unit Cmdliner.Cmd.t
+
+val term : unit Cmdliner.Term.t
+
+val info : string -> Cmdliner.Cmd.info
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
new file mode 100644
index 0000000000..5730ecb106
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -0,0 +1,44 @@
+(executable
+ (name wasm_of_ocaml)
+ (public_name wasm_of_ocaml)
+ (package wasm_of_ocaml-compiler)
+ (libraries
+  jsoo_cmdline
+  js_of_ocaml-compiler
+  cmdliner
+  compiler-libs.common
+  js_of_ocaml-compiler.runtime-files
+  (select
+   findlib_support.ml
+   from
+   ;; Only link wasm_of_ocaml-compiler.findlib-support if it exists
+   (js_of_ocaml-compiler.findlib-support -> findlib_support.empty.ml)
+   (-> findlib_support.empty.ml)))
+ (modes
+  byte
+  (best exe))
+ (flags
+  (:standard -safe-string)))
+
+(rule
+ (target wa_runtime.ml)
+ (deps
+  gen/gen.exe
+  ../../runtime/wasm/runtime.wasm)
+ (action
+  (with-stdout-to
+   %{target}
+   (run %{deps}))))
+
+(rule
+ (targets wasm_of_ocaml.1)
+ (action
+  (with-stdout-to
+   %{targets}
+   (run %{bin:wasm_of_ocaml} --help=groff))))
+
+(install
+ (section man)
+ (package wasm_of_ocaml-compiler)
+ (files
+  wasm_of_ocaml.1))
diff --git a/compiler/bin-wasm_of_ocaml/findlib_support.empty.ml b/compiler/bin-wasm_of_ocaml/findlib_support.empty.ml
new file mode 100644
index 0000000000..a96ea76350
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/findlib_support.empty.ml
@@ -0,0 +1,18 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
diff --git a/compiler/bin-wasm_of_ocaml/gen/dune b/compiler/bin-wasm_of_ocaml/gen/dune
new file mode 100644
index 0000000000..9df6b5100e
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/gen/dune
@@ -0,0 +1,2 @@
+(executable
+ (name gen))
diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml
new file mode 100644
index 0000000000..3ccb2003af
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml
@@ -0,0 +1,7 @@
+let read_file ic = really_input_string ic (in_channel_length ic)
+
+let () =
+  let () = set_binary_mode_out stdout true in
+  Format.printf
+    "let runtime = \"%s\"@."
+    (String.escaped (read_file (open_in Sys.argv.(1))))
diff --git a/compiler/bin-wasm_of_ocaml/info.ml b/compiler/bin-wasm_of_ocaml/info.ml
new file mode 100644
index 0000000000..0fc46359f7
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/info.ml
@@ -0,0 +1,49 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open Js_of_ocaml_compiler
+open Cmdliner
+
+let make ~name ~doc ~description =
+  let man =
+    [ `S "DESCRIPTION"
+    ; `P description
+    ; `S "BUGS"
+    ; `P
+        "Bugs are tracked on github at \
+         $(i,https://github.com/ocsigen/js_of_ocaml/issues)."
+    ; `S "SEE ALSO"
+    ; `P "ocaml(1)"
+    ; `S "AUTHORS"
+    ; `P "Jerome Vouillon, Hugo Heuzard."
+    ; `S "LICENSE"
+    ; `P "Copyright (C) 2010-2020."
+    ; `P
+        "js_of_ocaml 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, with linking exception; either version 2.1 of the License, \
+         or (at your option) any later version."
+    ]
+  in
+  let version =
+    match Compiler_version.git_version with
+    | "" -> Compiler_version.s
+    | v -> Printf.sprintf "%s+git-%s" Compiler_version.s v
+  in
+  Cmd.info name ~version ~doc ~man
diff --git a/compiler/bin-wasm_of_ocaml/info.mli b/compiler/bin-wasm_of_ocaml/info.mli
new file mode 100644
index 0000000000..cab49a83d2
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/info.mli
@@ -0,0 +1,20 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val make : name:string -> doc:string -> description:string -> Cmdliner.Cmd.info
diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
new file mode 100644
index 0000000000..313c8bb412
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
@@ -0,0 +1,112 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2010 Jérôme Vouillon
+ * Laboratoire PPS - CNRS Université Paris Diderot
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open! Js_of_ocaml_compiler.Stdlib
+open Js_of_ocaml_compiler
+
+let () =
+  Sys.catch_break true;
+  let argv = Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv in
+  let argv =
+    let like_arg x = String.length x > 0 && Char.equal x.[0] '-' in
+    let like_command x =
+      String.length x > 0
+      && (not (Char.equal x.[0] '-'))
+      && String.for_all x ~f:(function
+             | 'a' .. 'z' | 'A' .. 'Z' | '-' -> true
+             | _ -> false)
+    in
+    match Array.to_list argv with
+    | exe :: maybe_command :: rest ->
+        if like_command maybe_command || like_arg maybe_command
+        then argv
+        else
+          (* Keep compatibility with js_of_ocaml < 3.6.0 *)
+          Array.of_list (exe :: Cmdliner.Cmd.name Compile.command :: maybe_command :: rest)
+    | _ -> argv
+  in
+  try
+    match
+      Cmdliner.Cmd.eval_value
+        ~catch:false
+        ~argv
+        (Cmdliner.Cmd.group
+           ~default:Compile.term
+           (Compile.info "wasm_of_ocaml")
+           [ Compile.command ])
+    with
+    | Ok (`Ok () | `Help | `Version) ->
+        if !warnings > 0 && !werror
+        then (
+          Format.eprintf "%s: all warnings being treated as errors@." Sys.argv.(0);
+          exit 1)
+        else exit 0
+    | Error `Term -> exit 1
+    | Error `Parse -> exit Cmdliner.Cmd.Exit.cli_error
+    | Error `Exn -> ()
+    (* should not happen *)
+  with
+  | (Match_failure _ | Assert_failure _ | Not_found) as exc ->
+      let backtrace = Printexc.get_backtrace () in
+      Format.eprintf
+        "%s: You found a bug. Please report it at \
+         https://github.com/ocsigen/js_of_ocaml/issues :@."
+        Sys.argv.(0);
+      Format.eprintf "Error: %s@." (Printexc.to_string exc);
+      prerr_string backtrace;
+      exit Cmdliner.Cmd.Exit.internal_error
+  | Magic_number.Bad_magic_number s ->
+      Format.eprintf "%s: Error: Not an ocaml bytecode file@." Sys.argv.(0);
+      Format.eprintf "%s: Error: Invalid magic number %S@." Sys.argv.(0) s;
+      exit 1
+  | Magic_number.Bad_magic_version h ->
+      Format.eprintf "%s: Error: Bytecode version mismatch.@." Sys.argv.(0);
+      let k =
+        match Magic_number.kind h with
+        | (`Cmo | `Cma | `Exe) as x -> x
+        | `Other _ -> assert false
+      in
+      let comp =
+        if Magic_number.compare h (Magic_number.current k) < 0
+        then "an older"
+        else "a newer"
+      in
+      Format.eprintf
+        "%s: Error: Your ocaml bytecode and the wasm_of_ocaml compiler have to be \
+         compiled with the same version of ocaml.@."
+        Sys.argv.(0);
+      Format.eprintf
+        "%s: Error: The Wasm_of_ocaml compiler has been compiled with ocaml version %s.@."
+        Sys.argv.(0)
+        Sys.ocaml_version;
+      Format.eprintf
+        "%s: Error: Its seems that your ocaml bytecode has been compiled with %s version \
+         of ocaml.@."
+        Sys.argv.(0)
+        comp;
+      exit 1
+  | Failure s ->
+      Format.eprintf "%s: Error: %s@." Sys.argv.(0) s;
+      exit 1
+  | exc ->
+      let backtrace = Printexc.get_backtrace () in
+      Format.eprintf "%s: Error: %s@." Sys.argv.(0) (Printexc.to_string exc);
+      prerr_string backtrace;
+      exit 1
diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli
new file mode 100644
index 0000000000..a96ea76350
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli
@@ -0,0 +1,18 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index f5d8cc8fa2..bb8de30908 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -178,7 +178,6 @@ let generate
     ((p, live_vars), cps_calls) =
   if times () then Format.eprintf "Start Generation...@.";
   let should_export = should_export wrap_with_fun in
-  Wa_generate.f ~live_vars p;
   Generate.f
     p
     ~exported_runtime
@@ -571,7 +570,7 @@ let configure formatter =
   Code.Var.set_pretty (pretty && not (Config.Flag.shortvar ()));
   Code.Var.set_stable (Config.Flag.stable_var ())
 
-let full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map formatter d p =
+let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
   let exported_runtime = not standalone in
   let opt =
     specialize_js_once
@@ -583,7 +582,7 @@ let full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map formatter d p
     +> effects
     +> map_fst (*Generate_closure.f +>*) deadcode'
   in
-  let emit =
+  let emit formatter =
     generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
     +> link ~standalone ~linkall
     +> pack ~wrap_with_fun ~standalone
@@ -595,24 +594,29 @@ let full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map formatter d p
   let t = Timer.make () in
   let r = opt p in
   let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
-  emit r
-
-let full_no_source_map ~standalone ~wrap_with_fun ~profile ~linkall formatter d p =
+  match target with
+  | `JavaScript formatter -> emit formatter r
+  | `Wasm ch ->
+      let (p, live_vars), _ = r in
+      Wa_generate.f ch ~live_vars p;
+      None
+
+let full_no_source_map ~target ~standalone ~wrap_with_fun ~profile ~linkall d p =
   let (_ : Source_map.t option) =
-    full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map:None formatter d p
+    full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map:None d p
   in
   ()
 
 let f
+    ~target
     ?(standalone = true)
     ?(wrap_with_fun = `Iife)
     ?(profile = O1)
     ?(linkall = false)
     ?source_map
-    formatter
     d
     p =
-  full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map formatter d p
+  full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p
 
 let f'
     ?(standalone = true)
@@ -622,16 +626,23 @@ let f'
     formatter
     d
     p =
-  full_no_source_map ~standalone ~wrap_with_fun ~profile ~linkall formatter d p
+  full_no_source_map
+    ~target:(`JavaScript formatter)
+    ~standalone
+    ~wrap_with_fun
+    ~profile
+    ~linkall
+    d
+    p
 
 let from_string ~prims ~debug s formatter =
   let p, d = Parse_bytecode.from_string ~prims ~debug s in
   full_no_source_map
+    ~target:(`JavaScript formatter)
     ~standalone:false
     ~wrap_with_fun:`Anonymous
     ~profile:O1
     ~linkall:false
-    formatter
     d
     p
 
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index bc2dcecf8e..3359a12971 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -21,12 +21,12 @@
 type profile
 
 val f :
-     ?standalone:bool
+     target:[ `JavaScript of Pretty_print.t | `Wasm of out_channel ]
+  -> ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
   -> ?profile:profile
   -> ?linkall:bool
   -> ?source_map:Source_map.t
-  -> Pretty_print.t
   -> Parse_bytecode.Debug.t
   -> Code.program
   -> Source_map.t option
diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index aec7b7e4cc..1734650c46 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -429,14 +429,14 @@ module Output () = struct
               ~f:(fun f -> line (string ".ascii \"+\"") ^^ len_string f)
               (Feature.get features)))
 
-  let f fields =
+  let f ch fields =
     List.iter
       ~f:(fun f ->
         match f with
         | Global { name = S name; _ } -> Var_printer.add_reserved name
         | Import _ | Function _ | Data _ | Global { name = V _; _ } | Tag _ | Type _ -> ())
       fields;
-    to_channel stdout
+    to_channel ch
     @@
     let types =
       List.filter_map
@@ -601,6 +601,6 @@ module Output () = struct
     ^^ target_features
 end
 
-let f fields =
+let f ch fields =
   let module O = Output () in
-  O.f fields
+  O.f ch fields
diff --git a/compiler/lib/wasm/wa_asm_output.mli b/compiler/lib/wasm/wa_asm_output.mli
index a2cbc9164d..59f2b93d9a 100644
--- a/compiler/lib/wasm/wa_asm_output.mli
+++ b/compiler/lib/wasm/wa_asm_output.mli
@@ -1 +1 @@
-val f : Wa_ast.module_field list -> unit
+val f : out_channel -> Wa_ast.module_field list -> unit
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index ef4d92073f..c85744a5a7 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -671,13 +671,13 @@ module Generate (Target : Wa_target_sig.S) = struct
       (imports @ functions @ (start_function :: constant_data))
 end
 
-let f (p : Code.program) ~live_vars =
+let f ch (p : Code.program) ~live_vars =
   match target with
   | `Core ->
       let module G = Generate (Wa_core_target) in
       let fields = G.f ~live_vars p in
-      Wa_asm_output.f fields
+      Wa_asm_output.f ch fields
   | `GC ->
       let module G = Generate (Wa_gc_target) in
       let fields = G.f ~live_vars p in
-      Wa_wat_output.f fields
+      Wa_wat_output.f ch fields
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index b2d60bc2a5..5adecddcee 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -1 +1 @@
-val f : Code.program -> live_vars:int array -> unit
+val f : out_channel -> Code.program -> live_vars:int array -> unit
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 737ec4cdf8..07173fe785 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -592,7 +592,7 @@ let data_offsets fields =
     ~init:(0, Code.Var.Map.empty)
     fields
 
-let f fields =
+let f ch fields =
   let heap_base, addresses = data_offsets fields in
   let ctx =
     { addresses
@@ -633,7 +633,8 @@ let f fields =
       [ List (Atom "elem" :: Atom "declare" :: Atom "func" :: List.map ~f:index functions)
       ]
   in
-  Format.printf
+  Format.fprintf
+    (Format.formatter_of_out_channel ch)
     "%a@."
     format_sexp
     (List
diff --git a/compiler/lib/wasm/wa_wat_output.mli b/compiler/lib/wasm/wa_wat_output.mli
index a2cbc9164d..59f2b93d9a 100644
--- a/compiler/lib/wasm/wa_wat_output.mli
+++ b/compiler/lib/wasm/wa_wat_output.mli
@@ -1 +1 @@
-val f : Wa_ast.module_field list -> unit
+val f : out_channel -> Wa_ast.module_field list -> unit
diff --git a/dune-project b/dune-project
index a3e9e081da..86b19c9c19 100644
--- a/dune-project
+++ b/dune-project
@@ -131,3 +131,27 @@
   (ppx_expect (and (>= v0.14.2) :with-test))
   (re (and (>= 1.9.0) :with-test))
 ))
+
+(package
+ (name wasm_of_ocaml-compiler)
+ (synopsis "Compiler from OCaml bytecode to WebAssembly")
+ (description
+  "Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js")
+ (depends
+  (ocaml (and (>= 4.08) (< 5.1)))
+  (num :with-test)
+  (ppx_expect (and (>= v0.14.2) :with-test))
+  (ppxlib (>= 0.15.0))
+  (re :with-test)
+  (cmdliner (>= 1.1.0))
+  (sedlex (>= 2.3))
+  menhir
+  menhirLib
+  menhirSdk
+  yojson)
+ (depopts
+  ocamlfind)
+ (conflicts
+  (ocamlfind (< 1.5.1))
+  (js_of_ocaml (< 3.0))
+))
diff --git a/runtime/wasm/index.js b/runtime/wasm/index.js
index 66d7ee5e15..984c163a28 100644
--- a/runtime/wasm/index.js
+++ b/runtime/wasm/index.js
@@ -43,17 +43,17 @@
           await WebAssembly.instantiateStreaming(
               code,
               {env:runtimeModule.instance.exports,
-               Math:math}
+               Math:math,bindings:bindings}
           )
 
     try {
         wasmModule.instance.exports._initialize()
     } catch (e) {
         if (e instanceof WebAssembly.Exception &&
-            e.is(runtimeModule.instance.exports.ocaml_exit))
-            process.exit(e.getArg(runtimeModule.instance.exports.ocaml_exit, 0));
+            e.is(wasmModule.instance.exports.ocaml_exit))
+            process.exit(e.getArg(wasmModule.instance.exports.ocaml_exit, 0));
         if (e instanceof WebAssembly.Exception &&
-            e.is(runtimeModule.instance.exports.ocaml_exception)) {
+            e.is(wasmModule.instance.exports.ocaml_exception)) {
             console.log('Uncaught exception')
             process.exit(1)
         }
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
new file mode 100644
index 0000000000..d0af580a52
--- /dev/null
+++ b/wasm_of_ocaml-compiler.opam
@@ -0,0 +1,48 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Compiler from OCaml bytecode to WebAssembly"
+description:
+  "Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js"
+maintainer: ["Ocsigen team <dev@ocsigen.org>"]
+authors: ["Ocsigen team <dev@ocsigen.org>"]
+license: [
+  "GPL-2.0-or-later" "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception"
+]
+homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
+doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
+bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
+depends: [
+  "dune" {>= "3.7"}
+  "ocaml" {>= "4.08" & < "5.1"}
+  "num" {with-test}
+  "ppx_expect" {>= "v0.14.2" & with-test}
+  "ppxlib" {>= "0.15.0"}
+  "re" {with-test}
+  "cmdliner" {>= "1.1.0"}
+  "sedlex" {>= "2.3"}
+  "menhir"
+  "menhirLib"
+  "menhirSdk"
+  "yojson"
+  "odoc" {with-doc}
+]
+depopts: ["ocamlfind"]
+conflicts: [
+  "ocamlfind" {< "1.5.1"}
+  "js_of_ocaml" {< "3.0"}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git"

From 716c15101b3c5125d400c9baadf40ab7b19c063a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 11:45:26 +0200
Subject: [PATCH 030/481] Keep track of integer kinds

---
 compiler/bin-js_of_ocaml/compile.ml   |   4 +
 compiler/bin-wasm_of_ocaml/compile.ml |   1 +
 compiler/lib/code.ml                  |  19 +++-
 compiler/lib/code.mli                 |   7 +-
 compiler/lib/driver.ml                |  30 ++++--
 compiler/lib/effects.ml               |  13 +--
 compiler/lib/eval.ml                  | 132 +++++++++++++++-----------
 compiler/lib/eval.mli                 |   2 +-
 compiler/lib/flow.ml                  |   2 +-
 compiler/lib/generate.ml              |   4 +-
 compiler/lib/generate_closure.ml      |  15 ++-
 compiler/lib/link_js.ml               |   8 +-
 compiler/lib/ocaml_compiler.ml        |  29 ++++--
 compiler/lib/ocaml_compiler.mli       |   3 +-
 compiler/lib/parse_bytecode.ml        |  92 ++++++++++--------
 compiler/lib/parse_bytecode.mli       |  12 ++-
 compiler/lib/specialize_js.ml         |   6 +-
 compiler/lib/stdlib.ml                |  22 +++++
 compiler/lib/wasm/wa_core_target.ml   |  21 +++-
 compiler/lib/wasm/wa_gc_target.ml     |  39 +++++++-
 20 files changed, 321 insertions(+), 140 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 173257404b..a5dea291b0 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -290,6 +290,7 @@ let run
          let linkall = linkall || toplevel || dynlink in
          let code =
            Parse_bytecode.from_exe
+             ~target:`JavaScript
              ~includes:include_dirs
              ~include_cmis
              ~link_info:(toplevel || dynlink)
@@ -322,6 +323,7 @@ let run
          let t1 = Timer.make () in
          let code =
            Parse_bytecode.from_cmo
+             ~target:`JavaScript
              ~includes:include_dirs
              ~include_cmis
              ~debug:need_debug
@@ -351,6 +353,7 @@ let run
              let t1 = Timer.make () in
              let code =
                Parse_bytecode.from_cmo
+                 ~target:`JavaScript
                  ~includes:include_dirs
                  ~include_cmis
                  ~debug:need_debug
@@ -377,6 +380,7 @@ let run
                let t1 = Timer.make () in
                let code =
                  Parse_bytecode.from_cmo
+                   ~target:`JavaScript
                    ~includes:include_dirs
                    ~include_cmis
                    ~debug:need_debug
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 48887fc105..edbfb097bd 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -139,6 +139,7 @@ let run { Cmd_arg.common; profile; input_file; output_file; params } =
           used. But the -linkall option is probably good enough. *)
        let code =
          Parse_bytecode.from_exe
+           ~target:`Wasm
            ~includes:include_dirs
            ~include_cmis:false
            ~link_info:false
diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 03e9678650..c8f8393d9d 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -274,6 +274,11 @@ module Native_string = struct
     | Utf _, Byte _ | Byte _, Utf _ -> false
 end
 
+type int_kind =
+  | Regular
+  | Int32
+  | Native
+
 type constant =
   | String of string
   | NativeString of Native_string.t
@@ -281,7 +286,7 @@ type constant =
   | Float_array of float array
   | Int64 of int64
   | Tuple of int * constant array * array_or_not
-  | Int of int32
+  | Int of int_kind * int32
 
 let rec constant_equal a b =
   match a, b with
@@ -301,7 +306,7 @@ let rec constant_equal a b =
         !same
   | Int64 a, Int64 b -> Some (Int64.equal a b)
   | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
-  | Int a, Int b -> Some (Int32.equal a b)
+  | Int (k, a), Int (k', b) -> if Poly.(k = k') then Some (Int32.equal a b) else None
   | Float a, Float b -> Some (Float.equal a b)
   | String _, NativeString _ | NativeString _, String _ -> None
   | Int _, Float _ | Float _, Int _ -> None
@@ -416,7 +421,15 @@ module Print = struct
               constant f a.(i)
             done;
             Format.fprintf f ")")
-    | Int i -> Format.fprintf f "%ld" i
+    | Int (k, i) ->
+        Format.fprintf
+          f
+          "%ld%s"
+          i
+          (match k with
+          | Regular -> ""
+          | Int32 -> "l"
+          | Native -> "n")
 
   let arg f a =
     match a with
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 554631adbe..b61b093032 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -152,6 +152,11 @@ module Native_string : sig
   val of_bytestring : string -> t
 end
 
+type int_kind =
+  | Regular
+  | Int32
+  | Native
+
 type constant =
   | String of string
   | NativeString of Native_string.t
@@ -159,7 +164,7 @@ type constant =
   | Float_array of float array
   | Int64 of int64
   | Tuple of int * constant array * array_or_not
-  | Int of int32
+  | Int of int_kind * int32
 
 val constant_equal : constant -> constant -> bool option
 
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index bb8de30908..de5c01e10b 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -71,7 +71,8 @@ let specialize' (p, info) =
 
 let specialize p = fst (specialize' p)
 
-let eval (p, info) = if Config.Flag.staticeval () then Eval.f info p else p
+let eval ~target (p, info) =
+  if Config.Flag.staticeval () then Eval.f ~target info p else p
 
 let flow p =
   if debug () then Format.eprintf "Data flow...@.";
@@ -124,25 +125,25 @@ let identity x = x
 
 (* o1 *)
 
-let o1 : 'a -> 'a =
+let o1 ~target : 'a -> 'a =
   print
   +> tailcall
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
   +> specialize'
-  +> eval
+  +> eval ~target
   +> inline (* inlining may reveal new tailcall opt *)
   +> deadcode
   +> tailcall
   +> phi
   +> flow
   +> specialize'
-  +> eval
+  +> eval ~target
   +> inline
   +> deadcode
   +> print
   +> flow
   +> specialize'
-  +> eval
+  +> eval ~target
   +> inline
   +> deadcode
   +> phi
@@ -152,23 +153,26 @@ let o1 : 'a -> 'a =
 
 (* o2 *)
 
-let o2 : 'a -> 'a = loop 10 "o1" o1 1 +> print
+let o2 ~target : 'a -> 'a = loop 10 "o1" (o1 ~target) 1 +> print
 
 (* o3 *)
 
-let round1 : 'a -> 'a =
+let round1 ~target : 'a -> 'a =
   print
   +> tailcall
   +> inline (* inlining may reveal new tailcall opt *)
   +> deadcode (* deadcode required before flow simple -> provided by constant *)
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
   +> specialize'
-  +> eval
+  +> eval ~target
   +> identity
 
-let round2 = flow +> specialize' +> eval +> deadcode +> o1
+let round2 ~target = flow +> specialize' +> eval ~target +> deadcode +> o1 ~target
 
-let o3 = loop 10 "tailcall+inline" round1 1 +> loop 10 "flow" round2 1 +> print
+let o3 ~target =
+  loop 10 "tailcall+inline" (round1 ~target) 1
+  +> loop 10 "flow" (round2 ~target) 1
+  +> print
 
 let generate
     d
@@ -570,6 +574,11 @@ let configure formatter =
   Code.Var.set_pretty (pretty && not (Config.Flag.shortvar ()));
   Code.Var.set_stable (Config.Flag.stable_var ())
 
+let target_flag t =
+  match t with
+  | `JavaScript _ -> `JavaScript
+  | `Wasm _ -> `Wasm
+
 let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
   let exported_runtime = not standalone in
   let opt =
@@ -578,6 +587,7 @@ let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
        | O1 -> o1
        | O2 -> o2
        | O3 -> o3)
+         ~target:(target_flag target)
     +> exact_calls profile
     +> effects
     +> map_fst (*Generate_closure.f +>*) deadcode'
diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml
index 2854550fe9..71acf7af56 100644
--- a/compiler/lib/effects.ml
+++ b/compiler/lib/effects.ml
@@ -296,7 +296,7 @@ let cps_branch ~st ~src (pc, args) loc =
           (* We are jumping to a block that is also used as a continuation.
              We pass it a dummy argument. *)
           let x = Var.fresh () in
-          [ x ], [ Let (x, Constant (Int 0l)), noloc ]
+          [ x ], [ Let (x, Constant (Int (Regular, 0l))), noloc ]
         else args, []
       in
       (* We check the stack depth only for backward edges (so, at
@@ -390,7 +390,7 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
                         ( x'
                         , Prim
                             ( Extern "caml_maybe_attach_backtrace"
-                            , [ Pv x; Pc (Int (if force then 1l else 0l)) ] ) )
+                            , [ Pv x; Pc (Int (Regular, if force then 1l else 0l)) ] ) )
                     , noloc )
                   ]
                 in
@@ -468,11 +468,12 @@ let cps_instr ~st (instr : instr) : instr =
       Let (x, Closure (params @ [ k ], cont))
   | Let (x, Prim (Extern "caml_alloc_dummy_function", [ size; arity ])) -> (
       match arity with
-      | Pc (Int a) ->
+      | Pc (Int (_, a)) ->
           Let
             ( x
-            , Prim (Extern "caml_alloc_dummy_function", [ size; Pc (Int (Int32.succ a)) ])
-            )
+            , Prim
+                ( Extern "caml_alloc_dummy_function"
+                , [ size; Pc (Int (Regular, Int32.succ a)) ] ) )
       | _ -> assert false)
   | Let (x, Apply { f; args; _ }) when not (Var.Set.mem x st.cps_needed) ->
       (* At the moment, we turn into CPS any function not called with
@@ -549,7 +550,7 @@ let cps_block ~st ~k pc block =
               [ arg; k' ]
               loc)
     | Prim (Extern "%perform", [ Pv effect ]) ->
-        perform_effect ~effect ~continuation:(Pc (Int 0l)) loc
+        perform_effect ~effect ~continuation:(Pc (Int (Regular, 0l))) loc
     | Prim (Extern "%reperform", [ Pv effect; continuation ]) ->
         perform_effect ~effect ~continuation loc
     | _ -> None
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 6e1f09a7e8..e594350525 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -31,23 +31,23 @@ let get_static_env s = try Some (Hashtbl.find static_env s) with Not_found -> No
 
 module Int = Int32
 
-let int_binop l f =
+let int_binop l w f =
   match l with
-  | [ Int i; Int j ] -> Some (Int (f i j))
+  | [ Int (_, i); Int (_, j) ] -> Some (Int (Regular, w (f i j)))
   | _ -> None
 
-let shift l f =
+let shift l w f =
   match l with
-  | [ Int i; Int j ] -> Some (Int (f i (Int32.to_int j land 0x1f)))
+  | [ Int (_, i); Int (_, j) ] -> Some (Int (Regular, w (f i (Int32.to_int j land 0x1f))))
   | _ -> None
 
 let float_binop_aux l f =
   let args =
     match l with
     | [ Float i; Float j ] -> Some (i, j)
-    | [ Int i; Int j ] -> Some (Int32.to_float i, Int32.to_float j)
-    | [ Int i; Float j ] -> Some (Int32.to_float i, j)
-    | [ Float i; Int j ] -> Some (i, Int32.to_float j)
+    | [ Int (_, i); Int (_, j) ] -> Some (Int32.to_float i, Int32.to_float j)
+    | [ Int (_, i); Float j ] -> Some (Int32.to_float i, j)
+    | [ Float i; Int (_, j) ] -> Some (i, Int32.to_float j)
     | _ -> None
   in
   match args with
@@ -62,42 +62,47 @@ let float_binop l f =
 let float_unop l f =
   match l with
   | [ Float i ] -> Some (Float (f i))
-  | [ Int i ] -> Some (Float (f (Int32.to_float i)))
+  | [ Int (_, i) ] -> Some (Float (f (Int32.to_float i)))
   | _ -> None
 
 let float_binop_bool l f =
   match float_binop_aux l f with
-  | Some true -> Some (Int 1l)
-  | Some false -> Some (Int 0l)
+  | Some true -> Some (Int (Regular, 1l))
+  | Some false -> Some (Int (Regular, 0l))
   | None -> None
 
-let bool b = Some (Int (if b then 1l else 0l))
+let bool b = Some (Int (Regular, if b then 1l else 0l))
 
-let eval_prim x =
+let eval_prim ~target x =
   match x with
-  | Not, [ Int i ] -> bool Int32.(i = 0l)
-  | Lt, [ Int i; Int j ] -> bool Int32.(i < j)
-  | Le, [ Int i; Int j ] -> bool Int32.(i <= j)
-  | Eq, [ Int i; Int j ] -> bool Int32.(i = j)
-  | Neq, [ Int i; Int j ] -> bool Int32.(i <> j)
-  | Ult, [ Int i; Int j ] -> bool (Int32.(j < 0l) || Int32.(i < j))
+  | Not, [ Int (_, i) ] -> bool Int32.(i = 0l)
+  | Lt, [ Int (_, i); Int (_, j) ] -> bool Int32.(i < j)
+  | Le, [ Int (_, i); Int (_, j) ] -> bool Int32.(i <= j)
+  | Eq, [ Int (_, i); Int (_, j) ] -> bool Int32.(i = j)
+  | Neq, [ Int (_, i); Int (_, j) ] -> bool Int32.(i <> j)
+  | Ult, [ Int (_, i); Int (_, j) ] -> bool (Int32.(j < 0l) || Int32.(i < j))
   | Extern name, l -> (
       let name = Primitive.resolve name in
+      let wrap =
+        match target with
+        | `JavaScript -> fun i -> i
+        | `Wasm -> Int31.wrap
+      in
       match name, l with
       (* int *)
-      | "%int_add", _ -> int_binop l Int.add
-      | "%int_sub", _ -> int_binop l Int.sub
-      | "%direct_int_mul", _ -> int_binop l Int.mul
-      | "%direct_int_div", [ _; Int 0l ] -> None
-      | "%direct_int_div", _ -> int_binop l Int.div
-      | "%direct_int_mod", _ -> int_binop l Int.rem
-      | "%int_and", _ -> int_binop l Int.logand
-      | "%int_or", _ -> int_binop l Int.logor
-      | "%int_xor", _ -> int_binop l Int.logxor
-      | "%int_lsl", _ -> shift l Int.shift_left
-      | "%int_lsr", _ -> shift l Int.shift_right_logical
-      | "%int_asr", _ -> shift l Int.shift_right
-      | "%int_neg", [ Int i ] -> Some (Int (Int.neg i))
+      | "%int_add", _ -> int_binop l wrap Int.add
+      | "%int_sub", _ -> int_binop l wrap Int.sub
+      | "%direct_int_mul", _ -> int_binop l wrap Int.mul
+      | "%direct_int_div", [ _; Int (_, 0l) ] -> None
+      | "%direct_int_div", _ -> int_binop l wrap Int.div
+      | "%direct_int_mod", _ -> int_binop l wrap Int.rem
+      | "%int_and", _ -> int_binop l wrap Int.logand
+      | "%int_or", _ -> int_binop l wrap Int.logor
+      | "%int_xor", _ -> int_binop l wrap Int.logxor
+      | "%int_lsl", _ -> shift l wrap Int.shift_left
+      | "%int_lsr", _ -> shift l wrap Int.shift_right_logical
+      | "%int_asr", _ -> shift l wrap Int.shift_right
+      | "%int_neg", [ Int (_, i) ] -> Some (Int (Regular, Int.neg i))
       (* float *)
       | "caml_eq_float", _ -> float_binop_bool l Float.( = )
       | "caml_neq_float", _ -> float_binop_bool l Float.( <> )
@@ -110,9 +115,9 @@ let eval_prim x =
       | "caml_mul_float", _ -> float_binop l ( *. )
       | "caml_div_float", _ -> float_binop l ( /. )
       | "caml_fmod_float", _ -> float_binop l mod_float
-      | "caml_int_of_float", [ Float f ] -> Some (Int (Int32.of_float f))
-      | "to_int", [ Float f ] -> Some (Int (Int32.of_float f))
-      | "to_int", [ Int i ] -> Some (Int i)
+      | "caml_int_of_float", [ Float f ] -> Some (Int (Regular, Int.of_float f))
+      | "to_int", [ Float f ] -> Some (Int (Regular, Int.of_float f))
+      | "to_int", [ Int (_, i) ] -> Some (Int (Regular, i))
       (* Math *)
       | "caml_neg_float", _ -> float_unop l ( ~-. )
       | "caml_abs_float", _ -> float_unop l abs_float
@@ -129,10 +134,10 @@ let eval_prim x =
       | "caml_sin_float", _ -> float_unop l sin
       | "caml_sqrt_float", _ -> float_unop l sqrt
       | "caml_tan_float", _ -> float_unop l tan
-      | ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int pos ] ->
-          let pos = Int.to_int pos in
+      | ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int (_, pos) ] ->
+          let pos = Int32.to_int pos in
           if Config.Flag.safe_string () && pos >= 0 && pos < String.length s
-          then Some (Int (Int.of_int (Char.code s.[pos])))
+          then Some (Int (Regular, Int32.of_int (Char.code s.[pos])))
           else None
       | "caml_string_equal", [ String s1; String s2 ] -> bool (String.equal s1 s2)
       | "caml_string_notequal", [ String s1; String s2 ] ->
@@ -141,10 +146,16 @@ let eval_prim x =
           match get_static_env s with
           | Some env -> Some (String env)
           | None -> None)
-      | "caml_sys_const_word_size", [ _ ] -> Some (Int 32l)
-      | "caml_sys_const_int_size", [ _ ] -> Some (Int 32l)
-      | "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
-      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
+      | "caml_sys_const_word_size", [ _ ] -> Some (Int (Regular, 32l))
+      | "caml_sys_const_int_size", [ _ ] ->
+          Some
+            (Int
+               ( Regular
+               , match target with
+                 | `JavaScript -> 32l
+                 | `Wasm -> 32l ))
+      | "caml_sys_const_big_endian", [ _ ] -> Some (Int (Regular, 0l))
+      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int (Regular, 0l))
       | _ -> None)
   | _ -> None
 
@@ -169,14 +180,18 @@ type is_int =
   | N
   | Unknown
 
-let is_int info x =
+let is_int ~target info x =
   match x with
   | Pv x ->
       get_approx
         info
         (fun x ->
           match info.info_defs.(Var.idx x) with
-          | Expr (Constant (Int _)) -> Y
+          | Expr (Constant (Int (Regular, _))) -> Y
+          | Expr (Constant (Int _)) -> (
+              match target with
+              | `JavaScript -> Y
+              | `Wasm -> N)
           | Expr (Block (_, _, _)) | Expr (Constant _) -> N
           | _ -> Unknown)
         Unknown
@@ -186,10 +201,14 @@ let is_int info x =
           | N, N -> N
           | _ -> Unknown)
         x
-  | Pc (Int _) -> Y
+  | Pc (Int (Regular, _)) -> Y
+  | Pc (Int _) -> (
+      match target with
+      | `JavaScript -> Y
+      | `Wasm -> N)
   | Pc _ -> N
 
-let eval_instr info ((x, loc) as i) =
+let eval_instr ~target info ((x, loc) as i) =
   match x with
   | Let (x, Prim (Extern ("caml_js_equals" | "caml_equal"), [ y; z ])) -> (
       match the_const_of info y, the_const_of info z with
@@ -198,7 +217,7 @@ let eval_instr info ((x, loc) as i) =
           | None -> [ i ]
           | Some c ->
               let c = if c then 1l else 0l in
-              let c = Constant (Int c) in
+              let c = Constant (Int (Regular, c)) in
               Flow.update_def info x c;
               [ Let (x, c), loc ])
       | _ -> [ i ])
@@ -212,7 +231,7 @@ let eval_instr info ((x, loc) as i) =
       match c with
       | None -> [ i ]
       | Some c ->
-          let c = Constant (Int c) in
+          let c = Constant (Int (Regular, c)) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
   | Let (_, Prim (Extern ("caml_array_unsafe_get" | "caml_array_unsafe_set"), _)) ->
@@ -221,11 +240,11 @@ let eval_instr info ((x, loc) as i) =
            below fail. *)
       [ i ]
   | Let (x, Prim (IsInt, [ y ])) -> (
-      match is_int info y with
+      match is_int ~target info y with
       | Unknown -> [ i ]
       | (Y | N) as b ->
           let b = if Poly.(b = N) then 0l else 1l in
-          let c = Constant (Int b) in
+          let c = Constant (Int (Regular, b)) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
   | Let (x, Prim (Extern "caml_sys_const_backend_type", [ _ ])) ->
@@ -243,6 +262,7 @@ let eval_instr info ((x, loc) as i) =
                | _ -> false)
         then
           eval_prim
+            ~target
             ( prim
             , List.map prim_args' ~f:(function
                   | Some c -> c
@@ -283,7 +303,7 @@ let the_case_of info x =
         info
         (fun x ->
           match info.info_defs.(Var.idx x) with
-          | Expr (Constant (Int i)) -> CConst (Int32.to_int i)
+          | Expr (Constant (Int (_, i))) -> CConst (Int32.to_int i)
           | Expr (Block (j, _, _)) ->
               if Var.ISet.mem info.info_possibly_mutable x then Unknown else CTag j
           | Expr (Constant (Tuple (j, _, _))) -> CTag j
@@ -295,7 +315,7 @@ let the_case_of info x =
           | CConst i, CConst j when i = j -> u
           | _ -> Unknown)
         x
-  | Pc (Int i) -> CConst (Int32.to_int i)
+  | Pc (Int (_, i)) -> CConst (Int32.to_int i)
   | Pc (Tuple (j, _, _)) -> CTag j
   | _ -> Unknown
 
@@ -309,7 +329,7 @@ let the_cond_of info x =
     info
     (fun x ->
       match info.info_defs.(Var.idx x) with
-      | Expr (Constant (Int 0l)) -> Zero
+      | Expr (Constant (Int (_, 0l))) -> Zero
       | Expr
           (Constant
             ( Int _
@@ -424,15 +444,15 @@ let drop_exception_handler blocks =
     blocks
     blocks
 
-let eval info blocks =
+let eval ~target info blocks =
   Addr.Map.map
     (fun block ->
-      let body = List.concat_map block.body ~f:(eval_instr info) in
+      let body = List.concat_map block.body ~f:(eval_instr ~target info) in
       let branch = eval_branch info block.branch in
       { block with Code.body; Code.branch })
     blocks
 
-let f info p =
-  let blocks = eval info p.blocks in
+let f ~target info p =
+  let blocks = eval ~target info p.blocks in
   let blocks = drop_exception_handler blocks in
   { p with blocks }
diff --git a/compiler/lib/eval.mli b/compiler/lib/eval.mli
index a71f611ca1..30a36b08f6 100644
--- a/compiler/lib/eval.mli
+++ b/compiler/lib/eval.mli
@@ -21,4 +21,4 @@ val clear_static_env : unit -> unit
 
 val set_static_env : string -> string -> unit
 
-val f : Flow.info -> Code.program -> Code.program
+val f : target:[ `JavaScript | `Wasm ] -> Flow.info -> Code.program -> Code.program
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 74f1499d8d..e6b5b600e9 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -343,7 +343,7 @@ let the_const_of info x =
 
 let the_int info x =
   match the_const_of info x with
-  | Some (Int i) -> Some i
+  | Some (Int (_, i)) -> Some i
   | _ -> None
 
 let the_string_of info x =
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index eb27842268..5d42e11613 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -448,7 +448,7 @@ let rec constant_rec ~ctx x level instrs =
       let constant_max_depth = Config.Param.constant_max_depth () in
       let rec detect_list n acc = function
         | Tuple (0, [| x; l |], _) -> detect_list (succ n) (x :: acc) l
-        | Int 0l -> if n > constant_max_depth then Some acc else None
+        | Int (_, 0l) -> if n > constant_max_depth then Some acc else None
         | _ -> None
       in
       match detect_list 0 [] x with
@@ -485,7 +485,7 @@ let rec constant_rec ~ctx x level instrs =
             else List.rev l, instrs
           in
           Mlvalue.Block.make ~tag ~args:l, instrs)
-  | Int i -> int32 i, instrs
+  | Int (_, i) -> int32 i, instrs
 
 let constant ~ctx x level =
   let expr, instr = constant_rec ~ctx x level [] in
diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml
index 6c0d077c84..f32d0a68cf 100644
--- a/compiler/lib/generate_closure.ml
+++ b/compiler/lib/generate_closure.ml
@@ -105,7 +105,9 @@ module Trampoline = struct
         let counter_plus_1 = Code.Var.fork counter in
         { params = []
         ; body =
-            [ ( Let (counter_plus_1, Prim (Extern "%int_add", [ Pv counter; Pc (Int 1l) ]))
+            [ ( Let
+                  ( counter_plus_1
+                  , Prim (Extern "%int_add", [ Pv counter; Pc (Int (Regular, 1l)) ]) )
               , noloc )
             ; Let (return, Apply { f; args = counter_plus_1 :: args; exact = true }), loc
             ]
@@ -119,8 +121,9 @@ module Trampoline = struct
     ; body =
         [ ( Let
               ( new_args
-              , Prim (Extern "%js_array", Pc (Int 0l) :: List.map args ~f:(fun x -> Pv x))
-              )
+              , Prim
+                  ( Extern "%js_array"
+                  , Pc (Int (Regular, 0l)) :: List.map args ~f:(fun x -> Pv x) ) )
           , noloc )
         ; Let (return, Prim (Extern "caml_trampoline_return", [ Pv f; Pv new_args ])), loc
         ]
@@ -139,7 +142,7 @@ module Trampoline = struct
               ; Let (result2, Prim (Extern "caml_trampoline", [ Pv result1 ])), noloc
               ]
           | Some counter ->
-              [ Let (counter, Constant (Int 0l)), noloc
+              [ Let (counter, Constant (Int (Regular, 0l))), noloc
               ; Let (result1, Apply { f; args = counter :: args; exact = true }), loc
               ; Let (result2, Prim (Extern "caml_trampoline", [ Pv result1 ])), noloc
               ])
@@ -243,7 +246,9 @@ module Trampoline = struct
                                     , Prim
                                         ( Lt
                                         , [ Pv counter
-                                          ; Pc (Int (Int32.of_int tailcall_max_depth))
+                                          ; Pc
+                                              (Int
+                                                 (Regular, Int32.of_int tailcall_max_depth))
                                           ] ) )
                                 , noloc )
                               in
diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml
index a2403eb058..6b45f29ca3 100644
--- a/compiler/lib/link_js.ml
+++ b/compiler/lib/link_js.ml
@@ -412,7 +412,13 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
             List.fold_left units ~init:[] ~f:(fun acc (u : Unit_info.t) ->
                 acc @ u.primitives)
           in
-          let code = Parse_bytecode.link_info ~symtable:!sym ~primitives ~crcs:[] in
+          let code =
+            Parse_bytecode.link_info
+              ~target:`JavaScript
+              ~symtable:!sym
+              ~primitives
+              ~crcs:[]
+          in
           let b = Buffer.create 100 in
           let fmt = Pretty_print.to_buffer b in
           Driver.configure fmt;
diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
index 054a592e6c..120126d58a 100644
--- a/compiler/lib/ocaml_compiler.ml
+++ b/compiler/lib/ocaml_compiler.ml
@@ -18,26 +18,39 @@
 
 open! Stdlib
 
-let rec constant_of_const : _ -> Code.constant =
+let rec constant_of_const ~target c : Code.constant =
   let open Lambda in
   let open Asttypes in
-  function
-  | Const_base (Const_int i) -> Int (Int32.of_int_warning_on_overflow i)
-  | Const_base (Const_char c) -> Int (Int32.of_int (Char.code c))
+  match c with
+  | Const_base (Const_int i) ->
+      Int
+        ( Regular
+        , match target with
+          | `JavaScript -> Int32.of_int_warning_on_overflow i
+          | `Wasm -> Int31.of_int_warning_on_overflow i )
+  | Const_base (Const_char c) -> Int (Regular, Int32.of_int (Char.code c))
   | ((Const_base (Const_string (s, _))) [@if ocaml_version < (4, 11, 0)])
   | ((Const_base (Const_string (s, _, _))) [@if ocaml_version >= (4, 11, 0)]) -> String s
   | Const_base (Const_float s) -> Float (float_of_string s)
-  | Const_base (Const_int32 i) -> Int i
+  | Const_base (Const_int32 i) -> Int (Int32, i)
   | Const_base (Const_int64 i) -> Int64 i
-  | Const_base (Const_nativeint i) -> Int (Int32.of_nativeint_warning_on_overflow i)
+  | Const_base (Const_nativeint i) ->
+      Int
+        ( Native
+        , match target with
+          | `JavaScript -> Int32.of_nativeint_warning_on_overflow i
+          | `Wasm -> Int31.of_nativeint_warning_on_overflow i )
   | Const_immstring s -> String s
   | Const_float_array sl ->
       let l = List.map ~f:(fun f -> Code.Float (float_of_string f)) sl in
       Tuple (Obj.double_array_tag, Array.of_list l, Unknown)
   | ((Const_pointer i) [@if ocaml_version < (4, 12, 0)]) ->
-      Int (Int32.of_int_warning_on_overflow i)
+      Int
+        (match target with
+        | `JavaScript -> Int32.of_int_warning_on_overflow i
+        | `Wasm -> Int31.of_int_warning_on_overflow i)
   | Const_block (tag, l) ->
-      let l = Array.of_list (List.map l ~f:constant_of_const) in
+      let l = Array.of_list (List.map l ~f:(fun c -> constant_of_const ~target c)) in
       Tuple (tag, l, Unknown)
 
 let rec find_loc_in_summary ident' = function
diff --git a/compiler/lib/ocaml_compiler.mli b/compiler/lib/ocaml_compiler.mli
index da83ac43f0..5fec5260ed 100644
--- a/compiler/lib/ocaml_compiler.mli
+++ b/compiler/lib/ocaml_compiler.mli
@@ -16,7 +16,8 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val constant_of_const : Lambda.structured_constant -> Code.constant
+val constant_of_const :
+  target:[ `JavaScript | `Wasm ] -> Lambda.structured_constant -> Code.constant
 
 val find_loc_in_summary : Ident.t -> Env.summary -> Location.t option
 
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 80a5f12de4..d3e73b6aca 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -418,7 +418,7 @@ end
 
 (* Parse constants *)
 module Constants : sig
-  val parse : Obj.t -> Code.constant
+  val parse : target:[ `JavaScript | `Wasm ] -> Obj.t -> Code.constant
 
   val inlined : Code.constant -> bool
 end = struct
@@ -452,7 +452,7 @@ end = struct
 
   let ident_native = ident_of_custom (Obj.repr 0n)
 
-  let rec parse x =
+  let rec parse ~target x =
     if Obj.is_block x
     then
       let tag = Obj.tag x in
@@ -465,10 +465,14 @@ end = struct
       else if tag = Obj.custom_tag
       then
         match ident_of_custom x with
-        | Some name when same_ident name ident_32 -> Int (Obj.magic x : int32)
+        | Some name when same_ident name ident_32 -> Int (Int32, (Obj.magic x : int32))
         | Some name when same_ident name ident_native ->
             let i : nativeint = Obj.magic x in
-            Int (Int32.of_nativeint_warning_on_overflow i)
+            Int
+              ( Native
+              , match target with
+                | `JavaScript -> Int32.of_nativeint_warning_on_overflow i
+                | `Wasm -> Int31.of_nativeint_warning_on_overflow i )
         | Some name when same_ident name ident_64 -> Int64 (Obj.magic x : int64)
         | Some name ->
             failwith
@@ -478,11 +482,18 @@ end = struct
         | None -> assert false
       else if tag < Obj.no_scan_tag
       then
-        Tuple (tag, Array.init (Obj.size x) ~f:(fun i -> parse (Obj.field x i)), Unknown)
+        Tuple
+          ( tag
+          , Array.init (Obj.size x) ~f:(fun i -> parse ~target (Obj.field x i))
+          , Unknown )
       else assert false
     else
       let i : int = Obj.magic x in
-      Int (Int32.of_int_warning_on_overflow i)
+      Int
+        ( Regular
+        , match target with
+          | `JavaScript -> Int32.of_int_warning_on_overflow i
+          | `Wasm -> Int31.of_int_warning_on_overflow i )
 
   let inlined = function
     | String _ | NativeString _ -> false
@@ -493,7 +504,7 @@ end = struct
     | Int _ -> true
 end
 
-let const i = Constant (Int i)
+let const i = Constant (Int (Regular, i))
 
 (* Globals *)
 type globals =
@@ -764,7 +775,7 @@ let register_global ?(force = false) g i loc rem =
         ( Var.fresh ()
         , Prim
             ( Extern "caml_register_global"
-            , Pc (Int (Int32.of_int i)) :: Pv (access_global g i) :: args ) )
+            , Pc (Int (Regular, Int32.of_int i)) :: Pv (access_global g i) :: args ) )
     , loc )
     :: rem
   else rem
@@ -2132,7 +2143,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Eq, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Eq, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BNEQ ->
@@ -2142,7 +2153,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Eq, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Eq, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | BLTINT ->
@@ -2152,7 +2163,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Lt, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Lt, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BLEINT ->
@@ -2162,7 +2173,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Le, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Le, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BGTINT ->
@@ -2172,7 +2183,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Le, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Le, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | BGEINT ->
@@ -2182,7 +2193,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Lt, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Lt, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | BULTINT ->
@@ -2192,7 +2203,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Ult, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Ult, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BUGEINT ->
@@ -2202,7 +2213,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Ult, [ Pc (Int n); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Ult, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | ULTINT ->
@@ -2265,7 +2276,7 @@ and compile infos pc state instrs =
                ( m
                , Prim
                    ( Extern "caml_get_public_method"
-                   , [ Pv obj; Pv tag; Pc (Int (Int32.of_int cache)) ] ) )
+                   , [ Pv obj; Pv tag; Pc (Int (Regular, Int32.of_int cache)) ] ) )
            , loc )
           :: (Let (tag, const n), loc)
           :: instrs)
@@ -2289,7 +2300,10 @@ and compile infos pc state instrs =
           (pc + 1)
           state
           (( Let
-               (m, Prim (Extern "caml_get_public_method", [ Pv obj; Pv tag; Pc (Int 0l) ]))
+               ( m
+               , Prim
+                   ( Extern "caml_get_public_method"
+                   , [ Pv obj; Pv tag; Pc (Int (Regular, 0l)) ] ) )
            , loc )
           :: instrs)
     | GETMETHOD ->
@@ -2530,6 +2544,7 @@ let read_primitives toc ic =
   String.split_char ~sep:'\000' (String.sub prim ~pos:0 ~len:(String.length prim - 1))
 
 let from_exe
+    ~target
     ?(includes = [])
     ~linkall
     ~link_info
@@ -2543,7 +2558,7 @@ let from_exe
   let primitive_table = Array.of_list primitives in
   let code = Toc.read_code toc ic in
   let init_data = Toc.read_data toc ic in
-  let init_data = Array.map ~f:Constants.parse init_data in
+  let init_data = Array.map ~f:(Constants.parse ~target) init_data in
   let orig_symbols = Toc.read_symb toc ic in
   let orig_crcs = Toc.read_crcs toc ic in
   let keeps =
@@ -2636,8 +2651,8 @@ let from_exe
       let gdata = Var.fresh () in
       let need_gdata = ref false in
       let infos =
-        [ "toc", Constants.parse (Obj.repr toc)
-        ; "prim_count", Int (Int32.of_int (Array.length globals.primitives))
+        [ "toc", Constants.parse ~target (Obj.repr toc)
+        ; "prim_count", Int (Regular, Int32.of_int (Array.length globals.primitives))
         ]
       in
       let body =
@@ -2792,13 +2807,13 @@ module Reloc = struct
   let constant_of_const x = Constants.parse x [@@if ocaml_version >= (5, 1, 0)]
 
   (* We currently rely on constants to be relocated before globals. *)
-  let step1 t compunit code =
+  let step1 ~target t compunit code =
     if t.step2_started then assert false;
     let open Cmo_format in
     List.iter compunit.cu_primitives ~f:(fun name ->
         Hashtbl.add t.primitives name (Hashtbl.length t.primitives));
     let slot_for_literal sc =
-      t.constants <- constant_of_const sc :: t.constants;
+      t.constants <- constant_of_const ~target sc :: t.constants;
       let pos = t.pos in
       t.pos <- succ t.pos;
       pos
@@ -2866,9 +2881,9 @@ module Reloc = struct
     globals
 end
 
-let from_compilation_units ~includes:_ ~include_cmis ~debug_data l =
+let from_compilation_units ~target ~includes:_ ~include_cmis ~debug_data l =
   let reloc = Reloc.create () in
-  List.iter l ~f:(fun (compunit, code) -> Reloc.step1 reloc compunit code);
+  List.iter l ~f:(fun (compunit, code) -> Reloc.step1 ~target reloc compunit code);
   List.iter l ~f:(fun (compunit, code) -> Reloc.step2 reloc compunit code);
   let globals = Reloc.make_globals reloc in
   let code =
@@ -2917,7 +2932,8 @@ let from_compilation_units ~includes:_ ~include_cmis ~debug_data l =
   in
   { code = prepend prog body; cmis; debug = debug_data }
 
-let from_cmo ?(includes = []) ?(include_cmis = false) ?(debug = false) compunit ic =
+let from_cmo ~target ?(includes = []) ?(include_cmis = false) ?(debug = false) compunit ic
+    =
   let debug_data = Debug.create ~include_cmis debug in
   seek_in ic compunit.Cmo_format.cu_pos;
   let code = Bytes.create compunit.Cmo_format.cu_codesize in
@@ -2928,11 +2944,13 @@ let from_cmo ?(includes = []) ?(include_cmis = false) ?(debug = false) compunit
     seek_in ic compunit.Cmo_format.cu_debug;
     Debug.read_event_list debug_data ~crcs:[] ~includes ~orig:0 ic);
   if times () then Format.eprintf "    read debug events: %a@." Timer.print t;
-  let p = from_compilation_units ~includes ~include_cmis ~debug_data [ compunit, code ] in
+  let p =
+    from_compilation_units ~target ~includes ~include_cmis ~debug_data [ compunit, code ]
+  in
   Code.invariant p.code;
   p
 
-let from_cma ?(includes = []) ?(include_cmis = false) ?(debug = false) lib ic =
+let from_cma ~target ?(includes = []) ?(include_cmis = false) ?(debug = false) lib ic =
   let debug_data = Debug.create ~include_cmis debug in
   let orig = ref 0 in
   let t = ref 0. in
@@ -2951,7 +2969,7 @@ let from_cma ?(includes = []) ?(include_cmis = false) ?(debug = false) lib ic =
         compunit, code)
   in
   if times () then Format.eprintf "    read debug events: %.2f@." !t;
-  let p = from_compilation_units ~includes ~include_cmis ~debug_data units in
+  let p = from_compilation_units ~target ~includes ~include_cmis ~debug_data units in
   Code.invariant p.code;
   p
 
@@ -3011,17 +3029,17 @@ let predefined_exceptions () =
               ( v_index
               , Constant
                   (Int
-                     ((* Predefined exceptions are registered in
-                         Symtable.init with [-index - 1] *)
-                      Int32.of_int
-                        (-index - 1))) )
+                     ( (* Predefined exceptions are registered in
+                          Symtable.init with [-index - 1] *)
+                       Regular
+                     , Int32.of_int (-index - 1) )) )
           , noloc )
         ; Let (exn, Block (248, [| v_name; v_index |], NotArray)), noloc
         ; ( Let
               ( Var.fresh ()
               , Prim
                   ( Extern "caml_register_global"
-                  , [ Pc (Int (Int32.of_int index)); Pv exn; Pv v_name_js ] ) )
+                  , [ Pc (Int (Regular, Int32.of_int index)); Pv exn; Pv v_name_js ] ) )
           , noloc )
         ])
     |> List.concat
@@ -3038,7 +3056,7 @@ let predefined_exceptions () =
   in
   { start = 0; blocks = Addr.Map.singleton 0 block; free_pc = 1 }, unit_info
 
-let link_info ~symtable ~primitives ~crcs =
+let link_info ~target ~symtable ~primitives ~crcs =
   let gdata = Code.Var.fresh_n "global_data" in
   let symtable_js =
     Ocaml_compiler.Symtable.GlobalMap.fold
@@ -3058,8 +3076,8 @@ let link_info ~symtable ~primitives ~crcs =
       ]
     in
     let infos =
-      [ "toc", Constants.parse (Obj.repr toc)
-      ; "prim_count", Int (Int32.of_int (List.length primitives))
+      [ "toc", Constants.parse ~target (Obj.repr toc)
+      ; "prim_count", Int (Regular, Int32.of_int (List.length primitives))
       ]
     in
     let body =
diff --git a/compiler/lib/parse_bytecode.mli b/compiler/lib/parse_bytecode.mli
index b9565d296c..f357266b1f 100644
--- a/compiler/lib/parse_bytecode.mli
+++ b/compiler/lib/parse_bytecode.mli
@@ -52,7 +52,8 @@ end
 val read_primitives : Toc.t -> in_channel -> string list
 
 val from_exe :
-     ?includes:string list
+     target:[ `JavaScript | `Wasm ]
+  -> ?includes:string list
   -> linkall:bool
   -> link_info:bool
   -> include_cmis:bool
@@ -62,7 +63,8 @@ val from_exe :
   -> one
 
 val from_cmo :
-     ?includes:string list
+     target:[ `JavaScript | `Wasm ]
+  -> ?includes:string list
   -> ?include_cmis:bool
   -> ?debug:bool
   -> Cmo_format.compilation_unit
@@ -70,7 +72,8 @@ val from_cmo :
   -> one
 
 val from_cma :
-     ?includes:string list
+     target:[ `JavaScript | `Wasm ]
+  -> ?includes:string list
   -> ?include_cmis:bool
   -> ?debug:bool
   -> Cmo_format.library
@@ -90,7 +93,8 @@ val from_string :
 val predefined_exceptions : unit -> Code.program * Unit_info.t
 
 val link_info :
-     symtable:Ocaml_compiler.Symtable.GlobalMap.t
+     target:[ `JavaScript | `Wasm ]
+  -> symtable:Ocaml_compiler.Symtable.GlobalMap.t
   -> primitives:string list
   -> crcs:(string * Digest.t option) list
   -> Code.program
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 6c9b17e2d9..6496e0b666 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -49,7 +49,7 @@ let specialize_instr info i =
       match the_string_of info y with
       | Some s when Primitive.need_named_value s ->
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
-      | Some _ -> Let (x, Constant (Int 0l))
+      | Some _ -> Let (x, Constant (Int (Regular, 0l)))
       | None -> i)
   (*
   | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])) -> (
@@ -242,7 +242,9 @@ let f_once p =
                      | "caml_floatarray_unsafe_set" )
                  , [ _; _; _ ] ) as p) ) ->
             let x' = Code.Var.fork x in
-            let acc = (Let (x', p), loc) :: (Let (x, Constant (Int 0l)), loc) :: acc in
+            let acc =
+              (Let (x', p), loc) :: (Let (x, Constant (Int (Regular, 0l))), loc) :: acc
+            in
             loop acc r
         | _ -> loop ((i, loc) :: acc) r)
   in
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index ef8aeddca2..ccc23392fd 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -341,6 +341,28 @@ module Int32 = struct
       n
 end
 
+module Int31 = struct
+  let wrap i = Int32.(shift_right (shift_left i 1) 1)
+
+  let of_int_warning_on_overflow i =
+    Int32.convert_warning_on_overflow
+      ~to_int32:(fun i -> wrap (Int32.of_int i))
+      ~of_int32:Int32.to_int
+      ~equal:Int_replace_polymorphic_compare.( = )
+      ~to_dec:(Printf.sprintf "%d")
+      ~to_hex:(Printf.sprintf "%x")
+      i
+
+  let of_nativeint_warning_on_overflow n =
+    Int32.convert_warning_on_overflow
+      ~to_int32:(fun i -> wrap (Nativeint.to_int32 i))
+      ~of_int32:Nativeint.of_int32
+      ~equal:Nativeint.equal
+      ~to_dec:(Printf.sprintf "%nd")
+      ~to_hex:(Printf.sprintf "%nx")
+      n
+end
+
 module Option = struct
   let map ~f x =
     match x with
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 07442489ab..2fa42aa8fb 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -242,7 +242,7 @@ end
 module Constant = struct
   let rec translate_rec context c =
     match c with
-    | Code.Int i -> W.DataI32 Int32.(add (add i i) 1l)
+    | Code.Int (Regular, i) -> W.DataI32 Int32.(add (add i i) 1l)
     | Tuple (tag, a, _) ->
         let h = Memory.header ~const:true ~tag ~len:(Array.length a) () in
         let name = Code.Var.fresh_n "block" in
@@ -289,6 +289,25 @@ module Constant = struct
         let block = [ W.DataI32 h; DataSym (S "caml_int64_ops", 0); DataI64 i ] in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
         W.DataSym (V name, 4)
+    | Int (Int32, i) ->
+        let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:2 () in
+        let name = Code.Var.fresh_n "int32" in
+        let block =
+          [ W.DataI32 h; DataI32 0l (*ZZZ DataSym (S "caml_int32_ops", 0)*); DataI32 i ]
+        in
+        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
+        W.DataSym (V name, 4)
+    | Int (Native, i) ->
+        let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:2 () in
+        let name = Code.Var.fresh_n "nativeint" in
+        let block =
+          [ W.DataI32 h
+          ; DataI32 0l (*ZZZ DataSym (S "caml_nativeint_ops", 0)*)
+          ; DataI32 i
+          ]
+        in
+        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
+        W.DataSym (V name, 4)
 
   let translate c =
     let* context = get_context in
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index a651fec213..f2c8749a8c 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -67,6 +67,22 @@ module Type = struct
                 ]
           })
 
+  let int32_type =
+    register_type "int32" (fun () ->
+        let* custom_operations = custom_operations_type in
+        let* custom = custom_type in
+        return
+          { supertype = Some custom
+          ; final = false
+          ; typ =
+              W.Struct
+                [ { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type custom_operations })
+                  }
+                ; { mut = false; typ = Value I32 }
+                ]
+          })
+
   let int64_type =
     register_type "int64" (fun () ->
         let* custom_operations = custom_operations_type in
@@ -397,6 +413,21 @@ module Memory = struct
     let* ty = Type.float_type in
     wasm_struct_get ty (wasm_cast ty e) 0
 
+  let make_int32 ~kind e =
+    let* custom_operations = Type.custom_operations_type in
+    let* int32_ops =
+      register_import
+        ~name:
+          (match kind with
+          | `Int32 -> "int32_ops"
+          | `Nativeint -> "nativeint_ops")
+        (Global
+           { mut = false; typ = Ref { nullable = false; typ = Type custom_operations } })
+    in
+    let* ty = Type.int32_type in
+    let* e = e in
+    return (W.StructNew (ty, [ GlobalGet (V int32_ops); e ]))
+
   let make_int64 e =
     let* custom_operations = Type.custom_operations_type in
     let* int64_ops =
@@ -426,7 +457,7 @@ module Constant = struct
 
   let rec translate_rec c =
     match c with
-    | Code.Int i -> return (true, W.I31New (Const (I32 i))) (*ZZZ 32 bit integers *)
+    | Code.Int (Regular, i) -> return (true, W.I31New (Const (I32 i)))
     | Tuple (tag, a, _) ->
         let* ty = Type.block_type in
         let* l =
@@ -501,6 +532,12 @@ module Constant = struct
     | Int64 i ->
         let* e = Memory.make_int64 (return (W.Const (I64 i))) in
         return (true, e)
+    | Int (Int32, i) ->
+        let* e = Memory.make_int32 ~kind:`Int32 (return (W.Const (I32 i))) in
+        return (true, e)
+    | Int (Native, i) ->
+        let* e = Memory.make_int32 ~kind:`Nativeint (return (W.Const (I32 i))) in
+        return (true, e)
 
   let translate c =
     let* const, c = translate_rec c in

From 2c85e6a0c1e35436dfce78e1b93b0bd5044a02f9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 14:07:51 +0200
Subject: [PATCH 031/481] Don't alias as many primitives when producing Wasm
 code

In particular, we need to distinguish int, int32 and int64.
---
 compiler/bin-js_of_ocaml/check_runtime.ml |  1 +
 compiler/bin-js_of_ocaml/compile.ml       |  1 +
 compiler/bin-wasm_of_ocaml/compile.ml     |  1 +
 compiler/lib/generate.ml                  | 66 +++++++++++------------
 compiler/lib/primitive.ml                 |  8 +--
 compiler/lib/wasm/wa_generate.ml          |  8 +++
 compiler/lib/wasm/wa_generate.mli         |  2 +
 7 files changed, 47 insertions(+), 40 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/check_runtime.ml b/compiler/bin-js_of_ocaml/check_runtime.ml
index 869641a259..41b9495b6b 100644
--- a/compiler/bin-js_of_ocaml/check_runtime.ml
+++ b/compiler/bin-js_of_ocaml/check_runtime.ml
@@ -43,6 +43,7 @@ let print_groups output l =
               output_string output (Printf.sprintf "%s\n" name)))
 
 let f (runtime_files, bytecode, target_env) =
+  Generate.init ();
   let runtime_files, builtin =
     List.partition_map runtime_files ~f:(fun name ->
         match Builtins.find name with
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index a5dea291b0..22bf3650a3 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -88,6 +88,7 @@ let run
     ; export_file
     ; keep_unit_names
     } =
+  Generate.init ();
   let include_cmis = toplevel && not no_cmis in
   let custom_header = common.Jsoo_cmdline.Arg.custom_header in
   Jsoo_cmdline.Arg.eval common;
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index edbfb097bd..962b7a6463 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -91,6 +91,7 @@ let link_and_optimize wat_file output_file =
   optimize temp_file output_file
 
 let run { Cmd_arg.common; profile; input_file; output_file; params } =
+  Wa_generate.init ();
   Jsoo_cmdline.Arg.eval common;
   (match output_file with
   | name, _ when debug_mem () -> Debug.start_profiling name
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 5d42e11613..a3da1d294e 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -2088,34 +2088,6 @@ let compile_program ctx pc =
   if debug () then Format.eprintf "@]@.";
   res
 
-let f
-    (p : Code.program)
-    ~exported_runtime
-    ~live_vars
-    ~cps_calls
-    ~should_export
-    ~warn_on_unhandled_effect
-    debug =
-  let t' = Timer.make () in
-  let share = Share.get ~cps_calls ~alias_prims:exported_runtime p in
-  let exported_runtime =
-    if exported_runtime then Some (Code.Var.fresh_n "runtime", ref false) else None
-  in
-  let ctx =
-    Ctx.initial
-      ~warn_on_unhandled_effect
-      ~exported_runtime
-      ~should_export
-      p.blocks
-      live_vars
-      cps_calls
-      share
-      debug
-  in
-  let p = compile_program ctx p.start in
-  if times () then Format.eprintf "  code gen.: %a@." Timer.print t';
-  p
-
 let init () =
   List.iter
     ~f:(fun (nm, nm') -> Primitive.alias nm nm')
@@ -2167,9 +2139,7 @@ let init () =
     ; "caml_int64_to_int", "caml_int64_to_int32"
     ; "caml_int64_of_nativeint", "caml_int64_of_int32"
     ; "caml_int64_to_nativeint", "caml_int64_to_int32"
-      (* ZZZ
-          ; "caml_float_of_int", "%identity"
-      *)
+    ; "caml_float_of_int", "%identity"
     ; "caml_array_get_float", "caml_array_get"
     ; "caml_floatarray_get", "caml_array_get"
     ; "caml_array_get_addr", "caml_array_get"
@@ -2183,13 +2153,37 @@ let init () =
     ; "caml_alloc_dummy_float", "caml_alloc_dummy"
     ; "caml_make_array", "%identity"
     ; "caml_ensure_stack_capacity", "%identity"
-      (*ZZZ
-          ; "caml_js_from_float", "%identity"
-          ; "caml_js_to_float", "%identity"
-      *)
+    ; "caml_js_from_float", "%identity"
+    ; "caml_js_to_float", "%identity"
     ];
   Hashtbl.iter
     (fun name (k, _) -> Primitive.register name k None None)
     internal_primitives
 
-let () = init ()
+let f
+    (p : Code.program)
+    ~exported_runtime
+    ~live_vars
+    ~cps_calls
+    ~should_export
+    ~warn_on_unhandled_effect
+    debug =
+  let t' = Timer.make () in
+  let share = Share.get ~cps_calls ~alias_prims:exported_runtime p in
+  let exported_runtime =
+    if exported_runtime then Some (Code.Var.fresh_n "runtime", ref false) else None
+  in
+  let ctx =
+    Ctx.initial
+      ~warn_on_unhandled_effect
+      ~exported_runtime
+      ~should_export
+      p.blocks
+      live_vars
+      cps_calls
+      share
+      debug
+  in
+  let p = compile_program ctx p.start in
+  if times () then Format.eprintf "  code gen.: %a@." Timer.print t';
+  p
diff --git a/compiler/lib/primitive.ml b/compiler/lib/primitive.ml
index 55f9e8d27a..3a94dee698 100644
--- a/compiler/lib/primitive.ml
+++ b/compiler/lib/primitive.ml
@@ -95,17 +95,17 @@ let register p k kargs arity =
         (string_of_kind k));
   add_external p;
   (match arity with
-  | Some a -> Hashtbl.add arities p a
+  | Some a -> Hashtbl.replace arities p a
   | _ -> ());
   (match kargs with
-  | Some k -> Hashtbl.add kind_args_tbl p k
+  | Some k -> Hashtbl.replace kind_args_tbl p k
   | _ -> ());
-  Hashtbl.add kinds p k
+  Hashtbl.replace kinds p k
 
 let alias nm nm' =
   add_external nm';
   add_external nm;
-  Hashtbl.add aliases nm nm'
+  Hashtbl.replace aliases nm nm'
 
 let named_values = ref StringSet.empty
 
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index c85744a5a7..ffabd1cd0e 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -671,6 +671,14 @@ module Generate (Target : Wa_target_sig.S) = struct
       (imports @ functions @ (start_function :: constant_data))
 end
 
+let init () =
+  List.iter
+    ~f:(fun (nm, nm') -> Primitive.alias nm nm')
+    [ "caml_alloc_dummy_float", "caml_alloc_dummy" (*ZZZ*)
+    ; "caml_make_array", "%identity"
+    ; "caml_ensure_stack_capacity", "%identity"
+    ]
+
 let f ch (p : Code.program) ~live_vars =
   match target with
   | `Core ->
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index 5adecddcee..108958a9c5 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -1 +1,3 @@
+val init : unit -> unit
+
 val f : out_channel -> Code.program -> live_vars:int array -> unit

From d7d55247a2d0e898034ee330469d4b5a56b3029c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 14:11:24 +0200
Subject: [PATCH 032/481] Disable Generate_closure phase

No special handling of function in loops is needed.
We have tail call optimization, so we don't need to do anything to
optimize mutual function calls.
---
 compiler/lib/driver.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index de5c01e10b..ee3f608a07 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -590,7 +590,11 @@ let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
          ~target:(target_flag target)
     +> exact_calls profile
     +> effects
-    +> map_fst (*Generate_closure.f +>*) deadcode'
+    +> map_fst
+         ((match target with
+          | `JavaScript _ -> Generate_closure.f
+          | `Wasm _ -> Fun.id)
+         +> deadcode')
   in
   let emit formatter =
     generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone

From 105ad47cbb275d7f1bb21bd2a237bdd6755200cd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 14:14:38 +0200
Subject: [PATCH 033/481] Primitives cannot be first class values in Wasm

OCaml functions are represented by a closure; we need to create a
closure corresponding to the primitive.
---
 compiler/lib/driver.ml  | 12 ++++++------
 compiler/lib/inline.ml  | 14 +++++++++-----
 compiler/lib/inline.mli |  3 ++-
 3 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index ee3f608a07..1d0188ac92 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -44,12 +44,12 @@ let deadcode p =
   let r, _ = deadcode' p in
   r
 
-let inline p =
+let inline ~target p =
   if Config.Flag.inline () && Config.Flag.deadcode ()
   then (
     let p, live_vars = deadcode' p in
     if debug () then Format.eprintf "Inlining...@.";
-    Inline.f p live_vars)
+    Inline.f ~target p live_vars)
   else p
 
 let specialize_1 (p, info) =
@@ -131,20 +131,20 @@ let o1 ~target : 'a -> 'a =
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
   +> specialize'
   +> eval ~target
-  +> inline (* inlining may reveal new tailcall opt *)
+  +> inline ~target (* inlining may reveal new tailcall opt *)
   +> deadcode
   +> tailcall
   +> phi
   +> flow
   +> specialize'
   +> eval ~target
-  +> inline
+  +> inline ~target
   +> deadcode
   +> print
   +> flow
   +> specialize'
   +> eval ~target
-  +> inline
+  +> inline ~target
   +> deadcode
   +> phi
   +> flow
@@ -160,7 +160,7 @@ let o2 ~target : 'a -> 'a = loop 10 "o1" (o1 ~target) 1 +> print
 let round1 ~target : 'a -> 'a =
   print
   +> tailcall
-  +> inline (* inlining may reveal new tailcall opt *)
+  +> inline ~target (* inlining may reveal new tailcall opt *)
   +> deadcode (* deadcode required before flow simple -> provided by constant *)
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
   +> specialize'
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 43b786b2ea..26c8ad397a 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -185,7 +185,7 @@ let rec args_equal xs ys =
   | x :: xs, Pv y :: ys -> Code.Var.compare x y = 0 && args_equal xs ys
   | _ -> false
 
-let inline live_vars closures pc (outer, blocks, free_pc) =
+let inline ~first_class_primitives live_vars closures pc (outer, blocks, free_pc) =
   let block = Addr.Map.find pc blocks in
   let body, (outer, branch, blocks, free_pc) =
     List.fold_right
@@ -241,8 +241,7 @@ let inline live_vars closures pc (outer, blocks, free_pc) =
                   let outer = { outer with size = outer.size + f_size } in
                   [], (outer, (Branch (free_pc + 1, args), loc), blocks, free_pc + 2)
                 else i :: rem, state)
-        | Let (x, Closure (l, (pc, []))), loc when false && not (Config.Flag.effects ())
-          -> (
+        | Let (x, Closure (l, (pc, []))), loc when first_class_primitives -> (
             let block = Addr.Map.find pc blocks in
             match block with
             | { body = [ (Let (y, Prim (Extern prim, args)), _loc) ]
@@ -266,7 +265,12 @@ let inline live_vars closures pc (outer, blocks, free_pc) =
 
 let times = Debug.find "times"
 
-let f p live_vars =
+let f ~target p live_vars =
+  let first_class_primitives =
+    match target with
+    | `JavaScript -> not (Config.Flag.effects ())
+    | `Wasm -> false
+  in
   Code.invariant p;
   let t = Timer.make () in
   let closures = get_closures p in
@@ -277,7 +281,7 @@ let f p live_vars =
         let traverse outer =
           Code.traverse
             { fold = Code.fold_children }
-            (inline live_vars closures)
+            (inline ~first_class_primitives live_vars closures)
             pc
             blocks
             (outer, blocks, free_pc)
diff --git a/compiler/lib/inline.mli b/compiler/lib/inline.mli
index 9799e882a2..2bc18bc4f2 100644
--- a/compiler/lib/inline.mli
+++ b/compiler/lib/inline.mli
@@ -18,4 +18,5 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : Code.program -> Deadcode.variable_uses -> Code.program
+val f :
+  target:[ `JavaScript | `Wasm ] -> Code.program -> Deadcode.variable_uses -> Code.program

From 3ec656f717ab26a378ff2b7e1a3778b6fbe021ba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 14:17:47 +0200
Subject: [PATCH 034/481] Disable some JavaScript-specific optimizations

---
 compiler/lib/driver.ml         | 22 ++++++------
 compiler/lib/specialize_js.ml  | 63 +++++++++++++++++-----------------
 compiler/lib/specialize_js.mli |  2 +-
 3 files changed, 44 insertions(+), 43 deletions(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 1d0188ac92..ac388e8053 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -56,20 +56,20 @@ let specialize_1 (p, info) =
   if debug () then Format.eprintf "Specialize...@.";
   Specialize.f ~function_arity:(fun f -> Specialize.function_arity info f) p
 
-let specialize_js (p, info) =
+let specialize_js ~target (p, info) =
   if debug () then Format.eprintf "Specialize js...@.";
-  Specialize_js.f info p
+  Specialize_js.f ~target info p
 
 let specialize_js_once p =
   if debug () then Format.eprintf "Specialize js once...@.";
   Specialize_js.f_once p
 
-let specialize' (p, info) =
+let specialize' ~target (p, info) =
   let p = specialize_1 (p, info) in
-  let p = specialize_js (p, info) in
+  let p = specialize_js ~target (p, info) in
   p, info
 
-let specialize p = fst (specialize' p)
+let specialize ~target p = fst (specialize' ~target p)
 
 let eval ~target (p, info) =
   if Config.Flag.staticeval () then Eval.f ~target info p else p
@@ -129,26 +129,26 @@ let o1 ~target : 'a -> 'a =
   print
   +> tailcall
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
-  +> specialize'
+  +> specialize' ~target
   +> eval ~target
   +> inline ~target (* inlining may reveal new tailcall opt *)
   +> deadcode
   +> tailcall
   +> phi
   +> flow
-  +> specialize'
+  +> specialize' ~target
   +> eval ~target
   +> inline ~target
   +> deadcode
   +> print
   +> flow
-  +> specialize'
+  +> specialize' ~target
   +> eval ~target
   +> inline ~target
   +> deadcode
   +> phi
   +> flow
-  +> specialize
+  +> specialize ~target
   +> identity
 
 (* o2 *)
@@ -163,11 +163,11 @@ let round1 ~target : 'a -> 'a =
   +> inline ~target (* inlining may reveal new tailcall opt *)
   +> deadcode (* deadcode required before flow simple -> provided by constant *)
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
-  +> specialize'
+  +> specialize' ~target
   +> eval ~target
   +> identity
 
-let round2 ~target = flow +> specialize' +> eval ~target +> deadcode +> o1 ~target
+let round2 ~target = flow +> specialize' ~target +> eval ~target +> deadcode +> o1 ~target
 
 let o3 ~target =
   loop 10 "tailcall+inline" (round1 ~target) 1
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 6496e0b666..b671eff3af 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -22,49 +22,50 @@ open! Stdlib
 open Code
 open Flow
 
-let specialize_instr info i =
-  match i with
-  | Let (x, Prim (Extern "caml_format_int", [ y; z ])) -> (
+let specialize_instr ~target info i =
+  match i, target with
+  | Let (x, Prim (Extern "caml_format_int", [ y; z ])), _ -> (
       match the_string_of info y with
       | Some "%d" -> (
           match the_int info z with
           | Some i -> Let (x, Constant (String (Int32.to_string i)))
           | None -> Let (x, Prim (Extern "%caml_format_int_special", [ z ])))
       | _ -> i)
-  | Let (x, Prim (Extern "%caml_format_int_special", [ z ])) -> (
+  | Let (x, Prim (Extern "%caml_format_int_special", [ z ])), _ -> (
       match the_int info z with
       | Some i -> Let (x, Constant (String (Int32.to_string i)))
       | None -> i)
   (* inline the String constant argument so that generate.ml can attempt to parse it *)
-  | Let
-      ( x
-      , Prim
-          ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim)
-          , [ (Pv _ as y) ] ) )
+  | ( Let
+        ( x
+        , Prim
+            ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim)
+            , [ (Pv _ as y) ] ) )
+    , `JavaScript )
     when Config.Flag.safe_string () -> (
       match the_string_of info y with
       | Some s -> Let (x, Prim (Extern prim, [ Pc (String s) ]))
       | _ -> i)
-  | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ y; z ])) -> (
+  | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ y; z ])), `JavaScript
+    -> (
       match the_string_of info y with
       | Some s when Primitive.need_named_value s ->
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
       | Some _ -> Let (x, Constant (Int (Regular, 0l)))
       | None -> i)
-  (*
-  | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])) -> (
+  | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), `JavaScript -> (
       match the_def_of info a with
       | Some (Block (_, a, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_call", f :: o :: Array.to_list a))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])) -> (
+  | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])), `JavaScript -> (
       match the_def_of info a with
       | Some (Block (_, a, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])) -> (
+  | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), `JavaScript -> (
       match the_string_of info m with
       | Some m when Javascript.is_ident m -> (
           match the_def_of info a with
@@ -79,13 +80,13 @@ let specialize_instr info i =
                       :: Array.to_list a ) )
           | _ -> i)
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_new", [ c; a ])) -> (
+  | Let (x, Prim (Extern "caml_js_new", [ c; a ])), `JavaScript -> (
       match the_def_of info a with
       | Some (Block (_, a, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_new", c :: Array.to_list a))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_object", [ a ])) -> (
+  | Let (x, Prim (Extern "caml_js_object", [ a ])), `JavaScript -> (
       try
         let a =
           match the_def_of info a with
@@ -110,46 +111,46 @@ let specialize_instr info i =
         in
         Let (x, Prim (Extern "%caml_js_opt_object", List.flatten (Array.to_list a)))
       with Exit -> i)
-  | Let (x, Prim (Extern "caml_js_get", [ o; (Pv _ as f) ])) -> (
+  | Let (x, Prim (Extern "caml_js_get", [ o; (Pv _ as f) ])), _ -> (
       match the_native_string_of info f with
       | Some s -> Let (x, Prim (Extern "caml_js_get", [ o; Pc (NativeString s) ]))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_set", [ o; (Pv _ as f); v ])) -> (
+  | Let (x, Prim (Extern "caml_js_set", [ o; (Pv _ as f); v ])), _ -> (
       match the_native_string_of info f with
       | Some s -> Let (x, Prim (Extern "caml_js_set", [ o; Pc (NativeString s); v ]))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_delete", [ o; (Pv _ as f) ])) -> (
+  | Let (x, Prim (Extern "caml_js_delete", [ o; (Pv _ as f) ])), _ -> (
       match the_native_string_of info f with
       | Some s -> Let (x, Prim (Extern "caml_js_delete", [ o; Pc (NativeString s) ]))
       | _ -> i)
-  | Let (x, Prim (Extern ("caml_jsstring_of_string" | "caml_js_from_string"), [ y ])) -> (
+  | ( Let (x, Prim (Extern ("caml_jsstring_of_string" | "caml_js_from_string"), [ y ]))
+    , `JavaScript ) -> (
       match the_string_of info y with
       | Some s when String.is_valid_utf_8 s ->
           Let (x, Constant (NativeString (Native_string.of_string s)))
       | Some _ | None -> i)
-  | Let (x, Prim (Extern "caml_jsbytes_of_string", [ y ])) -> (
+  | Let (x, Prim (Extern "caml_jsbytes_of_string", [ y ])), `JavaScript -> (
       match the_string_of info y with
       | Some s -> Let (x, Constant (NativeString (Native_string.of_bytestring s)))
       | None -> i)
-*)
-  | Let (x, Prim (Extern "%int_mul", [ y; z ])) -> (
+  | Let (x, Prim (Extern "%int_mul", [ y; z ])), `JavaScript -> (
       match the_int info y, the_int info z with
       | Some j, _ when Int32.(abs j < 0x200000l) ->
           Let (x, Prim (Extern "%direct_int_mul", [ y; z ]))
       | _, Some j when Int32.(abs j < 0x200000l) ->
           Let (x, Prim (Extern "%direct_int_mul", [ y; z ]))
       | _ -> i)
-  | Let (x, Prim (Extern "%int_div", [ y; z ])) -> (
+  | Let (x, Prim (Extern "%int_div", [ y; z ])), _ -> (
       match the_int info z with
       | Some j when Int32.(j <> 0l) -> Let (x, Prim (Extern "%direct_int_div", [ y; z ]))
       | _ -> i)
-  | Let (x, Prim (Extern "%int_mod", [ y; z ])) -> (
+  | Let (x, Prim (Extern "%int_mod", [ y; z ])), _ -> (
       match the_int info z with
       | Some j when Int32.(j <> 0l) -> Let (x, Prim (Extern "%direct_int_mod", [ y; z ]))
       | _ -> i)
-  | _ -> i
+  | _, _ -> i
 
-let specialize_instrs info l =
+let specialize_instrs ~target info l =
   let rec aux info checks l acc =
     match l with
     | [] -> List.rev acc
@@ -206,22 +207,22 @@ let specialize_instrs info l =
               in
               aux info ((y, idx) :: checks) r acc
         | _ ->
-            let i = specialize_instr info i in
+            let i = specialize_instr ~target info i in
             aux info checks r ((i, loc) :: acc))
   in
   aux info [] l []
 
-let specialize_all_instrs info p =
+let specialize_all_instrs ~target info p =
   let blocks =
     Addr.Map.map
-      (fun block -> { block with Code.body = specialize_instrs info block.body })
+      (fun block -> { block with Code.body = specialize_instrs ~target info block.body })
       p.blocks
   in
   { p with blocks }
 
 (****)
 
-let f info p = specialize_all_instrs info p
+let f ~target info p = specialize_all_instrs ~target info p
 
 let f_once p =
   let rec loop acc l =
diff --git a/compiler/lib/specialize_js.mli b/compiler/lib/specialize_js.mli
index 3ed1f1a6c5..4bf26256a8 100644
--- a/compiler/lib/specialize_js.mli
+++ b/compiler/lib/specialize_js.mli
@@ -18,6 +18,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : Flow.info -> Code.program -> Code.program
+val f : target:[ `JavaScript | `Wasm ] -> Flow.info -> Code.program -> Code.program
 
 val f_once : Code.program -> Code.program

From c30ceade875f9ef4b2b7196653907d71d931f9db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 15:19:53 +0200
Subject: [PATCH 035/481] AST updates

---
 compiler/lib/wasm/wa_asm_output.ml |  72 ++++++++-----
 compiler/lib/wasm/wa_ast.ml        |  32 +++---
 compiler/lib/wasm/wa_tail_call.ml  |   3 +-
 compiler/lib/wasm/wa_wat_output.ml | 160 ++++++++++++++---------------
 4 files changed, 143 insertions(+), 124 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 1734650c46..d6ed147556 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -117,6 +117,7 @@ module Output () = struct
       (match t with
       | I32 -> "i32"
       | I64 -> "i64"
+      | F32 -> "f32"
       | F64 -> "f64"
       | Ref _ -> assert false (* Not supported *))
 
@@ -138,6 +139,7 @@ module Output () = struct
     match op with
     | I32 _ -> string "i32."
     | I64 _ -> string "i64."
+    | F32 _ -> string "f32."
     | F64 _ -> string "f64."
 
   let signage op (s : Wa_ast.signage) =
@@ -147,7 +149,7 @@ module Output () = struct
     | S -> "_s"
     | U -> "_u"
 
-  let int_un_op op =
+  let int_un_op sz op =
     match op with
     | Clz -> "clz"
     | Ctz -> "ctz"
@@ -156,9 +158,9 @@ module Output () = struct
     | TruncSatF64 s ->
         Feature.require nontrapping_fptoint;
         signage "trunc_sat_f64" s
-    | ReinterpretF64 -> "reinterpret_f64"
+    | ReinterpretF -> "reinterpret_f" ^ sz
 
-  let int_bin_op (op : int_bin_op) =
+  let int_bin_op _ (op : int_bin_op) =
     match op with
     | Add -> "add"
     | Sub -> "sub"
@@ -179,7 +181,7 @@ module Output () = struct
     | Le s -> signage "le" s
     | Ge s -> signage "ge" s
 
-  let float_un_op op =
+  let float_un_op sz op =
     match op with
     | Neg -> "neg"
     | Abs -> "abs"
@@ -190,10 +192,9 @@ module Output () = struct
     | Sqrt -> "sqrt"
     | Convert (`I32, s) -> signage "convert_i32" s
     | Convert (`I64, s) -> signage "convert_i64" s
-    | Reinterpret `I32 -> "reinterpret_i32"
-    | Reinterpret `I64 -> "reinterpret_i64"
+    | ReinterpretI -> "reinterpret_i" ^ sz
 
-  let float_bin_op op =
+  let float_bin_op _ op =
     match op with
     | Add -> "add"
     | Sub -> "sub"
@@ -209,27 +210,30 @@ module Output () = struct
     | Le -> "le"
     | Ge -> "ge"
 
-  let select i32 i64 f64 op =
+  let select i32 i64 f32 f64 op =
     match op with
-    | I32 x -> i32 x
-    | I64 x -> i64 x
-    | F64 x -> f64 x
+    | I32 x -> i32 "32" x
+    | I64 x -> i64 "64" x
+    | F32 x -> f32 "32" x
+    | F64 x -> f64 "64" x
 
   let integer i = string (string_of_int i)
 
-  let integer32 i =
+  let integer32 _ i =
     string
       (if Poly.(i > -10000l && i < 10000l)
        then Int32.to_string i
        else Printf.sprintf "0x%lx" i)
 
-  let integer64 i =
+  let integer64 _ i =
     string
       (if Poly.(i > -10000L && i < 10000L)
        then Int64.to_string i
        else Printf.sprintf "0x%Lx" i)
 
-  let float64 f = string (Printf.sprintf "%h" f) (*ZZZ nan with payload*)
+  let float32 _ f = string (Printf.sprintf "%h" f) (*ZZZ nan with payload*)
+
+  let float64 _ f = string (Printf.sprintf "%h" f) (*ZZZ nan with payload*)
 
   let index name = string (Code.Var.to_string name)
 
@@ -243,37 +247,52 @@ module Output () = struct
     then empty
     else (if offset < 0 then empty else string "+") ^^ integer offset
 
+  let offs _ i = Int32.to_string i
+
   let rec expression e =
     match e with
     | Const op ->
-        line (type_prefix op ^^ string "const " ^^ select integer32 integer64 float64 op)
+        line
+          (type_prefix op
+          ^^ string "const "
+          ^^ select integer32 integer64 float32 float64 op)
     | ConstSym (name, offset) ->
         line (type_prefix (I32 ()) ^^ string "const " ^^ symbol name offset)
     | UnOp (op, e') ->
         expression e'
-        ^^ line (type_prefix op ^^ string (select int_un_op int_un_op float_un_op op))
+        ^^ line
+             (type_prefix op
+             ^^ string (select int_un_op int_un_op float_un_op float_un_op op))
     | BinOp (op, e1, e2) ->
         expression e1
         ^^ expression e2
-        ^^ line (type_prefix op ^^ string (select int_bin_op int_bin_op float_bin_op op))
+        ^^ line
+             (type_prefix op
+             ^^ string (select int_bin_op int_bin_op float_bin_op float_bin_op op))
     | I32WrapI64 e -> expression e ^^ line (string "i32.wrap_i64")
     | I64ExtendI32 (s, e) -> expression e ^^ line (string (signage "i64.extend_i32" s))
+    | F32DemoteF64 e -> expression e ^^ line (string "f32.demote_f64")
+    | F64PromoteF32 e -> expression e ^^ line (string "f64.promote_f32")
     | Load (offset, e') ->
         expression e'
         ^^ line
              (type_prefix offset
              ^^ string "load "
-             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+             ^^ string (select offs offs offs offs offset))
     | Load8 (s, offset, e') ->
         expression e'
         ^^ line
              (type_prefix offset
              ^^ string (signage "load8" s)
              ^^ string " "
-             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+             ^^ string (select offs offs offs offs offset))
     | LocalGet i -> line (string "local.get " ^^ integer i)
     | LocalTee (i, e') -> expression e' ^^ line (string "local.tee " ^^ integer i)
     | GlobalGet nm -> line (string "global.get " ^^ symbol nm 0)
+    | BlockExpr (ty, l) ->
+        line (string "block" ^^ block_type ty)
+        ^^ indent (concat_map instruction l)
+        ^^ line (string "end_block")
     | Call_indirect (typ, f, l) ->
         concat_map expression l
         ^^ expression f
@@ -296,7 +315,9 @@ module Output () = struct
     | RefCast _
     | RefTest _
     | RefEq _
-    | RefNull
+    | RefNull _
+    | Br_on_cast _
+    | Br_on_cast_fail _
     | ExternExternalize _
     | ExternInternalize _ -> assert false (* Not supported *)
 
@@ -309,14 +330,14 @@ module Output () = struct
         ^^ line
              (type_prefix offset
              ^^ string "store "
-             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+             ^^ string (select offs offs offs offs offset))
     | Store8 (offset, e, e') ->
         expression e
         ^^ expression e'
         ^^ line
              (type_prefix offset
              ^^ string "store8 "
-             ^^ string (select Int32.to_string Int32.to_string Int32.to_string offset))
+             ^^ string (select offs offs offs offs offset))
     | LocalSet (i, e) -> expression e ^^ line (string "local.set " ^^ integer i)
     | GlobalSet (nm, e) -> expression e ^^ line (string "global.set " ^^ symbol nm 0)
     | Loop (ty, l) ->
@@ -373,8 +394,7 @@ module Output () = struct
     | Return_call (x, l) ->
         Feature.require tail_call;
         concat_map expression l ^^ line (string "return_call " ^^ index x)
-    | ArraySet _ | StructSet _ | Br_on_cast _ | Br_on_cast_fail _ | Return_call_ref _ ->
-        assert false (* Not supported *)
+    | ArraySet _ | StructSet _ | Return_call_ref _ -> assert false (* Not supported *)
 
   let escape_string s =
     let b = Buffer.create (String.length s + 2) in
@@ -542,8 +562,8 @@ module Output () = struct
                         line
                           (match d with
                           | DataI8 i -> string ".int8 " ^^ integer i
-                          | DataI32 i -> string ".int32 " ^^ integer32 i
-                          | DataI64 i -> string ".int64 " ^^ integer64 i
+                          | DataI32 i -> string ".int32 " ^^ integer32 "32" i
+                          | DataI64 i -> string ".int64 " ^^ integer64 "64" i
                           | DataBytes b ->
                               string ".ascii \""
                               ^^ string (escape_string b)
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index cf495886c2..9db6620715 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -23,6 +23,7 @@ type ref_type =
 type value_type =
   | I32
   | I64
+  | F32
   | F64
   | Ref of ref_type
 
@@ -49,9 +50,10 @@ type str_type =
   | Array of field_type
   | Func of func_type
 
-type ('i32, 'i64, 'f64) op =
+type ('i32, 'i64, 'f32, 'f64) op =
   | I32 of 'i32
   | I64 of 'i64
+  | F32 of 'f32
   | F64 of 'f64
 
 type signage =
@@ -64,7 +66,7 @@ type int_un_op =
   | Popcnt
   | Eqz
   | TruncSatF64 of signage
-  | ReinterpretF64
+  | ReinterpretF
 
 type int_bin_op =
   | Add
@@ -95,7 +97,7 @@ type float_un_op =
   | Nearest
   | Sqrt
   | Convert of [ `I32 | `I64 ] * signage
-  | Reinterpret of [ `I32 | `I64 ]
+  | ReinterpretI
 
 type float_bin_op =
   | Add
@@ -115,17 +117,21 @@ type float_bin_op =
 type memarg = int32
 
 type expression =
-  | Const of (int32, int64, float) op
+  | Const of (int32, int64, float, float) op
   | ConstSym of symbol * int
-  | UnOp of (int_un_op, int_un_op, float_un_op) op * expression
-  | BinOp of (int_bin_op, int_bin_op, float_bin_op) op * expression * expression
+  | UnOp of (int_un_op, int_un_op, float_un_op, float_un_op) op * expression
+  | BinOp of
+      (int_bin_op, int_bin_op, float_bin_op, float_bin_op) op * expression * expression
   | I32WrapI64 of expression
   | I64ExtendI32 of signage * expression
-  | Load of (memarg, memarg, memarg) op * expression
-  | Load8 of signage * (memarg, memarg, memarg) op * expression
+  | F32DemoteF64 of expression
+  | F64PromoteF32 of expression
+  | Load of (memarg, memarg, memarg, memarg) op * expression
+  | Load8 of signage * (memarg, memarg, memarg, memarg) op * expression
   | LocalGet of int
   | LocalTee of int * expression
   | GlobalGet of symbol
+  | BlockExpr of func_type * instruction list
   | Call_indirect of func_type * expression * expression list
   | Call of var * expression list
   | MemoryGrow of int * expression
@@ -145,14 +151,16 @@ type expression =
   | RefCast of ref_type * expression
   | RefTest of ref_type * expression
   | RefEq of expression * expression
-  | RefNull
+  | RefNull of heap_type
   | ExternInternalize of expression
   | ExternExternalize of expression
+  | Br_on_cast of int * ref_type * ref_type * expression
+  | Br_on_cast_fail of int * ref_type * ref_type * expression
 
 and instruction =
   | Drop of expression
-  | Store of (memarg, memarg, memarg) op * expression * expression
-  | Store8 of (memarg, memarg, memarg) op * expression * expression
+  | Store of (memarg, memarg, memarg, memarg) op * expression * expression
+  | Store8 of (memarg, memarg, memarg, memarg) op * expression * expression
   | LocalSet of int * expression
   | GlobalSet of symbol * expression
   | Loop of func_type * instruction list
@@ -173,8 +181,6 @@ and instruction =
   | Rethrow of int
   | ArraySet of var * expression * expression * expression
   | StructSet of var * int * expression * expression
-  | Br_on_cast of int * ref_type * ref_type * expression
-  | Br_on_cast_fail of int * ref_type * ref_type * expression
   | Return_call_indirect of func_type * expression * expression list
   | Return_call of var * expression list
   | Return_call_ref of var * expression * expression list
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index 94d249b8a2..9c475f94fa 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -18,6 +18,7 @@ let rec instruction ~tail i =
   | Push (Call_indirect (ty, e, l)) when tail -> Return_call_indirect (ty, e, l)
   | Push (Call_ref (ty, e, l)) when tail -> Return_call_ref (ty, e, l)
   | Push (Call_ref _) -> i
+  | Drop (BlockExpr (typ, l)) -> Drop (BlockExpr (typ, instructions ~tail:false l))
   | Drop _
   | Store _
   | Store8 _
@@ -33,8 +34,6 @@ let rec instruction ~tail i =
   | Push _
   | ArraySet _
   | StructSet _
-  | Br_on_cast _
-  | Br_on_cast_fail _
   | Return_call_indirect _
   | Return_call _
   | Return_call_ref _ -> i
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 07173fe785..211a9dcba4 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -40,6 +40,7 @@ let value_type (t : value_type) =
   match t with
   | I32 -> Atom "i32"
   | I64 -> Atom "i64"
+  | F32 -> Atom "f32"
   | F64 -> Atom "f64"
   | Ref ty -> ref_type ty
 
@@ -92,6 +93,7 @@ let type_prefix op nm =
   (match op with
   | I32 _ -> "i32."
   | I64 _ -> "i64."
+  | F32 _ -> "f32."
   | F64 _ -> "f64.")
   ^ nm
 
@@ -102,16 +104,16 @@ let signage op (s : Wa_ast.signage) =
   | S -> "_s"
   | U -> "_u"
 
-let int_un_op op =
+let int_un_op sz op =
   match op with
   | Clz -> "clz"
   | Ctz -> "ctz"
   | Popcnt -> "popcnt"
   | Eqz -> "eqz"
   | TruncSatF64 s -> signage "trunc_sat_f64" s
-  | ReinterpretF64 -> "reinterpret_f64"
+  | ReinterpretF -> "reinterpret_f" ^ sz
 
-let int_bin_op (op : int_bin_op) =
+let int_bin_op _ (op : int_bin_op) =
   match op with
   | Add -> "add"
   | Sub -> "sub"
@@ -132,7 +134,7 @@ let int_bin_op (op : int_bin_op) =
   | Le s -> signage "le" s
   | Ge s -> signage "ge" s
 
-let float_un_op op =
+let float_un_op sz op =
   match op with
   | Neg -> "neg"
   | Abs -> "abs"
@@ -143,10 +145,9 @@ let float_un_op op =
   | Sqrt -> "sqrt"
   | Convert (`I32, s) -> signage "convert_i32" s
   | Convert (`I64, s) -> signage "convert_i64" s
-  | Reinterpret `I32 -> "reinterpret_i32"
-  | Reinterpret `I64 -> "reinterpret_i64"
+  | ReinterpretI -> "reinterpret_i" ^ sz
 
-let float_bin_op op =
+let float_bin_op _ op =
   match op with
   | Add -> "add"
   | Sub -> "sub"
@@ -162,11 +163,12 @@ let float_bin_op op =
   | Le -> "le"
   | Ge -> "ge"
 
-let select i32 i64 f64 op =
+let select i32 i64 f32 f64 op =
   match op with
-  | I32 x -> i32 x
-  | I64 x -> i64 x
-  | F64 x -> f64 x
+  | I32 x -> i32 "32" x
+  | I64 x -> i64 "64" x
+  | F32 x -> f32 "32" x
+  | F64 x -> f64 "64" x
 
 type ctx =
   { addresses : int Code.Var.Map.t
@@ -192,31 +194,23 @@ let lookup_symbol ctx (x : symbol) =
 
 let remove_nops l = List.filter ~f:(fun i -> not (Poly.equal i Nop)) l
 
-let float64 f =
-  if Float.equal (1. /. f) 0.
-  then if Float.( < ) f 0. then "-inf" else "inf"
-  else Printf.sprintf "%h" f (*ZZZ nan with payload*)
+let float64 _ f = Printf.sprintf "%h" f (*ZZZ*)
+
+let float32 _ f = Printf.sprintf "%h" f (*ZZZ*)
 
 let expression_or_instructions ctx in_function =
   let rec expression e =
     match e with
-    | RefEq (LocalGet x, I31New (Const (I32 n))) ->
-        (*ZZZ Chrome bug *)
-        instruction
-          (If
-             ( { params = []; result = [ I32 ] }
-             , RefTest ({ nullable = false; typ = I31 }, LocalGet x)
-             , [ Push
-                   (BinOp
-                      ( I32 Eq
-                      , I31Get (S, RefCast ({ nullable = false; typ = I31 }, LocalGet x))
-                      , Const (I32 n) ))
-               ]
-             , [ Push (Const (I32 0l)) ] ))
     | Const op ->
         [ List
             [ Atom (type_prefix op "const")
-            ; Atom (select Int32.to_string Int64.to_string float64 op)
+            ; Atom
+                (select
+                   (fun _ i -> Int32.to_string i)
+                   (fun _ i -> Int64.to_string i)
+                   float64
+                   float32
+                   op)
             ]
         ]
     | ConstSym (symb, ofs) ->
@@ -224,36 +218,43 @@ let expression_or_instructions ctx in_function =
         [ List [ Atom "i32.const"; Atom (string_of_int (i + ofs)) ] ]
     | UnOp (op, e') ->
         [ List
-            (Atom (type_prefix op (select int_un_op int_un_op float_un_op op))
+            (Atom (type_prefix op (select int_un_op int_un_op float_un_op float_un_op op))
             :: expression e')
         ]
     | BinOp (op, e1, e2) ->
         [ List
-            (Atom (type_prefix op (select int_bin_op int_bin_op float_bin_op op))
+            (Atom
+               (type_prefix
+                  op
+                  (select int_bin_op int_bin_op float_bin_op float_bin_op op))
             :: (expression e1 @ expression e2))
         ]
     | I32WrapI64 e -> [ List (Atom "i32.wrap_i64" :: expression e) ]
     | I64ExtendI32 (s, e) -> [ List (Atom (signage "i64.extend_i32" s) :: expression e) ]
+    | F32DemoteF64 e -> [ List (Atom "f32.demote_f64" :: expression e) ]
+    | F64PromoteF32 e -> [ List (Atom "f64.promote_f64" :: expression e) ]
     | Load (offset, e') ->
-        let offs i =
+        let offs _ i =
           if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
         in
         [ List
-            ((Atom (type_prefix offset "load") :: select offs offs offs offset)
+            ((Atom (type_prefix offset "load") :: select offs offs offs offs offset)
             @ expression e')
         ]
     | Load8 (s, offset, e') ->
-        let offs i =
+        let offs _ i =
           if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
         in
         [ List
-            ((Atom (type_prefix offset (signage "load" s)) :: select offs offs offs offset)
+            (Atom (type_prefix offset (signage "load" s))
+             :: select offs offs offs offs offset
             @ expression e')
         ]
     | LocalGet i -> [ List [ Atom "local.get"; Atom (string_of_int i) ] ]
     | LocalTee (i, e') ->
         [ List (Atom "local.tee" :: Atom (string_of_int i) :: expression e') ]
     | GlobalGet nm -> [ List [ Atom "global.get"; symbol nm ] ]
+    | BlockExpr (ty, l) -> [ List (Atom "block" :: (block_type ty @ instructions l)) ]
     | Call_indirect (typ, e, l) ->
         [ List
             ((Atom "call_indirect" :: func_type typ)
@@ -325,27 +326,59 @@ let expression_or_instructions ctx in_function =
         | `Binaryen -> [ List (Atom "ref.test" :: (ref_type' ty @ expression e)) ]
         | `Reference -> [ List (Atom "ref.test" :: ref_type ty :: expression e) ])
     | RefEq (e, e') -> [ List (Atom "ref.eq" :: (expression e @ expression e')) ]
-    | RefNull -> [ Atom "ref.null" ]
+    | RefNull ty -> [ List [ Atom "ref.null"; heap_type ty ] ]
+    | Br_on_cast (i, ty, ty', e) -> (
+        match target with
+        | `Binaryen ->
+            [ List
+                (Atom "br_on_cast"
+                :: Atom (string_of_int i)
+                :: (ref_type' ty' @ expression e))
+            ]
+        | `Reference ->
+            [ List
+                (Atom "br_on_cast"
+                :: Atom (string_of_int i)
+                :: ref_type ty
+                :: ref_type ty'
+                :: expression e)
+            ])
+    | Br_on_cast_fail (i, ty, ty', e) -> (
+        match target with
+        | `Binaryen ->
+            [ List
+                (Atom "br_on_cast_fail"
+                :: Atom (string_of_int i)
+                :: (ref_type' ty' @ expression e))
+            ]
+        | `Reference ->
+            [ List
+                (Atom "br_on_cast_fail"
+                :: Atom (string_of_int i)
+                :: ref_type ty
+                :: ref_type ty'
+                :: expression e)
+            ])
     | ExternInternalize e -> [ List (Atom "extern.internalize" :: expression e) ]
     | ExternExternalize e -> [ List (Atom "extern.externalize" :: expression e) ]
   and instruction i =
     match i with
     | Drop e -> [ List (Atom "drop" :: expression e) ]
     | Store (offset, e1, e2) ->
-        let offs i =
+        let offs _ i =
           if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
         in
         [ List
             (Atom (type_prefix offset "store")
-            :: (select offs offs offs offset @ expression e1 @ expression e2))
+            :: (select offs offs offs offs offset @ expression e1 @ expression e2))
         ]
     | Store8 (offset, e1, e2) ->
-        let offs i =
+        let offs _ i =
           if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
         in
         [ List
             (Atom (type_prefix offset "store8")
-            :: (select offs offs offs offset @ expression e1 @ expression e2))
+            :: (select offs offs offs offs offset @ expression e1 @ expression e2))
         ]
     | LocalSet (i, Seq (l, e)) -> instructions (l @ [ LocalSet (i, e) ])
     | LocalSet (i, e) ->
@@ -420,38 +453,6 @@ let expression_or_instructions ctx in_function =
             :: Atom (string_of_int i)
             :: (expression e @ expression e'))
         ]
-    | Br_on_cast (i, ty, ty', e) -> (
-        match target with
-        | `Binaryen ->
-            [ List
-                (Atom "br_on_cast"
-                :: Atom (string_of_int i)
-                :: (ref_type' ty' @ expression e))
-            ]
-        | `Reference ->
-            [ List
-                (Atom "br_on_cast"
-                :: Atom (string_of_int i)
-                :: ref_type ty
-                :: ref_type ty'
-                :: expression e)
-            ])
-    | Br_on_cast_fail (i, ty, ty', e) -> (
-        match target with
-        | `Binaryen ->
-            [ List
-                (Atom "br_on_cast_fail"
-                :: Atom (string_of_int i)
-                :: (ref_type' ty' @ expression e))
-            ]
-        | `Reference ->
-            [ List
-                (Atom "br_on_cast_fail"
-                :: Atom (string_of_int i)
-                :: ref_type ty
-                :: ref_type ty'
-                :: expression e)
-            ])
     | Return_call_indirect (typ, e, l) ->
         [ List
             ((Atom "return_call_indirect" :: func_type typ)
@@ -522,22 +523,15 @@ let data_contents ctx contents =
 
 let type_field { name; typ; supertype; final } =
   match target with
-  | `Binaryen ->
-      List
-        (Atom "type"
-        :: index name
-        :: str_type typ
-        ::
-        (match supertype with
-        | Some supertype -> [ List [ Atom "extends"; index supertype ] ]
-        | None -> []))
-  | `Reference ->
+  | `Binaryen when Option.is_none supertype ->
+      List [ Atom "type"; index name; str_type typ ]
+  | _ ->
       List
         [ Atom "type"
         ; index name
         ; List
             (Atom "sub"
-            :: ((if final then [ Atom "final" ] else [])
+            :: ((if final && Poly.(target <> `Binaryen) then [ Atom "final" ] else [])
                @ (match supertype with
                  | Some supertype -> [ index supertype ]
                  | None -> [])

From ee76e48f3f5f75b52ad633028387aefc9e4f3990 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 15:31:23 +0200
Subject: [PATCH 036/481] Small improvements in generated code

---
 compiler/lib/wasm/wa_code_generation.ml  | 20 ++++++++++++++------
 compiler/lib/wasm/wa_code_generation.mli |  4 ++++
 compiler/lib/wasm/wa_core_target.ml      |  9 +++++++++
 compiler/lib/wasm/wa_curry.ml            | 19 +++++++++----------
 compiler/lib/wasm/wa_gc_target.ml        | 23 ++++++++++++++++++++---
 compiler/lib/wasm/wa_target_sig.ml       |  7 ++++++-
 6 files changed, 62 insertions(+), 20 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 2fb711f360..ac1a55377c 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -173,11 +173,7 @@ let is_closure f st = Var.Map.mem f st.context.closure_envs, st
 
 let var x st =
   try Var.Map.find x st.vars, st
-  with Not_found -> (
-    try Expr (return (Hashtbl.find st.context.constants x)), st
-    with Not_found ->
-      Format.eprintf "ZZZ %a@." Var.print x;
-      Local (0, None), st)
+  with Not_found -> Expr (return (Hashtbl.find st.context.constants x)), st
 
 let add_var ?typ x ({ var_count; vars; _ } as st) =
   match Var.Map.find_opt x vars with
@@ -298,7 +294,7 @@ module Arith = struct
   let of_int31 n =
     let* n = n in
     match n with
-    | W.I31New (Const (I32 _) as c) -> return c (*ZZZ Overflow *)
+    | W.I31New (Const (I32 n)) -> return (W.Const (I32 (Int31.wrap n)))
     | _ -> return (W.I31Get (S, n))
 end
 
@@ -359,6 +355,14 @@ let drop e =
       if b then instrs l else instr (Drop e)
   | _ -> instr (Drop e)
 
+let push e =
+  let* e = e in
+  match e with
+  | W.Seq (l, e') ->
+      let* () = instrs l in
+      instr (Push e')
+  | _ -> instr (Push e)
+
 let loop ty l =
   let* instrs = blk l in
   instr (Loop (ty, instrs))
@@ -367,6 +371,10 @@ let block ty l =
   let* instrs = blk l in
   instr (Block (ty, instrs))
 
+let block_expr ty l =
+  let* instrs = blk l in
+  return (W.BlockExpr (ty, instrs))
+
 let if_ ty e l1 l2 =
   let* e = e in
   let* instrs1 = blk l1 in
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 2cba13ae29..cb7922417b 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -88,10 +88,14 @@ val assign : Wa_ast.var -> expression -> unit t
 
 val drop : expression -> unit t
 
+val push : expression -> unit t
+
 val loop : Wa_ast.func_type -> unit t -> unit t
 
 val block : Wa_ast.func_type -> unit t -> unit t
 
+val block_expr : Wa_ast.func_type -> unit t -> expression
+
 val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
 val try_ : Wa_ast.func_type -> unit t -> Code.Var.t -> unit t -> unit t
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 2fa42aa8fb..d93195d0f3 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -125,6 +125,15 @@ module Memory = struct
 
   let load_function_arity closure = Arith.(field closure 1 lsr const 24l)
 
+  let check_function_arity f arity if_match if_mismatch =
+    let func_arity = load_function_arity (load f) in
+    if_
+      { params = []; result = [ I32 ] }
+      Arith.(func_arity = const (Int32.of_int arity))
+      (let* res = if_match ~typ:None (load f) in
+       instr (Push res))
+      if_mismatch
+
   let box_float stack_ctx x e =
     let p = Code.Var.fresh_n "p" in
     let size = 12 in
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index 79f82582d9..ee4eb83aae 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -117,10 +117,10 @@ module Make (Target : Wa_target_sig.S) = struct
           ~spilled_vars:Var.Set.empty
       in
       let stack_ctx = Stack.start_function ~context stack_info in
-      let* e =
-        Closure.curry_allocate ~stack_ctx ~x:res ~arity m ~f:name' ~closure:f ~arg:x
+      let* () =
+        push
+          (Closure.curry_allocate ~stack_ctx ~x:res ~arity m ~f:name' ~closure:f ~arg:x)
       in
-      let* () = instr (Push e) in
       Stack.perform_spilling stack_ctx (`Instr ret)
     in
     let locals, body =
@@ -141,13 +141,12 @@ module Make (Target : Wa_target_sig.S) = struct
       let* () = bind_parameters l in
       let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
-      let func_arity = Memory.load_function_arity (load f) in
-      if_
-        { params = []; result = [ Value.value ] }
-        Arith.(func_arity = const (Int32.of_int arity))
-        (let* l = expression_list load l in
-         let* res = call ~arity (load f) l in
-         instr (Push res))
+      Memory.check_function_arity
+        f
+        arity
+        (fun ~typ closure ->
+          let* l = expression_list load l in
+          call ?typ ~arity closure l)
         (let rec build_spilling_info stack_info stack live_vars acc l =
            match l with
            | [] -> stack_info, List.rev acc
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index f2c8749a8c..1f304329a3 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -400,9 +400,26 @@ module Memory = struct
     let* e = wasm_struct_get ty casted_closure (if arity = 1 then 1 else 2) in
     return (`Ref fun_ty, e)
 
-  let load_function_arity closure =
-    let* ty = Type.closure_type_1 in
-    wasm_struct_get ty (wasm_cast ty closure) 0
+  let check_function_arity f arity if_match if_mismatch =
+    let* fun_ty = Type.closure_type arity in
+    let* closure = load f in
+    let* () =
+      drop
+        (block_expr
+           { params = []; result = [ Value.value ] }
+           (let* e =
+              if_match
+                ~typ:(Some (W.Ref { nullable = false; typ = Type fun_ty }))
+                (return
+                   (W.Br_on_cast_fail
+                      ( 0
+                      , { nullable = false; typ = Eq }
+                      , { nullable = false; typ = Type fun_ty }
+                      , closure )))
+            in
+            instr (W.Return (Some e))))
+    in
+    if_mismatch
 
   let box_float _ _ e =
     let* ty = Type.float_type in
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index dde876f017..1c04da719d 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -65,7 +65,12 @@ module type S = sig
       -> expression
       -> ([ `Index | `Ref of Wa_ast.var ] * Wa_ast.expression) Wa_code_generation.t
 
-    val load_function_arity : expression -> expression
+    val check_function_arity :
+         Code.Var.t
+      -> int
+      -> (typ:Wa_ast.value_type option -> expression -> expression)
+      -> unit Wa_code_generation.t
+      -> unit Wa_code_generation.t
 
     val tag : expression -> expression
 

From 3be96fd6754af8fa072b97c0053cc3e01f7596f6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 15:49:46 +0200
Subject: [PATCH 037/481] Runtime support for numbers (int, int32, int64,
 nativeint, float)

---
 compiler/lib/wasm/wa_core_target.ml |  95 +++++++-
 compiler/lib/wasm/wa_gc_target.ml   |  68 +++++-
 compiler/lib/wasm/wa_generate.ml    | 270 +++++++++++++++++++++
 compiler/lib/wasm/wa_target_sig.ml  |  42 ++++
 runtime/wasm/index.js               |  15 +-
 runtime/wasm/run.js                 |  17 +-
 runtime/wasm/runtime.wat            | 363 +++++++++++++++++++++++++---
 7 files changed, 823 insertions(+), 47 deletions(-)

diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index d93195d0f3..66caa5e55c 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -162,7 +162,41 @@ module Memory = struct
         in
         let* _, l = get_data_segment x in
         return (get_data l)
-    | _ -> return (W.Load (F64 0l, e))
+    | _ ->
+        (*ZZZ aligned?*)
+        return (W.Load (F64 0l, e))
+
+  let box_int32 stack_ctx x e =
+    let p = Code.Var.fresh_n "p" in
+    let size = 16 in
+    seq
+      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+       let* v =
+         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
+       in
+       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
+       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
+       Stack.kill_variables stack_ctx;
+       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
+       let* p = load p in
+       (* ZZZ int32_ops *)
+       let* () = instr (Store (I32 4l, p, Const (I32 0l))) in
+       let* e = e in
+       instr (Store (I32 8l, p, e)))
+      Arith.(load p + const 4l)
+
+  let unbox_int32 e =
+    let* e = e in
+    match e with
+    | W.ConstSym (V x, 4) ->
+        let get_data l =
+          match l with
+          | [ W.DataI32 _; (W.DataI32 _ | W.DataSym _); W.DataI32 f ] -> W.Const (I32 f)
+          | _ -> assert false
+        in
+        let* _, l = get_data_segment x in
+        return (get_data l)
+    | _ -> return (W.Load (I32 4l, e))
 
   let box_int64 stack_ctx x e =
     let p = Code.Var.fresh_n "p" in
@@ -194,6 +228,27 @@ module Memory = struct
         let* _, l = get_data_segment x in
         return (get_data l)
     | _ -> return (W.Load (F64 4l, e))
+
+  let box_nativeint stack_ctx x e =
+    let p = Code.Var.fresh_n "p" in
+    let size = 16 in
+    seq
+      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+       let* v =
+         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
+       in
+       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
+       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
+       Stack.kill_variables stack_ctx;
+       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
+       let* p = load p in
+       (* ZZZ nativeint_ops *)
+       let* () = instr (Store (I32 4l, p, Const (I32 0l))) in
+       let* e = e in
+       instr (Store (I32 8l, p, e)))
+      Arith.(load p + const 4l)
+
+  let unbox_nativeint = unbox_int32
 end
 
 module Value = struct
@@ -295,7 +350,9 @@ module Constant = struct
     | Int64 i ->
         let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:3 () in
         let name = Code.Var.fresh_n "int64" in
-        let block = [ W.DataI32 h; DataSym (S "caml_int64_ops", 0); DataI64 i ] in
+        let block =
+          [ W.DataI32 h; DataI32 0l (*ZZZ DataSym (S "caml_int64_ops", 0)*); DataI64 i ]
+        in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
         W.DataSym (V name, 4)
     | Int (Int32, i) ->
@@ -492,8 +549,40 @@ module Math = struct
 
   let sin f = unary "sin" f
 
+  let tan f = unary "tan" f
+
+  let acos f = unary "acos" f
+
   let asin f = unary "asin" f
 
+  let atan f = unary "atan" f
+
+  let cosh f = unary "cosh" f
+
+  let sinh f = unary "sinh" f
+
+  let tanh f = unary "tanh" f
+
+  let acosh f = unary "acosh" f
+
+  let asinh f = unary "asinh" f
+
+  let atanh f = unary "atanh" f
+
+  let cbrt f = unary "cbrt" f
+
+  let exp f = unary "exp" f
+
+  let expm1 f = unary "expm1" f
+
+  let log f = unary "log" f
+
+  let log1p f = unary "log1p" f
+
+  let log2 f = unary "log2" f
+
+  let log10 f = unary "log10" f
+
   let binary name x y =
     let* f = register_import ~name (Fun (float_func_type 2)) in
     let* x = x in
@@ -502,6 +591,8 @@ module Math = struct
 
   let atan2 f g = binary "atan2" f g
 
+  let hypot f g = binary "hypot" f g
+
   let power f g = binary "pow" f g
 
   let fmod f g = binary "fmod" f g
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 1f304329a3..974ab560c3 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -31,25 +31,39 @@ module Type = struct
           ; typ = W.Struct [ { mut = false; typ = Value F64 } ]
           })
 
-  let compare_ext_type =
-    register_type "compare_ext" (fun () ->
+  let compare_type =
+    register_type "compare" (fun () ->
         return
           { supertype = None
           ; final = true
           ; typ = W.Func { W.params = [ value; value ]; result = [ I32 ] }
           })
 
+  let hash_type =
+    register_type "hash" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Func { W.params = [ value ]; result = [ I32 ] }
+          })
+
   let custom_operations_type =
     register_type "custom_operations" (fun () ->
-        let* compare_ext = compare_ext_type in
+        let* string = string_type in
+        let* compare = compare_type in
+        let* hash = hash_type in
         return
           { supertype = None
           ; final = true
           ; typ =
               W.Struct
                 [ { mut = false
-                  ; typ = Value (Ref { nullable = false; typ = Type compare_ext })
+                  ; typ = Value (Ref { nullable = false; typ = Type string })
+                  }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = false; typ = Type compare })
                   }
+                ; { mut = false; typ = Value (Ref { nullable = true; typ = Type hash }) }
                 ]
           })
 
@@ -445,6 +459,12 @@ module Memory = struct
     let* e = e in
     return (W.StructNew (ty, [ GlobalGet (V int32_ops); e ]))
 
+  let box_int32 _ _ e = make_int32 ~kind:`Int32 e
+
+  let unbox_int32 e =
+    let* ty = Type.int32_type in
+    wasm_struct_get ty (wasm_cast ty e) 1
+
   let make_int64 e =
     let* custom_operations = Type.custom_operations_type in
     let* int64_ops =
@@ -462,6 +482,12 @@ module Memory = struct
   let unbox_int64 e =
     let* ty = Type.int64_type in
     wasm_struct_get ty (wasm_cast ty e) 1
+
+  let box_nativeint _ _ e = make_int32 ~kind:`Nativeint e
+
+  let unbox_nativeint e =
+    let* ty = Type.int32_type in
+    wasm_struct_get ty (wasm_cast ty e) 1
 end
 
 module Constant = struct
@@ -785,8 +811,40 @@ module Math = struct
 
   let sin f = unary "sin" f
 
+  let tan f = unary "tan" f
+
+  let acos f = unary "acos" f
+
   let asin f = unary "asin" f
 
+  let atan f = unary "atan" f
+
+  let cosh f = unary "cosh" f
+
+  let sinh f = unary "sinh" f
+
+  let tanh f = unary "tanh" f
+
+  let acosh f = unary "acosh" f
+
+  let asinh f = unary "asinh" f
+
+  let atanh f = unary "atanh" f
+
+  let cbrt f = unary "cbrt" f
+
+  let exp f = unary "exp" f
+
+  let expm1 f = unary "expm1" f
+
+  let log f = unary "log" f
+
+  let log1p f = unary "log1p" f
+
+  let log2 f = unary "log2" f
+
+  let log10 f = unary "log10" f
+
   let binary name x y =
     let* f = register_import ~import_module:"Math" ~name (Fun (float_func_type 2)) in
     let* x = x in
@@ -795,6 +853,8 @@ module Math = struct
 
   let atan2 f g = binary "atan2" f g
 
+  let hypot f g = binary "hypot" f g
+
   let power f g = binary "pow" f g
 
   let fmod f g = binary "fmod" f g
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index ffabd1cd0e..ad7b0e886d 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -43,11 +43,36 @@ module Generate (Target : Wa_target_sig.S) = struct
     let* g = Memory.unbox_float g in
     Value.val_int (return (W.BinOp (F64 op, f, g)))
 
+  let int32_bin_op stack_ctx x op f g =
+    let* f = Memory.unbox_int32 f in
+    let* g = Memory.unbox_int32 g in
+    Memory.box_int32 stack_ctx x (return (W.BinOp (I32 op, f, g)))
+
+  let int32_shift_op stack_ctx x op f g =
+    let* f = Memory.unbox_int32 f in
+    let* g = Value.int_val g in
+    Memory.box_int32 stack_ctx x (return (W.BinOp (I32 op, f, g)))
+
   let int64_bin_op stack_ctx x op f g =
     let* f = Memory.unbox_int64 f in
     let* g = Memory.unbox_int64 g in
     Memory.box_int64 stack_ctx x (return (W.BinOp (I64 op, f, g)))
 
+  let int64_shift_op stack_ctx x op f g =
+    let* f = Memory.unbox_int64 f in
+    let* g = Value.int_val g in
+    Memory.box_int64 stack_ctx x (return (W.BinOp (I64 op, f, I64ExtendI32 (S, g))))
+
+  let nativeint_bin_op stack_ctx x op f g =
+    let* f = Memory.unbox_nativeint f in
+    let* g = Memory.unbox_nativeint g in
+    Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 op, f, g)))
+
+  let nativeint_shift_op stack_ctx x op f g =
+    let* f = Memory.unbox_nativeint f in
+    let* g = Value.int_val g in
+    Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 op, f, g)))
+
   let rec translate_expr ctx stack_ctx x e =
     match e with
     | Apply { f; args; exact } when exact || List.length args = 1 ->
@@ -190,6 +215,10 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_mul_float", [ f; g ] -> float_bin_op stack_ctx x Mul f g
         | Extern "caml_div_float", [ f; g ] -> float_bin_op stack_ctx x Div f g
         | Extern "caml_copysign_float", [ f; g ] -> float_bin_op stack_ctx x CopySign f g
+        | Extern "caml_signbit_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            let sign = W.BinOp (F64 CopySign, Const (F64 1.), f) in
+            Value.val_int (return (W.BinOp (F64 Lt, sign, Const (F64 0.))))
         | Extern "caml_neg_float", [ f ] -> float_un_op stack_ctx x Neg f
         | Extern "caml_abs_float", [ f ] -> float_un_op stack_ctx x Abs f
         | Extern "caml_ceil_float", [ f ] -> float_un_op stack_ctx x Ceil f
@@ -211,12 +240,138 @@ module Generate (Target : Wa_target_sig.S) = struct
             Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I32, S)), n)))
         | Extern "caml_cos_float", [ f ] -> float_un_op' stack_ctx x Math.cos f
         | Extern "caml_sin_float", [ f ] -> float_un_op' stack_ctx x Math.sin f
+        | Extern "caml_tan_float", [ f ] -> float_un_op' stack_ctx x Math.tan f
+        | Extern "caml_acos_float", [ f ] -> float_un_op' stack_ctx x Math.acos f
         | Extern "caml_asin_float", [ f ] -> float_un_op' stack_ctx x Math.asin f
+        | Extern "caml_atan_float", [ f ] -> float_un_op' stack_ctx x Math.atan f
         | Extern "caml_atan2_float", [ f; g ] -> float_bin_op' stack_ctx x Math.atan2 f g
+        | Extern "caml_cosh_float", [ f ] -> float_un_op' stack_ctx x Math.cosh f
+        | Extern "caml_sinh_float", [ f ] -> float_un_op' stack_ctx x Math.sinh f
+        | Extern "caml_tanh_float", [ f ] -> float_un_op' stack_ctx x Math.tanh f
+        | Extern "caml_acosh_float", [ f ] -> float_un_op' stack_ctx x Math.acosh f
+        | Extern "caml_asinh_float", [ f ] -> float_un_op' stack_ctx x Math.asinh f
+        | Extern "caml_atanh_float", [ f ] -> float_un_op' stack_ctx x Math.atanh f
+        | Extern "caml_cbrt_float", [ f ] -> float_un_op' stack_ctx x Math.cbrt f
+        | Extern "caml_exp_float", [ f ] -> float_un_op' stack_ctx x Math.exp f
+        | Extern "caml_log_float", [ f ] -> float_un_op' stack_ctx x Math.log f
+        | Extern "caml_expm1_float", [ f ] -> float_un_op' stack_ctx x Math.expm1 f
+        | Extern "caml_log1p_float", [ f ] -> float_un_op' stack_ctx x Math.log1p f
+        | Extern "caml_log2_float", [ f ] -> float_un_op' stack_ctx x Math.log2 f
+        | Extern "caml_log10_float", [ f ] -> float_un_op' stack_ctx x Math.log10 f
         | Extern "caml_power_float", [ f; g ] -> float_bin_op' stack_ctx x Math.power f g
+        | Extern "caml_hypot_float", [ f; g ] -> float_bin_op' stack_ctx x Math.hypot f g
         | Extern "caml_fmod_float", [ f; g ] -> float_bin_op' stack_ctx x Math.fmod f g
+        | Extern "caml_int32_bits_of_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            Memory.box_int32
+              stack_ctx
+              x
+              (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
+        | Extern "caml_int32_float_of_bits", [ i ] ->
+            let* i = Memory.unbox_int64 i in
+            Memory.box_float
+              stack_ctx
+              x
+              (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
+        | Extern "caml_int32_of_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            Memory.box_int32 stack_ctx x (return (W.UnOp (I32 (TruncSatF64 S), f)))
+        | Extern "caml_int32_to_float", [ n ] ->
+            let* n = Memory.unbox_int32 n in
+            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+        | Extern "caml_int32_neg", [ i ] ->
+            let* i = Memory.unbox_int32 i in
+            Memory.box_int32 stack_ctx x (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
+        | Extern "caml_int32_add", [ i; j ] -> int32_bin_op stack_ctx x Add i j
+        | Extern "caml_int32_sub", [ i; j ] -> int32_bin_op stack_ctx x Sub i j
+        | Extern "caml_int32_mul", [ i; j ] -> int32_bin_op stack_ctx x Mul i j
+        | Extern "caml_int32_and", [ i; j ] -> int32_bin_op stack_ctx x And i j
+        | Extern "caml_int32_or", [ i; j ] -> int32_bin_op stack_ctx x Or i j
+        | Extern "caml_int32_xor", [ i; j ] -> int32_bin_op stack_ctx x Xor i j
+        | Extern "caml_int32_div", [ i; j ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            let res = Var.fresh () in
+            (*ZZZ Can we do better?*)
+            let i' = Var.fresh () in
+            let j' = Var.fresh () in
+            seq
+              (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
+               let* () =
+                 if_
+                   { params = []; result = [] }
+                   (let* j = load j' in
+                    return (W.UnOp (I32 Eqz, j)))
+                   (instr (CallInstr (f, [])))
+                   (return ())
+               in
+               let* () = store ~typ:I32 i' (Memory.unbox_int32 i) in
+               if_
+                 { params = []; result = [] }
+                 Arith.(
+                   (let* j = load j' in
+                    return (W.BinOp (I32 Eq, j, Const (I32 (-1l)))))
+                   land let* i = load i' in
+                        return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int))))
+                 (store ~always:true ~typ:I32 res (return (W.Const (I32 Int32.min_int))))
+                 (store
+                    ~always:true
+                    ~typ:I32
+                    res
+                    (let* i = load i' in
+                     let* j = load j' in
+                     return (W.BinOp (I32 (Div S), i, j)))))
+              (Memory.box_int32 stack_ctx x (load res))
+        | Extern "caml_int32_mod", [ i; j ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            let j' = Var.fresh () in
+            seq
+              (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
+               if_
+                 { params = []; result = [] }
+                 (let* j = load j' in
+                  return (W.UnOp (I32 Eqz, j)))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              (let* i = Memory.unbox_int32 i in
+               let* j = load j' in
+               Memory.box_int32 stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
+        | Extern "caml_int32_shift_left", [ i; j ] -> int32_shift_op stack_ctx x Shl i j
+        | Extern "caml_int32_shift_right", [ i; j ] ->
+            int32_shift_op stack_ctx x (Shr S) i j
+        | Extern "caml_int32_shift_right_unsigned", [ i; j ] ->
+            int32_shift_op stack_ctx x (Shr U) i j
+        | Extern "caml_int32_to_int", [ i ] -> Value.val_int (Memory.unbox_int32 i)
+        | Extern "caml_int32_of_int", [ i ] ->
+            Memory.box_int32 stack_ctx x (Value.int_val i)
+        | Extern "caml_int64_bits_of_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            Memory.box_int64 stack_ctx x (return (W.UnOp (I64 ReinterpretF, f)))
+        | Extern "caml_int64_float_of_bits", [ i ] ->
+            let* i = Memory.unbox_int64 i in
+            Memory.box_float stack_ctx x (return (W.UnOp (F64 ReinterpretI, i)))
+        | Extern "caml_int64_of_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            Memory.box_int64 stack_ctx x (return (W.UnOp (I64 (TruncSatF64 S), f)))
+        | Extern "caml_int64_to_float", [ n ] ->
+            let* n = Memory.unbox_int64 n in
+            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I64, S)), n)))
+        | Extern "caml_int64_neg", [ i ] ->
+            let* i = Memory.unbox_int64 i in
+            Memory.box_int64 stack_ctx x (return (W.BinOp (I64 Sub, Const (I64 0L), i)))
         | Extern "caml_int64_add", [ i; j ] -> int64_bin_op stack_ctx x Add i j
+        | Extern "caml_int64_sub", [ i; j ] -> int64_bin_op stack_ctx x Sub i j
         | Extern "caml_int64_mul", [ i; j ] -> int64_bin_op stack_ctx x Mul i j
+        | Extern "caml_int64_and", [ i; j ] -> int64_bin_op stack_ctx x And i j
+        | Extern "caml_int64_or", [ i; j ] -> int64_bin_op stack_ctx x Or i j
+        | Extern "caml_int64_xor", [ i; j ] -> int64_bin_op stack_ctx x Xor i j
         | Extern "caml_int64_div", [ i; j ] ->
             let* f =
               register_import
@@ -272,6 +427,14 @@ module Generate (Target : Wa_target_sig.S) = struct
               (let* i = Memory.unbox_int64 i in
                let* j = load j' in
                Memory.box_int64 stack_ctx x (return (W.BinOp (I64 (Rem S), i, j))))
+        | Extern "caml_int64_shift_left", [ i; j ] -> int64_shift_op stack_ctx x Shl i j
+        | Extern "caml_int64_shift_right", [ i; j ] ->
+            int64_shift_op stack_ctx x (Shr S) i j
+        | Extern "caml_int64_shift_right_unsigned", [ i; j ] ->
+            int64_shift_op stack_ctx x (Shr U) i j
+        | Extern "caml_int64_to_int", [ i ] ->
+            let* i = Memory.unbox_int64 i in
+            Value.val_int (return (W.I32WrapI64 i))
         | Extern "caml_int64_of_int", [ i ] ->
             let* i = Value.int_val i in
             Memory.box_int64
@@ -281,6 +444,113 @@ module Generate (Target : Wa_target_sig.S) = struct
                  (match i with
                  | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i))
                  | _ -> W.I64ExtendI32 (S, i)))
+        | Extern "caml_int64_to_int32", [ i ] ->
+            let* i = Memory.unbox_int64 i in
+            Memory.box_int32 stack_ctx x (return (W.I32WrapI64 i))
+        | Extern "caml_int64_of_int32", [ i ] ->
+            let* i = Memory.unbox_int32 i in
+            Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
+        | Extern "caml_int64_to_nativeint", [ i ] ->
+            let* i = Memory.unbox_int64 i in
+            Memory.box_nativeint stack_ctx x (return (W.I32WrapI64 i))
+        | Extern "caml_int64_of_nativeint", [ i ] ->
+            let* i = Memory.unbox_nativeint i in
+            Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
+        | Extern "caml_nativeint_bits_of_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            Memory.box_nativeint
+              stack_ctx
+              x
+              (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
+        | Extern "caml_nativeint_float_of_bits", [ i ] ->
+            let* i = Memory.unbox_int64 i in
+            Memory.box_float
+              stack_ctx
+              x
+              (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
+        | Extern "caml_nativeint_of_float", [ f ] ->
+            let* f = Memory.unbox_float f in
+            Memory.box_nativeint stack_ctx x (return (W.UnOp (I32 (TruncSatF64 S), f)))
+        | Extern "caml_nativeint_to_float", [ n ] ->
+            let* n = Memory.unbox_nativeint n in
+            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+        | Extern "caml_nativeint_neg", [ i ] ->
+            let* i = Memory.unbox_nativeint i in
+            Memory.box_nativeint
+              stack_ctx
+              x
+              (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
+        | Extern "caml_nativeint_add", [ i; j ] -> nativeint_bin_op stack_ctx x Add i j
+        | Extern "caml_nativeint_sub", [ i; j ] -> nativeint_bin_op stack_ctx x Sub i j
+        | Extern "caml_nativeint_mul", [ i; j ] -> nativeint_bin_op stack_ctx x Mul i j
+        | Extern "caml_nativeint_and", [ i; j ] -> nativeint_bin_op stack_ctx x And i j
+        | Extern "caml_nativeint_or", [ i; j ] -> nativeint_bin_op stack_ctx x Or i j
+        | Extern "caml_nativeint_xor", [ i; j ] -> nativeint_bin_op stack_ctx x Xor i j
+        | Extern "caml_nativeint_div", [ i; j ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            let res = Var.fresh () in
+            (*ZZZ Can we do better?*)
+            let i' = Var.fresh () in
+            let j' = Var.fresh () in
+            seq
+              (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
+               let* () =
+                 if_
+                   { params = []; result = [] }
+                   (let* j = load j' in
+                    return (W.UnOp (I32 Eqz, j)))
+                   (instr (CallInstr (f, [])))
+                   (return ())
+               in
+               let* () = store ~typ:I32 i' (Memory.unbox_nativeint i) in
+               if_
+                 { params = []; result = [] }
+                 Arith.(
+                   (let* j = load j' in
+                    return (W.BinOp (I32 Eq, j, Const (I32 (-1l)))))
+                   land let* i = load i' in
+                        return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int))))
+                 (store ~always:true ~typ:I32 res (return (W.Const (I32 Int32.min_int))))
+                 (store
+                    ~always:true
+                    ~typ:I32
+                    res
+                    (let* i = load i' in
+                     let* j = load j' in
+                     return (W.BinOp (I32 (Div S), i, j)))))
+              (Memory.box_nativeint stack_ctx x (load res))
+        | Extern "caml_nativeint_mod", [ i; j ] ->
+            let* f =
+              register_import
+                ~name:"caml_raise_zero_divide"
+                (Fun { params = []; result = [] })
+            in
+            let j' = Var.fresh () in
+            seq
+              (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
+               if_
+                 { params = []; result = [] }
+                 (let* j = load j' in
+                  return (W.UnOp (I32 Eqz, j)))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              (let* i = Memory.unbox_nativeint i in
+               let* j = load j' in
+               Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
+        | Extern "caml_nativeint_shift_left", [ i; j ] ->
+            nativeint_shift_op stack_ctx x Shl i j
+        | Extern "caml_nativeint_shift_right", [ i; j ] ->
+            nativeint_shift_op stack_ctx x (Shr S) i j
+        | Extern "caml_nativeint_shift_right_unsigned", [ i; j ] ->
+            nativeint_shift_op stack_ctx x (Shr U) i j
+        | Extern "caml_nativeint_to_int", [ i ] ->
+            Value.val_int (Memory.unbox_nativeint i)
+        | Extern "caml_nativeint_of_int", [ i ] ->
+            Memory.box_nativeint stack_ctx x (Value.int_val i)
         | Extern "caml_int_compare", [ i; j ] ->
             Value.val_int
               Arith.(
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 1c04da719d..6985f6e1b9 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -94,9 +94,17 @@ module type S = sig
 
     val unbox_float : expression -> expression
 
+    val box_int32 : Stack.ctx -> Code.Var.t -> expression -> expression
+
+    val unbox_int32 : expression -> expression
+
     val box_int64 : Stack.ctx -> Code.Var.t -> expression -> expression
 
     val unbox_int64 : expression -> expression
+
+    val box_nativeint : Stack.ctx -> Code.Var.t -> expression -> expression
+
+    val unbox_nativeint : expression -> expression
   end
 
   module Value : sig
@@ -193,10 +201,44 @@ module type S = sig
 
     val sin : expression -> expression
 
+    val tan : expression -> expression
+
+    val acos : expression -> expression
+
     val asin : expression -> expression
 
+    val atan : expression -> expression
+
     val atan2 : expression -> expression -> expression
 
+    val cosh : expression -> expression
+
+    val sinh : expression -> expression
+
+    val tanh : expression -> expression
+
+    val acosh : expression -> expression
+
+    val asinh : expression -> expression
+
+    val atanh : expression -> expression
+
+    val cbrt : expression -> expression
+
+    val exp : expression -> expression
+
+    val log : expression -> expression
+
+    val expm1 : expression -> expression
+
+    val log1p : expression -> expression
+
+    val log2 : expression -> expression
+
+    val log10 : expression -> expression
+
+    val hypot : expression -> expression -> expression
+
     val power : expression -> expression -> expression
 
     val fmod : expression -> expression -> expression
diff --git a/runtime/wasm/index.js b/runtime/wasm/index.js
index 984c163a28..cf1415e24f 100644
--- a/runtime/wasm/index.js
+++ b/runtime/wasm/index.js
@@ -5,9 +5,15 @@
     var caml_callback;
 
     let math =
-        {cos:Math.cos, sin:Math.sin, asin:Math.asin, atan2:Math.atan2,
-         pow:Math.pow, fmod:(x, y) => x%y,
-         log:(x)=>console.log('ZZZZZ', x)}
+        {cos:Math.cos, sin:Math.sin, tan:Math.tan,
+         acos:Math.acos, asin:Math.asin, atan:Math.atan,
+         cosh:Math.cosh, sinh:Math.sinh, tanh:Math.tanh,
+         acosh:Math.acosh, asinh:Math.asinh, atanh:Math.atanh,
+         cbrt:Math.cbrt, exp:Math.exp, expm1:Math.expm1,
+         log:Math.log, log1p:Math.log1p, log2:Math.log2, log10:Math.log10,
+         atan2:Math.atan2, hypot:Math.hypot, pow:Math.pow,
+         fmod:(x, y) => x%y}
+
     let bindings =
         {identity:(x)=>x,
          from_bool:(x)=>!!x,
@@ -31,7 +37,8 @@
              for (var i = 0; i < len; i++) args[i] = arguments[i];
              return caml_callback(f, arity, args);
          },
-         format:(f)=>""+f
+         format:(f)=>""+f,
+         log:(x)=>console.log('ZZZZZ', x)
         }
     const runtimeModule =
           await WebAssembly.instantiateStreaming(runtime,
diff --git a/runtime/wasm/run.js b/runtime/wasm/run.js
index 95e6f46ddd..9d3a70ad77 100755
--- a/runtime/wasm/run.js
+++ b/runtime/wasm/run.js
@@ -10,9 +10,15 @@
     var caml_callback;
 
     let math =
-        {cos:Math.cos, sin:Math.sin, asin:Math.asin, atan2:Math.atan2,
-         pow:Math.pow, fmod:(x, y) => x%y,
-         log:(x)=>console.log('ZZZZZ', x)}
+        {cos:Math.cos, sin:Math.sin, tan:Math.tan,
+         acos:Math.acos, asin:Math.asin, atan:Math.atan,
+         cosh:Math.cosh, sinh:Math.sinh, tanh:Math.tanh,
+         acosh:Math.acosh, asinh:Math.asinh, atanh:Math.atanh,
+         cbrt:Math.cbrt, exp:Math.exp, expm1:Math.expm1,
+         log:Math.log, log1p:Math.log1p, log2:Math.log2, log10:Math.log10,
+         atan2:Math.atan2, hypot:Math.hypot, pow:Math.pow,
+         fmod:(x, y) => x%y}
+
     let bindings =
         {identity:(x)=>x,
          from_bool:(x)=>!!x,
@@ -36,7 +42,8 @@
              for (var i = 0; i < len; i++) args[i] = arguments[i];
              return caml_callback(f, arity, args);
          },
-         format:(f)=>""+f
+         format:(f)=>""+f,
+         log:(x)=>console.log('ZZZZZ', x)
         }
     const runtimeModule =
           await WebAssembly.instantiate(await runtime,
@@ -47,7 +54,7 @@
     const wasmModule =
           await WebAssembly.instantiate(await code,
                                         {env:runtimeModule.instance.exports,
-                                         Math:math})
+                                         Math:math,bindings:bindings})
     try {
         wasmModule.instance.exports._initialize()
     } catch (e) {
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index 0c1a958861..f677825643 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -2,8 +2,8 @@
    (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
    (tag $ocaml_exit (export "ocaml_exit") (param i32))
 
-   (import "Math" "log" (func $log (param i32)))
-   (import "Math" "log" (func $log_js (param anyref)))
+   (import "bindings" "log" (func $log (param i32)))
+   (import "bindings" "log" (func $log_js (param anyref)))
 
    (type $float (struct (field f64)))
 
@@ -15,11 +15,17 @@
 
    (type $closure (struct (field i32) (field (ref $function_1))))
 
-   (type $compare_ext (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
 
    (type $custom_operations
       (struct
-         (field (ref $compare_ext))
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
          ;; ZZZ
       ))
 
@@ -46,6 +52,14 @@
          (array.new_fixed $block
             (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
 
+   (global $FAILURE_EXN i32 (i32.const 2))
+
+   (func $caml_failwith (param $arg (ref eq))
+       (return_call $caml_raise_with_arg
+           (array.get $block (global.get $caml_global_data)
+              (global.get $FAILURE_EXN))
+           (local.get 0)))
+
    (global $INVALID_EXN i32 (i32.const 3))
 
    (func $caml_invalid_argument (param $arg (ref eq))
@@ -68,8 +82,73 @@
          (array.get $block (global.get $caml_global_data)
                     (global.get $ZERO_DIVIDE_EXN))))
 
+   (func (export "caml_bswap16") (param (ref eq)) (result (ref eq))
+      (local $x i32)
+      (local.set $x (i31.get_s (ref.cast i31 (local.get 0))))
+      (i31.new
+         (i32.or
+            (i32.shl (i32.and (local.get $x) (i32.const 0xFF)) (i32.const 8))
+            (i32.shr_u (i32.and (local.get $x) (i32.const 0x00FF))
+               (i32.const 8)))))
+
+   (global $int32_ops (export "int32_ops") (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string (i32.const 95) (i32.const 105)) ;; "_i"
+         (ref.func $int32_cmp)
+         (ref.func $int32_hash)))
+
+   (type $int32
+      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
+
+   (func $int32_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
+      (local $i1 i32) (local $i2 i32)
+      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get $v1))))
+      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get $v2))))
+      (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
+               (i32.lt_s (local.get $i1) (local.get $i2))))
+
+   (func $int32_hash (param $v (ref eq)) (result i32)
+      (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+
+   (func $caml_copy_int32 (param $i i32) (result (ref eq))
+      (struct.new $int32 (global.get $int32_ops) (local.get $i)))
+
+   (func (export "caml_int32_bswap") (param (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local.set $i (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
+      (return_call $caml_copy_int32
+         (i32.or
+            (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
+                      (i32.const 8))
+            (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00))
+                      (i32.const 8)))))
+
+   (global $INT32_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Int32.of_string"
+         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 51)
+         (i32.const 50) (i32.const 46) (i32.const 111) (i32.const 102)
+         (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
+         (i32.const 105) (i32.const 110) (i32.const 103)))
+
+   (func (export "caml_int32_of_string") (param $v (ref eq)) (result (ref eq))
+      (return_call $caml_copy_int32
+         (call $parse_int
+            (local.get $v) (i32.const 32) (global.get $INT32_ERRMSG))))
+
+   (export "caml_nativeint_compare" (func $caml_int32_compare))
+   (func $caml_int32_compare (export "caml_int32_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $i1 i32) (local $i2 i32)
+      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
+      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get 1))))
+      (i31.new (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
+                        (i32.lt_s (local.get $i1) (local.get $i2)))))
+
    (global $int64_ops (export "int64_ops") (ref $custom_operations)
-      (struct.new $custom_operations (ref.func $int64_cmp)))
+      (struct.new $custom_operations
+         (array.new_fixed $string (i32.const 95) (i32.const 106)) ;; "_j"
+         (ref.func $int64_cmp)
+         (ref.func $int64_hash)))
 
    (type $int64
       (sub $custom (struct (field (ref $custom_operations)) (field i64))))
@@ -81,30 +160,129 @@
       (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
                (i64.lt_s (local.get $i1) (local.get $i2))))
 
+   (func $int64_hash (param $v (ref eq)) (result i32)
+      (local $i i64)
+      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+      (i32.xor
+         (i32.wrap_i64 (local.get $i))
+         (i32.wrap_i64 (i64.shr_u (local.get $i) (i64.const 32)))))
+
    (func $caml_copy_int64 (param $i i64) (result (ref eq))
       (struct.new $int64 (global.get $int64_ops) (local.get $i)))
 
+   (func (export "caml_int64_bswap") (param (ref eq)) (result (ref eq))
+      (local $i i64)
+      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
+      (return_call $caml_copy_int64
+         (i64.or
+            (i64.or
+               (i64.rotr (i64.and (local.get $i) (i64.const 0x000000FF000000FF))
+                         (i64.const 8))
+               (i64.rotr (i64.and (local.get $i) (i64.const 0x0000FF000000FF00))
+                         (i64.const 24)))
+            (i64.or
+               (i64.rotl (i64.and (local.get $i) (i64.const 0x00FF000000FF0000))
+                         (i64.const 24))
+               (i64.rotl (i64.and (local.get $i) (i64.const 0xFF000000FF000000))
+                         (i64.const 8))))))
+
+   (func (export "caml_int64_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $i1 i64) (local $i2 i64)
+      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
+      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get 1))))
+      (i31.new (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
+                        (i64.lt_s (local.get $i1) (local.get $i2)))))
+
+   (global $INT64_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Int64.of_string"
+         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 54)
+         (i32.const 52) (i32.const 46) (i32.const 111) (i32.const 102)
+         (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
+         (i32.const 105) (i32.const 110) (i32.const 103)))
+
    (func (export "caml_int64_of_string") (param $v (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $i i32) (local $len i32)
-      (local $res i64)
+      (local $s (ref $string))
+      (local $i i32) (local $len i32) (local $d i32) (local $c i32)
+      (local $signedness i32) (local $sign i32) (local $base i32)
+      (local $res i64) (local $threshold i64)
+      (local $t (i32 i32 i32 i32))
       (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $res (i64.const 0))
-      (local.set $i (i32.const 0))
       (local.set $len (array.len (local.get $s)))
-      ;; ZZZ validation / negative numbers / ...
+      (local.set $t (call $parse_sign_and_base (local.get $s)))
+      (local.set $i (tuple.extract 0 (local.get $t)))
+      (local.set $signedness (tuple.extract 1 (local.get $t)))
+      (local.set $sign (tuple.extract 2 (local.get $t)))
+      (local.set $base (tuple.extract 3 (local.get $t)))
+      (local.set $threshold
+         (i64.div_u (i64.const -1) (i64.extend_i32_u (local.get $base))))
+      (local.set $d
+         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
+      (if (i32.ge_u (local.get $d) (local.get $base))
+         (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+      (local.set $res (i64.extend_i32_u (local.get $d)))
       (loop $loop
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
          (if (i32.lt_s (local.get $i) (local.get $len))
             (then
+               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
+               (local.set $d (call $parse_digit (local.get $c)))
+               (if (i32.ge_u (local.get $d) (local.get $base))
+                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+               (if (i64.gt_u (local.get $res) (local.get $threshold))
+                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
                (local.set $res
-                  (i64.add (i64.mul (local.get $res) (i64.const 10))
-                     (i64.extend_i32_s
-                        (i32.sub
-                           (array.get_u $string (local.get $s) (local.get $i))
-                           (i32.const 48)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (i64.add (i64.mul (local.get $res)
+                              (i64.extend_i32_u (local.get $base)))
+                           (i64.extend_i32_u (local.get $d))))
+               (if (i64.lt_u (local.get $res) (i64.extend_i32_u (local.get $d)))
+                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
                (br $loop))))
+      (if (local.get $signedness)
+         (then
+            (if (i32.gt_s (local.get $sign) (i32.const 0))
+               (then
+                  (if (i64.ge_u (local.get $res)
+                                (i64.shl (i64.const 1) (i64.const 63)))
+                     (then (call $caml_failwith (global.get $INT64_ERRMSG)))))
+               (else
+                  (if (i64.gt_u (local.get $res)
+                                (i64.shl (i64.const 1) (i64.const 63)))
+                     (then
+                        (call $caml_failwith (global.get $INT64_ERRMSG))))))))
+      (if (i32.lt_s (local.get $sign) (i32.const 0))
+         (then (local.set $res (i64.sub (i64.const 0) (local.get $res)))))
       (return_call $caml_copy_int64 (local.get $res)))
 
+   (func (export "caml_int64_create_lo_mi_hi")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ does not really make sense
+      (call $log_js (string.const "caml_int64_create_lo_mi_hi"))
+      (i31.new (i32.const 0)))
+
+   (global $nativeint_ops (export "nativeint_ops") (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string (i32.const 95) (i32.const 110)) ;; "_n"
+         (ref.func $int32_cmp)
+         (ref.func $int32_hash)))
+
+   (func $caml_copy_nativeint (param $i i32) (result (ref eq))
+      (struct.new $int32 (global.get $nativeint_ops) (local.get $i)))
+
+   (global $NATIVEINT_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Nativeint.of_string"
+         (i32.const 78) (i32.const 97) (i32.const 116) (i32.const 105)
+         (i32.const 118) (i32.const 101) (i32.const 46) (i32.const 111)
+         (i32.const 102) (i32.const 95) (i32.const 115) (i32.const 116)
+         (i32.const 114) (i32.const 105) (i32.const 110) (i32.const 103)))
+
+   (func (export "caml_nativeint_of_string")
+      (param $v (ref eq)) (result (ref eq))
+      (return_call $caml_copy_int32
+         (call $parse_int
+            (local.get $v) (i32.const 32) (global.get $NATIVEINT_ERRMSG))))
+
    (data $Array_make "Array.make")
 
    (func (export "caml_make_vect")
@@ -152,26 +330,142 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_int_of_string")
-      (param $v (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $i i32) (local $len i32)
-      (local $res i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $res (i32.const 0))
+   (func $parse_sign_and_base (param $s (ref $string)) (result i32 i32 i32 i32)
+      (local $i i32) (local $len i32) (local $c i32)
+      (local $signedness i32) (local $sign i32) (local $base i32)
       (local.set $i (i32.const 0))
       (local.set $len (array.len (local.get $s)))
-      ;; ZZZ validation / negative numbers / ...
+      (local.set $signedness (i32.const 1))
+      (local.set $sign (i32.const 1))
+      (local.set $base (i32.const 10))
+      (if (i32.eqz (local.get $len))
+         (then
+            (local.set $c (array.get $string (local.get $s) (i32.const 0)))
+            (if (i32.eq (local.get $c) (i32.const 45))
+               (then
+                  (local.set $sign (i32.const -1))
+                  (local.set $i (i32.const 1))))
+               (else (if (i32.eq (local.get $c) (i32.const 43))
+                  (then (local.set $i (i32.const 1)))))))
+      (if (i32.lt_s (i32.add (local.get $i) (i32.const 1)) (local.get $len))
+         (then (if (i32.eq (array.get $string (local.get $s) (local.get $i))
+                           (i32.const 48))
+            (then
+               (local.set $c
+                  (array.get $string (local.get $s)
+                     (i32.add (local.get $i) (i32.const 1))))
+               (if (i32.or (i32.eq (local.get $c) (i32.const 88))
+                           (i32.eq (local.get $c) (i32.const 120)))
+                  (then
+                     (local.set $base (i32.const 16))
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
+               (else (if (i32.or (i32.eq (local.get $c) (i32.const 79))
+                                 (i32.eq (local.get $c) (i32.const 111)))
+                  (then
+                     (local.set $base (i32.const 8))
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
+               (else (if (i32.or (i32.eq (local.get $c) (i32.const 66))
+                                 (i32.eq (local.get $c) (i32.const 98)))
+                  (then
+                     (local.set $base (i32.const 2))
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
+               (else (if (i32.or (i32.eq (local.get $c) (i32.const 85))
+                                 (i32.eq (local.get $c) (i32.const 117)))
+                  (then
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i)
+                        (i32.const 2)))))))))))))))
+      (tuple.make
+         (local.get $i) (local.get $signedness) (local.get $sign)
+         (local.get $base)))
+
+   (func $parse_digit (param $c i32) (result i32)
+      (if (i32.and (i32.ge_u (local.get $c) (i32.const 48))
+                   (i32.le_u (local.get $c) (i32.const 57)))
+         (then (return (i32.sub (local.get $c) (i32.const 48)))))
+      (if (i32.and (i32.ge_u (local.get $c) (i32.const 65))
+                   (i32.le_u (local.get $c) (i32.const 90)))
+         (then (return (i32.sub (local.get $c) (i32.const 55)))))
+      (if (i32.and (i32.ge_u (local.get $c) (i32.const 97))
+                   (i32.le_u (local.get $c) (i32.const 122)))
+         (then (return (i32.sub (local.get $c) (i32.const 87)))))
+      (return (i32.const -1)))
+
+   (func $parse_int
+      (param $v (ref eq)) (param $nbits i32) (param $errmsg (ref $string))
+      (result i32)
+      (local $s (ref $string))
+      (local $i i32) (local $len i32) (local $d i32) (local $c i32)
+      (local $signedness i32) (local $sign i32) (local $base i32)
+      (local $res i32) (local $threshold i32)
+      (local $t (i32 i32 i32 i32))
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $len (array.len (local.get $s)))
+      (local.set $t (call $parse_sign_and_base (local.get $s)))
+      (local.set $i (tuple.extract 0 (local.get $t)))
+      (local.set $signedness (tuple.extract 1 (local.get $t)))
+      (local.set $sign (tuple.extract 2 (local.get $t)))
+      (local.set $base (tuple.extract 3 (local.get $t)))
+      (local.set $threshold (i32.div_u (i32.const -1) (local.get $base)))
+      (local.set $d
+         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
+      (if (i32.ge_u (local.get $d) (local.get $base))
+         (then (call $caml_failwith (local.get $errmsg))))
+      (local.set $res (local.get $d))
       (loop $loop
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
          (if (i32.lt_s (local.get $i) (local.get $len))
             (then
+               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
+               (local.set $d (call $parse_digit (local.get $c)))
+               (if (i32.ge_u (local.get $d) (local.get $base))
+                  (then (call $caml_failwith (local.get $errmsg))))
+               (if (i32.gt_u (local.get $res) (local.get $threshold))
+                  (then (call $caml_failwith (local.get $errmsg))))
                (local.set $res
-                  (i32.add (i32.mul (local.get $res) (i32.const 10))
-                     (i32.sub
-                        (array.get_u $string (local.get $s) (local.get $i))
-                        (i32.const 48))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (i32.add (i32.mul (local.get $res) (local.get $base))
+                           (local.get $d)))
+               (if (i32.lt_u (local.get $res) (local.get $d))
+                  (then (call $caml_failwith (local.get $errmsg))))
                (br $loop))))
-      (i31.new (local.get $res)))
+      (if (local.get $signedness)
+         (then
+            (local.set $threshold
+               (i32.shl (i32.const 1)
+                  (i32.sub (local.get $nbits) (i32.const 1))))
+            (if (i32.gt_s (local.get $sign) (i32.const 0))
+               (then
+                  (if (i32.ge_u (local.get $res) (local.get $threshold))
+                     (then (call $caml_failwith (local.get $errmsg)))))
+               (else
+                  (if (i32.gt_u (local.get $res) (local.get $threshold))
+                     (then (call $caml_failwith (local.get $errmsg)))))))
+         (else
+            (if (i32.and
+                   (i32.lt_u (local.get $nbits) (i32.const 32))
+                   (i32.ge_u (local.get $res)
+                     (i32.shl (i32.const 1) (local.get $nbits))))
+               (then (call $caml_failwith (local.get $errmsg))))))
+      (if (i32.lt_s (local.get $sign) (i32.const 0))
+         (then (local.set $res (i32.sub (i32.const 0) (local.get $res)))))
+      (local.get $res))
+
+   (global $INT_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Int.of_string"
+         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 46)
+         (i32.const 111) (i32.const 102) (i32.const 95) (i32.const 115)
+         (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110)
+         (i32.const 103)))
+
+   (func (export "caml_int_of_string")
+      (param $v (ref eq)) (result (ref eq))
+      (i31.new
+         (call $parse_int
+            (local.get $v) (i32.const 31) (global.get $INT_ERRMSG))))
 
    (func (export "caml_sys_exit") (param (ref eq)) (result (ref eq))
       (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get 0)))))
@@ -693,9 +987,9 @@
                   ;; ZZZ compare types
                   ;; ZZZ abstract value?
                   (local.set $res
-                     (call_ref $compare_ext
+                     (call_ref $value->value->int
                         (local.get $v1) (local.get $v2)
-                        (struct.get $custom_operations 0
+                        (struct.get $custom_operations 1
                            (struct.get $custom 0 (local.get $c1)))
                         ))
                   (br_if $next_item (i32.eqz (local.get $res)))
@@ -806,7 +1100,12 @@
 
    (global $bigarray_ops (ref $custom_operations)
       ;; ZZZ
-      (struct.new $custom_operations (ref.func $int64_cmp)))
+      (struct.new $custom_operations
+         (array.new_fixed $string ;; "_bigarr02"
+            (i32.const 95) (i32.const 98) (i32.const 105) (i32.const 103)
+            (i32.const 97) (i32.const 114) (i32.const 114) (i32.const 48)
+            (i32.const 50))
+         (ref.func $int64_cmp) (ref.func $int64_hash)))
 
    (type $bigarray
       (sub $custom

From 0c6d23fa1cda2707cd810eb58661626fdf4b89ba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 15:57:51 +0200
Subject: [PATCH 038/481] No longer include arity in function closure

---
 compiler/lib/wasm/wa_gc_target.ml | 157 +++++++++++++++---------------
 runtime/wasm/runtime.wat          |   4 +-
 2 files changed, 82 insertions(+), 79 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 974ab560c3..372b152551 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -4,6 +4,8 @@ open Wa_code_generation
 
 type expression = Wa_ast.expression Wa_code_generation.t
 
+let include_closure_arity = false
+
 module Type = struct
   let value = W.Ref { nullable = false; typ = Eq }
 
@@ -120,20 +122,21 @@ module Type = struct
     register_type (Printf.sprintf "function_%d" n) (fun () ->
         return { supertype = None; final = true; typ = W.Func (func_type n) })
 
+  let closure_common_fields =
+    let* fun_ty = function_type 1 in
+    return
+      (let function_pointer =
+         [ { W.mut = false; typ = W.Value (Ref { nullable = false; typ = Type fun_ty }) }
+         ]
+       in
+       if include_closure_arity
+       then { W.mut = false; typ = W.Value I32 } :: function_pointer
+       else function_pointer)
+
   let closure_type_1 =
     register_type "closure" (fun () ->
-        let* fun_ty = function_type 1 in
-        return
-          { supertype = None
-          ; final = false
-          ; typ =
-              W.Struct
-                [ { mut = false; typ = Value I32 }
-                ; { mut = false
-                  ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
-                  }
-                ]
-          })
+        let* fields = closure_common_fields in
+        return { supertype = None; final = false; typ = W.Struct fields })
 
   let closure_type arity =
     if arity = 1
@@ -141,27 +144,24 @@ module Type = struct
     else
       register_type (Printf.sprintf "closure_%d" arity) (fun () ->
           let* cl_typ = closure_type_1 in
-          let* fun_ty = function_type 1 in
+          let* common = closure_common_fields in
           let* fun_ty' = function_type arity in
           return
             { supertype = Some cl_typ
             ; final = false
             ; typ =
                 W.Struct
-                  [ { mut = false; typ = Value I32 }
-                  ; { mut = false
-                    ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
-                    }
-                  ; { mut = false
-                    ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
-                    }
-                  ]
+                  (common
+                  @ [ { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                      }
+                    ])
             })
 
   let env_type ~arity n =
     register_type (Printf.sprintf "env_%d_%d" arity n) (fun () ->
         let* cl_typ = closure_type arity in
-        let* fun_ty = function_type 1 in
+        let* common = closure_common_fields in
         let* fun_ty' = function_type arity in
         return
           { supertype = Some cl_typ
@@ -169,21 +169,13 @@ module Type = struct
           ; typ =
               W.Struct
                 ((if arity = 1
-                  then
-                    [ { W.mut = false; typ = W.Value I32 }
-                    ; { mut = false
-                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
-                      }
-                    ]
+                  then common
                   else
-                    [ { mut = false; typ = Value I32 }
-                    ; { mut = false
-                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
-                      }
-                    ; { mut = false
-                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
-                      }
-                    ])
+                    common
+                    @ [ { mut = false
+                        ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                        }
+                      ])
                 @ List.init
                     ~f:(fun _ ->
                       { W.mut = false
@@ -214,7 +206,7 @@ module Type = struct
       (Printf.sprintf "closure_rec_%d_%d_%d" arity function_count free_variable_count)
       (fun () ->
         let* cl_typ = closure_type arity in
-        let* fun_ty = function_type 1 in
+        let* common = closure_common_fields in
         let* fun_ty' = function_type arity in
         let* env_ty = rec_env_type ~function_count ~free_variable_count in
         return
@@ -223,21 +215,13 @@ module Type = struct
           ; typ =
               W.Struct
                 ((if arity = 1
-                  then
-                    [ { W.mut = false; typ = W.Value I32 }
-                    ; { mut = false
-                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
-                      }
-                    ]
+                  then common
                   else
-                    [ { mut = false; typ = Value I32 }
-                    ; { mut = false
-                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
-                      }
-                    ; { mut = false
-                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
-                      }
-                    ])
+                    common
+                    @ [ { mut = false
+                        ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                        }
+                      ])
                 @ [ { W.mut = false
                     ; typ = W.Value (Ref { nullable = false; typ = Type env_ty })
                     }
@@ -246,23 +230,20 @@ module Type = struct
 
   let rec curry_type arity m =
     register_type (Printf.sprintf "curry_%d_%d" arity m) (fun () ->
-        let* cl_typ = closure_type 1 in
-        let* fun_ty = function_type 1 in
+        let* cl_typ = if m = 2 then closure_type 1 else closure_type_1 in
+        let* common = closure_common_fields in
         let* cl_ty = if m = arity then closure_type arity else curry_type arity (m + 1) in
         return
           { supertype = Some cl_typ
           ; final = true
           ; typ =
               W.Struct
-                [ { W.mut = false; typ = W.Value I32 }
-                ; { mut = false
-                  ; typ = Value (Ref { nullable = false; typ = Type fun_ty })
-                  }
-                ; { mut = false
-                  ; typ = Value (Ref { nullable = false; typ = Type cl_ty })
-                  }
-                ; { W.mut = false; typ = Value value }
-                ]
+                (common
+                @ [ { mut = false
+                    ; typ = Value (Ref { nullable = false; typ = Type cl_ty })
+                    }
+                  ; { W.mut = false; typ = Value value }
+                  ])
           })
 end
 
@@ -407,11 +388,14 @@ module Memory = struct
 
   let set_field e idx e' = wasm_array_set e (Arith.const (Int32.of_int (idx + 1))) e'
 
+  let env_start arity =
+    (if include_closure_arity then 1 else 0) + if arity = 1 then 1 else 2
+
   let load_function_pointer ~arity ?(skip_cast = false) closure =
     let* ty = Type.closure_type arity in
     let* fun_ty = Type.function_type arity in
     let casted_closure = if skip_cast then closure else wasm_cast ty closure in
-    let* e = wasm_struct_get ty casted_closure (if arity = 1 then 1 else 2) in
+    let* e = wasm_struct_get ty casted_closure (env_start arity - 1) in
     return (`Ref fun_ty, e)
 
   let check_function_arity f arity if_match if_mismatch =
@@ -628,9 +612,12 @@ module Closure = struct
           { mut = false; typ = Type.value }
           (W.StructNew
              ( typ
-             , if arity = 1
-               then [ Const (I32 1l); RefFunc f ]
-               else [ Const (I32 (Int32.of_int arity)); RefFunc curry_fun; RefFunc f ] ))
+             , let code_pointers =
+                 if arity = 1 then [ W.RefFunc f ] else [ RefFunc curry_fun; RefFunc f ]
+               in
+               if include_closure_arity
+               then Const (I32 (Int32.of_int arity)) :: code_pointers
+               else code_pointers ))
       in
       return (W.GlobalGet (V name))
     else
@@ -643,9 +630,14 @@ module Closure = struct
           return
             (W.StructNew
                ( typ
-               , (if arity = 1
-                  then [ W.Const (I32 1l); RefFunc f ]
-                  else [ Const (I32 (Int32.of_int arity)); RefFunc curry_fun; RefFunc f ])
+               , (let code_pointers =
+                    if arity = 1
+                    then [ W.RefFunc f ]
+                    else [ RefFunc curry_fun; RefFunc f ]
+                  in
+                  if include_closure_arity
+                  then W.Const (I32 (Int32.of_int arity)) :: code_pointers
+                  else code_pointers)
                  @ l ))
       | (g, _) :: _ as functions ->
           let function_count = List.length functions in
@@ -676,10 +668,14 @@ module Closure = struct
             return
               (W.StructNew
                  ( typ
-                 , (if arity = 1
-                    then [ W.Const (I32 1l); RefFunc f ]
-                    else
-                      [ Const (I32 (Int32.of_int arity)); RefFunc curry_fun; RefFunc f ])
+                 , (let code_pointers =
+                      if arity = 1
+                      then [ W.RefFunc f ]
+                      else [ RefFunc curry_fun; RefFunc f ]
+                    in
+                    if include_closure_arity
+                    then W.Const (I32 (Int32.of_int arity)) :: code_pointers
+                    else code_pointers)
                    @ [ env ] ))
           in
           if is_last_fun functions f
@@ -711,7 +707,7 @@ module Closure = struct
       let free_variables = get_free_variables ~context info in
       let free_variable_count = List.length free_variables in
       let arity = List.assoc f info.functions in
-      let offset = if arity = 1 then 2 else 3 in
+      let offset = Memory.env_start arity in
       match info.Wa_closure_conversion.functions with
       | [ _ ] ->
           let* typ = Type.env_type ~arity free_variable_count in
@@ -753,7 +749,13 @@ module Closure = struct
     in
     let* closure = Memory.wasm_cast cl_ty (load closure) in
     let* arg = load arg in
-    return (W.StructNew (ty, [ Const (I32 1l); RefFunc f; closure; arg ]))
+    let closure_contents = [ W.RefFunc f; closure; arg ] in
+    return
+      (W.StructNew
+         ( ty
+         , if include_closure_arity
+           then Const (I32 1l) :: closure_contents
+           else closure_contents ))
 
   let curry_load ~arity m closure =
     let m = m + 1 in
@@ -762,9 +764,10 @@ module Closure = struct
       if m = arity then Type.closure_type arity else Type.curry_type arity (m + 1)
     in
     let cast e = if m = 2 then Memory.wasm_cast ty e else e in
+    let offset = Memory.env_start 1 in
     return
-      ( Memory.wasm_struct_get ty (cast (load closure)) 3
-      , Memory.wasm_struct_get ty (cast (load closure)) 2
+      ( Memory.wasm_struct_get ty (cast (load closure)) (offset + 1)
+      , Memory.wasm_struct_get ty (cast (load closure)) offset
       , Some (W.Ref { nullable = false; typ = Type cl_ty }) )
 end
 
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index f677825643..ec01c6b495 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -13,7 +13,7 @@
 
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
 
-   (type $closure (struct (field i32) (field (ref $function_1))))
+   (type $closure (struct (field (ref $function_1))))
 
    (type $value->value->int
       (func (param (ref eq)) (param (ref eq)) (result i32)))
@@ -1369,7 +1369,7 @@
                      (call $wrap
                         (call $get (local.get $args) (i31.new (local.get $i))))
                      (local.get $acc)
-                     (struct.get $closure 1
+                     (struct.get $closure 0
                         (ref.cast $closure (local.get $acc)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))

From db3b053024d671b58556c630b6f781e363272d10 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 16:03:41 +0200
Subject: [PATCH 039/481] Add primitive caml_string_equals

We can no longer use (==) to compare JavaScript values
---
 compiler/lib/generate.ml | 2 ++
 runtime/jslib.js         | 3 +++
 2 files changed, 5 insertions(+)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index a3da1d294e..85622d76f3 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1162,6 +1162,8 @@ let _ =
       J.EUn (J.Delete, J.EAccess (cx, ANormal, cy)));
   register_bin_prim "caml_js_equals" `Mutable (fun cx cy _ ->
       bool (J.EBin (J.EqEq, cx, cy)));
+  register_bin_prim "caml_js_strict_equals" `Mutable (fun cx cy _ ->
+      bool (J.EBin (J.EqEqEq, cx, cy)));
   register_bin_prim "caml_js_instanceof" `Mutator (fun cx cy _ ->
       bool (J.EBin (J.InstanceOf, cx, cy)));
   register_un_prim "caml_js_typeof" `Mutator (fun cx _ -> J.EUn (J.Typeof, cx))
diff --git a/runtime/jslib.js b/runtime/jslib.js
index d6361548f4..5450b47c90 100644
--- a/runtime/jslib.js
+++ b/runtime/jslib.js
@@ -403,6 +403,9 @@ function caml_js_function_arity(f) {
 //Provides: caml_js_equals mutable (const, const)
 function caml_js_equals (x, y) { return +(x == y); }
 
+//Provides: caml_js_strict_equals mutable (const, const)
+function caml_js_strict_equals (x, y) { return +(x === y); }
+
 //Provides: caml_js_eval_string (const)
 //Requires: caml_jsstring_of_string
 function caml_js_eval_string (s) {return eval(caml_jsstring_of_string(s));}

From 313bec3c54caeaf4d256d8861f89a8860a640cda Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 16:12:11 +0200
Subject: [PATCH 040/481] Compilation of recursive definitions involving
 functions and other values

---
 compiler/lib/wasm/wa_code_generation.ml  | 11 +++
 compiler/lib/wasm/wa_code_generation.mli |  3 +
 compiler/lib/wasm/wa_core_target.ml      |  4 ++
 compiler/lib/wasm/wa_curry.ml            | 28 +++++++-
 compiler/lib/wasm/wa_gc_target.ml        | 52 ++++++++++++++
 compiler/lib/wasm/wa_generate.ml         |  4 ++
 compiler/lib/wasm/wa_target_sig.ml       |  5 ++
 runtime/wasm/runtime.wat                 | 87 ++++++++++++++++++++----
 8 files changed, 178 insertions(+), 16 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index ac1a55377c..5c66c070a6 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -29,6 +29,7 @@ type context =
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Var.t IntMap.t
   ; mutable curry_funs : Var.t IntMap.t
+  ; mutable dummy_funs : Var.t IntMap.t
   ; mutable init_code : W.instruction list
   }
 
@@ -42,6 +43,7 @@ let make_context () =
   ; closure_envs = Var.Map.empty
   ; apply_funs = IntMap.empty
   ; curry_funs = IntMap.empty
+  ; dummy_funs = IntMap.empty
   ; init_code = []
   }
 
@@ -406,6 +408,15 @@ let need_curry_fun ~arity st =
        x)
   , st )
 
+let need_dummy_fun ~arity st =
+  let ctx = st.context in
+  ( (try IntMap.find arity ctx.dummy_funs
+     with Not_found ->
+       let x = Var.fresh_n (Printf.sprintf "dummy_%d" arity) in
+       ctx.dummy_funs <- IntMap.add arity x ctx.dummy_funs;
+       x)
+  , st )
+
 let init_code context = instrs context.init_code
 
 let function_body ~context ~value_type ~param_count ~body =
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index cb7922417b..4881d5e668 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -13,6 +13,7 @@ type context =
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable curry_funs : Code.Var.t Stdlib.IntMap.t
+  ; mutable dummy_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable init_code : Wa_ast.instruction list
   }
 
@@ -142,6 +143,8 @@ val need_apply_fun : arity:int -> Code.Var.t t
 
 val need_curry_fun : arity:int -> Code.Var.t t
 
+val need_dummy_fun : arity:int -> Code.Var.t t
+
 val function_body :
      context:context
   -> value_type:Wa_ast.value_type
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 66caa5e55c..688d3725ca 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -125,6 +125,8 @@ module Memory = struct
 
   let load_function_arity closure = Arith.(field closure 1 lsr const 24l)
 
+  let load_real_closure ~arity:_ _ = assert false
+
   let check_function_arity f arity if_match if_mismatch =
     let func_arity = load_function_arity (load f) in
     if_
@@ -534,6 +536,8 @@ module Closure = struct
 
   let curry_load ~arity:_ _ closure =
     return (Memory.field (load closure) 3, Memory.field (load closure) 4, None)
+
+  let dummy ~arity:_ = assert false
 end
 
 module Math = struct
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index ee4eb83aae..2d1b2026ce 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -188,6 +188,27 @@ module Make (Target : Wa_target_sig.S) = struct
     in
     W.Function { name; exported_name = None; typ = func_type arity; locals; body }
 
+  let dummy ~context ~arity ~name =
+    let body =
+      let l =
+        List.rev
+          (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
+      in
+      let* () = bind_parameters l in
+      let f = Code.Var.fresh_n "f" in
+      let* _ = add_var f in
+      let* typ, closure = Memory.load_real_closure ~arity (load f) in
+      let* l = expression_list load l in
+      let* e =
+        call ~typ:(W.Ref { nullable = false; typ = Type typ }) ~arity (return closure) l
+      in
+      instr (W.Return (Some e))
+    in
+    let locals, body =
+      function_body ~context ~value_type:Value.value ~param_count:(arity + 1) ~body
+    in
+    W.Function { name; exported_name = None; typ = func_type arity; locals; body }
+
   let f ~context =
     IntMap.iter
       (fun arity name ->
@@ -198,5 +219,10 @@ module Make (Target : Wa_target_sig.S) = struct
       (fun arity name ->
         let l = curry ~context ~arity ~name in
         context.other_fields <- List.rev_append l context.other_fields)
-      context.curry_funs
+      context.curry_funs;
+    IntMap.iter
+      (fun arity name ->
+        let f = dummy ~context ~arity ~name in
+        context.other_fields <- f :: context.other_fields)
+      context.dummy_funs
 end
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 372b152551..e8b3c1111c 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -245,6 +245,31 @@ module Type = struct
                   ; { W.mut = false; typ = Value value }
                   ])
           })
+
+  let dummy_closure_type ~arity =
+    register_type (Printf.sprintf "dummy_closure_%d" arity) (fun () ->
+        let* cl_typ = closure_type arity in
+        let* cl_typ' = if arity = 1 then closure_type_1 else closure_type arity in
+        let* common = closure_common_fields in
+        let* fun_ty' = function_type arity in
+        return
+          { supertype = Some cl_typ
+          ; final = true
+          ; typ =
+              W.Struct
+                ((if arity = 1
+                  then common
+                  else
+                    common
+                    @ [ { mut = false
+                        ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                        }
+                      ])
+                @ [ { W.mut = true
+                    ; typ = W.Value (Ref { nullable = true; typ = Type cl_typ' })
+                    }
+                  ])
+          })
 end
 
 module Value = struct
@@ -398,6 +423,14 @@ module Memory = struct
     let* e = wasm_struct_get ty casted_closure (env_start arity - 1) in
     return (`Ref fun_ty, e)
 
+  let load_real_closure ~arity closure =
+    let* ty = Type.dummy_closure_type ~arity in
+    let* cl_typ = if arity = 1 then Type.closure_type_1 else Type.closure_type arity in
+    let* e =
+      wasm_cast cl_typ (wasm_struct_get ty (wasm_cast ty closure) (env_start arity))
+    in
+    return (cl_typ, e)
+
   let check_function_arity f arity if_match if_mismatch =
     let* fun_ty = Type.closure_type arity in
     let* closure = load f in
@@ -769,6 +802,25 @@ module Closure = struct
       ( Memory.wasm_struct_get ty (cast (load closure)) (offset + 1)
       , Memory.wasm_struct_get ty (cast (load closure)) offset
       , Some (W.Ref { nullable = false; typ = Type cl_ty }) )
+
+  let dummy ~arity =
+    (* The runtime only handle function with arity up to 4 *)
+    let arity = if arity > 4 then 1 else arity in
+    let* dummy_fun = need_dummy_fun ~arity in
+    let* ty = Type.dummy_closure_type ~arity in
+    let* curry_fun = if arity > 1 then need_curry_fun ~arity else return dummy_fun in
+    let* cl_typ = Type.closure_type arity in
+    let closure_contents =
+      if arity = 1
+      then [ W.RefFunc dummy_fun; RefNull (Type cl_typ) ]
+      else [ RefFunc curry_fun; RefFunc dummy_fun; RefNull (Type cl_typ) ]
+    in
+    return
+      (W.StructNew
+         ( ty
+         , if include_closure_arity
+           then Const (I32 1l) :: closure_contents
+           else closure_contents ))
 end
 
 module Stack = struct
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index ad7b0e886d..29e9f898ea 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -119,6 +119,10 @@ module Generate (Target : Wa_target_sig.S) = struct
     | Closure _ ->
         Closure.translate ~context:ctx.global_context ~closures:ctx.closures ~stack_ctx x
     | Constant c -> Constant.translate c
+    | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int (_, arity)) ])
+      when Poly.(target = `GC) -> Closure.dummy ~arity:(Int32.to_int arity)
+    | Prim (Extern "caml_alloc_dummy_infix", _) when Poly.(target = `GC) ->
+        Closure.dummy ~arity:1
     | Prim (p, l) -> (
         let l = List.map ~f:transl_prim_arg l in
         match p, l with
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 6985f6e1b9..a5d9346e94 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -65,6 +65,9 @@ module type S = sig
       -> expression
       -> ([ `Index | `Ref of Wa_ast.var ] * Wa_ast.expression) Wa_code_generation.t
 
+    val load_real_closure :
+      arity:int -> expression -> (Wa_ast.var * Wa_ast.expression) Wa_code_generation.t
+
     val check_function_arity :
          Code.Var.t
       -> int
@@ -194,6 +197,8 @@ module type S = sig
       -> int
       -> Code.Var.t
       -> (expression * expression * Wa_ast.value_type option) Wa_code_generation.t
+
+    val dummy : arity:int -> Wa_ast.expression Wa_code_generation.t
   end
 
   module Math : sig
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index ec01c6b495..8501ce6ce6 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -13,7 +13,47 @@
 
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
 
-   (type $closure (struct (field (ref $function_1))))
+   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+
+   (type $dummy_closure_1
+      (sub $closure
+         (struct (field (ref $function_1)) (field (mut (ref null $closure))))))
+
+   (type $function_2
+      (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+
+   (type $closure_2
+      (sub $closure
+         (struct (field (ref $function_1)) (field (ref $function_2)))))
+
+   (type $dummy_closure_2
+      (sub $closure_2
+         (struct (field (ref $function_1)) (field (ref $function_2))
+            (field (mut (ref null $closure_2))))))
+
+   (type $function_3
+      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+
+   (type $closure_3
+      (sub $closure
+         (struct (field (ref $function_1)) (field (ref $function_3)))))
+
+   (type $dummy_closure_3
+      (sub $closure_3
+         (struct (field (ref $function_1)) (field (ref $function_3))
+            (field (mut (ref null $closure_3))))))
+
+   (type $function_4
+      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+
+   (type $closure_4
+      (sub $closure
+         (struct (field (ref $function_1)) (field (ref $function_4)))))
+
+   (type $dummy_closure_4
+      (sub $closure_4
+         (struct (field (ref $function_1)) (field (ref $function_4))
+            (field (mut (ref null $closure_4))))))
 
    (type $value->value->int
       (func (param (ref eq)) (param (ref eq)) (result i32)))
@@ -545,21 +585,38 @@
 
    (func (export "caml_update_dummy")
       (param $dummy (ref eq)) (param $newval (ref eq)) (result (ref eq))
-      (local $i i32) (local $len i32)
+      (local $i i32)
       (local $dst (ref $block)) (local $src (ref $block))
-      ;; ZZZ check for closure or float array
-      (local.set $src (ref.cast $block (local.get $newval)))
-      (local.set $dst (ref.cast $block (local.get $dummy)))
-      (local.set $len (array.len (local.get $dst)))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (array.set $block (local.get $dst) (local.get $i)
-                  (array.get $block (local.get $src) (local.get $i)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (i31.new (i32.const 0)))
+      (drop (block $not_block (result (ref eq))
+         (local.set $dst
+            (br_on_cast_fail $not_block $block (local.get $dummy)))
+         (local.set $src (ref.cast $block (local.get $newval)))
+         (array.copy $block $block
+            (local.get $dst) (i32.const 0) (local.get $src) (i32.const 0)
+            (array.len (local.get $dst)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_1 (result (ref eq))
+         (struct.set $dummy_closure_1 1
+            (br_on_cast_fail $not_closure_1 $dummy_closure_1 (local.get $dummy))
+            (ref.cast $closure (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_2 (result (ref eq))
+         (struct.set $dummy_closure_2 2
+            (br_on_cast_fail $not_closure_2 $dummy_closure_2 (local.get $dummy))
+            (ref.cast $closure_2 (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_3 (result (ref eq))
+         (struct.set $dummy_closure_3 2
+            (br_on_cast_fail $not_closure_3 $dummy_closure_3 (local.get $dummy))
+            (ref.cast $closure_3 (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_4 (result (ref eq))
+         (struct.set $dummy_closure_4 2
+            (br_on_cast_fail $not_closure_4 $dummy_closure_4 (local.get $dummy))
+            (ref.cast $closure_4 (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      ;; ZZZ float array
+      (unreachable))
 
    (func $caml_string_equal (export "caml_string_equal")
       (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))

From 00c31f454402cc5a9268a7a99279f74094d9601d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 24 May 2023 16:31:20 +0200
Subject: [PATCH 041/481] More runtime functions

---
 compiler/lib/wasm/wa_gc_target.ml |   45 +-
 runtime/wasm/dune                 |   11 +-
 runtime/wasm/index.js             |  131 +-
 runtime/wasm/run.js               |  139 +-
 runtime/wasm/runtime.wat          | 2213 +++++++++++++++++++++++++++--
 5 files changed, 2334 insertions(+), 205 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index e8b3c1111c..d6d60b8f01 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -138,9 +138,18 @@ module Type = struct
         let* fields = closure_common_fields in
         return { supertype = None; final = false; typ = W.Struct fields })
 
-  let closure_type arity =
+  let closure_last_arg_type =
+    register_type "closure_last_arg" (fun () ->
+        let* cl_typ = closure_type_1 in
+        let* fields = closure_common_fields in
+        return { supertype = Some cl_typ; final = false; typ = W.Struct fields })
+
+  let closure_type ~usage arity =
     if arity = 1
-    then closure_type_1
+    then
+      match usage with
+      | `Alloc -> closure_last_arg_type
+      | `Access -> closure_type_1
     else
       register_type (Printf.sprintf "closure_%d" arity) (fun () ->
           let* cl_typ = closure_type_1 in
@@ -160,7 +169,7 @@ module Type = struct
 
   let env_type ~arity n =
     register_type (Printf.sprintf "env_%d_%d" arity n) (fun () ->
-        let* cl_typ = closure_type arity in
+        let* cl_typ = closure_type ~usage:`Alloc arity in
         let* common = closure_common_fields in
         let* fun_ty' = function_type arity in
         return
@@ -205,7 +214,7 @@ module Type = struct
     register_type
       (Printf.sprintf "closure_rec_%d_%d_%d" arity function_count free_variable_count)
       (fun () ->
-        let* cl_typ = closure_type arity in
+        let* cl_typ = closure_type ~usage:`Alloc arity in
         let* common = closure_common_fields in
         let* fun_ty' = function_type arity in
         let* env_ty = rec_env_type ~function_count ~free_variable_count in
@@ -230,9 +239,11 @@ module Type = struct
 
   let rec curry_type arity m =
     register_type (Printf.sprintf "curry_%d_%d" arity m) (fun () ->
-        let* cl_typ = if m = 2 then closure_type 1 else closure_type_1 in
+        let* cl_typ = closure_type ~usage:(if m = 2 then `Alloc else `Access) 1 in
         let* common = closure_common_fields in
-        let* cl_ty = if m = arity then closure_type arity else curry_type arity (m + 1) in
+        let* cl_ty =
+          if m = arity then closure_type ~usage:`Alloc arity else curry_type arity (m + 1)
+        in
         return
           { supertype = Some cl_typ
           ; final = true
@@ -248,8 +259,8 @@ module Type = struct
 
   let dummy_closure_type ~arity =
     register_type (Printf.sprintf "dummy_closure_%d" arity) (fun () ->
-        let* cl_typ = closure_type arity in
-        let* cl_typ' = if arity = 1 then closure_type_1 else closure_type arity in
+        let* cl_typ = closure_type ~usage:`Alloc arity in
+        let* cl_typ' = closure_type ~usage:`Access arity in
         let* common = closure_common_fields in
         let* fun_ty' = function_type arity in
         return
@@ -417,7 +428,7 @@ module Memory = struct
     (if include_closure_arity then 1 else 0) + if arity = 1 then 1 else 2
 
   let load_function_pointer ~arity ?(skip_cast = false) closure =
-    let* ty = Type.closure_type arity in
+    let* ty = Type.closure_type ~usage:`Access arity in
     let* fun_ty = Type.function_type arity in
     let casted_closure = if skip_cast then closure else wasm_cast ty closure in
     let* e = wasm_struct_get ty casted_closure (env_start arity - 1) in
@@ -425,14 +436,14 @@ module Memory = struct
 
   let load_real_closure ~arity closure =
     let* ty = Type.dummy_closure_type ~arity in
-    let* cl_typ = if arity = 1 then Type.closure_type_1 else Type.closure_type arity in
+    let* cl_typ = Type.closure_type ~usage:`Access arity in
     let* e =
       wasm_cast cl_typ (wasm_struct_get ty (wasm_cast ty closure) (env_start arity))
     in
     return (cl_typ, e)
 
   let check_function_arity f arity if_match if_mismatch =
-    let* fun_ty = Type.closure_type arity in
+    let* fun_ty = Type.closure_type ~usage:`Access arity in
     let* closure = load f in
     let* () =
       drop
@@ -637,7 +648,7 @@ module Closure = struct
     let* curry_fun = if arity > 1 then need_curry_fun ~arity else return f in
     if List.is_empty free_variables
     then
-      let* typ = Type.closure_type arity in
+      let* typ = Type.closure_type ~usage:`Alloc arity in
       let name = Code.Var.fresh_n "closure" in
       let* () =
         register_global
@@ -778,7 +789,9 @@ module Closure = struct
   let curry_allocate ~stack_ctx:_ ~x:_ ~arity m ~f ~closure ~arg =
     let* ty = Type.curry_type arity m in
     let* cl_ty =
-      if m = arity then Type.closure_type arity else Type.curry_type arity (m + 1)
+      if m = arity
+      then Type.closure_type ~usage:`Alloc arity
+      else Type.curry_type arity (m + 1)
     in
     let* closure = Memory.wasm_cast cl_ty (load closure) in
     let* arg = load arg in
@@ -794,7 +807,9 @@ module Closure = struct
     let m = m + 1 in
     let* ty = Type.curry_type arity m in
     let* cl_ty =
-      if m = arity then Type.closure_type arity else Type.curry_type arity (m + 1)
+      if m = arity
+      then Type.closure_type ~usage:`Alloc arity
+      else Type.curry_type arity (m + 1)
     in
     let cast e = if m = 2 then Memory.wasm_cast ty e else e in
     let offset = Memory.env_start 1 in
@@ -809,7 +824,7 @@ module Closure = struct
     let* dummy_fun = need_dummy_fun ~arity in
     let* ty = Type.dummy_closure_type ~arity in
     let* curry_fun = if arity > 1 then need_curry_fun ~arity else return dummy_fun in
-    let* cl_typ = Type.closure_type arity in
+    let* cl_typ = Type.closure_type ~usage:`Alloc arity in
     let closure_contents =
       if arity = 1
       then [ W.RefFunc dummy_fun; RefNull (Type cl_typ) ]
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 72f6fbfd26..ca62662dbf 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -1,9 +1,10 @@
+(install
+ (section lib)
+ (package wasm_of_ocaml-compiler)
+ (files runtime.wasm))
+
 (rule
    (target runtime.wasm)
    (deps runtime.wat)
    (action
-      (run wasm-opt --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{deps} -O  -o %{target})))
-
-(alias
- (name all)
- (deps (glob_files *.js)))
+      (run wasm-opt -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{deps} -O  -o %{target})))
diff --git a/runtime/wasm/index.js b/runtime/wasm/index.js
index cf1415e24f..64922a9291 100644
--- a/runtime/wasm/index.js
+++ b/runtime/wasm/index.js
@@ -1,8 +1,7 @@
 (async function () {
-    const runtime = fetch('runtime.wasm');
     const code = fetch('a.wasm');
 
-    var caml_callback;
+    var caml_callback, caml_alloc_tm;
 
     let math =
         {cos:Math.cos, sin:Math.sin, tan:Math.tan,
@@ -14,45 +13,151 @@
          atan2:Math.atan2, hypot:Math.hypot, pow:Math.pow,
          fmod:(x, y) => x%y}
 
+    let typed_arrays =
+      [Float32Array, Float64Array, Int8Array, Uint8Array, Int16Array,
+       Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
+       Float32Array, Float64Array, Uint8Array]
+
     let bindings =
         {identity:(x)=>x,
          from_bool:(x)=>!!x,
          get:(x,y)=>x[y],
          set:(x,y,z)=>x[y]=z,
+         delete:(x,y)=>delete x[y],
+         instanceof:(x,y)=>x instanceof y,
+         typeof:(x)=>typeof x,
          eval:eval,
+         equals:(x,y)=>x==y,
          strict_equals:(x,y)=>x===y,
-         fun_call:(f,args)=>f.apply(null,args),
+         fun_call:(f,o,args)=>f.apply(o,args),
          meth_call:(o,f,args)=>o[f].apply(o,args),
          new_array:(n)=>new Array(n),
          new_obj:()=>({}),
-         new:(c,args)=>{return new c(...args)},
+         new:(c,args)=>new c(...args),
+         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwnsProperty(nm)) f(nm)},
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,
          get_int:(a,i)=>a[i],
+         ta_create:(k,sz)=> new(typed_arrays[k])(sz),
+         ta_normalize:(a)=>
+           a instanceof Uint8ClampedArray?
+             new Uint8Array(a.buffer,a.byteOffset,a.byteLength):
+             a instanceof Uint32Array?
+               new Int32Array(a.buffer,a.byteOffset,a.byteLength):a,
+         ta_kind:(a)=>typed_arrays.findIndex((c)=>a instanceof c),
+         ta_length:(a)=>a.length,
+         ta_get_f64:(a,i)=>a[i],
+         ta_get_f32:(a,i)=>a[i],
+         ta_get_i32:(a,i)=>a[i],
+         ta_get_i16:(a,i)=>a[i],
+         ta_get_ui16:(a,i)=>a[i],
+         ta_get_i8:(a,i)=>a[i],
+         ta_get_ui8:(a,i)=>a[i],
+         ta_set_f64:(a,i,v)=>a[i]=v,
+         ta_set_f32:(a,i,v)=>a[i]=v,
+         ta_set_i32:(a,i,v)=>a[i]=v,
+         ta_set_i16:(a,i,v)=>a[i]=v,
+         ta_set_ui16:(a,i,v)=>a[i]=v,
+         ta_set_i8:(a,i,v)=>a[i]=v,
+         ta_set_ui8:(a,i,v)=>a[i]=v,
+         wrap_callback:(f)=>function (){
+             var n = arguments.length;
+             if(n > 0) {
+                 var args = new Array(n);
+                 for (var i = 0; i < n; i++) args[i] = arguments[i];
+             } else {
+                 args = [undefined];
+             }
+             return caml_callback(f, args.length, args, 1);
+         },
+         wrap_callback_args:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n);
+             for (var i = 0; i < n; i++) args[i] = arguments[i];
+             return caml_callback(f, 1, [args], 0);
+         },
          wrap_callback_strict:(arity,f)=>function (){
              var n = arguments.length;
              var args = new Array(arity);
              var len = Math.min(arguments.length, arity)
              for (var i = 0; i < len; i++) args[i] = arguments[i];
-             return caml_callback(f, arity, args);
+             return caml_callback(f, arity, args, 0);
          },
+         wrap_callback_unsafe:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n);
+             for (var i = 0; i < n; i++) args[i] = arguments[i];
+             return caml_callback(f, args.length, args, 2);
+         },
+         wrap_meth_callback:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n+1);
+             args[0] = this;
+             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
+             return caml_callback(f, args.length, args, 1);
+         },
+         wrap_meth_callback_args:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n);
+             for (var i = 0; i < n; i++) args[i] = arguments[i];
+             return caml_callback(f, 2, [this, args], 0);
+         },
+         wrap_meth_callback_strict:(arity,f)=>function (){
+             var args = new Array(arity + 1);
+             var len = Math.min(arguments.length, arity)
+             args[0] = this;
+             for (var i = 0; i < len; i++) args[i+1] = arguments[i];
+             return caml_callback(f, args.length, args, 0);
+         },
+         wrap_meth_callback_unsafe:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n+1);
+             args[0] = this;
+             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
+             return caml_callback(f, args.length, args, 2);
+         },
+         wrap_fun_arguments:(f)=>function(){return f(arguments)},
          format:(f)=>""+f,
+         gettimeofday:()=>(new Date()).getTime() / 1000,
+         gmtime:(t)=>{
+           var d = new Date (t * 1000);
+           var d_num = d.getTime();
+           var januaryfirst =
+             (new Date(Date.UTC(d.getUTCFullYear(), 0, 1))).getTime();
+           var doy = Math.floor((d_num - januaryfirst) / 86400000);
+           return caml_alloc_tm(d.getUTCSeconds(), d.getUTCMinutes(),
+                                d.getUTCHours(), d.getUTCDate(),
+                                d.getUTCMonth(), d.getUTCFullYear() - 1900,
+                                d.getUTCDay(), doy, false)
+         },
+         localtime:(t)=>{
+           var d = new Date (t * 1000);
+           var d_num = d.getTime();
+           var januaryfirst = (new Date(d.getFullYear(), 0, 1)).getTime();
+           var doy = Math.floor((d_num - januaryfirst) / 86400000);
+           var jan = new Date(d.getFullYear(), 0, 1);
+           var jul = new Date(d.getFullYear(), 6, 1);
+           var stdTimezoneOffset =
+               Math.max(jan.getTimezoneOffset(), jul.getTimezoneOffset());
+           return caml_alloc_tm(d.getSeconds(), d.getMinutes(), d.getHours(),
+                                d.getDate(), d.getMonth(),
+                                d.getFullYear() - 1900,
+                                d.getDay(), doy,
+                                (d.getTimezoneOffset() < stdTimezoneOffset))
+         },
+         random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const runtimeModule =
-          await WebAssembly.instantiateStreaming(runtime,
-                                                 {Math:math,bindings:bindings});
-
-    caml_callback = runtimeModule.instance.exports.caml_callback;
 
     const wasmModule =
           await WebAssembly.instantiateStreaming(
-              code,
-              {env:runtimeModule.instance.exports,
-               Math:math,bindings:bindings}
+              code, {Math:math,bindings:bindings}
           )
 
+    caml_callback = wasmModule.instance.exports.caml_callback;
+    caml_alloc_tm = wasmModule.instance.exports.caml_alloc_tm;
+
     try {
         wasmModule.instance.exports._initialize()
     } catch (e) {
diff --git a/runtime/wasm/run.js b/runtime/wasm/run.js
index 9d3a70ad77..3119a0e955 100755
--- a/runtime/wasm/run.js
+++ b/runtime/wasm/run.js
@@ -2,12 +2,9 @@
 (async function () {
     const fs = require('fs/promises');
     const path = require('path');
-    const runtimePath =
-          path.resolve(path.dirname(process.argv[1]), 'runtime.wasm');
-    const runtime = fs.readFile(runtimePath);
     const code = fs.readFile(process.argv[2]);
 
-    var caml_callback;
+    var caml_callback, caml_alloc_tm;
 
     let math =
         {cos:Math.cos, sin:Math.sin, tan:Math.tan,
@@ -19,50 +16,158 @@
          atan2:Math.atan2, hypot:Math.hypot, pow:Math.pow,
          fmod:(x, y) => x%y}
 
+    let typed_arrays =
+      [Float32Array, Float64Array, Int8Array, Uint8Array, Int16Array,
+       Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
+       Float32Array, Float64Array, Uint8Array]
+
     let bindings =
         {identity:(x)=>x,
          from_bool:(x)=>!!x,
          get:(x,y)=>x[y],
          set:(x,y,z)=>x[y]=z,
+         delete:(x,y)=>delete x[y],
+         instanceof:(x,y)=>x instanceof y,
+         typeof:(x)=>typeof x,
          eval:eval,
+         equals:(x,y)=>x==y,
          strict_equals:(x,y)=>x===y,
-         fun_call:(f,args)=>f.apply(null,args),
+         fun_call:(f,o,args)=>f.apply(o,args),
          meth_call:(o,f,args)=>o[f].apply(o,args),
          new_array:(n)=>new Array(n),
          new_obj:()=>({}),
-         new:(c,args)=>{return new c(...args)},
+         new:(c,args)=>new c(...args),
+         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwnsProperty(nm)) f(nm)},
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,
          get_int:(a,i)=>a[i],
+         ta_create:(k,sz)=> new(typed_arrays[k])(sz),
+         ta_normalize:(a)=>
+           a instanceof Uint8ClampedArray?
+             new Uint8Array(a.buffer,a.byteOffset,a.byteLength):
+             a instanceof Uint32Array?
+               new Int32Array(a.buffer,a.byteOffset,a.byteLength):a,
+         ta_kind:(a)=>typed_arrays.findIndex((c)=>a instanceof c),
+         ta_length:(a)=>a.length,
+         ta_get_f64:(a,i)=>a[i],
+         ta_get_f32:(a,i)=>a[i],
+         ta_get_i32:(a,i)=>a[i],
+         ta_get_i16:(a,i)=>a[i],
+         ta_get_ui16:(a,i)=>a[i],
+         ta_get_i8:(a,i)=>a[i],
+         ta_get_ui8:(a,i)=>a[i],
+         ta_set_f64:(a,i,v)=>a[i]=v,
+         ta_set_f32:(a,i,v)=>a[i]=v,
+         ta_set_i32:(a,i,v)=>a[i]=v,
+         ta_set_i16:(a,i,v)=>a[i]=v,
+         ta_set_ui16:(a,i,v)=>a[i]=v,
+         ta_set_i8:(a,i,v)=>a[i]=v,
+         ta_set_ui8:(a,i,v)=>a[i]=v,
+         wrap_callback:(f)=>function (){
+             var n = arguments.length;
+             if(n > 0) {
+                 var args = new Array(n);
+                 for (var i = 0; i < n; i++) args[i] = arguments[i];
+             } else {
+                 args = [undefined];
+             }
+             return caml_callback(f, args.length, args, 1);
+         },
+         wrap_callback_args:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n);
+             for (var i = 0; i < n; i++) args[i] = arguments[i];
+             return caml_callback(f, 1, [args], 0);
+         },
          wrap_callback_strict:(arity,f)=>function (){
              var n = arguments.length;
              var args = new Array(arity);
              var len = Math.min(arguments.length, arity)
              for (var i = 0; i < len; i++) args[i] = arguments[i];
-             return caml_callback(f, arity, args);
+             return caml_callback(f, arity, args, 0);
+         },
+         wrap_callback_unsafe:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n);
+             for (var i = 0; i < n; i++) args[i] = arguments[i];
+             return caml_callback(f, args.length, args, 2);
+         },
+         wrap_meth_callback:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n+1);
+             args[0] = this;
+             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
+             return caml_callback(f, args.length, args, 1);
+         },
+         wrap_meth_callback_args:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n);
+             for (var i = 0; i < n; i++) args[i] = arguments[i];
+             return caml_callback(f, 2, [this, args], 0);
+         },
+         wrap_meth_callback_strict:(arity,f)=>function (){
+             var args = new Array(arity + 1);
+             var len = Math.min(arguments.length, arity)
+             args[0] = this;
+             for (var i = 0; i < len; i++) args[i+1] = arguments[i];
+             return caml_callback(f, args.length, args, 0);
+         },
+         wrap_meth_callback_unsafe:(f)=>function (){
+             var n = arguments.length;
+             var args = new Array(n+1);
+             args[0] = this;
+             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
+             return caml_callback(f, args.length, args, 2);
          },
+         wrap_fun_arguments:(f)=>function(){return f(arguments)},
          format:(f)=>""+f,
+         gettimeofday:()=>(new Date()).getTime() / 1000,
+         gmtime:(t)=>{
+           var d = new Date (t * 1000);
+           var d_num = d.getTime();
+           var januaryfirst =
+             (new Date(Date.UTC(d.getUTCFullYear(), 0, 1))).getTime();
+           var doy = Math.floor((d_num - januaryfirst) / 86400000);
+           return caml_alloc_tm(d.getUTCSeconds(), d.getUTCMinutes(),
+                                d.getUTCHours(), d.getUTCDate(),
+                                d.getUTCMonth(), d.getUTCFullYear() - 1900,
+                                d.getUTCDay(), doy, false)
+         },
+         localtime:(t)=>{
+           var d = new Date (t * 1000);
+           var d_num = d.getTime();
+           var januaryfirst = (new Date(d.getFullYear(), 0, 1)).getTime();
+           var doy = Math.floor((d_num - januaryfirst) / 86400000);
+           var jan = new Date(d.getFullYear(), 0, 1);
+           var jul = new Date(d.getFullYear(), 6, 1);
+           var stdTimezoneOffset =
+               Math.max(jan.getTimezoneOffset(), jul.getTimezoneOffset());
+           return caml_alloc_tm(d.getSeconds(), d.getMinutes(), d.getHours(),
+                                d.getDate(), d.getMonth(),
+                                d.getFullYear() - 1900,
+                                d.getDay(), doy,
+                                (d.getTimezoneOffset() < stdTimezoneOffset))
+         },
+         random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const runtimeModule =
-          await WebAssembly.instantiate(await runtime,
-                                        {Math:math,bindings:bindings});
-
-    caml_callback = runtimeModule.instance.exports.caml_callback;
 
     const wasmModule =
           await WebAssembly.instantiate(await code,
-                                        {env:runtimeModule.instance.exports,
-                                         Math:math,bindings:bindings})
+                                        {Math:math,bindings:bindings})
+
+    caml_callback = wasmModule.instance.exports.caml_callback;
+    caml_alloc_tm = wasmModule.instance.exports.caml_alloc_tm;
+
     try {
         wasmModule.instance.exports._initialize()
     } catch (e) {
         if (e instanceof WebAssembly.Exception &&
-            e.is(runtimeModule.instance.exports.ocaml_exit))
-            process.exit(e.getArg(runtimeModule.instance.exports.ocaml_exit, 0));
+            e.is(wasmModule.instance.exports.ocaml_exit))
+            process.exit(e.getArg(wasmModule.instance.exports.ocaml_exit, 0));
         if (e instanceof WebAssembly.Exception &&
-            e.is(runtimeModule.instance.exports.ocaml_exception)) {
+            e.is(wasmModule.instance.exports.ocaml_exception)) {
             console.log('Uncaught exception')
             process.exit(1)
         }
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
index 8501ce6ce6..d3270be567 100644
--- a/runtime/wasm/runtime.wat
+++ b/runtime/wasm/runtime.wat
@@ -15,8 +15,11 @@
 
    (type $closure (struct (;(field i32);) (field (ref $function_1))))
 
+   (type $closure_last_arg
+      (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
+
    (type $dummy_closure_1
-      (sub $closure
+      (sub $closure_last_arg
          (struct (field (ref $function_1)) (field (mut (ref null $closure))))))
 
    (type $function_2
@@ -103,7 +106,7 @@
    (global $INVALID_EXN i32 (i32.const 3))
 
    (func $caml_invalid_argument (param $arg (ref eq))
-       (call $caml_raise_with_arg
+       (return_call $caml_raise_with_arg
            (array.get $block (global.get $caml_global_data)
               (global.get $INVALID_EXN))
            (local.get 0)))
@@ -111,17 +114,24 @@
    (data $index_out_of_bounds "index out of bounds")
 
    (func $caml_bound_error (export "caml_bound_error")
-      (call $caml_invalid_argument
+      (return_call $caml_invalid_argument
          (array.new_data $string $index_out_of_bounds
             (i32.const 0) (i32.const 19))))
 
    (global $ZERO_DIVIDE_EXN i32 (i32.const 5))
 
    (func (export "caml_raise_zero_divide")
-      (call $caml_raise_constant
+      (return_call $caml_raise_constant
          (array.get $block (global.get $caml_global_data)
                     (global.get $ZERO_DIVIDE_EXN))))
 
+   (global $NOT_FOUND_EXN i32 (i32.const 6))
+
+   (func $caml_raise_not_found
+      (return_call $caml_raise_constant
+         (array.get $block (global.get $caml_global_data)
+                    (global.get $NOT_FOUND_EXN))))
+
    (func (export "caml_bswap16") (param (ref eq)) (result (ref eq))
       (local $x i32)
       (local.set $x (i31.get_s (ref.cast i31 (local.get 0))))
@@ -325,7 +335,7 @@
 
    (data $Array_make "Array.make")
 
-   (func (export "caml_make_vect")
+   (func $caml_make_vect (export "caml_make_vect")
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $sz i32) (local $b (ref $block))
       (local.set $sz (i32.add (i31.get_s (ref.cast i31 (local.get $n)))
@@ -336,38 +346,382 @@
                (array.new_data $string $Array_make
                                (i32.const 0) (i32.const 10)))))
       (local.set $b (array.new $block (local.get $v) (local.get $sz)))
+      ;; ZZZ float array
       (array.set $block (local.get $b) (i32.const 0) (i31.new (i32.const 0)))
       (local.get $b))
 
+   (export "caml_make_float_vect" (func $caml_floatarray_create))
+   (func $caml_floatarray_create (export "caml_floatarray_create")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ float array
+      (return_call $caml_make_vect
+         (local.get 0) (struct.new $float (f64.const 0))))
+
+   (func (export "caml_array_sub")
+      (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
+      (result (ref eq))
+      (local $a1 (ref $block)) (local $a2 (ref $block)) (local $len i32)
+      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
+      (local.set $a1 (ref.cast $block (local.get $a)))
+      (local.set $a2 (array.new $block (i31.new (i32.const 0))
+                        (i32.add (local.get $len) (i32.const 1))))
+      (array.copy $block $block
+         (local.get $a2) (i32.const 1) (local.get $a1)
+         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
+         (local.get $len))
+      (local.get $a2))
+
+   (func (export "caml_array_append")
+      (param $va1 (ref eq)) (param $va2 (ref eq)) (result (ref eq))
+      (local $a1 (ref $block)) (local $a2 (ref $block)) (local $a (ref $block))
+      (local $l1 i32) (local $l2 i32)
+      (local.set $a1 (ref.cast $block (local.get $va1)))
+      (local.set $l1 (array.len (local.get $a1)))
+      (local.set $a2 (ref.cast $block (local.get $va2)))
+      (local.set $l2 (array.len (local.get $a2)))
+      (local.set $a
+         (array.new $block (i31.new (i32.const 0))
+            (i32.sub (i32.add (local.get $l1) (local.get $l2)) (i32.const 1))))
+      ;; ZZZ float array
+      (array.copy $block $block
+         (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
+         (i32.sub (local.get $l1) (i32.const 1)))
+      (array.copy $block $block
+         (local.get $a) (i32.const 1) (local.get $a2) (local.get $l1)
+         (i32.sub (local.get $l2) (i32.const 1)))
+      (local.get $a))
+
+   (func (export "caml_array_concat") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_array_concat"))
+      (unreachable))
+
+   (export "caml_floatarray_blit" (func $caml_array_blit))
+   (func $caml_array_blit (export "caml_array_blit")
+      (param $a1 (ref eq)) (param $i1 (ref eq))
+      (param $a2 (ref eq)) (param $i2 (ref eq))
+      (param $len (ref eq))
+      (result (ref eq))
+      (array.copy $block $block
+         (ref.cast $block (local.get $a2))
+         (i31.get_s (ref.cast i31 (local.get $i2)))
+         (ref.cast $block (local.get $a1))
+         (i31.get_s (ref.cast i31 (local.get $i1)))
+         (i31.get_s (ref.cast i31 (local.get $len))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_array_fill")
+      (param $a (ref eq)) (param $i (ref eq)) (param $len (ref eq))
+      (param $v (ref eq)) (result (ref eq))
+      (array.fill $block (ref.cast $block (local.get $a))
+         (i31.get_u (ref.cast i31 (local.get $i)))
+         (local.get $v)
+         (i31.get_u (ref.cast i31 (local.get $len))))
+      (i31.new (i32.const 0)))
+
    (func (export "caml_fs_init") (result (ref eq))
       (i31.new (i32.const 0)))
 
+   (export "caml_sys_time_include_children" (func $caml_sys_time))
+   (func $caml_sys_time (export "caml_sys_time")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_time"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_argv") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_argv"))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (array.new_fixed $string (i32.const 97))))
+
    (func (export "caml_ml_flush") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_flush"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_open_descriptor_in")
       (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_open_descriptor_in"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_open_descriptor_out")
       (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_open_descriptor_out"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_pos_in")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_pos_in"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_pos_out")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_pos_out"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_seek_in")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_seek_in"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_seek_in_64")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_seek_in_64"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_seek_out")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_seek_out"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_close_channel")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_close_channel"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_set_channel_name")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_set_channel_name"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_out_channels_list")
       (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_out_channels_list"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_input")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_output")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
       (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_output_bytes")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output_bytes"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_input_char")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input_char"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_input_int")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input_int"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_input_scan_line")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input_scan_line"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_output_char")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output_char"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_output_int")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output_int"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_open")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_open"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_close")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_close"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_read_directory")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_read_directory"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_remove")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_remove"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_rename")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_rename"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_system_command")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_system_command"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_random_seed")
+      (param (ref eq)) (result (ref eq))
+      (local $r externref)
+      (local $a (ref $block))
+      (local $i i32) (local $n i32)
+      (local.set $r (call $random_seed))
+      (local.set $n (call $ta_length (local.get $r)))
+      (local.set $a
+         (array.new $block (i31.new (i32.const 0))
+            (i32.add (local.get $n) (i32.const 1))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $n))
+            (then
+               (array.set $block
+                  (local.get $a) (i32.add (local.get $i) (i32.const 1))
+                  (i31.new (call $ta_get_i32 (local.get $r) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $a))
+
+   (func (export "caml_sys_file_exists")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_file_exists"))
+      (i31.new (i32.const 0)))
+
+   (data $Unix "Unix")
+
+   (func (export "caml_sys_get_config")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_get_config"))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (array.new_data $string $Unix (i32.const 0) (i32.const 4))
+         (i31.new (i32.const 32))
+         (i31.new (i32.const 0))))
+
+   (func (export "caml_sys_getcwd")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_getcwd"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_mkdir")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_mkdir"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_getenv")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_getenv"))
+      (call $log_js
+         (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
+      (call $caml_raise_not_found)
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_isatty")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_isatty"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_terminfo_rows")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_terminfo_rows"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_ostype_cygwin")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_const_ostype_cygwin"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_ostype_win32")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_const_ostype_win32"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_md5_string")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_md5_string"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_md5_chan")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_md5_chan"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_register_named_value")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_register_named_value"))
+      (call $log_js
+         (call $unwrap (call $caml_jsstring_of_string (local.get $0))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_dynlink_close_lib")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_dynlink_close_lib"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_dynlink_lookup_symbol")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_dynlink_lookup_symbol"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_new_lex_engine")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_new_lex_engine"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_lex_engine")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_lex_engine"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_quick_stat")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_gc_quick_stat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_final_register")
+     (param (ref eq) (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 
    (func $parse_sign_and_base (param $s (ref $string)) (result i32 i32 i32 i32)
@@ -512,6 +866,14 @@
 
    (global $caml_oo_last_id (mut i32) (i32.const 0))
 
+   (func (export "caml_set_oo_id") (param (ref eq)) (result (ref eq))
+      (local $id i32)
+      (local.set $id (global.get $caml_oo_last_id))
+      (array.set $block (ref.cast $block (local.get 0)) (i32.const 2)
+         (i31.new (local.get $id)))
+      (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
+      (local.get $0))
+
    (func (export "caml_fresh_oo_id") (param (ref eq)) (result (ref eq))
       (local $id i32)
       (local.set $id (global.get $caml_oo_last_id))
@@ -523,30 +885,77 @@
       (local $orig (ref $block))
       (local $res (ref $block))
       (local $len i32)
-      (local $i i32)
       (local.set $orig (ref.cast $block (local.get 0)))
       (local.set $len (array.len (local.get $orig)))
       (local.set $res
          (array.new $block (array.get $block (local.get $orig) (i32.const 0))
             (local.get $len)))
-      (local.set $i (i32.const 1))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (array.set $block (local.get $res) (local.get $i)
-                  (array.get $block (local.get $orig) (local.get $i)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (array.copy $block $block
+         (local.get $res) (i32.const 1) (local.get $orig) (i32.const 1)
+         (i32.sub (local.get $len) (i32.const 1)))
+      (local.get $res))
+
+   (func (export "caml_obj_block")
+      (param $tag (ref eq)) (param $size (ref eq)) (result (ref eq))
+      (local $res (ref $block))
+      ;; ZZZ float array / specific types
+      (local.set $res
+         (array.new $block
+            (i31.new (i32.const 0))
+            (i32.add (i31.get_s (ref.cast i31 (local.get $size)))
+                     (i32.const 1))))
+      (array.set $block (local.get $res) (i32.const 0) (local.get $tag))
       (local.get $res))
 
+   (global $forcing_tag i32 (i32.const 244))
+   (global $cont_tag i32 (i32.const 245))
+   (global $lazy_tag i32 (i32.const 246))
    (global $closure_tag i32 (i32.const 247))
    (global $object_tag i32 (i32.const 248))
    (global $forward_tag i32 (i32.const 250))
+   (global $abstract_tag i32 (i32.const 251))
    (global $string_tag i32 (i32.const 252))
    (global $float_tag i32 (i32.const 253))
    (global $double_array_tag i32 (i32.const 254))
    (global $custom_tag i32 (i32.const 255))
 
+   (func (export "caml_lazy_make_forward")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (global.get $forward_tag))
+         (local.get $0)))
+
+   (func $obj_update_tag
+      (param (ref eq)) (param $o i32) (param $n i32) (result i32)
+      (local $b (ref $block))
+      (local.set $b (ref.cast $block (local.get $0)))
+      (if (result i32) (ref.eq (array.get $block (local.get $b) (i32.const 0))
+                               (i31.new (local.get $o)))
+         (then
+            (array.set $block (local.get $b) (i32.const 0)
+               (i31.new (local.get $n)))
+            (i32.const 1))
+         (else
+            (i32.const 0))))
+
+   (func (export "caml_lazy_reset_to_lazy") (param (ref eq)) (result (ref eq))
+      (drop (call $obj_update_tag (local.get 0)
+               (global.get $forcing_tag) (global.get $lazy_tag)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_lazy_update_to_forward") (param (ref eq)) (result (ref eq))
+      (drop (call $obj_update_tag (local.get 0)
+               (global.get $forcing_tag) (global.get $forward_tag)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_lazy_update_to_forcing")
+      (param (ref eq)) (result (ref eq))
+      (if (ref.test $block (local.get $0))
+         (then
+            (if (call $obj_update_tag (local.get 0)
+                   (global.get $lazy_tag) (global.get $forcing_tag))
+               (then (return (i31.new (i32.const 0)))))))
+      (i31.new (i32.const 1)))
+
    (func (export "caml_obj_tag") (param $v (ref eq)) (result (ref eq))
       (if (ref.test i31 (local.get $v))
          (then (return (i31.new (i32.const 1000)))))
@@ -563,10 +972,8 @@
       (if (ref.test $closure (local.get $v))
          (then (return (i31.new (global.get $closure_tag)))))
       ;; ZZZ float array
-      ;; ZZZ others?
       (if (ref.test $js (local.get $v))
-         (then (return (i31.new (global.get $custom_tag))))) ;; ZZZ ???
-      (call $log (i32.const 0))
+         (then (return (i31.new (global.get $abstract_tag)))))
       (unreachable))
 
    (func (export "caml_obj_make_forward")
@@ -583,6 +990,13 @@
                  (i32.add (i31.get_u (ref.cast i31 (local.get $size)))
                           (i32.const 1))))
 
+   (func (export "caml_alloc_dummy_function") (param $size (ref eq))  (param (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_alloc_dummy_function"))
+      (array.new $block (i31.new (i32.const 0))
+                 (i32.add (i31.get_u (ref.cast i31 (local.get $size)))
+                          (i32.const 1))))
+
    (func (export "caml_update_dummy")
       (param $dummy (ref eq)) (param $newval (ref eq)) (result (ref eq))
       (local $i i32)
@@ -618,6 +1032,7 @@
       ;; ZZZ float array
       (unreachable))
 
+   (export "caml_bytes_equal" (func $caml_string_equal))
    (func $caml_string_equal (export "caml_string_equal")
       (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
       (local $s1 (ref $string)) (local $s2 (ref $string))
@@ -640,26 +1055,80 @@
                (br $loop))))
       (i31.new (i32.const 1)))
 
-   (func (export "caml_string_notequal")
+   (export "caml_bytes_notequal" (func $caml_string_notequal))
+   (func $caml_string_notequal (export "caml_string_notequal")
       (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
       (return
          (i31.new (i32.eqz (i31.get_u (ref.cast i31
             (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
 
+   (func $string_compare
+      (param $p1 (ref eq)) (param $p2 (ref eq)) (result i32)
+      (local $s1 (ref $string)) (local $s2 (ref $string))
+      (local $l1 i32) (local $l2 i32) (local $len i32) (local $i i32)
+      (local $c1 i32) (local $c2 i32)
+      (if (ref.eq (local.get $p1) (local.get $p2))
+         (then (return (i32.const 0))))
+      (local.set $s1 (ref.cast $string (local.get $p1)))
+      (local.set $s2 (ref.cast $string (local.get $p2)))
+      (local.set $l1 (array.len $string (local.get $s1)))
+      (local.set $l2 (array.len $string (local.get $s2)))
+      (local.set $len (select (local.get $l1) (local.get $l2)
+                          (i32.le_u (local.get $l1) (local.get $l2))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $c1
+                  (array.get_u $string (local.get $s1) (local.get $i)))
+               (local.set $c2
+                  (array.get_u $string (local.get $s2) (local.get $i)))
+               (if (i32.lt_u (local.get $c1) (local.get $c2))
+                  (then (return (i32.const -1))))
+               (if (i32.gt_u (local.get $c1) (local.get $c2))
+                  (then (return (i32.const 1))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (if (i32.lt_u (local.get $l1) (local.get $l2))
+         (then (return (i32.const -1))))
+      (if (i32.gt_u (local.get $l1) (local.get $l2))
+         (then (return (i32.const 1))))
+      (i32.const 0))
+
+   (export "caml_bytes_compare" (func $caml_string_compare))
+   (func $caml_string_compare (export "caml_string_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $string_compare (local.get 0) (local.get 1))))
+
+   (export "caml_bytes_lessequal" (func $caml_string_lessequal))
+   (func $caml_string_lessequal (export "caml_string_lessequal")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.le_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
+   (export "caml_bytes_lessthan" (func $caml_string_lessthan))
+   (func $caml_string_lessthan (export "caml_string_lessthan")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.lt_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
+   (export "caml_bytes_greaterequal" (func $caml_string_greaterequal))
+   (func $caml_string_greaterequal (export "caml_string_greaterequal")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.ge_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
+   (export "caml_bytes_greaterthan" (func $caml_string_greaterthan))
+   (func $caml_string_greaterthan (export "caml_string_greaterthan")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.gt_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
    (export "caml_bytes_of_string" (func $caml_string_of_bytes))
    (func $caml_string_of_bytes (export "caml_string_of_bytes")
       (param $v (ref eq)) (result (ref eq))
       (local.get $v))
 
-   (func (export "caml_string_get")
-      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
-      (if (i32.ge_u (local.get $p) (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
-      (i31.new (array.get_u $string (local.get $s) (local.get $p))))
-
    (data $Bytes_create "Bytes.create")
 
    (func (export "caml_create_bytes")
@@ -678,49 +1147,29 @@
       (param $v1 (ref eq)) (param $i1 (ref eq))
       (param $v2 (ref eq)) (param $i2 (ref eq))
       (param $n (ref eq)) (result (ref eq))
-      (local $s1 (ref $string)) (local $p1 i32)
-      (local $s2 (ref $string)) (local $p2 i32)
-      (local $i i32) (local $l i32)
-      (local.set $l (i31.get_s (ref.cast i31 (local.get $n))))
-      (block $return
-         (br_if $return (i32.eqz (local.get $l)))
-         (local.set $s1 (ref.cast $string (local.get $v1)))
-         (local.set $p1 (i31.get_s (ref.cast i31 (local.get $i1))))
-         (local.set $s2 (ref.cast $string (local.get $v2)))
-         (local.set $p2 (i31.get_s (ref.cast i31 (local.get $i2))))
-         (if (ref.eq (local.get $v1) (local.get $v2))
-            (br_if $return (i32.eq (local.get $p1) (local.get $p2)))
-            (if (i32.gt_u (i32.add (local.get $p2) (local.get $l))
-                          (local.get $p1))
-               (then
-                  (local.set $i (i32.sub (local.get $l) (i32.const 1)))
-                  (loop $loop1
-                     (br_if $return (i32.lt_s (local.get $i) (i32.const 0l)))
-                     (array.set $string (local.get $s2)
-                        (i32.add (local.get $p2) (local.get $i))
-                        (array.get_u $string (local.get $s1)
-                           (i32.add (local.get $p1) (local.get $i))))
-                     (local.set $i (i32.sub (local.get $i) (i32.const 1)))
-                     (br $loop1)))))
-         (local.set $i (i32.const 0))
-         (loop $loop2
-            (br_if $return (i32.eq (local.get $i) (local.get $l)))
-            (array.set $string (local.get $s2)
-               (i32.add (local.get $p2) (local.get $i))
-               (array.get_u $string (local.get $s1)
-                  (i32.add (local.get $p1) (local.get $i))))
-            (local.set $i (i32.add (local.get $i) (i32.const 1)))
-            (br $loop2)))
+      (array.copy $string $string
+         (ref.cast $string (local.get $v2))
+         (i31.get_s (ref.cast i31 (local.get $i2)))
+         (ref.cast $string (local.get $v1))
+         (i31.get_s (ref.cast i31 (local.get $i1)))
+         (i31.get_s (ref.cast i31 (local.get $n))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_fill_bytes")
       (param $v (ref eq)) (param $offset (ref eq))
       (param $len (ref eq)) (param $init (ref eq))
       (result (ref eq))
+(;ZZZ V8 bug
+      (array.fill $string (ref.cast $string (local.get $v))
+         (i31.get_u (ref.cast i31 (local.get $offset)))
+         (i31.get_u (ref.cast i31 (local.get $init)))
+         (i31.get_u (ref.cast i31 (local.get $len))))
+;)
       (local $s (ref $string)) (local $i i32) (local $limit i32) (local $c i32)
       (local.set $s (ref.cast $string (local.get $v)))
       (local.set $i (i31.get_u (ref.cast i31 (local.get $offset))))
-      (local.set $limit (i32.add (local.get $i) (i31.get_u (ref.cast i31 (local.get $len)))))
+      (local.set $limit
+         (i32.add (local.get $i) (i31.get_u (ref.cast i31 (local.get $len)))))
       (local.set $c (i31.get_u (ref.cast i31 (local.get $init))))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $limit))
@@ -730,6 +1179,175 @@
                (br $loop))))
       (i31.new (i32.const 0)))
 
+   (export "caml_string_get16" (func $caml_bytes_get16))
+   (func $caml_bytes_get16 (export "caml_bytes_get16")
+      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (i31.new (i32.or
+                  (array.get_u $string (local.get $s) (local.get $p))
+                  (i32.shl (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 1)))
+                           (i32.const 8)))))
+
+   (export "caml_string_get32" (func $caml_bytes_get32))
+   (func $caml_bytes_get32 (export "caml_bytes_get32")
+      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (return_call $caml_copy_int32
+         (i32.or
+            (i32.or
+               (array.get_u $string (local.get $s) (local.get $p))
+               (i32.shl (array.get_u $string (local.get $s)
+                           (i32.add (local.get $p) (i32.const 1)))
+                        (i32.const 8)))
+            (i32.or
+               (i32.shl (array.get_u $string (local.get $s)
+                           (i32.add (local.get $p) (i32.const 2)))
+                        (i32.const 16))
+               (i32.shl (array.get_u $string (local.get $s)
+                           (i32.add (local.get $p) (i32.const 3)))
+                        (i32.const 24))))))
+
+   (export "caml_string_get64" (func $caml_bytes_get64))
+   (func $caml_bytes_get64 (export "caml_bytes_get64")
+      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (return_call $caml_copy_int64
+         (i64.or
+            (i64.or
+               (i64.or
+                  (i64.extend_i32_u
+                     (array.get_u $string (local.get $s) (local.get $p)))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 1))))
+                           (i64.const 8)))
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 2))))
+                           (i64.const 16))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 3))))
+                           (i64.const 24))))
+            (i64.or
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 4))))
+                           (i64.const 32))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 5))))
+                           (i64.const 40)))
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 6))))
+                           (i64.const 48))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 7))))
+                           (i64.const 56)))))))
+
+   (func (export "caml_bytes_set16")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32) (local $v i32)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $v (i31.get_s (ref.cast i31 (local.get 2))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (array.set $string (local.get $s) (local.get $p) (local.get $v))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 1))
+         (i32.shr_u (local.get $v) (i32.const 8)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_bytes_set32")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32) (local $v i32)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $v (struct.get $int32 1 (ref.cast $int32 (local.get 2))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (array.set $string (local.get $s) (local.get $p) (local.get $v))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 1))
+         (i32.shr_u (local.get $v) (i32.const 8)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 2))
+         (i32.shr_u (local.get $v) (i32.const 16)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 3))
+         (i32.shr_u (local.get $v) (i32.const 24)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_bytes_set64")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32) (local $v i64)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $v (struct.get $int64 1 (ref.cast $int64 (local.get 2))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (array.set $string (local.get $s) (local.get $p)
+         (i32.wrap_i64 (local.get $v)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 1))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 8))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 2))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 16))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 3))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 24))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 4))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 32))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 5))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 40))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 6))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 48))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 7))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 56))))
+      (i31.new (i32.const 0)))
+
    (type $int_array (array (mut i32)))
    (type $block_array (array (mut (ref $block))))
    (type $compare_stack
@@ -784,15 +1402,36 @@
    (func $push_compare_stack (param $stack (ref $compare_stack))
       (param $v1 (ref $block)) (param $v2 (ref $block)) (param $p i32)
       (result (ref $compare_stack))
-      (local $i i32)
+      (local $i i32) (local $len i32) (local $len' i32)
+      (local $stack' (ref $compare_stack))
       (local.set $i
          (i32.add (struct.get $compare_stack 0 (local.get $stack))
             (i32.const 1)))
-      ;; ZZZ Allocate a larger stack if necessary
-      (if (i32.ge_u (local.get $i)
-             (array.len (struct.get $compare_stack 1 (local.get $stack))))
-         (then       (call $log (i32.const 1))
-(unreachable)))
+      (local.set $len
+         (array.len (struct.get $compare_stack 1 (local.get $stack))))
+      (if (i32.ge_u (local.get $i) (local.get $len))
+         (then
+            (local.set $len' (i32.shl (local.get $len) (i32.const 1)))
+            (local.set $stack'
+               (struct.new $compare_stack (local.get $i)
+                  (array.new $block_array
+                     (global.get $dummy_block) (i32.const 8))
+                  (array.new $block_array
+                     (global.get $dummy_block) (i32.const 8))
+                  (array.new $int_array (i32.const 0) (i32.const 8))))
+            (array.copy $block_array $block_array
+               (struct.get $compare_stack 1 (local.get $stack')) (i32.const 0)
+               (struct.get $compare_stack 1 (local.get $stack)) (i32.const 0)
+               (local.get $len))
+            (array.copy $block_array $block_array
+               (struct.get $compare_stack 2 (local.get $stack')) (i32.const 0)
+               (struct.get $compare_stack 2 (local.get $stack)) (i32.const 0)
+               (local.get $len))
+            (array.copy $int_array $int_array
+               (struct.get $compare_stack 3 (local.get $stack')) (i32.const 0)
+               (struct.get $compare_stack 3 (local.get $stack)) (i32.const 0)
+               (local.get $len))
+            (local.set $stack (local.get $stack'))))
       (struct.set $compare_stack 0 (local.get $stack) (local.get $i))
       (array.set $block_array (struct.get $compare_stack 1 (local.get $stack))
          (local.get $i) (local.get $v1))
@@ -834,7 +1473,7 @@
    (func $compare_val
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32)
       (result i32)
-      (local $stack (ref $compare_stack)) (local $i i32) (local $res i32)
+      (local $stack (ref $compare_stack)) (local $n i32) (local $res i32)
       (local.set $stack (global.get $default_compare_stack))
       (struct.set $compare_stack 0 (local.get $stack) (i32.const -1))
       (local.set $res
@@ -844,19 +1483,31 @@
 ;;      (if (i32.gt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const 1))))
 ;;      (if (i32.lt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const -1))))
 ;;      (call $log (local.get $res))
-      (local.set $i (struct.get $compare_stack 0 (local.get $stack)))
       ;; clear stack (to avoid memory leaks)
-      (loop $loop
-         (if (i32.ge_s (local.get $i) (i32.const 0))
-            (then
-               (array.set $block_array
-                  (struct.get $compare_stack 1 (local.get $stack))
-                  (local.get $i) (global.get $dummy_block))
-               (array.set $block_array
-                  (struct.get $compare_stack 2 (local.get $stack))
-                  (local.get $i) (global.get $dummy_block))
-               (local.set $i (i32.sub (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (local.set $n (struct.get $compare_stack 0 (local.get $stack)))
+      (if (i32.ge_s (local.get $n) (i32.const 0))
+         (then
+(; ZZZ
+            (local.set $n (i32.add (local.get $n) (i32.const 1)))
+            (array.fill $block_array
+               (struct.get $compare_stack 1 (local.get $stack))
+               (i32.const 0) (global.get $dummy_block) (local.get $n))
+            (array.fill $block_array
+               (struct.get $compare_stack 2 (local.get $stack))
+               (i32.const 0) (global.get $dummy_block) (local.get $n))
+;)
+            (loop $loop
+               (if (i32.ge_s (local.get $n) (i32.const 0))
+                  (then
+                     (array.set $block_array
+                        (struct.get $compare_stack 1 (local.get $stack))
+                        (local.get $n) (global.get $dummy_block))
+                     (array.set $block_array
+                        (struct.get $compare_stack 2 (local.get $stack))
+                        (local.get $n) (global.get $dummy_block))
+                     (local.set $n (i32.sub (local.get $n) (i32.const 1)))
+                     (br $loop))))
+          ))
       (local.get $res))
 
    (func $do_compare_val
@@ -1120,10 +1771,236 @@
       (i31.new (i32.le_s (i32.const 0)
          (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
 
+   (func $caml_hash_mix_int (param $h i32) (param $d i32) (result i32)
+      (i32.add
+         (i32.mul
+            (i32.rotl
+               (i32.xor
+                  (i32.mul
+                     (i32.rotl
+                        (i32.mul (local.get $d) (i32.const 0xcc9e2d51))
+                        (i32.const 15))
+                     (i32.const 0x1b873593))
+                  (local.get $h))
+               (i32.const 13))
+            (i32.const 5))
+         (i32.const 0xe6546b64)))
+
+   (func $caml_hash_mix_final (param $h i32) (result i32)
+      (local.set $h
+         (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
+      (local.set $h (i32.mul (local.get $h) (i32.const 0x85ebca6b)))
+      (local.set $h
+         (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 13))))
+      (local.set $h (i32.mul (local.get $h) (i32.const 0xc2b2ae35)))
+      (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
+
+   (func $caml_hash_mix_int64 (param $h i32) (param $d i64) (result i32)
+      (return_call $caml_hash_mix_int
+         (call $caml_hash_mix_int (local.get $h) (i32.wrap_i64 (local.get $d)))
+         (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
+
+   (func $caml_hash_mix_float (param $h i32) (param $d f64) (result i32)
+      (local $i i64)
+      (local.set $i (i64.reinterpret_f64 (local.get $d)))
+      (if (i64.eq (i64.and (local.get $i) (i64.const 0x7FF0000000000000))
+                  (i64.const 0x7ff0000000000000))
+         (then
+            (if (i64.ne (i64.and (local.get $i) (i64.const 0xFFFFFFFFFFFFF))
+                        (i64.const 0))
+               (then (local.set $i (i64.const 0x7ff0000000000001))))))
+      (if (i64.eq (local.get $i) (i64.const 0x8000000000000000))
+         (then (local.set $i (i64.const 0))))
+      (return_call $caml_hash_mix_int64 (local.get $h) (local.get $i)))
+
+   (func $caml_hash_mix_string
+      (param $h i32) (param $s (ref $string)) (result i32)
+      (local $i i32) (local $len i32) (local $w i32)
+      (local.set $len (array.len (local.get $s)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len))
+            (then
+               (local.set $h
+                  (call $caml_hash_mix_int
+                     (local.get $h)
+                     (i32.or
+                        (i32.or
+                           (array.get_u $string (local.get $s) (local.get $i))
+                           (i32.shl (array.get_u $string (local.get $s)
+                                       (i32.add (local.get $i) (i32.const 1)))
+                                    (i32.const 8)))
+                        (i32.or
+                           (i32.shl (array.get_u $string (local.get $s)
+                                       (i32.add (local.get $i) (i32.const 2)))
+                                    (i32.const 16))
+                           (i32.shl (array.get_u $string (local.get $s)
+                                       (i32.add (local.get $i) (i32.const 3)))
+                                    (i32.const 24))))))
+               (local.set $i (i32.add (local.get $i) (i32.const 4)))
+               (br $loop))))
+      (local.set $w (i32.const 0))
+      (block $0_bytes
+         (block $1_byte
+            (block $2_bytes
+               (block $3_bytes
+                  (br_table $0_bytes $1_byte $2_bytes $3_bytes
+                     (i32.and (local.get $len) (i32.const 3))))
+               (local.set $w
+                  (i32.shl (array.get_u $string (local.get $s)
+                              (i32.add (local.get $i) (i32.const 2)))
+                           (i32.const 16))))
+            (local.set $w
+               (i32.or (local.get $w)
+                  (i32.shl (array.get_u $string (local.get $s)
+                              (i32.add (local.get $i) (i32.const 1)))
+                           (i32.const 8)))))
+         (local.set $w
+            (i32.or (local.get $w)
+               (array.get_u $string (local.get $s) (local.get $i))))
+         (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
+      (i32.xor (local.get $h) (local.get $len)))
+
+   (global $HASH_QUEUE_SIZE i32 (i32.const 256))
+
+   (global $caml_hash_queue (ref $block)
+      (array.new $block (i31.new (i32.const 0)) (global.get $HASH_QUEUE_SIZE)))
+
+   (func (export "caml_hash")
+      (param $count (ref eq)) (param $limit (ref eq)) (param $seed (ref eq))
+      (param $obj (ref eq)) (result (ref eq))
+      (local $sz i32) (local $num i32) (local $h i32)
+      (local $rd i32) (local $wr i32)
+      (local $v (ref eq))
+      (local $b (ref $block))
+      (local $i i32)
+      (local $len i32)
+      (local $tag i32)
+      (local.set $sz (i31.get_u (ref.cast i31 (local.get $limit))))
+      (if (i32.gt_u (local.get $sz) (global.get $HASH_QUEUE_SIZE))
+         (then (local.set $sz (global.get $HASH_QUEUE_SIZE))))
+      (local.set $num (i31.get_u (ref.cast i31 (local.get $count))))
+      (local.set $h (i31.get_s (ref.cast i31 (local.get $seed))))
+      (array.set $block
+         (global.get $caml_hash_queue) (i32.const 0) (local.get $obj))
+      (local.set $rd (i32.const 0))
+      (local.set $wr (i32.const 1))
+      (loop $loop
+         (if (i32.and (i32.lt_u (local.get $rd) (local.get $wr))
+                      (i32.gt_u (local.get $num) (i32.const 0)))
+            (then
+               (local.set $v
+                  (array.get $block (global.get $caml_hash_queue)
+                     (local.get $rd)))
+               (local.set $rd (i32.add (local.get $rd) (i32.const 1)))
+               (block $again
+                  (drop (block $not_int (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (i31.get_s
+                              (br_on_cast_fail $not_int i31 (local.get $v)))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  (drop (block $not_string (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_string (local.get $h)
+                           (br_on_cast_fail $not_string $string (local.get $v))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  (drop (block $not_block (result (ref eq))
+                     (local.set $b
+                        (br_on_cast_fail $not_block $block (local.get $v)))
+                     (local.set $tag
+                        (i31.get_u
+                           (ref.cast i31
+                              (array.get $block (local.get $b) (i32.const 0)))))
+                     ;; ZZZ Special tags (forward / object)
+                     (local.set $len (array.len (local.get $b)))
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (i32.or
+                              (i32.sub (local.get $len) (i32.const 1))
+                              (local.get $tag))))
+                     (local.set $i (i32.const 1))
+                     (loop $block_iter
+                        (br_if $loop (i32.ge_u (local.get $i) (local.get $len)))
+                        (br_if $loop (i32.ge_u (local.get $wr) (local.get $sz)))
+                        (array.set $block (global.get $caml_hash_queue)
+                           (local.get $wr)
+                           (array.get $block (local.get $b) (local.get $i)))
+                        (local.set $wr (i32.add (local.get $wr) (i32.const 1)))
+                        (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                        (br $block_iter))))
+                  (drop (block $not_float (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_float (local.get $h)
+                           (struct.get $float 0
+                              (br_on_cast_fail $not_float $float
+                                 (local.get $v)))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  (drop (block $not_custom (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (call_ref $value->int
+                              (local.get $v)
+                              (struct.get $custom_operations 2
+                                 (br_on_null $loop
+                                    (struct.get $custom 0
+                                       (br_on_cast_fail $not_custom $custom
+                                          (local.get $v))))))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  ;; ZZZ other cases? (closures, javascript values)
+                  (unreachable)
+                  (br $loop)))))
+      ;; clear the queue to avoid a memory leak
+      (array.fill $block (global.get $caml_hash_queue)
+         (i32.const 0) (i31.new (i32.const 0)) (local.get $wr))
+      (i31.new (call $caml_hash_mix_final (local.get $h))))
+
+   (func (export "caml_marshal_data_size")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_marshal_data_size"))
+      (unreachable))
+
+   (func (export "caml_input_value") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_input_value"))
+      (unreachable))
+
+   (func (export "caml_input_value_from_bytes")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_input_value_from_bytes"))
+      (unreachable))
+
+   (func (export "caml_output_value")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_output_value"))
+      (unreachable))
+
+   (func (export "caml_output_value_to_buffer")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_output_value_to_buffer"))
+      (unreachable))
+
+   (func (export "caml_output_value_to_string")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_output_value_to_string"))
+      (unreachable))
+
    ;; ZZZ
    (func $dummy_format_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $log_js (string.const "dummy_format_fun"))
       (array.new_fixed $string (i32.const 64)))
    (func (export "%caml_format_int_special") (param (ref eq)) (result (ref eq))
+      (call $log_js (string.const "%caml_format_int_special"))
       (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 0)))))
    (func (export "caml_format_int") (param (ref eq)) (param (ref eq)) (result (ref eq))
       (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 1)))))
@@ -1143,10 +2020,42 @@
       (param (ref eq)) (result (ref eq))
       (array.new_fixed $block (i31.new (i32.const 0))))
 
+   (func (export "caml_backtrace_status")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
    (func (export "caml_convert_raw_backtrace")
       (param (ref eq)) (result (ref eq))
       (array.new_fixed $block (i31.new (i32.const 0))))
 
+   (data $raw_backtrace_slot_err
+      "Printexc.get_raw_backtrace_slot: index out of bounds")
+
+   (func (export "caml_raw_backtrace_slot")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      (call $caml_invalid_argument
+          (array.new_data $string $raw_backtrace_slot_err
+             (i32.const 0) (i32.const 52)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_convert_raw_backtrace_slot")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_restore_raw_backtrace")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_get_current_callstack")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_get_public_method")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_get_public_method"))
+      (i31.new (i32.const 0)))
+
    (func (export "caml_ml_debug_info_status")
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
@@ -1155,6 +2064,84 @@
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0xfffffff)))
 
+   (func (export "caml_ephe_create")
+      (param (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_create"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_get_data")
+      (param (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_get_data"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_set_data")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_set_data"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_set_key")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_set_key"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_unset_key")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_unset_key"))
+      (i31.new (i32.const 0)))
+
+   (global $caml_ephe_none (ref eq)
+      (array.new_fixed $block (i31.new (global.get $abstract_tag))))
+
+   (data $Weak_create "Weak.create")
+
+   (func (export "caml_weak_create")
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $len i32)
+      (local $res (ref $block))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (if (i32.lt_s (local.get $len) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Weak_create
+                  (i32.const 0) (i32.const 11)))))
+      (local.set $res
+         (array.new $block (global.get $caml_ephe_none)
+            (i32.add (local.get $len) (i32.const 3))))
+      (array.set $block (local.get $res) (i32.const 0)
+         (i31.new (global.get $abstract_tag)))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_create"))
+      (local.get $res))
+
+   (func (export "caml_weak_blit")
+      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_blit"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_weak_check")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_check"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_weak_get")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_get"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_weak_get_copy")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_get_copy"))
+      (i31.new (i32.const 0)))
+
    (global $bigarray_ops (ref $custom_operations)
       ;; ZZZ
       (struct.new $custom_operations
@@ -1168,86 +2155,614 @@
       (sub $custom
          (struct
             (field (ref $custom_operations))
-            (field (ref array)) ;; data
+            (field externref) ;; data
             (field (ref $int_array)) ;; size in each dimension
             (field i8) ;; number of dimensions
             (field i8) ;; kind
             (field i8)))) ;; layout
 
+   (func $caml_ba_get_size (param $dim (ref $int_array)) (result i32)
+      (local $i i32) (local $n i32) (local $sz i32)
+      (local.set $n (array.len (local.get $dim)))
+      (local.set $i (i32.const 0))
+      (local.set $sz (i32.const 1))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $n))
+            (then
+               ;; ZZZ Check for overflow
+               (local.set $sz
+                   (i32.mul (local.get $sz)
+                      (array.get $int_array
+                         (local.get $dim) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $sz))
+
+  (func $caml_ba_size_per_element (param $kind i32) (result i32)
+     (select (i32.const 2) (i32.const 1)
+        (i32.or (i32.eq (local.get $kind) (i32.const 7))
+                (i32.or (i32.eq (local.get $kind) (i32.const 10))
+                        (i32.eq (local.get $kind) (i32.const 11))))))
+
+  (func $caml_ba_create_buffer
+     (param $kind i32) (param $sz i32) (result externref)
+     (return_call $ta_create (local.get $kind)
+        ;; ZZZ Check for overflow
+        (i32.mul (local.get $sz)
+           (call $caml_ba_size_per_element (local.get $kind)))))
+
+   (global $CAML_BA_MAX_NUM_DIMS i32 (i32.const 16))
+
+   (data $ba_create_bad_dims "Bigarray.create: bad number of dimensions")
+   (data $ba_create_negative_dim "Bigarray.create: negative dimension")
+
    (func (export "caml_ba_create")
-      (param $kind (ref eq)) (param $layout (ref eq)) (param $d (ref eq))
+      (param $vkind (ref eq)) (param $layout (ref eq)) (param $d (ref eq))
       (result (ref eq))
-      (local $dims (ref $block))
-      (local $num_dims i32)
-      (local $len i32)
-      (local $data (ref $string))
-      (local.set $dims (ref.cast $block (local.get $d)))
-      (local.set $num_dims (i32.sub (array.len (local.get $dims)) (i32.const 1)))
-      (if (i32.eqz (i32.eq (local.get $num_dims) (i32.const 1)))
-         (then (unreachable))) ;;ZZZ
-      (local.set $len
-         (i31.get_u (ref.cast i31
-            (array.get $block (local.get $dims) (i32.const 1)))))
-      (local.set $data (array.new $string (i32.const 0) (local.get $len)))
+      (local $vdim (ref $block))
+      (local $dim (ref $int_array))
+      (local $kind i32) (local $num_dims i32) (local $i i32) (local $n i32)
+      (local.set $kind (i31.get_s (ref.cast i31 (local.get $vkind))))
+      (local.set $vdim (ref.cast $block (local.get $d)))
+      (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1)))
+      (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $ba_create_bad_dims
+                  (i32.const 0) (i32.const 41)))))
+      (local.set $dim
+         (array.new $int_array (i32.const 0) (local.get $num_dims)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $num_dims))
+            (then
+               (local.set $n
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $vdim)
+                           (i32.add (local.get $i) (i32.const 1))))))
+               (if (i32.lt_s (local.get $n) (i32.const 0))
+                  (then
+                     (call $caml_invalid_argument
+                        (array.new_data $string $ba_create_negative_dim
+                              (i32.const 0) (i32.const 35)))))
+               (array.set $int_array
+                  (local.get $dim) (local.get $i) (local.get $n))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
       (struct.new $bigarray
          (global.get $bigarray_ops)
-         (local.get $data)
-         (array.new_fixed $int_array (i32.const 1))
+         (call $caml_ba_create_buffer (local.get $kind)
+            (call $caml_ba_get_size (local.get $dim)))
+         (local.get $dim)
          (local.get $num_dims)
-         (i31.get_s (ref.cast i31 (local.get $kind)))
+         (local.get $kind)
          (i31.get_s (ref.cast i31 (local.get $layout)))))
 
+   (data $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind")
+   (data $ta_too_large "Typed_array.to_genarray: too large")
+
    (func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq))
-      (local $ta externref)
-      (local $len i32) (local $i i32)
-      (local $data (ref $string))
-      ;; ZZZ
-      (local.set $ta (extern.externalize (call $unwrap (local.get 0))))
-      (local.set $len (call $array_length (local.get $ta)))
-      (local.set $data (array.new $string (i32.const 0) (local.get $len)))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $len))
-            (then
-               (array.set $string (local.get $data) (local.get $i)
-                  (call $get_int (local.get $ta) (local.get $i)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (local $data externref)
+      (local $kind i32)
+      (local $len i32)
+      (local.set $data
+         (call $ta_normalize (extern.externalize (call $unwrap (local.get 0)))))
+      (local.set $kind (call $ta_kind (local.get $data)))
+      (if (i32.lt_s (local.get $kind) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $ta_unsupported_kind
+                  (i32.const 0) (i32.const 41)))))
+      (local.set $len (call $ta_length (local.get $data)))
+      (if (i32.lt_s (local.get $len) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $ta_too_large
+                  (i32.const 0) (i32.const 34)))))
       (struct.new $bigarray
          (global.get $bigarray_ops)
          (local.get $data)
-         (array.new_fixed $int_array (i32.const 1))
+         (array.new_fixed $int_array (local.get $len))
          (i32.const 1)
-         (i32.const 0)
+         (local.get $kind)
          (i32.const 0)))
 
+   (func (export "caml_ba_to_typed_array") (param (ref eq)) (result (ref eq))
+      (call $wrap
+         (extern.internalize
+            (struct.get $bigarray 1 (ref.cast $bigarray (local.get $0))))))
+
+   (func $caml_ba_get_at_offset
+      (param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
+      (local $data externref)
+      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
+      (block $float32
+       (block $float64
+        (block $int8
+         (block $uint8
+          (block $int16
+           (block $uint16
+            (block $int32
+             (block $int64
+              (block $nativeint
+               (block $int
+                (block $complex32
+                 (block $complex64
+                  (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                            $int32 $int64 $nativeint $int
+                            $complex32 $complex64 $uint8
+                     (struct.get $bigarray 4 (local.get $ba))))
+                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                 (return
+                    (array.new_fixed $block
+                       (i31.new (global.get $double_array_tag))
+                       (struct.new $float
+                          (call $ta_get_f64 (local.get $data) (local.get $i)))
+                       (struct.new $float
+                          (call $ta_get_f64 (local.get $data)
+                             (i32.add (local.get $i) (i32.const 1)))))))
+                (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                (return
+                   (array.new_fixed $block
+                      (i31.new (global.get $double_array_tag))
+                      (struct.new $float
+                         (call $ta_get_f32 (local.get $data) (local.get $i)))
+                      (struct.new $float
+                         (call $ta_get_f32 (local.get $data)
+                            (i32.add (local.get $i) (i32.const 1)))))))
+               (return
+                  (i31.new
+                     (call $ta_get_i32 (local.get $data) (local.get $i)))))
+              (return_call $caml_copy_nativeint
+                 (call $ta_get_i32 (local.get $data) (local.get $i))))
+             (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+             (return_call $caml_copy_int64
+                (i64.or
+                   (i64.extend_i32_u
+                      (call $ta_get_i32 (local.get $data) (local.get $i)))
+                   (i64.shl
+                      (i64.extend_i32_u
+                         (call $ta_get_i32 (local.get $data)
+                            (i32.add (local.get $i) (i32.const 1))))
+                      (i64.const 32)))))
+            (return_call $caml_copy_int32
+               (call $ta_get_i32 (local.get $data) (local.get $i))))
+           (return (i31.new
+                      (call $ta_get_ui16 (local.get $data) (local.get $i)))))
+          (return (i31.new
+                     (call $ta_get_i16 (local.get $data) (local.get $i)))))
+         (return (i31.new
+                    (call $ta_get_ui8 (local.get $data) (local.get $i)))))
+        (return (i31.new
+                   (call $ta_get_i8 (local.get $data) (local.get $i)))))
+       (return (struct.new $float
+                  (call $ta_get_f64 (local.get $data) (local.get $i)))))
+      (return (struct.new $float
+                 (call $ta_get_f32 (local.get $data) (local.get $i)))))
+
+   (func $caml_ba_set_at_offset
+      (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq))
+      (local $data externref)
+      (local $b (ref $block)) (local $l i64)
+      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
+      (block $float32
+       (block $float64
+        (block $int8
+         (block $uint8
+          (block $int16
+           (block $uint16
+            (block $int32
+             (block $int64
+              (block $nativeint
+               (block $int
+                (block $complex32
+                 (block $complex64
+                  (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                            $int32 $int64 $nativeint $int
+                            $complex32 $complex64 $uint8
+                     (struct.get $bigarray 4 (local.get $ba))))
+                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                 (local.set $b (ref.cast $block (local.get $v)))
+                 (call $ta_set_f64 (local.get $data) (local.get $i)
+                    (struct.get $float 0
+                       (ref.cast $float
+                          (array.get $block (local.get $b) (i32.const 1)))))
+                 (call $ta_set_f64 (local.get $data)
+                    (i32.add (local.get $i) (i32.const 1))
+                    (struct.get $float 0
+                       (ref.cast $float
+                         (array.get $block (local.get $b) (i32.const 2)))))
+                 (return))
+                (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                (local.set $b (ref.cast $block (local.get $v)))
+                (call $ta_set_f32 (local.get $data) (local.get $i)
+                   (struct.get $float 0
+                      (ref.cast $float
+                         (array.get $block (local.get $b) (i32.const 1)))))
+                (call $ta_set_f32 (local.get $data)
+                   (i32.add (local.get $i) (i32.const 1))
+                   (struct.get $float 0
+                      (ref.cast $float
+                         (array.get $block (local.get $b) (i32.const 2)))))
+                (return))
+               (call $ta_set_i32 (local.get $data) (local.get $i)
+                  (i31.get_s (ref.cast i31 (local.get $v))))
+               (return))
+              (call $ta_set_i32 (local.get $data) (local.get $i)
+                 (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+              (return))
+             (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+             (local.set $l
+                (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+             (call $ta_set_i32 (local.get $data) (local.get $i)
+                (i32.wrap_i64 (local.get $l)))
+             (call $ta_set_i32 (local.get $data)
+                (i32.add (local.get $i) (i32.const 1))
+                (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32))))
+             (return))
+            (call $ta_set_i32 (local.get $data) (local.get $i)
+               (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+            (return))
+           (call $ta_set_ui16 (local.get $data) (local.get $i)
+              (ref.cast i31 (local.get $v)))
+           (return))
+          (call $ta_set_i16 (local.get $data) (local.get $i)
+             (ref.cast i31 (local.get $v)))
+          (return))
+         (call $ta_set_ui8 (local.get $data) (local.get $i)
+            (ref.cast i31 (local.get $v)))
+         (return))
+        (call $ta_set_i8 (local.get $data) (local.get $i)
+           (ref.cast i31 (local.get $v)))
+        (return))
+       (call $ta_set_f64 (local.get $data) (local.get $i)
+          (struct.get $float 0 (ref.cast $float (local.get 0))))
+       (return))
+      (call $ta_set_f32 (local.get $data) (local.get $i)
+         (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (return))
+
+   (data $Bigarray_dim "Bigarray.dim")
+
+   (func $caml_ba_dim (export "caml_ba_dim")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $dim (ref $int_array))
+      (local $i i32)
+      (local.set $dim
+         (struct.get $bigarray 2 (ref.cast $bigarray (local.get 0))))
+      (local.set $i (i31.get_s (ref.cast i31 (local.get $1))))
+      (if (i32.ge_u (local.get $i) (array.len (local.get $dim)))
+         (then (call $caml_invalid_argument
+                  (array.new_data $string $Bigarray_dim
+                     (i32.const 0) (i32.const 12)))))
+      (i31.new (array.get $int_array (local.get $dim) (local.get $i))))
+
+   (func (export "caml_ba_dim_1")
+      (param (ref eq)) (result (ref eq))
+      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 0))))
+
    (func (export "caml_ba_get_1")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $ba (ref $bigarray))
       (local $i i32)
       (local.set $ba (ref.cast $bigarray (local.get 0)))
       (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
-      ;; ZZZ bound check / kind / layout
-      (i31.new (array.get_u $string
-                  (ref.cast $string (struct.get $bigarray 1 (local.get $ba)))
-                  (local.get $i))))
+      (if (struct.get $bigarray 5 (local.get $ba))
+         (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
+      (if (i32.ge_u (local.get $i)
+             (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
+                (i32.const 0)))
+         (call $caml_bound_error))
+      (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i)))
 
    (func (export "caml_ba_set_1")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (param (ref eq)) (param (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $ba (ref $bigarray))
       (local $i i32)
       (local.set $ba (ref.cast $bigarray (local.get 0)))
       (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
-      ;; ZZZ bound check / kind / layout
-      (array.set $string
-         (ref.cast $string (struct.get $bigarray 1 (local.get $ba)))
-         (local.get $i) (i31.get_u (ref.cast i31 (local.get 2))))
+      (if (struct.get $bigarray 5 (local.get $ba))
+         (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
+      (if (i32.ge_u (local.get $i)
+             (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
+                (i32.const 0)))
+         (call $caml_bound_error))
+      (call $caml_ba_set_at_offset
+         (local.get $ba) (local.get $i) (local.get $v))
       (i31.new (i32.const 0)))
 
+   (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
+      ;; ZZZ used to convert a typed array to a string...
+      (call $log_js (string.const "caml_string_of_array"))
+      (unreachable))
+
    (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
+      (local $a f64)
+      (local.set $a
+         (f64.abs (struct.get $float 0 (ref.cast $float (local.get 0)))))
+      (i31.new
+         (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
+            (then
+               (if (result i32) (f64.lt (local.get $a) (f64.const infinity))
+                  (then (i32.const 0)) ;; normal
+                  (else (i32.const 3)))) ;; infinity
+            (else
+               (if (result i32) (f64.eq (local.get $a) (f64.const 0))
+                  (then (i32.const 2)) ;; zero
+                  (else
+                     (if (result i32) (f64.eq (local.get $a) (local.get $a))
+                        (then (i32.const 1)) ;; subnormal
+                        (else (i32.const 4))))))))) ;; nan
+
+   (func (export "caml_modf_float") (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $a f64) (local $i f64) (local $f f64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $a (f64.abs (local.get $x)))
+      (if (f64.ge (local.get $a) (f64.const 0))
+         (then
+            (if (f64.lt (local.get $a) (f64.const infinity))
+               (then ;; normal
+                  (local.set $i (f64.floor (local.get $a)))
+                  (local.set $f (f64.sub (local.get $a) (local.get $i)))
+                  (local.set $i (f64.copysign (local.get $i) (local.get $x)))
+                  (local.set $f (f64.copysign (local.get $f) (local.get $x))))
+               (else ;; infinity
+                  (local.set $i (local.get $x))
+                  (local.set $f (f64.copysign (f64.const 0) (local.get $x))))))
+         (else ;; zero or nan
+            (local.set $i (local.get $x))
+            (local.set $f (local.get $x))))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
+
+   (func (export "caml_ldexp")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $n i32)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $n (i31.get_s (ref.cast i31 (local.get 1))))
+      (if (i32.gt_s (local.get $n) (i32.const 1023))
+         (then
+            (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
+            (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
+            (if (i32.gt_s (local.get $n) (i32.const 1023))
+               (then
+                  ;; subnormal
+                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
+                  (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
+                  (if (i32.gt_s (local.get $n) (i32.const 1023))
+                     (then (local.set $n (i32.const 1023))))))
+         (else
+            (if (i32.lt_s (local.get $n) (i32.const -1022))
+               (then
+                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p-969)))
+                  (local.set $n (i32.add (local.get $n) (i32.const 969)))
+                  (if (i32.lt_s (local.get $n) (i32.const -1022))
+                     (then
+                        (local.set $x
+                           (f64.mul (local.get $x) (f64.const 0x1p-969)))
+                        (local.set $n (i32.add (local.get $n) (i32.const 969)))
+                        (if (i32.lt_s (local.get $n) (i32.const -1022))
+                           (then (local.set $n (i32.const -1022)))))))))))
+      (struct.new $float
+         (f64.mul (local.get $x)
+            (f64.reinterpret_i64
+               (i64.shl (i64.add (i64.extend_i32_s (local.get $n))
+                                 (i64.const 0x3ff))
+                        (i64.const 52))))))
+
+   (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log (i32.const 26))
-      (unreachable)
+      (call $log_js (string.const "caml_float_of_string"))
+      (unreachable))
+
+   (func (export "caml_float_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $y f64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (if (f64.eq (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const 0)))))
+      (if (f64.lt (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (if (f64.gt (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (if (f64.eq (local.get $x) (local.get $x))
+         (then (return (i31.new (i32.const 1)))))
+      (if (f64.eq (local.get $y) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_nextafter")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $y f64) (local $i i64) (local $j i64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
+      (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
+      (if (f64.eq (local.get $x) (local.get $y))
+         (then (return (local.get 1))))
+      (if (result (ref eq)) (f64.eq (local.get $x) (f64.const 0))
+         (then
+            (if (f64.ge (local.get $y) (f64.const 0))
+               (then (return (struct.new $float (f64.const 0x1p-1074))))
+               (else (return (struct.new $float (f64.const -0x1p-1074))))))
+         (else
+            (local.set $i (i64.reinterpret_f64 (local.get $x)))
+            (local.set $j (i64.reinterpret_f64 (local.get $y)))
+            (if (i32.and (i64.lt_s (local.get $i) (local.get $j))
+                         (i64.lt_u (local.get $i) (local.get $j)))
+               (then (local.set $i (i64.add (local.get $i) (i64.const 1))))
+               (else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
+            (return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
+
+   (func (export "caml_atomic_cas")
+      (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
+      (result (ref eq))
+      (local $b (ref $block))
+      (local.set $b (ref.cast $block (local.get $ref)))
+      (if (result (ref eq))
+         (ref.eq (array.get $block (local.get $b) (i32.const 1))
+                 (local.get $o))
+         (then
+            (array.set $block (local.get $b) (i32.const 1) (local.get $n))
+            (i31.new (i32.const 1)))
+         (else
+            (i31.new (i32.const 0)))))
+
+   (func (export "caml_atomic_load") (param (ref eq)) (result (ref eq))
+      (array.get $block (ref.cast $block (local.get 0)) (i32.const 1)))
+
+   (func (export "caml_atomic_fetch_add")
+     (param $ref (ref eq)) (param $i (ref eq)) (result (ref eq))
+     (local $b (ref $block))
+     (local $old (ref eq))
+     (local.set $b (ref.cast $block (local.get $ref)))
+     (local.set $old (array.get $block (local.get $b) (i32.const 1)))
+     (array.set $block (local.get $b) (i32.const 1)
+        (i31.new (i32.add (i31.get_s (ref.cast i31 (local.get $old)))
+                          (i31.get_s (ref.cast i31 (local.get $i))))))
+     (local.get $old))
+
+   (global $caml_domain_dls (mut (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_domain_dls_set") (param $a (ref eq)) (result (ref eq))
+      (global.set $caml_domain_dls (local.get $a))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_domain_dls_get") (param (ref eq)) (result (ref eq))
+      (global.get $caml_domain_dls))
+
+   (func (export "caml_lxm_next") (param $v (ref eq)) (result (ref eq))
+      (local $data externref)
+      (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64)
+      (local $z i64)
+      (local.set $data
+         (struct.get $bigarray 1 (ref.cast $bigarray (local.get $v))))
+      (local.set $a
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 0)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 1)))
+               (i64.const 32))))
+      (local.set $s
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 2)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 3)))
+               (i64.const 32))))
+      (local.set $q0
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 4)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 5)))
+               (i64.const 32))))
+      (local.set $q1
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 6)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 7)))
+               (i64.const 32))))
+      (local.set $z (i64.add (local.get $s) (local.get $q0)))
+      (local.set $z
+         (i64.mul (i64.xor (local.get $z)
+                           (i64.shr_u (local.get $z) (i64.const 32)))
+                  (i64.const 0xdaba0b6eb09322e3)))
+      (local.set $z
+         (i64.mul (i64.xor (local.get $z)
+                           (i64.shr_u (local.get $z) (i64.const 32)))
+                  (i64.const 0xdaba0b6eb09322e3)))
+      (local.set $z
+         (i64.xor (local.get $z) (i64.shr_u (local.get $z) (i64.const 32))))
+      (local.set $s
+         (i64.add (i64.mul (local.get $s) (i64.const 0xd1342543de82ef95))
+                  (local.get $a)))
+      (call $ta_set_i32 (local.get $data) (i32.const 2)
+         (i32.wrap_i64 (local.get $s)))
+      (call $ta_set_i32 (local.get $data) (i32.const 3)
+         (i32.wrap_i64 (i64.shr_u (local.get $s) (i64.const 32))))
+      (local.set $q1 (i64.xor (local.get $q1) (local.get $q0)))
+      (local.set $q0 (i64.rotl (local.get $q0) (i64.const 24)))
+      (local.set $q0 (i64.xor (i64.xor (local.get $q0) (local.get $q1))
+                              (i64.shl (local.get $q1) (i64.const 16))))
+      (local.set $q1 (i64.rotl (local.get $q1) (i64.const 37)))
+      (call $ta_set_i32 (local.get $data) (i32.const 4)
+         (i32.wrap_i64 (local.get $q0)))
+      (call $ta_set_i32 (local.get $data) (i32.const 5)
+         (i32.wrap_i64 (i64.shr_u (local.get $q0) (i64.const 32))))
+      (call $ta_set_i32 (local.get $data) (i32.const 6)
+         (i32.wrap_i64 (local.get $q1)))
+      (call $ta_set_i32 (local.get $data) (i32.const 7)
+         (i32.wrap_i64 (i64.shr_u (local.get $q1) (i64.const 32))))
+      (return_call $caml_copy_int64 (local.get $z)))
+
+   (func (export "create_nat")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "create_nat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "incr_nat")
+      (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "incr_nat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "initialize_nat")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "set_digit_nat")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "set_digit_nat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "set_to_zero_nat")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "set_to_zero_nat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "unix_gettimeofday")
+      (param (ref eq)) (result (ref eq))
+      (struct.new $float (call $gettimeofday)))
+
+   (func (export "caml_alloc_tm")
+      (param $sec i32) (param $min i32) (param $hour i32) (param $mday i32)
+      (param $mon i32) (param $year i32) (param $wday i32) (param $yday $i32)
+      (param $isdst i32) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (i31.new (local.get $sec))
+         (i31.new (local.get $min))
+         (i31.new (local.get $hour))
+         (i31.new (local.get $mday))
+         (i31.new (local.get $mon))
+         (i31.new (local.get $year))
+         (i31.new (local.get $wday))
+         (i31.new (local.get $yday))
+         (i31.new (local.get $isdst))))
+
+   (func (export "unix_gmtime") (param (ref eq)) (result (ref eq))
+      (call $gmtime))
+
+   (func (export "unix_localtime") (param (ref eq)) (result (ref eq))
+      (call $localtime))
+
+   (func (export "unix_time") (param (ref eq)) (result (ref eq))
+      (struct.new $float (f64.floor (call $gettimeofday))))
+
+   (func (export "unix_inet_addr_of_string")
+      (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 
    (type $js (struct (field anyref)))
@@ -1269,23 +2784,92 @@
    (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
    (import "bindings" "get" (func $get (param externref) (param anyref) (result anyref)))
    (import "bindings" "set" (func $set (param anyref) (param anyref) (param anyref)))
+   (import "bindings" "delete" (func $delete (param anyref) (param anyref)))
+   (import "bindings" "instanceof"
+      (func $instanceof (param anyref) (param anyref) (result i32)))
+   (import "bindings" "typeof" (func $typeof (param anyref) (result anyref)))
+   (import "bindings" "equals" (func $equals (param anyref) (param anyref) (result i32)))
    (import "bindings" "strict_equals" (func $strict_equals (param anyref) (param anyref) (result i32)))
-   (import "bindings" "fun_call" (func $fun_call (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "fun_call"
+      (func $fun_call
+         (param anyref) (param anyref) (param anyref) (result anyref)))
    (import "bindings" "meth_call" (func $meth_call (param anyref) (param anyref) (param anyref) (result anyref)))
    (import "bindings" "new" (func $new (param anyref) (param anyref) (result anyref)))
    (import "bindings" "new_obj" (func $new_obj (result anyref)))
    (import "bindings" "new_array" (func $new_array (param i32) (result externref)))
+   (import "bindings" "iter_props"
+      (func $iter_props (param anyref) (param anyref)))
    (import "bindings" "array_length"
       (func $array_length (param externref) (result i32)))
    (import "bindings" "array_get"
       (func $array_get (param externref) (param i32) (result anyref)))
    (import "bindings" "array_set"
       (func $array_set (param externref) (param i32) (param anyref)))
+   (import "bindings" "wrap_callback"
+      (func $wrap_callback (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_callback_args"
+      (func $wrap_callback_args (param (ref eq)) (result anyref)))
    (import "bindings" "wrap_callback_strict"
       (func $wrap_callback_strict (param i32) (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_callback_unsafe"
+      (func $wrap_callback_unsafe (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback"
+      (func $wrap_meth_callback (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback_args"
+      (func $wrap_meth_callback_args (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback_strict"
+      (func $wrap_meth_callback_strict (param i32) (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback_unsafe"
+      (func $wrap_meth_callback_unsafe (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_fun_arguments"
+      (func $wrap_fun_arguments (param anyref) (result anyref)))
    (import "bindings" "get_int" (func $get_int (param externref) (param i32) (result i32)))
    (import "bindings" "format" (func $format_float (param f64) (result anyref)))
    (import "bindings" "format" (func $format_int (param (ref eq)) (result anyref)))
+   (import "bindings" "ta_create"
+      (func $ta_create (param i32) (param i32) (result externref)))
+   (import "bindings" "ta_normalize"
+      (func $ta_normalize (param externref) (result externref)))
+   (import "bindings" "ta_kind" (func $ta_kind (param externref) (result i32)))
+   (import "bindings" "ta_length"
+      (func $ta_length (param externref) (result i32)))
+   (import "bindings" "ta_get_f64"
+      (func $ta_get_f64 (param externref) (param i32) (result f64)))
+   (import "bindings" "ta_get_f32"
+      (func $ta_get_f32 (param externref) (param i32) (result f64)))
+   (import "bindings" "ta_get_i32"
+      (func $ta_get_i32 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_i16"
+      (func $ta_get_i16 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_ui16"
+      (func $ta_get_ui16 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_i8"
+      (func $ta_get_i8 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_ui8"
+      (func $ta_get_ui8 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_set_f64"
+      (func $ta_set_f64 (param externref) (param i32) (param f64)))
+   (import "bindings" "ta_set_f32"
+      (func $ta_set_f32 (param externref) (param i32) (param f64)))
+   (import "bindings" "ta_set_i32"
+      (func $ta_set_i32 (param externref) (param i32) (param i32)))
+   (import "bindings" "ta_set_i16"
+      (func $ta_set_i16 (param externref) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set_ui16"
+      (func $ta_set_ui16 (param externref) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set_i8"
+      (func $ta_set_i8 (param externref) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set_ui8"
+      (func $ta_set_ui8 (param externref) (param i32) (param (ref i31))))
+   (import "bindings" "gettimeofday" (func $gettimeofday (result f64)))
+   (import "bindings" "gmtime" (func $gmtime (result (ref eq))))
+   (import "bindings" "localtime" (func $localtime (result (ref eq))))
+   (import "bindings" "random_seed" (func $random_seed (result externref)))
+
+   (func (export "caml_js_equals")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $equals
+                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
 
    (func (export "caml_js_strict_equals")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
@@ -1294,17 +2878,22 @@
 
    ;; ZZZ We should generate JavaScript code instead of using 'eval'
    (export "caml_pure_js_expr" (func $caml_js_expr))
+   (export "caml_js_var" (func $caml_js_expr))
+   (export "caml_js_eval_string" (func $caml_js_expr))
    (func $caml_js_expr (export "caml_js_expr")
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
       (local.set $s (ref.cast $string (local.get 0)))
-      (call $wrap (call $eval (string.new_wtf8_array wtf8 (local.get $s) (i32.const 0) (array.len (local.get $s))))))
+      (return_call $wrap
+         (call $eval
+            (string.new_wtf8_array replace
+               (local.get $s) (i32.const 0) (array.len (local.get $s))))))
 
    (func (export "caml_js_to_float") (param (ref eq)) (result (ref eq))
       (struct.new $float (call $to_float (call $unwrap (local.get 0)))))
 
    (func (export "caml_js_from_float") (param (ref eq)) (result (ref eq))
-      (call $wrap
+      (return_call $wrap
          (call $from_float
             (struct.get $float 0 (ref.cast $float (local.get 0))))))
 
@@ -1315,16 +2904,32 @@
       (struct.new $js
          (call $from_bool (i31.get_s (ref.cast i31 (local.get 0))))))
 
+  (func (export "caml_js_pure_expr")
+     (param (ref eq)) (result (ref eq))
+     (return_call_ref $function_1
+        (i31.new (i32.const 0))
+        (local.get 0)
+        (struct.get $closure 0
+           (ref.cast $closure (local.get 0)))))
+
    (func (export "caml_js_fun_call")
       (param $f (ref eq)) (param $args (ref eq)) (result (ref eq))
-      (call $wrap
+      (return_call $wrap
+         (call $fun_call (call $unwrap (local.get $f)) (ref.null any)
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_js_call")
+      (param $f (ref eq)) (param $o (ref eq)) (param $args (ref eq))
+      (result (ref eq))
+      (return_call $wrap
          (call $fun_call (call $unwrap (local.get $f))
+            (call $unwrap (local.get $o))
             (call $unwrap (call $caml_js_from_array (local.get $args))))))
 
    (func (export "caml_js_meth_call")
       (param $o (ref eq)) (param $f (ref eq)) (param $args (ref eq))
       (result (ref eq))
-      (call $wrap
+      (return_call $wrap
          (call $meth_call (call $unwrap (local.get $o))
             (call $unwrap (call $caml_jsstring_of_string (local.get $f)))
             (call $unwrap (call $caml_js_from_array (local.get $args))))))
@@ -1333,9 +2938,8 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (if (ref.test $string (local.get 1))
          (then
-            ;; ZZZ jsbytes
             (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
-      (call $wrap
+      (return_call $wrap
          (call $get (extern.externalize (call $unwrap (local.get 0)))
             (call $unwrap (local.get 1)))))
 
@@ -1343,18 +2947,46 @@
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (if (ref.test $string (local.get 1))
          (then
-            ;; ZZZ jsbytes
             (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
       (call $set (call $unwrap (local.get 0)) (call $unwrap (local.get 1))
          (call $unwrap (local.get 2)))
       (i31.new (i32.const 0)))
 
+   (func (export "caml_js_delete")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (if (ref.test $string (local.get 1))
+         (then
+            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+      (call $delete (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_js_instanceof")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $instanceof
+                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
+
+   (func (export "caml_js_typeof")
+      (param (ref eq)) (result (ref eq))
+      (struct.new $js (call $typeof (call $unwrap (local.get 0)))))
+
    (func (export "caml_js_new")
       (param $c (ref eq)) (param $args (ref eq)) (result (ref eq))
-      (call $wrap
+      (return_call $wrap
          (call $new (call $unwrap (local.get $c))
             (call $unwrap (call $caml_js_from_array (local.get $args))))))
 
+   (func (export "caml_ojs_new_arr")
+      (param $c (ref eq)) (param $args (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $new (call $unwrap (local.get $c))
+            (call $unwrap (local.get $args)))))
+
+   (func (export "caml_ojs_iterate_properties")
+      (param $o (ref eq)) (param $f (ref eq)) (result (ref eq))
+      (call $iter_props
+         (call $unwrap (local.get $o)) (call $unwrap (local.get $f)))
+      (i31.new (i32.const 0)))
+
    (func (export "caml_js_object")
       (param (ref eq)) (result (ref eq))
       (local $a (ref $block)) (local $p (ref $block))
@@ -1401,46 +3033,172 @@
 
    (func (export "caml_js_to_array")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log (i32.const 16))
-(unreachable)
-      (i31.new (i32.const 0)))
+      (local $a externref)
+      (local $a' (ref $block))
+      (local $i i32) (local $l i32)
+      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
+      (local.set $l (call $array_length (local.get $a)))
+      (local.set $a'
+         (array.new $block (i31.new (i32.const 0))
+            (i32.add (local.get $l) (i32.const 1))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (array.set $block (local.get $a')
+                  (i32.add (local.get $i) (i32.const 1))
+                  (call $wrap (call $array_get (local.get $a) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $a'))
+
+   (func $caml_js_wrap_callback (export "caml_js_wrap_callback")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_callback (local.get 0))))
+
+   (func (export "caml_js_wrap_callback_arguments")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_callback_args (local.get 0))))
 
    (func (export "caml_js_wrap_callback_strict")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $wrap (call $wrap_callback_strict
-                     (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+      (return_call $wrap
+         (call $wrap_callback_strict
+            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+
+   (func (export "caml_js_wrap_callback_unsafe")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_callback_unsafe (local.get 0))))
+
+   (func (export "caml_js_wrap_meth_callback")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_meth_callback (local.get 0))))
+
+   (func (export "caml_js_wrap_meth_callback_arguments")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_meth_callback_args (local.get 0))))
+
+   (func (export "caml_js_wrap_meth_callback_strict")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $wrap_meth_callback_strict
+            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+
+   (func (export "caml_js_wrap_meth_callback_unsafe")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_meth_callback_unsafe (local.get 0))))
+
+   (func (export "caml_ojs_wrap_fun_arguments")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $wrap_fun_arguments
+            (call $wrap_callback_strict (i32.const 1) (local.get 0)))))
 
    (func (export "caml_callback")
       (param $f (ref eq)) (param $count i32) (param $args (ref extern))
+      (param $kind i32) ;; 0 ==> strict / 2 ==> unsafe
       (result anyref)
       (local $acc (ref eq)) (local $i i32)
       (local.set $acc (local.get $f))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $count))
-            (then
+      (if (i32.eq (local.get $kind) (i32.const 2))
+         (then
+            (loop $loop
+               (local.set $f (local.get $acc))
                (local.set $acc
                   (call_ref $function_1
                      (call $wrap
-                        (call $get (local.get $args) (i31.new (local.get $i))))
+                        (call $get (local.get $args)
+                           (i31.new (local.get $i))))
                      (local.get $acc)
                      (struct.get $closure 0
                         (ref.cast $closure (local.get $acc)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (call $unwrap (local.get $acc)))
+               (br_if $loop
+                  (i32.eqz (ref.test $closure_last_arg (local.get $f))))))
+         (else
+            (local.set $i (i32.const 0))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $count))
+                  (then
+                     (local.set $acc
+                        (call_ref $function_1
+                           (call $wrap
+                              (call $get (local.get $args)
+                                 (i31.new (local.get $i))))
+                           (local.get $acc)
+                           (struct.get $closure 0
+                              (ref.cast $closure (local.get $acc)))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (if (local.get $kind)
+               (then
+                  (if (ref.test $closure (local.get $acc))
+                     (then (local.set $acc
+                              (call $caml_js_wrap_callback
+                                 (local.get $acc)))))))))
+      (return_call $unwrap (local.get $acc)))
 
+   (export "caml_js_from_string" (func $caml_jsstring_of_string))
    (func $caml_jsstring_of_string (export "caml_jsstring_of_string")
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
       (local.set $s (ref.cast $string (local.get 0)))
-      ;; ZZZ string.new_wtf8_array replace
       (struct.new $js
-         (string.new_wtf8_array wtf8 (local.get $s) (i32.const 0)
+         (string.new_wtf8_array replace (local.get $s) (i32.const 0)
            (array.len (local.get $s)))))
 
+   (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
+      (param (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local $s' (ref $string))
+      (local $l i32) (local $i i32) (local $n i32) (local $c i32)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $l (array.len (local.get $s)))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $count
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (if (i32.ge_u (array.get_u $string (local.get $s) (local.get $i))
+                      (i32.const 128))
+                  (then (local.set $n (i32.add (local.get $n) (i32.const 1)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $count))))
+      (if (i32.eqz (local.get $n))
+         (then
+            (return
+               (struct.new $js
+                  (string.new_wtf8_array utf8 (local.get $s) (i32.const 0)
+                     (local.get $i))))))
+      (local.set $s'
+         (array.new $string (i32.const 0)
+            (i32.add (local.get $i) (local.get $n))))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $fill
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
+               (if (i32.lt_u (local.get $c) (i32.const 128))
+                  (then
+                     (array.set $string
+                        (local.get $s') (local.get $n) (local.get $c))
+                     (local.set $n (i32.add (local.get $n) (i32.const 1))))
+                  (else
+                     (array.set $string (local.get $s')
+                        (local.get $n)
+                        (i32.or (i32.shr_u (local.get $c) (i32.const 6))
+                           (i32.const 0xC0)))
+                     (array.set $string (local.get $s')
+                        (i32.add (local.get $n) (i32.const 1))
+                        (i32.and (local.get $c) (i32.const 0x3F)))
+                     (local.set $n (i32.add (local.get $n) (i32.const 2)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $fill))))
+      (struct.new $js
+         (string.new_wtf8_array utf8 (local.get $s') (i32.const 0)
+            (local.get $n))))
+
+   (export "caml_js_to_string" (func $caml_string_of_jsstring))
    (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
       (param (ref eq)) (result (ref eq))
       (local $s stringref)
@@ -1451,15 +3209,160 @@
          (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
       (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
       (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
-      (drop (string.encode_wtf8_array wtf8
+      (drop (string.encode_wtf8_array replace
                (local.get $s) (local.get $s') (i32.const 0)))
       (local.get $s'))
 
+   (func (export "caml_string_of_jsbytes")
+      (param (ref eq)) (result (ref eq))
+      (local $s stringref)
+      (local $l i32) (local $i i32) (local $n i32) (local $c i32)
+      (local $s' (ref $string)) (local $s'' (ref $string))
+      ;; ZZZ ref.cast string not yet implemented by V8
+      (local.set $s
+         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
+      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
+      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
+      (drop (string.encode_wtf8_array replace
+               (local.get $s) (local.get $s') (i32.const 0)))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $count
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (if (i32.ge_u (array.get_u $string (local.get $s') (local.get $i))
+                      (i32.const 0xC0))
+                  (then (local.set $n (i32.add (local.get $n) (i32.const 1)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $count))))
+      (if (i32.eqz (local.get $n)) (then (return (local.get $s'))))
+      (local.set $s''
+         (array.new $string (i32.const 0)
+            (i32.add (local.get $i) (local.get $n))))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $fill
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $c
+                  (array.get_u $string (local.get $s') (local.get $i)))
+               (if (i32.lt_u (local.get $c) (i32.const 0xC0))
+                  (then
+                     (array.set $string
+                        (local.get $s'') (local.get $n) (local.get $c))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1))))
+                  (else
+                     (array.set $string (local.get $s'')
+                        (local.get $n)
+                        (i32.sub
+                           (i32.or
+                              (i32.shl (local.get $c) (i32.const 6))
+                              (array.get_u $string (local.get $s')
+                                 (i32.add (local.get $i) (i32.const 1))))
+                           (i32.const 0X3080)))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2)))))
+               (local.set $n (i32.add (local.get $n) (i32.const 1)))
+               (br $fill))))
+      (local.get $s''))
+
    (func (export "caml_list_to_js_array")
       (param (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local $a externref)
+      (local $l (ref eq))
+      (local $b (ref $block))
+      (local.set $i (i32.const 0))
+      (local.set $l (local.get 0))
+      (drop (block $done (result (ref eq))
+         (loop $compute_length
+            (local.set $l
+               (array.get $block
+                  (br_on_cast_fail $done $block (local.get $l)) (i32.const 2)))
+            (local.set $i (i32.add (local.get $i) (i32.const 1)))
+            (br $compute_length))))
+      (local.set $a (call $new_array (local.get $i)))
+      (local.set $i (i32.const 0))
+      (local.set $l (local.get 0))
+      (drop (block $exit (result (ref eq))
+         (loop $loop
+            (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
+            (call $array_set (local.get $a) (local.get $i)
+               (call $unwrap (array.get $block (local.get $b) (i32.const 1))))
+            (local.set $l (array.get $block (local.get $b) (i32.const 2)))
+            (local.set $i (i32.add (local.get $i) (i32.const 1)))
+            (br $loop))))
+      (struct.new $js (extern.internalize (local.get $a))))
+
+   (func (export "caml_list_of_js_array")
+      (param (ref eq)) (result (ref eq))
+      (local $l (ref eq))
+      (local $i i32)
+      (local $len i32)
+      (local $a externref)
+      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
+      (local.set $len (call $array_length (local.get $a)))
+      (local.set $i (i32.const 0))
+      (local.set $l (i31.new (i32.const 0)))
+      (loop $loop
+         (if (i32.le_u (local.get $i) (local.get $len))
+            (then
+               (local.set $l
+                  (array.new_fixed $block (i31.new (i32.const 0))
+                     (call $wrap
+                        (call $array_get (local.get $a) (local.get $i)))
+                     (local.get $l)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $l))
+
+   (func (export "caml_js_error_option_of_exception")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_js_get_console")
+     (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log (i32.const 20))
-(unreachable)
+      (call $log_js (string.const "caml_js_get_console"))
       (i31.new (i32.const 0)))
-)
 
+  (func (export "caml_js_html_entities")
+     (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_js_html_entities"))
+      (i31.new (i32.const 0)))
+
+  (func (export "caml_js_html_escape")
+     (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_js_html_escape"))
+      (i31.new (i32.const 0)))
+
+  (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_xmlhttprequest_create"))
+      (i31.new (i32.const 0)))
+
+  (func (export "caml_js_on_ie")
+     (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_js_on_ie"))
+      (i31.new (i32.const 0)))
+
+  (func (export "bigstringaf_blit_from_bytes")
+     (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+     ;; ZZZ
+     (call $log_js (string.const "bigstringaf_blit_from_bytes"))
+     (i31.new (i32.const 0)))
+
+  (func (export "bigstringaf_blit_to_bytes")
+     (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+     ;; ZZZ
+     (call $log_js (string.const "bigstringaf_blit_to_bytes"))
+     (i31.new (i32.const 0)))
+
+  (func (export "caml_unwrap_value_from_string")
+     (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+     ;; ZZZ
+     (call $log_js (string.const "caml_unwrap_value_from_string"))
+     (i31.new (i32.const 0)))
+)

From 7357099198729d5f0f387a0e70e8deec15cb1a84 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 25 May 2023 17:14:14 +0200
Subject: [PATCH 042/481] Split runtime into multiple files

---
 runtime/wasm/args.ml                  |    4 +
 runtime/wasm/array.wat                |   95 +
 runtime/wasm/backtrace.wat            |   45 +
 runtime/wasm/bigarray.wat             |  416 +++
 runtime/wasm/bigstringaf.wat          |   15 +
 runtime/wasm/compare.wat              |  444 ++++
 runtime/wasm/deps.json                |   69 +
 runtime/wasm/domain.wat               |   41 +
 runtime/wasm/dune                     |   12 +-
 runtime/wasm/dynlink.wat              |   15 +
 runtime/wasm/fail.wat                 |   56 +
 runtime/wasm/fs.wat                   |   58 +
 runtime/wasm/gc.wat                   |   13 +
 runtime/wasm/hash.wat                 |  206 ++
 runtime/wasm/ieee_754.wat             |  141 ++
 runtime/wasm/int32.wat                |  104 +
 runtime/wasm/int64.wat                |  146 ++
 runtime/wasm/ints.wat                 |  164 ++
 runtime/wasm/io.wat                   |  142 ++
 runtime/wasm/jslib.wat                |  521 ++++
 runtime/wasm/jslib_js_of_ocaml.wat    |   32 +
 runtime/wasm/lexing.wat               |   15 +
 runtime/wasm/marshal.wat              |   28 +
 runtime/wasm/md5.wat                  |   15 +
 runtime/wasm/nat.wat                  |   31 +
 runtime/wasm/obj.wat                  |  231 ++
 runtime/wasm/prng.wat                 |  102 +
 runtime/wasm/run.js                   |  177 --
 runtime/wasm/{index.js => runtime.js} |   18 +-
 runtime/wasm/runtime.wat              | 3368 -------------------------
 runtime/wasm/stdlib.wat               |   29 +
 runtime/wasm/string.wat               |  343 +++
 runtime/wasm/sys.wat                  |   84 +
 runtime/wasm/toplevel.wat             |    5 +
 runtime/wasm/unix.wat                 |   40 +
 runtime/wasm/weak.wat                 |   87 +
 36 files changed, 3759 insertions(+), 3553 deletions(-)
 create mode 100644 runtime/wasm/args.ml
 create mode 100644 runtime/wasm/array.wat
 create mode 100644 runtime/wasm/backtrace.wat
 create mode 100644 runtime/wasm/bigarray.wat
 create mode 100644 runtime/wasm/bigstringaf.wat
 create mode 100644 runtime/wasm/compare.wat
 create mode 100644 runtime/wasm/deps.json
 create mode 100644 runtime/wasm/domain.wat
 create mode 100644 runtime/wasm/dynlink.wat
 create mode 100644 runtime/wasm/fail.wat
 create mode 100644 runtime/wasm/fs.wat
 create mode 100644 runtime/wasm/gc.wat
 create mode 100644 runtime/wasm/hash.wat
 create mode 100644 runtime/wasm/ieee_754.wat
 create mode 100644 runtime/wasm/int32.wat
 create mode 100644 runtime/wasm/int64.wat
 create mode 100644 runtime/wasm/ints.wat
 create mode 100644 runtime/wasm/io.wat
 create mode 100644 runtime/wasm/jslib.wat
 create mode 100644 runtime/wasm/jslib_js_of_ocaml.wat
 create mode 100644 runtime/wasm/lexing.wat
 create mode 100644 runtime/wasm/marshal.wat
 create mode 100644 runtime/wasm/md5.wat
 create mode 100644 runtime/wasm/nat.wat
 create mode 100644 runtime/wasm/obj.wat
 create mode 100644 runtime/wasm/prng.wat
 delete mode 100755 runtime/wasm/run.js
 rename runtime/wasm/{index.js => runtime.js} (91%)
 delete mode 100644 runtime/wasm/runtime.wat
 create mode 100644 runtime/wasm/stdlib.wat
 create mode 100644 runtime/wasm/string.wat
 create mode 100644 runtime/wasm/sys.wat
 create mode 100644 runtime/wasm/toplevel.wat
 create mode 100644 runtime/wasm/unix.wat
 create mode 100644 runtime/wasm/weak.wat

diff --git a/runtime/wasm/args.ml b/runtime/wasm/args.ml
new file mode 100644
index 0000000000..16cd0418a5
--- /dev/null
+++ b/runtime/wasm/args.ml
@@ -0,0 +1,4 @@
+let () =
+  for i = 1 to Array.length Sys.argv - 1 do
+    Format.printf "%s@.%s@." Sys.argv.(i) (Filename.chop_suffix Sys.argv.(i) ".wat")
+  done
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
new file mode 100644
index 0000000000..1b2853ad60
--- /dev/null
+++ b/runtime/wasm/array.wat
@@ -0,0 +1,95 @@
+(module
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+   (type $float (struct (field f64)))
+
+   (data $Array_make "Array.make")
+
+   (func $caml_make_vect (export "caml_make_vect")
+      (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
+      (local $sz i32) (local $b (ref $block))
+      (local.set $sz (i32.add (i31.get_s (ref.cast i31 (local.get $n)))
+                              (i32.const 1)))
+      (if (i32.lt_s (local.get $sz) (i32.const 1))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Array_make
+                               (i32.const 0) (i32.const 10)))))
+      (local.set $b (array.new $block (local.get $v) (local.get $sz)))
+      ;; ZZZ float array
+      (array.set $block (local.get $b) (i32.const 0) (i31.new (i32.const 0)))
+      (local.get $b))
+
+   (export "caml_make_float_vect" (func $caml_floatarray_create))
+   (func $caml_floatarray_create (export "caml_floatarray_create")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ float array
+      (return_call $caml_make_vect
+         (local.get 0) (struct.new $float (f64.const 0))))
+
+   (func (export "caml_array_sub")
+      (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
+      (result (ref eq))
+      (local $a1 (ref $block)) (local $a2 (ref $block)) (local $len i32)
+      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
+      (local.set $a1 (ref.cast $block (local.get $a)))
+      (local.set $a2 (array.new $block (i31.new (i32.const 0))
+                        (i32.add (local.get $len) (i32.const 1))))
+      (array.copy $block $block
+         (local.get $a2) (i32.const 1) (local.get $a1)
+         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
+         (local.get $len))
+      (local.get $a2))
+
+   (func (export "caml_array_append")
+      (param $va1 (ref eq)) (param $va2 (ref eq)) (result (ref eq))
+      (local $a1 (ref $block)) (local $a2 (ref $block)) (local $a (ref $block))
+      (local $l1 i32) (local $l2 i32)
+      (local.set $a1 (ref.cast $block (local.get $va1)))
+      (local.set $l1 (array.len (local.get $a1)))
+      (local.set $a2 (ref.cast $block (local.get $va2)))
+      (local.set $l2 (array.len (local.get $a2)))
+      (local.set $a
+         (array.new $block (i31.new (i32.const 0))
+            (i32.sub (i32.add (local.get $l1) (local.get $l2)) (i32.const 1))))
+      ;; ZZZ float array
+      (array.copy $block $block
+         (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
+         (i32.sub (local.get $l1) (i32.const 1)))
+      (array.copy $block $block
+         (local.get $a) (i32.const 1) (local.get $a2) (local.get $l1)
+         (i32.sub (local.get $l2) (i32.const 1)))
+      (local.get $a))
+
+   (func (export "caml_array_concat") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_array_concat"))
+      (unreachable))
+
+   (export "caml_floatarray_blit" (func $caml_array_blit))
+   (func $caml_array_blit (export "caml_array_blit")
+      (param $a1 (ref eq)) (param $i1 (ref eq))
+      (param $a2 (ref eq)) (param $i2 (ref eq))
+      (param $len (ref eq))
+      (result (ref eq))
+      (array.copy $block $block
+         (ref.cast $block (local.get $a2))
+         (i31.get_s (ref.cast i31 (local.get $i2)))
+         (ref.cast $block (local.get $a1))
+         (i31.get_s (ref.cast i31 (local.get $i1)))
+         (i31.get_s (ref.cast i31 (local.get $len))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_array_fill")
+      (param $a (ref eq)) (param $i (ref eq)) (param $len (ref eq))
+      (param $v (ref eq)) (result (ref eq))
+      (array.fill $block (ref.cast $block (local.get $a))
+         (i31.get_u (ref.cast i31 (local.get $i)))
+         (local.get $v)
+         (i31.get_u (ref.cast i31 (local.get $len))))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat
new file mode 100644
index 0000000000..9c6b80e01b
--- /dev/null
+++ b/runtime/wasm/backtrace.wat
@@ -0,0 +1,45 @@
+(module
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (func (export "caml_get_exception_raw_backtrace")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_backtrace_status")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_convert_raw_backtrace")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (data $raw_backtrace_slot_err
+      "Printexc.get_raw_backtrace_slot: index out of bounds")
+
+   (func (export "caml_raw_backtrace_slot")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      (call $caml_invalid_argument
+          (array.new_data $string $raw_backtrace_slot_err
+             (i32.const 0) (i32.const 52)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_convert_raw_backtrace_slot")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_restore_raw_backtrace")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_get_current_callstack")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_ml_debug_info_status")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
new file mode 100644
index 0000000000..529b5c6c0a
--- /dev/null
+++ b/runtime/wasm/bigarray.wat
@@ -0,0 +1,416 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "bindings" "ta_create"
+      (func $ta_create (param i32) (param i32) (result externref)))
+   (import "bindings" "ta_normalize"
+      (func $ta_normalize (param externref) (result externref)))
+   (import "bindings" "ta_kind" (func $ta_kind (param externref) (result i32)))
+   (import "bindings" "ta_length"
+      (func $ta_length (param externref) (result i32)))
+   (import "bindings" "ta_get_f64"
+      (func $ta_get_f64 (param externref) (param i32) (result f64)))
+   (import "bindings" "ta_get_f32"
+      (func $ta_get_f32 (param externref) (param i32) (result f64)))
+   (import "bindings" "ta_get_i32"
+      (func $ta_get_i32 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_i16"
+      (func $ta_get_i16 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_ui16"
+      (func $ta_get_ui16 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_i8"
+      (func $ta_get_i8 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_get_ui8"
+      (func $ta_get_ui8 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_set_f64"
+      (func $ta_set_f64 (param externref) (param i32) (param f64)))
+   (import "bindings" "ta_set_f32"
+      (func $ta_set_f32 (param externref) (param i32) (param f64)))
+   (import "bindings" "ta_set_i32"
+      (func $ta_set_i32 (param externref) (param i32) (param i32)))
+   (import "bindings" "ta_set_i16"
+      (func $ta_set_i16 (param externref) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set_ui16"
+      (func $ta_set_ui16 (param externref) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set_i8"
+      (func $ta_set_i8 (param externref) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set_ui8"
+      (func $ta_set_ui8 (param externref) (param i32) (param (ref i31))))
+   (import "fail" "caml_bound_error" (func $caml_bound_error))
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "int32" "caml_copy_int32"
+      (func $caml_copy_int32 (param i32) (result (ref eq))))
+   (import "int32" "caml_copy_nativeint"
+      (func $caml_copy_nativeint (param i32) (result (ref eq))))
+   (import "int64" "caml_copy_int64"
+      (func $caml_copy_int64 (param i64) (result (ref eq))))
+   (import "obj" "double_array_tag" (global $double_array_tag i32))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+   (type $float (struct (field f64)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+   (type $int32
+      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
+   (type $int64
+      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
+   (type $int_array (array (mut i32)))
+
+   (global $bigarray_ops (ref $custom_operations)
+      ;; ZZZ
+      (struct.new $custom_operations
+         (array.new_fixed $string ;; "_bigarr02"
+            (i32.const 95) (i32.const 98) (i32.const 105) (i32.const 103)
+            (i32.const 97) (i32.const 114) (i32.const 114) (i32.const 48)
+            (i32.const 50))
+         (ref.func $bigarray_cmp) (ref.func $bigarray_hash)))
+
+   (type $bigarray
+      (sub $custom
+         (struct
+            (field (ref $custom_operations))
+            (field externref) ;; data
+            (field (ref $int_array)) ;; size in each dimension
+            (field i8) ;; number of dimensions
+            (field i8) ;; kind
+            (field i8)))) ;; layout
+
+   (func $bigarray_cmp (param (ref eq)) (param (ref eq)) (result i32)
+      ;; ZZZ
+      (call $log_js (string.const "bigarray_cmp"))
+      (i32.const 1))
+
+   (func $bigarray_hash (param (ref eq)) (result i32)
+      ;; ZZZ
+      (call $log_js (string.const "bigarray_hash"))
+      (i32.const 1))
+
+   (func $caml_ba_get_size (param $dim (ref $int_array)) (result i32)
+      (local $i i32) (local $n i32) (local $sz i32)
+      (local.set $n (array.len (local.get $dim)))
+      (local.set $i (i32.const 0))
+      (local.set $sz (i32.const 1))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $n))
+            (then
+               ;; ZZZ Check for overflow
+               (local.set $sz
+                   (i32.mul (local.get $sz)
+                      (array.get $int_array
+                         (local.get $dim) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $sz))
+
+  (func $caml_ba_size_per_element (param $kind i32) (result i32)
+     (select (i32.const 2) (i32.const 1)
+        (i32.or (i32.eq (local.get $kind) (i32.const 7))
+                (i32.or (i32.eq (local.get $kind) (i32.const 10))
+                        (i32.eq (local.get $kind) (i32.const 11))))))
+
+  (func $caml_ba_create_buffer
+     (param $kind i32) (param $sz i32) (result externref)
+     (return_call $ta_create (local.get $kind)
+        ;; ZZZ Check for overflow
+        (i32.mul (local.get $sz)
+           (call $caml_ba_size_per_element (local.get $kind)))))
+
+   (global $CAML_BA_MAX_NUM_DIMS i32 (i32.const 16))
+
+   (data $ba_create_bad_dims "Bigarray.create: bad number of dimensions")
+   (data $ba_create_negative_dim "Bigarray.create: negative dimension")
+
+   (func (export "caml_ba_create")
+      (param $vkind (ref eq)) (param $layout (ref eq)) (param $d (ref eq))
+      (result (ref eq))
+      (local $vdim (ref $block))
+      (local $dim (ref $int_array))
+      (local $kind i32) (local $num_dims i32) (local $i i32) (local $n i32)
+      (local.set $kind (i31.get_s (ref.cast i31 (local.get $vkind))))
+      (local.set $vdim (ref.cast $block (local.get $d)))
+      (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1)))
+      (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $ba_create_bad_dims
+                  (i32.const 0) (i32.const 41)))))
+      (local.set $dim
+         (array.new $int_array (i32.const 0) (local.get $num_dims)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $num_dims))
+            (then
+               (local.set $n
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $vdim)
+                           (i32.add (local.get $i) (i32.const 1))))))
+               (if (i32.lt_s (local.get $n) (i32.const 0))
+                  (then
+                     (call $caml_invalid_argument
+                        (array.new_data $string $ba_create_negative_dim
+                              (i32.const 0) (i32.const 35)))))
+               (array.set $int_array
+                  (local.get $dim) (local.get $i) (local.get $n))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (call $caml_ba_create_buffer (local.get $kind)
+            (call $caml_ba_get_size (local.get $dim)))
+         (local.get $dim)
+         (local.get $num_dims)
+         (local.get $kind)
+         (i31.get_s (ref.cast i31 (local.get $layout)))))
+
+   (data $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind")
+   (data $ta_too_large "Typed_array.to_genarray: too large")
+
+   (func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq))
+      (local $data externref)
+      (local $kind i32)
+      (local $len i32)
+      (local.set $data
+         (call $ta_normalize (extern.externalize (call $unwrap (local.get 0)))))
+      (local.set $kind (call $ta_kind (local.get $data)))
+      (if (i32.lt_s (local.get $kind) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $ta_unsupported_kind
+                  (i32.const 0) (i32.const 41)))))
+      (local.set $len (call $ta_length (local.get $data)))
+      (if (i32.lt_s (local.get $len) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $ta_too_large
+                  (i32.const 0) (i32.const 34)))))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (local.get $data)
+         (array.new_fixed $int_array (local.get $len))
+         (i32.const 1)
+         (local.get $kind)
+         (i32.const 0)))
+
+   (func (export "caml_ba_to_typed_array") (param (ref eq)) (result (ref eq))
+      (call $wrap
+         (extern.internalize
+            (struct.get $bigarray 1 (ref.cast $bigarray (local.get $0))))))
+
+   (func $caml_ba_get_at_offset
+      (param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
+      (local $data externref)
+      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
+      (block $float32
+       (block $float64
+        (block $int8
+         (block $uint8
+          (block $int16
+           (block $uint16
+            (block $int32
+             (block $int64
+              (block $nativeint
+               (block $int
+                (block $complex32
+                 (block $complex64
+                  (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                            $int32 $int64 $nativeint $int
+                            $complex32 $complex64 $uint8
+                     (struct.get $bigarray 4 (local.get $ba))))
+                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                 (return
+                    (array.new_fixed $block
+                       (i31.new (global.get $double_array_tag))
+                       (struct.new $float
+                          (call $ta_get_f64 (local.get $data) (local.get $i)))
+                       (struct.new $float
+                          (call $ta_get_f64 (local.get $data)
+                             (i32.add (local.get $i) (i32.const 1)))))))
+                (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                (return
+                   (array.new_fixed $block
+                      (i31.new (global.get $double_array_tag))
+                      (struct.new $float
+                         (call $ta_get_f32 (local.get $data) (local.get $i)))
+                      (struct.new $float
+                         (call $ta_get_f32 (local.get $data)
+                            (i32.add (local.get $i) (i32.const 1)))))))
+               (return
+                  (i31.new
+                     (call $ta_get_i32 (local.get $data) (local.get $i)))))
+              (return_call $caml_copy_nativeint
+                 (call $ta_get_i32 (local.get $data) (local.get $i))))
+             (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+             (return_call $caml_copy_int64
+                (i64.or
+                   (i64.extend_i32_u
+                      (call $ta_get_i32 (local.get $data) (local.get $i)))
+                   (i64.shl
+                      (i64.extend_i32_u
+                         (call $ta_get_i32 (local.get $data)
+                            (i32.add (local.get $i) (i32.const 1))))
+                      (i64.const 32)))))
+            (return_call $caml_copy_int32
+               (call $ta_get_i32 (local.get $data) (local.get $i))))
+           (return (i31.new
+                      (call $ta_get_ui16 (local.get $data) (local.get $i)))))
+          (return (i31.new
+                     (call $ta_get_i16 (local.get $data) (local.get $i)))))
+         (return (i31.new
+                    (call $ta_get_ui8 (local.get $data) (local.get $i)))))
+        (return (i31.new
+                   (call $ta_get_i8 (local.get $data) (local.get $i)))))
+       (return (struct.new $float
+                  (call $ta_get_f64 (local.get $data) (local.get $i)))))
+      (return (struct.new $float
+                 (call $ta_get_f32 (local.get $data) (local.get $i)))))
+
+   (func $caml_ba_set_at_offset
+      (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq))
+      (local $data externref)
+      (local $b (ref $block)) (local $l i64)
+      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
+      (block $float32
+       (block $float64
+        (block $int8
+         (block $uint8
+          (block $int16
+           (block $uint16
+            (block $int32
+             (block $int64
+              (block $nativeint
+               (block $int
+                (block $complex32
+                 (block $complex64
+                  (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                            $int32 $int64 $nativeint $int
+                            $complex32 $complex64 $uint8
+                     (struct.get $bigarray 4 (local.get $ba))))
+                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                 (local.set $b (ref.cast $block (local.get $v)))
+                 (call $ta_set_f64 (local.get $data) (local.get $i)
+                    (struct.get $float 0
+                       (ref.cast $float
+                          (array.get $block (local.get $b) (i32.const 1)))))
+                 (call $ta_set_f64 (local.get $data)
+                    (i32.add (local.get $i) (i32.const 1))
+                    (struct.get $float 0
+                       (ref.cast $float
+                         (array.get $block (local.get $b) (i32.const 2)))))
+                 (return))
+                (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+                (local.set $b (ref.cast $block (local.get $v)))
+                (call $ta_set_f32 (local.get $data) (local.get $i)
+                   (struct.get $float 0
+                      (ref.cast $float
+                         (array.get $block (local.get $b) (i32.const 1)))))
+                (call $ta_set_f32 (local.get $data)
+                   (i32.add (local.get $i) (i32.const 1))
+                   (struct.get $float 0
+                      (ref.cast $float
+                         (array.get $block (local.get $b) (i32.const 2)))))
+                (return))
+               (call $ta_set_i32 (local.get $data) (local.get $i)
+                  (i31.get_s (ref.cast i31 (local.get $v))))
+               (return))
+              (call $ta_set_i32 (local.get $data) (local.get $i)
+                 (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+              (return))
+             (local.set $i (i32.shl (local.get $i) (i32.const 1)))
+             (local.set $l
+                (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+             (call $ta_set_i32 (local.get $data) (local.get $i)
+                (i32.wrap_i64 (local.get $l)))
+             (call $ta_set_i32 (local.get $data)
+                (i32.add (local.get $i) (i32.const 1))
+                (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32))))
+             (return))
+            (call $ta_set_i32 (local.get $data) (local.get $i)
+               (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+            (return))
+           (call $ta_set_ui16 (local.get $data) (local.get $i)
+              (ref.cast i31 (local.get $v)))
+           (return))
+          (call $ta_set_i16 (local.get $data) (local.get $i)
+             (ref.cast i31 (local.get $v)))
+          (return))
+         (call $ta_set_ui8 (local.get $data) (local.get $i)
+            (ref.cast i31 (local.get $v)))
+         (return))
+        (call $ta_set_i8 (local.get $data) (local.get $i)
+           (ref.cast i31 (local.get $v)))
+        (return))
+       (call $ta_set_f64 (local.get $data) (local.get $i)
+          (struct.get $float 0 (ref.cast $float (local.get 0))))
+       (return))
+      (call $ta_set_f32 (local.get $data) (local.get $i)
+         (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (return))
+
+   (data $Bigarray_dim "Bigarray.dim")
+
+   (func $caml_ba_dim (export "caml_ba_dim")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $dim (ref $int_array))
+      (local $i i32)
+      (local.set $dim
+         (struct.get $bigarray 2 (ref.cast $bigarray (local.get 0))))
+      (local.set $i (i31.get_s (ref.cast i31 (local.get $1))))
+      (if (i32.ge_u (local.get $i) (array.len (local.get $dim)))
+         (then (call $caml_invalid_argument
+                  (array.new_data $string $Bigarray_dim
+                     (i32.const 0) (i32.const 12)))))
+      (i31.new (array.get $int_array (local.get $dim) (local.get $i))))
+
+   (func (export "caml_ba_dim_1")
+      (param (ref eq)) (result (ref eq))
+      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 0))))
+
+   (func (export "caml_ba_get_1")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local.set $ba (ref.cast $bigarray (local.get 0)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
+      (if (struct.get $bigarray 5 (local.get $ba))
+         (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
+      (if (i32.ge_u (local.get $i)
+             (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
+                (i32.const 0)))
+         (call $caml_bound_error))
+      (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i)))
+
+   (func (export "caml_ba_set_1")
+      (param (ref eq)) (param (ref eq)) (param $v (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local.set $ba (ref.cast $bigarray (local.get 0)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
+      (if (struct.get $bigarray 5 (local.get $ba))
+         (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
+      (if (i32.ge_u (local.get $i)
+             (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
+                (i32.const 0)))
+         (call $caml_bound_error))
+      (call $caml_ba_set_at_offset
+         (local.get $ba) (local.get $i) (local.get $v))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
+      ;; ZZZ used to convert a typed array to a string...
+      (call $log_js (string.const "caml_string_of_array"))
+      (unreachable))
+)
diff --git a/runtime/wasm/bigstringaf.wat b/runtime/wasm/bigstringaf.wat
new file mode 100644
index 0000000000..6e0250a935
--- /dev/null
+++ b/runtime/wasm/bigstringaf.wat
@@ -0,0 +1,15 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "bigstringaf_blit_from_bytes")
+      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "bigstringaf_blit_from_bytes"))
+      (i31.new (i32.const 0)))
+
+   (func (export "bigstringaf_blit_to_bytes")
+      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "bigstringaf_blit_to_bytes"))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
new file mode 100644
index 0000000000..67d9ed01da
--- /dev/null
+++ b/runtime/wasm/compare.wat
@@ -0,0 +1,444 @@
+(module
+   (import "bindings" "log" (func $log (param i32)))
+   (import "obj" "forward_tag" (global $forward_tag i32))
+   (import "obj" "double_array_tag" (global $double_array_tag i32))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+   (type $float (struct (field f64)))
+
+   (type $int_array (array (mut i32)))
+   (type $block_array (array (mut (ref $block))))
+   (type $compare_stack
+      (struct (field (mut i32))          ;; position in stack
+              (field (ref $block_array)) ;; first value
+              (field (ref $block_array)) ;; second value
+              (field (ref $int_array)))) ;; position in value
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+
+   (global $dummy_block (ref $block)
+      (array.new $block (i31.new (i32.const 0)) (i32.const 0)))
+
+   (global $default_compare_stack (ref $compare_stack)
+      (struct.new $compare_stack (i32.const -1)
+         (array.new $block_array (global.get $dummy_block) (i32.const 8))
+         (array.new $block_array (global.get $dummy_block) (i32.const 8))
+         (array.new $int_array (i32.const 0) (i32.const 8))))
+
+   (func $compare_stack_is_not_empty
+      (param $stack (ref $compare_stack)) (result i32)
+      (i32.ge_s (struct.get $compare_stack 0 (local.get $stack)) (i32.const 0)))
+
+   (func $pop_compare_stack (param $stack (ref $compare_stack))
+      (result (ref eq)) (result (ref eq))
+      (local $i i32) (local $p i32) (local $p' i32)
+      (local $v1 (ref $block)) (local $v2 (ref $block))
+      (local.set $i (struct.get $compare_stack 0 (local.get $stack)))
+      (local.set $p
+         (array.get $int_array (struct.get $compare_stack 3 (local.get $stack))
+            (local.get $i)))
+      (local.set $p' (i32.add (local.get $p) (i32.const 1)))
+      (array.set $int_array (struct.get $compare_stack 3 (local.get $stack))
+            (local.get $i) (local.get $p'))
+      (local.set $v1
+         (array.get $block_array
+            (struct.get $compare_stack 1 (local.get $stack)) (local.get $i)))
+      (local.set $v2
+         (array.get $block_array
+            (struct.get $compare_stack 2 (local.get $stack)) (local.get $i)))
+      (if (i32.eq (local.get $p') (array.len (local.get $v1)))
+         (then
+            (array.set $block_array
+               (struct.get $compare_stack 1 (local.get $stack))
+               (local.get $i) (global.get $dummy_block))
+            (array.set $block_array
+               (struct.get $compare_stack 2 (local.get $stack))
+               (local.get $i) (global.get $dummy_block))
+            (struct.set $compare_stack 0 (local.get $stack)
+               (i32.sub (local.get $i) (i32.const 1)))))
+      (tuple.make (array.get $block (local.get $v1) (local.get $p))
+                  (array.get $block (local.get $v2) (local.get $p))))
+
+   (func $push_compare_stack (param $stack (ref $compare_stack))
+      (param $v1 (ref $block)) (param $v2 (ref $block)) (param $p i32)
+      (result (ref $compare_stack))
+      (local $i i32) (local $len i32) (local $len' i32)
+      (local $stack' (ref $compare_stack))
+      (local.set $i
+         (i32.add (struct.get $compare_stack 0 (local.get $stack))
+            (i32.const 1)))
+      (local.set $len
+         (array.len (struct.get $compare_stack 1 (local.get $stack))))
+      (if (i32.ge_u (local.get $i) (local.get $len))
+         (then
+            (local.set $len' (i32.shl (local.get $len) (i32.const 1)))
+            (local.set $stack'
+               (struct.new $compare_stack (local.get $i)
+                  (array.new $block_array
+                     (global.get $dummy_block) (i32.const 8))
+                  (array.new $block_array
+                     (global.get $dummy_block) (i32.const 8))
+                  (array.new $int_array (i32.const 0) (i32.const 8))))
+            (array.copy $block_array $block_array
+               (struct.get $compare_stack 1 (local.get $stack')) (i32.const 0)
+               (struct.get $compare_stack 1 (local.get $stack)) (i32.const 0)
+               (local.get $len))
+            (array.copy $block_array $block_array
+               (struct.get $compare_stack 2 (local.get $stack')) (i32.const 0)
+               (struct.get $compare_stack 2 (local.get $stack)) (i32.const 0)
+               (local.get $len))
+            (array.copy $int_array $int_array
+               (struct.get $compare_stack 3 (local.get $stack')) (i32.const 0)
+               (struct.get $compare_stack 3 (local.get $stack)) (i32.const 0)
+               (local.get $len))
+            (local.set $stack (local.get $stack'))))
+      (struct.set $compare_stack 0 (local.get $stack) (local.get $i))
+      (array.set $block_array (struct.get $compare_stack 1 (local.get $stack))
+         (local.get $i) (local.get $v1))
+      (array.set $block_array (struct.get $compare_stack 2 (local.get $stack))
+         (local.get $i) (local.get $v2))
+      (array.set $int_array (struct.get $compare_stack 3 (local.get $stack))
+         (local.get $i) (local.get $p))
+      (local.get $stack))
+
+   (global $unordered i32 (i32.const 0x80000000))
+
+   (func $compare_strings
+      (param $s1 (ref $string)) (param $s2 (ref $string)) (result i32)
+      (local $l1 i32) (local $l2 i32) (local $len i32) (local $i i32)
+      (local $c1 i32) (local $c2 i32)
+      (if (ref.eq (local.get $s1) (local.get $s2))
+         (then (return (i32.const 0))))
+      (local.set $l1 (array.len $string (local.get $s1)))
+      (local.set $l2 (array.len $string (local.get $s2)))
+      (local.set $len (select (local.get $l1) (local.get $l2)
+                         (i32.le_u (local.get $l1) (local.get $l2))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $c1
+                  (array.get_u $string (local.get $s1) (local.get $i)))
+               (local.set $c2
+                  (array.get_u $string (local.get $s2) (local.get $i)))
+               (if (i32.ne (local.get $c1) (local.get $c2))
+                  (then
+                     (if (i32.le_u (local.get $c1) (local.get $c2))
+                        (then (return (i32.const -1)))
+                        (else (return (i32.const 1))))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i32.sub (local.get $l1) (local.get $l2)))
+
+   (func $compare_val
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32)
+      (result i32)
+      (local $stack (ref $compare_stack)) (local $n i32) (local $res i32)
+      (local.set $stack (global.get $default_compare_stack))
+      (struct.set $compare_stack 0 (local.get $stack) (i32.const -1))
+      (local.set $res
+         (call $do_compare_val
+            (local.get $stack) (local.get $v1) (local.get $v2)
+            (local.get $total)))
+;;      (if (i32.gt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const 1))))
+;;      (if (i32.lt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const -1))))
+;;      (call $log (local.get $res))
+      ;; clear stack (to avoid memory leaks)
+      (local.set $n (struct.get $compare_stack 0 (local.get $stack)))
+      (if (i32.ge_s (local.get $n) (i32.const 0))
+         (then
+(; ZZZ
+            (local.set $n (i32.add (local.get $n) (i32.const 1)))
+            (array.fill $block_array
+               (struct.get $compare_stack 1 (local.get $stack))
+               (i32.const 0) (global.get $dummy_block) (local.get $n))
+            (array.fill $block_array
+               (struct.get $compare_stack 2 (local.get $stack))
+               (i32.const 0) (global.get $dummy_block) (local.get $n))
+;)
+            (loop $loop
+               (if (i32.ge_s (local.get $n) (i32.const 0))
+                  (then
+                     (array.set $block_array
+                        (struct.get $compare_stack 1 (local.get $stack))
+                        (local.get $n) (global.get $dummy_block))
+                     (array.set $block_array
+                        (struct.get $compare_stack 2 (local.get $stack))
+                        (local.get $n) (global.get $dummy_block))
+                     (local.set $n (i32.sub (local.get $n) (i32.const 1)))
+                     (br $loop))))
+          ))
+      (local.get $res))
+
+   (func $do_compare_val
+      (param $stack (ref $compare_stack))
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32)
+      (local $i1 (ref i31)) (local $i2 (ref i31))
+      (local $b1 (ref $block)) (local $b2 (ref $block))
+      (local $t1 i32) (local $t2 i32)
+      (local $s1 i32) (local $s2 i32)
+      (local $f1 f64) (local $f2 f64)
+      (local $str1 (ref $string)) (local $str2 (ref $string))
+      (local $c1 (ref $custom)) (local $c2 (ref $custom))
+      (local $tuple ((ref eq) (ref eq)))
+      (local $res i32)
+      (loop $loop
+         (block $next_item
+            (br_if $next_item
+               (i32.and (ref.eq (local.get $v1) (local.get $v2))
+                        (local.get $total)))
+            (drop (block $v1_is_not_int (result (ref eq))
+               (local.set $i1
+                  (br_on_cast_fail $v1_is_not_int i31 (local.get $v1)))
+               (br_if $next_item (ref.eq (local.get $v1) (local.get $v2)))
+               (drop (block $v2_is_not_int (result (ref eq))
+                  (local.set $i2
+                     (br_on_cast_fail $v2_is_not_int i31 (local.get $v2)))
+                  ;; v1 and v2 are both integers
+                  (return (i32.sub (i31.get_s (local.get $i1))
+                                   (i31.get_s (local.get $i2))))))
+               ;; check for forward tag
+               (drop (block $v2_not_forward (result (ref eq))
+                  (local.set $b2
+                     (br_on_cast_fail $v2_not_forward $block (local.get $v2)))
+                  (local.set $t2
+                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
+                                                 (i32.const 0)))))
+                  (if (i32.eq (local.get $t2) (global.get $forward_tag))
+                     (then
+                        (local.set $v2
+                           (array.get $block (local.get $b2) (i32.const 1)))
+                        (br $loop)))
+                  (i31.new (i32.const 1))))
+               ;; ZZZ custom tag
+               ;; v1 long < v2 block
+               (return (i32.const -1))))
+            (if (ref.test i31 (local.get $v2))
+               (then
+                  ;; check for forward tag
+                  (drop (block $v1_not_forward (result (ref eq))
+                     (local.set $b1
+                        (br_on_cast_fail
+                           $v1_not_forward $block (local.get $v1)))
+                     (local.set $t1
+                        (i31.get_u (ref.cast i31
+                                      (array.get $block (local.get $b1)
+                                         (i32.const 0)))))
+                     (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                        (then
+                           (local.set $v1
+                              (array.get $block (local.get $b1) (i32.const 1)))
+                           (br $loop)))
+                     (i31.new (i32.const 1))))
+                  ;; ZZZ custom tag
+                  ;; v1 block > v1 long
+                  (return (i32.const 1))))
+            (drop (block $v1_not_block (result (ref eq))
+               (local.set $b1
+                  (br_on_cast_fail $v1_not_block $block (local.get $v1)))
+               (local.set $t1
+                  (i31.get_u (ref.cast i31 (array.get $block (local.get $b1)
+                                              (i32.const 0)))))
+               (drop (block $v2_not_block (result (ref eq))
+                  (local.set $b2
+                     (br_on_cast_fail $v2_not_block $block (local.get $v2)))
+                  (local.set $t2
+                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
+                                                 (i32.const 0)))))
+                  (if (i32.ne (local.get $t1) (local.get $t2))
+                     (then
+                        ;; check for forward tag
+                        (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                           (then
+                              (local.set $v1
+                                 (array.get $block
+                                    (local.get $b1) (i32.const 1)))
+                              (br $loop)))
+                        (if (i32.eq (local.get $t2) (global.get $forward_tag))
+                           (then
+                              (local.set $v2
+                                 (array.get
+                                    $block (local.get $b2) (i32.const 1)))
+                              (br $loop)))
+                        ;; compare tags
+                        (return (i32.sub (local.get $t1) (local.get $t2)))))
+                  ;; forward tag
+                  (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                     (then
+                        (local.set $v1
+                           (array.get $block (local.get $b1) (i32.const 1)))
+                        (local.set $v2
+                           (array.get $block (local.get $b2) (i32.const 1)))
+                        (br $loop)))
+                  ;; ZZZ object tag
+                  (local.set $s1 (array.len (local.get $b1)))
+                  (local.set $s2 (array.len (local.get $b2)))
+                  ;; compare size first
+                  (if (i32.ne (local.get $s1) (local.get $s2))
+                     (then (return (i32.sub (local.get $s1) (local.get $s2)))))
+                  (br_if $next_item (i32.eq (local.get $s1) (i32.const 1)))
+                  (if (i32.gt_u (local.get $s1) (i32.const 2))
+                     (then
+                       (local.set $stack
+                          (call $push_compare_stack (local.get $stack)
+                             (local.get $b1) (local.get $b2) (i32.const 2)))))
+                  (local.set $v1
+                     (array.get $block (local.get $b1) (i32.const 1)))
+                  (local.set $v2
+                     (array.get $block (local.get $b2) (i32.const 1)))
+                  (br $loop)))
+               ;; check for forward tag
+               (if (i32.eq (local.get $t1) (global.get $forward_tag))
+                  (then
+                     (local.set $v1
+                        (array.get $block (local.get $b1) (i32.const 1)))
+                     (br $loop)))
+               ;; v1 float array > v2 not represented as block
+               (if (i32.eq (local.get $t1) (global.get $double_array_tag))
+                   (then (return (i32.const 1))))
+               (return (i32.const -1))))
+            (drop (block $v1_not_float (result (ref eq))
+               (local.set $f1
+                  (struct.get $float 0
+                     (br_on_cast_fail $v1_not_float $float (local.get $v1))))
+               (drop (block $v2_not_float (result (ref eq))
+                  (local.set $f2
+                     (struct.get $float 0
+                        (br_on_cast_fail $v2_not_float $float (local.get $v2))))
+                  (if (f64.lt (local.get $f1) (local.get $f2))
+                     (then (return (i32.const -1))))
+                  (if (f64.gt (local.get $f1) (local.get $f2))
+                     (then (return (i32.const 1))))
+                  (if (f64.ne (local.get $f1) (local.get $f2))
+                     (then
+                        (if (i32.eqz (local.get $total))
+                           (then (return (global.get $unordered))))
+                        (if (f64.eq (local.get $f1) (local.get $f1))
+                           (then (return (i32.const 1))))
+                        (if (f64.eq (local.get $f2) (local.get $f2))
+                           (then (return (i32.const -1))))))
+                  (br $next_item)))
+               ;; ZZZ forward tag
+               ;; ZZZ float array
+      (call $log (i32.const 2))
+               (unreachable)
+               (return (i32.const 1))))
+            (if (ref.test $float (local.get $v2))
+               (then
+                  ;; ZZZ forward tag
+                  ;; ZZZ float array
+      (call $log (i32.const 3))
+                  (unreachable)
+                  (return (i32.const -1))))
+            (drop (block $v1_not_string (result (ref eq))
+               (local.set $str1
+                  (br_on_cast_fail $v1_not_string $string (local.get $v1)))
+               (drop (block $v2_not_string (result (ref eq))
+                  (local.set $str2
+                      (br_on_cast_fail $v2_not_string $string (local.get $v2)))
+                  (local.set $res
+                     (call $compare_strings
+                        (local.get $str1) (local.get $str2)))
+                  (br_if $next_item (i32.eqz (local.get $res)))
+                  (return (local.get $res))))
+               ;; ZZZ forward tag
+               ;; ZZZ float array
+      (call $log (i32.const 4))
+               (unreachable)
+               (return (i32.const 1))))
+            (drop (block $v1_not_custom (result (ref eq))
+               (local.set $c1
+                  (br_on_cast_fail $v1_not_custom $custom (local.get $v1)))
+               (drop (block $v2_not_custom (result (ref eq))
+                  (local.set $c2
+                      (br_on_cast_fail $v2_not_custom $custom (local.get $v2)))
+                  ;; ZZZ compare types
+                  ;; ZZZ abstract value?
+                  (local.set $res
+                     (call_ref $value->value->int
+                        (local.get $v1) (local.get $v2)
+                        (struct.get $custom_operations 1
+                           (struct.get $custom 0 (local.get $c1)))
+                        ))
+                  (br_if $next_item (i32.eqz (local.get $res)))
+                  (return (local.get $res))))
+               ;; ZZZ forward tag
+               ;; ZZZ float array
+      (call $log (i32.const 5))
+               (unreachable)
+               (return (i32.const 1))))
+      (call $log (i32.const 6))
+            (unreachable)
+            ;; ZZZ forward tag
+            ;; ZZZ float array
+            (return (i32.const 1)))
+         (if (call $compare_stack_is_not_empty (local.get $stack))
+            (then
+               (local.set $tuple (call $pop_compare_stack (local.get $stack)))
+               (local.set $v1 (tuple.extract 0 (local.get $tuple)))
+               (local.set $v2 (tuple.extract 1 (local.get $tuple)))
+               (br $loop))))
+     (i32.const 0))
+
+   (func (export "caml_compare")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (local $res i32)
+      (local.set $res
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 1)))
+      (if (i32.lt_s (local.get $res) (i32.const 0))
+         (then (return (i31.new (i32.const -1)))))
+      (if (i32.gt_s (local.get $res) (i32.const 0))
+         (then (return (i31.new (i32.const 1)))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_equal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new
+         (i32.eqz
+            (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+
+   (func (export "caml_notequal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new
+         (i32.ne (i32.const 0)
+            (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+
+   (func (export "caml_lessthan")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (local $res i32)
+      (local.set $res
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
+      (i31.new
+         (i32.and (i32.lt_s (local.get $res) (i32.const 0))
+                  (i32.ne (local.get $res) (global.get $unordered)))))
+
+   (func (export "caml_lessequal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (local $res i32)
+      (local.set $res
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
+      (i31.new
+         (i32.and (i32.le_s (local.get $res) (i32.const 0))
+                  (i32.ne (local.get $res) (global.get $unordered)))))
+
+   (func (export "caml_greaterthan")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new (i32.lt_s (i32.const 0)
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+
+   (func (export "caml_greaterequal")
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
+      (i31.new (i32.le_s (i32.const 0)
+         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
+)
diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
new file mode 100644
index 0000000000..9c5826e118
--- /dev/null
+++ b/runtime/wasm/deps.json
@@ -0,0 +1,69 @@
+[
+  {
+    "name": "root",
+    "reaches": ["init"],
+    "root": true
+  },
+  {
+    "name": "init",
+    "export": "_initialize"
+  },
+  {
+    "name": "callback",
+    "export": "caml_callback"
+  },
+  {
+    "name": "wrap_callback",
+    "import": ["bindings", "wrap_callback"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "wrap_callback_args",
+    "import": ["bindings", "wrap_callback_args"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "wrap_callback_strict",
+    "import": ["bindings", "wrap_callback_strict"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "wrap_callback_unsafe",
+    "import": ["bindings", "wrap_callback_unsafe"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "meth_wrap_callback",
+    "import": ["bindings", "meth_wrap_callback"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "meth_wrap_callback_args",
+    "import": ["bindings", "meth_wrap_callback_args"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "meth_wrap_callback_strict",
+    "import": ["bindings", "meth_wrap_callback_strict"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "meth_wrap_callback_unsafe",
+    "import": ["bindings", "meth_wrap_callback_unsafe"],
+    "reaches": ["callback"]
+  },
+  {
+    "name": "alloc_tm",
+    "export": "caml_alloc_tm"
+  },
+  {
+    "name": "gmtime",
+    "import": ["bindings", "gmtime"],
+    "reaches": ["alloc_tm"]
+  },
+  {
+    "name": "localtime",
+    "import": ["bindings", "localtime"],
+    "reaches": ["alloc_tm"]
+  },
+]
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
new file mode 100644
index 0000000000..58f45f1ee7
--- /dev/null
+++ b/runtime/wasm/domain.wat
@@ -0,0 +1,41 @@
+(module
+   (type $block (array (mut (ref eq))))
+
+   (func (export "caml_atomic_cas")
+      (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
+      (result (ref eq))
+      (local $b (ref $block))
+      (local.set $b (ref.cast $block (local.get $ref)))
+      (if (result (ref eq))
+         (ref.eq (array.get $block (local.get $b) (i32.const 1))
+                 (local.get $o))
+         (then
+            (array.set $block (local.get $b) (i32.const 1) (local.get $n))
+            (i31.new (i32.const 1)))
+         (else
+            (i31.new (i32.const 0)))))
+
+   (func (export "caml_atomic_load") (param (ref eq)) (result (ref eq))
+      (array.get $block (ref.cast $block (local.get 0)) (i32.const 1)))
+
+   (func (export "caml_atomic_fetch_add")
+     (param $ref (ref eq)) (param $i (ref eq)) (result (ref eq))
+     (local $b (ref $block))
+     (local $old (ref eq))
+     (local.set $b (ref.cast $block (local.get $ref)))
+     (local.set $old (array.get $block (local.get $b) (i32.const 1)))
+     (array.set $block (local.get $b) (i32.const 1)
+        (i31.new (i32.add (i31.get_s (ref.cast i31 (local.get $old)))
+                          (i31.get_s (ref.cast i31 (local.get $i))))))
+     (local.get $old))
+
+   (global $caml_domain_dls (mut (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_domain_dls_set") (param $a (ref eq)) (result (ref eq))
+      (global.set $caml_domain_dls (local.get $a))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_domain_dls_get") (param (ref eq)) (result (ref eq))
+      (global.get $caml_domain_dls))
+)
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index ca62662dbf..19f2fc2f52 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -1,10 +1,16 @@
 (install
  (section lib)
  (package wasm_of_ocaml-compiler)
- (files runtime.wasm))
+ (files runtime.wasm runtime.js))
 
 (rule
    (target runtime.wasm)
-   (deps runtime.wat)
+   (deps args)
    (action
-      (run wasm-opt -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{deps} -O  -o %{target})))
+      (pipe-stdout
+         (run wasm-merge -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{read-lines:args} -o -)
+         (run wasm-opt -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory - -O3 -o %{target}))))
+
+(rule (target args)
+   (deps args.ml (glob_files *.wat))
+   (action (with-stdout-to %{target}  (run ocaml %{deps}))))
diff --git a/runtime/wasm/dynlink.wat b/runtime/wasm/dynlink.wat
new file mode 100644
index 0000000000..59fc84c90a
--- /dev/null
+++ b/runtime/wasm/dynlink.wat
@@ -0,0 +1,15 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_dynlink_close_lib")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_dynlink_close_lib"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_dynlink_lookup_symbol")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_dynlink_lookup_symbol"))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
new file mode 100644
index 0000000000..06f818edac
--- /dev/null
+++ b/runtime/wasm/fail.wat
@@ -0,0 +1,56 @@
+(module
+   (import "stdlib" "caml_global_data"
+      (global $caml_global_data (mut (ref $block))))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
+
+   (func $caml_raise_constant (param (ref eq))
+      (throw $ocaml_exception (local.get 0)))
+
+   (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))
+      (throw $ocaml_exception
+         (array.new_fixed $block
+            (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
+
+   (global $FAILURE_EXN i32 (i32.const 2))
+
+   (func (export "caml_failwith") (param $arg (ref eq))
+       (return_call $caml_raise_with_arg
+           (array.get $block (global.get $caml_global_data)
+              (global.get $FAILURE_EXN))
+           (local.get 0)))
+
+   (global $INVALID_EXN i32 (i32.const 3))
+
+   (func $caml_invalid_argument (export "caml_invalid_argument")
+       (param $arg (ref eq))
+       (return_call $caml_raise_with_arg
+           (array.get $block (global.get $caml_global_data)
+              (global.get $INVALID_EXN))
+           (local.get 0)))
+
+   (data $index_out_of_bounds "index out of bounds")
+
+   (func (export "caml_bound_error")
+      (return_call $caml_invalid_argument
+         (array.new_data $string $index_out_of_bounds
+            (i32.const 0) (i32.const 19))))
+
+   (global $ZERO_DIVIDE_EXN i32 (i32.const 5))
+
+   (func (export "caml_raise_zero_divide")
+      (return_call $caml_raise_constant
+         (array.get $block (global.get $caml_global_data)
+                    (global.get $ZERO_DIVIDE_EXN))))
+
+   (global $NOT_FOUND_EXN i32 (i32.const 6))
+
+   (func (export "caml_raise_not_found")
+      (return_call $caml_raise_constant
+         (array.get $block (global.get $caml_global_data)
+                    (global.get $NOT_FOUND_EXN))))
+
+)
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
new file mode 100644
index 0000000000..0605a6c005
--- /dev/null
+++ b/runtime/wasm/fs.wat
@@ -0,0 +1,58 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_sys_getcwd")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_getcwd"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_mkdir")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_mkdir"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_read_directory")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_read_directory"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_remove")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_remove"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_rename")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_rename"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_file_exists")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_file_exists"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_fs_init") (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_ostype_cygwin")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_const_ostype_cygwin"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_ostype_win32")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_const_ostype_win32"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_max_wosize")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0xfffffff)))
+)
diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat
new file mode 100644
index 0000000000..67052962f6
--- /dev/null
+++ b/runtime/wasm/gc.wat
@@ -0,0 +1,13 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_gc_quick_stat")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_gc_quick_stat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_final_register")
+     (param (ref eq) (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
new file mode 100644
index 0000000000..13095fee7f
--- /dev/null
+++ b/runtime/wasm/hash.wat
@@ -0,0 +1,206 @@
+(module
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+   (type $float (struct (field f64)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+
+   (func $caml_hash_mix_int (param $h i32) (param $d i32) (result i32)
+      (i32.add
+         (i32.mul
+            (i32.rotl
+               (i32.xor
+                  (i32.mul
+                     (i32.rotl
+                        (i32.mul (local.get $d) (i32.const 0xcc9e2d51))
+                        (i32.const 15))
+                     (i32.const 0x1b873593))
+                  (local.get $h))
+               (i32.const 13))
+            (i32.const 5))
+         (i32.const 0xe6546b64)))
+
+   (func $caml_hash_mix_final (param $h i32) (result i32)
+      (local.set $h
+         (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
+      (local.set $h (i32.mul (local.get $h) (i32.const 0x85ebca6b)))
+      (local.set $h
+         (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 13))))
+      (local.set $h (i32.mul (local.get $h) (i32.const 0xc2b2ae35)))
+      (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
+
+   (func $caml_hash_mix_int64 (param $h i32) (param $d i64) (result i32)
+      (return_call $caml_hash_mix_int
+         (call $caml_hash_mix_int (local.get $h) (i32.wrap_i64 (local.get $d)))
+         (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
+
+   (func $caml_hash_mix_float (param $h i32) (param $d f64) (result i32)
+      (local $i i64)
+      (local.set $i (i64.reinterpret_f64 (local.get $d)))
+      (if (i64.eq (i64.and (local.get $i) (i64.const 0x7FF0000000000000))
+                  (i64.const 0x7ff0000000000000))
+         (then
+            (if (i64.ne (i64.and (local.get $i) (i64.const 0xFFFFFFFFFFFFF))
+                        (i64.const 0))
+               (then (local.set $i (i64.const 0x7ff0000000000001))))))
+      (if (i64.eq (local.get $i) (i64.const 0x8000000000000000))
+         (then (local.set $i (i64.const 0))))
+      (return_call $caml_hash_mix_int64 (local.get $h) (local.get $i)))
+
+   (func $caml_hash_mix_string
+      (param $h i32) (param $s (ref $string)) (result i32)
+      (local $i i32) (local $len i32) (local $w i32)
+      (local.set $len (array.len (local.get $s)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len))
+            (then
+               (local.set $h
+                  (call $caml_hash_mix_int
+                     (local.get $h)
+                     (i32.or
+                        (i32.or
+                           (array.get_u $string (local.get $s) (local.get $i))
+                           (i32.shl (array.get_u $string (local.get $s)
+                                       (i32.add (local.get $i) (i32.const 1)))
+                                    (i32.const 8)))
+                        (i32.or
+                           (i32.shl (array.get_u $string (local.get $s)
+                                       (i32.add (local.get $i) (i32.const 2)))
+                                    (i32.const 16))
+                           (i32.shl (array.get_u $string (local.get $s)
+                                       (i32.add (local.get $i) (i32.const 3)))
+                                    (i32.const 24))))))
+               (local.set $i (i32.add (local.get $i) (i32.const 4)))
+               (br $loop))))
+      (local.set $w (i32.const 0))
+      (block $0_bytes
+         (block $1_byte
+            (block $2_bytes
+               (block $3_bytes
+                  (br_table $0_bytes $1_byte $2_bytes $3_bytes
+                     (i32.and (local.get $len) (i32.const 3))))
+               (local.set $w
+                  (i32.shl (array.get_u $string (local.get $s)
+                              (i32.add (local.get $i) (i32.const 2)))
+                           (i32.const 16))))
+            (local.set $w
+               (i32.or (local.get $w)
+                  (i32.shl (array.get_u $string (local.get $s)
+                              (i32.add (local.get $i) (i32.const 1)))
+                           (i32.const 8)))))
+         (local.set $w
+            (i32.or (local.get $w)
+               (array.get_u $string (local.get $s) (local.get $i))))
+         (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
+      (i32.xor (local.get $h) (local.get $len)))
+
+   (global $HASH_QUEUE_SIZE i32 (i32.const 256))
+
+   (global $caml_hash_queue (ref $block)
+      (array.new $block (i31.new (i32.const 0)) (global.get $HASH_QUEUE_SIZE)))
+
+   (func (export "caml_hash")
+      (param $count (ref eq)) (param $limit (ref eq)) (param $seed (ref eq))
+      (param $obj (ref eq)) (result (ref eq))
+      (local $sz i32) (local $num i32) (local $h i32)
+      (local $rd i32) (local $wr i32)
+      (local $v (ref eq))
+      (local $b (ref $block))
+      (local $i i32)
+      (local $len i32)
+      (local $tag i32)
+      (local.set $sz (i31.get_u (ref.cast i31 (local.get $limit))))
+      (if (i32.gt_u (local.get $sz) (global.get $HASH_QUEUE_SIZE))
+         (then (local.set $sz (global.get $HASH_QUEUE_SIZE))))
+      (local.set $num (i31.get_u (ref.cast i31 (local.get $count))))
+      (local.set $h (i31.get_s (ref.cast i31 (local.get $seed))))
+      (array.set $block
+         (global.get $caml_hash_queue) (i32.const 0) (local.get $obj))
+      (local.set $rd (i32.const 0))
+      (local.set $wr (i32.const 1))
+      (loop $loop
+         (if (i32.and (i32.lt_u (local.get $rd) (local.get $wr))
+                      (i32.gt_u (local.get $num) (i32.const 0)))
+            (then
+               (local.set $v
+                  (array.get $block (global.get $caml_hash_queue)
+                     (local.get $rd)))
+               (local.set $rd (i32.add (local.get $rd) (i32.const 1)))
+               (block $again
+                  (drop (block $not_int (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (i31.get_s
+                              (br_on_cast_fail $not_int i31 (local.get $v)))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  (drop (block $not_string (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_string (local.get $h)
+                           (br_on_cast_fail $not_string $string (local.get $v))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  (drop (block $not_block (result (ref eq))
+                     (local.set $b
+                        (br_on_cast_fail $not_block $block (local.get $v)))
+                     (local.set $tag
+                        (i31.get_u
+                           (ref.cast i31
+                              (array.get $block (local.get $b) (i32.const 0)))))
+                     ;; ZZZ Special tags (forward / object)
+                     (local.set $len (array.len (local.get $b)))
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (i32.or
+                              (i32.sub (local.get $len) (i32.const 1))
+                              (local.get $tag))))
+                     (local.set $i (i32.const 1))
+                     (loop $block_iter
+                        (br_if $loop (i32.ge_u (local.get $i) (local.get $len)))
+                        (br_if $loop (i32.ge_u (local.get $wr) (local.get $sz)))
+                        (array.set $block (global.get $caml_hash_queue)
+                           (local.get $wr)
+                           (array.get $block (local.get $b) (local.get $i)))
+                        (local.set $wr (i32.add (local.get $wr) (i32.const 1)))
+                        (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                        (br $block_iter))))
+                  (drop (block $not_float (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_float (local.get $h)
+                           (struct.get $float 0
+                              (br_on_cast_fail $not_float $float
+                                 (local.get $v)))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  (drop (block $not_custom (result (ref eq))
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (call_ref $value->int
+                              (local.get $v)
+                              (struct.get $custom_operations 2
+                                 (br_on_null $loop
+                                    (struct.get $custom 0
+                                       (br_on_cast_fail $not_custom $custom
+                                          (local.get $v))))))))
+                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
+                     (br $loop)))
+                  ;; ZZZ other cases? (closures, javascript values)
+                  (unreachable)
+                  (br $loop)))))
+      ;; clear the queue to avoid a memory leak
+      (array.fill $block (global.get $caml_hash_queue)
+         (i32.const 0) (i31.new (i32.const 0)) (local.get $wr))
+      (i31.new (i32.and (call $caml_hash_mix_final (local.get $h))
+                        (i32.const 0x3FFFFFFF))))
+)
diff --git a/runtime/wasm/ieee_754.wat b/runtime/wasm/ieee_754.wat
new file mode 100644
index 0000000000..415c2cce23
--- /dev/null
+++ b/runtime/wasm/ieee_754.wat
@@ -0,0 +1,141 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "bindings" "format" (func $format_float (param f64) (result anyref)))
+
+   (type $float (struct (field f64)))
+   (type $string (array (mut i8)))
+   (type $block (array (mut (ref eq))))
+
+   (func (export "caml_hexstring_of_float")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (array.new_fixed $string (i32.const 64)))
+
+   (func (export "caml_nextafter")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $y f64) (local $i i64) (local $j i64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
+      (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
+      (if (f64.eq (local.get $x) (local.get $y))
+         (then (return (local.get 1))))
+      (if (result (ref eq)) (f64.eq (local.get $x) (f64.const 0))
+         (then
+            (if (f64.ge (local.get $y) (f64.const 0))
+               (then (return (struct.new $float (f64.const 0x1p-1074))))
+               (else (return (struct.new $float (f64.const -0x1p-1074))))))
+         (else
+            (local.set $i (i64.reinterpret_f64 (local.get $x)))
+            (local.set $j (i64.reinterpret_f64 (local.get $y)))
+            (if (i32.and (i64.lt_s (local.get $i) (local.get $j))
+                         (i64.lt_u (local.get $i) (local.get $j)))
+               (then (local.set $i (i64.add (local.get $i) (i64.const 1))))
+               (else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
+            (return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
+
+
+   (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
+      (local $a f64)
+      (local.set $a
+         (f64.abs (struct.get $float 0 (ref.cast $float (local.get 0)))))
+      (i31.new
+         (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
+            (then
+               (if (result i32) (f64.lt (local.get $a) (f64.const infinity))
+                  (then (i32.const 0)) ;; normal
+                  (else (i32.const 3)))) ;; infinity
+            (else
+               (if (result i32) (f64.eq (local.get $a) (f64.const 0))
+                  (then (i32.const 2)) ;; zero
+                  (else
+                     (if (result i32) (f64.eq (local.get $a) (local.get $a))
+                        (then (i32.const 1)) ;; subnormal
+                        (else (i32.const 4))))))))) ;; nan
+
+   (func (export "caml_modf_float") (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $a f64) (local $i f64) (local $f f64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $a (f64.abs (local.get $x)))
+      (if (f64.ge (local.get $a) (f64.const 0))
+         (then
+            (if (f64.lt (local.get $a) (f64.const infinity))
+               (then ;; normal
+                  (local.set $i (f64.floor (local.get $a)))
+                  (local.set $f (f64.sub (local.get $a) (local.get $i)))
+                  (local.set $i (f64.copysign (local.get $i) (local.get $x)))
+                  (local.set $f (f64.copysign (local.get $f) (local.get $x))))
+               (else ;; infinity
+                  (local.set $i (local.get $x))
+                  (local.set $f (f64.copysign (f64.const 0) (local.get $x))))))
+         (else ;; zero or nan
+            (local.set $i (local.get $x))
+            (local.set $f (local.get $x))))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
+
+   (func (export "caml_ldexp")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $n i32)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $n (i31.get_s (ref.cast i31 (local.get 1))))
+      (if (i32.gt_s (local.get $n) (i32.const 1023))
+         (then
+            (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
+            (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
+            (if (i32.gt_s (local.get $n) (i32.const 1023))
+               (then
+                  ;; subnormal
+                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
+                  (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
+                  (if (i32.gt_s (local.get $n) (i32.const 1023))
+                     (then (local.set $n (i32.const 1023))))))
+         (else
+            (if (i32.lt_s (local.get $n) (i32.const -1022))
+               (then
+                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p-969)))
+                  (local.set $n (i32.add (local.get $n) (i32.const 969)))
+                  (if (i32.lt_s (local.get $n) (i32.const -1022))
+                     (then
+                        (local.set $x
+                           (f64.mul (local.get $x) (f64.const 0x1p-969)))
+                        (local.set $n (i32.add (local.get $n) (i32.const 969)))
+                        (if (i32.lt_s (local.get $n) (i32.const -1022))
+                           (then (local.set $n (i32.const -1022)))))))))))
+      (struct.new $float
+         (f64.mul (local.get $x)
+            (f64.reinterpret_i64
+               (i64.shl (i64.add (i64.extend_i32_s (local.get $n))
+                                 (i64.const 0x3ff))
+                        (i64.const 52))))))
+
+   (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_float_of_string"))
+      (unreachable))
+
+   (func (export "caml_float_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $y f64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (if (f64.eq (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const 0)))))
+      (if (f64.lt (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (if (f64.gt (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (if (f64.eq (local.get $x) (local.get $x))
+         (then (return (i31.new (i32.const 1)))))
+      (if (f64.eq (local.get $y) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_format_float")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $caml_string_of_jsstring (call $wrap (call $format_float (struct.get $float 0 (ref.cast $float (local.get 1)))))))
+)
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
new file mode 100644
index 0000000000..2a55cc709c
--- /dev/null
+++ b/runtime/wasm/int32.wat
@@ -0,0 +1,104 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "ints" "parse_int"
+      (func $parse_int
+         (param (ref eq)) (param i32) (param (ref $string)) (result i32)))
+
+   (type $string (array (mut i8)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+
+   (global $int32_ops (export "int32_ops") (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string (i32.const 95) (i32.const 105)) ;; "_i"
+         (ref.func $int32_cmp)
+         (ref.func $int32_hash)))
+
+   (type $int32
+      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
+
+   (func $int32_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
+      (local $i1 i32) (local $i2 i32)
+      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get $v1))))
+      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get $v2))))
+      (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
+               (i32.lt_s (local.get $i1) (local.get $i2))))
+
+   (func $int32_hash (param $v (ref eq)) (result i32)
+      (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+
+   (func $caml_copy_int32 (export "caml_copy_int32")
+      (param $i i32) (result (ref eq))
+      (struct.new $int32 (global.get $int32_ops) (local.get $i)))
+
+   (func (export "caml_int32_bswap") (param (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local.set $i (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
+      (return_call $caml_copy_int32
+         (i32.or
+            (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
+                      (i32.const 8))
+            (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00))
+                      (i32.const 8)))))
+
+   (global $INT32_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Int32.of_string"
+         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 51)
+         (i32.const 50) (i32.const 46) (i32.const 111) (i32.const 102)
+         (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
+         (i32.const 105) (i32.const 110) (i32.const 103)))
+
+   (func (export "caml_int32_of_string") (param $v (ref eq)) (result (ref eq))
+      (return_call $caml_copy_int32
+         (call $parse_int
+            (local.get $v) (i32.const 32) (global.get $INT32_ERRMSG))))
+
+   (export "caml_nativeint_compare" (func $caml_int32_compare))
+   (func $caml_int32_compare (export "caml_int32_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $i1 i32) (local $i2 i32)
+      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
+      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get 1))))
+      (i31.new (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
+                        (i32.lt_s (local.get $i1) (local.get $i2)))))
+
+   (global $nativeint_ops (export "nativeint_ops") (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string (i32.const 95) (i32.const 110)) ;; "_n"
+         (ref.func $int32_cmp)
+         (ref.func $int32_hash)))
+
+   (func $caml_copy_nativeint (export "caml_copy_nativeint")
+      (param $i i32) (result (ref eq))
+      (struct.new $int32 (global.get $nativeint_ops) (local.get $i)))
+
+   (global $NATIVEINT_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Nativeint.of_string"
+         (i32.const 78) (i32.const 97) (i32.const 116) (i32.const 105)
+         (i32.const 118) (i32.const 101) (i32.const 46) (i32.const 111)
+         (i32.const 102) (i32.const 95) (i32.const 115) (i32.const 116)
+         (i32.const 114) (i32.const 105) (i32.const 110) (i32.const 103)))
+
+   (func (export "caml_nativeint_of_string")
+      (param $v (ref eq)) (result (ref eq))
+      (return_call $caml_copy_int32
+         (call $parse_int
+            (local.get $v) (i32.const 32) (global.get $NATIVEINT_ERRMSG))))
+
+   ;; ZZZ
+   (func $dummy_format_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $log_js (string.const "dummy_format_fun"))
+      (array.new_fixed $string (i32.const 64)))
+   (export "caml_int32_format" (func $dummy_format_fun))
+   (export "caml_nativeint_format" (func $dummy_format_fun))
+)
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
new file mode 100644
index 0000000000..3f32c552af
--- /dev/null
+++ b/runtime/wasm/int64.wat
@@ -0,0 +1,146 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "ints" "parse_sign_and_base"
+      (func $parse_sign_and_base
+         (param (ref $string)) (result i32 i32 i32 i32)))
+   (import "ints" "parse_digit" (func $parse_digit (param i32) (result i32)))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+
+   (type $string (array (mut i8)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+
+   (global $int64_ops (export "int64_ops") (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string (i32.const 95) (i32.const 106)) ;; "_j"
+         (ref.func $int64_cmp)
+         (ref.func $int64_hash)))
+
+   (type $int64
+      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
+
+   (func $int64_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
+      (local $i1 i64) (local $i2 i64)
+      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get $v1))))
+      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get $v2))))
+      (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
+               (i64.lt_s (local.get $i1) (local.get $i2))))
+
+   (func $int64_hash (param $v (ref eq)) (result i32)
+      (local $i i64)
+      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+      (i32.xor
+         (i32.wrap_i64 (local.get $i))
+         (i32.wrap_i64 (i64.shr_u (local.get $i) (i64.const 32)))))
+
+   (func $caml_copy_int64 (export "caml_copy_int64")
+      (param $i i64) (result (ref eq))
+      (struct.new $int64 (global.get $int64_ops) (local.get $i)))
+
+   (func (export "caml_int64_bswap") (param (ref eq)) (result (ref eq))
+      (local $i i64)
+      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
+      (return_call $caml_copy_int64
+         (i64.or
+            (i64.or
+               (i64.rotr (i64.and (local.get $i) (i64.const 0x000000FF000000FF))
+                         (i64.const 8))
+               (i64.rotr (i64.and (local.get $i) (i64.const 0x0000FF000000FF00))
+                         (i64.const 24)))
+            (i64.or
+               (i64.rotl (i64.and (local.get $i) (i64.const 0x00FF000000FF0000))
+                         (i64.const 24))
+               (i64.rotl (i64.and (local.get $i) (i64.const 0xFF000000FF000000))
+                         (i64.const 8))))))
+
+   (func (export "caml_int64_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $i1 i64) (local $i2 i64)
+      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
+      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get 1))))
+      (i31.new (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
+                        (i64.lt_s (local.get $i1) (local.get $i2)))))
+
+   (global $INT64_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Int64.of_string"
+         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 54)
+         (i32.const 52) (i32.const 46) (i32.const 111) (i32.const 102)
+         (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
+         (i32.const 105) (i32.const 110) (i32.const 103)))
+
+   (func (export "caml_int64_of_string") (param $v (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local $i i32) (local $len i32) (local $d i32) (local $c i32)
+      (local $signedness i32) (local $sign i32) (local $base i32)
+      (local $res i64) (local $threshold i64)
+      (local $t (i32 i32 i32 i32))
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $len (array.len (local.get $s)))
+      (local.set $t (call $parse_sign_and_base (local.get $s)))
+      (local.set $i (tuple.extract 0 (local.get $t)))
+      (local.set $signedness (tuple.extract 1 (local.get $t)))
+      (local.set $sign (tuple.extract 2 (local.get $t)))
+      (local.set $base (tuple.extract 3 (local.get $t)))
+      (local.set $threshold
+         (i64.div_u (i64.const -1) (i64.extend_i32_u (local.get $base))))
+      (local.set $d
+         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
+      (if (i32.ge_u (local.get $d) (local.get $base))
+         (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+      (local.set $res (i64.extend_i32_u (local.get $d)))
+      (loop $loop
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
+               (local.set $d (call $parse_digit (local.get $c)))
+               (if (i32.ge_u (local.get $d) (local.get $base))
+                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+               (if (i64.gt_u (local.get $res) (local.get $threshold))
+                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+               (local.set $res
+                  (i64.add (i64.mul (local.get $res)
+                              (i64.extend_i32_u (local.get $base)))
+                           (i64.extend_i32_u (local.get $d))))
+               (if (i64.lt_u (local.get $res) (i64.extend_i32_u (local.get $d)))
+                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+               (br $loop))))
+      (if (local.get $signedness)
+         (then
+            (if (i32.gt_s (local.get $sign) (i32.const 0))
+               (then
+                  (if (i64.ge_u (local.get $res)
+                                (i64.shl (i64.const 1) (i64.const 63)))
+                     (then (call $caml_failwith (global.get $INT64_ERRMSG)))))
+               (else
+                  (if (i64.gt_u (local.get $res)
+                                (i64.shl (i64.const 1) (i64.const 63)))
+                     (then
+                        (call $caml_failwith (global.get $INT64_ERRMSG))))))))
+      (if (i32.lt_s (local.get $sign) (i32.const 0))
+         (then (local.set $res (i64.sub (i64.const 0) (local.get $res)))))
+      (return_call $caml_copy_int64 (local.get $res)))
+
+   (func (export "caml_int64_create_lo_mi_hi")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ does not really make sense
+      (call $log_js (string.const "caml_int64_create_lo_mi_hi"))
+      (i31.new (i32.const 0)))
+
+   ;; ZZZ
+   (func $dummy_format_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $log_js (string.const "dummy_format_fun"))
+      (array.new_fixed $string (i32.const 64)))
+   (export "caml_int64_format" (func $dummy_format_fun))
+)
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
new file mode 100644
index 0000000000..0aad2ecace
--- /dev/null
+++ b/runtime/wasm/ints.wat
@@ -0,0 +1,164 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "bindings" "format" (func $format_int (param (ref eq)) (result anyref)))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+
+   (type $string (array (mut i8)))
+
+   (func (export "caml_format_int") (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 1)))))
+
+   (func $parse_sign_and_base (export "parse_sign_and_base")
+      (param $s (ref $string)) (result i32 i32 i32 i32)
+      (local $i i32) (local $len i32) (local $c i32)
+      (local $signedness i32) (local $sign i32) (local $base i32)
+      (local.set $i (i32.const 0))
+      (local.set $len (array.len (local.get $s)))
+      (local.set $signedness (i32.const 1))
+      (local.set $sign (i32.const 1))
+      (local.set $base (i32.const 10))
+      (if (i32.eqz (local.get $len))
+         (then
+            (local.set $c (array.get $string (local.get $s) (i32.const 0)))
+            (if (i32.eq (local.get $c) (i32.const 45))
+               (then
+                  (local.set $sign (i32.const -1))
+                  (local.set $i (i32.const 1))))
+               (else (if (i32.eq (local.get $c) (i32.const 43))
+                  (then (local.set $i (i32.const 1)))))))
+      (if (i32.lt_s (i32.add (local.get $i) (i32.const 1)) (local.get $len))
+         (then (if (i32.eq (array.get $string (local.get $s) (local.get $i))
+                           (i32.const 48))
+            (then
+               (local.set $c
+                  (array.get $string (local.get $s)
+                     (i32.add (local.get $i) (i32.const 1))))
+               (if (i32.or (i32.eq (local.get $c) (i32.const 88))
+                           (i32.eq (local.get $c) (i32.const 120)))
+                  (then
+                     (local.set $base (i32.const 16))
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
+               (else (if (i32.or (i32.eq (local.get $c) (i32.const 79))
+                                 (i32.eq (local.get $c) (i32.const 111)))
+                  (then
+                     (local.set $base (i32.const 8))
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
+               (else (if (i32.or (i32.eq (local.get $c) (i32.const 66))
+                                 (i32.eq (local.get $c) (i32.const 98)))
+                  (then
+                     (local.set $base (i32.const 2))
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
+               (else (if (i32.or (i32.eq (local.get $c) (i32.const 85))
+                                 (i32.eq (local.get $c) (i32.const 117)))
+                  (then
+                     (local.set $signedness (i32.const 0))
+                     (local.set $i (i32.add (local.get $i)
+                        (i32.const 2)))))))))))))))
+      (tuple.make
+         (local.get $i) (local.get $signedness) (local.get $sign)
+         (local.get $base)))
+
+   (func $parse_digit (export "parse_digit") (param $c i32) (result i32)
+      (if (i32.and (i32.ge_u (local.get $c) (i32.const 48))
+                   (i32.le_u (local.get $c) (i32.const 57)))
+         (then (return (i32.sub (local.get $c) (i32.const 48)))))
+      (if (i32.and (i32.ge_u (local.get $c) (i32.const 65))
+                   (i32.le_u (local.get $c) (i32.const 90)))
+         (then (return (i32.sub (local.get $c) (i32.const 55)))))
+      (if (i32.and (i32.ge_u (local.get $c) (i32.const 97))
+                   (i32.le_u (local.get $c) (i32.const 122)))
+         (then (return (i32.sub (local.get $c) (i32.const 87)))))
+      (return (i32.const -1)))
+
+   (func $parse_int (export "parse_int")
+      (param $v (ref eq)) (param $nbits i32) (param $errmsg (ref $string))
+      (result i32)
+      (local $s (ref $string))
+      (local $i i32) (local $len i32) (local $d i32) (local $c i32)
+      (local $signedness i32) (local $sign i32) (local $base i32)
+      (local $res i32) (local $threshold i32)
+      (local $t (i32 i32 i32 i32))
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $len (array.len (local.get $s)))
+      (local.set $t (call $parse_sign_and_base (local.get $s)))
+      (local.set $i (tuple.extract 0 (local.get $t)))
+      (local.set $signedness (tuple.extract 1 (local.get $t)))
+      (local.set $sign (tuple.extract 2 (local.get $t)))
+      (local.set $base (tuple.extract 3 (local.get $t)))
+      (local.set $threshold (i32.div_u (i32.const -1) (local.get $base)))
+      (local.set $d
+         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
+      (if (i32.ge_u (local.get $d) (local.get $base))
+         (then (call $caml_failwith (local.get $errmsg))))
+      (local.set $res (local.get $d))
+      (loop $loop
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
+               (local.set $d (call $parse_digit (local.get $c)))
+               (if (i32.ge_u (local.get $d) (local.get $base))
+                  (then (call $caml_failwith (local.get $errmsg))))
+               (if (i32.gt_u (local.get $res) (local.get $threshold))
+                  (then (call $caml_failwith (local.get $errmsg))))
+               (local.set $res
+                  (i32.add (i32.mul (local.get $res) (local.get $base))
+                           (local.get $d)))
+               (if (i32.lt_u (local.get $res) (local.get $d))
+                  (then (call $caml_failwith (local.get $errmsg))))
+               (br $loop))))
+      (if (local.get $signedness)
+         (then
+            (local.set $threshold
+               (i32.shl (i32.const 1)
+                  (i32.sub (local.get $nbits) (i32.const 1))))
+            (if (i32.gt_s (local.get $sign) (i32.const 0))
+               (then
+                  (if (i32.ge_u (local.get $res) (local.get $threshold))
+                     (then (call $caml_failwith (local.get $errmsg)))))
+               (else
+                  (if (i32.gt_u (local.get $res) (local.get $threshold))
+                     (then (call $caml_failwith (local.get $errmsg)))))))
+         (else
+            (if (i32.and
+                   (i32.lt_u (local.get $nbits) (i32.const 32))
+                   (i32.ge_u (local.get $res)
+                     (i32.shl (i32.const 1) (local.get $nbits))))
+               (then (call $caml_failwith (local.get $errmsg))))))
+      (if (i32.lt_s (local.get $sign) (i32.const 0))
+         (then (local.set $res (i32.sub (i32.const 0) (local.get $res)))))
+      (local.get $res))
+
+   (global $INT_ERRMSG (ref $string)
+      (array.new_fixed $string ;; "Int.of_string"
+         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 46)
+         (i32.const 111) (i32.const 102) (i32.const 95) (i32.const 115)
+         (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110)
+         (i32.const 103)))
+
+   (func (export "caml_int_of_string")
+      (param $v (ref eq)) (result (ref eq))
+      (i31.new
+         (call $parse_int
+            (local.get $v) (i32.const 31) (global.get $INT_ERRMSG))))
+
+   (func (export "caml_bswap16") (param (ref eq)) (result (ref eq))
+      (local $x i32)
+      (local.set $x (i31.get_s (ref.cast i31 (local.get 0))))
+      (i31.new
+         (i32.or
+            (i32.shl (i32.and (local.get $x) (i32.const 0xFF)) (i32.const 8))
+            (i32.shr_u (i32.and (local.get $x) (i32.const 0x00FF))
+               (i32.const 8)))))
+
+   (func (export "%caml_format_int_special") (param (ref eq)) (result (ref eq))
+      (call $log_js (string.const "%caml_format_int_special"))
+      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 0)))))
+)
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
new file mode 100644
index 0000000000..9c374cd917
--- /dev/null
+++ b/runtime/wasm/io.wat
@@ -0,0 +1,142 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_sys_open")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_open"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_close")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_close"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_set_channel_name")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_set_channel_name"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_out_channels_list")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_out_channels_list"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_open_descriptor_in")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_open_descriptor_in"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_open_descriptor_out")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_open_descriptor_out"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_close_channel")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_close_channel"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_input")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_input_value") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_input_value"))
+      (unreachable))
+
+   (func (export "caml_ml_input_char")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input_char"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_input_int")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input_int"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_pos_in")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_pos_in"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_pos_out")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_pos_out"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_seek_in")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_seek_in"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_seek_in_64")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_seek_in_64"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_seek_out")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_seek_out"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_input_scan_line")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_input_scan_line"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_flush") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_flush"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_output")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_output_bytes")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output_bytes"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_output_char")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output_char"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_output_value")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_output_value"))
+      (unreachable))
+
+   (func (export "caml_ml_output_int")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_output_int"))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
new file mode 100644
index 0000000000..b9a4d22e4e
--- /dev/null
+++ b/runtime/wasm/jslib.wat
@@ -0,0 +1,521 @@
+(module
+   (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
+   (import "bindings" "identity" (func $from_float (param f64) (result anyref)))
+   (import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
+   (import "bindings" "identity" (func $ref_cast_string (param anyref) (result stringref)))
+   (import "bindings" "from_bool" (func $from_bool (param i32) (result anyref)))
+   (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
+   (import "bindings" "get" (func $get (param externref) (param anyref) (result anyref)))
+   (import "bindings" "set" (func $set (param anyref) (param anyref) (param anyref)))
+   (import "bindings" "delete" (func $delete (param anyref) (param anyref)))
+   (import "bindings" "instanceof"
+      (func $instanceof (param anyref) (param anyref) (result i32)))
+   (import "bindings" "typeof" (func $typeof (param anyref) (result anyref)))
+   (import "bindings" "equals" (func $equals (param anyref) (param anyref) (result i32)))
+   (import "bindings" "strict_equals" (func $strict_equals (param anyref) (param anyref) (result i32)))
+   (import "bindings" "fun_call"
+      (func $fun_call
+         (param anyref) (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "meth_call" (func $meth_call (param anyref) (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "new" (func $new (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "new_obj" (func $new_obj (result anyref)))
+   (import "bindings" "new_array" (func $new_array (param i32) (result externref)))
+   (import "bindings" "iter_props"
+      (func $iter_props (param anyref) (param anyref)))
+   (import "bindings" "array_length"
+      (func $array_length (param externref) (result i32)))
+   (import "bindings" "array_get"
+      (func $array_get (param externref) (param i32) (result anyref)))
+   (import "bindings" "array_set"
+      (func $array_set (param externref) (param i32) (param anyref)))
+   (import "bindings" "wrap_callback"
+      (func $wrap_callback (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_callback_args"
+      (func $wrap_callback_args (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_callback_strict"
+      (func $wrap_callback_strict (param i32) (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_callback_unsafe"
+      (func $wrap_callback_unsafe (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback"
+      (func $wrap_meth_callback (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback_args"
+      (func $wrap_meth_callback_args (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback_strict"
+      (func $wrap_meth_callback_strict (param i32) (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_meth_callback_unsafe"
+      (func $wrap_meth_callback_unsafe (param (ref eq)) (result anyref)))
+   (import "bindings" "wrap_fun_arguments"
+      (func $wrap_fun_arguments (param anyref) (result anyref)))
+   (import "bindings" "get_int" (func $get_int (param externref) (param i32) (result i32)))
+
+   (type $block (array (mut (ref eq))))
+   (type $float (struct (field f64)))
+   (type $string (array (mut i8)))
+   (type $js (struct (field anyref)))
+   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $closure_last_arg
+      (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
+
+   (func $wrap (export "wrap") (param anyref) (result (ref eq))
+      (block $is_eq (result (ref eq))
+         (return (struct.new $js (br_on_cast $is_eq eq (local.get 0))))))
+
+   (func $unwrap (export "unwrap") (param (ref eq)) (result anyref)
+      (block $not_js (result anyref)
+         (return (struct.get $js 0
+                    (br_on_cast_fail $not_js $js (local.get 0))))))
+
+   (func (export "caml_js_equals")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $equals
+                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
+
+   (func (export "caml_js_strict_equals")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $strict_equals
+                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
+
+   ;; ZZZ We should generate JavaScript code instead of using 'eval'
+   (export "caml_pure_js_expr" (func $caml_js_expr))
+   (export "caml_js_var" (func $caml_js_expr))
+   (export "caml_js_eval_string" (func $caml_js_expr))
+   (func $caml_js_expr (export "caml_js_expr")
+      (param (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local.set $s (ref.cast $string (local.get 0)))
+      (return_call $wrap
+         (call $eval
+            (string.new_wtf8_array replace
+               (local.get $s) (i32.const 0) (array.len (local.get $s))))))
+
+   (func (export "caml_js_to_float") (param (ref eq)) (result (ref eq))
+      (struct.new $float (call $to_float (call $unwrap (local.get 0)))))
+
+   (func (export "caml_js_from_float") (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $from_float
+            (struct.get $float 0 (ref.cast $float (local.get 0))))))
+
+   (func (export "caml_js_to_bool") (param (ref eq)) (result (ref eq))
+      (i31.new (call $to_bool (struct.get $js 0 (ref.cast $js (local.get 0))))))
+
+   (func (export "caml_js_from_bool") (param (ref eq)) (result (ref eq))
+      (struct.new $js
+         (call $from_bool (i31.get_s (ref.cast i31 (local.get 0))))))
+
+  (func (export "caml_js_pure_expr")
+     (param (ref eq)) (result (ref eq))
+     (return_call_ref $function_1
+        (i31.new (i32.const 0))
+        (local.get 0)
+        (struct.get $closure 0
+           (ref.cast $closure (local.get 0)))))
+
+   (func (export "caml_js_fun_call")
+      (param $f (ref eq)) (param $args (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $fun_call (call $unwrap (local.get $f)) (ref.null any)
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_js_call")
+      (param $f (ref eq)) (param $o (ref eq)) (param $args (ref eq))
+      (result (ref eq))
+      (return_call $wrap
+         (call $fun_call (call $unwrap (local.get $f))
+            (call $unwrap (local.get $o))
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_js_meth_call")
+      (param $o (ref eq)) (param $f (ref eq)) (param $args (ref eq))
+      (result (ref eq))
+      (return_call $wrap
+         (call $meth_call (call $unwrap (local.get $o))
+            (call $unwrap (call $caml_jsstring_of_string (local.get $f)))
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_js_get")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (if (ref.test $string (local.get 1))
+         (then
+            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+      (return_call $wrap
+         (call $get (extern.externalize (call $unwrap (local.get 0)))
+            (call $unwrap (local.get 1)))))
+
+   (func (export "caml_js_set")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (if (ref.test $string (local.get 1))
+         (then
+            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+      (call $set (call $unwrap (local.get 0)) (call $unwrap (local.get 1))
+         (call $unwrap (local.get 2)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_js_delete")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (if (ref.test $string (local.get 1))
+         (then
+            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+      (call $delete (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_js_instanceof")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $instanceof
+                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
+
+   (func (export "caml_js_typeof")
+      (param (ref eq)) (result (ref eq))
+      (struct.new $js (call $typeof (call $unwrap (local.get 0)))))
+
+   (func (export "caml_js_new")
+      (param $c (ref eq)) (param $args (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $new (call $unwrap (local.get $c))
+            (call $unwrap (call $caml_js_from_array (local.get $args))))))
+
+   (func (export "caml_ojs_new_arr")
+      (param $c (ref eq)) (param $args (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $new (call $unwrap (local.get $c))
+            (call $unwrap (local.get $args)))))
+
+   (func (export "caml_ojs_iterate_properties")
+      (param $o (ref eq)) (param $f (ref eq)) (result (ref eq))
+      (call $iter_props
+         (call $unwrap (local.get $o)) (call $unwrap (local.get $f)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_js_object")
+      (param (ref eq)) (result (ref eq))
+      (local $a (ref $block)) (local $p (ref $block))
+      (local $i i32) (local $l i32)
+      (local $o anyref)
+      (local.set $a (ref.cast $block (local.get 0)))
+      (local.set $l (array.len (local.get $a)))
+      (local.set $i (i32.const 1))
+      (local.set $o (call $new_obj))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $p
+                  (ref.cast $block
+                     (array.get $block (local.get $a) (local.get $i))))
+               (call $set (local.get $o)
+                  (call $unwrap
+                     (call $caml_jsstring_of_string
+                        (array.get $block (local.get $p) (i32.const 1))))
+                  (call $unwrap
+                        (array.get $block (local.get $p) (i32.const 2))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.new $js (local.get $o)))
+
+   (func $caml_js_from_array (export "caml_js_from_array")
+      (param (ref eq)) (result (ref eq))
+      (local $a (ref $block))
+      (local $a' externref)
+      (local $i i32) (local $l i32)
+      (local.set $a (ref.cast $block (local.get 0)))
+      (local.set $l (i32.sub (array.len (local.get $a)) (i32.const 1)))
+      (local.set $a' (call $new_array (local.get $l)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (call $array_set (local.get $a') (local.get $i)
+                  (call $unwrap (array.get $block (local.get $a)
+                                   (i32.add (local.get $i) (i32.const 1)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.new $js (extern.internalize (local.get $a'))))
+
+   (func (export "caml_js_to_array")
+      (param (ref eq)) (result (ref eq))
+      (local $a externref)
+      (local $a' (ref $block))
+      (local $i i32) (local $l i32)
+      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
+      (local.set $l (call $array_length (local.get $a)))
+      (local.set $a'
+         (array.new $block (i31.new (i32.const 0))
+            (i32.add (local.get $l) (i32.const 1))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (array.set $block (local.get $a')
+                  (i32.add (local.get $i) (i32.const 1))
+                  (call $wrap (call $array_get (local.get $a) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $a'))
+
+   (func $caml_js_wrap_callback (export "caml_js_wrap_callback")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_callback (local.get 0))))
+
+   (func (export "caml_js_wrap_callback_arguments")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_callback_args (local.get 0))))
+
+   (func (export "caml_js_wrap_callback_strict")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $wrap_callback_strict
+            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+
+   (func (export "caml_js_wrap_callback_unsafe")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_callback_unsafe (local.get 0))))
+
+   (func (export "caml_js_wrap_meth_callback")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_meth_callback (local.get 0))))
+
+   (func (export "caml_js_wrap_meth_callback_arguments")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_meth_callback_args (local.get 0))))
+
+   (func (export "caml_js_wrap_meth_callback_strict")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $wrap_meth_callback_strict
+            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+
+   (func (export "caml_js_wrap_meth_callback_unsafe")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $wrap_meth_callback_unsafe (local.get 0))))
+
+   (func (export "caml_ojs_wrap_fun_arguments")
+      (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $wrap_fun_arguments
+            (call $wrap_callback_strict (i32.const 1) (local.get 0)))))
+
+   (func (export "caml_callback")
+      (param $f (ref eq)) (param $count i32) (param $args (ref extern))
+      (param $kind i32) ;; 0 ==> strict / 2 ==> unsafe
+      (result anyref)
+      (local $acc (ref eq)) (local $i i32)
+      (local.set $acc (local.get $f))
+      (if (i32.eq (local.get $kind) (i32.const 2))
+         (then
+            (loop $loop
+               (local.set $f (local.get $acc))
+               (local.set $acc
+                  (call_ref $function_1
+                     (call $wrap
+                        (call $get (local.get $args)
+                           (i31.new (local.get $i))))
+                     (local.get $acc)
+                     (struct.get $closure 0
+                        (ref.cast $closure (local.get $acc)))))
+               (br_if $loop
+                  (i32.eqz (ref.test $closure_last_arg (local.get $f))))))
+         (else
+            (local.set $i (i32.const 0))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $count))
+                  (then
+                     (local.set $acc
+                        (call_ref $function_1
+                           (call $wrap
+                              (call $get (local.get $args)
+                                 (i31.new (local.get $i))))
+                           (local.get $acc)
+                           (struct.get $closure 0
+                              (ref.cast $closure (local.get $acc)))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (if (local.get $kind)
+               (then
+                  (if (ref.test $closure (local.get $acc))
+                     (then (local.set $acc
+                              (call $caml_js_wrap_callback
+                                 (local.get $acc)))))))))
+      (return_call $unwrap (local.get $acc)))
+
+   (export "caml_js_from_string" (func $caml_jsstring_of_string))
+   (func $caml_jsstring_of_string (export "caml_jsstring_of_string")
+      (param (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local.set $s (ref.cast $string (local.get 0)))
+      (struct.new $js
+         (string.new_wtf8_array replace (local.get $s) (i32.const 0)
+           (array.len (local.get $s)))))
+
+   (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
+      (param (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local $s' (ref $string))
+      (local $l i32) (local $i i32) (local $n i32) (local $c i32)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $l (array.len (local.get $s)))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $count
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (if (i32.ge_u (array.get_u $string (local.get $s) (local.get $i))
+                      (i32.const 128))
+                  (then (local.set $n (i32.add (local.get $n) (i32.const 1)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $count))))
+      (if (i32.eqz (local.get $n))
+         (then
+            (return
+               (struct.new $js
+                  (string.new_wtf8_array utf8 (local.get $s) (i32.const 0)
+                     (local.get $i))))))
+      (local.set $s'
+         (array.new $string (i32.const 0)
+            (i32.add (local.get $i) (local.get $n))))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $fill
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
+               (if (i32.lt_u (local.get $c) (i32.const 128))
+                  (then
+                     (array.set $string
+                        (local.get $s') (local.get $n) (local.get $c))
+                     (local.set $n (i32.add (local.get $n) (i32.const 1))))
+                  (else
+                     (array.set $string (local.get $s')
+                        (local.get $n)
+                        (i32.or (i32.shr_u (local.get $c) (i32.const 6))
+                           (i32.const 0xC0)))
+                     (array.set $string (local.get $s')
+                        (i32.add (local.get $n) (i32.const 1))
+                        (i32.and (local.get $c) (i32.const 0x3F)))
+                     (local.set $n (i32.add (local.get $n) (i32.const 2)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $fill))))
+      (struct.new $js
+         (string.new_wtf8_array utf8 (local.get $s') (i32.const 0)
+            (local.get $n))))
+
+   (export "caml_js_to_string" (func $caml_string_of_jsstring))
+   (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
+      (param (ref eq)) (result (ref eq))
+      (local $s stringref)
+      (local $l i32)
+      (local $s' (ref $string))
+      ;; ZZZ ref.cast string not yet implemented by V8
+      (local.set $s
+         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
+      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
+      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
+      (drop (string.encode_wtf8_array replace
+               (local.get $s) (local.get $s') (i32.const 0)))
+      (local.get $s'))
+
+   (func (export "caml_string_of_jsbytes")
+      (param (ref eq)) (result (ref eq))
+      (local $s stringref)
+      (local $l i32) (local $i i32) (local $n i32) (local $c i32)
+      (local $s' (ref $string)) (local $s'' (ref $string))
+      ;; ZZZ ref.cast string not yet implemented by V8
+      (local.set $s
+         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
+      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
+      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
+      (drop (string.encode_wtf8_array replace
+               (local.get $s) (local.get $s') (i32.const 0)))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $count
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (if (i32.ge_u (array.get_u $string (local.get $s') (local.get $i))
+                      (i32.const 0xC0))
+                  (then (local.set $n (i32.add (local.get $n) (i32.const 1)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $count))))
+      (if (i32.eqz (local.get $n)) (then (return (local.get $s'))))
+      (local.set $s''
+         (array.new $string (i32.const 0)
+            (i32.add (local.get $i) (local.get $n))))
+      (local.set $i (i32.const 0))
+      (local.set $n (i32.const 0))
+      (loop $fill
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $c
+                  (array.get_u $string (local.get $s') (local.get $i)))
+               (if (i32.lt_u (local.get $c) (i32.const 0xC0))
+                  (then
+                     (array.set $string
+                        (local.get $s'') (local.get $n) (local.get $c))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1))))
+                  (else
+                     (array.set $string (local.get $s'')
+                        (local.get $n)
+                        (i32.sub
+                           (i32.or
+                              (i32.shl (local.get $c) (i32.const 6))
+                              (array.get_u $string (local.get $s')
+                                 (i32.add (local.get $i) (i32.const 1))))
+                           (i32.const 0X3080)))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2)))))
+               (local.set $n (i32.add (local.get $n) (i32.const 1)))
+               (br $fill))))
+      (local.get $s''))
+
+   (func (export "caml_list_to_js_array")
+      (param (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local $a externref)
+      (local $l (ref eq))
+      (local $b (ref $block))
+      (local.set $i (i32.const 0))
+      (local.set $l (local.get 0))
+      (drop (block $done (result (ref eq))
+         (loop $compute_length
+            (local.set $l
+               (array.get $block
+                  (br_on_cast_fail $done $block (local.get $l)) (i32.const 2)))
+            (local.set $i (i32.add (local.get $i) (i32.const 1)))
+            (br $compute_length))))
+      (local.set $a (call $new_array (local.get $i)))
+      (local.set $i (i32.const 0))
+      (local.set $l (local.get 0))
+      (drop (block $exit (result (ref eq))
+         (loop $loop
+            (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
+            (call $array_set (local.get $a) (local.get $i)
+               (call $unwrap (array.get $block (local.get $b) (i32.const 1))))
+            (local.set $l (array.get $block (local.get $b) (i32.const 2)))
+            (local.set $i (i32.add (local.get $i) (i32.const 1)))
+            (br $loop))))
+      (struct.new $js (extern.internalize (local.get $a))))
+
+   (func (export "caml_list_of_js_array")
+      (param (ref eq)) (result (ref eq))
+      (local $l (ref eq))
+      (local $i i32)
+      (local $len i32)
+      (local $a externref)
+      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
+      (local.set $len (call $array_length (local.get $a)))
+      (local.set $i (i32.const 0))
+      (local.set $l (i31.new (i32.const 0)))
+      (loop $loop
+         (if (i32.le_u (local.get $i) (local.get $len))
+            (then
+               (local.set $l
+                  (array.new_fixed $block (i31.new (i32.const 0))
+                     (call $wrap
+                        (call $array_get (local.get $a) (local.get $i)))
+                     (local.get $l)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $l))
+
+   (func (export "caml_js_error_option_of_exception")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
new file mode 100644
index 0000000000..39b347cc94
--- /dev/null
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -0,0 +1,32 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_js_get_console")
+     (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_js_get_console"))
+      (i31.new (i32.const 0)))
+
+  (func (export "caml_js_html_entities")
+     (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_js_html_entities"))
+      (i31.new (i32.const 0)))
+
+  (func (export "caml_js_html_escape")
+     (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_js_html_escape"))
+      (i31.new (i32.const 0)))
+
+  (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_xmlhttprequest_create"))
+      (i31.new (i32.const 0)))
+
+  (func (export "caml_js_on_ie")
+     (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_js_on_ie"))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/lexing.wat b/runtime/wasm/lexing.wat
new file mode 100644
index 0000000000..2e8c505beb
--- /dev/null
+++ b/runtime/wasm/lexing.wat
@@ -0,0 +1,15 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_new_lex_engine")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_new_lex_engine"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_lex_engine")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_lex_engine"))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
new file mode 100644
index 0000000000..ce28e4c492
--- /dev/null
+++ b/runtime/wasm/marshal.wat
@@ -0,0 +1,28 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_marshal_data_size")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_marshal_data_size"))
+      (unreachable))
+
+   (func (export "caml_input_value_from_bytes")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_input_value_from_bytes"))
+      (unreachable))
+
+   (func (export "caml_output_value_to_buffer")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_output_value_to_buffer"))
+      (unreachable))
+
+   (func (export "caml_output_value_to_string")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_output_value_to_string"))
+      (unreachable))
+)
diff --git a/runtime/wasm/md5.wat b/runtime/wasm/md5.wat
new file mode 100644
index 0000000000..8de99ca310
--- /dev/null
+++ b/runtime/wasm/md5.wat
@@ -0,0 +1,15 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "caml_md5_string")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_md5_string"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_md5_chan")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_md5_chan"))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
new file mode 100644
index 0000000000..668214830f
--- /dev/null
+++ b/runtime/wasm/nat.wat
@@ -0,0 +1,31 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (func (export "create_nat")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "create_nat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "incr_nat")
+      (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "incr_nat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "initialize_nat")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "set_digit_nat")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "set_digit_nat"))
+      (i31.new (i32.const 0)))
+
+   (func (export "set_to_zero_nat")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "set_to_zero_nat"))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
new file mode 100644
index 0000000000..acf4aca53d
--- /dev/null
+++ b/runtime/wasm/obj.wat
@@ -0,0 +1,231 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+   (type $float (struct (field f64)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+   (type $js (struct (field anyref)))
+   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $closure_last_arg
+      (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
+
+   (type $dummy_closure_1
+      (sub $closure_last_arg
+         (struct (field (ref $function_1)) (field (mut (ref null $closure))))))
+
+   (type $function_2
+      (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+
+   (type $closure_2
+      (sub $closure
+         (struct (field (ref $function_1)) (field (ref $function_2)))))
+
+   (type $dummy_closure_2
+      (sub $closure_2
+         (struct (field (ref $function_1)) (field (ref $function_2))
+            (field (mut (ref null $closure_2))))))
+
+   (type $function_3
+      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+
+   (type $closure_3
+      (sub $closure
+         (struct (field (ref $function_1)) (field (ref $function_3)))))
+
+   (type $dummy_closure_3
+      (sub $closure_3
+         (struct (field (ref $function_1)) (field (ref $function_3))
+            (field (mut (ref null $closure_3))))))
+
+   (type $function_4
+      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+
+   (type $closure_4
+      (sub $closure
+         (struct (field (ref $function_1)) (field (ref $function_4)))))
+
+   (type $dummy_closure_4
+      (sub $closure_4
+         (struct (field (ref $function_1)) (field (ref $function_4))
+            (field (mut (ref null $closure_4))))))
+
+   (global $forcing_tag i32 (i32.const 244))
+   (global $cont_tag i32 (i32.const 245))
+   (global $lazy_tag i32 (i32.const 246))
+   (global $closure_tag i32 (i32.const 247))
+   (global $object_tag i32 (i32.const 248))
+   (global $forward_tag (export "forward_tag") i32 (i32.const 250))
+   (global $abstract_tag (export "abstract_tag") i32 (i32.const 251))
+   (global $string_tag i32 (i32.const 252))
+   (global $float_tag i32 (i32.const 253))
+   (global $double_array_tag (export "double_array_tag") i32 (i32.const 254))
+   (global $custom_tag i32 (i32.const 255))
+
+   (func (export "caml_alloc_dummy") (param $size (ref eq)) (result (ref eq))
+      (array.new $block (i31.new (i32.const 0))
+                 (i32.add (i31.get_u (ref.cast i31 (local.get $size)))
+                          (i32.const 1))))
+
+   (func (export "caml_update_dummy")
+      (param $dummy (ref eq)) (param $newval (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local $dst (ref $block)) (local $src (ref $block))
+      (drop (block $not_block (result (ref eq))
+         (local.set $dst
+            (br_on_cast_fail $not_block $block (local.get $dummy)))
+         (local.set $src (ref.cast $block (local.get $newval)))
+         (array.copy $block $block
+            (local.get $dst) (i32.const 0) (local.get $src) (i32.const 0)
+            (array.len (local.get $dst)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_1 (result (ref eq))
+         (struct.set $dummy_closure_1 1
+            (br_on_cast_fail $not_closure_1 $dummy_closure_1 (local.get $dummy))
+            (ref.cast $closure (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_2 (result (ref eq))
+         (struct.set $dummy_closure_2 2
+            (br_on_cast_fail $not_closure_2 $dummy_closure_2 (local.get $dummy))
+            (ref.cast $closure_2 (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_3 (result (ref eq))
+         (struct.set $dummy_closure_3 2
+            (br_on_cast_fail $not_closure_3 $dummy_closure_3 (local.get $dummy))
+            (ref.cast $closure_3 (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      (drop (block $not_closure_4 (result (ref eq))
+         (struct.set $dummy_closure_4 2
+            (br_on_cast_fail $not_closure_4 $dummy_closure_4 (local.get $dummy))
+            (ref.cast $closure_4 (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
+      ;; ZZZ float array
+      (unreachable))
+
+   (func (export "caml_obj_dup") (param (ref eq)) (result (ref eq))
+      ;; ZZZ Deal with non-block values?
+      (local $orig (ref $block))
+      (local $res (ref $block))
+      (local $len i32)
+      (local.set $orig (ref.cast $block (local.get 0)))
+      (local.set $len (array.len (local.get $orig)))
+      (local.set $res
+         (array.new $block (array.get $block (local.get $orig) (i32.const 0))
+            (local.get $len)))
+      (array.copy $block $block
+         (local.get $res) (i32.const 1) (local.get $orig) (i32.const 1)
+         (i32.sub (local.get $len) (i32.const 1)))
+      (local.get $res))
+
+   (func (export "caml_obj_block")
+      (param $tag (ref eq)) (param $size (ref eq)) (result (ref eq))
+      (local $res (ref $block))
+      ;; ZZZ float array / specific types
+      (local.set $res
+         (array.new $block
+            (i31.new (i32.const 0))
+            (i32.add (i31.get_s (ref.cast i31 (local.get $size)))
+                     (i32.const 1))))
+      (array.set $block (local.get $res) (i32.const 0) (local.get $tag))
+      (local.get $res))
+
+   (func (export "caml_obj_tag") (param $v (ref eq)) (result (ref eq))
+      (if (ref.test i31 (local.get $v))
+         (then (return (i31.new (i32.const 1000)))))
+      (drop (block $not_block (result (ref eq))
+         (return (array.get $block
+                    (br_on_cast_fail $not_block $block (local.get $v))
+                    (i32.const 0)))))
+      (if (ref.test $string (local.get $v))
+         (then (return (i31.new (global.get $string_tag)))))
+      (if (ref.test $float (local.get $v))
+         (then (return (i31.new (global.get $float_tag)))))
+      (if (ref.test $custom (local.get $v))
+         (then (return (i31.new (global.get $custom_tag)))))
+      (if (ref.test $closure (local.get $v))
+         (then (return (i31.new (global.get $closure_tag)))))
+      ;; ZZZ float array
+      (if (ref.test $js (local.get $v))
+         (then (return (i31.new (global.get $abstract_tag)))))
+      (unreachable))
+
+   (func (export "caml_obj_make_forward")
+      (param $b (ref eq)) (param $v (ref eq)) (result (ref eq))
+      (local $block (ref $block))
+      (local.set $block (ref.cast $block (local.get $b)))
+      (array.set $block (local.get $block)
+         (i32.const 0) (i31.new (global.get $forward_tag)))
+      (array.set $block (local.get $block) (i32.const 1) (local.get $v))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_lazy_make_forward")
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (global.get $forward_tag))
+         (local.get $0)))
+
+   (func $obj_update_tag
+      (param (ref eq)) (param $o i32) (param $n i32) (result i32)
+      (local $b (ref $block))
+      (local.set $b (ref.cast $block (local.get $0)))
+      (if (result i32) (ref.eq (array.get $block (local.get $b) (i32.const 0))
+                               (i31.new (local.get $o)))
+         (then
+            (array.set $block (local.get $b) (i32.const 0)
+               (i31.new (local.get $n)))
+            (i32.const 1))
+         (else
+            (i32.const 0))))
+
+   (func (export "caml_lazy_reset_to_lazy") (param (ref eq)) (result (ref eq))
+      (drop (call $obj_update_tag (local.get 0)
+               (global.get $forcing_tag) (global.get $lazy_tag)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_lazy_update_to_forward") (param (ref eq)) (result (ref eq))
+      (drop (call $obj_update_tag (local.get 0)
+               (global.get $forcing_tag) (global.get $forward_tag)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_lazy_update_to_forcing")
+      (param (ref eq)) (result (ref eq))
+      (if (ref.test $block (local.get $0))
+         (then
+            (if (call $obj_update_tag (local.get 0)
+                   (global.get $lazy_tag) (global.get $forcing_tag))
+               (then (return (i31.new (i32.const 0)))))))
+      (i31.new (i32.const 1)))
+
+   (func (export "caml_get_public_method")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_get_public_method"))
+      (i31.new (i32.const 0)))
+
+   (global $caml_oo_last_id (mut i32) (i32.const 0))
+
+   (func (export "caml_set_oo_id") (param (ref eq)) (result (ref eq))
+      (local $id i32)
+      (local.set $id (global.get $caml_oo_last_id))
+      (array.set $block (ref.cast $block (local.get 0)) (i32.const 2)
+         (i31.new (local.get $id)))
+      (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
+      (local.get $0))
+
+   (func (export "caml_fresh_oo_id") (param (ref eq)) (result (ref eq))
+      (local $id i32)
+      (local.set $id (global.get $caml_oo_last_id))
+      (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
+      (i31.new (local.get $id)))
+)
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
new file mode 100644
index 0000000000..8c2b48ee9e
--- /dev/null
+++ b/runtime/wasm/prng.wat
@@ -0,0 +1,102 @@
+(module
+   (import "int64" "caml_copy_int64"
+      (func $caml_copy_int64 (param i64) (result (ref eq))))
+   (import "bindings" "ta_get_i32"
+      (func $ta_get_i32 (param externref) (param i32) (result i32)))
+   (import "bindings" "ta_set_i32"
+      (func $ta_set_i32 (param externref) (param i32) (param i32)))
+
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+   (type $int_array (array (mut i32)))
+   (type $bigarray
+      (sub $custom
+         (struct
+            (field (ref $custom_operations))
+            (field externref) ;; data
+            (field (ref $int_array)) ;; size in each dimension
+            (field i8) ;; number of dimensions
+            (field i8) ;; kind
+            (field i8)))) ;; layout
+
+   (func (export "caml_lxm_next") (param $v (ref eq)) (result (ref eq))
+      (local $data externref)
+      (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64)
+      (local $z i64)
+      (local.set $data
+         (struct.get $bigarray 1 (ref.cast $bigarray (local.get $v))))
+      (local.set $a
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 0)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 1)))
+               (i64.const 32))))
+      (local.set $s
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 2)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 3)))
+               (i64.const 32))))
+      (local.set $q0
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 4)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 5)))
+               (i64.const 32))))
+      (local.set $q1
+         (i64.or
+            (i64.extend_i32_u
+               (call $ta_get_i32 (local.get $data) (i32.const 6)))
+            (i64.shl
+               (i64.extend_i32_u
+                  (call $ta_get_i32 (local.get $data) (i32.const 7)))
+               (i64.const 32))))
+      (local.set $z (i64.add (local.get $s) (local.get $q0)))
+      (local.set $z
+         (i64.mul (i64.xor (local.get $z)
+                           (i64.shr_u (local.get $z) (i64.const 32)))
+                  (i64.const 0xdaba0b6eb09322e3)))
+      (local.set $z
+         (i64.mul (i64.xor (local.get $z)
+                           (i64.shr_u (local.get $z) (i64.const 32)))
+                  (i64.const 0xdaba0b6eb09322e3)))
+      (local.set $z
+         (i64.xor (local.get $z) (i64.shr_u (local.get $z) (i64.const 32))))
+      (local.set $s
+         (i64.add (i64.mul (local.get $s) (i64.const 0xd1342543de82ef95))
+                  (local.get $a)))
+      (call $ta_set_i32 (local.get $data) (i32.const 2)
+         (i32.wrap_i64 (local.get $s)))
+      (call $ta_set_i32 (local.get $data) (i32.const 3)
+         (i32.wrap_i64 (i64.shr_u (local.get $s) (i64.const 32))))
+      (local.set $q1 (i64.xor (local.get $q1) (local.get $q0)))
+      (local.set $q0 (i64.rotl (local.get $q0) (i64.const 24)))
+      (local.set $q0 (i64.xor (i64.xor (local.get $q0) (local.get $q1))
+                              (i64.shl (local.get $q1) (i64.const 16))))
+      (local.set $q1 (i64.rotl (local.get $q1) (i64.const 37)))
+      (call $ta_set_i32 (local.get $data) (i32.const 4)
+         (i32.wrap_i64 (local.get $q0)))
+      (call $ta_set_i32 (local.get $data) (i32.const 5)
+         (i32.wrap_i64 (i64.shr_u (local.get $q0) (i64.const 32))))
+      (call $ta_set_i32 (local.get $data) (i32.const 6)
+         (i32.wrap_i64 (local.get $q1)))
+      (call $ta_set_i32 (local.get $data) (i32.const 7)
+         (i32.wrap_i64 (i64.shr_u (local.get $q1) (i64.const 32))))
+      (return_call $caml_copy_int64 (local.get $z)))
+)
diff --git a/runtime/wasm/run.js b/runtime/wasm/run.js
deleted file mode 100755
index 3119a0e955..0000000000
--- a/runtime/wasm/run.js
+++ /dev/null
@@ -1,177 +0,0 @@
-#!/usr/bin/env -S node --experimental-wasm-stringref  --experimental-wasm-gc
-(async function () {
-    const fs = require('fs/promises');
-    const path = require('path');
-    const code = fs.readFile(process.argv[2]);
-
-    var caml_callback, caml_alloc_tm;
-
-    let math =
-        {cos:Math.cos, sin:Math.sin, tan:Math.tan,
-         acos:Math.acos, asin:Math.asin, atan:Math.atan,
-         cosh:Math.cosh, sinh:Math.sinh, tanh:Math.tanh,
-         acosh:Math.acosh, asinh:Math.asinh, atanh:Math.atanh,
-         cbrt:Math.cbrt, exp:Math.exp, expm1:Math.expm1,
-         log:Math.log, log1p:Math.log1p, log2:Math.log2, log10:Math.log10,
-         atan2:Math.atan2, hypot:Math.hypot, pow:Math.pow,
-         fmod:(x, y) => x%y}
-
-    let typed_arrays =
-      [Float32Array, Float64Array, Int8Array, Uint8Array, Int16Array,
-       Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
-       Float32Array, Float64Array, Uint8Array]
-
-    let bindings =
-        {identity:(x)=>x,
-         from_bool:(x)=>!!x,
-         get:(x,y)=>x[y],
-         set:(x,y,z)=>x[y]=z,
-         delete:(x,y)=>delete x[y],
-         instanceof:(x,y)=>x instanceof y,
-         typeof:(x)=>typeof x,
-         eval:eval,
-         equals:(x,y)=>x==y,
-         strict_equals:(x,y)=>x===y,
-         fun_call:(f,o,args)=>f.apply(o,args),
-         meth_call:(o,f,args)=>o[f].apply(o,args),
-         new_array:(n)=>new Array(n),
-         new_obj:()=>({}),
-         new:(c,args)=>new c(...args),
-         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwnsProperty(nm)) f(nm)},
-         array_length:(a)=>a.length,
-         array_get:(a,i)=>a[i],
-         array_set:(a,i,v)=>a[i]=v,
-         get_int:(a,i)=>a[i],
-         ta_create:(k,sz)=> new(typed_arrays[k])(sz),
-         ta_normalize:(a)=>
-           a instanceof Uint8ClampedArray?
-             new Uint8Array(a.buffer,a.byteOffset,a.byteLength):
-             a instanceof Uint32Array?
-               new Int32Array(a.buffer,a.byteOffset,a.byteLength):a,
-         ta_kind:(a)=>typed_arrays.findIndex((c)=>a instanceof c),
-         ta_length:(a)=>a.length,
-         ta_get_f64:(a,i)=>a[i],
-         ta_get_f32:(a,i)=>a[i],
-         ta_get_i32:(a,i)=>a[i],
-         ta_get_i16:(a,i)=>a[i],
-         ta_get_ui16:(a,i)=>a[i],
-         ta_get_i8:(a,i)=>a[i],
-         ta_get_ui8:(a,i)=>a[i],
-         ta_set_f64:(a,i,v)=>a[i]=v,
-         ta_set_f32:(a,i,v)=>a[i]=v,
-         ta_set_i32:(a,i,v)=>a[i]=v,
-         ta_set_i16:(a,i,v)=>a[i]=v,
-         ta_set_ui16:(a,i,v)=>a[i]=v,
-         ta_set_i8:(a,i,v)=>a[i]=v,
-         ta_set_ui8:(a,i,v)=>a[i]=v,
-         wrap_callback:(f)=>function (){
-             var n = arguments.length;
-             if(n > 0) {
-                 var args = new Array(n);
-                 for (var i = 0; i < n; i++) args[i] = arguments[i];
-             } else {
-                 args = [undefined];
-             }
-             return caml_callback(f, args.length, args, 1);
-         },
-         wrap_callback_args:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n);
-             for (var i = 0; i < n; i++) args[i] = arguments[i];
-             return caml_callback(f, 1, [args], 0);
-         },
-         wrap_callback_strict:(arity,f)=>function (){
-             var n = arguments.length;
-             var args = new Array(arity);
-             var len = Math.min(arguments.length, arity)
-             for (var i = 0; i < len; i++) args[i] = arguments[i];
-             return caml_callback(f, arity, args, 0);
-         },
-         wrap_callback_unsafe:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n);
-             for (var i = 0; i < n; i++) args[i] = arguments[i];
-             return caml_callback(f, args.length, args, 2);
-         },
-         wrap_meth_callback:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n+1);
-             args[0] = this;
-             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
-             return caml_callback(f, args.length, args, 1);
-         },
-         wrap_meth_callback_args:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n);
-             for (var i = 0; i < n; i++) args[i] = arguments[i];
-             return caml_callback(f, 2, [this, args], 0);
-         },
-         wrap_meth_callback_strict:(arity,f)=>function (){
-             var args = new Array(arity + 1);
-             var len = Math.min(arguments.length, arity)
-             args[0] = this;
-             for (var i = 0; i < len; i++) args[i+1] = arguments[i];
-             return caml_callback(f, args.length, args, 0);
-         },
-         wrap_meth_callback_unsafe:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n+1);
-             args[0] = this;
-             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
-             return caml_callback(f, args.length, args, 2);
-         },
-         wrap_fun_arguments:(f)=>function(){return f(arguments)},
-         format:(f)=>""+f,
-         gettimeofday:()=>(new Date()).getTime() / 1000,
-         gmtime:(t)=>{
-           var d = new Date (t * 1000);
-           var d_num = d.getTime();
-           var januaryfirst =
-             (new Date(Date.UTC(d.getUTCFullYear(), 0, 1))).getTime();
-           var doy = Math.floor((d_num - januaryfirst) / 86400000);
-           return caml_alloc_tm(d.getUTCSeconds(), d.getUTCMinutes(),
-                                d.getUTCHours(), d.getUTCDate(),
-                                d.getUTCMonth(), d.getUTCFullYear() - 1900,
-                                d.getUTCDay(), doy, false)
-         },
-         localtime:(t)=>{
-           var d = new Date (t * 1000);
-           var d_num = d.getTime();
-           var januaryfirst = (new Date(d.getFullYear(), 0, 1)).getTime();
-           var doy = Math.floor((d_num - januaryfirst) / 86400000);
-           var jan = new Date(d.getFullYear(), 0, 1);
-           var jul = new Date(d.getFullYear(), 6, 1);
-           var stdTimezoneOffset =
-               Math.max(jan.getTimezoneOffset(), jul.getTimezoneOffset());
-           return caml_alloc_tm(d.getSeconds(), d.getMinutes(), d.getHours(),
-                                d.getDate(), d.getMonth(),
-                                d.getFullYear() - 1900,
-                                d.getDay(), doy,
-                                (d.getTimezoneOffset() < stdTimezoneOffset))
-         },
-         random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
-         log:(x)=>console.log('ZZZZZ', x)
-        }
-
-    const wasmModule =
-          await WebAssembly.instantiate(await code,
-                                        {Math:math,bindings:bindings})
-
-    caml_callback = wasmModule.instance.exports.caml_callback;
-    caml_alloc_tm = wasmModule.instance.exports.caml_alloc_tm;
-
-    try {
-        wasmModule.instance.exports._initialize()
-    } catch (e) {
-        if (e instanceof WebAssembly.Exception &&
-            e.is(wasmModule.instance.exports.ocaml_exit))
-            process.exit(e.getArg(wasmModule.instance.exports.ocaml_exit, 0));
-        if (e instanceof WebAssembly.Exception &&
-            e.is(wasmModule.instance.exports.ocaml_exception)) {
-            console.log('Uncaught exception')
-            process.exit(1)
-        }
-        throw e;
-    }
-
-})()
diff --git a/runtime/wasm/index.js b/runtime/wasm/runtime.js
similarity index 91%
rename from runtime/wasm/index.js
rename to runtime/wasm/runtime.js
index 64922a9291..06ab083bc7 100644
--- a/runtime/wasm/index.js
+++ b/runtime/wasm/runtime.js
@@ -1,5 +1,14 @@
+#!/usr/bin/env -S node --experimental-wasm-stringref --experimental-wasm-gc
 (async function () {
-    const code = fetch('a.wasm');
+    const src = 'CODE';
+    function loadRelative(src) {
+      const path = require('path');
+      const f = path.join(path.dirname(require.main.filename),src);
+      return require('fs/promises').readFile(f)
+    }
+    const isNode =
+          this.process && process.versions && process.versions.node;
+    const code = isNode?loadRelative(src):fetch(src);
 
     var caml_callback, caml_alloc_tm;
 
@@ -149,11 +158,10 @@
          random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
          log:(x)=>console.log('ZZZZZ', x)
         }
-
+    const imports = {Math:math,bindings:bindings}
     const wasmModule =
-          await WebAssembly.instantiateStreaming(
-              code, {Math:math,bindings:bindings}
-          )
+          isNode?await WebAssembly.instantiate(await code, imports)
+                :await WebAssembly.instantiateStreaming(code,imports)
 
     caml_callback = wasmModule.instance.exports.caml_callback;
     caml_alloc_tm = wasmModule.instance.exports.caml_alloc_tm;
diff --git a/runtime/wasm/runtime.wat b/runtime/wasm/runtime.wat
deleted file mode 100644
index d3270be567..0000000000
--- a/runtime/wasm/runtime.wat
+++ /dev/null
@@ -1,3368 +0,0 @@
-(module
-   (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
-   (tag $ocaml_exit (export "ocaml_exit") (param i32))
-
-   (import "bindings" "log" (func $log (param i32)))
-   (import "bindings" "log" (func $log_js (param anyref)))
-
-   (type $float (struct (field f64)))
-
-   (type $block (array (mut (ref eq))))
-
-   (type $string (array (mut i8)))
-
-   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-
-   (type $closure (struct (;(field i32);) (field (ref $function_1))))
-
-   (type $closure_last_arg
-      (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
-
-   (type $dummy_closure_1
-      (sub $closure_last_arg
-         (struct (field (ref $function_1)) (field (mut (ref null $closure))))))
-
-   (type $function_2
-      (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
-
-   (type $closure_2
-      (sub $closure
-         (struct (field (ref $function_1)) (field (ref $function_2)))))
-
-   (type $dummy_closure_2
-      (sub $closure_2
-         (struct (field (ref $function_1)) (field (ref $function_2))
-            (field (mut (ref null $closure_2))))))
-
-   (type $function_3
-      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
-
-   (type $closure_3
-      (sub $closure
-         (struct (field (ref $function_1)) (field (ref $function_3)))))
-
-   (type $dummy_closure_3
-      (sub $closure_3
-         (struct (field (ref $function_1)) (field (ref $function_3))
-            (field (mut (ref null $closure_3))))))
-
-   (type $function_4
-      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
-
-   (type $closure_4
-      (sub $closure
-         (struct (field (ref $function_1)) (field (ref $function_4)))))
-
-   (type $dummy_closure_4
-      (sub $closure_4
-         (struct (field (ref $function_1)) (field (ref $function_4))
-            (field (mut (ref null $closure_4))))))
-
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
-
-   (type $value->int
-      (func (param (ref eq)) (result i32)))
-
-   (type $custom_operations
-      (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
-         ;; ZZZ
-      ))
-
-   (type $custom (struct (field (ref $custom_operations))))
-
-   (global $caml_global_data (mut (ref $block))
-      (array.new $block (i31.new (i32.const 0)) (i32.const 12)))
-
-   (func (export "caml_register_global")
-      (param (ref eq)) (param $v (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $i i32)
-      (local.set $i (i31.get_u (ref.cast i31 (local.get 0))))
-      (if (i32.lt_u (local.get $i) (array.len (global.get $caml_global_data)))
-         (then
-            (array.set $block (global.get $caml_global_data)
-               (local.get $i) (local.get $v))))
-      (i31.new (i32.const 0)))
-
-   (func $caml_raise_constant (param (ref eq))
-      (throw $ocaml_exception (local.get 0)))
-
-   (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))
-      (throw $ocaml_exception
-         (array.new_fixed $block
-            (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
-
-   (global $FAILURE_EXN i32 (i32.const 2))
-
-   (func $caml_failwith (param $arg (ref eq))
-       (return_call $caml_raise_with_arg
-           (array.get $block (global.get $caml_global_data)
-              (global.get $FAILURE_EXN))
-           (local.get 0)))
-
-   (global $INVALID_EXN i32 (i32.const 3))
-
-   (func $caml_invalid_argument (param $arg (ref eq))
-       (return_call $caml_raise_with_arg
-           (array.get $block (global.get $caml_global_data)
-              (global.get $INVALID_EXN))
-           (local.get 0)))
-
-   (data $index_out_of_bounds "index out of bounds")
-
-   (func $caml_bound_error (export "caml_bound_error")
-      (return_call $caml_invalid_argument
-         (array.new_data $string $index_out_of_bounds
-            (i32.const 0) (i32.const 19))))
-
-   (global $ZERO_DIVIDE_EXN i32 (i32.const 5))
-
-   (func (export "caml_raise_zero_divide")
-      (return_call $caml_raise_constant
-         (array.get $block (global.get $caml_global_data)
-                    (global.get $ZERO_DIVIDE_EXN))))
-
-   (global $NOT_FOUND_EXN i32 (i32.const 6))
-
-   (func $caml_raise_not_found
-      (return_call $caml_raise_constant
-         (array.get $block (global.get $caml_global_data)
-                    (global.get $NOT_FOUND_EXN))))
-
-   (func (export "caml_bswap16") (param (ref eq)) (result (ref eq))
-      (local $x i32)
-      (local.set $x (i31.get_s (ref.cast i31 (local.get 0))))
-      (i31.new
-         (i32.or
-            (i32.shl (i32.and (local.get $x) (i32.const 0xFF)) (i32.const 8))
-            (i32.shr_u (i32.and (local.get $x) (i32.const 0x00FF))
-               (i32.const 8)))))
-
-   (global $int32_ops (export "int32_ops") (ref $custom_operations)
-      (struct.new $custom_operations
-         (array.new_fixed $string (i32.const 95) (i32.const 105)) ;; "_i"
-         (ref.func $int32_cmp)
-         (ref.func $int32_hash)))
-
-   (type $int32
-      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
-
-   (func $int32_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
-      (local $i1 i32) (local $i2 i32)
-      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get $v1))))
-      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get $v2))))
-      (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
-               (i32.lt_s (local.get $i1) (local.get $i2))))
-
-   (func $int32_hash (param $v (ref eq)) (result i32)
-      (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
-
-   (func $caml_copy_int32 (param $i i32) (result (ref eq))
-      (struct.new $int32 (global.get $int32_ops) (local.get $i)))
-
-   (func (export "caml_int32_bswap") (param (ref eq)) (result (ref eq))
-      (local $i i32)
-      (local.set $i (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
-      (return_call $caml_copy_int32
-         (i32.or
-            (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
-                      (i32.const 8))
-            (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00))
-                      (i32.const 8)))))
-
-   (global $INT32_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Int32.of_string"
-         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 51)
-         (i32.const 50) (i32.const 46) (i32.const 111) (i32.const 102)
-         (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
-         (i32.const 105) (i32.const 110) (i32.const 103)))
-
-   (func (export "caml_int32_of_string") (param $v (ref eq)) (result (ref eq))
-      (return_call $caml_copy_int32
-         (call $parse_int
-            (local.get $v) (i32.const 32) (global.get $INT32_ERRMSG))))
-
-   (export "caml_nativeint_compare" (func $caml_int32_compare))
-   (func $caml_int32_compare (export "caml_int32_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $i1 i32) (local $i2 i32)
-      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
-      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get 1))))
-      (i31.new (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
-                        (i32.lt_s (local.get $i1) (local.get $i2)))))
-
-   (global $int64_ops (export "int64_ops") (ref $custom_operations)
-      (struct.new $custom_operations
-         (array.new_fixed $string (i32.const 95) (i32.const 106)) ;; "_j"
-         (ref.func $int64_cmp)
-         (ref.func $int64_hash)))
-
-   (type $int64
-      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
-
-   (func $int64_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
-      (local $i1 i64) (local $i2 i64)
-      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get $v1))))
-      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get $v2))))
-      (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
-               (i64.lt_s (local.get $i1) (local.get $i2))))
-
-   (func $int64_hash (param $v (ref eq)) (result i32)
-      (local $i i64)
-      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
-      (i32.xor
-         (i32.wrap_i64 (local.get $i))
-         (i32.wrap_i64 (i64.shr_u (local.get $i) (i64.const 32)))))
-
-   (func $caml_copy_int64 (param $i i64) (result (ref eq))
-      (struct.new $int64 (global.get $int64_ops) (local.get $i)))
-
-   (func (export "caml_int64_bswap") (param (ref eq)) (result (ref eq))
-      (local $i i64)
-      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
-      (return_call $caml_copy_int64
-         (i64.or
-            (i64.or
-               (i64.rotr (i64.and (local.get $i) (i64.const 0x000000FF000000FF))
-                         (i64.const 8))
-               (i64.rotr (i64.and (local.get $i) (i64.const 0x0000FF000000FF00))
-                         (i64.const 24)))
-            (i64.or
-               (i64.rotl (i64.and (local.get $i) (i64.const 0x00FF000000FF0000))
-                         (i64.const 24))
-               (i64.rotl (i64.and (local.get $i) (i64.const 0xFF000000FF000000))
-                         (i64.const 8))))))
-
-   (func (export "caml_int64_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $i1 i64) (local $i2 i64)
-      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
-      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get 1))))
-      (i31.new (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
-                        (i64.lt_s (local.get $i1) (local.get $i2)))))
-
-   (global $INT64_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Int64.of_string"
-         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 54)
-         (i32.const 52) (i32.const 46) (i32.const 111) (i32.const 102)
-         (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
-         (i32.const 105) (i32.const 110) (i32.const 103)))
-
-   (func (export "caml_int64_of_string") (param $v (ref eq)) (result (ref eq))
-      (local $s (ref $string))
-      (local $i i32) (local $len i32) (local $d i32) (local $c i32)
-      (local $signedness i32) (local $sign i32) (local $base i32)
-      (local $res i64) (local $threshold i64)
-      (local $t (i32 i32 i32 i32))
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $len (array.len (local.get $s)))
-      (local.set $t (call $parse_sign_and_base (local.get $s)))
-      (local.set $i (tuple.extract 0 (local.get $t)))
-      (local.set $signedness (tuple.extract 1 (local.get $t)))
-      (local.set $sign (tuple.extract 2 (local.get $t)))
-      (local.set $base (tuple.extract 3 (local.get $t)))
-      (local.set $threshold
-         (i64.div_u (i64.const -1) (i64.extend_i32_u (local.get $base))))
-      (local.set $d
-         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
-      (if (i32.ge_u (local.get $d) (local.get $base))
-         (then (call $caml_failwith (global.get $INT64_ERRMSG))))
-      (local.set $res (i64.extend_i32_u (local.get $d)))
-      (loop $loop
-         (local.set $i (i32.add (local.get $i) (i32.const 1)))
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (local.set $c (array.get $string (local.get $s) (local.get $i)))
-               (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
-               (local.set $d (call $parse_digit (local.get $c)))
-               (if (i32.ge_u (local.get $d) (local.get $base))
-                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
-               (if (i64.gt_u (local.get $res) (local.get $threshold))
-                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
-               (local.set $res
-                  (i64.add (i64.mul (local.get $res)
-                              (i64.extend_i32_u (local.get $base)))
-                           (i64.extend_i32_u (local.get $d))))
-               (if (i64.lt_u (local.get $res) (i64.extend_i32_u (local.get $d)))
-                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
-               (br $loop))))
-      (if (local.get $signedness)
-         (then
-            (if (i32.gt_s (local.get $sign) (i32.const 0))
-               (then
-                  (if (i64.ge_u (local.get $res)
-                                (i64.shl (i64.const 1) (i64.const 63)))
-                     (then (call $caml_failwith (global.get $INT64_ERRMSG)))))
-               (else
-                  (if (i64.gt_u (local.get $res)
-                                (i64.shl (i64.const 1) (i64.const 63)))
-                     (then
-                        (call $caml_failwith (global.get $INT64_ERRMSG))))))))
-      (if (i32.lt_s (local.get $sign) (i32.const 0))
-         (then (local.set $res (i64.sub (i64.const 0) (local.get $res)))))
-      (return_call $caml_copy_int64 (local.get $res)))
-
-   (func (export "caml_int64_create_lo_mi_hi")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ does not really make sense
-      (call $log_js (string.const "caml_int64_create_lo_mi_hi"))
-      (i31.new (i32.const 0)))
-
-   (global $nativeint_ops (export "nativeint_ops") (ref $custom_operations)
-      (struct.new $custom_operations
-         (array.new_fixed $string (i32.const 95) (i32.const 110)) ;; "_n"
-         (ref.func $int32_cmp)
-         (ref.func $int32_hash)))
-
-   (func $caml_copy_nativeint (param $i i32) (result (ref eq))
-      (struct.new $int32 (global.get $nativeint_ops) (local.get $i)))
-
-   (global $NATIVEINT_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Nativeint.of_string"
-         (i32.const 78) (i32.const 97) (i32.const 116) (i32.const 105)
-         (i32.const 118) (i32.const 101) (i32.const 46) (i32.const 111)
-         (i32.const 102) (i32.const 95) (i32.const 115) (i32.const 116)
-         (i32.const 114) (i32.const 105) (i32.const 110) (i32.const 103)))
-
-   (func (export "caml_nativeint_of_string")
-      (param $v (ref eq)) (result (ref eq))
-      (return_call $caml_copy_int32
-         (call $parse_int
-            (local.get $v) (i32.const 32) (global.get $NATIVEINT_ERRMSG))))
-
-   (data $Array_make "Array.make")
-
-   (func $caml_make_vect (export "caml_make_vect")
-      (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
-      (local $sz i32) (local $b (ref $block))
-      (local.set $sz (i32.add (i31.get_s (ref.cast i31 (local.get $n)))
-                              (i32.const 1)))
-      (if (i32.lt_s (local.get $sz) (i32.const 1))
-         (then
-            (call $caml_invalid_argument
-               (array.new_data $string $Array_make
-                               (i32.const 0) (i32.const 10)))))
-      (local.set $b (array.new $block (local.get $v) (local.get $sz)))
-      ;; ZZZ float array
-      (array.set $block (local.get $b) (i32.const 0) (i31.new (i32.const 0)))
-      (local.get $b))
-
-   (export "caml_make_float_vect" (func $caml_floatarray_create))
-   (func $caml_floatarray_create (export "caml_floatarray_create")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ float array
-      (return_call $caml_make_vect
-         (local.get 0) (struct.new $float (f64.const 0))))
-
-   (func (export "caml_array_sub")
-      (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
-      (result (ref eq))
-      (local $a1 (ref $block)) (local $a2 (ref $block)) (local $len i32)
-      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
-      (local.set $a1 (ref.cast $block (local.get $a)))
-      (local.set $a2 (array.new $block (i31.new (i32.const 0))
-                        (i32.add (local.get $len) (i32.const 1))))
-      (array.copy $block $block
-         (local.get $a2) (i32.const 1) (local.get $a1)
-         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
-         (local.get $len))
-      (local.get $a2))
-
-   (func (export "caml_array_append")
-      (param $va1 (ref eq)) (param $va2 (ref eq)) (result (ref eq))
-      (local $a1 (ref $block)) (local $a2 (ref $block)) (local $a (ref $block))
-      (local $l1 i32) (local $l2 i32)
-      (local.set $a1 (ref.cast $block (local.get $va1)))
-      (local.set $l1 (array.len (local.get $a1)))
-      (local.set $a2 (ref.cast $block (local.get $va2)))
-      (local.set $l2 (array.len (local.get $a2)))
-      (local.set $a
-         (array.new $block (i31.new (i32.const 0))
-            (i32.sub (i32.add (local.get $l1) (local.get $l2)) (i32.const 1))))
-      ;; ZZZ float array
-      (array.copy $block $block
-         (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
-         (i32.sub (local.get $l1) (i32.const 1)))
-      (array.copy $block $block
-         (local.get $a) (i32.const 1) (local.get $a2) (local.get $l1)
-         (i32.sub (local.get $l2) (i32.const 1)))
-      (local.get $a))
-
-   (func (export "caml_array_concat") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_array_concat"))
-      (unreachable))
-
-   (export "caml_floatarray_blit" (func $caml_array_blit))
-   (func $caml_array_blit (export "caml_array_blit")
-      (param $a1 (ref eq)) (param $i1 (ref eq))
-      (param $a2 (ref eq)) (param $i2 (ref eq))
-      (param $len (ref eq))
-      (result (ref eq))
-      (array.copy $block $block
-         (ref.cast $block (local.get $a2))
-         (i31.get_s (ref.cast i31 (local.get $i2)))
-         (ref.cast $block (local.get $a1))
-         (i31.get_s (ref.cast i31 (local.get $i1)))
-         (i31.get_s (ref.cast i31 (local.get $len))))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_array_fill")
-      (param $a (ref eq)) (param $i (ref eq)) (param $len (ref eq))
-      (param $v (ref eq)) (result (ref eq))
-      (array.fill $block (ref.cast $block (local.get $a))
-         (i31.get_u (ref.cast i31 (local.get $i)))
-         (local.get $v)
-         (i31.get_u (ref.cast i31 (local.get $len))))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_fs_init") (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (export "caml_sys_time_include_children" (func $caml_sys_time))
-   (func $caml_sys_time (export "caml_sys_time")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_time"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_argv") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_argv"))
-      (array.new_fixed $block (i31.new (i32.const 0))
-         (array.new_fixed $string (i32.const 97))))
-
-   (func (export "caml_ml_flush") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_flush"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_open_descriptor_in")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_open_descriptor_in"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_open_descriptor_out")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_open_descriptor_out"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_pos_in")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_pos_in"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_pos_out")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_pos_out"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_seek_in")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_seek_in"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_seek_in_64")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_seek_in_64"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_seek_out")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_seek_out"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_close_channel")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_close_channel"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_set_channel_name")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_set_channel_name"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_out_channels_list")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_out_channels_list"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_input")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_output")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_output"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_output_bytes")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_output_bytes"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_input_char")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input_char"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_input_int")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input_int"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_input_scan_line")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input_scan_line"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_output_char")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_output_char"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_output_int")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_output_int"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_open")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_open"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_close")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_close"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_read_directory")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_read_directory"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_remove")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_remove"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_rename")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_rename"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_system_command")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_system_command"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_random_seed")
-      (param (ref eq)) (result (ref eq))
-      (local $r externref)
-      (local $a (ref $block))
-      (local $i i32) (local $n i32)
-      (local.set $r (call $random_seed))
-      (local.set $n (call $ta_length (local.get $r)))
-      (local.set $a
-         (array.new $block (i31.new (i32.const 0))
-            (i32.add (local.get $n) (i32.const 1))))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $n))
-            (then
-               (array.set $block
-                  (local.get $a) (i32.add (local.get $i) (i32.const 1))
-                  (i31.new (call $ta_get_i32 (local.get $r) (local.get $i))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (local.get $a))
-
-   (func (export "caml_sys_file_exists")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_file_exists"))
-      (i31.new (i32.const 0)))
-
-   (data $Unix "Unix")
-
-   (func (export "caml_sys_get_config")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_get_config"))
-      (array.new_fixed $block (i31.new (i32.const 0))
-         (array.new_data $string $Unix (i32.const 0) (i32.const 4))
-         (i31.new (i32.const 32))
-         (i31.new (i32.const 0))))
-
-   (func (export "caml_sys_getcwd")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_getcwd"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_mkdir")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_mkdir"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_getenv")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_getenv"))
-      (call $log_js
-         (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
-      (call $caml_raise_not_found)
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_isatty")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_isatty"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_terminfo_rows")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_terminfo_rows"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_const_ostype_cygwin")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_const_ostype_cygwin"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_const_ostype_win32")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_const_ostype_win32"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_md5_string")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_md5_string"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_md5_chan")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_md5_chan"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_register_named_value")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_register_named_value"))
-      (call $log_js
-         (call $unwrap (call $caml_jsstring_of_string (local.get $0))))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_dynlink_close_lib")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_dynlink_close_lib"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_dynlink_lookup_symbol")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_dynlink_lookup_symbol"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_new_lex_engine")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_new_lex_engine"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_lex_engine")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_lex_engine"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_gc_quick_stat")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_gc_quick_stat"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_final_register")
-     (param (ref eq) (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (func $parse_sign_and_base (param $s (ref $string)) (result i32 i32 i32 i32)
-      (local $i i32) (local $len i32) (local $c i32)
-      (local $signedness i32) (local $sign i32) (local $base i32)
-      (local.set $i (i32.const 0))
-      (local.set $len (array.len (local.get $s)))
-      (local.set $signedness (i32.const 1))
-      (local.set $sign (i32.const 1))
-      (local.set $base (i32.const 10))
-      (if (i32.eqz (local.get $len))
-         (then
-            (local.set $c (array.get $string (local.get $s) (i32.const 0)))
-            (if (i32.eq (local.get $c) (i32.const 45))
-               (then
-                  (local.set $sign (i32.const -1))
-                  (local.set $i (i32.const 1))))
-               (else (if (i32.eq (local.get $c) (i32.const 43))
-                  (then (local.set $i (i32.const 1)))))))
-      (if (i32.lt_s (i32.add (local.get $i) (i32.const 1)) (local.get $len))
-         (then (if (i32.eq (array.get $string (local.get $s) (local.get $i))
-                           (i32.const 48))
-            (then
-               (local.set $c
-                  (array.get $string (local.get $s)
-                     (i32.add (local.get $i) (i32.const 1))))
-               (if (i32.or (i32.eq (local.get $c) (i32.const 88))
-                           (i32.eq (local.get $c) (i32.const 120)))
-                  (then
-                     (local.set $base (i32.const 16))
-                     (local.set $signedness (i32.const 0))
-                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
-               (else (if (i32.or (i32.eq (local.get $c) (i32.const 79))
-                                 (i32.eq (local.get $c) (i32.const 111)))
-                  (then
-                     (local.set $base (i32.const 8))
-                     (local.set $signedness (i32.const 0))
-                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
-               (else (if (i32.or (i32.eq (local.get $c) (i32.const 66))
-                                 (i32.eq (local.get $c) (i32.const 98)))
-                  (then
-                     (local.set $base (i32.const 2))
-                     (local.set $signedness (i32.const 0))
-                     (local.set $i (i32.add (local.get $i) (i32.const 2))))
-               (else (if (i32.or (i32.eq (local.get $c) (i32.const 85))
-                                 (i32.eq (local.get $c) (i32.const 117)))
-                  (then
-                     (local.set $signedness (i32.const 0))
-                     (local.set $i (i32.add (local.get $i)
-                        (i32.const 2)))))))))))))))
-      (tuple.make
-         (local.get $i) (local.get $signedness) (local.get $sign)
-         (local.get $base)))
-
-   (func $parse_digit (param $c i32) (result i32)
-      (if (i32.and (i32.ge_u (local.get $c) (i32.const 48))
-                   (i32.le_u (local.get $c) (i32.const 57)))
-         (then (return (i32.sub (local.get $c) (i32.const 48)))))
-      (if (i32.and (i32.ge_u (local.get $c) (i32.const 65))
-                   (i32.le_u (local.get $c) (i32.const 90)))
-         (then (return (i32.sub (local.get $c) (i32.const 55)))))
-      (if (i32.and (i32.ge_u (local.get $c) (i32.const 97))
-                   (i32.le_u (local.get $c) (i32.const 122)))
-         (then (return (i32.sub (local.get $c) (i32.const 87)))))
-      (return (i32.const -1)))
-
-   (func $parse_int
-      (param $v (ref eq)) (param $nbits i32) (param $errmsg (ref $string))
-      (result i32)
-      (local $s (ref $string))
-      (local $i i32) (local $len i32) (local $d i32) (local $c i32)
-      (local $signedness i32) (local $sign i32) (local $base i32)
-      (local $res i32) (local $threshold i32)
-      (local $t (i32 i32 i32 i32))
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $len (array.len (local.get $s)))
-      (local.set $t (call $parse_sign_and_base (local.get $s)))
-      (local.set $i (tuple.extract 0 (local.get $t)))
-      (local.set $signedness (tuple.extract 1 (local.get $t)))
-      (local.set $sign (tuple.extract 2 (local.get $t)))
-      (local.set $base (tuple.extract 3 (local.get $t)))
-      (local.set $threshold (i32.div_u (i32.const -1) (local.get $base)))
-      (local.set $d
-         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
-      (if (i32.ge_u (local.get $d) (local.get $base))
-         (then (call $caml_failwith (local.get $errmsg))))
-      (local.set $res (local.get $d))
-      (loop $loop
-         (local.set $i (i32.add (local.get $i) (i32.const 1)))
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (local.set $c (array.get $string (local.get $s) (local.get $i)))
-               (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
-               (local.set $d (call $parse_digit (local.get $c)))
-               (if (i32.ge_u (local.get $d) (local.get $base))
-                  (then (call $caml_failwith (local.get $errmsg))))
-               (if (i32.gt_u (local.get $res) (local.get $threshold))
-                  (then (call $caml_failwith (local.get $errmsg))))
-               (local.set $res
-                  (i32.add (i32.mul (local.get $res) (local.get $base))
-                           (local.get $d)))
-               (if (i32.lt_u (local.get $res) (local.get $d))
-                  (then (call $caml_failwith (local.get $errmsg))))
-               (br $loop))))
-      (if (local.get $signedness)
-         (then
-            (local.set $threshold
-               (i32.shl (i32.const 1)
-                  (i32.sub (local.get $nbits) (i32.const 1))))
-            (if (i32.gt_s (local.get $sign) (i32.const 0))
-               (then
-                  (if (i32.ge_u (local.get $res) (local.get $threshold))
-                     (then (call $caml_failwith (local.get $errmsg)))))
-               (else
-                  (if (i32.gt_u (local.get $res) (local.get $threshold))
-                     (then (call $caml_failwith (local.get $errmsg)))))))
-         (else
-            (if (i32.and
-                   (i32.lt_u (local.get $nbits) (i32.const 32))
-                   (i32.ge_u (local.get $res)
-                     (i32.shl (i32.const 1) (local.get $nbits))))
-               (then (call $caml_failwith (local.get $errmsg))))))
-      (if (i32.lt_s (local.get $sign) (i32.const 0))
-         (then (local.set $res (i32.sub (i32.const 0) (local.get $res)))))
-      (local.get $res))
-
-   (global $INT_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Int.of_string"
-         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 46)
-         (i32.const 111) (i32.const 102) (i32.const 95) (i32.const 115)
-         (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110)
-         (i32.const 103)))
-
-   (func (export "caml_int_of_string")
-      (param $v (ref eq)) (result (ref eq))
-      (i31.new
-         (call $parse_int
-            (local.get $v) (i32.const 31) (global.get $INT_ERRMSG))))
-
-   (func (export "caml_sys_exit") (param (ref eq)) (result (ref eq))
-      (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get 0)))))
-
-   (global $caml_oo_last_id (mut i32) (i32.const 0))
-
-   (func (export "caml_set_oo_id") (param (ref eq)) (result (ref eq))
-      (local $id i32)
-      (local.set $id (global.get $caml_oo_last_id))
-      (array.set $block (ref.cast $block (local.get 0)) (i32.const 2)
-         (i31.new (local.get $id)))
-      (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
-      (local.get $0))
-
-   (func (export "caml_fresh_oo_id") (param (ref eq)) (result (ref eq))
-      (local $id i32)
-      (local.set $id (global.get $caml_oo_last_id))
-      (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
-      (i31.new (local.get $id)))
-
-   (func (export "caml_obj_dup") (param (ref eq)) (result (ref eq))
-      ;; ZZZ Deal with non-block values?
-      (local $orig (ref $block))
-      (local $res (ref $block))
-      (local $len i32)
-      (local.set $orig (ref.cast $block (local.get 0)))
-      (local.set $len (array.len (local.get $orig)))
-      (local.set $res
-         (array.new $block (array.get $block (local.get $orig) (i32.const 0))
-            (local.get $len)))
-      (array.copy $block $block
-         (local.get $res) (i32.const 1) (local.get $orig) (i32.const 1)
-         (i32.sub (local.get $len) (i32.const 1)))
-      (local.get $res))
-
-   (func (export "caml_obj_block")
-      (param $tag (ref eq)) (param $size (ref eq)) (result (ref eq))
-      (local $res (ref $block))
-      ;; ZZZ float array / specific types
-      (local.set $res
-         (array.new $block
-            (i31.new (i32.const 0))
-            (i32.add (i31.get_s (ref.cast i31 (local.get $size)))
-                     (i32.const 1))))
-      (array.set $block (local.get $res) (i32.const 0) (local.get $tag))
-      (local.get $res))
-
-   (global $forcing_tag i32 (i32.const 244))
-   (global $cont_tag i32 (i32.const 245))
-   (global $lazy_tag i32 (i32.const 246))
-   (global $closure_tag i32 (i32.const 247))
-   (global $object_tag i32 (i32.const 248))
-   (global $forward_tag i32 (i32.const 250))
-   (global $abstract_tag i32 (i32.const 251))
-   (global $string_tag i32 (i32.const 252))
-   (global $float_tag i32 (i32.const 253))
-   (global $double_array_tag i32 (i32.const 254))
-   (global $custom_tag i32 (i32.const 255))
-
-   (func (export "caml_lazy_make_forward")
-      (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (global.get $forward_tag))
-         (local.get $0)))
-
-   (func $obj_update_tag
-      (param (ref eq)) (param $o i32) (param $n i32) (result i32)
-      (local $b (ref $block))
-      (local.set $b (ref.cast $block (local.get $0)))
-      (if (result i32) (ref.eq (array.get $block (local.get $b) (i32.const 0))
-                               (i31.new (local.get $o)))
-         (then
-            (array.set $block (local.get $b) (i32.const 0)
-               (i31.new (local.get $n)))
-            (i32.const 1))
-         (else
-            (i32.const 0))))
-
-   (func (export "caml_lazy_reset_to_lazy") (param (ref eq)) (result (ref eq))
-      (drop (call $obj_update_tag (local.get 0)
-               (global.get $forcing_tag) (global.get $lazy_tag)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_lazy_update_to_forward") (param (ref eq)) (result (ref eq))
-      (drop (call $obj_update_tag (local.get 0)
-               (global.get $forcing_tag) (global.get $forward_tag)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_lazy_update_to_forcing")
-      (param (ref eq)) (result (ref eq))
-      (if (ref.test $block (local.get $0))
-         (then
-            (if (call $obj_update_tag (local.get 0)
-                   (global.get $lazy_tag) (global.get $forcing_tag))
-               (then (return (i31.new (i32.const 0)))))))
-      (i31.new (i32.const 1)))
-
-   (func (export "caml_obj_tag") (param $v (ref eq)) (result (ref eq))
-      (if (ref.test i31 (local.get $v))
-         (then (return (i31.new (i32.const 1000)))))
-      (drop (block $not_block (result (ref eq))
-         (return (array.get $block
-                    (br_on_cast_fail $not_block $block (local.get $v))
-                    (i32.const 0)))))
-      (if (ref.test $string (local.get $v))
-         (then (return (i31.new (global.get $string_tag)))))
-      (if (ref.test $float (local.get $v))
-         (then (return (i31.new (global.get $float_tag)))))
-      (if (ref.test $custom (local.get $v))
-         (then (return (i31.new (global.get $custom_tag)))))
-      (if (ref.test $closure (local.get $v))
-         (then (return (i31.new (global.get $closure_tag)))))
-      ;; ZZZ float array
-      (if (ref.test $js (local.get $v))
-         (then (return (i31.new (global.get $abstract_tag)))))
-      (unreachable))
-
-   (func (export "caml_obj_make_forward")
-      (param $b (ref eq)) (param $v (ref eq)) (result (ref eq))
-      (local $block (ref $block))
-      (local.set $block (ref.cast $block (local.get $b)))
-      (array.set $block (local.get $block)
-         (i32.const 0) (i31.new (global.get $forward_tag)))
-      (array.set $block (local.get $block) (i32.const 1) (local.get $v))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_alloc_dummy") (param $size (ref eq)) (result (ref eq))
-      (array.new $block (i31.new (i32.const 0))
-                 (i32.add (i31.get_u (ref.cast i31 (local.get $size)))
-                          (i32.const 1))))
-
-   (func (export "caml_alloc_dummy_function") (param $size (ref eq))  (param (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_alloc_dummy_function"))
-      (array.new $block (i31.new (i32.const 0))
-                 (i32.add (i31.get_u (ref.cast i31 (local.get $size)))
-                          (i32.const 1))))
-
-   (func (export "caml_update_dummy")
-      (param $dummy (ref eq)) (param $newval (ref eq)) (result (ref eq))
-      (local $i i32)
-      (local $dst (ref $block)) (local $src (ref $block))
-      (drop (block $not_block (result (ref eq))
-         (local.set $dst
-            (br_on_cast_fail $not_block $block (local.get $dummy)))
-         (local.set $src (ref.cast $block (local.get $newval)))
-         (array.copy $block $block
-            (local.get $dst) (i32.const 0) (local.get $src) (i32.const 0)
-            (array.len (local.get $dst)))
-         (return (i31.new (i32.const 0)))))
-      (drop (block $not_closure_1 (result (ref eq))
-         (struct.set $dummy_closure_1 1
-            (br_on_cast_fail $not_closure_1 $dummy_closure_1 (local.get $dummy))
-            (ref.cast $closure (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
-      (drop (block $not_closure_2 (result (ref eq))
-         (struct.set $dummy_closure_2 2
-            (br_on_cast_fail $not_closure_2 $dummy_closure_2 (local.get $dummy))
-            (ref.cast $closure_2 (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
-      (drop (block $not_closure_3 (result (ref eq))
-         (struct.set $dummy_closure_3 2
-            (br_on_cast_fail $not_closure_3 $dummy_closure_3 (local.get $dummy))
-            (ref.cast $closure_3 (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
-      (drop (block $not_closure_4 (result (ref eq))
-         (struct.set $dummy_closure_4 2
-            (br_on_cast_fail $not_closure_4 $dummy_closure_4 (local.get $dummy))
-            (ref.cast $closure_4 (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
-      ;; ZZZ float array
-      (unreachable))
-
-   (export "caml_bytes_equal" (func $caml_string_equal))
-   (func $caml_string_equal (export "caml_string_equal")
-      (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
-      (local $s1 (ref $string)) (local $s2 (ref $string))
-      (local $len i32) (local $i i32)
-      (if (ref.eq (local.get $p1) (local.get $p2))
-         (then (return (i31.new (i32.const 1)))))
-      (local.set $s1 (ref.cast $string (local.get $p1)))
-      (local.set $s2 (ref.cast $string (local.get $p2)))
-      (local.set $len (array.len $string (local.get $s1)))
-      (if (i32.ne (local.get $len) (array.len $string (local.get $s2)))
-         (then (return (i31.new (i32.const 0)))))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (if (i32.ne (array.get_u $string (local.get $s1) (local.get $i))
-                           (array.get_u $string (local.get $s2) (local.get $i)))
-                  (then (return (i31.new (i32.const 0)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (i31.new (i32.const 1)))
-
-   (export "caml_bytes_notequal" (func $caml_string_notequal))
-   (func $caml_string_notequal (export "caml_string_notequal")
-      (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
-      (return
-         (i31.new (i32.eqz (i31.get_u (ref.cast i31
-            (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
-
-   (func $string_compare
-      (param $p1 (ref eq)) (param $p2 (ref eq)) (result i32)
-      (local $s1 (ref $string)) (local $s2 (ref $string))
-      (local $l1 i32) (local $l2 i32) (local $len i32) (local $i i32)
-      (local $c1 i32) (local $c2 i32)
-      (if (ref.eq (local.get $p1) (local.get $p2))
-         (then (return (i32.const 0))))
-      (local.set $s1 (ref.cast $string (local.get $p1)))
-      (local.set $s2 (ref.cast $string (local.get $p2)))
-      (local.set $l1 (array.len $string (local.get $s1)))
-      (local.set $l2 (array.len $string (local.get $s2)))
-      (local.set $len (select (local.get $l1) (local.get $l2)
-                          (i32.le_u (local.get $l1) (local.get $l2))))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (local.set $c1
-                  (array.get_u $string (local.get $s1) (local.get $i)))
-               (local.set $c2
-                  (array.get_u $string (local.get $s2) (local.get $i)))
-               (if (i32.lt_u (local.get $c1) (local.get $c2))
-                  (then (return (i32.const -1))))
-               (if (i32.gt_u (local.get $c1) (local.get $c2))
-                  (then (return (i32.const 1))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (if (i32.lt_u (local.get $l1) (local.get $l2))
-         (then (return (i32.const -1))))
-      (if (i32.gt_u (local.get $l1) (local.get $l2))
-         (then (return (i32.const 1))))
-      (i32.const 0))
-
-   (export "caml_bytes_compare" (func $caml_string_compare))
-   (func $caml_string_compare (export "caml_string_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $string_compare (local.get 0) (local.get 1))))
-
-   (export "caml_bytes_lessequal" (func $caml_string_lessequal))
-   (func $caml_string_lessequal (export "caml_string_lessequal")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.le_s (call $string_compare (local.get 0) (local.get 1))
-                         (i32.const 0))))
-
-   (export "caml_bytes_lessthan" (func $caml_string_lessthan))
-   (func $caml_string_lessthan (export "caml_string_lessthan")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.lt_s (call $string_compare (local.get 0) (local.get 1))
-                         (i32.const 0))))
-
-   (export "caml_bytes_greaterequal" (func $caml_string_greaterequal))
-   (func $caml_string_greaterequal (export "caml_string_greaterequal")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.ge_s (call $string_compare (local.get 0) (local.get 1))
-                         (i32.const 0))))
-
-   (export "caml_bytes_greaterthan" (func $caml_string_greaterthan))
-   (func $caml_string_greaterthan (export "caml_string_greaterthan")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.gt_s (call $string_compare (local.get 0) (local.get 1))
-                         (i32.const 0))))
-
-   (export "caml_bytes_of_string" (func $caml_string_of_bytes))
-   (func $caml_string_of_bytes (export "caml_string_of_bytes")
-      (param $v (ref eq)) (result (ref eq))
-      (local.get $v))
-
-   (data $Bytes_create "Bytes.create")
-
-   (func (export "caml_create_bytes")
-      (param $len (ref eq)) (result (ref eq))
-      (local $l i32)
-      (local.set $l (i31.get_u (ref.cast i31 (local.get $len))))
-      (if (i32.lt_s (local.get $l) (i32.const 0))
-         (then
-            (call $caml_invalid_argument
-               (array.new_data $string $Bytes_create
-                               (i32.const 0) (i32.const 12)))))
-      (array.new $string (i32.const 0) (local.get $l)))
-
-   (export "caml_blit_bytes" (func $caml_blit_string))
-   (func $caml_blit_string (export "caml_blit_string")
-      (param $v1 (ref eq)) (param $i1 (ref eq))
-      (param $v2 (ref eq)) (param $i2 (ref eq))
-      (param $n (ref eq)) (result (ref eq))
-      (array.copy $string $string
-         (ref.cast $string (local.get $v2))
-         (i31.get_s (ref.cast i31 (local.get $i2)))
-         (ref.cast $string (local.get $v1))
-         (i31.get_s (ref.cast i31 (local.get $i1)))
-         (i31.get_s (ref.cast i31 (local.get $n))))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_fill_bytes")
-      (param $v (ref eq)) (param $offset (ref eq))
-      (param $len (ref eq)) (param $init (ref eq))
-      (result (ref eq))
-(;ZZZ V8 bug
-      (array.fill $string (ref.cast $string (local.get $v))
-         (i31.get_u (ref.cast i31 (local.get $offset)))
-         (i31.get_u (ref.cast i31 (local.get $init)))
-         (i31.get_u (ref.cast i31 (local.get $len))))
-;)
-      (local $s (ref $string)) (local $i i32) (local $limit i32) (local $c i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get $offset))))
-      (local.set $limit
-         (i32.add (local.get $i) (i31.get_u (ref.cast i31 (local.get $len)))))
-      (local.set $c (i31.get_u (ref.cast i31 (local.get $init))))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $limit))
-            (then
-               (array.set $string (local.get $s) (local.get $i) (local.get $c))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (i31.new (i32.const 0)))
-
-   (export "caml_string_get16" (func $caml_bytes_get16))
-   (func $caml_bytes_get16 (export "caml_bytes_get16")
-      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
-      (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
-      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
-                    (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
-      (i31.new (i32.or
-                  (array.get_u $string (local.get $s) (local.get $p))
-                  (i32.shl (array.get_u $string (local.get $s)
-                              (i32.add (local.get $p) (i32.const 1)))
-                           (i32.const 8)))))
-
-   (export "caml_string_get32" (func $caml_bytes_get32))
-   (func $caml_bytes_get32 (export "caml_bytes_get32")
-      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
-      (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
-      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
-                    (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
-      (return_call $caml_copy_int32
-         (i32.or
-            (i32.or
-               (array.get_u $string (local.get $s) (local.get $p))
-               (i32.shl (array.get_u $string (local.get $s)
-                           (i32.add (local.get $p) (i32.const 1)))
-                        (i32.const 8)))
-            (i32.or
-               (i32.shl (array.get_u $string (local.get $s)
-                           (i32.add (local.get $p) (i32.const 2)))
-                        (i32.const 16))
-               (i32.shl (array.get_u $string (local.get $s)
-                           (i32.add (local.get $p) (i32.const 3)))
-                        (i32.const 24))))))
-
-   (export "caml_string_get64" (func $caml_bytes_get64))
-   (func $caml_bytes_get64 (export "caml_bytes_get64")
-      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
-      (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
-      (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
-                    (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
-      (return_call $caml_copy_int64
-         (i64.or
-            (i64.or
-               (i64.or
-                  (i64.extend_i32_u
-                     (array.get_u $string (local.get $s) (local.get $p)))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 1))))
-                           (i64.const 8)))
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 2))))
-                           (i64.const 16))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 3))))
-                           (i64.const 24))))
-            (i64.or
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 4))))
-                           (i64.const 32))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 5))))
-                           (i64.const 40)))
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 6))))
-                           (i64.const 48))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 7))))
-                           (i64.const 56)))))))
-
-   (func (export "caml_bytes_set16")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32) (local $v i32)
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $v (i31.get_s (ref.cast i31 (local.get 2))))
-      (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
-      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
-                    (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
-      (array.set $string (local.get $s) (local.get $p) (local.get $v))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 1))
-         (i32.shr_u (local.get $v) (i32.const 8)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_bytes_set32")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32) (local $v i32)
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $v (struct.get $int32 1 (ref.cast $int32 (local.get 2))))
-      (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
-      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
-                    (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
-      (array.set $string (local.get $s) (local.get $p) (local.get $v))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 1))
-         (i32.shr_u (local.get $v) (i32.const 8)))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 2))
-         (i32.shr_u (local.get $v) (i32.const 16)))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 3))
-         (i32.shr_u (local.get $v) (i32.const 24)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_bytes_set64")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32) (local $v i64)
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $v (struct.get $int64 1 (ref.cast $int64 (local.get 2))))
-      (if (i32.lt_s (local.get $p) (i32.const 0))
-         (then (call $caml_bound_error)))
-      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
-                    (array.len (local.get $s)))
-         (then (call $caml_bound_error)))
-      (array.set $string (local.get $s) (local.get $p)
-         (i32.wrap_i64 (local.get $v)))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 1))
-         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 8))))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 2))
-         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 16))))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 3))
-         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 24))))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 4))
-         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 32))))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 5))
-         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 40))))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 6))
-         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 48))))
-      (array.set $string (local.get $s)
-         (i32.add (local.get $p) (i32.const 7))
-         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 56))))
-      (i31.new (i32.const 0)))
-
-   (type $int_array (array (mut i32)))
-   (type $block_array (array (mut (ref $block))))
-   (type $compare_stack
-      (struct (field (mut i32))          ;; position in stack
-              (field (ref $block_array)) ;; first value
-              (field (ref $block_array)) ;; second value
-              (field (ref $int_array)))) ;; position in value
-
-   (global $dummy_block (ref $block)
-      (array.new $block (i31.new (i32.const 0)) (i32.const 0)))
-
-   (global $default_compare_stack (ref $compare_stack)
-      (struct.new $compare_stack (i32.const -1)
-         (array.new $block_array (global.get $dummy_block) (i32.const 8))
-         (array.new $block_array (global.get $dummy_block) (i32.const 8))
-         (array.new $int_array (i32.const 0) (i32.const 8))))
-
-   (func $compare_stack_is_not_empty
-      (param $stack (ref $compare_stack)) (result i32)
-      (i32.ge_s (struct.get $compare_stack 0 (local.get $stack)) (i32.const 0)))
-
-   (func $pop_compare_stack (param $stack (ref $compare_stack))
-      (result (ref eq)) (result (ref eq))
-      (local $i i32) (local $p i32) (local $p' i32)
-      (local $v1 (ref $block)) (local $v2 (ref $block))
-      (local.set $i (struct.get $compare_stack 0 (local.get $stack)))
-      (local.set $p
-         (array.get $int_array (struct.get $compare_stack 3 (local.get $stack))
-            (local.get $i)))
-      (local.set $p' (i32.add (local.get $p) (i32.const 1)))
-      (array.set $int_array (struct.get $compare_stack 3 (local.get $stack))
-            (local.get $i) (local.get $p'))
-      (local.set $v1
-         (array.get $block_array
-            (struct.get $compare_stack 1 (local.get $stack)) (local.get $i)))
-      (local.set $v2
-         (array.get $block_array
-            (struct.get $compare_stack 2 (local.get $stack)) (local.get $i)))
-      (if (i32.eq (local.get $p') (array.len (local.get $v1)))
-         (then
-            (array.set $block_array
-               (struct.get $compare_stack 1 (local.get $stack))
-               (local.get $i) (global.get $dummy_block))
-            (array.set $block_array
-               (struct.get $compare_stack 2 (local.get $stack))
-               (local.get $i) (global.get $dummy_block))
-            (struct.set $compare_stack 0 (local.get $stack)
-               (i32.sub (local.get $i) (i32.const 1)))))
-      (tuple.make (array.get $block (local.get $v1) (local.get $p))
-                  (array.get $block (local.get $v2) (local.get $p))))
-
-   (func $push_compare_stack (param $stack (ref $compare_stack))
-      (param $v1 (ref $block)) (param $v2 (ref $block)) (param $p i32)
-      (result (ref $compare_stack))
-      (local $i i32) (local $len i32) (local $len' i32)
-      (local $stack' (ref $compare_stack))
-      (local.set $i
-         (i32.add (struct.get $compare_stack 0 (local.get $stack))
-            (i32.const 1)))
-      (local.set $len
-         (array.len (struct.get $compare_stack 1 (local.get $stack))))
-      (if (i32.ge_u (local.get $i) (local.get $len))
-         (then
-            (local.set $len' (i32.shl (local.get $len) (i32.const 1)))
-            (local.set $stack'
-               (struct.new $compare_stack (local.get $i)
-                  (array.new $block_array
-                     (global.get $dummy_block) (i32.const 8))
-                  (array.new $block_array
-                     (global.get $dummy_block) (i32.const 8))
-                  (array.new $int_array (i32.const 0) (i32.const 8))))
-            (array.copy $block_array $block_array
-               (struct.get $compare_stack 1 (local.get $stack')) (i32.const 0)
-               (struct.get $compare_stack 1 (local.get $stack)) (i32.const 0)
-               (local.get $len))
-            (array.copy $block_array $block_array
-               (struct.get $compare_stack 2 (local.get $stack')) (i32.const 0)
-               (struct.get $compare_stack 2 (local.get $stack)) (i32.const 0)
-               (local.get $len))
-            (array.copy $int_array $int_array
-               (struct.get $compare_stack 3 (local.get $stack')) (i32.const 0)
-               (struct.get $compare_stack 3 (local.get $stack)) (i32.const 0)
-               (local.get $len))
-            (local.set $stack (local.get $stack'))))
-      (struct.set $compare_stack 0 (local.get $stack) (local.get $i))
-      (array.set $block_array (struct.get $compare_stack 1 (local.get $stack))
-         (local.get $i) (local.get $v1))
-      (array.set $block_array (struct.get $compare_stack 2 (local.get $stack))
-         (local.get $i) (local.get $v2))
-      (array.set $int_array (struct.get $compare_stack 3 (local.get $stack))
-         (local.get $i) (local.get $p))
-      (local.get $stack))
-
-   (global $unordered i32 (i32.const 0x80000000))
-
-   (func $compare_strings
-      (param $s1 (ref $string)) (param $s2 (ref $string)) (result i32)
-      (local $l1 i32) (local $l2 i32) (local $len i32) (local $i i32)
-      (local $c1 i32) (local $c2 i32)
-      (if (ref.eq (local.get $s1) (local.get $s2))
-         (then (return (i32.const 0))))
-      (local.set $l1 (array.len $string (local.get $s1)))
-      (local.set $l2 (array.len $string (local.get $s2)))
-      (local.set $len (select (local.get $l1) (local.get $l2)
-                         (i32.le_u (local.get $l1) (local.get $l2))))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (local.set $c1
-                  (array.get_u $string (local.get $s1) (local.get $i)))
-               (local.set $c2
-                  (array.get_u $string (local.get $s2) (local.get $i)))
-               (if (i32.ne (local.get $c1) (local.get $c2))
-                  (then
-                     (if (i32.le_u (local.get $c1) (local.get $c2))
-                        (then (return (i32.const -1)))
-                        (else (return (i32.const 1))))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (i32.sub (local.get $l1) (local.get $l2)))
-
-   (func $compare_val
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32)
-      (result i32)
-      (local $stack (ref $compare_stack)) (local $n i32) (local $res i32)
-      (local.set $stack (global.get $default_compare_stack))
-      (struct.set $compare_stack 0 (local.get $stack) (i32.const -1))
-      (local.set $res
-         (call $do_compare_val
-            (local.get $stack) (local.get $v1) (local.get $v2)
-            (local.get $total)))
-;;      (if (i32.gt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const 1))))
-;;      (if (i32.lt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const -1))))
-;;      (call $log (local.get $res))
-      ;; clear stack (to avoid memory leaks)
-      (local.set $n (struct.get $compare_stack 0 (local.get $stack)))
-      (if (i32.ge_s (local.get $n) (i32.const 0))
-         (then
-(; ZZZ
-            (local.set $n (i32.add (local.get $n) (i32.const 1)))
-            (array.fill $block_array
-               (struct.get $compare_stack 1 (local.get $stack))
-               (i32.const 0) (global.get $dummy_block) (local.get $n))
-            (array.fill $block_array
-               (struct.get $compare_stack 2 (local.get $stack))
-               (i32.const 0) (global.get $dummy_block) (local.get $n))
-;)
-            (loop $loop
-               (if (i32.ge_s (local.get $n) (i32.const 0))
-                  (then
-                     (array.set $block_array
-                        (struct.get $compare_stack 1 (local.get $stack))
-                        (local.get $n) (global.get $dummy_block))
-                     (array.set $block_array
-                        (struct.get $compare_stack 2 (local.get $stack))
-                        (local.get $n) (global.get $dummy_block))
-                     (local.set $n (i32.sub (local.get $n) (i32.const 1)))
-                     (br $loop))))
-          ))
-      (local.get $res))
-
-   (func $do_compare_val
-      (param $stack (ref $compare_stack))
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32)
-      (local $i1 (ref i31)) (local $i2 (ref i31))
-      (local $b1 (ref $block)) (local $b2 (ref $block))
-      (local $t1 i32) (local $t2 i32)
-      (local $s1 i32) (local $s2 i32)
-      (local $f1 f64) (local $f2 f64)
-      (local $str1 (ref $string)) (local $str2 (ref $string))
-      (local $c1 (ref $custom)) (local $c2 (ref $custom))
-      (local $tuple ((ref eq) (ref eq)))
-      (local $res i32)
-      (loop $loop
-         (block $next_item
-            (br_if $next_item
-               (i32.and (ref.eq (local.get $v1) (local.get $v2))
-                        (local.get $total)))
-            (drop (block $v1_is_not_int (result (ref eq))
-               (local.set $i1
-                  (br_on_cast_fail $v1_is_not_int i31 (local.get $v1)))
-               (br_if $next_item (ref.eq (local.get $v1) (local.get $v2)))
-               (drop (block $v2_is_not_int (result (ref eq))
-                  (local.set $i2
-                     (br_on_cast_fail $v2_is_not_int i31 (local.get $v2)))
-                  ;; v1 and v2 are both integers
-                  (return (i32.sub (i31.get_s (local.get $i1))
-                                   (i31.get_s (local.get $i2))))))
-               ;; check for forward tag
-               (drop (block $v2_not_forward (result (ref eq))
-                  (local.set $b2
-                     (br_on_cast_fail $v2_not_forward $block (local.get $v2)))
-                  (local.set $t2
-                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
-                                                 (i32.const 0)))))
-                  (if (i32.eq (local.get $t2) (global.get $forward_tag))
-                     (then
-                        (local.set $v2
-                           (array.get $block (local.get $b2) (i32.const 1)))
-                        (br $loop)))
-                  (i31.new (i32.const 1))))
-               ;; ZZZ custom tag
-               ;; v1 long < v2 block
-               (return (i32.const -1))))
-            (if (ref.test i31 (local.get $v2))
-               (then
-                  ;; check for forward tag
-                  (drop (block $v1_not_forward (result (ref eq))
-                     (local.set $b1
-                        (br_on_cast_fail
-                           $v1_not_forward $block (local.get $v1)))
-                     (local.set $t1
-                        (i31.get_u (ref.cast i31
-                                      (array.get $block (local.get $b1)
-                                         (i32.const 0)))))
-                     (if (i32.eq (local.get $t1) (global.get $forward_tag))
-                        (then
-                           (local.set $v1
-                              (array.get $block (local.get $b1) (i32.const 1)))
-                           (br $loop)))
-                     (i31.new (i32.const 1))))
-                  ;; ZZZ custom tag
-                  ;; v1 block > v1 long
-                  (return (i32.const 1))))
-            (drop (block $v1_not_block (result (ref eq))
-               (local.set $b1
-                  (br_on_cast_fail $v1_not_block $block (local.get $v1)))
-               (local.set $t1
-                  (i31.get_u (ref.cast i31 (array.get $block (local.get $b1)
-                                              (i32.const 0)))))
-               (drop (block $v2_not_block (result (ref eq))
-                  (local.set $b2
-                     (br_on_cast_fail $v2_not_block $block (local.get $v2)))
-                  (local.set $t2
-                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
-                                                 (i32.const 0)))))
-                  (if (i32.ne (local.get $t1) (local.get $t2))
-                     (then
-                        ;; check for forward tag
-                        (if (i32.eq (local.get $t1) (global.get $forward_tag))
-                           (then
-                              (local.set $v1
-                                 (array.get $block
-                                    (local.get $b1) (i32.const 1)))
-                              (br $loop)))
-                        (if (i32.eq (local.get $t2) (global.get $forward_tag))
-                           (then
-                              (local.set $v2
-                                 (array.get
-                                    $block (local.get $b2) (i32.const 1)))
-                              (br $loop)))
-                        ;; compare tags
-                        (return (i32.sub (local.get $t1) (local.get $t2)))))
-                  ;; forward tag
-                  (if (i32.eq (local.get $t1) (global.get $forward_tag))
-                     (then
-                        (local.set $v1
-                           (array.get $block (local.get $b1) (i32.const 1)))
-                        (local.set $v2
-                           (array.get $block (local.get $b2) (i32.const 1)))
-                        (br $loop)))
-                  ;; ZZZ object tag
-                  (local.set $s1 (array.len (local.get $b1)))
-                  (local.set $s2 (array.len (local.get $b2)))
-                  ;; compare size first
-                  (if (i32.ne (local.get $s1) (local.get $s2))
-                     (then (return (i32.sub (local.get $s1) (local.get $s2)))))
-                  (br_if $next_item (i32.eq (local.get $s1) (i32.const 1)))
-                  (if (i32.gt_u (local.get $s1) (i32.const 2))
-                     (then
-                       (local.set $stack
-                          (call $push_compare_stack (local.get $stack)
-                             (local.get $b1) (local.get $b2) (i32.const 2)))))
-                  (local.set $v1
-                     (array.get $block (local.get $b1) (i32.const 1)))
-                  (local.set $v2
-                     (array.get $block (local.get $b2) (i32.const 1)))
-                  (br $loop)))
-               ;; check for forward tag
-               (if (i32.eq (local.get $t1) (global.get $forward_tag))
-                  (then
-                     (local.set $v1
-                        (array.get $block (local.get $b1) (i32.const 1)))
-                     (br $loop)))
-               ;; v1 float array > v2 not represented as block
-               (if (i32.eq (local.get $t1) (global.get $double_array_tag))
-                   (then (return (i32.const 1))))
-               (return (i32.const -1))))
-            (drop (block $v1_not_float (result (ref eq))
-               (local.set $f1
-                  (struct.get $float 0
-                     (br_on_cast_fail $v1_not_float $float (local.get $v1))))
-               (drop (block $v2_not_float (result (ref eq))
-                  (local.set $f2
-                     (struct.get $float 0
-                        (br_on_cast_fail $v2_not_float $float (local.get $v2))))
-                  (if (f64.lt (local.get $f1) (local.get $f2))
-                     (then (return (i32.const -1))))
-                  (if (f64.gt (local.get $f1) (local.get $f2))
-                     (then (return (i32.const 1))))
-                  (if (f64.ne (local.get $f1) (local.get $f2))
-                     (then
-                        (if (i32.eqz (local.get $total))
-                           (then (return (global.get $unordered))))
-                        (if (f64.eq (local.get $f1) (local.get $f1))
-                           (then (return (i32.const 1))))
-                        (if (f64.eq (local.get $f2) (local.get $f2))
-                           (then (return (i32.const -1))))))
-                  (br $next_item)))
-               ;; ZZZ forward tag
-               ;; ZZZ float array
-      (call $log (i32.const 2))
-               (unreachable)
-               (return (i32.const 1))))
-            (if (ref.test $float (local.get $v2))
-               (then
-                  ;; ZZZ forward tag
-                  ;; ZZZ float array
-      (call $log (i32.const 3))
-                  (unreachable)
-                  (return (i32.const -1))))
-            (drop (block $v1_not_string (result (ref eq))
-               (local.set $str1
-                  (br_on_cast_fail $v1_not_string $string (local.get $v1)))
-               (drop (block $v2_not_string (result (ref eq))
-                  (local.set $str2
-                      (br_on_cast_fail $v2_not_string $string (local.get $v2)))
-                  (local.set $res
-                     (call $compare_strings
-                        (local.get $str1) (local.get $str2)))
-                  (br_if $next_item (i32.eqz (local.get $res)))
-                  (return (local.get $res))))
-               ;; ZZZ forward tag
-               ;; ZZZ float array
-      (call $log (i32.const 4))
-               (unreachable)
-               (return (i32.const 1))))
-            (drop (block $v1_not_custom (result (ref eq))
-               (local.set $c1
-                  (br_on_cast_fail $v1_not_custom $custom (local.get $v1)))
-               (drop (block $v2_not_custom (result (ref eq))
-                  (local.set $c2
-                      (br_on_cast_fail $v2_not_custom $custom (local.get $v2)))
-                  ;; ZZZ compare types
-                  ;; ZZZ abstract value?
-                  (local.set $res
-                     (call_ref $value->value->int
-                        (local.get $v1) (local.get $v2)
-                        (struct.get $custom_operations 1
-                           (struct.get $custom 0 (local.get $c1)))
-                        ))
-                  (br_if $next_item (i32.eqz (local.get $res)))
-                  (return (local.get $res))))
-               ;; ZZZ forward tag
-               ;; ZZZ float array
-      (call $log (i32.const 5))
-               (unreachable)
-               (return (i32.const 1))))
-      (call $log (i32.const 6))
-            (unreachable)
-            ;; ZZZ forward tag
-            ;; ZZZ float array
-            (return (i32.const 1)))
-         (if (call $compare_stack_is_not_empty (local.get $stack))
-            (then
-               (local.set $tuple (call $pop_compare_stack (local.get $stack)))
-               (local.set $v1 (tuple.extract 0 (local.get $tuple)))
-               (local.set $v2 (tuple.extract 1 (local.get $tuple)))
-               (br $loop))))
-     (i32.const 0))
-
-   (func (export "caml_compare")
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (local $res i32)
-      (local.set $res
-         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 1)))
-      (if (i32.lt_s (local.get $res) (i32.const 0))
-         (then (return (i31.new (i32.const -1)))))
-      (if (i32.gt_s (local.get $res) (i32.const 0))
-         (then (return (i31.new (i32.const 1)))))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_equal")
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new
-         (i32.eqz
-            (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
-
-   (func (export "caml_notequal")
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new
-         (i32.ne (i32.const 0)
-            (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
-
-   (func (export "caml_lessthan")
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (local $res i32)
-      (local.set $res
-         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
-      (i31.new
-         (i32.and (i32.lt_s (local.get $res) (i32.const 0))
-                  (i32.ne (local.get $res) (global.get $unordered)))))
-
-   (func (export "caml_lessequal")
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (local $res i32)
-      (local.set $res
-         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
-      (i31.new
-         (i32.and (i32.le_s (local.get $res) (i32.const 0))
-                  (i32.ne (local.get $res) (global.get $unordered)))))
-
-   (func (export "caml_greaterthan")
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new (i32.lt_s (i32.const 0)
-         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
-
-   (func (export "caml_greaterequal")
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new (i32.le_s (i32.const 0)
-         (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
-
-   (func $caml_hash_mix_int (param $h i32) (param $d i32) (result i32)
-      (i32.add
-         (i32.mul
-            (i32.rotl
-               (i32.xor
-                  (i32.mul
-                     (i32.rotl
-                        (i32.mul (local.get $d) (i32.const 0xcc9e2d51))
-                        (i32.const 15))
-                     (i32.const 0x1b873593))
-                  (local.get $h))
-               (i32.const 13))
-            (i32.const 5))
-         (i32.const 0xe6546b64)))
-
-   (func $caml_hash_mix_final (param $h i32) (result i32)
-      (local.set $h
-         (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
-      (local.set $h (i32.mul (local.get $h) (i32.const 0x85ebca6b)))
-      (local.set $h
-         (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 13))))
-      (local.set $h (i32.mul (local.get $h) (i32.const 0xc2b2ae35)))
-      (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
-
-   (func $caml_hash_mix_int64 (param $h i32) (param $d i64) (result i32)
-      (return_call $caml_hash_mix_int
-         (call $caml_hash_mix_int (local.get $h) (i32.wrap_i64 (local.get $d)))
-         (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
-
-   (func $caml_hash_mix_float (param $h i32) (param $d f64) (result i32)
-      (local $i i64)
-      (local.set $i (i64.reinterpret_f64 (local.get $d)))
-      (if (i64.eq (i64.and (local.get $i) (i64.const 0x7FF0000000000000))
-                  (i64.const 0x7ff0000000000000))
-         (then
-            (if (i64.ne (i64.and (local.get $i) (i64.const 0xFFFFFFFFFFFFF))
-                        (i64.const 0))
-               (then (local.set $i (i64.const 0x7ff0000000000001))))))
-      (if (i64.eq (local.get $i) (i64.const 0x8000000000000000))
-         (then (local.set $i (i64.const 0))))
-      (return_call $caml_hash_mix_int64 (local.get $h) (local.get $i)))
-
-   (func $caml_hash_mix_string
-      (param $h i32) (param $s (ref $string)) (result i32)
-      (local $i i32) (local $len i32) (local $w i32)
-      (local.set $len (array.len (local.get $s)))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len))
-            (then
-               (local.set $h
-                  (call $caml_hash_mix_int
-                     (local.get $h)
-                     (i32.or
-                        (i32.or
-                           (array.get_u $string (local.get $s) (local.get $i))
-                           (i32.shl (array.get_u $string (local.get $s)
-                                       (i32.add (local.get $i) (i32.const 1)))
-                                    (i32.const 8)))
-                        (i32.or
-                           (i32.shl (array.get_u $string (local.get $s)
-                                       (i32.add (local.get $i) (i32.const 2)))
-                                    (i32.const 16))
-                           (i32.shl (array.get_u $string (local.get $s)
-                                       (i32.add (local.get $i) (i32.const 3)))
-                                    (i32.const 24))))))
-               (local.set $i (i32.add (local.get $i) (i32.const 4)))
-               (br $loop))))
-      (local.set $w (i32.const 0))
-      (block $0_bytes
-         (block $1_byte
-            (block $2_bytes
-               (block $3_bytes
-                  (br_table $0_bytes $1_byte $2_bytes $3_bytes
-                     (i32.and (local.get $len) (i32.const 3))))
-               (local.set $w
-                  (i32.shl (array.get_u $string (local.get $s)
-                              (i32.add (local.get $i) (i32.const 2)))
-                           (i32.const 16))))
-            (local.set $w
-               (i32.or (local.get $w)
-                  (i32.shl (array.get_u $string (local.get $s)
-                              (i32.add (local.get $i) (i32.const 1)))
-                           (i32.const 8)))))
-         (local.set $w
-            (i32.or (local.get $w)
-               (array.get_u $string (local.get $s) (local.get $i))))
-         (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
-      (i32.xor (local.get $h) (local.get $len)))
-
-   (global $HASH_QUEUE_SIZE i32 (i32.const 256))
-
-   (global $caml_hash_queue (ref $block)
-      (array.new $block (i31.new (i32.const 0)) (global.get $HASH_QUEUE_SIZE)))
-
-   (func (export "caml_hash")
-      (param $count (ref eq)) (param $limit (ref eq)) (param $seed (ref eq))
-      (param $obj (ref eq)) (result (ref eq))
-      (local $sz i32) (local $num i32) (local $h i32)
-      (local $rd i32) (local $wr i32)
-      (local $v (ref eq))
-      (local $b (ref $block))
-      (local $i i32)
-      (local $len i32)
-      (local $tag i32)
-      (local.set $sz (i31.get_u (ref.cast i31 (local.get $limit))))
-      (if (i32.gt_u (local.get $sz) (global.get $HASH_QUEUE_SIZE))
-         (then (local.set $sz (global.get $HASH_QUEUE_SIZE))))
-      (local.set $num (i31.get_u (ref.cast i31 (local.get $count))))
-      (local.set $h (i31.get_s (ref.cast i31 (local.get $seed))))
-      (array.set $block
-         (global.get $caml_hash_queue) (i32.const 0) (local.get $obj))
-      (local.set $rd (i32.const 0))
-      (local.set $wr (i32.const 1))
-      (loop $loop
-         (if (i32.and (i32.lt_u (local.get $rd) (local.get $wr))
-                      (i32.gt_u (local.get $num) (i32.const 0)))
-            (then
-               (local.set $v
-                  (array.get $block (global.get $caml_hash_queue)
-                     (local.get $rd)))
-               (local.set $rd (i32.add (local.get $rd) (i32.const 1)))
-               (block $again
-                  (drop (block $not_int (result (ref eq))
-                     (local.set $h
-                        (call $caml_hash_mix_int (local.get $h)
-                           (i31.get_s
-                              (br_on_cast_fail $not_int i31 (local.get $v)))))
-                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
-                     (br $loop)))
-                  (drop (block $not_string (result (ref eq))
-                     (local.set $h
-                        (call $caml_hash_mix_string (local.get $h)
-                           (br_on_cast_fail $not_string $string (local.get $v))))
-                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
-                     (br $loop)))
-                  (drop (block $not_block (result (ref eq))
-                     (local.set $b
-                        (br_on_cast_fail $not_block $block (local.get $v)))
-                     (local.set $tag
-                        (i31.get_u
-                           (ref.cast i31
-                              (array.get $block (local.get $b) (i32.const 0)))))
-                     ;; ZZZ Special tags (forward / object)
-                     (local.set $len (array.len (local.get $b)))
-                     (local.set $h
-                        (call $caml_hash_mix_int (local.get $h)
-                           (i32.or
-                              (i32.sub (local.get $len) (i32.const 1))
-                              (local.get $tag))))
-                     (local.set $i (i32.const 1))
-                     (loop $block_iter
-                        (br_if $loop (i32.ge_u (local.get $i) (local.get $len)))
-                        (br_if $loop (i32.ge_u (local.get $wr) (local.get $sz)))
-                        (array.set $block (global.get $caml_hash_queue)
-                           (local.get $wr)
-                           (array.get $block (local.get $b) (local.get $i)))
-                        (local.set $wr (i32.add (local.get $wr) (i32.const 1)))
-                        (local.set $i (i32.add (local.get $i) (i32.const 1)))
-                        (br $block_iter))))
-                  (drop (block $not_float (result (ref eq))
-                     (local.set $h
-                        (call $caml_hash_mix_float (local.get $h)
-                           (struct.get $float 0
-                              (br_on_cast_fail $not_float $float
-                                 (local.get $v)))))
-                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
-                     (br $loop)))
-                  (drop (block $not_custom (result (ref eq))
-                     (local.set $h
-                        (call $caml_hash_mix_int (local.get $h)
-                           (call_ref $value->int
-                              (local.get $v)
-                              (struct.get $custom_operations 2
-                                 (br_on_null $loop
-                                    (struct.get $custom 0
-                                       (br_on_cast_fail $not_custom $custom
-                                          (local.get $v))))))))
-                     (local.set $num (i32.sub (local.get $num) (i32.const 1)))
-                     (br $loop)))
-                  ;; ZZZ other cases? (closures, javascript values)
-                  (unreachable)
-                  (br $loop)))))
-      ;; clear the queue to avoid a memory leak
-      (array.fill $block (global.get $caml_hash_queue)
-         (i32.const 0) (i31.new (i32.const 0)) (local.get $wr))
-      (i31.new (call $caml_hash_mix_final (local.get $h))))
-
-   (func (export "caml_marshal_data_size")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_marshal_data_size"))
-      (unreachable))
-
-   (func (export "caml_input_value") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_input_value"))
-      (unreachable))
-
-   (func (export "caml_input_value_from_bytes")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_input_value_from_bytes"))
-      (unreachable))
-
-   (func (export "caml_output_value")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_output_value"))
-      (unreachable))
-
-   (func (export "caml_output_value_to_buffer")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_output_value_to_buffer"))
-      (unreachable))
-
-   (func (export "caml_output_value_to_string")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_output_value_to_string"))
-      (unreachable))
-
-   ;; ZZZ
-   (func $dummy_format_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (call $log_js (string.const "dummy_format_fun"))
-      (array.new_fixed $string (i32.const 64)))
-   (func (export "%caml_format_int_special") (param (ref eq)) (result (ref eq))
-      (call $log_js (string.const "%caml_format_int_special"))
-      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 0)))))
-   (func (export "caml_format_int") (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 1)))))
-   (export "caml_int32_format" (func $dummy_format_fun))
-   (export "caml_int64_format" (func $dummy_format_fun))
-   (export "caml_nativeint_format" (func $dummy_format_fun))
-   (func (export "caml_hexstring_of_float")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (array.new_fixed $string (i32.const 64)))
-   (func (export "caml_format_float")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $caml_string_of_jsstring (call $wrap (call $format_float (struct.get $float 0 (ref.cast $float (local.get 1)))))))
-
-   (func (export "caml_get_exception_raw_backtrace")
-      (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
-
-   (func (export "caml_backtrace_status")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_convert_raw_backtrace")
-      (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
-
-   (data $raw_backtrace_slot_err
-      "Printexc.get_raw_backtrace_slot: index out of bounds")
-
-   (func (export "caml_raw_backtrace_slot")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      (call $caml_invalid_argument
-          (array.new_data $string $raw_backtrace_slot_err
-             (i32.const 0) (i32.const 52)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_convert_raw_backtrace_slot")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_restore_raw_backtrace")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_get_current_callstack")
-      (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
-
-   (func (export "caml_get_public_method")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_get_public_method"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_debug_info_status")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_const_max_wosize")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0xfffffff)))
-
-   (func (export "caml_ephe_create")
-      (param (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_create"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ephe_get_data")
-      (param (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_get_data"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ephe_set_data")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_set_data"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ephe_set_key")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_set_key"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ephe_unset_key")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_unset_key"))
-      (i31.new (i32.const 0)))
-
-   (global $caml_ephe_none (ref eq)
-      (array.new_fixed $block (i31.new (global.get $abstract_tag))))
-
-   (data $Weak_create "Weak.create")
-
-   (func (export "caml_weak_create")
-      (param $vlen (ref eq)) (result (ref eq))
-      (local $len i32)
-      (local $res (ref $block))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
-      (if (i32.lt_s (local.get $len) (i32.const 0))
-         (then
-            (call $caml_invalid_argument
-               (array.new_data $string $Weak_create
-                  (i32.const 0) (i32.const 11)))))
-      (local.set $res
-         (array.new $block (global.get $caml_ephe_none)
-            (i32.add (local.get $len) (i32.const 3))))
-      (array.set $block (local.get $res) (i32.const 0)
-         (i31.new (global.get $abstract_tag)))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_create"))
-      (local.get $res))
-
-   (func (export "caml_weak_blit")
-      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_blit"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_weak_check")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_check"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_weak_get")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_get"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_weak_get_copy")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_get_copy"))
-      (i31.new (i32.const 0)))
-
-   (global $bigarray_ops (ref $custom_operations)
-      ;; ZZZ
-      (struct.new $custom_operations
-         (array.new_fixed $string ;; "_bigarr02"
-            (i32.const 95) (i32.const 98) (i32.const 105) (i32.const 103)
-            (i32.const 97) (i32.const 114) (i32.const 114) (i32.const 48)
-            (i32.const 50))
-         (ref.func $int64_cmp) (ref.func $int64_hash)))
-
-   (type $bigarray
-      (sub $custom
-         (struct
-            (field (ref $custom_operations))
-            (field externref) ;; data
-            (field (ref $int_array)) ;; size in each dimension
-            (field i8) ;; number of dimensions
-            (field i8) ;; kind
-            (field i8)))) ;; layout
-
-   (func $caml_ba_get_size (param $dim (ref $int_array)) (result i32)
-      (local $i i32) (local $n i32) (local $sz i32)
-      (local.set $n (array.len (local.get $dim)))
-      (local.set $i (i32.const 0))
-      (local.set $sz (i32.const 1))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $n))
-            (then
-               ;; ZZZ Check for overflow
-               (local.set $sz
-                   (i32.mul (local.get $sz)
-                      (array.get $int_array
-                         (local.get $dim) (local.get $i))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (local.get $sz))
-
-  (func $caml_ba_size_per_element (param $kind i32) (result i32)
-     (select (i32.const 2) (i32.const 1)
-        (i32.or (i32.eq (local.get $kind) (i32.const 7))
-                (i32.or (i32.eq (local.get $kind) (i32.const 10))
-                        (i32.eq (local.get $kind) (i32.const 11))))))
-
-  (func $caml_ba_create_buffer
-     (param $kind i32) (param $sz i32) (result externref)
-     (return_call $ta_create (local.get $kind)
-        ;; ZZZ Check for overflow
-        (i32.mul (local.get $sz)
-           (call $caml_ba_size_per_element (local.get $kind)))))
-
-   (global $CAML_BA_MAX_NUM_DIMS i32 (i32.const 16))
-
-   (data $ba_create_bad_dims "Bigarray.create: bad number of dimensions")
-   (data $ba_create_negative_dim "Bigarray.create: negative dimension")
-
-   (func (export "caml_ba_create")
-      (param $vkind (ref eq)) (param $layout (ref eq)) (param $d (ref eq))
-      (result (ref eq))
-      (local $vdim (ref $block))
-      (local $dim (ref $int_array))
-      (local $kind i32) (local $num_dims i32) (local $i i32) (local $n i32)
-      (local.set $kind (i31.get_s (ref.cast i31 (local.get $vkind))))
-      (local.set $vdim (ref.cast $block (local.get $d)))
-      (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1)))
-      (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS))
-         (then
-            (call $caml_invalid_argument
-               (array.new_data $string $ba_create_bad_dims
-                  (i32.const 0) (i32.const 41)))))
-      (local.set $dim
-         (array.new $int_array (i32.const 0) (local.get $num_dims)))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $num_dims))
-            (then
-               (local.set $n
-                  (i31.get_s
-                     (ref.cast i31
-                        (array.get $block (local.get $vdim)
-                           (i32.add (local.get $i) (i32.const 1))))))
-               (if (i32.lt_s (local.get $n) (i32.const 0))
-                  (then
-                     (call $caml_invalid_argument
-                        (array.new_data $string $ba_create_negative_dim
-                              (i32.const 0) (i32.const 35)))))
-               (array.set $int_array
-                  (local.get $dim) (local.get $i) (local.get $n))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (struct.new $bigarray
-         (global.get $bigarray_ops)
-         (call $caml_ba_create_buffer (local.get $kind)
-            (call $caml_ba_get_size (local.get $dim)))
-         (local.get $dim)
-         (local.get $num_dims)
-         (local.get $kind)
-         (i31.get_s (ref.cast i31 (local.get $layout)))))
-
-   (data $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind")
-   (data $ta_too_large "Typed_array.to_genarray: too large")
-
-   (func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq))
-      (local $data externref)
-      (local $kind i32)
-      (local $len i32)
-      (local.set $data
-         (call $ta_normalize (extern.externalize (call $unwrap (local.get 0)))))
-      (local.set $kind (call $ta_kind (local.get $data)))
-      (if (i32.lt_s (local.get $kind) (i32.const 0))
-         (then
-            (call $caml_invalid_argument
-               (array.new_data $string $ta_unsupported_kind
-                  (i32.const 0) (i32.const 41)))))
-      (local.set $len (call $ta_length (local.get $data)))
-      (if (i32.lt_s (local.get $len) (i32.const 0))
-         (then
-            (call $caml_invalid_argument
-               (array.new_data $string $ta_too_large
-                  (i32.const 0) (i32.const 34)))))
-      (struct.new $bigarray
-         (global.get $bigarray_ops)
-         (local.get $data)
-         (array.new_fixed $int_array (local.get $len))
-         (i32.const 1)
-         (local.get $kind)
-         (i32.const 0)))
-
-   (func (export "caml_ba_to_typed_array") (param (ref eq)) (result (ref eq))
-      (call $wrap
-         (extern.internalize
-            (struct.get $bigarray 1 (ref.cast $bigarray (local.get $0))))))
-
-   (func $caml_ba_get_at_offset
-      (param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
-      (local $data externref)
-      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
-      (block $float32
-       (block $float64
-        (block $int8
-         (block $uint8
-          (block $int16
-           (block $uint16
-            (block $int32
-             (block $int64
-              (block $nativeint
-               (block $int
-                (block $complex32
-                 (block $complex64
-                  (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
-                            $int32 $int64 $nativeint $int
-                            $complex32 $complex64 $uint8
-                     (struct.get $bigarray 4 (local.get $ba))))
-                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                 (return
-                    (array.new_fixed $block
-                       (i31.new (global.get $double_array_tag))
-                       (struct.new $float
-                          (call $ta_get_f64 (local.get $data) (local.get $i)))
-                       (struct.new $float
-                          (call $ta_get_f64 (local.get $data)
-                             (i32.add (local.get $i) (i32.const 1)))))))
-                (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                (return
-                   (array.new_fixed $block
-                      (i31.new (global.get $double_array_tag))
-                      (struct.new $float
-                         (call $ta_get_f32 (local.get $data) (local.get $i)))
-                      (struct.new $float
-                         (call $ta_get_f32 (local.get $data)
-                            (i32.add (local.get $i) (i32.const 1)))))))
-               (return
-                  (i31.new
-                     (call $ta_get_i32 (local.get $data) (local.get $i)))))
-              (return_call $caml_copy_nativeint
-                 (call $ta_get_i32 (local.get $data) (local.get $i))))
-             (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-             (return_call $caml_copy_int64
-                (i64.or
-                   (i64.extend_i32_u
-                      (call $ta_get_i32 (local.get $data) (local.get $i)))
-                   (i64.shl
-                      (i64.extend_i32_u
-                         (call $ta_get_i32 (local.get $data)
-                            (i32.add (local.get $i) (i32.const 1))))
-                      (i64.const 32)))))
-            (return_call $caml_copy_int32
-               (call $ta_get_i32 (local.get $data) (local.get $i))))
-           (return (i31.new
-                      (call $ta_get_ui16 (local.get $data) (local.get $i)))))
-          (return (i31.new
-                     (call $ta_get_i16 (local.get $data) (local.get $i)))))
-         (return (i31.new
-                    (call $ta_get_ui8 (local.get $data) (local.get $i)))))
-        (return (i31.new
-                   (call $ta_get_i8 (local.get $data) (local.get $i)))))
-       (return (struct.new $float
-                  (call $ta_get_f64 (local.get $data) (local.get $i)))))
-      (return (struct.new $float
-                 (call $ta_get_f32 (local.get $data) (local.get $i)))))
-
-   (func $caml_ba_set_at_offset
-      (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq))
-      (local $data externref)
-      (local $b (ref $block)) (local $l i64)
-      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
-      (block $float32
-       (block $float64
-        (block $int8
-         (block $uint8
-          (block $int16
-           (block $uint16
-            (block $int32
-             (block $int64
-              (block $nativeint
-               (block $int
-                (block $complex32
-                 (block $complex64
-                  (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
-                            $int32 $int64 $nativeint $int
-                            $complex32 $complex64 $uint8
-                     (struct.get $bigarray 4 (local.get $ba))))
-                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                 (local.set $b (ref.cast $block (local.get $v)))
-                 (call $ta_set_f64 (local.get $data) (local.get $i)
-                    (struct.get $float 0
-                       (ref.cast $float
-                          (array.get $block (local.get $b) (i32.const 1)))))
-                 (call $ta_set_f64 (local.get $data)
-                    (i32.add (local.get $i) (i32.const 1))
-                    (struct.get $float 0
-                       (ref.cast $float
-                         (array.get $block (local.get $b) (i32.const 2)))))
-                 (return))
-                (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                (local.set $b (ref.cast $block (local.get $v)))
-                (call $ta_set_f32 (local.get $data) (local.get $i)
-                   (struct.get $float 0
-                      (ref.cast $float
-                         (array.get $block (local.get $b) (i32.const 1)))))
-                (call $ta_set_f32 (local.get $data)
-                   (i32.add (local.get $i) (i32.const 1))
-                   (struct.get $float 0
-                      (ref.cast $float
-                         (array.get $block (local.get $b) (i32.const 2)))))
-                (return))
-               (call $ta_set_i32 (local.get $data) (local.get $i)
-                  (i31.get_s (ref.cast i31 (local.get $v))))
-               (return))
-              (call $ta_set_i32 (local.get $data) (local.get $i)
-                 (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
-              (return))
-             (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-             (local.set $l
-                (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
-             (call $ta_set_i32 (local.get $data) (local.get $i)
-                (i32.wrap_i64 (local.get $l)))
-             (call $ta_set_i32 (local.get $data)
-                (i32.add (local.get $i) (i32.const 1))
-                (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32))))
-             (return))
-            (call $ta_set_i32 (local.get $data) (local.get $i)
-               (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
-            (return))
-           (call $ta_set_ui16 (local.get $data) (local.get $i)
-              (ref.cast i31 (local.get $v)))
-           (return))
-          (call $ta_set_i16 (local.get $data) (local.get $i)
-             (ref.cast i31 (local.get $v)))
-          (return))
-         (call $ta_set_ui8 (local.get $data) (local.get $i)
-            (ref.cast i31 (local.get $v)))
-         (return))
-        (call $ta_set_i8 (local.get $data) (local.get $i)
-           (ref.cast i31 (local.get $v)))
-        (return))
-       (call $ta_set_f64 (local.get $data) (local.get $i)
-          (struct.get $float 0 (ref.cast $float (local.get 0))))
-       (return))
-      (call $ta_set_f32 (local.get $data) (local.get $i)
-         (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (return))
-
-   (data $Bigarray_dim "Bigarray.dim")
-
-   (func $caml_ba_dim (export "caml_ba_dim")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $dim (ref $int_array))
-      (local $i i32)
-      (local.set $dim
-         (struct.get $bigarray 2 (ref.cast $bigarray (local.get 0))))
-      (local.set $i (i31.get_s (ref.cast i31 (local.get $1))))
-      (if (i32.ge_u (local.get $i) (array.len (local.get $dim)))
-         (then (call $caml_invalid_argument
-                  (array.new_data $string $Bigarray_dim
-                     (i32.const 0) (i32.const 12)))))
-      (i31.new (array.get $int_array (local.get $dim) (local.get $i))))
-
-   (func (export "caml_ba_dim_1")
-      (param (ref eq)) (result (ref eq))
-      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 0))))
-
-   (func (export "caml_ba_get_1")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $ba (ref $bigarray))
-      (local $i i32)
-      (local.set $ba (ref.cast $bigarray (local.get 0)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
-      (if (struct.get $bigarray 5 (local.get $ba))
-         (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
-      (if (i32.ge_u (local.get $i)
-             (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
-                (i32.const 0)))
-         (call $caml_bound_error))
-      (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i)))
-
-   (func (export "caml_ba_set_1")
-      (param (ref eq)) (param (ref eq)) (param $v (ref eq)) (result (ref eq))
-      (local $ba (ref $bigarray))
-      (local $i i32)
-      (local.set $ba (ref.cast $bigarray (local.get 0)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
-      (if (struct.get $bigarray 5 (local.get $ba))
-         (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
-      (if (i32.ge_u (local.get $i)
-             (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
-                (i32.const 0)))
-         (call $caml_bound_error))
-      (call $caml_ba_set_at_offset
-         (local.get $ba) (local.get $i) (local.get $v))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
-      ;; ZZZ used to convert a typed array to a string...
-      (call $log_js (string.const "caml_string_of_array"))
-      (unreachable))
-
-   (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
-      (local $a f64)
-      (local.set $a
-         (f64.abs (struct.get $float 0 (ref.cast $float (local.get 0)))))
-      (i31.new
-         (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
-            (then
-               (if (result i32) (f64.lt (local.get $a) (f64.const infinity))
-                  (then (i32.const 0)) ;; normal
-                  (else (i32.const 3)))) ;; infinity
-            (else
-               (if (result i32) (f64.eq (local.get $a) (f64.const 0))
-                  (then (i32.const 2)) ;; zero
-                  (else
-                     (if (result i32) (f64.eq (local.get $a) (local.get $a))
-                        (then (i32.const 1)) ;; subnormal
-                        (else (i32.const 4))))))))) ;; nan
-
-   (func (export "caml_modf_float") (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $a f64) (local $i f64) (local $f f64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $a (f64.abs (local.get $x)))
-      (if (f64.ge (local.get $a) (f64.const 0))
-         (then
-            (if (f64.lt (local.get $a) (f64.const infinity))
-               (then ;; normal
-                  (local.set $i (f64.floor (local.get $a)))
-                  (local.set $f (f64.sub (local.get $a) (local.get $i)))
-                  (local.set $i (f64.copysign (local.get $i) (local.get $x)))
-                  (local.set $f (f64.copysign (local.get $f) (local.get $x))))
-               (else ;; infinity
-                  (local.set $i (local.get $x))
-                  (local.set $f (f64.copysign (f64.const 0) (local.get $x))))))
-         (else ;; zero or nan
-            (local.set $i (local.get $x))
-            (local.set $f (local.get $x))))
-      (array.new_fixed $block (i31.new (i32.const 0))
-         (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
-
-   (func (export "caml_ldexp")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $n i32)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $n (i31.get_s (ref.cast i31 (local.get 1))))
-      (if (i32.gt_s (local.get $n) (i32.const 1023))
-         (then
-            (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
-            (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
-            (if (i32.gt_s (local.get $n) (i32.const 1023))
-               (then
-                  ;; subnormal
-                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
-                  (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
-                  (if (i32.gt_s (local.get $n) (i32.const 1023))
-                     (then (local.set $n (i32.const 1023))))))
-         (else
-            (if (i32.lt_s (local.get $n) (i32.const -1022))
-               (then
-                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p-969)))
-                  (local.set $n (i32.add (local.get $n) (i32.const 969)))
-                  (if (i32.lt_s (local.get $n) (i32.const -1022))
-                     (then
-                        (local.set $x
-                           (f64.mul (local.get $x) (f64.const 0x1p-969)))
-                        (local.set $n (i32.add (local.get $n) (i32.const 969)))
-                        (if (i32.lt_s (local.get $n) (i32.const -1022))
-                           (then (local.set $n (i32.const -1022)))))))))))
-      (struct.new $float
-         (f64.mul (local.get $x)
-            (f64.reinterpret_i64
-               (i64.shl (i64.add (i64.extend_i32_s (local.get $n))
-                                 (i64.const 0x3ff))
-                        (i64.const 52))))))
-
-   (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_float_of_string"))
-      (unreachable))
-
-   (func (export "caml_float_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $y f64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
-      (if (f64.eq (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const 0)))))
-      (if (f64.lt (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (if (f64.gt (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (if (f64.eq (local.get $x) (local.get $x))
-         (then (return (i31.new (i32.const 1)))))
-      (if (f64.eq (local.get $y) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_nextafter")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $y f64) (local $i i64) (local $j i64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
-      (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
-      (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
-      (if (f64.eq (local.get $x) (local.get $y))
-         (then (return (local.get 1))))
-      (if (result (ref eq)) (f64.eq (local.get $x) (f64.const 0))
-         (then
-            (if (f64.ge (local.get $y) (f64.const 0))
-               (then (return (struct.new $float (f64.const 0x1p-1074))))
-               (else (return (struct.new $float (f64.const -0x1p-1074))))))
-         (else
-            (local.set $i (i64.reinterpret_f64 (local.get $x)))
-            (local.set $j (i64.reinterpret_f64 (local.get $y)))
-            (if (i32.and (i64.lt_s (local.get $i) (local.get $j))
-                         (i64.lt_u (local.get $i) (local.get $j)))
-               (then (local.set $i (i64.add (local.get $i) (i64.const 1))))
-               (else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
-            (return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
-
-   (func (export "caml_atomic_cas")
-      (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
-      (result (ref eq))
-      (local $b (ref $block))
-      (local.set $b (ref.cast $block (local.get $ref)))
-      (if (result (ref eq))
-         (ref.eq (array.get $block (local.get $b) (i32.const 1))
-                 (local.get $o))
-         (then
-            (array.set $block (local.get $b) (i32.const 1) (local.get $n))
-            (i31.new (i32.const 1)))
-         (else
-            (i31.new (i32.const 0)))))
-
-   (func (export "caml_atomic_load") (param (ref eq)) (result (ref eq))
-      (array.get $block (ref.cast $block (local.get 0)) (i32.const 1)))
-
-   (func (export "caml_atomic_fetch_add")
-     (param $ref (ref eq)) (param $i (ref eq)) (result (ref eq))
-     (local $b (ref $block))
-     (local $old (ref eq))
-     (local.set $b (ref.cast $block (local.get $ref)))
-     (local.set $old (array.get $block (local.get $b) (i32.const 1)))
-     (array.set $block (local.get $b) (i32.const 1)
-        (i31.new (i32.add (i31.get_s (ref.cast i31 (local.get $old)))
-                          (i31.get_s (ref.cast i31 (local.get $i))))))
-     (local.get $old))
-
-   (global $caml_domain_dls (mut (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
-
-   (func (export "caml_domain_dls_set") (param $a (ref eq)) (result (ref eq))
-      (global.set $caml_domain_dls (local.get $a))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_domain_dls_get") (param (ref eq)) (result (ref eq))
-      (global.get $caml_domain_dls))
-
-   (func (export "caml_lxm_next") (param $v (ref eq)) (result (ref eq))
-      (local $data externref)
-      (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64)
-      (local $z i64)
-      (local.set $data
-         (struct.get $bigarray 1 (ref.cast $bigarray (local.get $v))))
-      (local.set $a
-         (i64.or
-            (i64.extend_i32_u
-               (call $ta_get_i32 (local.get $data) (i32.const 0)))
-            (i64.shl
-               (i64.extend_i32_u
-                  (call $ta_get_i32 (local.get $data) (i32.const 1)))
-               (i64.const 32))))
-      (local.set $s
-         (i64.or
-            (i64.extend_i32_u
-               (call $ta_get_i32 (local.get $data) (i32.const 2)))
-            (i64.shl
-               (i64.extend_i32_u
-                  (call $ta_get_i32 (local.get $data) (i32.const 3)))
-               (i64.const 32))))
-      (local.set $q0
-         (i64.or
-            (i64.extend_i32_u
-               (call $ta_get_i32 (local.get $data) (i32.const 4)))
-            (i64.shl
-               (i64.extend_i32_u
-                  (call $ta_get_i32 (local.get $data) (i32.const 5)))
-               (i64.const 32))))
-      (local.set $q1
-         (i64.or
-            (i64.extend_i32_u
-               (call $ta_get_i32 (local.get $data) (i32.const 6)))
-            (i64.shl
-               (i64.extend_i32_u
-                  (call $ta_get_i32 (local.get $data) (i32.const 7)))
-               (i64.const 32))))
-      (local.set $z (i64.add (local.get $s) (local.get $q0)))
-      (local.set $z
-         (i64.mul (i64.xor (local.get $z)
-                           (i64.shr_u (local.get $z) (i64.const 32)))
-                  (i64.const 0xdaba0b6eb09322e3)))
-      (local.set $z
-         (i64.mul (i64.xor (local.get $z)
-                           (i64.shr_u (local.get $z) (i64.const 32)))
-                  (i64.const 0xdaba0b6eb09322e3)))
-      (local.set $z
-         (i64.xor (local.get $z) (i64.shr_u (local.get $z) (i64.const 32))))
-      (local.set $s
-         (i64.add (i64.mul (local.get $s) (i64.const 0xd1342543de82ef95))
-                  (local.get $a)))
-      (call $ta_set_i32 (local.get $data) (i32.const 2)
-         (i32.wrap_i64 (local.get $s)))
-      (call $ta_set_i32 (local.get $data) (i32.const 3)
-         (i32.wrap_i64 (i64.shr_u (local.get $s) (i64.const 32))))
-      (local.set $q1 (i64.xor (local.get $q1) (local.get $q0)))
-      (local.set $q0 (i64.rotl (local.get $q0) (i64.const 24)))
-      (local.set $q0 (i64.xor (i64.xor (local.get $q0) (local.get $q1))
-                              (i64.shl (local.get $q1) (i64.const 16))))
-      (local.set $q1 (i64.rotl (local.get $q1) (i64.const 37)))
-      (call $ta_set_i32 (local.get $data) (i32.const 4)
-         (i32.wrap_i64 (local.get $q0)))
-      (call $ta_set_i32 (local.get $data) (i32.const 5)
-         (i32.wrap_i64 (i64.shr_u (local.get $q0) (i64.const 32))))
-      (call $ta_set_i32 (local.get $data) (i32.const 6)
-         (i32.wrap_i64 (local.get $q1)))
-      (call $ta_set_i32 (local.get $data) (i32.const 7)
-         (i32.wrap_i64 (i64.shr_u (local.get $q1) (i64.const 32))))
-      (return_call $caml_copy_int64 (local.get $z)))
-
-   (func (export "create_nat")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "create_nat"))
-      (i31.new (i32.const 0)))
-
-   (func (export "incr_nat")
-      (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "incr_nat"))
-      (i31.new (i32.const 0)))
-
-   (func (export "initialize_nat")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (func (export "set_digit_nat")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "set_digit_nat"))
-      (i31.new (i32.const 0)))
-
-   (func (export "set_to_zero_nat")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "set_to_zero_nat"))
-      (i31.new (i32.const 0)))
-
-   (func (export "unix_gettimeofday")
-      (param (ref eq)) (result (ref eq))
-      (struct.new $float (call $gettimeofday)))
-
-   (func (export "caml_alloc_tm")
-      (param $sec i32) (param $min i32) (param $hour i32) (param $mday i32)
-      (param $mon i32) (param $year i32) (param $wday i32) (param $yday $i32)
-      (param $isdst i32) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))
-         (i31.new (local.get $sec))
-         (i31.new (local.get $min))
-         (i31.new (local.get $hour))
-         (i31.new (local.get $mday))
-         (i31.new (local.get $mon))
-         (i31.new (local.get $year))
-         (i31.new (local.get $wday))
-         (i31.new (local.get $yday))
-         (i31.new (local.get $isdst))))
-
-   (func (export "unix_gmtime") (param (ref eq)) (result (ref eq))
-      (call $gmtime))
-
-   (func (export "unix_localtime") (param (ref eq)) (result (ref eq))
-      (call $localtime))
-
-   (func (export "unix_time") (param (ref eq)) (result (ref eq))
-      (struct.new $float (f64.floor (call $gettimeofday))))
-
-   (func (export "unix_inet_addr_of_string")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (type $js (struct (field anyref)))
-
-   (func $wrap (param anyref) (result (ref eq))
-      (block $is_eq (result (ref eq))
-         (return (struct.new $js (br_on_cast $is_eq eq (local.get 0))))))
-
-   (func $unwrap (param (ref eq)) (result anyref)
-      (block $not_js (result anyref)
-         (return (struct.get $js 0
-                    (br_on_cast_fail $not_js $js (local.get 0))))))
-
-   (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
-   (import "bindings" "identity" (func $from_float (param f64) (result anyref)))
-   (import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
-   (import "bindings" "identity" (func $ref_cast_string (param anyref) (result stringref)))
-   (import "bindings" "from_bool" (func $from_bool (param i32) (result anyref)))
-   (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
-   (import "bindings" "get" (func $get (param externref) (param anyref) (result anyref)))
-   (import "bindings" "set" (func $set (param anyref) (param anyref) (param anyref)))
-   (import "bindings" "delete" (func $delete (param anyref) (param anyref)))
-   (import "bindings" "instanceof"
-      (func $instanceof (param anyref) (param anyref) (result i32)))
-   (import "bindings" "typeof" (func $typeof (param anyref) (result anyref)))
-   (import "bindings" "equals" (func $equals (param anyref) (param anyref) (result i32)))
-   (import "bindings" "strict_equals" (func $strict_equals (param anyref) (param anyref) (result i32)))
-   (import "bindings" "fun_call"
-      (func $fun_call
-         (param anyref) (param anyref) (param anyref) (result anyref)))
-   (import "bindings" "meth_call" (func $meth_call (param anyref) (param anyref) (param anyref) (result anyref)))
-   (import "bindings" "new" (func $new (param anyref) (param anyref) (result anyref)))
-   (import "bindings" "new_obj" (func $new_obj (result anyref)))
-   (import "bindings" "new_array" (func $new_array (param i32) (result externref)))
-   (import "bindings" "iter_props"
-      (func $iter_props (param anyref) (param anyref)))
-   (import "bindings" "array_length"
-      (func $array_length (param externref) (result i32)))
-   (import "bindings" "array_get"
-      (func $array_get (param externref) (param i32) (result anyref)))
-   (import "bindings" "array_set"
-      (func $array_set (param externref) (param i32) (param anyref)))
-   (import "bindings" "wrap_callback"
-      (func $wrap_callback (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_callback_args"
-      (func $wrap_callback_args (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_callback_strict"
-      (func $wrap_callback_strict (param i32) (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_callback_unsafe"
-      (func $wrap_callback_unsafe (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_meth_callback"
-      (func $wrap_meth_callback (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_meth_callback_args"
-      (func $wrap_meth_callback_args (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_meth_callback_strict"
-      (func $wrap_meth_callback_strict (param i32) (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_meth_callback_unsafe"
-      (func $wrap_meth_callback_unsafe (param (ref eq)) (result anyref)))
-   (import "bindings" "wrap_fun_arguments"
-      (func $wrap_fun_arguments (param anyref) (result anyref)))
-   (import "bindings" "get_int" (func $get_int (param externref) (param i32) (result i32)))
-   (import "bindings" "format" (func $format_float (param f64) (result anyref)))
-   (import "bindings" "format" (func $format_int (param (ref eq)) (result anyref)))
-   (import "bindings" "ta_create"
-      (func $ta_create (param i32) (param i32) (result externref)))
-   (import "bindings" "ta_normalize"
-      (func $ta_normalize (param externref) (result externref)))
-   (import "bindings" "ta_kind" (func $ta_kind (param externref) (result i32)))
-   (import "bindings" "ta_length"
-      (func $ta_length (param externref) (result i32)))
-   (import "bindings" "ta_get_f64"
-      (func $ta_get_f64 (param externref) (param i32) (result f64)))
-   (import "bindings" "ta_get_f32"
-      (func $ta_get_f32 (param externref) (param i32) (result f64)))
-   (import "bindings" "ta_get_i32"
-      (func $ta_get_i32 (param externref) (param i32) (result i32)))
-   (import "bindings" "ta_get_i16"
-      (func $ta_get_i16 (param externref) (param i32) (result i32)))
-   (import "bindings" "ta_get_ui16"
-      (func $ta_get_ui16 (param externref) (param i32) (result i32)))
-   (import "bindings" "ta_get_i8"
-      (func $ta_get_i8 (param externref) (param i32) (result i32)))
-   (import "bindings" "ta_get_ui8"
-      (func $ta_get_ui8 (param externref) (param i32) (result i32)))
-   (import "bindings" "ta_set_f64"
-      (func $ta_set_f64 (param externref) (param i32) (param f64)))
-   (import "bindings" "ta_set_f32"
-      (func $ta_set_f32 (param externref) (param i32) (param f64)))
-   (import "bindings" "ta_set_i32"
-      (func $ta_set_i32 (param externref) (param i32) (param i32)))
-   (import "bindings" "ta_set_i16"
-      (func $ta_set_i16 (param externref) (param i32) (param (ref i31))))
-   (import "bindings" "ta_set_ui16"
-      (func $ta_set_ui16 (param externref) (param i32) (param (ref i31))))
-   (import "bindings" "ta_set_i8"
-      (func $ta_set_i8 (param externref) (param i32) (param (ref i31))))
-   (import "bindings" "ta_set_ui8"
-      (func $ta_set_ui8 (param externref) (param i32) (param (ref i31))))
-   (import "bindings" "gettimeofday" (func $gettimeofday (result f64)))
-   (import "bindings" "gmtime" (func $gmtime (result (ref eq))))
-   (import "bindings" "localtime" (func $localtime (result (ref eq))))
-   (import "bindings" "random_seed" (func $random_seed (result externref)))
-
-   (func (export "caml_js_equals")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $equals
-                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
-
-   (func (export "caml_js_strict_equals")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $strict_equals
-                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
-
-   ;; ZZZ We should generate JavaScript code instead of using 'eval'
-   (export "caml_pure_js_expr" (func $caml_js_expr))
-   (export "caml_js_var" (func $caml_js_expr))
-   (export "caml_js_eval_string" (func $caml_js_expr))
-   (func $caml_js_expr (export "caml_js_expr")
-      (param (ref eq)) (result (ref eq))
-      (local $s (ref $string))
-      (local.set $s (ref.cast $string (local.get 0)))
-      (return_call $wrap
-         (call $eval
-            (string.new_wtf8_array replace
-               (local.get $s) (i32.const 0) (array.len (local.get $s))))))
-
-   (func (export "caml_js_to_float") (param (ref eq)) (result (ref eq))
-      (struct.new $float (call $to_float (call $unwrap (local.get 0)))))
-
-   (func (export "caml_js_from_float") (param (ref eq)) (result (ref eq))
-      (return_call $wrap
-         (call $from_float
-            (struct.get $float 0 (ref.cast $float (local.get 0))))))
-
-   (func (export "caml_js_to_bool") (param (ref eq)) (result (ref eq))
-      (i31.new (call $to_bool (struct.get $js 0 (ref.cast $js (local.get 0))))))
-
-   (func (export "caml_js_from_bool") (param (ref eq)) (result (ref eq))
-      (struct.new $js
-         (call $from_bool (i31.get_s (ref.cast i31 (local.get 0))))))
-
-  (func (export "caml_js_pure_expr")
-     (param (ref eq)) (result (ref eq))
-     (return_call_ref $function_1
-        (i31.new (i32.const 0))
-        (local.get 0)
-        (struct.get $closure 0
-           (ref.cast $closure (local.get 0)))))
-
-   (func (export "caml_js_fun_call")
-      (param $f (ref eq)) (param $args (ref eq)) (result (ref eq))
-      (return_call $wrap
-         (call $fun_call (call $unwrap (local.get $f)) (ref.null any)
-            (call $unwrap (call $caml_js_from_array (local.get $args))))))
-
-   (func (export "caml_js_call")
-      (param $f (ref eq)) (param $o (ref eq)) (param $args (ref eq))
-      (result (ref eq))
-      (return_call $wrap
-         (call $fun_call (call $unwrap (local.get $f))
-            (call $unwrap (local.get $o))
-            (call $unwrap (call $caml_js_from_array (local.get $args))))))
-
-   (func (export "caml_js_meth_call")
-      (param $o (ref eq)) (param $f (ref eq)) (param $args (ref eq))
-      (result (ref eq))
-      (return_call $wrap
-         (call $meth_call (call $unwrap (local.get $o))
-            (call $unwrap (call $caml_jsstring_of_string (local.get $f)))
-            (call $unwrap (call $caml_js_from_array (local.get $args))))))
-
-   (func (export "caml_js_get")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (if (ref.test $string (local.get 1))
-         (then
-            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
-      (return_call $wrap
-         (call $get (extern.externalize (call $unwrap (local.get 0)))
-            (call $unwrap (local.get 1)))))
-
-   (func (export "caml_js_set")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (if (ref.test $string (local.get 1))
-         (then
-            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
-      (call $set (call $unwrap (local.get 0)) (call $unwrap (local.get 1))
-         (call $unwrap (local.get 2)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_js_delete")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (if (ref.test $string (local.get 1))
-         (then
-            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
-      (call $delete (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_js_instanceof")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $instanceof
-                  (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
-
-   (func (export "caml_js_typeof")
-      (param (ref eq)) (result (ref eq))
-      (struct.new $js (call $typeof (call $unwrap (local.get 0)))))
-
-   (func (export "caml_js_new")
-      (param $c (ref eq)) (param $args (ref eq)) (result (ref eq))
-      (return_call $wrap
-         (call $new (call $unwrap (local.get $c))
-            (call $unwrap (call $caml_js_from_array (local.get $args))))))
-
-   (func (export "caml_ojs_new_arr")
-      (param $c (ref eq)) (param $args (ref eq)) (result (ref eq))
-      (return_call $wrap
-         (call $new (call $unwrap (local.get $c))
-            (call $unwrap (local.get $args)))))
-
-   (func (export "caml_ojs_iterate_properties")
-      (param $o (ref eq)) (param $f (ref eq)) (result (ref eq))
-      (call $iter_props
-         (call $unwrap (local.get $o)) (call $unwrap (local.get $f)))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_js_object")
-      (param (ref eq)) (result (ref eq))
-      (local $a (ref $block)) (local $p (ref $block))
-      (local $i i32) (local $l i32)
-      (local $o anyref)
-      (local.set $a (ref.cast $block (local.get 0)))
-      (local.set $l (array.len (local.get $a)))
-      (local.set $i (i32.const 1))
-      (local.set $o (call $new_obj))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (local.set $p
-                  (ref.cast $block
-                     (array.get $block (local.get $a) (local.get $i))))
-               (call $set (local.get $o)
-                  (call $unwrap
-                     (call $caml_jsstring_of_string
-                        (array.get $block (local.get $p) (i32.const 1))))
-                  (call $unwrap
-                        (array.get $block (local.get $p) (i32.const 2))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (struct.new $js (local.get $o)))
-
-   (func $caml_js_from_array (export "caml_js_from_array")
-      (param (ref eq)) (result (ref eq))
-      (local $a (ref $block))
-      (local $a' externref)
-      (local $i i32) (local $l i32)
-      (local.set $a (ref.cast $block (local.get 0)))
-      (local.set $l (i32.sub (array.len (local.get $a)) (i32.const 1)))
-      (local.set $a' (call $new_array (local.get $l)))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (call $array_set (local.get $a') (local.get $i)
-                  (call $unwrap (array.get $block (local.get $a)
-                                   (i32.add (local.get $i) (i32.const 1)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (struct.new $js (extern.internalize (local.get $a'))))
-
-   (func (export "caml_js_to_array")
-      (param (ref eq)) (result (ref eq))
-      (local $a externref)
-      (local $a' (ref $block))
-      (local $i i32) (local $l i32)
-      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
-      (local.set $l (call $array_length (local.get $a)))
-      (local.set $a'
-         (array.new $block (i31.new (i32.const 0))
-            (i32.add (local.get $l) (i32.const 1))))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (array.set $block (local.get $a')
-                  (i32.add (local.get $i) (i32.const 1))
-                  (call $wrap (call $array_get (local.get $a) (local.get $i))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (local.get $a'))
-
-   (func $caml_js_wrap_callback (export "caml_js_wrap_callback")
-      (param (ref eq)) (result (ref eq))
-      (return_call $wrap (call $wrap_callback (local.get 0))))
-
-   (func (export "caml_js_wrap_callback_arguments")
-      (param (ref eq)) (result (ref eq))
-      (return_call $wrap (call $wrap_callback_args (local.get 0))))
-
-   (func (export "caml_js_wrap_callback_strict")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (return_call $wrap
-         (call $wrap_callback_strict
-            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
-
-   (func (export "caml_js_wrap_callback_unsafe")
-      (param (ref eq)) (result (ref eq))
-      (return_call $wrap (call $wrap_callback_unsafe (local.get 0))))
-
-   (func (export "caml_js_wrap_meth_callback")
-      (param (ref eq)) (result (ref eq))
-      (return_call $wrap (call $wrap_meth_callback (local.get 0))))
-
-   (func (export "caml_js_wrap_meth_callback_arguments")
-      (param (ref eq)) (result (ref eq))
-      (return_call $wrap (call $wrap_meth_callback_args (local.get 0))))
-
-   (func (export "caml_js_wrap_meth_callback_strict")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (return_call $wrap
-         (call $wrap_meth_callback_strict
-            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
-
-   (func (export "caml_js_wrap_meth_callback_unsafe")
-      (param (ref eq)) (result (ref eq))
-      (return_call $wrap (call $wrap_meth_callback_unsafe (local.get 0))))
-
-   (func (export "caml_ojs_wrap_fun_arguments")
-      (param (ref eq)) (result (ref eq))
-      (return_call $wrap
-         (call $wrap_fun_arguments
-            (call $wrap_callback_strict (i32.const 1) (local.get 0)))))
-
-   (func (export "caml_callback")
-      (param $f (ref eq)) (param $count i32) (param $args (ref extern))
-      (param $kind i32) ;; 0 ==> strict / 2 ==> unsafe
-      (result anyref)
-      (local $acc (ref eq)) (local $i i32)
-      (local.set $acc (local.get $f))
-      (if (i32.eq (local.get $kind) (i32.const 2))
-         (then
-            (loop $loop
-               (local.set $f (local.get $acc))
-               (local.set $acc
-                  (call_ref $function_1
-                     (call $wrap
-                        (call $get (local.get $args)
-                           (i31.new (local.get $i))))
-                     (local.get $acc)
-                     (struct.get $closure 0
-                        (ref.cast $closure (local.get $acc)))))
-               (br_if $loop
-                  (i32.eqz (ref.test $closure_last_arg (local.get $f))))))
-         (else
-            (local.set $i (i32.const 0))
-            (loop $loop
-               (if (i32.lt_u (local.get $i) (local.get $count))
-                  (then
-                     (local.set $acc
-                        (call_ref $function_1
-                           (call $wrap
-                              (call $get (local.get $args)
-                                 (i31.new (local.get $i))))
-                           (local.get $acc)
-                           (struct.get $closure 0
-                              (ref.cast $closure (local.get $acc)))))
-                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
-                     (br $loop))))
-            (if (local.get $kind)
-               (then
-                  (if (ref.test $closure (local.get $acc))
-                     (then (local.set $acc
-                              (call $caml_js_wrap_callback
-                                 (local.get $acc)))))))))
-      (return_call $unwrap (local.get $acc)))
-
-   (export "caml_js_from_string" (func $caml_jsstring_of_string))
-   (func $caml_jsstring_of_string (export "caml_jsstring_of_string")
-      (param (ref eq)) (result (ref eq))
-      (local $s (ref $string))
-      (local.set $s (ref.cast $string (local.get 0)))
-      (struct.new $js
-         (string.new_wtf8_array replace (local.get $s) (i32.const 0)
-           (array.len (local.get $s)))))
-
-   (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
-      (param (ref eq)) (result (ref eq))
-      (local $s (ref $string))
-      (local $s' (ref $string))
-      (local $l i32) (local $i i32) (local $n i32) (local $c i32)
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $l (array.len (local.get $s)))
-      (local.set $i (i32.const 0))
-      (local.set $n (i32.const 0))
-      (loop $count
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (if (i32.ge_u (array.get_u $string (local.get $s) (local.get $i))
-                      (i32.const 128))
-                  (then (local.set $n (i32.add (local.get $n) (i32.const 1)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $count))))
-      (if (i32.eqz (local.get $n))
-         (then
-            (return
-               (struct.new $js
-                  (string.new_wtf8_array utf8 (local.get $s) (i32.const 0)
-                     (local.get $i))))))
-      (local.set $s'
-         (array.new $string (i32.const 0)
-            (i32.add (local.get $i) (local.get $n))))
-      (local.set $i (i32.const 0))
-      (local.set $n (i32.const 0))
-      (loop $fill
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
-               (if (i32.lt_u (local.get $c) (i32.const 128))
-                  (then
-                     (array.set $string
-                        (local.get $s') (local.get $n) (local.get $c))
-                     (local.set $n (i32.add (local.get $n) (i32.const 1))))
-                  (else
-                     (array.set $string (local.get $s')
-                        (local.get $n)
-                        (i32.or (i32.shr_u (local.get $c) (i32.const 6))
-                           (i32.const 0xC0)))
-                     (array.set $string (local.get $s')
-                        (i32.add (local.get $n) (i32.const 1))
-                        (i32.and (local.get $c) (i32.const 0x3F)))
-                     (local.set $n (i32.add (local.get $n) (i32.const 2)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $fill))))
-      (struct.new $js
-         (string.new_wtf8_array utf8 (local.get $s') (i32.const 0)
-            (local.get $n))))
-
-   (export "caml_js_to_string" (func $caml_string_of_jsstring))
-   (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
-      (param (ref eq)) (result (ref eq))
-      (local $s stringref)
-      (local $l i32)
-      (local $s' (ref $string))
-      ;; ZZZ ref.cast string not yet implemented by V8
-      (local.set $s
-         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
-      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
-      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
-      (drop (string.encode_wtf8_array replace
-               (local.get $s) (local.get $s') (i32.const 0)))
-      (local.get $s'))
-
-   (func (export "caml_string_of_jsbytes")
-      (param (ref eq)) (result (ref eq))
-      (local $s stringref)
-      (local $l i32) (local $i i32) (local $n i32) (local $c i32)
-      (local $s' (ref $string)) (local $s'' (ref $string))
-      ;; ZZZ ref.cast string not yet implemented by V8
-      (local.set $s
-         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
-      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
-      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
-      (drop (string.encode_wtf8_array replace
-               (local.get $s) (local.get $s') (i32.const 0)))
-      (local.set $i (i32.const 0))
-      (local.set $n (i32.const 0))
-      (loop $count
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (if (i32.ge_u (array.get_u $string (local.get $s') (local.get $i))
-                      (i32.const 0xC0))
-                  (then (local.set $n (i32.add (local.get $n) (i32.const 1)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $count))))
-      (if (i32.eqz (local.get $n)) (then (return (local.get $s'))))
-      (local.set $s''
-         (array.new $string (i32.const 0)
-            (i32.add (local.get $i) (local.get $n))))
-      (local.set $i (i32.const 0))
-      (local.set $n (i32.const 0))
-      (loop $fill
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (local.set $c
-                  (array.get_u $string (local.get $s') (local.get $i)))
-               (if (i32.lt_u (local.get $c) (i32.const 0xC0))
-                  (then
-                     (array.set $string
-                        (local.get $s'') (local.get $n) (local.get $c))
-                     (local.set $i (i32.add (local.get $i) (i32.const 1))))
-                  (else
-                     (array.set $string (local.get $s'')
-                        (local.get $n)
-                        (i32.sub
-                           (i32.or
-                              (i32.shl (local.get $c) (i32.const 6))
-                              (array.get_u $string (local.get $s')
-                                 (i32.add (local.get $i) (i32.const 1))))
-                           (i32.const 0X3080)))
-                     (local.set $i (i32.add (local.get $i) (i32.const 2)))))
-               (local.set $n (i32.add (local.get $n) (i32.const 1)))
-               (br $fill))))
-      (local.get $s''))
-
-   (func (export "caml_list_to_js_array")
-      (param (ref eq)) (result (ref eq))
-      (local $i i32)
-      (local $a externref)
-      (local $l (ref eq))
-      (local $b (ref $block))
-      (local.set $i (i32.const 0))
-      (local.set $l (local.get 0))
-      (drop (block $done (result (ref eq))
-         (loop $compute_length
-            (local.set $l
-               (array.get $block
-                  (br_on_cast_fail $done $block (local.get $l)) (i32.const 2)))
-            (local.set $i (i32.add (local.get $i) (i32.const 1)))
-            (br $compute_length))))
-      (local.set $a (call $new_array (local.get $i)))
-      (local.set $i (i32.const 0))
-      (local.set $l (local.get 0))
-      (drop (block $exit (result (ref eq))
-         (loop $loop
-            (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
-            (call $array_set (local.get $a) (local.get $i)
-               (call $unwrap (array.get $block (local.get $b) (i32.const 1))))
-            (local.set $l (array.get $block (local.get $b) (i32.const 2)))
-            (local.set $i (i32.add (local.get $i) (i32.const 1)))
-            (br $loop))))
-      (struct.new $js (extern.internalize (local.get $a))))
-
-   (func (export "caml_list_of_js_array")
-      (param (ref eq)) (result (ref eq))
-      (local $l (ref eq))
-      (local $i i32)
-      (local $len i32)
-      (local $a externref)
-      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
-      (local.set $len (call $array_length (local.get $a)))
-      (local.set $i (i32.const 0))
-      (local.set $l (i31.new (i32.const 0)))
-      (loop $loop
-         (if (i32.le_u (local.get $i) (local.get $len))
-            (then
-               (local.set $l
-                  (array.new_fixed $block (i31.new (i32.const 0))
-                     (call $wrap
-                        (call $array_get (local.get $a) (local.get $i)))
-                     (local.get $l)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (local.get $l))
-
-   (func (export "caml_js_error_option_of_exception")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_js_get_console")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_get_console"))
-      (i31.new (i32.const 0)))
-
-  (func (export "caml_js_html_entities")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_html_entities"))
-      (i31.new (i32.const 0)))
-
-  (func (export "caml_js_html_escape")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_html_escape"))
-      (i31.new (i32.const 0)))
-
-  (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_xmlhttprequest_create"))
-      (i31.new (i32.const 0)))
-
-  (func (export "caml_js_on_ie")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_on_ie"))
-      (i31.new (i32.const 0)))
-
-  (func (export "bigstringaf_blit_from_bytes")
-     (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-     ;; ZZZ
-     (call $log_js (string.const "bigstringaf_blit_from_bytes"))
-     (i31.new (i32.const 0)))
-
-  (func (export "bigstringaf_blit_to_bytes")
-     (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-     ;; ZZZ
-     (call $log_js (string.const "bigstringaf_blit_to_bytes"))
-     (i31.new (i32.const 0)))
-
-  (func (export "caml_unwrap_value_from_string")
-     (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-     ;; ZZZ
-     (call $log_js (string.const "caml_unwrap_value_from_string"))
-     (i31.new (i32.const 0)))
-)
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
new file mode 100644
index 0000000000..d4eb25ccec
--- /dev/null
+++ b/runtime/wasm/stdlib.wat
@@ -0,0 +1,29 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "caml_jsstring_of_string"
+      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+
+   (type $block (array (mut (ref eq))))
+
+   (func (export "caml_register_named_value")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_register_named_value"))
+      (call $log_js
+         (call $unwrap (call $caml_jsstring_of_string (local.get $0))))
+      (i31.new (i32.const 0)))
+
+   (global $caml_global_data (export "caml_global_data") (mut (ref $block))
+      (array.new $block (i31.new (i32.const 0)) (i32.const 12)))
+
+   (func (export "caml_register_global")
+      (param (ref eq)) (param $v (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local.set $i (i31.get_u (ref.cast i31 (local.get 0))))
+      (if (i32.lt_u (local.get $i) (array.len (global.get $caml_global_data)))
+         (then
+            (array.set $block (global.get $caml_global_data)
+               (local.get $i) (local.get $v))))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
new file mode 100644
index 0000000000..6035a02ba6
--- /dev/null
+++ b/runtime/wasm/string.wat
@@ -0,0 +1,343 @@
+(module
+   (import "fail" "caml_bound_error" (func $caml_bound_error))
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param $arg (ref eq))))
+   (import "int32" "caml_copy_int32"
+      (func $caml_copy_int32 (param i32) (result (ref eq))))
+   (import "int64" "caml_copy_int64"
+      (func $caml_copy_int64 (param i64) (result (ref eq))))
+
+   (type $string (array (mut i8)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+   (type $int32
+      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
+   (type $int64
+      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
+
+   (export "caml_bytes_equal" (func $caml_string_equal))
+   (func $caml_string_equal (export "caml_string_equal")
+      (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
+      (local $s1 (ref $string)) (local $s2 (ref $string))
+      (local $len i32) (local $i i32)
+      (if (ref.eq (local.get $p1) (local.get $p2))
+         (then (return (i31.new (i32.const 1)))))
+      (local.set $s1 (ref.cast $string (local.get $p1)))
+      (local.set $s2 (ref.cast $string (local.get $p2)))
+      (local.set $len (array.len $string (local.get $s1)))
+      (if (i32.ne (local.get $len) (array.len $string (local.get $s2)))
+         (then (return (i31.new (i32.const 0)))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (if (i32.ne (array.get_u $string (local.get $s1) (local.get $i))
+                           (array.get_u $string (local.get $s2) (local.get $i)))
+                  (then (return (i31.new (i32.const 0)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (i32.const 1)))
+
+   (export "caml_bytes_notequal" (func $caml_string_notequal))
+   (func $caml_string_notequal (export "caml_string_notequal")
+      (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
+      (return
+         (i31.new (i32.eqz (i31.get_u (ref.cast i31
+            (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
+
+   (func $string_compare
+      (param $p1 (ref eq)) (param $p2 (ref eq)) (result i32)
+      (local $s1 (ref $string)) (local $s2 (ref $string))
+      (local $l1 i32) (local $l2 i32) (local $len i32) (local $i i32)
+      (local $c1 i32) (local $c2 i32)
+      (if (ref.eq (local.get $p1) (local.get $p2))
+         (then (return (i32.const 0))))
+      (local.set $s1 (ref.cast $string (local.get $p1)))
+      (local.set $s2 (ref.cast $string (local.get $p2)))
+      (local.set $l1 (array.len $string (local.get $s1)))
+      (local.set $l2 (array.len $string (local.get $s2)))
+      (local.set $len (select (local.get $l1) (local.get $l2)
+                          (i32.le_u (local.get $l1) (local.get $l2))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $c1
+                  (array.get_u $string (local.get $s1) (local.get $i)))
+               (local.set $c2
+                  (array.get_u $string (local.get $s2) (local.get $i)))
+               (if (i32.lt_u (local.get $c1) (local.get $c2))
+                  (then (return (i32.const -1))))
+               (if (i32.gt_u (local.get $c1) (local.get $c2))
+                  (then (return (i32.const 1))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (if (i32.lt_u (local.get $l1) (local.get $l2))
+         (then (return (i32.const -1))))
+      (if (i32.gt_u (local.get $l1) (local.get $l2))
+         (then (return (i32.const 1))))
+      (i32.const 0))
+
+   (export "caml_bytes_compare" (func $caml_string_compare))
+   (func $caml_string_compare (export "caml_string_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (call $string_compare (local.get 0) (local.get 1))))
+
+   (export "caml_bytes_lessequal" (func $caml_string_lessequal))
+   (func $caml_string_lessequal (export "caml_string_lessequal")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.le_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
+   (export "caml_bytes_lessthan" (func $caml_string_lessthan))
+   (func $caml_string_lessthan (export "caml_string_lessthan")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.lt_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
+   (export "caml_bytes_greaterequal" (func $caml_string_greaterequal))
+   (func $caml_string_greaterequal (export "caml_string_greaterequal")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.ge_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
+   (export "caml_bytes_greaterthan" (func $caml_string_greaterthan))
+   (func $caml_string_greaterthan (export "caml_string_greaterthan")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.gt_s (call $string_compare (local.get 0) (local.get 1))
+                         (i32.const 0))))
+
+   (export "caml_bytes_of_string" (func $caml_string_of_bytes))
+   (func $caml_string_of_bytes (export "caml_string_of_bytes")
+      (param $v (ref eq)) (result (ref eq))
+      (local.get $v))
+
+   (data $Bytes_create "Bytes.create")
+
+   (func (export "caml_create_bytes")
+      (param $len (ref eq)) (result (ref eq))
+      (local $l i32)
+      (local.set $l (i31.get_u (ref.cast i31 (local.get $len))))
+      (if (i32.lt_s (local.get $l) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Bytes_create
+                               (i32.const 0) (i32.const 12)))))
+      (array.new $string (i32.const 0) (local.get $l)))
+
+   (export "caml_blit_bytes" (func $caml_blit_string))
+   (func $caml_blit_string (export "caml_blit_string")
+      (param $v1 (ref eq)) (param $i1 (ref eq))
+      (param $v2 (ref eq)) (param $i2 (ref eq))
+      (param $n (ref eq)) (result (ref eq))
+      (array.copy $string $string
+         (ref.cast $string (local.get $v2))
+         (i31.get_s (ref.cast i31 (local.get $i2)))
+         (ref.cast $string (local.get $v1))
+         (i31.get_s (ref.cast i31 (local.get $i1)))
+         (i31.get_s (ref.cast i31 (local.get $n))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_fill_bytes")
+      (param $v (ref eq)) (param $offset (ref eq))
+      (param $len (ref eq)) (param $init (ref eq))
+      (result (ref eq))
+(;ZZZ V8 bug
+      (array.fill $string (ref.cast $string (local.get $v))
+         (i31.get_u (ref.cast i31 (local.get $offset)))
+         (i31.get_u (ref.cast i31 (local.get $init)))
+         (i31.get_u (ref.cast i31 (local.get $len))))
+;)
+      (local $s (ref $string)) (local $i i32) (local $limit i32) (local $c i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get $offset))))
+      (local.set $limit
+         (i32.add (local.get $i) (i31.get_u (ref.cast i31 (local.get $len)))))
+      (local.set $c (i31.get_u (ref.cast i31 (local.get $init))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $limit))
+            (then
+               (array.set $string (local.get $s) (local.get $i) (local.get $c))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (i32.const 0)))
+
+   (export "caml_string_get16" (func $caml_bytes_get16))
+   (func $caml_bytes_get16 (export "caml_bytes_get16")
+      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (i31.new (i32.or
+                  (array.get_u $string (local.get $s) (local.get $p))
+                  (i32.shl (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 1)))
+                           (i32.const 8)))))
+
+   (export "caml_string_get32" (func $caml_bytes_get32))
+   (func $caml_bytes_get32 (export "caml_bytes_get32")
+      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (return_call $caml_copy_int32
+         (i32.or
+            (i32.or
+               (array.get_u $string (local.get $s) (local.get $p))
+               (i32.shl (array.get_u $string (local.get $s)
+                           (i32.add (local.get $p) (i32.const 1)))
+                        (i32.const 8)))
+            (i32.or
+               (i32.shl (array.get_u $string (local.get $s)
+                           (i32.add (local.get $p) (i32.const 2)))
+                        (i32.const 16))
+               (i32.shl (array.get_u $string (local.get $s)
+                           (i32.add (local.get $p) (i32.const 3)))
+                        (i32.const 24))))))
+
+   (export "caml_string_get64" (func $caml_bytes_get64))
+   (func $caml_bytes_get64 (export "caml_bytes_get64")
+      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (return_call $caml_copy_int64
+         (i64.or
+            (i64.or
+               (i64.or
+                  (i64.extend_i32_u
+                     (array.get_u $string (local.get $s) (local.get $p)))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 1))))
+                           (i64.const 8)))
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 2))))
+                           (i64.const 16))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 3))))
+                           (i64.const 24))))
+            (i64.or
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 4))))
+                           (i64.const 32))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 5))))
+                           (i64.const 40)))
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 6))))
+                           (i64.const 48))
+                  (i64.shl (i64.extend_i32_u
+                              (array.get_u $string (local.get $s)
+                                 (i32.add (local.get $p) (i32.const 7))))
+                           (i64.const 56)))))))
+
+   (func (export "caml_bytes_set16")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32) (local $v i32)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $v (i31.get_s (ref.cast i31 (local.get 2))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (array.set $string (local.get $s) (local.get $p) (local.get $v))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 1))
+         (i32.shr_u (local.get $v) (i32.const 8)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_bytes_set32")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32) (local $v i32)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $v (struct.get $int32 1 (ref.cast $int32 (local.get 2))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (array.set $string (local.get $s) (local.get $p) (local.get $v))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 1))
+         (i32.shr_u (local.get $v) (i32.const 8)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 2))
+         (i32.shr_u (local.get $v) (i32.const 16)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 3))
+         (i32.shr_u (local.get $v) (i32.const 24)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_bytes_set64")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $p i32) (local $v i64)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $v (struct.get $int64 1 (ref.cast $int64 (local.get 2))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+                    (array.len (local.get $s)))
+         (then (call $caml_bound_error)))
+      (array.set $string (local.get $s) (local.get $p)
+         (i32.wrap_i64 (local.get $v)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 1))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 8))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 2))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 16))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 3))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 24))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 4))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 32))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 5))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 40))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 6))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 48))))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $p) (i32.const 7))
+         (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 56))))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
new file mode 100644
index 0000000000..b4c09292b4
--- /dev/null
+++ b/runtime/wasm/sys.wat
@@ -0,0 +1,84 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "bindings" "ta_length"
+      (func $ta_length (param externref) (result i32)))
+   (import "bindings" "ta_get_i32"
+      (func $ta_get_i32 (param externref) (param i32) (result i32)))
+   (import "bindings" "random_seed" (func $random_seed (result externref)))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "caml_jsstring_of_string"
+      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+   (import "fail" "caml_raise_not_found" (func $caml_raise_not_found))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (tag $ocaml_exit (export "ocaml_exit") (param i32))
+
+   (func (export "caml_sys_exit") (param (ref eq)) (result (ref eq))
+      (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get 0)))))
+
+   (func (export "caml_sys_getenv")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_getenv"))
+      (call $log_js
+         (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
+      (call $caml_raise_not_found)
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_argv") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_argv"))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (array.new_fixed $string (i32.const 97))))
+
+   (export "caml_sys_time_include_children" (func $caml_sys_time))
+   (func $caml_sys_time (export "caml_sys_time")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_time"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_system_command")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_system_command"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_random_seed")
+      (param (ref eq)) (result (ref eq))
+      (local $r externref)
+      (local $a (ref $block))
+      (local $i i32) (local $n i32)
+      (local.set $r (call $random_seed))
+      (local.set $n (call $ta_length (local.get $r)))
+      (local.set $a
+         (array.new $block (i31.new (i32.const 0))
+            (i32.add (local.get $n) (i32.const 1))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $n))
+            (then
+               (array.set $block
+                  (local.get $a) (i32.add (local.get $i) (i32.const 1))
+                  (i31.new (call $ta_get_i32 (local.get $r) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $a))
+
+   (data $Unix "Unix")
+
+   (func (export "caml_sys_get_config")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_get_config"))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (array.new_data $string $Unix (i32.const 0) (i32.const 4))
+         (i31.new (i32.const 32))
+         (i31.new (i32.const 0))))
+
+   (func (export "caml_sys_isatty")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/toplevel.wat b/runtime/wasm/toplevel.wat
new file mode 100644
index 0000000000..b7f612afe9
--- /dev/null
+++ b/runtime/wasm/toplevel.wat
@@ -0,0 +1,5 @@
+(module
+   (func (export "caml_terminfo_rows")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
new file mode 100644
index 0000000000..aca44935d5
--- /dev/null
+++ b/runtime/wasm/unix.wat
@@ -0,0 +1,40 @@
+(module
+   (import "bindings" "gettimeofday" (func $gettimeofday (result f64)))
+   (import "bindings" "gmtime" (func $gmtime (result (ref eq))))
+   (import "bindings" "localtime" (func $localtime (result (ref eq))))
+
+   (type $block (array (mut (ref eq))))
+   (type $float (struct (field f64)))
+
+   (func (export "unix_gettimeofday")
+      (param (ref eq)) (result (ref eq))
+      (struct.new $float (call $gettimeofday)))
+
+   (func (export "caml_alloc_tm")
+      (param $sec i32) (param $min i32) (param $hour i32) (param $mday i32)
+      (param $mon i32) (param $year i32) (param $wday i32) (param $yday $i32)
+      (param $isdst i32) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (i31.new (local.get $sec))
+         (i31.new (local.get $min))
+         (i31.new (local.get $hour))
+         (i31.new (local.get $mday))
+         (i31.new (local.get $mon))
+         (i31.new (local.get $year))
+         (i31.new (local.get $wday))
+         (i31.new (local.get $yday))
+         (i31.new (local.get $isdst))))
+
+   (func (export "unix_gmtime") (param (ref eq)) (result (ref eq))
+      (call $gmtime))
+
+   (func (export "unix_localtime") (param (ref eq)) (result (ref eq))
+      (call $localtime))
+
+   (func (export "unix_time") (param (ref eq)) (result (ref eq))
+      (struct.new $float (f64.floor (call $gettimeofday))))
+
+   (func (export "unix_inet_addr_of_string")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
new file mode 100644
index 0000000000..17a42cb1dc
--- /dev/null
+++ b/runtime/wasm/weak.wat
@@ -0,0 +1,87 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "obj" "abstract_tag" (global $abstract_tag i32))
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param $arg (ref eq))))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (func (export "caml_ephe_create")
+      (param (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_create"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_get_data")
+      (param (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_get_data"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_set_data")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_set_data"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_set_key")
+      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_set_key"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ephe_unset_key")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_ephe_unset_key"))
+      (i31.new (i32.const 0)))
+
+   (global $caml_ephe_none (ref eq)
+      (array.new_fixed $block (i31.new (global.get $abstract_tag))))
+
+   (data $Weak_create "Weak.create")
+
+   (func (export "caml_weak_create")
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $len i32)
+      (local $res (ref $block))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (if (i32.lt_s (local.get $len) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Weak_create
+                  (i32.const 0) (i32.const 11)))))
+      (local.set $res
+         (array.new $block (global.get $caml_ephe_none)
+            (i32.add (local.get $len) (i32.const 3))))
+      (array.set $block (local.get $res) (i32.const 0)
+         (i31.new (global.get $abstract_tag)))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_create"))
+      (local.get $res))
+
+   (func (export "caml_weak_blit")
+      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_blit"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_weak_check")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_check"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_weak_get")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_get"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_weak_get_copy")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;;ZZZ
+      (call $log_js (string.const "caml_weak_get_copy"))
+      (i31.new (i32.const 0)))
+)

From ccb06c289920ce96d9d08f4abf6f17dc48106dc1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 25 May 2023 17:23:01 +0200
Subject: [PATCH 043/481] Output JavaScript loader script

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml |  2 +-
 compiler/bin-wasm_of_ocaml/compile.ml | 36 +++++++++++++++++++++++++--
 compiler/bin-wasm_of_ocaml/dune       |  3 ++-
 compiler/bin-wasm_of_ocaml/gen/gen.ml |  7 ++++--
 4 files changed, 42 insertions(+), 6 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index f2d507ed5b..c5552a8dc6 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -57,7 +57,7 @@ let options =
     let output_file =
       match output_file with
       | Some s -> s, true
-      | None -> chop_extension input_file ^ ".wasm", false
+      | None -> chop_extension input_file ^ ".js", false
     in
     let params : (string * string) list = List.flatten set_param in
     `Ok { common; params; profile; output_file; input_file }
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 962b7a6463..3ee5a5c2f0 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -84,12 +84,42 @@ let optimize in_file out_file =
 let link_and_optimize wat_file output_file =
   with_intermediate_file (Filename.temp_file "funtime" ".wasm")
   @@ fun runtime_file ->
-  write_file runtime_file Wa_runtime.runtime;
+  write_file runtime_file Wa_runtime.wasm_runtime;
   with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
   @@ fun temp_file ->
   link runtime_file wat_file temp_file;
   optimize temp_file output_file
 
+let escape_string s =
+  let l = String.length s in
+  let b = Buffer.create (String.length s + 2) in
+  for i = 0 to l - 1 do
+    let c = s.[i] in
+    match c with
+    (* https://github.com/ocsigen/js_of_ocaml/issues/898 *)
+    | '/' when i > 0 && Char.equal s.[i - 1] '<' -> Buffer.add_string b "\\/"
+    | '\000' .. '\031' | '\127' ->
+        Buffer.add_string b "\\x";
+        Buffer.add_char_hex b c
+    | '"' ->
+        Buffer.add_char b '\\';
+        Buffer.add_char b c
+    | c -> Buffer.add_char b c
+  done;
+  Buffer.contents b
+
+let copy_js_runtime wasm_file output_file =
+  let s = Wa_runtime.js_runtime in
+  let rec find i =
+    if String.equal (String.sub s ~pos:i ~len:4) "CODE" then i else find (i + 1)
+  in
+  let i = find 0 in
+  write_file
+    output_file
+    (String.sub s ~pos:0 ~len:i
+    ^ escape_string (Filename.basename wasm_file)
+    ^ String.sub s ~pos:(i + 4) ~len:(String.length s - i - 4))
+
 let run { Cmd_arg.common; profile; input_file; output_file; params } =
   Wa_generate.init ();
   Jsoo_cmdline.Arg.eval common;
@@ -150,8 +180,10 @@ let run { Cmd_arg.common; profile; input_file; output_file; params } =
        in
        if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
        let wat_file = Filename.chop_extension (fst output_file) ^ ".wat" in
+       let wasm_file = Filename.chop_extension (fst output_file) ^ ".wasm" in
        output_gen wat_file (output code ~standalone:true);
-       link_and_optimize wat_file (fst output_file)
+       link_and_optimize wat_file wasm_file;
+       copy_js_runtime wasm_file (fst output_file)
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());
   Debug.stop_profiling ()
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index 5730ecb106..ec2fe1adc9 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -24,7 +24,8 @@
  (target wa_runtime.ml)
  (deps
   gen/gen.exe
-  ../../runtime/wasm/runtime.wasm)
+  ../../runtime/wasm/runtime.wasm
+  ../../runtime/wasm/runtime.js)
  (action
   (with-stdout-to
    %{target}
diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml
index 3ccb2003af..e80c7df114 100644
--- a/compiler/bin-wasm_of_ocaml/gen/gen.ml
+++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml
@@ -3,5 +3,8 @@ let read_file ic = really_input_string ic (in_channel_length ic)
 let () =
   let () = set_binary_mode_out stdout true in
   Format.printf
-    "let runtime = \"%s\"@."
-    (String.escaped (read_file (open_in Sys.argv.(1))))
+    "let wasm_runtime = \"%s\"@."
+    (String.escaped (read_file (open_in Sys.argv.(1))));
+  Format.printf
+    "let js_runtime = \"%s\"@."
+    (String.escaped (read_file (open_in Sys.argv.(2))))

From 8ea4fc0c5e3790bc17944e89d88488db0114e418 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 25 May 2023 18:14:25 +0200
Subject: [PATCH 044/481] Perform deadcode elimination to remove unused runtime
 functions

---
 compiler/bin-wasm_of_ocaml/compile.ml | 22 ++++++++++++++++++++--
 compiler/bin-wasm_of_ocaml/dune       |  3 ++-
 compiler/bin-wasm_of_ocaml/gen/gen.ml |  5 ++++-
 3 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 3ee5a5c2f0..0d04732642 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -76,19 +76,37 @@ let link runtime_file input_file output_file =
       ; Filename.quote output_file
       ])
 
+let dead_code_elimination in_file out_file =
+  with_intermediate_file (Filename.temp_file "deps" ".json")
+  @@ fun deps_file ->
+  write_file deps_file Wa_runtime.dependencies;
+  command
+    (("wasm-metadce" :: common_binaryen_options)
+    @ [ "--graph-file"
+      ; Filename.quote deps_file
+      ; Filename.quote in_file
+      ; "-o"
+      ; Filename.quote out_file
+      ; ">"
+      ; "/dev/null"
+      ])
+
 let optimize in_file out_file =
   command
     (("wasm-opt" :: common_binaryen_options)
     @ [ "-O3"; "--gufa"; "-O3"; Filename.quote in_file; "-o"; Filename.quote out_file ])
 
 let link_and_optimize wat_file output_file =
-  with_intermediate_file (Filename.temp_file "funtime" ".wasm")
+  with_intermediate_file (Filename.temp_file "runtime" ".wasm")
   @@ fun runtime_file ->
   write_file runtime_file Wa_runtime.wasm_runtime;
   with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
   @@ fun temp_file ->
   link runtime_file wat_file temp_file;
-  optimize temp_file output_file
+  with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
+  @@ fun temp_file' ->
+  dead_code_elimination temp_file temp_file';
+  optimize temp_file' output_file
 
 let escape_string s =
   let l = String.length s in
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index ec2fe1adc9..4532beed0f 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -25,7 +25,8 @@
  (deps
   gen/gen.exe
   ../../runtime/wasm/runtime.wasm
-  ../../runtime/wasm/runtime.js)
+  ../../runtime/wasm/runtime.js
+  ../../runtime/wasm/deps.json)
  (action
   (with-stdout-to
    %{target}
diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml
index e80c7df114..7c841a192c 100644
--- a/compiler/bin-wasm_of_ocaml/gen/gen.ml
+++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml
@@ -7,4 +7,7 @@ let () =
     (String.escaped (read_file (open_in Sys.argv.(1))));
   Format.printf
     "let js_runtime = \"%s\"@."
-    (String.escaped (read_file (open_in Sys.argv.(2))))
+    (String.escaped (read_file (open_in Sys.argv.(2))));
+  Format.printf
+    "let dependencies = \"%s\"@."
+    (String.escaped (read_file (open_in Sys.argv.(3))))

From f05e27572e557ce7ef8ebc394cdd05179cb81700 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 26 May 2023 17:20:37 +0200
Subject: [PATCH 045/481] More runtime functions

---
 runtime/wasm/array.wat     | 40 ++++++++++++++--
 runtime/wasm/backtrace.wat |  7 +++
 runtime/wasm/deps.json     | 10 +++-
 runtime/wasm/domain.wat    | 69 +++++++++++++++++++++++----
 runtime/wasm/dune          |  2 +-
 runtime/wasm/gc.wat        | 98 ++++++++++++++++++++++++++++++++++++--
 runtime/wasm/hash.wat      | 43 +++++++++++++++--
 runtime/wasm/obj.wat       | 36 +++++++++++++-
 runtime/wasm/runtime.js    | 18 +++----
 9 files changed, 292 insertions(+), 31 deletions(-)

diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index 1b2853ad60..935e2b8c28 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -66,9 +66,43 @@
       (local.get $a))
 
    (func (export "caml_array_concat") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_array_concat"))
-      (unreachable))
+      ;; ZZZ float array
+      (local $i i32) (local $len i32)
+      (local $l (ref eq))
+      (local $a (ref $block)) (local $a' (ref $block)) (local $b (ref $block))
+      (local.set $l (local.get 0))
+      (local.set $len (i32.const 1))
+      (loop $compute_length
+         (drop (block $exit (result (ref eq))
+             (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
+             (local.set $len
+                (i32.add (local.get $len)
+                   (i32.sub
+                      (array.len
+                         (ref.cast $block
+                            (array.get $block (local.get $b) (i32.const 1))))
+                      (i32.const 1))))
+             (local.set $l (array.get $block (local.get $b) (i32.const 2)))
+             (br $compute_length))))
+      (local.set $a
+         (array.new $block (i31.new (i32.const 0)) (local.get $len)))
+      (local.set $i (i32.const 1))
+      (loop $fill
+         (drop (block $exit (result (ref eq))
+             (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
+             (local.set $a'
+                (ref.cast $block
+                   (array.get $block (local.get $b) (i32.const 1))))
+             (local.set $len
+                (i32.sub (array.len (local.get $a')) (i32.const 1)))
+             (array.copy $block $block
+                (local.get $a) (local.get $i)
+                (local.get $a') (i32.const 1)
+                (local.get $len))
+             (local.set $i (i32.add (local.get $i) (local.get $len)))
+             (local.set $l (array.get $block (local.get $b) (i32.const 2)))
+             (br $fill))))
+      (local.get $a))
 
    (export "caml_floatarray_blit" (func $caml_array_blit))
    (func $caml_array_blit (export "caml_array_blit")
diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat
index 9c6b80e01b..f7adf3e244 100644
--- a/runtime/wasm/backtrace.wat
+++ b/runtime/wasm/backtrace.wat
@@ -17,6 +17,10 @@
       (param (ref eq)) (result (ref eq))
       (array.new_fixed $block (i31.new (i32.const 0))))
 
+   (func (export "caml_raw_backtrace_next_slot")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
    (data $raw_backtrace_slot_err
       "Printexc.get_raw_backtrace_slot: index out of bounds")
 
@@ -42,4 +46,7 @@
    (func (export "caml_ml_debug_info_status")
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_record_backtrace") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
 )
diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 9c5826e118..621bdb9cba 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,13 +1,21 @@
 [
   {
     "name": "root",
-    "reaches": ["init"],
+    "reaches": ["init", "exn", "exit"],
     "root": true
   },
   {
     "name": "init",
     "export": "_initialize"
   },
+  {
+    "name": "exn",
+    "export": "ocaml_exception"
+  },
+  {
+    "name": "exit",
+    "export": "ocaml_exit"
+  },
   {
     "name": "callback",
     "export": "caml_callback"
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index 58f45f1ee7..b3e57b02ca 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -1,5 +1,9 @@
 (module
    (type $block (array (mut (ref eq))))
+   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (import "sync" "caml_ml_mutex_unlock"
+      (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
 
    (func (export "caml_atomic_cas")
       (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
@@ -19,15 +23,24 @@
       (array.get $block (ref.cast $block (local.get 0)) (i32.const 1)))
 
    (func (export "caml_atomic_fetch_add")
-     (param $ref (ref eq)) (param $i (ref eq)) (result (ref eq))
-     (local $b (ref $block))
-     (local $old (ref eq))
-     (local.set $b (ref.cast $block (local.get $ref)))
-     (local.set $old (array.get $block (local.get $b) (i32.const 1)))
-     (array.set $block (local.get $b) (i32.const 1)
-        (i31.new (i32.add (i31.get_s (ref.cast i31 (local.get $old)))
-                          (i31.get_s (ref.cast i31 (local.get $i))))))
-     (local.get $old))
+      (param $ref (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $b (ref $block))
+      (local $old (ref eq))
+      (local.set $b (ref.cast $block (local.get $ref)))
+      (local.set $old (array.get $block (local.get $b) (i32.const 1)))
+      (array.set $block (local.get $b) (i32.const 1)
+         (i31.new (i32.add (i31.get_s (ref.cast i31 (local.get $old)))
+                           (i31.get_s (ref.cast i31 (local.get $i))))))
+      (local.get $old))
+
+   (func (export "caml_atomic_exchange")
+      (param $ref (ref eq)) (param $v (ref eq)) (result (ref eq))
+      (local $b (ref $block))
+      (local $r (ref eq))
+      (local.set $b (ref.cast $block (local.get $ref)))
+      (local.set $r (array.get $block (local.get $b) (i32.const 1)))
+      (array.set $block (local.get $b) (i32.const 1) (local.get $v))
+      (local.get $r))
 
    (global $caml_domain_dls (mut (ref eq))
       (array.new_fixed $block (i31.new (i32.const 0))))
@@ -38,4 +51,42 @@
 
    (func (export "caml_domain_dls_get") (param (ref eq)) (result (ref eq))
       (global.get $caml_domain_dls))
+
+   (global $caml_ml_domain_unique_token (ref eq)
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_ml_domain_unique_token")
+      (param (ref eq)) (result (ref eq))
+      (global.get $caml_ml_domain_unique_token))
+
+   (func (export "caml_ml_domain_set_name")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_recommended_domain_count")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 1)))
+
+   (global $caml_domain_id (mut i32) (i32.const 0))
+   (global $caml_domain_latest_id (mut i32) (i32.const 1))
+
+   (func (export "caml_domain_spawn")
+      (param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq))
+      (local $id i32) (local $old i32)
+      (local.set $id (global.get $caml_domain_latest_id))
+      (global.set $caml_domain_latest_id
+         (i32.add (local.get $id) (i32.const 1)))
+      (local.set $old (global.get $caml_domain_id))
+      (drop (call_ref $function_1 (i31.new (i32.const 0))
+               (local.get $f)
+                  (struct.get $closure 0 (ref.cast $closure (local.get $f)))))
+      (global.set $caml_domain_id (local.get $old))
+      (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
+      (i31.new (local.get $id)))
+
+   (func (export "caml_ml_domain_id") (param (ref eq)) (result (ref eq))
+      (i31.new (global.get $caml_domain_id)))
+
+   (func (export "caml_ml_domain_cpu_relax") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
 )
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 19f2fc2f52..520fb664ec 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -5,7 +5,7 @@
 
 (rule
    (target runtime.wasm)
-   (deps args)
+   (deps args (glob_files *.wat))
    (action
       (pipe-stdout
          (run wasm-merge -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{read-lines:args} -o -)
diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat
index 67052962f6..44d48b1021 100644
--- a/runtime/wasm/gc.wat
+++ b/runtime/wasm/gc.wat
@@ -1,13 +1,103 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
 
-   (func (export "caml_gc_quick_stat")
+   (type $float (struct (field f64)))
+   (type $block (array (mut (ref eq))))
+
+   (func (export "caml_gc_minor") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_major") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_full_major") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_compaction") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_counters") (param (ref eq)) (result (ref eq))
+      (local $f (ref eq))
+      (local.set $f (struct.new $float (f64.const 0)))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (local.get $f) (local.get $f) (local.get $f)))
+
+   (export "caml_gc_quick_stat" (func $caml_gc_stat))
+   (func $caml_gc_stat (export "caml_gc_stat")
+      (param (ref eq)) (result (ref eq))
+      (local $f (ref eq))
+      (local.set $f (struct.new $float (f64.const 0)))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (local.get $f) (local.get $f) (local.get $f)
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))))
+
+   (func (export "caml_gc_set") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_get") (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))
+         (i31.new (i32.const 0)) (i31.new (i32.const 0))))
+
+   (func (export "caml_gc_huge_fallback_count")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_major_slice")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_major_bucket")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_major_credit")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_gc_minor_free")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_gc_quick_stat"))
       (i31.new (i32.const 0)))
 
+   (func (export "caml_gc_minor_words")
+      (param (ref eq)) (result (ref eq))
+      (struct.new $float (f64.const 0)))
+
    (func (export "caml_final_register")
-     (param (ref eq) (ref eq)) (result (ref eq))
+      (param (ref eq) (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_final_register_called_without_value")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ Use FinalizationRegistry?
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_final_release") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_memprof_start")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_memprof_set") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_memprof_stop") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_eventlog_pause") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_eventlog_resume") (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 )
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index 13095fee7f..ddbd0396ef 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -1,4 +1,7 @@
 (module
+   (import "obj" "object_tag" (global $object_tag i32))
+   (import "obj" "forward_tag" (global $forward_tag i32))
+
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
@@ -106,6 +109,7 @@
       (i32.xor (local.get $h) (local.get $len)))
 
    (global $HASH_QUEUE_SIZE i32 (i32.const 256))
+   (global $MAX_FORWARD_DEREFERENCE i32 (i32.const 1000))
 
    (global $caml_hash_queue (ref $block)
       (array.new $block (i31.new (i32.const 0)) (global.get $HASH_QUEUE_SIZE)))
@@ -158,7 +162,40 @@
                         (i31.get_u
                            (ref.cast i31
                               (array.get $block (local.get $b) (i32.const 0)))))
-                     ;; ZZZ Special tags (forward / object)
+                     (if (i32.eq (local.get $tag) (global.get $forward_tag))
+                        (then
+                           (local.set $i (i32.const 0))
+                           (loop $forward
+                              (local.set $v
+                                 (array.get $block
+                                    (local.get $b) (i32.const 1)))
+                              (drop (block $not_block' (result (ref eq))
+                                 (local.set $b
+                                    (br_on_cast_fail $not_block' $block
+                                       (local.get $v)))
+                                 (br_if $again
+                                    (i32.eqz
+                                       (ref.eq
+                                          (array.get $block (local.get $b)
+                                             (i32.const 0))
+                                          (i31.new (global.get $forward_tag)))))
+                                 (local.set $i
+                                    (i32.add (local.get $i) (i32.const 1)))
+                                 (br_if $loop
+                                    (i32.eq
+                                       (local.get $i)
+                                       (global.get $MAX_FORWARD_DEREFERENCE)))
+                                 (br $forward)))
+                              (br $again))))
+                     (if (i32.eqz (local.get $tag) (global.get $object_tag))
+                        (then
+                           (local.set $h
+                              (call $caml_hash_mix_int (local.get $h)
+                                 (i31.get_s
+                                    (ref.cast i31
+                                       (array.get $block
+                                          (local.get $b) (i32.const 2))))))
+                           (br $loop)))
                      (local.set $len (array.len (local.get $b)))
                      (local.set $h
                         (call $caml_hash_mix_int (local.get $h)
@@ -195,8 +232,8 @@
                                           (local.get $v))))))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
-                  ;; ZZZ other cases? (closures, javascript values)
-                  (unreachable)
+                  ;; closures are ignored
+                  ;; ZZZ javascript values
                   (br $loop)))))
       ;; clear the queue to avoid a memory leak
       (array.fill $block (global.get $caml_hash_queue)
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index acf4aca53d..b072353476 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -66,7 +66,7 @@
    (global $cont_tag i32 (i32.const 245))
    (global $lazy_tag i32 (i32.const 246))
    (global $closure_tag i32 (i32.const 247))
-   (global $object_tag i32 (i32.const 248))
+   (global $object_tag (export "object_tag") i32 (i32.const 248))
    (global $forward_tag (export "forward_tag") i32 (i32.const 250))
    (global $abstract_tag (export "abstract_tag") i32 (i32.const 251))
    (global $string_tag i32 (i32.const 252))
@@ -114,7 +114,8 @@
       ;; ZZZ float array
       (unreachable))
 
-   (func (export "caml_obj_dup") (param (ref eq)) (result (ref eq))
+   (func $caml_obj_dup (export "caml_obj_dup")
+      (param (ref eq)) (result (ref eq))
       ;; ZZZ Deal with non-block values?
       (local $orig (ref $block))
       (local $res (ref $block))
@@ -129,6 +130,14 @@
          (i32.sub (local.get $len) (i32.const 1)))
       (local.get $res))
 
+   (func (export "caml_obj_with_tag")
+      (param $tag (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $res (ref eq))
+      (local.set $res (call $caml_obj_dup (local.get 1)))
+      (array.set $block (ref.cast $block (local.get $res)) (i32.const 0)
+         (local.get $tag))
+      (local.get $res))
+
    (func (export "caml_obj_block")
       (param $tag (ref eq)) (param $size (ref eq)) (result (ref eq))
       (local $res (ref $block))
@@ -207,6 +216,26 @@
                (then (return (i31.new (i32.const 0)))))))
       (i31.new (i32.const 1)))
 
+   (func (export "caml_obj_compare_and_swap")
+      (param (ref eq)) (param (ref eq))
+      (param $old (ref eq)) (param $new (ref eq)) (result (ref eq))
+      (local $b (ref $block))
+      (local $i i32)
+      (local.set $b (ref.cast $block (local.get 0)))
+      (local.set $i
+         (i32.add (i31.get_u (ref.cast i31 (local.get 1))) (i32.const 1)))
+      (if (result (ref eq))
+          (ref.eq
+            (array.get $block (local.get $b) (local.get $i)) (local.get $old))
+         (then
+            (array.set $block (local.get $b) (local.get $i) (local.get $new))
+            (i31.new (i32.const 1)))
+         (else
+            (i31.new (i32.const 0)))))
+
+   (func (export "caml_obj_is_shared") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 1)))
+
    (func (export "caml_get_public_method")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       ;;ZZZ
@@ -228,4 +257,7 @@
       (local.set $id (global.get $caml_oo_last_id))
       (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
       (i31.new (local.get $id)))
+
+   (func (export "caml_obj_reachable_words") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 06ab083bc7..d170a1c349 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -169,15 +169,17 @@
     try {
         wasmModule.instance.exports._initialize()
     } catch (e) {
-        if (e instanceof WebAssembly.Exception &&
-            e.is(wasmModule.instance.exports.ocaml_exit))
-            process.exit(e.getArg(wasmModule.instance.exports.ocaml_exit, 0));
-        if (e instanceof WebAssembly.Exception &&
-            e.is(wasmModule.instance.exports.ocaml_exception)) {
+        if (e instanceof WebAssembly.Exception) {
+          const exit_tag = wasmModule.instance.exports.ocaml_exit;
+          if (exit_tag && e.is(exit_tag))
+            isNode && process.exit(e.getArg(exit_tag, 0));
+          const exn_tag = wasmModule.instance.exports.ocaml_exception;
+          if (exn_tag && e.is(exn_tag)) {
             console.log('Uncaught exception')
-            process.exit(1)
+            isNode && process.exit(1)
+          }
+        } else {
+            throw e;
         }
-        throw e;
     }
-
 })()

From b0bb725b665bdceb9926e2b283a7f71aeb324bd3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 1 Jun 2023 17:29:50 +0200
Subject: [PATCH 046/481] Runtime: format numbers

---
 runtime/wasm/float.wat    | 444 ++++++++++++++++++++++++++++++++++++++
 runtime/wasm/ieee_754.wat | 141 ------------
 runtime/wasm/int32.wat    |  14 +-
 runtime/wasm/int64.wat    | 129 ++++++++++-
 runtime/wasm/ints.wat     | 216 ++++++++++++++++++-
 runtime/wasm/runtime.js   |  58 ++++-
 6 files changed, 839 insertions(+), 163 deletions(-)
 create mode 100644 runtime/wasm/float.wat
 delete mode 100644 runtime/wasm/ieee_754.wat

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
new file mode 100644
index 0000000000..205d8cf575
--- /dev/null
+++ b/runtime/wasm/float.wat
@@ -0,0 +1,444 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_jsstring_of_string"
+      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+   (import "bindings" "format_float"
+      (func $format_float
+         (param i32) (param i32) (param f64) (result (ref string))))
+   (import "Math" "exp" (func $exp (param f64) (result f64)))
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
+   (import "ints" "lowercase_hex_table"
+      (global $lowercase_hex_table (ref $chars)))
+
+   (type $float (struct (field f64)))
+   (type $string (array (mut i8)))
+   (type $block (array (mut (ref eq))))
+
+   (type $chars (array i8))
+
+   (global $infinity (ref $chars)
+      (array.new_fixed $chars
+         (i32.const 105) (i32.const 110) (i32.const 102) (i32.const 105)
+         (i32.const 110) (i32.const 105) (i32.const 116) (i32.const 121)))
+
+   (global $nan (ref $chars)
+      (array.new_fixed $chars (i32.const 110) (i32.const 97) (i32.const 110)))
+
+   (func (export "caml_hexstring_of_float")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $b i64) (local $prec i32) (local $style i32)
+      (local $sign i32) (local $exp i32) (local $m i64)
+      (local $i i32) (local $j i32) (local $d i32) (local $txt (ref $chars))
+      (local $len i32) (local $s (ref $string))
+      (local $unit i64) (local $half i64) (local $mask i64) (local $frac i64)
+      (local.set $prec (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $style (i31.get_s (ref.cast i31 (local.get 2))))
+      (local.set $b
+         (i64.reinterpret_f64
+            (struct.get $float 0 (ref.cast $float (local.get 0)))))
+      (local.set $sign (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 63))))
+      (local.set $exp
+          (i32.and (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 52)))
+                   (i32.const 0x7FF)))
+      (local.set $m
+         (i64.and (local.get $b)
+            (i64.sub (i64.shl (i64.const 1) (i64.const 52)) (i64.const 1))))
+      (local.set $i
+         (i32.or (local.get $sign)
+            (i32.ne (local.get $style) (i32.const 45)))) ;; '-'
+      (local.set $s
+         (block $sign (result (ref $string))
+            (if (i32.eq (local.get $exp) (i32.const 0x7FF))
+               (then
+                  (local.set $txt
+                     (if (result (ref $chars)) (i64.eqz (local.get $m))
+                        (then
+                           (global.get $infinity))
+                        (else
+                           (local.set $sign (i32.const 0))
+                           (local.set $i
+                              (i32.ne (local.get $style) (i32.const 45)))
+                           (global.get $nan))))
+                  (local.set $len (array.len (local.get $txt)))
+                  (local.set $s
+                     (array.new $string (i32.const 0)
+                        (i32.add (local.get $i) (local.get $len))))
+                  (array.copy $string $chars
+                     (local.get $s) (local.get $i) (local.get $txt) (i32.const 0)
+                     (local.get $len))
+                  (br $sign (local.get $s))))
+            (if (i32.eqz (local.get $exp))
+               (then
+                  (if (i64.ne (local.get $m) (i64.const 0))
+                     (then (local.set $exp (i32.const -1022)))))
+               (else
+                  (local.set $exp (i32.sub (local.get $exp) (i32.const 1023)))
+                  (local.set $m
+                     (i64.or (local.get $m)
+                             (i64.shl (i64.const 1) (i64.const 52))))))
+            (if (i32.and (i32.ge_s (local.get $prec) (i32.const 0))
+                         (i32.lt_s (local.get $prec) (i32.const 13)))
+               (then
+                  (local.set $unit
+                     (i64.shl (i64.const 1)
+                        (i64.extend_i32_s
+                           (i32.sub (i32.const 52)
+                              (i32.shl (local.get $prec) (i32.const 2))))))
+                  (local.set $half
+                     (i64.shr_u (local.get $unit) (i64.const 1)))
+                  (local.set $mask (i64.sub (local.get $unit) (i64.const 1)))
+                  (local.set $frac (i64.and (local.get $m) (local.get $mask)))
+                  (local.set $m
+                     (i64.and (local.get $m)
+                        (i64.xor (i64.const -1) (local.get $mask))))
+                  (if (i32.or (i64.gt_u (local.get $frac) (local.get $half))
+                         (i32.and (i64.eq (local.get $frac) (local.get $half))
+                                  (i64.ne (i64.and (local.get $m)
+                                                   (local.get $unit))
+                                          (i64.const 0))))
+                     (then
+                        (local.set $m
+                           (i64.add (local.get $m) (local.get $unit)))))))
+         (local.set $frac (i64.shl (local.get $m) (i64.const 12)))
+         (local.set $j (i32.const 0))
+         (loop $prec
+            (if (i64.ne (local.get $frac) (i64.const 0))
+               (then
+                  (local.set $j (i32.add (local.get $j) (i32.const 1)))
+                  (local.set $frac (i64.shl (local.get $frac) (i64.const 4)))
+                  (br $prec))))
+         (if (i32.lt_s (local.get $prec) (local.get $j))
+            (then (local.set $prec (local.get $j))))
+         (if (i32.ge_s (local.get $exp) (i32.const 0))
+            (then (local.set $d (local.get $exp)))
+            (else (local.set $d (i32.sub (i32.const 0) (local.get $exp)))))
+         (local.set $j (i32.const 0))
+         (loop $count
+            (local.set $j (i32.add (local.get $j) (i32.const 1)))
+            (local.set $d (i32.div_u (local.get $d) (i32.const 10)))
+            (br_if $count (i32.ne (local.get $d) (i32.const 0))))
+         (local.set $len (i32.add (i32.add (local.get $i) (local.get $prec))
+                                  (i32.add (i32.const 6) (local.get $j))))
+         (if (i32.eqz (local.get $prec))
+            (then (local.set $len (i32.sub (local.get $len) (i32.const 1)))))
+         (local.set $s (array.new $string (i32.const 0) (local.get $len)))
+         (if (i32.ge_s (local.get $exp) (i32.const 0))
+            (then (local.set $d (local.get $exp)))
+            (else (local.set $d (i32.sub (i32.const 0) (local.get $exp)))))
+         (loop $write
+            (local.set $len (i32.sub (local.get $len) (i32.const 1)))
+            (array.set $string (local.get $s) (local.get $len)
+               (i32.add (i32.const 48)
+                  (i32.rem_u (local.get $d) (i32.const 10))))
+            (local.set $d (i32.div_u (local.get $d) (i32.const 10)))
+            (br_if $write (i32.ne (local.get $d) (i32.const 0))))
+         (array.set $string (local.get $s)
+            (i32.sub (local.get $len) (i32.const 1))
+            (select (i32.const 43) (i32.const 45)
+               (i32.ge_s (local.get $exp) (i32.const 0))))
+         (array.set $string (local.get $s) (local.get $i) (i32.const 48)) ;; '0'
+         (array.set $string (local.get $s) (i32.add (local.get $i) (i32.const 1))
+            (i32.const 120)) ;; 'x'
+         (array.set $string (local.get $s) (i32.add (local.get $i) (i32.const 2))
+            (i32.add
+               (i32.wrap_i64 (i64.shr_u (local.get $m) (i64.const 52)))
+               (i32.const 48))) ;; '0'
+         (local.set $i (i32.add (local.get $i) (i32.const 3)))
+         (if (i32.gt_s (local.get $prec) (i32.const 0))
+            (then
+               (array.set $string (local.get $s) (local.get $i)
+                  (i32.const 46)) ;; '.'
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (local.set $frac (i64.shl (local.get $m) (i64.const 12)))
+               (loop $write
+                  (array.set $string (local.get $s) (local.get $i)
+                     (array.get_u $chars (global.get $lowercase_hex_table)
+                        (i32.wrap_i64
+                           (i64.shr_u (local.get $frac) (i64.const 60)))))
+                  (local.set $frac (i64.shl (local.get $frac) (i64.const 4)))
+                  (local.set $prec (i32.sub (local.get $prec) (i32.const 1)))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (br_if $write (i32.gt_s (local.get $prec) (i32.const 0))))))
+         (array.set $string (local.get $s) (local.get $i) (i32.const 112))
+         (local.get $s)))
+      (if (local.get $sign)
+         (then
+            (array.set $string (local.get $s) (i32.const 0)
+               (i32.const 45))) ;; '-'
+         (else
+            (if (i32.ne (local.get $style) (i32.const 45)) ;; '-'
+               (then
+                  (array.set $string (local.get $s) (i32.const 0)
+                     (local.get $style))))))
+      (local.get $s))
+
+   (data $format_error "format_float: bad format")
+
+   (func $parse_format
+      (param $s (ref $string)) (result i32 i32 i32 i32)
+      (local $i i32) (local $len i32) (local $c i32)
+      (local $sign_style i32) (local $precision i32)
+      (local $conversion i32) (local $uppercase i32)
+      (local.set $len (array.len (local.get $s)))
+      (local.set $i (i32.const 1))
+      (block $return
+         (block $bad_format
+            (br_if $bad_format (i32.lt_u (local.get $len) (i32.const 2)))
+            (br_if $bad_format
+               (i32.ne (array.get $string (local.get $s) (i32.const 0))
+                       (i32.const 37))) ;; '%'
+            (local.set $c (array.get $string (local.get $s) (i32.const 1)))
+            (if (i32.eq (local.get $c) (i32.const 43)) ;; '+'
+               (then
+                  (local.set $sign_style (i32.const 1))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))))
+            (if (i32.eq (local.get $c) (i32.const 32)) ;; ' '
+               (then
+                  (local.set $sign_style (i32.const 2))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))))
+            (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
+            (br_if $bad_format
+               (i32.ne (array.get $string (local.get $s) (local.get $i))
+                       (i32.const 46))) ;; '.'
+            (loop $precision
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
+               (local.set $c
+                  (array.get $string (local.get $s) (local.get $i)))
+               (if (i32.and (i32.ge_u (local.get $c) (i32.const 48))  ;; '0'
+                            (i32.le_u (local.get $c) (i32.const 57))) ;; '9'
+                  (then
+                     (local.set $precision
+                        (i32.add (i32.mul (local.get $precision) (i32.const 10))
+                                 (i32.sub (local.get $c) (i32.const 48))))
+                     (br $precision))))
+            (br_if $bad_format
+              (i32.ne (i32.add (local.get $i) (i32.const 1)) (local.get $len)))
+            (local.set $uppercase (i32.lt_s (local.get $c) (i32.const 96)))
+            (local.set $conversion
+               (i32.sub
+                  (i32.and (local.get $c) (i32.const 0xdf))
+                  (i32.const 69))) ;; 'E'
+            (br_if $return (i32.le_u (local.get $conversion) (i32.const 2))))
+         (call $caml_invalid_argument
+            (array.new_data $string $format_error
+               (i32.const 0) (i32.const 22))))
+      (tuple.make
+         (local.get $sign_style)
+         (local.get $precision)
+         (local.get $conversion)
+         (local.get $uppercase)))
+
+   (global $inf (ref $chars)
+      (array.new_fixed $chars (i32.const 105) (i32.const 110) (i32.const 102)))
+
+   (func (export "caml_format_float")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $f f64) (local $b i64) (local $format (i32 i32 i32 i32))
+      (local $sign_style i32) (local $precision i32)
+      (local $conversion i32) (local $uppercase i32)
+      (local $negative i32)
+      (local $exp i32) (local $m i64)
+      (local $i i32) (local $len i32) (local $c i32)
+      (local $s (ref $string)) (local $txt (ref $chars))
+      (local $num (ref string))
+      (local.set $f (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (local.set $b (i64.reinterpret_f64 (local.get $f)))
+      (local.set $format (call $parse_format (ref.cast $string (local.get 0))))
+      (local.set $sign_style (tuple.extract 0 (local.get $format)))
+      (local.set $precision (tuple.extract 1 (local.get $format)))
+      (local.set $conversion (tuple.extract 2 (local.get $format)))
+      (local.set $uppercase (tuple.extract 3 (local.get $format)))
+      (local.set $negative
+         (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 63))))
+      (local.set $i
+         (i32.or (local.get $negative) (local.get $sign_style)))
+      (local.set $s
+         (block $sign (result (ref $string))
+            (local.set $exp
+                (i32.and (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 52)))
+                         (i32.const 0x7FF)))
+            (if (i32.eq (local.get $exp) (i32.const 0x7FF))
+               (then
+                  (local.set $m (i64.shl (local.get $b) (i64.const 12)))
+                  (local.set $txt
+                     (if (result (ref $chars)) (i64.eqz (local.get $m))
+                        (then
+                           (global.get $inf))
+                        (else
+                           (local.set $negative (i32.const 0))
+                           (local.set $i (local.get $sign_style))
+                           (global.get $nan))))
+                  (local.set $len (array.len (local.get $txt)))
+                  (local.set $s
+                     (array.new $string (i32.const 0)
+                        (i32.add (local.get $i) (local.get $len))))
+                  (array.copy $string $chars
+                     (local.get $s) (local.get $i) (local.get $txt) (i32.const 0)
+                     (local.get $len))
+                  (br $sign (local.get $s))))
+            (local.set $num
+               (call $format_float
+                  (local.get $precision) (local.get $conversion)
+                  (f64.abs (local.get $f))))
+            (local.set $len (string.measure_wtf8 wtf8 (local.get $num)))
+            (local.set $s
+               (array.new $string (i32.const 0)
+                  (i32.add (local.get $len) (local.get $i))))
+            (drop (string.encode_wtf8_array replace
+                     (local.get $num) (local.get $s) (local.get $i)))
+            (br $sign (local.get $s))))
+      (if (local.get $negative)
+         (then
+            (array.set $string (local.get $s) (i32.const 0)
+               (i32.const 45))) ;; '-'
+         (else
+            (if (local.get $sign_style)
+               (then
+                  (if (i32.eq (local.get $sign_style) (i32.const 1))
+                     (then
+                        (array.set $string (local.get $s) (i32.const 0)
+                           (i32.const 43))) ;; '+'
+                     (else
+                        (array.set $string (local.get $s) (i32.const 0)
+                           (i32.const 32)))))))) ;; ' '
+      (if (local.get $uppercase)
+         (then
+            (local.set $i (i32.const 0))
+            (local.set $len (array.len (local.get $s)))
+            (loop $uppercase
+               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (if (i32.and (i32.ge_u (local.get $c) (i32.const 97))   ;; 'a'
+                            (i32.le_u (local.get $c) (i32.const 122))) ;; 'z'
+                  (then
+                     (array.set $string (local.get $s) (local.get $i)
+                        (i32.sub (local.get $c) (i32.const 32)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br_if $uppercase (i32.lt_u (local.get $i) (local.get $len))))))
+      (local.get $s))
+
+   (func (export "caml_nextafter")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $y f64) (local $i i64) (local $j i64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
+      (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
+      (if (f64.eq (local.get $x) (local.get $y))
+         (then (return (local.get 1))))
+      (if (result (ref eq)) (f64.eq (local.get $x) (f64.const 0))
+         (then
+            (if (f64.ge (local.get $y) (f64.const 0))
+               (then (return (struct.new $float (f64.const 0x1p-1074))))
+               (else (return (struct.new $float (f64.const -0x1p-1074))))))
+         (else
+            (local.set $i (i64.reinterpret_f64 (local.get $x)))
+            (local.set $j (i64.reinterpret_f64 (local.get $y)))
+            (if (i32.and (i64.lt_s (local.get $i) (local.get $j))
+                         (i64.lt_u (local.get $i) (local.get $j)))
+               (then (local.set $i (i64.add (local.get $i) (i64.const 1))))
+               (else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
+            (return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
+
+
+   (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
+      (local $a f64)
+      (local.set $a
+         (f64.abs (struct.get $float 0 (ref.cast $float (local.get 0)))))
+      (i31.new
+         (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
+            (then
+               (if (result i32) (f64.lt (local.get $a) (f64.const infinity))
+                  (then (i32.const 0)) ;; normal
+                  (else (i32.const 3)))) ;; infinity
+            (else
+               (if (result i32) (f64.eq (local.get $a) (f64.const 0))
+                  (then (i32.const 2)) ;; zero
+                  (else
+                     (if (result i32) (f64.eq (local.get $a) (local.get $a))
+                        (then (i32.const 1)) ;; subnormal
+                        (else (i32.const 4))))))))) ;; nan
+
+   (func (export "caml_modf_float") (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $a f64) (local $i f64) (local $f f64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $a (f64.abs (local.get $x)))
+      (if (f64.ge (local.get $a) (f64.const 0))
+         (then
+            (if (f64.lt (local.get $a) (f64.const infinity))
+               (then ;; normal
+                  (local.set $i (f64.floor (local.get $a)))
+                  (local.set $f (f64.sub (local.get $a) (local.get $i)))
+                  (local.set $i (f64.copysign (local.get $i) (local.get $x)))
+                  (local.set $f (f64.copysign (local.get $f) (local.get $x))))
+               (else ;; infinity
+                  (local.set $i (local.get $x))
+                  (local.set $f (f64.copysign (f64.const 0) (local.get $x))))))
+         (else ;; zero or nan
+            (local.set $i (local.get $x))
+            (local.set $f (local.get $x))))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
+
+   (func (export "caml_ldexp")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $n i32)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $n (i31.get_s (ref.cast i31 (local.get 1))))
+      (if (i32.gt_s (local.get $n) (i32.const 1023))
+         (then
+            (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
+            (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
+            (if (i32.gt_s (local.get $n) (i32.const 1023))
+               (then
+                  ;; subnormal
+                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
+                  (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
+                  (if (i32.gt_s (local.get $n) (i32.const 1023))
+                     (then (local.set $n (i32.const 1023))))))
+         (else
+            (if (i32.lt_s (local.get $n) (i32.const -1022))
+               (then
+                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p-969)))
+                  (local.set $n (i32.add (local.get $n) (i32.const 969)))
+                  (if (i32.lt_s (local.get $n) (i32.const -1022))
+                     (then
+                        (local.set $x
+                           (f64.mul (local.get $x) (f64.const 0x1p-969)))
+                        (local.set $n (i32.add (local.get $n) (i32.const 969)))
+                        (if (i32.lt_s (local.get $n) (i32.const -1022))
+                           (then (local.set $n (i32.const -1022)))))))))))
+      (struct.new $float
+         (f64.mul (local.get $x)
+            (f64.reinterpret_i64
+               (i64.shl (i64.add (i64.extend_i32_s (local.get $n))
+                                 (i64.const 0x3ff))
+                        (i64.const 52))))))
+
+   (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_float_of_string"))
+      (unreachable))
+
+   (func (export "caml_float_compare")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $x f64) (local $y f64)
+      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (if (f64.eq (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const 0)))))
+      (if (f64.lt (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (if (f64.gt (local.get $x) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (if (f64.eq (local.get $x) (local.get $x))
+         (then (return (i31.new (i32.const 1)))))
+      (if (f64.eq (local.get $y) (local.get $y))
+         (then (return (i31.new (i32.const -1)))))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/ieee_754.wat b/runtime/wasm/ieee_754.wat
deleted file mode 100644
index 415c2cce23..0000000000
--- a/runtime/wasm/ieee_754.wat
+++ /dev/null
@@ -1,141 +0,0 @@
-(module
-   (import "bindings" "log" (func $log_js (param anyref)))
-   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
-   (import "jslib" "caml_string_of_jsstring"
-      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
-   (import "bindings" "format" (func $format_float (param f64) (result anyref)))
-
-   (type $float (struct (field f64)))
-   (type $string (array (mut i8)))
-   (type $block (array (mut (ref eq))))
-
-   (func (export "caml_hexstring_of_float")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (array.new_fixed $string (i32.const 64)))
-
-   (func (export "caml_nextafter")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $y f64) (local $i i64) (local $j i64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
-      (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
-      (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
-      (if (f64.eq (local.get $x) (local.get $y))
-         (then (return (local.get 1))))
-      (if (result (ref eq)) (f64.eq (local.get $x) (f64.const 0))
-         (then
-            (if (f64.ge (local.get $y) (f64.const 0))
-               (then (return (struct.new $float (f64.const 0x1p-1074))))
-               (else (return (struct.new $float (f64.const -0x1p-1074))))))
-         (else
-            (local.set $i (i64.reinterpret_f64 (local.get $x)))
-            (local.set $j (i64.reinterpret_f64 (local.get $y)))
-            (if (i32.and (i64.lt_s (local.get $i) (local.get $j))
-                         (i64.lt_u (local.get $i) (local.get $j)))
-               (then (local.set $i (i64.add (local.get $i) (i64.const 1))))
-               (else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
-            (return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
-
-
-   (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
-      (local $a f64)
-      (local.set $a
-         (f64.abs (struct.get $float 0 (ref.cast $float (local.get 0)))))
-      (i31.new
-         (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
-            (then
-               (if (result i32) (f64.lt (local.get $a) (f64.const infinity))
-                  (then (i32.const 0)) ;; normal
-                  (else (i32.const 3)))) ;; infinity
-            (else
-               (if (result i32) (f64.eq (local.get $a) (f64.const 0))
-                  (then (i32.const 2)) ;; zero
-                  (else
-                     (if (result i32) (f64.eq (local.get $a) (local.get $a))
-                        (then (i32.const 1)) ;; subnormal
-                        (else (i32.const 4))))))))) ;; nan
-
-   (func (export "caml_modf_float") (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $a f64) (local $i f64) (local $f f64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $a (f64.abs (local.get $x)))
-      (if (f64.ge (local.get $a) (f64.const 0))
-         (then
-            (if (f64.lt (local.get $a) (f64.const infinity))
-               (then ;; normal
-                  (local.set $i (f64.floor (local.get $a)))
-                  (local.set $f (f64.sub (local.get $a) (local.get $i)))
-                  (local.set $i (f64.copysign (local.get $i) (local.get $x)))
-                  (local.set $f (f64.copysign (local.get $f) (local.get $x))))
-               (else ;; infinity
-                  (local.set $i (local.get $x))
-                  (local.set $f (f64.copysign (f64.const 0) (local.get $x))))))
-         (else ;; zero or nan
-            (local.set $i (local.get $x))
-            (local.set $f (local.get $x))))
-      (array.new_fixed $block (i31.new (i32.const 0))
-         (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
-
-   (func (export "caml_ldexp")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $n i32)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $n (i31.get_s (ref.cast i31 (local.get 1))))
-      (if (i32.gt_s (local.get $n) (i32.const 1023))
-         (then
-            (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
-            (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
-            (if (i32.gt_s (local.get $n) (i32.const 1023))
-               (then
-                  ;; subnormal
-                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
-                  (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
-                  (if (i32.gt_s (local.get $n) (i32.const 1023))
-                     (then (local.set $n (i32.const 1023))))))
-         (else
-            (if (i32.lt_s (local.get $n) (i32.const -1022))
-               (then
-                  (local.set $x (f64.mul (local.get $x) (f64.const 0x1p-969)))
-                  (local.set $n (i32.add (local.get $n) (i32.const 969)))
-                  (if (i32.lt_s (local.get $n) (i32.const -1022))
-                     (then
-                        (local.set $x
-                           (f64.mul (local.get $x) (f64.const 0x1p-969)))
-                        (local.set $n (i32.add (local.get $n) (i32.const 969)))
-                        (if (i32.lt_s (local.get $n) (i32.const -1022))
-                           (then (local.set $n (i32.const -1022)))))))))))
-      (struct.new $float
-         (f64.mul (local.get $x)
-            (f64.reinterpret_i64
-               (i64.shl (i64.add (i64.extend_i32_s (local.get $n))
-                                 (i64.const 0x3ff))
-                        (i64.const 52))))))
-
-   (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_float_of_string"))
-      (unreachable))
-
-   (func (export "caml_float_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $y f64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
-      (if (f64.eq (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const 0)))))
-      (if (f64.lt (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (if (f64.gt (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (if (f64.eq (local.get $x) (local.get $x))
-         (then (return (i31.new (i32.const 1)))))
-      (if (f64.eq (local.get $y) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_format_float")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $caml_string_of_jsstring (call $wrap (call $format_float (struct.get $float 0 (ref.cast $float (local.get 1)))))))
-)
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 2a55cc709c..45b18b1095 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -1,8 +1,9 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
    (import "ints" "parse_int"
       (func $parse_int
          (param (ref eq)) (param i32) (param (ref $string)) (result i32)))
+   (import "ints" "format_int"
+      (func $format_int (param (ref eq)) (param i32) (result (ref eq))))
 
    (type $string (array (mut i8)))
    (type $value->value->int
@@ -95,10 +96,9 @@
          (call $parse_int
             (local.get $v) (i32.const 32) (global.get $NATIVEINT_ERRMSG))))
 
-   ;; ZZZ
-   (func $dummy_format_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (call $log_js (string.const "dummy_format_fun"))
-      (array.new_fixed $string (i32.const 64)))
-   (export "caml_int32_format" (func $dummy_format_fun))
-   (export "caml_nativeint_format" (func $dummy_format_fun))
+   (export "caml_nativeint_format" (func $caml_int32_format))
+   (func $caml_int32_format (export "caml_int32_format")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (return_call $format_int (local.get 0)
+         (struct.get $int32 1 (ref.cast $int32 (local.get 1)))))
 )
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 3f32c552af..bebf29fb31 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -4,6 +4,9 @@
       (func $parse_sign_and_base
          (param (ref $string)) (result i32 i32 i32 i32)))
    (import "ints" "parse_digit" (func $parse_digit (param i32) (result i32)))
+   (import "ints" "parse_int_format"
+      (func $parse_int_format
+         (param (ref $string)) (result i32 i32 i32 i32 i32)))
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
 
    (type $string (array (mut i8)))
@@ -138,9 +141,125 @@
       (call $log_js (string.const "caml_int64_create_lo_mi_hi"))
       (i31.new (i32.const 0)))
 
-   ;; ZZZ
-   (func $dummy_format_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (call $log_js (string.const "dummy_format_fun"))
-      (array.new_fixed $string (i32.const 64)))
-   (export "caml_int64_format" (func $dummy_format_fun))
+   (func $format_int64_default (param $d i64) (result (ref eq))
+      (local $s (ref $string))
+      (local $negative i32) (local $i i32) (local $n i64)
+      (if (i64.lt_s (local.get $d) (i64.const 0))
+         (then
+            (local.set $negative (i32.const 1))
+            (local.set $i (i32.const 1))
+            (local.set $d (i64.sub (i64.const 0) (local.get $d)))))
+      (local.set $n (local.get $d))
+      (loop $count
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (local.set $n (i64.div_u (local.get $n) (i64.const 10)))
+         (br_if $count (i64.ne (local.get $n) (i64.const 0))))
+      (local.set $s (array.new $string (i32.const 0) (local.get $i)))
+      (loop $write
+         (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+         (array.set $string (local.get $s) (local.get $i)
+            (i32.add (i32.const 48)
+               (i32.wrap_i64 (i64.rem_u (local.get $d) (i64.const 10)))))
+         (local.set $d (i64.div_u (local.get $d) (i64.const 10)))
+         (br_if $write (i64.ne (local.get $d) (i64.const 0))))
+      (if (local.get $negative)
+         (then
+            (array.set $string (local.get $s) (i32.const 0)
+               (i32.const 45)))) ;; '-'
+      (local.get $s))
+
+   (type $chars (array i8))
+
+   (import "ints" "lowercase_hex_table"
+      (global $lowercase_hex_table (ref $chars)))
+
+   (import "ints" "uppercase_hex_table"
+      (global $uppercase_hex_table (ref $chars)))
+
+   (func (export "caml_int64_format")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $d i64)
+      (local $s (ref $string))
+      (local $format (i32 i32 i32 i32 i32))
+      (local $sign_style i32) (local $alternate i32) (local $signed i32)
+      (local $base i64) (local $uppercase i32)
+      (local $negative i32)
+      (local $i i32)
+      (local $n i64)
+      (local $chars (ref $chars))
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $d (struct.get $int64 1 (ref.cast $int64 (local.get 1))))
+      (if (i32.eq (array.len (local.get $s)) (i32.const 2))
+         (then
+            (if (i32.eq (array.get $string (local.get $s) (i32.const 1))
+                        (i32.const 100)) ;; 'd'
+               (then (return_call $format_int64_default (local.get $d))))))
+      (local.set $format (call $parse_int_format (local.get $s)))
+      (local.set $sign_style (tuple.extract 0 (local.get $format)))
+      (local.set $alternate (tuple.extract 1 (local.get $format)))
+      (local.set $signed (tuple.extract 2 (local.get $format)))
+      (local.set $base (i64.extend_i32_u (tuple.extract 3 (local.get $format))))
+      (local.set $uppercase (tuple.extract 4 (local.get $format)))
+      (if (i32.and (local.get $signed) (i64.lt_s (local.get $d) (i64.const 0)))
+         (then
+            (local.set $negative (i32.const 1))
+            (local.set $d (i64.sub (i64.const 0) (local.get $d)))))
+      (local.set $n (local.get $d))
+      (loop $count
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (local.set $n (i64.div_u (local.get $n) (local.get $base)))
+         (br_if $count (i64.ne (local.get $n) (i64.const 0))))
+      (if (i32.or (local.get $negative)
+                  (local.get $sign_style))
+         (then (local.set $i (i32.add (local.get $i) (i32.const 1)))))
+      (if (local.get $alternate)
+         (then
+            (if (i64.ne (local.get $d) (i64.const 0))
+               (then
+                  (if (i64.eq (local.get $base) (i64.const 16))
+                     (then
+                        (local.set $i (i32.add (local.get $i) (i32.const 2)))))
+                  (if (i64.eq (local.get $base) (i64.const 8))
+                     (then
+                        (local.set $i
+                           (i32.add (local.get $i) (i32.const 1)))))))))
+      (local.set $chars
+         (select (result (ref $chars))
+            (global.get $uppercase_hex_table)
+            (global.get $lowercase_hex_table)
+            (local.get $uppercase)))
+      (local.set $s (array.new $string (i32.const 0) (local.get $i)))
+      (loop $write
+         (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+         (array.set $string (local.get $s) (local.get $i)
+            (array.get_u $chars (local.get $chars)
+               (i32.wrap_i64 (i64.rem_u (local.get $d) (local.get $base)))))
+         (local.set $d (i64.div_u (local.get $d) (local.get $base)))
+         (br_if $write (i64.ne (local.get $d) (i64.const 0))))
+      (if (local.get $negative)
+         (then
+            (array.set $string (local.get $s) (i32.const 0)
+               (i32.const 45))) ;; '-'
+         (else
+            (if (local.get $sign_style)
+               (then
+                  (if (i32.eq (local.get $sign_style) (i32.const 1))
+                     (then
+                        (array.set $string (local.get $s) (i32.const 0)
+                           (i32.const 43))) ;; '+'
+                     (else
+                        (array.set $string (local.get $s) (i32.const 0)
+                           (i32.const 32)))))))) ;; ' '
+      (if (local.get $alternate)
+         (then
+            (if (i32.ne (local.get $i) (i32.const 0))
+               (then
+                  (array.set $string (local.get $s) (i32.const 0)
+                     (i32.const 48)) ;; '0'
+                  (if (i64.eq (local.get $base) (i64.const 16))
+                     (then
+                        (array.set $string (local.get $s) (i32.const 1)
+                           (i32.const 120)))))))) ;; 'x'
+      (local.get $s))
+
 )
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index 0aad2ecace..55805c6a46 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -1,15 +1,14 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
-   (import "jslib" "caml_string_of_jsstring"
-      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
-   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
-   (import "bindings" "format" (func $format_int (param (ref eq)) (result anyref)))
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
 
    (type $string (array (mut i8)))
 
-   (func (export "caml_format_int") (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 1)))))
+   (func (export "caml_format_int")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (return_call $format_int
+         (local.get 0) (i31.get_s (ref.cast i31 (local.get 1)))))
 
    (func $parse_sign_and_base (export "parse_sign_and_base")
       (param $s (ref $string)) (result i32 i32 i32 i32)
@@ -159,6 +158,205 @@
                (i32.const 8)))))
 
    (func (export "%caml_format_int_special") (param (ref eq)) (result (ref eq))
-      (call $log_js (string.const "%caml_format_int_special"))
-      (call $caml_string_of_jsstring (call $wrap (call $format_int (local.get 0)))))
+      (return_call $format_int_default
+         (i31.get_s (ref.cast i31 (local.get 0)))))
+
+   (type $chars (array i8))
+
+   (global $lowercase_hex_table (export "lowercase_hex_table") (ref $chars)
+      (array.new_fixed $chars
+         (i32.const 48) (i32.const 49) (i32.const 50) (i32.const 51)
+         (i32.const 52) (i32.const 53) (i32.const 54) (i32.const 55)
+         (i32.const 56) (i32.const 57) (i32.const 97) (i32.const 98)
+         (i32.const 99) (i32.const 100) (i32.const 101) (i32.const 102)))
+
+   (global $uppercase_hex_table (export "uppercase_hex_table") (ref $chars)
+      (array.new_fixed $chars
+         (i32.const 48) (i32.const 49) (i32.const 50) (i32.const 51)
+         (i32.const 52) (i32.const 53) (i32.const 54) (i32.const 55)
+         (i32.const 56) (i32.const 57) (i32.const 65) (i32.const 66)
+         (i32.const 67) (i32.const 68) (i32.const 69) (i32.const 70)))
+
+   (func $format_int_default (param $d i32) (result (ref eq))
+      (local $s (ref $string))
+      (local $negative i32) (local $i i32) (local $n i32)
+      (if (i32.lt_s (local.get $d) (i32.const 0))
+         (then
+            (local.set $negative (i32.const 1))
+            (local.set $i (i32.const 1))
+            (local.set $d (i32.sub (i32.const 0) (local.get $d)))))
+      (local.set $n (local.get $d))
+      (loop $count
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (local.set $n (i32.div_u (local.get $n) (i32.const 10)))
+         (br_if $count (i32.ne (local.get $n) (i32.const 0))))
+      (local.set $s (array.new $string (i32.const 0) (local.get $i)))
+      (loop $write
+         (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+         (array.set $string (local.get $s) (local.get $i)
+            (i32.add (i32.const 48)
+               (i32.rem_u (local.get $d) (i32.const 10))))
+         (local.set $d (i32.div_u (local.get $d) (i32.const 10)))
+         (br_if $write (i32.ne (local.get $d) (i32.const 0))))
+      (if (local.get $negative)
+         (then
+            (array.set $string (local.get $s) (i32.const 0)
+               (i32.const 45)))) ;; '-'
+      (local.get $s))
+
+   (data $format_error "format_int: bad format")
+
+   (func $parse_int_format (export "parse_int_format")
+      (param $s (ref $string)) (result i32 i32 i32 i32 i32)
+      (local $i i32) (local $len i32) (local $c i32)
+      (local $sign_style i32) (local $alternate i32) (local $base i32)
+      (local $signed i32) (local $uppercase i32)
+      (local.set $len (array.len (local.get $s)))
+      (local.set $i (i32.const 1))
+      (block $return
+         (block $bad_format
+            (br_if $bad_format (i32.lt_u (local.get $len) (i32.const 2)))
+            (br_if $bad_format
+               (i32.ne (array.get $string (local.get $s) (i32.const 0))
+                       (i32.const 37))) ;; '%'
+            (local.set $c (array.get $string (local.get $s) (i32.const 1)))
+            (if (i32.eq (local.get $c) (i32.const 43)) ;; '+'
+               (then
+                  (local.set $sign_style (i32.const 1))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))))
+            (if (i32.eq (local.get $c) (i32.const 32)) ;; ' '
+               (then
+                  (local.set $sign_style (i32.const 2))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))))
+            (if (i32.eq (local.get $c) (i32.const 35)) ;; '#'
+               (then
+                  (local.set $alternate (i32.const 1))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))))
+            (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
+            (local.set $c (array.get $string (local.get $s) (local.get $i)))
+            (if (i32.or (i32.or (i32.eq (local.get $c) (i32.const 76)) ;; 'L'
+                                (i32.eq (local.get $c) (i32.const 108))) ;; 'l'
+                        (i32.eq (local.get $c) (i32.const 110))) ;; 'n'
+               (then
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
+                  (local.set $c
+                     (array.get $string (local.get $s) (local.get $i)))))
+            (br_if $bad_format
+              (i32.ne (i32.add (local.get $i) (i32.const 1)) (local.get $len)))
+            (if (i32.or (i32.eq (local.get $c) (i32.const 100)) ;; 'd'
+                        (i32.eq (local.get $c) (i32.const 105))) ;; 'i'
+               (then
+                  (local.set $base (i32.const 10))
+                  (local.set $signed (i32.const 1)))
+            (else (if (i32.eq (local.get $c) (i32.const 117)) ;; 'u'
+               (then
+                  (local.set $base (i32.const 10)))
+            (else (if (i32.eq (local.get $c) (i32.const 120)) ;; 'x'
+               (then
+                  (local.set $base (i32.const 16)))
+            (else (if (i32.eq (local.get $c) (i32.const 88)) ;; 'X'
+               (then
+                  (local.set $base (i32.const 16))
+                  (local.set $uppercase (i32.const 1)))
+            (else (if (i32.eq (local.get $c) (i32.const 111)) ;; 'o'
+               (then
+                  (local.set $base (i32.const 8)))
+            (else
+               (br $bad_format)))))))))))
+            (br $return))
+         (call $caml_invalid_argument
+            (array.new_data $string $format_error
+               (i32.const 0) (i32.const 22))))
+      (tuple.make
+         (local.get $sign_style)
+         (local.get $alternate)
+         (local.get $signed)
+         (local.get $base)
+         (local.get $uppercase)))
+
+   (func $format_int (export "format_int")
+      (param (ref eq)) (param $d i32) (result (ref eq))
+      (local $s (ref $string))
+      (local $format (i32 i32 i32 i32 i32))
+      (local $sign_style i32) (local $alternate i32) (local $signed i32)
+      (local $base i32) (local $uppercase i32)
+      (local $negative i32)
+      (local $i i32)
+      (local $n i32)
+      (local $chars (ref $chars))
+      (local.set $s (ref.cast $string (local.get 0)))
+      (if (i32.eq (array.len (local.get $s)) (i32.const 2))
+         (then
+            (if (i32.eq (array.get $string (local.get $s) (i32.const 1))
+                        (i32.const 100)) ;; 'd'
+               (then (return_call $format_int_default (local.get $d))))))
+      (local.set $format (call $parse_int_format (local.get $s)))
+      (local.set $sign_style (tuple.extract 0 (local.get $format)))
+      (local.set $alternate (tuple.extract 1 (local.get $format)))
+      (local.set $signed (tuple.extract 2 (local.get $format)))
+      (local.set $base (tuple.extract 3 (local.get $format)))
+      (local.set $uppercase (tuple.extract 4 (local.get $format)))
+      (if (i32.and (local.get $signed) (i32.lt_s (local.get $d) (i32.const 0)))
+         (then
+            (local.set $negative (i32.const 1))
+            (local.set $d (i32.sub (i32.const 0) (local.get $d)))))
+      (local.set $n (local.get $d))
+      (loop $count
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (local.set $n (i32.div_u (local.get $n) (local.get $base)))
+         (br_if $count (i32.ne (local.get $n) (i32.const 0))))
+      (if (i32.or (local.get $negative)
+                  (local.get $sign_style))
+         (then (local.set $i (i32.add (local.get $i) (i32.const 1)))))
+      (if (local.get $alternate)
+         (then
+            (if (i32.ne (local.get $d) (i32.const 0))
+               (then
+                  (if (i32.eq (local.get $base) (i32.const 16))
+                     (then
+                        (local.set $i (i32.add (local.get $i) (i32.const 2)))))
+                  (if (i32.eq (local.get $base) (i32.const 8))
+                     (then
+                        (local.set $i
+                           (i32.add (local.get $i) (i32.const 1)))))))))
+      (local.set $chars
+         (select (result (ref $chars))
+            (global.get $uppercase_hex_table)
+            (global.get $lowercase_hex_table)
+            (local.get $uppercase)))
+      (local.set $s (array.new $string (i32.const 0) (local.get $i)))
+      (loop $write
+         (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+         (array.set $string (local.get $s) (local.get $i)
+            (array.get_u $chars (local.get $chars)
+               (i32.rem_u (local.get $d) (local.get $base))))
+         (local.set $d (i32.div_u (local.get $d) (local.get $base)))
+         (br_if $write (i32.ne (local.get $d) (i32.const 0))))
+      (if (local.get $negative)
+         (then
+            (array.set $string (local.get $s) (i32.const 0)
+               (i32.const 45))) ;; '-'
+         (else
+            (if (local.get $sign_style)
+               (then
+                  (if (i32.eq (local.get $sign_style) (i32.const 1))
+                     (then
+                        (array.set $string (local.get $s) (i32.const 0)
+                           (i32.const 43))) ;; '+'
+                     (else
+                        (array.set $string (local.get $s) (i32.const 0)
+                           (i32.const 32)))))))) ;; ' '
+      (if (local.get $alternate)
+         (then
+            (if (i32.ne (local.get $i) (i32.const 0))
+               (then
+                  (array.set $string (local.get $s) (i32.const 0)
+                     (i32.const 48)) ;; '0'
+                  (if (i32.eq (local.get $base) (i32.const 16))
+                     (then
+                        (array.set $string (local.get $s) (i32.const 1)
+                           (select (i32.const 88) (i32.const 120) ;; 'X' 'x'
+                              (local.get $uppercase)))))))))
+      (local.get $s))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index d170a1c349..e9c6fe34f3 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -127,7 +127,63 @@
              return caml_callback(f, args.length, args, 2);
          },
          wrap_fun_arguments:(f)=>function(){return f(arguments)},
-         format:(f)=>""+f,
+         format_float:(prec, conversion, x)=>{
+           function toFixed(x,dp) {
+             if (Math.abs(x) < 1.0) {
+               return x.toFixed(dp);
+             } else {
+               var e = parseInt(x.toString().split('+')[1]);
+               if (e > 20) {
+                 e -= 20;
+                 x /= Math.pow(10,e);
+                 x += (new Array(e+1)).join('0');
+                 if(dp > 0) {
+                   x = x + '.' + (new Array(dp+1)).join('0');
+                 }
+                 return x;
+               }
+               else return x.toFixed(dp)
+             }
+           }
+           switch (conversion) {
+           case 0:
+             var s = x.toExponential(prec);
+             // exponent should be at least two digits
+             var i = s.length;
+             if (s.charAt(i - 3) == 'e')
+               s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
+             break;
+           case 1:
+             s = toFixed(x, prec); break;
+           case 2:
+             prec = prec?prec:1;
+             s = x.toExponential(prec - 1);
+             var j = s.indexOf('e');
+             var exp = +s.slice(j + 1);
+             if (exp < -4 || x >= 1e21 || x.toFixed(0).length > prec) {
+               // remove trailing zeroes
+               var i = j - 1; while (s.charAt(i) == '0') i--;
+               if (s.charAt(i) == '.') i--;
+               s = s.slice(0, i + 1) + s.slice(j);
+               i = s.length;
+               if (s.charAt(i - 3) == 'e')
+                 s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
+               break;
+             } else {
+               var p = prec;
+               if (exp < 0) { p -= exp + 1; s = x.toFixed(p); }
+               else while (s = x.toFixed(p), s.length > prec + 1) p--;
+               if (p) {
+                 // remove trailing zeroes
+                 var i = s.length - 1; while (s.charAt(i) == '0') i--;
+                 if (s.charAt(i) == '.') i--;
+                 s = s.slice(0, i + 1);
+               }
+             }
+             break;
+           }
+           return s
+         },
          gettimeofday:()=>(new Date()).getTime() / 1000,
          gmtime:(t)=>{
            var d = new Date (t * 1000);

From 4dc56472dee6b747956020b50c86f81627d780d7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 1 Jun 2023 17:31:30 +0200
Subject: [PATCH 047/481] More runtime functions

---
 runtime/wasm/array.wat    |   1 -
 runtime/wasm/bigarray.wat |   4 +-
 runtime/wasm/float.wat    | 120 ++++++++++++++++++++++++++++++++++----
 runtime/wasm/fs.wat       |  16 -----
 runtime/wasm/hash.wat     |  11 ++++
 runtime/wasm/obj.wat      |  39 +++++++++++--
 runtime/wasm/stdlib.wat   |  74 ++++++++++++++++++++---
 runtime/wasm/sync.wat     |  75 ++++++++++++++++++++++++
 runtime/wasm/sys.wat      |  66 ++++++++++++++++++++-
 runtime/wasm/unix.wat     |   2 +-
 10 files changed, 363 insertions(+), 45 deletions(-)
 create mode 100644 runtime/wasm/sync.wat

diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index 935e2b8c28..d3a5fecdf4 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -1,7 +1,6 @@
 (module
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
-   (import "bindings" "log" (func $log_js (param anyref)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 529b5c6c0a..63761063e5 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -208,7 +208,7 @@
    (func (export "caml_ba_to_typed_array") (param (ref eq)) (result (ref eq))
       (call $wrap
          (extern.internalize
-            (struct.get $bigarray 1 (ref.cast $bigarray (local.get $0))))))
+            (struct.get $bigarray 1 (ref.cast $bigarray (local.get 0))))))
 
    (func $caml_ba_get_at_offset
       (param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
@@ -368,7 +368,7 @@
       (local $i i32)
       (local.set $dim
          (struct.get $bigarray 2 (ref.cast $bigarray (local.get 0))))
-      (local.set $i (i31.get_s (ref.cast i31 (local.get $1))))
+      (local.set $i (i31.get_s (ref.cast i31 (local.get 1))))
       (if (i32.ge_u (local.get $i) (array.len (local.get $dim)))
          (then (call $caml_invalid_argument
                   (array.new_data $string $Bigarray_dim
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 205d8cf575..d2b963d7ba 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -345,7 +345,6 @@
                (else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
             (return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
 
-
    (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
       (local $a f64)
       (local.set $a
@@ -420,6 +419,108 @@
                                  (i64.const 0x3ff))
                         (i64.const 52))))))
 
+   (func $frexp (param $x f64) (result f64 i32)
+      (local $y i64)
+      (local $e i32)
+      (local $r (f64 i32))
+      (local.set $y (i64.reinterpret_f64 (local.get $x)))
+      (local.set $e
+         (i32.and (i32.const 0x7ff)
+            (i32.wrap_i64 (i64.shr_u (local.get $y) (i64.const 52)))))
+      (if (i32.eqz (local.get $e))
+         (then
+            (if (f64.ne (local.get $x) (f64.const 0))
+               (then
+                  (local.set $r
+                     (call $frexp (f64.mul (local.get $x) (f64.const 0x1p64))))
+                  (return
+                     (tuple.make (tuple.extract 0 (local.get $r))
+                        (i32.sub (tuple.extract 1 (local.get $r))
+                           (i32.const 64)))))
+               (else
+                  (return (tuple.make (local.get $x) (i32.const 0))))))
+         (else
+            (if (i32.eq (local.get $e) (i32.const 0x7ff))
+               (then
+                  (return (tuple.make (local.get $x) (i32.const 0)))))))
+      (tuple.make
+         (f64.reinterpret_i64
+            (i64.or (i64.and (local.get $y) (i64.const 0x800fffffffffffff))
+               (i64.const 0x3fe0000000000000)))
+         (i32.sub (local.get $e) (i32.const 0x3fe))))
+
+   (func (export "caml_frexp_float") (param (ref eq)) (result (ref eq))
+      (local $r (f64 i32))
+      (local.set $r
+         (call $frexp (struct.get $float 0 (ref.cast $float (local.get 0)))))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (struct.new $float (tuple.extract 0 (local.get $r)))
+         (i31.new (tuple.extract 1 (local.get $r)))))
+
+   (func (export "caml_signbit_float") (param (ref eq)) (result (ref eq))
+      (i31.new
+         (i32.wrap_i64
+            (i64.shr_u
+               (i64.reinterpret_f64
+                  (struct.get $float 0 (ref.cast $float (local.get 0))))
+               (i64.const 63)))))
+
+   (func $erf (param $x f64) (result f64)
+      (local $a1 f64) (local $a2 f64) (local $a3 f64)
+      (local $a4 f64) (local $a5 f64) (local $p f64)
+      (local $t f64) (local $y f64)
+      (local.set $a1 (f64.const 0.254829592))
+      (local.set $a2 (f64.const -0.284496736))
+      (local.set $a3 (f64.const 1.421413741))
+      (local.set $a4 (f64.const -1.453152027))
+      (local.set $a5 (f64.const 1.061405429))
+      (local.set $p (f64.const 0.3275911))
+      (local.set $t
+         (f64.div (f64.const 1)
+            (f64.add (f64.const 1)
+               (f64.mul (local.get $p) (f64.abs (local.get $x))))))
+      (local.set $y
+          (f64.sub (f64.const 1)
+             (f64.mul
+                (f64.add
+                   (f64.mul
+                      (f64.add
+                         (f64.mul
+                            (f64.add
+                               (f64.mul
+                                  (f64.add
+                                     (f64.mul (local.get $a5) (local.get $t))
+                                        (local.get $a4))
+                                  (local.get $t))
+                               (local.get $a3))
+                            (local.get $t))
+                         (local.get $a2))
+                      (local.get $t))
+                   (local.get $a1))
+                (f64.mul (local.get $t)
+                   (call $exp
+                      (f64.neg (f64.mul (local.get $x) (local.get $x))))))))
+      (f64.copysign (local.get $y) (local.get $x)))
+
+   (func (export "caml_erf_float") (param (ref eq)) (result (ref eq))
+      (struct.new $float
+         (call $erf (struct.get $float 0 (ref.cast $float (local.get 0))))))
+
+   (func (export "caml_erfc_float") (param (ref eq)) (result (ref eq))
+      (struct.new $float
+         (f64.sub (f64.const 1)
+            (call $erf (struct.get $float 0 (ref.cast $float (local.get 0)))))))
+
+   (func (export "caml_fma_float")
+      (param $x (ref eq)) (param $y (ref eq)) (param $z (ref eq))
+      (result (ref eq))
+      ;; ZZZ not accurate
+      (struct.new $float
+         (f64.add
+            (f64.mul (struct.get $float 0 (ref.cast $float (local.get $x)))
+                     (struct.get $float 0 (ref.cast $float (local.get $y))))
+            (struct.get $float 0 (ref.cast $float (local.get $z))))))
+
    (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_float_of_string"))
@@ -430,15 +531,10 @@
       (local $x f64) (local $y f64)
       (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
       (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
-      (if (f64.eq (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const 0)))))
-      (if (f64.lt (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (if (f64.gt (local.get $x) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (if (f64.eq (local.get $x) (local.get $x))
-         (then (return (i31.new (i32.const 1)))))
-      (if (f64.eq (local.get $y) (local.get $y))
-         (then (return (i31.new (i32.const -1)))))
-      (i31.new (i32.const 0)))
+      (i31.new
+         (i32.add
+            (i32.sub (f64.gt (local.get $x) (local.get $y))
+                     (f64.lt (local.get $y) (local.get $x)))
+            (i32.sub (f64.eq (local.get $x) (local.get $x))
+                     (f64.eq (local.get $y) (local.get $y))))))
 )
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index 0605a6c005..37243fcf18 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -39,20 +39,4 @@
 
    (func (export "caml_fs_init") (result (ref eq))
       (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_const_ostype_cygwin")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_const_ostype_cygwin"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_const_ostype_win32")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_const_ostype_win32"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_sys_const_max_wosize")
-      (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0xfffffff)))
 )
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index ddbd0396ef..5e5e99dffc 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -240,4 +240,15 @@
          (i32.const 0) (i31.new (i32.const 0)) (local.get $wr))
       (i31.new (i32.and (call $caml_hash_mix_final (local.get $h))
                         (i32.const 0x3FFFFFFF))))
+
+   (func (export "caml_string_hash")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $h i32)
+      (i31.new
+         (i32.and
+            (call $caml_hash_mix_final
+               (call $caml_hash_mix_string
+                  (i31.get_s (ref.cast i31 (local.get 0)))
+                  (ref.cast $string (local.get 1))))
+            (i32.const 0x3FFFFFFF))))
 )
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index b072353476..002432a189 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -1,5 +1,6 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -182,12 +183,12 @@
    (func (export "caml_lazy_make_forward")
       (param (ref eq)) (result (ref eq))
       (array.new_fixed $block (i31.new (global.get $forward_tag))
-         (local.get $0)))
+         (local.get 0)))
 
    (func $obj_update_tag
       (param (ref eq)) (param $o i32) (param $n i32) (result i32)
       (local $b (ref $block))
-      (local.set $b (ref.cast $block (local.get $0)))
+      (local.set $b (ref.cast $block (local.get 0)))
       (if (result i32) (ref.eq (array.get $block (local.get $b) (i32.const 0))
                                (i31.new (local.get $o)))
          (then
@@ -209,7 +210,7 @@
 
    (func (export "caml_lazy_update_to_forcing")
       (param (ref eq)) (result (ref eq))
-      (if (ref.test $block (local.get $0))
+      (if (ref.test $block (local.get 0))
          (then
             (if (call $obj_update_tag (local.get 0)
                    (global.get $lazy_tag) (global.get $forcing_tag))
@@ -236,6 +237,36 @@
    (func (export "caml_obj_is_shared") (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 1)))
 
+   (func (export "caml_obj_raw_field")
+      (param $o (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (array.get $block (ref.cast $block (local.get $o))
+         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))))
+
+   (func (export "caml_obj_set_raw_field")
+      (param $o (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (array.set $block (ref.cast $block (local.get $o))
+         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
+         (local.get $v))
+      (i31.new (i32.const 0)))
+
+   (data $not_implemented "Obj.add_offset is not supported")
+
+   (func (export "caml_obj_add_offset")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $caml_failwith
+         (array.new_data $string $not_implemented (i32.const 0) (i32.const 31)))
+      (i31.new (i32.const 0)))
+
+   (data $truncate_not_implemented "Obj.truncate is not supported")
+
+   (func (export "caml_obj_truncate")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $caml_failwith
+         (array.new_data $string $truncate_not_implemented
+            (i32.const 0) (i32.const 29)))
+      (i31.new (i32.const 0)))
+
    (func (export "caml_get_public_method")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       ;;ZZZ
@@ -250,7 +281,7 @@
       (array.set $block (ref.cast $block (local.get 0)) (i32.const 2)
          (i31.new (local.get $id)))
       (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
-      (local.get $0))
+      (local.get 0))
 
    (func (export "caml_fresh_oo_id") (param (ref eq)) (result (ref eq))
       (local $id i32)
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index d4eb25ccec..325885752d 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -1,17 +1,72 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
-   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
-   (import "jslib" "caml_jsstring_of_string"
-      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+   (import "hash" "caml_string_hash"
+      (func $caml_string_hash
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "string" "caml_string_equal"
+      (func $caml_string_equal
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
 
    (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (type $assoc
+      (struct (field (ref $string)) (field (ref eq)) (field (ref null $assoc))))
+
+   (type $assoc_array (array (field (mut (ref null $assoc)))))
+
+   (global $Named_value_size i32 (i32.const 13))
+
+   (global $named_value_table (ref $assoc_array)
+     (array.new $assoc_array (ref.null $assoc) (global.get $Named_value_size)))
+
+   (func $find_named_value
+      (param $s (ref eq)) (param $l (ref null $assoc)) (result (ref null eq))
+      (local $a (ref $assoc))
+      (block $tail (result (ref null eq))
+         (loop $loop
+            (local.set $a (br_on_cast_fail $tail $assoc (local.get $l)))
+            (if (i31.get_u
+                   (ref.cast i31
+                       (call $caml_string_equal
+                          (local.get $s)
+                          (struct.get $assoc 0 (local.get $a)))))
+               (then
+                  (return (struct.get $assoc 1 (local.get $a)))))
+            (local.set $l (struct.get $assoc 2 (local.get $a)))
+            (br $loop))))
+
+   (func (export "caml_named_value") (param (ref eq)) (result (ref null eq))
+      (return_call $find_named_value
+         (local.get 0)
+         (array.get $assoc_array (global.get $named_value_table)
+            (i32.rem_u
+               (i31.get_s
+                  (ref.cast i31
+                     (call $caml_string_hash
+                        (i31.new (i32.const 0)) (local.get 0))))
+               (global.get $Named_value_size)))))
 
    (func (export "caml_register_named_value")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_register_named_value"))
-      (call $log_js
-         (call $unwrap (call $caml_jsstring_of_string (local.get $0))))
+      (local $h i32)
+      (local $r (ref null $assoc))
+      (local.set $h
+         (i32.rem_u
+            (i31.get_s
+               (ref.cast i31
+                  (call $caml_string_hash
+                     (i31.new (i32.const 0)) (local.get 0))))
+            (global.get $Named_value_size)))
+      (local.set $r
+         (array.get $assoc_array
+            (global.get $named_value_table) (local.get $h)))
+      (if (ref.is_null (call $find_named_value (local.get 0) (local.get $r)))
+         (then
+            (array.set $assoc_array
+               (global.get $named_value_table) (local.get $h)
+               (struct.new $assoc
+                  (ref.cast $string (local.get 0))
+                  (local.get 1) (local.get $r)))))
       (i31.new (i32.const 0)))
 
    (global $caml_global_data (export "caml_global_data") (mut (ref $block))
@@ -26,4 +81,7 @@
             (array.set $block (global.get $caml_global_data)
                (local.get $i) (local.get $v))))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_get_global_data") (param (ref eq)) (result (ref eq))
+      (global.get $caml_global_data))
 )
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
new file mode 100644
index 0000000000..3d1478ca2a
--- /dev/null
+++ b/runtime/wasm/sync.wat
@@ -0,0 +1,75 @@
+(module
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+
+   (type $string (array (mut i8)))
+   (type $value->value->int
+      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field (ref $string)) ;; identifier
+         (field (ref $value->value->int)) ;; compare
+         (field (ref null $value->int)) ;; hash
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+
+   (global $mutex_ops (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string ;; "_mutex"
+            (i32.const 95) (i32.const 109) (i32.const 117) (i32.const 116)
+            (i32.const 101) (i32.const 120))
+         (ref.func $mutex_cmp)
+         (ref.func $mutex_hash)))
+
+   (type $mutex
+      (sub $custom
+         (struct
+            (field (ref $custom_operations)) (field i32) (field (mut i32)))))
+
+   (func $mutex_cmp (param (ref eq)) (param (ref eq)) (result i32)
+      (local $i1 i32) (local $i2 i32)
+      (local.set $i1 (struct.get $mutex 1 (ref.cast $mutex (local.get 0))))
+      (local.set $i2 (struct.get $mutex 1 (ref.cast $mutex (local.get 1))))
+      (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
+               (i32.lt_s (local.get $i1) (local.get $i2))))
+
+   (func $mutex_hash (param (ref eq)) (result i32)
+      (struct.get $mutex 1 (ref.cast $mutex (local.get 0))))
+
+   (global $next_mutex_id (mut i32) (i32.const 0))
+
+   (func (export "caml_ml_mutex_new") (param (ref eq)) (result (ref eq))
+      (local $id i32)
+      (local.set $id (global.get $next_mutex_id))
+      (global.set $next_mutex_id (i32.add (local.get $id) (i32.const 1)))
+      (struct.new $mutex (global.get $mutex_ops) (local.get $id) (i32.const 0)))
+
+   (data $lock_failure "Mutex.lock: mutex already locked. Cannot wait.")
+
+   (func (export "caml_ml_mutex_lock") (param (ref eq)) (result (ref eq))
+      (local $t (ref $mutex))
+      (local.set $t (ref.cast $mutex (local.get 0)))
+      (if (struct.get $mutex 2 (local.get $t))
+         (then
+            (call $caml_failwith
+               (array.new_data $string $lock_failure
+                  (i32.const 0) (i32.const 46)))))
+      (struct.set $mutex 2 (local.get $t) (i32.const 1))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_try_lock") (param (ref eq)) (result (ref eq))
+      (local $t (ref $mutex))
+      (local.set $t (ref.cast $mutex (local.get 0)))
+      (if (result (ref eq)) (struct.get $mutex 2 (local.get $t))
+         (then
+            (i31.new (i32.const 0)))
+         (else
+            (struct.set $mutex 2 (local.get $t) (i32.const 1))
+            (i31.new (i32.const 1)))))
+
+   (func (export "caml_ml_mutex_unlock") (param (ref eq)) (result (ref eq))
+      (struct.set $mutex 2 (ref.cast $mutex (local.get 0)) (i32.const 1))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index b4c09292b4..e5c59cca99 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -18,7 +18,8 @@
    (func (export "caml_sys_exit") (param (ref eq)) (result (ref eq))
       (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get 0)))))
 
-   (func (export "caml_sys_getenv")
+   (export "caml_sys_unsafe_getenv" (func $caml_sys_getenv))
+   (func $caml_sys_getenv (export "caml_sys_getenv")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_sys_getenv"))
@@ -33,6 +34,12 @@
       (array.new_fixed $block (i31.new (i32.const 0))
          (array.new_fixed $string (i32.const 97))))
 
+   (func (export "caml_sys_executable_name")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_executable_name"))
+      (i31.new (i32.const 0)))
+
    (export "caml_sys_time_include_children" (func $caml_sys_time))
    (func $caml_sys_time (export "caml_sys_time")
       (param (ref eq)) (result (ref eq))
@@ -67,6 +74,40 @@
                (br $loop))))
       (local.get $a))
 
+   (func (export "caml_sys_const_bigendian")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_word_size")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 32)))
+
+   (func (export "caml_sys_const_int_size")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 31)))
+
+   (func (export "caml_sys_const_max_wosize")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0xfffffff)))
+
+   (func (export "caml_sys_const_ostype_unix")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_const_ostype_unix"))
+      (i31.new (i32.const 1)))
+
+   (func (export "caml_sys_const_ostype_win32")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_const_ostype_win32"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_sys_const_ostype_cygwin")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_sys_const_ostype_cygwin"))
+      (i31.new (i32.const 0)))
+
    (data $Unix "Unix")
 
    (func (export "caml_sys_get_config")
@@ -81,4 +122,27 @@
    (func (export "caml_sys_isatty")
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_runtime_variant") (param (ref eq)) (result (ref eq))
+      (array.new_fixed $string))
+
+   (func (export "caml_runtime_parameters") (param (ref eq)) (result (ref eq))
+      (array.new_fixed $string))
+
+   (func (export "caml_install_signal_handler")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (global $caml_runtime_warnings (mut i32) (i32.const 0))
+
+   (func (export "caml_ml_enable_runtime_warnings")
+      (param (ref eq)) (result (ref eq))
+      (global.set $caml_runtime_warnings
+         (i31.get_u (ref.cast i31 (local.get 0))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_runtime_warnings_enabled")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (global.get $caml_runtime_warnings)))
+
 )
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index aca44935d5..bf0a673804 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -12,7 +12,7 @@
 
    (func (export "caml_alloc_tm")
       (param $sec i32) (param $min i32) (param $hour i32) (param $mday i32)
-      (param $mon i32) (param $year i32) (param $wday i32) (param $yday $i32)
+      (param $mon i32) (param $year i32) (param $wday i32) (param $yday i32)
       (param $isdst i32) (result (ref eq))
       (array.new_fixed $block (i31.new (i32.const 0))
          (i31.new (local.get $sec))

From 7b0b525e473526a71fb3db5def7de99cbc593042 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 2 Jun 2023 10:44:16 +0200
Subject: [PATCH 048/481] Runtime: cleanup

---
 runtime/wasm/float.wat | 14 +++++++-------
 runtime/wasm/int64.wat |  8 ++++----
 runtime/wasm/ints.wat  | 32 ++++++++++++++++----------------
 runtime/wasm/unix.wat  | 13 +++++++++----
 4 files changed, 36 insertions(+), 31 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index d2b963d7ba..b79cfc348f 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -121,7 +121,7 @@
          (loop $count
             (local.set $j (i32.add (local.get $j) (i32.const 1)))
             (local.set $d (i32.div_u (local.get $d) (i32.const 10)))
-            (br_if $count (i32.ne (local.get $d) (i32.const 0))))
+            (br_if $count (local.get $d)))
          (local.set $len (i32.add (i32.add (local.get $i) (local.get $prec))
                                   (i32.add (i32.const 6) (local.get $j))))
          (if (i32.eqz (local.get $prec))
@@ -136,7 +136,7 @@
                (i32.add (i32.const 48)
                   (i32.rem_u (local.get $d) (i32.const 10))))
             (local.set $d (i32.div_u (local.get $d) (i32.const 10)))
-            (br_if $write (i32.ne (local.get $d) (i32.const 0))))
+            (br_if $write (local.get $d)))
          (array.set $string (local.get $s)
             (i32.sub (local.get $len) (i32.const 1))
             (select (i32.const 43) (i32.const 45)
@@ -190,9 +190,9 @@
          (block $bad_format
             (br_if $bad_format (i32.lt_u (local.get $len) (i32.const 2)))
             (br_if $bad_format
-               (i32.ne (array.get $string (local.get $s) (i32.const 0))
+               (i32.ne (array.get_u $string (local.get $s) (i32.const 0))
                        (i32.const 37))) ;; '%'
-            (local.set $c (array.get $string (local.get $s) (i32.const 1)))
+            (local.set $c (array.get_u $string (local.get $s) (i32.const 1)))
             (if (i32.eq (local.get $c) (i32.const 43)) ;; '+'
                (then
                   (local.set $sign_style (i32.const 1))
@@ -203,13 +203,13 @@
                   (local.set $i (i32.add (local.get $i) (i32.const 1)))))
             (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
             (br_if $bad_format
-               (i32.ne (array.get $string (local.get $s) (local.get $i))
+               (i32.ne (array.get_u $string (local.get $s) (local.get $i))
                        (i32.const 46))) ;; '.'
             (loop $precision
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
                (local.set $c
-                  (array.get $string (local.get $s) (local.get $i)))
+                  (array.get_u $string (local.get $s) (local.get $i)))
                (if (i32.and (i32.ge_u (local.get $c) (i32.const 48))  ;; '0'
                             (i32.le_u (local.get $c) (i32.const 57))) ;; '9'
                   (then
@@ -312,7 +312,7 @@
             (local.set $i (i32.const 0))
             (local.set $len (array.len (local.get $s)))
             (loop $uppercase
-               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
                (if (i32.and (i32.ge_u (local.get $c) (i32.const 97))   ;; 'a'
                             (i32.le_u (local.get $c) (i32.const 122))) ;; 'z'
                   (then
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index bebf29fb31..a6a2cfd2e7 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -97,7 +97,7 @@
       (local.set $threshold
          (i64.div_u (i64.const -1) (i64.extend_i32_u (local.get $base))))
       (local.set $d
-         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
+         (call $parse_digit (array.get_u $string (local.get $s) (local.get $i))))
       (if (i32.ge_u (local.get $d) (local.get $base))
          (then (call $caml_failwith (global.get $INT64_ERRMSG))))
       (local.set $res (i64.extend_i32_u (local.get $d)))
@@ -105,7 +105,7 @@
          (local.set $i (i32.add (local.get $i) (i32.const 1)))
          (if (i32.lt_s (local.get $i) (local.get $len))
             (then
-               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
                (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
                (local.set $d (call $parse_digit (local.get $c)))
                (if (i32.ge_u (local.get $d) (local.get $base))
@@ -191,7 +191,7 @@
       (local.set $d (struct.get $int64 1 (ref.cast $int64 (local.get 1))))
       (if (i32.eq (array.len (local.get $s)) (i32.const 2))
          (then
-            (if (i32.eq (array.get $string (local.get $s) (i32.const 1))
+            (if (i32.eq (array.get_u $string (local.get $s) (i32.const 1))
                         (i32.const 100)) ;; 'd'
                (then (return_call $format_int64_default (local.get $d))))))
       (local.set $format (call $parse_int_format (local.get $s)))
@@ -252,7 +252,7 @@
                            (i32.const 32)))))))) ;; ' '
       (if (local.get $alternate)
          (then
-            (if (i32.ne (local.get $i) (i32.const 0))
+            (if (local.get $i)
                (then
                   (array.set $string (local.get $s) (i32.const 0)
                      (i32.const 48)) ;; '0'
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index 55805c6a46..12f4a364b2 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -21,7 +21,7 @@
       (local.set $base (i32.const 10))
       (if (i32.eqz (local.get $len))
          (then
-            (local.set $c (array.get $string (local.get $s) (i32.const 0)))
+            (local.set $c (array.get_u $string (local.get $s) (i32.const 0)))
             (if (i32.eq (local.get $c) (i32.const 45))
                (then
                   (local.set $sign (i32.const -1))
@@ -29,11 +29,11 @@
                (else (if (i32.eq (local.get $c) (i32.const 43))
                   (then (local.set $i (i32.const 1)))))))
       (if (i32.lt_s (i32.add (local.get $i) (i32.const 1)) (local.get $len))
-         (then (if (i32.eq (array.get $string (local.get $s) (local.get $i))
+         (then (if (i32.eq (array.get_u $string (local.get $s) (local.get $i))
                            (i32.const 48))
             (then
                (local.set $c
-                  (array.get $string (local.get $s)
+                  (array.get_u $string (local.get $s)
                      (i32.add (local.get $i) (i32.const 1))))
                (if (i32.or (i32.eq (local.get $c) (i32.const 88))
                            (i32.eq (local.get $c) (i32.const 120)))
@@ -92,7 +92,7 @@
       (local.set $base (tuple.extract 3 (local.get $t)))
       (local.set $threshold (i32.div_u (i32.const -1) (local.get $base)))
       (local.set $d
-         (call $parse_digit (array.get $string (local.get $s) (local.get $i))))
+         (call $parse_digit (array.get_u $string (local.get $s) (local.get $i))))
       (if (i32.ge_u (local.get $d) (local.get $base))
          (then (call $caml_failwith (local.get $errmsg))))
       (local.set $res (local.get $d))
@@ -100,7 +100,7 @@
          (local.set $i (i32.add (local.get $i) (i32.const 1)))
          (if (i32.lt_s (local.get $i) (local.get $len))
             (then
-               (local.set $c (array.get $string (local.get $s) (local.get $i)))
+               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
                (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
                (local.set $d (call $parse_digit (local.get $c)))
                (if (i32.ge_u (local.get $d) (local.get $base))
@@ -189,7 +189,7 @@
       (loop $count
          (local.set $i (i32.add (local.get $i) (i32.const 1)))
          (local.set $n (i32.div_u (local.get $n) (i32.const 10)))
-         (br_if $count (i32.ne (local.get $n) (i32.const 0))))
+         (br_if $count (local.get $n)))
       (local.set $s (array.new $string (i32.const 0) (local.get $i)))
       (loop $write
          (local.set $i (i32.sub (local.get $i) (i32.const 1)))
@@ -197,7 +197,7 @@
             (i32.add (i32.const 48)
                (i32.rem_u (local.get $d) (i32.const 10))))
          (local.set $d (i32.div_u (local.get $d) (i32.const 10)))
-         (br_if $write (i32.ne (local.get $d) (i32.const 0))))
+         (br_if $write (local.get $d)))
       (if (local.get $negative)
          (then
             (array.set $string (local.get $s) (i32.const 0)
@@ -217,9 +217,9 @@
          (block $bad_format
             (br_if $bad_format (i32.lt_u (local.get $len) (i32.const 2)))
             (br_if $bad_format
-               (i32.ne (array.get $string (local.get $s) (i32.const 0))
+               (i32.ne (array.get_u $string (local.get $s) (i32.const 0))
                        (i32.const 37))) ;; '%'
-            (local.set $c (array.get $string (local.get $s) (i32.const 1)))
+            (local.set $c (array.get_u $string (local.get $s) (i32.const 1)))
             (if (i32.eq (local.get $c) (i32.const 43)) ;; '+'
                (then
                   (local.set $sign_style (i32.const 1))
@@ -233,7 +233,7 @@
                   (local.set $alternate (i32.const 1))
                   (local.set $i (i32.add (local.get $i) (i32.const 1)))))
             (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
-            (local.set $c (array.get $string (local.get $s) (local.get $i)))
+            (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
             (if (i32.or (i32.or (i32.eq (local.get $c) (i32.const 76)) ;; 'L'
                                 (i32.eq (local.get $c) (i32.const 108))) ;; 'l'
                         (i32.eq (local.get $c) (i32.const 110))) ;; 'n'
@@ -241,7 +241,7 @@
                   (local.set $i (i32.add (local.get $i) (i32.const 1)))
                   (br_if $bad_format (i32.eq (local.get $i) (local.get $len)))
                   (local.set $c
-                     (array.get $string (local.get $s) (local.get $i)))))
+                     (array.get_u $string (local.get $s) (local.get $i)))))
             (br_if $bad_format
               (i32.ne (i32.add (local.get $i) (i32.const 1)) (local.get $len)))
             (if (i32.or (i32.eq (local.get $c) (i32.const 100)) ;; 'd'
@@ -288,7 +288,7 @@
       (local.set $s (ref.cast $string (local.get 0)))
       (if (i32.eq (array.len (local.get $s)) (i32.const 2))
          (then
-            (if (i32.eq (array.get $string (local.get $s) (i32.const 1))
+            (if (i32.eq (array.get_u $string (local.get $s) (i32.const 1))
                         (i32.const 100)) ;; 'd'
                (then (return_call $format_int_default (local.get $d))))))
       (local.set $format (call $parse_int_format (local.get $s)))
@@ -305,13 +305,13 @@
       (loop $count
          (local.set $i (i32.add (local.get $i) (i32.const 1)))
          (local.set $n (i32.div_u (local.get $n) (local.get $base)))
-         (br_if $count (i32.ne (local.get $n) (i32.const 0))))
+         (br_if $count (local.get $n)))
       (if (i32.or (local.get $negative)
                   (local.get $sign_style))
          (then (local.set $i (i32.add (local.get $i) (i32.const 1)))))
       (if (local.get $alternate)
          (then
-            (if (i32.ne (local.get $d) (i32.const 0))
+            (if (local.get $d)
                (then
                   (if (i32.eq (local.get $base) (i32.const 16))
                      (then
@@ -332,7 +332,7 @@
             (array.get_u $chars (local.get $chars)
                (i32.rem_u (local.get $d) (local.get $base))))
          (local.set $d (i32.div_u (local.get $d) (local.get $base)))
-         (br_if $write (i32.ne (local.get $d) (i32.const 0))))
+         (br_if $write (local.get $d)))
       (if (local.get $negative)
          (then
             (array.set $string (local.get $s) (i32.const 0)
@@ -349,7 +349,7 @@
                            (i32.const 32)))))))) ;; ' '
       (if (local.get $alternate)
          (then
-            (if (i32.ne (local.get $i) (i32.const 0))
+            (if (local.get $i)
                (then
                   (array.set $string (local.get $s) (i32.const 0)
                      (i32.const 48)) ;; '0'
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index bf0a673804..67a7ab01b3 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -1,7 +1,12 @@
 (module
    (import "bindings" "gettimeofday" (func $gettimeofday (result f64)))
-   (import "bindings" "gmtime" (func $gmtime (result (ref eq))))
-   (import "bindings" "localtime" (func $localtime (result (ref eq))))
+   (import "bindings" "gmtime" (func $gmtime (param f64) (result (ref eq))))
+   (import "bindings" "localtime"
+      (func $localtime (param f64) (result (ref eq))))
+   (import "bindings" "mktime"
+      (func $mktime
+         (param i32) (param i32) (param i32) (param i32) (param i32) (param i32)
+         (result f64)))
 
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
@@ -26,10 +31,10 @@
          (i31.new (local.get $isdst))))
 
    (func (export "unix_gmtime") (param (ref eq)) (result (ref eq))
-      (call $gmtime))
+      (call $gmtime (struct.get $float 0 (ref.cast $float (local.get 0)))))
 
    (func (export "unix_localtime") (param (ref eq)) (result (ref eq))
-      (call $localtime))
+      (call $localtime (struct.get $float 0 (ref.cast $float (local.get 0)))))
 
    (func (export "unix_time") (param (ref eq)) (result (ref eq))
       (struct.new $float (f64.floor (call $gettimeofday))))

From d4c700b5e03e9791e360e2d1faa635816c6a209a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 2 Jun 2023 10:45:02 +0200
Subject: [PATCH 049/481] Runtime: float parsing

---
 runtime/wasm/float.wat  | 345 +++++++++++++++++++++++++++++++++++++---
 runtime/wasm/runtime.js |   1 +
 2 files changed, 327 insertions(+), 19 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index b79cfc348f..dfe98bb54c 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -1,15 +1,14 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
-   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
-   (import "jslib" "caml_string_of_jsstring"
-      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
    (import "jslib" "caml_jsstring_of_string"
       (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
    (import "bindings" "format_float"
       (func $format_float
          (param i32) (param i32) (param f64) (result (ref string))))
+   (import "bindings" "parse_float"
+      (func $parse_float (param anyref) (result f64)))
    (import "Math" "exp" (func $exp (param f64) (result f64)))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
    (import "ints" "lowercase_hex_table"
@@ -322,6 +321,318 @@
                (br_if $uppercase (i32.lt_u (local.get $i) (local.get $len))))))
       (local.get $s))
 
+   (data $float_of_string "float_of_string")
+
+   (func $caml_float_of_hex (param $s (ref $string)) (param $i i32) (result f64)
+      (local $len i32) (local $c i32) (local $d i32) (local $m i64)
+      (local $f f64) (local $negative i32)
+      (local $dec_point i32) (local $exp i32) (local $adj i32)
+      (local $n_bits i32) (local $m_bits i32) (local $x_bits i32)
+      (local.set $len (array.len (local.get $s)))
+      (local.set $dec_point (i32.const -1))
+      (block $error
+         (loop $parse
+            (if (i32.lt_u (local.get $i) (local.get $len))
+               (then
+                  (local.set $c
+                     (array.get_u $string (local.get $s) (local.get $i)))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (if (i32.eq (local.get $c) (i32.const 46)) ;; '.'
+                     (then
+                        (br_if $error
+                           (i32.ge_s (local.get $dec_point) (i32.const 0)))
+                        (local.set $dec_point (local.get $n_bits))
+                        (br $parse)))
+                  (if (i32.or (i32.eq (local.get $c) (i32.const 80))   ;; 'P'
+                              (i32.eq (local.get $c) (i32.const 112))) ;; 'p'
+                     (then
+                        (br_if $error (i32.eq (local.get $i) (local.get $len)))
+                        (local.set $c
+                           (array.get_u $string (local.get $s) (local.get $i)))
+                        (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                        (if (i32.eq (local.get $c) (i32.const 45)) ;; '-'
+                           (then
+                              (local.set $negative (i32.const 1))
+                              (br_if $error
+                                 (i32.eq (local.get $i) (local.get $len)))
+                              (local.set $c
+                                 (array.get_u $string
+                                    (local.get $s) (local.get $i)))
+                              (local.set $i
+                                 (i32.add (local.get $i) (i32.const 1)))))
+                        (if (i32.eq (local.get $c) (i32.const 43)) ;; '+'
+                           (then
+                              (br_if $error
+                                 (i32.eq (local.get $i) (local.get $len)))
+                              (local.set $c
+                                 (array.get_u $string
+                                    (local.get $s) (local.get $i)))
+                              (local.set $i
+                                 (i32.add (local.get $i) (i32.const 1)))))
+                        (block $overflow
+                           (loop $parse_exponent
+                              (br_if $error
+                                 (i32.or (i32.lt_u (local.get $c) (i32.const 48))
+                                    (i32.gt_u (local.get $c) (i32.const 57))))
+                              (local.set $d
+                                 (i32.sub (local.get $c) (i32.const 48)))
+                              (local.set $exp
+                                 (i32.add
+                                    (i32.mul (local.get $exp) (i32.const 10))
+                                    (local.get $d)))
+                              (br_if $overflow
+                                 (i32.lt_u (local.get $exp) (local.get $d)))
+                              (if (i32.ne (local.get $i) (local.get $len))
+                                 (then
+                                    (local.set $c
+                                       (array.get_u $string
+                                          (local.get $s) (local.get $i)))
+                                    (local.set $i
+                                       (i32.add (local.get $i) (i32.const 1)))
+                                    (br $parse_exponent))))
+                           (if (local.get $negative)
+                              (then
+                                 (br_if $overflow
+                                    (i32.gt_u (local.get $exp)
+                                       (i32.const 0x80000000)))
+                                 (local.set $exp
+                                    (i32.sub (i32.const 0) (local.get $exp))))
+                              (else
+                                 (br_if $overflow
+                                    (i32.ge_u (local.get $exp)
+                                       (i32.const 0x80000000)))))
+                           (br $parse))
+                        (if (i32.or (local.get $negative)
+                                    (i64.eqz (local.get $m)))
+                           (then
+                              (return (f64.const 0)))
+                           (else
+                              (return (f64.const infinity))))))
+                  (if (i32.and (i32.ge_u (local.get $c) (i32.const 48))
+                               (i32.le_u (local.get $c) (i32.const 57)))
+                     (then
+                        (local.set $d (i32.sub (local.get $c) (i32.const 48))))
+                  (else (if (i32.and (i32.ge_u (local.get $c) (i32.const 97))
+                                     (i32.le_u (local.get $c) (i32.const 102)))
+                     (then
+                        (local.set $d (i32.sub (local.get $c) (i32.const 87))))
+                  (else (if (i32.and (i32.ge_u (local.get $c) (i32.const 65))
+                                     (i32.le_u (local.get $c) (i32.const 70)))
+                     (then
+                        (local.set $d (i32.sub (local.get $c) (i32.const 55))))
+                     (else
+                        (br $error)))))))
+                  (local.set $n_bits
+                     (i32.add (local.get $n_bits) (i32.const 4)))
+                  (br_if $parse
+                     (i32.and (i32.eqz (local.get $d)) (i64.eqz (local.get $m))))
+                  (if (i32.lt_u (local.get $m_bits) (i32.const 60))
+                     (then
+                        (local.set $m
+                           (i64.add (i64.shl (local.get $m) (i64.const 4))
+                                    (i64.extend_i32_u (local.get $d))))
+                        (local.set $m_bits
+                           (i32.add (local.get $m_bits) (i32.const 4))))
+                     (else
+                        (if (local.get $d)
+                           (then
+                              (local.set $m
+                                 (i64.or (local.get $m) (i64.const 1)))))
+                        (local.set $x_bits
+                           (i32.add (local.get $x_bits) (i32.const 4)))))
+                  (br $parse))))
+         (br_if $error (i32.eqz (local.get $n_bits)))
+         (local.set $f (f64.convert_i64_s (local.get $m)))
+         (local.set $adj (local.get $x_bits))
+         (if (i32.ge_s (local.get $dec_point) (i32.const 0))
+            (then
+               (local.set $adj
+                  (i32.add (local.get $adj)
+                     (i32.sub (local.get $dec_point) (local.get $n_bits))))))
+         (if (i32.and (i32.gt_s (local.get $adj) (i32.const 0))
+                      (i32.gt_s (local.get $exp) (i32.const 0x7fffffff)))
+            (then (local.set $exp (i32.const 0x7fffffff)))
+         (else (if (i32.and (i32.lt_s (local.get $adj) (i32.const 0))
+                            (i32.lt_s (local.get $exp) (i32.const 0x80000000)))
+            (then (local.set $exp (i32.const 0x80000000)))
+            (else
+              (local.set $exp (i32.add (local.get $exp) (local.get $adj)))))))
+         (if (local.get $exp)
+            (then (local.set $f (call $ldexp (local.get $f) (local.get $exp)))))
+         (return (local.get $f)))
+      (call $caml_failwith
+         (array.new_data $string $float_of_string (i32.const 0) (i32.const 15)))
+      (f64.const 0))
+
+   (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
+      (local $s (ref $string)) (local $len i32) (local $i i32) (local $j i32)
+      (local $s' (ref $string))
+      (local $negative i32) (local $c i32)
+      (local $f f64)
+      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $len (array.len (local.get $s)))
+      (loop $count
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (if (i32.eq (i32.const 95) ;; '_'
+                      (array.get_u $string (local.get $s) (local.get $i)))
+                  (then
+                     (local.set $j (i32.add (local.get $j) (i32.const 1)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $count))))
+      (if (local.get $j)
+         (then
+            (local.set $s'
+               (array.new $string (i32.const 0)
+                  (i32.sub (local.get $len) (local.get $j))))
+            (local.set $i (i32.const 0))
+            (local.set $j (i32.const 0))
+            (loop $copy
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (local.set $c
+                        (array.get_u $string (local.get $s) (local.get $i)))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (if (i32.ne (local.get $c) (i32.const 95)) ;; '_'
+                        (then
+                           (array.set $string (local.get $s')
+                              (local.get $j) (local.get $c))
+                           (local.set $j
+                              (i32.add (local.get $j) (i32.const 1)))))
+                     (br $copy))))
+            (local.set $s (local.get $s'))))
+      (block $error
+         (br_if $error (i32.eqz (local.get $len)))
+         (local.set $c (array.get_u $string (local.get $s) (i32.const 0)))
+         (local.set $i (i32.const 0))
+         (if (i32.eq (local.get $c) (i32.const 45)) ;; '-'
+            (then
+               (local.set $negative (i32.const 1))
+               (local.set $i (i32.const 1))))
+         (if (i32.eq (local.get $c) (i32.const 43)) ;; '+'
+            (then
+               (local.set $i (i32.const 1))))
+         (if (i32.lt_u (i32.add (local.get $i) (i32.const 2)) (local.get $len))
+            (then
+               (if (i32.eq (array.get_u $string (local.get $s) (local.get $i))
+                           (i32.const 48)) ;; '0'
+                  (then
+                     (if (i32.eq (i32.and
+                                    (array.get_u $string (local.get $s)
+                                       (i32.add (local.get $i) (i32.const 1)))
+                                    (i32.const 0xdf))
+                                 (i32.const 88)) ;; 'X'
+                        (then
+                           (local.set $f
+                              (call $caml_float_of_hex (local.get $s)
+                                 (i32.add (local.get $i) (i32.const 2))))
+                           (if (local.get $negative)
+                              (then (local.set $f (f64.neg (local.get $f)))))
+                           (return (struct.new $float (local.get $f)))))))))
+         (if (i32.eq (i32.add (local.get $i) (i32.const 3)) (local.get $len))
+            (then
+               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
+               (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                           (i32.const 78)) (then ;; 'N'
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (local.set $c
+                     (array.get_u $string (local.get $s) (local.get $i)))
+                  (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                              (i32.const 65)) (then ;; 'A'
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (local.set $c
+                        (array.get_u $string (local.get $s) (local.get $i)))
+                     (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                                 (i32.const 78)) ;; 'N'
+                        (then
+                           (return
+                              (struct.new $float (f64.const nan)))))))))
+               (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                           (i32.const 73)) (then ;; 'I'
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (local.set $c
+                     (array.get_u $string (local.get $s) (local.get $i)))
+                  (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                              (i32.const 78)) (then ;; 'N'
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (local.set $c
+                        (array.get_u $string (local.get $s) (local.get $i)))
+                     (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                                 (i32.const 70)) ;; 'F'
+                        (then
+                           (return
+                              (struct.new $float
+                                 (select
+                                    (f64.const -infinity)
+                                    (f64.const infinity)
+                                    (local.get $negative))))))))))))
+         (if (i32.eq (i32.add (local.get $i) (i32.const 8)) (local.get $len))
+            (then
+               (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
+               (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                           (i32.const 73)) (then ;; 'I'
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (local.set $c
+                     (array.get_u $string (local.get $s) (local.get $i)))
+                  (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                              (i32.const 78)) (then ;; 'N'
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (local.set $c
+                        (array.get_u $string (local.get $s) (local.get $i)))
+                     (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                                 (i32.const 70)) (then ;; 'F'
+                        (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                        (local.set $c
+                           (array.get_u $string (local.get $s) (local.get $i)))
+                        (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                                    (i32.const 73)) (then ;; 'I'
+                           (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                           (local.set $c
+                              (array.get_u $string
+                                 (local.get $s) (local.get $i)))
+                           (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf))
+                                       (i32.const 78)) (then ;; 'N'
+                              (local.set $i
+                                 (i32.add (local.get $i) (i32.const 1)))
+                              (local.set $c
+                                 (array.get_u $string
+                                     (local.get $s) (local.get $i)))
+                              (if (i32.eq
+                                     (i32.and (local.get $c) (i32.const 0xdf))
+                                     (i32.const 73)) (then ;; 'I'
+                                 (local.set $i
+                                    (i32.add (local.get $i) (i32.const 1)))
+                                 (local.set $c
+                                    (array.get_u $string
+                                       (local.get $s) (local.get $i)))
+                                 (if (i32.eq
+                                        (i32.and (local.get $c) (i32.const 0xdf))
+                                             (i32.const 84)) (then ;; 'T'
+                                    (local.set $i
+                                       (i32.add (local.get $i) (i32.const 1)))
+                                    (local.set $c
+                                       (array.get_u $string
+                                           (local.get $s) (local.get $i)))
+                                    (if (i32.eq
+                                           (i32.and (local.get $c)
+                                              (i32.const 0xdf))
+                                           (i32.const 89)) (then ;; 'Y'
+                                       (return
+                                          (struct.new $float
+                                             (select
+                                                (f64.const -infinity)
+                                                (f64.const infinity)
+                                                (local.get $negative))))
+                                       ))))))))))))))))))
+         (local.set $f
+            (call $parse_float
+               (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
+         (br_if $error (f64.ne (local.get $f) (local.get $f)))
+         (return (struct.new $float (local.get $f))))
+      (call $caml_failwith
+         (array.new_data $string $float_of_string (i32.const 0) (i32.const 15)))
+      (return (struct.new $float (f64.const 0))))
+
    (func (export "caml_nextafter")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $x f64) (local $y f64) (local $i i64) (local $j i64)
@@ -384,11 +695,7 @@
       (array.new_fixed $block (i31.new (i32.const 0))
          (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
 
-   (func (export "caml_ldexp")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $n i32)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $n (i31.get_s (ref.cast i31 (local.get 1))))
+   (func $ldexp (param $x f64) (param $n i32) (result f64)
       (if (i32.gt_s (local.get $n) (i32.const 1023))
          (then
             (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
@@ -412,12 +719,17 @@
                         (local.set $n (i32.add (local.get $n) (i32.const 969)))
                         (if (i32.lt_s (local.get $n) (i32.const -1022))
                            (then (local.set $n (i32.const -1022)))))))))))
+      (f64.mul (local.get $x)
+         (f64.reinterpret_i64
+            (i64.shl (i64.add (i64.extend_i32_s (local.get $n))
+                              (i64.const 0x3ff))
+                     (i64.const 52)))))
+
+   (func (export "caml_ldexp")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
       (struct.new $float
-         (f64.mul (local.get $x)
-            (f64.reinterpret_i64
-               (i64.shl (i64.add (i64.extend_i32_s (local.get $n))
-                                 (i64.const 0x3ff))
-                        (i64.const 52))))))
+         (call $ldexp (struct.get $float 0 (ref.cast $float (local.get 0)))
+            (i31.get_s (ref.cast i31 (local.get 1))))))
 
    (func $frexp (param $x f64) (result f64 i32)
       (local $y i64)
@@ -521,11 +833,6 @@
                      (struct.get $float 0 (ref.cast $float (local.get $y))))
             (struct.get $float 0 (ref.cast $float (local.get $z))))))
 
-   (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_float_of_string"))
-      (unreachable))
-
    (func (export "caml_float_compare")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $x f64) (local $y f64)
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index e9c6fe34f3..c31a6d6cc4 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -127,6 +127,7 @@
              return caml_callback(f, args.length, args, 2);
          },
          wrap_fun_arguments:(f)=>function(){return f(arguments)},
+         parse_float:(s)=>+s,
          format_float:(prec, conversion, x)=>{
            function toFixed(x,dp) {
              if (Math.abs(x) < 1.0) {

From b025fa5400d23078d83f2b339f747c0aa19faa79 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 2 Jun 2023 14:01:51 +0200
Subject: [PATCH 050/481] More runtime functions

---
 runtime/wasm/jslib_js_of_ocaml.wat | 26 ++++++++++++-------------
 runtime/wasm/runtime.js            |  5 +++--
 runtime/wasm/sync.wat              | 19 ++++++++++++++++++
 runtime/wasm/unix.wat              | 31 ++++++++++++++++++++++++++++++
 4 files changed, 65 insertions(+), 16 deletions(-)

diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index 39b347cc94..c70cd517b3 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -1,11 +1,10 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
+   (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
 
-   (func (export "caml_js_get_console")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_get_console"))
-      (i31.new (i32.const 0)))
+   (func (export "caml_js_get_console") (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $eval (string.const "console"))))
 
   (func (export "caml_js_html_entities")
      (param (ref eq)) (result (ref eq))
@@ -19,14 +18,13 @@
       (call $log_js (string.const "caml_js_html_escape"))
       (i31.new (i32.const 0)))
 
-  (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_xmlhttprequest_create"))
-      (i31.new (i32.const 0)))
+   (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $eval (string.const "new XMLHttpRequest"))))
 
-  (func (export "caml_js_on_ie")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_on_ie"))
-      (i31.new (i32.const 0)))
+   (func (export "caml_js_on_ie") (param (ref eq)) (result (ref eq))
+      (return_call $wrap
+         (call $eval
+            (string.const
+               "var ua = navigator?navigator.userAgent:\"\"; ua.indexOf(\"MSIE\") != -1 && ua.indexOf(\"Opera\") != 0"))))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index c31a6d6cc4..234f0f2af3 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,13 +1,13 @@
 #!/usr/bin/env -S node --experimental-wasm-stringref --experimental-wasm-gc
 (async function () {
+    "use strict";
     const src = 'CODE';
     function loadRelative(src) {
       const path = require('path');
       const f = path.join(path.dirname(require.main.filename),src);
       return require('fs/promises').readFile(f)
     }
-    const isNode =
-          this.process && process.versions && process.versions.node;
+    const isNode = globalThis?.process?.versions?.node;
     const code = isNode?loadRelative(src):fetch(src);
 
     var caml_callback, caml_alloc_tm;
@@ -212,6 +212,7 @@
                                 d.getDay(), doy,
                                 (d.getTimezoneOffset() < stdTimezoneOffset))
          },
+         mktime:(year,month,day,h,m,s)=>new Date(year,month,day,h,m,s).getTime(),
          random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
          log:(x)=>console.log('ZZZZZ', x)
         }
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index 3d1478ca2a..c123bda57c 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -72,4 +72,23 @@
    (func (export "caml_ml_mutex_unlock") (param (ref eq)) (result (ref eq))
       (struct.set $mutex 2 (ref.cast $mutex (local.get 0)) (i32.const 1))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_condition_new") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (data $condition_failure "Condition.wait: cannot wait")
+
+   (func (export "caml_ml_condition_wait")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (call $caml_failwith
+         (array.new_data $string $condition_failure
+            (i32.const 0) (i32.const 27)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_condition_signal") (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_condition_broadcast")
+      (param (ref eq)) (result (ref eq))
+      (i31.new (i32.const 0)))
 )
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index 67a7ab01b3..ea5f9f2262 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -39,6 +39,37 @@
    (func (export "unix_time") (param (ref eq)) (result (ref eq))
       (struct.new $float (f64.floor (call $gettimeofday))))
 
+   (func (export "unix_mktime") (param (ref eq)) (result (ref eq))
+      (local $tm (ref $block)) (local $t f64)
+      (local.set $tm (ref.cast $block (local.get 0)))
+      (local.set $t
+         (f64.div
+            (call $mktime
+               (i32.add
+                  (i31.get_s
+                     (ref.cast i31
+                       (array.get $block (local.get $tm) (i32.const 6))))
+                  (i32.const 1900))
+               (i31.get_s
+                  (ref.cast i31
+                     (array.get $block (local.get $tm) (i32.const 5))))
+               (i31.get_s
+                  (ref.cast i31
+                     (array.get $block (local.get $tm) (i32.const 4))))
+               (i31.get_s
+                  (ref.cast i31
+                     (array.get $block (local.get $tm) (i32.const 3))))
+               (i31.get_s
+                  (ref.cast i31
+                     (array.get $block (local.get $tm) (i32.const 2))))
+               (i31.get_s
+                  (ref.cast i31
+                     (array.get $block (local.get $tm) (i32.const 1)))))
+            (f64.const 1000)))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (struct.new $float (local.get $t))
+         (call $localtime (local.get $t))))
+
    (func (export "unix_inet_addr_of_string")
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))

From c01d7458c1b735edacb94ef06506ec5c4cc9749d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 2 Jun 2023 16:16:07 +0200
Subject: [PATCH 051/481] Fix lsr

---
 compiler/lib/eval.ml              | 12 +++++++-----
 compiler/lib/wasm/wa_gc_target.ml |  2 +-
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index e594350525..86e07a8b8c 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -36,9 +36,10 @@ let int_binop l w f =
   | [ Int (_, i); Int (_, j) ] -> Some (Int (Regular, w (f i j)))
   | _ -> None
 
-let shift l w f =
+let shift l w t f =
   match l with
-  | [ Int (_, i); Int (_, j) ] -> Some (Int (Regular, w (f i (Int32.to_int j land 0x1f))))
+  | [ Int (_, i); Int (_, j) ] ->
+      Some (Int (Regular, w (f (t i) (Int32.to_int j land 0x1f))))
   | _ -> None
 
 let float_binop_aux l f =
@@ -99,9 +100,10 @@ let eval_prim ~target x =
       | "%int_and", _ -> int_binop l wrap Int.logand
       | "%int_or", _ -> int_binop l wrap Int.logor
       | "%int_xor", _ -> int_binop l wrap Int.logxor
-      | "%int_lsl", _ -> shift l wrap Int.shift_left
-      | "%int_lsr", _ -> shift l wrap Int.shift_right_logical
-      | "%int_asr", _ -> shift l wrap Int.shift_right
+      | "%int_lsl", _ -> shift l wrap Fun.id Int.shift_left
+      | "%int_lsr", _ ->
+          shift l wrap (fun i -> Int.logand i 0x7fffffffl) Int.shift_right_logical
+      | "%int_asr", _ -> shift l wrap Fun.id Int.shift_right
       | "%int_neg", [ Int (_, i) ] -> Some (Int (Regular, Int.neg i))
       (* float *)
       | "caml_eq_float", _ -> float_binop_bool l Float.( = )
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index d6d60b8f01..6f4c4d4923 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -344,7 +344,7 @@ module Value = struct
 
   let int_lsl = binop Arith.( lsl )
 
-  let int_lsr = binop Arith.( lsr )
+  let int_lsr i i' = val_int Arith.((int_val i land const 0x7fffffffl) lsr int_val i')
 
   let int_asr = binop Arith.( asr )
 end

From 28fe0a270de4b9c6979ea782cf4917217cd2f45c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 2 Jun 2023 16:30:46 +0200
Subject: [PATCH 052/481] Runtime: caml_get_public_method

---
 runtime/wasm/obj.wat | 81 +++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 77 insertions(+), 4 deletions(-)

diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 002432a189..7cda5108c4 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -23,6 +23,8 @@
    (type $closure_last_arg
       (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
 
+   (type $int_array (array (mut i32)))
+
    (type $dummy_closure_1
       (sub $closure_last_arg
          (struct (field (ref $function_1)) (field (mut (ref null $closure))))))
@@ -267,11 +269,82 @@
             (i32.const 0) (i32.const 29)))
       (i31.new (i32.const 0)))
 
+   (global $method_cache (mut (ref $int_array))
+      (array.new $int_array (i32.const 0) (i32.const 8)))
+
    (func (export "caml_get_public_method")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_get_public_method"))
-      (i31.new (i32.const 0)))
+      (param $obj (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (local $meths (ref $block))
+      (local $tag i32) (local $cacheid i32) (local $ofs i32)
+      (local $li i32) (local $mi i32) (local $hi i32)
+      (local $a (ref $int_array)) (local $len i32)
+      (local.set $meths
+         (ref.cast $block
+            (array.get $block (ref.cast $block (local.get $obj)) (i32.const 1))))
+      (local.set $tag (i31.get_s (ref.cast i31 (local.get 1))))
+      (local.set $cacheid (i31.get_u (ref.cast i31 (local.get 2))))
+      (local.set $len (array.len (global.get $method_cache)))
+      (if (i32.ge_s (local.get $cacheid) (local.get $len))
+         (then
+            (loop $size
+               (local.set $len (i32.shl (local.get $len) (i32.const 1)))
+               (br_if $size (i32.ge_s (local.get $cacheid) (local.get $len))))
+            (local.set $a (array.new $int_array (i32.const 0) (local.get $len)))
+            (array.copy $int_array $int_array
+               (local.get $a) (i32.const 0)
+               (global.get $method_cache) (i32.const 0)
+               (array.len (global.get $method_cache)))
+            (global.set $method_cache (local.get $a))))
+      (local.set $ofs
+         (array.get $int_array (global.get $method_cache) (local.get $cacheid)))
+      (if (i32.eq (local.get $tag)
+             (i31.get_s
+                (ref.cast i31
+                   (array.get $block (local.get $meths) (local.get $ofs)))))
+         (then
+            (return
+               (array.get $block
+                  (local.get $meths) (i32.sub (local.get $ofs) (i32.const 1))))))
+      (local.set $li (i32.const 3))
+      (local.set $hi
+         (i32.add
+            (i32.shl
+               (i31.get_u
+                  (ref.cast i31
+                     (array.get $block (local.get $meths) (i32.const 1))))
+               (i32.const 1))
+            (i32.const 1)))
+      (loop $loop
+         (if (i32.lt_u (local.get $li) (local.get $hi))
+            (then
+               (local.set $mi
+                  (i32.or (i32.shr_u (i32.add (local.get $li) (local.get $hi))
+                                     (i32.const 1))
+                          (i32.const 1)))
+               (if (i32.lt_s
+                      (local.get $tag)
+                      (i31.get_s
+                         (ref.cast i31
+                            (array.get $block
+                               (local.get $meths)
+                               (i32.add (local.get $mi) (i32.const 1))))))
+                  (then
+                     (local.set $hi (i32.sub (local.get $mi) (i32.const 2))))
+                  (else
+                     (local.set $li (local.get $mi))))
+               (br $loop))))
+      (array.set $int_array (global.get $method_cache) (local.get $cacheid)
+         (i32.add (local.get $li) (i32.const 1)))
+      (if (result (ref eq))
+          (i32.eq (local.get $tag)
+             (i31.get_s
+                (ref.cast i31
+                   (array.get $block (local.get $meths)
+                      (i32.add (local.get $li) (i32.const 1))))))
+         (then
+            (array.get $block (local.get $meths) (local.get $li)))
+         (else
+            (i31.new (i32.const 0)))))
 
    (global $caml_oo_last_id (mut i32) (i32.const 0))
 

From 63bd04cae097e5e922f3337fe3199add77c00537 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 2 Jun 2023 16:58:25 +0200
Subject: [PATCH 053/481] Float conversion functions are no longer deprecated

---
 lib/js_of_ocaml/js.ml  |  8 ++++----
 lib/js_of_ocaml/js.mli | 14 ++++++--------
 2 files changed, 10 insertions(+), 12 deletions(-)

diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index 64fbab90dd..6dc5a16d3f 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -775,6 +775,10 @@ external bytestring : string -> js_string t = "caml_jsbytes_of_string"
 
 external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
 
+external float : float -> float = "caml_js_from_float"
+
+external to_float : float -> float = "caml_js_to_float"
+
 external typeof : _ t -> js_string t = "caml_js_typeof"
 
 external instanceof : _ t -> _ constr -> bool = "caml_js_instanceof"
@@ -822,7 +826,3 @@ let export_all obj =
 (* DEPRECATED *)
 
 type float_prop = float prop
-
-external float : float -> float = "%identity"
-
-external to_float : float -> float = "%identity"
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index e55dc77883..68743b1f0e 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -813,6 +813,12 @@ external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
       Javascript string should only contain UTF-16 code points below
       255.) *)
 
+external float : float -> float = "caml_js_from_float"
+(** Conversion of OCaml floats to Javascript numbers. *)
+
+external to_float : float -> float = "caml_js_to_float"
+(** Conversion of Javascript numbers to OCaml floats. *)
+
 (** {2 Convenience coercion functions} *)
 
 val coerce : 'a -> ('a -> 'b Opt.t) -> ('a -> 'b) -> 'b
@@ -1018,14 +1024,6 @@ exception Error of error t [@ocaml.deprecated "[since 4.0] Use [Js_error.Exn] in
     it will be serialized and wrapped into a [Failure] exception.
   *)
 
-external float : float -> float = "%identity" [@@ocaml.deprecated "[since 2.0]."]
-
-(** Conversion of OCaml floats to Javascript numbers. *)
-
-external to_float : float -> float = "%identity" [@@ocaml.deprecated "[since 2.0]."]
-
-(** Conversion of Javascript numbers to OCaml floats. *)
-
 type float_prop = float prop [@@ocaml.deprecated "[since 2.0]."]
 
 (** Type of float properties. *)

From 70658bc9425e991b97dd5829a74dccd87ad9088b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 5 Jun 2023 14:47:12 +0200
Subject: [PATCH 054/481] Runtime: many small fixes

---
 compiler/lib/eval.ml                | 10 ++++++++--
 compiler/lib/wasm/wa_core_target.ml |  2 ++
 compiler/lib/wasm/wa_gc_target.ml   |  5 +++++
 compiler/lib/wasm/wa_generate.ml    |  7 ++++---
 compiler/lib/wasm/wa_target_sig.ml  |  2 ++
 runtime/wasm/array.wat              |  9 +++++----
 runtime/wasm/float.wat              | 28 +++++++++++++++++++++++-----
 runtime/wasm/hash.wat               | 14 ++++++++++----
 runtime/wasm/int32.wat              |  5 +++--
 runtime/wasm/int64.wat              |  5 ++++-
 runtime/wasm/ints.wat               | 25 +++++++++++++++++--------
 runtime/wasm/jslib.wat              |  3 ++-
 runtime/wasm/runtime.js             |  2 --
 runtime/wasm/stdlib.wat             | 11 ++++++++---
 runtime/wasm/string.wat             |  4 ++--
 15 files changed, 95 insertions(+), 37 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 86e07a8b8c..be13381a0b 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -102,7 +102,13 @@ let eval_prim ~target x =
       | "%int_xor", _ -> int_binop l wrap Int.logxor
       | "%int_lsl", _ -> shift l wrap Fun.id Int.shift_left
       | "%int_lsr", _ ->
-          shift l wrap (fun i -> Int.logand i 0x7fffffffl) Int.shift_right_logical
+          shift
+            l
+            wrap
+            (match target with
+            | `JavaScript -> Fun.id
+            | `Wasm -> fun i -> Int.logand i 0x7fffffffl)
+            Int.shift_right_logical
       | "%int_asr", _ -> shift l wrap Fun.id Int.shift_right
       | "%int_neg", [ Int (_, i) ] -> Some (Int (Regular, Int.neg i))
       (* float *)
@@ -155,7 +161,7 @@ let eval_prim ~target x =
                ( Regular
                , match target with
                  | `JavaScript -> 32l
-                 | `Wasm -> 32l ))
+                 | `Wasm -> 31l ))
       | "caml_sys_const_big_endian", [ _ ] -> Some (Int (Regular, 0l))
       | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int (Regular, 0l))
       | _ -> None)
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 688d3725ca..84dd5399d9 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -587,6 +587,8 @@ module Math = struct
 
   let log10 f = unary "log10" f
 
+  let round f = unary "round" f
+
   let binary name x y =
     let* f = register_import ~name (Fun (float_func_type 2)) in
     let* x = x in
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 6f4c4d4923..e8b145e1c2 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -928,6 +928,11 @@ module Math = struct
   let power f g = binary "pow" f g
 
   let fmod f g = binary "fmod" f g
+
+  let round x =
+    let* f = register_import ~name:"caml_round" (Fun (float_func_type 1)) in
+    let* x = x in
+    return (W.Call (f, [ x ]))
 end
 
 let entry_point ~context = init_code context
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 29e9f898ea..0e31920e5b 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -127,8 +127,9 @@ module Generate (Target : Wa_target_sig.S) = struct
         let l = List.map ~f:transl_prim_arg l in
         match p, l with
         (*ZZZ array operations need to deal with array of unboxed floats *)
-        | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.array_get x y
-        | Extern "caml_array_unsafe_set", [ x; y; z ] ->
+        | Extern ("caml_array_unsafe_get" | "caml_floatarray_unsafe_get"), [ x; y ] ->
+            Memory.array_get x y
+        | Extern ("caml_array_unsafe_set" | "caml_floatarray_unsafe_set"), [ x; y; z ] ->
             seq (Memory.array_set x y z) Value.unit
         | Extern ("caml_string_unsafe_get" | "caml_bytes_unsafe_get"), [ x; y ] ->
             Memory.bytes_get x y
@@ -228,7 +229,7 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_ceil_float", [ f ] -> float_un_op stack_ctx x Ceil f
         | Extern "caml_floor_float", [ f ] -> float_un_op stack_ctx x Floor f
         | Extern "caml_trunc_float", [ f ] -> float_un_op stack_ctx x Trunc f
-        | Extern "caml_round_float", [ f ] -> float_un_op stack_ctx x Nearest f
+        | Extern "caml_round_float", [ f ] -> float_un_op' stack_ctx x Math.round f
         | Extern "caml_sqrt_float", [ f ] -> float_un_op stack_ctx x Sqrt f
         | Extern "caml_eq_float", [ f; g ] -> float_comparison Eq f g
         | Extern "caml_neq_float", [ f; g ] -> float_comparison Ne f g
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index a5d9346e94..9511096d5f 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -247,6 +247,8 @@ module type S = sig
     val power : expression -> expression -> expression
 
     val fmod : expression -> expression -> expression
+
+    val round : expression -> expression
   end
 
   val entry_point : context:Wa_code_generation.context -> unit Wa_code_generation.t
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index d3a5fecdf4..b049b07f45 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -60,7 +60,7 @@
          (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
          (i32.sub (local.get $l1) (i32.const 1)))
       (array.copy $block $block
-         (local.get $a) (i32.const 1) (local.get $a2) (local.get $l1)
+         (local.get $a) (local.get $l1) (local.get $a2) (i32.const 1)
          (i32.sub (local.get $l2) (i32.const 1)))
       (local.get $a))
 
@@ -85,6 +85,7 @@
              (br $compute_length))))
       (local.set $a
          (array.new $block (i31.new (i32.const 0)) (local.get $len)))
+      (local.set $l (local.get 0))
       (local.set $i (i32.const 1))
       (loop $fill
          (drop (block $exit (result (ref eq))
@@ -111,9 +112,9 @@
       (result (ref eq))
       (array.copy $block $block
          (ref.cast $block (local.get $a2))
-         (i31.get_s (ref.cast i31 (local.get $i2)))
+         (i32.add (i31.get_s (ref.cast i31 (local.get $i2))) (i32.const 1))
          (ref.cast $block (local.get $a1))
-         (i31.get_s (ref.cast i31 (local.get $i1)))
+         (i32.add (i31.get_s (ref.cast i31 (local.get $i1))) (i32.const 1))
          (i31.get_s (ref.cast i31 (local.get $len))))
       (i31.new (i32.const 0)))
 
@@ -121,7 +122,7 @@
       (param $a (ref eq)) (param $i (ref eq)) (param $len (ref eq))
       (param $v (ref eq)) (result (ref eq))
       (array.fill $block (ref.cast $block (local.get $a))
-         (i31.get_u (ref.cast i31 (local.get $i)))
+         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
          (local.get $v)
          (i31.get_u (ref.cast i31 (local.get $len))))
       (i31.new (i32.const 0)))
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index dfe98bb54c..490d76d30f 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -5,7 +5,7 @@
    (import "bindings" "format_float"
       (func $format_float
          (param i32) (param i32) (param f64) (result (ref string))))
-   (import "bindings" "parse_float"
+   (import "bindings" "identity"
       (func $parse_float (param anyref) (result f64)))
    (import "Math" "exp" (func $exp (param f64) (result f64)))
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
@@ -256,7 +256,8 @@
       (local.set $negative
          (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 63))))
       (local.set $i
-         (i32.or (local.get $negative) (local.get $sign_style)))
+         (i32.or (local.get $negative)
+                 (i32.ne (local.get $sign_style) (i32.const 0))))
       (local.set $s
          (block $sign (result (ref $string))
             (local.set $exp
@@ -271,7 +272,8 @@
                            (global.get $inf))
                         (else
                            (local.set $negative (i32.const 0))
-                           (local.set $i (local.get $sign_style))
+                           (local.set $i
+                              (i32.ne (local.get $sign_style) (i32.const 0)))
                            (global.get $nan))))
                   (local.set $len (array.len (local.get $txt)))
                   (local.set $s
@@ -633,7 +635,7 @@
          (array.new_data $string $float_of_string (i32.const 0) (i32.const 15)))
       (return (struct.new $float (f64.const 0))))
 
-   (func (export "caml_nextafter")
+   (func (export "caml_nextafter_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $x f64) (local $y f64) (local $i i64) (local $j i64)
       (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
@@ -841,7 +843,23 @@
       (i31.new
          (i32.add
             (i32.sub (f64.gt (local.get $x) (local.get $y))
-                     (f64.lt (local.get $y) (local.get $x)))
+                     (f64.lt (local.get $x) (local.get $y)))
             (i32.sub (f64.eq (local.get $x) (local.get $x))
                      (f64.eq (local.get $y) (local.get $y))))))
+
+   (func (export "caml_round") (param $x f64) (result f64)
+      (local $y f64)
+      (if (result f64) (f64.ge (local.get $x) (f64.const 0))
+         (then
+            (local.set $y (f64.floor (local.get $x)))
+            (if (result f64)
+                (f64.ge (f64.sub (local.get $x) (local.get $y)) (f64.const 0.5))
+               (then (f64.add (local.get $y) (f64.const 1)))
+               (else (local.get $y))))
+         (else
+            (local.set $y (f64.ceil (local.get $x)))
+            (if (result f64)
+                (f64.ge (f64.sub (local.get $y) (local.get $x)) (f64.const 0.5))
+               (then (f64.sub (local.get $y) (f64.const 1)))
+               (else (local.get $y))))))
 )
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index 5e5e99dffc..cf72169e67 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -145,8 +145,13 @@
                   (drop (block $not_int (result (ref eq))
                      (local.set $h
                         (call $caml_hash_mix_int (local.get $h)
-                           (i31.get_s
-                              (br_on_cast_fail $not_int i31 (local.get $v)))))
+                           (i32.add
+                              (i32.shl
+                                 (i31.get_s
+                                    (br_on_cast_fail $not_int i31
+                                       (local.get $v)))
+                                 (i32.const 1))
+                              (i32.const 1))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
                   (drop (block $not_string (result (ref eq))
@@ -187,7 +192,7 @@
                                        (global.get $MAX_FORWARD_DEREFERENCE)))
                                  (br $forward)))
                               (br $again))))
-                     (if (i32.eqz (local.get $tag) (global.get $object_tag))
+                     (if (i32.eq (local.get $tag) (global.get $object_tag))
                         (then
                            (local.set $h
                               (call $caml_hash_mix_int (local.get $h)
@@ -200,7 +205,8 @@
                      (local.set $h
                         (call $caml_hash_mix_int (local.get $h)
                            (i32.or
-                              (i32.sub (local.get $len) (i32.const 1))
+                              (i32.shl (i32.sub (local.get $len) (i32.const 1))
+                                 (i32.const 10))
                               (local.get $tag))))
                      (local.set $i (i32.const 1))
                      (loop $block_iter
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 45b18b1095..6c25ecc893 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -3,7 +3,8 @@
       (func $parse_int
          (param (ref eq)) (param i32) (param (ref $string)) (result i32)))
    (import "ints" "format_int"
-      (func $format_int (param (ref eq)) (param i32) (result (ref eq))))
+      (func $format_int
+         (param (ref eq)) (param i32) (param i32) (result (ref eq))))
 
    (type $string (array (mut i8)))
    (type $value->value->int
@@ -100,5 +101,5 @@
    (func $caml_int32_format (export "caml_int32_format")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (return_call $format_int (local.get 0)
-         (struct.get $int32 1 (ref.cast $int32 (local.get 1)))))
+         (struct.get $int32 1 (ref.cast $int32 (local.get 1))) (i32.const 0)))
 )
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index a6a2cfd2e7..ab859204b9 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -89,6 +89,8 @@
       (local $t (i32 i32 i32 i32))
       (local.set $s (ref.cast $string (local.get $v)))
       (local.set $len (array.len (local.get $s)))
+      (if (i32.eqz (local.get $len))
+        (then (call $caml_failwith (global.get $INT64_ERRMSG))))
       (local.set $t (call $parse_sign_and_base (local.get $s)))
       (local.set $i (tuple.extract 0 (local.get $t)))
       (local.set $signedness (tuple.extract 1 (local.get $t)))
@@ -259,7 +261,8 @@
                   (if (i64.eq (local.get $base) (i64.const 16))
                      (then
                         (array.set $string (local.get $s) (i32.const 1)
-                           (i32.const 120)))))))) ;; 'x'
+                           (select (i32.const 88) (i32.const 120) ;; 'X' 'x'
+                              (local.get $uppercase)))))))))
       (local.get $s))
 
 )
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index 12f4a364b2..48e4a697f9 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -8,7 +8,7 @@
    (func (export "caml_format_int")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (return_call $format_int
-         (local.get 0) (i31.get_s (ref.cast i31 (local.get 1)))))
+         (local.get 0) (i31.get_s (ref.cast i31 (local.get 1))) (i32.const 1)))
 
    (func $parse_sign_and_base (export "parse_sign_and_base")
       (param $s (ref $string)) (result i32 i32 i32 i32)
@@ -19,7 +19,7 @@
       (local.set $signedness (i32.const 1))
       (local.set $sign (i32.const 1))
       (local.set $base (i32.const 10))
-      (if (i32.eqz (local.get $len))
+      (if (i32.ne (local.get $len) (i32.const 0))
          (then
             (local.set $c (array.get_u $string (local.get $s) (i32.const 0)))
             (if (i32.eq (local.get $c) (i32.const 45))
@@ -85,6 +85,8 @@
       (local $t (i32 i32 i32 i32))
       (local.set $s (ref.cast $string (local.get $v)))
       (local.set $len (array.len (local.get $s)))
+      (if (i32.eqz (local.get $len))
+        (then (call $caml_failwith (local.get $errmsg))))
       (local.set $t (call $parse_sign_and_base (local.get $s)))
       (local.set $i (tuple.extract 0 (local.get $t)))
       (local.set $signedness (tuple.extract 1 (local.get $t)))
@@ -154,8 +156,8 @@
       (i31.new
          (i32.or
             (i32.shl (i32.and (local.get $x) (i32.const 0xFF)) (i32.const 8))
-            (i32.shr_u (i32.and (local.get $x) (i32.const 0x00FF))
-               (i32.const 8)))))
+            (i32.and
+               (i32.shr_u (local.get $x) (i32.const 8)) (i32.const 0xFF)))))
 
    (func (export "%caml_format_int_special") (param (ref eq)) (result (ref eq))
       (return_call $format_int_default
@@ -276,7 +278,7 @@
          (local.get $uppercase)))
 
    (func $format_int (export "format_int")
-      (param (ref eq)) (param $d i32) (result (ref eq))
+      (param (ref eq)) (param $d i32) (param $small i32) (result (ref eq))
       (local $s (ref $string))
       (local $format (i32 i32 i32 i32 i32))
       (local $sign_style i32) (local $alternate i32) (local $signed i32)
@@ -297,10 +299,17 @@
       (local.set $signed (tuple.extract 2 (local.get $format)))
       (local.set $base (tuple.extract 3 (local.get $format)))
       (local.set $uppercase (tuple.extract 4 (local.get $format)))
-      (if (i32.and (local.get $signed) (i32.lt_s (local.get $d) (i32.const 0)))
+      (if (i32.lt_s (local.get $d) (i32.const 0))
          (then
-            (local.set $negative (i32.const 1))
-            (local.set $d (i32.sub (i32.const 0) (local.get $d)))))
+            (if (local.get $signed)
+               (then
+                  (local.set $negative (i32.const 1))
+                  (local.set $d (i32.sub (i32.const 0) (local.get $d))))
+               (else
+                  (if (local.get $small)
+                     (then
+                        (local.set $d
+                           (i32.and (local.get $d) (i32.const 0x7fffffff)))))))))
       (local.set $n (local.get $d))
       (loop $count
          (local.set $i (i32.add (local.get $i) (i32.const 1)))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index b9a4d22e4e..3f7775c748 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -390,7 +390,8 @@
                            (i32.const 0xC0)))
                      (array.set $string (local.get $s')
                         (i32.add (local.get $n) (i32.const 1))
-                        (i32.and (local.get $c) (i32.const 0x3F)))
+                        (i32.or (i32.const 0x80)
+                           (i32.and (local.get $c) (i32.const 0x3F))))
                      (local.set $n (i32.add (local.get $n) (i32.const 2)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $fill))))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 234f0f2af3..65af9a6e2a 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -47,7 +47,6 @@
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,
-         get_int:(a,i)=>a[i],
          ta_create:(k,sz)=> new(typed_arrays[k])(sz),
          ta_normalize:(a)=>
            a instanceof Uint8ClampedArray?
@@ -127,7 +126,6 @@
              return caml_callback(f, args.length, args, 2);
          },
          wrap_fun_arguments:(f)=>function(){return f(arguments)},
-         parse_float:(s)=>+s,
          format_float:(prec, conversion, x)=>{
            function toFixed(x,dp) {
              if (Math.abs(x) < 1.0) {
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index 325885752d..da7e079277 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -5,6 +5,9 @@
    (import "string" "caml_string_equal"
       (func $caml_string_equal
          (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -35,15 +38,17 @@
             (local.set $l (struct.get $assoc 2 (local.get $a)))
             (br $loop))))
 
-   (func (export "caml_named_value") (param (ref eq)) (result (ref null eq))
+   (func (export "caml_named_value") (param anyref) (result (ref null eq))
+      (local $s (ref eq))
+      (local.set $s (call $caml_string_of_jsstring (call $wrap (local.get $0))))
       (return_call $find_named_value
-         (local.get 0)
+         (local.get $s)
          (array.get $assoc_array (global.get $named_value_table)
             (i32.rem_u
                (i31.get_s
                   (ref.cast i31
                      (call $caml_string_hash
-                        (i31.new (i32.const 0)) (local.get 0))))
+                        (i31.new (i32.const 0)) (local.get $s))))
                (global.get $Named_value_size)))))
 
    (func (export "caml_register_named_value")
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 6035a02ba6..718f26b050 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -127,7 +127,7 @@
    (func (export "caml_create_bytes")
       (param $len (ref eq)) (result (ref eq))
       (local $l i32)
-      (local.set $l (i31.get_u (ref.cast i31 (local.get $len))))
+      (local.set $l (i31.get_s (ref.cast i31 (local.get $len))))
       (if (i32.lt_s (local.get $l) (i32.const 0))
          (then
             (call $caml_invalid_argument
@@ -313,7 +313,7 @@
       (local.set $v (struct.get $int64 1 (ref.cast $int64 (local.get 2))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
-      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
                     (array.len (local.get $s)))
          (then (call $caml_bound_error)))
       (array.set $string (local.get $s) (local.get $p)

From 73b6409dd3aad778bcecb7a7f949ba48ddd46a15 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 5 Jun 2023 14:53:08 +0200
Subject: [PATCH 055/481] Runtime: use non-nullable types whenever possible

---
 runtime/wasm/bigarray.wat | 50 +++++++++++++++++-----------------
 runtime/wasm/jslib.wat    | 56 ++++++++++++++++++++++++---------------
 runtime/wasm/prng.wat     |  8 +++---
 runtime/wasm/sys.wat      |  8 +++---
 4 files changed, 68 insertions(+), 54 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 63761063e5..b1c05584e5 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -1,40 +1,41 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
    (import "bindings" "ta_create"
-      (func $ta_create (param i32) (param i32) (result externref)))
+      (func $ta_create (param i32) (param i32) (result (ref extern))))
    (import "bindings" "ta_normalize"
-      (func $ta_normalize (param externref) (result externref)))
-   (import "bindings" "ta_kind" (func $ta_kind (param externref) (result i32)))
+      (func $ta_normalize (param (ref extern)) (result (ref extern))))
+   (import "bindings" "ta_kind"
+      (func $ta_kind (param (ref extern)) (result i32)))
    (import "bindings" "ta_length"
-      (func $ta_length (param externref) (result i32)))
+      (func $ta_length (param (ref extern)) (result i32)))
    (import "bindings" "ta_get_f64"
-      (func $ta_get_f64 (param externref) (param i32) (result f64)))
+      (func $ta_get_f64 (param (ref extern)) (param i32) (result f64)))
    (import "bindings" "ta_get_f32"
-      (func $ta_get_f32 (param externref) (param i32) (result f64)))
+      (func $ta_get_f32 (param (ref extern)) (param i32) (result f64)))
    (import "bindings" "ta_get_i32"
-      (func $ta_get_i32 (param externref) (param i32) (result i32)))
+      (func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_get_i16"
-      (func $ta_get_i16 (param externref) (param i32) (result i32)))
+      (func $ta_get_i16 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_get_ui16"
-      (func $ta_get_ui16 (param externref) (param i32) (result i32)))
+      (func $ta_get_ui16 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_get_i8"
-      (func $ta_get_i8 (param externref) (param i32) (result i32)))
+      (func $ta_get_i8 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_get_ui8"
-      (func $ta_get_ui8 (param externref) (param i32) (result i32)))
+      (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_set_f64"
-      (func $ta_set_f64 (param externref) (param i32) (param f64)))
+      (func $ta_set_f64 (param (ref extern)) (param i32) (param f64)))
    (import "bindings" "ta_set_f32"
-      (func $ta_set_f32 (param externref) (param i32) (param f64)))
+      (func $ta_set_f32 (param (ref extern)) (param i32) (param f64)))
    (import "bindings" "ta_set_i32"
-      (func $ta_set_i32 (param externref) (param i32) (param i32)))
+      (func $ta_set_i32 (param (ref extern)) (param i32) (param i32)))
    (import "bindings" "ta_set_i16"
-      (func $ta_set_i16 (param externref) (param i32) (param (ref i31))))
+      (func $ta_set_i16 (param (ref extern)) (param i32) (param (ref i31))))
    (import "bindings" "ta_set_ui16"
-      (func $ta_set_ui16 (param externref) (param i32) (param (ref i31))))
+      (func $ta_set_ui16 (param (ref extern)) (param i32) (param (ref i31))))
    (import "bindings" "ta_set_i8"
-      (func $ta_set_i8 (param externref) (param i32) (param (ref i31))))
+      (func $ta_set_i8 (param (ref extern)) (param i32) (param (ref i31))))
    (import "bindings" "ta_set_ui8"
-      (func $ta_set_ui8 (param externref) (param i32) (param (ref i31))))
+      (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31))))
    (import "fail" "caml_bound_error" (func $caml_bound_error))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
@@ -82,7 +83,7 @@
       (sub $custom
          (struct
             (field (ref $custom_operations))
-            (field externref) ;; data
+            (field (ref extern)) ;; data
             (field (ref $int_array)) ;; size in each dimension
             (field i8) ;; number of dimensions
             (field i8) ;; kind
@@ -122,7 +123,7 @@
                         (i32.eq (local.get $kind) (i32.const 11))))))
 
   (func $caml_ba_create_buffer
-     (param $kind i32) (param $sz i32) (result externref)
+     (param $kind i32) (param $sz i32) (result (ref extern))
      (return_call $ta_create (local.get $kind)
         ;; ZZZ Check for overflow
         (i32.mul (local.get $sz)
@@ -180,11 +181,12 @@
    (data $ta_too_large "Typed_array.to_genarray: too large")
 
    (func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq))
-      (local $data externref)
+      (local $data (ref extern))
       (local $kind i32)
       (local $len i32)
       (local.set $data
-         (call $ta_normalize (extern.externalize (call $unwrap (local.get 0)))))
+         (call $ta_normalize
+            (ref.as_non_null (extern.externalize (call $unwrap (local.get 0))))))
       (local.set $kind (call $ta_kind (local.get $data)))
       (if (i32.lt_s (local.get $kind) (i32.const 0))
          (then
@@ -212,7 +214,7 @@
 
    (func $caml_ba_get_at_offset
       (param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
-      (local $data externref)
+      (local $data (ref extern))
       (local.set $data (struct.get $bigarray 1 (local.get $ba)))
       (block $float32
        (block $float64
@@ -280,7 +282,7 @@
 
    (func $caml_ba_set_at_offset
       (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq))
-      (local $data externref)
+      (local $data (ref extern))
       (local $b (ref $block)) (local $l i64)
       (local.set $data (struct.get $bigarray 1 (local.get $ba)))
       (block $float32
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 3f7775c748..524f65c57f 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -2,32 +2,41 @@
    (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
    (import "bindings" "identity" (func $from_float (param f64) (result anyref)))
    (import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
-   (import "bindings" "identity" (func $ref_cast_string (param anyref) (result stringref)))
+   (import "bindings" "identity"
+      (func $ref_cast_string (param anyref) (result (ref string))))
    (import "bindings" "from_bool" (func $from_bool (param i32) (result anyref)))
    (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
-   (import "bindings" "get" (func $get (param externref) (param anyref) (result anyref)))
-   (import "bindings" "set" (func $set (param anyref) (param anyref) (param anyref)))
+   (import "bindings" "get"
+      (func $get (param (ref extern)) (param anyref) (result anyref)))
+   (import "bindings" "set"
+      (func $set (param anyref) (param anyref) (param anyref)))
    (import "bindings" "delete" (func $delete (param anyref) (param anyref)))
    (import "bindings" "instanceof"
       (func $instanceof (param anyref) (param anyref) (result i32)))
    (import "bindings" "typeof" (func $typeof (param anyref) (result anyref)))
-   (import "bindings" "equals" (func $equals (param anyref) (param anyref) (result i32)))
-   (import "bindings" "strict_equals" (func $strict_equals (param anyref) (param anyref) (result i32)))
+   (import "bindings" "equals"
+      (func $equals (param anyref) (param anyref) (result i32)))
+   (import "bindings" "strict_equals"
+      (func $strict_equals (param anyref) (param anyref) (result i32)))
    (import "bindings" "fun_call"
       (func $fun_call
          (param anyref) (param anyref) (param anyref) (result anyref)))
-   (import "bindings" "meth_call" (func $meth_call (param anyref) (param anyref) (param anyref) (result anyref)))
-   (import "bindings" "new" (func $new (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "meth_call"
+      (func $meth_call
+         (param anyref) (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "new"
+      (func $new (param anyref) (param anyref) (result anyref)))
    (import "bindings" "new_obj" (func $new_obj (result anyref)))
-   (import "bindings" "new_array" (func $new_array (param i32) (result externref)))
+   (import "bindings" "new_array"
+      (func $new_array (param i32) (result (ref extern))))
    (import "bindings" "iter_props"
       (func $iter_props (param anyref) (param anyref)))
    (import "bindings" "array_length"
-      (func $array_length (param externref) (result i32)))
+      (func $array_length (param (ref extern)) (result i32)))
    (import "bindings" "array_get"
-      (func $array_get (param externref) (param i32) (result anyref)))
+      (func $array_get (param (ref extern)) (param i32) (result anyref)))
    (import "bindings" "array_set"
-      (func $array_set (param externref) (param i32) (param anyref)))
+      (func $array_set (param (ref extern)) (param i32) (param anyref)))
    (import "bindings" "wrap_callback"
       (func $wrap_callback (param (ref eq)) (result anyref)))
    (import "bindings" "wrap_callback_args"
@@ -41,12 +50,12 @@
    (import "bindings" "wrap_meth_callback_args"
       (func $wrap_meth_callback_args (param (ref eq)) (result anyref)))
    (import "bindings" "wrap_meth_callback_strict"
-      (func $wrap_meth_callback_strict (param i32) (param (ref eq)) (result anyref)))
+      (func $wrap_meth_callback_strict
+         (param i32) (param (ref eq)) (result anyref)))
    (import "bindings" "wrap_meth_callback_unsafe"
       (func $wrap_meth_callback_unsafe (param (ref eq)) (result anyref)))
    (import "bindings" "wrap_fun_arguments"
       (func $wrap_fun_arguments (param anyref) (result anyref)))
-   (import "bindings" "get_int" (func $get_int (param externref) (param i32) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
@@ -140,7 +149,8 @@
          (then
             (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
       (return_call $wrap
-         (call $get (extern.externalize (call $unwrap (local.get 0)))
+         (call $get
+            (ref.as_non_null (extern.externalize (call $unwrap (local.get 0))))
             (call $unwrap (local.get 1)))))
 
    (func (export "caml_js_set")
@@ -215,7 +225,7 @@
    (func $caml_js_from_array (export "caml_js_from_array")
       (param (ref eq)) (result (ref eq))
       (local $a (ref $block))
-      (local $a' externref)
+      (local $a' (ref extern))
       (local $i i32) (local $l i32)
       (local.set $a (ref.cast $block (local.get 0)))
       (local.set $l (i32.sub (array.len (local.get $a)) (i32.const 1)))
@@ -233,10 +243,11 @@
 
    (func (export "caml_js_to_array")
       (param (ref eq)) (result (ref eq))
-      (local $a externref)
+      (local $a (ref extern))
       (local $a' (ref $block))
       (local $i i32) (local $l i32)
-      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
+      (local.set $a
+         (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
       (local.set $l (call $array_length (local.get $a)))
       (local.set $a'
          (array.new $block (i31.new (i32.const 0))
@@ -402,7 +413,7 @@
    (export "caml_js_to_string" (func $caml_string_of_jsstring))
    (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
       (param (ref eq)) (result (ref eq))
-      (local $s stringref)
+      (local $s (ref string))
       (local $l i32)
       (local $s' (ref $string))
       ;; ZZZ ref.cast string not yet implemented by V8
@@ -416,7 +427,7 @@
 
    (func (export "caml_string_of_jsbytes")
       (param (ref eq)) (result (ref eq))
-      (local $s stringref)
+      (local $s (ref string))
       (local $l i32) (local $i i32) (local $n i32) (local $c i32)
       (local $s' (ref $string)) (local $s'' (ref $string))
       ;; ZZZ ref.cast string not yet implemented by V8
@@ -469,7 +480,7 @@
    (func (export "caml_list_to_js_array")
       (param (ref eq)) (result (ref eq))
       (local $i i32)
-      (local $a externref)
+      (local $a (ref extern))
       (local $l (ref eq))
       (local $b (ref $block))
       (local.set $i (i32.const 0))
@@ -499,8 +510,9 @@
       (local $l (ref eq))
       (local $i i32)
       (local $len i32)
-      (local $a externref)
-      (local.set $a (extern.externalize (call $unwrap (local.get 0))))
+      (local $a (ref extern))
+      (local.set $a
+         (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
       (local.set $len (call $array_length (local.get $a)))
       (local.set $i (i32.const 0))
       (local.set $l (i31.new (i32.const 0)))
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index 8c2b48ee9e..82e656da1d 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -2,9 +2,9 @@
    (import "int64" "caml_copy_int64"
       (func $caml_copy_int64 (param i64) (result (ref eq))))
    (import "bindings" "ta_get_i32"
-      (func $ta_get_i32 (param externref) (param i32) (result i32)))
+      (func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_set_i32"
-      (func $ta_set_i32 (param externref) (param i32) (param i32)))
+      (func $ta_set_i32 (param (ref extern)) (param i32) (param i32)))
 
    (type $value->value->int
       (func (param (ref eq)) (param (ref eq)) (result i32)))
@@ -23,14 +23,14 @@
       (sub $custom
          (struct
             (field (ref $custom_operations))
-            (field externref) ;; data
+            (field (ref extern)) ;; data
             (field (ref $int_array)) ;; size in each dimension
             (field i8) ;; number of dimensions
             (field i8) ;; kind
             (field i8)))) ;; layout
 
    (func (export "caml_lxm_next") (param $v (ref eq)) (result (ref eq))
-      (local $data externref)
+      (local $data (ref extern))
       (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64)
       (local $z i64)
       (local.set $data
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index e5c59cca99..16965e194b 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -1,10 +1,10 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
    (import "bindings" "ta_length"
-      (func $ta_length (param externref) (result i32)))
+      (func $ta_length (param (ref extern)) (result i32)))
    (import "bindings" "ta_get_i32"
-      (func $ta_get_i32 (param externref) (param i32) (result i32)))
-   (import "bindings" "random_seed" (func $random_seed (result externref)))
+      (func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
+   (import "bindings" "random_seed" (func $random_seed (result (ref extern))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "jslib" "caml_jsstring_of_string"
       (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
@@ -55,7 +55,7 @@
 
    (func (export "caml_sys_random_seed")
       (param (ref eq)) (result (ref eq))
-      (local $r externref)
+      (local $r (ref extern))
       (local $a (ref $block))
       (local $i i32) (local $n i32)
       (local.set $r (call $random_seed))

From 9cc75b04524845daa08023134ccf3daf118e5f71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 5 Jun 2023 14:59:56 +0200
Subject: [PATCH 056/481] More runtime functions

---
 runtime/wasm/bigarray.wat |  18 +-
 runtime/wasm/md5.wat      | 492 +++++++++++++++++++++++++++++++++++++-
 2 files changed, 503 insertions(+), 7 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index b1c05584e5..c356c654eb 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -412,7 +412,19 @@
       (i31.new (i32.const 0)))
 
    (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
-      ;; ZZZ used to convert a typed array to a string...
-      (call $log_js (string.const "caml_string_of_array"))
-      (unreachable))
+      ;; used to convert a typed array to a string
+      (local $a (ref extern)) (local $len i32) (local $i i32)
+      (local $s (ref $string))
+      (local.set $a
+         (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
+      (local.set $len (call $ta_length (local.get $a)))
+      (local.set $s (array.new $string (i32.const 0) (local.get $len)))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (array.set $string (local.get $s) (local.get $i)
+                  (call $ta_get_ui8 (local.get $a) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $s))
 )
diff --git a/runtime/wasm/md5.wat b/runtime/wasm/md5.wat
index 8de99ca310..dbf4aaaba0 100644
--- a/runtime/wasm/md5.wat
+++ b/runtime/wasm/md5.wat
@@ -1,15 +1,499 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
 
+   (type $string (array (mut i8)))
+   (type $int_array (array (mut i32)))
+
+   (type $context
+      (struct
+         (field (ref $int_array)) ;; w
+         (field (mut i64))        ;; len
+         (field (ref $int_array)) ;; buffer
+         (field (ref $string))))  ;; intermediate buffer
+
    (func (export "caml_md5_string")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_md5_string"))
-      (i31.new (i32.const 0)))
+      (local $ctx (ref $context))
+      (local.set $ctx (call $MD5Init))
+      (call $MD5Update (local.get $ctx) (ref.cast $string (local.get 0))
+         (i31.get_u (ref.cast i31 (local.get 1)))
+         (i31.get_u (ref.cast i31 (local.get 2))))
+      (return_call $MD5Final (local.get $ctx)))
 
    (func (export "caml_md5_chan")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_md5_chan"))
-      (i31.new (i32.const 0)))
+      (array.new $string (i32.const 0) (i32.const 16)))
+
+   (func $xx
+      (param $q i32) (param $a i32) (param $b i32) (param $x i32) (param $s i32)
+      (param $t i32) (result i32)
+      (i32.add
+         (i32.rotl
+            (i32.add
+               (i32.add (local.get $a) (local.get $q))
+               (i32.add (local.get $x) (local.get $t)))
+            (local.get $s))
+         (local.get $b)))
+
+   (func $ff
+      (param $a i32) (param $b i32) (param $c i32) (param $d i32) (param $x i32)
+      (param $s i32) (param $t i32) (result i32)
+      (call $xx
+         (i32.xor (local.get $d)
+            (i32.and (local.get $b) (i32.xor (local.get $c) (local.get $d))))
+         (local.get $a) (local.get $b)
+         (local.get $x) (local.get $s) (local.get $t)))
+
+   (func $gg
+      (param $a i32) (param $b i32) (param $c i32) (param $d i32) (param $x i32)
+      (param $s i32) (param $t i32) (result i32)
+      (call $xx
+         (i32.xor (local.get $c)
+            (i32.and (local.get $d) (i32.xor (local.get $b) (local.get $c))))
+         (local.get $a) (local.get $b)
+         (local.get $x) (local.get $s) (local.get $t)))
+
+   (func $hh
+      (param $a i32) (param $b i32) (param $c i32) (param $d i32) (param $x i32)
+      (param $s i32) (param $t i32) (result i32)
+      (call $xx
+         (i32.xor (local.get $b) (i32.xor (local.get $c) (local.get $d)))
+         (local.get $a) (local.get $b)
+         (local.get $x) (local.get $s) (local.get $t)))
+
+   (func $ii
+      (param $a i32) (param $b i32) (param $c i32) (param $d i32) (param $x i32)
+      (param $s i32) (param $t i32) (result i32)
+      (call $xx
+         (i32.xor (local.get $c)
+            (i32.or (local.get $b) (i32.xor (local.get $d) (i32.const -1))))
+         (local.get $a) (local.get $b)
+         (local.get $x) (local.get $s) (local.get $t)))
+
+   (func $get_32 (param $s (ref $string)) (param $p i32) (result i32)
+       (i32.or
+          (i32.or
+             (array.get_u $string (local.get $s) (local.get $p))
+             (i32.shl (array.get_u $string (local.get $s)
+                         (i32.add (local.get $p) (i32.const 1)))
+                      (i32.const 8)))
+          (i32.or
+             (i32.shl (array.get_u $string (local.get $s)
+                         (i32.add (local.get $p) (i32.const 2)))
+                      (i32.const 16))
+             (i32.shl (array.get_u $string (local.get $s)
+                         (i32.add (local.get $p) (i32.const 3)))
+                        (i32.const 24)))))
+
+   (func $MD5Transform
+      (param $w (ref $int_array)) (param $buffer (ref $int_array))
+      (param $buffer' (ref $string)) (param $p i32)
+      (local $i i32)
+      (local $a i32) (local $b i32) (local $c i32) (local $d i32)
+      (loop $loop
+         (array.set $int_array (local.get $buffer) (local.get $i)
+            (call $get_32 (local.get $buffer') (local.get $p)))
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (local.set $p (i32.add (local.get $p) (i32.const 4)))
+         (br_if $loop (i32.lt_u (local.get $i) (i32.const 16))))
+      (local.set $a (array.get $int_array (local.get $w) (i32.const 0)))
+      (local.set $b (array.get $int_array (local.get $w) (i32.const 1)))
+      (local.set $c (array.get $int_array (local.get $w) (i32.const 2)))
+      (local.set $d (array.get $int_array (local.get $w) (i32.const 3)))
+      (local.set $a
+         (call $ff (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  0))
+            (i32.const 7) (i32.const 0xD76AA478)))
+      (local.set $d
+         (call $ff (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  1))
+            (i32.const 12) (i32.const 0xE8C7B756)))
+      (local.set $c
+         (call $ff (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  2))
+            (i32.const 17) (i32.const 0x242070DB)))
+      (local.set $b
+         (call $ff (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  3))
+            (i32.const 22) (i32.const 0xC1BDCEEE)))
+      (local.set $a
+         (call $ff (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  4))
+            (i32.const 7) (i32.const 0xF57C0FAF)))
+      (local.set $d
+         (call $ff (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  5))
+            (i32.const 12) (i32.const 0x4787C62A)))
+      (local.set $c
+         (call $ff (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  6))
+            (i32.const 17) (i32.const 0xA8304613)))
+      (local.set $b
+         (call $ff (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  7))
+            (i32.const 22) (i32.const 0xFD469501)))
+      (local.set $a
+         (call $ff (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  8))
+            (i32.const 7) (i32.const 0x698098D8)))
+      (local.set $d
+         (call $ff (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  9))
+            (i32.const 12) (i32.const 0x8B44F7AF)))
+      (local.set $c
+         (call $ff (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 10))
+            (i32.const 17) (i32.const 0xFFFF5BB1)))
+      (local.set $b
+         (call $ff (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const 11))
+            (i32.const 22) (i32.const 0x895CD7BE)))
+      (local.set $a
+         (call $ff (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const 12))
+            (i32.const 7) (i32.const 0x6B901122)))
+      (local.set $d
+         (call $ff (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const 13))
+            (i32.const 12) (i32.const 0xFD987193)))
+      (local.set $c
+         (call $ff (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 14))
+            (i32.const 17) (i32.const 0xA679438E)))
+      (local.set $b
+         (call $ff (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const 15))
+            (i32.const 22) (i32.const 0x49B40821)))
+      (local.set $a
+         (call $gg (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  1))
+            (i32.const 5) (i32.const 0xF61E2562)))
+      (local.set $d
+         (call $gg (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  6))
+            (i32.const 9) (i32.const 0xC040B340)))
+      (local.set $c
+         (call $gg (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 11))
+            (i32.const 14) (i32.const 0x265E5A51)))
+      (local.set $b
+         (call $gg (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  0))
+            (i32.const 20) (i32.const 0xE9B6C7AA)))
+      (local.set $a
+         (call $gg (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  5))
+            (i32.const 5) (i32.const 0xD62F105D)))
+      (local.set $d
+         (call $gg (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const 10))
+            (i32.const 9) (i32.const 0x02441453)))
+      (local.set $c
+         (call $gg (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 15))
+            (i32.const 14) (i32.const 0xD8A1E681)))
+      (local.set $b
+         (call $gg (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  4))
+            (i32.const 20) (i32.const 0xE7D3FBC8)))
+      (local.set $a
+         (call $gg (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  9))
+            (i32.const 5) (i32.const 0x21E1CDE6)))
+      (local.set $d
+         (call $gg (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const 14))
+            (i32.const 9) (i32.const 0xC33707D6)))
+      (local.set $c
+         (call $gg (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  3))
+            (i32.const 14) (i32.const 0xF4D50D87)))
+      (local.set $b
+         (call $gg (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  8))
+            (i32.const 20) (i32.const 0x455A14ED)))
+      (local.set $a
+         (call $gg (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const 13))
+            (i32.const 5) (i32.const 0xA9E3E905)))
+      (local.set $d
+         (call $gg (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  2))
+            (i32.const 9) (i32.const 0xFCEFA3F8)))
+      (local.set $c
+         (call $gg (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  7))
+            (i32.const 14) (i32.const 0x676F02D9)))
+      (local.set $b
+         (call $gg (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const 12))
+            (i32.const 20) (i32.const 0x8D2A4C8A)))
+      (local.set $a
+         (call $hh (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  5))
+            (i32.const 4) (i32.const 0xFFFA3942)))
+      (local.set $d
+         (call $hh (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  8))
+            (i32.const 11) (i32.const 0x8771F681)))
+      (local.set $c
+         (call $hh (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 11))
+            (i32.const 16) (i32.const 0x6D9D6122)))
+      (local.set $b
+         (call $hh (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const 14))
+            (i32.const 23) (i32.const 0xFDE5380C)))
+      (local.set $a
+         (call $hh (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  1))
+            (i32.const 4) (i32.const 0xA4BEEA44)))
+      (local.set $d
+         (call $hh (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  4))
+            (i32.const 11) (i32.const 0x4BDECFA9)))
+      (local.set $c
+         (call $hh (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  7))
+            (i32.const 16) (i32.const 0xF6BB4B60)))
+      (local.set $b
+         (call $hh (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const 10))
+            (i32.const 23) (i32.const 0xBEBFBC70)))
+      (local.set $a
+         (call $hh (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const 13))
+            (i32.const 4) (i32.const 0x289B7EC6)))
+      (local.set $d
+         (call $hh (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  0))
+            (i32.const 11) (i32.const 0xEAA127FA)))
+      (local.set $c
+         (call $hh (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  3))
+            (i32.const 16) (i32.const 0xD4EF3085)))
+      (local.set $b
+         (call $hh (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  6))
+            (i32.const 23) (i32.const 0x04881D05)))
+      (local.set $a
+         (call $hh (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  9))
+            (i32.const 4) (i32.const 0xD9D4D039)))
+      (local.set $d
+         (call $hh (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const 12))
+            (i32.const 11) (i32.const 0xE6DB99E5)))
+      (local.set $c
+         (call $hh (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 15))
+            (i32.const 16) (i32.const 0x1FA27CF8)))
+      (local.set $b
+         (call $hh (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  2))
+            (i32.const 23) (i32.const 0xC4AC5665)))
+      (local.set $a
+         (call $ii (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  0))
+            (i32.const 6) (i32.const 0xF4292244)))
+      (local.set $d
+         (call $ii (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  7))
+            (i32.const 10) (i32.const 0x432AFF97)))
+      (local.set $c
+         (call $ii (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 14))
+            (i32.const 15) (i32.const 0xAB9423A7)))
+      (local.set $b
+         (call $ii (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  5))
+            (i32.const 21) (i32.const 0xFC93A039)))
+      (local.set $a
+         (call $ii (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const 12))
+            (i32.const 6) (i32.const 0x655B59C3)))
+      (local.set $d
+         (call $ii (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const  3))
+            (i32.const 10) (i32.const 0x8F0CCC92)))
+      (local.set $c
+         (call $ii (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const 10))
+            (i32.const 15) (i32.const 0xFFEFF47D)))
+      (local.set $b
+         (call $ii (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  1))
+            (i32.const 21) (i32.const 0x85845DD1)))
+      (local.set $a
+         (call $ii (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  8))
+            (i32.const 6) (i32.const 0x6FA87E4F)))
+      (local.set $d
+         (call $ii (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const 15))
+            (i32.const 10) (i32.const 0xFE2CE6E0)))
+      (local.set $c
+         (call $ii (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  6))
+            (i32.const 15) (i32.const 0xA3014314)))
+      (local.set $b
+         (call $ii (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const 13))
+            (i32.const 21) (i32.const 0x4E0811A1)))
+      (local.set $a
+         (call $ii (local.get $a) (local.get $b) (local.get $c) (local.get $d)
+            (array.get $int_array (local.get $buffer) (i32.const  4))
+            (i32.const 6) (i32.const 0xF7537E82)))
+      (local.set $d
+         (call $ii (local.get $d) (local.get $a) (local.get $b) (local.get $c)
+            (array.get $int_array (local.get $buffer) (i32.const 11))
+            (i32.const 10) (i32.const 0xBD3AF235)))
+      (local.set $c
+         (call $ii (local.get $c) (local.get $d) (local.get $a) (local.get $b)
+            (array.get $int_array (local.get $buffer) (i32.const  2))
+            (i32.const 15) (i32.const 0x2AD7D2BB)))
+      (local.set $b
+         (call $ii (local.get $b) (local.get $c) (local.get $d) (local.get $a)
+            (array.get $int_array (local.get $buffer) (i32.const  9))
+            (i32.const 21) (i32.const 0xEB86D391)))
+      (array.set $int_array (local.get $w) (i32.const 0)
+         (i32.add (array.get $int_array (local.get $w) (i32.const 0))
+                  (local.get $a)))
+      (array.set $int_array (local.get $w) (i32.const 1)
+         (i32.add (array.get $int_array (local.get $w) (i32.const 1))
+                  (local.get $b)))
+      (array.set $int_array (local.get $w) (i32.const 2)
+         (i32.add (array.get $int_array (local.get $w) (i32.const 2))
+                  (local.get $c)))
+      (array.set $int_array (local.get $w) (i32.const 3)
+         (i32.add (array.get $int_array (local.get $w) (i32.const 3))
+                  (local.get $d))))
+
+   (func $MD5Init (result (ref $context))
+       (struct.new $context
+          (array.new_fixed $int_array
+             (i32.const 0x67452301) (i32.const 0xEFCDAB89)
+             (i32.const 0x98BADCFE) (i32.const 0x10325476))
+          (i64.const 0)
+          (array.new $int_array (i32.const 0) (i32.const 16))
+          (array.new $string (i32.const 0) (i32.const 64))))
+
+   (func $MD5Update
+      (param $ctx (ref $context)) (param $input (ref $string))
+      (param $input_pos i32) (param $input_len i32)
+      (local $in_buf i32) (local $len i64)
+      (local $missing i32)
+      (local.set $len (struct.get $context 1 (local.get $ctx)))
+      (local.set $in_buf
+         (i32.and (i32.wrap_i64 (local.get $len)) (i32.const 0x3f)))
+      (struct.set $context 1 (local.get $ctx)
+         (i64.add (local.get $len) (i64.extend_i32_u (local.get $input_len))))
+      (if (local.get $in_buf)
+         (then
+            (local.set $missing (i32.sub (i32.const 64) (local.get $in_buf)))
+            (if (i32.lt_u (local.get $input_len) (local.get $missing))
+               (then
+                  (array.copy $string $string
+                     (struct.get $context 3 (local.get $ctx))
+                     (local.get $missing)
+                     (local.get $input) (local.get $input_pos)
+                     (local.get $input_len))
+                  (return)))
+            (array.copy $string $string
+               (struct.get $context 3 (local.get $ctx))
+               (local.get $missing)
+               (local.get $input) (local.get $input_pos) (local.get $missing))
+            (call $MD5Transform (struct.get $context 0 (local.get $ctx))
+               (struct.get $context 2 (local.get $ctx))
+               (struct.get $context 3 (local.get $ctx))
+               (i32.const 0))
+            (local.set $input_pos
+               (i32.add (local.get $input_pos) (local.get $missing)))
+            (local.set $input_len
+               (i32.sub (local.get $input_len) (local.get $missing)))))
+      (loop $loop
+         (if (i32.ge_u (local.get $input_len) (i32.const 64))
+            (then
+               (call $MD5Transform (struct.get $context 0 (local.get $ctx))
+                  (struct.get $context 2 (local.get $ctx))
+                  (local.get $input)
+                  (local.get $input_pos))
+                (local.set $input_pos
+                   (i32.add (local.get $input_pos) (i32.const 64)))
+                (local.set $input_len
+                   (i32.sub (local.get $input_len) (i32.const 64)))
+                (br $loop))))
+      (if (local.get $input_len)
+         (then
+            (array.copy $string $string
+               (struct.get $context 3 (local.get $ctx)) (i32.const 0)
+               (local.get $input) (local.get $input_pos)
+               (local.get $input_len)))))
+
+   (func $MD5Final (param $ctx (ref $context)) (result (ref $string))
+      (local $in_buf i32) (local $i i32) (local $len i64)
+      (local $w (ref $int_array))
+      (local $buffer (ref $string)) (local $res (ref $string))
+      (local.set $len (struct.get $context 1 (local.get $ctx)))
+      (local.set $in_buf
+         (i32.and (i32.wrap_i64 (local.get $len)) (i32.const 0x3f)))
+      (local.set $buffer (struct.get $context 3 (local.get $ctx)))
+      (array.set $string (local.get $buffer) (local.get $in_buf)
+         (i32.const 0x80))
+      (local.set $in_buf (i32.add (local.get $in_buf) (i32.const 1)))
+      (if (i32.gt_u (local.get $in_buf) (i32.const 56))
+         (then
+            (local.set $i (local.get $in_buf))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (i32.const 64))
+                  (then
+                     (array.set $string
+                        (local.get $buffer) (local.get $i) (i32.const 0))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (call $MD5Transform (struct.get $context 0 (local.get $ctx))
+               (struct.get $context 2 (local.get $ctx))
+               (local.get $buffer)
+               (i32.const 0))
+            (local.set $in_buf (i32.const 0))))
+      (local.set $i (local.get $in_buf))
+      (loop $loop
+         (array.set $string (local.get $buffer) (local.get $i) (i32.const 0))
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (br_if $loop (i32.lt_u (local.get $i) (i32.const 56))))
+      (local.set $len (i64.shl (local.get $len) (i64.const 3)))
+      (array.set $string (local.get $buffer) (i32.const 56)
+         (i32.wrap_i64 (local.get $len)))
+      (array.set $string (local.get $buffer) (i32.const 57)
+         (i32.wrap_i64 (i64.shr_u (local.get $len) (i64.const 8))))
+      (array.set $string (local.get $buffer) (i32.const 58)
+         (i32.wrap_i64 (i64.shr_u (local.get $len) (i64.const 16))))
+      (array.set $string (local.get $buffer) (i32.const 59)
+         (i32.wrap_i64 (i64.shr_u (local.get $len) (i64.const 24))))
+      (array.set $string (local.get $buffer) (i32.const 60)
+         (i32.wrap_i64 (i64.shr_u (local.get $len) (i64.const 32))))
+      (array.set $string (local.get $buffer) (i32.const 61)
+         (i32.wrap_i64 (i64.shr_u (local.get $len) (i64.const 40))))
+      (array.set $string (local.get $buffer) (i32.const 62)
+         (i32.wrap_i64 (i64.shr_u (local.get $len) (i64.const 48))))
+      (array.set $string (local.get $buffer) (i32.const 63)
+         (i32.wrap_i64 (i64.shr_u (local.get $len) (i64.const 56))))
+      (call $MD5Transform (struct.get $context 0 (local.get $ctx))
+         (struct.get $context 2 (local.get $ctx))
+         (local.get $buffer)
+         (i32.const 0))
+      (local.set $res (array.new $string (i32.const 0) (i32.const 16)))
+      (local.set $i (i32.const 0))
+      (local.set $w (struct.get $context 0 (local.get $ctx)))
+      (loop $loop
+         (array.set $string (local.get $res) (local.get $i)
+            (i32.shr_u
+               (array.get $int_array (local.get $w)
+                  (i32.shr_u (local.get $i) (i32.const 2)))
+               (i32.shl (local.get $i) (i32.const 3))))
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (br_if $loop (i32.lt_u (local.get $i) (i32.const 16))))
+      (local.get $res))
 )

From 41d325f89b79323319a135bb3989657b672f8f59 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 6 Jun 2023 14:22:38 +0200
Subject: [PATCH 057/481] Runtime: fixes + add a few missing functions

---
 compiler/lib/wasm/wa_core_target.ml |  2 ++
 compiler/lib/wasm/wa_gc_target.ml   |  2 ++
 compiler/lib/wasm/wa_generate.ml    |  1 +
 compiler/lib/wasm/wa_target_sig.ml  |  2 ++
 runtime/wasm/int32.wat              |  8 ++++++
 runtime/wasm/jslib.wat              | 34 ++++++++++++++------------
 runtime/wasm/obj.wat                | 38 +++++++++++++++++------------
 7 files changed, 57 insertions(+), 30 deletions(-)

diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 84dd5399d9..5363a7ea01 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -577,6 +577,8 @@ module Math = struct
 
   let exp f = unary "exp" f
 
+  let exp2 f = unary "exp" f
+
   let expm1 f = unary "expm1" f
 
   let log f = unary "log" f
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index e8b145e1c2..c5bd01d19f 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -933,6 +933,8 @@ module Math = struct
     let* f = register_import ~name:"caml_round" (Fun (float_func_type 1)) in
     let* x = x in
     return (W.Call (f, [ x ]))
+
+  let exp2 x = power (return (W.Const (F64 2.))) x
 end
 
 let entry_point ~context = init_code context
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 0e31920e5b..c38ba1b988 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -258,6 +258,7 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_atanh_float", [ f ] -> float_un_op' stack_ctx x Math.atanh f
         | Extern "caml_cbrt_float", [ f ] -> float_un_op' stack_ctx x Math.cbrt f
         | Extern "caml_exp_float", [ f ] -> float_un_op' stack_ctx x Math.exp f
+        | Extern "caml_exp2_float", [ f ] -> float_un_op' stack_ctx x Math.exp2 f
         | Extern "caml_log_float", [ f ] -> float_un_op' stack_ctx x Math.log f
         | Extern "caml_expm1_float", [ f ] -> float_un_op' stack_ctx x Math.expm1 f
         | Extern "caml_log1p_float", [ f ] -> float_un_op' stack_ctx x Math.log1p f
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 9511096d5f..e2653eab0d 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -232,6 +232,8 @@ module type S = sig
 
     val exp : expression -> expression
 
+    val exp2 : expression -> expression
+
     val log : expression -> expression
 
     val expm1 : expression -> expression
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 6c25ecc893..df4e1e11ea 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -102,4 +102,12 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (return_call $format_int (local.get 0)
          (struct.get $int32 1 (ref.cast $int32 (local.get 1))) (i32.const 0)))
+
+   (func (export "caml_nativeint_of_int32") (param (ref eq)) (result (ref eq))
+      (return_call $caml_copy_nativeint
+         (struct.get $int32 1 (ref.cast $int32 (local.get 0)))))
+
+   (func (export "caml_nativeint_to_int32") (param (ref eq)) (result (ref eq))
+      (return_call $caml_copy_int32
+         (struct.get $int32 1 (ref.cast $int32 (local.get 0)))))
 )
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 524f65c57f..282f70cf57 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -147,7 +147,7 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (if (ref.test $string (local.get 1))
          (then
-            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+            (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (return_call $wrap
          (call $get
             (ref.as_non_null (extern.externalize (call $unwrap (local.get 0))))
@@ -157,7 +157,7 @@
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (if (ref.test $string (local.get 1))
          (then
-            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+            (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (call $set (call $unwrap (local.get 0)) (call $unwrap (local.get 1))
          (call $unwrap (local.get 2)))
       (i31.new (i32.const 0)))
@@ -323,23 +323,27 @@
                      (local.get $acc)
                      (struct.get $closure 0
                         (ref.cast $closure (local.get $acc)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop
                   (i32.eqz (ref.test $closure_last_arg (local.get $f))))))
          (else
             (local.set $i (i32.const 0))
-            (loop $loop
-               (if (i32.lt_u (local.get $i) (local.get $count))
-                  (then
-                     (local.set $acc
-                        (call_ref $function_1
-                           (call $wrap
-                              (call $get (local.get $args)
-                                 (i31.new (local.get $i))))
-                           (local.get $acc)
-                           (struct.get $closure 0
-                              (ref.cast $closure (local.get $acc)))))
-                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
-                     (br $loop))))
+            (drop (block $done (result (ref eq))
+               (loop $loop
+                  (if (i32.lt_u (local.get $i) (local.get $count))
+                     (then
+                        (local.set $acc
+                           (call_ref $function_1
+                              (call $wrap
+                                 (call $get (local.get $args)
+                                    (i31.new (local.get $i))))
+                              (local.get $acc)
+                              (struct.get $closure 0
+                                 (br_on_cast_fail $done $closure
+                                    (local.get $acc)))))
+                        (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                        (br $loop))))
+               (i31.new (i32.const 0))))
             (if (local.get $kind)
                (then
                   (if (ref.test $closure (local.get $acc))
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 7cda5108c4..6708b39538 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -119,19 +119,29 @@
 
    (func $caml_obj_dup (export "caml_obj_dup")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ Deal with non-block values?
-      (local $orig (ref $block))
-      (local $res (ref $block))
+      (local $orig (ref $block)) (local $res (ref $block))
+      (local $s (ref $string)) (local $s' (ref $string))
       (local $len i32)
-      (local.set $orig (ref.cast $block (local.get 0)))
-      (local.set $len (array.len (local.get $orig)))
-      (local.set $res
-         (array.new $block (array.get $block (local.get $orig) (i32.const 0))
-            (local.get $len)))
-      (array.copy $block $block
-         (local.get $res) (i32.const 1) (local.get $orig) (i32.const 1)
-         (i32.sub (local.get $len) (i32.const 1)))
-      (local.get $res))
+      (drop (block $not_block (result (ref eq))
+         (local.set $orig (br_on_cast_fail $not_block $block (local.get 0)))
+         (local.set $len (array.len (local.get $orig)))
+         (local.set $res
+            (array.new $block (array.get $block (local.get $orig) (i32.const 0))
+               (local.get $len)))
+         (array.copy $block $block
+            (local.get $res) (i32.const 1) (local.get $orig) (i32.const 1)
+            (i32.sub (local.get $len) (i32.const 1)))
+         (return (local.get $res))))
+      (drop (block $not_string (result (ref eq))
+         (local.set $s (br_on_cast_fail $not_string $string (local.get 0)))
+         (local.set $len (array.len (local.get $s)))
+         (local.set $s' (array.new $string (i32.const 0) (local.get $len)))
+         (array.copy $string $string
+            (local.get $s') (i32.const 0) (local.get $s) (i32.const 0)
+            (local.get $len))
+         (return (local.get $s'))))
+      ;; ZZZ Deal with other values?
+      (unreachable))
 
    (func (export "caml_obj_with_tag")
       (param $tag (ref eq)) (param (ref eq)) (result (ref eq))
@@ -169,9 +179,7 @@
       (if (ref.test $closure (local.get $v))
          (then (return (i31.new (global.get $closure_tag)))))
       ;; ZZZ float array
-      (if (ref.test $js (local.get $v))
-         (then (return (i31.new (global.get $abstract_tag)))))
-      (unreachable))
+      (i31.new (global.get $abstract_tag)))
 
    (func (export "caml_obj_make_forward")
       (param $b (ref eq)) (param $v (ref eq)) (result (ref eq))

From 668903b30fa4871001c0d7925d9870dcfaed0adb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 6 Jun 2023 14:23:48 +0200
Subject: [PATCH 058/481] Runtime: lexing

---
 runtime/wasm/lexing.wat | 380 ++++++++++++++++++++++++++++++++++++++--
 1 file changed, 370 insertions(+), 10 deletions(-)

diff --git a/runtime/wasm/lexing.wat b/runtime/wasm/lexing.wat
index 2e8c505beb..f2f76d0926 100644
--- a/runtime/wasm/lexing.wat
+++ b/runtime/wasm/lexing.wat
@@ -1,15 +1,375 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
 
-   (func (export "caml_new_lex_engine")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_new_lex_engine"))
-      (i31.new (i32.const 0)))
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (func $get (param $a (ref eq)) (param $i i32) (result i32)
+      (local $s (ref $string))
+      (local.set $s (ref.cast $string (local.get $a)))
+      (local.set $i (i32.add (local.get $i) (local.get $i)))
+      (i32.extend16_s
+         (i32.or (array.get_u $string (local.get $s) (local.get $i))
+            (i32.shl
+               (array.get_u $string (local.get $s)
+                  (i32.add (local.get $i) (i32.const 1)))
+               (i32.const 8)))))
+
+   (global $lex_buffer i32 (i32.const 2))
+   (global $lex_buffer_len i32 (i32.const 3))
+   (global $lex_start_pos i32 (i32.const 5))
+   (global $lex_curr_pos i32 (i32.const 6))
+   (global $lex_last_pos i32 (i32.const 7))
+   (global $lex_last_action i32 (i32.const 8))
+   (global $lex_eof_reached i32 (i32.const 9))
+   (global $lex_mem i32 (i32.const 10))
+   (global $lex_base i32 (i32.const 1))
+   (global $lex_backtrk i32 (i32.const 2))
+   (global $lex_default i32 (i32.const 3))
+   (global $lex_trans i32 (i32.const 4))
+   (global $lex_check i32 (i32.const 5))
+   (global $lex_base_code i32 (i32.const 6))
+   (global $lex_backtrk_code i32 (i32.const 7))
+   (global $lex_default_code i32 (i32.const 8))
+   (global $lex_trans_code i32 (i32.const 9))
+   (global $lex_check_code i32 (i32.const 10))
+   (global $lex_code i32 (i32.const 11))
+
+   (data $lexing_empty_token "lexing: empty token")
 
    (func (export "caml_lex_engine")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_lex_engine"))
-      (i31.new (i32.const 0)))
+      (param $vtbl (ref eq)) (param $start_state (ref eq))
+      (param $vlexbuf (ref eq))
+      (result (ref eq))
+      (local $tbl (ref $block))
+      (local $lexbuf (ref $block))
+      (local $c i32)
+      (local $state i32)
+      (local $buffer (ref $string))
+      (local $vpos (ref eq)) (local $action (ref eq))
+      (local $pos i32) (local $base i32) (local $backtrk i32)
+      (local $lex_base (ref $string))
+      (local $lex_backtrk (ref $string))
+      (local $lex_check (ref $string))
+      (local $lex_check_code (ref $string))
+      (local $lex_trans (ref $string))
+      (local $lex_default (ref $string))
+      (local.set $tbl (ref.cast $block (local.get $vtbl)))
+      (local.set $lexbuf (ref.cast $block (local.get $vlexbuf)))
+      (local.set $state (i31.get_s (ref.cast i31 (local.get $start_state))))
+      (local.set $buffer
+         (ref.cast $string
+            (array.get $block (local.get $lexbuf) (global.get $lex_buffer))))
+      (if (i32.ge_s (local.get $state) (i32.const 0))
+         (then
+            (local.set $vpos
+               (array.get $block (local.get $lexbuf) (global.get $lex_curr_pos)))
+            (array.set $block (local.get $lexbuf) (global.get $lex_last_pos)
+               (local.get $vpos))
+            (array.set $block (local.get $lexbuf) (global.get $lex_start_pos)
+               (local.get $vpos))
+            (array.set $block (local.get $lexbuf) (global.get $lex_last_action)
+               (i31.new (i32.const -1))))
+         (else
+            (local.set $state (i32.sub (i32.const -1) (local.get $state)))))
+      (local.set $lex_base
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_base))))
+      (local.set $lex_backtrk
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_backtrk))))
+      (local.set $lex_check
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_check))))
+      (local.set $lex_check_code
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_check_code))))
+      (local.set $lex_trans
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_trans))))
+      (local.set $lex_default
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_default))))
+      (loop $loop
+         (local.set $base (call $get (local.get $lex_base) (local.get $state)))
+         (if (i32.lt_s (local.get $base) (i32.const 0))
+            (then
+               (return (i31.new (i32.sub (i32.const -1) (local.get $base))))))
+         (local.set $backtrk
+            (call $get (local.get $lex_backtrk) (local.get $state)))
+         (if (i32.ge_s (local.get $backtrk) (i32.const 0))
+            (then
+               (array.set $block (local.get $lexbuf) (global.get $lex_last_pos)
+                  (array.get $block (local.get $lexbuf)
+                     (global.get $lex_curr_pos)))
+               (array.set $block (local.get $lexbuf)
+                  (global.get $lex_last_action)
+                  (i31.new (local.get $backtrk)))))
+         (if (i32.ge_s
+                (i31.get_s
+                   (ref.cast i31
+                      (array.get $block (local.get $lexbuf)
+                         (global.get $lex_curr_pos))))
+                (i31.get_s
+                   (ref.cast i31
+                      (array.get $block (local.get $lexbuf)
+                         (global.get $lex_buffer_len)))))
+            (then
+               (if (ref.eq
+                      (array.get $block (local.get $lexbuf)
+                         (global.get $lex_eof_reached))
+                      (i31.new (i32.const 0)))
+                  (then
+                     (return
+                        (i31.new (i32.sub (i32.const -1) (local.get $state)))))
+                  (else
+                     (local.set $c (i32.const 256)))))
+            (else
+               (local.set $pos
+                  (i31.get_u
+                     (ref.cast i31
+                        (array.get $block (local.get $lexbuf)
+                           (global.get $lex_curr_pos)))))
+               (local.set $c
+                  (array.get_u $string (local.get $buffer) (local.get $pos)))
+               (array.set $block (local.get $lexbuf) (global.get $lex_curr_pos)
+                  (i31.new (i32.add (local.get $pos) (i32.const 1))))))
+         (if (i32.eq
+                (call $get (local.get $lex_check)
+                   (i32.add (local.get $base) (local.get $c)))
+                (local.get $state))
+            (then
+               (local.set $state
+                  (call $get (local.get $lex_trans)
+                     (i32.add (local.get $base) (local.get $c)))))
+            (else
+               (local.set $state
+                  (call $get (local.get $lex_default) (local.get $state)))))
+         (if (i32.lt_s (local.get $state) (i32.const 0))
+            (then
+               (array.set $block (local.get $lexbuf) (global.get $lex_curr_pos)
+                  (array.get $block (local.get $lexbuf)
+                     (global.get $lex_last_pos)))
+               (local.set $action
+                  (array.get $block (local.get $lexbuf)
+                     (global.get $lex_last_action)))
+               (if (ref.eq (local.get $action) (i31.new (i32.const -1)))
+                  (then
+                     (call $caml_failwith
+                        (array.new_data $string $lexing_empty_token
+                           (i32.const 0) (i32.const 19)))))
+               (return (local.get $action))))
+         (if (i32.eq (local.get $c) (i32.const 256))
+            (then
+               (array.set $block (local.get $lexbuf)
+                  (global.get $lex_eof_reached)
+                  (i31.new (i32.const 0)))))
+         (br $loop)))
+
+   (func $run_mem
+      (param $s (ref $string)) (param $i i32) (param $lexbuf (ref $block))
+      (param $curr_pos (ref eq))
+      (local $dst i32) (local $src i32)
+      (local $mem (ref $block))
+      (local.set $mem
+         (ref.cast $block
+            (array.get $block (local.get $lexbuf) (global.get $lex_mem))))
+      (loop $loop
+         (local.set $dst (array.get_u $string (local.get $s) (local.get $i)))
+         (if (i32.eq (local.get $dst) (i32.const 0xff))
+            (then (return)))
+         (local.set $src
+            (array.get_u $string (local.get $s)
+              (i32.add (local.get $i) (i32.const 1))))
+         (local.set $i (i32.add (local.get $i) (i32.const 2)))
+         (array.set $block (local.get $mem)
+            (i32.add (local.get $dst) (i32.const 1))
+            (if (result (ref eq)) (i32.eq (local.get $src) (i32.const 0xff))
+               (then
+                  (local.get $curr_pos))
+               (else
+                  (array.get $block (local.get $mem)
+                     (i32.add (local.get $src) (i32.const 1))))))
+         (br $loop)))
+
+   (func $run_tag
+      (param $s (ref $string)) (param $i i32) (param $lexbuf (ref $block))
+      (return_call $run_mem (local.get $s) (local.get $i) (local.get $lexbuf)
+         (i31.new (i32.const -1))))
+
+   (func (export "caml_new_lex_engine")
+      (param $vtbl (ref eq)) (param $start_state (ref eq))
+      (param $vlexbuf (ref eq))
+      (result (ref eq))
+      (local $tbl (ref $block))
+      (local $lexbuf (ref $block))
+      (local $c i32)
+      (local $state i32) (local $pstate i32)
+      (local $buffer (ref $string))
+      (local $vpos (ref eq)) (local $action (ref eq))
+      (local $pos i32) (local $base i32) (local $backtrk i32)
+      (local $pc_off i32) (local $base_code i32)
+      (local $lex_code (ref $string))
+      (local $lex_base (ref $string))
+      (local $lex_base_code (ref $string))
+      (local $lex_backtrk (ref $string))
+      (local $lex_backtrk_code (ref $string))
+      (local $lex_check (ref $string))
+      (local $lex_check_code (ref $string))
+      (local $lex_trans (ref $string))
+      (local $lex_trans_code (ref $string))
+      (local $lex_default (ref $string))
+      (local $lex_default_code (ref $string))
+      (local.set $tbl (ref.cast $block (local.get $vtbl)))
+      (local.set $lexbuf (ref.cast $block (local.get $vlexbuf)))
+      (local.set $state (i31.get_s (ref.cast i31 (local.get $start_state))))
+      (local.set $buffer
+         (ref.cast $string
+            (array.get $block (local.get $lexbuf) (global.get $lex_buffer))))
+      (if (i32.ge_s (local.get $state) (i32.const 0))
+         (then
+            (local.set $vpos
+               (array.get $block (local.get $lexbuf) (global.get $lex_curr_pos)))
+            (array.set $block (local.get $lexbuf) (global.get $lex_last_pos)
+               (local.get $vpos))
+            (array.set $block (local.get $lexbuf) (global.get $lex_start_pos)
+               (local.get $vpos))
+            (array.set $block (local.get $lexbuf) (global.get $lex_last_action)
+               (i31.new (i32.const -1))))
+         (else
+            (local.set $state (i32.sub (i32.const -1) (local.get $state)))))
+      (local.set $lex_code
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_code))))
+      (local.set $lex_base
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_base))))
+      (local.set $lex_base_code
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_base_code))))
+      (local.set $lex_backtrk
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_backtrk))))
+      (local.set $lex_backtrk_code
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_backtrk_code))))
+      (local.set $lex_check
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_check))))
+      (local.set $lex_check_code
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_check_code))))
+      (local.set $lex_trans
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_trans))))
+      (local.set $lex_trans_code
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_trans_code))))
+      (local.set $lex_default
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_default))))
+      (local.set $lex_default_code
+         (ref.cast $string
+            (array.get $block (local.get $tbl) (global.get $lex_default_code))))
+      (loop $loop
+         (local.set $base (call $get (local.get $lex_base) (local.get $state)))
+         (if (i32.lt_s (local.get $base) (i32.const 0))
+            (then
+               (local.set $pc_off
+                  (call $get (local.get $lex_base_code) (local.get $state)))
+               (call $run_tag (local.get $lex_code) (local.get $pc_off)
+                  (local.get $lexbuf))
+               (return (i31.new (i32.sub (i32.const -1) (local.get $base))))))
+         (local.set $backtrk
+            (call $get (local.get $lex_backtrk) (local.get $state)))
+         (if (i32.ge_s (local.get $backtrk) (i32.const 0))
+            (then
+               (local.set $pc_off
+                  (call $get (local.get $lex_backtrk_code) (local.get $state)))
+               (call $run_tag (local.get $lex_code) (local.get $pc_off)
+                  (local.get $lexbuf))
+               (array.set $block (local.get $lexbuf) (global.get $lex_last_pos)
+                  (array.get $block (local.get $lexbuf)
+                     (global.get $lex_curr_pos)))
+               (array.set $block (local.get $lexbuf)
+                  (global.get $lex_last_action)
+                  (i31.new (local.get $backtrk)))))
+         (if (i32.ge_s
+                (i31.get_s
+                   (ref.cast i31
+                      (array.get $block (local.get $lexbuf)
+                         (global.get $lex_curr_pos))))
+                (i31.get_s
+                   (ref.cast i31
+                      (array.get $block (local.get $lexbuf)
+                         (global.get $lex_buffer_len)))))
+            (then
+               (if (ref.eq
+                      (array.get $block (local.get $lexbuf)
+                         (global.get $lex_eof_reached))
+                      (i31.new (i32.const 0)))
+                  (then
+                     (return
+                        (i31.new (i32.sub (i32.const -1) (local.get $state)))))
+                  (else
+                     (local.set $c (i32.const 256)))))
+            (else
+               (local.set $pos
+                  (i31.get_u
+                     (ref.cast i31
+                        (array.get $block (local.get $lexbuf)
+                           (global.get $lex_curr_pos)))))
+               (local.set $c
+                  (array.get_u $string (local.get $buffer) (local.get $pos)))
+               (array.set $block (local.get $lexbuf) (global.get $lex_curr_pos)
+                  (i31.new (i32.add (local.get $pos) (i32.const 1))))))
+         (local.set $pstate (local.get $state))
+         (if (i32.eq
+                (call $get (local.get $lex_check)
+                   (i32.add (local.get $base) (local.get $c)))
+                (local.get $state))
+            (then
+               (local.set $state
+                  (call $get (local.get $lex_trans)
+                     (i32.add (local.get $base) (local.get $c)))))
+            (else
+               (local.set $state
+                  (call $get (local.get $lex_default) (local.get $state)))))
+         (if (i32.lt_s (local.get $state) (i32.const 0))
+            (then
+               (array.set $block (local.get $lexbuf) (global.get $lex_curr_pos)
+                  (array.get $block (local.get $lexbuf)
+                     (global.get $lex_last_pos)))
+               (local.set $action
+                  (array.get $block (local.get $lexbuf)
+                     (global.get $lex_last_action)))
+               (if (ref.eq (local.get $action) (i31.new (i32.const -1)))
+                  (then
+                     (call $caml_failwith
+                        (array.new_data $string $lexing_empty_token
+                           (i32.const 0) (i32.const 19)))))
+               (return (local.get $action))))
+         (local.set $base_code
+            (call $get (local.get $lex_base_code) (local.get $pstate)))
+         (local.set $pc_off
+            (if (result i32)
+                (i32.eq
+                   (call $get (local.get $lex_check_code)
+                      (i32.add (local.get $base_code) (local.get $c)))
+                   (local.get $pstate))
+               (then
+                  (call $get (local.get $lex_trans_code)
+                     (i32.add (local.get $base_code) (local.get $c))))
+               (else
+                  (call $get (local.get $lex_default_code)
+                     (local.get $pstate)))))
+         (call $run_mem (local.get $lex_code) (local.get $pc_off)
+            (local.get $lexbuf)
+            (array.get $block (local.get $lexbuf) (global.get $lex_curr_pos)))
+         (if (i32.eq (local.get $c) (i32.const 256))
+            (then
+               (array.set $block (local.get $lexbuf)
+                  (global.get $lex_eof_reached)
+                  (i31.new (i32.const 0)))))
+         (br $loop)))
 )

From e7f3e63649d4eafea0d1270779df355b1db89456 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 6 Jun 2023 15:19:51 +0200
Subject: [PATCH 059/481] Fix tail call optimization

There should be no tail call within a try body
---
 compiler/lib/wasm/wa_tail_call.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index 9c475f94fa..8053092c90 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -8,7 +8,7 @@ let rec instruction ~tail i =
   | Try (ty, l, catches, catch_all) ->
       Try
         ( ty
-        , instructions ~tail:false l
+        , l
         , List.map ~f:(fun (tag, l) -> tag, instructions ~tail l) catches
         , Option.map ~f:(fun l -> instructions ~tail l) catch_all )
   | Return (Some (Call (symb, l))) -> Return_call (symb, l)

From d2499eaa7fbd7f43080c0edc13a8dcf948ecb01c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 12 Jun 2023 10:01:12 +0200
Subject: [PATCH 060/481] Runtime: small fixes

---
 compiler/lib/eval.ml                | 9 ++++++++-
 compiler/lib/specialize_js.ml       | 4 ++--
 compiler/lib/wasm/wa_core_target.ml | 2 +-
 runtime/wasm/ints.wat               | 4 ----
 runtime/wasm/prng.wat               | 1 +
 runtime/wasm/sync.wat               | 2 +-
 6 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index be13381a0b..daab6b0f60 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -257,7 +257,14 @@ let eval_instr ~target info ((x, loc) as i) =
           [ Let (x, c), loc ])
   | Let (x, Prim (Extern "caml_sys_const_backend_type", [ _ ])) ->
       let jsoo = Code.Var.fresh () in
-      [ Let (jsoo, Constant (String "js_of_ocaml")), noloc
+      [ ( Let
+            ( jsoo
+            , Constant
+                (String
+                   (match target with
+                   | `JavaScript -> "js_of_ocaml"
+                   | `Wasm -> "wasm_of_ocaml")) )
+        , noloc )
       ; Let (x, Block (0, [| jsoo |], NotArray)), loc
       ]
   | Let (_, Prim (Extern ("%resume" | "%perform" | "%reperform"), _)) ->
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index b671eff3af..91502ab82e 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -24,14 +24,14 @@ open Flow
 
 let specialize_instr ~target info i =
   match i, target with
-  | Let (x, Prim (Extern "caml_format_int", [ y; z ])), _ -> (
+  | Let (x, Prim (Extern "caml_format_int", [ y; z ])), `JavaScript -> (
       match the_string_of info y with
       | Some "%d" -> (
           match the_int info z with
           | Some i -> Let (x, Constant (String (Int32.to_string i)))
           | None -> Let (x, Prim (Extern "%caml_format_int_special", [ z ])))
       | _ -> i)
-  | Let (x, Prim (Extern "%caml_format_int_special", [ z ])), _ -> (
+  | Let (x, Prim (Extern "%caml_format_int_special", [ z ])), `JavaScript -> (
       match the_int info z with
       | Some i -> Let (x, Constant (String (Int32.to_string i)))
       | None -> i)
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 5363a7ea01..f8d4876168 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -577,7 +577,7 @@ module Math = struct
 
   let exp f = unary "exp" f
 
-  let exp2 f = unary "exp" f
+  let exp2 f = unary "exp2" f
 
   let expm1 f = unary "expm1" f
 
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index 48e4a697f9..eb2608b6df 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -159,10 +159,6 @@
             (i32.and
                (i32.shr_u (local.get $x) (i32.const 8)) (i32.const 0xFF)))))
 
-   (func (export "%caml_format_int_special") (param (ref eq)) (result (ref eq))
-      (return_call $format_int_default
-         (i31.get_s (ref.cast i31 (local.get 0)))))
-
    (type $chars (array i8))
 
    (global $lowercase_hex_table (export "lowercase_hex_table") (ref $chars)
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index 82e656da1d..74d738980b 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -6,6 +6,7 @@
    (import "bindings" "ta_set_i32"
       (func $ta_set_i32 (param (ref extern)) (param i32) (param i32)))
 
+   (type $string (array (mut i8)))
    (type $value->value->int
       (func (param (ref eq)) (param (ref eq)) (result i32)))
    (type $value->int
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index c123bda57c..82df517e6a 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -70,7 +70,7 @@
             (i31.new (i32.const 1)))))
 
    (func (export "caml_ml_mutex_unlock") (param (ref eq)) (result (ref eq))
-      (struct.set $mutex 2 (ref.cast $mutex (local.get 0)) (i32.const 1))
+      (struct.set $mutex 2 (ref.cast $mutex (local.get 0)) (i32.const 0))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_condition_new") (param (ref eq)) (result (ref eq))

From b4f9100df40103d9a988fd8c41de753ca885ad03 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 12 Jun 2023 10:14:15 +0200
Subject: [PATCH 061/481] JavaScript bindings: equalities and global object

---
 compiler/lib/generate.ml                |  2 ++
 lib/js_of_ocaml/js.ml                   | 46 ++++++++++++++++++-------
 lib/js_of_ocaml/js.mli                  | 20 +++++++++++
 lib/runtime/js_of_ocaml_runtime_stubs.c |  8 +++++
 lib/runtime/jsoo_runtime.ml             |  4 +++
 runtime/jslib.js                        |  3 ++
 runtime/wasm/jslib.wat                  |  4 +++
 runtime/wasm/runtime.js                 |  1 +
 8 files changed, 75 insertions(+), 13 deletions(-)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 85622d76f3..43c92c05f9 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1390,6 +1390,8 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
            | Extern "caml_js_delete", [ _; Pc (String _) ] -> assert false
            ]}
         *)
+        | Extern "caml_js_global", _ ->
+            J.EVar (J.ident Constant.global_object_), const_p, queue
         | Extern "%overrideMod", [ Pc (String m); Pc (String f) ] ->
             runtime_fun ctx (Printf.sprintf "caml_%s_%s" m f), const_p, queue
         | Extern "%overrideMod", _ -> assert false
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index 6dc5a16d3f..6da9c405f3 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -56,6 +56,8 @@ module Js = struct
 
     external equals : 'a -> 'b -> bool = "caml_js_equals"
 
+    external strict_equals : 'a -> 'b -> bool = "caml_js_strict_equals"
+
     external pure_expr : (unit -> 'a) -> 'a = "caml_js_pure_expr"
 
     external eval_string : string -> 'a = "caml_js_eval_string"
@@ -64,7 +66,9 @@ module Js = struct
 
     external pure_js_expr : string -> 'a = "caml_pure_js_expr"
 
-    let global = pure_js_expr "globalThis"
+    external get_global : unit -> 'a = "caml_js_global"
+
+    let global = get_global ()
 
     external callback : ('a -> 'b) -> ('c, 'a -> 'b) meth_callback
       = "caml_js_wrap_callback_unsafe"
@@ -92,6 +96,10 @@ module Js = struct
 
   (****)
 
+  external equals : _ -> _ -> bool = "caml_js_equals"
+
+  external strict_equals : _ -> _ -> bool = "caml_js_strict_equals"
+
   type 'a opt = 'a
 
   type 'a optdef = 'a
@@ -128,6 +136,10 @@ module Js = struct
     val option : 'a option -> 'a t
 
     val to_option : 'a t -> 'a option
+
+    external equals : _ t -> _ t -> bool = "caml_js_equals"
+
+    external strict_equals : _ t -> _ t -> bool = "caml_js_strict_equals"
   end
 
   module Opt : OPT with type 'a t = 'a opt = struct
@@ -137,17 +149,17 @@ module Js = struct
 
     let return = some
 
-    let map x f = if Unsafe.equals x null then null else return (f x)
+    let map x f = if equals x null then null else return (f x)
 
-    let bind x f = if Unsafe.equals x null then null else f x
+    let bind x f = if equals x null then null else f x
 
-    let test x = not (Unsafe.equals x null)
+    let test x = not (equals x null)
 
-    let iter x f = if not (Unsafe.equals x null) then f x
+    let iter x f = if not (equals x null) then f x
 
-    let case x f g = if Unsafe.equals x null then f () else g x
+    let case x f g = if equals x null then f () else g x
 
-    let get x f = if Unsafe.equals x null then f () else x
+    let get x f = if equals x null then f () else x
 
     let option x =
       match x with
@@ -155,6 +167,10 @@ module Js = struct
       | Some x -> return x
 
     let to_option x = case x (fun () -> None) (fun x -> Some x)
+
+    external equals : 'a -> 'b -> bool = "caml_js_equals"
+
+    external strict_equals : 'a -> 'b -> bool = "caml_js_strict_equals"
   end
 
   module Optdef : OPT with type 'a t = 'a optdef = struct
@@ -164,17 +180,17 @@ module Js = struct
 
     let return = def
 
-    let map x f = if x == undefined then undefined else return (f x)
+    let map x f = if strict_equals x undefined then undefined else return (f x)
 
-    let bind x f = if x == undefined then undefined else f x
+    let bind x f = if strict_equals x undefined then undefined else f x
 
-    let test x = x != undefined
+    let test x = not (strict_equals x undefined)
 
-    let iter x f = if x != undefined then f x
+    let iter x f = if not (strict_equals x undefined) then f x
 
-    let case x f g = if x == undefined then f () else g x
+    let case x f g = if strict_equals x undefined then f () else g x
 
-    let get x f = if x == undefined then f () else x
+    let get x f = if strict_equals x undefined then f () else x
 
     let option x =
       match x with
@@ -182,6 +198,10 @@ module Js = struct
       | Some x -> return x
 
     let to_option x = case x (fun () -> None) (fun x -> Some x)
+
+    external equals : 'a -> 'b -> bool = "caml_js_equals"
+
+    external strict_equals : 'a -> 'b -> bool = "caml_js_strict_equals"
   end
 
   (****)
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index 68743b1f0e..164a0454ac 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -81,6 +81,12 @@ module type OPT = sig
 
   val to_option : 'a t -> 'a option
   (** Convert to option type. *)
+
+  external equals : _ t -> _ t -> bool = "caml_js_equals"
+  (** Javascript [==] equality operator. *)
+
+  external strict_equals : _ t -> _ t -> bool = "caml_js_strict_equals"
+  (** Javascript [===] equality operator. *)
 end
 
 module Opt : OPT with type 'a t = 'a opt
@@ -168,6 +174,14 @@ external wrap_meth_callback : ('b -> 'a) -> ('b, 'a) meth_callback
       Javascript.  The first parameter of the function will be bound
       to the value of the [this] implicit parameter. *)
 
+(** {2 Javascript comparisons} *)
+
+external equals : _ t -> _ t -> bool = "caml_js_equals"
+(** Javascript [==] equality operator. *)
+
+external strict_equals : _ t -> _ t -> bool = "caml_js_strict_equals"
+(** Javascript [===] equality operator. *)
+
 (** {2 Javascript standard objects} *)
 
 val _true : bool t
@@ -987,6 +1001,12 @@ module Unsafe : sig
   external meth_callback_with_arity : int -> ('b -> 'a) -> ('b, 'a) meth_callback
     = "caml_js_wrap_meth_callback_strict"
 
+  external equals : _ -> _ -> bool = "caml_js_equals"
+  (** Javascript [==] equality operator. *)
+
+  external strict_equals : _ -> _ -> bool = "caml_js_strict_equals"
+  (** Javascript [===] equality operator. *)
+
   (** {3 Deprecated functions.} *)
 
   external variable : string -> 'a = "caml_js_var"
diff --git a/lib/runtime/js_of_ocaml_runtime_stubs.c b/lib/runtime/js_of_ocaml_runtime_stubs.c
index 8f703518d3..b9a08b077a 100644
--- a/lib/runtime/js_of_ocaml_runtime_stubs.c
+++ b/lib/runtime/js_of_ocaml_runtime_stubs.c
@@ -88,6 +88,10 @@ void caml_js_get () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_get!\n");
   exit(1);
 }
+void caml_js_global () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_js_global!\n");
+  exit(1);
+}
 void caml_js_instanceof () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_instanceof!\n");
   exit(1);
@@ -112,6 +116,10 @@ void caml_js_set () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_set!\n");
   exit(1);
 }
+void caml_js_strict_equals () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_js_strict_equals!\n");
+  exit(1);
+}
 void caml_js_to_array () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_to_array!\n");
   exit(1);
diff --git a/lib/runtime/jsoo_runtime.ml b/lib/runtime/jsoo_runtime.ml
index 420cab4919..3fc3397249 100644
--- a/lib/runtime/jsoo_runtime.ml
+++ b/lib/runtime/jsoo_runtime.ml
@@ -37,6 +37,8 @@ module Js = struct
 
   external delete : t -> t -> unit = "caml_js_delete"
 
+  external get_global : unit -> t = "caml_js_global"
+
   external call : t -> t -> t array -> t = "caml_js_call"
 
   external fun_call : t -> t array -> t = "caml_js_fun_call"
@@ -51,6 +53,8 @@ module Js = struct
 
   external equals : t -> t -> bool = "caml_js_equals"
 
+  external strict_equals : t -> t -> bool = "caml_js_strict_equals"
+
   external pure_expr : (unit -> 'a) -> 'a = "caml_js_pure_expr"
 
   external eval_string : string -> 'a = "caml_js_eval_string"
diff --git a/runtime/jslib.js b/runtime/jslib.js
index 5450b47c90..34738487bf 100644
--- a/runtime/jslib.js
+++ b/runtime/jslib.js
@@ -30,6 +30,9 @@ function caml_js_get(o,f) { return o[f]; }
 //Provides: caml_js_delete (mutable, const)
 function caml_js_delete(o,f) { delete o[f]; return 0}
 
+//Provides: caml_js_global const
+function caml_js_global () { return globalThis }
+
 //Provides: caml_js_instanceof (const, const)
 function caml_js_instanceof(o,c) { return (o instanceof c) ? 1 : 0; }
 
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 282f70cf57..f534b05f95 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -29,6 +29,7 @@
    (import "bindings" "new_obj" (func $new_obj (result anyref)))
    (import "bindings" "new_array"
       (func $new_array (param i32) (result (ref extern))))
+   (import "bindings" "global_this" (global $global_this anyref))
    (import "bindings" "iter_props"
       (func $iter_props (param anyref) (param anyref)))
    (import "bindings" "array_length"
@@ -98,6 +99,9 @@
             (string.new_wtf8_array replace
                (local.get $s) (i32.const 0) (array.len (local.get $s))))))
 
+   (func (export "caml_js_global") (param (ref eq)) (result (ref eq))
+      (call $wrap (global.get $global_this)))
+
    (func (export "caml_js_to_float") (param (ref eq)) (result (ref eq))
       (struct.new $float (call $to_float (call $unwrap (local.get 0)))))
 
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 65af9a6e2a..c77cece8d4 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -43,6 +43,7 @@
          new_array:(n)=>new Array(n),
          new_obj:()=>({}),
          new:(c,args)=>new c(...args),
+         global_this:globalThis,
          iter_props:(o,f)=>{for (var nm in o) if(o.hasOwnsProperty(nm)) f(nm)},
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],

From a3f592a803e3e5c220b9140ca21ba9fb0fd6cc71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 12 Jun 2023 10:34:15 +0200
Subject: [PATCH 062/481] Wrap JavaScript exceptions

---
 compiler/bin-wasm_of_ocaml/compile.ml |  2 +-
 compiler/lib/wasm/wa_core_target.ml   |  2 ++
 compiler/lib/wasm/wa_gc_target.ml     | 18 +++++++++++
 compiler/lib/wasm/wa_generate.ml      |  4 ++-
 compiler/lib/wasm/wa_target_sig.ml    |  3 ++
 runtime/wasm/fail.wat                 |  6 ++++
 runtime/wasm/jslib.wat                | 43 +++++++++++++++++++++++++++
 runtime/wasm/runtime.js               |  6 +++-
 8 files changed, 81 insertions(+), 3 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 0d04732642..7e8a33c8ee 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -94,7 +94,7 @@ let dead_code_elimination in_file out_file =
 let optimize in_file out_file =
   command
     (("wasm-opt" :: common_binaryen_options)
-    @ [ "-O3"; "--gufa"; "-O3"; Filename.quote in_file; "-o"; Filename.quote out_file ])
+    @ [ "-O3"; Filename.quote in_file; "-o"; Filename.quote out_file ])
 
 let link_and_optimize wat_file output_file =
   with_intermediate_file (Filename.temp_file "runtime" ".wasm")
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index f8d4876168..df219ae1a8 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -606,6 +606,8 @@ module Math = struct
   let fmod f g = binary "fmod" f g
 end
 
+let exception_handler_body ~typ:_ b = b
+
 let entry_point ~context:_ =
   let declare_global name =
     register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index c5bd01d19f..5b121fe8f6 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -937,4 +937,22 @@ module Math = struct
   let exp2 x = power (return (W.Const (F64 2.))) x
 end
 
+let exception_handler_body ~typ b =
+  let externref = W.Ref { nullable = true; typ = Extern } in
+  let* js_tag = register_import ~name:"javascript_exception" (Tag externref) in
+  let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
+  let x = Code.Var.fresh () in
+  let* f =
+    register_import
+      ~name:"caml_wrap_exception"
+      (Fun { params = [ externref ]; result = [ Value.value ] })
+  in
+  try_
+    { params = []; result = typ }
+    b
+    js_tag
+    (let* () = store ~always:true ~typ:externref x (return (W.Pop externref)) in
+     let* exn = load x in
+     instr (Throw (ocaml_tag, W.Call (f, [ exn ]))))
+
 let entry_point ~context = init_code context
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index c38ba1b988..ae2e2bf26c 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -808,7 +808,9 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* tag = register_import ~name:exception_name (Tag Value.value) in
               try_
                 { params = []; result = result_typ }
-                (translate_branch result_typ fall_through pc cont context' stack_ctx)
+                (exception_handler_body
+                   ~typ:result_typ
+                   (translate_branch result_typ fall_through pc cont context' stack_ctx))
                 tag
                 (let* () = store ~always:true x (return (W.Pop Value.value)) in
                  translate_branch result_typ fall_through pc cont' context' stack_ctx)
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index e2653eab0d..c4fe807a9d 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -253,5 +253,8 @@ module type S = sig
     val round : expression -> expression
   end
 
+  val exception_handler_body :
+    typ:Wa_ast.value_type list -> unit Wa_code_generation.t -> unit Wa_code_generation.t
+
   val entry_point : context:Wa_code_generation.context -> unit Wa_code_generation.t
 end
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 06f818edac..c85c083235 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -1,11 +1,13 @@
 (module
    (import "stdlib" "caml_global_data"
       (global $caml_global_data (mut (ref $block))))
+   (import "bindings" "jstag" (tag $javascript_exception (param externref)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
 
    (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
+   (export "javascript_exception" (tag $javascript_exception))
 
    (func $caml_raise_constant (param (ref eq))
       (throw $ocaml_exception (local.get 0)))
@@ -17,6 +19,10 @@
 
    (global $FAILURE_EXN i32 (i32.const 2))
 
+   (func (export "caml_failwith_tag") (result (ref eq))
+       (array.get $block (global.get $caml_global_data)
+          (global.get $FAILURE_EXN)))
+
    (func (export "caml_failwith") (param $arg (ref eq))
        (return_call $caml_raise_with_arg
            (array.get $block (global.get $caml_global_data)
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index f534b05f95..9399ebd900 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -57,6 +57,10 @@
       (func $wrap_meth_callback_unsafe (param (ref eq)) (result anyref)))
    (import "bindings" "wrap_fun_arguments"
       (func $wrap_fun_arguments (param anyref) (result anyref)))
+   (import "fail" "caml_failwith_tag"
+      (func $caml_failwith_tag (result (ref eq))))
+   (import "stdlib" "caml_named_value"
+      (func $caml_named_value (param anyref) (result (ref null eq))))
 
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
@@ -536,7 +540,46 @@
                (br $loop))))
       (local.get $l))
 
+   (func (export "caml_wrap_exception") (param (externref)) (result (ref eq))
+      (local $exn (ref eq))
+      (local.set $exn (call $wrap (extern.internalize (local.get 0))))
+      ;; ZZZ special case for stack overflows?
+      (block $undef
+         (return
+            (array.new_fixed $block (i31.new (i32.const 0))
+               (br_on_null $undef
+                  (call $caml_named_value (string.const "jsError"))))
+               (local.get $exn)))
+      (array.new_fixed $block (i31.new (i32.const 0))
+         (call $caml_failwith_tag)
+         (local.get $exn)))
+
    (func (export "caml_js_error_option_of_exception")
       (param (ref eq)) (result (ref eq))
+      (local $exn (ref $block))
+      (local.set $exn (ref.cast $block (local.get $0)))
+      (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
+                  (i31.new (i32.const 0)))
+         (then
+            (if (ref.eq (array.get $block (local.get $exn) (i32.const 1))
+                   (call $caml_named_value (string.const "jsError")))
+               (then
+                  (return
+                     (array.new_fixed $block (i31.new (i32.const 0))
+                        (array.get $block (local.get $exn) (i32.const 2))))))))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_js_error_of_exception")
+      (param (ref eq)) (result (ref eq))
+      (local $exn (ref $block))
+      (local.set $exn (ref.cast $block (local.get $0)))
+      (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
+                  (i31.new (i32.const 0)))
+         (then
+            (if (ref.eq (array.get $block (local.get $exn) (i32.const 1))
+                   (call $caml_named_value (string.const "jsError")))
+               (then
+                  (return
+                     (array.get $block (local.get $exn) (i32.const 2)))))))
+      (call $wrap (ref.null any)))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index c77cece8d4..a8f54a5f29 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -28,7 +28,11 @@
        Float32Array, Float64Array, Uint8Array]
 
     let bindings =
-        {identity:(x)=>x,
+        {jstag:
+         WebAssembly.JSTag||
+         // ZZZ not supported in node yet
+         new WebAssembly.Tag({parameters:['externref'],results:[]}),
+         identity:(x)=>x,
          from_bool:(x)=>!!x,
          get:(x,y)=>x[y],
          set:(x,y,z)=>x[y]=z,

From 5fbf51893e1e08f2208a8b85dee52bfe2a78cb96 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 12 Jun 2023 13:25:09 +0200
Subject: [PATCH 063/481] Runtime: effects

---
 compiler/lib/wasm/wa_core_target.ml |  31 +--
 compiler/lib/wasm/wa_gc_target.ml   |  15 +-
 compiler/lib/wasm/wa_generate.ml    |  11 +-
 compiler/lib/wasm/wa_target_sig.ml  |   3 +-
 runtime/wasm/deps.json              |   6 +-
 runtime/wasm/effect.wat             | 373 ++++++++++++++++++++++++++++
 runtime/wasm/fail.wat               |   5 +-
 runtime/wasm/obj.wat                |   4 +
 runtime/wasm/runtime.js             |  32 ++-
 9 files changed, 455 insertions(+), 25 deletions(-)
 create mode 100644 runtime/wasm/effect.wat

diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index df219ae1a8..4b6a4ab2ac 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -609,18 +609,21 @@ end
 let exception_handler_body ~typ:_ b = b
 
 let entry_point ~context:_ =
-  let declare_global name =
-    register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
-  in
-  let* () = declare_global "sp" in
-  let* () = declare_global "young_ptr" in
-  let* () = declare_global "young_limit" in
-  let* call_ctors =
-    register_import ~name:"__wasm_call_ctors" (Fun { W.params = []; result = [] })
+  let code =
+    let declare_global name =
+      register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
+    in
+    let* () = declare_global "sp" in
+    let* () = declare_global "young_ptr" in
+    let* () = declare_global "young_limit" in
+    let* call_ctors =
+      register_import ~name:"__wasm_call_ctors" (Fun { W.params = []; result = [] })
+    in
+    let* () = instr (W.CallInstr (call_ctors, [])) in
+    let* sz = Arith.const 3l in
+    let* high = Arith.((return (W.MemoryGrow (0, sz)) + const 3l) lsl const 16l) in
+    let* () = instr (W.GlobalSet (S "young_ptr", high)) in
+    let low = W.ConstSym (S "__heap_base", 0) in
+    instr (W.GlobalSet (S "young_limit", low))
   in
-  let* () = instr (W.CallInstr (call_ctors, [])) in
-  let* sz = Arith.const 3l in
-  let* high = Arith.((return (W.MemoryGrow (0, sz)) + const 3l) lsl const 16l) in
-  let* () = instr (W.GlobalSet (S "young_ptr", high)) in
-  let low = W.ConstSym (S "__heap_base", 0) in
-  instr (W.GlobalSet (S "young_limit", low))
+  { W.params = []; result = [] }, code
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 5b121fe8f6..07e4bfa6f4 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -955,4 +955,17 @@ let exception_handler_body ~typ b =
      let* exn = load x in
      instr (Throw (ocaml_tag, W.Call (f, [ exn ]))))
 
-let entry_point ~context = init_code context
+let entry_point ~context =
+  let code =
+    let* f =
+      register_import
+        ~name:"caml_initialize_effects"
+        (Fun { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] })
+    in
+    let suspender = Code.Var.fresh () in
+    let* _ = add_var suspender in
+    let* s = load suspender in
+    let* () = instr (W.CallInstr (f, [ s ])) in
+    init_code context
+  in
+  { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] }, code
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index ae2e2bf26c..9e05cc2821 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -881,21 +881,22 @@ module Generate (Target : Wa_target_sig.S) = struct
     :: acc
 
   let entry_point ctx toplevel_fun entry_name =
+    let typ, code = entry_point ~context:ctx.global_context in
     let body =
-      let* () = entry_point ~context:ctx.global_context in
+      let* () = code in
       drop (return (W.Call (toplevel_fun, [])))
     in
     let locals, body =
       function_body
         ~context:ctx.global_context
         ~value_type:Value.value
-        ~param_count:0
+        ~param_count:(List.length typ.W.params)
         ~body
     in
     W.Function
       { name = Var.fresh_n "entry_point"
       ; exported_name = Some entry_name
-      ; typ = { W.params = []; result = [] }
+      ; typ
       ; locals
       ; body
       }
@@ -926,6 +927,8 @@ module Generate (Target : Wa_target_sig.S) = struct
           translate_function p ctx name_opt toplevel_name params cont)
         []
     in
+    Curry.f ~context:ctx.global_context;
+    let start_function = entry_point ctx toplevel_name "_initialize" in
     let imports =
       List.concat
         (List.map
@@ -942,8 +945,6 @@ module Generate (Target : Wa_target_sig.S) = struct
           W.Data { name; read_only = true; active; contents })
         (Var.Map.bindings ctx.global_context.data_segments)
     in
-    Curry.f ~context:ctx.global_context;
-    let start_function = entry_point ctx toplevel_name "_initialize" in
     List.rev_append
       ctx.global_context.other_fields
       (imports @ functions @ (start_function :: constant_data))
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index c4fe807a9d..7f4f41a54a 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -256,5 +256,6 @@ module type S = sig
   val exception_handler_body :
     typ:Wa_ast.value_type list -> unit Wa_code_generation.t -> unit Wa_code_generation.t
 
-  val entry_point : context:Wa_code_generation.context -> unit Wa_code_generation.t
+  val entry_point :
+    context:Wa_code_generation.context -> Wa_ast.func_type * unit Wa_code_generation.t
 end
diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 621bdb9cba..35a2b6a21d 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,13 +1,17 @@
 [
   {
     "name": "root",
-    "reaches": ["init", "exn", "exit"],
+    "reaches": ["init", "exn", "exit", "effects"],
     "root": true
   },
   {
     "name": "init",
     "export": "_initialize"
   },
+  {
+    "name": "effects",
+    "export": "caml_start_fiber"
+  },
   {
     "name": "exn",
     "export": "ocaml_exception"
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
new file mode 100644
index 0000000000..ad386256d3
--- /dev/null
+++ b/runtime/wasm/effect.wat
@@ -0,0 +1,373 @@
+(module
+   (import "fail" "caml_raise_constant"
+      (func $caml_raise_constant (param (ref eq))))
+   (import "fail" "caml_raise_with_arg"
+      (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))))
+   (import "obj" "caml_fresh_oo_id"
+     (func $caml_fresh_oo_id (param (ref eq)) (result (ref eq))))
+   (import "stdlib" "caml_named_value"
+      (func $caml_named_value (param anyref) (result (ref null eq))))
+   (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
+   (import "fail" "javascript_exception"
+      (tag $javascript_exception (param externref)))
+   (import "jslib" "caml_wrap_exception"
+      (func $caml_wrap_exception (param externref) (result (ref eq))))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $function_3
+      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+   (type $closure_3
+      (sub $closure
+         (struct (field (ref $function_1)) (field (ref $function_3)))))
+
+   ;; Apply a function f to a value v, both contained in a pair (f, v)
+
+   (type $pair (struct (field (ref eq)) (field (ref eq))))
+
+   (func $apply_pair (param $p (ref $pair)) (result (ref eq))
+      (local $f (ref eq))
+      (return_call_ref $function_1 (struct.get $pair 1 (local.get $p))
+         (local.tee $f (struct.get $pair 0 (local.get $p)))
+         (struct.get $closure 0 (ref.cast $closure (local.get $f)))))
+
+   ;; Low-level primitives
+
+   (import "bindings" "start_fiber" (func $start_fiber (param (ref eq))))
+   (import "bindings" "suspend_fiber"
+      (func $suspend_fiber
+         (param externref) (param $f funcref) (param $env eqref)
+         (result eqref)))
+   (import "bindings" "resume_fiber"
+      (func $resume_fiber (param externref) (param (ref eq))))
+
+   (global $current_suspender (mut (externref)) (ref.null extern))
+
+   ;; Capturing the current continuation
+
+   (type $cont_func (func (param (ref $pair)) (param (ref eq))))
+   (type $cont (struct (field $cont_func (ref $cont_func))))
+
+   (type $called_with_continuation
+      (func (param (ref $cont)) (param (ref eq))))
+
+   (type $thunk
+      (struct (field (ref $called_with_continuation)) (field (ref eq))))
+
+   (type $cont_resume
+      (sub $cont
+         (struct
+            (field $cont_func (ref $cont_func))
+            (field $cont_resolver externref))))
+
+   (func $invoke_promise_resolver (param $p (ref $pair)) (param (ref eq))
+      (call $resume_fiber
+         (struct.get $cont_resume $cont_resolver
+            (ref.cast $cont_resume (local.get 1)))
+         (local.get $p)))
+
+   (func $apply_continuation (param $resolver (ref extern)) (param $v (ref eq))
+      (local $t (ref $thunk))
+      (local.set $t (ref.cast $thunk (local.get $v)))
+      (return_call_ref $called_with_continuation
+         (struct.new $cont_resume
+            (ref.func $invoke_promise_resolver) (local.get $resolver))
+         (struct.get $thunk 1 (local.get $t))
+         (struct.get $thunk 0 (local.get $t))))
+
+   (func $capture_continuation
+      (param $f (ref $called_with_continuation))
+      (param $v (ref eq))
+      (result (ref eq))
+      (return_call $apply_pair
+         (ref.cast $pair
+            (call $suspend_fiber
+               (global.get $current_suspender)
+               (ref.func $apply_continuation)
+               (struct.new $thunk (local.get $f) (local.get $v))))))
+
+   ;; Stack of fibers
+
+   (type $handlers (array (ref eq)))
+
+   (type $fiber
+      (struct
+         (field $fiber_handlers (mut (ref $handlers)))
+         (field $fiber_cont (ref $cont))
+         (field $fiber_suspender externref)
+         (field $fiber_next (ref null $fiber))))
+
+   (type $continuation (struct (mut (ref null $fiber))))
+
+   (data $effect_unhandled "Effect.Unhandled")
+
+   (func $raise_unhandled
+      (param $eff (ref eq)) (param (ref eq)) (result (ref eq))
+      (block $null
+         (call $caml_raise_with_arg
+            (br_on_null $null
+               (call $caml_named_value
+                  (string.const "Effect.Unhandled")))
+            (local.get $eff)))
+      (call $caml_raise_constant
+         (array.new_fixed $block (i31.new (i32.const 248))
+            (array.new_data $string $effect_unhandled
+               (i32.const 0) (i32.const 16))
+            (call $caml_fresh_oo_id (i31.new (i32.const 0)))))
+      (i31.new (i32.const 0)))
+
+   (func $uncaught_effect_handler
+      (param $eff (ref eq)) (param $cont (ref eq)) (param $k (ref eq))
+      (param (ref eq)) (result (ref eq))
+      (local $k' (ref $cont))
+      (local.set $k'
+         (call $push_stack
+            (ref.as_non_null
+               (struct.get $continuation 0
+                  (ref.cast $continuation (local.get $cont))))
+            (ref.cast $cont (local.get $k))))
+      (call_ref $cont_func
+         (struct.new $pair
+            (struct.new $closure (ref.func $raise_unhandled))
+            (local.get $eff))
+         (local.get $k')
+         (struct.get $cont $cont_func (local.get $k')))
+      (i31.new (i32.const 0)))
+
+   (func $dummy_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (unreachable))
+
+   (func $default_continuation (param $p (ref $pair)) (param (ref eq))
+      (drop (call $apply_pair (local.get $p))))
+
+   (global $fiber_stack (mut (ref null $fiber))
+      (struct.new $fiber
+         (array.new_fixed $handlers
+            (i31.new (i32.const 0))
+            (i31.new (i32.const 0))
+            (struct.new $closure_3
+               (ref.func $dummy_fun)
+               (ref.func $uncaught_effect_handler)))
+         (struct.new $cont (ref.func $default_continuation))
+         (ref.null extern)
+         (ref.null $fiber)))
+
+   ;; Utility functions moving fibers between a continuation and the
+   ;; current stack of fibers
+
+   (func $pop_fiber (result (ref $cont))
+      (local $f (ref $fiber))
+      (local.set $f (ref.as_non_null (global.get $fiber_stack)))
+      (global.set $fiber_stack
+         (struct.get $fiber $fiber_next (local.get $f)))
+      (global.set $current_suspender
+         (struct.get $fiber $fiber_suspender (local.get $f)))
+      (struct.get $fiber $fiber_cont (local.get $f)))
+
+   (func $push_stack
+      (param $stack (ref $fiber)) (param $k (ref $cont))
+      (result (ref $cont))
+      (block $done
+         (loop $loop
+            (global.set $fiber_stack
+               (struct.new $fiber
+                  (struct.get $fiber $fiber_handlers (local.get $stack))
+                  (local.get $k)
+                  (global.get $current_suspender)
+                  (global.get $fiber_stack)))
+            (global.set $current_suspender
+               (struct.get $fiber $fiber_suspender (local.get $stack)))
+            (local.set $k
+               (struct.get $fiber $fiber_cont (local.get $stack)))
+            (local.set $stack
+               (br_on_null $done
+                  (struct.get $fiber $fiber_next (local.get $stack))))
+            (br $loop)))
+      (local.get $k))
+
+   ;; Resume
+
+   (func $do_resume (param $k (ref $cont)) (param $vp (ref eq))
+      (local $p (ref $pair))
+      (local $stack (ref $fiber))
+      (local.set $p (ref.cast $pair (local.get $vp)))
+      (local.set $stack (ref.cast $fiber (struct.get $pair 0 (local.get $p))))
+      (local.set $p (ref.cast $pair (struct.get $pair 1 (local.get $p))))
+      (local.set $k (call $push_stack (local.get $stack) (local.get $k)))
+      (call_ref $cont_func (local.get $p) (local.get $k)
+         (struct.get $cont $cont_func (local.get $k))))
+
+   (func (export "%resume")
+      (param $stack (ref eq)) (param $f (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (local $k (ref $cont))
+      (local $pair (ref $pair))
+      (if (ref.eq (local.get $stack) (i31.new (i32.const 0)))
+         (then
+            (call $caml_raise_constant
+               (ref.as_non_null
+                  (call $caml_named_value
+                     (string.const "Effect.Continuation_already_resumed"))))))
+      (call $capture_continuation
+         (ref.func $do_resume)
+          (struct.new $pair
+             (local.get $stack)
+             (struct.new $pair (local.get $f) (local.get $v)))))
+
+   ;; Perform
+
+   (type $call_handler_env
+      (sub $closure
+         (struct
+            (field (ref $function_1))
+            (field $handler (ref eq))
+            (field $eff (ref eq))
+            (field $cont (ref eq)))))
+
+   (func $call_effect_handler
+      (param $k (ref eq)) (param $venv (ref eq)) (result (ref eq))
+      (local $env (ref $call_handler_env))
+      (local $handler (ref $closure_3))
+      (local.set $env (ref.cast $call_handler_env (local.get $venv)))
+      (return_call_ref $function_3
+         (struct.get $call_handler_env $eff (local.get $env))
+         (struct.get $call_handler_env $cont (local.get $env))
+         (local.get $k)
+         (local.tee $handler
+            (ref.cast $closure_3
+              (struct.get $call_handler_env $handler (local.get $env))))
+         (struct.get $closure_3 1 (local.get $handler))))
+
+   (func $do_perform
+      (param $k0 (ref $cont)) (param $vp (ref eq))
+      (local $eff (ref eq)) (local $cont (ref $continuation))
+      (local $handler (ref eq))
+      (local $k1 (ref $cont))
+      (local $p (ref $pair))
+      (local.set $p (ref.cast $pair (local.get $vp)))
+      (local.set $eff (struct.get $pair 0 (local.get $p)))
+      (local.set $cont
+         (ref.cast $continuation (struct.get $pair 1 (local.get $p))))
+      (local.set $handler
+         (array.get $handlers
+            (struct.get $fiber $fiber_handlers (global.get $fiber_stack))
+            (i32.const 2)))
+      (struct.set $continuation 0
+         (local.get $cont)
+         (struct.new $fiber
+             (struct.get $fiber $fiber_handlers
+                (global.get $fiber_stack))
+             (local.get $k0)
+             (global.get $current_suspender)
+             (struct.get $continuation 0 (local.get $cont))))
+      (local.set $k1 (call $pop_fiber))
+      (call_ref $cont_func
+         (struct.new $pair
+            (struct.new $call_handler_env
+               (ref.func $call_effect_handler)
+               (local.get $handler)
+               (local.get $eff)
+               (local.get $cont))
+            (local.get $k1))
+         (local.get $k1)
+         (struct.get $cont $cont_func (local.get $k1))))
+
+   (func $reperform (export "%reperform")
+      (param $eff (ref eq)) (param $cont (ref eq))
+      (result (ref eq))
+      (call $capture_continuation
+         (ref.func $do_perform)
+         (struct.new $pair (local.get $eff) (local.get $cont))))
+
+   (func (export "%perform") (param $eff (ref eq)) (result (ref eq))
+      (return_call $reperform (local.get $eff)
+         (struct.new $continuation (ref.null $fiber))))
+
+   ;; Allocate a stack
+
+   (func $call_handler (param $i i32) (param $x (ref eq))
+      ;; Propagate a value or an exception to the parent fiber
+      (local $f (ref eq))
+      (local $cont (ref $cont))
+      (local.set $f
+         (array.get $handlers
+            (struct.get $fiber $fiber_handlers (global.get $fiber_stack))
+            (local.get $i)))
+      (call_ref $cont_func (struct.new $pair (local.get $f) (local.get $x))
+         (local.tee $cont (call $pop_fiber))
+         (struct.get $cont $cont_func (local.get $cont))))
+
+   (func (export "caml_start_fiber")
+      (param $suspender externref) (param $p eqref)
+      ;; Start executing some code in a new fiber
+      (local $exn (ref eq))
+      (local $res (ref eq))
+      (global.set $current_suspender (local.get $suspender))
+      (local.set $res
+         (try (result (ref eq))
+            (do
+               (try (result (ref eq))
+                  (do
+                     (call $apply_pair (ref.cast $pair (local.get $p))))
+                  (catch $javascript_exception
+                     (throw $ocaml_exception
+                        (call $caml_wrap_exception (pop externref))))))
+            (catch $ocaml_exception
+               (local.set $exn (pop (ref eq)))
+               (call $call_handler (i32.const 1) (local.get $exn))
+               (return))))
+      (call $call_handler (i32.const 0) (local.get $res)))
+
+   (func $initial_cont (param $p (ref $pair)) (param (ref eq))
+      (call $start_fiber (local.get $p)))
+
+   (func (export "caml_alloc_stack")
+      (param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq))
+      (result (ref eq))
+      (struct.new $fiber
+         (array.new_fixed $handlers
+            (local.get $hv) (local.get $hx) (local.get $hf))
+         (struct.new $cont (ref.func $initial_cont))
+         (ref.null extern)
+         (ref.null $fiber)))
+
+   ;; Other functions
+
+   (func $caml_continuation_use_noexc (export "caml_continuation_use_noexc")
+      (param (ref eq)) (result (ref eq))
+      (local $cont (ref $continuation))
+      (local $stack (ref $fiber))
+      (block $used
+         (local.set $cont (ref.cast $continuation (local.get 0)))
+         (local.set $stack
+            (br_on_null $used (struct.get $continuation 0 (local.get $cont))))
+         (struct.set $continuation 0 (local.get $cont) (ref.null $fiber))
+         (return (local.get $stack)))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_continuation_use_and_update_handler_noexc")
+      (param $cont (ref eq)) (param $hval (ref eq)) (param $hexn (ref eq))
+      (param $heff (ref eq)) (result (ref eq))
+      (local $stack (ref $fiber))
+      (local.set $stack
+         (ref.cast $fiber
+            (call $caml_continuation_use_noexc (local.get $cont))))
+      (block $used
+         (struct.set $fiber $fiber_handlers
+            (br_on_null $used (local.get $stack))
+            (array.new_fixed $handlers
+               (local.get $hval) (local.get $hexn) (local.get $heff))))
+      (local.get $stack))
+
+   (func (export $caml_get_continuation_callstack)
+      (param (ref eq)) (result (ref eq))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (func (export "caml_is_continuation") (param (ref eq)) (result i32)
+      (ref.test $continuation (local.get 0)))
+
+   (func (export "caml_initialize_effects") (param $s externref)
+      (global.set $current_suspender (local.get $s)))
+)
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index c85c083235..b979cbfc15 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -9,10 +9,11 @@
    (tag $ocaml_exception (export "ocaml_exception") (param (ref eq)))
    (export "javascript_exception" (tag $javascript_exception))
 
-   (func $caml_raise_constant (param (ref eq))
+   (func $caml_raise_constant (export "caml_raise_constant") (param (ref eq))
       (throw $ocaml_exception (local.get 0)))
 
-   (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))
+   (func $caml_raise_with_arg (export "caml_raise_with_arg")
+      (param $tag (ref eq)) (param $arg (ref eq))
       (throw $ocaml_exception
          (array.new_fixed $block
             (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 6708b39538..ef36c9bfcf 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -1,6 +1,8 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+   (import "effect" "caml_is_continuation"
+      (func $caml_is_continuation (param (ref eq)) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -178,6 +180,8 @@
          (then (return (i31.new (global.get $custom_tag)))))
       (if (ref.test $closure (local.get $v))
          (then (return (i31.new (global.get $closure_tag)))))
+      (if (call $caml_is_continuation (local.get $v))
+         (then (return (i31.new (global.get $cont_tag)))))
       ;; ZZZ float array
       (i31.new (global.get $abstract_tag)))
 
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index a8f54a5f29..a801268018 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -27,6 +27,18 @@
        Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
        Float32Array, Float64Array, Uint8Array]
 
+    var start_fiber
+
+    function wrap_fun (t,f,a) {
+       // Don't wrap if js-promise-integration is not enabled
+       // There is no way to check this without calling WebAssembly.Function
+       try {
+         return new WebAssembly.Function(t,f,a)
+       } catch (e) {
+         return f
+       }
+    }
+
     let bindings =
         {jstag:
          WebAssembly.JSTag||
@@ -217,6 +229,13 @@
          },
          mktime:(year,month,day,h,m,s)=>new Date(year,month,day,h,m,s).getTime(),
          random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
+         start_fiber:(x)=>start_fiber(x),
+         suspend_fiber:
+         wrap_fun(
+             {parameters: ['externref','funcref','eqref'], results: ['eqref']},
+             ((f, env)=>new Promise((k)=> f(k, env))),
+             {suspending:"first"}),
+         resume_fiber:(k,v)=>k(v),
          log:(x)=>console.log('ZZZZZ', x)
         }
     const imports = {Math:math,bindings:bindings}
@@ -227,8 +246,19 @@
     caml_callback = wasmModule.instance.exports.caml_callback;
     caml_alloc_tm = wasmModule.instance.exports.caml_alloc_tm;
 
+    start_fiber = wrap_fun(
+        {parameters: ['eqref'], results: ['externref']},
+        wasmModule.instance.exports.caml_start_fiber,
+        {promising: 'first'}
+    )
+    var _initialize = wrap_fun(
+        {parameters: [], results: ['externref']},
+        wasmModule.instance.exports._initialize,
+        {promising: 'first'}
+    )
+
     try {
-        wasmModule.instance.exports._initialize()
+        await _initialize()
     } catch (e) {
         if (e instanceof WebAssembly.Exception) {
           const exit_tag = wasmModule.instance.exports.ocaml_exit;

From a460b7bbe1e7a4a3b21515bc116e58022f799059 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 12 Jun 2023 13:33:58 +0200
Subject: [PATCH 064/481] Runtime: parsing

---
 runtime/wasm/io.wat      |   3 +
 runtime/wasm/parsing.wat | 650 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 653 insertions(+)
 create mode 100644 runtime/wasm/parsing.wat

diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 9c374cd917..e2bbcc9854 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -31,6 +31,9 @@
       (call $log_js (string.const "caml_ml_open_descriptor_in"))
       (i31.new (i32.const 0)))
 
+   (global $caml_stderr (export "caml_stderr")
+      (mut (ref eq)) (i31.new (i32.const 0)))
+
    (func (export "caml_ml_open_descriptor_out")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat
new file mode 100644
index 0000000000..c5138586b1
--- /dev/null
+++ b/runtime/wasm/parsing.wat
@@ -0,0 +1,650 @@
+(module
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "io" "caml_stderr" (global $caml_stderr (mut (ref eq))))
+   (import "io" "caml_ml_open_descriptor_out"
+      (func $caml_ml_open_descriptor_out (param (ref eq)) (result (ref eq))))
+   (import "io" "caml_ml_output"
+      (func $caml_ml_output
+         (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
+         (result (ref eq))))
+   (import "io" "caml_ml_flush"
+      (func $caml_ml_flush (param (ref eq)) (result (ref eq))))
+   (import "ints" "caml_format_int"
+      (func $caml_format_int
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "float" "caml_format_float"
+      (func $caml_format_float
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+
+   (type $float (struct (field f64)))
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (func $get (param $a (ref eq)) (param $i i32) (result i32)
+      (local $s (ref $string))
+      (local.set $s (ref.cast $string (local.get $a)))
+      (local.set $i (i32.add (local.get $i) (local.get $i)))
+      (i32.extend16_s
+         (i32.or (array.get_u $string (local.get $s) (local.get $i))
+            (i32.shl
+               (array.get_u $string (local.get $s)
+                  (i32.add (local.get $i) (i32.const 1)))
+               (i32.const 8)))))
+
+   (global $caml_parser_trace (mut i32) (i32.const 0))
+
+   (global $ERRCODE i32 (i32.const 256))
+
+   (global $START i32 (i32.const 0))
+   (global $TOKEN_READ i32 (i32.const 1))
+   (global $STACKS_GROWN_1 i32 (i32.const 2))
+   (global $STACKS_GROWN_2 i32 (i32.const 3))
+   (global $SEMANTIC_ACTION_COMPUTED i32 (i32.const 4))
+   (global $ERROR_DETECTED i32 (i32.const 5))
+   (global $loop i32 (i32.const 6))
+   (global $testshift i32 (i32.const 7))
+   (global $shift i32 (i32.const 8))
+   (global $shift_recover i32 (i32.const 9))
+   (global $reduce i32 (i32.const 10))
+
+   (global $READ_TOKEN i32 (i32.const 0))
+   (global $RAISE_PARSE_ERROR i32 (i32.const 1))
+   (global $GROW_STACKS_1 i32 (i32.const 2))
+   (global $GROW_STACKS_2 i32 (i32.const 3))
+   (global $COMPUTE_SEMANTIC_ACTION i32 (i32.const 4))
+   (global $CALL_ERROR_FUNCTION i32 (i32.const 5))
+
+   (global $env_s_stack i32 (i32.const 1))
+   (global $env_v_stack i32 (i32.const 2))
+   (global $env_symb_start_stack i32 (i32.const 3))
+   (global $env_symb_end_stack i32 (i32.const 4))
+   (global $env_stacksize i32 (i32.const 5))
+   (global $env_stackbase i32 (i32.const 6))
+   (global $env_curr_char i32 (i32.const 7))
+   (global $env_lval i32 (i32.const 8))
+   (global $env_symb_start i32 (i32.const 9))
+   (global $env_symb_end i32 (i32.const 10))
+   (global $env_asp i32 (i32.const 11))
+   (global $env_rule_len i32 (i32.const 12))
+   (global $env_rule_number i32 (i32.const 13))
+   (global $env_sp i32 (i32.const 14))
+   (global $env_state i32 (i32.const 15))
+   (global $env_errflag i32 (i32.const 16))
+
+   (global $tbl_transl_const i32 (i32.const 2))
+   (global $tbl_transl_block i32 (i32.const 3))
+   (global $tbl_lhs i32 (i32.const 4))
+   (global $tbl_len i32 (i32.const 5))
+   (global $tbl_defred i32 (i32.const 6))
+   (global $tbl_dgoto i32 (i32.const 7))
+   (global $tbl_sindex i32 (i32.const 8))
+   (global $tbl_rindex i32 (i32.const 9))
+   (global $tbl_gindex i32 (i32.const 10))
+   (global $tbl_tablesize i32 (i32.const 11))
+   (global $tbl_table i32 (i32.const 12))
+   (global $tbl_check i32 (i32.const 13))
+   (global $tbl_names_const i32 (i32.const 15))
+   (global $tbl_names_block i32 (i32.const 16))
+
+   (func $strlen (param $s (ref $string)) (param $p i32) (result i32)
+      (local $i i32)
+      (local.set $i (local.get $p))
+      (loop $loop
+         (if (i32.ne (array.get $string (local.get $s) (local.get $i))
+               (i32.const 0))
+            (then
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i32.sub (local.get $i) (local.get $p)))
+
+   (data $unknown_token "<unknown token>")
+   (func $token_name
+      (param $vnames (ref eq)) (param $number i32) (result (ref eq))
+      (local $names (ref $string)) (local $i i32) (local $len i32)
+      (local $name (ref $string))
+      (local.set $names (ref.cast $string (local.get $vnames)))
+      (loop $loop
+         (if (i32.eqz (array.get $string (local.get $names) (local.get $i)))
+            (then
+               (return
+                  (array.new_data $string $unknown_token
+                     (i32.const 0) (i32.const 15)))))
+         (if (i32.ne (local.get $number) (i32.const 0))
+            (then
+               (local.set $i
+                  (i32.add (local.get $i)
+                    (i32.add (call $strlen (local.get $names) (local.get $i))
+                      (i32.const 1))))
+               (local.set $number (i32.sub (local.get $number) (i32.const 1)))
+               (br $loop))))
+      (local.set $len (call $strlen (local.get $names) (local.get $i)))
+      (local.set $name (array.new $string (i32.const 0) (local.get $len)))
+      (array.copy $string $string
+         (local.get $name) (i32.const 0)
+         (local.get $names) (local.get $i) (local.get $len))
+      (local.get $name))
+
+   (func $output (param (ref eq))
+      (local $s (ref $string))
+      (local.set $s (ref.cast $string (local.get 0)))
+      (drop
+         (call $caml_ml_output (global.get $caml_stderr)
+            (local.get $s) (i31.new (i32.const 0))
+            (i31.new (array.len (local.get $s))))))
+
+   (func $output_nl
+      (drop
+         (call $caml_ml_output (global.get $caml_stderr)
+            (array.new_fixed $string (i32.const 10))
+            (i31.new (i32.const 0)) (i31.new (i32.const 1))))
+      (drop (call $caml_ml_flush (global.get $caml_stderr))))
+
+   (func $output_str (param (ref string))
+      (call $output (call $caml_string_of_jsstring (call $wrap (local.get 0)))))
+
+   (func $output_int (param i32)
+      (call $output
+         (call $caml_format_int
+            (array.new_fixed $string (i32.const 37) (i32.const 100))
+            (i31.new (local.get 0)))))
+
+   (func $print_token
+      (param $tables (ref $block)) (param $state i32) (param $tok (ref eq))
+      (local $b (ref $block))
+      (local $v (ref eq))
+      (if (ref.test i31 (local.get $tok))
+         (then
+            (call $output_str (string.const "State "))
+            (call $output_int (local.get $state))
+            (call $output_str (string.const ": read token "))
+            (call $output
+               (call $token_name
+                  (array.get $block (local.get $tables)
+                     (global.get $tbl_names_const))
+                  (i31.get_u (ref.cast i31 (local.get $tok)))))
+            (call $output_nl))
+         (else
+            (call $output_str (string.const "State "))
+            (call $output_int (local.get $state))
+            (call $output_str (string.const ": read token "))
+            (local.set $b (ref.cast $block (local.get $tok)))
+            (call $output
+               (call $token_name
+                  (array.get $block (local.get $tables)
+                     (global.get $tbl_names_block))
+                  (i31.get_u
+                     (ref.cast i31
+                        (array.get $block (local.get $b) (i32.const 0))))))
+            (call $output_str (string.const "("))
+            (local.set $v (array.get $block (local.get $b) (i32.const 1)))
+            (if (ref.test i31 (local.get $v))
+               (then
+                  (call $output_int (i31.get_s (ref.cast i31 (local.get $v)))))
+            (else (if (ref.test $string (local.get $v))
+               (then (call $output (local.get $v)))
+            (else (if (ref.test $float (local.get $v))
+               (then
+                  (call $output
+                     (call $caml_format_float
+                        (array.new_fixed $string (i32.const 37) (i32.const 103))
+                        (local.get $v))))
+            (else
+               (call $output_str (string.const "_"))))))))
+            (call $output_str (string.const ")"))
+            (call $output_nl))))
+
+   (func (export "caml_parse_engine")
+      (param $vtables (ref eq)) (param $venv (ref eq)) (param $vcmd (ref eq))
+      (param $varg (ref eq)) (result (ref eq))
+      (local $res i32) (local $n i32) (local $n1 i32) (local $n2 i32)
+      (local $m i32)
+      (local $state1 i32) (local $sp i32) (local $asp i32) (local $state i32)
+      (local $errflag i32)
+      (local $tables (ref $block)) (local $env (ref $block)) (local $cmd i32)
+      (local $arg (ref $block))
+      (local $tbl_defred (ref $string))
+      (local $tbl_sindex (ref $string))
+      (local $tbl_check (ref $string))
+      (local $tbl_rindex (ref $string))
+      (local $tbl_table (ref $string))
+      (local $tbl_len (ref $string))
+      (local $tbl_lhs (ref $string))
+      (local $tbl_gindex (ref $string))
+      (local $tbl_dgoto (ref $string))
+      (local.set $tables (ref.cast $block (local.get $vtables)))
+      (local.set $tbl_defred
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_defred))))
+      (local.set $tbl_sindex
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_sindex))))
+      (local.set $tbl_check
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_check))))
+      (local.set $tbl_rindex
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_rindex))))
+      (local.set $tbl_table
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_table))))
+      (local.set $tbl_len
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_len))))
+      (local.set $tbl_lhs
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_lhs))))
+      (local.set $tbl_gindex
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_gindex))))
+      (local.set $tbl_dgoto
+         (ref.cast $string
+            (array.get $block (local.get $tables) (global.get $tbl_dgoto))))
+      (local.set $env (ref.cast $block (local.get $venv)))
+      (local.set $cmd (i31.get_s (ref.cast i31 (local.get $vcmd))))
+      (local.set $sp
+         (i31.get_s
+            (ref.cast i31
+               (array.get $block (local.get $env) (global.get $env_sp)))))
+      (local.set $state
+         (i31.get_s
+            (ref.cast i31
+               (array.get $block (local.get $env) (global.get $env_state)))))
+      (local.set $errflag
+         (i31.get_s
+            (ref.cast i31
+               (array.get $block (local.get $env) (global.get $env_errflag)))))
+      (block $exit
+       (loop $next
+        (block $default
+         (block $SEMANTIC_ACTION_COMPUTED
+          (block $STACKS_GROWN_2
+           (block $reduce
+            (block $STACKS_GROWN_1
+             (block $shift_recover
+              (block $shift
+               (block $ERROR_DETECTED
+                (block $testshift
+                 (block $TOKEN_READ
+                  (block $loop
+                   (block $START
+                    (br_table $START $TOKEN_READ $STACKS_GROWN_1 $STACKS_GROWN_2
+                       $SEMANTIC_ACTION_COMPUTED $ERROR_DETECTED $loop
+                       $testshift $shift $shift_recover $reduce $default
+                       (local.get $cmd)))
+                   ;; START:
+                   (local.set $state (i32.const 0))
+                   (local.set $errflag (i32.const 0)))
+                   ;; Fall through
+                  ;; loop:
+                  (local.set $n
+                     (call $get (local.get $tbl_defred) (local.get $state)))
+                  (if (i32.ne (local.get $n) (i32.const 0))
+                     (then
+                        (local.set $cmd (global.get $reduce))
+                        (br $next)))
+                  (if (i32.ge_s
+                         (i31.get_s
+                            (ref.cast i31
+                               (array.get $block (local.get $env)
+                                  (global.get $env_curr_char))))
+                         (i32.const 0))
+                     (then
+                        (local.set $cmd (global.get $testshift))
+                        (br $next)))
+                  (local.set $res (global.get $READ_TOKEN))
+                  (br $exit))
+                 ;; TOKEN_READ:
+                 (block $cont
+                    (drop (block $not_block (result (ref eq))
+                       (local.set $arg
+                          (br_on_cast_fail $not_block $block (local.get $varg)))
+                       (array.set $block (local.get $env)
+                          (global.get $env_curr_char)
+                          (array.get $block
+                             (ref.cast $block
+                                (array.get $block (local.get $tables)
+                                   (global.get $tbl_transl_block)))
+                             (i32.add
+                                (i31.get_u
+                                   (ref.cast i31
+                                      (array.get $block
+                                         (local.get $arg) (i32.const 0))))
+                                (i32.const 1))))
+                       (array.set $block (local.get $env) (global.get $env_lval)
+                          (array.get $block (local.get $arg) (i32.const 1)))
+                       (br $cont)))
+                    (array.set $block (local.get $env)
+                       (global.get $env_curr_char)
+                       (array.get $block
+                          (ref.cast $block
+                             (array.get $block (local.get $tables)
+                                (global.get $tbl_transl_const)))
+                          (i32.add
+                             (i31.get_u (ref.cast i31 (local.get $varg)))
+                             (i32.const 1))))
+                    (array.set $block (local.get $env) (global.get $env_lval)
+                       (i31.new (i32.const 0))))
+                 (if (global.get $caml_parser_trace)
+                    (then (call $print_token (local.get $tables)
+                       (local.get $state) (local.get $varg)))))
+                 ;; Fall through
+                ;; testshift:
+                (local.set $n1
+                   (call $get (local.get $tbl_sindex) (local.get $state)))
+                (local.set $n2
+                    (i32.add (local.get $n1)
+                       (i31.get_s
+                          (ref.cast i31
+                             (array.get $block (local.get $env)
+                                (global.get $env_curr_char))))))
+                (if (i32.and
+                       (i32.ne (local.get $n1) (i32.const 0))
+                       (i32.ge_s (local.get $n2) (i32.const 0)))
+                   (then
+                      (if (i32.le_s (local.get $n2)
+                             (i31.get_s
+                                (ref.cast i31
+                                   (array.get $block (local.get $tables)
+                                      (global.get $tbl_tablesize)))))
+                         (then
+                            (if (ref.eq
+                                   (i31.new
+                                      (call $get (local.get $tbl_check)
+                                         (local.get $n2)))
+                                   (array.get $block (local.get $env)
+                                      (global.get $env_curr_char)))
+                               (then
+                                  (local.set $cmd (global.get $shift))
+                                  (br $next)))))))
+                (local.set $n1
+                   (call $get (local.get $tbl_rindex) (local.get $state)))
+                (local.set $n2
+                   (i32.add (local.get $n1)
+                      (i31.get_s
+                         (ref.cast i31
+                            (array.get $block (local.get $env)
+                               (global.get $env_curr_char))))))
+                (if (i32.and
+                       (i32.ne (local.get $n1) (i32.const 0))
+                       (i32.ge_s (local.get $n2) (i32.const 0)))
+                   (then
+                      (if (i32.le_s (local.get $n2)
+                             (i31.get_s
+                                (ref.cast i31
+                                   (array.get $block (local.get $tables)
+                                      (global.get $tbl_tablesize)))))
+                         (then
+                            (if (ref.eq
+                                   (i31.new
+                                      (call $get (local.get $tbl_check)
+                                         (local.get $n2)))
+                                   (array.get $block (local.get $env)
+                                      (global.get $env_curr_char)))
+                               (then
+                                  (local.set $n
+                                     (call $get (local.get $tbl_table)
+                                        (local.get $n2)))
+                                  (local.set $cmd (global.get $reduce))
+                                  (br $next)))))))
+                (if (i32.le_s (local.get $errflag) (i32.const 0))
+                   (then
+                      (local.set $res (global.get $CALL_ERROR_FUNCTION))
+                      (br $exit))))
+                ;; Fall through
+               ;; ERROR_DETECTED:
+               (if (i32.lt_s (local.get $errflag) (i32.const 3))
+                  (then
+                     (local.set $errflag (i32.const 3))
+                     (loop $loop2
+                       (local.set $state1
+                          (i31.get_s
+                             (ref.cast i31
+                                (array.get $block
+                                   (ref.cast $block
+                                      (array.get $block (local.get $env)
+                                         (global.get $env_s_stack)))
+                                   (i32.add (local.get $sp) (i32.const 1))))))
+                       (local.set $n1
+                          (call $get (local.get $tbl_sindex)
+                             (local.get $state1)))
+                       (local.set $n2
+                          (i32.add (local.get $n1) (global.get $ERRCODE)))
+                       (if (i32.and
+                              (i32.ne (local.get $n1) (i32.const 0))
+                              (i32.ge_s (local.get $n2) (i32.const 0)))
+                          (then
+                             (if (i32.le_s (local.get $n2)
+                                    (i31.get_s
+                                       (ref.cast i31
+                                          (array.get $block (local.get $tables)
+                                             (global.get $tbl_tablesize)))))
+                                (then
+                                   (if (i32.eq
+                                          (call $get (local.get $tbl_check)
+                                             (local.get $n2))
+                                          (global.get $ERRCODE))
+                                      (then
+                                         (if (global.get $caml_parser_trace)
+                                            (then
+                                               (call $output_str
+                                                  (string.const
+                                                     "Recovering in state "))
+                                               (call $output_int
+                                                  (local.get $state1))
+                                               (call $output_nl)))
+                                         (local.set $cmd
+                                            (global.get $shift_recover))
+                                         (br $next)))))))
+                       (if (global.get $caml_parser_trace)
+                          (then
+                             (call $output_str
+                                (string.const "Discarding state "))
+                             (call $output_int (local.get $state1))
+                             (call $output_nl)))
+                       (if (i32.le_s (local.get $sp)
+                              (i31.get_s
+                                 (ref.cast i31
+                                    (array.get $block (local.get $env)
+                                       (global.get $env_stackbase)))))
+                          (then
+                             (if (global.get $caml_parser_trace)
+                                (then
+                                   (call $output_str
+                                      (string.const
+                                         "No more states to discard"))
+                                   (call $output_nl)))
+                             (return (i31.new (global.get $RAISE_PARSE_ERROR)))))
+                       (local.set $sp (i32.sub (local.get $sp) (i32.const 1)))
+                       (br $loop2)))
+                  (else
+                     (if (ref.eq
+                            (array.get $block (local.get $env)
+                               (global.get $env_curr_char))
+                            (i31.new (i32.const 0)))
+                        (then
+                           (return (i31.new (global.get $RAISE_PARSE_ERROR)))))
+                     (if (global.get $caml_parser_trace)
+                        (then
+                           (call $output_str
+                              (string.const "Discarding last token read"))
+                           (call $output_nl)))
+                     (array.set $block (local.get $env)
+                        (global.get $env_curr_char)
+                        (i31.new (i32.const -1)))
+                     (local.set $cmd (global.get $loop))
+                     (br $next))))
+              ;; shift:
+              (array.set $block (local.get $env) (global.get $env_curr_char)
+                 (i31.new (i32.const -1)))
+              (if (i32.gt_s (local.get $errflag) (i32.const 0))
+                 (then
+                    (local.set $errflag
+                       (i32.sub (local.get $errflag) (i32.const 1))))))
+              ;; Fall through
+             ;; shift_recover:
+             (if (global.get $caml_parser_trace)
+                (then
+                   (call $output_str (string.const "State "))
+                   (call $output_int (local.get $state))
+                   (call $output_str (string.const ": shift to state "))
+                   (call $output_int
+                      (call $get (local.get $tbl_table) (local.get $n2)))
+                   (call $output_nl)))
+             (local.set $state
+                (call $get (local.get $tbl_table) (local.get $n2)))
+             (local.set $sp (i32.add (local.get $sp) (i32.const 1)))
+             (if (i32.ge_s (local.get $sp)
+                    (i31.get_s
+                       (ref.cast i31
+                           (array.get $block (local.get $env)
+                              (global.get $env_stacksize)))))
+                (then
+                   (local.set $res (global.get $GROW_STACKS_1))
+                   (br $exit))))
+             ;; Fall through
+            ;; STACKS_GROWN_1:
+            (array.set $block
+               (ref.cast $block
+                  (array.get $block (local.get $env) (global.get $env_s_stack)))
+               (i32.add (local.get $sp) (i32.const 1))
+               (i31.new (local.get $state)))
+            (array.set $block
+               (ref.cast $block
+                  (array.get $block (local.get $env) (global.get $env_v_stack)))
+               (i32.add (local.get $sp) (i32.const 1))
+               (array.get $block (local.get $env) (global.get $env_lval)))
+            (array.set $block
+               (ref.cast $block
+                  (array.get $block (local.get $env)
+                     (global.get $env_symb_start_stack)))
+               (i32.add (local.get $sp) (i32.const 1))
+               (array.get $block (local.get $env) (global.get $env_symb_start)))
+            (array.set $block
+               (ref.cast $block
+                  (array.get $block (local.get $env)
+                     (global.get $env_symb_end_stack)))
+               (i32.add (local.get $sp) (i32.const 1))
+               (array.get $block (local.get $env) (global.get $env_symb_end)))
+            (local.set $cmd (global.get $loop))
+            (br $next))
+           ;; reduce:
+           (if (global.get $caml_parser_trace)
+              (then
+                 (call $output_str (string.const "State "))
+                 (call $output_int (local.get $state))
+                 (call $output_str (string.const ": reduce by rule "))
+                 (call $output_int (local.get $n))
+                 (call $output_nl)))
+           (local.set $m (call $get (local.get $tbl_len) (local.get $n)))
+           (array.set $block (local.get $env) (global.get $env_asp)
+              (i31.new (local.get $sp)))
+           (array.set $block (local.get $env) (global.get $env_rule_number)
+              (i31.new (local.get $n)))
+           (array.set $block (local.get $env) (global.get $env_rule_len)
+              (i31.new (local.get $m)))
+           (local.set $sp
+              (i32.add (local.get $sp) (i32.sub (i32.const 1) (local.get $m))))
+           (local.set $m (call $get (local.get $tbl_lhs) (local.get $n)))
+           (local.set $state1
+              (i31.get_s
+                 (ref.cast i31
+                    (array.get $block
+                       (ref.cast $block
+                          (array.get $block (local.get $env)
+                             (global.get $env_s_stack)))
+                       (local.get $sp)))))
+           (local.set $n1 (call $get (local.get $tbl_gindex) (local.get $m)))
+           (local.set $n2 (i32.add (local.get $n1) (local.get $state1)))
+           (block $cont
+              (if (i32.and
+                     (i32.ne (local.get $n1) (i32.const 0))
+                     (i32.ge_s (local.get $n2) (i32.const 0)))
+                 (then
+                    (if (i32.le_s (local.get $n2)
+                           (i31.get_s
+                              (ref.cast i31
+                                 (array.get $block (local.get $tables)
+                                    (global.get $tbl_tablesize)))))
+                       (then
+                          (if (i32.eq
+                                 (call $get (local.get $tbl_check)
+                                    (local.get $n2))
+                                 (local.get $state1))
+                             (then
+                                (local.set $state
+                                   (call $get (local.get $tbl_table)
+                                      (local.get $n2)))
+                                (br $cont)))))))
+              (local.set $state
+                 (call $get (local.get $tbl_dgoto) (local.get $m))))
+           (if (i32.ge_s (local.get $sp)
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $env)
+                           (global.get $env_stacksize)))))
+              (then
+                 (local.set $res (global.get $GROW_STACKS_2))
+                 (br $exit))))
+           ;; Fall through
+          ;; STACKS_GROWN_2:
+          (local.set $res (global.get $COMPUTE_SEMANTIC_ACTION))
+          (br $exit))
+         ;; SEMANTIC_ACTION_COMPUTED:
+         (array.set $block
+            (ref.cast $block
+               (array.get $block (local.get $env) (global.get $env_s_stack)))
+            (i32.add (local.get $sp) (i32.const 1))
+            (i31.new (local.get $state)))
+         (array.set $block
+            (ref.cast $block
+               (array.get $block (local.get $env) (global.get $env_v_stack)))
+            (i32.add (local.get $sp) (i32.const 1))
+            (local.get $varg))
+         (local.set $asp
+            (i31.get_s
+               (ref.cast i31
+                  (array.get $block (local.get $env) (global.get $env_asp)))))
+         (array.set $block
+            (ref.cast $block
+               (array.get $block (local.get $env)
+                  (global.get $env_symb_end_stack)))
+            (i32.add (local.get $sp) (i32.const 1))
+            (array.get $block
+               (ref.cast $block
+                  (array.get $block (local.get $env)
+                     (global.get $env_symb_end_stack)))
+               (i32.add (local.get $asp) (i32.const 1))))
+         (if (i32.gt_s (local.get $sp) (local.get $asp))
+            (then
+            ;; This is an epsilon production. Take symb_start equal to symb_end.
+               (array.set $block
+                  (ref.cast $block
+                     (array.get $block (local.get $env)
+                        (global.get $env_symb_start_stack)))
+                  (i32.add (local.get $sp) (i32.const 1))
+                  (array.get $block
+                     (ref.cast $block
+                        (array.get $block (local.get $env)
+                           (global.get $env_symb_end_stack)))
+                     (i32.add (local.get $asp) (i32.const 1))))))
+         (local.set $cmd (global.get $loop))
+         (br $next))
+        ;; default:
+        (return (i31.new (global.get $RAISE_PARSE_ERROR)))))
+      ;; SAVE
+      (array.set $block (local.get $env) (global.get $env_sp)
+         (i31.new (local.get $sp)))
+      (array.set $block (local.get $env) (global.get $env_state)
+         (i31.new (local.get $state)))
+      (array.set $block (local.get $env) (global.get $env_errflag)
+         (i31.new (local.get $errflag)))
+      (i31.new (local.get $res)))
+
+   (func (export "caml_set_parser_trace") (param (ref eq)) (result (ref eq))
+      (local $oldflag i32)
+      (local.set $oldflag (global.get $caml_parser_trace))
+      (global.set $caml_parser_trace (i31.get_s (ref.cast i31 (local.get 0))))
+      (i31.new (local.get $oldflag)))
+)

From e6a777134244cd45a14ea72a7e53da4ad47cab0d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 12 Jun 2023 13:46:23 +0200
Subject: [PATCH 065/481] Stdlib: make float conversions mandatory

---
 examples/cubes/cubes.ml                  |  76 +++++---
 examples/graph_viewer/viewer_js.ml       |  52 ++++--
 examples/hyperbolic/hypertree.ml         | 130 ++++++++-----
 examples/planet/planet.ml                |  88 ++++++---
 examples/test_wheel/test_wheel.ml        |   6 +-
 examples/webgl/webgldemo.ml              |   6 +-
 lib/js_of_ocaml/dom_html.ml              | 202 +++++++++++----------
 lib/js_of_ocaml/dom_html.mli             | 190 ++++++++++---------
 lib/js_of_ocaml/dom_svg.ml               | 222 +++++++++++++----------
 lib/js_of_ocaml/dom_svg.mli              | 222 +++++++++++++----------
 lib/js_of_ocaml/geolocation.ml           |  14 +-
 lib/js_of_ocaml/geolocation.mli          |  14 +-
 lib/js_of_ocaml/intersectionObserver.ml  |   8 +-
 lib/js_of_ocaml/intersectionObserver.mli |   8 +-
 lib/js_of_ocaml/intl.mli                 |   4 +-
 lib/js_of_ocaml/js.ml                    | 130 ++++++-------
 lib/js_of_ocaml/js.mli                   | 130 ++++++-------
 lib/js_of_ocaml/performanceObserver.ml   |   4 +-
 lib/js_of_ocaml/performanceObserver.mli  |   4 +-
 lib/js_of_ocaml/resizeObserver.ml        |   4 +-
 lib/js_of_ocaml/resizeObserver.mli       |   4 +-
 lib/js_of_ocaml/typed_array.ml           |  22 +--
 lib/js_of_ocaml/typed_array.mli          |  22 +--
 lib/js_of_ocaml/webGL.ml                 |  59 +++---
 lib/js_of_ocaml/webGL.mli                |  59 +++---
 lib/lwt/graphics/graphics_js.ml          |   8 +-
 lib/lwt/lwt_js.ml                        |   4 +-
 lib/lwt/lwt_js_events.ml                 |   2 +-
 28 files changed, 942 insertions(+), 752 deletions(-)

diff --git a/examples/cubes/cubes.ml b/examples/cubes/cubes.ml
index f7a3c9d195..0314554e66 100644
--- a/examples/cubes/cubes.ml
+++ b/examples/cubes/cubes.ml
@@ -65,64 +65,64 @@ let on_cube c i j k f =
   let x = float (i - k + n - 1) *. w in
   let y = (float (n - 1 - j) *. h) +. (float (i + k) *. h /. 2.) in
   c##save;
-  c##translate x y;
+  c##translate (Js.float x) (Js.float y);
   f c;
   c##restore
 
 let draw_top c =
   c##.fillStyle := top;
   c##beginPath;
-  c##moveTo w 0.;
-  c##lineTo (2. *. w) (h /. 2.);
-  c##lineTo w h;
-  c##lineTo 0. (h /. 2.);
+  c##moveTo (Js.float w) (Js.float 0.);
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
+  c##lineTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float 0.) (Js.float (h /. 2.));
   c##fill
 
 let top_edges c =
   c##beginPath;
-  c##moveTo 0. (h /. 2.);
-  c##lineTo w 0.;
-  c##lineTo (2. *. w) (h /. 2.);
+  c##moveTo (Js.float 0.) (Js.float (h /. 2.));
+  c##lineTo (Js.float w) (Js.float 0.);
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
   c##stroke
 
 let draw_right c =
   c##.fillStyle := right;
   c##beginPath;
-  c##moveTo w h;
-  c##lineTo w (2. *. h);
-  c##lineTo (2. *. w) (1.5 *. h);
-  c##lineTo (2. *. w) (h /. 2.);
+  c##moveTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float w) (Js.float (2. *. h));
+  c##lineTo (Js.float (2. *. w)) (Js.float (1.5 *. h));
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
   c##fill
 
 let right_edges c =
   c##beginPath;
-  c##moveTo w (2. *. h);
-  c##lineTo w h;
-  c##lineTo (2. *. w) (h /. 2.);
+  c##moveTo (Js.float w) (Js.float (2. *. h));
+  c##lineTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float (2. *. w)) (Js.float (h /. 2.));
   c##stroke
 
 let draw_left c =
   c##.fillStyle := left;
   c##beginPath;
-  c##moveTo w h;
-  c##lineTo w (2. *. h);
-  c##lineTo 0. (1.5 *. h);
-  c##lineTo 0. (h /. 2.);
+  c##moveTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float w) (Js.float (2. *. h));
+  c##lineTo (Js.float 0.) (Js.float (1.5 *. h));
+  c##lineTo (Js.float 0.) (Js.float (h /. 2.));
   c##fill
 
 let left_edges c =
   c##beginPath;
-  c##moveTo w h;
-  c##lineTo 0. (h /. 2.);
-  c##lineTo 0. (1.5 *. h);
+  c##moveTo (Js.float w) (Js.float h);
+  c##lineTo (Js.float 0.) (Js.float (h /. 2.));
+  c##lineTo (Js.float 0.) (Js.float (1.5 *. h));
   c##stroke
 
 let remaining_edges c =
   c##beginPath;
-  c##moveTo 0. (float n *. 1.5 *. h);
-  c##lineTo (float n *. w) (float n *. 2. *. h);
-  c##lineTo (float n *. 2. *. w) (float n *. 1.5 *. h);
-  c##lineTo (float n *. 2. *. w) (float n *. 0.5 *. h);
+  c##moveTo (Js.float 0.) (Js.float (float n *. 1.5 *. h));
+  c##lineTo (Js.float (float n *. w)) (Js.float (float n *. 2. *. h));
+  c##lineTo (Js.float (float n *. 2. *. w)) (Js.float (float n *. 1.5 *. h));
+  c##lineTo (Js.float (float n *. 2. *. w)) (Js.float (float n *. 0.5 *. h));
   c##stroke
 
 let tile c a (top, right, left) =
@@ -163,15 +163,31 @@ let create_canvas () =
 
 let redraw ctx canvas a =
   let c = canvas##getContext Html._2d_ in
-  c##setTransform 1. 0. 0. 1. 0. 0.;
-  c##clearRect 0. 0. (float canvas##.width) (float canvas##.height);
-  c##setTransform 1. 0. 0. 1. 0.5 0.5;
+  c##setTransform
+    (Js.float 1.)
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float 1.)
+    (Js.float 0.)
+    (Js.float 0.);
+  c##clearRect
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float (float canvas##.width))
+    (Js.float (float canvas##.height));
+  c##setTransform
+    (Js.float 1.)
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float 1.)
+    (Js.float 0.5)
+    (Js.float 0.5);
   c##.globalCompositeOperation := Js.string "lighter";
   tile c a (draw_top, draw_right, draw_left);
   c##.globalCompositeOperation := Js.string "source-over";
   tile c a (top_edges, right_edges, left_edges);
   remaining_edges c;
-  ctx##drawImage_fromCanvas canvas 0. 0.
+  ctx##drawImage_fromCanvas canvas (Js.float 0.) (Js.float 0.)
 
 let ( >>= ) = Lwt.bind
 
diff --git a/examples/graph_viewer/viewer_js.ml b/examples/graph_viewer/viewer_js.ml
index 3ecc09c22d..a0e7316903 100644
--- a/examples/graph_viewer/viewer_js.ml
+++ b/examples/graph_viewer/viewer_js.ml
@@ -50,24 +50,38 @@ module Common = Viewer_common.F (struct
 
   let restore ctx = ctx##restore
 
-  let scale ctx ~sx ~sy = ctx##scale sx sy
+  let scale ctx ~sx ~sy = ctx##scale (Js.float sx) (Js.float sy)
 
-  let translate ctx ~tx ~ty = ctx##translate tx ty
+  let translate ctx ~tx ~ty = ctx##translate (Js.float tx) (Js.float ty)
 
   let begin_path ctx = ctx##beginPath
 
   let close_path ctx = ctx##closePath
 
-  let move_to ctx ~x ~y = ctx##moveTo x y
+  let move_to ctx ~x ~y = ctx##moveTo (Js.float x) (Js.float y)
 
-  let line_to ctx ~x ~y = ctx##lineTo x y
+  let line_to ctx ~x ~y = ctx##lineTo (Js.float x) (Js.float y)
 
-  let curve_to ctx ~x1 ~y1 ~x2 ~y2 ~x3 ~y3 = ctx##bezierCurveTo x1 y1 x2 y2 x3 y3
+  let curve_to ctx ~x1 ~y1 ~x2 ~y2 ~x3 ~y3 =
+    ctx##bezierCurveTo
+      (Js.float x1)
+      (Js.float y1)
+      (Js.float x2)
+      (Js.float y2)
+      (Js.float x3)
+      (Js.float y3)
 
   let arc ctx ~xc ~yc ~radius ~angle1 ~angle2 =
-    ctx##arc xc yc radius angle1 angle2 Js._true
+    ctx##arc
+      (Js.float xc)
+      (Js.float yc)
+      (Js.float radius)
+      (Js.float angle1)
+      (Js.float angle2)
+      Js._true
 
-  let rectangle ctx ~x ~y ~width ~height = ctx##rect x y width height
+  let rectangle ctx ~x ~y ~width ~height =
+    ctx##rect (Js.float x) (Js.float y) (Js.float width) (Js.float height)
 
   let fill ctx c =
     ctx##.fillStyle := c;
@@ -86,12 +100,12 @@ module Common = Viewer_common.F (struct
     (match fill_color with
     | Some c ->
         ctx##.fillStyle := c;
-        ctx##fillText txt x y
+        ctx##fillText txt (Js.float x) (Js.float y)
     | None -> ());
     match stroke_color with
     | Some c ->
         ctx##.strokeStyle := c;
-        ctx##strokeText txt x y
+        ctx##strokeText txt (Js.float x) (Js.float y)
     | None -> ()
 
   type window = Html.canvasElement Js.t
@@ -102,7 +116,7 @@ module Common = Viewer_common.F (struct
 
   let get_drawable w =
     let ctx = w##getContext Html._2d_ in
-    ctx##.lineWidth := 2.;
+    ctx##.lineWidth := Js.float 2.;
     w, ctx
 
   let make_pixmap _ width height =
@@ -126,14 +140,14 @@ module Common = Viewer_common.F (struct
       ((p, _) : pixmap) =
     c##drawImage_fullFromCanvas
       p
-      (float xsrc)
-      (float ysrc)
-      (float width)
-      (float height)
-      (float x)
-      (float y)
-      (float width)
-      (float height)
+      (Js.float (float xsrc))
+      (Js.float (float ysrc))
+      (Js.float (float width))
+      (Js.float (float height))
+      (Js.float (float x))
+      (Js.float (float y))
+      (Js.float (float width))
+      (Js.float (float height))
 
   (****)
 
@@ -353,7 +367,7 @@ Firebug.console##log_2(Js.string "update", Js.date##now());
       redraw_queued := true;
       let (_ : Html.animation_frame_request_id) =
         Html.window##requestAnimationFrame
-          (Js.wrap_callback (fun (_ : float) ->
+          (Js.wrap_callback (fun _ ->
                redraw_queued := false;
                redraw st (get_scale ()) hadj#value vadj#value canvas))
       in
diff --git a/examples/hyperbolic/hypertree.ml b/examples/hyperbolic/hypertree.ml
index 8afd26443b..b203a345c8 100644
--- a/examples/hyperbolic/hypertree.ml
+++ b/examples/hyperbolic/hypertree.ml
@@ -105,9 +105,9 @@ let option var = Js.Optdef.get var (fun () -> Js.Unsafe.coerce (new%js Js.array_
 
 class type style =
   object
-    method border : float Js.optdef Js.readonly_prop
+    method border : float Js.t Js.optdef Js.readonly_prop
 
-    method padding : float Js.optdef Js.readonly_prop
+    method padding : float Js.t Js.optdef Js.readonly_prop
 
     method backgroundColor : Js.js_string Js.t Js.optdef Js.readonly_prop
 
@@ -483,11 +483,26 @@ debug_msg (Format.sprintf "Touch end");
 let roundRectPath c x y w h r =
   let r = min r (min w h /. 2.) in
   c##beginPath;
-  c##moveTo (x +. r) y;
-  c##arcTo (x +. w) y (x +. w) (y +. r) r;
-  c##arcTo (x +. w) (y +. h) (x +. w -. r) (y +. h) r;
-  c##arcTo x (y +. h) x (y +. h -. r) r;
-  c##arcTo x y (x +. r) y r
+  c##moveTo (Js.float (x +. r)) (Js.float y);
+  c##arcTo
+    (Js.float (x +. w))
+    (Js.float y)
+    (Js.float (x +. w))
+    (Js.float (y +. r))
+    (Js.float r);
+  c##arcTo
+    (Js.float (x +. w))
+    (Js.float (y +. h))
+    (Js.float (x +. w -. r))
+    (Js.float (y +. h))
+    (Js.float r);
+  c##arcTo
+    (Js.float x)
+    (Js.float (y +. h))
+    (Js.float x)
+    (Js.float (y +. h -. r))
+    (Js.float r);
+  c##arcTo (Js.float x) (Js.float y) (Js.float (x +. r)) (Js.float y) (Js.float r)
 
 let text_size_div =
   let doc = Html.document in
@@ -540,7 +555,10 @@ let local_messages msgs : messages Js.t = option (Js.Unsafe.get msgs !language)
 (******)
 
 let screen_transform canvas =
-  let offset = opt_style style##.border 0.5 +. opt_style style##.padding 0. in
+  let offset =
+    Js.to_float (opt_style style##.border (Js.float 0.5))
+    +. Js.to_float (opt_style style##.padding (Js.float 0.))
+  in
   let w = canvas##.width in
   let h = canvas##.height in
   (*
@@ -569,9 +587,15 @@ let pi = 4. *. atan 1.
 
 let ellipse_arc c cx cy rx ry start fin clock_wise =
   c##save;
-  c##translate cx cy;
-  c##scale rx ry;
-  c##arc 0. 0. 1. start fin clock_wise;
+  c##translate (Js.float cx) (Js.float cy);
+  c##scale (Js.float rx) (Js.float ry);
+  c##arc
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float 1.)
+    (Js.float start)
+    (Js.float fin)
+    clock_wise;
   c##restore
 
 let arc c (rx, ry, dx, dy) z0 z1 z2 =
@@ -586,11 +610,11 @@ Firebug.console##log_4(start, fin, alpha, (alpha > pi));
   if rx = ry
   then
     c##arc
-      ((z0.x *. rx) +. dx)
-      ((z0.y *. rx) +. dy)
-      (rd *. rx)
-      start
-      fin
+      (Js.float ((z0.x *. rx) +. dx))
+      (Js.float ((z0.y *. rx) +. dy))
+      (Js.float (rd *. rx))
+      (Js.float start)
+      (Js.float fin)
       (Js.bool (alpha > pi))
   else
     ellipse_arc
@@ -606,8 +630,8 @@ Firebug.console##log_4(start, fin, alpha, (alpha > pi));
 
 let line c (rx, ry, dx, dy) z1 z2 =
   c##beginPath;
-  c##moveTo ((z1.x *. rx) +. dx) ((z1.y *. ry) +. dy);
-  c##lineTo ((z2.x *. rx) +. dx) ((z2.y *. ry) +. dy);
+  c##moveTo (Js.float ((z1.x *. rx) +. dx)) (Js.float ((z1.y *. ry) +. dy));
+  c##lineTo (Js.float ((z2.x *. rx) +. dx)) (Js.float ((z2.y *. ry) +. dy));
   c##stroke
 
 (*
@@ -642,18 +666,22 @@ let draw canvas vertices edges nodes boxes =
   Firebug.console##time (Js.string "draw");
   let c = canvas##getContext Html._2d_ in
   let ((rx, ry, dx, dy) as transf) = screen_transform canvas in
-  c##clearRect 0. 0. (float canvas##.width) (float canvas##.height);
-  let padding = opt_style style##.padding 0. in
+  c##clearRect
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float (float canvas##.width))
+    (Js.float (float canvas##.height));
+  let padding = Js.to_float (opt_style style##.padding (Js.float 0.)) in
   c##beginPath;
   ellipse_arc c dx dy (rx +. padding) (ry +. padding) 0. 7. Js._false;
   Js.Optdef.iter style##.backgroundColor (fun color ->
       c##.fillStyle := color;
       c##fill);
   Js.Optdef.iter style##.boundaryColor (fun color ->
-      c##.lineWidth := 1.;
+      c##.lineWidth := Js.float 1.;
       c##.strokeStyle := color;
       c##stroke);
-  c##.lineWidth := 2.;
+  c##.lineWidth := Js.float 2.;
   c##.lineCap := Js.string "round";
   c##.strokeStyle := opt_style style##.treeColor tree_color;
   let rx, ry, _, _ = transf in
@@ -663,7 +691,7 @@ let draw canvas vertices edges nodes boxes =
     let z' = vertices.(j') in
     if rx *. ry *. sq_norm_sub z z' > 4.
     then (
-      c##.lineWidth := w;
+      c##.lineWidth := Js.float w;
       segment c transf z z')
   done;
   let image_count = ref 0 in
@@ -723,13 +751,18 @@ let draw canvas vertices edges nodes boxes =
 *)
                   let blur = 7. *. scale in
                   let offset = 5. *. scale in
-                  c##.shadowBlur := if blur < 1. then 0. else blur;
-                  c##.shadowOffsetX := if blur < 1. then 0. else offset;
-                  c##.shadowOffsetY := if blur < 1. then 0. else offset;
+                  c##.shadowBlur := Js.float (if blur < 1. then 0. else blur);
+                  c##.shadowOffsetX := Js.float (if blur < 1. then 0. else offset);
+                  c##.shadowOffsetY := Js.float (if blur < 1. then 0. else offset);
                   c##.shadowColor := Js.string "black");
                 let x = (z.x *. rx) +. dx in
                 let y = (z.y *. ry) +. dy in
-                c##drawImage_withSize img (x -. w) (y -. h) (2. *. w) (2. *. h);
+                c##drawImage_withSize
+                  img
+                  (Js.float (x -. w))
+                  (Js.float (y -. h))
+                  (Js.float (2. *. w))
+                  (Js.float (2. *. h));
                 (*
               c##drawImage_fromCanvasWithSize
                    (img, x -. w, y -. h, 2. *. w, 2. *. h);
@@ -759,19 +792,19 @@ let draw canvas vertices edges nodes boxes =
           c##beginPath;
           c##.fillStyle := opt_style style##.nodeBackgroundColor tree_color;
           c##arc
-            ((z.x *. rx) +. dx)
-            ((z.y *. ry) +. dy)
-            (sqrt ((w *. w) +. (h *. h)))
-            0.
-            7.
+            (Js.float ((z.x *. rx) +. dx))
+            (Js.float ((z.y *. ry) +. dy))
+            (Js.float (sqrt ((w *. w) +. (h *. h))))
+            (Js.float 0.)
+            (Js.float 7.)
             Js._false;
           c##fill);
         c##drawImage_fromCanvasWithSize
           txt
-          ((z.x *. rx) +. dx -. w)
-          ((z.y *. ry) +. dy -. h)
-          (2. *. w)
-          (2. *. h)
+          (Js.float ((z.x *. rx) +. dx -. w))
+          (Js.float ((z.y *. ry) +. dy -. h))
+          (Js.float (2. *. w))
+          (Js.float (2. *. h))
     | `Txt (_, None, _) | `None -> ()
   done;
   Firebug.console##timeEnd (Js.string "draw");
@@ -795,7 +828,7 @@ let rec randomize_tree n =
   let (Node (_info, ch)) = n in
   for i = Array.length ch - 1 downto 0 do
     let v = ch.(i) in
-    let j = truncate (Js.math##random *. float (i + 1)) in
+    let j = truncate (Js.to_float Js.math##random *. float (i + 1)) in
     ch.(i) <- ch.(j);
     ch.(j) <- v
   done;
@@ -815,7 +848,7 @@ let schedule_redraw () =
     need_redraw := true;
     let (_ : Html.animation_frame_request_id) =
       Html.window##requestAnimationFrame
-        (Js.wrap_callback (fun (_ : float) -> if !need_redraw then perform_redraw ()))
+        (Js.wrap_callback (fun _ -> if !need_redraw then perform_redraw ()))
     in
     ())
 
@@ -859,7 +892,7 @@ let compute_text_node info =
   c##.fillStyle := opt_style style##.nodeColor (Js.string "black");
   c##.textAlign := Js.string "center";
   c##.textBaseline := Js.string "middle";
-  c##fillText (Js.string info) (float w /. 2.) (float h /. 2.);
+  c##fillText (Js.string info) (Js.float (float w /. 2.)) (Js.float (float h /. 2.));
   canvas
 
 let compute_text_nodes node_names nodes =
@@ -1098,19 +1131,19 @@ let close_button over =
   let canvas = create_canvas size size in
   let c = canvas##getContext Html._2d_ in
   c##save;
-  c##.lineWidth := 2.;
+  c##.lineWidth := Js.float 2.;
   c##.strokeStyle := color;
   if over
   then (
-    c##.shadowBlur := offset;
+    c##.shadowBlur := Js.float offset;
     c##.shadowColor := color);
   c##beginPath;
   let a = offset +. (lw /. sqrt 2.) in
   let b = float size -. offset -. (lw /. sqrt 2.) in
-  c##moveTo a a;
-  c##lineTo b b;
-  c##moveTo a b;
-  c##lineTo b a;
+  c##moveTo (Js.float a) (Js.float a);
+  c##lineTo (Js.float b) (Js.float b);
+  c##moveTo (Js.float a) (Js.float b);
+  c##lineTo (Js.float b) (Js.float a);
   c##stroke;
   c##restore;
   canvas##.className := Js.string (if over then "on" else "off");
@@ -1249,7 +1282,12 @@ let show_image all_messages image_info name small_image =
     | Some small_image ->
         let canvas = create_canvas info.width info.height in
         let c = canvas##getContext Html._2d_ in
-        c##drawImage_withSize small_image 0. 0. (float info.width) (float info.height);
+        c##drawImage_withSize
+          small_image
+          (Js.float 0.)
+          (Js.float 0.)
+          (Js.float (float info.width))
+          (Js.float (float info.height));
         canvas##.style##.display := Js.string "block";
         canvas##.style##.height := Js.string "auto";
         canvas##.style##.width := Js.string "auto";
diff --git a/examples/planet/planet.ml b/examples/planet/planet.ml
index 8ca8dffefe..1e55fdf5cd 100644
--- a/examples/planet/planet.ml
+++ b/examples/planet/planet.ml
@@ -355,7 +355,13 @@ let shadow texture =
   let canvas = create_canvas w h in
   let ctx = canvas##getContext Html._2d_ in
   let w, h = w / 8, h / 8 in
-  let img = ctx##getImageData 0. 0. (float w) (float h) in
+  let img =
+    ctx##getImageData
+      (Js.float 0.)
+      (Js.float 0.)
+      (Js.float (float w))
+      (Js.float (float h))
+  in
   let data = img##.data in
   let inv_gamma = 1. /. gamma in
   let update_shadow obliquity =
@@ -382,12 +388,14 @@ let shadow texture =
         Html.pixel_set data (k' + 3) c
       done
     done;
-    ctx##putImageData img 0. 0.;
+    ctx##putImageData img (Js.float 0.) (Js.float 0.);
     ctx##.globalCompositeOperation := Js.string "copy";
     ctx##save;
-    ctx##scale (8. *. float (w + 2) /. float w) (8. *. float (h + 2) /. float h);
-    ctx##translate (-1.) (-1.);
-    ctx##drawImage_fromCanvas canvas 0. 0.;
+    ctx##scale
+      (Js.float (8. *. float (w + 2) /. float w))
+      (Js.float (8. *. float (h + 2) /. float h));
+    ctx##translate (Js.float (-1.)) (Js.float (-1.));
+    ctx##drawImage_fromCanvas canvas (Js.float 0.) (Js.float 0.);
     ctx##restore
   in
   update_shadow obliquity;
@@ -401,15 +409,15 @@ let shadow texture =
     then (
       no_lighting := false;
       let phi = mod_float phi (2. *. pi) in
-      ctx'##drawImage texture 0. 0.;
+      ctx'##drawImage texture (Js.float 0.) (Js.float 0.);
       let i =
         truncate (mod_float (((2. *. pi) -. phi) *. float w /. 2. /. pi) (float w))
       in
-      ctx'##drawImage_fromCanvas canvas (float i) 0.;
-      ctx'##drawImage_fromCanvas canvas (float i -. float w) 0.)
+      ctx'##drawImage_fromCanvas canvas (Js.float (float i)) (Js.float 0.);
+      ctx'##drawImage_fromCanvas canvas (Js.float (float i -. float w)) (Js.float 0.))
     else if not !no_lighting
     then (
-      ctx'##drawImage texture 0. 0.;
+      ctx'##drawImage texture (Js.float 0.) (Js.float 0.);
       no_lighting := true)
   in
   (*
@@ -481,9 +489,9 @@ let draw ctx _img shd o _uv normals face_info dir =
       if dot_product normals.(i) dir >= 0.
       then (
         ctx##beginPath;
-        ctx##moveTo x1 y1;
-        ctx##lineTo x2 y2;
-        ctx##lineTo x3 y3;
+        ctx##moveTo (Js.float x1) (Js.float y1);
+        ctx##lineTo (Js.float x2) (Js.float y2);
+        ctx##lineTo (Js.float x3) (Js.float y3);
         ctx##closePath;
         ctx##save;
         ctx##clip;
@@ -498,7 +506,13 @@ let draw ctx _img shd o _uv normals face_info dir =
         let d = (dy2 *. dv3) -. (dy3 *. dv2) in
         let e = (dy2 *. du3) -. (dy3 *. du2) in
         let f = y1 -. (d *. u1) -. (e *. v1) in
-        ctx##transform a d b e c f;
+        ctx##transform
+          (Js.float a)
+          (Js.float d)
+          (Js.float b)
+          (Js.float e)
+          (Js.float c)
+          (Js.float f);
         (*
 let (u1, v1) = uv.(v1) in
 let (u2, v2) = uv.(v2) in
@@ -546,7 +560,16 @@ let v' = min th (max v1 (max v2 v3) +. 4.) in
 let du = u' -. u in
 let dv = v' -. v in
 *)
-        ctx##drawImage_fullFromCanvas shd u v du dv u v du dv;
+        ctx##drawImage_fullFromCanvas
+          shd
+          (Js.float u)
+          (Js.float v)
+          (Js.float du)
+          (Js.float dv)
+          (Js.float u)
+          (Js.float v)
+          (Js.float du)
+          (Js.float dv);
         ctx##restore))
     o.faces
 
@@ -694,7 +717,7 @@ let start _ =
                       Js._true))
                  Js._true);
           Js._false);
-    let ti = ref (new%js Js.date_now)##getTime in
+    let ti = ref (Js.to_float (new%js Js.date_now)##getTime) in
     let fps = ref 0. in
     let rec loop t phi =
       let rotation = xz_rotation (phi -. !phi_rot) in
@@ -702,21 +725,40 @@ let start _ =
       let m = matrix_mul !m (matrix_mul !m_obliq rotation) in
       let o' = rotate_object m o in
       let v' = rotate_normal m v in
-      ctx'##clearRect 0. 0. (float width) (float height);
+      ctx'##clearRect
+        (Js.float 0.)
+        (Js.float 0.)
+        (Js.float (float width))
+        (Js.float (float height));
       ctx'##save;
       if !clipped
       then (
         ctx'##beginPath;
-        ctx'##arc r r (r *. 0.95) 0. (-2. *. pi) Js._true;
+        ctx'##arc
+          (Js.float r)
+          (Js.float r)
+          (Js.float (r *. 0.95))
+          (Js.float 0.)
+          (Js.float (-2. *. pi))
+          Js._true;
         ctx'##clip);
-      ctx'##setTransform (r -. 2.) 0. 0. (r -. 2.) r r;
+      ctx'##setTransform
+        (Js.float (r -. 2.))
+        (Js.float 0.)
+        (Js.float 0.)
+        (Js.float (r -. 2.))
+        (Js.float r)
+        (Js.float r);
       ctx'##.globalCompositeOperation := Js.string "lighter";
       draw ctx' texture shd o' uv normals face_info v';
       ctx'##restore;
       ctx##.globalCompositeOperation := Js.string "copy";
-      ctx##drawImage_fromCanvas canvas' 0. 0.;
-      (try ignore (ctx##getImageData 0. 0. 1. 1.) with _ -> ());
-      let t' = (new%js Js.date_now)##getTime in
+      ctx##drawImage_fromCanvas canvas' (Js.float 0.) (Js.float 0.);
+      (try
+         ignore
+           (ctx##getImageData (Js.float 0.) (Js.float 0.) (Js.float 1.) (Js.float 1.))
+       with _ -> ());
+      let t' = Js.to_float (new%js Js.date_now)##getTime in
       (fps :=
          let hz = 1000. /. (t' -. !ti) in
          if !fps = 0. then hz else (0.9 *. !fps) +. (0.1 *. hz));
@@ -724,7 +766,7 @@ let start _ =
       ti := t';
       Lwt_js.sleep 0.01
       >>= fun () ->
-      let t' = (new%js Js.date_now)##getTime in
+      let t' = Js.to_float (new%js Js.date_now)##getTime in
       let dt = t' -. t in
       let dt = if dt < 0. then 0. else if dt > 1000. then 0. else dt in
       let angle = 2. *. pi *. dt /. 1000. /. 10. in
@@ -734,7 +776,7 @@ if true then Lwt.return () else
       if (not !paused) && !follow then phi_rot := !phi_rot +. angle;
       loop t' (if !paused then phi else phi +. angle)
     in
-    loop (new%js Js.date_now)##getTime 0.);
+    loop (Js.to_float (new%js Js.date_now)##getTime) 0.);
   Js._false
 
 let _ = Html.window##.onload := Html.handler start
diff --git a/examples/test_wheel/test_wheel.ml b/examples/test_wheel/test_wheel.ml
index 9d17dfbe40..84ef892672 100644
--- a/examples/test_wheel/test_wheel.ml
+++ b/examples/test_wheel/test_wheel.ml
@@ -14,9 +14,9 @@ let () =
   html##.onwheel :=
     Dom.handler (fun (event : Dom_html.mousewheelEvent Js.t) ->
         Firebug.console##debug event;
-        let deltaX = event##.deltaX in
-        let deltaY = event##.deltaY in
-        let deltaZ = event##.deltaZ in
+        let deltaX = Js.to_float event##.deltaX in
+        let deltaY = Js.to_float event##.deltaY in
+        let deltaZ = Js.to_float event##.deltaZ in
         let deltaMode = event##.deltaMode in
         let wheelDelta = event##.wheelDelta in
         let wheelDeltaX = event##.wheelDeltaX in
diff --git a/examples/webgl/webgldemo.ml b/examples/webgl/webgldemo.ml
index edb7f44d20..c071713e7a 100644
--- a/examples/webgl/webgldemo.ml
+++ b/examples/webgl/webgldemo.ml
@@ -89,7 +89,7 @@ let get_source src_id =
 
 let float32array a =
   let array = new%js Typed_array.float32Array (Array.length a) in
-  Array.iteri (fun i v -> Typed_array.set array i v) a;
+  Array.iteri (fun i v -> Typed_array.set array i (Js.float v)) a;
   array
 
 module Proj3D = struct
@@ -273,11 +273,11 @@ let start (pos, norm) =
   in
   check_error gl;
   debug "ready";
-  let get_time () = (new%js date_now)##getTime in
+  let get_time () = Js.to_float (new%js date_now)##getTime in
   let last_draw = ref (get_time ()) in
   let draw_times = Queue.create () in
   let rec f () =
-    let t = (new%js date_now)##getTime /. 1000. in
+    let t = Js.to_float (new%js date_now)##getTime /. 1000. in
     let mat' = Proj3D.mult mat (Proj3D.rotate_y (1. *. t)) in
     gl##uniformMatrix4fv_typed proj_loc _false (Proj3D.array mat');
     gl##clear (gl##._DEPTH_BUFFER_BIT_ lor gl##._COLOR_BUFFER_BIT_);
diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index b579b89f37..1a16f08bd0 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -372,11 +372,11 @@ and mousewheelEvent =
 
     method wheelDeltaY : int optdef readonly_prop
 
-    method deltaX : float readonly_prop
+    method deltaX : float t readonly_prop
 
-    method deltaY : float readonly_prop
+    method deltaY : float t readonly_prop
 
-    method deltaZ : float readonly_prop
+    method deltaZ : float t readonly_prop
 
     method deltaMode : delta_mode readonly_prop
   end
@@ -579,13 +579,13 @@ and pointerEvent =
 
     method pointerId : int Js.readonly_prop
 
-    method width : float Js.readonly_prop
+    method width : float t Js.readonly_prop
 
-    method height : float Js.readonly_prop
+    method height : float t Js.readonly_prop
 
-    method pressure : float Js.readonly_prop
+    method pressure : float t Js.readonly_prop
 
-    method tangentialPressure : float Js.readonly_prop
+    method tangentialPressure : float t Js.readonly_prop
 
     method tiltX : int Js.readonly_prop
 
@@ -643,7 +643,7 @@ and animationEvent =
 
     method animationName : js_string t readonly_prop
 
-    method elapsedTime : float readonly_prop
+    method elapsedTime : float t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -654,7 +654,7 @@ and transitionEvent =
 
     method propertyName : js_string t readonly_prop
 
-    method elapsedTime : float readonly_prop
+    method elapsedTime : float t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -770,17 +770,17 @@ and element =
 
 and clientRect =
   object
-    method top : float readonly_prop
+    method top : float t readonly_prop
 
-    method right : float readonly_prop
+    method right : float t readonly_prop
 
-    method bottom : float readonly_prop
+    method bottom : float t readonly_prop
 
-    method left : float readonly_prop
+    method left : float t readonly_prop
 
-    method width : float optdef readonly_prop
+    method width : float t optdef readonly_prop
 
-    method height : float optdef readonly_prop
+    method height : float t optdef readonly_prop
   end
 
 and clientRectList =
@@ -1670,9 +1670,9 @@ class type timeRanges =
   object
     method length : int readonly_prop
 
-    method start : int -> float meth
+    method start : int -> float t meth
 
-    method end_ : int -> float meth
+    method end_ : int -> float t meth
   end
 
 type networkState =
@@ -1710,9 +1710,9 @@ class type mediaElement =
 
     method currentSrc : js_string t readonly_prop
 
-    method currentTime : float prop
+    method currentTime : float t prop
 
-    method duration : float readonly_prop
+    method duration : float t readonly_prop
 
     method ended : bool t readonly_prop
 
@@ -1728,7 +1728,7 @@ class type mediaElement =
 
     method paused : bool t readonly_prop
 
-    method playbackRate : float prop
+    method playbackRate : float t prop
 
     method played : timeRanges t readonly_prop
 
@@ -1744,7 +1744,7 @@ class type mediaElement =
 
     method src : js_string t prop
 
-    method volume : float prop
+    method volume : float t prop
 
     method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
@@ -1811,7 +1811,7 @@ class type canvasElement =
 
     method toDataURL_type : js_string t -> js_string t meth
 
-    method toDataURL_type_compression : js_string t -> float -> js_string t meth
+    method toDataURL_type_compression : js_string t -> float t -> js_string t meth
 
     method getContext : js_string t -> canvasRenderingContext2D t meth
   end
@@ -1824,17 +1824,19 @@ and canvasRenderingContext2D =
 
     method restore : unit meth
 
-    method scale : float -> float -> unit meth
+    method scale : float t -> float t -> unit meth
 
-    method rotate : float -> unit meth
+    method rotate : float t -> unit meth
 
-    method translate : float -> float -> unit meth
+    method translate : float t -> float t -> unit meth
 
-    method transform : float -> float -> float -> float -> float -> float -> unit meth
+    method transform :
+      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method setTransform : float -> float -> float -> float -> float -> float -> unit meth
+    method setTransform :
+      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method globalAlpha : float prop
+    method globalAlpha : float t prop
 
     method globalCompositeOperation : js_string t prop
 
@@ -1851,10 +1853,16 @@ and canvasRenderingContext2D =
     method fillStyle_pattern : canvasPattern t writeonly_prop
 
     method createLinearGradient :
-      float -> float -> float -> float -> canvasGradient t meth
+      float t -> float t -> float t -> float t -> canvasGradient t meth
 
     method createRadialGradient :
-      float -> float -> float -> float -> float -> float -> canvasGradient t meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> canvasGradient t meth
 
     method createPattern : imageElement t -> js_string t -> canvasPattern t meth
 
@@ -1863,45 +1871,47 @@ and canvasRenderingContext2D =
 
     method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-    method lineWidth : float prop
+    method lineWidth : float t prop
 
     method lineCap : js_string t prop
 
     method lineJoin : js_string t prop
 
-    method miterLimit : float prop
+    method miterLimit : float t prop
 
-    method shadowOffsetX : float prop
+    method shadowOffsetX : float t prop
 
-    method shadowOffsetY : float prop
+    method shadowOffsetY : float t prop
 
-    method shadowBlur : float prop
+    method shadowBlur : float t prop
 
     method shadowColor : js_string t prop
 
-    method clearRect : float -> float -> float -> float -> unit meth
+    method clearRect : float t -> float t -> float t -> float t -> unit meth
 
-    method fillRect : float -> float -> float -> float -> unit meth
+    method fillRect : float t -> float t -> float t -> float t -> unit meth
 
-    method strokeRect : float -> float -> float -> float -> unit meth
+    method strokeRect : float t -> float t -> float t -> float t -> unit meth
 
     method beginPath : unit meth
 
     method closePath : unit meth
 
-    method moveTo : float -> float -> unit meth
+    method moveTo : float t -> float t -> unit meth
 
-    method lineTo : float -> float -> unit meth
+    method lineTo : float t -> float t -> unit meth
 
-    method quadraticCurveTo : float -> float -> float -> float -> unit meth
+    method quadraticCurveTo : float t -> float t -> float t -> float t -> unit meth
 
-    method bezierCurveTo : float -> float -> float -> float -> float -> float -> unit meth
+    method bezierCurveTo :
+      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method arcTo : float -> float -> float -> float -> float -> unit meth
+    method arcTo : float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method rect : float -> float -> float -> float -> unit meth
+    method rect : float t -> float t -> float t -> float t -> unit meth
 
-    method arc : float -> float -> float -> float -> float -> bool t -> unit meth
+    method arc :
+      float t -> float t -> float t -> float t -> float t -> bool t -> unit meth
 
     method fill : unit meth
 
@@ -1909,9 +1919,9 @@ and canvasRenderingContext2D =
 
     method clip : unit meth
 
-    method isPointInPath : float -> float -> bool t meth
+    method isPointInPath : float t -> float t -> bool t meth
 
-    method drawFocusRing : #element t -> float -> float -> bool t -> bool t meth
+    method drawFocusRing : #element t -> float t -> float t -> bool t -> bool t meth
 
     method font : js_string t prop
 
@@ -1919,82 +1929,84 @@ and canvasRenderingContext2D =
 
     method textBaseline : js_string t prop
 
-    method fillText : js_string t -> float -> float -> unit meth
+    method fillText : js_string t -> float t -> float t -> unit meth
 
-    method fillText_withWidth : js_string t -> float -> float -> float -> unit meth
+    method fillText_withWidth : js_string t -> float t -> float t -> float t -> unit meth
 
-    method strokeText : js_string t -> float -> float -> unit meth
+    method strokeText : js_string t -> float t -> float t -> unit meth
 
-    method strokeText_withWidth : js_string t -> float -> float -> float -> unit meth
+    method strokeText_withWidth :
+      js_string t -> float t -> float t -> float t -> unit meth
 
     method measureText : js_string t -> textMetrics t meth
 
-    method drawImage : imageElement t -> float -> float -> unit meth
+    method drawImage : imageElement t -> float t -> float t -> unit meth
 
     method drawImage_withSize :
-      imageElement t -> float -> float -> float -> float -> unit meth
+      imageElement t -> float t -> float t -> float t -> float t -> unit meth
 
     method drawImage_full :
          imageElement t
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
       -> unit meth
 
-    method drawImage_fromCanvas : canvasElement t -> float -> float -> unit meth
+    method drawImage_fromCanvas : canvasElement t -> float t -> float t -> unit meth
 
     method drawImage_fromCanvasWithSize :
-      canvasElement t -> float -> float -> float -> float -> unit meth
+      canvasElement t -> float t -> float t -> float t -> float t -> unit meth
 
     method drawImage_fullFromCanvas :
          canvasElement t
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
       -> unit meth
 
-    method drawImage_fromVideoWithVideo : videoElement t -> float -> float -> unit meth
+    method drawImage_fromVideoWithVideo :
+      videoElement t -> float t -> float t -> unit meth
 
     method drawImage_fromVideoWithSize :
-      videoElement t -> float -> float -> float -> float -> unit meth
+      videoElement t -> float t -> float t -> float t -> float t -> unit meth
 
     method drawImage_fullFromVideo :
          videoElement t
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
       -> unit meth
 
     method createImageData : int -> int -> imageData t meth
 
-    method getImageData : float -> float -> float -> float -> imageData t meth
+    method getImageData : float t -> float t -> float t -> float t -> imageData t meth
 
-    method putImageData : imageData t -> float -> float -> unit meth
+    method putImageData : imageData t -> float t -> float t -> unit meth
   end
 
 and canvasGradient =
   object
-    method addColorStop : float -> js_string t -> unit meth
+    method addColorStop : float t -> js_string t -> unit meth
   end
 
 and textMetrics =
   object
-    method width : float readonly_prop
+    method width : float t readonly_prop
   end
 
 and imageData =
@@ -2357,16 +2369,16 @@ class type window =
 
     method print : unit meth
 
-    method setInterval : (unit -> unit) Js.callback -> float -> interval_id meth
+    method setInterval : (unit -> unit) Js.callback -> float t -> interval_id meth
 
     method clearInterval : interval_id -> unit meth
 
-    method setTimeout : (unit -> unit) Js.callback -> float -> timeout_id meth
+    method setTimeout : (unit -> unit) Js.callback -> float t -> timeout_id meth
 
     method clearTimeout : timeout_id -> unit meth
 
     method requestAnimationFrame :
-      (float -> unit) Js.callback -> animation_frame_request_id meth
+      (float t -> unit) Js.callback -> animation_frame_request_id meth
 
     method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
@@ -2413,7 +2425,7 @@ class type window =
 
     method _URL : _URL t readonly_prop
 
-    method devicePixelRatio : float readonly_prop
+    method devicePixelRatio : float t readonly_prop
   end
 
 let window : window t = Js.Unsafe.global
@@ -2912,8 +2924,8 @@ let elementClientPosition (e : #element t) =
   let r = e##getBoundingClientRect in
   let body = document##.body in
   let html = document##.documentElement in
-  ( truncate r##.left - body##.clientLeft - html##.clientLeft
-  , truncate r##.top - body##.clientTop - html##.clientTop )
+  ( truncate (Js.to_float r##.left) - body##.clientLeft - html##.clientLeft
+  , truncate (Js.to_float r##.top) - body##.clientTop - html##.clientTop )
 
 let getDocumentScroll () =
   let body = document##.body in
@@ -3400,7 +3412,7 @@ module Keyboard_key = struct
     let key = Optdef.get evt##.key empty_string in
     match key##.length with
     | 0 -> Optdef.case evt##.charCode none char_of_int
-    | 1 -> char_of_int (int_of_float (key##charCodeAt 0))
+    | 1 -> char_of_int (key##charCodeAt 0)
     | _ -> None
 end
 
@@ -3655,14 +3667,14 @@ let _requestAnimationFrame : (unit -> unit) Js.callback -> unit =
         let req = List.find (fun c -> Js.Optdef.test c) l in
         fun callback -> Js.Unsafe.fun_call req [| Js.Unsafe.inject callback |]
       with Not_found ->
-        let now () = (new%js Js.date_now)##getTime in
+        let now () = Js.to_float (new%js Js.date_now)##getTime in
         let last = ref (now ()) in
         fun callback ->
           let t = now () in
           let dt = !last +. (1000. /. 60.) -. t in
           let dt = if Poly.(dt < 0.) then 0. else dt in
           last := t;
-          ignore (window##setTimeout callback dt))
+          ignore (window##setTimeout callback (Js.float dt)))
 
 (****)
 
@@ -3689,7 +3701,7 @@ let setTimeout callback d : timeout_id_safe =
       if Poly.(d > overflow_limit) then overflow_limit, d -. overflow_limit else d, 0.
     in
     let cb = if Poly.(remain = 0.) then callback else loop remain in
-    id := Some (window##setTimeout (Js.wrap_callback cb) step)
+    id := Some (window##setTimeout (Js.wrap_callback cb) (Js.float step))
   in
   loop d ();
   id
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index c42c44cfe7..9991763420 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -381,11 +381,11 @@ and mousewheelEvent =
 
     method wheelDeltaY : int optdef readonly_prop
 
-    method deltaX : float readonly_prop
+    method deltaX : float t readonly_prop
 
-    method deltaY : float readonly_prop
+    method deltaY : float t readonly_prop
 
-    method deltaZ : float readonly_prop
+    method deltaZ : float t readonly_prop
 
     method deltaMode : delta_mode readonly_prop
   end
@@ -590,13 +590,13 @@ and pointerEvent =
 
     method pointerId : int Js.readonly_prop
 
-    method width : float Js.readonly_prop
+    method width : float t Js.readonly_prop
 
-    method height : float Js.readonly_prop
+    method height : float t Js.readonly_prop
 
-    method pressure : float Js.readonly_prop
+    method pressure : float t Js.readonly_prop
 
-    method tangentialPressure : float Js.readonly_prop
+    method tangentialPressure : float t Js.readonly_prop
 
     method tiltX : int Js.readonly_prop
 
@@ -655,7 +655,7 @@ and animationEvent =
 
     method animationName : js_string t readonly_prop
 
-    method elapsedTime : float readonly_prop
+    method elapsedTime : float t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -666,7 +666,7 @@ and transitionEvent =
 
     method propertyName : js_string t readonly_prop
 
-    method elapsedTime : float readonly_prop
+    method elapsedTime : float t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -787,17 +787,17 @@ and element =
 (** Rectangular box (used for element bounding boxes) *)
 and clientRect =
   object
-    method top : float readonly_prop
+    method top : float t readonly_prop
 
-    method right : float readonly_prop
+    method right : float t readonly_prop
 
-    method bottom : float readonly_prop
+    method bottom : float t readonly_prop
 
-    method left : float readonly_prop
+    method left : float t readonly_prop
 
-    method width : float optdef readonly_prop
+    method width : float t optdef readonly_prop
 
-    method height : float optdef readonly_prop
+    method height : float t optdef readonly_prop
   end
 
 and clientRectList =
@@ -1496,9 +1496,9 @@ class type timeRanges =
   object
     method length : int readonly_prop
 
-    method start : int -> float meth
+    method start : int -> float t meth
 
-    method end_ : int -> float meth
+    method end_ : int -> float t meth
   end
 
 type networkState =
@@ -1534,9 +1534,9 @@ class type mediaElement =
 
     method currentSrc : js_string t readonly_prop
 
-    method currentTime : float prop
+    method currentTime : float t prop
 
-    method duration : float readonly_prop
+    method duration : float t readonly_prop
 
     method ended : bool t readonly_prop
 
@@ -1552,7 +1552,7 @@ class type mediaElement =
 
     method paused : bool t readonly_prop
 
-    method playbackRate : float prop
+    method playbackRate : float t prop
 
     method played : timeRanges t readonly_prop
 
@@ -1568,7 +1568,7 @@ class type mediaElement =
 
     method src : js_string t prop
 
-    method volume : float prop
+    method volume : float t prop
 
     method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
@@ -1637,7 +1637,7 @@ class type canvasElement =
 
     method toDataURL_type : js_string t -> js_string t meth
 
-    method toDataURL_type_compression : js_string t -> float -> js_string t meth
+    method toDataURL_type_compression : js_string t -> float t -> js_string t meth
 
     method getContext : context -> canvasRenderingContext2D t meth
   end
@@ -1650,17 +1650,19 @@ and canvasRenderingContext2D =
 
     method restore : unit meth
 
-    method scale : float -> float -> unit meth
+    method scale : float t -> float t -> unit meth
 
-    method rotate : float -> unit meth
+    method rotate : float t -> unit meth
 
-    method translate : float -> float -> unit meth
+    method translate : float t -> float t -> unit meth
 
-    method transform : float -> float -> float -> float -> float -> float -> unit meth
+    method transform :
+      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method setTransform : float -> float -> float -> float -> float -> float -> unit meth
+    method setTransform :
+      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method globalAlpha : float prop
+    method globalAlpha : float t prop
 
     method globalCompositeOperation : js_string t prop
 
@@ -1677,10 +1679,16 @@ and canvasRenderingContext2D =
     method fillStyle_pattern : canvasPattern t writeonly_prop
 
     method createLinearGradient :
-      float -> float -> float -> float -> canvasGradient t meth
+      float t -> float t -> float t -> float t -> canvasGradient t meth
 
     method createRadialGradient :
-      float -> float -> float -> float -> float -> float -> canvasGradient t meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> canvasGradient t meth
 
     method createPattern : imageElement t -> js_string t -> canvasPattern t meth
 
@@ -1689,45 +1697,47 @@ and canvasRenderingContext2D =
 
     method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-    method lineWidth : float prop
+    method lineWidth : float t prop
 
     method lineCap : js_string t prop
 
     method lineJoin : js_string t prop
 
-    method miterLimit : float prop
+    method miterLimit : float t prop
 
-    method shadowOffsetX : float prop
+    method shadowOffsetX : float t prop
 
-    method shadowOffsetY : float prop
+    method shadowOffsetY : float t prop
 
-    method shadowBlur : float prop
+    method shadowBlur : float t prop
 
     method shadowColor : js_string t prop
 
-    method clearRect : float -> float -> float -> float -> unit meth
+    method clearRect : float t -> float t -> float t -> float t -> unit meth
 
-    method fillRect : float -> float -> float -> float -> unit meth
+    method fillRect : float t -> float t -> float t -> float t -> unit meth
 
-    method strokeRect : float -> float -> float -> float -> unit meth
+    method strokeRect : float t -> float t -> float t -> float t -> unit meth
 
     method beginPath : unit meth
 
     method closePath : unit meth
 
-    method moveTo : float -> float -> unit meth
+    method moveTo : float t -> float t -> unit meth
 
-    method lineTo : float -> float -> unit meth
+    method lineTo : float t -> float t -> unit meth
 
-    method quadraticCurveTo : float -> float -> float -> float -> unit meth
+    method quadraticCurveTo : float t -> float t -> float t -> float t -> unit meth
 
-    method bezierCurveTo : float -> float -> float -> float -> float -> float -> unit meth
+    method bezierCurveTo :
+      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method arcTo : float -> float -> float -> float -> float -> unit meth
+    method arcTo : float t -> float t -> float t -> float t -> float t -> unit meth
 
-    method rect : float -> float -> float -> float -> unit meth
+    method rect : float t -> float t -> float t -> float t -> unit meth
 
-    method arc : float -> float -> float -> float -> float -> bool t -> unit meth
+    method arc :
+      float t -> float t -> float t -> float t -> float t -> bool t -> unit meth
 
     method fill : unit meth
 
@@ -1735,9 +1745,9 @@ and canvasRenderingContext2D =
 
     method clip : unit meth
 
-    method isPointInPath : float -> float -> bool t meth
+    method isPointInPath : float t -> float t -> bool t meth
 
-    method drawFocusRing : #element t -> float -> float -> bool t -> bool t meth
+    method drawFocusRing : #element t -> float t -> float t -> bool t -> bool t meth
 
     method font : js_string t prop
 
@@ -1745,83 +1755,85 @@ and canvasRenderingContext2D =
 
     method textBaseline : js_string t prop
 
-    method fillText : js_string t -> float -> float -> unit meth
+    method fillText : js_string t -> float t -> float t -> unit meth
 
-    method fillText_withWidth : js_string t -> float -> float -> float -> unit meth
+    method fillText_withWidth : js_string t -> float t -> float t -> float t -> unit meth
 
-    method strokeText : js_string t -> float -> float -> unit meth
+    method strokeText : js_string t -> float t -> float t -> unit meth
 
-    method strokeText_withWidth : js_string t -> float -> float -> float -> unit meth
+    method strokeText_withWidth :
+      js_string t -> float t -> float t -> float t -> unit meth
 
     method measureText : js_string t -> textMetrics t meth
 
-    method drawImage : imageElement t -> float -> float -> unit meth
+    method drawImage : imageElement t -> float t -> float t -> unit meth
 
     method drawImage_withSize :
-      imageElement t -> float -> float -> float -> float -> unit meth
+      imageElement t -> float t -> float t -> float t -> float t -> unit meth
 
     method drawImage_full :
          imageElement t
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
       -> unit meth
 
-    method drawImage_fromCanvas : canvasElement t -> float -> float -> unit meth
+    method drawImage_fromCanvas : canvasElement t -> float t -> float t -> unit meth
 
     method drawImage_fromCanvasWithSize :
-      canvasElement t -> float -> float -> float -> float -> unit meth
+      canvasElement t -> float t -> float t -> float t -> float t -> unit meth
 
     method drawImage_fullFromCanvas :
          canvasElement t
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
       -> unit meth
 
-    method drawImage_fromVideoWithVideo : videoElement t -> float -> float -> unit meth
+    method drawImage_fromVideoWithVideo :
+      videoElement t -> float t -> float t -> unit meth
 
     method drawImage_fromVideoWithSize :
-      videoElement t -> float -> float -> float -> float -> unit meth
+      videoElement t -> float t -> float t -> float t -> float t -> unit meth
 
     method drawImage_fullFromVideo :
          videoElement t
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
-      -> float
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
       -> unit meth
 
     (* Method createImageData not available in Opera *)
     method createImageData : int -> int -> imageData t meth
 
-    method getImageData : float -> float -> float -> float -> imageData t meth
+    method getImageData : float t -> float t -> float t -> float t -> imageData t meth
 
-    method putImageData : imageData t -> float -> float -> unit meth
+    method putImageData : imageData t -> float t -> float t -> unit meth
   end
 
 and canvasGradient =
   object
-    method addColorStop : float -> js_string t -> unit meth
+    method addColorStop : float t -> js_string t -> unit meth
   end
 
 and textMetrics =
   object
-    method width : float readonly_prop
+    method width : float t readonly_prop
   end
 
 and imageData =
@@ -2210,16 +2222,16 @@ class type window =
 
     method print : unit meth
 
-    method setInterval : (unit -> unit) Js.callback -> float -> interval_id meth
+    method setInterval : (unit -> unit) Js.callback -> float t -> interval_id meth
 
     method clearInterval : interval_id -> unit meth
 
-    method setTimeout : (unit -> unit) Js.callback -> float -> timeout_id meth
+    method setTimeout : (unit -> unit) Js.callback -> float t -> timeout_id meth
 
     method clearTimeout : timeout_id -> unit meth
 
     method requestAnimationFrame :
-      (float -> unit) Js.callback -> animation_frame_request_id meth
+      (float t -> unit) Js.callback -> animation_frame_request_id meth
 
     method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
@@ -2266,7 +2278,7 @@ class type window =
 
     method _URL : _URL t readonly_prop
 
-    method devicePixelRatio : float readonly_prop
+    method devicePixelRatio : float t readonly_prop
   end
 
 val window : window t
diff --git a/lib/js_of_ocaml/dom_svg.ml b/lib/js_of_ocaml/dom_svg.ml
index 7382a5f0f1..06162871e2 100644
--- a/lib/js_of_ocaml/dom_svg.ml
+++ b/lib/js_of_ocaml/dom_svg.ml
@@ -221,7 +221,7 @@ and animatedEnumeration = [int (*short*)] animated
 and animatedInteger = [int] animated
 
 (* interface SVGAnimatedNumber *)
-and animatedNumber = [float] animated
+and animatedNumber = [float t] animated
 
 (* interface SVGNumberList *)
 and numberList = [number t] list
@@ -234,13 +234,13 @@ and length =
   object
     method unitType : lengthUnitType readonly_prop
 
-    method value : float prop
+    method value : float t prop
 
-    method valueInSpecifiedUnits : float prop
+    method valueInSpecifiedUnits : float t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : lengthUnitType -> float -> unit meth
+    method newValueSpecifiedUnits : lengthUnitType -> float t -> unit meth
 
     method convertToSpecifiedUnits : lengthUnitType -> unit meth
   end
@@ -259,13 +259,13 @@ and angle =
   object
     method unitType : angleUnitType readonly_prop
 
-    method value : float prop
+    method value : float t prop
 
-    method valueInSpecifiedUnits : float prop
+    method valueInSpecifiedUnits : float t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : angleUnitType -> float -> unit meth
+    method newValueSpecifiedUnits : angleUnitType -> float t -> unit meth
 
     method convertToSpecifiedUnits : angleUnitType -> unit meth
   end
@@ -304,13 +304,13 @@ and iccColor =
 (* interface SVGRect *)
 and rect =
   object
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method width : float prop
+    method width : float t prop
 
-    method height : float prop
+    method height : float t prop
   end
 
 (* interface SVGAnimatedRect *)
@@ -471,19 +471,19 @@ and svgElement =
 
     method viewport : rect t readonly_prop
 
-    method pixelUnitToMillimeterX : float readonly_prop
+    method pixelUnitToMillimeterX : float t readonly_prop
 
-    method pixelUnitToMillimeterY : float readonly_prop
+    method pixelUnitToMillimeterY : float t readonly_prop
 
-    method screenPixelUnitToMillimeterX : float readonly_prop
+    method screenPixelUnitToMillimeterX : float t readonly_prop
 
-    method screenPixelUnitToMillimeterY : float readonly_prop
+    method screenPixelUnitToMillimeterY : float t readonly_prop
 
     method useCurrentView : bool t readonly_prop
 
     method currentView : viewSpec t readonly_prop
 
-    method currentScale : float prop
+    method currentScale : float t prop
 
     method currentTranslate : point t readonly_prop
 
@@ -501,7 +501,7 @@ and svgElement =
 
     method animationsPaused : bool t meth
 
-    method getCurrentTime : float meth
+    method getCurrentTime : float t meth
 
     method setCurrentTime : int -> unit meth
 
@@ -726,9 +726,9 @@ and styleElement =
 (* interface SVGPoint *)
 and point =
   object
-    method x : float readonly_prop
+    method x : float t readonly_prop
 
-    method y : float readonly_prop
+    method y : float t readonly_prop
 
     method matrixTransform : matrix t -> point t meth
   end
@@ -739,39 +739,39 @@ and pointList = [point t] list
 (* interface SVGMatrix *)
 and matrix =
   object
-    method a : float readonly_prop
+    method a : float t readonly_prop
 
-    method b : float readonly_prop
+    method b : float t readonly_prop
 
-    method c : float readonly_prop
+    method c : float t readonly_prop
 
-    method d : float readonly_prop
+    method d : float t readonly_prop
 
-    method e : float readonly_prop
+    method e : float t readonly_prop
 
-    method f : float readonly_prop
+    method f : float t readonly_prop
 
     method multiply : matrix t -> matrix t meth
 
     method inverse : matrix t meth
 
-    method translate : float -> float -> matrix t meth
+    method translate : float t -> float t -> matrix t meth
 
-    method scale : float -> matrix t meth
+    method scale : float t -> matrix t meth
 
-    method scaleNonUniform : float -> float -> matrix t meth
+    method scaleNonUniform : float t -> float t -> matrix t meth
 
-    method rotate : float -> matrix t meth
+    method rotate : float t -> matrix t meth
 
-    method rotateFromVector : float -> float -> matrix t meth
+    method rotateFromVector : float t -> float t -> matrix t meth
 
     method flipX : matrix t meth
 
     method flipY : matrix t meth
 
-    method skewX : float -> matrix t meth
+    method skewX : float t -> matrix t meth
 
-    method skewY : float -> matrix t meth
+    method skewY : float t -> matrix t meth
   end
 
 (* interface SVGTransform *)
@@ -781,19 +781,19 @@ and transform =
 
     method matrix : matrix t readonly_prop
 
-    method angle : float readonly_prop
+    method angle : float t readonly_prop
 
     method setMatrix : matrix t -> unit meth
 
-    method setTranslate : float -> float -> unit meth
+    method setTranslate : float t -> float t -> unit meth
 
-    method setScale : float -> float -> unit meth
+    method setScale : float t -> float t -> unit meth
 
-    method setRotate : float -> float -> float -> unit meth
+    method setRotate : float t -> float t -> float t -> unit meth
 
-    method setSkewX : float -> unit meth
+    method setSkewX : float t -> unit meth
 
-    method setSkewY : float -> unit meth
+    method setSkewY : float t -> unit meth
   end
 
 (* interface SVGTransformList *)
@@ -837,9 +837,9 @@ and pathSegMoveto =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
   end
 
 (* interface SVGPathSegLinetoAbs *)
@@ -848,9 +848,9 @@ and pathSegLineto =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
   end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
@@ -859,17 +859,17 @@ and pathSegCurvetoCubic =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method x1 : float prop
+    method x1 : float t prop
 
-    method y1 : float prop
+    method y1 : float t prop
 
-    method x2 : float prop
+    method x2 : float t prop
 
-    method y2 : float prop
+    method y2 : float t prop
   end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
@@ -878,13 +878,13 @@ and pathSegCurvetoQuadratic =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method x1 : float prop
+    method x1 : float t prop
 
-    method y1 : float prop
+    method y1 : float t prop
   end
 
 (* interface SVGPathSegArcAbs *)
@@ -893,13 +893,13 @@ and pathSegArc =
   object
     inherit pathSeg
 
-    method y : float prop
+    method y : float t prop
 
-    method r1 : float prop
+    method r1 : float t prop
 
-    method r2 : float prop
+    method r2 : float t prop
 
-    method angle : float prop
+    method angle : float t prop
 
     method largeArcFlag : bool t prop
 
@@ -912,7 +912,7 @@ and pathSegLinetoHorizontal =
   object
     inherit pathSeg
 
-    method x : float
+    method x : float t
   end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
@@ -921,20 +921,20 @@ and pathSegLinetoVertical =
   object
     inherit pathSeg
 
-    method y : float
+    method y : float t
   end
 
 and pathSegCurvetoCubicSmooth =
   object
     inherit pathSeg
 
-    method x : float
+    method x : float t
 
-    method y : float
+    method y : float t
 
-    method x2 : float
+    method x2 : float t
 
-    method y2 : float
+    method y2 : float t
   end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
@@ -943,9 +943,9 @@ and pathSegCurvetoQuadraticSmooth =
   object
     inherit pathSeg
 
-    method x : float
+    method x : float t
 
-    method y : float
+    method y : float t
   end
 
 and pathSegList = [pathSeg t] list
@@ -981,59 +981,85 @@ and pathElement =
 
     method pathLength : animatedNumber t readonly_prop
 
-    method getTotalLength : float meth
+    method getTotalLength : float t meth
 
-    method getPointAtLength : float -> point t meth
+    method getPointAtLength : float t -> point t meth
 
-    method getPathSegAtLength : float -> int
+    method getPathSegAtLength : float t -> int
 
     method createSVGPathSegClosePath : pathSegClosePath meth
 
-    method createSVGPathSegMovetoAbs : float -> float -> pathSegMoveto meth
+    method createSVGPathSegMovetoAbs : float t -> float t -> pathSegMoveto meth
 
-    method createSVGPathSegMovetoRel : float -> float -> pathSegMoveto meth
+    method createSVGPathSegMovetoRel : float t -> float t -> pathSegMoveto meth
 
-    method createSVGPathSegLinetoAbs : float -> float -> pathSegLineto meth
+    method createSVGPathSegLinetoAbs : float t -> float t -> pathSegLineto meth
 
-    method createSVGPathSegLinetoRel : float -> float -> pathSegLineto meth
+    method createSVGPathSegLinetoRel : float t -> float t -> pathSegLineto meth
 
     method createSVGPathSegCurvetoCubicAbs :
-      float -> float -> float -> float -> float -> float -> pathSegCurvetoCubic meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoCubicRel :
-      float -> float -> float -> float -> float -> float -> pathSegCurvetoCubic meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoQuadraticAbs :
-      float -> float -> float -> float -> pathSegCurvetoQuadratic meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegCurvetoQuadraticRel :
-      float -> float -> float -> float -> pathSegCurvetoQuadratic meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegArcAbs :
-      float -> float -> float -> float -> float -> bool t -> bool t -> pathSegArc meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> bool t
+      -> bool t
+      -> pathSegArc meth
 
     method createSVGPathSegArcRel :
-      float -> float -> float -> float -> float -> bool t -> bool t -> pathSegArc meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> bool t
+      -> bool t
+      -> pathSegArc meth
 
-    method createSVGPathSegLinetoHorizontalAbs : float -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalAbs : float t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoHorizontalRel : float -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalRel : float t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoVerticalAbs : float -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalAbs : float t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegLinetoVerticalRel : float -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalRel : float t -> pathSegLinetoVertical meth
 
     method createSVGPathSegCurvetoCubicSmoothAbs :
-      float -> float -> float -> float -> pathSegCurvetoCubicSmooth meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoCubicSmoothRel :
-      float -> float -> float -> float -> pathSegCurvetoCubicSmooth meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothAbs :
-      float -> float -> pathSegCurvetoQuadraticSmooth meth
+      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothRel :
-      float -> float -> pathSegCurvetoQuadraticSmooth meth
+      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
   end
 
 (* interface SVGRectElement *)
@@ -1201,9 +1227,9 @@ and textContentElement =
 
     method getNumberOfChars : int meth
 
-    method getComputedTextLength : float meth
+    method getComputedTextLength : float t meth
 
-    method getSubStringLength : int -> int -> float meth
+    method getSubStringLength : int -> int -> float t meth
 
     method getStartPositionOfChar : int -> point t meth
 
@@ -1211,7 +1237,7 @@ and textContentElement =
 
     method getExtentOfChar : int -> rect t meth
 
-    method getRotationOfChar : int -> float meth
+    method getRotationOfChar : int -> float t meth
 
     method getCharNumAtPosition : point -> int meth
 
@@ -1300,13 +1326,13 @@ and glyphRefElement =
 
     method format : js_string t prop
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method dx : float prop
+    method dx : float t prop
 
-    method dy : float prop
+    method dy : float t prop
   end
 
 (* interface SVGPaint : SVGColor { *)
@@ -1709,7 +1735,7 @@ and filterElement =
 (*   readonly attribute SVGAnimatedNumber stdDeviationX; *)
 (*   readonly attribute SVGAnimatedNumber stdDeviationY; *)
 
-(*   void setStdDeviation(in float stdDeviationX, in float stdDeviationY) raises(DOMException); *)
+(*   void setStdDeviation(in float t stdDeviationX, in float t stdDeviationY) raises(DOMException); *)
 (* }; *)
 
 (* interface SVGFEImageElement : SVGElement, *)
@@ -1849,9 +1875,9 @@ and scriptElement =
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
-(*   readonly attribute float previousScale; *)
+(*   readonly attribute float t previousScale; *)
 (*   readonly attribute SVGPoint previousTranslate; *)
-(*   readonly attribute float newScale; *)
+(*   readonly attribute float t newScale; *)
 (*   readonly attribute SVGPoint newTranslate; *)
 (* }; *)
 
@@ -1867,11 +1893,11 @@ and animationElement =
     (* inherit elementTimeControl *)
     method targetElement : element t readonly_prop
 
-    method getStartTime : float meth
+    method getStartTime : float t meth
 
-    method getCurrentTime : float meth
+    method getCurrentTime : float t meth
 
-    method getSimpleDuration : float meth
+    method getSimpleDuration : float t meth
   end
 
 (* interface SVGAnimateElement *)
diff --git a/lib/js_of_ocaml/dom_svg.mli b/lib/js_of_ocaml/dom_svg.mli
index 3a0772d448..3445471df6 100644
--- a/lib/js_of_ocaml/dom_svg.mli
+++ b/lib/js_of_ocaml/dom_svg.mli
@@ -224,7 +224,7 @@ and animatedEnumeration = [int (*short*)] animated
 and animatedInteger = [int] animated
 
 (* interface SVGAnimatedNumber *)
-and animatedNumber = [float] animated
+and animatedNumber = [float t] animated
 
 (* interface SVGNumberList *)
 and numberList = [number t] list
@@ -237,13 +237,13 @@ and length =
   object
     method unitType : lengthUnitType readonly_prop
 
-    method value : float prop
+    method value : float t prop
 
-    method valueInSpecifiedUnits : float prop
+    method valueInSpecifiedUnits : float t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : lengthUnitType -> float -> unit meth
+    method newValueSpecifiedUnits : lengthUnitType -> float t -> unit meth
 
     method convertToSpecifiedUnits : lengthUnitType -> unit meth
   end
@@ -262,13 +262,13 @@ and angle =
   object
     method unitType : angleUnitType readonly_prop
 
-    method value : float prop
+    method value : float t prop
 
-    method valueInSpecifiedUnits : float prop
+    method valueInSpecifiedUnits : float t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : angleUnitType -> float -> unit meth
+    method newValueSpecifiedUnits : angleUnitType -> float t -> unit meth
 
     method convertToSpecifiedUnits : angleUnitType -> unit meth
   end
@@ -307,13 +307,13 @@ and iccColor =
 (* interface SVGRect *)
 and rect =
   object
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method width : float prop
+    method width : float t prop
 
-    method height : float prop
+    method height : float t prop
   end
 
 (* interface SVGAnimatedRect *)
@@ -473,19 +473,19 @@ and svgElement =
 
     method viewport : rect t readonly_prop
 
-    method pixelUnitToMillimeterX : float readonly_prop
+    method pixelUnitToMillimeterX : float t readonly_prop
 
-    method pixelUnitToMillimeterY : float readonly_prop
+    method pixelUnitToMillimeterY : float t readonly_prop
 
-    method screenPixelUnitToMillimeterX : float readonly_prop
+    method screenPixelUnitToMillimeterX : float t readonly_prop
 
-    method screenPixelUnitToMillimeterY : float readonly_prop
+    method screenPixelUnitToMillimeterY : float t readonly_prop
 
     method useCurrentView : bool t readonly_prop
 
     method currentView : viewSpec t readonly_prop
 
-    method currentScale : float prop
+    method currentScale : float t prop
 
     method currentTranslate : point t readonly_prop
 
@@ -503,7 +503,7 @@ and svgElement =
 
     method animationsPaused : bool t meth
 
-    method getCurrentTime : float meth
+    method getCurrentTime : float t meth
 
     method setCurrentTime : int -> unit meth
 
@@ -728,9 +728,9 @@ and styleElement =
 (* interface SVGPoint *)
 and point =
   object
-    method x : float readonly_prop
+    method x : float t readonly_prop
 
-    method y : float readonly_prop
+    method y : float t readonly_prop
 
     method matrixTransform : matrix t -> point t meth
   end
@@ -741,39 +741,39 @@ and pointList = [point t] list
 (* interface SVGMatrix *)
 and matrix =
   object
-    method a : float readonly_prop
+    method a : float t readonly_prop
 
-    method b : float readonly_prop
+    method b : float t readonly_prop
 
-    method c : float readonly_prop
+    method c : float t readonly_prop
 
-    method d : float readonly_prop
+    method d : float t readonly_prop
 
-    method e : float readonly_prop
+    method e : float t readonly_prop
 
-    method f : float readonly_prop
+    method f : float t readonly_prop
 
     method multiply : matrix t -> matrix t meth
 
     method inverse : matrix t meth
 
-    method translate : float -> float -> matrix t meth
+    method translate : float t -> float t -> matrix t meth
 
-    method scale : float -> matrix t meth
+    method scale : float t -> matrix t meth
 
-    method scaleNonUniform : float -> float -> matrix t meth
+    method scaleNonUniform : float t -> float t -> matrix t meth
 
-    method rotate : float -> matrix t meth
+    method rotate : float t -> matrix t meth
 
-    method rotateFromVector : float -> float -> matrix t meth
+    method rotateFromVector : float t -> float t -> matrix t meth
 
     method flipX : matrix t meth
 
     method flipY : matrix t meth
 
-    method skewX : float -> matrix t meth
+    method skewX : float t -> matrix t meth
 
-    method skewY : float -> matrix t meth
+    method skewY : float t -> matrix t meth
   end
 
 (* interface SVGTransform *)
@@ -783,19 +783,19 @@ and transform =
 
     method matrix : matrix t readonly_prop
 
-    method angle : float readonly_prop
+    method angle : float t readonly_prop
 
     method setMatrix : matrix t -> unit meth
 
-    method setTranslate : float -> float -> unit meth
+    method setTranslate : float t -> float t -> unit meth
 
-    method setScale : float -> float -> unit meth
+    method setScale : float t -> float t -> unit meth
 
-    method setRotate : float -> float -> float -> unit meth
+    method setRotate : float t -> float t -> float t -> unit meth
 
-    method setSkewX : float -> unit meth
+    method setSkewX : float t -> unit meth
 
-    method setSkewY : float -> unit meth
+    method setSkewY : float t -> unit meth
   end
 
 (* interface SVGTransformList *)
@@ -839,9 +839,9 @@ and pathSegMoveto =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
   end
 
 (* interface SVGPathSegLinetoAbs *)
@@ -850,9 +850,9 @@ and pathSegLineto =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
   end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
@@ -861,17 +861,17 @@ and pathSegCurvetoCubic =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method x1 : float prop
+    method x1 : float t prop
 
-    method y1 : float prop
+    method y1 : float t prop
 
-    method x2 : float prop
+    method x2 : float t prop
 
-    method y2 : float prop
+    method y2 : float t prop
   end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
@@ -880,13 +880,13 @@ and pathSegCurvetoQuadratic =
   object
     inherit pathSeg
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method x1 : float prop
+    method x1 : float t prop
 
-    method y1 : float prop
+    method y1 : float t prop
   end
 
 (* interface SVGPathSegArcAbs *)
@@ -895,13 +895,13 @@ and pathSegArc =
   object
     inherit pathSeg
 
-    method y : float prop
+    method y : float t prop
 
-    method r1 : float prop
+    method r1 : float t prop
 
-    method r2 : float prop
+    method r2 : float t prop
 
-    method angle : float prop
+    method angle : float t prop
 
     method largeArcFlag : bool t prop
 
@@ -914,7 +914,7 @@ and pathSegLinetoHorizontal =
   object
     inherit pathSeg
 
-    method x : float
+    method x : float t
   end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
@@ -923,20 +923,20 @@ and pathSegLinetoVertical =
   object
     inherit pathSeg
 
-    method y : float
+    method y : float t
   end
 
 and pathSegCurvetoCubicSmooth =
   object
     inherit pathSeg
 
-    method x : float
+    method x : float t
 
-    method y : float
+    method y : float t
 
-    method x2 : float
+    method x2 : float t
 
-    method y2 : float
+    method y2 : float t
   end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
@@ -945,9 +945,9 @@ and pathSegCurvetoQuadraticSmooth =
   object
     inherit pathSeg
 
-    method x : float
+    method x : float t
 
-    method y : float
+    method y : float t
   end
 
 and pathSegList = [pathSeg t] list
@@ -983,59 +983,85 @@ and pathElement =
 
     method pathLength : animatedNumber t readonly_prop
 
-    method getTotalLength : float meth
+    method getTotalLength : float t meth
 
-    method getPointAtLength : float -> point t meth
+    method getPointAtLength : float t -> point t meth
 
-    method getPathSegAtLength : float -> int
+    method getPathSegAtLength : float t -> int
 
     method createSVGPathSegClosePath : pathSegClosePath meth
 
-    method createSVGPathSegMovetoAbs : float -> float -> pathSegMoveto meth
+    method createSVGPathSegMovetoAbs : float t -> float t -> pathSegMoveto meth
 
-    method createSVGPathSegMovetoRel : float -> float -> pathSegMoveto meth
+    method createSVGPathSegMovetoRel : float t -> float t -> pathSegMoveto meth
 
-    method createSVGPathSegLinetoAbs : float -> float -> pathSegLineto meth
+    method createSVGPathSegLinetoAbs : float t -> float t -> pathSegLineto meth
 
-    method createSVGPathSegLinetoRel : float -> float -> pathSegLineto meth
+    method createSVGPathSegLinetoRel : float t -> float t -> pathSegLineto meth
 
     method createSVGPathSegCurvetoCubicAbs :
-      float -> float -> float -> float -> float -> float -> pathSegCurvetoCubic meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoCubicRel :
-      float -> float -> float -> float -> float -> float -> pathSegCurvetoCubic meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoQuadraticAbs :
-      float -> float -> float -> float -> pathSegCurvetoQuadratic meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegCurvetoQuadraticRel :
-      float -> float -> float -> float -> pathSegCurvetoQuadratic meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegArcAbs :
-      float -> float -> float -> float -> float -> bool t -> bool t -> pathSegArc meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> bool t
+      -> bool t
+      -> pathSegArc meth
 
     method createSVGPathSegArcRel :
-      float -> float -> float -> float -> float -> bool t -> bool t -> pathSegArc meth
+         float t
+      -> float t
+      -> float t
+      -> float t
+      -> float t
+      -> bool t
+      -> bool t
+      -> pathSegArc meth
 
-    method createSVGPathSegLinetoHorizontalAbs : float -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalAbs : float t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoHorizontalRel : float -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalRel : float t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoVerticalAbs : float -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalAbs : float t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegLinetoVerticalRel : float -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalRel : float t -> pathSegLinetoVertical meth
 
     method createSVGPathSegCurvetoCubicSmoothAbs :
-      float -> float -> float -> float -> pathSegCurvetoCubicSmooth meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoCubicSmoothRel :
-      float -> float -> float -> float -> pathSegCurvetoCubicSmooth meth
+      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothAbs :
-      float -> float -> pathSegCurvetoQuadraticSmooth meth
+      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothRel :
-      float -> float -> pathSegCurvetoQuadraticSmooth meth
+      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
   end
 
 (* interface SVGRectElement *)
@@ -1203,9 +1229,9 @@ and textContentElement =
 
     method getNumberOfChars : int meth
 
-    method getComputedTextLength : float meth
+    method getComputedTextLength : float t meth
 
-    method getSubStringLength : int -> int -> float meth
+    method getSubStringLength : int -> int -> float t meth
 
     method getStartPositionOfChar : int -> point t meth
 
@@ -1213,7 +1239,7 @@ and textContentElement =
 
     method getExtentOfChar : int -> rect t meth
 
-    method getRotationOfChar : int -> float meth
+    method getRotationOfChar : int -> float t meth
 
     method getCharNumAtPosition : point -> int meth
 
@@ -1302,13 +1328,13 @@ and glyphRefElement =
 
     method format : js_string t prop
 
-    method x : float prop
+    method x : float t prop
 
-    method y : float prop
+    method y : float t prop
 
-    method dx : float prop
+    method dx : float t prop
 
-    method dy : float prop
+    method dy : float t prop
   end
 
 (* interface SVGPaint : SVGColor { *)
@@ -1711,7 +1737,7 @@ and filterElement =
 (*   readonly attribute SVGAnimatedNumber stdDeviationX; *)
 (*   readonly attribute SVGAnimatedNumber stdDeviationY; *)
 
-(*   void setStdDeviation(in float stdDeviationX, in float stdDeviationY) raises(DOMException); *)
+(*   void setStdDeviation(in float t stdDeviationX, in float t stdDeviationY) raises(DOMException); *)
 (* }; *)
 
 (* interface SVGFEImageElement : SVGElement, *)
@@ -1851,9 +1877,9 @@ and scriptElement =
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
-(*   readonly attribute float previousScale; *)
+(*   readonly attribute float t previousScale; *)
 (*   readonly attribute SVGPoint previousTranslate; *)
-(*   readonly attribute float newScale; *)
+(*   readonly attribute float t newScale; *)
 (*   readonly attribute SVGPoint newTranslate; *)
 (* }; *)
 
@@ -1869,11 +1895,11 @@ and animationElement =
     (* inherit elementTimeControl *)
     method targetElement : element t readonly_prop
 
-    method getStartTime : float meth
+    method getStartTime : float t meth
 
-    method getCurrentTime : float meth
+    method getCurrentTime : float t meth
 
-    method getSimpleDuration : float meth
+    method getSimpleDuration : float t meth
   end
 
 (* interface SVGAnimateElement *)
diff --git a/lib/js_of_ocaml/geolocation.ml b/lib/js_of_ocaml/geolocation.ml
index 65637e25dd..38e7d2fd2d 100644
--- a/lib/js_of_ocaml/geolocation.ml
+++ b/lib/js_of_ocaml/geolocation.ml
@@ -24,19 +24,19 @@ type watchId
 
 class type coordinates =
   object
-    method latitude : float Js.readonly_prop
+    method latitude : float Js.t Js.readonly_prop
 
-    method longitude : float Js.readonly_prop
+    method longitude : float Js.t Js.readonly_prop
 
-    method altitude : float Js.opt Js.readonly_prop
+    method altitude : float Js.t Js.opt Js.readonly_prop
 
-    method accuracy : float Js.readonly_prop
+    method accuracy : float Js.t Js.readonly_prop
 
-    method altitudeAccuracy : float Js.opt Js.readonly_prop
+    method altitudeAccuracy : float Js.t Js.opt Js.readonly_prop
 
-    method heading : float Js.opt Js.readonly_prop
+    method heading : float Js.t Js.opt Js.readonly_prop
 
-    method speed : float Js.opt Js.readonly_prop
+    method speed : float Js.t Js.opt Js.readonly_prop
   end
 
 class type position =
diff --git a/lib/js_of_ocaml/geolocation.mli b/lib/js_of_ocaml/geolocation.mli
index d816d90037..4d6c52b6c7 100644
--- a/lib/js_of_ocaml/geolocation.mli
+++ b/lib/js_of_ocaml/geolocation.mli
@@ -46,19 +46,19 @@ type watchId
 
 class type coordinates =
   object
-    method latitude : float Js.readonly_prop
+    method latitude : float Js.t Js.readonly_prop
 
-    method longitude : float Js.readonly_prop
+    method longitude : float Js.t Js.readonly_prop
 
-    method altitude : float Js.opt Js.readonly_prop
+    method altitude : float Js.t Js.opt Js.readonly_prop
 
-    method accuracy : float Js.readonly_prop
+    method accuracy : float Js.t Js.readonly_prop
 
-    method altitudeAccuracy : float Js.opt Js.readonly_prop
+    method altitudeAccuracy : float Js.t Js.opt Js.readonly_prop
 
-    method heading : float Js.opt Js.readonly_prop
+    method heading : float Js.t Js.opt Js.readonly_prop
 
-    method speed : float Js.opt Js.readonly_prop
+    method speed : float Js.t Js.opt Js.readonly_prop
   end
 
 class type position =
diff --git a/lib/js_of_ocaml/intersectionObserver.ml b/lib/js_of_ocaml/intersectionObserver.ml
index 41146ca6c4..7e4a69e1e6 100644
--- a/lib/js_of_ocaml/intersectionObserver.ml
+++ b/lib/js_of_ocaml/intersectionObserver.ml
@@ -8,11 +8,11 @@ class type intersectionObserverEntry =
 
     method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method intersectionRatio : float Js.readonly_prop
+    method intersectionRatio : float Js.t Js.readonly_prop
 
     method isIntersecting : bool Js.t Js.readonly_prop
 
-    method time : float Js.readonly_prop
+    method time : float Js.t Js.readonly_prop
   end
 
 class type intersectionObserverOptions =
@@ -21,7 +21,7 @@ class type intersectionObserverOptions =
 
     method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-    method threshold : float Js.js_array Js.t Js.writeonly_prop
+    method threshold : float Js.t Js.js_array Js.t Js.writeonly_prop
   end
 
 class type intersectionObserver =
@@ -30,7 +30,7 @@ class type intersectionObserver =
 
     method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-    method thresholds : float Js.js_array Js.t Js.readonly_prop
+    method thresholds : float Js.t Js.js_array Js.t Js.readonly_prop
 
     method observe : #Dom.node Js.t -> unit Js.meth
 
diff --git a/lib/js_of_ocaml/intersectionObserver.mli b/lib/js_of_ocaml/intersectionObserver.mli
index 8aa4f59692..fa4cfa2b60 100644
--- a/lib/js_of_ocaml/intersectionObserver.mli
+++ b/lib/js_of_ocaml/intersectionObserver.mli
@@ -14,11 +14,11 @@ class type intersectionObserverEntry =
 
     method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method intersectionRatio : float Js.readonly_prop
+    method intersectionRatio : float Js.t Js.readonly_prop
 
     method isIntersecting : bool Js.t Js.readonly_prop
 
-    method time : float Js.readonly_prop
+    method time : float Js.t Js.readonly_prop
   end
 
 class type intersectionObserverOptions =
@@ -27,7 +27,7 @@ class type intersectionObserverOptions =
 
     method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-    method threshold : float Js.js_array Js.t Js.writeonly_prop
+    method threshold : float Js.t Js.js_array Js.t Js.writeonly_prop
   end
 
 class type intersectionObserver =
@@ -36,7 +36,7 @@ class type intersectionObserver =
 
     method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-    method thresholds : float Js.js_array Js.t Js.readonly_prop
+    method thresholds : float Js.t Js.js_array Js.t Js.readonly_prop
 
     method observe : #Dom.node Js.t -> unit Js.meth
 
diff --git a/lib/js_of_ocaml/intl.mli b/lib/js_of_ocaml/intl.mli
index 31e546c785..283ad5b785 100644
--- a/lib/js_of_ocaml/intl.mli
+++ b/lib/js_of_ocaml/intl.mli
@@ -46,7 +46,7 @@ if (Intl.is_supported()) then (
           let collator = new%js Intl.collator_constr
             (def (array [| lang |])) undefined
           in
-          float_of_int(collator##.compare a b))) ;
+          Js.float (float_of_int(collator##.compare a b)))) ;
       letters
     in
     let a = jas [| "a"; "z"; "ä" |] in
@@ -95,7 +95,7 @@ if (Intl.is_supported()) then (
       (def (jas [| "de-u-co-phonebk" |])) undefined
     in
     let a = a##sort (wrap_callback
-                       (fun v1 v2 -> float_of_int(collator##.compare v1 v2)))
+                       (fun v1 v2 -> Js.float (float_of_int(collator##.compare v1 v2))))
     in
     fc (a##join (string ", ")) ;
 
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index 6da9c405f3..a353a7941d 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -254,7 +254,7 @@ module Js = struct
 
       method charAt : int -> js_string t meth
 
-      method charCodeAt : int -> float meth
+      method charCodeAt : int -> int meth
 
       (* This may return NaN... *)
       method concat : js_string t -> js_string t meth
@@ -274,7 +274,7 @@ module Js = struct
 
       method lastIndexOf_from : js_string t -> int -> int meth
 
-      method localeCompare : js_string t -> float meth
+      method localeCompare : js_string t -> float t meth
 
       method _match : regExp t -> match_result_handle t opt meth
 
@@ -396,7 +396,7 @@ class type ['a] js_array =
 
     method slice_end : int -> 'a js_array t meth
 
-    method sort : ('a -> 'a -> float) callback -> 'a js_array t meth
+    method sort : ('a -> 'a -> float t) callback -> 'a js_array t meth
 
     method sort_asStrings : 'a js_array t meth
 
@@ -511,9 +511,9 @@ class type date =
 
     method toLocaleTimeString : js_string t meth
 
-    method valueOf : float meth
+    method valueOf : float t meth
 
-    method getTime : float meth
+    method getTime : float t meth
 
     method getFullYear : int meth
 
@@ -549,39 +549,39 @@ class type date =
 
     method getTimezoneOffset : int meth
 
-    method setTime : float -> float meth
+    method setTime : float t -> float t meth
 
-    method setFullYear : int -> float meth
+    method setFullYear : int -> float t meth
 
-    method setUTCFullYear : int -> float meth
+    method setUTCFullYear : int -> float t meth
 
-    method setMonth : int -> float meth
+    method setMonth : int -> float t meth
 
-    method setUTCMonth : int -> float meth
+    method setUTCMonth : int -> float t meth
 
-    method setDate : int -> float meth
+    method setDate : int -> float t meth
 
-    method setUTCDate : int -> float meth
+    method setUTCDate : int -> float t meth
 
-    method setDay : int -> float meth
+    method setDay : int -> float t meth
 
-    method setUTCDay : int -> float meth
+    method setUTCDay : int -> float t meth
 
-    method setHours : int -> float meth
+    method setHours : int -> float t meth
 
-    method setUTCHours : int -> float meth
+    method setUTCHours : int -> float t meth
 
-    method setMinutes : int -> float meth
+    method setMinutes : int -> float t meth
 
-    method setUTCMinutes : int -> float meth
+    method setUTCMinutes : int -> float t meth
 
-    method setSeconds : int -> float meth
+    method setSeconds : int -> float t meth
 
-    method setUTCSeconds : int -> float meth
+    method setUTCSeconds : int -> float t meth
 
-    method setMilliseconds : int -> float meth
+    method setMilliseconds : int -> float t meth
 
-    method setUTCMilliseconds : int -> float meth
+    method setUTCMilliseconds : int -> float t meth
 
     method toUTCString : js_string t meth
 
@@ -592,21 +592,21 @@ class type date =
 
 class type date_constr =
   object
-    method parse : js_string t -> float meth
+    method parse : js_string t -> float t meth
 
-    method _UTC_month : int -> int -> float meth
+    method _UTC_month : int -> int -> float t meth
 
-    method _UTC_day : int -> int -> float meth
+    method _UTC_day : int -> int -> float t meth
 
-    method _UTC_hour : int -> int -> int -> int -> float meth
+    method _UTC_hour : int -> int -> int -> int -> float t meth
 
-    method _UTC_min : int -> int -> int -> int -> int -> float meth
+    method _UTC_min : int -> int -> int -> int -> int -> float t meth
 
-    method _UTC_sec : int -> int -> int -> int -> int -> int -> float meth
+    method _UTC_sec : int -> int -> int -> int -> int -> int -> float t meth
 
-    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> float meth
+    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> float t meth
 
-    method now : float meth
+    method now : float t meth
   end
 
 let date_constr = Unsafe.global##._Date
@@ -615,7 +615,7 @@ let date : date_constr t = date_constr
 
 let date_now : date t constr = date_constr
 
-let date_fromTimeValue : (float -> date t) constr = date_constr
+let date_fromTimeValue : (float t -> date t) constr = date_constr
 
 let date_month : (int -> int -> date t) constr = date_constr
 
@@ -632,65 +632,65 @@ let date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr =
 
 class type math =
   object
-    method _E : float readonly_prop
+    method _E : float t readonly_prop
 
-    method _LN2 : float readonly_prop
+    method _LN2 : float t readonly_prop
 
-    method _LN10 : float readonly_prop
+    method _LN10 : float t readonly_prop
 
-    method _LOG2E : float readonly_prop
+    method _LOG2E : float t readonly_prop
 
-    method _LOG10E : float readonly_prop
+    method _LOG10E : float t readonly_prop
 
-    method _PI : float readonly_prop
+    method _PI : float t readonly_prop
 
-    method _SQRT1_2_ : float readonly_prop
+    method _SQRT1_2_ : float t readonly_prop
 
-    method _SQRT2 : float readonly_prop
+    method _SQRT2 : float t readonly_prop
 
-    method abs : float -> float meth
+    method abs : float t -> float t meth
 
-    method acos : float -> float meth
+    method acos : float t -> float t meth
 
-    method asin : float -> float meth
+    method asin : float t -> float t meth
 
-    method atan : float -> float meth
+    method atan : float t -> float t meth
 
-    method atan2 : float -> float -> float meth
+    method atan2 : float t -> float t -> float t meth
 
-    method ceil : float -> float meth
+    method ceil : float t -> float t meth
 
-    method cos : float -> float meth
+    method cos : float t -> float t meth
 
-    method exp : float -> float meth
+    method exp : float t -> float t meth
 
-    method floor : float -> float meth
+    method floor : float t -> float t meth
 
-    method log : float -> float meth
+    method log : float t -> float t meth
 
-    method max : float -> float -> float meth
+    method max : float t -> float t -> float t meth
 
-    method max_3 : float -> float -> float -> float meth
+    method max_3 : float t -> float t -> float t -> float t meth
 
-    method max_4 : float -> float -> float -> float -> float meth
+    method max_4 : float t -> float t -> float t -> float t -> float t meth
 
-    method min : float -> float -> float meth
+    method min : float t -> float t -> float t meth
 
-    method min_3 : float -> float -> float -> float meth
+    method min_3 : float t -> float t -> float t -> float t meth
 
-    method min_4 : float -> float -> float -> float -> float meth
+    method min_4 : float t -> float t -> float t -> float t -> float t meth
 
-    method pow : float -> float -> float meth
+    method pow : float t -> float t -> float t meth
 
-    method random : float meth
+    method random : float t meth
 
-    method round : float -> float meth
+    method round : float t -> float t meth
 
-    method sin : float -> float meth
+    method sin : float t -> float t meth
 
-    method sqrt : float -> float meth
+    method sqrt : float t -> float t meth
 
-    method tan : float -> float meth
+    method tan : float t -> float t meth
   end
 
 let math = Unsafe.global##._Math
@@ -795,9 +795,9 @@ external bytestring : string -> js_string t = "caml_jsbytes_of_string"
 
 external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
 
-external float : float -> float = "caml_js_from_float"
+external float : float -> float t = "caml_js_from_float"
 
-external to_float : float -> float = "caml_js_to_float"
+external to_float : float t -> float = "caml_js_to_float"
 
 external typeof : _ t -> js_string t = "caml_js_typeof"
 
@@ -810,7 +810,7 @@ let parseInt (s : js_string t) : int =
   let s = Unsafe.fun_call Unsafe.global##.parseInt [| Unsafe.inject s |] in
   if isNaN s then failwith "parseInt" else s
 
-let parseFloat (s : js_string t) : float =
+let parseFloat (s : js_string t) : float t =
   let s = Unsafe.fun_call Unsafe.global##.parseFloat [| Unsafe.inject s |] in
   if isNaN s then failwith "parseFloat" else s
 
@@ -845,4 +845,4 @@ let export_all obj =
 
 (* DEPRECATED *)
 
-type float_prop = float prop
+type float_prop = float t prop
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index 164a0454ac..2555056901 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -226,7 +226,7 @@ class type js_string =
 
     method charAt : int -> js_string t meth
 
-    method charCodeAt : int -> float meth
+    method charCodeAt : int -> int meth
 
     (* This may return NaN... *)
     method concat : js_string t -> js_string t meth
@@ -246,7 +246,7 @@ class type js_string =
 
     method lastIndexOf_from : js_string t -> int -> int meth
 
-    method localeCompare : js_string t -> float meth
+    method localeCompare : js_string t -> float t meth
 
     method _match : regExp t -> match_result_handle t opt meth
 
@@ -362,7 +362,7 @@ class type ['a] js_array =
 
     method slice_end : int -> 'a js_array t meth
 
-    method sort : ('a -> 'a -> float) callback -> 'a js_array t meth
+    method sort : ('a -> 'a -> float t) callback -> 'a js_array t meth
 
     method sort_asStrings : 'a js_array t meth
 
@@ -492,9 +492,9 @@ class type date =
 
     method toLocaleTimeString : js_string t meth
 
-    method valueOf : float meth
+    method valueOf : float t meth
 
-    method getTime : float meth
+    method getTime : float t meth
 
     method getFullYear : int meth
 
@@ -530,39 +530,39 @@ class type date =
 
     method getTimezoneOffset : int meth
 
-    method setTime : float -> float meth
+    method setTime : float t -> float t meth
 
-    method setFullYear : int -> float meth
+    method setFullYear : int -> float t meth
 
-    method setUTCFullYear : int -> float meth
+    method setUTCFullYear : int -> float t meth
 
-    method setMonth : int -> float meth
+    method setMonth : int -> float t meth
 
-    method setUTCMonth : int -> float meth
+    method setUTCMonth : int -> float t meth
 
-    method setDate : int -> float meth
+    method setDate : int -> float t meth
 
-    method setUTCDate : int -> float meth
+    method setUTCDate : int -> float t meth
 
-    method setDay : int -> float meth
+    method setDay : int -> float t meth
 
-    method setUTCDay : int -> float meth
+    method setUTCDay : int -> float t meth
 
-    method setHours : int -> float meth
+    method setHours : int -> float t meth
 
-    method setUTCHours : int -> float meth
+    method setUTCHours : int -> float t meth
 
-    method setMinutes : int -> float meth
+    method setMinutes : int -> float t meth
 
-    method setUTCMinutes : int -> float meth
+    method setUTCMinutes : int -> float t meth
 
-    method setSeconds : int -> float meth
+    method setSeconds : int -> float t meth
 
-    method setUTCSeconds : int -> float meth
+    method setUTCSeconds : int -> float t meth
 
-    method setMilliseconds : int -> float meth
+    method setMilliseconds : int -> float t meth
 
-    method setUTCMilliseconds : int -> float meth
+    method setUTCMilliseconds : int -> float t meth
 
     method toUTCString : js_string t meth
 
@@ -575,7 +575,7 @@ val date_now : date t constr
 (** Constructor of [Date] objects: [new%js date_now] returns a
       [Date] object initialized with the current date. *)
 
-val date_fromTimeValue : (float -> date t) constr
+val date_fromTimeValue : (float t -> date t) constr
 (** Constructor of [Date] objects: [new%js date_fromTimeValue t] returns a
       [Date] object initialized with the time value [t]. *)
 
@@ -610,21 +610,21 @@ val date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr
 (** Specification of the date constructor, considered as an object. *)
 class type date_constr =
   object
-    method parse : js_string t -> float meth
+    method parse : js_string t -> float t meth
 
-    method _UTC_month : int -> int -> float meth
+    method _UTC_month : int -> int -> float t meth
 
-    method _UTC_day : int -> int -> float meth
+    method _UTC_day : int -> int -> float t meth
 
-    method _UTC_hour : int -> int -> int -> int -> float meth
+    method _UTC_hour : int -> int -> int -> int -> float t meth
 
-    method _UTC_min : int -> int -> int -> int -> int -> float meth
+    method _UTC_min : int -> int -> int -> int -> int -> float t meth
 
-    method _UTC_sec : int -> int -> int -> int -> int -> int -> float meth
+    method _UTC_sec : int -> int -> int -> int -> int -> int -> float t meth
 
-    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> float meth
+    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> float t meth
 
-    method now : float meth
+    method now : float t meth
   end
 
 val date : date_constr t
@@ -633,65 +633,65 @@ val date : date_constr t
 (** Specification of Javascript math object. *)
 class type math =
   object
-    method _E : float readonly_prop
+    method _E : float t readonly_prop
 
-    method _LN2 : float readonly_prop
+    method _LN2 : float t readonly_prop
 
-    method _LN10 : float readonly_prop
+    method _LN10 : float t readonly_prop
 
-    method _LOG2E : float readonly_prop
+    method _LOG2E : float t readonly_prop
 
-    method _LOG10E : float readonly_prop
+    method _LOG10E : float t readonly_prop
 
-    method _PI : float readonly_prop
+    method _PI : float t readonly_prop
 
-    method _SQRT1_2_ : float readonly_prop
+    method _SQRT1_2_ : float t readonly_prop
 
-    method _SQRT2 : float readonly_prop
+    method _SQRT2 : float t readonly_prop
 
-    method abs : float -> float meth
+    method abs : float t -> float t meth
 
-    method acos : float -> float meth
+    method acos : float t -> float t meth
 
-    method asin : float -> float meth
+    method asin : float t -> float t meth
 
-    method atan : float -> float meth
+    method atan : float t -> float t meth
 
-    method atan2 : float -> float -> float meth
+    method atan2 : float t -> float t -> float t meth
 
-    method ceil : float -> float meth
+    method ceil : float t -> float t meth
 
-    method cos : float -> float meth
+    method cos : float t -> float t meth
 
-    method exp : float -> float meth
+    method exp : float t -> float t meth
 
-    method floor : float -> float meth
+    method floor : float t -> float t meth
 
-    method log : float -> float meth
+    method log : float t -> float t meth
 
-    method max : float -> float -> float meth
+    method max : float t -> float t -> float t meth
 
-    method max_3 : float -> float -> float -> float meth
+    method max_3 : float t -> float t -> float t -> float t meth
 
-    method max_4 : float -> float -> float -> float -> float meth
+    method max_4 : float t -> float t -> float t -> float t -> float t meth
 
-    method min : float -> float -> float meth
+    method min : float t -> float t -> float t meth
 
-    method min_3 : float -> float -> float -> float meth
+    method min_3 : float t -> float t -> float t -> float t meth
 
-    method min_4 : float -> float -> float -> float -> float meth
+    method min_4 : float t -> float t -> float t -> float t -> float t meth
 
-    method pow : float -> float -> float meth
+    method pow : float t -> float t -> float t meth
 
-    method random : float meth
+    method random : float t meth
 
-    method round : float -> float meth
+    method round : float t -> float t meth
 
-    method sin : float -> float meth
+    method sin : float t -> float t meth
 
-    method sqrt : float -> float meth
+    method sqrt : float t -> float t meth
 
-    method tan : float -> float meth
+    method tan : float t -> float t meth
   end
 
 val math : math t
@@ -794,7 +794,7 @@ val isNaN : 'a -> bool
 
 val parseInt : js_string t -> int
 
-val parseFloat : js_string t -> float
+val parseFloat : js_string t -> float t
 
 (** {2 Conversion functions between Javascript and OCaml types} *)
 
@@ -827,10 +827,10 @@ external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
       Javascript string should only contain UTF-16 code points below
       255.) *)
 
-external float : float -> float = "caml_js_from_float"
+external float : float -> float t = "caml_js_from_float"
 (** Conversion of OCaml floats to Javascript numbers. *)
 
-external to_float : float -> float = "caml_js_to_float"
+external to_float : float t -> float = "caml_js_to_float"
 (** Conversion of Javascript numbers to OCaml floats. *)
 
 (** {2 Convenience coercion functions} *)
@@ -1044,6 +1044,6 @@ exception Error of error t [@ocaml.deprecated "[since 4.0] Use [Js_error.Exn] in
     it will be serialized and wrapped into a [Failure] exception.
   *)
 
-type float_prop = float prop [@@ocaml.deprecated "[since 2.0]."]
+type float_prop = float t prop [@@ocaml.deprecated "[since 2.0]."]
 
 (** Type of float properties. *)
diff --git a/lib/js_of_ocaml/performanceObserver.ml b/lib/js_of_ocaml/performanceObserver.ml
index c6daece939..e5933d394f 100644
--- a/lib/js_of_ocaml/performanceObserver.ml
+++ b/lib/js_of_ocaml/performanceObserver.ml
@@ -30,9 +30,9 @@ class type performanceEntry =
 
     method entryType : Js.js_string Js.t Js.readonly_prop
 
-    method startTime : float Js.readonly_prop
+    method startTime : float Js.t Js.readonly_prop
 
-    method duration : float Js.readonly_prop
+    method duration : float Js.t Js.readonly_prop
   end
 
 class type performanceObserverEntryList =
diff --git a/lib/js_of_ocaml/performanceObserver.mli b/lib/js_of_ocaml/performanceObserver.mli
index 2484dbf6bd..b09062a797 100644
--- a/lib/js_of_ocaml/performanceObserver.mli
+++ b/lib/js_of_ocaml/performanceObserver.mli
@@ -46,9 +46,9 @@ class type performanceEntry =
 
     method entryType : Js.js_string Js.t Js.readonly_prop
 
-    method startTime : float Js.readonly_prop
+    method startTime : float Js.t Js.readonly_prop
 
-    method duration : float Js.readonly_prop
+    method duration : float Js.t Js.readonly_prop
   end
 
 class type performanceObserverEntryList =
diff --git a/lib/js_of_ocaml/resizeObserver.ml b/lib/js_of_ocaml/resizeObserver.ml
index b4705a3d64..8d4a83304a 100644
--- a/lib/js_of_ocaml/resizeObserver.ml
+++ b/lib/js_of_ocaml/resizeObserver.ml
@@ -20,9 +20,9 @@ open! Import
 
 class type resizeObserverSize =
   object
-    method inlineSize : float Js.readonly_prop
+    method inlineSize : float Js.t Js.readonly_prop
 
-    method blockSize : float Js.readonly_prop
+    method blockSize : float Js.t Js.readonly_prop
   end
 
 class type resizeObserverEntry =
diff --git a/lib/js_of_ocaml/resizeObserver.mli b/lib/js_of_ocaml/resizeObserver.mli
index e15de57925..94bd05e4f4 100644
--- a/lib/js_of_ocaml/resizeObserver.mli
+++ b/lib/js_of_ocaml/resizeObserver.mli
@@ -43,9 +43,9 @@
 
 class type resizeObserverSize =
   object
-    method inlineSize : float Js.readonly_prop
+    method inlineSize : float Js.t Js.readonly_prop
 
-    method blockSize : float Js.readonly_prop
+    method blockSize : float Js.t Js.readonly_prop
   end
 
 class type resizeObserverEntry =
diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index d6a40320d2..85011cb88d 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -20,7 +20,7 @@
 open! Import
 open Js
 
-type uint32 = float
+type uint32 = float Js.t
 
 class type arrayBuffer =
   object
@@ -79,9 +79,9 @@ type int32Array = (int32, Bigarray.int32_elt) typedArray
 
 type uint32Array = (int32, Bigarray.int32_elt) typedArray
 
-type float32Array = (float, Bigarray.float32_elt) typedArray
+type float32Array = (float Js.t, Bigarray.float32_elt) typedArray
 
-type float64Array = (float, Bigarray.float64_elt) typedArray
+type float64Array = (float Js.t, Bigarray.float64_elt) typedArray
 
 external kind : ('a, 'b) typedArray t -> ('a, 'b) Bigarray.kind
   = "caml_ba_kind_of_typed_array"
@@ -205,13 +205,13 @@ class type dataView =
 
     method getUint32_ : int -> bool t -> uint32 meth
 
-    method getFloat32 : int -> float meth
+    method getFloat32 : int -> float Js.t meth
 
-    method getFloat32_ : int -> bool t -> float meth
+    method getFloat32_ : int -> bool t -> float Js.t meth
 
-    method getFloat64 : int -> float meth
+    method getFloat64 : int -> float Js.t meth
 
-    method getFloat64_ : int -> bool t -> float meth
+    method getFloat64_ : int -> bool t -> float Js.t meth
 
     method setInt8 : int -> int -> unit meth
 
@@ -233,13 +233,13 @@ class type dataView =
 
     method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-    method setFloat32 : int -> float -> unit meth
+    method setFloat32 : int -> float Js.t -> unit meth
 
-    method setFloat32_ : int -> float -> bool t -> unit meth
+    method setFloat32_ : int -> float Js.t -> bool t -> unit meth
 
-    method setFloat64 : int -> float -> unit meth
+    method setFloat64 : int -> float Js.t -> unit meth
 
-    method setFloat64_ : int -> float -> bool t -> unit meth
+    method setFloat64_ : int -> float Js.t -> bool t -> unit meth
   end
 
 let dataView = Js.Unsafe.global##._DataView
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index b69e6edb98..bd1ca64fd5 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -22,7 +22,7 @@
 
 open Js
 
-type uint32 = float
+type uint32 = float Js.t
 
 class type arrayBuffer =
   object
@@ -79,9 +79,9 @@ type int32Array = (int32, Bigarray.int32_elt) typedArray
 
 type uint32Array = (int32, Bigarray.int32_elt) typedArray
 
-type float32Array = (float, Bigarray.float32_elt) typedArray
+type float32Array = (float Js.t, Bigarray.float32_elt) typedArray
 
-type float64Array = (float, Bigarray.float64_elt) typedArray
+type float64Array = (float Js.t, Bigarray.float64_elt) typedArray
 
 val kind : ('a, 'b) typedArray t -> ('a, 'b) Bigarray.kind
 
@@ -200,13 +200,13 @@ class type dataView =
 
     method getUint32_ : int -> bool t -> uint32 meth
 
-    method getFloat32 : int -> float meth
+    method getFloat32 : int -> float Js.t meth
 
-    method getFloat32_ : int -> bool t -> float meth
+    method getFloat32_ : int -> bool t -> float Js.t meth
 
-    method getFloat64 : int -> float meth
+    method getFloat64 : int -> float Js.t meth
 
-    method getFloat64_ : int -> bool t -> float meth
+    method getFloat64_ : int -> bool t -> float Js.t meth
 
     method setInt8 : int -> int -> unit meth
 
@@ -228,13 +228,13 @@ class type dataView =
 
     method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-    method setFloat32 : int -> float -> unit meth
+    method setFloat32 : int -> float Js.t -> unit meth
 
-    method setFloat32_ : int -> float -> bool t -> unit meth
+    method setFloat32_ : int -> float Js.t -> bool t -> unit meth
 
-    method setFloat64 : int -> float -> unit meth
+    method setFloat64 : int -> float Js.t -> unit meth
 
-    method setFloat64_ : int -> float -> bool t -> unit meth
+    method setFloat64_ : int -> float Js.t -> bool t -> unit meth
   end
 
 val dataView : (arrayBuffer t -> dataView t) constr
diff --git a/lib/js_of_ocaml/webGL.ml b/lib/js_of_ocaml/webGL.ml
index d7d9dc36aa..b489c0d9fe 100644
--- a/lib/js_of_ocaml/webGL.ml
+++ b/lib/js_of_ocaml/webGL.ml
@@ -31,7 +31,7 @@ type intptr = int
 
 type uint = int
 
-type clampf = float
+type clampf = float t
 
 type void
 
@@ -244,11 +244,11 @@ class type renderingContext =
 
     method isEnabled : enableCap -> bool t meth
 
-    method lineWidth : float -> unit meth
+    method lineWidth : float t -> unit meth
 
     method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-    method polygonOffset : float -> float -> unit meth
+    method polygonOffset : float t -> float t -> unit meth
 
     method sampleCoverage : clampf -> bool t -> unit meth
 
@@ -442,7 +442,7 @@ class type renderingContext =
       -> unit meth
 
     (* {[
-        method texParameterf : texTarget -> texParam -> float -> unit meth
+        method texParameterf : texTarget -> texParam -> float t -> unit meth
        ]}
     *)
     method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
@@ -564,12 +564,12 @@ class type renderingContext =
 
     method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-    method uniform1f : float uniformLocation t -> float -> unit meth
+    method uniform1f : float t uniformLocation t -> float t -> unit meth
 
     method uniform1fv_typed :
-      float uniformLocation t -> Typed_array.float32Array t -> unit meth
+      float t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform1fv : float uniformLocation t -> float js_array t -> unit meth
+    method uniform1fv : float t uniformLocation t -> float t js_array t -> unit meth
 
     method uniform1i : int uniformLocation t -> int -> unit meth
 
@@ -578,12 +578,12 @@ class type renderingContext =
 
     method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2f : [ `vec2 ] uniformLocation t -> float -> float -> unit meth
+    method uniform2f : [ `vec2 ] uniformLocation t -> float t -> float t -> unit meth
 
     method uniform2fv_typed :
       [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform2fv : [ `vec2 ] uniformLocation t -> float js_array t -> unit meth
+    method uniform2fv : [ `vec2 ] uniformLocation t -> float t js_array t -> unit meth
 
     method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
@@ -592,12 +592,13 @@ class type renderingContext =
     method uniform2iv_typed :
       [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform3f : [ `vec3 ] uniformLocation t -> float -> float -> float -> unit meth
+    method uniform3f :
+      [ `vec3 ] uniformLocation t -> float t -> float t -> float t -> unit meth
 
     method uniform3fv_typed :
       [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform3fv : [ `vec3 ] uniformLocation t -> float js_array t -> unit meth
+    method uniform3fv : [ `vec3 ] uniformLocation t -> float t js_array t -> unit meth
 
     method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
@@ -607,12 +608,12 @@ class type renderingContext =
       [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniform4f :
-      [ `vec4 ] uniformLocation t -> float -> float -> float -> float -> unit meth
+      [ `vec4 ] uniformLocation t -> float t -> float t -> float t -> float t -> unit meth
 
     method uniform4fv_typed :
       [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform4fv : [ `vec4 ] uniformLocation t -> float js_array t -> unit meth
+    method uniform4fv : [ `vec4 ] uniformLocation t -> float t js_array t -> unit meth
 
     method uniform4i :
       [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
@@ -623,44 +624,44 @@ class type renderingContext =
       [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniformMatrix2fv :
-      [ `mat2 ] uniformLocation t -> bool t -> float js_array t -> unit meth
+      [ `mat2 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
 
     method uniformMatrix2fv_typed :
       [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix3fv :
-      [ `mat3 ] uniformLocation t -> bool t -> float js_array t -> unit meth
+      [ `mat3 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
 
     method uniformMatrix3fv_typed :
       [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix4fv :
-      [ `mat4 ] uniformLocation t -> bool t -> float js_array t -> unit meth
+      [ `mat4 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
 
     method uniformMatrix4fv_typed :
       [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib1f : uint -> float -> unit meth
+    method vertexAttrib1f : uint -> float t -> unit meth
 
-    method vertexAttrib1fv : uint -> float js_array t -> unit meth
+    method vertexAttrib1fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib2f : uint -> float -> float -> unit meth
+    method vertexAttrib2f : uint -> float t -> float t -> unit meth
 
-    method vertexAttrib2fv : uint -> float js_array t -> unit meth
+    method vertexAttrib2fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib3f : uint -> float -> float -> float -> unit meth
+    method vertexAttrib3f : uint -> float t -> float t -> float t -> unit meth
 
-    method vertexAttrib3fv : uint -> float js_array t -> unit meth
+    method vertexAttrib3fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib4f : uint -> float -> float -> float -> float -> unit meth
+    method vertexAttrib4f : uint -> float t -> float t -> float t -> float t -> unit meth
 
-    method vertexAttrib4fv : uint -> float js_array t -> unit meth
+    method vertexAttrib4fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
@@ -854,7 +855,7 @@ class type renderingContext =
 
     method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-    method _LINE_WIDTH_ : float parameter readonly_prop
+    method _LINE_WIDTH_ : float t parameter readonly_prop
 
     method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
@@ -868,7 +869,7 @@ class type renderingContext =
 
     method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-    method _DEPTH_CLEAR_VALUE_ : float parameter readonly_prop
+    method _DEPTH_CLEAR_VALUE_ : float t parameter readonly_prop
 
     method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
@@ -932,9 +933,9 @@ class type renderingContext =
 
     method _STENCIL_BITS_ : int parameter readonly_prop
 
-    method _POLYGON_OFFSET_UNITS_ : float parameter readonly_prop
+    method _POLYGON_OFFSET_UNITS_ : float t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FACTOR_ : float parameter readonly_prop
+    method _POLYGON_OFFSET_FACTOR_ : float t parameter readonly_prop
 
     method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
@@ -944,7 +945,7 @@ class type renderingContext =
 
     method _SAMPLES_ : int parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_VALUE_ : float parameter readonly_prop
+    method _SAMPLE_COVERAGE_VALUE_ : float t parameter readonly_prop
 
     method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
diff --git a/lib/js_of_ocaml/webGL.mli b/lib/js_of_ocaml/webGL.mli
index a5c258a352..b839d2282c 100644
--- a/lib/js_of_ocaml/webGL.mli
+++ b/lib/js_of_ocaml/webGL.mli
@@ -32,7 +32,7 @@ type intptr = int
 
 type uint = int
 
-type clampf = float
+type clampf = float t
 
 type void
 
@@ -234,11 +234,11 @@ class type renderingContext =
 
     method isEnabled : enableCap -> bool t meth
 
-    method lineWidth : float -> unit meth
+    method lineWidth : float t -> unit meth
 
     method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-    method polygonOffset : float -> float -> unit meth
+    method polygonOffset : float t -> float t -> unit meth
 
     method sampleCoverage : clampf -> bool t -> unit meth
 
@@ -432,7 +432,7 @@ class type renderingContext =
       -> unit meth
 
     (* {[
-         method texParameterf : texTarget -> texParam -> float -> unit meth
+         method texParameterf : texTarget -> texParam -> float t -> unit meth
        ]}
     *)
     method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
@@ -554,12 +554,12 @@ class type renderingContext =
 
     method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-    method uniform1f : float uniformLocation t -> float -> unit meth
+    method uniform1f : float t uniformLocation t -> float t -> unit meth
 
     method uniform1fv_typed :
-      float uniformLocation t -> Typed_array.float32Array t -> unit meth
+      float t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform1fv : float uniformLocation t -> float js_array t -> unit meth
+    method uniform1fv : float t uniformLocation t -> float t js_array t -> unit meth
 
     method uniform1i : int uniformLocation t -> int -> unit meth
 
@@ -568,12 +568,12 @@ class type renderingContext =
 
     method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2f : [ `vec2 ] uniformLocation t -> float -> float -> unit meth
+    method uniform2f : [ `vec2 ] uniformLocation t -> float t -> float t -> unit meth
 
     method uniform2fv_typed :
       [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform2fv : [ `vec2 ] uniformLocation t -> float js_array t -> unit meth
+    method uniform2fv : [ `vec2 ] uniformLocation t -> float t js_array t -> unit meth
 
     method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
@@ -582,12 +582,13 @@ class type renderingContext =
     method uniform2iv_typed :
       [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform3f : [ `vec3 ] uniformLocation t -> float -> float -> float -> unit meth
+    method uniform3f :
+      [ `vec3 ] uniformLocation t -> float t -> float t -> float t -> unit meth
 
     method uniform3fv_typed :
       [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform3fv : [ `vec3 ] uniformLocation t -> float js_array t -> unit meth
+    method uniform3fv : [ `vec3 ] uniformLocation t -> float t js_array t -> unit meth
 
     method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
@@ -597,12 +598,12 @@ class type renderingContext =
       [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniform4f :
-      [ `vec4 ] uniformLocation t -> float -> float -> float -> float -> unit meth
+      [ `vec4 ] uniformLocation t -> float t -> float t -> float t -> float t -> unit meth
 
     method uniform4fv_typed :
       [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform4fv : [ `vec4 ] uniformLocation t -> float js_array t -> unit meth
+    method uniform4fv : [ `vec4 ] uniformLocation t -> float t js_array t -> unit meth
 
     method uniform4i :
       [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
@@ -613,44 +614,44 @@ class type renderingContext =
       [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniformMatrix2fv :
-      [ `mat2 ] uniformLocation t -> bool t -> float js_array t -> unit meth
+      [ `mat2 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
 
     method uniformMatrix2fv_typed :
       [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix3fv :
-      [ `mat3 ] uniformLocation t -> bool t -> float js_array t -> unit meth
+      [ `mat3 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
 
     method uniformMatrix3fv_typed :
       [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix4fv :
-      [ `mat4 ] uniformLocation t -> bool t -> float js_array t -> unit meth
+      [ `mat4 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
 
     method uniformMatrix4fv_typed :
       [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib1f : uint -> float -> unit meth
+    method vertexAttrib1f : uint -> float t -> unit meth
 
-    method vertexAttrib1fv : uint -> float js_array t -> unit meth
+    method vertexAttrib1fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib2f : uint -> float -> float -> unit meth
+    method vertexAttrib2f : uint -> float t -> float t -> unit meth
 
-    method vertexAttrib2fv : uint -> float js_array t -> unit meth
+    method vertexAttrib2fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib3f : uint -> float -> float -> float -> unit meth
+    method vertexAttrib3f : uint -> float t -> float t -> float t -> unit meth
 
-    method vertexAttrib3fv : uint -> float js_array t -> unit meth
+    method vertexAttrib3fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib4f : uint -> float -> float -> float -> float -> unit meth
+    method vertexAttrib4f : uint -> float t -> float t -> float t -> float t -> unit meth
 
-    method vertexAttrib4fv : uint -> float js_array t -> unit meth
+    method vertexAttrib4fv : uint -> float t js_array t -> unit meth
 
     method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
@@ -844,7 +845,7 @@ class type renderingContext =
 
     method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-    method _LINE_WIDTH_ : float parameter readonly_prop
+    method _LINE_WIDTH_ : float t parameter readonly_prop
 
     method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
@@ -858,7 +859,7 @@ class type renderingContext =
 
     method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-    method _DEPTH_CLEAR_VALUE_ : float parameter readonly_prop
+    method _DEPTH_CLEAR_VALUE_ : float t parameter readonly_prop
 
     method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
@@ -922,9 +923,9 @@ class type renderingContext =
 
     method _STENCIL_BITS_ : int parameter readonly_prop
 
-    method _POLYGON_OFFSET_UNITS_ : float parameter readonly_prop
+    method _POLYGON_OFFSET_UNITS_ : float t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FACTOR_ : float parameter readonly_prop
+    method _POLYGON_OFFSET_FACTOR_ : float t parameter readonly_prop
 
     method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
@@ -934,7 +935,7 @@ class type renderingContext =
 
     method _SAMPLES_ : int parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_VALUE_ : float parameter readonly_prop
+    method _SAMPLE_COVERAGE_VALUE_ : float t parameter readonly_prop
 
     method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
diff --git a/lib/lwt/graphics/graphics_js.ml b/lib/lwt/graphics/graphics_js.ml
index 8b9b615d26..bc7d8f2161 100644
--- a/lib/lwt/graphics/graphics_js.ml
+++ b/lib/lwt/graphics/graphics_js.ml
@@ -49,13 +49,13 @@ let open_canvas x =
 let compute_real_pos (elt : #Dom_html.element Js.t) ev =
   let r = elt##getBoundingClientRect in
   let x =
-    (float_of_int ev##.clientX -. r##.left)
-    /. (r##.right -. r##.left)
+    (float_of_int ev##.clientX -. Js.to_float r##.left)
+    /. (Js.to_float r##.right -. Js.to_float r##.left)
     *. float_of_int elt##.width
   in
   let y =
-    (float_of_int ev##.clientY -. r##.top)
-    /. (r##.bottom -. r##.top)
+    (float_of_int ev##.clientY -. Js.to_float r##.top)
+    /. (Js.to_float r##.bottom -. Js.to_float r##.top)
     *. float_of_int elt##.height
   in
   truncate x, elt##.height - truncate y
diff --git a/lib/lwt/lwt_js.ml b/lib/lwt/lwt_js.ml
index 254c2f292e..e76708bbd0 100644
--- a/lib/lwt/lwt_js.ml
+++ b/lib/lwt/lwt_js.ml
@@ -30,7 +30,9 @@ let sleep d =
 let yield () = sleep 0.
 
 let wakeup = function
-  | 1 -> ignore (Dom_html.window##setTimeout (Js.wrap_callback Lwt.wakeup_paused) 0.)
+  | 1 ->
+      ignore
+        (Dom_html.window##setTimeout (Js.wrap_callback Lwt.wakeup_paused) (Js.float 0.))
   | _ -> ()
 
 let () = Lwt.register_pause_notifier wakeup
diff --git a/lib/lwt/lwt_js_events.ml b/lib/lwt/lwt_js_events.ml
index 398ccce0fc..d712e9a4a9 100644
--- a/lib/lwt/lwt_js_events.ml
+++ b/lib/lwt/lwt_js_events.ml
@@ -610,7 +610,7 @@ let request_animation_frame () =
   let t, s = Lwt.wait () in
   let (_ : Dom_html.animation_frame_request_id) =
     Dom_html.window##requestAnimationFrame
-      (Js.wrap_callback (fun (_ : float) -> Lwt.wakeup s ()))
+      (Js.wrap_callback (fun (_ : float Js.t) -> Lwt.wakeup s ()))
   in
   t
 

From 872876f8743b05a29edd7488954cab97d48d62bd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 13 Jun 2023 14:32:33 +0200
Subject: [PATCH 066/481] Runtime: comparison and hashing improvements

---
 compiler/lib/wasm/wa_gc_target.ml |   7 +-
 runtime/wasm/bigarray.wat         | 238 +++++++++++++++++--
 runtime/wasm/compare.wat          | 370 ++++++++++++++++++++----------
 runtime/wasm/custom.wat           |  47 ++++
 runtime/wasm/hash.wat             |  52 ++++-
 runtime/wasm/int32.wat            |  18 +-
 runtime/wasm/int64.wat            |  15 +-
 runtime/wasm/obj.wat              |  13 +-
 runtime/wasm/prng.wat             |  13 +-
 runtime/wasm/runtime.js           |   1 +
 runtime/wasm/string.wat           |  11 +-
 runtime/wasm/sync.wat             |  61 ++---
 12 files changed, 635 insertions(+), 211 deletions(-)
 create mode 100644 runtime/wasm/custom.wat

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 07e4bfa6f4..8d81a2c246 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -38,7 +38,7 @@ module Type = struct
         return
           { supertype = None
           ; final = true
-          ; typ = W.Func { W.params = [ value; value ]; result = [ I32 ] }
+          ; typ = W.Func { W.params = [ value; value; I32 ]; result = [ I32 ] }
           })
 
   let hash_type =
@@ -63,7 +63,10 @@ module Type = struct
                   ; typ = Value (Ref { nullable = false; typ = Type string })
                   }
                 ; { mut = false
-                  ; typ = Value (Ref { nullable = false; typ = Type compare })
+                  ; typ = Value (Ref { nullable = true; typ = Type compare })
+                  }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = true; typ = Type compare })
                   }
                 ; { mut = false; typ = Value (Ref { nullable = true; typ = Type hash }) }
                 ]
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index c356c654eb..6a5c1f8140 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -48,19 +48,21 @@
    (import "int64" "caml_copy_int64"
       (func $caml_copy_int64 (param i64) (result (ref eq))))
    (import "obj" "double_array_tag" (global $double_array_tag i32))
+   (import "compare" "unordered" (global $unordered i32))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
@@ -77,22 +79,19 @@
             (i32.const 95) (i32.const 98) (i32.const 105) (i32.const 103)
             (i32.const 97) (i32.const 114) (i32.const 114) (i32.const 48)
             (i32.const 50))
-         (ref.func $bigarray_cmp) (ref.func $bigarray_hash)))
+         (ref.func $caml_ba_compare)
+         (ref.null $value->value->int->int)
+         (ref.func $bigarray_hash)))
 
    (type $bigarray
       (sub $custom
          (struct
             (field (ref $custom_operations))
-            (field (ref extern)) ;; data
-            (field (ref $int_array)) ;; size in each dimension
-            (field i8) ;; number of dimensions
-            (field i8) ;; kind
-            (field i8)))) ;; layout
-
-   (func $bigarray_cmp (param (ref eq)) (param (ref eq)) (result i32)
-      ;; ZZZ
-      (call $log_js (string.const "bigarray_cmp"))
-      (i32.const 1))
+            (field $ba_data (mut (ref extern))) ;; data
+            (field $ba_dim (ref $int_array)) ;; size in each dimension
+            (field $ba_num_dims i8) ;; number of dimensions
+            (field $ba_kind i8) ;; kind
+            (field $ba_layout i8)))) ;; layout
 
    (func $bigarray_hash (param (ref eq)) (result i32)
       ;; ZZZ
@@ -411,6 +410,213 @@
          (local.get $ba) (local.get $i) (local.get $v))
       (i31.new (i32.const 0)))
 
+   (func $caml_ba_compare
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32)
+      (local $b1 (ref $bigarray)) (local $b2 (ref $bigarray))
+      (local $i1 i32) (local $i2 i32) (local $i i32) (local $len i32)
+      (local $f1 f64) (local $f2 f64)
+      (local $d1 (ref extern)) (local $d2 (ref extern))
+      (local.set $b1 (ref.cast $bigarray (local.get $v1)))
+      (local.set $b2 (ref.cast $bigarray (local.get $v2)))
+      (if (i32.ne (struct.get $bigarray $ba_layout (local.get $b2))
+                  (struct.get $bigarray $ba_layout (local.get $b1)))
+         (then
+            (return
+               (i32.sub (struct.get $bigarray $ba_layout (local.get $b2))
+                        (struct.get $bigarray $ba_layout (local.get $b1))))))
+      (if (i32.ne (struct.get $bigarray $ba_kind (local.get $b2))
+                  (struct.get $bigarray $ba_kind (local.get $b1)))
+         (then
+            (return
+               (i32.sub (struct.get $bigarray $ba_kind (local.get $b2))
+                        (struct.get $bigarray $ba_kind (local.get $b1))))))
+      (if (i32.ne (struct.get $bigarray $ba_num_dims (local.get $b2))
+                  (struct.get $bigarray $ba_num_dims (local.get $b1)))
+         (then
+            (return
+               (i32.sub (struct.get $bigarray $ba_num_dims (local.get $b2))
+                        (struct.get $bigarray $ba_num_dims (local.get $b1))))))
+      (local.set $len (struct.get $bigarray $ba_num_dims (local.get $b2)))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+                (local.set $i1
+                   (array.get $int_array
+                      (struct.get $bigarray $ba_dim (local.get $b1))
+                      (local.get $i)))
+                (local.set $i2
+                   (array.get $int_array
+                      (struct.get $bigarray $ba_dim (local.get $b2))
+                      (local.get $i)))
+                (if (i32.ne (local.get $i1) (local.get $i2))
+                   (return
+                      (select (i32.const -1) (i32.const 1)
+                         (i32.lt_u (local.get $i1) (local.get $i2)))))
+                (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                (br $loop))))
+      (local.set $d1 (struct.get $bigarray $ba_data (local.get $b1)))
+      (local.set $d2 (struct.get $bigarray $ba_data (local.get $b2)))
+      (local.set $len (call $ta_length (local.get $d1)))
+      (local.set $i (i32.const 0))
+      (block $float32
+       (block $float64
+        (block $int8
+         (block $uint8
+          (block $int16
+           (block $uint16
+            (block $int32
+             (block $int64
+              (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                        $int32 $int64 $int32 $int32
+                        $float32 $float64 $uint8
+                 (struct.get $bigarray $ba_kind (local.get $b1))))
+             ;; int64
+             (loop $loop
+                (if (i32.lt_u (local.get $i) (local.get $len))
+                   (then
+                      (local.set $i1
+                         (call $ta_get_i32 (local.get $d1)
+                            (i32.add (local.get $i) (i32.const 1))))
+                      (local.set $i2
+                         (call $ta_get_i32 (local.get $d2)
+                            (i32.add (local.get $i) (i32.const 1))))
+                      (if (i32.lt_s (local.get $i1) (local.get $i2))
+                         (then (return (i32.const -1))))
+                      (if (i32.gt_s (local.get $i1) (local.get $i2))
+                         (then (return (i32.const 1))))
+                      (local.set $i1
+                         (call $ta_get_i32 (local.get $d1) (local.get $i)))
+                      (local.set $i2
+                         (call $ta_get_i32 (local.get $d2) (local.get $i)))
+                      (if (i32.lt_u (local.get $i1) (local.get $i2))
+                         (then (return (i32.const -1))))
+                      (if (i32.gt_u (local.get $i1) (local.get $i2))
+                         (then (return (i32.const 1))))
+                      (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                      (br $loop))))
+             (return (i32.const 0)))
+            ;; int32
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (local.set $i1
+                        (call $ta_get_i32 (local.get $d1) (local.get $i)))
+                     (local.set $i2
+                        (call $ta_get_i32 (local.get $d2) (local.get $i)))
+                     (if (i32.lt_s (local.get $i1) (local.get $i2))
+                        (then (return (i32.const -1))))
+                     (if (i32.gt_s (local.get $i1) (local.get $i2))
+                        (then (return (i32.const 1))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (return (i32.const 0)))
+           ;; uint16
+           (loop $loop
+              (if (i32.lt_u (local.get $i) (local.get $len))
+                 (then
+                    (local.set $i1
+                       (call $ta_get_ui16 (local.get $d1) (local.get $i)))
+                    (local.set $i2
+                       (call $ta_get_ui16 (local.get $d2) (local.get $i)))
+                    (if (i32.lt_s (local.get $i1) (local.get $i2))
+                       (then (return (i32.const -1))))
+                    (if (i32.gt_s (local.get $i1) (local.get $i2))
+                       (then (return (i32.const 1))))
+                    (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                    (br $loop))))
+           (return (i32.const 0)))
+          ;; int16
+          (loop $loop
+             (if (i32.lt_u (local.get $i) (local.get $len))
+                (then
+                   (local.set $i1
+                      (call $ta_get_i16 (local.get $d1) (local.get $i)))
+                   (local.set $i2
+                      (call $ta_get_i16 (local.get $d2) (local.get $i)))
+                   (if (i32.lt_s (local.get $i1) (local.get $i2))
+                      (then (return (i32.const -1))))
+                   (if (i32.gt_s (local.get $i1) (local.get $i2))
+                      (then (return (i32.const 1))))
+                   (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                   (br $loop))))
+          (return (i32.const 0)))
+         ;; uint8
+         (loop $loop
+            (if (i32.lt_u (local.get $i) (local.get $len))
+               (then
+                  (local.set $i1
+                     (call $ta_get_ui8 (local.get $d1) (local.get $i)))
+                  (local.set $i2
+                     (call $ta_get_ui8 (local.get $d2) (local.get $i)))
+                  (if (i32.lt_s (local.get $i1) (local.get $i2))
+                     (then (return (i32.const -1))))
+                  (if (i32.gt_s (local.get $i1) (local.get $i2))
+                     (then (return (i32.const 1))))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (br $loop))))
+         (return (i32.const 0)))
+        ;; int8
+        (loop $loop
+           (if (i32.lt_u (local.get $i) (local.get $len))
+              (then
+                 (local.set $i1
+                    (call $ta_get_i8 (local.get $d1) (local.get $i)))
+                 (local.set $i2
+                    (call $ta_get_i8 (local.get $d2) (local.get $i)))
+                 (if (i32.lt_s (local.get $i1) (local.get $i2))
+                    (then (return (i32.const -1))))
+                 (if (i32.gt_s (local.get $i1) (local.get $i2))
+                    (then (return (i32.const 1))))
+                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                 (br $loop))))
+        (return (i32.const 0)))
+       ;; float64
+       (loop $loop
+          (if (i32.lt_u (local.get $i) (local.get $len))
+             (then
+                (local.set $f1
+                   (call $ta_get_f64 (local.get $d1) (local.get $i)))
+                (local.set $f2
+                   (call $ta_get_f64 (local.get $d2) (local.get $i)))
+                (if (f64.lt (local.get $f1) (local.get $f2))
+                   (then (return (i32.const -1))))
+                (if (f64.gt (local.get $f1) (local.get $f2))
+                   (then (return (i32.const 1))))
+                (if (f64.ne (local.get $f1) (local.get $f2))
+                   (then
+                      (if (i32.eqz (local.get $total))
+                         (then (return (global.get $unordered))))
+                      (if (f64.eq (local.get $f1) (local.get $f1))
+                         (then (return (i32.const 1))))
+                      (if (f64.eq (local.get $f2) (local.get $f2))
+                         (then (return (i32.const -1))))))
+                (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                (br $loop))))
+       (return (i32.const 0)))
+      ;; float32
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (local.set $f1
+                  (call $ta_get_f32 (local.get $d1) (local.get $i)))
+               (local.set $f2
+                  (call $ta_get_f32 (local.get $d2) (local.get $i)))
+               (if (f64.lt (local.get $f1) (local.get $f2))
+                  (then (return (i32.const -1))))
+               (if (f64.gt (local.get $f1) (local.get $f2))
+                  (then (return (i32.const 1))))
+               (if (f64.ne (local.get $f1) (local.get $f2))
+                  (then
+                     (if (i32.eqz (local.get $total))
+                        (then (return (global.get $unordered))))
+                     (if (f64.eq (local.get $f1) (local.get $f1))
+                        (then (return (i32.const 1))))
+                     (if (f64.eq (local.get $f2) (local.get $f2))
+                        (then (return (i32.const -1))))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (return (i32.const 0)))
+
    (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
       ;; used to convert a typed array to a string
       (local $a (ref extern)) (local $len i32) (local $i i32)
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 67d9ed01da..36efcb78e3 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -1,11 +1,29 @@
 (module
-   (import "bindings" "log" (func $log (param i32)))
+   (import "bindings" "is_string"
+      (func $ref_test_string (param anyref) (result i32)))
+   (import "bindings" "identity"
+      (func $ref_cast_string (param anyref) (result (ref string))))
+   (import "bindings" "equals"
+      (func $equals (param anyref) (param anyref) (result i32)))
    (import "obj" "forward_tag" (global $forward_tag i32))
+   (import "obj" "object_tag" (global $object_tag i32))
    (import "obj" "double_array_tag" (global $double_array_tag i32))
+   (import "obj" "caml_obj_tag"
+      (func $caml_obj_tag (param (ref eq)) (result (ref eq))))
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
+   (import "effect" "caml_is_continuation"
+      (func $caml_is_continuation (param (ref eq)) (result i32)))
+   (import "string" "caml_string_compare"
+      (func $caml_string_compare
+        (param (ref eq)) (param (ref eq)) (result (ref eq))))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
+   (type $js (struct (field anyref)))
+   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+   (type $closure (struct (;(field i32);) (field (ref $function_1))))
 
    (type $int_array (array (mut i32)))
    (type $block_array (array (mut (ref $block))))
@@ -14,15 +32,16 @@
               (field (ref $block_array)) ;; first value
               (field (ref $block_array)) ;; second value
               (field (ref $int_array)))) ;; position in value
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
@@ -112,7 +131,7 @@
          (local.get $i) (local.get $p))
       (local.get $stack))
 
-   (global $unordered i32 (i32.const 0x80000000))
+   (global $unordered (export "unordered") i32 (i32.const 0x80000000))
 
    (func $compare_strings
       (param $s1 (ref $string)) (param $s2 (ref $string)) (result i32)
@@ -141,20 +160,10 @@
                (br $loop))))
       (i32.sub (local.get $l1) (local.get $l2)))
 
-   (func $compare_val
-      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32)
-      (result i32)
+   (func $clear_compare_stack
+      ;; clear stack (to avoid memory leaks)
       (local $stack (ref $compare_stack)) (local $n i32) (local $res i32)
       (local.set $stack (global.get $default_compare_stack))
-      (struct.set $compare_stack 0 (local.get $stack) (i32.const -1))
-      (local.set $res
-         (call $do_compare_val
-            (local.get $stack) (local.get $v1) (local.get $v2)
-            (local.get $total)))
-;;      (if (i32.gt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const 1))))
-;;      (if (i32.lt_s (local.get $res) (i32.const 0)) (then (local.set $res (i32.const -1))))
-;;      (call $log (local.get $res))
-      ;; clear stack (to avoid memory leaks)
       (local.set $n (struct.get $compare_stack 0 (local.get $stack)))
       (if (i32.ge_s (local.get $n) (i32.const 0))
          (then
@@ -178,26 +187,43 @@
                         (local.get $n) (global.get $dummy_block))
                      (local.set $n (i32.sub (local.get $n) (i32.const 1)))
                      (br $loop))))
-          ))
+          )))
+
+   (func $compare_val
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32)
+      (result i32)
+      (local $stack (ref $compare_stack)) (local $n i32) (local $res i32)
+      (local.set $stack (global.get $default_compare_stack))
+      (struct.set $compare_stack 0 (local.get $stack) (i32.const -1))
+      (local.set $res
+         (call $do_compare_val
+            (local.get $stack) (local.get $v1) (local.get $v2)
+            (local.get $total)))
+      (call $clear_compare_stack)
       (local.get $res))
 
+   (data $abstract_value "compare: abstract value")
+   (data $functional_value "compare: functional value")
+   (data $continuation_value "compare: continuation value")
+
    (func $do_compare_val
       (param $stack (ref $compare_stack))
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32)
-      (local $i1 (ref i31)) (local $i2 (ref i31))
+      (local $i i32) (local $i1 (ref i31)) (local $i2 (ref i31))
       (local $b1 (ref $block)) (local $b2 (ref $block))
       (local $t1 i32) (local $t2 i32)
       (local $s1 i32) (local $s2 i32)
       (local $f1 f64) (local $f2 f64)
       (local $str1 (ref $string)) (local $str2 (ref $string))
       (local $c1 (ref $custom)) (local $c2 (ref $custom))
+      (local $js1 anyref) (local $js2 anyref)
       (local $tuple ((ref eq) (ref eq)))
       (local $res i32)
       (loop $loop
          (block $next_item
-            (br_if $next_item
-               (i32.and (ref.eq (local.get $v1) (local.get $v2))
-                        (local.get $total)))
+            (if (local.get $total)
+               (then
+                  (br_if $next_item (ref.eq (local.get $v1) (local.get $v2)))))
             (drop (block $v1_is_not_int (result (ref eq))
                (local.set $i1
                   (br_on_cast_fail $v1_is_not_int i31 (local.get $v1)))
@@ -221,7 +247,19 @@
                            (array.get $block (local.get $b2) (i32.const 1)))
                         (br $loop)))
                   (i31.new (i32.const 1))))
-               ;; ZZZ custom tag
+               (block $v2_not_comparable
+                  (drop (block $v2_not_custom (result (ref eq))
+                     (local.set $c2
+                         (br_on_cast_fail $v2_not_custom $custom
+                            (local.get $v2)))
+                     (local.set $res
+                        (call_ref $value->value->int->int
+                           (local.get $v1) (local.get $v2) (local.get $total)
+                           (br_on_null $v2_not_comparable
+                              (struct.get $custom_operations $cust_compare_ext
+                                 (struct.get $custom 0 (local.get $c2))))))
+                     (br_if $next_item (i32.eqz (local.get $res)))
+                     (return (local.get $res)))))
                ;; v1 long < v2 block
                (return (i32.const -1))))
             (if (ref.test i31 (local.get $v2))
@@ -241,38 +279,37 @@
                               (array.get $block (local.get $b1) (i32.const 1)))
                            (br $loop)))
                      (i31.new (i32.const 1))))
-                  ;; ZZZ custom tag
+                  (block $v1_not_comparable
+                     (drop (block $v1_not_custom (result (ref eq))
+                        (local.set $c1
+                            (br_on_cast_fail $v1_not_custom $custom
+                               (local.get $v1)))
+                        (local.set $res
+                           (call_ref $value->value->int->int
+                              (local.get $v1) (local.get $v2) (local.get $total)
+                              (br_on_null $v1_not_comparable
+                                 (struct.get $custom_operations $cust_compare_ext
+                                    (struct.get $custom 0 (local.get $c1))))))
+                        (br_if $next_item (i32.eqz (local.get $res)))
+                        (return (local.get $res)))))
                   ;; v1 block > v1 long
                   (return (i32.const 1))))
-            (drop (block $v1_not_block (result (ref eq))
-               (local.set $b1
-                  (br_on_cast_fail $v1_not_block $block (local.get $v1)))
-               (local.set $t1
-                  (i31.get_u (ref.cast i31 (array.get $block (local.get $b1)
-                                              (i32.const 0)))))
-               (drop (block $v2_not_block (result (ref eq))
+            (drop (block $heterogeneous (result (ref eq))
+               (drop (block $v1_not_block (result (ref eq))
+                  (local.set $b1
+                     (br_on_cast_fail $v1_not_block $block (local.get $v1)))
+                  (local.set $t1
+                     (i31.get_u
+                        (ref.cast i31
+                           (array.get $block (local.get $b1) (i32.const 0)))))
                   (local.set $b2
-                     (br_on_cast_fail $v2_not_block $block (local.get $v2)))
+                     (br_on_cast_fail $heterogeneous $block (local.get $v2)))
                   (local.set $t2
-                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
-                                                 (i32.const 0)))))
-                  (if (i32.ne (local.get $t1) (local.get $t2))
-                     (then
-                        ;; check for forward tag
-                        (if (i32.eq (local.get $t1) (global.get $forward_tag))
-                           (then
-                              (local.set $v1
-                                 (array.get $block
-                                    (local.get $b1) (i32.const 1)))
-                              (br $loop)))
-                        (if (i32.eq (local.get $t2) (global.get $forward_tag))
-                           (then
-                              (local.set $v2
-                                 (array.get
-                                    $block (local.get $b2) (i32.const 1)))
-                              (br $loop)))
-                        ;; compare tags
-                        (return (i32.sub (local.get $t1) (local.get $t2)))))
+                     (i31.get_u
+                        (ref.cast i31
+                           (array.get $block (local.get $b2) (i32.const 0)))))
+                  (drop (br_if $heterogeneous (i31.new (i32.const 0))
+                     (i32.ne (local.get $t1) (local.get $t2))))
                   ;; forward tag
                   (if (i32.eq (local.get $t1) (global.get $forward_tag))
                      (then
@@ -281,12 +318,59 @@
                         (local.set $v2
                            (array.get $block (local.get $b2) (i32.const 1)))
                         (br $loop)))
-                  ;; ZZZ object tag
+                  (if (i32.eq (local.get $t1) (global.get $object_tag))
+                     (then
+                        (local.set $v1
+                           (array.get $block (local.get $b1) (i32.const 2)))
+                        (local.set $v2
+                           (array.get $block (local.get $b2) (i32.const 2)))
+                        (br_if $next_item
+                           (ref.eq (local.get $v1) (local.get $v2)))
+                        (return
+                           (i32.sub
+                              (i31.get_s (ref.cast i31 (local.get $v1)))
+                              (i31.get_s (ref.cast i31 (local.get $v2)))))))
                   (local.set $s1 (array.len (local.get $b1)))
                   (local.set $s2 (array.len (local.get $b2)))
                   ;; compare size first
                   (if (i32.ne (local.get $s1) (local.get $s2))
-                     (then (return (i32.sub (local.get $s1) (local.get $s2)))))
+                     (then
+                        (return (i32.sub (local.get $s1) (local.get $s2)))))
+                  (if (i32.eq (local.get $t1) (global.get $double_array_tag))
+                     (then
+                        (local.set $i (i32.const 1))
+                        (loop $float_array
+                           (if (i32.lt_s (local.get $i) (local.get $s1))
+                              (then
+                                 (local.set $f1
+                                    (struct.get $float 0
+                                       (ref.cast $float
+                                          (array.get $block (local.get $b1)
+                                             (local.get $i)))))
+                                 (local.set $f2
+                                    (struct.get $float 0
+                                       (ref.cast $float
+                                          (array.get $block (local.get $b2)
+                                          (local.get $i)))))
+                                 (if (f64.lt (local.get $f1) (local.get $f2))
+                                    (then (return (i32.const -1))))
+                                 (if (f64.gt (local.get $f1) (local.get $f2))
+                                    (then (return (i32.const 1))))
+                                 (if (f64.ne (local.get $f1) (local.get $f2))
+                                    (then
+                                       (if (i32.eqz (local.get $total))
+                                          (then
+                                             (return (global.get $unordered))))
+                                       (if (f64.eq (local.get $f1)
+                                                   (local.get $f1))
+                                          (then (return (i32.const 1))))
+                                       (if (f64.eq (local.get $f2)
+                                                   (local.get $f2))
+                                          (then (return (i32.const -1))))))
+                                 (local.set $i
+                                    (i32.add (local.get $i) (i32.const 1)))
+                                 (br $float_array))))
+                        (br $next_item)))
                   (br_if $next_item (i32.eq (local.get $s1) (i32.const 1)))
                   (if (i32.gt_u (local.get $s1) (i32.const 2))
                      (then
@@ -298,24 +382,13 @@
                   (local.set $v2
                      (array.get $block (local.get $b2) (i32.const 1)))
                   (br $loop)))
-               ;; check for forward tag
-               (if (i32.eq (local.get $t1) (global.get $forward_tag))
-                  (then
-                     (local.set $v1
-                        (array.get $block (local.get $b1) (i32.const 1)))
-                     (br $loop)))
-               ;; v1 float array > v2 not represented as block
-               (if (i32.eq (local.get $t1) (global.get $double_array_tag))
-                   (then (return (i32.const 1))))
-               (return (i32.const -1))))
-            (drop (block $v1_not_float (result (ref eq))
-               (local.set $f1
-                  (struct.get $float 0
-                     (br_on_cast_fail $v1_not_float $float (local.get $v1))))
-               (drop (block $v2_not_float (result (ref eq))
+               (drop (block $v1_not_float (result (ref eq))
+                  (local.set $f1
+                     (struct.get $float 0
+                        (br_on_cast_fail $v1_not_float $float (local.get $v1))))
                   (local.set $f2
                      (struct.get $float 0
-                        (br_on_cast_fail $v2_not_float $float (local.get $v2))))
+                        (br_on_cast_fail $heterogeneous $float (local.get $v2))))
                   (if (f64.lt (local.get $f1) (local.get $f2))
                      (then (return (i32.const -1))))
                   (if (f64.gt (local.get $f1) (local.get $f2))
@@ -329,60 +402,117 @@
                         (if (f64.eq (local.get $f2) (local.get $f2))
                            (then (return (i32.const -1))))))
                   (br $next_item)))
-               ;; ZZZ forward tag
-               ;; ZZZ float array
-      (call $log (i32.const 2))
-               (unreachable)
-               (return (i32.const 1))))
-            (if (ref.test $float (local.get $v2))
-               (then
-                  ;; ZZZ forward tag
-                  ;; ZZZ float array
-      (call $log (i32.const 3))
-                  (unreachable)
-                  (return (i32.const -1))))
-            (drop (block $v1_not_string (result (ref eq))
-               (local.set $str1
-                  (br_on_cast_fail $v1_not_string $string (local.get $v1)))
-               (drop (block $v2_not_string (result (ref eq))
+               (drop (block $v1_not_string (result (ref eq))
+                  (local.set $str1
+                     (br_on_cast_fail $v1_not_string $string (local.get $v1)))
                   (local.set $str2
-                      (br_on_cast_fail $v2_not_string $string (local.get $v2)))
+                      (br_on_cast_fail $heterogeneous $string (local.get $v2)))
                   (local.set $res
-                     (call $compare_strings
-                        (local.get $str1) (local.get $str2)))
+                     (call $compare_strings (local.get $str1) (local.get $str2)))
                   (br_if $next_item (i32.eqz (local.get $res)))
                   (return (local.get $res))))
-               ;; ZZZ forward tag
-               ;; ZZZ float array
-      (call $log (i32.const 4))
-               (unreachable)
-               (return (i32.const 1))))
-            (drop (block $v1_not_custom (result (ref eq))
-               (local.set $c1
-                  (br_on_cast_fail $v1_not_custom $custom (local.get $v1)))
-               (drop (block $v2_not_custom (result (ref eq))
+               (drop (block $v1_not_custom (result (ref eq))
+                  (local.set $c1
+                     (br_on_cast_fail $v1_not_custom $custom (local.get $v1)))
                   (local.set $c2
-                      (br_on_cast_fail $v2_not_custom $custom (local.get $v2)))
-                  ;; ZZZ compare types
-                  ;; ZZZ abstract value?
-                  (local.set $res
-                     (call_ref $value->value->int
-                        (local.get $v1) (local.get $v2)
-                        (struct.get $custom_operations 1
-                           (struct.get $custom 0 (local.get $c1)))
-                        ))
-                  (br_if $next_item (i32.eqz (local.get $res)))
-                  (return (local.get $res))))
-               ;; ZZZ forward tag
-               ;; ZZZ float array
-      (call $log (i32.const 5))
-               (unreachable)
-               (return (i32.const 1))))
-      (call $log (i32.const 6))
-            (unreachable)
-            ;; ZZZ forward tag
-            ;; ZZZ float array
-            (return (i32.const 1)))
+                      (br_on_cast_fail $heterogeneous $custom (local.get $v2)))
+                  (if (i32.eqz
+                         (ref.eq (struct.get $custom 0 (local.get $c1))
+                                 (struct.get $custom 0 (local.get $c2))))
+                     (then
+                        (return
+                           (i31.get_s
+                              (ref.cast i31
+                                 (call $caml_string_compare
+                                    (struct.get $custom_operations $cust_id
+                                       (struct.get $custom 0
+                                          (local.get $c1)))
+                                    (struct.get $custom_operations $cust_id
+                                       (struct.get $custom 0
+                                          (local.get $c2)))))))))
+                  (block $not_comparable
+                     (local.set $res
+                        (call_ref $value->value->int->int
+                           (local.get $v1) (local.get $v2) (local.get $total)
+                           (br_on_null $not_comparable
+                              (struct.get $custom_operations $cust_compare
+                                 (struct.get $custom 0 (local.get $c1))))))
+                     (br_if $next_item (i32.eqz (local.get $res)))
+                     (return (local.get $res)))
+                  (call $clear_compare_stack)
+                  (call $caml_invalid_argument
+                     (array.new_data $string $abstract_value
+                        (i32.const 0) (i32.const 23)))
+                  (i31.new (i32.const 0))))
+               ;; ZZZ float array (unboxed)
+               (drop (block $v1_not_js (result (ref eq))
+                  (local.set $js1
+                     (struct.get $js 0
+                        (br_on_cast_fail $v1_not_js $js (local.get $v1))))
+                  (local.set $js2
+                     (struct.get $js 0
+                        (br_on_cast_fail $heterogeneous $js (local.get $v2))))
+                  ;; ZZZ use ref.test / ref.cast
+                  (if (i32.and (call $ref_test_string (local.get $js1))
+                               (call $ref_test_string (local.get $js2)))
+                     (then
+                        (local.set $res
+                           (string.compare
+                              (call $ref_cast_string (local.get $js1))
+                              (call $ref_cast_string (local.get $js2))))
+                        (br_if $next_item (i32.eqz (local.get $res)))
+                        (return (local.get $res))))
+                  ;; We cannot order two JavaScript objects,
+                  ;; but we can tell whether they are equal or not
+                  (if (i32.eqz (local.get $total))
+                     (then
+                        (br_if $next_item
+                           (call $equals (local.get $js1) (local.get $js2)))
+                        (return (global.get $unordered))))
+                  (br $heterogeneous (i31.new (i32.const 0)))))
+               (if (ref.test $closure (local.get $v1))
+                  (then
+                     (drop (br_if $heterogeneous (i31.new (i32.const 0))
+                              (i32.eqz (ref.test $closure (local.get $v2)))))
+                     (call $clear_compare_stack)
+                     (call $caml_invalid_argument
+                        (array.new_data $string $functional_value
+                           (i32.const 0) (i32.const 25)))))
+               (if (call $caml_is_continuation (local.get $v1))
+                  (then
+                     (drop (br_if $heterogeneous(i31.new (i32.const 0))
+                              (i32.eqz
+                                 (call $caml_is_continuation (local.get $v2)))))
+                     (call $clear_compare_stack)
+                     (call $caml_invalid_argument
+                        (array.new_data $string $continuation_value
+                           (i32.const 0) (i32.const 27)))))
+               (i31.new (i32.const 0)))) ;; fall through
+            ;; heterogeneous comparison
+            (local.set $t1
+               (i31.get_u (ref.cast i31 (call $caml_obj_tag (local.get $v1)))))
+            (local.set $t2
+               (i31.get_u (ref.cast i31 (call $caml_obj_tag (local.get $v2)))))
+            (if (i32.eq (local.get $t1) (global.get $forward_tag))
+               (then
+                  (local.set $v1
+                     (array.get $block (ref.cast $block (local.get $v1))
+                        (i32.const 1)))
+                  (br $loop)))
+            (if (i32.eq (local.get $t2) (global.get $forward_tag))
+               (then
+                  (local.set $v2
+                     (array.get $block (ref.cast $block (local.get $v2))
+                        (i32.const 1)))
+                  (br $loop)))
+            (local.set $res (i32.sub (local.get $t1) (local.get $t2)))
+            (if (i32.eqz (local.get $res))
+               (then
+                  (call $clear_compare_stack)
+                  (call $caml_invalid_argument
+                     (array.new_data $string $abstract_value
+                        (i32.const 0) (i32.const 23)))))
+            (return (local.get $res)))
          (if (call $compare_stack_is_not_empty (local.get $stack))
             (then
                (local.set $tuple (call $pop_compare_stack (local.get $stack)))
diff --git a/runtime/wasm/custom.wat b/runtime/wasm/custom.wat
new file mode 100644
index 0000000000..4f04fa57f6
--- /dev/null
+++ b/runtime/wasm/custom.wat
@@ -0,0 +1,47 @@
+(module
+   (type $string (array (mut i8)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+
+   (type $custom_with_id
+      (sub $custom
+         (struct
+            (field (ref $custom_operations))
+            (field $id i64))))
+
+   (func (export "custom_compare_id")
+      (param (ref eq)) (param (ref eq)) (param i32) (result i32)
+      (local $i1 i64) (local $i2 i64)
+      (local.set $i1
+         (struct.get $custom_with_id $id
+            (ref.cast $custom_with_id (local.get 0))))
+      (local.set $i2
+         (struct.get $custom_with_id $id
+            (ref.cast $custom_with_id (local.get 1))))
+      (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
+               (i64.lt_s (local.get $i1) (local.get $i2))))
+
+   (func (export "custom_hash_id") (param (ref eq)) (result i32)
+      (i32.wrap_i64
+         (struct.get $custom_with_id $id
+           (ref.cast $custom_with_id (local.get 0)))))
+
+   (global $next_id (mut i64) (i64.const 0))
+
+   (func (export "custom_next_id") (result i64)
+      (local $id i64)
+      (local.set $id (global.get $next_id))
+      (global.set $next_id (i64.add (local.get $id) (i64.const 1)))
+      (local.get $id))
+)
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index cf72169e67..b1d99d498e 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -1,24 +1,33 @@
 (module
    (import "obj" "object_tag" (global $object_tag i32))
    (import "obj" "forward_tag" (global $forward_tag i32))
+   (import "bindings" "is_string"
+      (func $ref_test_string (param anyref) (result i32)))
+   (import "bindings" "identity"
+      (func $ref_cast_string (param anyref) (result (ref string))))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $js (struct (field anyref)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
 
-   (func $caml_hash_mix_int (param $h i32) (param $d i32) (result i32)
+   (func $caml_hash_mix_int (export "caml_hash_mix_int")
+      (param $h i32) (param $d i32) (result i32)
       (i32.add
          (i32.mul
             (i32.rotl
@@ -33,7 +42,8 @@
             (i32.const 5))
          (i32.const 0xe6546b64)))
 
-   (func $caml_hash_mix_final (param $h i32) (result i32)
+   (func $caml_hash_mix_final (export "caml_hash_mix_final")
+      (param $h i32) (result i32)
       (local.set $h
          (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
       (local.set $h (i32.mul (local.get $h) (i32.const 0x85ebca6b)))
@@ -60,7 +70,7 @@
          (then (local.set $i (i64.const 0))))
       (return_call $caml_hash_mix_int64 (local.get $h) (local.get $i)))
 
-   (func $caml_hash_mix_string
+   (func $caml_hash_mix_string (export "caml_hash_mix_string")
       (param $h i32) (param $s (ref $string)) (result i32)
       (local $i i32) (local $len i32) (local $w i32)
       (local.set $len (array.len (local.get $s)))
@@ -108,6 +118,11 @@
          (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
       (i32.xor (local.get $h) (local.get $len)))
 
+   (func $caml_hash_mix_jsstring
+      (param $h i32) (param $s (ref eq)) (result i32)
+      (return_call $caml_hash_mix_string (local.get $h)
+         (ref.cast $string (call $caml_string_of_jsstring (local.get $s)))))
+
    (global $HASH_QUEUE_SIZE i32 (i32.const 256))
    (global $MAX_FORWARD_DEREFERENCE i32 (i32.const 1000))
 
@@ -124,6 +139,7 @@
       (local $i i32)
       (local $len i32)
       (local $tag i32)
+      (local $str anyref)
       (local.set $sz (i31.get_u (ref.cast i31 (local.get $limit))))
       (if (i32.gt_u (local.get $sz) (global.get $HASH_QUEUE_SIZE))
          (then (local.set $sz (global.get $HASH_QUEUE_SIZE))))
@@ -231,15 +247,27 @@
                         (call $caml_hash_mix_int (local.get $h)
                            (call_ref $value->int
                               (local.get $v)
-                              (struct.get $custom_operations 2
-                                 (br_on_null $loop
+                              (br_on_null $loop
+                                 (struct.get $custom_operations $cust_hash
                                     (struct.get $custom 0
                                        (br_on_cast_fail $not_custom $custom
                                           (local.get $v))))))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
-                  ;; closures are ignored
-                  ;; ZZZ javascript values
+                  (drop (block $not_js (result (ref eq))
+                     (local.set $str
+                        (struct.get $js 0
+                           (br_on_cast_fail $not_js $js (local.get $v))))
+                     ;; ZZZ use ref.test / ref.cast
+                     (if (call $ref_test_string (local.get $str))
+                        (then
+                           (local.set $h
+                              (call $caml_hash_mix_int (local.get $h)
+                                 (string.hash
+                                    (call $ref_cast_string
+                                       (local.get $str)))))))
+                     (i31.new (i32.const 0))))
+                  ;; closures and continuations and other js values are ignored
                   (br $loop)))))
       ;; clear the queue to avoid a memory leak
       (array.fill $block (global.get $caml_hash_queue)
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index df4e1e11ea..d3fc32e617 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -7,15 +7,16 @@
          (param (ref eq)) (param i32) (param i32) (result (ref eq))))
 
    (type $string (array (mut i8)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
@@ -24,12 +25,14 @@
       (struct.new $custom_operations
          (array.new_fixed $string (i32.const 95) (i32.const 105)) ;; "_i"
          (ref.func $int32_cmp)
+         (ref.null $value->value->int->int)
          (ref.func $int32_hash)))
 
    (type $int32
       (sub $custom (struct (field (ref $custom_operations)) (field i32))))
 
-   (func $int32_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
+   (func $int32_cmp
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param i32) (result i32)
       (local $i1 i32) (local $i2 i32)
       (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get $v1))))
       (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get $v2))))
@@ -78,6 +81,7 @@
       (struct.new $custom_operations
          (array.new_fixed $string (i32.const 95) (i32.const 110)) ;; "_n"
          (ref.func $int32_cmp)
+         (ref.null $value->value->int->int)
          (ref.func $int32_hash)))
 
    (func $caml_copy_nativeint (export "caml_copy_nativeint")
@@ -93,7 +97,7 @@
 
    (func (export "caml_nativeint_of_string")
       (param $v (ref eq)) (result (ref eq))
-      (return_call $caml_copy_int32
+      (return_call $caml_copy_nativeint
          (call $parse_int
             (local.get $v) (i32.const 32) (global.get $NATIVEINT_ERRMSG))))
 
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index ab859204b9..ebea0ef47a 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -10,15 +10,16 @@
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
 
    (type $string (array (mut i8)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
@@ -27,12 +28,14 @@
       (struct.new $custom_operations
          (array.new_fixed $string (i32.const 95) (i32.const 106)) ;; "_j"
          (ref.func $int64_cmp)
+         (ref.null $value->value->int->int)
          (ref.func $int64_hash)))
 
    (type $int64
       (sub $custom (struct (field (ref $custom_operations)) (field i64))))
 
-   (func $int64_cmp (param $v1 (ref eq)) (param $v2 (ref eq)) (result i32)
+   (func $int64_cmp
+      (param $v1 (ref eq)) (param $v2 (ref eq)) (param i32) (result i32)
       (local $i1 i64) (local $i2 i64)
       (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get $v1))))
       (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get $v2))))
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index ef36c9bfcf..ac6f21ce07 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -1,5 +1,4 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "effect" "caml_is_continuation"
       (func $caml_is_continuation (param (ref eq)) (result i32)))
@@ -7,19 +6,19 @@
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
-   (type $js (struct (field anyref)))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
    (type $closure (struct (;(field i32);) (field (ref $function_1))))
    (type $closure_last_arg
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index 74d738980b..34cbfba1dc 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -7,15 +7,16 @@
       (func $ta_set_i32 (param (ref extern)) (param i32) (param i32)))
 
    (type $string (array (mut i8)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
@@ -24,7 +25,7 @@
       (sub $custom
          (struct
             (field (ref $custom_operations))
-            (field (ref extern)) ;; data
+            (field (mut (ref extern))) ;; data
             (field (ref $int_array)) ;; size in each dimension
             (field i8) ;; number of dimensions
             (field i8) ;; kind
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index a801268018..5d23182da6 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -64,6 +64,7 @@
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,
+         is_string:(v)=>+(typeof v==="string"),
          ta_create:(k,sz)=> new(typed_arrays[k])(sz),
          ta_normalize:(a)=>
            a instanceof Uint8ClampedArray?
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 718f26b050..78aa07a6d3 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -8,15 +8,16 @@
       (func $caml_copy_int64 (param i64) (result (ref eq))))
 
    (type $string (array (mut i8)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index 82df517e6a..960b0d7b22 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -1,76 +1,77 @@
 (module
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+   (import "custom" "custom_compare_id"
+      (func $custom_compare_id
+        (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
+   (import "custom" "custom_hash_id"
+      (func $custom_hash_id (param (ref eq)) (result i32)))
+   (import "custom" "custom_next_id" (func $custom_next_id (result i64)))
 
    (type $string (array (mut i8)))
-   (type $value->value->int
-      (func (param (ref eq)) (param (ref eq)) (result i32)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
    (type $value->int
       (func (param (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field (ref $string)) ;; identifier
-         (field (ref $value->value->int)) ;; compare
-         (field (ref null $value->int)) ;; hash
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
          ;; ZZZ
       ))
    (type $custom (struct (field (ref $custom_operations))))
+   (type $custom_with_id
+      (sub $custom
+         (struct
+            (field (ref $custom_operations))
+            (field $id i64))))
 
    (global $mutex_ops (ref $custom_operations)
       (struct.new $custom_operations
          (array.new_fixed $string ;; "_mutex"
             (i32.const 95) (i32.const 109) (i32.const 117) (i32.const 116)
             (i32.const 101) (i32.const 120))
-         (ref.func $mutex_cmp)
-         (ref.func $mutex_hash)))
+         (ref.func $custom_compare_id)
+         (ref.null $value->value->int->int)
+         (ref.func $custom_hash_id)))
 
    (type $mutex
-      (sub $custom
+      (sub $custom_with_id
          (struct
-            (field (ref $custom_operations)) (field i32) (field (mut i32)))))
-
-   (func $mutex_cmp (param (ref eq)) (param (ref eq)) (result i32)
-      (local $i1 i32) (local $i2 i32)
-      (local.set $i1 (struct.get $mutex 1 (ref.cast $mutex (local.get 0))))
-      (local.set $i2 (struct.get $mutex 1 (ref.cast $mutex (local.get 1))))
-      (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
-               (i32.lt_s (local.get $i1) (local.get $i2))))
-
-   (func $mutex_hash (param (ref eq)) (result i32)
-      (struct.get $mutex 1 (ref.cast $mutex (local.get 0))))
-
-   (global $next_mutex_id (mut i32) (i32.const 0))
+            (field (ref $custom_operations))
+            (field i64)
+            (field $state (mut i32)))))
 
    (func (export "caml_ml_mutex_new") (param (ref eq)) (result (ref eq))
-      (local $id i32)
-      (local.set $id (global.get $next_mutex_id))
-      (global.set $next_mutex_id (i32.add (local.get $id) (i32.const 1)))
-      (struct.new $mutex (global.get $mutex_ops) (local.get $id) (i32.const 0)))
+      (struct.new $mutex
+         (global.get $mutex_ops) (call $custom_next_id) (i32.const 0)))
 
    (data $lock_failure "Mutex.lock: mutex already locked. Cannot wait.")
 
    (func (export "caml_ml_mutex_lock") (param (ref eq)) (result (ref eq))
       (local $t (ref $mutex))
       (local.set $t (ref.cast $mutex (local.get 0)))
-      (if (struct.get $mutex 2 (local.get $t))
+      (if (struct.get $mutex $state (local.get $t))
          (then
             (call $caml_failwith
                (array.new_data $string $lock_failure
                   (i32.const 0) (i32.const 46)))))
-      (struct.set $mutex 2 (local.get $t) (i32.const 1))
+      (struct.set $mutex $state (local.get $t) (i32.const 1))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_try_lock") (param (ref eq)) (result (ref eq))
       (local $t (ref $mutex))
       (local.set $t (ref.cast $mutex (local.get 0)))
-      (if (result (ref eq)) (struct.get $mutex 2 (local.get $t))
+      (if (result (ref eq)) (struct.get $mutex $state (local.get $t))
          (then
             (i31.new (i32.const 0)))
          (else
-            (struct.set $mutex 2 (local.get $t) (i32.const 1))
+            (struct.set $mutex $state (local.get $t) (i32.const 1))
             (i31.new (i32.const 1)))))
 
    (func (export "caml_ml_mutex_unlock") (param (ref eq)) (result (ref eq))
-      (struct.set $mutex 2 (ref.cast $mutex (local.get 0)) (i32.const 0))
+      (struct.set $mutex $state (ref.cast $mutex (local.get 0)) (i32.const 0))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_condition_new") (param (ref eq)) (result (ref eq))

From ace112f66cf22e267557010bcf057c28aeab14aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 21 Jun 2023 14:39:43 +0200
Subject: [PATCH 067/481] Fix parallel renaming

---
 compiler/lib/wasm/wa_generate.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 9e05cc2821..43cb9966df 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -648,7 +648,7 @@ module Generate (Target : Wa_target_sig.S) = struct
       in
       l
     in
-    let l = List.rev (visit_all params args) in
+    let l = visit_all params args in
     List.fold_left
       l
       ~f:(fun continuation (y, x) ->

From 46d2af157554203f9122fc9e61bb3825a9ff3f05 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 21 Jun 2023 14:40:29 +0200
Subject: [PATCH 068/481] Runtime: Str

---
 runtime/wasm/str.wat | 721 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 721 insertions(+)
 create mode 100644 runtime/wasm/str.wat

diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat
new file mode 100644
index 0000000000..3eae74dc7e
--- /dev/null
+++ b/runtime/wasm/str.wat
@@ -0,0 +1,721 @@
+(module
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+
+   (type $string (array (mut i8)))
+   (type $block (array (mut (ref eq))))
+
+   (type $char_table (array i8))
+   (type $int_array (array (mut i32)))
+
+   (global $re_word_letters (ref $char_table)
+      (array.new_fixed $char_table
+         (i32.const 0x00) (i32.const 0x00)
+         (i32.const 0x00) (i32.const 0x00)   ;; 0x00-0x1F: none
+         (i32.const 0x00) (i32.const 0x00)
+         (i32.const 0xFF) (i32.const 0x03)   ;; 0x20-0x3F: digits 0-9
+         (i32.const 0xFE) (i32.const 0xFF)
+         (i32.const 0xFF) (i32.const 0x87)   ;; 0x40-0x5F: A to Z, _
+         (i32.const 0xFE) (i32.const 0xFF)
+         (i32.const 0xFF) (i32.const 0x07)   ;; 0x60-0x7F: a to z
+         (i32.const 0x00) (i32.const 0x00)
+         (i32.const 0x00) (i32.const 0x00)   ;; 0x80-0x9F: none
+         (i32.const 0x00) (i32.const 0x00)
+         (i32.const 0x00) (i32.const 0x00)   ;; 0xA0-0xBF: none
+         (i32.const 0xFF) (i32.const 0xFF)   ;; 0xC0-0xDF:
+         (i32.const 0x7F) (i32.const 0xFF)   ;; Latin-1 accented uppercase
+         (i32.const 0xFF) (i32.const 0xFF)   ;; 0xE0-0xFF:
+         (i32.const 0x7F) (i32.const 0xFF))) ;; Latin-1 accented lowercase
+
+   (rec (type $stack (struct (field (ref null $stack)))))
+   (type $pos
+      (sub $stack
+         (struct
+            (field $pos_previous (ref null $stack))
+            (field $pc i32)
+            (field $pos i32))))
+   (type $undo
+      (sub $stack
+         (struct
+            (field $undo_previous (ref null $stack))
+            (field $tbl (ref $int_array))
+            (field $idx i32)
+            (field $val i32))))
+
+   (func $is_word_letter (param $c i32) (result i32)
+      (i32.and (i32.const 1)
+         (i32.shr_u
+            (array.get_u $char_table (global.get $re_word_letters)
+               (i32.shr_u (local.get $c) (i32.const 3)))
+            (i32.and (local.get $c) (i32.const 7)))))
+
+   (func $in_bitset (param $s (ref $string)) (param $c i32) (result i32)
+      (i32.and (i32.const 1)
+         (i32.shr_u
+            (array.get_u $string (local.get $s)
+               (i32.shr_u (local.get $c) (i32.const 3)))
+            (i32.and (local.get $c) (i32.const 7)))))
+
+   (func $re_match
+      (param $vre (ref eq)) (param $s (ref $string)) (param $pos i32)
+      (param $accept_partial_match i32) (result (ref eq))
+      (local $res (ref $block))
+      (local $s' (ref $string)) (local $set (ref $string))
+      (local $len i32) (local $instr i32) (local $arg i32) (local $i i32)
+      (local $j i32) (local $l i32)
+      (local $re (ref $block))
+      (local $prog (ref $block))
+      (local $cpool (ref $block))
+      (local $normtable (ref $string))
+      (local $numgroups i32)
+      (local $numregisters i32)
+      (local $group_start (ref $int_array))
+      (local $group_end (ref $int_array))
+      (local $re_register (ref $int_array))
+      (local $pc i32)
+      (local $stack (ref null $stack))
+      (local $u (ref $undo))
+      (local $p (ref $pos))
+      (local.set $len (array.len (local.get $s)))
+      (local.set $re (ref.cast $block (local.get $vre)))
+      (local.set $prog
+         (ref.cast $block (array.get $block (local.get $re) (i32.const 1))))
+      (local.set $cpool
+         (ref.cast $block (array.get $block (local.get $re) (i32.const 2))))
+      (local.set $normtable
+         (ref.cast $string (array.get $block (local.get $re) (i32.const 3))))
+      (local.set $numgroups
+         (i31.get_s
+            (ref.cast i31 (array.get $block (local.get $re) (i32.const 4)))))
+      (local.set $numregisters
+         (i31.get_s
+            (ref.cast i31 (array.get $block (local.get $re) (i32.const 5)))))
+      (local.set $group_start
+         (array.new $int_array (i32.const -1) (local.get $numgroups)))
+      (local.set $group_end
+         (array.new $int_array (i32.const -1) (local.get $numgroups)))
+      (local.set $re_register
+         (array.new $int_array (i32.const -1) (local.get $numregisters)))
+      (local.set $pc (i32.const 1))
+      (array.set $int_array (local.get $group_start) (i32.const 0)
+         (local.get $pos))
+      (block $reject
+       (block $ACCEPT
+        (loop $continue
+         (block $backtrack
+          (block $prefix_match
+           (block $CHECKPROGRESS
+            (block $SETMARK
+             (block $PUSHBACK
+              (block $GOTO
+               (block $SIMPLEPLUS
+                (block $SIMPLESTAR
+                 (block $SIMPLEOPT
+                  (block $REFGROUP
+                   (block $ENDGROUP
+                    (block $BEGGROUP
+                     (block $WORDBOUNDARY
+                      (block $EOL
+                       (block $BOL
+                        (block $CHARCLASS
+                         (block $STRINGNORM
+                          (block $STRING
+                           (block $CHARNORM
+                            (block $CHAR
+                             (local.set $instr
+                                (i31.get_s
+                                   (ref.cast i31
+                                      (array.get $block (local.get $prog)
+                                         (local.get $pc)))))
+                             (local.set $pc
+                                (i32.add (local.get $pc) (i32.const 1)))
+                             (br_table
+                                $CHAR $CHARNORM $STRING $STRINGNORM $CHARCLASS
+                                $BOL $EOL $WORDBOUNDARY $BEGGROUP $ENDGROUP
+                                $REFGROUP $ACCEPT $SIMPLEOPT $SIMPLESTAR
+                                $SIMPLEPLUS $GOTO $PUSHBACK $SETMARK
+                                $CHECKPROGRESS
+                                (i32.and (local.get $instr) (i32.const 0xff))))
+                            ;; CHAR
+                            (br_if $prefix_match
+                               (i32.eq (local.get $pos) (local.get $len)))
+                            (local.set $arg
+                               (i32.shr_u (local.get $instr) (i32.const 8)))
+                            (br_if $backtrack
+                               (i32.ne (local.get $arg)
+                                  (array.get_u $string
+                                     (local.get $s) (local.get $pos))))
+                            (local.set $pos
+                               (i32.add (local.get $pos) (i32.const 1)))
+                            (br $continue))
+                           ;; CHARNORM
+                           (br_if $prefix_match
+                              (i32.eq (local.get $pos) (local.get $len)))
+                           (local.set $arg
+                              (i32.shr_u (local.get $instr) (i32.const 8)))
+                           (br_if $backtrack
+                              (i32.ne (local.get $arg)
+                                 (array.get_u $string
+                                    (local.get $normtable)
+                                    (array.get_u $string
+                                       (local.get $s) (local.get $pos)))))
+                           (local.set $pos
+                              (i32.add (local.get $pos) (i32.const 1)))
+                           (br $continue))
+                          ;; STRING
+                          (local.set $arg
+                             (i32.shr_u (local.get $instr) (i32.const 8)))
+                          (local.set $s'
+                             (ref.cast $string
+                                (array.get $block (local.get $cpool)
+                                   (i32.add (local.get $arg) (i32.const 1)))))
+                          (local.set $i (i32.const 0))
+                          (local.set $l (array.len (local.get $s')))
+                          (loop $loop
+                             (if (i32.lt_u (local.get $i) (local.get $l))
+                                (then
+                                   (br_if $prefix_match
+                                      (i32.eq
+                                         (local.get $pos) (local.get $len)))
+                                   (br_if $backtrack
+                                      (i32.ne
+                                         (array.get_u $string (local.get $s')
+                                            (local.get $i))
+                                         (array.get_u $string (local.get $s)
+                                            (local.get $pos))))
+                                   (local.set $pos
+                                      (i32.add (local.get $pos) (i32.const 1)))
+                                   (local.set $i
+                                      (i32.add (local.get $i) (i32.const 1)))
+                                   (br $loop))))
+                          (br $continue))
+                         ;; STRINGNORM
+                         (local.set $arg
+                            (i32.shr_u (local.get $instr) (i32.const 8)))
+                         (local.set $s'
+                            (ref.cast $string
+                               (array.get $block (local.get $cpool)
+                                  (i32.add (local.get $arg) (i32.const 1)))))
+                         (local.set $i (i32.const 0))
+                         (local.set $l (array.len (local.get $s')))
+                         (loop $loop
+                            (if (i32.lt_u (local.get $i) (local.get $l))
+                               (then
+                                  (br_if $prefix_match
+                                     (i32.eq
+                                        (local.get $pos) (local.get $len)))
+                                  (br_if $backtrack
+                                     (i32.ne
+                                        (array.get_u $string (local.get $s')
+                                           (local.get $i))
+                                        (array.get_u $string
+                                           (local.get $normtable)
+                                           (array.get_u $string (local.get $s)
+                                              (local.get $pos)))))
+                                  (local.set $pos
+                                     (i32.add (local.get $pos) (i32.const 1)))
+                                  (local.set $i
+                                     (i32.add (local.get $i) (i32.const 1)))
+                                  (br $loop))))
+                         (br $continue))
+                        ;; CHARCLASS
+                        (br_if $prefix_match
+                           (i32.eq (local.get $pos) (local.get $len)))
+                        (local.set $arg
+                           (i32.shr_u (local.get $instr) (i32.const 8)))
+                        (br_if $backtrack
+                           (i32.eqz
+                              (call $in_bitset
+                                 (ref.cast $string
+                                    (array.get $block (local.get $cpool)
+                                       (i32.add (local.get $arg)
+                                          (i32.const 1))))
+                                 (array.get_u $string (local.get $s)
+                                    (local.get $pos)))))
+                        (local.set $pos
+                           (i32.add (local.get $pos) (i32.const 1)))
+                        (br $continue))
+                       ;; BOL
+                       (br_if $continue (i32.eqz (local.get $pos)))
+                       (br_if $continue
+                          (i32.eq (i32.const 10) ;; '\n'
+                             (array.get_u $string (local.get $s)
+                                (i32.sub (local.get $pos) (i32.const 1)))))
+                       (br $backtrack))
+                      ;; EOL
+                      (br_if $continue
+                         (i32.eq (local.get $pos) (local.get $len)))
+                      (br_if $continue
+                         (i32.eq (i32.const 10) ;; '\n'
+                            (array.get_u $string (local.get $s)
+                               (local.get $pos))))
+                      (br $backtrack))
+                     ;; WORDBOUNDARY
+                     (if (i32.eqz (local.get $pos))
+                        (then
+                           (br_if $prefix_match
+                              (i32.eq (local.get $pos) (local.get $len)))
+                           (br_if $continue
+                              (call $is_word_letter
+                                 (array.get_u $string (local.get $s)
+                                    (local.get $pos))))
+                           (br $backtrack))
+                        (else
+                           (if (i32.eq (local.get $pos) (local.get $len))
+                              (then
+                                 (br_if $continue
+                                    (call $is_word_letter
+                                       (array.get_u $string (local.get $s)
+                                          (i32.sub (local.get $pos)
+                                             (i32.const 1)))))
+                                 (br $backtrack))
+                              (else
+                                 (br_if $continue
+                                    (i32.ne
+                                       (call $is_word_letter
+                                          (array.get_u $string (local.get $s)
+                                             (i32.sub (local.get $pos)
+                                                (i32.const 1))))
+                                       (call $is_word_letter
+                                          (array.get_u $string (local.get $s)
+                                             (local.get $pos)))))
+                                 (br $backtrack))))))
+                    ;; BEGGROUP
+                    (local.set $arg
+                       (i32.shr_u (local.get $instr) (i32.const 8)))
+                    (local.set $stack
+                       (struct.new $undo
+                          (local.get $stack)
+                          (local.get $group_start)
+                          (local.get $arg)
+                          (array.get $int_array
+                             (local.get $group_start) (local.get $arg))))
+                    (array.set $int_array (local.get $group_start)
+                       (local.get $arg) (local.get $pos))
+                    (br $continue))
+                   ;; ENDGROUP
+                   (local.set $arg
+                      (i32.shr_u (local.get $instr) (i32.const 8)))
+                    (local.set $stack
+                       (struct.new $undo
+                          (local.get $stack)
+                          (local.get $group_end)
+                          (local.get $arg)
+                          (array.get $int_array
+                             (local.get $group_end) (local.get $arg))))
+                   (array.set $int_array (local.get $group_end)
+                      (local.get $arg) (local.get $pos))
+                   (br $continue))
+                  ;; REFGROUP
+                  (local.set $arg
+                     (i32.shr_u (local.get $instr) (i32.const 8)))
+                  (local.set $i
+                     (array.get $int_array (local.get $group_start)
+                        (local.get $arg)))
+                  (local.set $j
+                     (array.get $int_array (local.get $group_end)
+                        (local.get $arg)))
+                  (br_if $backtrack
+                     (i32.or (i32.lt_s (local.get $i) (i32.const 0))
+                         (i32.lt_s (local.get $j) (i32.const 0))))
+                  (loop $loop
+                     (if (i32.lt_u (local.get $i) (local.get $j))
+                        (then
+                           (br_if $prefix_match
+                              (i32.eq (local.get $pos) (local.get $len)))
+                           (br_if $backtrack
+                              (i32.ne
+                                 (array.get_u $string (local.get $s)
+                                    (local.get $i))
+                                 (array.get_u $string (local.get $s)
+                                    (local.get $pos))))
+                           (local.set $pos
+                              (i32.add (local.get $pos) (i32.const 1)))
+                           (local.set $i
+                              (i32.add (local.get $i) (i32.const 1)))
+                           (br $loop))))
+                  (br $continue))
+                 ;; SIMPLEOPT
+                 (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8)))
+                 (if (i32.lt_u (local.get $pos) (local.get $len))
+                    (then
+                       (if (call $in_bitset
+                              (ref.cast $string
+                                 (array.get $block (local.get $cpool)
+                                    (i32.add (local.get $arg) (i32.const 1))))
+                              (array.get_u $string (local.get $s)
+                                 (local.get $pos)))
+                          (then
+                             (local.set $pos
+                                (i32.add (local.get $pos) (i32.const 1)))))))
+                 (br $continue))
+                ;; SIMPLESTAR
+                (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8)))
+                (local.set $set
+                   (ref.cast $string
+                      (array.get $block (local.get $cpool)
+                      (i32.add (local.get $arg) (i32.const 1)))))
+                (loop $loop
+                   (if (i32.lt_u (local.get $pos) (local.get $len))
+                      (then
+                         (if (call $in_bitset (local.get $set)
+                                (array.get_u $string (local.get $s)
+                                   (local.get $pos)))
+                            (then
+                               (local.set $pos
+                                  (i32.add (local.get $pos) (i32.const 1)))
+                               (br $loop))))))
+                (br $continue))
+               ;; SIMPLEPLUS
+               (br_if $prefix_match (i32.eq (local.get $pos) (local.get $len)))
+               (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8)))
+               (local.set $set
+                  (ref.cast $string
+                     (array.get $block (local.get $cpool)
+                     (i32.add (local.get $arg) (i32.const 1)))))
+               (br_if $backtrack
+                  (i32.eqz
+                     (call $in_bitset (local.get $set)
+                        (array.get_u $string (local.get $s) (local.get $pos)))))
+               (loop $loop
+                  (local.set $pos (i32.add (local.get $pos) (i32.const 1)))
+                  (if (i32.lt_u (local.get $pos) (local.get $len))
+                     (then
+                        (br_if $loop
+                           (call $in_bitset (local.get $set)
+                              (array.get_u $string (local.get $s)
+                                 (local.get $pos)))))))
+               (br $continue))
+              ;; GOTO
+              (local.set $pc
+                 (i32.add
+                    (local.get $pc)
+                    (i32.shr_s (local.get $instr) (i32.const 8))))
+              (br $continue))
+             ;; PUSHBACK
+             (local.set $stack
+                (struct.new $pos
+                   (local.get $stack)
+                   (i32.add (local.get $pc)
+                      (i32.shr_s (local.get $instr) (i32.const 8)))
+                   (local.get $pos)))
+             (br $continue))
+            ;; SETMARK
+            (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8)))
+            (local.set $stack
+               (struct.new $undo
+                  (local.get $stack)
+                  (local.get $re_register)
+                  (local.get $arg)
+                  (array.get $int_array
+                     (local.get $re_register) (local.get $arg))))
+            (array.set $int_array (local.get $re_register) (local.get $arg)
+               (local.get $pos))
+            (br $continue))
+           ;; CHECKPROGRESS
+           (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8)))
+           (br_if $backtrack
+              (i32.eq (local.get $pos)
+                 (array.get $int_array (local.get $re_register)
+                    (local.get $arg))))
+           (br $continue))
+          ;; prefix_match
+          (br_if $ACCEPT (local.get $accept_partial_match)))
+         ;; backtrack
+         (loop $loop
+            (local.set $u
+               (ref.cast $undo
+                  (block $undo (result (ref $stack))
+                     (local.set $p
+                        (br_on_cast_fail $undo $pos
+                           (br_on_null $reject (local.get $stack))))
+                     (local.set $pc (struct.get $pos $pc (local.get $p)))
+                     (local.set $pos (struct.get $pos $pos (local.get $p)))
+                     (local.set $stack
+                        (struct.get $pos $pos_previous (local.get $p)))
+                     (br $continue))))
+            (array.set $int_array (struct.get $undo $tbl (local.get $u))
+                (struct.get $undo $idx (local.get $u))
+                (struct.get $undo $val (local.get $u)))
+            (local.set $stack (struct.get $undo $undo_previous (local.get $u)))
+            (br $loop))))
+       ;; ACCEPT
+       (array.set $int_array
+          (local.get $group_end) (i32.const 0) (local.get $pos))
+       (local.set $res
+          (array.new $block (i31.new (i32.const 0))
+             (i32.add (i32.shl (local.get $numgroups) (i32.const 1))
+                (i32.const 1))))
+       (local.set $i (i32.const 0))
+       (loop $loop
+          (if (i32.lt_u (local.get $i) (local.get $numgroups))
+             (then
+                (local.set $j (i32.shl (local.get $i) (i32.const 1)))
+                (if (i32.or
+                       (i32.lt_s
+                          (array.get $int_array (local.get $group_start)
+                             (local.get $i))
+                          (i32.const 0))
+                       (i32.lt_s
+                          (array.get $int_array (local.get $group_end)
+                             (local.get $i))
+                          (i32.const 0)))
+                   (then
+                      (array.set $block (local.get $res)
+                         (i32.add (local.get $j) (i32.const 1))
+                         (i31.new (i32.const -1)))
+                      (array.set $block (local.get $res)
+                         (i32.add (local.get $j) (i32.const 2))
+                         (i31.new (i32.const -1))))
+                   (else
+                      (array.set $block (local.get $res)
+                         (i32.add (local.get $j) (i32.const 1))
+                         (i31.new
+                            (array.get $int_array (local.get $group_start)
+                               (local.get $i))))
+                      (array.set $block (local.get $res)
+                         (i32.add (local.get $j) (i32.const 2))
+                         (i31.new
+                            (array.get $int_array (local.get $group_end)
+                               (local.get $i))))))
+                (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                (br $loop))))
+       (return (local.get $res)))
+      ;; reject
+      (i31.new (i32.const 0)))
+
+   (data $search_forward "Str.search_forward")
+
+   (func (export "re_search_forward")
+      (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq))
+      (result (ref eq))
+      ;; ZZZ startchars
+      (local $s (ref $string))
+      (local $pos i32) (local $len i32)
+      (local $res (ref eq))
+      (local.set $s (ref.cast $string (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $len (array.len (local.get $s)))
+      (if (i32.gt_u (local.get $pos) (local.get $len))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $search_forward
+                  (i32.const 0) (i32.const 18)))))
+      (loop $loop
+         (local.set $res
+            (call $re_match
+               (local.get $re) (local.get $s) (local.get $pos) (i32.const 0)))
+         (if (ref.test $block (local.get $res))
+            (then
+               (return (local.get $res))))
+         (local.set $pos (i32.add (local.get $pos) (i32.const 1)))
+         (br_if $loop (i32.le_u (local.get $pos) (local.get $len))))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (data $search_backward "Str.search_backward")
+
+   (func (export "re_search_backward")
+      (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq))
+      (result (ref eq))
+      ;; ZZZ startchars
+      (local $s (ref $string))
+      (local $pos i32) (local $len i32)
+      (local $res (ref eq))
+      (local.set $s (ref.cast $string (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $len (array.len (local.get $s)))
+      (if (i32.gt_u (local.get $pos) (local.get $len))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $search_backward
+                  (i32.const 0) (i32.const 19)))))
+      (loop $loop
+         (local.set $res
+            (call $re_match
+               (local.get $re) (local.get $s) (local.get $pos) (i32.const 0)))
+         (if (ref.test $block (local.get $res))
+            (then
+               (return (local.get $res))))
+         (local.set $pos (i32.sub (local.get $pos) (i32.const 1)))
+         (br_if $loop (i32.ge_s (local.get $pos) (i32.const 0))))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (data $string_match "Str.string_match")
+
+   (func (export "re_string_match")
+      (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq))
+      (result (ref eq))
+      ;; ZZZ startchars
+      (local $s (ref $string))
+      (local $pos i32) (local $len i32)
+      (local $res (ref eq))
+      (local.set $s (ref.cast $string (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $len (array.len (local.get $s)))
+      (if (i32.gt_u (local.get $pos) (local.get $len))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $string_match
+                  (i32.const 0) (i32.const 16)))))
+      (local.set $res
+         (call $re_match
+            (local.get $re) (local.get $s) (local.get $pos) (i32.const 0)))
+       (if (ref.test $block (local.get $res))
+          (then
+            (return (local.get $res))))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (data $string_partial_match "Str.string_partial_match")
+
+   (func (export "re_partial_match")
+      (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq))
+      (result (ref eq))
+      ;; ZZZ startchars
+      (local $s (ref $string))
+      (local $pos i32) (local $len i32)
+      (local $res (ref eq))
+      (local.set $s (ref.cast $string (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $len (array.len (local.get $s)))
+      (if (i32.gt_u (local.get $pos) (local.get $len))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $string_partial_match
+                  (i32.const 0) (i32.const 24)))))
+      (local.set $res
+         (call $re_match
+            (local.get $re) (local.get $s) (local.get $pos) (i32.const 1)))
+       (if (ref.test $block (local.get $res))
+          (then
+            (return (local.get $res))))
+      (array.new_fixed $block (i31.new (i32.const 0))))
+
+   (data $illegal_backslash "Str.replace: illegal backslash sequence")
+   (data $unmatched_group "Str.replace: reference to unmatched group")
+
+   (func (export "re_replacement_text")
+      (param $vrepl (ref eq)) (param $vgroups (ref eq)) (param $vorig (ref eq))
+      (result (ref eq))
+      (local $repl (ref $string))
+      (local $groups (ref $block))
+      (local $orig (ref $string))
+      (local $res (ref $string))
+      (local $i i32) (local $j i32) (local $l i32) (local $len i32)
+      (local $c i32) (local $start i32) (local $end i32)
+      (local.set $repl (ref.cast $string (local.get $vrepl)))
+      (local.set $l (array.len (local.get $repl)))
+      (local.set $groups (ref.cast $block (local.get $vgroups)))
+      (local.set $orig (ref.cast $string (local.get $vorig)))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $c
+                  (array.get_u $string (local.get $repl) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (if (i32.ne (local.get $c) (i32.const 92)) ;; '\\'
+                  (then
+                     (local.set $len (i32.add (local.get $len) (i32.const 1)))
+                     (br $loop)))
+               (if (i32.eq (local.get $i) (local.get $l))
+                  (then
+                     (call $caml_failwith
+                        (array.new_data $string $illegal_backslash
+                           (i32.const 0) (i32.const 39)))))
+               (local.set $c
+                  (array.get_u $string (local.get $repl) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (if (i32.eq (local.get $c) (i32.const 92)) ;; '\\'
+                  (then
+                     (local.set $len (i32.add (local.get $len) (i32.const 1)))
+                     (br $loop)))
+               (local.set $c (i32.sub (local.get $c) (i32.const 48))) ;; '0'
+               (if (i32.gt_u (local.get $c) (i32.const 9))
+                  (then
+                     (local.set $len (i32.add (local.get $len) (i32.const 2)))
+                     (br $loop)))
+               (local.set $c (i32.shl (local.get $c) (i32.const 1)))
+               (if (i32.gt_u (i32.add (local.get $c) (i32.const 1))
+                      (array.len (local.get $groups)))
+                  (then
+                     (call $caml_failwith
+                        (array.new_data $string $unmatched_group
+                           (i32.const 0) (i32.const 41)))))
+               (local.set $start
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $groups)
+                           (i32.add (local.get $c) (i32.const 1))))))
+               (local.set $end
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $groups)
+                           (i32.add (local.get $c) (i32.const 2))))))
+               (if (i32.eq (local.get $start) (i32.const -1))
+                  (then
+                     (call $caml_failwith
+                        (array.new_data $string $unmatched_group
+                           (i32.const 0) (i32.const 41)))))
+               (local.set $len
+                   (i32.add (local.get $len)
+                      (i32.sub (local.get $end) (local.get $start))))
+               (br $loop))))
+      (local.set $res (array.new $string (i32.const 0) (local.get $len)))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (local.set $c
+                  (array.get_u $string (local.get $repl) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (if (i32.ne (local.get $c) (i32.const 92)) ;; '\\'
+                  (then
+                     (array.set $string (local.get $res) (local.get $j)
+                        (local.get $c))
+                     (local.set $j (i32.add (local.get $j) (i32.const 1)))
+                     (br $loop)))
+               (local.set $c
+                  (array.get_u $string (local.get $repl) (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (if (i32.eq (local.get $c) (i32.const 92)) ;; '\\'
+                  (then
+                     (array.set $string (local.get $res) (local.get $j)
+                        (local.get $c))
+                     (local.set $j (i32.add (local.get $j) (i32.const 1)))
+                     (br $loop)))
+               (local.set $c (i32.sub (local.get $c) (i32.const 48))) ;; '0'
+               (if (i32.gt_u (local.get $c) (i32.const 9))
+                  (then
+                     (array.set $string (local.get $res) (local.get $j)
+                        (i32.const 92))
+                     (array.set $string (local.get $res)
+                        (i32.add (local.get $j) (i32.const 1))
+                        (i32.add (local.get $c) (i32.const 48)))
+                     (local.set $j (i32.add (local.get $j) (i32.const 2)))
+                     (br $loop)))
+               (local.set $c (i32.shl (local.get $c) (i32.const 1)))
+               (if (i32.gt_u (i32.add (local.get $c) (i32.const 1))
+                      (array.len (local.get $groups)))
+                  (then
+                     (call $caml_failwith
+                        (array.new_data $string $unmatched_group
+                           (i32.const 0) (i32.const 41)))))
+               (local.set $start
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $groups)
+                           (i32.add (local.get $c) (i32.const 1))))))
+               (local.set $end
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $groups)
+                           (i32.add (local.get $c) (i32.const 2))))))
+               (local.set $len (i32.sub (local.get $end) (local.get $start)))
+               (array.copy $string $string
+                  (local.get $res) (local.get $j)
+                  (local.get $orig) (local.get $start)
+                  (local.get $len))
+               (local.set $j (i32.add (local.get $j) (local.get $len)))
+               (br $loop))))
+      (local.get $res))
+)

From 8a235720960ab8125152987dbc54fa0b5bbe23b4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 26 Jun 2023 08:48:57 +0200
Subject: [PATCH 069/481] Runtime: use appropriate tag for float arrays

---
 runtime/wasm/array.wat | 43 +++++++++++++++++++++++++++++++++---------
 1 file changed, 34 insertions(+), 9 deletions(-)

diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index b049b07f45..0319ad7bae 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -1,6 +1,7 @@
 (module
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
+   (import "obj" "double_array_tag" (global $double_array_tag i32))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -11,16 +12,20 @@
    (func $caml_make_vect (export "caml_make_vect")
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $sz i32) (local $b (ref $block))
-      (local.set $sz (i32.add (i31.get_s (ref.cast i31 (local.get $n)))
-                              (i32.const 1)))
-      (if (i32.lt_s (local.get $sz) (i32.const 1))
+      (local.set $sz (i31.get_s (ref.cast i31 (local.get $n))))
+      (if (i32.lt_s (local.get $sz) (i32.const 0))
          (then
             (call $caml_invalid_argument
                (array.new_data $string $Array_make
                                (i32.const 0) (i32.const 10)))))
-      (local.set $b (array.new $block (local.get $v) (local.get $sz)))
+      (local.set $b
+         (array.new $block (local.get $v)
+            (i32.add (local.get $sz) (i32.const 1))))
       ;; ZZZ float array
-      (array.set $block (local.get $b) (i32.const 0) (i31.new (i32.const 0)))
+      (array.set $block (local.get $b) (i32.const 0)
+         (i31.new
+            (select (global.get $double_array_tag) (i32.const 0)
+               (i32.and (local.get $sz) (ref.test $float (local.get $v))))))
       (local.get $b))
 
    (export "caml_make_float_vect" (func $caml_floatarray_create))
@@ -38,10 +43,14 @@
       (local.set $a1 (ref.cast $block (local.get $a)))
       (local.set $a2 (array.new $block (i31.new (i32.const 0))
                         (i32.add (local.get $len) (i32.const 1))))
-      (array.copy $block $block
-         (local.get $a2) (i32.const 1) (local.get $a1)
-         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
-         (local.get $len))
+      (array.set $block (local.get $a2) (i32.const 0)
+         (array.get $block (local.get $a1) (i32.const 0)))
+      (if (local.get $len)
+         (then
+            (array.copy $block $block
+               (local.get $a2) (i32.const 1) (local.get $a1)
+               (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
+               (local.get $len))))
       (local.get $a2))
 
    (func (export "caml_array_append")
@@ -56,6 +65,14 @@
          (array.new $block (i31.new (i32.const 0))
             (i32.sub (i32.add (local.get $l1) (local.get $l2)) (i32.const 1))))
       ;; ZZZ float array
+      (array.set $block (local.get $a) (i32.const 0)
+         (i31.new
+            (select (global.get $double_array_tag) (i32.const 0)
+               (i32.or
+                  (ref.eq (array.get $block (local.get $a1) (i32.const 0))
+                     (i31.new (global.get $double_array_tag)))
+                  (ref.eq (array.get $block (local.get $a2) (i32.const 0))
+                     (i31.new (global.get $double_array_tag)))))))
       (array.copy $block $block
          (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
          (i32.sub (local.get $l1) (i32.const 1)))
@@ -68,6 +85,7 @@
       ;; ZZZ float array
       (local $i i32) (local $len i32)
       (local $l (ref eq))
+      (local $isfloat i32)
       (local $a (ref $block)) (local $a' (ref $block)) (local $b (ref $block))
       (local.set $l (local.get 0))
       (local.set $len (i32.const 1))
@@ -81,10 +99,17 @@
                          (ref.cast $block
                             (array.get $block (local.get $b) (i32.const 1))))
                       (i32.const 1))))
+             (if (ref.eq (array.get $block (local.get $b) (i32.const 0))
+                    (i31.new (global.get $double_array_tag)))
+                 (then (local.set $isfloat (i32.const 1))))
              (local.set $l (array.get $block (local.get $b) (i32.const 2)))
              (br $compute_length))))
       (local.set $a
          (array.new $block (i31.new (i32.const 0)) (local.get $len)))
+      (if (local.get $isfloat)
+         (then
+            (array.set $block (local.get $a) (i32.const 0)
+               (i31.new (global.get $double_array_tag)))))
       (local.set $l (local.get 0))
       (local.set $i (i32.const 1))
       (loop $fill

From 70af9b16948e9e17b0ea1e92deec3359df298cb0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 26 Jun 2023 08:51:44 +0200
Subject: [PATCH 070/481] Runtime: bigarrays

---
 runtime/wasm/bigarray.wat  | 1246 ++++++++++++++++++++++++++++++++++--
 runtime/wasm/bigstring.wat |  218 +++++++
 runtime/wasm/fail.wat      |    7 +
 runtime/wasm/hash.wat      |   27 +-
 runtime/wasm/runtime.js    |   12 +-
 5 files changed, 1460 insertions(+), 50 deletions(-)
 create mode 100644 runtime/wasm/bigstring.wat

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 6a5c1f8140..766010899a 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -36,7 +36,17 @@
       (func $ta_set_i8 (param (ref extern)) (param i32) (param (ref i31))))
    (import "bindings" "ta_set_ui8"
       (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31))))
+   (import "bindings" "ta_fill"
+      (func $ta_fill_int (param (ref extern)) (param i32)))
+   (import "bindings" "ta_fill"
+      (func $ta_fill_float (param (ref extern)) (param f64)))
+   (import "bindings" "ta_blit"
+      (func $ta_blit (param (ref extern)) (param (ref extern))))
+   (import "bindings" "ta_subarray"
+      (func $ta_subarray
+         (param (ref extern)) (param i32) (param i32) (result (ref extern))))
    (import "fail" "caml_bound_error" (func $caml_bound_error))
+   (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
@@ -49,6 +59,14 @@
       (func $caml_copy_int64 (param i64) (result (ref eq))))
    (import "obj" "double_array_tag" (global $double_array_tag i32))
    (import "compare" "unordered" (global $unordered i32))
+   (import "hash" "caml_hash_mix_int"
+      (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
+   (import "hash" "caml_hash_mix_int64"
+      (func $caml_hash_mix_int64 (param i32) (param i64) (result i32)))
+   (import "hash" "caml_hash_mix_float"
+      (func $caml_hash_mix_float (param i32) (param f64) (result i32)))
+   (import "hash" "caml_hash_mix_float32"
+      (func $caml_hash_mix_float32 (param i32) (param f32) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -94,26 +112,240 @@
             (field $ba_layout i8)))) ;; layout
 
    (func $bigarray_hash (param (ref eq)) (result i32)
-      ;; ZZZ
-      (call $log_js (string.const "bigarray_hash"))
-      (i32.const 1))
+      (local $b (ref $bigarray))
+      (local $h i32) (local $len i32) (local $i i32) (local $w i32)
+      (local $data (ref extern))
+      (local.set $b (ref.cast $bigarray (local.get 0)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
+      (local.set $len (call $ta_length (local.get $data)))
+      (block $float32
+       (block $float64
+        (block $int8
+         (block $uint8
+          (block $int16
+           (block $uint16
+            (block $int32
+             (block $int64
+              (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                        $int32 $int64 $int32 $int32
+                        $float32 $float64 $uint8
+                 (struct.get $bigarray $ba_kind (local.get $b))))
+             ;; int64
+             (if (i32.gt_u (local.get $len) (i32.const 32))
+                (then (local.set $len (i32.const 32))))
+             (loop $loop
+                (if (i32.lt_u (local.get $i) (local.get $len))
+                   (then
+                      (local.set $h
+                         (call $caml_hash_mix_int64 (local.get $h)
+                            (i64.or
+                               (i64.extend_i32_u
+                                  (call $ta_get_i32 (local.get $data)
+                                     (local.get $i)))
+                               (i64.shl
+                                  (i64.extend_i32_u
+                                     (call $ta_get_i32 (local.get $data)
+                                        (i32.add (local.get $i) (i32.const 1))))
+                                  (i64.const 32)))))
+                      (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                      (br $loop))))
+             (return (local.get $h)))
+            ;; int32
+            (if (i32.gt_u (local.get $len) (i32.const 64))
+               (then (local.set $len (i32.const 64))))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (call $ta_get_i32 (local.get $data) (local.get $i))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (return (local.get $h)))
+           ;; uint16
+           (if (i32.gt_u (local.get $len) (i32.const 128))
+              (then (local.set $len (i32.const 182))))
+           (loop $loop
+              (if (i32.le_u (i32.add (local.get $i) (i32.const 2))
+                     (local.get $len))
+                 (then
+                    (local.set $h
+                       (call $caml_hash_mix_int
+                          (local.get $h)
+                          (i32.or
+                             (call $ta_get_ui16 (local.get $data) (local.get $i))
+                             (i32.shl (call $ta_get_ui16 (local.get $data)
+                                         (i32.add (local.get $i) (i32.const 1)))
+                                      (i32.const 16)))))
+                    (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                    (br $loop))))
+           (if (i32.and (local.get $len) (i32.const 1))
+              (then
+                 (local.set $h
+                    (call $caml_hash_mix_int (local.get $h)
+                       (call $ta_get_ui16 (local.get $data) (local.get $i))))))
+           (return (local.get $h)))
+          ;; int16
+          (if (i32.gt_u (local.get $len) (i32.const 128))
+             (then (local.set $len (i32.const 182))))
+          (loop $loop
+             (if (i32.le_u (i32.add (local.get $i) (i32.const 2))
+                    (local.get $len))
+                (then
+                   (local.set $h
+                      (call $caml_hash_mix_int
+                         (local.get $h)
+                         (i32.or
+                            (call $ta_get_i16 (local.get $data) (local.get $i))
+                            (i32.shl (call $ta_get_i16 (local.get $data)
+                                        (i32.add (local.get $i) (i32.const 1)))
+                                     (i32.const 16)))))
+                   (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                   (br $loop))))
+          (if (i32.and (local.get $len) (i32.const 1))
+             (then
+                (local.set $h
+                   (call $caml_hash_mix_int (local.get $h)
+                      (call $ta_get_i16 (local.get $data) (local.get $i))))))
+          (return (local.get $h)))
+         ;; uint8
+         (if (i32.gt_u (local.get $len) (i32.const 256))
+            (then (local.set $len (i32.const 256))))
+         (loop $loop
+            (if (i32.le_u (i32.add (local.get $i) (i32.const 4))
+                   (local.get $len))
+               (then
+                  (local.set $h
+                     (call $caml_hash_mix_int
+                        (local.get $h)
+                        (i32.or
+                           (i32.or
+                              (call $ta_get_ui8 (local.get $data) (local.get $i))
+                              (i32.shl (call $ta_get_ui8 (local.get $data)
+                                          (i32.add (local.get $i) (i32.const 1)))
+                                       (i32.const 8)))
+                           (i32.or
+                              (i32.shl (call $ta_get_ui8 (local.get $data)
+                                          (i32.add (local.get $i) (i32.const 2)))
+                                       (i32.const 16))
+                              (i32.shl (call $ta_get_ui8 (local.get $data)
+                                          (i32.add (local.get $i) (i32.const 3)))
+                                       (i32.const 24))))))
+                  (local.set $i (i32.add (local.get $i) (i32.const 4)))
+                  (br $loop))))
+         (local.set $w (i32.const 0))
+         (block $0_bytes
+            (block $1_byte
+               (block $2_bytes
+                  (block $3_bytes
+                     (br_table $0_bytes $1_byte $2_bytes $3_bytes
+                        (i32.and (local.get $len) (i32.const 3))))
+                  (local.set $w
+                     (i32.shl (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $i) (i32.const 2)))
+                              (i32.const 16))))
+               (local.set $w
+                  (i32.or (local.get $w)
+                     (i32.shl (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $i) (i32.const 1)))
+                              (i32.const 8)))))
+            (local.set $w
+               (i32.or (local.get $w)
+                  (call $ta_get_ui8 (local.get $data) (local.get $i))))
+            (local.set $h
+               (call $caml_hash_mix_int (local.get $h) (local.get $w))))
+         (return (local.get $h)))
+        ;; int8
+        (if (i32.gt_u (local.get $len) (i32.const 256))
+           (then (local.set $len (i32.const 256))))
+        (loop $loop
+           (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len))
+              (then
+                 (local.set $h
+                    (call $caml_hash_mix_int
+                       (local.get $h)
+                       (i32.or
+                          (i32.or
+                             (call $ta_get_i8 (local.get $data) (local.get $i))
+                             (i32.shl (call $ta_get_i8 (local.get $data)
+                                         (i32.add (local.get $i) (i32.const 1)))
+                                      (i32.const 8)))
+                          (i32.or
+                             (i32.shl (call $ta_get_i8 (local.get $data)
+                                         (i32.add (local.get $i) (i32.const 2)))
+                                      (i32.const 16))
+                             (i32.shl (call $ta_get_i8 (local.get $data)
+                                         (i32.add (local.get $i) (i32.const 3)))
+                                      (i32.const 24))))))
+                 (local.set $i (i32.add (local.get $i) (i32.const 4)))
+                 (br $loop))))
+        (local.set $w (i32.const 0))
+        (block $0_bytes
+           (block $1_byte
+              (block $2_bytes
+                 (block $3_bytes
+                    (br_table $0_bytes $1_byte $2_bytes $3_bytes
+                       (i32.and (local.get $len) (i32.const 3))))
+                 (local.set $w
+                    (i32.shl (call $ta_get_i8 (local.get $data)
+                                (i32.add (local.get $i) (i32.const 2)))
+                             (i32.const 16))))
+              (local.set $w
+                 (i32.or (local.get $w)
+                    (i32.shl (call $ta_get_i8 (local.get $data)
+                                (i32.add (local.get $i) (i32.const 1)))
+                             (i32.const 8)))))
+           (local.set $w
+              (i32.or (local.get $w)
+                 (call $ta_get_i8 (local.get $data) (local.get $i))))
+           (local.set $h
+              (call $caml_hash_mix_int (local.get $h) (local.get $w))))
+        (return (local.get $h)))
+       ;; float32
+       (if (i32.gt_u (local.get $len) (i32.const 64))
+          (then (local.set $len (i32.const 64))))
+       (loop $loop
+          (if (i32.lt_u (local.get $i) (local.get $len))
+             (then
+                (local.set $h
+                   (call $caml_hash_mix_float32 (local.get $h)
+                      (f32.demote_f64
+                         (call $ta_get_f32 (local.get $data) (local.get $i)))))
+                (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                (br $loop))))
+       (return (local.get $h)))
+      ;; float64
+      (if (i32.gt_u (local.get $len) (i32.const 32))
+         (then (local.set $len (i32.const 32))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (local.set $h
+                  (call $caml_hash_mix_float (local.get $h)
+                     (call $ta_get_f64 (local.get $data) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (return (local.get $h)))
 
    (func $caml_ba_get_size (param $dim (ref $int_array)) (result i32)
-      (local $i i32) (local $n i32) (local $sz i32)
+      (local $i i32) (local $n i32) (local $sz i64)
       (local.set $n (array.len (local.get $dim)))
       (local.set $i (i32.const 0))
-      (local.set $sz (i32.const 1))
+      (local.set $sz (i64.const 1))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $n))
             (then
-               ;; ZZZ Check for overflow
                (local.set $sz
-                   (i32.mul (local.get $sz)
-                      (array.get $int_array
-                         (local.get $dim) (local.get $i))))
+                   (i64.mul (local.get $sz)
+                      (i64.extend_i32_s
+                         (array.get $int_array
+                            (local.get $dim) (local.get $i)))))
+               (if (i64.ne (local.get $sz)
+                      (i64.extend_i32_s (i32.wrap_i64 (local.get $sz))))
+                  (then (call $caml_raise_out_of_memory)))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
-      (local.get $sz))
+      (i32.wrap_i64 (local.get $sz)))
 
   (func $caml_ba_size_per_element (param $kind i32) (result i32)
      (select (i32.const 2) (i32.const 1)
@@ -123,10 +355,14 @@
 
   (func $caml_ba_create_buffer
      (param $kind i32) (param $sz i32) (result (ref extern))
-     (return_call $ta_create (local.get $kind)
-        ;; ZZZ Check for overflow
-        (i32.mul (local.get $sz)
-           (call $caml_ba_size_per_element (local.get $kind)))))
+     (local $l i64)
+     (local.set $l
+        (i64.mul (i64.extend_i32_s (local.get $sz))
+           (i64.extend_i32_s
+              (call $caml_ba_size_per_element (local.get $kind)))))
+     (if (i64.ne (local.get $l) (i64.extend_i32_s (i32.wrap_i64 (local.get $l))))
+        (then (call $caml_raise_out_of_memory)))
+     (return_call $ta_create (local.get $kind) (i32.wrap_i64 (local.get $l))))
 
    (global $CAML_BA_MAX_NUM_DIMS i32 (i32.const 16))
 
@@ -209,12 +445,12 @@
    (func (export "caml_ba_to_typed_array") (param (ref eq)) (result (ref eq))
       (call $wrap
          (extern.internalize
-            (struct.get $bigarray 1 (ref.cast $bigarray (local.get 0))))))
+            (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get 0))))))
 
    (func $caml_ba_get_at_offset
       (param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
       (local $data (ref extern))
-      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (block $float32
        (block $float64
         (block $int8
@@ -223,14 +459,15 @@
            (block $uint16
             (block $int32
              (block $int64
-              (block $nativeint
-               (block $int
+              (block $int
+               (block $nativeint
                 (block $complex32
                  (block $complex64
                   (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
-                            $int32 $int64 $nativeint $int
+                            $int32 $int64 $int $nativeint
                             $complex32 $complex64 $uint8
-                     (struct.get $bigarray 4 (local.get $ba))))
+                     (struct.get $bigarray $ba_kind (local.get $ba))))
+                 ;; complex64
                  (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                  (return
                     (array.new_fixed $block
@@ -240,6 +477,7 @@
                        (struct.new $float
                           (call $ta_get_f64 (local.get $data)
                              (i32.add (local.get $i) (i32.const 1)))))))
+                ;; complex32
                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                 (return
                    (array.new_fixed $block
@@ -249,11 +487,14 @@
                       (struct.new $float
                          (call $ta_get_f32 (local.get $data)
                             (i32.add (local.get $i) (i32.const 1)))))))
-               (return
-                  (i31.new
-                     (call $ta_get_i32 (local.get $data) (local.get $i)))))
-              (return_call $caml_copy_nativeint
-                 (call $ta_get_i32 (local.get $data) (local.get $i))))
+               ;; nativeint
+               (return_call $caml_copy_nativeint
+                  (call $ta_get_i32 (local.get $data) (local.get $i))))
+              ;; int
+              (return
+                 (i31.new
+                    (call $ta_get_i32 (local.get $data) (local.get $i)))))
+             ;; int64
              (local.set $i (i32.shl (local.get $i) (i32.const 1)))
              (return_call $caml_copy_int64
                 (i64.or
@@ -264,18 +505,25 @@
                          (call $ta_get_i32 (local.get $data)
                             (i32.add (local.get $i) (i32.const 1))))
                       (i64.const 32)))))
+            ;; int32
             (return_call $caml_copy_int32
                (call $ta_get_i32 (local.get $data) (local.get $i))))
+           ;; uint16
            (return (i31.new
                       (call $ta_get_ui16 (local.get $data) (local.get $i)))))
+          ;; int16
           (return (i31.new
                      (call $ta_get_i16 (local.get $data) (local.get $i)))))
+         ;; uint8
          (return (i31.new
                     (call $ta_get_ui8 (local.get $data) (local.get $i)))))
+        ;; int8
         (return (i31.new
                    (call $ta_get_i8 (local.get $data) (local.get $i)))))
+       ;; float64
        (return (struct.new $float
                   (call $ta_get_f64 (local.get $data) (local.get $i)))))
+      ;; float32
       (return (struct.new $float
                  (call $ta_get_f32 (local.get $data) (local.get $i)))))
 
@@ -283,7 +531,7 @@
       (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq))
       (local $data (ref extern))
       (local $b (ref $block)) (local $l i64)
-      (local.set $data (struct.get $bigarray 1 (local.get $ba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (block $float32
        (block $float64
         (block $int8
@@ -292,14 +540,15 @@
            (block $uint16
             (block $int32
              (block $int64
-              (block $nativeint
-               (block $int
+              (block $int
+               (block $nativeint
                 (block $complex32
                  (block $complex64
                   (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
-                            $int32 $int64 $nativeint $int
+                            $int32 $int64 $int $nativeint
                             $complex32 $complex64 $uint8
-                     (struct.get $bigarray 4 (local.get $ba))))
+                     (struct.get $bigarray $ba_kind (local.get $ba))))
+                 ;; complex64
                  (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                  (local.set $b (ref.cast $block (local.get $v)))
                  (call $ta_set_f64 (local.get $data) (local.get $i)
@@ -312,6 +561,7 @@
                        (ref.cast $float
                          (array.get $block (local.get $b) (i32.const 2)))))
                  (return))
+                ;; complex32
                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                 (local.set $b (ref.cast $block (local.get $v)))
                 (call $ta_set_f32 (local.get $data) (local.get $i)
@@ -324,12 +574,15 @@
                       (ref.cast $float
                          (array.get $block (local.get $b) (i32.const 2)))))
                 (return))
+               ;; nativeint
                (call $ta_set_i32 (local.get $data) (local.get $i)
-                  (i31.get_s (ref.cast i31 (local.get $v))))
+                  (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
                (return))
+              ;; int
               (call $ta_set_i32 (local.get $data) (local.get $i)
-                 (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+                 (i31.get_s (ref.cast i31 (local.get $v))))
               (return))
+             ;; int64
              (local.set $i (i32.shl (local.get $i) (i32.const 1)))
              (local.set $l
                 (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
@@ -339,26 +592,33 @@
                 (i32.add (local.get $i) (i32.const 1))
                 (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32))))
              (return))
+            ;; int32
             (call $ta_set_i32 (local.get $data) (local.get $i)
                (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
             (return))
+           ;; uint16
            (call $ta_set_ui16 (local.get $data) (local.get $i)
               (ref.cast i31 (local.get $v)))
            (return))
+          ;; int16
           (call $ta_set_i16 (local.get $data) (local.get $i)
              (ref.cast i31 (local.get $v)))
           (return))
+         ;; uint8
          (call $ta_set_ui8 (local.get $data) (local.get $i)
             (ref.cast i31 (local.get $v)))
          (return))
+        ;; int8
         (call $ta_set_i8 (local.get $data) (local.get $i)
            (ref.cast i31 (local.get $v)))
         (return))
+       ;; float64
        (call $ta_set_f64 (local.get $data) (local.get $i)
-          (struct.get $float 0 (ref.cast $float (local.get 0))))
+          (struct.get $float 0 (ref.cast $float (local.get $v))))
        (return))
+      ;; float32
       (call $ta_set_f32 (local.get $data) (local.get $i)
-         (struct.get $float 0 (ref.cast $float (local.get 0))))
+         (struct.get $float 0 (ref.cast $float (local.get $v))))
       (return))
 
    (data $Bigarray_dim "Bigarray.dim")
@@ -368,7 +628,7 @@
       (local $dim (ref $int_array))
       (local $i i32)
       (local.set $dim
-         (struct.get $bigarray 2 (ref.cast $bigarray (local.get 0))))
+         (struct.get $bigarray $ba_dim (ref.cast $bigarray (local.get 0))))
       (local.set $i (i31.get_s (ref.cast i31 (local.get 1))))
       (if (i32.ge_u (local.get $i) (array.len (local.get $dim)))
          (then (call $caml_invalid_argument
@@ -376,8 +636,7 @@
                      (i32.const 0) (i32.const 12)))))
       (i31.new (array.get $int_array (local.get $dim) (local.get $i))))
 
-   (func (export "caml_ba_dim_1")
-      (param (ref eq)) (result (ref eq))
+   (func (export "caml_ba_dim_1") (param (ref eq)) (result (ref eq))
       (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 0))))
 
    (func (export "caml_ba_get_1")
@@ -386,7 +645,7 @@
       (local $i i32)
       (local.set $ba (ref.cast $bigarray (local.get 0)))
       (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
-      (if (struct.get $bigarray 5 (local.get $ba))
+      (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
       (if (i32.ge_u (local.get $i)
              (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
@@ -400,16 +659,723 @@
       (local $i i32)
       (local.set $ba (ref.cast $bigarray (local.get 0)))
       (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
-      (if (struct.get $bigarray 5 (local.get $ba))
+      (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
       (if (i32.ge_u (local.get $i)
-             (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
+             (array.get $int_array (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (call $caml_bound_error))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $i) (local.get $v))
       (i31.new (i32.const 0)))
 
+   (func (export "caml_ba_get_2")
+      (param $vba (ref eq)) (param $vi (ref eq)) (param $vj (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local $j i32)
+      (local $offset i32)
+      (local $dim (ref $int_array))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
+      (if (struct.get $bigarray $ba_layout (local.get $ba))
+         (then
+            (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+            (local.set $j (i32.sub (local.get $j) (i32.const 1)))
+            (local.set $offset
+               (i32.add
+                  (i32.mul (local.get $j)
+                     (array.get $int_array (local.get $dim) (i32.const 0)))
+                  (local.get $i))))
+         (else
+            (local.set $offset
+               (i32.add
+                  (i32.mul (local.get $i)
+                     (array.get $int_array (local.get $dim) (i32.const 1)))
+                  (local.get $j)))))
+      (if (i32.or
+             (i32.ge_u (local.get $i)
+                (array.get $int_array (local.get $dim) (i32.const 0)))
+             (i32.ge_u (local.get $j)
+                (array.get $int_array (local.get $dim) (i32.const 1))))
+         (then
+            (call $caml_bound_error)))
+      (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $offset)))
+
+   (func (export "caml_ba_set_2")
+      (param $vba (ref eq)) (param $vi (ref eq)) (param $vj (ref eq))
+      (param $v (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local $j i32)
+      (local $offset i32)
+      (local $dim (ref $int_array))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
+      (if (struct.get $bigarray $ba_layout (local.get $ba))
+         (then
+            (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+            (local.set $j (i32.sub (local.get $j) (i32.const 1)))
+            (local.set $offset
+               (i32.add
+                  (i32.mul (local.get $j)
+                     (array.get $int_array (local.get $dim) (i32.const 0)))
+                  (local.get $i))))
+         (else
+            (local.set $offset
+               (i32.add
+                  (i32.mul (local.get $i)
+                     (array.get $int_array (local.get $dim) (i32.const 1)))
+                  (local.get $j)))))
+      (if (i32.or
+             (i32.ge_u (local.get $i)
+                (array.get $int_array (local.get $dim) (i32.const 0)))
+             (i32.ge_u (local.get $j)
+                (array.get $int_array (local.get $dim) (i32.const 1))))
+         (then
+            (call $caml_bound_error)))
+      (call $caml_ba_set_at_offset
+         (local.get $ba) (local.get $offset) (local.get $v))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ba_dim_2") (param (ref eq)) (result (ref eq))
+      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 1))))
+
+   (func (export "caml_ba_get_3")
+      (param $vba (ref eq)) (param $vi (ref eq)) (param $vj (ref eq))
+      (param $vk (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local $j i32)
+      (local $k i32)
+      (local $offset i32)
+      (local $dim (ref $int_array))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
+      (local.set $k (i31.get_u (ref.cast i31 (local.get $vk))))
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
+      (if (struct.get $bigarray $ba_layout (local.get $ba))
+         (then
+            (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+            (local.set $j (i32.sub (local.get $j) (i32.const 1)))
+            (local.set $k (i32.sub (local.get $k) (i32.const 1)))
+            (local.set $offset
+               (i32.add
+                  (i32.mul
+                     (i32.add
+                        (i32.mul
+                           (local.get $k)
+                           (array.get $int_array (local.get $dim) (i32.const 1)))
+                        (local.get $j))
+                     (array.get $int_array (local.get $dim) (i32.const 0)))
+                  (local.get $i))))
+         (else
+            (local.set $offset
+               (i32.add
+                  (i32.mul
+                     (i32.add
+                        (i32.mul
+                           (local.get $i)
+                           (array.get $int_array (local.get $dim) (i32.const 1)))
+                     (local.get $j))
+                     (array.get $int_array (local.get $dim) (i32.const 2)))
+                  (local.get $k)))))
+      (if (i32.or
+             (i32.ge_u (local.get $i)
+                (array.get $int_array (local.get $dim) (i32.const 0)))
+             (i32.or
+                (i32.ge_u (local.get $j)
+                   (array.get $int_array (local.get $dim) (i32.const 1)))
+                (i32.ge_u (local.get $j)
+                   (array.get $int_array (local.get $dim) (i32.const 2)))))
+         (then
+            (call $caml_bound_error)))
+      (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $offset)))
+
+   (func (export "caml_ba_set_3")
+      (param $vba (ref eq)) (param $vi (ref eq)) (param $vj (ref eq))
+      (param $vk (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $i i32)
+      (local $j i32)
+      (local $k i32)
+      (local $offset i32)
+      (local $dim (ref $int_array))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
+      (local.set $k (i31.get_u (ref.cast i31 (local.get $vk))))
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
+      (if (struct.get $bigarray $ba_layout (local.get $ba))
+         (then
+            (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+            (local.set $j (i32.sub (local.get $j) (i32.const 1)))
+            (local.set $k (i32.sub (local.get $k) (i32.const 1)))
+            (local.set $offset
+               (i32.add
+                  (i32.mul
+                     (i32.add
+                        (i32.mul
+                           (local.get $k)
+                           (array.get $int_array (local.get $dim) (i32.const 1)))
+                        (local.get $j))
+                     (array.get $int_array (local.get $dim) (i32.const 0)))
+                  (local.get $i))))
+         (else
+            (local.set $offset
+               (i32.add
+                  (i32.mul
+                     (i32.add
+                        (i32.mul
+                           (local.get $i)
+                           (array.get $int_array (local.get $dim) (i32.const 1)))
+                     (local.get $j))
+                     (array.get $int_array (local.get $dim) (i32.const 2)))
+                  (local.get $k)))))
+      (if (i32.or
+             (i32.ge_u (local.get $i)
+                (array.get $int_array (local.get $dim) (i32.const 0)))
+             (i32.or
+                (i32.ge_u (local.get $j)
+                   (array.get $int_array (local.get $dim) (i32.const 1)))
+                (i32.ge_u (local.get $k)
+                   (array.get $int_array (local.get $dim) (i32.const 2)))))
+         (then
+            (call $caml_bound_error)))
+      (call $caml_ba_set_at_offset
+         (local.get $ba) (local.get $offset) (local.get $v))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ba_dim_3") (param (ref eq)) (result (ref eq))
+      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 2))))
+
+   (func $caml_ba_offset
+      (param $b (ref $bigarray)) (param $index (ref $int_array)) (result i32)
+      (local $dim (ref $int_array))
+      (local $num_dims i32) (local $idx i32)
+      (local $offset i32) (local $i i32) (local $l i32)
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $b)))
+      (if (struct.get $bigarray $ba_layout (local.get $b))
+         (then
+            (local.set $i
+               (i32.sub (struct.get $bigarray $ba_num_dims (local.get $b))
+                  (i32.const 1)))
+            (loop $loop
+               (if (i32.ge_s (local.get $i) (i32.const 0))
+                  (then
+                     (local.set $idx
+                        (i32.sub
+                           (array.get $int_array (local.get $index)
+                              (local.get $i))
+                           (i32.const 1)))
+                     (local.set $l
+                        (array.get $int_array (local.get $dim) (local.get $i)))
+                     (if (i32.ge_u (local.get $idx) (local.get $l))
+                        (then
+                           (call $caml_bound_error)))
+                     (local.set $offset
+                        (i32.add (i32.mul (local.get $offset) (local.get $l))
+                           (local.get $idx)))
+                     (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+                     (br $loop)))))
+         (else
+            (local.set $num_dims
+               (struct.get $bigarray $ba_num_dims (local.get $b)))
+            (loop $loop
+               (if (i32.lt_s (local.get $i) (local.get $num_dims))
+                  (then
+                     (local.set $idx
+                        (array.get $int_array (local.get $index) (local.get $i)))
+                     (local.set $l
+                        (array.get $int_array (local.get $dim) (local.get $i)))
+                     (if (i32.ge_u (local.get $idx) (local.get $l))
+                        (then
+                           (call $caml_bound_error)))
+                     (local.set $offset
+                        (i32.add (i32.mul (local.get $offset) (local.get $l))
+                           (local.get $idx)))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))))
+      (local.get $offset))
+
+   (func $caml_ba_offset'
+      (param $b (ref $bigarray)) (param $index (ref $block)) (result i32)
+      (local $dim (ref $int_array))
+      (local $num_dims i32) (local $idx i32)
+      (local $offset i32) (local $i i32) (local $l i32)
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $b)))
+      (if (struct.get $bigarray $ba_layout (local.get $b))
+         (then
+            (local.set $i
+               (i32.sub (struct.get $bigarray $ba_num_dims (local.get $b))
+                  (i32.const 1)))
+            (loop $loop
+               (if (i32.ge_s (local.get $i) (i32.const 0))
+                  (then
+                     (local.set $idx
+                        (i32.sub
+                           (i31.get_s
+                              (ref.cast i31
+                                 (array.get $block (local.get $index)
+                                    (i32.add (local.get $i) (i32.const 1)))))
+                           (i32.const 1)))
+                     (local.set $l
+                        (array.get $int_array (local.get $dim) (local.get $i)))
+                     (if (i32.ge_u (local.get $idx) (local.get $l))
+                        (then
+                           (call $caml_bound_error)))
+                     (local.set $offset
+                        (i32.add (i32.mul (local.get $offset) (local.get $l))
+                           (local.get $idx)))
+                     (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+                     (br $loop)))))
+         (else
+            (local.set $num_dims
+               (struct.get $bigarray $ba_num_dims (local.get $b)))
+            (loop $loop
+               (if (i32.lt_s (local.get $i) (local.get $num_dims))
+                  (then
+                     (local.set $idx
+                        (i31.get_s
+                           (ref.cast i31
+                              (array.get $block (local.get $index)
+                                 (i32.add (local.get $i) (i32.const 1))))))
+                     (local.set $l
+                        (array.get $int_array (local.get $dim) (local.get $i)))
+                     (if (i32.ge_u (local.get $idx) (local.get $l))
+                        (then
+                           (call $caml_bound_error)))
+                     (local.set $offset
+                        (i32.add (i32.mul (local.get $offset) (local.get $l))
+                           (local.get $idx)))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))))
+      (local.get $offset))
+
+   (func (export "caml_ba_get_generic")
+      (param $vba (ref eq)) (param $index (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (return_call $caml_ba_get_at_offset (local.get $ba)
+         (call $caml_ba_offset' (local.get $ba)
+            (ref.cast $block (local.get $index)))))
+
+   (func (export "caml_ba_set_generic")
+      (param $vba (ref eq)) (param $index (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (call $caml_ba_set_at_offset (local.get $ba)
+         (call $caml_ba_offset' (local.get $ba)
+            (ref.cast $block (local.get $index)))
+         (local.get $v))
+      (i31.new (i32.const 0)))
+
+   (data $too_many_indices "Bigarray.slice: too many indices")
+
+   (func (export "caml_ba_slice")
+      (param $vb (ref eq)) (param $vind (ref eq)) (result (ref eq))
+      (local $b (ref $bigarray))
+      (local $ind (ref $block))
+      (local $index (ref $int_array)) (local $sub_dim (ref $int_array))
+      (local $num_inds i32) (local $num_dims i32) (local $i i32)
+      (local $idx i32) (local $mul i32) (local $offset i32) (local $size i32)
+      (local $sub_data (ref extern))
+      (local.set $b (ref.cast $bigarray (local.get $vb)))
+      (local.set $ind (ref.cast $block (local.get $vind)))
+      (local.set $num_inds (i32.sub (array.len (local.get $ind)) (i32.const 1)))
+      (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $b)))
+      (if (i32.gt_u (local.get $num_inds)
+             (struct.get $bigarray $ba_num_dims (local.get $b)))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $too_many_indices
+                  (i32.const 0) (i32.const 32)))))
+      (local.set $sub_dim
+         (array.new $int_array (i32.const 0)
+            (i32.sub (local.get $num_dims) (local.get $num_inds))))
+      (if (struct.get $bigarray $ba_layout (local.get $b))
+         (then
+            (local.set $index
+               (array.new $int_array (i32.const 1) (local.get $num_dims)))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $num_inds))
+                  (then
+                     (array.set $int_array (local.get $index)
+                        (i32.sub (i32.add (local.get $num_dims) (local.get $i))
+                           (local.get $num_inds))
+                        (i31.get_u
+                           (ref.cast i31
+                              (array.get $block (local.get $ind)
+                                 (i32.add (local.get $i) (i32.const 1))))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (local.set $offset
+               (call $caml_ba_offset (local.get $b) (local.get $index)))
+            (array.copy $int_array $int_array
+               (local.get $sub_dim) (i32.const 0)
+               (struct.get $bigarray $ba_dim (local.get $b)) (i32.const 0)
+               (i32.sub (local.get $num_dims) (local.get $num_inds))))
+         (else
+            (local.set $index
+               (array.new $int_array (i32.const 0) (local.get $num_dims)))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $num_inds))
+                  (then
+                     (array.set $int_array (local.get $index)
+                        (local.get $i)
+                        (i31.get_u
+                           (ref.cast i31
+                              (array.get $block (local.get $ind)
+                                 (i32.add (local.get $i) (i32.const 1))))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (local.set $offset
+               (call $caml_ba_offset (local.get $b) (local.get $index)))
+            (array.copy $int_array $int_array
+               (local.get $sub_dim) (i32.const 0)
+               (struct.get $bigarray $ba_dim (local.get $b))
+               (local.get $num_inds)
+               (i32.sub (local.get $num_dims) (local.get $num_inds)))))
+      (local.set $mul
+         (call $caml_ba_size_per_element
+            (struct.get $bigarray $ba_kind (local.get $b))))
+      (local.set $size (call $caml_ba_get_size (local.get $sub_dim)))
+      (local.set $sub_data
+         (call $ta_subarray (struct.get $bigarray $ba_data (local.get $b))
+            (i32.mul (local.get $offset) (local.get $mul))
+            (i32.mul (i32.add (local.get $offset) (local.get $size))
+               (local.get $mul))))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (local.get $sub_data)
+         (local.get $sub_dim)
+         (array.len (local.get $sub_dim))
+         (struct.get $bigarray $ba_kind (local.get $b))
+         (struct.get $bigarray $ba_layout (local.get $b))))
+
+   (data $bad_subarray "Bigarray.sub: bad sub-array")
+
+   (func (export "caml_ba_sub")
+      (param $vba (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $ofs i32) (local $len i32)
+      (local $changed_dim i32) (local $mul i32) (local $i i32)
+      (local $num_dims i32)
+      (local $dim (ref $int_array)) (local $new_dim (ref $int_array))
+      (local $new_data (ref extern))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ofs (i31.get_s (ref.cast i31 (local.get $vofs))))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $ba)))
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
+      (local.set $mul (i32.const 1))
+      (if (struct.get $bigarray $ba_layout (local.get $ba))
+         (then
+            (local.set $changed_dim
+               (i32.sub (local.get $num_dims) (i32.const 1)))
+            (local.set $ofs (i32.sub (local.get $ofs) (i32.const 1)))
+            (local.set $i (i32.const 0))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $changed_dim))
+                  (then
+                     (local.set $mul
+                        (i32.mul (local.get $mul)
+                           (array.get $int_array
+                              (local.get $dim) (local.get $i))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop)))))
+         (else
+            (local.set $changed_dim (i32.const 0))
+            (local.set $i (i32.const 1))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $num_dims))
+                  (then
+                     (local.set $mul
+                        (i32.mul (local.get $mul)
+                           (array.get $int_array
+                              (local.get $dim) (local.get $i))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))))
+      (if (i32.or
+             (i32.or (i32.lt_s (local.get $ofs) (i32.const 0))
+                (i32.lt_s (local.get $len) (i32.const 0)))
+             (i32.gt_s (i32.add (local.get $ofs) (local.get $len))
+                (array.get $int_array (local.get $dim)
+                   (local.get $changed_dim))))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $bad_subarray
+                  (i32.const 0) (i32.const 27)))))
+      (local.set $new_dim
+         (array.new $int_array (i32.const 0) (local.get $num_dims)))
+      (array.copy $int_array $int_array
+         (local.get $new_dim) (i32.const 0)
+         (local.get $dim) (i32.const 0)
+         (local.get $num_dims))
+      (array.set $int_array (local.get $new_dim) (local.get $changed_dim)
+         (local.get $len))
+      (local.set $mul (i32.mul (local.get $mul)
+         (call $caml_ba_size_per_element
+           (struct.get $bigarray $ba_kind (local.get $ba)))))
+      (local.set $new_data
+         (call $ta_subarray (struct.get $bigarray $ba_data (local.get $ba))
+            (i32.mul (local.get $ofs) (local.get $mul))
+            (i32.mul (i32.add (local.get $ofs) (local.get $len))
+               (local.get $mul))))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (local.get $new_data)
+         (local.get $new_dim)
+         (local.get $num_dims)
+         (struct.get $bigarray $ba_kind (local.get $ba))
+         (struct.get $bigarray $ba_layout (local.get $ba))))
+
+   (func (export "caml_ba_fill")
+      (param $vba (ref eq)) (param $v (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $data (ref extern))
+      (local $l i64)
+      (local $i i32) (local $len i32) (local $i1 i32) (local $i2 i32)
+      (local $f1 f64) (local $f2 f64)
+      (local $b (ref $block))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
+      (block $float
+       (block $int
+        (block $int32
+         (block $int64
+          (block $complex32
+           (block $complex64
+            (br_table $float $float $int $int $int $int $int32 $int64 $int
+               $int32 $complex32 $complex64 $int
+               (struct.get $bigarray $ba_kind (local.get $ba))))
+            ;; complex64
+            (local.set $len (call $ta_length (local.get $data)))
+            (local.set $b (ref.cast $block (local.get $v)))
+            (local.set $f1
+               (struct.get $float 0
+                  (ref.cast $float
+                     (array.get $block (local.get $b) (i32.const 1)))))
+            (local.set $f2
+               (struct.get $float 0
+                  (ref.cast $float
+                     (array.get $block (local.get $b) (i32.const 2)))))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (call $ta_set_f64 (local.get $data) (local.get $i)
+                        (local.get $f1))
+                     (call $ta_set_f64 (local.get $data)
+                        (i32.add (local.get $i) (i32.const 1))
+                        (local.get $f2))
+                     (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                     (br $loop))))
+            (return (i31.new (i32.const 0))))
+           ;; complex32
+           (local.set $len (call $ta_length (local.get $data)))
+           (local.set $b (ref.cast $block (local.get $v)))
+           (local.set $f1
+              (struct.get $float 0
+                 (ref.cast $float
+                    (array.get $block (local.get $b) (i32.const 1)))))
+           (local.set $f2
+              (struct.get $float 0
+                 (ref.cast $float
+                    (array.get $block (local.get $b) (i32.const 2)))))
+           (loop $loop
+              (if (i32.lt_u (local.get $i) (local.get $len))
+                 (then
+                    (call $ta_set_f32 (local.get $data) (local.get $i)
+                       (local.get $f1))
+                    (call $ta_set_f32 (local.get $data)
+                       (i32.add (local.get $i) (i32.const 1))
+                       (local.get $f2))
+                    (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                    (br $loop))))
+           (return (i31.new (i32.const 0))))
+          ;; int64
+          (local.set $len (call $ta_length (local.get $data)))
+          (local.set $l
+             (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+          (local.set $i1 (i32.wrap_i64 (local.get $l)))
+          (local.set $i2
+             (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32))))
+          (loop $loop
+             (if (i32.lt_u (local.get $i) (local.get $len))
+                (then
+                   (call $ta_set_i32 (local.get $data) (local.get $i)
+                      (local.get $i1))
+                   (call $ta_set_i32 (local.get $data)
+                      (i32.add (local.get $i) (i32.const 1))
+                      (local.get $i2))
+                   (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                   (br $loop))))
+          (return (i31.new (i32.const 0))))
+         ;; int32
+         (call $ta_fill_int (local.get $data)
+            (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+         (return (i31.new (i32.const 0))))
+        ;; int
+        (call $ta_fill_int (local.get $data)
+           (i31.get_s (ref.cast i31 (local.get $v))))
+        (return (i31.new (i32.const 0))))
+       ;; float
+       (call $ta_fill_float (local.get $data)
+          (struct.get $float 0 (ref.cast $float (local.get $v))))
+       (return (i31.new (i32.const 0))))
+
+   (data $dim_mismatch "Bigarray.blit: dimension mismatch")
+
+   (func (export "caml_ba_blit")
+      (param $vsrc (ref eq)) (param $vdst (ref eq)) (result (ref eq))
+      (local $src (ref $bigarray))
+      (local $dst (ref $bigarray))
+      (local $sdim (ref $int_array))
+      (local $ddim (ref $int_array))
+      (local $i i32) (local $len i32)
+      (local.set $src (ref.cast $bigarray (local.get $vsrc)))
+      (local.set $dst (ref.cast $bigarray (local.get $vdst)))
+      (local.set $len (struct.get $bigarray $ba_num_dims (local.get $dst)))
+      (if (i32.ne (local.get $len)
+             (struct.get $bigarray $ba_num_dims (local.get $src)))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $dim_mismatch
+                  (i32.const 0) (i32.const 33)))))
+      (local.set $sdim (struct.get $bigarray $ba_dim (local.get $src)))
+      (local.set $ddim (struct.get $bigarray $ba_dim (local.get $dst)))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (if (i32.ne (array.get $int_array (local.get $sdim) (local.get $i))
+                        (array.get $int_array (local.get $ddim) (local.get $i)))
+               (then
+                  (call $caml_invalid_argument
+                     (array.new_data $string $dim_mismatch
+                        (i32.const 0) (i32.const 33)))))
+            (local.set $i (i32.add (local.get $i) (i32.const 1)))
+            (br $loop)))
+      (call $ta_blit
+         (struct.get $bigarray $ba_data (local.get $src))
+         (struct.get $bigarray $ba_data (local.get $dst)))
+     (i31.new (i32.const 0)))
+
+   (data $bad_number_dim "Bigarray.reshape: bad number of dimensions")
+   (data $negative_dim "Bigarray.reshape: negative dimension")
+   (data $size_mismatch "Bigarray.reshape: size mismatch")
+
+   (func (export "caml_ba_reshape")
+      (param $vb (ref eq)) (param $vd (ref eq)) (result (ref eq))
+      (local $vdim (ref $block))
+      (local $num_dims i32) (local $num_elts i64) (local $i i32) (local $d i32)
+      (local $b (ref $bigarray))
+      (local $dim (ref $int_array))
+      (local.set $vdim (ref.cast $block (local.get $vd)))
+      (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1)))
+      (local.set $b (ref.cast $bigarray (local.get $vb)))
+      (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $bad_number_dim
+                  (i32.const 0) (i32.const 42)))))
+      (local.set $num_elts (i64.const 1))
+      (local.set $dim (array.new $int_array (i32.const 0) (local.get $num_dims)))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $num_dims))
+            (then
+               (local.set $d
+                  (i31.get_s
+                     (ref.cast i31
+                        (array.get $block (local.get $vdim)
+                           (i32.add (local.get $i) (i32.const 1))))))
+               (if (i32.lt_s (local.get $d) (i32.const 0))
+                  (then
+                     (call $caml_invalid_argument
+                        (array.new_data $string $negative_dim
+                           (i32.const 0) (i32.const 36)))))
+               (array.set $int_array (local.get $dim) (local.get $i)
+                  (local.get $d))
+               (local.set $num_elts
+                  (i64.mul (local.get $num_elts)
+                     (i64.extend_i32_s (local.get $d))))
+               (if (i64.ne (local.get $num_elts)
+                      (i64.extend_i32_s (i32.wrap_i64 (local.get $num_elts))))
+                  (then (call $caml_raise_out_of_memory)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (if (i32.ne (i32.wrap_i64 (local.get $num_elts))
+             (call $caml_ba_get_size
+                (struct.get $bigarray $ba_dim (local.get $b))))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $size_mismatch
+                  (i32.const 0) (i32.const 31)))))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (struct.get $bigarray $ba_data (local.get $b))
+         (local.get $dim)
+         (local.get $num_dims)
+         (struct.get $bigarray $ba_kind (local.get $b))
+         (struct.get $bigarray $ba_layout (local.get $b))))
+
+   (func (export "caml_ba_change_layout")
+      (param $vb (ref eq)) (param $vlayout (ref eq)) (result (ref eq))
+      (local $b (ref $bigarray))
+      (local $layout i32) (local $num_dims i32) (local $i i32)
+      (local $dim (ref $int_array)) (local $new_dim (ref $int_array))
+      (local.set $b (ref.cast $bigarray (local.get $vb)))
+      (local.set $layout (i31.get_s (ref.cast i31 (local.get $vlayout))))
+      (if (result (ref eq))
+          (i32.ne (struct.get $bigarray $ba_layout (local.get $b))
+             (local.get $layout))
+         (then
+            (local.set $num_dims
+               (struct.get $bigarray $ba_num_dims (local.get $b)))
+            (local.set $dim
+               (struct.get $bigarray $ba_dim (local.get $b)))
+            (local.set $new_dim
+               (array.new $int_array (i32.const 0) (local.get $num_dims)))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $num_dims))
+                  (then
+                     (array.set $int_array (local.get $new_dim) (local.get $i)
+                        (array.get $int_array (local.get $dim)
+                           (i32.sub
+                              (i32.sub (local.get $num_dims) (local.get $i))
+                              (i32.const 1))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (struct.new $bigarray
+               (global.get $bigarray_ops)
+               (struct.get $bigarray $ba_data (local.get $b))
+               (local.get $new_dim)
+               (local.get $num_dims)
+               (struct.get $bigarray $ba_kind (local.get $b))
+               (local.get $layout)))
+         (else
+            (local.get $vb))))
+
+   (func (export "caml_ba_num_dims") (param (ref eq)) (result (ref eq))
+      (i31.new
+         (struct.get $bigarray $ba_num_dims (ref.cast $bigarray (local.get 0)))))
+
+   (func (export "caml_ba_kind") (param (ref eq)) (result (ref eq))
+      (i31.new
+         (struct.get $bigarray $ba_kind (ref.cast $bigarray (local.get 0)))))
+
+   (func (export "caml_ba_layout") (param (ref eq)) (result (ref eq))
+      (i31.new
+         (struct.get $bigarray $ba_layout (ref.cast $bigarray (local.get 0)))))
+
    (func $caml_ba_compare
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32)
       (local $b1 (ref $bigarray)) (local $b2 (ref $bigarray))
@@ -617,6 +1583,206 @@
                (br $loop))))
       (return (i32.const 0)))
 
+   (func (export "caml_ba_uint8_get16")
+      (param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $data (ref extern))
+      (local $p i32)
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
+             (array.get $int_array
+                (struct.get $bigarray $ba_dim (local.get $ba))
+                (i32.const 0)))
+         (then (call $caml_bound_error)))
+      (i31.new (i32.or
+                  (call $ta_get_ui8 (local.get $data) (local.get $p))
+                  (i32.shl (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 1)))
+                           (i32.const 8)))))
+
+   (func (export "caml_ba_uint8_get32")
+      (param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $data (ref extern))
+      (local $p i32)
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+             (array.get $int_array
+                (struct.get $bigarray $ba_dim (local.get $ba))
+                (i32.const 0)))
+         (then (call $caml_bound_error)))
+      (return_call $caml_copy_int32
+         (i32.or
+            (i32.or
+               (call $ta_get_ui8 (local.get $data) (local.get $p))
+               (i32.shl (call $ta_get_ui8 (local.get $data)
+                           (i32.add (local.get $p) (i32.const 1)))
+                        (i32.const 8)))
+            (i32.or
+               (i32.shl (call $ta_get_ui8 (local.get $data)
+                           (i32.add (local.get $p) (i32.const 2)))
+                        (i32.const 16))
+               (i32.shl (call $ta_get_ui8 (local.get $data)
+                           (i32.add (local.get $p) (i32.const 3)))
+                        (i32.const 24))))))
+
+   (func (export "caml_ba_uint8_get64")
+      (param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $data (ref extern))
+      (local $p i32)
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
+             (array.get $int_array
+                (struct.get $bigarray $ba_dim (local.get $ba))
+                (i32.const 0)))
+         (then (call $caml_bound_error)))
+      (return_call $caml_copy_int64
+         (i64.or
+            (i64.or
+               (i64.or
+                  (i64.extend_i32_u
+                     (call $ta_get_ui8 (local.get $data) (local.get $p)))
+                  (i64.shl (i64.extend_i32_u
+                              (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $p) (i32.const 1))))
+                           (i64.const 8)))
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $p) (i32.const 2))))
+                           (i64.const 16))
+                  (i64.shl (i64.extend_i32_u
+                              (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $p) (i32.const 3))))
+                           (i64.const 24))))
+            (i64.or
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $p) (i32.const 4))))
+                           (i64.const 32))
+                  (i64.shl (i64.extend_i32_u
+                              (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $p) (i32.const 5))))
+                           (i64.const 40)))
+               (i64.or
+                  (i64.shl (i64.extend_i32_u
+                              (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $p) (i32.const 6))))
+                           (i64.const 48))
+                  (i64.shl (i64.extend_i32_u
+                              (call $ta_get_ui8 (local.get $data)
+                                 (i32.add (local.get $p) (i32.const 7))))
+                           (i64.const 56)))))))
+
+   (func (export "caml_ba_uint8_set16")
+      (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $data (ref extern))
+      (local $p i32) (local $d (ref i31))
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $d (ref.cast i31 (local.get $v)))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
+             (array.get $int_array
+                (struct.get $bigarray $ba_dim (local.get $ba))
+                (i32.const 0)))
+         (then (call $caml_bound_error)))
+      (call $ta_set_ui8 (local.get $data) (local.get $p) (local.get $d))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 1))
+         (i31.new (i32.shr_u (i31.get_s (local.get $d)) (i32.const 8))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ba_uint8_set32")
+      (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $data (ref extern))
+      (local $p i32) (local $d i32)
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $d (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
+             (array.get $int_array
+                (struct.get $bigarray $ba_dim (local.get $ba))
+                (i32.const 0)))
+         (then (call $caml_bound_error)))
+      (call $ta_set_ui8 (local.get $data) (local.get $p)
+         (i31.new (local.get $d)))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 1))
+         (i31.new (i32.shr_u (local.get $d) (i32.const 8))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 2))
+         (i31.new (i32.shr_u (local.get $d) (i32.const 16))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 3))
+         (i31.new (i32.shr_u (local.get $d) (i32.const 24))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ba_uint8_set64")
+      (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (local $ba (ref $bigarray))
+      (local $data (ref extern))
+      (local $p i32) (local $d i64)
+      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
+      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $d (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+      (if (i32.lt_s (local.get $p) (i32.const 0))
+         (then (call $caml_bound_error)))
+      (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
+             (array.get $int_array
+                (struct.get $bigarray $ba_dim (local.get $ba))
+                (i32.const 0)))
+         (then (call $caml_bound_error)))
+      (call $ta_set_ui8 (local.get $data) (local.get $p)
+         (i31.new (i32.wrap_i64 (local.get $d))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 1))
+         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 8)))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 2))
+         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 16)))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 3))
+         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 24)))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 4))
+         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 5))
+         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 40)))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 6))
+         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 48)))))
+      (call $ta_set_ui8 (local.get $data)
+         (i32.add (local.get $p) (i32.const 7))
+         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 56)))))
+      (i31.new (i32.const 0)))
+
    (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
       ;; used to convert a typed array to a string
       (local $a (ref extern)) (local $len i32) (local $i i32)
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
new file mode 100644
index 0000000000..96f0616db3
--- /dev/null
+++ b/runtime/wasm/bigstring.wat
@@ -0,0 +1,218 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "caml_js_get"
+      (func $caml_js_get (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "bigarray" "caml_ba_to_typed_array"
+     (func $caml_ba_to_typed_array (param (ref eq)) (result (ref eq))))
+   (import "bigarray" "caml_ba_from_typed_array"
+      (func $caml_ba_from_typed_array (param (ref eq)) (result (ref eq))))
+   (import "bindings" "ta_create"
+      (func $ta_create (param i32) (param anyref) (result anyref)))
+   (import "bindings" "ta_get_ui8"
+      (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32)))
+   (import "bindings" "ta_set_ui8"
+      (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31))))
+   (import "bindings" "ta_subarray"
+      (func $ta_subarray
+         (param (ref extern)) (param i32) (param i32) (result (ref extern))))
+   (import "bindings" "ta_set"
+      (func $ta_set (param (ref extern)) (param (ref extern)) (param i32)))
+   (import "bindings" "ta_len"
+      (func $ta_len (param (ref extern)) (result i32)))
+   (import "hash" "caml_hash_mix_int"
+      (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
+
+   (type $string (array (mut i8)))
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+   (type $int_array (array (mut i32)))
+   (type $bigarray
+      (sub $custom
+         (struct
+            (field $ba_ops (ref $custom_operations))
+            (field $ba_data (mut (ref extern))) ;; data
+            (field $ba_dim (ref $int_array)) ;; size in each dimension
+            (field $ba_num_dims i8) ;; number of dimensions
+            (field $ba_kind i8) ;; kind
+            (field $ba_layout i8)))) ;; layout
+
+   (func (export "caml_hash_mix_bigstring")
+      (param $h i32) (param $vb (ref $bigarray)) (result i32)
+      (local $b (ref $bigarray))
+      (local $data (ref extern))
+      (local $len i32) (local $i i32) (local $w i32)
+      (local.set $b (ref.cast $bigarray (local.get $vb)))
+      (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
+      (local.set $len (call $ta_len (local.get $data)))
+      (loop $loop
+         (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len))
+            (then
+               (local.set $h
+                  (call $caml_hash_mix_int
+                     (local.get $h)
+                     (i32.or
+                        (i32.or
+                           (call $ta_get_ui8 (local.get $data) (local.get $i))
+                           (i32.shl (call $ta_get_ui8 (local.get $data)
+                                       (i32.add (local.get $i) (i32.const 1)))
+                                    (i32.const 8)))
+                        (i32.or
+                           (i32.shl (call $ta_get_ui8 (local.get $data)
+                                       (i32.add (local.get $i) (i32.const 2)))
+                                    (i32.const 16))
+                           (i32.shl (call $ta_get_ui8 (local.get $data)
+                                       (i32.add (local.get $i) (i32.const 3)))
+                                    (i32.const 24))))))
+               (local.set $i (i32.add (local.get $i) (i32.const 4)))
+               (br $loop))))
+      (local.set $w (i32.const 0))
+      (block $0_bytes
+         (block $1_byte
+            (block $2_bytes
+               (block $3_bytes
+                  (br_table $0_bytes $1_byte $2_bytes $3_bytes
+                     (i32.and (local.get $len) (i32.const 3))))
+               (local.set $w
+                  (i32.shl (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $i) (i32.const 2)))
+                           (i32.const 16))))
+            (local.set $w
+               (i32.or (local.get $w)
+                  (i32.shl (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $i) (i32.const 1)))
+                           (i32.const 8)))))
+         (local.set $w
+            (i32.or (local.get $w)
+               (call $ta_get_ui8 (local.get $data) (local.get $i))))
+         (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
+      (i32.xor (local.get $h) (local.get $len)))
+
+   (func (export "bigstring_to_array_buffer")
+      (param $bs (ref eq)) (result (ref eq))
+      (return_call $caml_js_get
+         (call $caml_ba_to_typed_array (local.get $bs))
+         (call $wrap (string.const "buffer"))))
+
+   (export "bigstring_to_typed_array" (func $caml_ba_to_typed_array))
+
+   (func (export "bigstring_of_array_buffer") (param (ref eq)) (result (ref eq))
+       (return_call $caml_ba_from_typed_array
+          (call $wrap (call $ta_create (i32.const 12) (local.get $0)))))
+
+   (export "bigstring_of_typed_array" (func $caml_ba_from_typed_array))
+
+   (func (export "caml_bigstring_memcmp")
+      (param $s1 (ref eq)) (param $vpos1 (ref eq))
+      (param $s2 (ref eq)) (param $vpos2 (ref eq))
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
+      (local $c1 i32) (local $c2 i32)
+      (local $d1 (ref extern))
+      (local $d2 (ref extern))
+      (local.set $d1
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s1))))
+      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+      (local.set $d2
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s2))))
+      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (local.set $c1
+                  (call $ta_get_ui8 (local.get $d1)
+                     (i32.add (local.get $pos1) (local.get $i))))
+               (local.set $c2
+                  (call $ta_get_ui8 (local.get $d2)
+                     (i32.add (local.get $pos2) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br_if $loop (i32.eq (local.get $c1) (local.get $c2)))
+               (return
+                  (select (i31.new (i32.const -1)) (i31.new (i32.const 1))
+                     (i32.lt_u (local.get $c1) (local.get $c2)))))))
+      (i31.new (i32.const 0)))
+
+   (export "caml_bigstring_blit_string_to_ba"
+      (func $caml_bigstring_blit_bytes_to_ba))
+   (func $caml_bigstring_blit_bytes_to_ba
+      (export "caml_bigstring_blit_bytes_to_ba")
+      (param $str1 (ref eq)) (param $vpos1 (ref eq))
+      (param $ba2 (ref eq)) (param $vpos2 (ref eq))
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
+      (local $s1 (ref $string))
+      (local $d2 (ref extern))
+      (local.set $s1 (ref.cast $string (local.get $str1)))
+      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+      (local.set $d2
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba2))))
+      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (call $ta_set_ui8 (local.get $d2)
+                  (i32.add (local.get $pos2) (local.get $i))
+                  (i31.new
+                     (array.get_u $string (local.get $s1)
+                        (i32.add (local.get $pos1) (local.get $i)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_bigstring_blit_ba_to_bytes")
+      (param $ba1 (ref eq)) (param $vpos1 (ref eq))
+      (param $str2 (ref eq)) (param $vpos2 (ref eq))
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
+      (local $d1 (ref extern))
+      (local $s2 (ref $string))
+      (local.set $d1
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba1))))
+      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+      (local.set $s2 (ref.cast $string (local.get $str2)))
+      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (array.set $string (local.get $s2)
+                  (i32.add (local.get $pos2) (local.get $i))
+                  (call $ta_get_ui8 (local.get $d1)
+                     (i32.add (local.get $pos1) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_bigstring_blit_ba_to_ba")
+      (param $ba1 (ref eq)) (param $vpos1 (ref eq))
+      (param $ba2 (ref eq)) (param $vpos2 (ref eq))
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $pos1 i32) (local $pos2 i32) (local $len i32)
+      (local $d1 (ref extern))
+      (local $d2 (ref extern))
+      (local.set $d1
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba1))))
+      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+      (local.set $d2
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba2))))
+      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (call $ta_set (local.get $d2)
+         (call $ta_subarray (local.get $d1)
+            (local.get $pos1) (i32.add (local.get $pos1) (local.get $len)))
+         (local.get $pos2))
+      (i31.new (i32.const 0)))
+)
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index b979cbfc15..8010894148 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -18,6 +18,13 @@
          (array.new_fixed $block
             (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
 
+   (global $OUT_OF_MEMORY_EXN i32 (i32.const 0))
+
+   (func (export "caml_raise_out_of_memory")
+      (return_call $caml_raise_constant
+         (array.get $block (global.get $caml_global_data)
+                    (global.get $OUT_OF_MEMORY_EXN))))
+
    (global $FAILURE_EXN i32 (i32.const 2))
 
    (func (export "caml_failwith_tag") (result (ref eq))
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index b1d99d498e..e2ed1e8b84 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -5,8 +5,7 @@
       (func $ref_test_string (param anyref) (result i32)))
    (import "bindings" "identity"
       (func $ref_cast_string (param anyref) (result (ref string))))
-   (import "jslib" "caml_string_of_jsstring"
-      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -52,12 +51,14 @@
       (local.set $h (i32.mul (local.get $h) (i32.const 0xc2b2ae35)))
       (i32.xor (local.get $h) (i32.shr_u (local.get $h) (i32.const 16))))
 
-   (func $caml_hash_mix_int64 (param $h i32) (param $d i64) (result i32)
+   (func $caml_hash_mix_int64 (export "caml_hash_mix_int64")
+      (param $h i32) (param $d i64) (result i32)
       (return_call $caml_hash_mix_int
          (call $caml_hash_mix_int (local.get $h) (i32.wrap_i64 (local.get $d)))
          (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
 
-   (func $caml_hash_mix_float (param $h i32) (param $d f64) (result i32)
+   (func $caml_hash_mix_float (export "caml_hash_mix_float")
+      (param $h i32) (param $d f64) (result i32)
       (local $i i64)
       (local.set $i (i64.reinterpret_f64 (local.get $d)))
       (if (i64.eq (i64.and (local.get $i) (i64.const 0x7FF0000000000000))
@@ -70,6 +71,20 @@
          (then (local.set $i (i64.const 0))))
       (return_call $caml_hash_mix_int64 (local.get $h) (local.get $i)))
 
+   (func $caml_hash_mix_float32 (export "caml_hash_mix_float32")
+      (param $h i32) (param $d f32) (result i32)
+      (local $i i32)
+      (local.set $i (i32.reinterpret_f32 (local.get $d)))
+      (if (i32.eq (i32.and (local.get $i) (i32.const 0x7F800000))
+                  (i32.const 0x7F800000))
+         (then
+            (if (i32.ne (i32.and (local.get $i) (i32.const 0x7FFFFF))
+                        (i32.const 0))
+               (then (local.set $i (i32.const 0x7F800001))))))
+      (if (i32.eq (local.get $i) (i32.const 0x80000000))
+         (then (local.set $i (i32.const 0))))
+      (return_call $caml_hash_mix_int (local.get $h) (local.get $i)))
+
    (func $caml_hash_mix_string (export "caml_hash_mix_string")
       (param $h i32) (param $s (ref $string)) (result i32)
       (local $i i32) (local $len i32) (local $w i32)
@@ -120,8 +135,8 @@
 
    (func $caml_hash_mix_jsstring
       (param $h i32) (param $s (ref eq)) (result i32)
-      (return_call $caml_hash_mix_string (local.get $h)
-         (ref.cast $string (call $caml_string_of_jsstring (local.get $s)))))
+      (return_call $caml_hash_mix_int (local.get $h)
+         (string.hash (call $ref_cast_string (call $unwrap (local.get $s))))))
 
    (global $HASH_QUEUE_SIZE i32 (i32.const 256))
    (global $MAX_FORWARD_DEREFERENCE i32 (i32.const 1000))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 5d23182da6..c925a25c48 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -67,10 +67,8 @@
          is_string:(v)=>+(typeof v==="string"),
          ta_create:(k,sz)=> new(typed_arrays[k])(sz),
          ta_normalize:(a)=>
-           a instanceof Uint8ClampedArray?
-             new Uint8Array(a.buffer,a.byteOffset,a.byteLength):
-             a instanceof Uint32Array?
-               new Int32Array(a.buffer,a.byteOffset,a.byteLength):a,
+           a instanceof Uint32Array?
+           new Int32Array(a.buffer,a.byteOffset,a.length):a,
          ta_kind:(a)=>typed_arrays.findIndex((c)=>a instanceof c),
          ta_length:(a)=>a.length,
          ta_get_f64:(a,i)=>a[i],
@@ -87,6 +85,12 @@
          ta_set_ui16:(a,i,v)=>a[i]=v,
          ta_set_i8:(a,i,v)=>a[i]=v,
          ta_set_ui8:(a,i,v)=>a[i]=v,
+         ta_fill:(a,v)=>a.fill(v),
+         ta_blit:(s,d)=>d.set(s),
+         ta_subarray:(a,i,j)=>a.subarray(i,j),
+         ta_set:(a,b,i)=>a.set(b,i),
+         ta_new:(len)=>new Uint8Array(len),
+         ta_copy:(ta,t,s,n)=>ta.copyWithin(t,s,n),
          wrap_callback:(f)=>function (){
              var n = arguments.length;
              if(n > 0) {

From 038af00218408113bef0fa8da8038e657e71dec9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 28 Jun 2023 17:12:00 +0200
Subject: [PATCH 071/481] Fix `cubes` example

---
 examples/cubes/cubes.ml   | 7 ++-----
 examples/cubes/index.html | 2 +-
 2 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/examples/cubes/cubes.ml b/examples/cubes/cubes.ml
index 0314554e66..08f11c1266 100644
--- a/examples/cubes/cubes.ml
+++ b/examples/cubes/cubes.ml
@@ -201,7 +201,7 @@ let rec loop c c' a =
   if !need_redraw then redraw c c' a;
   loop c c' a
 
-let start _ =
+let () =
   let c = create_canvas () in
   let c' = create_canvas () in
   Dom.appendChild Html.window##.document##.body c;
@@ -209,7 +209,4 @@ let start _ =
   c##.globalCompositeOperation := Js.string "copy";
   let a = create_cubes true in
   redraw c c' a;
-  ignore (loop c c' a);
-  Js._false
-
-let _ = Html.window##.onload := Html.handler start
+  ignore (loop c c' a)
diff --git a/examples/cubes/index.html b/examples/cubes/index.html
index c48a46e7bd..b4cadb1ff7 100644
--- a/examples/cubes/index.html
+++ b/examples/cubes/index.html
@@ -4,7 +4,7 @@
 <html xmlns="http://www.w3.org/1999/xhtml">
   <head>
     <title>Cubes</title>
-    <script type="text/javascript" src="cubes.js"></script>
+    <script type="text/javascript" src="cubes.js" defer></script>
   </head>
   <body>
   </body>

From c7811dc2371182d1b51aeaaa9b0e2f8cdb7cb94e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 28 Jun 2023 17:13:23 +0200
Subject: [PATCH 072/481] Short readme file

---
 README.md      | 142 +++++----------------------------------------
 README_jsoo.md | 154 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 167 insertions(+), 129 deletions(-)
 create mode 100644 README_jsoo.md

diff --git a/README.md b/README.md
index 1585664b42..f329aefe8a 100644
--- a/README.md
+++ b/README.md
@@ -1,57 +1,19 @@
-# Js_of_ocaml (jsoo)
+# Wasm_of_ocaml
 
-[![Build Status](https://github.com/ocsigen/js_of_ocaml/workflows/build/badge.svg?branch=master)](https://github.com/ocsigen/js_of_ocaml/actions)
-[![Update Web site - build](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml)
-[![Update Web site - deploy](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment)
-
-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.
-
-- It is easy to install and use as it works with an existing installation of
-  OCaml, with no need to recompile any library.
-- It comes with bindings for a large part of the browser APIs.
-- According to our benchmarks, the generated programs runs typically faster than
-  with the OCaml bytecode interpreter.
-- We believe this compiler will prove much easier to maintain than a retargeted
-  OCaml compiler, as the bytecode provides a very stable API.
-
-Js_of_ocaml is composed of multiple packages:
-- js_of_ocaml-compiler, the compiler.
-- js_of_ocaml-ppx, a ppx syntax extension.
-- js_of_ocaml, the base library.
-- js_of_ocaml-ppx_deriving_json
-- js_of_ocaml-lwt, lwt support.
-- js_of_ocaml-tyxml, tyxml support.
-- js_of_ocaml-toplevel, lib and tools to build an ocaml toplevel to
-  javascript.
+Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssembly.
 
 ## Requirements
 
-See
-[opam](https://github.com/ocsigen/js_of_ocaml/blob/master/js_of_ocaml-compiler.opam)
-file for version constraints.
-
-### optional
+Wasm_of_ocaml relies on the Binaryen toolchain. At the moment, you need to install a [specific fork](https://github.com/vouillon/binaryen/tree/fixes): we rely on a number of unreleased fixes, and the main branch uses a new format for the `br_on_cast` instruction which is not yet supported by `node`.
 
-- [lwt](https://github.com/ocsigen/lwt)
-- [tyxml](https://github.com/ocsigen/tyxml)
-- [reactiveData](https://github.com/ocsigen/reactiveData)
-- [yojson](https://github.com/mjambon/yojson)
+## Supported engines
 
-### Toplevel requirements
-
-- tyxml, reactiveData
-- ocp-indent: needed to support indentation in the toplevel
-- higlo: needed to support Syntax highlighting in the toplevel
-- cohttp: needed to build the toplevel webserver
+The generated code works with [Chrome beta](https://www.google.com/chrome/beta/) and [node nightly](https://nodejs.org/download/nightly/v21.0.0-nightly20230628900ae1bda7/). For Chrome, you need to enable WebAssembly Garbage Collection and WebAssembly Stringref from chrome://flags/. For node, you need to use the following flags:`--experimental-wasm-gc  --experimental-wasm-stringref`.
 
 ## Installation
 
-### Opam
-
 ```
-opam install js_of_ocaml js_of_ocaml-compiler js_of_ocaml-ppx
+opam pin add . wasm_of_ocaml js_of_ocaml js_of_ocaml-compiler js_of_ocaml-ppx
 ```
 
 ## Usage
@@ -61,94 +23,16 @@ JavaScript bindings are provided by the `js_of_ocaml` package. The syntax
 extension is provided by `js_of_ocaml-ppx` package.
 
 ```
-ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o cubes.byte cubes.ml
+ocamlfind ocamlc -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt -linkpkg -o cubes.byte cubes.ml
 ```
 
-Then, run the `js_of_ocaml` compiler to produce JavaScript code:
+Then, run the `wasm_of_ocaml` compiler to produce WebAssembly code:
 
 ```
-js_of_ocaml cubes.byte
+wasm_of_ocaml cubes.byte
 ```
 
-## Features
-
-Most of the OCaml standard library is supported. However,
-
-- Most of the Sys module is not supported.
-
-Extra libraries distributed with OCaml (such as Thread) are not supported in
-general. However,
-
-- Bigarray: bigarrays are supported using Typed Arrays
-- Num: supported
-- Str: supported
-- Graphics: partially supported using canvas (see js_of_ocaml-lwt.graphics)
-- Unix: time related functions are supported
-
-Tail call is not optimized in general. However, mutually recursive functions are
-optimized:
-
-- self recursive functions (when the tail calls are the function itself) are
-  compiled using a loop.
-- trampolines are used otherwise.
-  [More](http://ocsigen.org/js_of_ocaml/dev/manual/tailcall) about tail call
-  optimization.
-
-Effect handlers are supported with the `--enable=effects` flag.
-
-## Data representation
-
-Data representation differs from the usual one. Most notably, integers are 32
-bits (rather than 31 bits or 63 bits), which is their natural size in
-JavaScript, and floats are not boxed. As a consequence, marshalling, polymorphic
-comparison, and hashing functions can yield results different from usual:
-
-- marshalling of floats is not supported (unmarshalling works);
-- the polymorphic hash function will not give the same results on datastructures
-  containing floats;
-- these functions may be more prone to stack overflow.
-
-| Ocaml | javascript |
-| ------------- | ------------- |
-| int   | number (32bit int)  |
-| int32 | number (32bit int)  |
-| nativeint | number (32bit int)  |
-| int64 | Object (MlInt64) |
-| float | number |
-| string | string or object (MlBytes) |
-| bytes | object (MlBytes) |
-| "immediate" (e.g. true, false, None, ()) | number (32bit int) |
-| "block" | array with tag as first element (e.g. `C(1,2) => [tag,1,2]`) |
-| array | block with tag 0 (e.g. `[\|1;2\|] => [0,1,2]`) |
-| tuple | block with tag 0 (e.g. `(1,2) => [0,1,2]`) |
-| record | block (e.g. `{x=1;y=2} => [0,1,2]`) |
-| constructor with arguments | block (e.g. `C (1, 2) => [tag,1,2]`) |
-| module | block |
-| exception and extensible variant | block or immediate |
-| function | function |
-
-
-
-## Toplevel
-
-- [OCaml 4.04.2](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.04.2)
-  includes Base, Core_kernel, Async_kernel, Async_js
-- [OCaml 4.04.0+BER](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.04.0+BER)
-  see http://okmij.org/ftp/ML/MetaOCaml.html
-- [OCaml 4.05.0](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.05.0)
-  includes Base, Core_kernel, Async_kernel, Async_js
-- [OCaml 4.06.0](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.06.0)
-  includes Base, Core_kernel, Async_kernel, Async_js
-
-## Contents of the distribution
-
-| Filename    | Description                                  |
-| ----------- | -------------------------------------------- |
-| LICENSE     | license and copyright notice                 |
-| README      | this file                                    |
-| compiler/   | compiler                                     |
-| examples/   | small examples                               |
-| lib/        | library for interfacing with JavaScript APIs |
-| ppx/        | ppx syntax extensions                        |
-| runtime/    | runtime system                               |
-| toplevel/   | web-based OCaml toplevel                     |
+This outputs a file `cubes.js` which loads the WebAssembly code from file `cube.wasm`. For debugging, we currently also output the generated WebAssembly code in text file to `cube.wat`. Since Chrome does not allow loading from the filesystem, you need to serve the files using some Web server. For instance:
+```
+python3 -m http.server 8000 --directory .
+```
diff --git a/README_jsoo.md b/README_jsoo.md
new file mode 100644
index 0000000000..1585664b42
--- /dev/null
+++ b/README_jsoo.md
@@ -0,0 +1,154 @@
+# Js_of_ocaml (jsoo)
+
+[![Build Status](https://github.com/ocsigen/js_of_ocaml/workflows/build/badge.svg?branch=master)](https://github.com/ocsigen/js_of_ocaml/actions)
+[![Update Web site - build](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml)
+[![Update Web site - deploy](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment)
+
+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.
+
+- It is easy to install and use as it works with an existing installation of
+  OCaml, with no need to recompile any library.
+- It comes with bindings for a large part of the browser APIs.
+- According to our benchmarks, the generated programs runs typically faster than
+  with the OCaml bytecode interpreter.
+- We believe this compiler will prove much easier to maintain than a retargeted
+  OCaml compiler, as the bytecode provides a very stable API.
+
+Js_of_ocaml is composed of multiple packages:
+- js_of_ocaml-compiler, the compiler.
+- js_of_ocaml-ppx, a ppx syntax extension.
+- js_of_ocaml, the base library.
+- js_of_ocaml-ppx_deriving_json
+- js_of_ocaml-lwt, lwt support.
+- js_of_ocaml-tyxml, tyxml support.
+- js_of_ocaml-toplevel, lib and tools to build an ocaml toplevel to
+  javascript.
+
+## Requirements
+
+See
+[opam](https://github.com/ocsigen/js_of_ocaml/blob/master/js_of_ocaml-compiler.opam)
+file for version constraints.
+
+### optional
+
+- [lwt](https://github.com/ocsigen/lwt)
+- [tyxml](https://github.com/ocsigen/tyxml)
+- [reactiveData](https://github.com/ocsigen/reactiveData)
+- [yojson](https://github.com/mjambon/yojson)
+
+### Toplevel requirements
+
+- tyxml, reactiveData
+- ocp-indent: needed to support indentation in the toplevel
+- higlo: needed to support Syntax highlighting in the toplevel
+- cohttp: needed to build the toplevel webserver
+
+## Installation
+
+### Opam
+
+```
+opam install js_of_ocaml js_of_ocaml-compiler js_of_ocaml-ppx
+```
+
+## Usage
+
+Your program must first be compiled using the OCaml bytecode compiler `ocamlc`.
+JavaScript bindings are provided by the `js_of_ocaml` package. The syntax
+extension is provided by `js_of_ocaml-ppx` package.
+
+```
+ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o cubes.byte cubes.ml
+```
+
+Then, run the `js_of_ocaml` compiler to produce JavaScript code:
+
+```
+js_of_ocaml cubes.byte
+```
+
+## Features
+
+Most of the OCaml standard library is supported. However,
+
+- Most of the Sys module is not supported.
+
+Extra libraries distributed with OCaml (such as Thread) are not supported in
+general. However,
+
+- Bigarray: bigarrays are supported using Typed Arrays
+- Num: supported
+- Str: supported
+- Graphics: partially supported using canvas (see js_of_ocaml-lwt.graphics)
+- Unix: time related functions are supported
+
+Tail call is not optimized in general. However, mutually recursive functions are
+optimized:
+
+- self recursive functions (when the tail calls are the function itself) are
+  compiled using a loop.
+- trampolines are used otherwise.
+  [More](http://ocsigen.org/js_of_ocaml/dev/manual/tailcall) about tail call
+  optimization.
+
+Effect handlers are supported with the `--enable=effects` flag.
+
+## Data representation
+
+Data representation differs from the usual one. Most notably, integers are 32
+bits (rather than 31 bits or 63 bits), which is their natural size in
+JavaScript, and floats are not boxed. As a consequence, marshalling, polymorphic
+comparison, and hashing functions can yield results different from usual:
+
+- marshalling of floats is not supported (unmarshalling works);
+- the polymorphic hash function will not give the same results on datastructures
+  containing floats;
+- these functions may be more prone to stack overflow.
+
+| Ocaml | javascript |
+| ------------- | ------------- |
+| int   | number (32bit int)  |
+| int32 | number (32bit int)  |
+| nativeint | number (32bit int)  |
+| int64 | Object (MlInt64) |
+| float | number |
+| string | string or object (MlBytes) |
+| bytes | object (MlBytes) |
+| "immediate" (e.g. true, false, None, ()) | number (32bit int) |
+| "block" | array with tag as first element (e.g. `C(1,2) => [tag,1,2]`) |
+| array | block with tag 0 (e.g. `[\|1;2\|] => [0,1,2]`) |
+| tuple | block with tag 0 (e.g. `(1,2) => [0,1,2]`) |
+| record | block (e.g. `{x=1;y=2} => [0,1,2]`) |
+| constructor with arguments | block (e.g. `C (1, 2) => [tag,1,2]`) |
+| module | block |
+| exception and extensible variant | block or immediate |
+| function | function |
+
+
+
+## Toplevel
+
+- [OCaml 4.04.2](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.04.2)
+  includes Base, Core_kernel, Async_kernel, Async_js
+- [OCaml 4.04.0+BER](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.04.0+BER)
+  see http://okmij.org/ftp/ML/MetaOCaml.html
+- [OCaml 4.05.0](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.05.0)
+  includes Base, Core_kernel, Async_kernel, Async_js
+- [OCaml 4.06.0](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.06.0)
+  includes Base, Core_kernel, Async_kernel, Async_js
+
+## Contents of the distribution
+
+| Filename    | Description                                  |
+| ----------- | -------------------------------------------- |
+| LICENSE     | license and copyright notice                 |
+| README      | this file                                    |
+| compiler/   | compiler                                     |
+| examples/   | small examples                               |
+| lib/        | library for interfacing with JavaScript APIs |
+| ppx/        | ppx syntax extensions                        |
+| runtime/    | runtime system                               |
+| toplevel/   | web-based OCaml toplevel                     |

From 06188b863c7ebc32a82237fd52735ddfe2b1e41e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 28 Jun 2023 17:15:10 +0200
Subject: [PATCH 073/481] Fix missing opam dependency

---
 dune-project                | 1 +
 wasm_of_ocaml-compiler.opam | 1 +
 2 files changed, 2 insertions(+)

diff --git a/dune-project b/dune-project
index 86b19c9c19..977e5bfeef 100644
--- a/dune-project
+++ b/dune-project
@@ -139,6 +139,7 @@
   "Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js")
  (depends
   (ocaml (and (>= 4.08) (< 5.1)))
+  (js_of_ocaml (= :version))
   (num :with-test)
   (ppx_expect (and (>= v0.14.2) :with-test))
   (ppxlib (>= 0.15.0))
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
index d0af580a52..029ab9b481 100644
--- a/wasm_of_ocaml-compiler.opam
+++ b/wasm_of_ocaml-compiler.opam
@@ -14,6 +14,7 @@ bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
   "dune" {>= "3.7"}
   "ocaml" {>= "4.08" & < "5.1"}
+  "js_of_ocaml" {= version}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}
   "ppxlib" {>= "0.15.0"}

From e90bb668a2673e8216f0e867f3f2a314eb360eda Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 21 Jun 2023 20:01:00 +0200
Subject: [PATCH 074/481] Fix type of charCodeAt

---
 lib/js_of_ocaml/dom_html.ml | 2 +-
 lib/js_of_ocaml/js.ml       | 2 +-
 lib/js_of_ocaml/js.mli      | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index 1a16f08bd0..9e41607037 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -3412,7 +3412,7 @@ module Keyboard_key = struct
     let key = Optdef.get evt##.key empty_string in
     match key##.length with
     | 0 -> Optdef.case evt##.charCode none char_of_int
-    | 1 -> char_of_int (key##charCodeAt 0)
+    | 1 -> char_of_int (int_of_float (Js.to_float (key##charCodeAt 0)))
     | _ -> None
 end
 
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index a353a7941d..e429bf70f7 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -254,7 +254,7 @@ module Js = struct
 
       method charAt : int -> js_string t meth
 
-      method charCodeAt : int -> int meth
+      method charCodeAt : int -> float t meth
 
       (* This may return NaN... *)
       method concat : js_string t -> js_string t meth
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index 2555056901..42cd3380f5 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -226,7 +226,7 @@ class type js_string =
 
     method charAt : int -> js_string t meth
 
-    method charCodeAt : int -> int meth
+    method charCodeAt : int -> float t meth
 
     (* This may return NaN... *)
     method concat : js_string t -> js_string t meth

From 508bf2dd5962c70fd6aad02c1beba8b13f0a2f64 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 3 Jul 2023 16:09:34 +0200
Subject: [PATCH 075/481] Fixed README

---
 README.md | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/README.md b/README.md
index f329aefe8a..70a9dfb396 100644
--- a/README.md
+++ b/README.md
@@ -12,18 +12,23 @@ The generated code works with [Chrome beta](https://www.google.com/chrome/beta/)
 
 ## Installation
 
+The following commands will perform a minimal installation:
 ```
-opam pin add . wasm_of_ocaml js_of_ocaml js_of_ocaml-compiler js_of_ocaml-ppx
+opam pin add -n --with-version 5.3.0 .
+opam install wasm_of_ocaml-compiler
+```
+You may want to install additional packages. For instance:
+
+```
+opam install js_of_ocaml-ppx js_of_ocaml-lwt
 ```
 
 ## Usage
 
-Your program must first be compiled using the OCaml bytecode compiler `ocamlc`.
-JavaScript bindings are provided by the `js_of_ocaml` package. The syntax
-extension is provided by `js_of_ocaml-ppx` package.
+You can try compiling the program in `examples/cubes`. Your program must first be compiled using the OCaml bytecode compiler `ocamlc`. JavaScript bindings are provided by the `js_of_ocaml` package. The syntax extension is provided by `js_of_ocaml-ppx` package. Package `js_of_ocaml-lwt` provides Javascript specific Lwt functions.
 
 ```
-ocamlfind ocamlc -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt -linkpkg -o cubes.byte cubes.ml
+ocamlfind ocamlc -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt -linkpkg -o cubes.byte cubes.mli cubes.ml
 ```
 
 Then, run the `wasm_of_ocaml` compiler to produce WebAssembly code:

From a8088783139f42e48c8060aa98ff7902d26bb846 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 4 Jul 2023 12:59:17 +0200
Subject: [PATCH 076/481] Runtime: weak pointers and ephemerons

---
 runtime/wasm/runtime.js |   6 +
 runtime/wasm/weak.wat   | 321 ++++++++++++++++++++++++++++++++++------
 2 files changed, 279 insertions(+), 48 deletions(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index c925a25c48..6cfd7d2738 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -241,6 +241,12 @@
              ((f, env)=>new Promise((k)=> f(k, env))),
              {suspending:"first"}),
          resume_fiber:(k,v)=>k(v),
+         weak_new:(v)=>new WeakRef(v),
+         weak_deref:(w)=>{var v = w.deref(); return v==undefined?null:v},
+         weak_map_new:()=>new WeakMap,
+         weak_map_get:(m,x)=>m.get(x),
+         weak_map_set:(m,x,v)=>m.set(x,v),
+         weak_map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
         }
     const imports = {Math:math,bindings:bindings}
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
index 17a42cb1dc..b31ee94d55 100644
--- a/runtime/wasm/weak.wat
+++ b/runtime/wasm/weak.wat
@@ -1,48 +1,265 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
    (import "obj" "abstract_tag" (global $abstract_tag i32))
+   (import "obj" "caml_obj_dup"
+      (func $caml_obj_dup (param (ref eq)) (result (ref eq))))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param $arg (ref eq))))
-
+   (import "bindings" "weak_new"
+      (func $weak_new (param (ref eq)) (result anyref)))
+   (import "bindings" "weak_deref"
+      (func $weak_deref (param anyref) (result eqref)))
+   (import "bindings" "weak_map_new" (func $weak_map_new (result (ref any))))
+   (import "bindings" "weak_map_get"
+      (func $weak_map_get (param (ref any)) (param (ref eq)) (result anyref)))
+   (import "bindings" "weak_map_set"
+      (func $weak_map_set (param (ref any)) (param (ref eq)) (param (ref any))))
+   (import "bindings" "weak_map_delete"
+      (func $weak_map_delete (param (ref any)) (param (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
+   (type $js (struct (field anyref)))
 
-   (func (export "caml_ephe_create")
-      (param (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_create"))
-      (i31.new (i32.const 0)))
+   ;; A weak array is a an abstract value composed of possibly some
+   ;; data and an array of keys.
+   ;; Keys are either caml_ephe_none (unset), a 31-bit integer, or a
+   ;; weak reference.
+   ;; To access the data, we need to traverse a series of weak maps
+   ;; indexed by the keys (omitting integers).
+
+   (global $caml_ephe_data_offset i32 (i32.const 2))
+   (global $caml_ephe_key_offset i32 (i32.const 3))
+
+   (global $caml_ephe_none (ref eq)
+      (array.new_fixed $block (i31.new (global.get $abstract_tag))))
 
-   (func (export "caml_ephe_get_data")
-      (param (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_get_data"))
+   (func $caml_ephe_get_data (export "caml_ephe_get_data")
+      (param $vx (ref eq)) (result (ref eq))
+      (local $x (ref $block))
+      (local $d (ref eq)) (local $v (ref eq))
+      (local $m (ref any))
+      (local $i i32) (local $len i32)
+      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $d
+         (array.get $block (local.get $x) (global.get $caml_ephe_data_offset)))
+      (block $no_data
+         (block $released
+            (br_if $no_data
+               (ref.eq (local.get $d) (global.get $caml_ephe_none)))
+            (local.set $i (global.get $caml_ephe_key_offset))
+            (local.set $len (array.len (local.get $x)))
+            (local.set $m (ref.as_non_null (call $unwrap (local.get $d))))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (local.set $v
+                        (array.get $block (local.get $x) (local.get $i)))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br_if $loop
+                        (ref.eq (local.get $v) (global.get $caml_ephe_none)))
+                     (br_if $loop (ref.test i31 (local.get $v)))
+                     (local.set $v
+                        (br_on_null $released
+                           (call $weak_deref (call $unwrap (local.get $v)))))
+                     (local.set $m
+                        (br_on_null $released
+                           (call $weak_map_get (local.get $m) (local.get $v))))
+                     (br $loop))))
+            (return
+              (array.new_fixed $block (i31.new (i32.const 0))
+                 (ref.cast eq (local.get $m)))))
+         (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
+            (global.get $caml_ephe_none)))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_ephe_set_data")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_set_data"))
+   (func (export "caml_ephe_get_data_copy")
+      (param $x (ref eq)) (result (ref eq))
+      (local $r (ref eq))
+      (local.set $r (call $caml_ephe_get_data (local.get $x)))
+      (drop (block $no_copy (result (ref eq))
+         (return
+            (array.new_fixed $block (i31.new (i32.const 0))
+               (call $caml_obj_dup
+                  (br_on_cast_fail $no_copy $block
+                     (array.get $block
+                        (br_on_cast_fail $no_copy $block (local.get $r))
+                        (i32.const 1))))))))
+      (local.get $r))
+
+   (func $caml_ephe_set_data (export "caml_ephe_set_data")
+      (param $vx (ref eq)) (param $data (ref eq)) (result (ref eq))
+      (local $x (ref $block))
+      (local $v (ref eq))
+      (local $m (ref any)) (local $m' (ref any))
+      (local $i i32)
+      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $i (array.len (local.get $x)))
+      (local.set $m (local.get $data))
+      (loop $loop
+         (local.set $i (i32.sub (local.get $i) (i32.const 1)))
+         (if (i32.ge_u (local.get $i) (global.get $caml_ephe_key_offset))
+            (then
+               (local.set $v
+                  (array.get $block (local.get $x) (local.get $i)))
+               (br_if $loop
+                  (ref.eq (local.get $v) (global.get $caml_ephe_none)))
+               (br_if $loop (ref.test i31 (local.get $v)))
+               (block $released
+                  (local.set $v
+                     (br_on_null $released
+                        (call $weak_deref (call $unwrap (local.get $v)))))
+                  (local.set $m' (call $weak_map_new))
+                  (call $weak_map_set (local.get $m') (local.get $v)
+                     (local.get $m))
+                  (local.set $m (local.get $m'))
+                  (br $loop))
+               (array.set $block (local.get $x) (local.get $i)
+                  (global.get $caml_ephe_none))
+               (br $loop))))
+      (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
+         (call $wrap (local.get $m)))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_ephe_set_key")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_set_key"))
+   (func (export "caml_ephe_unset_data")
+      (param $vx (ref eq)) (result (ref eq))
+      (local $x (ref $block))
+      (local.set $x (ref.cast $block (local.get $vx)))
+      (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
+         (global.get $caml_ephe_none))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_ephe_unset_key")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_ephe_unset_key"))
+   (func (export "caml_ephe_check_data")
+      (param $x (ref eq)) (result (ref eq))
+      (i31.new
+         (i32.eqz
+            (ref.eq (call $caml_ephe_get_data (local.get $x))
+               (i31.new (i32.const 0))))))
+
+   (func $caml_ephe_set_data_opt
+      (param $x (ref eq)) (param $opt_data (ref eq))
+      (drop (block $no_data (result (ref eq))
+         (call $caml_ephe_set_data (local.get $x)
+            (array.get $block
+               (br_on_cast_fail $no_data $block (local.get $opt_data))
+               (i32.const 1))))))
+
+   (export "caml_weak_get" (func $caml_ephe_get_key))
+   (func $caml_ephe_get_key (export "caml_ephe_get_key")
+      (param $vx (ref eq)) (param $vi (ref eq)) (result (ref eq))
+      (local $x (ref $block))
+      (local $i i32)
+      (local $v (ref eq))
+      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $i
+         (i32.add (global.get $caml_ephe_key_offset)
+            (i31.get_s (ref.cast i31 (local.get $vi)))))
+      (local.set $v (array.get $block (local.get $x) (local.get $i)))
+      (block $value
+         (block $no_value
+            (br_if $no_value
+               (ref.eq (local.get $v) (global.get $caml_ephe_none)))
+            (br_if $value (ref.test i31 (local.get $v)))
+            (block $released
+               (local.set $v
+                  (br_on_null $released
+                     (call $weak_deref (call $unwrap (local.get $v)))))
+               (br $value))
+            (array.set $block (local.get $x) (local.get $i)
+               (global.get $caml_ephe_none))
+            (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
+               (global.get $caml_ephe_none)))
+         (return (i31.new (i32.const 0))))
+      (array.new_fixed $block (i31.new (i32.const 0)) (local.get $v)))
+
+   (export "caml_weak_get_copy" (func $caml_ephe_get_key_copy))
+   (func $caml_ephe_get_key_copy (export "caml_ephe_get_key_copy")
+      (param $x (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (local $r (ref eq))
+      (local.set $r (call $caml_ephe_get_key (local.get $x) (local.get $i)))
+      (drop (block $no_copy (result (ref eq))
+         (return
+            (array.new_fixed $block (i31.new (i32.const 0))
+               (call $caml_obj_dup
+                  (br_on_cast_fail $no_copy $block
+                     (array.get $block
+                        (br_on_cast_fail $no_copy $block (local.get $r))
+                        (i32.const 1))))))))
+      (local.get $r))
+
+   (export "caml_weak_check" (func $caml_ephe_check_key))
+   (func $caml_ephe_check_key (export "caml_ephe_check_key")
+      (param $vx (ref eq)) (param $vi (ref eq)) (result (ref eq))
+      (local $x (ref $block))
+      (local $i i32)
+      (local $v (ref eq))
+      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $i
+        (i32.add (i31.get_s (ref.cast i31 (local.get $vi)))
+           (global.get $caml_ephe_key_offset)))
+      (local.set $v (array.get $block (local.get $x) (local.get $i)))
+      (block $value
+         (block $no_value
+            (br_if $no_value
+               (ref.eq (local.get $v) (global.get $caml_ephe_none)))
+            (br_if $value (ref.test i31 (local.get $v)))
+            (br_if $value
+               (i32.eqz
+                  (ref.is_null
+                     (call $weak_deref (call $unwrap (local.get $v))))))
+            (array.set $block (local.get $x) (local.get $i)
+               (global.get $caml_ephe_none))
+            (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
+               (global.get $caml_ephe_none)))
+         (return (i31.new (i32.const 0))))
+      (i31.new (i32.const 1)))
+
+   (func $caml_ephe_set_key (export "caml_ephe_set_key")
+      (param $vx (ref eq)) (param $vi (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (local $x (ref $block))
+      (local $d (ref eq))
+      (local $i i32)
+      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $i
+         (i32.add (i31.get_s (ref.cast i31 (local.get $vi)))
+            (global.get $caml_ephe_key_offset)))
+      (local.set $d (i31.new (i32.const 0)))
+      (if (ref.test i31 (local.get $v))
+         (then
+            (if (ref.test $js (array.get $block (local.get $x) (local.get $i)))
+               (then
+                  (local.set $d (call $caml_ephe_get_data (local.get $vx)))))
+            (array.set $block (local.get $x) (local.get $i) (local.get $v)))
+         (else
+            (local.set $d (call $caml_ephe_get_data (local.get $vx)))
+            (array.set $block (local.get $x) (local.get $i)
+               (call $wrap (call $weak_new (local.get $v))))))
+      (call $caml_ephe_set_data_opt (local.get $vx) (local.get $d))
       (i31.new (i32.const 0)))
 
-   (global $caml_ephe_none (ref eq)
-      (array.new_fixed $block (i31.new (global.get $abstract_tag))))
+   (func $caml_ephe_unset_key (export "caml_ephe_unset_key")
+      (param $vx (ref eq)) (param $vi (ref eq)) (result (ref eq))
+      (local $x (ref $block))
+      (local $d (ref eq))
+      (local $i i32)
+      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $i
+         (i32.add (i31.get_s (ref.cast i31 (local.get $vi)))
+            (global.get $caml_ephe_key_offset)))
+      (local.set $d (i31.new (i32.const 0)))
+      (if (ref.test $js (array.get $block (local.get $x) (local.get $i)))
+         (then
+            (local.set $d (call $caml_ephe_get_data (local.get $vx)))))
+      (array.set $block (local.get $x) (local.get $i)
+         (global.get $caml_ephe_none))
+      (call $caml_ephe_set_data_opt (local.get $vx) (local.get $d))
+      (i31.new (i32.const 0)))
 
    (data $Weak_create "Weak.create")
 
-   (func (export "caml_weak_create")
+   (export "caml_weak_create" (func $caml_ephe_create))
+   (func $caml_ephe_create (export "caml_ephe_create")
       (param $vlen (ref eq)) (result (ref eq))
       (local $len i32)
       (local $res (ref $block))
@@ -54,34 +271,42 @@
                   (i32.const 0) (i32.const 11)))))
       (local.set $res
          (array.new $block (global.get $caml_ephe_none)
-            (i32.add (local.get $len) (i32.const 3))))
+            (i32.add (local.get $len) (global.get $caml_ephe_key_offset))))
       (array.set $block (local.get $res) (i32.const 0)
          (i31.new (global.get $abstract_tag)))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_create"))
       (local.get $res))
 
-   (func (export "caml_weak_blit")
-      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_blit"))
+   (func (export "caml_ephe_blit_data")
+      (param $x (ref eq)) (param $y (ref eq)) (result (ref eq))
+      (call $caml_ephe_set_data_opt
+         (local.get $y) (call $caml_ephe_get_data (local.get $x)))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_weak_check")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_check"))
+   (export "caml_weak_blit" (func $caml_ephe_blit_key))
+   (func $caml_ephe_blit_key (export "caml_ephe_blit_key")
+      (param $x (ref eq)) (param $i (ref eq))
+      (param $y (ref eq)) (param $j (ref eq))
+      (param $l (ref eq)) (result (ref eq))
+      (local $d (ref eq))
+      (local.set $d (call $caml_ephe_get_data (local.get $y)))
+      (array.copy $block $block
+         (ref.cast $block (local.get $y))
+         (i32.add (i31.get_s (ref.cast i31 (local.get $j)))
+            (global.get $caml_ephe_key_offset))
+         (ref.cast $block (local.get $x))
+         (i32.add (i31.get_s (ref.cast i31 (local.get $i)))
+            (global.get $caml_ephe_key_offset))
+         (i31.get_s (ref.cast i31 (local.get $l))))
+      (call $caml_ephe_set_data_opt (local.get $y) (local.get $d))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_weak_get")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_get"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_weak_get_copy")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;;ZZZ
-      (call $log_js (string.const "caml_weak_get_copy"))
-      (i31.new (i32.const 0)))
+   (func (export "caml_weak_set")
+      (param $x (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (drop (block $unset (result (ref eq))
+         (return_call $caml_ephe_set_key
+            (local.get $x) (local.get $i)
+            (array.get $block
+               (br_on_cast_fail $unset $block (local.get $v)) (i32.const 1)))))
+      (return_call $caml_ephe_unset_key (local.get $x) (local.get $i)))
 )

From d69212dd1bee8deb410d3198593b14af95012489 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 6 Jul 2023 12:08:33 +0200
Subject: [PATCH 077/481] Explicit coercion between Javascript Numbers and
 OCaml int32 and nativeint

---
 compiler/lib/generate.ml                |  4 ++++
 compiler/tests-compiler/jsopt.ml        |  8 ++++++++
 lib/js_of_ocaml/js.ml                   |  8 ++++++++
 lib/js_of_ocaml/js.mli                  | 13 +++++++++++++
 lib/runtime/js_of_ocaml_runtime_stubs.c | 16 ++++++++++++++++
 lib/runtime/jsoo_runtime.ml             |  8 ++++++++
 runtime/jslib.js                        |  5 +++++
 7 files changed, 62 insertions(+)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 43c92c05f9..fd431eeb59 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -2159,6 +2159,10 @@ let init () =
     ; "caml_ensure_stack_capacity", "%identity"
     ; "caml_js_from_float", "%identity"
     ; "caml_js_to_float", "%identity"
+    ; "caml_js_from_int32", "%identity"
+    ; "caml_js_from_nativeint", "%identity"
+    ; "caml_js_to_int32", "caml_int_of_float"
+    ; "caml_js_to_nativeint", "caml_int_of_float"
     ];
   Hashtbl.iter
     (fun name (k, _) -> Primitive.register name k None None)
diff --git a/compiler/tests-compiler/jsopt.ml b/compiler/tests-compiler/jsopt.ml
index 1f29c9f92b..9c0b6b6dd4 100644
--- a/compiler/tests-compiler/jsopt.ml
+++ b/compiler/tests-compiler/jsopt.ml
@@ -48,6 +48,14 @@ module Js = struct
 
   external float_of_number : t -> float = "caml_js_to_float"
 
+  external number_of_int32 : int32 -> t = "caml_js_from_int32"
+
+  external int32_of_number : t -> int32 = "caml_js_to_int32"
+
+  external number_of_nativeint : nativeint -> t = "caml_js_from_nativeint"
+
+  external nativeint_of_number : t -> nativeint = "caml_js_to_nativeint"
+
   external typeof : t -> t = "caml_js_typeof"
 
   external instanceof : t -> t -> bool = "caml_js_instanceof"
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index e429bf70f7..7cfef13359 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -799,6 +799,14 @@ external float : float -> float t = "caml_js_from_float"
 
 external to_float : float t -> float = "caml_js_to_float"
 
+external int32 : int32 -> float t = "caml_js_from_int32"
+
+external to_int32 : float t -> int32 = "caml_js_to_int32"
+
+external nativeint : nativeint -> float t = "caml_js_from_nativeint"
+
+external to_nativeint : float t -> nativeint = "caml_js_to_nativeint"
+
 external typeof : _ t -> js_string t = "caml_js_typeof"
 
 external instanceof : _ t -> _ constr -> bool = "caml_js_instanceof"
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index 42cd3380f5..555db61acb 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -833,6 +833,19 @@ external float : float -> float t = "caml_js_from_float"
 external to_float : float t -> float = "caml_js_to_float"
 (** Conversion of Javascript numbers to OCaml floats. *)
 
+external int32 : int32 -> float t = "caml_js_from_int32"
+(** Conversion of OCaml floats to Javascript numbers. *)
+
+external to_int32 : float t -> int32 = "caml_js_to_int32"
+(** Conversion of Javascript numbers to OCaml 32-bits. *)
+
+external nativeint : nativeint -> float t = "caml_js_from_nativeint"
+(** Conversion of OCaml 32-bits integers to Javascript numbers. *)
+
+external to_nativeint : float t -> nativeint = "caml_js_to_nativeint"
+
+(** Conversion of Javascript numbers to OCaml native integers. *)
+
 (** {2 Convenience coercion functions} *)
 
 val coerce : 'a -> ('a -> 'b Opt.t) -> ('a -> 'b) -> 'b
diff --git a/lib/runtime/js_of_ocaml_runtime_stubs.c b/lib/runtime/js_of_ocaml_runtime_stubs.c
index b9a08b077a..a09130a2d8 100644
--- a/lib/runtime/js_of_ocaml_runtime_stubs.c
+++ b/lib/runtime/js_of_ocaml_runtime_stubs.c
@@ -76,6 +76,14 @@ void caml_js_from_float () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_from_float!\n");
   exit(1);
 }
+void caml_js_from_int32 () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_js_from_int32!\n");
+  exit(1);
+}
+void caml_js_from_nativeint () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_js_from_nativeint!\n");
+  exit(1);
+}
 void caml_js_from_string () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_from_string!\n");
   exit(1);
@@ -136,6 +144,14 @@ void caml_js_to_float () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_to_float!\n");
   exit(1);
 }
+void caml_js_to_int32 () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_js_to_int32!\n");
+  exit(1);
+}
+void caml_js_to_nativeint () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_js_to_nativeint!\n");
+  exit(1);
+}
 void caml_js_to_string () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_to_string!\n");
   exit(1);
diff --git a/lib/runtime/jsoo_runtime.ml b/lib/runtime/jsoo_runtime.ml
index 3fc3397249..8f42e9f6d1 100644
--- a/lib/runtime/jsoo_runtime.ml
+++ b/lib/runtime/jsoo_runtime.ml
@@ -25,6 +25,14 @@ module Js = struct
 
   external float_of_number : t -> float = "caml_js_to_float"
 
+  external number_of_int32 : int32 -> t = "caml_js_from_int32"
+
+  external int32_of_number : t -> int32 = "caml_js_to_int32"
+
+  external number_of_nativeint : nativeint -> t = "caml_js_from_nativeint"
+
+  external nativeint_of_number : t -> nativeint = "caml_js_to_nativeint"
+
   external typeof : t -> t = "caml_js_typeof"
 
   external instanceof : t -> t -> bool = "caml_js_instanceof"
diff --git a/runtime/jslib.js b/runtime/jslib.js
index 34738487bf..da75a133e3 100644
--- a/runtime/jslib.js
+++ b/runtime/jslib.js
@@ -194,9 +194,14 @@ function caml_js_from_bool(x) { return !!x; }
 //Provides: caml_js_to_bool const (const)
 function caml_js_to_bool(x) { return +x; }
 //Provides: caml_js_from_float const (const)
+//Alias: caml_js_from_int32
+//Alias: caml_js_from_nativeint
 function caml_js_from_float(x) { return x; }
 //Provides: caml_js_to_float const (const)
 function caml_js_to_float(x) { return x; }
+//Provides: caml_js_to_int32 const (const)
+//Alias: caml_js_to_nativeint
+function caml_js_to_int32(x) { return x|0; }
 
 //Provides: caml_js_from_array mutable (shallow)
 function caml_js_from_array(a) {

From ca6dc7e458de083ea62469933c582ae8082f9d78 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 12 Jul 2023 10:08:11 +0200
Subject: [PATCH 078/481] Fix JavaScript exception wrapping

---
 runtime/wasm/jslib.wat | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 9399ebd900..cdbeeb437d 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -541,18 +541,23 @@
       (local.get $l))
 
    (func (export "caml_wrap_exception") (param (externref)) (result (ref eq))
-      (local $exn (ref eq))
-      (local.set $exn (call $wrap (extern.internalize (local.get 0))))
+      (local $exn anyref)
+      (local.set $exn (extern.internalize (local.get 0)))
       ;; ZZZ special case for stack overflows?
       (block $undef
          (return
             (array.new_fixed $block (i31.new (i32.const 0))
                (br_on_null $undef
-                  (call $caml_named_value (string.const "jsError"))))
-               (local.get $exn)))
+                  (call $caml_named_value (string.const "jsError")))
+               (call $wrap (local.get $exn)))))
       (array.new_fixed $block (i31.new (i32.const 0))
          (call $caml_failwith_tag)
-         (local.get $exn)))
+         (call $caml_string_of_jsstring
+            (call $wrap
+               (call $meth_call
+                  (local.get $exn)
+                  (string.const "toString")
+                  (extern.internalize (call $new_array (i32.const 0))))))))
 
    (func (export "caml_js_error_option_of_exception")
       (param (ref eq)) (result (ref eq))

From c658fa286efaee8f3b33c6434d633b1e21994164 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 12 Jul 2023 10:15:13 +0200
Subject: [PATCH 079/481] Compiler: link additional runtime files passed on the
 command line

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml  | 17 +++++++++---
 compiler/bin-wasm_of_ocaml/cmd_arg.mli |  1 +
 compiler/bin-wasm_of_ocaml/compile.ml  | 37 +++++++++++++++++---------
 3 files changed, 39 insertions(+), 16 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index c5552a8dc6..9bb3d4303b 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -25,12 +25,17 @@ type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
     profile : Driver.profile option
+  ; runtime_files : string list
   ; output_file : string * bool
   ; input_file : string
   ; params : (string * string) list
   }
 
 let options =
+  let runtime_files =
+    let doc = "Link JavaScript and WebAssembly files [$(docv)]. " in
+    Arg.(value & pos_left ~rev:true 0 string [] & info [] ~docv:"RUNTIME_FILES" ~doc)
+  in
   let output_file =
     let doc = "Set output file name to [$(docv)]." in
     Arg.(value & opt (some string) None & info [ "o" ] ~docv:"FILE" ~doc)
@@ -52,7 +57,7 @@ let options =
       & opt_all (list (pair ~sep:'=' (enum all) string)) []
       & info [ "set" ] ~docv:"PARAM=VALUE" ~doc)
   in
-  let build_t common set_param profile output_file input_file =
+  let build_t common set_param profile output_file input_file runtime_files =
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let output_file =
       match output_file with
@@ -60,10 +65,16 @@ let options =
       | None -> chop_extension input_file ^ ".js", false
     in
     let params : (string * string) list = List.flatten set_param in
-    `Ok { common; params; profile; output_file; input_file }
+    `Ok { common; params; profile; output_file; input_file; runtime_files }
   in
   let t =
     Term.(
-      const build_t $ Jsoo_cmdline.Arg.t $ set_param $ profile $ output_file $ input_file)
+      const build_t
+      $ Jsoo_cmdline.Arg.t
+      $ set_param
+      $ profile
+      $ output_file
+      $ input_file
+      $ runtime_files)
   in
   Term.ret t
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
index 281b89b62f..1f0c36cdae 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.mli
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
@@ -23,6 +23,7 @@ type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
     profile : Driver.profile option
+  ; runtime_files : string list
   ; output_file : string * bool
   ; input_file : string
   ; params : (string * string) list
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 7e8a33c8ee..2dd81995dc 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -65,16 +65,14 @@ let common_binaryen_options =
   ; "-n"
   ]
 
-let link runtime_file input_file output_file =
+let link runtime_files input_file output_file =
   command
     (("wasm-merge" :: common_binaryen_options)
-    @ [ Filename.quote runtime_file
-      ; "env"
-      ; Filename.quote input_file
-      ; "exec"
-      ; "-o"
-      ; Filename.quote output_file
-      ])
+    @ List.flatten
+        (List.map
+           ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ])
+           runtime_files)
+    @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ])
 
 let dead_code_elimination in_file out_file =
   with_intermediate_file (Filename.temp_file "deps" ".json")
@@ -96,13 +94,13 @@ let optimize in_file out_file =
     (("wasm-opt" :: common_binaryen_options)
     @ [ "-O3"; Filename.quote in_file; "-o"; Filename.quote out_file ])
 
-let link_and_optimize wat_file output_file =
+let link_and_optimize runtime_wasm_files wat_file output_file =
   with_intermediate_file (Filename.temp_file "runtime" ".wasm")
   @@ fun runtime_file ->
   write_file runtime_file Wa_runtime.wasm_runtime;
   with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
   @@ fun temp_file ->
-  link runtime_file wat_file temp_file;
+  link (runtime_file :: runtime_wasm_files) wat_file temp_file;
   with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
   @@ fun temp_file' ->
   dead_code_elimination temp_file temp_file';
@@ -138,7 +136,7 @@ let copy_js_runtime wasm_file output_file =
     ^ escape_string (Filename.basename wasm_file)
     ^ String.sub s ~pos:(i + 4) ~len:(String.length s - i - 4))
 
-let run { Cmd_arg.common; profile; input_file; output_file; params } =
+let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
   Wa_generate.init ();
   Jsoo_cmdline.Arg.eval common;
   (match output_file with
@@ -147,12 +145,25 @@ let run { Cmd_arg.common; profile; input_file; output_file; params } =
   List.iter params ~f:(fun (s, v) -> Config.Param.set s v);
   let t = Timer.make () in
   let include_dirs = List.filter_map [ "+stdlib/" ] ~f:(fun d -> Findlib.find [] d) in
+  let runtime_wasm_files, runtime_js_files =
+    List.partition runtime_files ~f:(fun name ->
+        List.exists
+          ~f:(fun s -> Filename.check_suffix name s)
+          [ ".wasm"; ".wat"; ".wast" ])
+  in
+  let runtime_js_files, builtin =
+    List.partition_map runtime_js_files ~f:(fun name ->
+        match Builtins.find name with
+        | Some t -> `Snd t
+        | None -> `Fst name)
+  in
   let t1 = Timer.make () in
-  let builtin = Js_of_ocaml_compiler_runtime_files.runtime in
+  let builtin = Js_of_ocaml_compiler_runtime_files.runtime @ builtin in
   List.iter builtin ~f:(fun t ->
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in
       Linker.load_fragments ~target_env:Target_env.Isomorphic ~filename runtimes);
+  Linker.load_files ~target_env:Target_env.Isomorphic runtime_js_files;
   Linker.check_deps ();
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
@@ -200,7 +211,7 @@ let run { Cmd_arg.common; profile; input_file; output_file; params } =
        let wat_file = Filename.chop_extension (fst output_file) ^ ".wat" in
        let wasm_file = Filename.chop_extension (fst output_file) ^ ".wasm" in
        output_gen wat_file (output code ~standalone:true);
-       link_and_optimize wat_file wasm_file;
+       link_and_optimize runtime_wasm_files wat_file wasm_file;
        copy_js_runtime wasm_file (fst output_file)
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());

From e416827bd3a182215b129d6b05a54df9e382b4b6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 12 Jul 2023 10:34:08 +0200
Subject: [PATCH 080/481] New br_on_cast syntax + final types

---
 README.md                          |  4 +-
 compiler/lib/wasm/wa_gc_target.ml  |  4 +-
 compiler/lib/wasm/wa_wat_output.ml | 86 +++++++++++-------------------
 runtime/wasm/array.wat             |  6 ++-
 runtime/wasm/bigarray.wat          |  6 +--
 runtime/wasm/bigstring.wat         |  2 +-
 runtime/wasm/compare.wat           | 48 +++++++++++------
 runtime/wasm/effect.wat            |  4 +-
 runtime/wasm/hash.wat              | 20 ++++---
 runtime/wasm/int32.wat             |  2 +-
 runtime/wasm/int64.wat             |  2 +-
 runtime/wasm/jslib.wat             | 16 +++---
 runtime/wasm/obj.wat               | 36 ++++++++-----
 runtime/wasm/parsing.wat           |  3 +-
 runtime/wasm/runtime.js            |  5 +-
 runtime/wasm/stdlib.wat            |  3 +-
 runtime/wasm/str.wat               |  6 +--
 runtime/wasm/string.wat            |  4 +-
 runtime/wasm/sync.wat              |  2 +-
 runtime/wasm/weak.wat              | 16 +++---
 20 files changed, 145 insertions(+), 130 deletions(-)

diff --git a/README.md b/README.md
index 70a9dfb396..278cb814fa 100644
--- a/README.md
+++ b/README.md
@@ -4,11 +4,11 @@ Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssem
 
 ## Requirements
 
-Wasm_of_ocaml relies on the Binaryen toolchain. At the moment, you need to install a [specific fork](https://github.com/vouillon/binaryen/tree/fixes): we rely on a number of unreleased fixes, and the main branch uses a new format for the `br_on_cast` instruction which is not yet supported by `node`.
+Wasm_of_ocaml relies on the Binaryen toolchain. At the moment, you need to install it [from the main branch on GitHub](https://github.com/WebAssembly/binaryen/).
 
 ## Supported engines
 
-The generated code works with [Chrome beta](https://www.google.com/chrome/beta/) and [node nightly](https://nodejs.org/download/nightly/v21.0.0-nightly20230628900ae1bda7/). For Chrome, you need to enable WebAssembly Garbage Collection and WebAssembly Stringref from chrome://flags/. For node, you need to use the following flags:`--experimental-wasm-gc  --experimental-wasm-stringref`.
+The generated code works with [Chrome beta](https://www.google.com/chrome/beta/) and [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230711fb76fe1ec2/). For Chrome, you need to enable WebAssembly Garbage Collection and WebAssembly Stringref from chrome://flags/. For node, you need to use the following flags:`--experimental-wasm-gc  --experimental-wasm-stringref`.
 
 ## Installation
 
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 8d81a2c246..5e72e4e635 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -92,7 +92,7 @@ module Type = struct
         let* custom = custom_type in
         return
           { supertype = Some custom
-          ; final = false
+          ; final = true
           ; typ =
               W.Struct
                 [ { mut = false
@@ -108,7 +108,7 @@ module Type = struct
         let* custom = custom_type in
         return
           { supertype = Some custom
-          ; final = false
+          ; final = true
           ; typ =
               W.Struct
                 [ { mut = false
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 211a9dcba4..e0a562783a 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -71,13 +71,8 @@ let global_type typ = mut_type value_type typ
 let str_type typ =
   match typ with
   | Func ty -> List (Atom "func" :: func_type ty)
-  | Struct l -> (
-      match target with
-      | `Binaryen ->
-          List
-            (Atom "struct" :: List.map ~f:(fun f -> List [ Atom "field"; field_type f ]) l)
-      | `Reference ->
-          List [ Atom "struct"; List (Atom "field" :: List.map ~f:field_type l) ])
+  | Struct l ->
+      List (Atom "struct" :: List.map ~f:(fun f -> List [ Atom "field"; field_type f ]) l)
   | Array ty -> List [ Atom "array"; field_type ty ]
 
 let block_type = func_type
@@ -327,38 +322,22 @@ let expression_or_instructions ctx in_function =
         | `Reference -> [ List (Atom "ref.test" :: ref_type ty :: expression e) ])
     | RefEq (e, e') -> [ List (Atom "ref.eq" :: (expression e @ expression e')) ]
     | RefNull ty -> [ List [ Atom "ref.null"; heap_type ty ] ]
-    | Br_on_cast (i, ty, ty', e) -> (
-        match target with
-        | `Binaryen ->
-            [ List
-                (Atom "br_on_cast"
-                :: Atom (string_of_int i)
-                :: (ref_type' ty' @ expression e))
-            ]
-        | `Reference ->
-            [ List
-                (Atom "br_on_cast"
-                :: Atom (string_of_int i)
-                :: ref_type ty
-                :: ref_type ty'
-                :: expression e)
-            ])
-    | Br_on_cast_fail (i, ty, ty', e) -> (
-        match target with
-        | `Binaryen ->
-            [ List
-                (Atom "br_on_cast_fail"
-                :: Atom (string_of_int i)
-                :: (ref_type' ty' @ expression e))
-            ]
-        | `Reference ->
-            [ List
-                (Atom "br_on_cast_fail"
-                :: Atom (string_of_int i)
-                :: ref_type ty
-                :: ref_type ty'
-                :: expression e)
-            ])
+    | Br_on_cast (i, ty, ty', e) ->
+        [ List
+            (Atom "br_on_cast"
+            :: Atom (string_of_int i)
+            :: ref_type ty
+            :: ref_type ty'
+            :: expression e)
+        ]
+    | Br_on_cast_fail (i, ty, ty', e) ->
+        [ List
+            (Atom "br_on_cast_fail"
+            :: Atom (string_of_int i)
+            :: ref_type ty
+            :: ref_type ty'
+            :: expression e)
+        ]
     | ExternInternalize e -> [ List (Atom "extern.internalize" :: expression e) ]
     | ExternExternalize e -> [ List (Atom "extern.externalize" :: expression e) ]
   and instruction i =
@@ -522,21 +501,20 @@ let data_contents ctx contents =
   escape_string (Buffer.contents b)
 
 let type_field { name; typ; supertype; final } =
-  match target with
-  | `Binaryen when Option.is_none supertype ->
-      List [ Atom "type"; index name; str_type typ ]
-  | _ ->
-      List
-        [ Atom "type"
-        ; index name
-        ; List
-            (Atom "sub"
-            :: ((if final && Poly.(target <> `Binaryen) then [ Atom "final" ] else [])
-               @ (match supertype with
-                 | Some supertype -> [ index supertype ]
-                 | None -> [])
-               @ [ str_type typ ]))
-        ]
+  if final && Option.is_none supertype
+  then List [ Atom "type"; index name; str_type typ ]
+  else
+    List
+      [ Atom "type"
+      ; index name
+      ; List
+          (Atom "sub"
+          :: ((if final then [ Atom "final" ] else [])
+             @ (match supertype with
+               | Some supertype -> [ index supertype ]
+               | None -> [])
+             @ [ str_type typ ]))
+      ]
 
 let field ctx f =
   match f with
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index 0319ad7bae..df013293e0 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -91,7 +91,8 @@
       (local.set $len (i32.const 1))
       (loop $compute_length
          (drop (block $exit (result (ref eq))
-             (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
+             (local.set $b
+                (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l)))
              (local.set $len
                 (i32.add (local.get $len)
                    (i32.sub
@@ -114,7 +115,8 @@
       (local.set $i (i32.const 1))
       (loop $fill
          (drop (block $exit (result (ref eq))
-             (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
+             (local.set $b
+                (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l)))
              (local.set $a'
                 (ref.cast $block
                    (array.get $block (local.get $b) (i32.const 1))))
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 766010899a..e31bbfe72e 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -85,9 +85,9 @@
       ))
    (type $custom (struct (field (ref $custom_operations))))
    (type $int32
-      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
+      (sub final $custom (struct (field (ref $custom_operations)) (field i32))))
    (type $int64
-      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
+      (sub final $custom (struct (field (ref $custom_operations)) (field i64))))
    (type $int_array (array (mut i32)))
 
    (global $bigarray_ops (ref $custom_operations)
@@ -102,7 +102,7 @@
          (ref.func $bigarray_hash)))
 
    (type $bigarray
-      (sub $custom
+      (sub final $custom
          (struct
             (field (ref $custom_operations))
             (field $ba_data (mut (ref extern))) ;; data
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 96f0616db3..13f2029311 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -39,7 +39,7 @@
    (type $custom (struct (field (ref $custom_operations))))
    (type $int_array (array (mut i32)))
    (type $bigarray
-      (sub $custom
+      (sub final $custom
          (struct
             (field $ba_ops (ref $custom_operations))
             (field $ba_data (mut (ref extern))) ;; data
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 36efcb78e3..f91f1cc9d2 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -226,18 +226,21 @@
                   (br_if $next_item (ref.eq (local.get $v1) (local.get $v2)))))
             (drop (block $v1_is_not_int (result (ref eq))
                (local.set $i1
-                  (br_on_cast_fail $v1_is_not_int i31 (local.get $v1)))
+                  (br_on_cast_fail $v1_is_not_int (ref eq) (ref i31)
+                    (local.get $v1)))
                (br_if $next_item (ref.eq (local.get $v1) (local.get $v2)))
                (drop (block $v2_is_not_int (result (ref eq))
                   (local.set $i2
-                     (br_on_cast_fail $v2_is_not_int i31 (local.get $v2)))
+                     (br_on_cast_fail $v2_is_not_int (ref eq) (ref i31)
+                        (local.get $v2)))
                   ;; v1 and v2 are both integers
                   (return (i32.sub (i31.get_s (local.get $i1))
                                    (i31.get_s (local.get $i2))))))
                ;; check for forward tag
                (drop (block $v2_not_forward (result (ref eq))
                   (local.set $b2
-                     (br_on_cast_fail $v2_not_forward $block (local.get $v2)))
+                     (br_on_cast_fail $v2_not_forward (ref eq) (ref $block)
+                        (local.get $v2)))
                   (local.set $t2
                      (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
                                                  (i32.const 0)))))
@@ -250,7 +253,7 @@
                (block $v2_not_comparable
                   (drop (block $v2_not_custom (result (ref eq))
                      (local.set $c2
-                         (br_on_cast_fail $v2_not_custom $custom
+                         (br_on_cast_fail $v2_not_custom (ref eq) (ref $custom)
                             (local.get $v2)))
                      (local.set $res
                         (call_ref $value->value->int->int
@@ -267,8 +270,8 @@
                   ;; check for forward tag
                   (drop (block $v1_not_forward (result (ref eq))
                      (local.set $b1
-                        (br_on_cast_fail
-                           $v1_not_forward $block (local.get $v1)))
+                        (br_on_cast_fail $v1_not_forward (ref eq) (ref $block)
+                           (local.get $v1)))
                      (local.set $t1
                         (i31.get_u (ref.cast i31
                                       (array.get $block (local.get $b1)
@@ -282,7 +285,8 @@
                   (block $v1_not_comparable
                      (drop (block $v1_not_custom (result (ref eq))
                         (local.set $c1
-                            (br_on_cast_fail $v1_not_custom $custom
+                            (br_on_cast_fail
+                               $v1_not_custom (ref eq) (ref $custom)
                                (local.get $v1)))
                         (local.set $res
                            (call_ref $value->value->int->int
@@ -297,13 +301,15 @@
             (drop (block $heterogeneous (result (ref eq))
                (drop (block $v1_not_block (result (ref eq))
                   (local.set $b1
-                     (br_on_cast_fail $v1_not_block $block (local.get $v1)))
+                     (br_on_cast_fail $v1_not_block (ref eq) (ref $block)
+                        (local.get $v1)))
                   (local.set $t1
                      (i31.get_u
                         (ref.cast i31
                            (array.get $block (local.get $b1) (i32.const 0)))))
                   (local.set $b2
-                     (br_on_cast_fail $heterogeneous $block (local.get $v2)))
+                     (br_on_cast_fail $heterogeneous (ref eq) (ref $block)
+                        (local.get $v2)))
                   (local.set $t2
                      (i31.get_u
                         (ref.cast i31
@@ -385,10 +391,12 @@
                (drop (block $v1_not_float (result (ref eq))
                   (local.set $f1
                      (struct.get $float 0
-                        (br_on_cast_fail $v1_not_float $float (local.get $v1))))
+                        (br_on_cast_fail $v1_not_float (ref eq) (ref $float)
+                           (local.get $v1))))
                   (local.set $f2
                      (struct.get $float 0
-                        (br_on_cast_fail $heterogeneous $float (local.get $v2))))
+                        (br_on_cast_fail $heterogeneous (ref eq) (ref $float)
+                           (local.get $v2))))
                   (if (f64.lt (local.get $f1) (local.get $f2))
                      (then (return (i32.const -1))))
                   (if (f64.gt (local.get $f1) (local.get $f2))
@@ -404,18 +412,22 @@
                   (br $next_item)))
                (drop (block $v1_not_string (result (ref eq))
                   (local.set $str1
-                     (br_on_cast_fail $v1_not_string $string (local.get $v1)))
+                     (br_on_cast_fail $v1_not_string (ref eq) (ref $string)
+                        (local.get $v1)))
                   (local.set $str2
-                      (br_on_cast_fail $heterogeneous $string (local.get $v2)))
+                      (br_on_cast_fail $heterogeneous (ref eq) (ref $string)
+                         (local.get $v2)))
                   (local.set $res
                      (call $compare_strings (local.get $str1) (local.get $str2)))
                   (br_if $next_item (i32.eqz (local.get $res)))
                   (return (local.get $res))))
                (drop (block $v1_not_custom (result (ref eq))
                   (local.set $c1
-                     (br_on_cast_fail $v1_not_custom $custom (local.get $v1)))
+                     (br_on_cast_fail $v1_not_custom (ref eq) (ref $custom)
+                        (local.get $v1)))
                   (local.set $c2
-                      (br_on_cast_fail $heterogeneous $custom (local.get $v2)))
+                      (br_on_cast_fail $heterogeneous (ref eq) (ref $custom)
+                         (local.get $v2)))
                   (if (i32.eqz
                          (ref.eq (struct.get $custom 0 (local.get $c1))
                                  (struct.get $custom 0 (local.get $c2))))
@@ -448,10 +460,12 @@
                (drop (block $v1_not_js (result (ref eq))
                   (local.set $js1
                      (struct.get $js 0
-                        (br_on_cast_fail $v1_not_js $js (local.get $v1))))
+                        (br_on_cast_fail $v1_not_js (ref eq) (ref $js)
+                           (local.get $v1))))
                   (local.set $js2
                      (struct.get $js 0
-                        (br_on_cast_fail $heterogeneous $js (local.get $v2))))
+                        (br_on_cast_fail $heterogeneous (ref eq) (ref $js)
+                           (local.get $v2))))
                   ;; ZZZ use ref.test / ref.cast
                   (if (i32.and (call $ref_test_string (local.get $js1))
                                (call $ref_test_string (local.get $js2)))
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index ad386256d3..ec61b19d92 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -57,7 +57,7 @@
       (struct (field (ref $called_with_continuation)) (field (ref eq))))
 
    (type $cont_resume
-      (sub $cont
+      (sub final $cont
          (struct
             (field $cont_func (ref $cont_func))
             (field $cont_resolver externref))))
@@ -219,7 +219,7 @@
    ;; Perform
 
    (type $call_handler_env
-      (sub $closure
+      (sub final $closure
          (struct
             (field (ref $function_1))
             (field $handler (ref eq))
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index e2ed1e8b84..d4f9ee0432 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -179,7 +179,8 @@
                            (i32.add
                               (i32.shl
                                  (i31.get_s
-                                    (br_on_cast_fail $not_int i31
+                                    (br_on_cast_fail
+                                       $not_int (ref eq) (ref i31)
                                        (local.get $v)))
                                  (i32.const 1))
                               (i32.const 1))))
@@ -188,12 +189,14 @@
                   (drop (block $not_string (result (ref eq))
                      (local.set $h
                         (call $caml_hash_mix_string (local.get $h)
-                           (br_on_cast_fail $not_string $string (local.get $v))))
+                           (br_on_cast_fail $not_string (ref eq) (ref $string)
+                              (local.get $v))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
                   (drop (block $not_block (result (ref eq))
                      (local.set $b
-                        (br_on_cast_fail $not_block $block (local.get $v)))
+                        (br_on_cast_fail $not_block (ref eq) (ref $block)
+                           (local.get $v)))
                      (local.set $tag
                         (i31.get_u
                            (ref.cast i31
@@ -207,7 +210,8 @@
                                     (local.get $b) (i32.const 1)))
                               (drop (block $not_block' (result (ref eq))
                                  (local.set $b
-                                    (br_on_cast_fail $not_block' $block
+                                    (br_on_cast_fail
+                                       $not_block' (ref eq) (ref $block)
                                        (local.get $v)))
                                  (br_if $again
                                     (i32.eqz
@@ -253,7 +257,7 @@
                      (local.set $h
                         (call $caml_hash_mix_float (local.get $h)
                            (struct.get $float 0
-                              (br_on_cast_fail $not_float $float
+                              (br_on_cast_fail $not_float (ref eq) (ref $float)
                                  (local.get $v)))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
@@ -265,14 +269,16 @@
                               (br_on_null $loop
                                  (struct.get $custom_operations $cust_hash
                                     (struct.get $custom 0
-                                       (br_on_cast_fail $not_custom $custom
+                                       (br_on_cast_fail $not_custom
+                                          (ref eq) (ref $custom)
                                           (local.get $v))))))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
                   (drop (block $not_js (result (ref eq))
                      (local.set $str
                         (struct.get $js 0
-                           (br_on_cast_fail $not_js $js (local.get $v))))
+                           (br_on_cast_fail $not_js (ref eq) (ref $js)
+                              (local.get $v))))
                      ;; ZZZ use ref.test / ref.cast
                      (if (call $ref_test_string (local.get $str))
                         (then
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index d3fc32e617..909c862872 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -29,7 +29,7 @@
          (ref.func $int32_hash)))
 
    (type $int32
-      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
+      (sub final $custom (struct (field (ref $custom_operations)) (field i32))))
 
    (func $int32_cmp
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param i32) (result i32)
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index ebea0ef47a..2e0abd030d 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -32,7 +32,7 @@
          (ref.func $int64_hash)))
 
    (type $int64
-      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
+      (sub final $custom (struct (field (ref $custom_operations)) (field i64))))
 
    (func $int64_cmp
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param i32) (result i32)
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index cdbeeb437d..d69708a881 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -73,12 +73,14 @@
 
    (func $wrap (export "wrap") (param anyref) (result (ref eq))
       (block $is_eq (result (ref eq))
-         (return (struct.new $js (br_on_cast $is_eq eq (local.get 0))))))
+         (return
+            (struct.new $js (br_on_cast $is_eq anyref (ref eq) (local.get 0))))))
 
    (func $unwrap (export "unwrap") (param (ref eq)) (result anyref)
       (block $not_js (result anyref)
-         (return (struct.get $js 0
-                    (br_on_cast_fail $not_js $js (local.get 0))))))
+         (return
+            (struct.get $js 0
+               (br_on_cast_fail $not_js (ref eq) (ref $js) (local.get 0))))))
 
    (func (export "caml_js_equals")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
@@ -347,7 +349,7 @@
                                     (i31.new (local.get $i))))
                               (local.get $acc)
                               (struct.get $closure 0
-                                 (br_on_cast_fail $done $closure
+                                 (br_on_cast_fail $done (ref eq) (ref $closure)
                                     (local.get $acc)))))
                         (local.set $i (i32.add (local.get $i) (i32.const 1)))
                         (br $loop))))
@@ -501,7 +503,8 @@
          (loop $compute_length
             (local.set $l
                (array.get $block
-                  (br_on_cast_fail $done $block (local.get $l)) (i32.const 2)))
+                  (br_on_cast_fail $done (ref eq) (ref $block) (local.get $l))
+                  (i32.const 2)))
             (local.set $i (i32.add (local.get $i) (i32.const 1)))
             (br $compute_length))))
       (local.set $a (call $new_array (local.get $i)))
@@ -509,7 +512,8 @@
       (local.set $l (local.get 0))
       (drop (block $exit (result (ref eq))
          (loop $loop
-            (local.set $b (br_on_cast_fail $exit $block (local.get $l)))
+            (local.set $b
+               (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l)))
             (call $array_set (local.get $a) (local.get $i)
                (call $unwrap (array.get $block (local.get $b) (i32.const 1))))
             (local.set $l (array.get $block (local.get $b) (i32.const 2)))
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index ac6f21ce07..5847b3c1af 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -27,7 +27,7 @@
    (type $int_array (array (mut i32)))
 
    (type $dummy_closure_1
-      (sub $closure_last_arg
+      (sub final $closure_last_arg
          (struct (field (ref $function_1)) (field (mut (ref null $closure))))))
 
    (type $function_2
@@ -38,7 +38,7 @@
          (struct (field (ref $function_1)) (field (ref $function_2)))))
 
    (type $dummy_closure_2
-      (sub $closure_2
+      (sub final $closure_2
          (struct (field (ref $function_1)) (field (ref $function_2))
             (field (mut (ref null $closure_2))))))
 
@@ -50,7 +50,7 @@
          (struct (field (ref $function_1)) (field (ref $function_3)))))
 
    (type $dummy_closure_3
-      (sub $closure_3
+      (sub final $closure_3
          (struct (field (ref $function_1)) (field (ref $function_3))
             (field (mut (ref null $closure_3))))))
 
@@ -62,7 +62,7 @@
          (struct (field (ref $function_1)) (field (ref $function_4)))))
 
    (type $dummy_closure_4
-      (sub $closure_4
+      (sub final $closure_4
          (struct (field (ref $function_1)) (field (ref $function_4))
             (field (mut (ref null $closure_4))))))
 
@@ -89,7 +89,8 @@
       (local $dst (ref $block)) (local $src (ref $block))
       (drop (block $not_block (result (ref eq))
          (local.set $dst
-            (br_on_cast_fail $not_block $block (local.get $dummy)))
+            (br_on_cast_fail $not_block (ref eq) (ref $block)
+               (local.get $dummy)))
          (local.set $src (ref.cast $block (local.get $newval)))
          (array.copy $block $block
             (local.get $dst) (i32.const 0) (local.get $src) (i32.const 0)
@@ -97,22 +98,26 @@
          (return (i31.new (i32.const 0)))))
       (drop (block $not_closure_1 (result (ref eq))
          (struct.set $dummy_closure_1 1
-            (br_on_cast_fail $not_closure_1 $dummy_closure_1 (local.get $dummy))
+            (br_on_cast_fail $not_closure_1 (ref eq) (ref $dummy_closure_1)
+               (local.get $dummy))
             (ref.cast $closure (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       (drop (block $not_closure_2 (result (ref eq))
          (struct.set $dummy_closure_2 2
-            (br_on_cast_fail $not_closure_2 $dummy_closure_2 (local.get $dummy))
+            (br_on_cast_fail $not_closure_2 (ref eq) (ref $dummy_closure_2)
+               (local.get $dummy))
             (ref.cast $closure_2 (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       (drop (block $not_closure_3 (result (ref eq))
          (struct.set $dummy_closure_3 2
-            (br_on_cast_fail $not_closure_3 $dummy_closure_3 (local.get $dummy))
+            (br_on_cast_fail $not_closure_3 (ref eq) (ref $dummy_closure_3)
+               (local.get $dummy))
             (ref.cast $closure_3 (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       (drop (block $not_closure_4 (result (ref eq))
          (struct.set $dummy_closure_4 2
-            (br_on_cast_fail $not_closure_4 $dummy_closure_4 (local.get $dummy))
+            (br_on_cast_fail $not_closure_4 (ref eq) (ref $dummy_closure_4)
+               (local.get $dummy))
             (ref.cast $closure_4 (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       ;; ZZZ float array
@@ -124,7 +129,8 @@
       (local $s (ref $string)) (local $s' (ref $string))
       (local $len i32)
       (drop (block $not_block (result (ref eq))
-         (local.set $orig (br_on_cast_fail $not_block $block (local.get 0)))
+         (local.set $orig (br_on_cast_fail $not_block (ref eq) (ref $block)
+            (local.get 0)))
          (local.set $len (array.len (local.get $orig)))
          (local.set $res
             (array.new $block (array.get $block (local.get $orig) (i32.const 0))
@@ -134,7 +140,8 @@
             (i32.sub (local.get $len) (i32.const 1)))
          (return (local.get $res))))
       (drop (block $not_string (result (ref eq))
-         (local.set $s (br_on_cast_fail $not_string $string (local.get 0)))
+         (local.set $s (br_on_cast_fail $not_string (ref eq) (ref $string)
+            (local.get 0)))
          (local.set $len (array.len (local.get $s)))
          (local.set $s' (array.new $string (i32.const 0) (local.get $len)))
          (array.copy $string $string
@@ -168,9 +175,10 @@
       (if (ref.test i31 (local.get $v))
          (then (return (i31.new (i32.const 1000)))))
       (drop (block $not_block (result (ref eq))
-         (return (array.get $block
-                    (br_on_cast_fail $not_block $block (local.get $v))
-                    (i32.const 0)))))
+         (return
+            (array.get $block
+              (br_on_cast_fail $not_block (ref eq) (ref $block) (local.get $v))
+              (i32.const 0)))))
       (if (ref.test $string (local.get $v))
          (then (return (i31.new (global.get $string_tag)))))
       (if (ref.test $float (local.get $v))
diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat
index c5138586b1..136a7ee61f 100644
--- a/runtime/wasm/parsing.wat
+++ b/runtime/wasm/parsing.wat
@@ -299,7 +299,8 @@
                  (block $cont
                     (drop (block $not_block (result (ref eq))
                        (local.set $arg
-                          (br_on_cast_fail $not_block $block (local.get $varg)))
+                          (br_on_cast_fail $not_block (ref eq) (ref $block)
+                             (local.get $varg)))
                        (array.set $block (local.get $env)
                           (global.get $env_curr_char)
                           (array.get $block
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 6cfd7d2738..731460957e 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -40,10 +40,7 @@
     }
 
     let bindings =
-        {jstag:
-         WebAssembly.JSTag||
-         // ZZZ not supported in node yet
-         new WebAssembly.Tag({parameters:['externref'],results:[]}),
+        {jstag:WebAssembly.JSTag,
          identity:(x)=>x,
          from_bool:(x)=>!!x,
          get:(x,y)=>x[y],
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index da7e079277..17582700b9 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -27,7 +27,8 @@
       (local $a (ref $assoc))
       (block $tail (result (ref null eq))
          (loop $loop
-            (local.set $a (br_on_cast_fail $tail $assoc (local.get $l)))
+            (local.set $a
+               (br_on_cast_fail $tail (ref null eq) (ref $assoc) (local.get $l)))
             (if (i31.get_u
                    (ref.cast i31
                        (call $caml_string_equal
diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat
index 3eae74dc7e..39b29b454f 100644
--- a/runtime/wasm/str.wat
+++ b/runtime/wasm/str.wat
@@ -30,13 +30,13 @@
 
    (rec (type $stack (struct (field (ref null $stack)))))
    (type $pos
-      (sub $stack
+      (sub final $stack
          (struct
             (field $pos_previous (ref null $stack))
             (field $pc i32)
             (field $pos i32))))
    (type $undo
-      (sub $stack
+      (sub final $stack
          (struct
             (field $undo_previous (ref null $stack))
             (field $tbl (ref $int_array))
@@ -428,7 +428,7 @@
                (ref.cast $undo
                   (block $undo (result (ref $stack))
                      (local.set $p
-                        (br_on_cast_fail $undo $pos
+                        (br_on_cast_fail $undo (ref eq) (ref $pos)
                            (br_on_null $reject (local.get $stack))))
                      (local.set $pc (struct.get $pos $pc (local.get $p)))
                      (local.set $pos (struct.get $pos $pos (local.get $p)))
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 78aa07a6d3..14efab2dc5 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -22,9 +22,9 @@
       ))
    (type $custom (struct (field (ref $custom_operations))))
    (type $int32
-      (sub $custom (struct (field (ref $custom_operations)) (field i32))))
+      (sub final $custom (struct (field (ref $custom_operations)) (field i32))))
    (type $int64
-      (sub $custom (struct (field (ref $custom_operations)) (field i64))))
+      (sub final $custom (struct (field (ref $custom_operations)) (field i64))))
 
    (export "caml_bytes_equal" (func $caml_string_equal))
    (func $caml_string_equal (export "caml_string_equal")
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index 960b0d7b22..22230e69e4 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -37,7 +37,7 @@
          (ref.func $custom_hash_id)))
 
    (type $mutex
-      (sub $custom_with_id
+      (sub final $custom_with_id
          (struct
             (field (ref $custom_operations))
             (field i64)
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
index b31ee94d55..dc05b72f4c 100644
--- a/runtime/wasm/weak.wat
+++ b/runtime/wasm/weak.wat
@@ -81,9 +81,10 @@
          (return
             (array.new_fixed $block (i31.new (i32.const 0))
                (call $caml_obj_dup
-                  (br_on_cast_fail $no_copy $block
+                  (br_on_cast_fail $no_copy (ref eq) (ref $block)
                      (array.get $block
-                        (br_on_cast_fail $no_copy $block (local.get $r))
+                        (br_on_cast_fail $no_copy (ref eq) (ref $block)
+                           (local.get $r))
                         (i32.const 1))))))))
       (local.get $r))
 
@@ -141,7 +142,8 @@
       (drop (block $no_data (result (ref eq))
          (call $caml_ephe_set_data (local.get $x)
             (array.get $block
-               (br_on_cast_fail $no_data $block (local.get $opt_data))
+               (br_on_cast_fail $no_data (ref eq) (ref $block)
+                  (local.get $opt_data))
                (i32.const 1))))))
 
    (export "caml_weak_get" (func $caml_ephe_get_key))
@@ -181,9 +183,10 @@
          (return
             (array.new_fixed $block (i31.new (i32.const 0))
                (call $caml_obj_dup
-                  (br_on_cast_fail $no_copy $block
+                  (br_on_cast_fail $no_copy (ref eq) (ref $block)
                      (array.get $block
-                        (br_on_cast_fail $no_copy $block (local.get $r))
+                        (br_on_cast_fail $no_copy (ref eq) (ref $block)
+                           (local.get $r))
                         (i32.const 1))))))))
       (local.get $r))
 
@@ -307,6 +310,7 @@
          (return_call $caml_ephe_set_key
             (local.get $x) (local.get $i)
             (array.get $block
-               (br_on_cast_fail $unset $block (local.get $v)) (i32.const 1)))))
+               (br_on_cast_fail $unset (ref eq) (ref $block) (local.get $v))
+               (i32.const 1)))))
       (return_call $caml_ephe_unset_key (local.get $x) (local.get $i)))
 )

From 1fcd182c70fd48b58ff09b71bfabfe1924672974 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 12 Jul 2023 10:37:13 +0200
Subject: [PATCH 081/481] Fix JavaScript exception printer

---
 lib/js_of_ocaml/js.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index 7cfef13359..fe41c247fb 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -830,7 +830,9 @@ let _ =
 let _ =
   Printexc.register_printer (fun e ->
       let e : < .. > t = Obj.magic e in
-      if instanceof e array_constructor then None else Some (to_string e##toString))
+      if instanceof e error_constr
+      then Some (Js_error.to_string (Js_error.of_error e))
+      else None)
 
 let export_js (field : js_string t) x =
   Unsafe.set

From 6a24107340779db541f18c9043dc7ace7224b6bb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 12 Jul 2023 14:57:23 +0200
Subject: [PATCH 082/481] Runtime: convenience functions

---
 runtime/wasm/bigarray.wat | 28 ++++++++++++++++++++++++++++
 runtime/wasm/float.wat    |  3 +++
 runtime/wasm/int32.wat    |  3 +++
 runtime/wasm/int64.wat    |  3 +++
 4 files changed, 37 insertions(+)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index e31bbfe72e..5096236eb4 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -1799,4 +1799,32 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
       (local.get $s))
+
+   (func (export "caml_ba_get_kind") (param (ref eq)) (result i32)
+      (struct.get $bigarray $ba_kind (ref.cast $bigarray (local.get 0))))
+
+   (func (export "caml_ba_get_layout") (param (ref eq)) (result i32)
+      (struct.get $bigarray $ba_layout (ref.cast $bigarray (local.get 0))))
+
+   (func (export "caml_ba_get_data") (param (ref eq)) (result (ref extern))
+      (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get 0))))
+
+   (func (export "caml_ba_set_data") (param (ref eq)) (param (ref extern))
+      (struct.set $bigarray $ba_data (ref.cast $bigarray (local.get 0))
+         (local.get $1)))
+
+   (func (export "caml_ba_get_dim") (param (ref eq)) (result (ref $int_array))
+      (struct.get $bigarray $ba_dim (ref.cast $bigarray (local.get 0))))
+
+   (func (export "caml_ba_alloc")
+      (param $kind i32) (param $layout i32) (param $num_dims i32)
+      (param $data (ref extern)) (param $dim (ref $int_array))
+      (result (ref eq))
+      (struct.new $bigarray
+         (global.get $bigarray_ops)
+         (local.get $data)
+         (local.get $dim)
+         (local.get $num_dims)
+         (local.get $kind)
+         (local.get $layout)))
 )
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 490d76d30f..ee4a43c62b 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -28,6 +28,9 @@
    (global $nan (ref $chars)
       (array.new_fixed $chars (i32.const 110) (i32.const 97) (i32.const 110)))
 
+   (func (export "Double_val") (param (ref eq)) (result f64)
+      (struct.get $float 0 (ref.cast $float (local.get 0))))
+
    (func (export "caml_hexstring_of_float")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $b i64) (local $prec i32) (local $style i32)
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 909c862872..04d174c8c3 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -46,6 +46,9 @@
       (param $i i32) (result (ref eq))
       (struct.new $int32 (global.get $int32_ops) (local.get $i)))
 
+   (func (export "Int32_val") (param (ref eq)) (result i32)
+      (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
+
    (func (export "caml_int32_bswap") (param (ref eq)) (result (ref eq))
       (local $i i32)
       (local.set $i (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 2e0abd030d..48d7b58277 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -53,6 +53,9 @@
       (param $i i64) (result (ref eq))
       (struct.new $int64 (global.get $int64_ops) (local.get $i)))
 
+   (func (export "Int64_val") (param (ref eq)) (result i64)
+      (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
+
    (func (export "caml_int64_bswap") (param (ref eq)) (result (ref eq))
       (local $i i64)
       (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get 0))))

From 822fce0dc4606704fecf4ff196ba3bcc1287f3dd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 12 Jul 2023 14:58:53 +0200
Subject: [PATCH 083/481] Runtime / Unix function names: compatibility with
 OCaml 5

---
 runtime/wasm/unix.wat | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index ea5f9f2262..32db54db34 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -11,7 +11,8 @@
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
 
-   (func (export "unix_gettimeofday")
+   (export "caml_unix_gettimeofday" (func $unix_gettimeofday))
+   (func $unix_gettimeofday (export "unix_gettimeofday")
       (param (ref eq)) (result (ref eq))
       (struct.new $float (call $gettimeofday)))
 
@@ -30,16 +31,21 @@
          (i31.new (local.get $yday))
          (i31.new (local.get $isdst))))
 
-   (func (export "unix_gmtime") (param (ref eq)) (result (ref eq))
+   (export "caml_unix_gmtime" (func $unix_gmtime))
+   (func $unix_gmtime (export "unix_gmtime") (param (ref eq)) (result (ref eq))
       (call $gmtime (struct.get $float 0 (ref.cast $float (local.get 0)))))
 
-   (func (export "unix_localtime") (param (ref eq)) (result (ref eq))
+   (export "caml_unix_localtime" (func $unix_localtime))
+   (func $unix_localtime (export "unix_localtime")
+      (param (ref eq)) (result (ref eq))
       (call $localtime (struct.get $float 0 (ref.cast $float (local.get 0)))))
 
-   (func (export "unix_time") (param (ref eq)) (result (ref eq))
+   (export "caml_unix_time" (func $unix_time))
+   (func $unix_time (export "unix_time") (param (ref eq)) (result (ref eq))
       (struct.new $float (f64.floor (call $gettimeofday))))
 
-   (func (export "unix_mktime") (param (ref eq)) (result (ref eq))
+   (export "caml_unix_mktime" (func $unix_mktime))
+   (func $unix_mktime (export "unix_mktime") (param (ref eq)) (result (ref eq))
       (local $tm (ref $block)) (local $t f64)
       (local.set $tm (ref.cast $block (local.get 0)))
       (local.set $t
@@ -70,7 +76,8 @@
          (struct.new $float (local.get $t))
          (call $localtime (local.get $t))))
 
-   (func (export "unix_inet_addr_of_string")
+   (export "caml_unix_inet_addr_of_string" (func $unix_inet_addr_of_string))
+   (func $unix_inet_addr_of_string (export "unix_inet_addr_of_string")
       (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
 )

From ac7600041568a271d7ea18ff159cd9a3653f5dea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 12 Jul 2023 15:01:23 +0200
Subject: [PATCH 084/481] Runtime: update JavaScript-side dependencies

---
 runtime/wasm/deps.json | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 35a2b6a21d..5f452701fe 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,17 +1,13 @@
 [
   {
     "name": "root",
-    "reaches": ["init", "exn", "exit", "effects"],
+    "reaches": ["init", "exn", "exit"],
     "root": true
   },
   {
     "name": "init",
     "export": "_initialize"
   },
-  {
-    "name": "effects",
-    "export": "caml_start_fiber"
-  },
   {
     "name": "exn",
     "export": "ocaml_exception"
@@ -78,4 +74,13 @@
     "import": ["bindings", "localtime"],
     "reaches": ["alloc_tm"]
   },
+  {
+    "name": "effects",
+    "export": "caml_start_fiber"
+  },
+  {
+    "name": "start_fiber",
+    "import": ["bindings", "start_fiber"],
+    "reaches": ["effects"]
+  },
 ]

From 0700be53abf4bb8eef5265e1d6ad0a8a290529d7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 13 Jul 2023 17:29:30 +0200
Subject: [PATCH 085/481] Runtime: more bigstring functions + small changes

---
 runtime/wasm/bigarray.wat  |  2 +-
 runtime/wasm/bigstring.wat | 66 +++++++++++++++++++++++++++++++++++++-
 runtime/wasm/fs.wat        |  8 +++++
 runtime/wasm/int32.wat     |  3 +-
 runtime/wasm/obj.wat       |  2 +-
 5 files changed, 77 insertions(+), 4 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 5096236eb4..86d7d5af7f 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -353,7 +353,7 @@
                 (i32.or (i32.eq (local.get $kind) (i32.const 10))
                         (i32.eq (local.get $kind) (i32.const 11))))))
 
-  (func $caml_ba_create_buffer
+  (func $caml_ba_create_buffer (export "caml_ba_create_buffer")
      (param $kind i32) (param $sz i32) (result (ref extern))
      (local $l i64)
      (local.set $l
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 13f2029311..5442499636 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -7,6 +7,11 @@
      (func $caml_ba_to_typed_array (param (ref eq)) (result (ref eq))))
    (import "bigarray" "caml_ba_from_typed_array"
       (func $caml_ba_from_typed_array (param (ref eq)) (result (ref eq))))
+   (import "bigarray" "caml_ba_sub"
+      (func $caml_ba_sub
+         (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "bigarray" "caml_ba_fill"
+      (func $caml_ba_fill (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "bindings" "ta_create"
       (func $ta_create (param i32) (param anyref) (result anyref)))
    (import "bindings" "ta_get_ui8"
@@ -49,7 +54,7 @@
             (field $ba_layout i8)))) ;; layout
 
    (func (export "caml_hash_mix_bigstring")
-      (param $h i32) (param $vb (ref $bigarray)) (result i32)
+      (param $h i32) (param $vb (ref eq)) (result i32)
       (local $b (ref $bigarray))
       (local $data (ref extern))
       (local $len i32) (local $i i32) (local $w i32)
@@ -113,6 +118,13 @@
 
    (export "bigstring_of_typed_array" (func $caml_ba_from_typed_array))
 
+   (func (export "caml_bigstring_memset")
+      (param $s (ref eq)) (param $pos (ref eq)) (param $len (ref eq))
+      (param $v (ref eq)) (result (ref eq))
+      (return_call $caml_ba_fill
+         (call $caml_ba_sub (local.get $s) (local.get $pos) (local.get $len))
+         (local.get $v)))
+
    (func (export "caml_bigstring_memcmp")
       (param $s1 (ref eq)) (param $vpos1 (ref eq))
       (param $s2 (ref eq)) (param $vpos2 (ref eq))
@@ -144,6 +156,58 @@
                      (i32.lt_u (local.get $c1) (local.get $c2)))))))
       (i31.new (i32.const 0)))
 
+   (func (export "caml_bigstring_memcmp_string")
+      (param $s1 (ref eq)) (param $vpos1 (ref eq))
+      (param $vs2 (ref eq)) (param $vpos2 (ref eq))
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
+      (local $c1 i32) (local $c2 i32)
+      (local $d1 (ref extern))
+      (local $s2 (ref $string))
+      (local.set $d1
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s1))))
+      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+      (local.set $s2 (ref.cast $string (local.get $vs2)))
+      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (local.set $c1
+                  (call $ta_get_ui8 (local.get $d1)
+                     (i32.add (local.get $pos1) (local.get $i))))
+               (local.set $c2
+                  (array.get $string (local.get $s2)
+                     (i32.add (local.get $pos2) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br_if $loop (i32.eq (local.get $c1) (local.get $c2)))
+               (return
+                  (select (i31.new (i32.const -1)) (i31.new (i32.const 1))
+                     (i32.lt_u (local.get $c1) (local.get $c2)))))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_bigstring_memchr")
+      (param $s (ref eq)) (param $vc (ref eq))
+      (param $vpos (ref eq)) (param $vlen (ref eq)) (result (ref eq))
+      (local $pos i32) (local $len i32) (local $c i32)
+      (local $d (ref extern))
+      (local.set $c (i31.get_s (ref.cast i31 (local.get $vc))))
+      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (local.set $d
+         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s))))
+      (loop $loop
+         (if (i32.gt_s (local.get $len) (i32.const 0))
+            (then
+               (if (i32.eq (local.get $c)
+                      (call $ta_get_ui8 (local.get $d) (local.get $pos)))
+                  (then
+                     (return (i31.new (local.get $pos)))))
+               (local.set $len (i32.sub (local.get $len) (i32.const 1)))
+               (local.set $pos (i32.add (local.get $pos) (i32.const 1)))
+               (br $loop))))
+     (i31.new (i32.const -1)))
+
    (export "caml_bigstring_blit_string_to_ba"
       (func $caml_bigstring_blit_bytes_to_ba))
    (func $caml_bigstring_blit_bytes_to_ba
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index 37243fcf18..baf0e35e35 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -1,6 +1,8 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
 
+   (type $string (array (mut i8)))
+
    (func (export "caml_sys_getcwd")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
@@ -37,6 +39,12 @@
       (call $log_js (string.const "caml_sys_file_exists"))
       (i31.new (i32.const 0)))
 
+   (func (export "caml_read_file_content")
+      (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_read_file_content"))
+      (array.new_fixed $string))
+
    (func (export "caml_fs_init") (result (ref eq))
       (i31.new (i32.const 0)))
 )
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 04d174c8c3..62a4a02b26 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -46,7 +46,8 @@
       (param $i i32) (result (ref eq))
       (struct.new $int32 (global.get $int32_ops) (local.get $i)))
 
-   (func (export "Int32_val") (param (ref eq)) (result i32)
+   (export "Nativeint_val" (func $Int32_val))
+   (func $Int32_val (export "Int32_val") (param (ref eq)) (result i32)
       (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
 
    (func (export "caml_int32_bswap") (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 5847b3c1af..84a9b69102 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -68,7 +68,7 @@
 
    (global $forcing_tag i32 (i32.const 244))
    (global $cont_tag i32 (i32.const 245))
-   (global $lazy_tag i32 (i32.const 246))
+   (global $lazy_tag (export "lazy_tag") i32 (i32.const 246))
    (global $closure_tag i32 (i32.const 247))
    (global $object_tag (export "object_tag") i32 (i32.const 248))
    (global $forward_tag (export "forward_tag") i32 (i32.const 250))

From ee7cd9ddc68e2019c26306f5d4a553ef3c32512e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 14 Jul 2023 14:36:39 +0200
Subject: [PATCH 086/481] Runtime: remove workarounds for older versions of V8

---
 runtime/wasm/compare.wat | 39 ++++++++++-----------------------------
 runtime/wasm/hash.wat    | 23 ++++++++---------------
 runtime/wasm/runtime.js  |  1 -
 runtime/wasm/string.wat  | 14 --------------
 4 files changed, 18 insertions(+), 59 deletions(-)

diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index f91f1cc9d2..847183ed19 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -1,8 +1,4 @@
 (module
-   (import "bindings" "is_string"
-      (func $ref_test_string (param anyref) (result i32)))
-   (import "bindings" "identity"
-      (func $ref_cast_string (param anyref) (result (ref string))))
    (import "bindings" "equals"
       (func $equals (param anyref) (param anyref) (result i32)))
    (import "obj" "forward_tag" (global $forward_tag i32))
@@ -167,27 +163,13 @@
       (local.set $n (struct.get $compare_stack 0 (local.get $stack)))
       (if (i32.ge_s (local.get $n) (i32.const 0))
          (then
-(; ZZZ
             (local.set $n (i32.add (local.get $n) (i32.const 1)))
             (array.fill $block_array
                (struct.get $compare_stack 1 (local.get $stack))
                (i32.const 0) (global.get $dummy_block) (local.get $n))
             (array.fill $block_array
                (struct.get $compare_stack 2 (local.get $stack))
-               (i32.const 0) (global.get $dummy_block) (local.get $n))
-;)
-            (loop $loop
-               (if (i32.ge_s (local.get $n) (i32.const 0))
-                  (then
-                     (array.set $block_array
-                        (struct.get $compare_stack 1 (local.get $stack))
-                        (local.get $n) (global.get $dummy_block))
-                     (array.set $block_array
-                        (struct.get $compare_stack 2 (local.get $stack))
-                        (local.get $n) (global.get $dummy_block))
-                     (local.set $n (i32.sub (local.get $n) (i32.const 1)))
-                     (br $loop))))
-          )))
+               (i32.const 0) (global.get $dummy_block) (local.get $n)))))
 
    (func $compare_val
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32)
@@ -466,16 +448,15 @@
                      (struct.get $js 0
                         (br_on_cast_fail $heterogeneous (ref eq) (ref $js)
                            (local.get $v2))))
-                  ;; ZZZ use ref.test / ref.cast
-                  (if (i32.and (call $ref_test_string (local.get $js1))
-                               (call $ref_test_string (local.get $js2)))
-                     (then
-                        (local.set $res
-                           (string.compare
-                              (call $ref_cast_string (local.get $js1))
-                              (call $ref_cast_string (local.get $js2))))
-                        (br_if $next_item (i32.eqz (local.get $res)))
-                        (return (local.get $res))))
+                  (drop (block $not_jsstring (result anyref)
+                     (local.set $res
+                        (string.compare
+                           (br_on_cast_fail $not_jsstring anyref (ref string)
+                              (local.get $js1))
+                           (br_on_cast_fail $not_jsstring anyref (ref string)
+                              (local.get $js2))))
+                     (br_if $next_item (i32.eqz (local.get $res)))
+                     (return (local.get $res))))
                   ;; We cannot order two JavaScript objects,
                   ;; but we can tell whether they are equal or not
                   (if (i32.eqz (local.get $total))
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index d4f9ee0432..f4c17608da 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -1,10 +1,6 @@
 (module
    (import "obj" "object_tag" (global $object_tag i32))
    (import "obj" "forward_tag" (global $forward_tag i32))
-   (import "bindings" "is_string"
-      (func $ref_test_string (param anyref) (result i32)))
-   (import "bindings" "identity"
-      (func $ref_cast_string (param anyref) (result (ref string))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
 
    (type $block (array (mut (ref eq))))
@@ -136,7 +132,7 @@
    (func $caml_hash_mix_jsstring
       (param $h i32) (param $s (ref eq)) (result i32)
       (return_call $caml_hash_mix_int (local.get $h)
-         (string.hash (call $ref_cast_string (call $unwrap (local.get $s))))))
+         (string.hash (ref.cast string (call $unwrap (local.get $s))))))
 
    (global $HASH_QUEUE_SIZE i32 (i32.const 256))
    (global $MAX_FORWARD_DEREFERENCE i32 (i32.const 1000))
@@ -274,19 +270,16 @@
                                           (local.get $v))))))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
-                  (drop (block $not_js (result (ref eq))
+                  (drop (block $not_jsstring anyref
                      (local.set $str
                         (struct.get $js 0
-                           (br_on_cast_fail $not_js (ref eq) (ref $js)
+                           (br_on_cast_fail $not_jsstring (ref eq) (ref $js)
                               (local.get $v))))
-                     ;; ZZZ use ref.test / ref.cast
-                     (if (call $ref_test_string (local.get $str))
-                        (then
-                           (local.set $h
-                              (call $caml_hash_mix_int (local.get $h)
-                                 (string.hash
-                                    (call $ref_cast_string
-                                       (local.get $str)))))))
+                     (local.set $h
+                        (call $caml_hash_mix_int (local.get $h)
+                           (string.hash
+                              (br_on_cast_fail $not_jsstring anyref (ref string)
+                                 (local.get $str)))))
                      (i31.new (i32.const 0))))
                   ;; closures and continuations and other js values are ignored
                   (br $loop)))))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 731460957e..00e98500f2 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -61,7 +61,6 @@
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,
-         is_string:(v)=>+(typeof v==="string"),
          ta_create:(k,sz)=> new(typed_arrays[k])(sz),
          ta_normalize:(a)=>
            a instanceof Uint32Array?
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 14efab2dc5..e0acd74fc8 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -153,24 +153,10 @@
       (param $v (ref eq)) (param $offset (ref eq))
       (param $len (ref eq)) (param $init (ref eq))
       (result (ref eq))
-(;ZZZ V8 bug
       (array.fill $string (ref.cast $string (local.get $v))
          (i31.get_u (ref.cast i31 (local.get $offset)))
          (i31.get_u (ref.cast i31 (local.get $init)))
          (i31.get_u (ref.cast i31 (local.get $len))))
-;)
-      (local $s (ref $string)) (local $i i32) (local $limit i32) (local $c i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get $offset))))
-      (local.set $limit
-         (i32.add (local.get $i) (i31.get_u (ref.cast i31 (local.get $len)))))
-      (local.set $c (i31.get_u (ref.cast i31 (local.get $init))))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $limit))
-            (then
-               (array.set $string (local.get $s) (local.get $i) (local.get $c))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
       (i31.new (i32.const 0)))
 
    (export "caml_string_get16" (func $caml_bytes_get16))

From a2748e03e95e63624f1bc89b212b71aec30efd4c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 17 Jul 2023 17:18:25 +0200
Subject: [PATCH 087/481] Runtime: improved eval function

The legacy variable joo_global_object should be bound when evaluating
JavaScript code.
---
 runtime/wasm/runtime.js | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 00e98500f2..b0839fd42e 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,5 +1,5 @@
 #!/usr/bin/env -S node --experimental-wasm-stringref --experimental-wasm-gc
-(async function () {
+(async function (eval_function) {
     "use strict";
     const src = 'CODE';
     function loadRelative(src) {
@@ -48,7 +48,7 @@
          delete:(x,y)=>delete x[y],
          instanceof:(x,y)=>x instanceof y,
          typeof:(x)=>typeof x,
-         eval:eval,
+         eval:eval_function,
          equals:(x,y)=>x==y,
          strict_equals:(x,y)=>x===y,
          fun_call:(f,o,args)=>f.apply(o,args),
@@ -280,4 +280,4 @@
             throw e;
         }
     }
-})()
+})(((joo_global_object,globalThis)=>(x)=>eval(x))(globalThis,globalThis));

From ab1fe050488f34cee7051fd28e6a5aa194297bb2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 17 Jul 2023 15:27:29 +0200
Subject: [PATCH 088/481] Include JavaScript runtime files

---
 compiler/bin-wasm_of_ocaml/compile.ml | 64 +++++++++++++++++++++++++--
 1 file changed, 60 insertions(+), 4 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 2dd81995dc..8638fcbdab 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -124,17 +124,73 @@ let escape_string s =
   done;
   Buffer.contents b
 
-let copy_js_runtime wasm_file output_file =
+let build_js_runtime wasm_file output_file =
+  let wrap_in_iife ~use_strict js =
+    let module J = Javascript in
+    let var ident e = J.variable_declaration [ J.ident ident, (e, J.N) ], J.N in
+    let expr e = J.Expression_statement e, J.N in
+    let freenames =
+      let o = new Js_traverse.free in
+      let (_ : J.program) = o#program js in
+      o#get_free
+    in
+    let export_shim js =
+      if J.IdentSet.mem (J.ident Constant.exports_) freenames
+      then
+        let export_node =
+          let s =
+            Printf.sprintf
+              {|((typeof module === 'object' && module.exports) || %s)|}
+              Constant.global_object
+          in
+          let lex = Parse_js.Lexer.of_string s in
+          Parse_js.parse_expr lex
+        in
+        var Constant.exports_ export_node :: js
+      else js
+    in
+    let old_global_object_shim js =
+      if J.IdentSet.mem (J.ident Constant.old_global_object_) freenames
+      then
+        var Constant.old_global_object_ (J.EVar (J.ident Constant.global_object_)) :: js
+      else js
+    in
+
+    let efun args body = J.EFun (None, J.fun_ args body J.U) in
+    let mk f =
+      let js = export_shim js in
+      let js = old_global_object_shim js in
+      let js =
+        if use_strict
+        then expr (J.EStr (Utf8_string.of_string_exn "use strict")) :: js
+        else js
+      in
+      f [ J.ident Constant.global_object_ ] js
+    in
+    expr (J.call (mk efun) [ J.EVar (J.ident Constant.global_object_) ] J.N)
+  in
+  let always_required_js =
+    List.map
+      Linker.((link [] (init ())).always_required_codes)
+      ~f:(fun { Linker.program; _ } -> wrap_in_iife ~use_strict:false program)
+  in
+  let b = Buffer.create 1024 in
+  let f = Pretty_print.to_buffer b in
+  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
+  ignore (Js_output.program f always_required_js);
   let s = Wa_runtime.js_runtime in
   let rec find i =
     if String.equal (String.sub s ~pos:i ~len:4) "CODE" then i else find (i + 1)
   in
-  let i = find 0 in
+  let i = String.index s '\n' + 1 in
+  let j = find 0 in
   write_file
     output_file
     (String.sub s ~pos:0 ~len:i
+    ^ Buffer.contents b
+    ^ String.sub s ~pos:i ~len:(j - i)
     ^ escape_string (Filename.basename wasm_file)
-    ^ String.sub s ~pos:(i + 4) ~len:(String.length s - i - 4))
+    ^ String.sub s ~pos:(j + 4) ~len:(String.length s - j - 4))
 
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
   Wa_generate.init ();
@@ -212,7 +268,7 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
        let wasm_file = Filename.chop_extension (fst output_file) ^ ".wasm" in
        output_gen wat_file (output code ~standalone:true);
        link_and_optimize runtime_wasm_files wat_file wasm_file;
-       copy_js_runtime wasm_file (fst output_file)
+       build_js_runtime wasm_file (fst output_file)
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());
   Debug.stop_profiling ()

From 2e979096fd78d4e30f830e6c60be0aa10d38753b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 13 Jul 2023 19:32:26 +0200
Subject: [PATCH 089/481] Fix: do not duplicate constant strings

---
 compiler/lib/eval.ml | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index daab6b0f60..c7bdd00494 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -295,13 +295,14 @@ let eval_instr ~target info ((x, loc) as i) =
                 , Prim
                     ( prim
                     , List.map2 prim_args prim_args' ~f:(fun arg c ->
-                          match c with
-                          | Some ((Int _ | Float _ | NativeString _) as c) -> Pc c
-                          | Some (String _ as c) when Config.Flag.use_js_string () -> Pc c
-                          | Some _
+                          match c, target with
+                          | Some ((Int _ | Float _ | NativeString _) as c), _ -> Pc c
+                          | Some (String _ as c), `JavaScript
+                            when Config.Flag.use_js_string () -> Pc c
+                          | Some _, _
                           (* do not be duplicated other constant as
                               they're not represented with constant in javascript. *)
-                          | None -> arg) ) )
+                          | None, _ -> arg) ) )
             , loc )
           ])
   | _ -> [ i ]

From d8e919d309f89299e6da20b0c5283250ecb90ebf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 21 Jul 2023 19:00:37 +0200
Subject: [PATCH 090/481] Do not use OCaml physical equality on JavaScript
 values

---
 lib/js_of_ocaml/dom.ml      |  2 +-
 lib/js_of_ocaml/dom_html.ml | 12 ++++++------
 lib/js_of_ocaml/dom_svg.ml  |  2 +-
 lib/js_of_ocaml/file.ml     |  2 +-
 lib/js_of_ocaml/json.ml     |  2 +-
 lib/js_of_ocaml/url.ml      |  2 +-
 lib/js_of_ocaml/worker.ml   |  6 +++---
 7 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/lib/js_of_ocaml/dom.ml b/lib/js_of_ocaml/dom.ml
index 47bf5b3abd..cd99f1d902 100644
--- a/lib/js_of_ocaml/dom.ml
+++ b/lib/js_of_ocaml/dom.ml
@@ -370,7 +370,7 @@ class type event_listener_options =
   end
 
 let addEventListenerWithOptions (e : (< .. > as 'a) t) typ ?capture ?once ?passive h =
-  if (Js.Unsafe.coerce e)##.addEventListener == Js.undefined
+  if not (Js.Optdef.test (Js.Unsafe.coerce e)##.addEventListener)
   then
     let ev = (Js.string "on")##concat typ in
     let callback e = Js.Unsafe.call (h, e, [||]) in
diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index 9e41607037..6108e2b017 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -2556,8 +2556,8 @@ let rec unsafeCreateElementEx ?_type ?name doc elt =
                  Js.Unsafe.coerce
                    (document##createElement (Js.string "<input name=\"x\">"))
                in
-               el##.tagName##toLowerCase == Js.string "input"
-               && el##.name == Js.string "x"
+               Js.equals el##.tagName##toLowerCase (Js.string "input")
+               && Js.equals el##.name (Js.string "x")
              with _ -> false
           then `Extended
           else `Standard;
@@ -2740,12 +2740,12 @@ let html_element : htmlElement t constr = Js.Unsafe.global##._HTMLElement
 
 module CoerceTo = struct
   let element : #Dom.node Js.t -> element Js.t Js.opt =
-    if def html_element == undefined
+    if not (Js.Optdef.test (def html_element))
     then
       (* ie < 9 does not have HTMLElement: we have to cheat to check
          that something is an html element *)
       fun e ->
-      if def (Js.Unsafe.coerce e)##.innerHTML == undefined
+      if not (Js.Optdef.test (def (Js.Unsafe.coerce e)##.innerHTML))
       then Js.null
       else Js.some (Js.Unsafe.coerce e)
     else
@@ -2753,7 +2753,7 @@ module CoerceTo = struct
       if Js.instanceof e html_element then Js.some (Js.Unsafe.coerce e) else Js.null
 
   let unsafeCoerce tag (e : #element t) =
-    if e##.tagName##toLowerCase == Js.string tag
+    if Js.equals e##.tagName##toLowerCase (Js.string tag)
     then Js.some (Js.Unsafe.coerce e)
     else Js.null
 
@@ -2880,7 +2880,7 @@ module CoerceTo = struct
   let video e = unsafeCoerce "video" e
 
   let unsafeCoerceEvent constr (ev : #event t) =
-    if def constr != undefined && Js.instanceof ev constr
+    if Js.Optdef.test (def constr) && Js.instanceof ev constr
     then Js.some (Js.Unsafe.coerce ev)
     else Js.null
 
diff --git a/lib/js_of_ocaml/dom_svg.ml b/lib/js_of_ocaml/dom_svg.ml
index 06162871e2..8af42a441f 100644
--- a/lib/js_of_ocaml/dom_svg.ml
+++ b/lib/js_of_ocaml/dom_svg.ml
@@ -2136,7 +2136,7 @@ module CoerceTo = struct
     if Js.instanceof e svg_element then Js.some (Js.Unsafe.coerce e) else Js.null
 
   let unsafeCoerce (e : #element t) tag =
-    if e##.tagName##toLowerCase == Js.string tag
+    if Js.equals e##.tagName##toLowerCase (Js.string tag)
     then Js.some (Js.Unsafe.coerce e)
     else Js.null
 
diff --git a/lib/js_of_ocaml/file.ml b/lib/js_of_ocaml/file.ml
index 445654726b..431ce9134d 100644
--- a/lib/js_of_ocaml/file.ml
+++ b/lib/js_of_ocaml/file.ml
@@ -126,7 +126,7 @@ module CoerceTo = struct
     if instanceof e blob_constr then Js.some (Unsafe.coerce e : #blob t) else Js.null
 
   let string (e : file_any) =
-    if typeof e == string "string"
+    if Js.equals (typeof e) (Js.string "string")
     then Js.some (Unsafe.coerce e : js_string t)
     else Js.null
 
diff --git a/lib/js_of_ocaml/json.ml b/lib/js_of_ocaml/json.ml
index c3afe1851f..3d666ab968 100644
--- a/lib/js_of_ocaml/json.ml
+++ b/lib/js_of_ocaml/json.ml
@@ -37,7 +37,7 @@ let json : json Js.t = Unsafe.global##._JSON
 
 let input_reviver =
   let reviver _this _key (value : Unsafe.any) : Obj.t =
-    if typeof value == string "string"
+    if Js.equals (typeof value) (string "string")
     then Obj.repr (to_bytestring (Unsafe.coerce value))
     else if instanceof value Js.array_empty
             && (Unsafe.coerce value)##.length == 4
diff --git a/lib/js_of_ocaml/url.ml b/lib/js_of_ocaml/url.ml
index fbd2945eb6..1be4dfe656 100644
--- a/lib/js_of_ocaml/url.ml
+++ b/lib/js_of_ocaml/url.ml
@@ -304,7 +304,7 @@ module Current = struct
 
   let arguments =
     decode_arguments_js_string
-      (if l##.search##charAt 0 == Js.string "?"
+      (if Js.equals (l##.search##charAt 0) (Js.string "?")
        then l##.search##slice_end 1
        else l##.search)
 
diff --git a/lib/js_of_ocaml/worker.ml b/lib/js_of_ocaml/worker.ml
index 732ae43725..f163f9aa68 100644
--- a/lib/js_of_ocaml/worker.ml
+++ b/lib/js_of_ocaml/worker.ml
@@ -61,19 +61,19 @@ let worker = Unsafe.global##._Worker
 let create script = new%js worker (string script)
 
 let import_scripts scripts : unit =
-  if Unsafe.global##.importScripts == undefined
+  if not (Js.Optdef.test Unsafe.global##.importScripts)
   then invalid_arg "Worker.import_scripts is undefined";
   Unsafe.fun_call
     Unsafe.global##.importScripts
     (Array.map (fun s -> Unsafe.inject (string s)) (Array.of_list scripts))
 
 let set_onmessage handler =
-  if Unsafe.global##.onmessage == undefined
+  if not (Js.Optdef.test Unsafe.global##.onmessage)
   then invalid_arg "Worker.onmessage is undefined";
   let js_handler (ev : 'a messageEvent Js.t) = handler ev##.data in
   Unsafe.global##.onmessage := wrap_callback js_handler
 
 let post_message msg =
-  if Unsafe.global##.postMessage == undefined
+  if not (Js.Optdef.test Unsafe.global##.postMessage)
   then invalid_arg "Worker.onmessage is undefined";
   Unsafe.global##postMessage msg

From 9170c1c4f0924ad23f0e64932c49bfe5b535a9d6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 24 Jul 2023 13:52:32 +0200
Subject: [PATCH 091/481] Lib: update typing of typed arrays

---
 lib/js_of_ocaml/typed_array.ml  | 72 ++++++++++++++++++++-------------
 lib/js_of_ocaml/typed_array.mli | 69 +++++++++++++++++++------------
 lib/tests/test_typed_array.ml   | 59 ++++++++++++++++++---------
 3 files changed, 128 insertions(+), 72 deletions(-)

diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index 85011cb88d..3054b3d22b 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -20,6 +20,8 @@
 open! Import
 open Js
 
+type int32 = float Js.t
+
 type uint32 = float Js.t
 
 class type arrayBuffer =
@@ -42,7 +44,7 @@ class type arrayBufferView =
     method byteLength : int readonly_prop
   end
 
-class type ['a, 'b] typedArray =
+class type ['a, 'b, 'c] typedArray =
   object
     inherit arrayBufferView
 
@@ -52,47 +54,61 @@ class type ['a, 'b] typedArray =
 
     method set_fromArray : 'a js_array t -> int -> unit meth
 
-    method set_fromTypedArray : ('a, 'b) typedArray t -> int -> unit meth
+    method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth
 
-    method subarray : int -> int -> ('a, 'b) typedArray t meth
+    method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method subarray_toEnd : int -> ('a, 'b) typedArray t meth
+    method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice : int -> int -> ('a, 'b) typedArray t meth
+    method slice : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice_toEnd : int -> ('a, 'b) typedArray t meth
+    method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
     (* This fake method is needed for typing purposes.
        Without it, ['b] would not be constrained. *)
-    method _content_type_ : 'b optdef readonly_prop
+    method _content_type_ : ('b * 'c) optdef readonly_prop
   end
 
-type int8Array = (int, Bigarray.int8_signed_elt) typedArray
+type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray
+
+type uint8Array = (int, int, Bigarray.int8_unsigned_elt) typedArray
 
-type uint8Array = (int, Bigarray.int8_unsigned_elt) typedArray
+type int16Array = (int, int, Bigarray.int16_signed_elt) typedArray
 
-type int16Array = (int, Bigarray.int16_signed_elt) typedArray
+type uint16Array = (int, int, Bigarray.int16_unsigned_elt) typedArray
 
-type uint16Array = (int, Bigarray.int16_unsigned_elt) typedArray
+type int32Array = (int32, Int32.t, Bigarray.int32_elt) typedArray
 
-type int32Array = (int32, Bigarray.int32_elt) typedArray
+type uint32Array = (uint32, Int32.t, Bigarray.int32_elt) typedArray
 
-type uint32Array = (int32, Bigarray.int32_elt) typedArray
+type float32Array = (float Js.t, float, Bigarray.float32_elt) typedArray
 
-type float32Array = (float Js.t, Bigarray.float32_elt) typedArray
+type float64Array = (float Js.t, float, Bigarray.float64_elt) typedArray
 
-type float64Array = (float Js.t, Bigarray.float64_elt) typedArray
+type ('bigarray, 'typed_array, 'elt) type' =
+  | Char : (int, char, Bigarray.int8_unsigned_elt) type'
+  | Int8_signed : (int, int, Bigarray.int8_signed_elt) type'
+  | Int8_unsigned : (int, int, Bigarray.int8_unsigned_elt) type'
+  | Int16_signed : (int, int, Bigarray.int16_signed_elt) type'
+  | Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) type'
+  | Int32_signed : (int32, Int32.t, Bigarray.int32_elt) type'
+  | Int32_unsigned : (uint32, Int32.t, Bigarray.int32_elt) type'
+  | Float32 : (float Js.t, float, Bigarray.float32_elt) type'
+  | Float64 : (float Js.t, float, Bigarray.float64_elt) type'
 
-external kind : ('a, 'b) typedArray t -> ('a, 'b) Bigarray.kind
+external kind :
+  ('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
   = "caml_ba_kind_of_typed_array"
 
-external from_genarray :
-  ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t -> ('a, 'b) typedArray t
-  = "caml_ba_to_typed_array"
+external from_genarray_impl :
+     ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
+  -> ('typed_array, 'bigarray, 'elt) typedArray t = "caml_ba_to_typed_array"
 
 external to_genarray :
-  ('a, 'b) typedArray t -> ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t
-  = "caml_ba_from_typed_array"
+     ('typed_array, 'bigarray, 'elt) typedArray t
+  -> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t = "caml_ba_from_typed_array"
+
+let from_genarray _ a = from_genarray_impl a
 
 let int8Array = Js.Unsafe.global##._Int8Array
 
@@ -174,12 +190,12 @@ let float64Array_fromBuffer = float64Array
 
 let float64Array_inBuffer = float64Array
 
-let set : ('a, 'b) typedArray t -> int -> 'a -> unit =
+let set : ('a, _, _) typedArray t -> int -> 'a -> unit =
  fun a i v -> array_set (Unsafe.coerce a) i v
 
-let get : ('a, 'b) typedArray t -> int -> 'a optdef = fun a i -> Js.Unsafe.get a i
+let get : ('a, _, _) typedArray t -> int -> 'a optdef = fun a i -> Js.Unsafe.get a i
 
-let unsafe_get : ('a, 'b) typedArray t -> int -> 'a = fun a i -> Js.Unsafe.get a i
+let unsafe_get : ('a, _, _) typedArray t -> int -> 'a = fun a i -> Js.Unsafe.get a i
 
 class type dataView =
   object
@@ -197,9 +213,9 @@ class type dataView =
 
     method getUint16_ : int -> bool t -> int meth
 
-    method getInt32 : int -> int meth
+    method getInt32 : int -> int32 meth
 
-    method getInt32_ : int -> bool t -> int meth
+    method getInt32_ : int -> bool t -> int32 meth
 
     method getUint32 : int -> uint32 meth
 
@@ -225,9 +241,9 @@ class type dataView =
 
     method setUint16_ : int -> int -> bool t -> unit meth
 
-    method setInt32 : int -> int -> unit meth
+    method setInt32 : int -> int32 -> unit meth
 
-    method setInt32_ : int -> int -> bool t -> unit meth
+    method setInt32_ : int -> int32 -> bool t -> unit meth
 
     method setUint32 : int -> uint32 -> unit meth
 
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index bd1ca64fd5..7b03eb435c 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -22,6 +22,8 @@
 
 open Js
 
+type int32 = float Js.t
+
 type uint32 = float Js.t
 
 class type arrayBuffer =
@@ -44,7 +46,7 @@ class type arrayBufferView =
     method byteLength : int readonly_prop
   end
 
-class type ['a, 'b] typedArray =
+class type ['a, 'b, 'c] typedArray =
   object
     inherit arrayBufferView
 
@@ -54,41 +56,58 @@ class type ['a, 'b] typedArray =
 
     method set_fromArray : 'a js_array t -> int -> unit meth
 
-    method set_fromTypedArray : ('a, 'b) typedArray t -> int -> unit meth
+    method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth
 
-    method subarray : int -> int -> ('a, 'b) typedArray t meth
+    method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method subarray_toEnd : int -> ('a, 'b) typedArray t meth
+    method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice : int -> int -> ('a, 'b) typedArray t meth
+    method slice : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice_toEnd : int -> ('a, 'b) typedArray t meth
+    method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-    method _content_type_ : 'b optdef readonly_prop
+    (* This fake method is needed for typing purposes.
+       Without it, ['b] would not be constrained. *)
+    method _content_type_ : ('b * 'c) optdef readonly_prop
   end
 
-type int8Array = (int, Bigarray.int8_signed_elt) typedArray
+type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray
+
+type uint8Array = (int, int, Bigarray.int8_unsigned_elt) typedArray
 
-type uint8Array = (int, Bigarray.int8_unsigned_elt) typedArray
+type int16Array = (int, int, Bigarray.int16_signed_elt) typedArray
 
-type int16Array = (int, Bigarray.int16_signed_elt) typedArray
+type uint16Array = (int, int, Bigarray.int16_unsigned_elt) typedArray
 
-type uint16Array = (int, Bigarray.int16_unsigned_elt) typedArray
+type int32Array = (int32, Int32.t, Bigarray.int32_elt) typedArray
 
-type int32Array = (int32, Bigarray.int32_elt) typedArray
+type uint32Array = (uint32, Int32.t, Bigarray.int32_elt) typedArray
 
-type uint32Array = (int32, Bigarray.int32_elt) typedArray
+type float32Array = (float Js.t, float, Bigarray.float32_elt) typedArray
 
-type float32Array = (float Js.t, Bigarray.float32_elt) typedArray
+type float64Array = (float Js.t, float, Bigarray.float64_elt) typedArray
 
-type float64Array = (float Js.t, Bigarray.float64_elt) typedArray
+type ('bigarray, 'typed_array, 'elt) type' =
+  | Char : (int, char, Bigarray.int8_unsigned_elt) type'
+  | Int8_signed : (int, int, Bigarray.int8_signed_elt) type'
+  | Int8_unsigned : (int, int, Bigarray.int8_unsigned_elt) type'
+  | Int16_signed : (int, int, Bigarray.int16_signed_elt) type'
+  | Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) type'
+  | Int32_signed : (int32, Int32.t, Bigarray.int32_elt) type'
+  | Int32_unsigned : (uint32, Int32.t, Bigarray.int32_elt) type'
+  | Float32 : (float Js.t, float, Bigarray.float32_elt) type'
+  | Float64 : (float Js.t, float, Bigarray.float64_elt) type'
 
-val kind : ('a, 'b) typedArray t -> ('a, 'b) Bigarray.kind
+val kind : ('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
 
 val from_genarray :
-  ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t -> ('a, 'b) typedArray t
+     ('typed_array, 'bigarray, 'elt) type'
+  -> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
+  -> ('typed_array, 'bigarray, 'elt) typedArray t
 
-val to_genarray : ('a, 'b) typedArray t -> ('a, 'b, Bigarray.c_layout) Bigarray.Genarray.t
+val to_genarray :
+     ('typed_array, 'bigarray, 'elt) typedArray t
+  -> ('bigarray, 'elt, Bigarray.c_layout) Bigarray.Genarray.t
 
 val int8Array : (int -> int8Array t) constr
 
@@ -170,11 +189,11 @@ val float64Array_fromBuffer : (arrayBuffer t -> float64Array t) constr
 
 val float64Array_inBuffer : (arrayBuffer t -> int -> int -> float64Array t) constr
 
-val set : ('a, 'b) typedArray t -> int -> 'a -> unit
+val set : ('a, _, _) typedArray t -> int -> 'a -> unit
 
-val get : ('a, 'b) typedArray t -> int -> 'a optdef
+val get : ('a, _, _) typedArray t -> int -> 'a optdef
 
-val unsafe_get : ('a, 'b) typedArray t -> int -> 'a
+val unsafe_get : ('a, _, _) typedArray t -> int -> 'a
 
 class type dataView =
   object
@@ -192,9 +211,9 @@ class type dataView =
 
     method getUint16_ : int -> bool t -> int meth
 
-    method getInt32 : int -> int meth
+    method getInt32 : int -> int32 meth
 
-    method getInt32_ : int -> bool t -> int meth
+    method getInt32_ : int -> bool t -> int32 meth
 
     method getUint32 : int -> uint32 meth
 
@@ -220,9 +239,9 @@ class type dataView =
 
     method setUint16_ : int -> int -> bool t -> unit meth
 
-    method setInt32 : int -> int -> unit meth
+    method setInt32 : int -> int32 -> unit meth
 
-    method setInt32_ : int -> int -> bool t -> unit meth
+    method setInt32_ : int -> int32 -> bool t -> unit meth
 
     method setUint32 : int -> uint32 -> unit meth
 
diff --git a/lib/tests/test_typed_array.ml b/lib/tests/test_typed_array.ml
index b81df76f19..bf2c733b31 100644
--- a/lib/tests/test_typed_array.ml
+++ b/lib/tests/test_typed_array.ml
@@ -18,24 +18,24 @@
 
 open Js_of_ocaml
 open Typed_array
-open Bigarray
+open! Bigarray
 
 type ('a, 'b) ba = ('a, 'b, c_layout) Genarray.t
 
-type ('a, 'b) ta = ('a, 'b) typedArray
+type ('a, 'b, 'c) ta = ('a, 'b, 'c) typedArray
 
 module Setup = struct
-  type (_, _) t =
-    | Int8 : (int, Bigarray.int8_signed_elt) t
-    | Uint8 : (int, Bigarray.int8_unsigned_elt) t
-    | Int16 : (int, Bigarray.int16_signed_elt) t
-    | Uint16 : (int, Bigarray.int16_unsigned_elt) t
-    | Int32 : (int32, Bigarray.int32_elt) t
-    | Float32 : (float, Bigarray.float32_elt) t
-    | Float64 : (float, Bigarray.float64_elt) t
+  type (_, _, _) t =
+    | Int8 : (int, int, Bigarray.int8_signed_elt) t
+    | Uint8 : (int, int, Bigarray.int8_unsigned_elt) t
+    | Int16 : (int, int, Bigarray.int16_signed_elt) t
+    | Uint16 : (int, int, Bigarray.int16_unsigned_elt) t
+    | Int32 : (float Js.t, Int32.t, Bigarray.int32_elt) t
+    | Float32 : (float Js.t, float, Bigarray.float32_elt) t
+    | Float64 : (float Js.t, float, Bigarray.float64_elt) t
 end
 
-let kind_of_setup : type a b. (a, b) Setup.t -> (a, b) kind = function
+let kind_of_setup : type a b c. (a, b, c) Setup.t -> (b, c) kind = function
   | Setup.Int8 -> Int8_signed
   | Setup.Uint8 -> Int8_unsigned
   | Setup.Int16 -> Int16_signed
@@ -44,7 +44,25 @@ let kind_of_setup : type a b. (a, b) Setup.t -> (a, b) kind = function
   | Setup.Float32 -> Float32
   | Setup.Float64 -> Float64
 
-let ta_type_is_correct : type a b. (a, b) Setup.t -> (a, b) ta Js.t -> bool =
+let convert : type a b c. (a, b, c) Setup.t -> a -> b = function
+  | Setup.Int8 -> Fun.id
+  | Setup.Uint8 -> Fun.id
+  | Setup.Int16 -> Fun.id
+  | Setup.Uint16 -> Fun.id
+  | Setup.Int32 -> fun f -> Int32.of_float (Js.to_float f)
+  | Setup.Float32 -> Js.to_float
+  | Setup.Float64 -> Js.to_float
+
+let type_of_setup : type a b c. (a, b, c) Setup.t -> (a, b, c) type' = function
+  | Setup.Int8 -> Int8_signed
+  | Setup.Uint8 -> Int8_unsigned
+  | Setup.Int16 -> Int16_signed
+  | Setup.Uint16 -> Int16_unsigned
+  | Setup.Int32 -> Int32_signed
+  | Setup.Float32 -> Float32
+  | Setup.Float64 -> Float64
+
+let ta_type_is_correct : type a b c. (a, b, c) Setup.t -> (a, b, c) ta Js.t -> bool =
  fun setup a ->
   let get_prop prop obj = Js.Unsafe.get obj (Js.string prop) in
   let name = a |> get_prop "constructor" |> get_prop "name" |> Js.to_string in
@@ -58,7 +76,7 @@ let ta_type_is_correct : type a b. (a, b) Setup.t -> (a, b) ta Js.t -> bool =
   | Setup.Int32, "Int32Array" -> true
   | _, _ -> false
 
-let kind_field_is_correct : type a b. (a, b) Setup.t -> (a, b) ba -> bool =
+let kind_field_is_correct : type a b c. (a, b, c) Setup.t -> (b, c) ba -> bool =
  fun setup a ->
   (* To trigger a `false`, modify the `kind` integer hard coded in the
    * `caml_ba_kind_of_typed_array` stub
@@ -73,7 +91,7 @@ let kind_field_is_correct : type a b. (a, b) Setup.t -> (a, b) ba -> bool =
   | Int32, Int32 -> true
   | _, _ -> false
 
-let ba_of_array : type a b. (a, b) Setup.t -> a array -> (a, b) ba =
+let ba_of_array : type a b c. (a, b, c) Setup.t -> b array -> (b, c) ba =
  fun setup a -> Array1.of_array (kind_of_setup setup) c_layout a |> genarray_of_array1
 
 let array_of_ba : type a b. (a, b) ba -> a array =
@@ -85,16 +103,19 @@ let array_of_ba : type a b. (a, b) ba -> a array =
   in
   aux 0 |> Array.of_list
 
-let array_of_ta : type a b. (a, b) Setup.t -> (a, b) ta Js.t -> a array =
- fun _ a ->
+let array_of_ta : type a b c. (a, b, c) Setup.t -> (a, b, c) ta Js.t -> b array =
+ fun setup a ->
   let len = a##.length in
-  let rec aux i = if i == len then [] else unsafe_get a i :: aux (i + 1) in
+  let rec aux i =
+    if i == len then [] else convert setup (unsafe_get a i) :: aux (i + 1)
+  in
   aux 0 |> Array.of_list
 
-let test setup a0 =
+let test : type a b c. (a, b, c) Setup.t -> b array -> unit =
+ fun setup a0 ->
   let a1 = ba_of_array setup a0 in
 
-  let a2 = from_genarray a1 in
+  let a2 = from_genarray (type_of_setup setup) a1 in
   if not (array_of_ta setup a2 = a0) then print_endline "`a2` doesnt match `a0`";
   if not (ta_type_is_correct setup a2) then print_endline "corrupted typedArray type";
 

From 142f3edb839b1ee4c02844f233c03b3f6beb6ce3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 24 Jul 2023 13:54:03 +0200
Subject: [PATCH 092/481] Runtime: removed bigstringaf stubs

---
 runtime/wasm/bigstringaf.wat | 15 ---------------
 1 file changed, 15 deletions(-)
 delete mode 100644 runtime/wasm/bigstringaf.wat

diff --git a/runtime/wasm/bigstringaf.wat b/runtime/wasm/bigstringaf.wat
deleted file mode 100644
index 6e0250a935..0000000000
--- a/runtime/wasm/bigstringaf.wat
+++ /dev/null
@@ -1,15 +0,0 @@
-(module
-   (import "bindings" "log" (func $log_js (param anyref)))
-
-   (func (export "bigstringaf_blit_from_bytes")
-      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "bigstringaf_blit_from_bytes"))
-      (i31.new (i32.const 0)))
-
-   (func (export "bigstringaf_blit_to_bytes")
-      (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "bigstringaf_blit_to_bytes"))
-      (i31.new (i32.const 0)))
-)

From 9ffae7f7465c6824d75c99b4a9c0ea40daacf54f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 24 Jul 2023 14:22:03 +0200
Subject: [PATCH 093/481] Updated README

---
 README.md | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/README.md b/README.md
index 278cb814fa..6ed5006d2f 100644
--- a/README.md
+++ b/README.md
@@ -41,3 +41,25 @@ This outputs a file `cubes.js` which loads the WebAssembly code from file `cube.
 ```
 python3 -m http.server 8000 --directory .
 ```
+
+As a larger example, you can try [CAMLBOY](https://github.com/linoscope/CAMLBOY). You need to install a forked version of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm). Once the Js_of_ocaml UI is compiled (with `dune build`), you can generate WebAssembly code instead with the following command:
+```
+wasm_of_ocaml _build/default/bin/web/index.bc-for-jsoo
+```
+
+## Implementation status
+
+A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions, marshaling and dynamic linking are not supported yet.
+
+Separate compilation is not implemented yet.
+
+## Compatibility with Js_of_ocaml
+
+Since the value representation is different, some adaptations are necessary.
+
+The most notable change is that, except for integers, OCaml numbers are no longer mapped to JavaScript numbers. So, explicit conversions `Js.to_float` and `Js.float` are now necessary to convert between OCaml floats and JavaScript numbers. The typing of JavaScript Typed Arrays has also been changed to deal with this.
+
+Additionally, OCaml physical equality will not work properly on JavaScript objects (it compares boxed values instead of values themselves). You should use `Js.string_equals` instead.
+
+Some forked versions of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm) and
+[Gen_js_api](https://github.com/ocaml-wasm/gen_js_api/tree/wasm) are compatible with Wasm_of_ocaml.

From 8a155dd599d1f4b9b03dd41410c07d0bb326ef8f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 25 Jul 2023 11:38:59 +0200
Subject: [PATCH 094/481] Add ignore --source-map-inline option for
 compatibility with Js_of_ocaml

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index 9bb3d4303b..431a3c74fe 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -49,6 +49,10 @@ let options =
     let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in
     Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc)
   in
+  let sourcemap_inline_in_js =
+    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    Arg.(value & flag & info [ "source-map-inline" ] ~doc)
+  in
   let set_param =
     let doc = "Set compiler options." in
     let all = List.map (Config.Param.all ()) ~f:(fun (x, _) -> x, x) in
@@ -57,7 +61,7 @@ let options =
       & opt_all (list (pair ~sep:'=' (enum all) string)) []
       & info [ "set" ] ~docv:"PARAM=VALUE" ~doc)
   in
-  let build_t common set_param profile output_file input_file runtime_files =
+  let build_t common set_param profile _ output_file input_file runtime_files =
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let output_file =
       match output_file with
@@ -73,6 +77,7 @@ let options =
       $ Jsoo_cmdline.Arg.t
       $ set_param
       $ profile
+      $ sourcemap_inline_in_js
       $ output_file
       $ input_file
       $ runtime_files)

From 01c8bbf88944b1680ddf7087a0d2617183cc4920 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 25 Jul 2023 16:40:16 +0200
Subject: [PATCH 095/481] Use Js.number Js.t for JavaScript numbers

---
 lib/js_of_ocaml/dom_html.ml              | 189 +++++++++---------
 lib/js_of_ocaml/dom_html.mli             | 188 +++++++++---------
 lib/js_of_ocaml/dom_svg.ml               | 232 +++++++++++------------
 lib/js_of_ocaml/dom_svg.mli              | 232 +++++++++++------------
 lib/js_of_ocaml/geolocation.ml           |  14 +-
 lib/js_of_ocaml/geolocation.mli          |  14 +-
 lib/js_of_ocaml/intersectionObserver.ml  |   8 +-
 lib/js_of_ocaml/intersectionObserver.mli |   8 +-
 lib/js_of_ocaml/js.ml                    | 174 ++++++++---------
 lib/js_of_ocaml/js.mli                   | 188 +++++++++---------
 lib/js_of_ocaml/performanceObserver.ml   |   4 +-
 lib/js_of_ocaml/performanceObserver.mli  |   4 +-
 lib/js_of_ocaml/resizeObserver.ml        |   4 +-
 lib/js_of_ocaml/resizeObserver.mli       |   4 +-
 lib/js_of_ocaml/typed_array.ml           |  28 +--
 lib/js_of_ocaml/typed_array.mli          |  28 +--
 lib/js_of_ocaml/webGL.ml                 |  64 ++++---
 lib/js_of_ocaml/webGL.mli                |  64 ++++---
 lib/tests/test_typed_array.ml            |   6 +-
 19 files changed, 733 insertions(+), 720 deletions(-)

diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index 6108e2b017..8e41109028 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -372,11 +372,11 @@ and mousewheelEvent =
 
     method wheelDeltaY : int optdef readonly_prop
 
-    method deltaX : float t readonly_prop
+    method deltaX : number t readonly_prop
 
-    method deltaY : float t readonly_prop
+    method deltaY : number t readonly_prop
 
-    method deltaZ : float t readonly_prop
+    method deltaZ : number t readonly_prop
 
     method deltaMode : delta_mode readonly_prop
   end
@@ -579,13 +579,13 @@ and pointerEvent =
 
     method pointerId : int Js.readonly_prop
 
-    method width : float t Js.readonly_prop
+    method width : number t Js.readonly_prop
 
-    method height : float t Js.readonly_prop
+    method height : number t Js.readonly_prop
 
-    method pressure : float t Js.readonly_prop
+    method pressure : number t Js.readonly_prop
 
-    method tangentialPressure : float t Js.readonly_prop
+    method tangentialPressure : number t Js.readonly_prop
 
     method tiltX : int Js.readonly_prop
 
@@ -643,7 +643,7 @@ and animationEvent =
 
     method animationName : js_string t readonly_prop
 
-    method elapsedTime : float t readonly_prop
+    method elapsedTime : number t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -654,7 +654,7 @@ and transitionEvent =
 
     method propertyName : js_string t readonly_prop
 
-    method elapsedTime : float t readonly_prop
+    method elapsedTime : number t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -770,17 +770,17 @@ and element =
 
 and clientRect =
   object
-    method top : float t readonly_prop
+    method top : number t readonly_prop
 
-    method right : float t readonly_prop
+    method right : number t readonly_prop
 
-    method bottom : float t readonly_prop
+    method bottom : number t readonly_prop
 
-    method left : float t readonly_prop
+    method left : number t readonly_prop
 
-    method width : float t optdef readonly_prop
+    method width : number t optdef readonly_prop
 
-    method height : float t optdef readonly_prop
+    method height : number t optdef readonly_prop
   end
 
 and clientRectList =
@@ -1670,9 +1670,9 @@ class type timeRanges =
   object
     method length : int readonly_prop
 
-    method start : int -> float t meth
+    method start : int -> number t meth
 
-    method end_ : int -> float t meth
+    method end_ : int -> number t meth
   end
 
 type networkState =
@@ -1710,9 +1710,9 @@ class type mediaElement =
 
     method currentSrc : js_string t readonly_prop
 
-    method currentTime : float t prop
+    method currentTime : number t prop
 
-    method duration : float t readonly_prop
+    method duration : number t readonly_prop
 
     method ended : bool t readonly_prop
 
@@ -1728,7 +1728,7 @@ class type mediaElement =
 
     method paused : bool t readonly_prop
 
-    method playbackRate : float t prop
+    method playbackRate : number t prop
 
     method played : timeRanges t readonly_prop
 
@@ -1744,7 +1744,7 @@ class type mediaElement =
 
     method src : js_string t prop
 
-    method volume : float t prop
+    method volume : number t prop
 
     method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
@@ -1811,7 +1811,7 @@ class type canvasElement =
 
     method toDataURL_type : js_string t -> js_string t meth
 
-    method toDataURL_type_compression : js_string t -> float t -> js_string t meth
+    method toDataURL_type_compression : js_string t -> number t -> js_string t meth
 
     method getContext : js_string t -> canvasRenderingContext2D t meth
   end
@@ -1824,19 +1824,19 @@ and canvasRenderingContext2D =
 
     method restore : unit meth
 
-    method scale : float t -> float t -> unit meth
+    method scale : number t -> number t -> unit meth
 
-    method rotate : float t -> unit meth
+    method rotate : number t -> unit meth
 
-    method translate : float t -> float t -> unit meth
+    method translate : number t -> number t -> unit meth
 
     method transform :
-      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
     method setTransform :
-      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method globalAlpha : float t prop
+    method globalAlpha : number t prop
 
     method globalCompositeOperation : js_string t prop
 
@@ -1853,15 +1853,15 @@ and canvasRenderingContext2D =
     method fillStyle_pattern : canvasPattern t writeonly_prop
 
     method createLinearGradient :
-      float t -> float t -> float t -> float t -> canvasGradient t meth
+      number t -> number t -> number t -> number t -> canvasGradient t meth
 
     method createRadialGradient :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> canvasGradient t meth
 
     method createPattern : imageElement t -> js_string t -> canvasPattern t meth
@@ -1871,47 +1871,47 @@ and canvasRenderingContext2D =
 
     method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-    method lineWidth : float t prop
+    method lineWidth : number t prop
 
     method lineCap : js_string t prop
 
     method lineJoin : js_string t prop
 
-    method miterLimit : float t prop
+    method miterLimit : number t prop
 
-    method shadowOffsetX : float t prop
+    method shadowOffsetX : number t prop
 
-    method shadowOffsetY : float t prop
+    method shadowOffsetY : number t prop
 
-    method shadowBlur : float t prop
+    method shadowBlur : number t prop
 
     method shadowColor : js_string t prop
 
-    method clearRect : float t -> float t -> float t -> float t -> unit meth
+    method clearRect : number t -> number t -> number t -> number t -> unit meth
 
-    method fillRect : float t -> float t -> float t -> float t -> unit meth
+    method fillRect : number t -> number t -> number t -> number t -> unit meth
 
-    method strokeRect : float t -> float t -> float t -> float t -> unit meth
+    method strokeRect : number t -> number t -> number t -> number t -> unit meth
 
     method beginPath : unit meth
 
     method closePath : unit meth
 
-    method moveTo : float t -> float t -> unit meth
+    method moveTo : number t -> number t -> unit meth
 
-    method lineTo : float t -> float t -> unit meth
+    method lineTo : number t -> number t -> unit meth
 
-    method quadraticCurveTo : float t -> float t -> float t -> float t -> unit meth
+    method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
 
     method bezierCurveTo :
-      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method arcTo : float t -> float t -> float t -> float t -> float t -> unit meth
+    method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method rect : float t -> float t -> float t -> float t -> unit meth
+    method rect : number t -> number t -> number t -> number t -> unit meth
 
     method arc :
-      float t -> float t -> float t -> float t -> float t -> bool t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
 
     method fill : unit meth
 
@@ -1919,9 +1919,9 @@ and canvasRenderingContext2D =
 
     method clip : unit meth
 
-    method isPointInPath : float t -> float t -> bool t meth
+    method isPointInPath : number t -> number t -> bool t meth
 
-    method drawFocusRing : #element t -> float t -> float t -> bool t -> bool t meth
+    method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
 
     method font : js_string t prop
 
@@ -1929,84 +1929,85 @@ and canvasRenderingContext2D =
 
     method textBaseline : js_string t prop
 
-    method fillText : js_string t -> float t -> float t -> unit meth
+    method fillText : js_string t -> number t -> number t -> unit meth
 
-    method fillText_withWidth : js_string t -> float t -> float t -> float t -> unit meth
+    method fillText_withWidth :
+      js_string t -> number t -> number t -> number t -> unit meth
 
-    method strokeText : js_string t -> float t -> float t -> unit meth
+    method strokeText : js_string t -> number t -> number t -> unit meth
 
     method strokeText_withWidth :
-      js_string t -> float t -> float t -> float t -> unit meth
+      js_string t -> number t -> number t -> number t -> unit meth
 
     method measureText : js_string t -> textMetrics t meth
 
-    method drawImage : imageElement t -> float t -> float t -> unit meth
+    method drawImage : imageElement t -> number t -> number t -> unit meth
 
     method drawImage_withSize :
-      imageElement t -> float t -> float t -> float t -> float t -> unit meth
+      imageElement t -> number t -> number t -> number t -> number t -> unit meth
 
     method drawImage_full :
          imageElement t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> unit meth
 
-    method drawImage_fromCanvas : canvasElement t -> float t -> float t -> unit meth
+    method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
 
     method drawImage_fromCanvasWithSize :
-      canvasElement t -> float t -> float t -> float t -> float t -> unit meth
+      canvasElement t -> number t -> number t -> number t -> number t -> unit meth
 
     method drawImage_fullFromCanvas :
          canvasElement t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> unit meth
 
     method drawImage_fromVideoWithVideo :
-      videoElement t -> float t -> float t -> unit meth
+      videoElement t -> number t -> number t -> unit meth
 
     method drawImage_fromVideoWithSize :
-      videoElement t -> float t -> float t -> float t -> float t -> unit meth
+      videoElement t -> number t -> number t -> number t -> number t -> unit meth
 
     method drawImage_fullFromVideo :
          videoElement t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> unit meth
 
     method createImageData : int -> int -> imageData t meth
 
-    method getImageData : float t -> float t -> float t -> float t -> imageData t meth
+    method getImageData : number t -> number t -> number t -> number t -> imageData t meth
 
-    method putImageData : imageData t -> float t -> float t -> unit meth
+    method putImageData : imageData t -> number t -> number t -> unit meth
   end
 
 and canvasGradient =
   object
-    method addColorStop : float t -> js_string t -> unit meth
+    method addColorStop : number t -> js_string t -> unit meth
   end
 
 and textMetrics =
   object
-    method width : float t readonly_prop
+    method width : number t readonly_prop
   end
 
 and imageData =
@@ -2369,16 +2370,16 @@ class type window =
 
     method print : unit meth
 
-    method setInterval : (unit -> unit) Js.callback -> float t -> interval_id meth
+    method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
 
     method clearInterval : interval_id -> unit meth
 
-    method setTimeout : (unit -> unit) Js.callback -> float t -> timeout_id meth
+    method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
 
     method clearTimeout : timeout_id -> unit meth
 
     method requestAnimationFrame :
-      (float t -> unit) Js.callback -> animation_frame_request_id meth
+      (number t -> unit) Js.callback -> animation_frame_request_id meth
 
     method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
@@ -2425,7 +2426,7 @@ class type window =
 
     method _URL : _URL t readonly_prop
 
-    method devicePixelRatio : float t readonly_prop
+    method devicePixelRatio : number t readonly_prop
   end
 
 let window : window t = Js.Unsafe.global
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 9991763420..23de2ca77c 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -381,11 +381,11 @@ and mousewheelEvent =
 
     method wheelDeltaY : int optdef readonly_prop
 
-    method deltaX : float t readonly_prop
+    method deltaX : number t readonly_prop
 
-    method deltaY : float t readonly_prop
+    method deltaY : number t readonly_prop
 
-    method deltaZ : float t readonly_prop
+    method deltaZ : number t readonly_prop
 
     method deltaMode : delta_mode readonly_prop
   end
@@ -590,13 +590,13 @@ and pointerEvent =
 
     method pointerId : int Js.readonly_prop
 
-    method width : float t Js.readonly_prop
+    method width : number t Js.readonly_prop
 
-    method height : float t Js.readonly_prop
+    method height : number t Js.readonly_prop
 
-    method pressure : float t Js.readonly_prop
+    method pressure : number t Js.readonly_prop
 
-    method tangentialPressure : float t Js.readonly_prop
+    method tangentialPressure : number t Js.readonly_prop
 
     method tiltX : int Js.readonly_prop
 
@@ -655,7 +655,7 @@ and animationEvent =
 
     method animationName : js_string t readonly_prop
 
-    method elapsedTime : float t readonly_prop
+    method elapsedTime : number t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -666,7 +666,7 @@ and transitionEvent =
 
     method propertyName : js_string t readonly_prop
 
-    method elapsedTime : float t readonly_prop
+    method elapsedTime : number t readonly_prop
 
     method pseudoElement : js_string t readonly_prop
   end
@@ -787,17 +787,17 @@ and element =
 (** Rectangular box (used for element bounding boxes) *)
 and clientRect =
   object
-    method top : float t readonly_prop
+    method top : number t readonly_prop
 
-    method right : float t readonly_prop
+    method right : number t readonly_prop
 
-    method bottom : float t readonly_prop
+    method bottom : number t readonly_prop
 
-    method left : float t readonly_prop
+    method left : number t readonly_prop
 
-    method width : float t optdef readonly_prop
+    method width : number t optdef readonly_prop
 
-    method height : float t optdef readonly_prop
+    method height : number t optdef readonly_prop
   end
 
 and clientRectList =
@@ -1496,9 +1496,9 @@ class type timeRanges =
   object
     method length : int readonly_prop
 
-    method start : int -> float t meth
+    method start : int -> number t meth
 
-    method end_ : int -> float t meth
+    method end_ : int -> number t meth
   end
 
 type networkState =
@@ -1534,9 +1534,9 @@ class type mediaElement =
 
     method currentSrc : js_string t readonly_prop
 
-    method currentTime : float t prop
+    method currentTime : number t prop
 
-    method duration : float t readonly_prop
+    method duration : number t readonly_prop
 
     method ended : bool t readonly_prop
 
@@ -1552,7 +1552,7 @@ class type mediaElement =
 
     method paused : bool t readonly_prop
 
-    method playbackRate : float t prop
+    method playbackRate : number t prop
 
     method played : timeRanges t readonly_prop
 
@@ -1568,7 +1568,7 @@ class type mediaElement =
 
     method src : js_string t prop
 
-    method volume : float t prop
+    method volume : number t prop
 
     method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
@@ -1637,7 +1637,7 @@ class type canvasElement =
 
     method toDataURL_type : js_string t -> js_string t meth
 
-    method toDataURL_type_compression : js_string t -> float t -> js_string t meth
+    method toDataURL_type_compression : js_string t -> number t -> js_string t meth
 
     method getContext : context -> canvasRenderingContext2D t meth
   end
@@ -1650,19 +1650,19 @@ and canvasRenderingContext2D =
 
     method restore : unit meth
 
-    method scale : float t -> float t -> unit meth
+    method scale : number t -> number t -> unit meth
 
-    method rotate : float t -> unit meth
+    method rotate : number t -> unit meth
 
-    method translate : float t -> float t -> unit meth
+    method translate : number t -> number t -> unit meth
 
     method transform :
-      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
     method setTransform :
-      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method globalAlpha : float t prop
+    method globalAlpha : number t prop
 
     method globalCompositeOperation : js_string t prop
 
@@ -1679,15 +1679,15 @@ and canvasRenderingContext2D =
     method fillStyle_pattern : canvasPattern t writeonly_prop
 
     method createLinearGradient :
-      float t -> float t -> float t -> float t -> canvasGradient t meth
+      number t -> number t -> number t -> number t -> canvasGradient t meth
 
     method createRadialGradient :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> canvasGradient t meth
 
     method createPattern : imageElement t -> js_string t -> canvasPattern t meth
@@ -1697,47 +1697,47 @@ and canvasRenderingContext2D =
 
     method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-    method lineWidth : float t prop
+    method lineWidth : number t prop
 
     method lineCap : js_string t prop
 
     method lineJoin : js_string t prop
 
-    method miterLimit : float t prop
+    method miterLimit : number t prop
 
-    method shadowOffsetX : float t prop
+    method shadowOffsetX : number t prop
 
-    method shadowOffsetY : float t prop
+    method shadowOffsetY : number t prop
 
-    method shadowBlur : float t prop
+    method shadowBlur : number t prop
 
     method shadowColor : js_string t prop
 
-    method clearRect : float t -> float t -> float t -> float t -> unit meth
+    method clearRect : number t -> number t -> number t -> number t -> unit meth
 
-    method fillRect : float t -> float t -> float t -> float t -> unit meth
+    method fillRect : number t -> number t -> number t -> number t -> unit meth
 
-    method strokeRect : float t -> float t -> float t -> float t -> unit meth
+    method strokeRect : number t -> number t -> number t -> number t -> unit meth
 
     method beginPath : unit meth
 
     method closePath : unit meth
 
-    method moveTo : float t -> float t -> unit meth
+    method moveTo : number t -> number t -> unit meth
 
-    method lineTo : float t -> float t -> unit meth
+    method lineTo : number t -> number t -> unit meth
 
-    method quadraticCurveTo : float t -> float t -> float t -> float t -> unit meth
+    method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
 
     method bezierCurveTo :
-      float t -> float t -> float t -> float t -> float t -> float t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method arcTo : float t -> float t -> float t -> float t -> float t -> unit meth
+    method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method rect : float t -> float t -> float t -> float t -> unit meth
+    method rect : number t -> number t -> number t -> number t -> unit meth
 
     method arc :
-      float t -> float t -> float t -> float t -> float t -> bool t -> unit meth
+      number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
 
     method fill : unit meth
 
@@ -1745,9 +1745,9 @@ and canvasRenderingContext2D =
 
     method clip : unit meth
 
-    method isPointInPath : float t -> float t -> bool t meth
+    method isPointInPath : number t -> number t -> bool t meth
 
-    method drawFocusRing : #element t -> float t -> float t -> bool t -> bool t meth
+    method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
 
     method font : js_string t prop
 
@@ -1755,85 +1755,85 @@ and canvasRenderingContext2D =
 
     method textBaseline : js_string t prop
 
-    method fillText : js_string t -> float t -> float t -> unit meth
+    method fillText : js_string t -> number t -> number t -> unit meth
 
-    method fillText_withWidth : js_string t -> float t -> float t -> float t -> unit meth
+    method fillText_withWidth : js_string t -> number t -> number t -> number t -> unit meth
 
-    method strokeText : js_string t -> float t -> float t -> unit meth
+    method strokeText : js_string t -> number t -> number t -> unit meth
 
     method strokeText_withWidth :
-      js_string t -> float t -> float t -> float t -> unit meth
+      js_string t -> number t -> number t -> number t -> unit meth
 
     method measureText : js_string t -> textMetrics t meth
 
-    method drawImage : imageElement t -> float t -> float t -> unit meth
+    method drawImage : imageElement t -> number t -> number t -> unit meth
 
     method drawImage_withSize :
-      imageElement t -> float t -> float t -> float t -> float t -> unit meth
+      imageElement t -> number t -> number t -> number t -> number t -> unit meth
 
     method drawImage_full :
          imageElement t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> unit meth
 
-    method drawImage_fromCanvas : canvasElement t -> float t -> float t -> unit meth
+    method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
 
     method drawImage_fromCanvasWithSize :
-      canvasElement t -> float t -> float t -> float t -> float t -> unit meth
+      canvasElement t -> number t -> number t -> number t -> number t -> unit meth
 
     method drawImage_fullFromCanvas :
          canvasElement t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> unit meth
 
     method drawImage_fromVideoWithVideo :
-      videoElement t -> float t -> float t -> unit meth
+      videoElement t -> number t -> number t -> unit meth
 
     method drawImage_fromVideoWithSize :
-      videoElement t -> float t -> float t -> float t -> float t -> unit meth
+      videoElement t -> number t -> number t -> number t -> number t -> unit meth
 
     method drawImage_fullFromVideo :
          videoElement t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> unit meth
 
     (* Method createImageData not available in Opera *)
     method createImageData : int -> int -> imageData t meth
 
-    method getImageData : float t -> float t -> float t -> float t -> imageData t meth
+    method getImageData : number t -> number t -> number t -> number t -> imageData t meth
 
-    method putImageData : imageData t -> float t -> float t -> unit meth
+    method putImageData : imageData t -> number t -> number t -> unit meth
   end
 
 and canvasGradient =
   object
-    method addColorStop : float t -> js_string t -> unit meth
+    method addColorStop : number t -> js_string t -> unit meth
   end
 
 and textMetrics =
   object
-    method width : float t readonly_prop
+    method width : number t readonly_prop
   end
 
 and imageData =
@@ -2222,16 +2222,16 @@ class type window =
 
     method print : unit meth
 
-    method setInterval : (unit -> unit) Js.callback -> float t -> interval_id meth
+    method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
 
     method clearInterval : interval_id -> unit meth
 
-    method setTimeout : (unit -> unit) Js.callback -> float t -> timeout_id meth
+    method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
 
     method clearTimeout : timeout_id -> unit meth
 
     method requestAnimationFrame :
-      (float t -> unit) Js.callback -> animation_frame_request_id meth
+      (number t -> unit) Js.callback -> animation_frame_request_id meth
 
     method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
@@ -2278,7 +2278,7 @@ class type window =
 
     method _URL : _URL t readonly_prop
 
-    method devicePixelRatio : float t readonly_prop
+    method devicePixelRatio : number t readonly_prop
   end
 
 val window : window t
diff --git a/lib/js_of_ocaml/dom_svg.ml b/lib/js_of_ocaml/dom_svg.ml
index 8af42a441f..794c4e99ea 100644
--- a/lib/js_of_ocaml/dom_svg.ml
+++ b/lib/js_of_ocaml/dom_svg.ml
@@ -221,7 +221,7 @@ and animatedEnumeration = [int (*short*)] animated
 and animatedInteger = [int] animated
 
 (* interface SVGAnimatedNumber *)
-and animatedNumber = [float t] animated
+and animatedNumber = [number t] animated
 
 (* interface SVGNumberList *)
 and numberList = [number t] list
@@ -234,13 +234,13 @@ and length =
   object
     method unitType : lengthUnitType readonly_prop
 
-    method value : float t prop
+    method value : number t prop
 
-    method valueInSpecifiedUnits : float t prop
+    method valueInSpecifiedUnits : number t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : lengthUnitType -> float t -> unit meth
+    method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
 
     method convertToSpecifiedUnits : lengthUnitType -> unit meth
   end
@@ -259,13 +259,13 @@ and angle =
   object
     method unitType : angleUnitType readonly_prop
 
-    method value : float t prop
+    method value : number t prop
 
-    method valueInSpecifiedUnits : float t prop
+    method valueInSpecifiedUnits : number t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : angleUnitType -> float t -> unit meth
+    method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
 
     method convertToSpecifiedUnits : angleUnitType -> unit meth
   end
@@ -304,13 +304,13 @@ and iccColor =
 (* interface SVGRect *)
 and rect =
   object
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method width : float t prop
+    method width : number t prop
 
-    method height : float t prop
+    method height : number t prop
   end
 
 (* interface SVGAnimatedRect *)
@@ -471,19 +471,19 @@ and svgElement =
 
     method viewport : rect t readonly_prop
 
-    method pixelUnitToMillimeterX : float t readonly_prop
+    method pixelUnitToMillimeterX : number t readonly_prop
 
-    method pixelUnitToMillimeterY : float t readonly_prop
+    method pixelUnitToMillimeterY : number t readonly_prop
 
-    method screenPixelUnitToMillimeterX : float t readonly_prop
+    method screenPixelUnitToMillimeterX : number t readonly_prop
 
-    method screenPixelUnitToMillimeterY : float t readonly_prop
+    method screenPixelUnitToMillimeterY : number t readonly_prop
 
     method useCurrentView : bool t readonly_prop
 
     method currentView : viewSpec t readonly_prop
 
-    method currentScale : float t prop
+    method currentScale : number t prop
 
     method currentTranslate : point t readonly_prop
 
@@ -501,7 +501,7 @@ and svgElement =
 
     method animationsPaused : bool t meth
 
-    method getCurrentTime : float t meth
+    method getCurrentTime : number t meth
 
     method setCurrentTime : int -> unit meth
 
@@ -726,9 +726,9 @@ and styleElement =
 (* interface SVGPoint *)
 and point =
   object
-    method x : float t readonly_prop
+    method x : number t readonly_prop
 
-    method y : float t readonly_prop
+    method y : number t readonly_prop
 
     method matrixTransform : matrix t -> point t meth
   end
@@ -739,39 +739,39 @@ and pointList = [point t] list
 (* interface SVGMatrix *)
 and matrix =
   object
-    method a : float t readonly_prop
+    method a : number t readonly_prop
 
-    method b : float t readonly_prop
+    method b : number t readonly_prop
 
-    method c : float t readonly_prop
+    method c : number t readonly_prop
 
-    method d : float t readonly_prop
+    method d : number t readonly_prop
 
-    method e : float t readonly_prop
+    method e : number t readonly_prop
 
-    method f : float t readonly_prop
+    method f : number t readonly_prop
 
     method multiply : matrix t -> matrix t meth
 
     method inverse : matrix t meth
 
-    method translate : float t -> float t -> matrix t meth
+    method translate : number t -> number t -> matrix t meth
 
-    method scale : float t -> matrix t meth
+    method scale : number t -> matrix t meth
 
-    method scaleNonUniform : float t -> float t -> matrix t meth
+    method scaleNonUniform : number t -> number t -> matrix t meth
 
-    method rotate : float t -> matrix t meth
+    method rotate : number t -> matrix t meth
 
-    method rotateFromVector : float t -> float t -> matrix t meth
+    method rotateFromVector : number t -> number t -> matrix t meth
 
     method flipX : matrix t meth
 
     method flipY : matrix t meth
 
-    method skewX : float t -> matrix t meth
+    method skewX : number t -> matrix t meth
 
-    method skewY : float t -> matrix t meth
+    method skewY : number t -> matrix t meth
   end
 
 (* interface SVGTransform *)
@@ -781,19 +781,19 @@ and transform =
 
     method matrix : matrix t readonly_prop
 
-    method angle : float t readonly_prop
+    method angle : number t readonly_prop
 
     method setMatrix : matrix t -> unit meth
 
-    method setTranslate : float t -> float t -> unit meth
+    method setTranslate : number t -> number t -> unit meth
 
-    method setScale : float t -> float t -> unit meth
+    method setScale : number t -> number t -> unit meth
 
-    method setRotate : float t -> float t -> float t -> unit meth
+    method setRotate : number t -> number t -> number t -> unit meth
 
-    method setSkewX : float t -> unit meth
+    method setSkewX : number t -> unit meth
 
-    method setSkewY : float t -> unit meth
+    method setSkewY : number t -> unit meth
   end
 
 (* interface SVGTransformList *)
@@ -837,9 +837,9 @@ and pathSegMoveto =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
   end
 
 (* interface SVGPathSegLinetoAbs *)
@@ -848,9 +848,9 @@ and pathSegLineto =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
   end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
@@ -859,17 +859,17 @@ and pathSegCurvetoCubic =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method x1 : float t prop
+    method x1 : number t prop
 
-    method y1 : float t prop
+    method y1 : number t prop
 
-    method x2 : float t prop
+    method x2 : number t prop
 
-    method y2 : float t prop
+    method y2 : number t prop
   end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
@@ -878,13 +878,13 @@ and pathSegCurvetoQuadratic =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method x1 : float t prop
+    method x1 : number t prop
 
-    method y1 : float t prop
+    method y1 : number t prop
   end
 
 (* interface SVGPathSegArcAbs *)
@@ -893,13 +893,13 @@ and pathSegArc =
   object
     inherit pathSeg
 
-    method y : float t prop
+    method y : number t prop
 
-    method r1 : float t prop
+    method r1 : number t prop
 
-    method r2 : float t prop
+    method r2 : number t prop
 
-    method angle : float t prop
+    method angle : number t prop
 
     method largeArcFlag : bool t prop
 
@@ -912,7 +912,7 @@ and pathSegLinetoHorizontal =
   object
     inherit pathSeg
 
-    method x : float t
+    method x : number t
   end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
@@ -921,20 +921,20 @@ and pathSegLinetoVertical =
   object
     inherit pathSeg
 
-    method y : float t
+    method y : number t
   end
 
 and pathSegCurvetoCubicSmooth =
   object
     inherit pathSeg
 
-    method x : float t
+    method x : number t
 
-    method y : float t
+    method y : number t
 
-    method x2 : float t
+    method x2 : number t
 
-    method y2 : float t
+    method y2 : number t
   end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
@@ -943,9 +943,9 @@ and pathSegCurvetoQuadraticSmooth =
   object
     inherit pathSeg
 
-    method x : float t
+    method x : number t
 
-    method y : float t
+    method y : number t
   end
 
 and pathSegList = [pathSeg t] list
@@ -981,85 +981,85 @@ and pathElement =
 
     method pathLength : animatedNumber t readonly_prop
 
-    method getTotalLength : float t meth
+    method getTotalLength : number t meth
 
-    method getPointAtLength : float t -> point t meth
+    method getPointAtLength : number t -> point t meth
 
-    method getPathSegAtLength : float t -> int
+    method getPathSegAtLength : number t -> int
 
     method createSVGPathSegClosePath : pathSegClosePath meth
 
-    method createSVGPathSegMovetoAbs : float t -> float t -> pathSegMoveto meth
+    method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegMovetoRel : float t -> float t -> pathSegMoveto meth
+    method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegLinetoAbs : float t -> float t -> pathSegLineto meth
+    method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
 
-    method createSVGPathSegLinetoRel : float t -> float t -> pathSegLineto meth
+    method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
 
     method createSVGPathSegCurvetoCubicAbs :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoCubicRel :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoQuadraticAbs :
-      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegCurvetoQuadraticRel :
-      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegArcAbs :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> bool t
       -> bool t
       -> pathSegArc meth
 
     method createSVGPathSegArcRel :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> bool t
       -> bool t
       -> pathSegArc meth
 
-    method createSVGPathSegLinetoHorizontalAbs : float t -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoHorizontalRel : float t -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoVerticalAbs : float t -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegLinetoVerticalRel : float t -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
 
     method createSVGPathSegCurvetoCubicSmoothAbs :
-      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoCubicSmoothRel :
-      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothAbs :
-      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
+      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothRel :
-      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
+      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
   end
 
 (* interface SVGRectElement *)
@@ -1227,9 +1227,9 @@ and textContentElement =
 
     method getNumberOfChars : int meth
 
-    method getComputedTextLength : float t meth
+    method getComputedTextLength : number t meth
 
-    method getSubStringLength : int -> int -> float t meth
+    method getSubStringLength : int -> int -> number t meth
 
     method getStartPositionOfChar : int -> point t meth
 
@@ -1237,7 +1237,7 @@ and textContentElement =
 
     method getExtentOfChar : int -> rect t meth
 
-    method getRotationOfChar : int -> float t meth
+    method getRotationOfChar : int -> number t meth
 
     method getCharNumAtPosition : point -> int meth
 
@@ -1326,13 +1326,13 @@ and glyphRefElement =
 
     method format : js_string t prop
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method dx : float t prop
+    method dx : number t prop
 
-    method dy : float t prop
+    method dy : number t prop
   end
 
 (* interface SVGPaint : SVGColor { *)
@@ -1735,7 +1735,7 @@ and filterElement =
 (*   readonly attribute SVGAnimatedNumber stdDeviationX; *)
 (*   readonly attribute SVGAnimatedNumber stdDeviationY; *)
 
-(*   void setStdDeviation(in float t stdDeviationX, in float t stdDeviationY) raises(DOMException); *)
+(*   void setStdDeviation(in number t stdDeviationX, in number t stdDeviationY) raises(DOMException); *)
 (* }; *)
 
 (* interface SVGFEImageElement : SVGElement, *)
@@ -1875,9 +1875,9 @@ and scriptElement =
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
-(*   readonly attribute float t previousScale; *)
+(*   readonly attribute number t previousScale; *)
 (*   readonly attribute SVGPoint previousTranslate; *)
-(*   readonly attribute float t newScale; *)
+(*   readonly attribute number t newScale; *)
 (*   readonly attribute SVGPoint newTranslate; *)
 (* }; *)
 
@@ -1893,11 +1893,11 @@ and animationElement =
     (* inherit elementTimeControl *)
     method targetElement : element t readonly_prop
 
-    method getStartTime : float t meth
+    method getStartTime : number t meth
 
-    method getCurrentTime : float t meth
+    method getCurrentTime : number t meth
 
-    method getSimpleDuration : float t meth
+    method getSimpleDuration : number t meth
   end
 
 (* interface SVGAnimateElement *)
diff --git a/lib/js_of_ocaml/dom_svg.mli b/lib/js_of_ocaml/dom_svg.mli
index 3445471df6..24ce259f2b 100644
--- a/lib/js_of_ocaml/dom_svg.mli
+++ b/lib/js_of_ocaml/dom_svg.mli
@@ -224,7 +224,7 @@ and animatedEnumeration = [int (*short*)] animated
 and animatedInteger = [int] animated
 
 (* interface SVGAnimatedNumber *)
-and animatedNumber = [float t] animated
+and animatedNumber = [number t] animated
 
 (* interface SVGNumberList *)
 and numberList = [number t] list
@@ -237,13 +237,13 @@ and length =
   object
     method unitType : lengthUnitType readonly_prop
 
-    method value : float t prop
+    method value : number t prop
 
-    method valueInSpecifiedUnits : float t prop
+    method valueInSpecifiedUnits : number t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : lengthUnitType -> float t -> unit meth
+    method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
 
     method convertToSpecifiedUnits : lengthUnitType -> unit meth
   end
@@ -262,13 +262,13 @@ and angle =
   object
     method unitType : angleUnitType readonly_prop
 
-    method value : float t prop
+    method value : number t prop
 
-    method valueInSpecifiedUnits : float t prop
+    method valueInSpecifiedUnits : number t prop
 
     method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : angleUnitType -> float t -> unit meth
+    method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
 
     method convertToSpecifiedUnits : angleUnitType -> unit meth
   end
@@ -307,13 +307,13 @@ and iccColor =
 (* interface SVGRect *)
 and rect =
   object
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method width : float t prop
+    method width : number t prop
 
-    method height : float t prop
+    method height : number t prop
   end
 
 (* interface SVGAnimatedRect *)
@@ -473,19 +473,19 @@ and svgElement =
 
     method viewport : rect t readonly_prop
 
-    method pixelUnitToMillimeterX : float t readonly_prop
+    method pixelUnitToMillimeterX : number t readonly_prop
 
-    method pixelUnitToMillimeterY : float t readonly_prop
+    method pixelUnitToMillimeterY : number t readonly_prop
 
-    method screenPixelUnitToMillimeterX : float t readonly_prop
+    method screenPixelUnitToMillimeterX : number t readonly_prop
 
-    method screenPixelUnitToMillimeterY : float t readonly_prop
+    method screenPixelUnitToMillimeterY : number t readonly_prop
 
     method useCurrentView : bool t readonly_prop
 
     method currentView : viewSpec t readonly_prop
 
-    method currentScale : float t prop
+    method currentScale : number t prop
 
     method currentTranslate : point t readonly_prop
 
@@ -503,7 +503,7 @@ and svgElement =
 
     method animationsPaused : bool t meth
 
-    method getCurrentTime : float t meth
+    method getCurrentTime : number t meth
 
     method setCurrentTime : int -> unit meth
 
@@ -728,9 +728,9 @@ and styleElement =
 (* interface SVGPoint *)
 and point =
   object
-    method x : float t readonly_prop
+    method x : number t readonly_prop
 
-    method y : float t readonly_prop
+    method y : number t readonly_prop
 
     method matrixTransform : matrix t -> point t meth
   end
@@ -741,39 +741,39 @@ and pointList = [point t] list
 (* interface SVGMatrix *)
 and matrix =
   object
-    method a : float t readonly_prop
+    method a : number t readonly_prop
 
-    method b : float t readonly_prop
+    method b : number t readonly_prop
 
-    method c : float t readonly_prop
+    method c : number t readonly_prop
 
-    method d : float t readonly_prop
+    method d : number t readonly_prop
 
-    method e : float t readonly_prop
+    method e : number t readonly_prop
 
-    method f : float t readonly_prop
+    method f : number t readonly_prop
 
     method multiply : matrix t -> matrix t meth
 
     method inverse : matrix t meth
 
-    method translate : float t -> float t -> matrix t meth
+    method translate : number t -> number t -> matrix t meth
 
-    method scale : float t -> matrix t meth
+    method scale : number t -> matrix t meth
 
-    method scaleNonUniform : float t -> float t -> matrix t meth
+    method scaleNonUniform : number t -> number t -> matrix t meth
 
-    method rotate : float t -> matrix t meth
+    method rotate : number t -> matrix t meth
 
-    method rotateFromVector : float t -> float t -> matrix t meth
+    method rotateFromVector : number t -> number t -> matrix t meth
 
     method flipX : matrix t meth
 
     method flipY : matrix t meth
 
-    method skewX : float t -> matrix t meth
+    method skewX : number t -> matrix t meth
 
-    method skewY : float t -> matrix t meth
+    method skewY : number t -> matrix t meth
   end
 
 (* interface SVGTransform *)
@@ -783,19 +783,19 @@ and transform =
 
     method matrix : matrix t readonly_prop
 
-    method angle : float t readonly_prop
+    method angle : number t readonly_prop
 
     method setMatrix : matrix t -> unit meth
 
-    method setTranslate : float t -> float t -> unit meth
+    method setTranslate : number t -> number t -> unit meth
 
-    method setScale : float t -> float t -> unit meth
+    method setScale : number t -> number t -> unit meth
 
-    method setRotate : float t -> float t -> float t -> unit meth
+    method setRotate : number t -> number t -> number t -> unit meth
 
-    method setSkewX : float t -> unit meth
+    method setSkewX : number t -> unit meth
 
-    method setSkewY : float t -> unit meth
+    method setSkewY : number t -> unit meth
   end
 
 (* interface SVGTransformList *)
@@ -839,9 +839,9 @@ and pathSegMoveto =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
   end
 
 (* interface SVGPathSegLinetoAbs *)
@@ -850,9 +850,9 @@ and pathSegLineto =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
   end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
@@ -861,17 +861,17 @@ and pathSegCurvetoCubic =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method x1 : float t prop
+    method x1 : number t prop
 
-    method y1 : float t prop
+    method y1 : number t prop
 
-    method x2 : float t prop
+    method x2 : number t prop
 
-    method y2 : float t prop
+    method y2 : number t prop
   end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
@@ -880,13 +880,13 @@ and pathSegCurvetoQuadratic =
   object
     inherit pathSeg
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method x1 : float t prop
+    method x1 : number t prop
 
-    method y1 : float t prop
+    method y1 : number t prop
   end
 
 (* interface SVGPathSegArcAbs *)
@@ -895,13 +895,13 @@ and pathSegArc =
   object
     inherit pathSeg
 
-    method y : float t prop
+    method y : number t prop
 
-    method r1 : float t prop
+    method r1 : number t prop
 
-    method r2 : float t prop
+    method r2 : number t prop
 
-    method angle : float t prop
+    method angle : number t prop
 
     method largeArcFlag : bool t prop
 
@@ -914,7 +914,7 @@ and pathSegLinetoHorizontal =
   object
     inherit pathSeg
 
-    method x : float t
+    method x : number t
   end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
@@ -923,20 +923,20 @@ and pathSegLinetoVertical =
   object
     inherit pathSeg
 
-    method y : float t
+    method y : number t
   end
 
 and pathSegCurvetoCubicSmooth =
   object
     inherit pathSeg
 
-    method x : float t
+    method x : number t
 
-    method y : float t
+    method y : number t
 
-    method x2 : float t
+    method x2 : number t
 
-    method y2 : float t
+    method y2 : number t
   end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
@@ -945,9 +945,9 @@ and pathSegCurvetoQuadraticSmooth =
   object
     inherit pathSeg
 
-    method x : float t
+    method x : number t
 
-    method y : float t
+    method y : number t
   end
 
 and pathSegList = [pathSeg t] list
@@ -983,85 +983,85 @@ and pathElement =
 
     method pathLength : animatedNumber t readonly_prop
 
-    method getTotalLength : float t meth
+    method getTotalLength : number t meth
 
-    method getPointAtLength : float t -> point t meth
+    method getPointAtLength : number t -> point t meth
 
-    method getPathSegAtLength : float t -> int
+    method getPathSegAtLength : number t -> int
 
     method createSVGPathSegClosePath : pathSegClosePath meth
 
-    method createSVGPathSegMovetoAbs : float t -> float t -> pathSegMoveto meth
+    method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegMovetoRel : float t -> float t -> pathSegMoveto meth
+    method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegLinetoAbs : float t -> float t -> pathSegLineto meth
+    method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
 
-    method createSVGPathSegLinetoRel : float t -> float t -> pathSegLineto meth
+    method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
 
     method createSVGPathSegCurvetoCubicAbs :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoCubicRel :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> pathSegCurvetoCubic meth
 
     method createSVGPathSegCurvetoQuadraticAbs :
-      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegCurvetoQuadraticRel :
-      float t -> float t -> float t -> float t -> pathSegCurvetoQuadratic meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
     method createSVGPathSegArcAbs :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> bool t
       -> bool t
       -> pathSegArc meth
 
     method createSVGPathSegArcRel :
-         float t
-      -> float t
-      -> float t
-      -> float t
-      -> float t
+         number t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
       -> bool t
       -> bool t
       -> pathSegArc meth
 
-    method createSVGPathSegLinetoHorizontalAbs : float t -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoHorizontalRel : float t -> pathSegLinetoHorizontal meth
+    method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoVerticalAbs : float t -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegLinetoVerticalRel : float t -> pathSegLinetoVertical meth
+    method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
 
     method createSVGPathSegCurvetoCubicSmoothAbs :
-      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoCubicSmoothRel :
-      float t -> float t -> float t -> float t -> pathSegCurvetoCubicSmooth meth
+      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothAbs :
-      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
+      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
 
     method createSVGPathSegCurvetoQuadraticSmoothRel :
-      float t -> float t -> pathSegCurvetoQuadraticSmooth meth
+      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
   end
 
 (* interface SVGRectElement *)
@@ -1229,9 +1229,9 @@ and textContentElement =
 
     method getNumberOfChars : int meth
 
-    method getComputedTextLength : float t meth
+    method getComputedTextLength : number t meth
 
-    method getSubStringLength : int -> int -> float t meth
+    method getSubStringLength : int -> int -> number t meth
 
     method getStartPositionOfChar : int -> point t meth
 
@@ -1239,7 +1239,7 @@ and textContentElement =
 
     method getExtentOfChar : int -> rect t meth
 
-    method getRotationOfChar : int -> float t meth
+    method getRotationOfChar : int -> number t meth
 
     method getCharNumAtPosition : point -> int meth
 
@@ -1328,13 +1328,13 @@ and glyphRefElement =
 
     method format : js_string t prop
 
-    method x : float t prop
+    method x : number t prop
 
-    method y : float t prop
+    method y : number t prop
 
-    method dx : float t prop
+    method dx : number t prop
 
-    method dy : float t prop
+    method dy : number t prop
   end
 
 (* interface SVGPaint : SVGColor { *)
@@ -1737,7 +1737,7 @@ and filterElement =
 (*   readonly attribute SVGAnimatedNumber stdDeviationX; *)
 (*   readonly attribute SVGAnimatedNumber stdDeviationY; *)
 
-(*   void setStdDeviation(in float t stdDeviationX, in float t stdDeviationY) raises(DOMException); *)
+(*   void setStdDeviation(in number t stdDeviationX, in number t stdDeviationY) raises(DOMException); *)
 (* }; *)
 
 (* interface SVGFEImageElement : SVGElement, *)
@@ -1877,9 +1877,9 @@ and scriptElement =
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
-(*   readonly attribute float t previousScale; *)
+(*   readonly attribute number t previousScale; *)
 (*   readonly attribute SVGPoint previousTranslate; *)
-(*   readonly attribute float t newScale; *)
+(*   readonly attribute number t newScale; *)
 (*   readonly attribute SVGPoint newTranslate; *)
 (* }; *)
 
@@ -1895,11 +1895,11 @@ and animationElement =
     (* inherit elementTimeControl *)
     method targetElement : element t readonly_prop
 
-    method getStartTime : float t meth
+    method getStartTime : number t meth
 
-    method getCurrentTime : float t meth
+    method getCurrentTime : number t meth
 
-    method getSimpleDuration : float t meth
+    method getSimpleDuration : number t meth
   end
 
 (* interface SVGAnimateElement *)
diff --git a/lib/js_of_ocaml/geolocation.ml b/lib/js_of_ocaml/geolocation.ml
index 38e7d2fd2d..5a4980c6e8 100644
--- a/lib/js_of_ocaml/geolocation.ml
+++ b/lib/js_of_ocaml/geolocation.ml
@@ -24,19 +24,19 @@ type watchId
 
 class type coordinates =
   object
-    method latitude : float Js.t Js.readonly_prop
+    method latitude : Js.number Js.t Js.readonly_prop
 
-    method longitude : float Js.t Js.readonly_prop
+    method longitude : Js.number Js.t Js.readonly_prop
 
-    method altitude : float Js.t Js.opt Js.readonly_prop
+    method altitude : Js.number Js.t Js.opt Js.readonly_prop
 
-    method accuracy : float Js.t Js.readonly_prop
+    method accuracy : Js.number Js.t Js.readonly_prop
 
-    method altitudeAccuracy : float Js.t Js.opt Js.readonly_prop
+    method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
 
-    method heading : float Js.t Js.opt Js.readonly_prop
+    method heading : Js.number Js.t Js.opt Js.readonly_prop
 
-    method speed : float Js.t Js.opt Js.readonly_prop
+    method speed : Js.number Js.t Js.opt Js.readonly_prop
   end
 
 class type position =
diff --git a/lib/js_of_ocaml/geolocation.mli b/lib/js_of_ocaml/geolocation.mli
index 4d6c52b6c7..967f40f562 100644
--- a/lib/js_of_ocaml/geolocation.mli
+++ b/lib/js_of_ocaml/geolocation.mli
@@ -46,19 +46,19 @@ type watchId
 
 class type coordinates =
   object
-    method latitude : float Js.t Js.readonly_prop
+    method latitude : Js.number Js.t Js.readonly_prop
 
-    method longitude : float Js.t Js.readonly_prop
+    method longitude : Js.number Js.t Js.readonly_prop
 
-    method altitude : float Js.t Js.opt Js.readonly_prop
+    method altitude : Js.number Js.t Js.opt Js.readonly_prop
 
-    method accuracy : float Js.t Js.readonly_prop
+    method accuracy : Js.number Js.t Js.readonly_prop
 
-    method altitudeAccuracy : float Js.t Js.opt Js.readonly_prop
+    method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
 
-    method heading : float Js.t Js.opt Js.readonly_prop
+    method heading : Js.number Js.t Js.opt Js.readonly_prop
 
-    method speed : float Js.t Js.opt Js.readonly_prop
+    method speed : Js.number Js.t Js.opt Js.readonly_prop
   end
 
 class type position =
diff --git a/lib/js_of_ocaml/intersectionObserver.ml b/lib/js_of_ocaml/intersectionObserver.ml
index 7e4a69e1e6..1202b54598 100644
--- a/lib/js_of_ocaml/intersectionObserver.ml
+++ b/lib/js_of_ocaml/intersectionObserver.ml
@@ -8,11 +8,11 @@ class type intersectionObserverEntry =
 
     method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method intersectionRatio : float Js.t Js.readonly_prop
+    method intersectionRatio : Js.number Js.t Js.readonly_prop
 
     method isIntersecting : bool Js.t Js.readonly_prop
 
-    method time : float Js.t Js.readonly_prop
+    method time : Js.number Js.t Js.readonly_prop
   end
 
 class type intersectionObserverOptions =
@@ -21,7 +21,7 @@ class type intersectionObserverOptions =
 
     method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-    method threshold : float Js.t Js.js_array Js.t Js.writeonly_prop
+    method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
   end
 
 class type intersectionObserver =
@@ -30,7 +30,7 @@ class type intersectionObserver =
 
     method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-    method thresholds : float Js.t Js.js_array Js.t Js.readonly_prop
+    method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
 
     method observe : #Dom.node Js.t -> unit Js.meth
 
diff --git a/lib/js_of_ocaml/intersectionObserver.mli b/lib/js_of_ocaml/intersectionObserver.mli
index fa4cfa2b60..0c9f5a026b 100644
--- a/lib/js_of_ocaml/intersectionObserver.mli
+++ b/lib/js_of_ocaml/intersectionObserver.mli
@@ -14,11 +14,11 @@ class type intersectionObserverEntry =
 
     method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method intersectionRatio : float Js.t Js.readonly_prop
+    method intersectionRatio : Js.number Js.t Js.readonly_prop
 
     method isIntersecting : bool Js.t Js.readonly_prop
 
-    method time : float Js.t Js.readonly_prop
+    method time : Js.number Js.t Js.readonly_prop
   end
 
 class type intersectionObserverOptions =
@@ -27,7 +27,7 @@ class type intersectionObserverOptions =
 
     method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-    method threshold : float Js.t Js.js_array Js.t Js.writeonly_prop
+    method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
   end
 
 class type intersectionObserver =
@@ -36,7 +36,7 @@ class type intersectionObserver =
 
     method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-    method thresholds : float Js.t Js.js_array Js.t Js.readonly_prop
+    method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
 
     method observe : #Dom.node Js.t -> unit Js.meth
 
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index fe41c247fb..3349b04ec5 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -246,7 +246,24 @@ module Js = struct
 
   type string_array
 
-  class type js_string =
+  class type number =
+    object
+      method toString : js_string t meth
+
+      method toString_radix : int -> js_string t meth
+
+      method toLocaleString : js_string t meth
+
+      method toFixed : int -> js_string t meth
+
+      method toExponential : js_string t meth
+
+      method toExponential_digits : int -> js_string t meth
+
+      method toPrecision : int -> js_string t meth
+    end
+
+  and js_string =
     object
       method toString : js_string t meth
 
@@ -254,7 +271,7 @@ module Js = struct
 
       method charAt : int -> js_string t meth
 
-      method charCodeAt : int -> float t meth
+      method charCodeAt : int -> number t meth
 
       (* This may return NaN... *)
       method concat : js_string t -> js_string t meth
@@ -274,7 +291,7 @@ module Js = struct
 
       method lastIndexOf_from : js_string t -> int -> int meth
 
-      method localeCompare : js_string t -> float t meth
+      method localeCompare : js_string t -> number t meth
 
       method _match : regExp t -> match_result_handle t opt meth
 
@@ -396,7 +413,7 @@ class type ['a] js_array =
 
     method slice_end : int -> 'a js_array t meth
 
-    method sort : ('a -> 'a -> float t) callback -> 'a js_array t meth
+    method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
 
     method sort_asStrings : 'a js_array t meth
 
@@ -476,23 +493,6 @@ let str_array : string_array t -> js_string t js_array t = Unsafe.coerce
 
 let match_result : match_result_handle t -> match_result t = Unsafe.coerce
 
-class type number =
-  object
-    method toString : js_string t meth
-
-    method toString_radix : int -> js_string t meth
-
-    method toLocaleString : js_string t meth
-
-    method toFixed : int -> js_string t meth
-
-    method toExponential : js_string t meth
-
-    method toExponential_digits : int -> js_string t meth
-
-    method toPrecision : int -> js_string t meth
-  end
-
 external number_of_float : float -> number t = "caml_js_from_float"
 
 external float_of_number : number t -> float = "caml_js_to_float"
@@ -511,9 +511,9 @@ class type date =
 
     method toLocaleTimeString : js_string t meth
 
-    method valueOf : float t meth
+    method valueOf : number t meth
 
-    method getTime : float t meth
+    method getTime : number t meth
 
     method getFullYear : int meth
 
@@ -549,39 +549,39 @@ class type date =
 
     method getTimezoneOffset : int meth
 
-    method setTime : float t -> float t meth
+    method setTime : number t -> number t meth
 
-    method setFullYear : int -> float t meth
+    method setFullYear : int -> number t meth
 
-    method setUTCFullYear : int -> float t meth
+    method setUTCFullYear : int -> number t meth
 
-    method setMonth : int -> float t meth
+    method setMonth : int -> number t meth
 
-    method setUTCMonth : int -> float t meth
+    method setUTCMonth : int -> number t meth
 
-    method setDate : int -> float t meth
+    method setDate : int -> number t meth
 
-    method setUTCDate : int -> float t meth
+    method setUTCDate : int -> number t meth
 
-    method setDay : int -> float t meth
+    method setDay : int -> number t meth
 
-    method setUTCDay : int -> float t meth
+    method setUTCDay : int -> number t meth
 
-    method setHours : int -> float t meth
+    method setHours : int -> number t meth
 
-    method setUTCHours : int -> float t meth
+    method setUTCHours : int -> number t meth
 
-    method setMinutes : int -> float t meth
+    method setMinutes : int -> number t meth
 
-    method setUTCMinutes : int -> float t meth
+    method setUTCMinutes : int -> number t meth
 
-    method setSeconds : int -> float t meth
+    method setSeconds : int -> number t meth
 
-    method setUTCSeconds : int -> float t meth
+    method setUTCSeconds : int -> number t meth
 
-    method setMilliseconds : int -> float t meth
+    method setMilliseconds : int -> number t meth
 
-    method setUTCMilliseconds : int -> float t meth
+    method setUTCMilliseconds : int -> number t meth
 
     method toUTCString : js_string t meth
 
@@ -592,21 +592,21 @@ class type date =
 
 class type date_constr =
   object
-    method parse : js_string t -> float t meth
+    method parse : js_string t -> number t meth
 
-    method _UTC_month : int -> int -> float t meth
+    method _UTC_month : int -> int -> number t meth
 
-    method _UTC_day : int -> int -> float t meth
+    method _UTC_day : int -> int -> number t meth
 
-    method _UTC_hour : int -> int -> int -> int -> float t meth
+    method _UTC_hour : int -> int -> int -> int -> number t meth
 
-    method _UTC_min : int -> int -> int -> int -> int -> float t meth
+    method _UTC_min : int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_sec : int -> int -> int -> int -> int -> int -> float t meth
+    method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> float t meth
+    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
 
-    method now : float t meth
+    method now : number t meth
   end
 
 let date_constr = Unsafe.global##._Date
@@ -615,7 +615,7 @@ let date : date_constr t = date_constr
 
 let date_now : date t constr = date_constr
 
-let date_fromTimeValue : (float t -> date t) constr = date_constr
+let date_fromTimeValue : (number t -> date t) constr = date_constr
 
 let date_month : (int -> int -> date t) constr = date_constr
 
@@ -632,65 +632,65 @@ let date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr =
 
 class type math =
   object
-    method _E : float t readonly_prop
+    method _E : number t readonly_prop
 
-    method _LN2 : float t readonly_prop
+    method _LN2 : number t readonly_prop
 
-    method _LN10 : float t readonly_prop
+    method _LN10 : number t readonly_prop
 
-    method _LOG2E : float t readonly_prop
+    method _LOG2E : number t readonly_prop
 
-    method _LOG10E : float t readonly_prop
+    method _LOG10E : number t readonly_prop
 
-    method _PI : float t readonly_prop
+    method _PI : number t readonly_prop
 
-    method _SQRT1_2_ : float t readonly_prop
+    method _SQRT1_2_ : number t readonly_prop
 
-    method _SQRT2 : float t readonly_prop
+    method _SQRT2 : number t readonly_prop
 
-    method abs : float t -> float t meth
+    method abs : number t -> number t meth
 
-    method acos : float t -> float t meth
+    method acos : number t -> number t meth
 
-    method asin : float t -> float t meth
+    method asin : number t -> number t meth
 
-    method atan : float t -> float t meth
+    method atan : number t -> number t meth
 
-    method atan2 : float t -> float t -> float t meth
+    method atan2 : number t -> number t -> number t meth
 
-    method ceil : float t -> float t meth
+    method ceil : number t -> number t meth
 
-    method cos : float t -> float t meth
+    method cos : number t -> number t meth
 
-    method exp : float t -> float t meth
+    method exp : number t -> number t meth
 
-    method floor : float t -> float t meth
+    method floor : number t -> number t meth
 
-    method log : float t -> float t meth
+    method log : number t -> number t meth
 
-    method max : float t -> float t -> float t meth
+    method max : number t -> number t -> number t meth
 
-    method max_3 : float t -> float t -> float t -> float t meth
+    method max_3 : number t -> number t -> number t -> number t meth
 
-    method max_4 : float t -> float t -> float t -> float t -> float t meth
+    method max_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method min : float t -> float t -> float t meth
+    method min : number t -> number t -> number t meth
 
-    method min_3 : float t -> float t -> float t -> float t meth
+    method min_3 : number t -> number t -> number t -> number t meth
 
-    method min_4 : float t -> float t -> float t -> float t -> float t meth
+    method min_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method pow : float t -> float t -> float t meth
+    method pow : number t -> number t -> number t meth
 
-    method random : float t meth
+    method random : number t meth
 
-    method round : float t -> float t meth
+    method round : number t -> number t meth
 
-    method sin : float t -> float t meth
+    method sin : number t -> number t meth
 
-    method sqrt : float t -> float t meth
+    method sqrt : number t -> number t meth
 
-    method tan : float t -> float t meth
+    method tan : number t -> number t meth
   end
 
 let math = Unsafe.global##._Math
@@ -795,17 +795,17 @@ external bytestring : string -> js_string t = "caml_jsbytes_of_string"
 
 external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
 
-external float : float -> float t = "caml_js_from_float"
+external float : float -> number t = "caml_js_from_float"
 
-external to_float : float t -> float = "caml_js_to_float"
+external to_float : number t -> float = "caml_js_to_float"
 
-external int32 : int32 -> float t = "caml_js_from_int32"
+external int32 : int32 -> number t = "caml_js_from_int32"
 
-external to_int32 : float t -> int32 = "caml_js_to_int32"
+external to_int32 : number t -> int32 = "caml_js_to_int32"
 
-external nativeint : nativeint -> float t = "caml_js_from_nativeint"
+external nativeint : nativeint -> number t = "caml_js_from_nativeint"
 
-external to_nativeint : float t -> nativeint = "caml_js_to_nativeint"
+external to_nativeint : number t -> nativeint = "caml_js_to_nativeint"
 
 external typeof : _ t -> js_string t = "caml_js_typeof"
 
@@ -818,7 +818,7 @@ let parseInt (s : js_string t) : int =
   let s = Unsafe.fun_call Unsafe.global##.parseInt [| Unsafe.inject s |] in
   if isNaN s then failwith "parseInt" else s
 
-let parseFloat (s : js_string t) : float t =
+let parseFloat (s : js_string t) : number t =
   let s = Unsafe.fun_call Unsafe.global##.parseFloat [| Unsafe.inject s |] in
   if isNaN s then failwith "parseFloat" else s
 
@@ -855,4 +855,4 @@ let export_all obj =
 
 (* DEPRECATED *)
 
-type float_prop = float t prop
+type float_prop = number t prop
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index 555db61acb..3626cf281f 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -217,8 +217,26 @@ val nfkd : normalization t
 val nfkc : normalization t
 (** Compatibility Decomposition, followed by Canonical Composition *)
 
+(** Specification of Javascript number objects. *)
+class type number =
+  object
+    method toString : js_string t meth
+
+    method toString_radix : int -> js_string t meth
+
+    method toLocaleString : js_string t meth
+
+    method toFixed : int -> js_string t meth
+
+    method toExponential : js_string t meth
+
+    method toExponential_digits : int -> js_string t meth
+
+    method toPrecision : int -> js_string t meth
+  end
+
 (** Specification of Javascript string objects. *)
-class type js_string =
+and js_string =
   object
     method toString : js_string t meth
 
@@ -226,7 +244,7 @@ class type js_string =
 
     method charAt : int -> js_string t meth
 
-    method charCodeAt : int -> float t meth
+    method charCodeAt : int -> number t meth
 
     (* This may return NaN... *)
     method concat : js_string t -> js_string t meth
@@ -246,7 +264,7 @@ class type js_string =
 
     method lastIndexOf_from : js_string t -> int -> int meth
 
-    method localeCompare : js_string t -> float t meth
+    method localeCompare : js_string t -> number t meth
 
     method _match : regExp t -> match_result_handle t opt meth
 
@@ -362,7 +380,7 @@ class type ['a] js_array =
 
     method slice_end : int -> 'a js_array t meth
 
-    method sort : ('a -> 'a -> float t) callback -> 'a js_array t meth
+    method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
 
     method sort_asStrings : 'a js_array t meth
 
@@ -453,30 +471,6 @@ val match_result : match_result_handle t -> match_result t
       (Used to resolved the mutual dependency between string
       and array type definitions.) *)
 
-(** Specification of Javascript number objects. *)
-class type number =
-  object
-    method toString : js_string t meth
-
-    method toString_radix : int -> js_string t meth
-
-    method toLocaleString : js_string t meth
-
-    method toFixed : int -> js_string t meth
-
-    method toExponential : js_string t meth
-
-    method toExponential_digits : int -> js_string t meth
-
-    method toPrecision : int -> js_string t meth
-  end
-
-external number_of_float : float -> number t = "caml_js_from_float"
-(** Conversion of OCaml floats to Javascript number objects. *)
-
-external float_of_number : number t -> float = "caml_js_to_float"
-(** Conversion of Javascript number objects to OCaml floats. *)
-
 (** Specification of Javascript date objects. *)
 class type date =
   object
@@ -492,9 +486,9 @@ class type date =
 
     method toLocaleTimeString : js_string t meth
 
-    method valueOf : float t meth
+    method valueOf : number t meth
 
-    method getTime : float t meth
+    method getTime : number t meth
 
     method getFullYear : int meth
 
@@ -530,39 +524,39 @@ class type date =
 
     method getTimezoneOffset : int meth
 
-    method setTime : float t -> float t meth
+    method setTime : number t -> number t meth
 
-    method setFullYear : int -> float t meth
+    method setFullYear : int -> number t meth
 
-    method setUTCFullYear : int -> float t meth
+    method setUTCFullYear : int -> number t meth
 
-    method setMonth : int -> float t meth
+    method setMonth : int -> number t meth
 
-    method setUTCMonth : int -> float t meth
+    method setUTCMonth : int -> number t meth
 
-    method setDate : int -> float t meth
+    method setDate : int -> number t meth
 
-    method setUTCDate : int -> float t meth
+    method setUTCDate : int -> number t meth
 
-    method setDay : int -> float t meth
+    method setDay : int -> number t meth
 
-    method setUTCDay : int -> float t meth
+    method setUTCDay : int -> number t meth
 
-    method setHours : int -> float t meth
+    method setHours : int -> number t meth
 
-    method setUTCHours : int -> float t meth
+    method setUTCHours : int -> number t meth
 
-    method setMinutes : int -> float t meth
+    method setMinutes : int -> number t meth
 
-    method setUTCMinutes : int -> float t meth
+    method setUTCMinutes : int -> number t meth
 
-    method setSeconds : int -> float t meth
+    method setSeconds : int -> number t meth
 
-    method setUTCSeconds : int -> float t meth
+    method setUTCSeconds : int -> number t meth
 
-    method setMilliseconds : int -> float t meth
+    method setMilliseconds : int -> number t meth
 
-    method setUTCMilliseconds : int -> float t meth
+    method setUTCMilliseconds : int -> number t meth
 
     method toUTCString : js_string t meth
 
@@ -575,7 +569,7 @@ val date_now : date t constr
 (** Constructor of [Date] objects: [new%js date_now] returns a
       [Date] object initialized with the current date. *)
 
-val date_fromTimeValue : (float t -> date t) constr
+val date_fromTimeValue : (number t -> date t) constr
 (** Constructor of [Date] objects: [new%js date_fromTimeValue t] returns a
       [Date] object initialized with the time value [t]. *)
 
@@ -610,21 +604,21 @@ val date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr
 (** Specification of the date constructor, considered as an object. *)
 class type date_constr =
   object
-    method parse : js_string t -> float t meth
+    method parse : js_string t -> number t meth
 
-    method _UTC_month : int -> int -> float t meth
+    method _UTC_month : int -> int -> number t meth
 
-    method _UTC_day : int -> int -> float t meth
+    method _UTC_day : int -> int -> number t meth
 
-    method _UTC_hour : int -> int -> int -> int -> float t meth
+    method _UTC_hour : int -> int -> int -> int -> number t meth
 
-    method _UTC_min : int -> int -> int -> int -> int -> float t meth
+    method _UTC_min : int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_sec : int -> int -> int -> int -> int -> int -> float t meth
+    method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> float t meth
+    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
 
-    method now : float t meth
+    method now : number t meth
   end
 
 val date : date_constr t
@@ -633,65 +627,65 @@ val date : date_constr t
 (** Specification of Javascript math object. *)
 class type math =
   object
-    method _E : float t readonly_prop
+    method _E : number t readonly_prop
 
-    method _LN2 : float t readonly_prop
+    method _LN2 : number t readonly_prop
 
-    method _LN10 : float t readonly_prop
+    method _LN10 : number t readonly_prop
 
-    method _LOG2E : float t readonly_prop
+    method _LOG2E : number t readonly_prop
 
-    method _LOG10E : float t readonly_prop
+    method _LOG10E : number t readonly_prop
 
-    method _PI : float t readonly_prop
+    method _PI : number t readonly_prop
 
-    method _SQRT1_2_ : float t readonly_prop
+    method _SQRT1_2_ : number t readonly_prop
 
-    method _SQRT2 : float t readonly_prop
+    method _SQRT2 : number t readonly_prop
 
-    method abs : float t -> float t meth
+    method abs : number t -> number t meth
 
-    method acos : float t -> float t meth
+    method acos : number t -> number t meth
 
-    method asin : float t -> float t meth
+    method asin : number t -> number t meth
 
-    method atan : float t -> float t meth
+    method atan : number t -> number t meth
 
-    method atan2 : float t -> float t -> float t meth
+    method atan2 : number t -> number t -> number t meth
 
-    method ceil : float t -> float t meth
+    method ceil : number t -> number t meth
 
-    method cos : float t -> float t meth
+    method cos : number t -> number t meth
 
-    method exp : float t -> float t meth
+    method exp : number t -> number t meth
 
-    method floor : float t -> float t meth
+    method floor : number t -> number t meth
 
-    method log : float t -> float t meth
+    method log : number t -> number t meth
 
-    method max : float t -> float t -> float t meth
+    method max : number t -> number t -> number t meth
 
-    method max_3 : float t -> float t -> float t -> float t meth
+    method max_3 : number t -> number t -> number t -> number t meth
 
-    method max_4 : float t -> float t -> float t -> float t -> float t meth
+    method max_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method min : float t -> float t -> float t meth
+    method min : number t -> number t -> number t meth
 
-    method min_3 : float t -> float t -> float t -> float t meth
+    method min_3 : number t -> number t -> number t -> number t meth
 
-    method min_4 : float t -> float t -> float t -> float t -> float t meth
+    method min_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method pow : float t -> float t -> float t meth
+    method pow : number t -> number t -> number t meth
 
-    method random : float t meth
+    method random : number t meth
 
-    method round : float t -> float t meth
+    method round : number t -> number t meth
 
-    method sin : float t -> float t meth
+    method sin : number t -> number t meth
 
-    method sqrt : float t -> float t meth
+    method sqrt : number t -> number t meth
 
-    method tan : float t -> float t meth
+    method tan : number t -> number t meth
   end
 
 val math : math t
@@ -794,7 +788,7 @@ val isNaN : 'a -> bool
 
 val parseInt : js_string t -> int
 
-val parseFloat : js_string t -> float t
+val parseFloat : js_string t -> number t
 
 (** {2 Conversion functions between Javascript and OCaml types} *)
 
@@ -827,22 +821,28 @@ external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
       Javascript string should only contain UTF-16 code points below
       255.) *)
 
-external float : float -> float t = "caml_js_from_float"
+external float : float -> number t = "caml_js_from_float"
 (** Conversion of OCaml floats to Javascript numbers. *)
 
-external to_float : float t -> float = "caml_js_to_float"
+external to_float : number t -> float = "caml_js_to_float"
 (** Conversion of Javascript numbers to OCaml floats. *)
 
-external int32 : int32 -> float t = "caml_js_from_int32"
+external number_of_float : float -> number t = "caml_js_from_float"
+(** Conversion of OCaml floats to Javascript number objects. *)
+
+external float_of_number : number t -> float = "caml_js_to_float"
+(** Conversion of Javascript number objects to OCaml floats. *)
+
+external int32 : int32 -> number t = "caml_js_from_int32"
 (** Conversion of OCaml floats to Javascript numbers. *)
 
-external to_int32 : float t -> int32 = "caml_js_to_int32"
+external to_int32 : number t -> int32 = "caml_js_to_int32"
 (** Conversion of Javascript numbers to OCaml 32-bits. *)
 
-external nativeint : nativeint -> float t = "caml_js_from_nativeint"
+external nativeint : nativeint -> number t = "caml_js_from_nativeint"
 (** Conversion of OCaml 32-bits integers to Javascript numbers. *)
 
-external to_nativeint : float t -> nativeint = "caml_js_to_nativeint"
+external to_nativeint : number t -> nativeint = "caml_js_to_nativeint"
 
 (** Conversion of Javascript numbers to OCaml native integers. *)
 
@@ -1057,6 +1057,6 @@ exception Error of error t [@ocaml.deprecated "[since 4.0] Use [Js_error.Exn] in
     it will be serialized and wrapped into a [Failure] exception.
   *)
 
-type float_prop = float t prop [@@ocaml.deprecated "[since 2.0]."]
+type float_prop = number t prop [@@ocaml.deprecated "[since 2.0]."]
 
 (** Type of float properties. *)
diff --git a/lib/js_of_ocaml/performanceObserver.ml b/lib/js_of_ocaml/performanceObserver.ml
index e5933d394f..57cea8cef6 100644
--- a/lib/js_of_ocaml/performanceObserver.ml
+++ b/lib/js_of_ocaml/performanceObserver.ml
@@ -30,9 +30,9 @@ class type performanceEntry =
 
     method entryType : Js.js_string Js.t Js.readonly_prop
 
-    method startTime : float Js.t Js.readonly_prop
+    method startTime : Js.number Js.t Js.readonly_prop
 
-    method duration : float Js.t Js.readonly_prop
+    method duration : Js.number Js.t Js.readonly_prop
   end
 
 class type performanceObserverEntryList =
diff --git a/lib/js_of_ocaml/performanceObserver.mli b/lib/js_of_ocaml/performanceObserver.mli
index b09062a797..0c2950df7c 100644
--- a/lib/js_of_ocaml/performanceObserver.mli
+++ b/lib/js_of_ocaml/performanceObserver.mli
@@ -46,9 +46,9 @@ class type performanceEntry =
 
     method entryType : Js.js_string Js.t Js.readonly_prop
 
-    method startTime : float Js.t Js.readonly_prop
+    method startTime : Js.number Js.t Js.readonly_prop
 
-    method duration : float Js.t Js.readonly_prop
+    method duration : Js.number Js.t Js.readonly_prop
   end
 
 class type performanceObserverEntryList =
diff --git a/lib/js_of_ocaml/resizeObserver.ml b/lib/js_of_ocaml/resizeObserver.ml
index 8d4a83304a..2040977d4a 100644
--- a/lib/js_of_ocaml/resizeObserver.ml
+++ b/lib/js_of_ocaml/resizeObserver.ml
@@ -20,9 +20,9 @@ open! Import
 
 class type resizeObserverSize =
   object
-    method inlineSize : float Js.t Js.readonly_prop
+    method inlineSize : Js.number Js.t Js.readonly_prop
 
-    method blockSize : float Js.t Js.readonly_prop
+    method blockSize : Js.number Js.t Js.readonly_prop
   end
 
 class type resizeObserverEntry =
diff --git a/lib/js_of_ocaml/resizeObserver.mli b/lib/js_of_ocaml/resizeObserver.mli
index 94bd05e4f4..3b31d29f84 100644
--- a/lib/js_of_ocaml/resizeObserver.mli
+++ b/lib/js_of_ocaml/resizeObserver.mli
@@ -43,9 +43,9 @@
 
 class type resizeObserverSize =
   object
-    method inlineSize : float Js.t Js.readonly_prop
+    method inlineSize : Js.number Js.t Js.readonly_prop
 
-    method blockSize : float Js.t Js.readonly_prop
+    method blockSize : Js.number Js.t Js.readonly_prop
   end
 
 class type resizeObserverEntry =
diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index 3054b3d22b..02199ce90c 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -20,9 +20,9 @@
 open! Import
 open Js
 
-type int32 = float Js.t
+type int32 = Js.number Js.t
 
-type uint32 = float Js.t
+type uint32 = Js.number Js.t
 
 class type arrayBuffer =
   object
@@ -81,9 +81,9 @@ type int32Array = (int32, Int32.t, Bigarray.int32_elt) typedArray
 
 type uint32Array = (uint32, Int32.t, Bigarray.int32_elt) typedArray
 
-type float32Array = (float Js.t, float, Bigarray.float32_elt) typedArray
+type float32Array = (Js.number Js.t, float, Bigarray.float32_elt) typedArray
 
-type float64Array = (float Js.t, float, Bigarray.float64_elt) typedArray
+type float64Array = (Js.number Js.t, float, Bigarray.float64_elt) typedArray
 
 type ('bigarray, 'typed_array, 'elt) type' =
   | Char : (int, char, Bigarray.int8_unsigned_elt) type'
@@ -93,8 +93,8 @@ type ('bigarray, 'typed_array, 'elt) type' =
   | Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) type'
   | Int32_signed : (int32, Int32.t, Bigarray.int32_elt) type'
   | Int32_unsigned : (uint32, Int32.t, Bigarray.int32_elt) type'
-  | Float32 : (float Js.t, float, Bigarray.float32_elt) type'
-  | Float64 : (float Js.t, float, Bigarray.float64_elt) type'
+  | Float32 : (Js.number Js.t, float, Bigarray.float32_elt) type'
+  | Float64 : (Js.number Js.t, float, Bigarray.float64_elt) type'
 
 external kind :
   ('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
@@ -221,13 +221,13 @@ class type dataView =
 
     method getUint32_ : int -> bool t -> uint32 meth
 
-    method getFloat32 : int -> float Js.t meth
+    method getFloat32 : int -> Js.number Js.t meth
 
-    method getFloat32_ : int -> bool t -> float Js.t meth
+    method getFloat32_ : int -> bool t -> Js.number Js.t meth
 
-    method getFloat64 : int -> float Js.t meth
+    method getFloat64 : int -> Js.number Js.t meth
 
-    method getFloat64_ : int -> bool t -> float Js.t meth
+    method getFloat64_ : int -> bool t -> Js.number Js.t meth
 
     method setInt8 : int -> int -> unit meth
 
@@ -249,13 +249,13 @@ class type dataView =
 
     method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-    method setFloat32 : int -> float Js.t -> unit meth
+    method setFloat32 : int -> Js.number Js.t -> unit meth
 
-    method setFloat32_ : int -> float Js.t -> bool t -> unit meth
+    method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
 
-    method setFloat64 : int -> float Js.t -> unit meth
+    method setFloat64 : int -> Js.number Js.t -> unit meth
 
-    method setFloat64_ : int -> float Js.t -> bool t -> unit meth
+    method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
   end
 
 let dataView = Js.Unsafe.global##._DataView
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index 7b03eb435c..6ea4b30e02 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -22,9 +22,9 @@
 
 open Js
 
-type int32 = float Js.t
+type int32 = Js.number Js.t
 
-type uint32 = float Js.t
+type uint32 = Js.number Js.t
 
 class type arrayBuffer =
   object
@@ -83,9 +83,9 @@ type int32Array = (int32, Int32.t, Bigarray.int32_elt) typedArray
 
 type uint32Array = (uint32, Int32.t, Bigarray.int32_elt) typedArray
 
-type float32Array = (float Js.t, float, Bigarray.float32_elt) typedArray
+type float32Array = (Js.number Js.t, float, Bigarray.float32_elt) typedArray
 
-type float64Array = (float Js.t, float, Bigarray.float64_elt) typedArray
+type float64Array = (Js.number Js.t, float, Bigarray.float64_elt) typedArray
 
 type ('bigarray, 'typed_array, 'elt) type' =
   | Char : (int, char, Bigarray.int8_unsigned_elt) type'
@@ -95,8 +95,8 @@ type ('bigarray, 'typed_array, 'elt) type' =
   | Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) type'
   | Int32_signed : (int32, Int32.t, Bigarray.int32_elt) type'
   | Int32_unsigned : (uint32, Int32.t, Bigarray.int32_elt) type'
-  | Float32 : (float Js.t, float, Bigarray.float32_elt) type'
-  | Float64 : (float Js.t, float, Bigarray.float64_elt) type'
+  | Float32 : (Js.number Js.t, float, Bigarray.float32_elt) type'
+  | Float64 : (Js.number Js.t, float, Bigarray.float64_elt) type'
 
 val kind : ('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
 
@@ -219,13 +219,13 @@ class type dataView =
 
     method getUint32_ : int -> bool t -> uint32 meth
 
-    method getFloat32 : int -> float Js.t meth
+    method getFloat32 : int -> Js.number Js.t meth
 
-    method getFloat32_ : int -> bool t -> float Js.t meth
+    method getFloat32_ : int -> bool t -> Js.number Js.t meth
 
-    method getFloat64 : int -> float Js.t meth
+    method getFloat64 : int -> Js.number Js.t meth
 
-    method getFloat64_ : int -> bool t -> float Js.t meth
+    method getFloat64_ : int -> bool t -> Js.number Js.t meth
 
     method setInt8 : int -> int -> unit meth
 
@@ -247,13 +247,13 @@ class type dataView =
 
     method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-    method setFloat32 : int -> float Js.t -> unit meth
+    method setFloat32 : int -> Js.number Js.t -> unit meth
 
-    method setFloat32_ : int -> float Js.t -> bool t -> unit meth
+    method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
 
-    method setFloat64 : int -> float Js.t -> unit meth
+    method setFloat64 : int -> Js.number Js.t -> unit meth
 
-    method setFloat64_ : int -> float Js.t -> bool t -> unit meth
+    method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
   end
 
 val dataView : (arrayBuffer t -> dataView t) constr
diff --git a/lib/js_of_ocaml/webGL.ml b/lib/js_of_ocaml/webGL.ml
index b489c0d9fe..22a19774b3 100644
--- a/lib/js_of_ocaml/webGL.ml
+++ b/lib/js_of_ocaml/webGL.ml
@@ -31,7 +31,7 @@ type intptr = int
 
 type uint = int
 
-type clampf = float t
+type clampf = number t
 
 type void
 
@@ -244,11 +244,11 @@ class type renderingContext =
 
     method isEnabled : enableCap -> bool t meth
 
-    method lineWidth : float t -> unit meth
+    method lineWidth : number t -> unit meth
 
     method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-    method polygonOffset : float t -> float t -> unit meth
+    method polygonOffset : number t -> number t -> unit meth
 
     method sampleCoverage : clampf -> bool t -> unit meth
 
@@ -442,7 +442,7 @@ class type renderingContext =
       -> unit meth
 
     (* {[
-        method texParameterf : texTarget -> texParam -> float t -> unit meth
+        method texParameterf : texTarget -> texParam -> number t -> unit meth
        ]}
     *)
     method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
@@ -564,12 +564,12 @@ class type renderingContext =
 
     method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-    method uniform1f : float t uniformLocation t -> float t -> unit meth
+    method uniform1f : number t uniformLocation t -> number t -> unit meth
 
     method uniform1fv_typed :
-      float t uniformLocation t -> Typed_array.float32Array t -> unit meth
+      number t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform1fv : float t uniformLocation t -> float t js_array t -> unit meth
+    method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
 
     method uniform1i : int uniformLocation t -> int -> unit meth
 
@@ -578,12 +578,12 @@ class type renderingContext =
 
     method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2f : [ `vec2 ] uniformLocation t -> float t -> float t -> unit meth
+    method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
 
     method uniform2fv_typed :
       [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform2fv : [ `vec2 ] uniformLocation t -> float t js_array t -> unit meth
+    method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
 
     method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
@@ -593,12 +593,12 @@ class type renderingContext =
       [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniform3f :
-      [ `vec3 ] uniformLocation t -> float t -> float t -> float t -> unit meth
+      [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
 
     method uniform3fv_typed :
       [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform3fv : [ `vec3 ] uniformLocation t -> float t js_array t -> unit meth
+    method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
 
     method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
@@ -608,12 +608,17 @@ class type renderingContext =
       [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniform4f :
-      [ `vec4 ] uniformLocation t -> float t -> float t -> float t -> float t -> unit meth
+         [ `vec4 ] uniformLocation t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> unit meth
 
     method uniform4fv_typed :
       [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform4fv : [ `vec4 ] uniformLocation t -> float t js_array t -> unit meth
+    method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
 
     method uniform4i :
       [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
@@ -624,44 +629,45 @@ class type renderingContext =
       [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniformMatrix2fv :
-      [ `mat2 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
+      [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
     method uniformMatrix2fv_typed :
       [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix3fv :
-      [ `mat3 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
+      [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
     method uniformMatrix3fv_typed :
       [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix4fv :
-      [ `mat4 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
+      [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
     method uniformMatrix4fv_typed :
       [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib1f : uint -> float t -> unit meth
+    method vertexAttrib1f : uint -> number t -> unit meth
 
-    method vertexAttrib1fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib1fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib2f : uint -> float t -> float t -> unit meth
+    method vertexAttrib2f : uint -> number t -> number t -> unit meth
 
-    method vertexAttrib2fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib2fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib3f : uint -> float t -> float t -> float t -> unit meth
+    method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib3fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib3fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib4f : uint -> float t -> float t -> float t -> float t -> unit meth
+    method vertexAttrib4f :
+      uint -> number t -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib4fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib4fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
@@ -855,7 +861,7 @@ class type renderingContext =
 
     method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-    method _LINE_WIDTH_ : float t parameter readonly_prop
+    method _LINE_WIDTH_ : number t parameter readonly_prop
 
     method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
@@ -869,7 +875,7 @@ class type renderingContext =
 
     method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-    method _DEPTH_CLEAR_VALUE_ : float t parameter readonly_prop
+    method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
 
     method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
@@ -933,9 +939,9 @@ class type renderingContext =
 
     method _STENCIL_BITS_ : int parameter readonly_prop
 
-    method _POLYGON_OFFSET_UNITS_ : float t parameter readonly_prop
+    method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FACTOR_ : float t parameter readonly_prop
+    method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
 
     method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
@@ -945,7 +951,7 @@ class type renderingContext =
 
     method _SAMPLES_ : int parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_VALUE_ : float t parameter readonly_prop
+    method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
 
     method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
diff --git a/lib/js_of_ocaml/webGL.mli b/lib/js_of_ocaml/webGL.mli
index b839d2282c..b2671fdec4 100644
--- a/lib/js_of_ocaml/webGL.mli
+++ b/lib/js_of_ocaml/webGL.mli
@@ -32,7 +32,7 @@ type intptr = int
 
 type uint = int
 
-type clampf = float t
+type clampf = number t
 
 type void
 
@@ -234,11 +234,11 @@ class type renderingContext =
 
     method isEnabled : enableCap -> bool t meth
 
-    method lineWidth : float t -> unit meth
+    method lineWidth : number t -> unit meth
 
     method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-    method polygonOffset : float t -> float t -> unit meth
+    method polygonOffset : number t -> number t -> unit meth
 
     method sampleCoverage : clampf -> bool t -> unit meth
 
@@ -432,7 +432,7 @@ class type renderingContext =
       -> unit meth
 
     (* {[
-         method texParameterf : texTarget -> texParam -> float t -> unit meth
+         method texParameterf : texTarget -> texParam -> number t -> unit meth
        ]}
     *)
     method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
@@ -554,12 +554,12 @@ class type renderingContext =
 
     method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-    method uniform1f : float t uniformLocation t -> float t -> unit meth
+    method uniform1f : number t uniformLocation t -> number t -> unit meth
 
     method uniform1fv_typed :
-      float t uniformLocation t -> Typed_array.float32Array t -> unit meth
+      number t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform1fv : float t uniformLocation t -> float t js_array t -> unit meth
+    method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
 
     method uniform1i : int uniformLocation t -> int -> unit meth
 
@@ -568,12 +568,12 @@ class type renderingContext =
 
     method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2f : [ `vec2 ] uniformLocation t -> float t -> float t -> unit meth
+    method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
 
     method uniform2fv_typed :
       [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform2fv : [ `vec2 ] uniformLocation t -> float t js_array t -> unit meth
+    method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
 
     method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
@@ -583,12 +583,12 @@ class type renderingContext =
       [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniform3f :
-      [ `vec3 ] uniformLocation t -> float t -> float t -> float t -> unit meth
+      [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
 
     method uniform3fv_typed :
       [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform3fv : [ `vec3 ] uniformLocation t -> float t js_array t -> unit meth
+    method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
 
     method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
@@ -598,12 +598,17 @@ class type renderingContext =
       [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniform4f :
-      [ `vec4 ] uniformLocation t -> float t -> float t -> float t -> float t -> unit meth
+         [ `vec4 ] uniformLocation t
+      -> number t
+      -> number t
+      -> number t
+      -> number t
+      -> unit meth
 
     method uniform4fv_typed :
       [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform4fv : [ `vec4 ] uniformLocation t -> float t js_array t -> unit meth
+    method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
 
     method uniform4i :
       [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
@@ -614,44 +619,45 @@ class type renderingContext =
       [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
     method uniformMatrix2fv :
-      [ `mat2 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
+      [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
     method uniformMatrix2fv_typed :
       [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix3fv :
-      [ `mat3 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
+      [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
     method uniformMatrix3fv_typed :
       [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
     method uniformMatrix4fv :
-      [ `mat4 ] uniformLocation t -> bool t -> float t js_array t -> unit meth
+      [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
     method uniformMatrix4fv_typed :
       [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib1f : uint -> float t -> unit meth
+    method vertexAttrib1f : uint -> number t -> unit meth
 
-    method vertexAttrib1fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib1fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib2f : uint -> float t -> float t -> unit meth
+    method vertexAttrib2f : uint -> number t -> number t -> unit meth
 
-    method vertexAttrib2fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib2fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib3f : uint -> float t -> float t -> float t -> unit meth
+    method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib3fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib3fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib4f : uint -> float t -> float t -> float t -> float t -> unit meth
+    method vertexAttrib4f :
+      uint -> number t -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib4fv : uint -> float t js_array t -> unit meth
+    method vertexAttrib4fv : uint -> number t js_array t -> unit meth
 
     method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
@@ -845,7 +851,7 @@ class type renderingContext =
 
     method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-    method _LINE_WIDTH_ : float t parameter readonly_prop
+    method _LINE_WIDTH_ : number t parameter readonly_prop
 
     method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
@@ -859,7 +865,7 @@ class type renderingContext =
 
     method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-    method _DEPTH_CLEAR_VALUE_ : float t parameter readonly_prop
+    method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
 
     method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
@@ -923,9 +929,9 @@ class type renderingContext =
 
     method _STENCIL_BITS_ : int parameter readonly_prop
 
-    method _POLYGON_OFFSET_UNITS_ : float t parameter readonly_prop
+    method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FACTOR_ : float t parameter readonly_prop
+    method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
 
     method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
@@ -935,7 +941,7 @@ class type renderingContext =
 
     method _SAMPLES_ : int parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_VALUE_ : float t parameter readonly_prop
+    method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
 
     method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
diff --git a/lib/tests/test_typed_array.ml b/lib/tests/test_typed_array.ml
index bf2c733b31..10846b3338 100644
--- a/lib/tests/test_typed_array.ml
+++ b/lib/tests/test_typed_array.ml
@@ -30,9 +30,9 @@ module Setup = struct
     | Uint8 : (int, int, Bigarray.int8_unsigned_elt) t
     | Int16 : (int, int, Bigarray.int16_signed_elt) t
     | Uint16 : (int, int, Bigarray.int16_unsigned_elt) t
-    | Int32 : (float Js.t, Int32.t, Bigarray.int32_elt) t
-    | Float32 : (float Js.t, float, Bigarray.float32_elt) t
-    | Float64 : (float Js.t, float, Bigarray.float64_elt) t
+    | Int32 : (Js.number Js.t, Int32.t, Bigarray.int32_elt) t
+    | Float32 : (Js.number Js.t, float, Bigarray.float32_elt) t
+    | Float64 : (Js.number Js.t, float, Bigarray.float64_elt) t
 end
 
 let kind_of_setup : type a b c. (a, b, c) Setup.t -> (b, c) kind = function

From d61370edda9e5e24605c9ad89f8132fa7c952d7d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 25 Jul 2023 16:40:16 +0200
Subject: [PATCH 096/481] Fix caml_js_on_ie

---
 runtime/jslib_js_of_ocaml.js | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/runtime/jslib_js_of_ocaml.js b/runtime/jslib_js_of_ocaml.js
index a5e2fa565b..fa88452927 100644
--- a/runtime/jslib_js_of_ocaml.js
+++ b/runtime/jslib_js_of_ocaml.js
@@ -22,7 +22,8 @@
 //Provides: caml_js_on_ie const
 function caml_js_on_ie () {
   var ua =
-      globalThis.navigator?globalThis.navigator.userAgent:"";
+      (globalThis.navigator&&globalThis.navigator.userAgent)
+      ?globalThis.navigator.userAgent:"";
   return ua.indexOf("MSIE") != -1 && ua.indexOf("Opera") != 0;
 }
 

From d131bf1c5ee2cb36d128051a35f91de2a5885ca8 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@nomadic-labs.com>
Date: Tue, 25 Jul 2023 14:57:05 +0200
Subject: [PATCH 097/481] Wa_structure.is_forward

---
 compiler/lib/wasm/wa_structure.ml | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
index 28c45c6f85..2e2efdc900 100644
--- a/compiler/lib/wasm/wa_structure.ml
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -30,6 +30,9 @@ type control_flow_graph =
   ; block_order : (Addr.t, int) Hashtbl.t
   }
 
+let is_backward g pc pc' = Hashtbl.find g.block_order pc >= Hashtbl.find g.block_order pc'
+let is_forward g pc pc' = Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+
 let build_graph blocks pc =
   let succs = Hashtbl.create 16 in
   let l = ref [] in
@@ -79,7 +82,7 @@ let dominator_tree g =
     (* Compute closest common ancestor *)
     if pc = pc'
     then pc
-    else if Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+    else if is_forward g pc pc'
     then inter pc (Hashtbl.find dom pc')
     else inter (Hashtbl.find dom pc) pc'
   in
@@ -87,7 +90,7 @@ let dominator_tree g =
       let l = Hashtbl.find g.succs pc in
       Addr.Set.iter
         (fun pc' ->
-          if Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+          if is_forward g pc pc'
           then
             let d = try inter pc (Hashtbl.find dom pc') with Not_found -> pc in
             Hashtbl.replace dom pc' d)
@@ -97,7 +100,7 @@ let dominator_tree g =
       let l = Hashtbl.find g.succs pc in
       Addr.Set.iter
         (fun pc' ->
-          if Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+          if is_forward g pc pc'
           then
             let d = Hashtbl.find dom pc' in
             assert (inter pc d = d))
@@ -107,7 +110,7 @@ let dominator_tree g =
 (* pc dominates pc' *)
 let rec dominates g idom pc pc' =
   pc = pc'
-  || Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
+  || is_forward g pc pc'
      && dominates g idom pc (Hashtbl.find idom pc')
 
 (* pc has at least two forward edges moving into it *)
@@ -127,7 +130,6 @@ let is_loop_header g pc =
   let o = Hashtbl.find g.block_order pc in
   Addr.Set.exists (fun pc' -> Hashtbl.find g.block_order pc' >= o) s
 
-let is_backward g pc pc' = Hashtbl.find g.block_order pc >= Hashtbl.find g.block_order pc'
 
 let dominance_frontier g idom =
   let frontiers = Hashtbl.create 16 in

From 66f6cb57956ac2fb7ffb548d498771a277b0e7fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 13:06:38 +0200
Subject: [PATCH 098/481] Runtime: small fixes

---
 runtime/wasm/float.wat  | 2 +-
 runtime/wasm/jslib.wat  | 9 ++++++---
 runtime/wasm/runtime.js | 2 +-
 3 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index ee4a43c62b..f425e18a3e 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -730,7 +730,7 @@
                               (i64.const 0x3ff))
                      (i64.const 52)))))
 
-   (func (export "caml_ldexp")
+   (func (export "caml_ldexp_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (struct.new $float
          (call $ldexp (struct.get $float 0 (ref.cast $float (local.get 0)))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index d69708a881..fb83f894aa 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -148,9 +148,12 @@
    (func (export "caml_js_meth_call")
       (param $o (ref eq)) (param $f (ref eq)) (param $args (ref eq))
       (result (ref eq))
+      (if (ref.test $string (local.get $f))
+         (then
+            (local.set $f (call $caml_jsbytes_of_string (local.get $f)))))
       (return_call $wrap
          (call $meth_call (call $unwrap (local.get $o))
-            (call $unwrap (call $caml_jsstring_of_string (local.get $f)))
+            (call $unwrap (local.get $f))
             (call $unwrap (call $caml_js_from_array (local.get $args))))))
 
    (func (export "caml_js_get")
@@ -176,7 +179,7 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (if (ref.test $string (local.get 1))
          (then
-            (local.set 1 (call $caml_jsstring_of_string (local.get 1)))))
+            (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (call $delete (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))
       (i31.new (i32.const 0)))
 
@@ -533,7 +536,7 @@
       (local.set $i (i32.const 0))
       (local.set $l (i31.new (i32.const 0)))
       (loop $loop
-         (if (i32.le_u (local.get $i) (local.get $len))
+         (if (i32.lt_u (local.get $i) (local.get $len))
             (then
                (local.set $l
                   (array.new_fixed $block (i31.new (i32.const 0))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index b0839fd42e..f894101cb1 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -245,7 +245,7 @@
          weak_map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const imports = {Math:math,bindings:bindings}
+    const imports = {Math:math,bindings:bindings,env:{}}
     const wasmModule =
           isNode?await WebAssembly.instantiate(await code, imports)
                 :await WebAssembly.instantiateStreaming(code,imports)

From 73cdc790662d187ec18d696344463a74e3ca3223 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 13:12:14 +0200
Subject: [PATCH 099/481] Runtime: implement some Sys functions

---
 runtime/wasm/jslib.wat  | 20 ++++++++++++++++++
 runtime/wasm/runtime.js |  6 ++++++
 runtime/wasm/sys.wat    | 45 ++++++++++++++++++++++++-----------------
 3 files changed, 53 insertions(+), 18 deletions(-)

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index fb83f894aa..389663793a 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -276,6 +276,26 @@
                (br $loop))))
       (local.get $a'))
 
+   (func (export "caml_js_to_string_array")
+      (param $a (ref extern)) (result (ref eq))
+      (local $a' (ref $block)) (local $l i32) (local $i i32)
+      (local.set $l (call $array_length (local.get $a)))
+      (local.set $a'
+         (array.new $block (i31.new (i32.const 0))
+            (i32.add (local.get $l) (i32.const 1))))
+      (local.set $i (i32.const 0))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $l))
+            (then
+               (array.set $block (local.get $a')
+                  (i32.add (local.get $i) (i32.const 1))
+                  (call $caml_string_of_jsstring
+                     (call $wrap
+                        (call $array_get (local.get $a) (local.get $i)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.get $a'))
+
    (func $caml_js_wrap_callback (export "caml_js_wrap_callback")
       (param (ref eq)) (result (ref eq))
       (return_call $wrap (call $wrap_callback (local.get 0))))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index f894101cb1..97d425c103 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -230,6 +230,12 @@
          },
          mktime:(year,month,day,h,m,s)=>new Date(year,month,day,h,m,s).getTime(),
          random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
+         argv:()=>isNode?process.argv.slice(1):['a.out'],
+         getenv:(n)=>isNode?process.env[n]:null,
+         system:(c)=>{
+           var res = require('child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
+           return res.signal?128:status
+         },
          start_fiber:(x)=>start_fiber(x),
          suspend_fiber:
          wrap_fun(
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 16965e194b..d399b806d0 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -6,9 +6,21 @@
       (func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "random_seed" (func $random_seed (result (ref extern))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "caml_jsstring_of_string"
       (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_js_to_string_array"
+      (func $caml_js_to_string_array (param $a (ref extern)) (result (ref eq))))
    (import "fail" "caml_raise_not_found" (func $caml_raise_not_found))
+   (import "bindings" "argv" (func $argv (result (ref extern))))
+   (import "bindings" "system" (func $system (param anyref) (result (ref eq))))
+   (import "bindings" "getenv" (func $getenv (param anyref) (result anyref)))
+   (import "bindings" "array_length"
+      (func $array_length (param (ref extern)) (result i32)))
+   (import "bindings" "array_get"
+      (func $array_get (param (ref extern)) (param i32) (result anyref)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -21,24 +33,24 @@
    (export "caml_sys_unsafe_getenv" (func $caml_sys_getenv))
    (func $caml_sys_getenv (export "caml_sys_getenv")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_getenv"))
-      (call $log_js
-         (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
-      (call $caml_raise_not_found)
-      (i31.new (i32.const 0)))
+      (local $res anyref)
+      (local.set $res
+         (call $getenv
+            (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
+      (if (i32.eqz (ref.test string (local.get $res)))
+         (then
+            (call $caml_raise_not_found)))
+      (return_call $caml_string_of_jsstring (call $wrap (local.get $res))))
 
    (func (export "caml_sys_argv") (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_sys_argv"))
-      (array.new_fixed $block (i31.new (i32.const 0))
-         (array.new_fixed $string (i32.const 97))))
+      (call $caml_js_to_string_array (call $argv)))
 
    (func (export "caml_sys_executable_name")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_executable_name"))
-      (i31.new (i32.const 0)))
+      (array.get $block
+         (ref.cast $block (call $caml_js_to_string_array (call $argv)))
+         (i32.const 1)))
 
    (export "caml_sys_time_include_children" (func $caml_sys_time))
    (func $caml_sys_time (export "caml_sys_time")
@@ -50,8 +62,8 @@
    (func (export "caml_sys_system_command")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_sys_system_command"))
-      (i31.new (i32.const 0)))
+      (return_call $system
+         (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
 
    (func (export "caml_sys_random_seed")
       (param (ref eq)) (result (ref eq))
@@ -93,19 +105,16 @@
    (func (export "caml_sys_const_ostype_unix")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_sys_const_ostype_unix"))
       (i31.new (i32.const 1)))
 
    (func (export "caml_sys_const_ostype_win32")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_sys_const_ostype_win32"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_sys_const_ostype_cygwin")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_sys_const_ostype_cygwin"))
       (i31.new (i32.const 0)))
 
    (data $Unix "Unix")
@@ -113,7 +122,7 @@
    (func (export "caml_sys_get_config")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_sys_get_config"))
+      ;; (call $log_js (string.const "caml_sys_get_config"))
       (array.new_fixed $block (i31.new (i32.const 0))
          (array.new_data $string $Unix (i32.const 0) (i32.const 4))
          (i31.new (i32.const 32))

From 33e4149e229bb6d21f95ca0cf25ee68d66a329c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 13:19:44 +0200
Subject: [PATCH 100/481] Runtime: implement some filesystem functions

---
 runtime/wasm/fs.wat     | 38 +++++++++++++++++++++++++++-----------
 runtime/wasm/runtime.js |  7 +++++++
 2 files changed, 34 insertions(+), 11 deletions(-)

diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index baf0e35e35..f77793a29b 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -1,12 +1,30 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
+   (import "bindings" "getcwd" (func $getcwd (result anyref)))
+   (import "bindings" "chdir" (func $chdir (param anyref)))
+   (import "bindings" "unlink" (func $unlink (param anyref)))
+   (import "bindings" "readdir"
+      (func $readdir (param anyref) (result (ref extern))))
+   (import "bindings" "file_exists"
+      (func $file_exists (param anyref) (result (ref eq))))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "caml_string_of_jsstring"
+      (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_jsstring_of_string"
+      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_js_to_string_array"
+      (func $caml_js_to_string_array (param $a (ref extern)) (result (ref eq))))
 
    (type $string (array (mut i8)))
 
    (func (export "caml_sys_getcwd")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_getcwd"))
+      (return_call $caml_string_of_jsstring (call $wrap (call $getcwd))))
+
+   (func (export "caml_sys_chdir")
+      (param (ref eq)) (result (ref eq))
+      (call $chdir (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_sys_mkdir")
@@ -17,14 +35,13 @@
 
    (func (export "caml_sys_read_directory")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_read_directory"))
-      (i31.new (i32.const 0)))
+      (return_call $caml_js_to_string_array
+         (call $readdir
+            (call $unwrap (call $caml_jsstring_of_string (local.get 0))))))
 
    (func (export "caml_sys_remove")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_remove"))
+      (call $unlink (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_sys_rename")
@@ -35,15 +52,14 @@
 
    (func (export "caml_sys_file_exists")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_file_exists"))
-      (i31.new (i32.const 0)))
+      (return_call $file_exists
+         (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
 
    (func (export "caml_read_file_content")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_read_file_content"))
-      (array.new_fixed $string))
+      (i31.new (i32.const 0)))
 
    (func (export "caml_fs_init") (result (ref eq))
       (i31.new (i32.const 0)))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 97d425c103..53caf744fa 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -27,6 +27,8 @@
        Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
        Float32Array, Float64Array, Uint8Array]
 
+    const fs = isNode&&require('fs')
+
     var start_fiber
 
     function wrap_fun (t,f,a) {
@@ -236,6 +238,11 @@
            var res = require('child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
            return res.signal?128:status
          },
+         getcwd:()=>isNode?process.cwd():'/static',
+         chdir:(x)=>process.chdir(x),
+         unlink:(p)=>fs.unlinkSync(p),
+         readdir:(p)=>fs.readdirSync(p),
+         file_exists:(p)=>+fs.existsSync(p),
          start_fiber:(x)=>start_fiber(x),
          suspend_fiber:
          wrap_fun(

From 3705eacbf775fbe34bc874ee80c78de0ce930b66 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 14:04:49 +0200
Subject: [PATCH 101/481] Runtime: implement some I/O primitives

---
 runtime/wasm/io.wat     | 418 +++++++++++++++++++++++++++++++++++-----
 runtime/wasm/runtime.js |  41 ++++
 2 files changed, 410 insertions(+), 49 deletions(-)

diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index e2bbcc9854..f57902c6f6 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -1,62 +1,275 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "caml_jsstring_of_string"
+      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_list_of_js_array"
+      (func $caml_list_of_js_array (param (ref eq)) (result (ref eq))))
+   (import "bindings" "open"
+      (func $open (param anyref) (param i32) (param i32) (result i32)))
+   (import "bindings" "close" (func $close (param i32)))
+   (import "bindings" "write"
+      (func $write
+         (param i32) (param (ref extern)) (param i32) (param i32) (result i32)))
+   (import "bindings" "read"
+      (func $read
+         (param i32) (param (ref extern)) (param i32) (param i32) (param i64)
+         (result i32)))
+   (import "bindings" "file_size" (func $file_size (param i32) (result i64)))
+   (import "bindings" "register_channel"
+      (func $register_channel (param (ref eq))))
+   (import "bindings" "unregister_channel"
+      (func $unregister_channel (param (ref eq))))
+   (import "bindings" "channel_list" (func $channel_list (result anyref)))
+   (import "bindings" "ta_new" (func $ta_new (param i32) (result (ref extern))))
+   (import "bindings" "ta_copy"
+      (func $ta_copy (param (ref extern)) (param i32) (param i32) (param i32)))
+   (import "bindings" "ta_set_ui8"
+      (func $ta_set_ui8 (param (ref extern)) (param i32) (param i32))) ;; ZZZ ??
+   (import "bindings" "ta_get_ui8"
+      (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32)))
+   (import "custom" "custom_compare_id"
+      (func $custom_compare_id
+        (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
+   (import "custom" "custom_hash_id"
+      (func $custom_hash_id (param (ref eq)) (result i32)))
+   (import "custom" "custom_next_id" (func $custom_next_id (result i64)))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+   (type $offset_array (array (mut i64)))
+
+   (type $value->value->int->int
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
+   (type $value->int
+      (func (param (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field $cust_id (ref $string))
+         (field $cust_compare (ref null $value->value->int->int))
+         (field $cust_compare_ext (ref null $value->value->int->int))
+         (field $cust_hash (ref null $value->int))
+         ;; ZZZ
+      ))
+   (type $custom (struct (field (ref $custom_operations))))
+   (type $custom_with_id
+      (sub $custom
+         (struct
+            (field (ref $custom_operations))
+            (field $id i64))))
+
+   (global $channel_ops (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string ;; "_chan"
+            (i32.const 95) (i32.const 99) (i32.const 104) (i32.const 97)
+            (i32.const 110))
+         (ref.func $custom_compare_id)
+         (ref.null $value->value->int->int)
+         (ref.func $custom_hash_id)))
+
+   (type $channel
+      (sub final $custom_with_id
+         (struct
+            (field (ref $custom_operations))
+            (field i64)
+            (field $fd (mut i32))
+            (field $buffer (mut (ref extern)))
+            (field $curr (mut i32))
+            (field $max (mut i32))
+            (field $size (mut i32))
+            (field $flags (mut i32))))) ;; flags
+
+   (global $fd_offsets (export "fd_offsets") (mut (ref $offset_array))
+      (array.new $offset_array (i64.const 0) (i32.const 3)))
+
+   (func $initialize_fd_offset (param $fd i32) (param $offset i64)
+      (local $len i32)
+      (local $a (ref $offset_array))
+      (local.set $len (array.len (global.get $fd_offsets)))
+      (if (i32.ge_u (local.get $fd) (local.get $len))
+         (then
+            (loop $loop
+               (local.set $len (i32.shl (local.get $len) (i32.const 1)))
+               (br_if $loop (i32.ge_u (local.get $fd) (local.get $len))))
+            (local.set $a
+               (array.new $offset_array (i64.const 0) (local.get $len)))
+            (array.copy $offset_array $offset_array
+               (local.get $a) (i32.const 0)
+               (global.get $fd_offsets) (i32.const 0)
+               (array.len (global.get $fd_offsets)))
+             (global.set $fd_offsets (local.get $a))))
+      (array.set $offset_array (global.get $fd_offsets) (local.get $fd)
+        (local.get $offset)))
+
+   (global $IO_BUFFER_SIZE i32 (i32.const 65536))
+
+   (type $open_flags (array i8))
+   ;;  1 O_RDONLY
+   ;;  2 O_WRONLY
+   ;;  4 O_APPEND
+   ;;  8 O_CREAT
+   ;; 16 O_TRUNC
+   ;; 32 O_EXCL
+   ;; 64 O_NONBLOCK
+   (global $sys_open_flags (ref $open_flags)
+      (array.new_fixed $open_flags
+         (i32.const 1) (i32.const 2) (i32.const 6) (i32.const 8) (i32.const 16)
+         (i32.const 32) (i32.const 0) (i32.const 0) (i32.const 64)))
+
+   (func $convert_flag_list (param $vflags (ref eq)) (result i32)
+      (local $flags i32)
+      (local $cons (ref $block))
+      (loop $loop
+         (drop (block $done (result (ref eq))
+            (local.set $cons
+               (br_on_cast_fail $done (ref eq) (ref $block) (local.get $vflags)))
+            (local.set $flags
+               (i32.or (local.get $flags)
+                  (array.get_u $open_flags (global.get $sys_open_flags)
+                     (i31.get_u
+                        (ref.cast i31
+                           (array.get $block
+                              (local.get $cons) (i32.const 1)))))))
+            (local.set $vflags
+               (array.get $block (local.get $cons) (i32.const 2)))
+            (br $loop))))
+      (local.get $flags))
 
    (func (export "caml_sys_open")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_open"))
-      (i31.new (i32.const 0)))
+      (param $path (ref eq)) (param $flags (ref eq)) (param $perm (ref eq))
+      (result (ref eq))
+      (local $fd i32)
+      (local.set $fd
+         (call $open
+            (call $unwrap (call $caml_jsstring_of_string (local.get $path)))
+            (call $convert_flag_list (local.get $flags))
+            (i31.get_u (ref.cast i31 (local.get $perm)))))
+      ;; ZZZ initial offset is file size when appending
+      (call $initialize_fd_offset (local.get $fd) (i64.const 0))
+      (i31.new (local.get $fd)))
 
-   (func (export "caml_sys_close")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_close"))
+   (func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
+      (call $close (i31.get_u (ref.cast i31 (local.get 0))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_set_channel_name")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_set_channel_name"))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_out_channels_list")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_out_channels_list"))
-      (i31.new (i32.const 0)))
+      (return_call $caml_list_of_js_array (call $wrap (call $channel_list))))
 
    (func (export "caml_ml_open_descriptor_in")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_open_descriptor_in"))
-      (i31.new (i32.const 0)))
+      (param $fd (ref eq)) (result (ref eq))
+      (struct.new $channel
+         (global.get $channel_ops)
+         (call $custom_next_id)
+         (i31.get_u (ref.cast i31 (local.get $fd)))
+         (call $ta_new (global.get $IO_BUFFER_SIZE))
+         (i32.const 0)
+         (i32.const 0)
+         (global.get $IO_BUFFER_SIZE)
+         (i32.const 0)))
 
    (global $caml_stderr (export "caml_stderr")
       (mut (ref eq)) (i31.new (i32.const 0)))
 
    (func (export "caml_ml_open_descriptor_out")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_open_descriptor_out"))
-      (i31.new (i32.const 0)))
+      (param $fd (ref eq)) (result (ref eq))
+      (local $res (ref eq))
+      (local.set $res
+         (struct.new $channel
+            (global.get $channel_ops)
+            (call $custom_next_id)
+            (i31.get_u (ref.cast i31 (local.get $fd)))
+            (call $ta_new (global.get $IO_BUFFER_SIZE))
+            (i32.const 0)
+            (i32.const -1)
+            (global.get $IO_BUFFER_SIZE)
+            (i32.const 0)))
+      (call $register_channel (local.get $res))
+      (if (ref.eq (local.get $fd) (i31.new (i32.const 2)))
+         (then
+            (global.set $caml_stderr (local.get $res))))
+      (local.get $res))
 
    (func (export "caml_ml_close_channel")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_close_channel"))
+      (local $ch (ref $channel))
+      (local $fd i32)
+      (local.set $ch (ref.cast $channel (local.get 0)))
+      (struct.set $channel $curr (local.get $ch) (i32.const 0))
+      (struct.set $channel $max (local.get $ch) (i32.const 0))
+      (struct.set $channel $size (local.get $ch) (i32.const 0))
+      (local.set $fd (struct.get $channel $fd (local.get $ch)))
+      (if (i32.ne (local.get $fd) (i32.const -1))
+         (then
+            (struct.set $channel $fd (local.get $ch) (i32.const -1))
+            (call $unregister_channel (local.get $ch))
+            (call $close (local.get $fd))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_input")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input"))
-      (i31.new (i32.const 0)))
+      (param $vch (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq))
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $ch (ref $channel)) (local $s (ref $string))
+      (local $pos i32) (local $len i32) (local $curr i32)
+      (local $i i32) (local $avail i32) (local $nread $i32)
+      (local $fd i32)
+      (local $buf (ref extern))
+      (local $offset i64)
+      (local.set $ch (ref.cast $channel (local.get $vch)))
+      (local.set $s (ref.cast $string (local.get $vs)))
+      (local.set $pos (i31.get_u (ref.cast i31 (local.get $vpos))))
+      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
+      (local.set $buf (struct.get $channel $buffer (local.get $ch)))
+      (local.set $curr (struct.get $channel $curr (local.get $ch)))
+      (local.set $avail
+         (i32.sub (struct.get $channel $max (local.get $ch)) (local.get $curr)))
+      (if (i32.gt_u (local.get $len) (local.get $avail))
+         (then
+            (if (i32.gt_u (local.get $avail) (i32.const 0))
+               (then
+                  (local.set $len (local.get $avail)))
+               (else
+                  (local.set $fd (struct.get $channel $fd (local.get $ch)))
+                  (local.set $offset
+                     (array.get $offset_array (global.get $fd_offsets)
+                        (local.get $fd)))
+                  (local.set $nread
+                     (call $read
+                        (local.get $fd)
+                        (local.get $buf)
+                        (i32.const 0)
+                        (struct.get $channel $size (local.get $ch))
+                        (local.get $offset)))
+                  (array.set $offset_array
+                     (global.get $fd_offsets) (local.get $fd)
+                     (i64.add (local.get $offset)
+                        (i64.extend_i32_u (local.get $nread))))
+                  (struct.set $channel $max (local.get $ch) (local.get $nread))
+                  (local.set $curr (i32.const 0))
+                  (if (i32.gt_u (local.get $len) (local.get $nread))
+                     (then (local.set $len (local.get $nread))))))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (array.set $string (local.get $s)
+                  (i32.add (local.get $pos) (local.get $i))
+                  (call $ta_get_ui8 (local.get $buf)
+                     (i32.add (local.get $curr) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.set $channel $curr (local.get $ch)
+         (i32.add (local.get $curr) (local.get $len)))
+      (i31.new (local.get $len)))
 
    (func (export "caml_input_value") (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_input_value"))
-      (unreachable))
+      (i31.new (i32.const 0)))
 
    (func (export "caml_ml_input_char")
       (param (ref eq)) (result (ref eq))
@@ -83,9 +296,16 @@
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_seek_in")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_seek_in"))
+      (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast $channel (local.get $vch)))
+      ;; ZZZ Check for error
+      (array.set $offset_array
+         (global.get $fd_offsets)
+         (struct.get $channel $fd (local.get $ch))
+         (i64.extend_i32_s (i31.get_s (ref.cast i31 (local.get $voffset)))))
+      (struct.set $channel $curr (local.get $ch) (i32.const 0))
+      (struct.set $channel $max (local.get $ch) (i32.const 0))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_seek_in_64")
@@ -106,40 +326,140 @@
       (call $log_js (string.const "caml_ml_input_scan_line"))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_ml_flush") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_flush"))
+   (func $caml_ml_flush (export "caml_ml_flush")
+      (param $ch (ref eq)) (result (ref eq))
+      (loop $loop
+         (br_if $loop
+            (i32.eqz
+               (call $caml_flush_partial (ref.cast $channel (local.get $ch))))))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_ml_output")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_output"))
-      (i31.new (i32.const 0)))
+   (func $caml_flush_partial (param $ch (ref $channel)) (result i32)
+      (local $towrite i32) (local $written i32) (local $fd i32)
+      (local $buf (ref extern))
+      (local.set $towrite (struct.get $channel $curr (local.get $ch)))
+      (if (i32.gt_u (local.get $towrite) (i32.const 0))
+         (then
+            (local.set $buf (struct.get $channel $buffer (local.get $ch)))
+            (local.set $fd (struct.get $channel $fd (local.get $ch)))
+            (local.set $written
+               (call $write
+                  (local.get $fd)
+                  (local.get $buf)
+                  (i32.const 0)
+                  (local.get $towrite)))
+            (array.set $offset_array
+               (global.get $fd_offsets) (local.get $fd)
+               (i64.add
+                  (array.get $offset_array
+                     (global.get $fd_offsets) (local.get $fd))
+                  (i64.extend_i32_u (local.get $written))))
+            (local.set $towrite
+               (i32.sub (local.get $towrite) (local.get $written)))
+            (if (i32.gt_u (local.get $towrite) (i32.const 0))
+               (then
+                  (call $ta_copy (local.get $buf)
+                     (i32.const 0) (local.get $written) (local.get $towrite))))
+            (struct.set $channel $curr (local.get $ch) (local.get $towrite))))
+      (i32.eqz (local.get $towrite)))
 
-   (func (export "caml_ml_output_bytes")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_output_bytes"))
+   (func $caml_putblock
+      (param $ch (ref $channel)) (param $s (ref $string)) (param $pos i32)
+      (param $len i32) (result i32)
+      (local $free i32) (local $curr i32) (local $i i32)
+      (local $buf (ref extern))
+      (local.set $curr (struct.get $channel $curr (local.get $ch)))
+      (local.set $free
+         (i32.sub (struct.get $channel $size (local.get $ch)) (local.get $curr)))
+      (if (i32.ge_u (local.get $len) (local.get $free))
+         (then (local.set $len (local.get $free))))
+      (local.set $buf (struct.get $channel $buffer (local.get $ch)))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (call $ta_set_ui8 (local.get $buf)
+                  (i32.add (local.get $curr) (local.get $i))
+                  (array.get_u $string (local.get $s)
+                     (i32.add (local.get $pos) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (struct.set $channel $curr (local.get $ch)
+         (i32.add (local.get $curr) (local.get $len)))
+      (if (i32.ge_u (local.get $len) (local.get $free))
+         (then (drop (call $caml_flush_partial (local.get $ch)))))
+      (local.get $len))
+
+   (export "caml_ml_output_bytes" (func $caml_ml_output))
+   (func $caml_ml_output (export "caml_ml_output")
+      (param $ch (ref eq)) (param $s (ref eq)) (param $vpos (ref eq))
+      (param $vlen (ref eq)) (result (ref eq))
+      (local $pos i32) (local $len i32) (local $written i32)
+      (local.set $pos (i31.get_u (ref.cast i31 (local.get $vpos))))
+      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
+      (loop $loop
+         (if (i32.gt_u (local.get $len) (i32.const 0))
+            (then
+               (local.set $written
+                  (call $caml_putblock (ref.cast $channel (local.get $ch))
+                     (ref.cast $string (local.get $s))
+                     (local.get $pos) (local.get $len)))
+               (local.set $pos (i32.add (local.get $pos) (local.get $written)))
+               (local.set $len (i32.sub (local.get $len) (local.get $written)))
+               (br $loop))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_output_char")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_ml_output_char"))
-      (i31.new (i32.const 0)))
+      ;;(call $log_js (string.const "caml_ml_output_char"))
+      (return_call $caml_ml_output (local.get 0)
+         (array.new $string
+            (i31.get_u (ref.cast i31 (local.get 1))) (i32.const 1))
+         (i31.new (i32.const 0)) (i31.new (i32.const 1))))
 
    (func (export "caml_output_value")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_output_value"))
-      (unreachable))
+      (i31.new (i32.const 0)))
 
    (func (export "caml_ml_output_int")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_ml_output_int"))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_is_buffered") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_is_buffered"))
+      (i31.new (i32.const 1)))
+
+   (func (export "caml_ml_set_buffered")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_set_buffered"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_set_channel_refill")
+      (param (ref eq) (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "caml_ml_set_channel_refill"))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_ml_channel_size") (param (ref eq)) (result (ref eq))
+      ;; ZZZ check for overflow
+      (i31.new
+         (i32.wrap_i64
+            (call $file_size (call $caml_ml_get_channel_fd (local.get 0))))))
+
+   (func $caml_ml_get_channel_fd (export "caml_ml_get_channel_fd")
+      (param (ref eq)) (result i32)
+      (struct.get $channel $fd (ref.cast $channel (local.get 0))))
+
+   (func (export "caml_ml_set_channel_fd") (param (ref eq)) (param i32)
+      (struct.set $channel $fd (ref.cast $channel (local.get 0)) (local.get 1)))
+
+   (func (export "caml_ml_get_channel_offset") (param (ref eq)) (result i64)
+      (array.get $offset_array (global.get $fd_offsets)
+         (struct.get $channel $fd (ref.cast $channel (local.get 0)))))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 53caf744fa..db501bf110 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -29,6 +29,37 @@
 
     const fs = isNode&&require('fs')
 
+    let fs_cst = fs?.constants;
+
+    let open_flags =
+      fs?[fs_cst.RDONLY,fs_cst.O_WRONLY,fs_cst.O_APPEND,fs_cst.O_CREAT,
+          fs_cst.O_TRUNC,fs_cst.O_EXCL,fs_cst.O_NONBLOCK]:[]
+
+    var out_channels =
+      { map : new WeakMap(), set : new Set(),
+        finalization :
+          new FinalizationRegistry ((ref)=>out_channels.set.delete(ref)) };
+
+    function register_channel (ch) {
+      const ref = new WeakRef (ch);
+      out_channels.map.set(ch, ref);
+      out_channels.set.add(ref);
+      out_channels.finalization.register(ch, ref, ch);
+    }
+
+    function unregister_channel (ch) {
+      const ref = out_channels.map.get(ch);
+      if (ref) {
+        out_channels.map.delete(ch);
+        out_channels.set.delete(ref);
+        out_channels.finalization.unregister(ch);
+      }
+    }
+
+    function channel_list () {
+      return [...out_channels.set].map((ref) => ref.deref()).filter((ch)=>ch);
+    }
+
     var start_fiber
 
     function wrap_fun (t,f,a) {
@@ -232,6 +263,16 @@
          },
          mktime:(year,month,day,h,m,s)=>new Date(year,month,day,h,m,s).getTime(),
          random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
+         open:(p,flags,perm)=>
+           fs.openSync(p,open_flags.reduce((f,v,i)=>(flags&(1<<i))?(f|v):f,0),
+                       perm),
+         close:(fd)=>fs.closeSync(fd),
+         write:(fd,b,o,l)=>fs.writeSync(fd,b,o,l),
+         read:(fd,b,o,l,p)=>fs.readSync(fd,b,o,l,p),
+         file_size:(fd)=>fs.fstatSync(fd,{bigint:true}).size,
+         register_channel,
+         unregister_channel,
+         channel_list,
          argv:()=>isNode?process.argv.slice(1):['a.out'],
          getenv:(n)=>isNode?process.env[n]:null,
          system:(c)=>{

From b2b71afc254fa8024f1014c483bac1cc58b74ddf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 14:10:57 +0200
Subject: [PATCH 102/481] Runtime: improved exception handling

---
 runtime/wasm/deps.json    |  12 +++-
 runtime/wasm/fail.wat     |  16 +++++
 runtime/wasm/printexc.wat | 131 ++++++++++++++++++++++++++++++++++++++
 runtime/wasm/runtime.js   |  23 ++++++-
 4 files changed, 178 insertions(+), 4 deletions(-)
 create mode 100644 runtime/wasm/printexc.wat

diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 5f452701fe..16f7edaac7 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,13 +1,21 @@
 [
   {
     "name": "root",
-    "reaches": ["init", "exn", "exit"],
+    "reaches": ["init", "exn", "exit", "named_values", "format_exn", "callback"],
     "root": true
   },
   {
     "name": "init",
     "export": "_initialize"
   },
+  {
+    "name": "named_values",
+    "export": "caml_named_value"
+  },
+  {
+    "name": "format_exn",
+    "export": "caml_format_exception"
+  },
   {
     "name": "exn",
     "export": "ocaml_exception"
@@ -82,5 +90,5 @@
     "name": "start_fiber",
     "import": ["bindings", "start_fiber"],
     "reaches": ["effects"]
-  },
+  }
 ]
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 8010894148..036bb03a35 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -67,4 +67,20 @@
          (array.get $block (global.get $caml_global_data)
                     (global.get $NOT_FOUND_EXN))))
 
+   (global $MATCH_FAILURE_EXN i32 (i32.const 7))
+   (global $ASSERT_FAILURE_EXN i32 (i32.const 10))
+   (global $UNDEFINED_RECURSIVE_MODULE_EXN i32 (i32.const 11))
+
+   (func (export "caml_is_special_exception") (param (ref eq)) (result i32)
+      (i32.or
+         (ref.eq (local.get 0)
+            (array.get $block (global.get $caml_global_data)
+               (global.get $MATCH_FAILURE_EXN)))
+         (i32.or
+            (ref.eq (local.get 0)
+               (array.get $block (global.get $caml_global_data)
+                  (global.get $ASSERT_FAILURE_EXN)))
+            (ref.eq (local.get 0)
+               (array.get $block (global.get $caml_global_data)
+                  (global.get $UNDEFINED_RECURSIVE_MODULE_EXN))))))
 )
diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat
new file mode 100644
index 0000000000..52c8df6935
--- /dev/null
+++ b/runtime/wasm/printexc.wat
@@ -0,0 +1,131 @@
+(module
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "caml_jsstring_of_string"
+      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
+   (import "fail" "caml_is_special_exception"
+      (func $caml_is_special_exception (param (ref eq)) (result i32)))
+   (import "ints" "caml_format_int"
+      (func $caml_format_int
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+
+   (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
+
+   (type $buffer
+      (struct
+         (field (mut i32))
+         (field (ref $string))))
+
+   (func $add_char (param $buf (ref $buffer)) (param $c i32)
+      (local $pos i32)
+      (local $data (ref $string))
+      (local.set $pos (struct.get $buffer 0 (local.get $buf)))
+      (local.set $data (struct.get $buffer 1 (local.get $buf)))
+      (if (i32.lt_u (local.get $pos) (array.len (local.get $data)))
+         (then
+            (array.set $string (local.get $data) (local.get $pos) (local.get $c))
+            (struct.set $buffer 0 (local.get $buf)
+               (i32.add (local.get $pos) (i32.const 1))))))
+
+   (func $add_string (param $buf (ref $buffer)) (param $v (ref eq))
+      (local $pos i32) (local $len i32)
+      (local $data (ref $string))
+      (local $s (ref $string))
+      (local.set $pos (struct.get $buffer 0 (local.get $buf)))
+      (local.set $data (struct.get $buffer 1 (local.get $buf)))
+      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $len (array.len (local.get $s)))
+      (if (i32.gt_u (i32.add (local.get $pos) (local.get $len))
+                    (array.len (local.get $data)))
+         (then
+            (local.set $len
+                (i32.sub (array.len (local.get $data)) (local.get $pos)))))
+      (array.copy $string $string
+         (local.get $data) (local.get $pos)
+         (local.get $s) (i32.const 0)
+         (local.get $len))
+      (struct.set $buffer 0 (local.get $buf)
+         (i32.add (local.get $pos) (local.get $len))))
+
+   (func (export "caml_format_exception") (param (ref eq)) (result anyref)
+      (local $exn (ref $block))
+      (local $buf (ref $buffer))
+      (local $v (ref eq))
+      (local $bucket (ref $block))
+      (local $i i32) (local $len i32)
+      (local.set $exn (ref.cast $block (local.get 0)))
+      (if (result anyref)
+          (ref.eq (array.get $block (local.get $exn) (i32.const 0))
+                  (i31.new (i32.const 0)))
+         (then
+            (local.set $buf
+               (struct.new $buffer
+                  (i32.const 0)
+                  (array.new $string (i32.const 0) (i32.const 256))))
+            (call $add_string
+               (local.get $buf)
+               (array.get $block
+                  (ref.cast $block
+                     (array.get $block (local.get $exn) (i32.const 1)))
+                  (i32.const 1)))
+            (local.set $bucket
+               (block $continue (result (ref $block))
+                  (block $default
+                     (br_if $default
+                        (i32.ne (array.len (local.get $exn)) (i32.const 3)))
+                     (br_if $default
+                        (i32.eqz
+                           (call $caml_is_special_exception
+                              (array.get $block (local.get $exn) (i32.const 1)))))
+                     (local.set $v
+                        (array.get $block (local.get $exn) (i32.const 2)))
+                     (br_if $default (i32.eqz (ref.test $block (local.get $v))))
+                     (local.set $bucket (ref.cast $block (local.get $v)))
+                     (br_if $default
+                        (i32.eqz
+                           (ref.eq
+                              (array.get $block (local.get $bucket) (i32.const 0))
+                              (i31.new (i32.const 0)))))
+                    (local.set $i (i32.const 1))
+                    (br $continue (local.get $bucket)))
+                 (local.set $i (i32.const 2))
+                 (local.get $exn)))
+           (local.set $len (array.len (local.get $bucket)))
+           (if (i32.lt_u (local.get $i) (local.get $len))
+              (then
+                 (call $add_char (local.get $buf) (i32.const 40)) ;; '\('
+                 (loop $loop
+                    (local.set $v
+                       (array.get $block (local.get $bucket) (local.get $i)))
+                    (if (ref.test i31 (local.get $v))
+                       (then
+                           (call $add_string (local.get $buf)
+                              (call $caml_format_int
+                                  (array.new_fixed $string
+                                     (i32.const 37) (i32.const 100)) ;; %d
+                                  (ref.cast i31 (local.get $v)))))
+                    (else (if (ref.test $string (local.get $v))
+                       (then
+                          (call $add_char (local.get $buf)
+                             (i32.const 34)) ;; '\"'
+                          (call $add_string (local.get $buf) (local.get $v))
+                          (call $add_char (local.get $buf)
+                             (i32.const 34))) ;; '\"'
+                    (else
+                       (call $add_char (local.get $buf)
+                          (i32.const 95)))))) ;; '_'
+                    (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                    (if (i32.lt_u (local.get $i) (local.get $len))
+                       (then
+                          (call $add_char (local.get $buf)
+                             (i32.const 44)) ;; ','
+                          (br $loop))))
+                 (call $add_char (local.get $buf) (i32.const 41)))) ;; '\)'
+           (string.new_wtf8_array replace
+              (struct.get $buffer 1 (local.get $buf)) (i32.const 0)
+              (struct.get $buffer 0 (local.get $buf))))
+         (else
+            (call $unwrap
+               (call $caml_jsstring_of_string
+                  (array.get $block (local.get $exn) (i32.const 1)))))))
+)
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index db501bf110..05d5118334 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -327,8 +327,27 @@
             isNode && process.exit(e.getArg(exit_tag, 0));
           const exn_tag = wasmModule.instance.exports.ocaml_exception;
           if (exn_tag && e.is(exn_tag)) {
-            console.log('Uncaught exception')
-            isNode && process.exit(1)
+            var exn = e.getArg(exn_tag, 0)
+            var handle_uncaught_exception =
+              wasmModule.instance.exports.caml_named_value
+                ('Printexc.handle_uncaught_exception');
+            if (handle_uncaught_exception)
+              wasmModule.instance.exports.caml_callback
+                (handle_uncaught_exception, 2, [exn, 0], 0)
+            else {
+                var at_exit =
+                    wasmModule.instance.exports.caml_named_value
+                      ('Pervasives.do_at_exit');
+                if (at_exit)
+                    wasmModule.instance.exports.caml_callback
+                      (at_exit, 1, [0], 0);
+                console.error (
+                    "Fatal error: exception " +
+                        wasmModule.instance.exports.caml_format_exception(exn) +
+                        "\n"
+                )
+            }
+            isNode && process.exit(2)
           }
         } else {
             throw e;

From c04f94f2b6f95517d4c5ff9259188c89d55d9947 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 14:13:08 +0200
Subject: [PATCH 103/481] Runtime: no longer make marshaling function trap

---
 runtime/wasm/marshal.wat | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index ce28e4c492..7c615b409b 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -1,28 +1,30 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
 
+   (type $string (array (mut i8)))
+
    (func (export "caml_marshal_data_size")
       (param (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_marshal_data_size"))
-      (unreachable))
+      (i31.new (i32.const 0)))
 
    (func (export "caml_input_value_from_bytes")
       (param (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_input_value_from_bytes"))
-      (unreachable))
+      (i31.new (i32.const 0)))
 
    (func (export "caml_output_value_to_buffer")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_output_value_to_buffer"))
-      (unreachable))
+      (i31.new (i32.const 0)))
 
    (func (export "caml_output_value_to_string")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_output_value_to_string"))
-      (unreachable))
+      (array.new_fixed $string))
 )

From 5cf212bc13fc826018c173275df89da89875ef32 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 14:20:45 +0200
Subject: [PATCH 104/481] Make it possible to run the testsuite with
 Wasm_of_ocaml

---
 compiler/tests-jsoo/test_parsing.ml     |  9 +------
 compiler/tests-ocaml/lib-effects/dune   |  3 +++
 compiler/tests-sourcemap/dune           |  4 +--
 dune                                    |  4 +++
 lib/deriving_json/tests/json_convert.ml | 11 +++++---
 lib/tests/dune.inc                      |  2 +-
 lib/tests/gen-rules/gen.ml              |  5 +++-
 lib/tests/test_fun_call.ml              | 35 ++++++++++++++-----------
 tools/node_wrapper.sh                   |  3 +++
 9 files changed, 46 insertions(+), 30 deletions(-)
 create mode 100755 tools/node_wrapper.sh

diff --git a/compiler/tests-jsoo/test_parsing.ml b/compiler/tests-jsoo/test_parsing.ml
index 4be62aa8f7..cba1eee0c9 100644
--- a/compiler/tests-jsoo/test_parsing.ml
+++ b/compiler/tests-jsoo/test_parsing.ml
@@ -17,22 +17,15 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-(* see https://github.com/ocaml/ocaml/pull/12046 *)
-external flush_stdout_stderr : unit -> unit = "flush_stdout_stderr"
-
 let parse s =
-  flush_stdout_stderr ();
   try
     let lexbuf = Lexing.from_string s in
     while true do
       let result = Calc_parser.main Calc_lexer.token lexbuf in
-      flush_stdout_stderr ();
       print_int result;
       print_newline ()
     done
-  with Calc_lexer.Eof ->
-    flush_stdout_stderr ();
-    print_endline "EOF"
+  with Calc_lexer.Eof -> print_endline "EOF"
 
 let%expect_test "parsing" =
   let (old : bool) = Parsing.set_trace true in
diff --git a/compiler/tests-ocaml/lib-effects/dune b/compiler/tests-ocaml/lib-effects/dune
index 7261b03c3f..4f997d5fde 100644
--- a/compiler/tests-ocaml/lib-effects/dune
+++ b/compiler/tests-ocaml/lib-effects/dune
@@ -2,6 +2,9 @@
  (using-effects
   (flags
    (:standard -w -38)))
+ (wasm
+  (flags
+   (:standard -w -38)))
  (_
   (flags
    (:standard -w -38))
diff --git a/compiler/tests-sourcemap/dune b/compiler/tests-sourcemap/dune
index 5209cab0c8..1cc6f530b9 100644
--- a/compiler/tests-sourcemap/dune
+++ b/compiler/tests-sourcemap/dune
@@ -21,7 +21,7 @@
 (rule
  (target dump)
  (enabled_if
-  (<> %{profile} using-effects))
+  (and (<> %{profile} using-effects) (<> %{profile} wasm)))
  (action
   (with-stdout-to
    %{target}
@@ -30,7 +30,7 @@
 (rule
  (alias runtest)
  (enabled_if
-  (<> %{profile} using-effects))
+  (and (<> %{profile} using-effects) (<> %{profile} wasm)))
  (deps dump.reference dump)
  (action
   (diff dump.reference dump)))
diff --git a/dune b/dune
index 38e369ffce..892aad19fe 100644
--- a/dune
+++ b/dune
@@ -9,6 +9,10 @@
     (:standard --enable effects))
    (build_runtime_flags
     (:standard --enable effects))))
+ (wasm
+  (binaries (tools/node_wrapper.sh as node))
+  (js_of_ocaml
+   (target wasm)))
  (bench_no_debug
   (flags
    (:standard \ -g))
diff --git a/lib/deriving_json/tests/json_convert.ml b/lib/deriving_json/tests/json_convert.ml
index 0e5bbd3b1c..45e0640b10 100644
--- a/lib/deriving_json/tests/json_convert.ml
+++ b/lib/deriving_json/tests/json_convert.ml
@@ -33,12 +33,17 @@ let str =
 
 type t = int list * float option * string [@@deriving json]
 
+let wasm =
+  match Sys.backend_type with
+  | Other "wasm_of_ocaml" -> true
+  | _ -> false
+
 let test t v =
-  if v = Json.unsafe_input (Json.output v) then () else print_endline "Not equal";
-  if v = Deriving_Json.from_string t (Js.to_string (Json.output v))
+  if wasm || v = Json.unsafe_input (Json.output v) then () else print_endline "Not equal";
+  if wasm || v = Deriving_Json.from_string t (Js.to_string (Json.output v))
   then ()
   else print_endline "Not equal";
-  if v = Json.unsafe_input (Js.string (Deriving_Json.to_string t v))
+  if wasm || v = Json.unsafe_input (Js.string (Deriving_Json.to_string t v))
   then ()
   else print_endline "Not equal";
   if v = Deriving_Json.from_string t (Deriving_Json.to_string t v)
diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc
index 57c773ffc3..410dfcebd7 100644
--- a/lib/tests/dune.inc
+++ b/lib/tests/dune.inc
@@ -42,7 +42,7 @@
 (library
  ;; lib/tests/test_json.ml
  (name test_json_75)
- (enabled_if true)
+ (enabled_if (<> %{profile} wasm))
  (modules test_json)
  (libraries js_of_ocaml unix)
  (inline_tests (modes js))
diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml
index ac42fddb81..57a16ee029 100644
--- a/lib/tests/gen-rules/gen.ml
+++ b/lib/tests/gen-rules/gen.ml
@@ -48,11 +48,13 @@ let prefix : string =
 type enabled_if =
   | GE5
   | No_effects
+  | Not_wasm
   | Any
 
 let enabled_if = function
   | "test_sys" -> GE5
   | "test_fun_call" -> No_effects
+  | "test_json" -> Not_wasm
   | _ -> Any
 
 let () =
@@ -80,5 +82,6 @@ let () =
            (match enabled_if basename with
            | Any -> "true"
            | GE5 -> "(>= %{ocaml_version} 5)"
-           | No_effects -> "(<> %{profile} using-effects)")
+           | No_effects -> "(<> %{profile} using-effects)"
+           | Not_wasm -> "(<> %{profile} wasm)")
            basename)
diff --git a/lib/tests/test_fun_call.ml b/lib/tests/test_fun_call.ml
index 888246dd20..1481c2aacf 100644
--- a/lib/tests/test_fun_call.ml
+++ b/lib/tests/test_fun_call.ml
@@ -29,9 +29,8 @@ let s x =
       return "undefined"
     if(typeof x === "function")
       return "function#" + x.length + "#" + x.l
-    if(x.toString() == "[object Arguments]")
-      return "(Arguments: " + Array.prototype.slice.call(x).toString() + ")";
-    return x.toString()
+    if (x.toString) return x.toString();
+    return "other"
 })
 |}
   in
@@ -356,8 +355,9 @@ let%expect_test _ =
   [%expect {|
     Result: function#2#2 |}]
 
+(*
 let%expect_test _ =
-  call_and_log cb3 ~cont:(fun g -> g 1 2 3 4) {| (function(f){ return f }) |};
+  cal_and_log cb3 ~cont:(fun g -> g 1 2 3 4) {| (function(f){ return f }) |};
   [%expect {|
     got 1, 2, 3, done
     Result: 0 |}]
@@ -378,6 +378,7 @@ let%expect_test _ =
   [%expect {|
     got 1, 1, 2, done
     Result: 0 |}]
+*)
 
 let%expect_test _ =
   let f cb =
@@ -385,6 +386,7 @@ let%expect_test _ =
     | Invalid_argument s | Failure s -> Printf.printf "Error: %s" s
     | _ -> Printf.printf "Error: unknown"
   in
+  (*
   f (Obj.magic cb1);
   [%expect {|
     got 1, done
@@ -393,6 +395,7 @@ let%expect_test _ =
   [%expect {|
     got 1, 2, done
     Result: 0 |}];
+*)
   f (Obj.magic cb3);
   [%expect {|
     got 1, 2, 3, done
@@ -404,14 +407,16 @@ let%expect_test _ =
   [%expect {|
     Result: function#2#2 |}]
 
-let%expect_test _ =
-  let open Js_of_ocaml in
-  let f = Js.wrap_callback (fun s -> print_endline s) in
-  Js.export "f" f;
-  let () =
-    Js.Unsafe.fun_call
-      (Js.Unsafe.pure_js_expr "jsoo_exports")##.f
-      [| Js.Unsafe.coerce (Js.string "hello") |]
-  in
-  ();
-  [%expect {| hello |}]
+(*ZZZ
+  let%expect_test _ =
+    let open Js_of_ocaml in
+    let f = Js.wrap_callback (fun s -> print_endline s) in
+    Js.export "f" f;
+    let () =
+      Js.Unsafe.fun_call
+        (Js.Unsafe.pure_js_expr "jsoo_exports")##.f
+        [| Js.Unsafe.coerce (Js.string "hello") |]
+    in
+    ();
+    [%expect {| hello |}]
+*)
diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh
new file mode 100755
index 0000000000..c65c19f001
--- /dev/null
+++ b/tools/node_wrapper.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively
+exec node --experimental-wasm-stringref --experimental-wasm-gc --experimental-wasm-stack-switching "$@"

From 515b798196aeeb99d9edc56ce5167a987abaa598 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 18:51:38 +0200
Subject: [PATCH 105/481] Fix Lwt_js_events

---
 lib/lwt/lwt_js_events.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/lwt/lwt_js_events.ml b/lib/lwt/lwt_js_events.ml
index d712e9a4a9..7ccbae9358 100644
--- a/lib/lwt/lwt_js_events.ml
+++ b/lib/lwt/lwt_js_events.ml
@@ -610,7 +610,7 @@ let request_animation_frame () =
   let t, s = Lwt.wait () in
   let (_ : Dom_html.animation_frame_request_id) =
     Dom_html.window##requestAnimationFrame
-      (Js.wrap_callback (fun (_ : float Js.t) -> Lwt.wakeup s ()))
+      (Js.wrap_callback (fun (_ : Js.number Js.t) -> Lwt.wakeup s ()))
   in
   t
 

From 59c82017041c3a045045322f1fa2d963198c66a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jul 2023 20:16:57 +0200
Subject: [PATCH 106/481] Lower binaryen optimization level

---
 compiler/bin-wasm_of_ocaml/compile.ml | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 8638fcbdab..3ee2272d72 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -92,7 +92,12 @@ let dead_code_elimination in_file out_file =
 let optimize in_file out_file =
   command
     (("wasm-opt" :: common_binaryen_options)
-    @ [ "-O3"; Filename.quote in_file; "-o"; Filename.quote out_file ])
+    @ [ "-O2"
+      ; "--skip-pass=inlining-optimizing"
+      ; Filename.quote in_file
+      ; "-o"
+      ; Filename.quote out_file
+      ])
 
 let link_and_optimize runtime_wasm_files wat_file output_file =
   with_intermediate_file (Filename.temp_file "runtime" ".wasm")

From cf5a4da9332271a110d1fc7758bde69813e773b0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 27 Jul 2023 17:04:41 +0200
Subject: [PATCH 107/481] Wa_structure: clean-up

---
 compiler/lib/wasm/wa_generate.ml   | 11 ++++----
 compiler/lib/wasm/wa_structure.ml  | 45 +++++++++++-------------------
 compiler/lib/wasm/wa_structure.mli | 17 +++++++++++
 3 files changed, 39 insertions(+), 34 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_structure.mli

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 43cb9966df..87534078ee 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -677,8 +677,7 @@ module Generate (Target : Wa_target_sig.S) = struct
         ~params
     in
     let g = Wa_structure.build_graph ctx.blocks pc in
-    let idom = Wa_structure.dominator_tree g in
-    let dom = Wa_structure.reverse_tree idom in
+    let dom = Wa_structure.dominator_tree g in
     let rec index pc i context =
       match context with
       | `Block pc' :: _ when pc = pc' -> i
@@ -698,9 +697,11 @@ module Generate (Target : Wa_target_sig.S) = struct
           ~fall_through
           ~pc
           ~l:
-            (List.filter
-               ~f:(fun pc' -> is_switch || Wa_structure.is_merge_node g pc')
-               (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc))))
+            (pc
+            |> Wa_structure.get_edges dom
+            |> Addr.Set.elements
+            |> List.filter ~f:(fun pc' -> is_switch || Wa_structure.is_merge_node g pc')
+            |> Wa_structure.sort_in_post_order g)
           ~context
       in
       if Wa_structure.is_loop_header g pc
diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
index 2e2efdc900..e00ae0f781 100644
--- a/compiler/lib/wasm/wa_structure.ml
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -1,6 +1,8 @@
 open Stdlib
 open Code
 
+type graph = (Addr.t, Addr.Set.t) Hashtbl.t
+
 let get_edges g src = try Hashtbl.find g src with Not_found -> Addr.Set.empty
 
 let add_edge g src dst = Hashtbl.replace g src (Addr.Set.add dst (get_edges g src))
@@ -17,12 +19,6 @@ let reverse_tree t =
   Hashtbl.iter (fun child parent -> add_edge g parent child) t;
   g
 
-let rec leave_try_body blocks pc =
-  match Addr.Map.find pc blocks with
-  | { body = []; branch = (Return _ | Stop), _; _ } -> false
-  | { body = []; branch = Branch (pc', _), _; _ } -> leave_try_body blocks pc'
-  | _ -> true
-
 type control_flow_graph =
   { succs : (Addr.t, Addr.Set.t) Hashtbl.t
   ; preds : (Addr.t, Addr.Set.t) Hashtbl.t
@@ -31,8 +27,15 @@ type control_flow_graph =
   }
 
 let is_backward g pc pc' = Hashtbl.find g.block_order pc >= Hashtbl.find g.block_order pc'
+
 let is_forward g pc pc' = Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
 
+let rec leave_try_body blocks pc =
+  match Addr.Map.find pc blocks with
+  | { body = []; branch = (Return _ | Stop), _; _ } -> false
+  | { body = []; branch = Branch (pc', _), _; _ } -> leave_try_body blocks pc'
+  | _ -> true
+
 let build_graph blocks pc =
   let succs = Hashtbl.create 16 in
   let l = ref [] in
@@ -74,7 +77,7 @@ let build_graph blocks pc =
   let preds = reverse_graph succs in
   { succs; preds; reverse_post_order = !l; block_order }
 
-let dominator_tree g =
+let reversed_dominator_tree g =
   (* A Simple, Fast Dominance Algorithm
      Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy *)
   let dom = Hashtbl.create 16 in
@@ -107,11 +110,7 @@ let dominator_tree g =
         l);
   dom
 
-(* pc dominates pc' *)
-let rec dominates g idom pc pc' =
-  pc = pc'
-  || is_forward g pc pc'
-     && dominates g idom pc (Hashtbl.find idom pc')
+let dominator_tree g = reverse_tree (reversed_dominator_tree g)
 
 (* pc has at least two forward edges moving into it *)
 let is_merge_node g pc =
@@ -130,20 +129,8 @@ let is_loop_header g pc =
   let o = Hashtbl.find g.block_order pc in
   Addr.Set.exists (fun pc' -> Hashtbl.find g.block_order pc' >= o) s
 
-
-let dominance_frontier g idom =
-  let frontiers = Hashtbl.create 16 in
-  Hashtbl.iter
-    (fun pc preds ->
-      if Addr.Set.cardinal preds > 1
-      then
-        let dom = Hashtbl.find idom pc in
-        let rec loop runner =
-          if runner <> dom
-          then (
-            add_edge frontiers runner pc;
-            loop (Hashtbl.find idom runner))
-        in
-        Addr.Set.iter loop preds)
-    g.preds;
-  frontiers
+let sort_in_post_order g l =
+  List.sort
+    ~cmp:(fun b b' ->
+      compare (Hashtbl.find g.block_order b') (Hashtbl.find g.block_order b))
+    l
diff --git a/compiler/lib/wasm/wa_structure.mli b/compiler/lib/wasm/wa_structure.mli
new file mode 100644
index 0000000000..db1dfc9c80
--- /dev/null
+++ b/compiler/lib/wasm/wa_structure.mli
@@ -0,0 +1,17 @@
+type graph
+
+val get_edges : graph -> Code.Addr.t -> Code.Addr.Set.t
+
+type control_flow_graph
+
+val build_graph : Code.block Code.Addr.Map.t -> Code.Addr.t -> control_flow_graph
+
+val dominator_tree : control_flow_graph -> graph
+
+val is_loop_header : control_flow_graph -> Code.Addr.t -> bool
+
+val is_merge_node : control_flow_graph -> Code.Addr.t -> bool
+
+val is_backward : control_flow_graph -> Code.Addr.t -> Code.Addr.t -> bool
+
+val sort_in_post_order : control_flow_graph -> Code.Addr.t list -> Code.Addr.t list

From 220234423d525346ec78625ca28547e60977508f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 27 Jul 2023 18:32:25 +0200
Subject: [PATCH 108/481] Runtime: fix process spawning

---
 runtime/wasm/runtime.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 05d5118334..57ba7093bd 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -277,7 +277,7 @@
          getenv:(n)=>isNode?process.env[n]:null,
          system:(c)=>{
            var res = require('child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
-           return res.signal?128:status
+           return res.signal?128:res.status
          },
          getcwd:()=>isNode?process.cwd():'/static',
          chdir:(x)=>process.chdir(x),

From c4b23fab4753c2211847c7373028146b47befd0c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 31 Jul 2023 12:08:51 +0200
Subject: [PATCH 109/481] Runtime: fix caml_string_of_jsbytes

---
 runtime/wasm/jslib.wat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 389663793a..25714c446b 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -487,7 +487,7 @@
       (if (i32.eqz (local.get $n)) (then (return (local.get $s'))))
       (local.set $s''
          (array.new $string (i32.const 0)
-            (i32.add (local.get $i) (local.get $n))))
+            (i32.sub (local.get $i) (local.get $n))))
       (local.set $i (i32.const 0))
       (local.set $n (i32.const 0))
       (loop $fill

From 9ad86926444a680c90f44f02dd8430a364390bcb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 31 Jul 2023 12:24:57 +0200
Subject: [PATCH 110/481] Support linking JavaScript primitives

---
 compiler/bin-wasm_of_ocaml/compile.ml | 149 +++++++++++++++-----------
 compiler/bin-wasm_of_ocaml/dune       |   1 +
 compiler/lib/driver.ml                |  12 ++-
 compiler/lib/driver.mli               |   7 ++
 compiler/lib/linker.ml                |  27 +++--
 compiler/lib/linker.mli               |  12 ++-
 runtime/wasm/runtime.js               |   7 +-
 7 files changed, 133 insertions(+), 82 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 3ee2272d72..1e077084e8 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -42,7 +42,9 @@ let remove_file filename =
 
 let with_intermediate_file ?(keep = false) name f =
   match f name with
-  | _ -> if not keep then remove_file name
+  | res ->
+      if not keep then remove_file name;
+      res
   | exception e ->
       remove_file name;
       raise e
@@ -74,10 +76,39 @@ let link runtime_files input_file output_file =
            runtime_files)
     @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ])
 
+let generate_dependencies primitives =
+  Yojson.Basic.to_string
+    (`List
+      (StringSet.fold
+         (fun nm s ->
+           `Assoc
+             [ "name", `String ("js:" ^ nm)
+             ; "import", `List [ `String "js"; `String nm ]
+             ]
+           :: s)
+         primitives
+         (Yojson.Basic.Util.to_list (Yojson.Basic.from_string Wa_runtime.dependencies))))
+
+let filter_unused_primitives primitives usage_file =
+  let ch = open_in usage_file in
+  let s = ref primitives in
+  (try
+     while true do
+       let l = input_line ch in
+       match String.drop_prefix ~prefix:"unused: js:" l with
+       | Some nm -> s := StringSet.remove nm !s
+       | None -> ()
+     done
+   with End_of_file -> ());
+  !s
+
 let dead_code_elimination in_file out_file =
   with_intermediate_file (Filename.temp_file "deps" ".json")
   @@ fun deps_file ->
-  write_file deps_file Wa_runtime.dependencies;
+  with_intermediate_file (Filename.temp_file "usage" ".txt")
+  @@ fun usage_file ->
+  let primitives = Linker.get_provided () in
+  write_file deps_file (generate_dependencies primitives);
   command
     (("wasm-metadce" :: common_binaryen_options)
     @ [ "--graph-file"
@@ -86,8 +117,9 @@ let dead_code_elimination in_file out_file =
       ; "-o"
       ; Filename.quote out_file
       ; ">"
-      ; "/dev/null"
-      ])
+      ; Filename.quote usage_file
+      ]);
+  filter_unused_primitives primitives usage_file
 
 let optimize in_file out_file =
   command
@@ -108,8 +140,9 @@ let link_and_optimize runtime_wasm_files wat_file output_file =
   link (runtime_file :: runtime_wasm_files) wat_file temp_file;
   with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
   @@ fun temp_file' ->
-  dead_code_elimination temp_file temp_file';
-  optimize temp_file' output_file
+  let primitives = dead_code_elimination temp_file temp_file' in
+  optimize temp_file' output_file;
+  primitives
 
 let escape_string s =
   let l = String.length s in
@@ -129,73 +162,58 @@ let escape_string s =
   done;
   Buffer.contents b
 
-let build_js_runtime wasm_file output_file =
-  let wrap_in_iife ~use_strict js =
-    let module J = Javascript in
-    let var ident e = J.variable_declaration [ J.ident ident, (e, J.N) ], J.N in
-    let expr e = J.Expression_statement e, J.N in
-    let freenames =
-      let o = new Js_traverse.free in
-      let (_ : J.program) = o#program js in
-      o#get_free
-    in
-    let export_shim js =
-      if J.IdentSet.mem (J.ident Constant.exports_) freenames
-      then
-        let export_node =
-          let s =
-            Printf.sprintf
-              {|((typeof module === 'object' && module.exports) || %s)|}
-              Constant.global_object
-          in
-          let lex = Parse_js.Lexer.of_string s in
-          Parse_js.parse_expr lex
-        in
-        var Constant.exports_ export_node :: js
-      else js
-    in
-    let old_global_object_shim js =
-      if J.IdentSet.mem (J.ident Constant.old_global_object_) freenames
-      then
-        var Constant.old_global_object_ (J.EVar (J.ident Constant.global_object_)) :: js
-      else js
-    in
-
-    let efun args body = J.EFun (None, J.fun_ args body J.U) in
-    let mk f =
-      let js = export_shim js in
-      let js = old_global_object_shim js in
-      let js =
-        if use_strict
-        then expr (J.EStr (Utf8_string.of_string_exn "use strict")) :: js
-        else js
-      in
-      f [ J.ident Constant.global_object_ ] js
+let build_js_runtime primitives wasm_file output_file =
+  let always_required_js, primitives =
+    let l =
+      StringSet.fold
+        (fun nm l ->
+          let id = Utf8_string.of_string_exn nm in
+          Javascript.Property (PNI id, EVar (S { name = id; var = None; loc = N })) :: l)
+        primitives
+        []
     in
-    expr (J.call (mk efun) [ J.EVar (J.ident Constant.global_object_) ] J.N)
-  in
-  let always_required_js =
-    List.map
-      Linker.((link [] (init ())).always_required_codes)
-      ~f:(fun { Linker.program; _ } -> wrap_in_iife ~use_strict:false program)
+    match
+      List.split_last
+      @@ Driver.link_and_pack [ Javascript.Return_statement (Some (EObj l)), N ]
+    with
+    | Some x -> x
+    | None -> assert false
   in
   let b = Buffer.create 1024 in
   let f = Pretty_print.to_buffer b in
   Pretty_print.set_compact f (not (Config.Flag.pretty ()));
   ignore (Js_output.program f always_required_js);
+  let b' = Buffer.create 1024 in
+  let f = Pretty_print.to_buffer b' in
+  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
+  ignore (Js_output.program f [ primitives ]);
   let s = Wa_runtime.js_runtime in
-  let rec find i =
-    if String.equal (String.sub s ~pos:i ~len:4) "CODE" then i else find (i + 1)
+  let rec find pat i =
+    if String.equal (String.sub s ~pos:i ~len:(String.length pat)) pat
+    then i
+    else find pat (i + 1)
   in
   let i = String.index s '\n' + 1 in
-  let j = find 0 in
+  let j = find "CODE" 0 in
+  let k = find "PRIMITIVES" 0 in
+  let rec trim_semi s =
+    let l = String.length s in
+    if l = 0
+    then s
+    else
+      match s.[l - 1] with
+      | ';' | '\n' -> trim_semi (String.sub s ~pos:0 ~len:(l - 1))
+      | _ -> s
+  in
   write_file
     output_file
     (String.sub s ~pos:0 ~len:i
     ^ Buffer.contents b
     ^ String.sub s ~pos:i ~len:(j - i)
     ^ escape_string (Filename.basename wasm_file)
-    ^ String.sub s ~pos:(j + 4) ~len:(String.length s - j - 4))
+    ^ String.sub s ~pos:(j + 4) ~len:(k - j - 4)
+    ^ trim_semi (Buffer.contents b')
+    ^ String.sub s ~pos:(k + 10) ~len:(String.length s - k - 10))
 
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
   Wa_generate.init ();
@@ -223,8 +241,15 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
   List.iter builtin ~f:(fun t ->
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in
-      Linker.load_fragments ~target_env:Target_env.Isomorphic ~filename runtimes);
-  Linker.load_files ~target_env:Target_env.Isomorphic runtime_js_files;
+      Linker.load_fragments
+        ~ignore_always_annotation:true
+        ~target_env:Target_env.Isomorphic
+        ~filename
+        runtimes);
+  Linker.load_files
+    ~ignore_always_annotation:true
+    ~target_env:Target_env.Isomorphic
+    runtime_js_files;
   Linker.check_deps ();
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
@@ -272,8 +297,8 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
        let wat_file = Filename.chop_extension (fst output_file) ^ ".wat" in
        let wasm_file = Filename.chop_extension (fst output_file) ^ ".wasm" in
        output_gen wat_file (output code ~standalone:true);
-       link_and_optimize runtime_wasm_files wat_file wasm_file;
-       build_js_runtime wasm_file (fst output_file)
+       let primitives = link_and_optimize runtime_wasm_files wat_file wasm_file in
+       build_js_runtime primitives wasm_file (fst output_file)
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());
   Debug.stop_profiling ()
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index 4532beed0f..77efec5eb8 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -8,6 +8,7 @@
   cmdliner
   compiler-libs.common
   js_of_ocaml-compiler.runtime-files
+  yojson
   (select
    findlib_support.ml
    from
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index ac388e8053..ed62a65eb2 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -579,6 +579,13 @@ let target_flag t =
   | `JavaScript _ -> `JavaScript
   | `Wasm _ -> `Wasm
 
+let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(linkall = false) p =
+  p
+  |> link ~standalone ~linkall
+  |> pack ~wrap_with_fun ~standalone
+  |> coloring
+  |> check_js
+
 let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
   let exported_runtime = not standalone in
   let opt =
@@ -598,10 +605,7 @@ let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
   in
   let emit formatter =
     generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
-    +> link ~standalone ~linkall
-    +> pack ~wrap_with_fun ~standalone
-    +> coloring
-    +> check_js
+    +> link_and_pack ~standalone ~wrap_with_fun ~linkall
     +> output formatter ~source_map ()
   in
   if times () then Format.eprintf "Start Optimizing...@.";
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 3359a12971..975e8be2ea 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -48,6 +48,13 @@ val from_string :
   -> Pretty_print.t
   -> unit
 
+val link_and_pack :
+     ?standalone:bool
+  -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
+  -> ?linkall:bool
+  -> Javascript.statement_list
+  -> Javascript.statement_list
+
 val configure : Pretty_print.t -> unit
 
 val profiles : (int * profile) list
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index a33687e5f2..76808e78f9 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -423,7 +423,7 @@ let reset () =
   Primitive.reset ();
   Generate.init ()
 
-let load_fragment ~target_env ~filename (f : Fragment.t) =
+let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.t) =
   match f with
   | Always_include code ->
       always_included :=
@@ -468,9 +468,11 @@ let load_fragment ~target_env ~filename (f : Fragment.t) =
                 filename;
             if always
             then (
-              always_included :=
-                { ar_filename = filename; ar_program = code; ar_requires = requires }
-                :: !always_included;
+              if not ignore_always_annotation
+              then
+                always_included :=
+                  { ar_filename = filename; ar_program = code; ar_requires = requires }
+                  :: !always_included;
               `Ok)
             else
               error
@@ -572,19 +574,24 @@ let check_deps () =
           ())
     code_pieces
 
-let load_file ~target_env filename =
+let load_file ~ignore_always_annotation ~target_env filename =
   List.iter (Fragment.parse_file filename) ~f:(fun frag ->
-      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
+      let (`Ok | `Ignored) =
+        load_fragment ~ignore_always_annotation ~target_env ~filename frag
+      in
       ())
 
-let load_fragments ~target_env ~filename l =
+let load_fragments ?(ignore_always_annotation = false) ~target_env ~filename l =
   List.iter l ~f:(fun frag ->
-      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
+      let (`Ok | `Ignored) =
+        load_fragment ~ignore_always_annotation ~target_env ~filename frag
+      in
       ());
   check_deps ()
 
-let load_files ~target_env l =
-  List.iter l ~f:(fun filename -> load_file ~target_env filename);
+let load_files ?(ignore_always_annotation = false) ~target_env l =
+  List.iter l ~f:(fun filename ->
+      load_file ~ignore_always_annotation ~target_env filename);
   check_deps ()
 
 (* resolve *)
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index ad0dba9ce7..cc13208dfa 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -36,9 +36,15 @@ end
 
 val reset : unit -> unit
 
-val load_files : target_env:Target_env.t -> string list -> unit
-
-val load_fragments : target_env:Target_env.t -> filename:string -> Fragment.t list -> unit
+val load_files :
+  ?ignore_always_annotation:bool -> target_env:Target_env.t -> string list -> unit
+
+val load_fragments :
+     ?ignore_always_annotation:bool
+  -> target_env:Target_env.t
+  -> filename:string
+  -> Fragment.t list
+  -> unit
 
 val check_deps : unit -> unit
 
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 57ba7093bd..28d0b70e1e 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,5 +1,5 @@
 #!/usr/bin/env -S node --experimental-wasm-stringref --experimental-wasm-gc
-(async function (eval_function) {
+(async function (eval_function, js) {
     "use strict";
     const src = 'CODE';
     function loadRelative(src) {
@@ -299,7 +299,7 @@
          weak_map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const imports = {Math:math,bindings:bindings,env:{}}
+    const imports = {Math:math,bindings:bindings,env:{},js:js}
     const wasmModule =
           isNode?await WebAssembly.instantiate(await code, imports)
                 :await WebAssembly.instantiateStreaming(code,imports)
@@ -353,4 +353,5 @@
             throw e;
         }
     }
-})(((joo_global_object,globalThis)=>(x)=>eval(x))(globalThis,globalThis));
+})(((joo_global_object,globalThis)=>(x)=>eval(x))(globalThis,globalThis),
+   PRIMITIVES);

From 66d9ae3322b1286575e0f0d97076f2f1633f7d49 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 2 Aug 2023 17:41:45 +0200
Subject: [PATCH 111/481] Runtime: fix some bigstring functions

---
 runtime/wasm/bigstring.wat | 10 ++++++++--
 runtime/wasm/runtime.js    |  3 +++
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 5442499636..6d89765b91 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -1,6 +1,7 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "jslib" "caml_js_get"
       (func $caml_js_get (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "bigarray" "caml_ba_to_typed_array"
@@ -25,6 +26,8 @@
       (func $ta_set (param (ref extern)) (param (ref extern)) (param i32)))
    (import "bindings" "ta_len"
       (func $ta_len (param (ref extern)) (result i32)))
+   (import "bindings" "ta_bytes"
+      (func $ta_bytes (param anyref) (result anyref)))
    (import "hash" "caml_hash_mix_int"
       (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
 
@@ -114,9 +117,12 @@
 
    (func (export "bigstring_of_array_buffer") (param (ref eq)) (result (ref eq))
        (return_call $caml_ba_from_typed_array
-          (call $wrap (call $ta_create (i32.const 12) (local.get $0)))))
+          (call $wrap
+             (call $ta_create (i32.const 12) (call $unwrap (local.get $0))))))
 
-   (export "bigstring_of_typed_array" (func $caml_ba_from_typed_array))
+   (func (export "bigstring_of_typed_array") (param (ref eq)) (result (ref eq))
+       (return_call $caml_ba_from_typed_array
+          (call $wrap (call $ta_bytes (call $unwrap (local.get $0))))))
 
    (func (export "caml_bigstring_memset")
       (param $s (ref eq)) (param $pos (ref eq)) (param $len (ref eq))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 28d0b70e1e..46fd6612a3 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -120,6 +120,9 @@
          ta_set:(a,b,i)=>a.set(b,i),
          ta_new:(len)=>new Uint8Array(len),
          ta_copy:(ta,t,s,n)=>ta.copyWithin(t,s,n),
+         ta_bytes:(a)=>
+           new Uint8Array(a.buffer, a.byteOffset,
+                          a.length * a.BYTES_PER_ELEMENT),
          wrap_callback:(f)=>function (){
              var n = arguments.length;
              if(n > 0) {

From 0169dc8d13c41f8ef0618865741063f3f7acbf5f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Aug 2023 16:05:02 +0200
Subject: [PATCH 112/481] Runtime: improve stub for caml_read_file_content

---
 runtime/wasm/fail.wat |  8 ++++++++
 runtime/wasm/fs.wat   | 21 +++++++++++++++++++++
 2 files changed, 29 insertions(+)

diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 036bb03a35..1d7f8284f4 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -25,6 +25,14 @@
          (array.get $block (global.get $caml_global_data)
                     (global.get $OUT_OF_MEMORY_EXN))))
 
+   (global $SYS_ERROR_EXN i32 (i32.const 1))
+
+   (func (export "caml_raise_sys_error") (param $msg (ref $string))
+       (return_call $caml_raise_with_arg
+           (array.get $block (global.get $caml_global_data)
+              (global.get $SYS_ERROR_EXN))
+           (local.get 0)))
+
    (global $FAILURE_EXN i32 (i32.const 2))
 
    (func (export "caml_failwith_tag") (result (ref eq))
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index f77793a29b..a33157d1b9 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -15,6 +15,8 @@
       (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
    (import "jslib" "caml_js_to_string_array"
       (func $caml_js_to_string_array (param $a (ref extern)) (result (ref eq))))
+   (import "fail" "caml_raise_sys_error"
+      (func $caml_raise_sys_error (param (ref eq))))
 
    (type $string (array (mut i8)))
 
@@ -55,10 +57,29 @@
       (return_call $file_exists
          (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
 
+   (data $no_such_file ": No such file or directory")
+
+   (func $caml_raise_no_such_file (param $vname (ref eq))
+      (local $name (ref $string)) (local $msg (ref $string))
+      (local $len i32)
+      (local.set $name (ref.cast $string (local.get $vname)))
+      (local.set $len (array.len (local.get $name)))
+      (local.set $msg
+         (array.new $string (i32.const 0)
+            (i32.add (local.get $len) (i32.const 27))))
+      (array.copy $string $string
+         (local.get $msg) (i32.const 0)
+         (local.get $name) (i32.const 0)
+         (local.get $len))
+      (array.init_data $string $no_such_file
+         (local.get $msg) (local.get $len) (i32.const 0) (i32.const 27))
+      (call $caml_raise_sys_error (local.get $msg)))
+
    (func (export "caml_read_file_content")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_read_file_content"))
+      (call $caml_raise_no_such_file (local.get 0))
       (i31.new (i32.const 0)))
 
    (func (export "caml_fs_init") (result (ref eq))

From b5c961566c1840a35bfc51756ee4e38fc6e4f8ec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 9 Aug 2023 14:26:58 +0200
Subject: [PATCH 113/481] Runtime: console output

---
 runtime/wasm/runtime.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 46fd6612a3..7c8b7c9047 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -270,7 +270,7 @@
            fs.openSync(p,open_flags.reduce((f,v,i)=>(flags&(1<<i))?(f|v):f,0),
                        perm),
          close:(fd)=>fs.closeSync(fd),
-         write:(fd,b,o,l)=>fs.writeSync(fd,b,o,l),
+         write:(fd,b,o,l)=>fs?fs.writeSync(fd,b,o,l):(console.log(new TextDecoder().decode(b.slice(o,o+l))),l),
          read:(fd,b,o,l,p)=>fs.readSync(fd,b,o,l,p),
          file_size:(fd)=>fs.fstatSync(fd,{bigint:true}).size,
          register_channel,

From afc0c7944d135c2a46c94edff5de8c58a51d2e6f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 21 Aug 2023 14:49:22 +0200
Subject: [PATCH 114/481] Runtime: jslib_js_of_ocaml

---
 lib/js_of_ocaml/dom_html.ml        |  5 ++-
 runtime/jslib_js_of_ocaml.js       |  3 +-
 runtime/wasm/jslib_js_of_ocaml.wat | 54 ++++++++++++++++++------------
 3 files changed, 38 insertions(+), 24 deletions(-)

diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index 8e41109028..ae2f81eca6 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -27,7 +27,10 @@ let onIE = Js.to_bool (caml_js_on_ie ())
 
 external html_escape : js_string t -> js_string t = "caml_js_html_escape"
 
-external decode_html_entities : js_string t -> js_string t = "caml_js_html_entities"
+external html_entities : js_string t -> js_string t opt = "caml_js_html_entities"
+
+let decode_html_entities s =
+  Js.Opt.get (html_entities s) (fun () -> failwith ("Invalid entity " ^ Js.to_string s))
 
 class type cssStyleDeclaration =
   object
diff --git a/runtime/jslib_js_of_ocaml.js b/runtime/jslib_js_of_ocaml.js
index fa88452927..d54436c6bd 100644
--- a/runtime/jslib_js_of_ocaml.js
+++ b/runtime/jslib_js_of_ocaml.js
@@ -37,7 +37,6 @@ function caml_js_html_escape (s) {
 }
 
 //Provides: caml_js_html_entities
-//Requires: caml_failwith
 function caml_js_html_entities(s) {
   var entity = /^&#?[0-9a-zA-Z]+;$/
   if(s.match(entity))
@@ -49,7 +48,7 @@ function caml_js_html_entities(s) {
     return str;
   }
   else {
-    caml_failwith("Invalid entity " + s);
+    return null;
   }
 }
 
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index c70cd517b3..347e20f672 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -1,30 +1,42 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
-   (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jslib" "caml_js_global"
+      (func $caml_js_global (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_js_get"
+      (func $caml_js_get (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_js_new"
+      (func $caml_js_new (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_js_from_array"
+      (func $caml_js_from_array (param (ref eq)) (result (ref eq))))
+   (import "js" "caml_js_on_ie" (func $caml_js_on_ie (result i32)))
+   (import "js" "caml_js_html_escape"
+      (func $caml_js_html_escape (param anyref) (result anyref)))
+   (import "js" "caml_js_html_entities"
+      (func $caml_js_html_entities (param anyref) (result anyref)))
 
-   (func (export "caml_js_get_console") (param (ref eq)) (result (ref eq))
-      (return_call $wrap (call $eval (string.const "console"))))
-
-  (func (export "caml_js_html_entities")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_html_entities"))
-      (i31.new (i32.const 0)))
+   (type $block (array (mut (ref eq))))
 
-  (func (export "caml_js_html_escape")
-     (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_js_html_escape"))
-      (i31.new (i32.const 0)))
+   (func (export "caml_js_on_ie") (param (ref eq)) (result (ref eq))
+      (i31.new (call $caml_js_on_ie)))
 
-   (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
+   (func (export "caml_js_html_escape") (param (ref eq)) (result (ref eq))
       (return_call $wrap
-         (call $eval (string.const "new XMLHttpRequest"))))
+         (call $caml_js_html_escape (call $unwrap (local.get 0)))))
 
-   (func (export "caml_js_on_ie") (param (ref eq)) (result (ref eq))
+   (func (export "caml_js_html_entities") (param (ref eq)) (result (ref eq))
       (return_call $wrap
-         (call $eval
-            (string.const
-               "var ua = navigator?navigator.userAgent:\"\"; ua.indexOf(\"MSIE\") != -1 && ua.indexOf(\"Opera\") != 0"))))
+         (call $caml_js_html_entities (call $unwrap (local.get 0)))))
+
+   (func (export "caml_js_get_console") (param (ref eq)) (result (ref eq))
+      (return_call $caml_js_get (call $caml_js_global (i31.new (i32.const 0)))
+         (call $wrap (string.const "console"))))
+
+   (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
+      (return_call $caml_js_new
+         (call $caml_js_get
+            (call $caml_js_global (i31.new (i32.const 0)))
+            (call $wrap (string.const "XMLHttpRequest")))
+         (call $caml_js_from_array
+            (array.new_fixed $block (i31.new (i32.const 0))))))
 )

From e71fd204f2f1b4a126892b129586aec8e135b2ec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 1 Aug 2023 17:45:42 +0200
Subject: [PATCH 115/481] Improved compilation of try .. catch

Thanks to @hhugo.
---
 compiler/lib/wasm/wa_structure.ml | 49 +++++++++++++++++--------------
 1 file changed, 27 insertions(+), 22 deletions(-)

diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
index e00ae0f781..95cfbc02b9 100644
--- a/compiler/lib/wasm/wa_structure.ml
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -30,16 +30,30 @@ let is_backward g pc pc' = Hashtbl.find g.block_order pc >= Hashtbl.find g.block
 
 let is_forward g pc pc' = Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
 
-let rec leave_try_body blocks pc =
-  match Addr.Map.find pc blocks with
-  | { body = []; branch = (Return _ | Stop), _; _ } -> false
-  | { body = []; branch = Branch (pc', _), _; _ } -> leave_try_body blocks pc'
-  | _ -> true
+(* pc has at least two forward edges moving into it *)
+let is_merge_node' block_order preds pc =
+  let s = try Hashtbl.find preds pc with Not_found -> Addr.Set.empty in
+  let o = Hashtbl.find block_order pc in
+  let n =
+    Addr.Set.fold (fun pc' n -> if Hashtbl.find block_order pc' < o then n + 1 else n) s 0
+  in
+  n > 1
+
+let rec leave_try_body block_order preds blocks pc =
+  if is_merge_node' block_order preds pc
+  then false
+  else
+    match Addr.Map.find pc blocks with
+    | { body = []; branch = (Return _ | Stop), _; _ } -> false
+    | { body = []; branch = Branch (pc', _), _; _ } ->
+        leave_try_body block_order preds blocks pc'
+    | _ -> true
 
 let build_graph blocks pc =
   let succs = Hashtbl.create 16 in
   let l = ref [] in
   let visited = Hashtbl.create 16 in
+  let poptraps = ref [] in
   let rec traverse ~englobing_exn_handlers pc =
     if not (Hashtbl.mem visited pc)
     then (
@@ -57,13 +71,7 @@ let build_graph blocks pc =
                 match englobing_exn_handlers with
                 | [] -> assert false
                 | enter_pc :: rem ->
-                    if leave_try_body blocks leave_pc
-                    then
-                      (* Add an edge to limit the [try] body *)
-                      Hashtbl.add
-                        succs
-                        enter_pc
-                        (Addr.Set.add leave_pc (Hashtbl.find succs enter_pc));
+                    poptraps := (enter_pc, leave_pc) :: !poptraps;
                     rem)
             | _ -> englobing_exn_handlers
           in
@@ -75,6 +83,12 @@ let build_graph blocks pc =
   let block_order = Hashtbl.create 16 in
   List.iteri !l ~f:(fun i pc -> Hashtbl.add block_order pc i);
   let preds = reverse_graph succs in
+  List.iter !poptraps ~f:(fun (enter_pc, leave_pc) ->
+      if leave_try_body block_order preds blocks leave_pc
+      then (
+        (* Add an edge to limit the [try] body *)
+        Hashtbl.add succs enter_pc (Addr.Set.add leave_pc (Hashtbl.find succs enter_pc));
+        Hashtbl.add preds leave_pc (Addr.Set.add enter_pc (Hashtbl.find preds leave_pc))));
   { succs; preds; reverse_post_order = !l; block_order }
 
 let reversed_dominator_tree g =
@@ -113,16 +127,7 @@ let reversed_dominator_tree g =
 let dominator_tree g = reverse_tree (reversed_dominator_tree g)
 
 (* pc has at least two forward edges moving into it *)
-let is_merge_node g pc =
-  let s = try Hashtbl.find g.preds pc with Not_found -> Addr.Set.empty in
-  let o = Hashtbl.find g.block_order pc in
-  let n =
-    Addr.Set.fold
-      (fun pc' n -> if Hashtbl.find g.block_order pc' < o then n + 1 else n)
-      s
-      0
-  in
-  n > 1
+let is_merge_node g pc = is_merge_node' g.block_order g.preds pc
 
 let is_loop_header g pc =
   let s = try Hashtbl.find g.preds pc with Not_found -> Addr.Set.empty in

From d7ac2c9fff236a4e874a2db50cc4bd54e58e3359 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Aug 2023 11:26:53 +0200
Subject: [PATCH 116/481] Standard syntax for ref.cast/ref.test/array.new_fixed

---
 compiler/lib/wasm/wa_wat_output.ml | 27 +++++++--------------------
 1 file changed, 7 insertions(+), 20 deletions(-)

diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index e0a562783a..45d82125a9 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -30,11 +30,9 @@ let heap_type (ty : heap_type) =
   | I31 -> Atom "i31"
   | Type t -> index t
 
-let ref_type' { nullable; typ } =
+let ref_type { nullable; typ } =
   let r = [ heap_type typ ] in
-  if nullable then Atom "null" :: r else r
-
-let ref_type r = List (Atom "ref" :: ref_type' r)
+  List (Atom "ref" :: (if nullable then Atom "null" :: r else r))
 
 let value_type (t : value_type) =
   match t with
@@ -280,10 +278,8 @@ let expression_or_instructions ctx in_function =
         [ List
             (Atom "array.new_fixed"
             :: index typ
-            :: ((match target with
-                | `Binaryen -> []
-                | `Reference -> [ Atom (string_of_int (List.length l)) ])
-               @ List.concat (List.map ~f:expression l)))
+            :: Atom (string_of_int (List.length l))
+            :: List.concat (List.map ~f:expression l))
         ]
     | ArrayNewData (typ, data, e, e') ->
         [ List
@@ -312,14 +308,8 @@ let expression_or_instructions ctx in_function =
             :: Atom (string_of_int i)
             :: expression e)
         ]
-    | RefCast (ty, e) -> (
-        match target with
-        | `Binaryen -> [ List (Atom "ref.cast" :: (ref_type' ty @ expression e)) ]
-        | `Reference -> [ List (Atom "ref.cast" :: ref_type ty :: expression e) ])
-    | RefTest (ty, e) -> (
-        match target with
-        | `Binaryen -> [ List (Atom "ref.test" :: (ref_type' ty @ expression e)) ]
-        | `Reference -> [ List (Atom "ref.test" :: ref_type ty :: expression e) ])
+    | RefCast (ty, e) -> [ List (Atom "ref.cast" :: ref_type ty :: expression e) ]
+    | RefTest (ty, e) -> [ List (Atom "ref.test" :: ref_type ty :: expression e) ]
     | RefEq (e, e') -> [ List (Atom "ref.eq" :: (expression e @ expression e')) ]
     | RefNull ty -> [ List [ Atom "ref.null"; heap_type ty ] ]
     | Br_on_cast (i, ty, ty', e) ->
@@ -370,10 +360,7 @@ let expression_or_instructions ctx in_function =
             (Atom "if"
             :: (block_type ty
                @ expression e
-               @ (let l1 = remove_nops l1 in
-                  if Poly.equal target `Binaryen && List.is_empty l1
-                  then [ List [ Atom "then"; Atom "nop" ] ]
-                  else list ~always:true "then" instructions l1)
+               @ list ~always:true "then" instructions (remove_nops l1)
                @ list "else" instructions (remove_nops l2)))
         ]
     | Try (ty, body, catches, catch_all) ->

From f96b9d5649b0448cfcdeb2573868eded1ce66255 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Aug 2023 11:32:15 +0200
Subject: [PATCH 117/481] Runtime: standard syntax

---
 runtime/wasm/array.wat     |  38 ++++---
 runtime/wasm/backtrace.wat |   6 +-
 runtime/wasm/bigarray.wat  | 212 +++++++++++++++++++------------------
 runtime/wasm/bigstring.wat |  68 ++++++------
 runtime/wasm/compare.wat   |  40 ++++---
 runtime/wasm/custom.wat    |   6 +-
 runtime/wasm/domain.wat    |  19 ++--
 runtime/wasm/effect.wat    |  45 ++++----
 runtime/wasm/fail.wat      |   2 +-
 runtime/wasm/float.wat     |  65 +++++++-----
 runtime/wasm/fs.wat        |   2 +-
 runtime/wasm/gc.wat        |   6 +-
 runtime/wasm/hash.wat      |  16 +--
 runtime/wasm/int32.wat     |  33 +++---
 runtime/wasm/int64.wat     |  29 ++---
 runtime/wasm/ints.wat      |  15 +--
 runtime/wasm/io.wat        |  49 +++++----
 runtime/wasm/jslib.wat     |  77 +++++++-------
 runtime/wasm/lexing.wat    |  68 ++++++------
 runtime/wasm/md5.wat       |   8 +-
 runtime/wasm/obj.wat       |  66 ++++++------
 runtime/wasm/parsing.wat   | 121 ++++++++++-----------
 runtime/wasm/printexc.wat  |  21 ++--
 runtime/wasm/prng.wat      |   2 +-
 runtime/wasm/stdlib.wat    |  10 +-
 runtime/wasm/str.wat       |  81 +++++++-------
 runtime/wasm/string.wat    |  60 +++++------
 runtime/wasm/sync.wat      |   9 +-
 runtime/wasm/sys.wat       |  14 +--
 runtime/wasm/unix.wat      |  24 +++--
 runtime/wasm/weak.wat      |  61 +++++------
 31 files changed, 669 insertions(+), 604 deletions(-)

diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index df013293e0..b8ecb71705 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -12,7 +12,7 @@
    (func $caml_make_vect (export "caml_make_vect")
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $sz i32) (local $b (ref $block))
-      (local.set $sz (i31.get_s (ref.cast i31 (local.get $n))))
+      (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
       (if (i32.lt_s (local.get $sz) (i32.const 0))
          (then
             (call $caml_invalid_argument
@@ -25,7 +25,8 @@
       (array.set $block (local.get $b) (i32.const 0)
          (i31.new
             (select (global.get $double_array_tag) (i32.const 0)
-               (i32.and (local.get $sz) (ref.test $float (local.get $v))))))
+               (i32.and
+                  (local.get $sz) (ref.test (ref $float) (local.get $v))))))
       (local.get $b))
 
    (export "caml_make_float_vect" (func $caml_floatarray_create))
@@ -39,8 +40,8 @@
       (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
       (result (ref eq))
       (local $a1 (ref $block)) (local $a2 (ref $block)) (local $len i32)
-      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
-      (local.set $a1 (ref.cast $block (local.get $a)))
+      (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+      (local.set $a1 (ref.cast (ref $block) (local.get $a)))
       (local.set $a2 (array.new $block (i31.new (i32.const 0))
                         (i32.add (local.get $len) (i32.const 1))))
       (array.set $block (local.get $a2) (i32.const 0)
@@ -49,7 +50,8 @@
          (then
             (array.copy $block $block
                (local.get $a2) (i32.const 1) (local.get $a1)
-               (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
+               (i32.add
+                  (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))
                (local.get $len))))
       (local.get $a2))
 
@@ -57,9 +59,9 @@
       (param $va1 (ref eq)) (param $va2 (ref eq)) (result (ref eq))
       (local $a1 (ref $block)) (local $a2 (ref $block)) (local $a (ref $block))
       (local $l1 i32) (local $l2 i32)
-      (local.set $a1 (ref.cast $block (local.get $va1)))
+      (local.set $a1 (ref.cast (ref $block) (local.get $va1)))
       (local.set $l1 (array.len (local.get $a1)))
-      (local.set $a2 (ref.cast $block (local.get $va2)))
+      (local.set $a2 (ref.cast (ref $block) (local.get $va2)))
       (local.set $l2 (array.len (local.get $a2)))
       (local.set $a
          (array.new $block (i31.new (i32.const 0))
@@ -97,7 +99,7 @@
                 (i32.add (local.get $len)
                    (i32.sub
                       (array.len
-                         (ref.cast $block
+                         (ref.cast (ref $block)
                             (array.get $block (local.get $b) (i32.const 1))))
                       (i32.const 1))))
              (if (ref.eq (array.get $block (local.get $b) (i32.const 0))
@@ -118,7 +120,7 @@
              (local.set $b
                 (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l)))
              (local.set $a'
-                (ref.cast $block
+                (ref.cast (ref $block)
                    (array.get $block (local.get $b) (i32.const 1))))
              (local.set $len
                 (i32.sub (array.len (local.get $a')) (i32.const 1)))
@@ -138,19 +140,21 @@
       (param $len (ref eq))
       (result (ref eq))
       (array.copy $block $block
-         (ref.cast $block (local.get $a2))
-         (i32.add (i31.get_s (ref.cast i31 (local.get $i2))) (i32.const 1))
-         (ref.cast $block (local.get $a1))
-         (i32.add (i31.get_s (ref.cast i31 (local.get $i1))) (i32.const 1))
-         (i31.get_s (ref.cast i31 (local.get $len))))
+         (ref.cast (ref $block) (local.get $a2))
+         (i32.add
+            (i31.get_s (ref.cast (ref i31) (local.get $i2))) (i32.const 1))
+         (ref.cast (ref $block) (local.get $a1))
+         (i32.add
+            (i31.get_s (ref.cast (ref i31) (local.get $i1))) (i32.const 1))
+         (i31.get_s (ref.cast (ref i31) (local.get $len))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_array_fill")
       (param $a (ref eq)) (param $i (ref eq)) (param $len (ref eq))
       (param $v (ref eq)) (result (ref eq))
-      (array.fill $block (ref.cast $block (local.get $a))
-         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
+      (array.fill $block (ref.cast (ref $block) (local.get $a))
+         (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))
          (local.get $v)
-         (i31.get_u (ref.cast i31 (local.get $len))))
+         (i31.get_u (ref.cast (ref i31) (local.get $len))))
       (i31.new (i32.const 0)))
 )
diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat
index f7adf3e244..11c0c8b53a 100644
--- a/runtime/wasm/backtrace.wat
+++ b/runtime/wasm/backtrace.wat
@@ -7,7 +7,7 @@
 
    (func (export "caml_get_exception_raw_backtrace")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (func (export "caml_backtrace_status")
       (param (ref eq)) (result (ref eq))
@@ -15,7 +15,7 @@
 
    (func (export "caml_convert_raw_backtrace")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (func (export "caml_raw_backtrace_next_slot")
       (param (ref eq)) (result (ref eq))
@@ -41,7 +41,7 @@
 
    (func (export "caml_get_current_callstack")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (func (export "caml_ml_debug_info_status")
       (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 86d7d5af7f..f243fc83ef 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -93,7 +93,7 @@
    (global $bigarray_ops (ref $custom_operations)
       ;; ZZZ
       (struct.new $custom_operations
-         (array.new_fixed $string ;; "_bigarr02"
+         (array.new_fixed $string 9 ;; "_bigarr02"
             (i32.const 95) (i32.const 98) (i32.const 105) (i32.const 103)
             (i32.const 97) (i32.const 114) (i32.const 114) (i32.const 48)
             (i32.const 50))
@@ -115,7 +115,7 @@
       (local $b (ref $bigarray))
       (local $h i32) (local $len i32) (local $i i32) (local $w i32)
       (local $data (ref extern))
-      (local.set $b (ref.cast $bigarray (local.get 0)))
+      (local.set $b (ref.cast (ref $bigarray) (local.get 0)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
       (local.set $len (call $ta_length (local.get $data)))
       (block $float32
@@ -375,8 +375,8 @@
       (local $vdim (ref $block))
       (local $dim (ref $int_array))
       (local $kind i32) (local $num_dims i32) (local $i i32) (local $n i32)
-      (local.set $kind (i31.get_s (ref.cast i31 (local.get $vkind))))
-      (local.set $vdim (ref.cast $block (local.get $d)))
+      (local.set $kind (i31.get_s (ref.cast (ref i31) (local.get $vkind))))
+      (local.set $vdim (ref.cast (ref $block) (local.get $d)))
       (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1)))
       (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS))
          (then
@@ -391,7 +391,7 @@
             (then
                (local.set $n
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $vdim)
                            (i32.add (local.get $i) (i32.const 1))))))
                (if (i32.lt_s (local.get $n) (i32.const 0))
@@ -410,7 +410,7 @@
          (local.get $dim)
          (local.get $num_dims)
          (local.get $kind)
-         (i31.get_s (ref.cast i31 (local.get $layout)))))
+         (i31.get_s (ref.cast (ref i31) (local.get $layout)))))
 
    (data $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind")
    (data $ta_too_large "Typed_array.to_genarray: too large")
@@ -437,7 +437,7 @@
       (struct.new $bigarray
          (global.get $bigarray_ops)
          (local.get $data)
-         (array.new_fixed $int_array (local.get $len))
+         (array.new_fixed $int_array 1 (local.get $len))
          (i32.const 1)
          (local.get $kind)
          (i32.const 0)))
@@ -445,7 +445,8 @@
    (func (export "caml_ba_to_typed_array") (param (ref eq)) (result (ref eq))
       (call $wrap
          (extern.internalize
-            (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get 0))))))
+            (struct.get $bigarray $ba_data
+               (ref.cast (ref $bigarray) (local.get 0))))))
 
    (func $caml_ba_get_at_offset
       (param $ba (ref $bigarray)) (param $i i32) (result (ref eq))
@@ -470,7 +471,7 @@
                  ;; complex64
                  (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                  (return
-                    (array.new_fixed $block
+                    (array.new_fixed $block 3
                        (i31.new (global.get $double_array_tag))
                        (struct.new $float
                           (call $ta_get_f64 (local.get $data) (local.get $i)))
@@ -480,7 +481,7 @@
                 ;; complex32
                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                 (return
-                   (array.new_fixed $block
+                   (array.new_fixed $block 3
                       (i31.new (global.get $double_array_tag))
                       (struct.new $float
                          (call $ta_get_f32 (local.get $data) (local.get $i)))
@@ -550,42 +551,42 @@
                      (struct.get $bigarray $ba_kind (local.get $ba))))
                  ;; complex64
                  (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                 (local.set $b (ref.cast $block (local.get $v)))
+                 (local.set $b (ref.cast (ref $block) (local.get $v)))
                  (call $ta_set_f64 (local.get $data) (local.get $i)
                     (struct.get $float 0
-                       (ref.cast $float
+                       (ref.cast (ref $float)
                           (array.get $block (local.get $b) (i32.const 1)))))
                  (call $ta_set_f64 (local.get $data)
                     (i32.add (local.get $i) (i32.const 1))
                     (struct.get $float 0
-                       (ref.cast $float
+                       (ref.cast (ref $float)
                          (array.get $block (local.get $b) (i32.const 2)))))
                  (return))
                 ;; complex32
                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                (local.set $b (ref.cast $block (local.get $v)))
+                (local.set $b (ref.cast (ref $block) (local.get $v)))
                 (call $ta_set_f32 (local.get $data) (local.get $i)
                    (struct.get $float 0
-                      (ref.cast $float
+                      (ref.cast (ref $float)
                          (array.get $block (local.get $b) (i32.const 1)))))
                 (call $ta_set_f32 (local.get $data)
                    (i32.add (local.get $i) (i32.const 1))
                    (struct.get $float 0
-                      (ref.cast $float
+                      (ref.cast (ref $float)
                          (array.get $block (local.get $b) (i32.const 2)))))
                 (return))
                ;; nativeint
                (call $ta_set_i32 (local.get $data) (local.get $i)
-                  (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+                  (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
                (return))
               ;; int
               (call $ta_set_i32 (local.get $data) (local.get $i)
-                 (i31.get_s (ref.cast i31 (local.get $v))))
+                 (i31.get_s (ref.cast (ref i31) (local.get $v))))
               (return))
              ;; int64
              (local.set $i (i32.shl (local.get $i) (i32.const 1)))
              (local.set $l
-                (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+                (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
              (call $ta_set_i32 (local.get $data) (local.get $i)
                 (i32.wrap_i64 (local.get $l)))
              (call $ta_set_i32 (local.get $data)
@@ -594,31 +595,31 @@
              (return))
             ;; int32
             (call $ta_set_i32 (local.get $data) (local.get $i)
-               (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+               (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
             (return))
            ;; uint16
            (call $ta_set_ui16 (local.get $data) (local.get $i)
-              (ref.cast i31 (local.get $v)))
+              (ref.cast (ref i31) (local.get $v)))
            (return))
           ;; int16
           (call $ta_set_i16 (local.get $data) (local.get $i)
-             (ref.cast i31 (local.get $v)))
+             (ref.cast (ref i31) (local.get $v)))
           (return))
          ;; uint8
          (call $ta_set_ui8 (local.get $data) (local.get $i)
-            (ref.cast i31 (local.get $v)))
+            (ref.cast (ref i31) (local.get $v)))
          (return))
         ;; int8
         (call $ta_set_i8 (local.get $data) (local.get $i)
-           (ref.cast i31 (local.get $v)))
+           (ref.cast (ref i31) (local.get $v)))
         (return))
        ;; float64
        (call $ta_set_f64 (local.get $data) (local.get $i)
-          (struct.get $float 0 (ref.cast $float (local.get $v))))
+          (struct.get $float 0 (ref.cast (ref $float) (local.get $v))))
        (return))
       ;; float32
       (call $ta_set_f32 (local.get $data) (local.get $i)
-         (struct.get $float 0 (ref.cast $float (local.get $v))))
+         (struct.get $float 0 (ref.cast (ref $float) (local.get $v))))
       (return))
 
    (data $Bigarray_dim "Bigarray.dim")
@@ -628,8 +629,9 @@
       (local $dim (ref $int_array))
       (local $i i32)
       (local.set $dim
-         (struct.get $bigarray $ba_dim (ref.cast $bigarray (local.get 0))))
-      (local.set $i (i31.get_s (ref.cast i31 (local.get 1))))
+         (struct.get $bigarray $ba_dim
+            (ref.cast (ref $bigarray) (local.get 0))))
+      (local.set $i (i31.get_s (ref.cast (ref i31) (local.get 1))))
       (if (i32.ge_u (local.get $i) (array.len (local.get $dim)))
          (then (call $caml_invalid_argument
                   (array.new_data $string $Bigarray_dim
@@ -643,8 +645,8 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $ba (ref $bigarray))
       (local $i i32)
-      (local.set $ba (ref.cast $bigarray (local.get 0)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get 0)))
+      (local.set $i (i31.get_u (ref.cast (ref i31) (local.get 1))))
       (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
       (if (i32.ge_u (local.get $i)
@@ -657,8 +659,8 @@
       (param (ref eq)) (param (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $ba (ref $bigarray))
       (local $i i32)
-      (local.set $ba (ref.cast $bigarray (local.get 0)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get 1))))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get 0)))
+      (local.set $i (i31.get_u (ref.cast (ref i31) (local.get 1))))
       (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then (local.set $i (i32.sub (local.get $i) (i32.const 1)))))
       (if (i32.ge_u (local.get $i)
@@ -677,9 +679,9 @@
       (local $j i32)
       (local $offset i32)
       (local $dim (ref $int_array))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
-      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast (ref i31) (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast (ref i31) (local.get $vj))))
       (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
       (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then
@@ -713,9 +715,9 @@
       (local $j i32)
       (local $offset i32)
       (local $dim (ref $int_array))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
-      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast (ref i31) (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast (ref i31) (local.get $vj))))
       (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
       (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then
@@ -756,10 +758,10 @@
       (local $k i32)
       (local $offset i32)
       (local $dim (ref $int_array))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
-      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
-      (local.set $k (i31.get_u (ref.cast i31 (local.get $vk))))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast (ref i31) (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast (ref i31) (local.get $vj))))
+      (local.set $k (i31.get_u (ref.cast (ref i31) (local.get $vk))))
       (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
       (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then
@@ -809,10 +811,10 @@
       (local $k i32)
       (local $offset i32)
       (local $dim (ref $int_array))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
-      (local.set $i (i31.get_u (ref.cast i31 (local.get $vi))))
-      (local.set $j (i31.get_u (ref.cast i31 (local.get $vj))))
-      (local.set $k (i31.get_u (ref.cast i31 (local.get $vk))))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
+      (local.set $i (i31.get_u (ref.cast (ref i31) (local.get $vi))))
+      (local.set $j (i31.get_u (ref.cast (ref i31) (local.get $vj))))
+      (local.set $k (i31.get_u (ref.cast (ref i31) (local.get $vk))))
       (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
       (if (struct.get $bigarray $ba_layout (local.get $ba))
          (then
@@ -923,7 +925,7 @@
                      (local.set $idx
                         (i32.sub
                            (i31.get_s
-                              (ref.cast i31
+                              (ref.cast (ref i31)
                                  (array.get $block (local.get $index)
                                     (i32.add (local.get $i) (i32.const 1)))))
                            (i32.const 1)))
@@ -945,7 +947,7 @@
                   (then
                      (local.set $idx
                         (i31.get_s
-                           (ref.cast i31
+                           (ref.cast (ref i31)
                               (array.get $block (local.get $index)
                                  (i32.add (local.get $i) (i32.const 1))))))
                      (local.set $l
@@ -963,19 +965,19 @@
    (func (export "caml_ba_get_generic")
       (param $vba (ref eq)) (param $index (ref eq)) (result (ref eq))
       (local $ba (ref $bigarray))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (return_call $caml_ba_get_at_offset (local.get $ba)
          (call $caml_ba_offset' (local.get $ba)
-            (ref.cast $block (local.get $index)))))
+            (ref.cast (ref $block) (local.get $index)))))
 
    (func (export "caml_ba_set_generic")
       (param $vba (ref eq)) (param $index (ref eq)) (param $v (ref eq))
       (result (ref eq))
       (local $ba (ref $bigarray))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (call $caml_ba_set_at_offset (local.get $ba)
          (call $caml_ba_offset' (local.get $ba)
-            (ref.cast $block (local.get $index)))
+            (ref.cast (ref $block) (local.get $index)))
          (local.get $v))
       (i31.new (i32.const 0)))
 
@@ -989,8 +991,8 @@
       (local $num_inds i32) (local $num_dims i32) (local $i i32)
       (local $idx i32) (local $mul i32) (local $offset i32) (local $size i32)
       (local $sub_data (ref extern))
-      (local.set $b (ref.cast $bigarray (local.get $vb)))
-      (local.set $ind (ref.cast $block (local.get $vind)))
+      (local.set $b (ref.cast (ref $bigarray) (local.get $vb)))
+      (local.set $ind (ref.cast (ref $block) (local.get $vind)))
       (local.set $num_inds (i32.sub (array.len (local.get $ind)) (i32.const 1)))
       (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $b)))
       (if (i32.gt_u (local.get $num_inds)
@@ -1013,7 +1015,7 @@
                         (i32.sub (i32.add (local.get $num_dims) (local.get $i))
                            (local.get $num_inds))
                         (i31.get_u
-                           (ref.cast i31
+                           (ref.cast (ref i31)
                               (array.get $block (local.get $ind)
                                  (i32.add (local.get $i) (i32.const 1))))))
                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
@@ -1033,7 +1035,7 @@
                      (array.set $int_array (local.get $index)
                         (local.get $i)
                         (i31.get_u
-                           (ref.cast i31
+                           (ref.cast (ref i31)
                               (array.get $block (local.get $ind)
                                  (i32.add (local.get $i) (i32.const 1))))))
                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
@@ -1073,9 +1075,9 @@
       (local $num_dims i32)
       (local $dim (ref $int_array)) (local $new_dim (ref $int_array))
       (local $new_data (ref extern))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
-      (local.set $ofs (i31.get_s (ref.cast i31 (local.get $vofs))))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
+      (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $ba)))
       (local.set $dim (struct.get $bigarray $ba_dim (local.get $ba)))
       (local.set $mul (i32.const 1))
@@ -1148,7 +1150,7 @@
       (local $i i32) (local $len i32) (local $i1 i32) (local $i2 i32)
       (local $f1 f64) (local $f2 f64)
       (local $b (ref $block))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (block $float
        (block $int
@@ -1161,14 +1163,14 @@
                (struct.get $bigarray $ba_kind (local.get $ba))))
             ;; complex64
             (local.set $len (call $ta_length (local.get $data)))
-            (local.set $b (ref.cast $block (local.get $v)))
+            (local.set $b (ref.cast (ref $block) (local.get $v)))
             (local.set $f1
                (struct.get $float 0
-                  (ref.cast $float
+                  (ref.cast (ref $float)
                      (array.get $block (local.get $b) (i32.const 1)))))
             (local.set $f2
                (struct.get $float 0
-                  (ref.cast $float
+                  (ref.cast (ref $float)
                      (array.get $block (local.get $b) (i32.const 2)))))
             (loop $loop
                (if (i32.lt_u (local.get $i) (local.get $len))
@@ -1183,14 +1185,14 @@
             (return (i31.new (i32.const 0))))
            ;; complex32
            (local.set $len (call $ta_length (local.get $data)))
-           (local.set $b (ref.cast $block (local.get $v)))
+           (local.set $b (ref.cast (ref $block) (local.get $v)))
            (local.set $f1
               (struct.get $float 0
-                 (ref.cast $float
+                 (ref.cast (ref $float)
                     (array.get $block (local.get $b) (i32.const 1)))))
            (local.set $f2
               (struct.get $float 0
-                 (ref.cast $float
+                 (ref.cast (ref $float)
                     (array.get $block (local.get $b) (i32.const 2)))))
            (loop $loop
               (if (i32.lt_u (local.get $i) (local.get $len))
@@ -1206,7 +1208,7 @@
           ;; int64
           (local.set $len (call $ta_length (local.get $data)))
           (local.set $l
-             (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+             (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
           (local.set $i1 (i32.wrap_i64 (local.get $l)))
           (local.set $i2
              (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32))))
@@ -1223,15 +1225,15 @@
           (return (i31.new (i32.const 0))))
          ;; int32
          (call $ta_fill_int (local.get $data)
-            (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+            (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
          (return (i31.new (i32.const 0))))
         ;; int
         (call $ta_fill_int (local.get $data)
-           (i31.get_s (ref.cast i31 (local.get $v))))
+           (i31.get_s (ref.cast (ref i31) (local.get $v))))
         (return (i31.new (i32.const 0))))
        ;; float
        (call $ta_fill_float (local.get $data)
-          (struct.get $float 0 (ref.cast $float (local.get $v))))
+          (struct.get $float 0 (ref.cast (ref $float) (local.get $v))))
        (return (i31.new (i32.const 0))))
 
    (data $dim_mismatch "Bigarray.blit: dimension mismatch")
@@ -1243,8 +1245,8 @@
       (local $sdim (ref $int_array))
       (local $ddim (ref $int_array))
       (local $i i32) (local $len i32)
-      (local.set $src (ref.cast $bigarray (local.get $vsrc)))
-      (local.set $dst (ref.cast $bigarray (local.get $vdst)))
+      (local.set $src (ref.cast (ref $bigarray) (local.get $vsrc)))
+      (local.set $dst (ref.cast (ref $bigarray) (local.get $vdst)))
       (local.set $len (struct.get $bigarray $ba_num_dims (local.get $dst)))
       (if (i32.ne (local.get $len)
              (struct.get $bigarray $ba_num_dims (local.get $src)))
@@ -1279,9 +1281,9 @@
       (local $num_dims i32) (local $num_elts i64) (local $i i32) (local $d i32)
       (local $b (ref $bigarray))
       (local $dim (ref $int_array))
-      (local.set $vdim (ref.cast $block (local.get $vd)))
+      (local.set $vdim (ref.cast (ref $block) (local.get $vd)))
       (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1)))
-      (local.set $b (ref.cast $bigarray (local.get $vb)))
+      (local.set $b (ref.cast (ref $bigarray) (local.get $vb)))
       (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS))
          (then
             (call $caml_invalid_argument
@@ -1294,7 +1296,7 @@
             (then
                (local.set $d
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $vdim)
                            (i32.add (local.get $i) (i32.const 1))))))
                (if (i32.lt_s (local.get $d) (i32.const 0))
@@ -1332,8 +1334,8 @@
       (local $b (ref $bigarray))
       (local $layout i32) (local $num_dims i32) (local $i i32)
       (local $dim (ref $int_array)) (local $new_dim (ref $int_array))
-      (local.set $b (ref.cast $bigarray (local.get $vb)))
-      (local.set $layout (i31.get_s (ref.cast i31 (local.get $vlayout))))
+      (local.set $b (ref.cast (ref $bigarray) (local.get $vb)))
+      (local.set $layout (i31.get_s (ref.cast (ref i31) (local.get $vlayout))))
       (if (result (ref eq))
           (i32.ne (struct.get $bigarray $ba_layout (local.get $b))
              (local.get $layout))
@@ -1366,15 +1368,18 @@
 
    (func (export "caml_ba_num_dims") (param (ref eq)) (result (ref eq))
       (i31.new
-         (struct.get $bigarray $ba_num_dims (ref.cast $bigarray (local.get 0)))))
+         (struct.get $bigarray $ba_num_dims
+            (ref.cast (ref $bigarray) (local.get 0)))))
 
    (func (export "caml_ba_kind") (param (ref eq)) (result (ref eq))
       (i31.new
-         (struct.get $bigarray $ba_kind (ref.cast $bigarray (local.get 0)))))
+         (struct.get $bigarray $ba_kind
+            (ref.cast (ref $bigarray) (local.get 0)))))
 
    (func (export "caml_ba_layout") (param (ref eq)) (result (ref eq))
       (i31.new
-         (struct.get $bigarray $ba_layout (ref.cast $bigarray (local.get 0)))))
+         (struct.get $bigarray $ba_layout
+            (ref.cast (ref $bigarray) (local.get 0)))))
 
    (func $caml_ba_compare
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32)
@@ -1382,8 +1387,8 @@
       (local $i1 i32) (local $i2 i32) (local $i i32) (local $len i32)
       (local $f1 f64) (local $f2 f64)
       (local $d1 (ref extern)) (local $d2 (ref extern))
-      (local.set $b1 (ref.cast $bigarray (local.get $v1)))
-      (local.set $b2 (ref.cast $bigarray (local.get $v2)))
+      (local.set $b1 (ref.cast (ref $bigarray) (local.get $v1)))
+      (local.set $b2 (ref.cast (ref $bigarray) (local.get $v2)))
       (if (i32.ne (struct.get $bigarray $ba_layout (local.get $b2))
                   (struct.get $bigarray $ba_layout (local.get $b1)))
          (then
@@ -1588,9 +1593,9 @@
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32)
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
@@ -1609,9 +1614,9 @@
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32)
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -1639,9 +1644,9 @@
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32)
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
@@ -1694,10 +1699,10 @@
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32) (local $d (ref i31))
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
-      (local.set $d (ref.cast i31 (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
+      (local.set $d (ref.cast (ref i31) (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
@@ -1717,10 +1722,11 @@
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32) (local $d i32)
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
-      (local.set $d (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
+      (local.set $d
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -1747,10 +1753,11 @@
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32) (local $d i64)
-      (local.set $ba (ref.cast $bigarray (local.get $vba)))
+      (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
-      (local.set $d (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
+      (local.set $d
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
@@ -1801,20 +1808,21 @@
       (local.get $s))
 
    (func (export "caml_ba_get_kind") (param (ref eq)) (result i32)
-      (struct.get $bigarray $ba_kind (ref.cast $bigarray (local.get 0))))
+      (struct.get $bigarray $ba_kind (ref.cast (ref $bigarray) (local.get 0))))
 
    (func (export "caml_ba_get_layout") (param (ref eq)) (result i32)
-      (struct.get $bigarray $ba_layout (ref.cast $bigarray (local.get 0))))
+      (struct.get $bigarray $ba_layout
+         (ref.cast (ref $bigarray) (local.get 0))))
 
    (func (export "caml_ba_get_data") (param (ref eq)) (result (ref extern))
-      (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get 0))))
+      (struct.get $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0))))
 
    (func (export "caml_ba_set_data") (param (ref eq)) (param (ref extern))
-      (struct.set $bigarray $ba_data (ref.cast $bigarray (local.get 0))
+      (struct.set $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0))
          (local.get $1)))
 
    (func (export "caml_ba_get_dim") (param (ref eq)) (result (ref $int_array))
-      (struct.get $bigarray $ba_dim (ref.cast $bigarray (local.get 0))))
+      (struct.get $bigarray $ba_dim (ref.cast (ref $bigarray) (local.get 0))))
 
    (func (export "caml_ba_alloc")
       (param $kind i32) (param $layout i32) (param $num_dims i32)
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 6d89765b91..7b9606b590 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -61,7 +61,7 @@
       (local $b (ref $bigarray))
       (local $data (ref extern))
       (local $len i32) (local $i i32) (local $w i32)
-      (local.set $b (ref.cast $bigarray (local.get $vb)))
+      (local.set $b (ref.cast (ref $bigarray) (local.get $vb)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
       (local.set $len (call $ta_len (local.get $data)))
       (loop $loop
@@ -140,12 +140,14 @@
       (local $d1 (ref extern))
       (local $d2 (ref extern))
       (local.set $d1
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s1))))
-      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $s1))))
+      (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
       (local.set $d2
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s2))))
-      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $s2))))
+      (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
@@ -171,11 +173,12 @@
       (local $d1 (ref extern))
       (local $s2 (ref $string))
       (local.set $d1
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s1))))
-      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
-      (local.set $s2 (ref.cast $string (local.get $vs2)))
-      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $s1))))
+      (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
+      (local.set $s2 (ref.cast (ref $string) (local.get $vs2)))
+      (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
@@ -197,11 +200,12 @@
       (param $vpos (ref eq)) (param $vlen (ref eq)) (result (ref eq))
       (local $pos i32) (local $len i32) (local $c i32)
       (local $d (ref extern))
-      (local.set $c (i31.get_s (ref.cast i31 (local.get $vc))))
-      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (local.set $c (i31.get_s (ref.cast (ref i31) (local.get $vc))))
+      (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (local.set $d
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $s))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $s))))
       (loop $loop
          (if (i32.gt_s (local.get $len) (i32.const 0))
             (then
@@ -224,12 +228,13 @@
       (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
       (local $s1 (ref $string))
       (local $d2 (ref extern))
-      (local.set $s1 (ref.cast $string (local.get $str1)))
-      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+      (local.set $s1 (ref.cast (ref $string) (local.get $str1)))
+      (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
       (local.set $d2
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba2))))
-      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $ba2))))
+      (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
@@ -250,11 +255,12 @@
       (local $d1 (ref extern))
       (local $s2 (ref $string))
       (local.set $d1
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba1))))
-      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
-      (local.set $s2 (ref.cast $string (local.get $str2)))
-      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $ba1))))
+      (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
+      (local.set $s2 (ref.cast (ref $string) (local.get $str2)))
+      (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
@@ -274,12 +280,14 @@
       (local $d1 (ref extern))
       (local $d2 (ref extern))
       (local.set $d1
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba1))))
-      (local.set $pos1 (i31.get_s (ref.cast i31 (local.get $vpos1))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $ba1))))
+      (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
       (local.set $d2
-         (struct.get $bigarray $ba_data (ref.cast $bigarray (local.get $ba2))))
-      (local.set $pos2 (i31.get_s (ref.cast i31 (local.get $vpos2))))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+         (struct.get $bigarray $ba_data
+            (ref.cast (ref $bigarray) (local.get $ba2))))
+      (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (call $ta_set (local.get $d2)
          (call $ta_subarray (local.get $d1)
             (local.get $pos1) (i32.add (local.get $pos1) (local.get $len)))
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 847183ed19..9e01f8ddeb 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -224,8 +224,10 @@
                      (br_on_cast_fail $v2_not_forward (ref eq) (ref $block)
                         (local.get $v2)))
                   (local.set $t2
-                     (i31.get_u (ref.cast i31 (array.get $block (local.get $b2)
-                                                 (i32.const 0)))))
+                     (i31.get_u
+                        (ref.cast (ref i31)
+                           (array.get $block (local.get $b2)
+                              (i32.const 0)))))
                   (if (i32.eq (local.get $t2) (global.get $forward_tag))
                      (then
                         (local.set $v2
@@ -247,7 +249,7 @@
                      (return (local.get $res)))))
                ;; v1 long < v2 block
                (return (i32.const -1))))
-            (if (ref.test i31 (local.get $v2))
+            (if (ref.test (ref i31) (local.get $v2))
                (then
                   ;; check for forward tag
                   (drop (block $v1_not_forward (result (ref eq))
@@ -255,7 +257,7 @@
                         (br_on_cast_fail $v1_not_forward (ref eq) (ref $block)
                            (local.get $v1)))
                      (local.set $t1
-                        (i31.get_u (ref.cast i31
+                        (i31.get_u (ref.cast (ref i31)
                                       (array.get $block (local.get $b1)
                                          (i32.const 0)))))
                      (if (i32.eq (local.get $t1) (global.get $forward_tag))
@@ -287,14 +289,14 @@
                         (local.get $v1)))
                   (local.set $t1
                      (i31.get_u
-                        (ref.cast i31
+                        (ref.cast (ref i31)
                            (array.get $block (local.get $b1) (i32.const 0)))))
                   (local.set $b2
                      (br_on_cast_fail $heterogeneous (ref eq) (ref $block)
                         (local.get $v2)))
                   (local.set $t2
                      (i31.get_u
-                        (ref.cast i31
+                        (ref.cast (ref i31)
                            (array.get $block (local.get $b2) (i32.const 0)))))
                   (drop (br_if $heterogeneous (i31.new (i32.const 0))
                      (i32.ne (local.get $t1) (local.get $t2))))
@@ -316,8 +318,9 @@
                            (ref.eq (local.get $v1) (local.get $v2)))
                         (return
                            (i32.sub
-                              (i31.get_s (ref.cast i31 (local.get $v1)))
-                              (i31.get_s (ref.cast i31 (local.get $v2)))))))
+                              (i31.get_s (ref.cast (ref i31) (local.get $v1)))
+                              (i31.get_s
+                                 (ref.cast (ref i31) (local.get $v2)))))))
                   (local.set $s1 (array.len (local.get $b1)))
                   (local.set $s2 (array.len (local.get $b2)))
                   ;; compare size first
@@ -332,12 +335,12 @@
                               (then
                                  (local.set $f1
                                     (struct.get $float 0
-                                       (ref.cast $float
+                                       (ref.cast (ref $float)
                                           (array.get $block (local.get $b1)
                                              (local.get $i)))))
                                  (local.set $f2
                                     (struct.get $float 0
-                                       (ref.cast $float
+                                       (ref.cast (ref $float)
                                           (array.get $block (local.get $b2)
                                           (local.get $i)))))
                                  (if (f64.lt (local.get $f1) (local.get $f2))
@@ -416,7 +419,7 @@
                      (then
                         (return
                            (i31.get_s
-                              (ref.cast i31
+                              (ref.cast (ref i31)
                                  (call $caml_string_compare
                                     (struct.get $custom_operations $cust_id
                                        (struct.get $custom 0
@@ -465,10 +468,11 @@
                            (call $equals (local.get $js1) (local.get $js2)))
                         (return (global.get $unordered))))
                   (br $heterogeneous (i31.new (i32.const 0)))))
-               (if (ref.test $closure (local.get $v1))
+               (if (ref.test (ref $closure) (local.get $v1))
                   (then
                      (drop (br_if $heterogeneous (i31.new (i32.const 0))
-                              (i32.eqz (ref.test $closure (local.get $v2)))))
+                              (i32.eqz
+                                 (ref.test (ref $closure) (local.get $v2)))))
                      (call $clear_compare_stack)
                      (call $caml_invalid_argument
                         (array.new_data $string $functional_value
@@ -485,19 +489,21 @@
                (i31.new (i32.const 0)))) ;; fall through
             ;; heterogeneous comparison
             (local.set $t1
-               (i31.get_u (ref.cast i31 (call $caml_obj_tag (local.get $v1)))))
+               (i31.get_u
+                  (ref.cast (ref i31) (call $caml_obj_tag (local.get $v1)))))
             (local.set $t2
-               (i31.get_u (ref.cast i31 (call $caml_obj_tag (local.get $v2)))))
+               (i31.get_u
+                  (ref.cast (ref i31) (call $caml_obj_tag (local.get $v2)))))
             (if (i32.eq (local.get $t1) (global.get $forward_tag))
                (then
                   (local.set $v1
-                     (array.get $block (ref.cast $block (local.get $v1))
+                     (array.get $block (ref.cast (ref $block) (local.get $v1))
                         (i32.const 1)))
                   (br $loop)))
             (if (i32.eq (local.get $t2) (global.get $forward_tag))
                (then
                   (local.set $v2
-                     (array.get $block (ref.cast $block (local.get $v2))
+                     (array.get $block (ref.cast (ref $block) (local.get $v2))
                         (i32.const 1)))
                   (br $loop)))
             (local.set $res (i32.sub (local.get $t1) (local.get $t2)))
diff --git a/runtime/wasm/custom.wat b/runtime/wasm/custom.wat
index 4f04fa57f6..d38d844c4e 100644
--- a/runtime/wasm/custom.wat
+++ b/runtime/wasm/custom.wat
@@ -25,17 +25,17 @@
       (local $i1 i64) (local $i2 i64)
       (local.set $i1
          (struct.get $custom_with_id $id
-            (ref.cast $custom_with_id (local.get 0))))
+            (ref.cast (ref $custom_with_id) (local.get 0))))
       (local.set $i2
          (struct.get $custom_with_id $id
-            (ref.cast $custom_with_id (local.get 1))))
+            (ref.cast (ref $custom_with_id) (local.get 1))))
       (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
                (i64.lt_s (local.get $i1) (local.get $i2))))
 
    (func (export "custom_hash_id") (param (ref eq)) (result i32)
       (i32.wrap_i64
          (struct.get $custom_with_id $id
-           (ref.cast $custom_with_id (local.get 0)))))
+           (ref.cast (ref $custom_with_id) (local.get 0)))))
 
    (global $next_id (mut i64) (i64.const 0))
 
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index b3e57b02ca..9dcb507d81 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -9,7 +9,7 @@
       (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
       (result (ref eq))
       (local $b (ref $block))
-      (local.set $b (ref.cast $block (local.get $ref)))
+      (local.set $b (ref.cast (ref $block) (local.get $ref)))
       (if (result (ref eq))
          (ref.eq (array.get $block (local.get $b) (i32.const 1))
                  (local.get $o))
@@ -20,30 +20,30 @@
             (i31.new (i32.const 0)))))
 
    (func (export "caml_atomic_load") (param (ref eq)) (result (ref eq))
-      (array.get $block (ref.cast $block (local.get 0)) (i32.const 1)))
+      (array.get $block (ref.cast (ref $block) (local.get 0)) (i32.const 1)))
 
    (func (export "caml_atomic_fetch_add")
       (param $ref (ref eq)) (param $i (ref eq)) (result (ref eq))
       (local $b (ref $block))
       (local $old (ref eq))
-      (local.set $b (ref.cast $block (local.get $ref)))
+      (local.set $b (ref.cast (ref $block) (local.get $ref)))
       (local.set $old (array.get $block (local.get $b) (i32.const 1)))
       (array.set $block (local.get $b) (i32.const 1)
-         (i31.new (i32.add (i31.get_s (ref.cast i31 (local.get $old)))
-                           (i31.get_s (ref.cast i31 (local.get $i))))))
+         (i31.new (i32.add (i31.get_s (ref.cast (ref i31) (local.get $old)))
+                           (i31.get_s (ref.cast (ref i31) (local.get $i))))))
       (local.get $old))
 
    (func (export "caml_atomic_exchange")
       (param $ref (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $b (ref $block))
       (local $r (ref eq))
-      (local.set $b (ref.cast $block (local.get $ref)))
+      (local.set $b (ref.cast (ref $block) (local.get $ref)))
       (local.set $r (array.get $block (local.get $b) (i32.const 1)))
       (array.set $block (local.get $b) (i32.const 1) (local.get $v))
       (local.get $r))
 
    (global $caml_domain_dls (mut (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (func (export "caml_domain_dls_set") (param $a (ref eq)) (result (ref eq))
       (global.set $caml_domain_dls (local.get $a))
@@ -53,7 +53,7 @@
       (global.get $caml_domain_dls))
 
    (global $caml_ml_domain_unique_token (ref eq)
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (func (export "caml_ml_domain_unique_token")
       (param (ref eq)) (result (ref eq))
@@ -79,7 +79,8 @@
       (local.set $old (global.get $caml_domain_id))
       (drop (call_ref $function_1 (i31.new (i32.const 0))
                (local.get $f)
-                  (struct.get $closure 0 (ref.cast $closure (local.get $f)))))
+                  (struct.get $closure 0
+                     (ref.cast (ref $closure) (local.get $f)))))
       (global.set $caml_domain_id (local.get $old))
       (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
       (i31.new (local.get $id)))
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index ec61b19d92..f80d6ae155 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -31,7 +31,7 @@
       (local $f (ref eq))
       (return_call_ref $function_1 (struct.get $pair 1 (local.get $p))
          (local.tee $f (struct.get $pair 0 (local.get $p)))
-         (struct.get $closure 0 (ref.cast $closure (local.get $f)))))
+         (struct.get $closure 0 (ref.cast (ref $closure) (local.get $f)))))
 
    ;; Low-level primitives
 
@@ -65,12 +65,12 @@
    (func $invoke_promise_resolver (param $p (ref $pair)) (param (ref eq))
       (call $resume_fiber
          (struct.get $cont_resume $cont_resolver
-            (ref.cast $cont_resume (local.get 1)))
+            (ref.cast (ref $cont_resume) (local.get 1)))
          (local.get $p)))
 
    (func $apply_continuation (param $resolver (ref extern)) (param $v (ref eq))
       (local $t (ref $thunk))
-      (local.set $t (ref.cast $thunk (local.get $v)))
+      (local.set $t (ref.cast (ref $thunk) (local.get $v)))
       (return_call_ref $called_with_continuation
          (struct.new $cont_resume
             (ref.func $invoke_promise_resolver) (local.get $resolver))
@@ -82,7 +82,7 @@
       (param $v (ref eq))
       (result (ref eq))
       (return_call $apply_pair
-         (ref.cast $pair
+         (ref.cast (ref $pair)
             (call $suspend_fiber
                (global.get $current_suspender)
                (ref.func $apply_continuation)
@@ -112,7 +112,7 @@
                   (string.const "Effect.Unhandled")))
             (local.get $eff)))
       (call $caml_raise_constant
-         (array.new_fixed $block (i31.new (i32.const 248))
+         (array.new_fixed $block 3 (i31.new (i32.const 248))
             (array.new_data $string $effect_unhandled
                (i32.const 0) (i32.const 16))
             (call $caml_fresh_oo_id (i31.new (i32.const 0)))))
@@ -126,8 +126,8 @@
          (call $push_stack
             (ref.as_non_null
                (struct.get $continuation 0
-                  (ref.cast $continuation (local.get $cont))))
-            (ref.cast $cont (local.get $k))))
+                  (ref.cast (ref $continuation) (local.get $cont))))
+            (ref.cast (ref $cont) (local.get $k))))
       (call_ref $cont_func
          (struct.new $pair
             (struct.new $closure (ref.func $raise_unhandled))
@@ -144,7 +144,7 @@
 
    (global $fiber_stack (mut (ref null $fiber))
       (struct.new $fiber
-         (array.new_fixed $handlers
+         (array.new_fixed $handlers 3
             (i31.new (i32.const 0))
             (i31.new (i32.const 0))
             (struct.new $closure_3
@@ -192,9 +192,10 @@
    (func $do_resume (param $k (ref $cont)) (param $vp (ref eq))
       (local $p (ref $pair))
       (local $stack (ref $fiber))
-      (local.set $p (ref.cast $pair (local.get $vp)))
-      (local.set $stack (ref.cast $fiber (struct.get $pair 0 (local.get $p))))
-      (local.set $p (ref.cast $pair (struct.get $pair 1 (local.get $p))))
+      (local.set $p (ref.cast (ref $pair) (local.get $vp)))
+      (local.set $stack
+         (ref.cast (ref $fiber) (struct.get $pair 0 (local.get $p))))
+      (local.set $p (ref.cast (ref $pair) (struct.get $pair 1 (local.get $p))))
       (local.set $k (call $push_stack (local.get $stack) (local.get $k)))
       (call_ref $cont_func (local.get $p) (local.get $k)
          (struct.get $cont $cont_func (local.get $k))))
@@ -230,13 +231,13 @@
       (param $k (ref eq)) (param $venv (ref eq)) (result (ref eq))
       (local $env (ref $call_handler_env))
       (local $handler (ref $closure_3))
-      (local.set $env (ref.cast $call_handler_env (local.get $venv)))
+      (local.set $env (ref.cast (ref $call_handler_env) (local.get $venv)))
       (return_call_ref $function_3
          (struct.get $call_handler_env $eff (local.get $env))
          (struct.get $call_handler_env $cont (local.get $env))
          (local.get $k)
          (local.tee $handler
-            (ref.cast $closure_3
+            (ref.cast (ref $closure_3)
               (struct.get $call_handler_env $handler (local.get $env))))
          (struct.get $closure_3 1 (local.get $handler))))
 
@@ -246,10 +247,10 @@
       (local $handler (ref eq))
       (local $k1 (ref $cont))
       (local $p (ref $pair))
-      (local.set $p (ref.cast $pair (local.get $vp)))
+      (local.set $p (ref.cast (ref $pair) (local.get $vp)))
       (local.set $eff (struct.get $pair 0 (local.get $p)))
       (local.set $cont
-         (ref.cast $continuation (struct.get $pair 1 (local.get $p))))
+         (ref.cast (ref $continuation) (struct.get $pair 1 (local.get $p))))
       (local.set $handler
          (array.get $handlers
             (struct.get $fiber $fiber_handlers (global.get $fiber_stack))
@@ -310,7 +311,7 @@
             (do
                (try (result (ref eq))
                   (do
-                     (call $apply_pair (ref.cast $pair (local.get $p))))
+                     (call $apply_pair (ref.cast (ref $pair) (local.get $p))))
                   (catch $javascript_exception
                      (throw $ocaml_exception
                         (call $caml_wrap_exception (pop externref))))))
@@ -327,7 +328,7 @@
       (param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq))
       (result (ref eq))
       (struct.new $fiber
-         (array.new_fixed $handlers
+         (array.new_fixed $handlers 3
             (local.get $hv) (local.get $hx) (local.get $hf))
          (struct.new $cont (ref.func $initial_cont))
          (ref.null extern)
@@ -340,7 +341,7 @@
       (local $cont (ref $continuation))
       (local $stack (ref $fiber))
       (block $used
-         (local.set $cont (ref.cast $continuation (local.get 0)))
+         (local.set $cont (ref.cast (ref $continuation) (local.get 0)))
          (local.set $stack
             (br_on_null $used (struct.get $continuation 0 (local.get $cont))))
          (struct.set $continuation 0 (local.get $cont) (ref.null $fiber))
@@ -352,21 +353,21 @@
       (param $heff (ref eq)) (result (ref eq))
       (local $stack (ref $fiber))
       (local.set $stack
-         (ref.cast $fiber
+         (ref.cast (ref $fiber)
             (call $caml_continuation_use_noexc (local.get $cont))))
       (block $used
          (struct.set $fiber $fiber_handlers
             (br_on_null $used (local.get $stack))
-            (array.new_fixed $handlers
+            (array.new_fixed $handlers 3
                (local.get $hval) (local.get $hexn) (local.get $heff))))
       (local.get $stack))
 
    (func (export $caml_get_continuation_callstack)
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (func (export "caml_is_continuation") (param (ref eq)) (result i32)
-      (ref.test $continuation (local.get 0)))
+      (ref.test (ref $continuation) (local.get 0)))
 
    (func (export "caml_initialize_effects") (param $s externref)
       (global.set $current_suspender (local.get $s)))
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 1d7f8284f4..614273c5ee 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -15,7 +15,7 @@
    (func $caml_raise_with_arg (export "caml_raise_with_arg")
       (param $tag (ref eq)) (param $arg (ref eq))
       (throw $ocaml_exception
-         (array.new_fixed $block
+         (array.new_fixed $block 3
             (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
 
    (global $OUT_OF_MEMORY_EXN i32 (i32.const 0))
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index f425e18a3e..dcf91cf54b 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -21,15 +21,15 @@
    (type $chars (array i8))
 
    (global $infinity (ref $chars)
-      (array.new_fixed $chars
+      (array.new_fixed $chars 8
          (i32.const 105) (i32.const 110) (i32.const 102) (i32.const 105)
          (i32.const 110) (i32.const 105) (i32.const 116) (i32.const 121)))
 
    (global $nan (ref $chars)
-      (array.new_fixed $chars (i32.const 110) (i32.const 97) (i32.const 110)))
+      (array.new_fixed $chars 3 (i32.const 110) (i32.const 97) (i32.const 110)))
 
    (func (export "Double_val") (param (ref eq)) (result f64)
-      (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
 
    (func (export "caml_hexstring_of_float")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
@@ -38,11 +38,11 @@
       (local $i i32) (local $j i32) (local $d i32) (local $txt (ref $chars))
       (local $len i32) (local $s (ref $string))
       (local $unit i64) (local $half i64) (local $mask i64) (local $frac i64)
-      (local.set $prec (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $style (i31.get_s (ref.cast i31 (local.get 2))))
+      (local.set $prec (i31.get_s (ref.cast (ref i31) (local.get 1))))
+      (local.set $style (i31.get_s (ref.cast (ref i31) (local.get 2))))
       (local.set $b
          (i64.reinterpret_f64
-            (struct.get $float 0 (ref.cast $float (local.get 0)))))
+            (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
       (local.set $sign (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 63))))
       (local.set $exp
           (i32.and (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 52)))
@@ -237,7 +237,8 @@
          (local.get $uppercase)))
 
    (global $inf (ref $chars)
-      (array.new_fixed $chars (i32.const 105) (i32.const 110) (i32.const 102)))
+      (array.new_fixed $chars 3
+         (i32.const 105) (i32.const 110) (i32.const 102)))
 
    (func (export "caml_format_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
@@ -249,9 +250,10 @@
       (local $i i32) (local $len i32) (local $c i32)
       (local $s (ref $string)) (local $txt (ref $chars))
       (local $num (ref string))
-      (local.set $f (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (local.set $f (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
       (local.set $b (i64.reinterpret_f64 (local.get $f)))
-      (local.set $format (call $parse_format (ref.cast $string (local.get 0))))
+      (local.set $format
+         (call $parse_format (ref.cast (ref $string) (local.get 0))))
       (local.set $sign_style (tuple.extract 0 (local.get $format)))
       (local.set $precision (tuple.extract 1 (local.get $format)))
       (local.set $conversion (tuple.extract 2 (local.get $format)))
@@ -290,11 +292,11 @@
                (call $format_float
                   (local.get $precision) (local.get $conversion)
                   (f64.abs (local.get $f))))
-            (local.set $len (string.measure_wtf8 wtf8 (local.get $num)))
+            (local.set $len (string.measure_wtf8 (local.get $num)))
             (local.set $s
                (array.new $string (i32.const 0)
                   (i32.add (local.get $len) (local.get $i))))
-            (drop (string.encode_wtf8_array replace
+            (drop (string.encode_lossy_utf8_array
                      (local.get $num) (local.get $s) (local.get $i)))
             (br $sign (local.get $s))))
       (if (local.get $negative)
@@ -474,7 +476,7 @@
       (local $s' (ref $string))
       (local $negative i32) (local $c i32)
       (local $f f64)
-      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
       (local.set $len (array.len (local.get $s)))
       (loop $count
          (if (i32.lt_u (local.get $i) (local.get $len))
@@ -641,8 +643,8 @@
    (func (export "caml_nextafter_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $x f64) (local $y f64) (local $i i64) (local $j i64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
       (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
       (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
       (if (f64.eq (local.get $x) (local.get $y))
@@ -664,7 +666,7 @@
    (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
       (local $a f64)
       (local.set $a
-         (f64.abs (struct.get $float 0 (ref.cast $float (local.get 0)))))
+         (f64.abs (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
       (i31.new
          (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
             (then
@@ -681,7 +683,7 @@
 
    (func (export "caml_modf_float") (param (ref eq)) (result (ref eq))
       (local $x f64) (local $a f64) (local $i f64) (local $f f64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
+      (local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
       (local.set $a (f64.abs (local.get $x)))
       (if (f64.ge (local.get $a) (f64.const 0))
          (then
@@ -697,7 +699,7 @@
          (else ;; zero or nan
             (local.set $i (local.get $x))
             (local.set $f (local.get $x))))
-      (array.new_fixed $block (i31.new (i32.const 0))
+      (array.new_fixed $block 3 (i31.new (i32.const 0))
          (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
 
    (func $ldexp (param $x f64) (param $n i32) (result f64)
@@ -733,8 +735,9 @@
    (func (export "caml_ldexp_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (struct.new $float
-         (call $ldexp (struct.get $float 0 (ref.cast $float (local.get 0)))
-            (i31.get_s (ref.cast i31 (local.get 1))))))
+         (call $ldexp
+            (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))
+            (i31.get_s (ref.cast (ref i31) (local.get 1))))))
 
    (func $frexp (param $x f64) (result f64 i32)
       (local $y i64)
@@ -769,8 +772,9 @@
    (func (export "caml_frexp_float") (param (ref eq)) (result (ref eq))
       (local $r (f64 i32))
       (local.set $r
-         (call $frexp (struct.get $float 0 (ref.cast $float (local.get 0)))))
-      (array.new_fixed $block (i31.new (i32.const 0))
+         (call $frexp
+            (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
+      (array.new_fixed $block 3 (i31.new (i32.const 0))
          (struct.new $float (tuple.extract 0 (local.get $r)))
          (i31.new (tuple.extract 1 (local.get $r)))))
 
@@ -779,7 +783,7 @@
          (i32.wrap_i64
             (i64.shr_u
                (i64.reinterpret_f64
-                  (struct.get $float 0 (ref.cast $float (local.get 0))))
+                  (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
                (i64.const 63)))))
 
    (func $erf (param $x f64) (result f64)
@@ -821,12 +825,14 @@
 
    (func (export "caml_erf_float") (param (ref eq)) (result (ref eq))
       (struct.new $float
-         (call $erf (struct.get $float 0 (ref.cast $float (local.get 0))))))
+         (call $erf
+            (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))))
 
    (func (export "caml_erfc_float") (param (ref eq)) (result (ref eq))
       (struct.new $float
          (f64.sub (f64.const 1)
-            (call $erf (struct.get $float 0 (ref.cast $float (local.get 0)))))))
+            (call $erf
+               (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))))
 
    (func (export "caml_fma_float")
       (param $x (ref eq)) (param $y (ref eq)) (param $z (ref eq))
@@ -834,15 +840,16 @@
       ;; ZZZ not accurate
       (struct.new $float
          (f64.add
-            (f64.mul (struct.get $float 0 (ref.cast $float (local.get $x)))
-                     (struct.get $float 0 (ref.cast $float (local.get $y))))
-            (struct.get $float 0 (ref.cast $float (local.get $z))))))
+            (f64.mul
+               (struct.get $float 0 (ref.cast (ref $float) (local.get $x)))
+               (struct.get $float 0 (ref.cast (ref $float) (local.get $y))))
+            (struct.get $float 0 (ref.cast (ref $float) (local.get $z))))))
 
    (func (export "caml_float_compare")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $x f64) (local $y f64)
-      (local.set $x (struct.get $float 0 (ref.cast $float (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast $float (local.get 1))))
+      (local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
+      (local.set $y (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
       (i31.new
          (i32.add
             (i32.sub (f64.gt (local.get $x) (local.get $y))
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index a33157d1b9..481c59da5c 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -62,7 +62,7 @@
    (func $caml_raise_no_such_file (param $vname (ref eq))
       (local $name (ref $string)) (local $msg (ref $string))
       (local $len i32)
-      (local.set $name (ref.cast $string (local.get $vname)))
+      (local.set $name (ref.cast (ref $string) (local.get $vname)))
       (local.set $len (array.len (local.get $name)))
       (local.set $msg
          (array.new $string (i32.const 0)
diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat
index 44d48b1021..8dac52a4f1 100644
--- a/runtime/wasm/gc.wat
+++ b/runtime/wasm/gc.wat
@@ -19,7 +19,7 @@
    (func (export "caml_gc_counters") (param (ref eq)) (result (ref eq))
       (local $f (ref eq))
       (local.set $f (struct.new $float (f64.const 0)))
-      (array.new_fixed $block (i31.new (i32.const 0))
+      (array.new_fixed $block 4 (i31.new (i32.const 0))
          (local.get $f) (local.get $f) (local.get $f)))
 
    (export "caml_gc_quick_stat" (func $caml_gc_stat))
@@ -27,7 +27,7 @@
       (param (ref eq)) (result (ref eq))
       (local $f (ref eq))
       (local.set $f (struct.new $float (f64.const 0)))
-      (array.new_fixed $block (i31.new (i32.const 0))
+      (array.new_fixed $block 18 (i31.new (i32.const 0))
          (local.get $f) (local.get $f) (local.get $f)
          (i31.new (i32.const 0)) (i31.new (i32.const 0))
          (i31.new (i32.const 0)) (i31.new (i32.const 0))
@@ -41,7 +41,7 @@
       (i31.new (i32.const 0)))
 
    (func (export "caml_gc_get") (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block
+      (array.new_fixed $block 12
          (i31.new (i32.const 0)) (i31.new (i32.const 0))
          (i31.new (i32.const 0)) (i31.new (i32.const 0))
          (i31.new (i32.const 0)) (i31.new (i32.const 0))
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index f4c17608da..aa70d0fad8 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -132,7 +132,7 @@
    (func $caml_hash_mix_jsstring
       (param $h i32) (param $s (ref eq)) (result i32)
       (return_call $caml_hash_mix_int (local.get $h)
-         (string.hash (ref.cast string (call $unwrap (local.get $s))))))
+         (string.hash (ref.cast (ref string) (call $unwrap (local.get $s))))))
 
    (global $HASH_QUEUE_SIZE i32 (i32.const 256))
    (global $MAX_FORWARD_DEREFERENCE i32 (i32.const 1000))
@@ -151,11 +151,11 @@
       (local $len i32)
       (local $tag i32)
       (local $str anyref)
-      (local.set $sz (i31.get_u (ref.cast i31 (local.get $limit))))
+      (local.set $sz (i31.get_u (ref.cast (ref i31) (local.get $limit))))
       (if (i32.gt_u (local.get $sz) (global.get $HASH_QUEUE_SIZE))
          (then (local.set $sz (global.get $HASH_QUEUE_SIZE))))
-      (local.set $num (i31.get_u (ref.cast i31 (local.get $count))))
-      (local.set $h (i31.get_s (ref.cast i31 (local.get $seed))))
+      (local.set $num (i31.get_u (ref.cast (ref i31) (local.get $count))))
+      (local.set $h (i31.get_s (ref.cast (ref i31) (local.get $seed))))
       (array.set $block
          (global.get $caml_hash_queue) (i32.const 0) (local.get $obj))
       (local.set $rd (i32.const 0))
@@ -195,7 +195,7 @@
                            (local.get $v)))
                      (local.set $tag
                         (i31.get_u
-                           (ref.cast i31
+                           (ref.cast (ref i31)
                               (array.get $block (local.get $b) (i32.const 0)))))
                      (if (i32.eq (local.get $tag) (global.get $forward_tag))
                         (then
@@ -228,7 +228,7 @@
                            (local.set $h
                               (call $caml_hash_mix_int (local.get $h)
                                  (i31.get_s
-                                    (ref.cast i31
+                                    (ref.cast (ref i31)
                                        (array.get $block
                                           (local.get $b) (i32.const 2))))))
                            (br $loop)))
@@ -296,7 +296,7 @@
          (i32.and
             (call $caml_hash_mix_final
                (call $caml_hash_mix_string
-                  (i31.get_s (ref.cast i31 (local.get 0)))
-                  (ref.cast $string (local.get 1))))
+                  (i31.get_s (ref.cast (ref i31) (local.get 0)))
+                  (ref.cast (ref $string) (local.get 1))))
             (i32.const 0x3FFFFFFF))))
 )
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 62a4a02b26..0b66c65e28 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -23,7 +23,7 @@
 
    (global $int32_ops (export "int32_ops") (ref $custom_operations)
       (struct.new $custom_operations
-         (array.new_fixed $string (i32.const 95) (i32.const 105)) ;; "_i"
+         (array.new_fixed $string 2 (i32.const 95) (i32.const 105)) ;; "_i"
          (ref.func $int32_cmp)
          (ref.null $value->value->int->int)
          (ref.func $int32_hash)))
@@ -34,13 +34,15 @@
    (func $int32_cmp
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param i32) (result i32)
       (local $i1 i32) (local $i2 i32)
-      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get $v1))))
-      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get $v2))))
+      (local.set $i1
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v1))))
+      (local.set $i2
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v2))))
       (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
                (i32.lt_s (local.get $i1) (local.get $i2))))
 
    (func $int32_hash (param $v (ref eq)) (result i32)
-      (struct.get $int32 1 (ref.cast $int32 (local.get $v))))
+      (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
 
    (func $caml_copy_int32 (export "caml_copy_int32")
       (param $i i32) (result (ref eq))
@@ -48,11 +50,11 @@
 
    (export "Nativeint_val" (func $Int32_val))
    (func $Int32_val (export "Int32_val") (param (ref eq)) (result i32)
-      (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
+      (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
 
    (func (export "caml_int32_bswap") (param (ref eq)) (result (ref eq))
       (local $i i32)
-      (local.set $i (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
+      (local.set $i (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
       (return_call $caml_copy_int32
          (i32.or
             (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
@@ -61,7 +63,7 @@
                       (i32.const 8)))))
 
    (global $INT32_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Int32.of_string"
+      (array.new_fixed $string 15 ;; "Int32.of_string"
          (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 51)
          (i32.const 50) (i32.const 46) (i32.const 111) (i32.const 102)
          (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
@@ -76,14 +78,16 @@
    (func $caml_int32_compare (export "caml_int32_compare")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $i1 i32) (local $i2 i32)
-      (local.set $i1 (struct.get $int32 1 (ref.cast $int32 (local.get 0))))
-      (local.set $i2 (struct.get $int32 1 (ref.cast $int32 (local.get 1))))
+      (local.set $i1
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
+      (local.set $i2
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 1))))
       (i31.new (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
                         (i32.lt_s (local.get $i1) (local.get $i2)))))
 
    (global $nativeint_ops (export "nativeint_ops") (ref $custom_operations)
       (struct.new $custom_operations
-         (array.new_fixed $string (i32.const 95) (i32.const 110)) ;; "_n"
+         (array.new_fixed $string 2 (i32.const 95) (i32.const 110)) ;; "_n"
          (ref.func $int32_cmp)
          (ref.null $value->value->int->int)
          (ref.func $int32_hash)))
@@ -93,7 +97,7 @@
       (struct.new $int32 (global.get $nativeint_ops) (local.get $i)))
 
    (global $NATIVEINT_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Nativeint.of_string"
+      (array.new_fixed $string 16 ;; "Nativeint.of_string"
          (i32.const 78) (i32.const 97) (i32.const 116) (i32.const 105)
          (i32.const 118) (i32.const 101) (i32.const 46) (i32.const 111)
          (i32.const 102) (i32.const 95) (i32.const 115) (i32.const 116)
@@ -109,13 +113,14 @@
    (func $caml_int32_format (export "caml_int32_format")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (return_call $format_int (local.get 0)
-         (struct.get $int32 1 (ref.cast $int32 (local.get 1))) (i32.const 0)))
+         (struct.get $int32 1
+            (ref.cast (ref $int32) (local.get 1))) (i32.const 0)))
 
    (func (export "caml_nativeint_of_int32") (param (ref eq)) (result (ref eq))
       (return_call $caml_copy_nativeint
-         (struct.get $int32 1 (ref.cast $int32 (local.get 0)))))
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0)))))
 
    (func (export "caml_nativeint_to_int32") (param (ref eq)) (result (ref eq))
       (return_call $caml_copy_int32
-         (struct.get $int32 1 (ref.cast $int32 (local.get 0)))))
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0)))))
 )
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 48d7b58277..b0c65b2c77 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -26,7 +26,7 @@
 
    (global $int64_ops (export "int64_ops") (ref $custom_operations)
       (struct.new $custom_operations
-         (array.new_fixed $string (i32.const 95) (i32.const 106)) ;; "_j"
+         (array.new_fixed $string 2 (i32.const 95) (i32.const 106)) ;; "_j"
          (ref.func $int64_cmp)
          (ref.null $value->value->int->int)
          (ref.func $int64_hash)))
@@ -37,14 +37,17 @@
    (func $int64_cmp
       (param $v1 (ref eq)) (param $v2 (ref eq)) (param i32) (result i32)
       (local $i1 i64) (local $i2 i64)
-      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get $v1))))
-      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get $v2))))
+      (local.set $i1
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v1))))
+      (local.set $i2
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v2))))
       (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
                (i64.lt_s (local.get $i1) (local.get $i2))))
 
    (func $int64_hash (param $v (ref eq)) (result i32)
       (local $i i64)
-      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get $v))))
+      (local.set $i
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
       (i32.xor
          (i32.wrap_i64 (local.get $i))
          (i32.wrap_i64 (i64.shr_u (local.get $i) (i64.const 32)))))
@@ -54,11 +57,11 @@
       (struct.new $int64 (global.get $int64_ops) (local.get $i)))
 
    (func (export "Int64_val") (param (ref eq)) (result i64)
-      (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
+      (struct.get $int64 1 (ref.cast (ref $int64) (local.get 0))))
 
    (func (export "caml_int64_bswap") (param (ref eq)) (result (ref eq))
       (local $i i64)
-      (local.set $i (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
+      (local.set $i (struct.get $int64 1 (ref.cast (ref $int64) (local.get 0))))
       (return_call $caml_copy_int64
          (i64.or
             (i64.or
@@ -75,13 +78,15 @@
    (func (export "caml_int64_compare")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $i1 i64) (local $i2 i64)
-      (local.set $i1 (struct.get $int64 1 (ref.cast $int64 (local.get 0))))
-      (local.set $i2 (struct.get $int64 1 (ref.cast $int64 (local.get 1))))
+      (local.set $i1
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get 0))))
+      (local.set $i2
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get 1))))
       (i31.new (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
                         (i64.lt_s (local.get $i1) (local.get $i2)))))
 
    (global $INT64_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Int64.of_string"
+      (array.new_fixed $string 15 ;; "Int64.of_string"
          (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 54)
          (i32.const 52) (i32.const 46) (i32.const 111) (i32.const 102)
          (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
@@ -93,7 +98,7 @@
       (local $signedness i32) (local $sign i32) (local $base i32)
       (local $res i64) (local $threshold i64)
       (local $t (i32 i32 i32 i32))
-      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $len (array.len (local.get $s)))
       (if (i32.eqz (local.get $len))
         (then (call $caml_failwith (global.get $INT64_ERRMSG))))
@@ -195,8 +200,8 @@
       (local $i i32)
       (local $n i64)
       (local $chars (ref $chars))
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $d (struct.get $int64 1 (ref.cast $int64 (local.get 1))))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
+      (local.set $d (struct.get $int64 1 (ref.cast (ref $int64) (local.get 1))))
       (if (i32.eq (array.len (local.get $s)) (i32.const 2))
          (then
             (if (i32.eq (array.get_u $string (local.get $s) (i32.const 1))
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index eb2608b6df..bd2dc1ffd2 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -8,7 +8,8 @@
    (func (export "caml_format_int")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (return_call $format_int
-         (local.get 0) (i31.get_s (ref.cast i31 (local.get 1))) (i32.const 1)))
+         (local.get 0)
+         (i31.get_s (ref.cast (ref i31) (local.get 1))) (i32.const 1)))
 
    (func $parse_sign_and_base (export "parse_sign_and_base")
       (param $s (ref $string)) (result i32 i32 i32 i32)
@@ -83,7 +84,7 @@
       (local $signedness i32) (local $sign i32) (local $base i32)
       (local $res i32) (local $threshold i32)
       (local $t (i32 i32 i32 i32))
-      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $len (array.len (local.get $s)))
       (if (i32.eqz (local.get $len))
         (then (call $caml_failwith (local.get $errmsg))))
@@ -138,7 +139,7 @@
       (local.get $res))
 
    (global $INT_ERRMSG (ref $string)
-      (array.new_fixed $string ;; "Int.of_string"
+      (array.new_fixed $string 13 ;; "Int.of_string"
          (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 46)
          (i32.const 111) (i32.const 102) (i32.const 95) (i32.const 115)
          (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110)
@@ -152,7 +153,7 @@
 
    (func (export "caml_bswap16") (param (ref eq)) (result (ref eq))
       (local $x i32)
-      (local.set $x (i31.get_s (ref.cast i31 (local.get 0))))
+      (local.set $x (i31.get_s (ref.cast (ref i31) (local.get 0))))
       (i31.new
          (i32.or
             (i32.shl (i32.and (local.get $x) (i32.const 0xFF)) (i32.const 8))
@@ -162,14 +163,14 @@
    (type $chars (array i8))
 
    (global $lowercase_hex_table (export "lowercase_hex_table") (ref $chars)
-      (array.new_fixed $chars
+      (array.new_fixed $chars 16
          (i32.const 48) (i32.const 49) (i32.const 50) (i32.const 51)
          (i32.const 52) (i32.const 53) (i32.const 54) (i32.const 55)
          (i32.const 56) (i32.const 57) (i32.const 97) (i32.const 98)
          (i32.const 99) (i32.const 100) (i32.const 101) (i32.const 102)))
 
    (global $uppercase_hex_table (export "uppercase_hex_table") (ref $chars)
-      (array.new_fixed $chars
+      (array.new_fixed $chars 16
          (i32.const 48) (i32.const 49) (i32.const 50) (i32.const 51)
          (i32.const 52) (i32.const 53) (i32.const 54) (i32.const 55)
          (i32.const 56) (i32.const 57) (i32.const 65) (i32.const 66)
@@ -283,7 +284,7 @@
       (local $i i32)
       (local $n i32)
       (local $chars (ref $chars))
-      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
       (if (i32.eq (array.len (local.get $s)) (i32.const 2))
          (then
             (if (i32.eq (array.get_u $string (local.get $s) (i32.const 1))
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index f57902c6f6..380e8c6d9c 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -61,7 +61,7 @@
 
    (global $channel_ops (ref $custom_operations)
       (struct.new $custom_operations
-         (array.new_fixed $string ;; "_chan"
+         (array.new_fixed $string 5 ;; "_chan"
             (i32.const 95) (i32.const 99) (i32.const 104) (i32.const 97)
             (i32.const 110))
          (ref.func $custom_compare_id)
@@ -113,7 +113,7 @@
    ;; 32 O_EXCL
    ;; 64 O_NONBLOCK
    (global $sys_open_flags (ref $open_flags)
-      (array.new_fixed $open_flags
+      (array.new_fixed $open_flags 9
          (i32.const 1) (i32.const 2) (i32.const 6) (i32.const 8) (i32.const 16)
          (i32.const 32) (i32.const 0) (i32.const 0) (i32.const 64)))
 
@@ -128,7 +128,7 @@
                (i32.or (local.get $flags)
                   (array.get_u $open_flags (global.get $sys_open_flags)
                      (i31.get_u
-                        (ref.cast i31
+                        (ref.cast (ref i31)
                            (array.get $block
                               (local.get $cons) (i32.const 1)))))))
             (local.set $vflags
@@ -144,13 +144,13 @@
          (call $open
             (call $unwrap (call $caml_jsstring_of_string (local.get $path)))
             (call $convert_flag_list (local.get $flags))
-            (i31.get_u (ref.cast i31 (local.get $perm)))))
+            (i31.get_u (ref.cast (ref i31) (local.get $perm)))))
       ;; ZZZ initial offset is file size when appending
       (call $initialize_fd_offset (local.get $fd) (i64.const 0))
       (i31.new (local.get $fd)))
 
    (func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
-      (call $close (i31.get_u (ref.cast i31 (local.get 0))))
+      (call $close (i31.get_u (ref.cast (ref i31) (local.get 0))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_set_channel_name")
@@ -166,7 +166,7 @@
       (struct.new $channel
          (global.get $channel_ops)
          (call $custom_next_id)
-         (i31.get_u (ref.cast i31 (local.get $fd)))
+         (i31.get_u (ref.cast (ref i31) (local.get $fd)))
          (call $ta_new (global.get $IO_BUFFER_SIZE))
          (i32.const 0)
          (i32.const 0)
@@ -183,7 +183,7 @@
          (struct.new $channel
             (global.get $channel_ops)
             (call $custom_next_id)
-            (i31.get_u (ref.cast i31 (local.get $fd)))
+            (i31.get_u (ref.cast (ref i31) (local.get $fd)))
             (call $ta_new (global.get $IO_BUFFER_SIZE))
             (i32.const 0)
             (i32.const -1)
@@ -199,7 +199,7 @@
       (param (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
       (local $fd i32)
-      (local.set $ch (ref.cast $channel (local.get 0)))
+      (local.set $ch (ref.cast (ref $channel) (local.get 0)))
       (struct.set $channel $curr (local.get $ch) (i32.const 0))
       (struct.set $channel $max (local.get $ch) (i32.const 0))
       (struct.set $channel $size (local.get $ch) (i32.const 0))
@@ -220,10 +220,10 @@
       (local $fd i32)
       (local $buf (ref extern))
       (local $offset i64)
-      (local.set $ch (ref.cast $channel (local.get $vch)))
-      (local.set $s (ref.cast $string (local.get $vs)))
-      (local.set $pos (i31.get_u (ref.cast i31 (local.get $vpos))))
-      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (local.set $s (ref.cast (ref $string) (local.get $vs)))
+      (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
+      (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
       (local.set $buf (struct.get $channel $buffer (local.get $ch)))
       (local.set $curr (struct.get $channel $curr (local.get $ch)))
       (local.set $avail
@@ -298,12 +298,13 @@
    (func (export "caml_ml_seek_in")
       (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
-      (local.set $ch (ref.cast $channel (local.get $vch)))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       ;; ZZZ Check for error
       (array.set $offset_array
          (global.get $fd_offsets)
          (struct.get $channel $fd (local.get $ch))
-         (i64.extend_i32_s (i31.get_s (ref.cast i31 (local.get $voffset)))))
+         (i64.extend_i32_s
+            (i31.get_s (ref.cast (ref i31) (local.get $voffset)))))
       (struct.set $channel $curr (local.get $ch) (i32.const 0))
       (struct.set $channel $max (local.get $ch) (i32.const 0))
       (i31.new (i32.const 0)))
@@ -331,7 +332,8 @@
       (loop $loop
          (br_if $loop
             (i32.eqz
-               (call $caml_flush_partial (ref.cast $channel (local.get $ch))))))
+               (call $caml_flush_partial
+                  (ref.cast (ref $channel) (local.get $ch))))))
       (i31.new (i32.const 0)))
 
    (func $caml_flush_partial (param $ch (ref $channel)) (result i32)
@@ -394,14 +396,14 @@
       (param $ch (ref eq)) (param $s (ref eq)) (param $vpos (ref eq))
       (param $vlen (ref eq)) (result (ref eq))
       (local $pos i32) (local $len i32) (local $written i32)
-      (local.set $pos (i31.get_u (ref.cast i31 (local.get $vpos))))
-      (local.set $len (i31.get_u (ref.cast i31 (local.get $vlen))))
+      (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
+      (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
       (loop $loop
          (if (i32.gt_u (local.get $len) (i32.const 0))
             (then
                (local.set $written
-                  (call $caml_putblock (ref.cast $channel (local.get $ch))
-                     (ref.cast $string (local.get $s))
+                  (call $caml_putblock (ref.cast (ref $channel) (local.get $ch))
+                     (ref.cast (ref $string) (local.get $s))
                      (local.get $pos) (local.get $len)))
                (local.set $pos (i32.add (local.get $pos) (local.get $written)))
                (local.set $len (i32.sub (local.get $len) (local.get $written)))
@@ -414,7 +416,7 @@
       ;;(call $log_js (string.const "caml_ml_output_char"))
       (return_call $caml_ml_output (local.get 0)
          (array.new $string
-            (i31.get_u (ref.cast i31 (local.get 1))) (i32.const 1))
+            (i31.get_u (ref.cast (ref i31) (local.get 1))) (i32.const 1))
          (i31.new (i32.const 0)) (i31.new (i32.const 1))))
 
    (func (export "caml_output_value")
@@ -454,12 +456,13 @@
 
    (func $caml_ml_get_channel_fd (export "caml_ml_get_channel_fd")
       (param (ref eq)) (result i32)
-      (struct.get $channel $fd (ref.cast $channel (local.get 0))))
+      (struct.get $channel $fd (ref.cast (ref $channel) (local.get 0))))
 
    (func (export "caml_ml_set_channel_fd") (param (ref eq)) (param i32)
-      (struct.set $channel $fd (ref.cast $channel (local.get 0)) (local.get 1)))
+      (struct.set $channel $fd
+         (ref.cast (ref $channel) (local.get 0)) (local.get 1)))
 
    (func (export "caml_ml_get_channel_offset") (param (ref eq)) (result i64)
       (array.get $offset_array (global.get $fd_offsets)
-         (struct.get $channel $fd (ref.cast $channel (local.get 0)))))
+         (struct.get $channel $fd (ref.cast (ref $channel) (local.get 0)))))
 )
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 25714c446b..484b182195 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -2,8 +2,6 @@
    (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
    (import "bindings" "identity" (func $from_float (param f64) (result anyref)))
    (import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
-   (import "bindings" "identity"
-      (func $ref_cast_string (param anyref) (result (ref string))))
    (import "bindings" "from_bool" (func $from_bool (param i32) (result anyref)))
    (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
    (import "bindings" "get"
@@ -99,10 +97,10 @@
    (func $caml_js_expr (export "caml_js_expr")
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
-      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
       (return_call $wrap
          (call $eval
-            (string.new_wtf8_array replace
+            (string.new_lossy_utf8_array
                (local.get $s) (i32.const 0) (array.len (local.get $s))))))
 
    (func (export "caml_js_global") (param (ref eq)) (result (ref eq))
@@ -114,14 +112,15 @@
    (func (export "caml_js_from_float") (param (ref eq)) (result (ref eq))
       (return_call $wrap
          (call $from_float
-            (struct.get $float 0 (ref.cast $float (local.get 0))))))
+            (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))))
 
    (func (export "caml_js_to_bool") (param (ref eq)) (result (ref eq))
-      (i31.new (call $to_bool (struct.get $js 0 (ref.cast $js (local.get 0))))))
+      (i31.new
+         (call $to_bool (struct.get $js 0 (ref.cast (ref $js) (local.get 0))))))
 
    (func (export "caml_js_from_bool") (param (ref eq)) (result (ref eq))
       (struct.new $js
-         (call $from_bool (i31.get_s (ref.cast i31 (local.get 0))))))
+         (call $from_bool (i31.get_s (ref.cast (ref i31) (local.get 0))))))
 
   (func (export "caml_js_pure_expr")
      (param (ref eq)) (result (ref eq))
@@ -129,7 +128,7 @@
         (i31.new (i32.const 0))
         (local.get 0)
         (struct.get $closure 0
-           (ref.cast $closure (local.get 0)))))
+           (ref.cast (ref $closure) (local.get 0)))))
 
    (func (export "caml_js_fun_call")
       (param $f (ref eq)) (param $args (ref eq)) (result (ref eq))
@@ -148,7 +147,7 @@
    (func (export "caml_js_meth_call")
       (param $o (ref eq)) (param $f (ref eq)) (param $args (ref eq))
       (result (ref eq))
-      (if (ref.test $string (local.get $f))
+      (if (ref.test (ref $string) (local.get $f))
          (then
             (local.set $f (call $caml_jsbytes_of_string (local.get $f)))))
       (return_call $wrap
@@ -158,7 +157,7 @@
 
    (func (export "caml_js_get")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (if (ref.test $string (local.get 1))
+      (if (ref.test (ref $string) (local.get 1))
          (then
             (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (return_call $wrap
@@ -168,7 +167,7 @@
 
    (func (export "caml_js_set")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (if (ref.test $string (local.get 1))
+      (if (ref.test (ref $string) (local.get 1))
          (then
             (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (call $set (call $unwrap (local.get 0)) (call $unwrap (local.get 1))
@@ -177,7 +176,7 @@
 
    (func (export "caml_js_delete")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (if (ref.test $string (local.get 1))
+      (if (ref.test (ref $string) (local.get 1))
          (then
             (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (call $delete (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))
@@ -215,7 +214,7 @@
       (local $a (ref $block)) (local $p (ref $block))
       (local $i i32) (local $l i32)
       (local $o anyref)
-      (local.set $a (ref.cast $block (local.get 0)))
+      (local.set $a (ref.cast (ref $block) (local.get 0)))
       (local.set $l (array.len (local.get $a)))
       (local.set $i (i32.const 1))
       (local.set $o (call $new_obj))
@@ -223,7 +222,7 @@
          (if (i32.lt_u (local.get $i) (local.get $l))
             (then
                (local.set $p
-                  (ref.cast $block
+                  (ref.cast (ref $block)
                      (array.get $block (local.get $a) (local.get $i))))
                (call $set (local.get $o)
                   (call $unwrap
@@ -240,7 +239,7 @@
       (local $a (ref $block))
       (local $a' (ref extern))
       (local $i i32) (local $l i32)
-      (local.set $a (ref.cast $block (local.get 0)))
+      (local.set $a (ref.cast (ref $block) (local.get 0)))
       (local.set $l (i32.sub (array.len (local.get $a)) (i32.const 1)))
       (local.set $a' (call $new_array (local.get $l)))
       (local.set $i (i32.const 0))
@@ -308,7 +307,7 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (return_call $wrap
          (call $wrap_callback_strict
-            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+            (i31.get_u (ref.cast (ref i31) (local.get 0))) (local.get 1))))
 
    (func (export "caml_js_wrap_callback_unsafe")
       (param (ref eq)) (result (ref eq))
@@ -326,7 +325,7 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (return_call $wrap
          (call $wrap_meth_callback_strict
-            (i31.get_u (ref.cast i31 (local.get 0))) (local.get 1))))
+            (i31.get_u (ref.cast (ref i31) (local.get 0))) (local.get 1))))
 
    (func (export "caml_js_wrap_meth_callback_unsafe")
       (param (ref eq)) (result (ref eq))
@@ -355,10 +354,10 @@
                            (i31.new (local.get $i))))
                      (local.get $acc)
                      (struct.get $closure 0
-                        (ref.cast $closure (local.get $acc)))))
+                        (ref.cast (ref $closure) (local.get $acc)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop
-                  (i32.eqz (ref.test $closure_last_arg (local.get $f))))))
+                  (i32.eqz (ref.test (ref $closure_last_arg) (local.get $f))))))
          (else
             (local.set $i (i32.const 0))
             (drop (block $done (result (ref eq))
@@ -379,7 +378,7 @@
                (i31.new (i32.const 0))))
             (if (local.get $kind)
                (then
-                  (if (ref.test $closure (local.get $acc))
+                  (if (ref.test (ref $closure) (local.get $acc))
                      (then (local.set $acc
                               (call $caml_js_wrap_callback
                                  (local.get $acc)))))))))
@@ -389,9 +388,9 @@
    (func $caml_jsstring_of_string (export "caml_jsstring_of_string")
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
-      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
       (struct.new $js
-         (string.new_wtf8_array replace (local.get $s) (i32.const 0)
+         (string.new_lossy_utf8_array (local.get $s) (i32.const 0)
            (array.len (local.get $s)))))
 
    (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
@@ -399,7 +398,7 @@
       (local $s (ref $string))
       (local $s' (ref $string))
       (local $l i32) (local $i i32) (local $n i32) (local $c i32)
-      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
       (local.set $l (array.len (local.get $s)))
       (local.set $i (i32.const 0))
       (local.set $n (i32.const 0))
@@ -415,7 +414,7 @@
          (then
             (return
                (struct.new $js
-                  (string.new_wtf8_array utf8 (local.get $s) (i32.const 0)
+                  (string.new_utf8_array (local.get $s) (i32.const 0)
                      (local.get $i))))))
       (local.set $s'
          (array.new $string (i32.const 0)
@@ -444,7 +443,7 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $fill))))
       (struct.new $js
-         (string.new_wtf8_array utf8 (local.get $s') (i32.const 0)
+         (string.new_utf8_array (local.get $s') (i32.const 0)
             (local.get $n))))
 
    (export "caml_js_to_string" (func $caml_string_of_jsstring))
@@ -453,12 +452,12 @@
       (local $s (ref string))
       (local $l i32)
       (local $s' (ref $string))
-      ;; ZZZ ref.cast string not yet implemented by V8
       (local.set $s
-         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
-      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
+         (ref.cast (ref string)
+            (struct.get $js 0 (ref.cast (ref $js) (local.get 0)))))
+      (local.set $l (string.measure_wtf8 (local.get $s)))
       (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
-      (drop (string.encode_wtf8_array replace
+      (drop (string.encode_lossy_utf8_array
                (local.get $s) (local.get $s') (i32.const 0)))
       (local.get $s'))
 
@@ -467,12 +466,12 @@
       (local $s (ref string))
       (local $l i32) (local $i i32) (local $n i32) (local $c i32)
       (local $s' (ref $string)) (local $s'' (ref $string))
-      ;; ZZZ ref.cast string not yet implemented by V8
       (local.set $s
-         (call $ref_cast_string (struct.get $js 0 (ref.cast $js (local.get 0)))))
-      (local.set $l (string.measure_wtf8 wtf8 (local.get $s)))
+         (ref.cast (ref string)
+            (struct.get $js 0 (ref.cast (ref $js) (local.get 0)))))
+      (local.set $l (string.measure_wtf8 (local.get $s)))
       (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
-      (drop (string.encode_wtf8_array replace
+      (drop (string.encode_lossy_utf8_array
                (local.get $s) (local.get $s') (i32.const 0)))
       (local.set $i (i32.const 0))
       (local.set $n (i32.const 0))
@@ -559,7 +558,7 @@
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
                (local.set $l
-                  (array.new_fixed $block (i31.new (i32.const 0))
+                  (array.new_fixed $block 3 (i31.new (i32.const 0))
                      (call $wrap
                         (call $array_get (local.get $a) (local.get $i)))
                      (local.get $l)))
@@ -573,11 +572,11 @@
       ;; ZZZ special case for stack overflows?
       (block $undef
          (return
-            (array.new_fixed $block (i31.new (i32.const 0))
+            (array.new_fixed $block 3 (i31.new (i32.const 0))
                (br_on_null $undef
                   (call $caml_named_value (string.const "jsError")))
                (call $wrap (local.get $exn)))))
-      (array.new_fixed $block (i31.new (i32.const 0))
+      (array.new_fixed $block 3 (i31.new (i32.const 0))
          (call $caml_failwith_tag)
          (call $caml_string_of_jsstring
             (call $wrap
@@ -589,7 +588,7 @@
    (func (export "caml_js_error_option_of_exception")
       (param (ref eq)) (result (ref eq))
       (local $exn (ref $block))
-      (local.set $exn (ref.cast $block (local.get $0)))
+      (local.set $exn (ref.cast (ref $block) (local.get $0)))
       (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
                   (i31.new (i32.const 0)))
          (then
@@ -597,14 +596,14 @@
                    (call $caml_named_value (string.const "jsError")))
                (then
                   (return
-                     (array.new_fixed $block (i31.new (i32.const 0))
+                     (array.new_fixed $block 2 (i31.new (i32.const 0))
                         (array.get $block (local.get $exn) (i32.const 2))))))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_js_error_of_exception")
       (param (ref eq)) (result (ref eq))
       (local $exn (ref $block))
-      (local.set $exn (ref.cast $block (local.get $0)))
+      (local.set $exn (ref.cast (ref $block) (local.get $0)))
       (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
                   (i31.new (i32.const 0)))
          (then
diff --git a/runtime/wasm/lexing.wat b/runtime/wasm/lexing.wat
index f2f76d0926..509923c11b 100644
--- a/runtime/wasm/lexing.wat
+++ b/runtime/wasm/lexing.wat
@@ -6,7 +6,7 @@
 
    (func $get (param $a (ref eq)) (param $i i32) (result i32)
       (local $s (ref $string))
-      (local.set $s (ref.cast $string (local.get $a)))
+      (local.set $s (ref.cast (ref $string) (local.get $a)))
       (local.set $i (i32.add (local.get $i) (local.get $i)))
       (i32.extend16_s
          (i32.or (array.get_u $string (local.get $s) (local.get $i))
@@ -54,11 +54,12 @@
       (local $lex_check_code (ref $string))
       (local $lex_trans (ref $string))
       (local $lex_default (ref $string))
-      (local.set $tbl (ref.cast $block (local.get $vtbl)))
-      (local.set $lexbuf (ref.cast $block (local.get $vlexbuf)))
-      (local.set $state (i31.get_s (ref.cast i31 (local.get $start_state))))
+      (local.set $tbl (ref.cast (ref $block) (local.get $vtbl)))
+      (local.set $lexbuf (ref.cast (ref $block) (local.get $vlexbuf)))
+      (local.set $state
+         (i31.get_s (ref.cast (ref i31) (local.get $start_state))))
       (local.set $buffer
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $lexbuf) (global.get $lex_buffer))))
       (if (i32.ge_s (local.get $state) (i32.const 0))
          (then
@@ -73,22 +74,22 @@
          (else
             (local.set $state (i32.sub (i32.const -1) (local.get $state)))))
       (local.set $lex_base
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_base))))
       (local.set $lex_backtrk
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_backtrk))))
       (local.set $lex_check
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_check))))
       (local.set $lex_check_code
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_check_code))))
       (local.set $lex_trans
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_trans))))
       (local.set $lex_default
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_default))))
       (loop $loop
          (local.set $base (call $get (local.get $lex_base) (local.get $state)))
@@ -107,11 +108,11 @@
                   (i31.new (local.get $backtrk)))))
          (if (i32.ge_s
                 (i31.get_s
-                   (ref.cast i31
+                   (ref.cast (ref i31)
                       (array.get $block (local.get $lexbuf)
                          (global.get $lex_curr_pos))))
                 (i31.get_s
-                   (ref.cast i31
+                   (ref.cast (ref i31)
                       (array.get $block (local.get $lexbuf)
                          (global.get $lex_buffer_len)))))
             (then
@@ -127,7 +128,7 @@
             (else
                (local.set $pos
                   (i31.get_u
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $lexbuf)
                            (global.get $lex_curr_pos)))))
                (local.set $c
@@ -172,7 +173,7 @@
       (local $dst i32) (local $src i32)
       (local $mem (ref $block))
       (local.set $mem
-         (ref.cast $block
+         (ref.cast (ref $block)
             (array.get $block (local.get $lexbuf) (global.get $lex_mem))))
       (loop $loop
          (local.set $dst (array.get_u $string (local.get $s) (local.get $i)))
@@ -220,11 +221,12 @@
       (local $lex_trans_code (ref $string))
       (local $lex_default (ref $string))
       (local $lex_default_code (ref $string))
-      (local.set $tbl (ref.cast $block (local.get $vtbl)))
-      (local.set $lexbuf (ref.cast $block (local.get $vlexbuf)))
-      (local.set $state (i31.get_s (ref.cast i31 (local.get $start_state))))
+      (local.set $tbl (ref.cast (ref $block) (local.get $vtbl)))
+      (local.set $lexbuf (ref.cast (ref $block) (local.get $vlexbuf)))
+      (local.set $state
+         (i31.get_s (ref.cast (ref i31) (local.get $start_state))))
       (local.set $buffer
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $lexbuf) (global.get $lex_buffer))))
       (if (i32.ge_s (local.get $state) (i32.const 0))
          (then
@@ -239,37 +241,37 @@
          (else
             (local.set $state (i32.sub (i32.const -1) (local.get $state)))))
       (local.set $lex_code
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_code))))
       (local.set $lex_base
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_base))))
       (local.set $lex_base_code
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_base_code))))
       (local.set $lex_backtrk
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_backtrk))))
       (local.set $lex_backtrk_code
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_backtrk_code))))
       (local.set $lex_check
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_check))))
       (local.set $lex_check_code
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_check_code))))
       (local.set $lex_trans
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_trans))))
       (local.set $lex_trans_code
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_trans_code))))
       (local.set $lex_default
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_default))))
       (local.set $lex_default_code
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tbl) (global.get $lex_default_code))))
       (loop $loop
          (local.set $base (call $get (local.get $lex_base) (local.get $state)))
@@ -296,11 +298,11 @@
                   (i31.new (local.get $backtrk)))))
          (if (i32.ge_s
                 (i31.get_s
-                   (ref.cast i31
+                   (ref.cast (ref i31)
                       (array.get $block (local.get $lexbuf)
                          (global.get $lex_curr_pos))))
                 (i31.get_s
-                   (ref.cast i31
+                   (ref.cast (ref i31)
                       (array.get $block (local.get $lexbuf)
                          (global.get $lex_buffer_len)))))
             (then
@@ -316,7 +318,7 @@
             (else
                (local.set $pos
                   (i31.get_u
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $lexbuf)
                            (global.get $lex_curr_pos)))))
                (local.set $c
diff --git a/runtime/wasm/md5.wat b/runtime/wasm/md5.wat
index dbf4aaaba0..d8985af715 100644
--- a/runtime/wasm/md5.wat
+++ b/runtime/wasm/md5.wat
@@ -15,9 +15,9 @@
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $ctx (ref $context))
       (local.set $ctx (call $MD5Init))
-      (call $MD5Update (local.get $ctx) (ref.cast $string (local.get 0))
-         (i31.get_u (ref.cast i31 (local.get 1)))
-         (i31.get_u (ref.cast i31 (local.get 2))))
+      (call $MD5Update (local.get $ctx) (ref.cast (ref $string) (local.get 0))
+         (i31.get_u (ref.cast (ref i31) (local.get 1)))
+         (i31.get_u (ref.cast (ref i31) (local.get 2))))
       (return_call $MD5Final (local.get $ctx)))
 
    (func (export "caml_md5_chan")
@@ -373,7 +373,7 @@
 
    (func $MD5Init (result (ref $context))
        (struct.new $context
-          (array.new_fixed $int_array
+          (array.new_fixed $int_array 4
              (i32.const 0x67452301) (i32.const 0xEFCDAB89)
              (i32.const 0x98BADCFE) (i32.const 0x10325476))
           (i64.const 0)
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 84a9b69102..097c8d7f2c 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -80,7 +80,7 @@
 
    (func (export "caml_alloc_dummy") (param $size (ref eq)) (result (ref eq))
       (array.new $block (i31.new (i32.const 0))
-                 (i32.add (i31.get_u (ref.cast i31 (local.get $size)))
+                 (i32.add (i31.get_u (ref.cast (ref i31) (local.get $size)))
                           (i32.const 1))))
 
    (func (export "caml_update_dummy")
@@ -91,7 +91,7 @@
          (local.set $dst
             (br_on_cast_fail $not_block (ref eq) (ref $block)
                (local.get $dummy)))
-         (local.set $src (ref.cast $block (local.get $newval)))
+         (local.set $src (ref.cast (ref $block) (local.get $newval)))
          (array.copy $block $block
             (local.get $dst) (i32.const 0) (local.get $src) (i32.const 0)
             (array.len (local.get $dst)))
@@ -100,25 +100,25 @@
          (struct.set $dummy_closure_1 1
             (br_on_cast_fail $not_closure_1 (ref eq) (ref $dummy_closure_1)
                (local.get $dummy))
-            (ref.cast $closure (local.get $newval)))
+            (ref.cast (ref $closure) (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       (drop (block $not_closure_2 (result (ref eq))
          (struct.set $dummy_closure_2 2
             (br_on_cast_fail $not_closure_2 (ref eq) (ref $dummy_closure_2)
                (local.get $dummy))
-            (ref.cast $closure_2 (local.get $newval)))
+            (ref.cast (ref $closure_2) (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       (drop (block $not_closure_3 (result (ref eq))
          (struct.set $dummy_closure_3 2
             (br_on_cast_fail $not_closure_3 (ref eq) (ref $dummy_closure_3)
                (local.get $dummy))
-            (ref.cast $closure_3 (local.get $newval)))
+            (ref.cast (ref $closure_3) (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       (drop (block $not_closure_4 (result (ref eq))
          (struct.set $dummy_closure_4 2
             (br_on_cast_fail $not_closure_4 (ref eq) (ref $dummy_closure_4)
                (local.get $dummy))
-            (ref.cast $closure_4 (local.get $newval)))
+            (ref.cast (ref $closure_4) (local.get $newval)))
          (return (i31.new (i32.const 0)))))
       ;; ZZZ float array
       (unreachable))
@@ -155,7 +155,7 @@
       (param $tag (ref eq)) (param (ref eq)) (result (ref eq))
       (local $res (ref eq))
       (local.set $res (call $caml_obj_dup (local.get 1)))
-      (array.set $block (ref.cast $block (local.get $res)) (i32.const 0)
+      (array.set $block (ref.cast (ref $block) (local.get $res)) (i32.const 0)
          (local.get $tag))
       (local.get $res))
 
@@ -166,26 +166,26 @@
       (local.set $res
          (array.new $block
             (i31.new (i32.const 0))
-            (i32.add (i31.get_s (ref.cast i31 (local.get $size)))
+            (i32.add (i31.get_s (ref.cast (ref i31) (local.get $size)))
                      (i32.const 1))))
       (array.set $block (local.get $res) (i32.const 0) (local.get $tag))
       (local.get $res))
 
    (func (export "caml_obj_tag") (param $v (ref eq)) (result (ref eq))
-      (if (ref.test i31 (local.get $v))
+      (if (ref.test (ref i31) (local.get $v))
          (then (return (i31.new (i32.const 1000)))))
       (drop (block $not_block (result (ref eq))
          (return
             (array.get $block
               (br_on_cast_fail $not_block (ref eq) (ref $block) (local.get $v))
               (i32.const 0)))))
-      (if (ref.test $string (local.get $v))
+      (if (ref.test (ref $string) (local.get $v))
          (then (return (i31.new (global.get $string_tag)))))
-      (if (ref.test $float (local.get $v))
+      (if (ref.test (ref $float) (local.get $v))
          (then (return (i31.new (global.get $float_tag)))))
-      (if (ref.test $custom (local.get $v))
+      (if (ref.test (ref $custom) (local.get $v))
          (then (return (i31.new (global.get $custom_tag)))))
-      (if (ref.test $closure (local.get $v))
+      (if (ref.test (ref $closure) (local.get $v))
          (then (return (i31.new (global.get $closure_tag)))))
       (if (call $caml_is_continuation (local.get $v))
          (then (return (i31.new (global.get $cont_tag)))))
@@ -195,7 +195,7 @@
    (func (export "caml_obj_make_forward")
       (param $b (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $block (ref $block))
-      (local.set $block (ref.cast $block (local.get $b)))
+      (local.set $block (ref.cast (ref $block) (local.get $b)))
       (array.set $block (local.get $block)
          (i32.const 0) (i31.new (global.get $forward_tag)))
       (array.set $block (local.get $block) (i32.const 1) (local.get $v))
@@ -203,13 +203,13 @@
 
    (func (export "caml_lazy_make_forward")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block (i31.new (global.get $forward_tag))
+      (array.new_fixed $block 2 (i31.new (global.get $forward_tag))
          (local.get 0)))
 
    (func $obj_update_tag
       (param (ref eq)) (param $o i32) (param $n i32) (result i32)
       (local $b (ref $block))
-      (local.set $b (ref.cast $block (local.get 0)))
+      (local.set $b (ref.cast (ref $block) (local.get 0)))
       (if (result i32) (ref.eq (array.get $block (local.get $b) (i32.const 0))
                                (i31.new (local.get $o)))
          (then
@@ -231,7 +231,7 @@
 
    (func (export "caml_lazy_update_to_forcing")
       (param (ref eq)) (result (ref eq))
-      (if (ref.test $block (local.get 0))
+      (if (ref.test (ref $block) (local.get 0))
          (then
             (if (call $obj_update_tag (local.get 0)
                    (global.get $lazy_tag) (global.get $forcing_tag))
@@ -243,9 +243,9 @@
       (param $old (ref eq)) (param $new (ref eq)) (result (ref eq))
       (local $b (ref $block))
       (local $i i32)
-      (local.set $b (ref.cast $block (local.get 0)))
+      (local.set $b (ref.cast (ref $block) (local.get 0)))
       (local.set $i
-         (i32.add (i31.get_u (ref.cast i31 (local.get 1))) (i32.const 1)))
+         (i32.add (i31.get_u (ref.cast (ref i31) (local.get 1))) (i32.const 1)))
       (if (result (ref eq))
           (ref.eq
             (array.get $block (local.get $b) (local.get $i)) (local.get $old))
@@ -260,14 +260,15 @@
 
    (func (export "caml_obj_raw_field")
       (param $o (ref eq)) (param $i (ref eq)) (result (ref eq))
-      (array.get $block (ref.cast $block (local.get $o))
-         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))))
+      (array.get $block (ref.cast (ref $block) (local.get $o))
+         (i32.add
+            (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))))
 
    (func (export "caml_obj_set_raw_field")
       (param $o (ref eq)) (param $i (ref eq)) (param $v (ref eq))
       (result (ref eq))
-      (array.set $block (ref.cast $block (local.get $o))
-         (i32.add (i31.get_u (ref.cast i31 (local.get $i))) (i32.const 1))
+      (array.set $block (ref.cast (ref $block) (local.get $o))
+         (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))
          (local.get $v))
       (i31.new (i32.const 0)))
 
@@ -298,10 +299,11 @@
       (local $li i32) (local $mi i32) (local $hi i32)
       (local $a (ref $int_array)) (local $len i32)
       (local.set $meths
-         (ref.cast $block
-            (array.get $block (ref.cast $block (local.get $obj)) (i32.const 1))))
-      (local.set $tag (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $cacheid (i31.get_u (ref.cast i31 (local.get 2))))
+         (ref.cast (ref $block)
+            (array.get $block
+               (ref.cast (ref $block) (local.get $obj)) (i32.const 1))))
+      (local.set $tag (i31.get_s (ref.cast (ref i31) (local.get 1))))
+      (local.set $cacheid (i31.get_u (ref.cast (ref i31) (local.get 2))))
       (local.set $len (array.len (global.get $method_cache)))
       (if (i32.ge_s (local.get $cacheid) (local.get $len))
          (then
@@ -318,7 +320,7 @@
          (array.get $int_array (global.get $method_cache) (local.get $cacheid)))
       (if (i32.eq (local.get $tag)
              (i31.get_s
-                (ref.cast i31
+                (ref.cast (ref i31)
                    (array.get $block (local.get $meths) (local.get $ofs)))))
          (then
             (return
@@ -329,7 +331,7 @@
          (i32.add
             (i32.shl
                (i31.get_u
-                  (ref.cast i31
+                  (ref.cast (ref i31)
                      (array.get $block (local.get $meths) (i32.const 1))))
                (i32.const 1))
             (i32.const 1)))
@@ -343,7 +345,7 @@
                (if (i32.lt_s
                       (local.get $tag)
                       (i31.get_s
-                         (ref.cast i31
+                         (ref.cast (ref i31)
                             (array.get $block
                                (local.get $meths)
                                (i32.add (local.get $mi) (i32.const 1))))))
@@ -357,7 +359,7 @@
       (if (result (ref eq))
           (i32.eq (local.get $tag)
              (i31.get_s
-                (ref.cast i31
+                (ref.cast (ref i31)
                    (array.get $block (local.get $meths)
                       (i32.add (local.get $li) (i32.const 1))))))
          (then
@@ -370,7 +372,7 @@
    (func (export "caml_set_oo_id") (param (ref eq)) (result (ref eq))
       (local $id i32)
       (local.set $id (global.get $caml_oo_last_id))
-      (array.set $block (ref.cast $block (local.get 0)) (i32.const 2)
+      (array.set $block (ref.cast (ref $block) (local.get 0)) (i32.const 2)
          (i31.new (local.get $id)))
       (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
       (local.get 0))
diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat
index 136a7ee61f..25e7d87dcf 100644
--- a/runtime/wasm/parsing.wat
+++ b/runtime/wasm/parsing.wat
@@ -24,7 +24,7 @@
 
    (func $get (param $a (ref eq)) (param $i i32) (result i32)
       (local $s (ref $string))
-      (local.set $s (ref.cast $string (local.get $a)))
+      (local.set $s (ref.cast (ref $string) (local.get $a)))
       (local.set $i (i32.add (local.get $i) (local.get $i)))
       (i32.extend16_s
          (i32.or (array.get_u $string (local.get $s) (local.get $i))
@@ -104,7 +104,7 @@
       (param $vnames (ref eq)) (param $number i32) (result (ref eq))
       (local $names (ref $string)) (local $i i32) (local $len i32)
       (local $name (ref $string))
-      (local.set $names (ref.cast $string (local.get $vnames)))
+      (local.set $names (ref.cast (ref $string) (local.get $vnames)))
       (loop $loop
          (if (i32.eqz (array.get $string (local.get $names) (local.get $i)))
             (then
@@ -128,7 +128,7 @@
 
    (func $output (param (ref eq))
       (local $s (ref $string))
-      (local.set $s (ref.cast $string (local.get 0)))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
       (drop
          (call $caml_ml_output (global.get $caml_stderr)
             (local.get $s) (i31.new (i32.const 0))
@@ -137,7 +137,7 @@
    (func $output_nl
       (drop
          (call $caml_ml_output (global.get $caml_stderr)
-            (array.new_fixed $string (i32.const 10))
+            (array.new_fixed $string 1 (i32.const 10))
             (i31.new (i32.const 0)) (i31.new (i32.const 1))))
       (drop (call $caml_ml_flush (global.get $caml_stderr))))
 
@@ -147,14 +147,14 @@
    (func $output_int (param i32)
       (call $output
          (call $caml_format_int
-            (array.new_fixed $string (i32.const 37) (i32.const 100))
+            (array.new_fixed $string 2 (i32.const 37) (i32.const 100))
             (i31.new (local.get 0)))))
 
    (func $print_token
       (param $tables (ref $block)) (param $state i32) (param $tok (ref eq))
       (local $b (ref $block))
       (local $v (ref eq))
-      (if (ref.test i31 (local.get $tok))
+      (if (ref.test (ref i31) (local.get $tok))
          (then
             (call $output_str (string.const "State "))
             (call $output_int (local.get $state))
@@ -163,32 +163,34 @@
                (call $token_name
                   (array.get $block (local.get $tables)
                      (global.get $tbl_names_const))
-                  (i31.get_u (ref.cast i31 (local.get $tok)))))
+                  (i31.get_u (ref.cast (ref i31) (local.get $tok)))))
             (call $output_nl))
          (else
             (call $output_str (string.const "State "))
             (call $output_int (local.get $state))
             (call $output_str (string.const ": read token "))
-            (local.set $b (ref.cast $block (local.get $tok)))
+            (local.set $b (ref.cast (ref $block) (local.get $tok)))
             (call $output
                (call $token_name
                   (array.get $block (local.get $tables)
                      (global.get $tbl_names_block))
                   (i31.get_u
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $b) (i32.const 0))))))
             (call $output_str (string.const "("))
             (local.set $v (array.get $block (local.get $b) (i32.const 1)))
-            (if (ref.test i31 (local.get $v))
+            (if (ref.test (ref i31) (local.get $v))
                (then
-                  (call $output_int (i31.get_s (ref.cast i31 (local.get $v)))))
-            (else (if (ref.test $string (local.get $v))
+                  (call $output_int
+                     (i31.get_s (ref.cast (ref i31) (local.get $v)))))
+            (else (if (ref.test (ref $string) (local.get $v))
                (then (call $output (local.get $v)))
-            (else (if (ref.test $float (local.get $v))
+            (else (if (ref.test (ref $float) (local.get $v))
                (then
                   (call $output
                      (call $caml_format_float
-                        (array.new_fixed $string (i32.const 37) (i32.const 103))
+                        (array.new_fixed $string 2
+                           (i32.const 37) (i32.const 103))
                         (local.get $v))))
             (else
                (call $output_str (string.const "_"))))))))
@@ -213,47 +215,47 @@
       (local $tbl_lhs (ref $string))
       (local $tbl_gindex (ref $string))
       (local $tbl_dgoto (ref $string))
-      (local.set $tables (ref.cast $block (local.get $vtables)))
+      (local.set $tables (ref.cast (ref $block) (local.get $vtables)))
       (local.set $tbl_defred
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_defred))))
       (local.set $tbl_sindex
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_sindex))))
       (local.set $tbl_check
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_check))))
       (local.set $tbl_rindex
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_rindex))))
       (local.set $tbl_table
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_table))))
       (local.set $tbl_len
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_len))))
       (local.set $tbl_lhs
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_lhs))))
       (local.set $tbl_gindex
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_gindex))))
       (local.set $tbl_dgoto
-         (ref.cast $string
+         (ref.cast (ref $string)
             (array.get $block (local.get $tables) (global.get $tbl_dgoto))))
-      (local.set $env (ref.cast $block (local.get $venv)))
-      (local.set $cmd (i31.get_s (ref.cast i31 (local.get $vcmd))))
+      (local.set $env (ref.cast (ref $block) (local.get $venv)))
+      (local.set $cmd (i31.get_s (ref.cast (ref i31) (local.get $vcmd))))
       (local.set $sp
          (i31.get_s
-            (ref.cast i31
+            (ref.cast (ref i31)
                (array.get $block (local.get $env) (global.get $env_sp)))))
       (local.set $state
          (i31.get_s
-            (ref.cast i31
+            (ref.cast (ref i31)
                (array.get $block (local.get $env) (global.get $env_state)))))
       (local.set $errflag
          (i31.get_s
-            (ref.cast i31
+            (ref.cast (ref i31)
                (array.get $block (local.get $env) (global.get $env_errflag)))))
       (block $exit
        (loop $next
@@ -286,7 +288,7 @@
                         (br $next)))
                   (if (i32.ge_s
                          (i31.get_s
-                            (ref.cast i31
+                            (ref.cast (ref i31)
                                (array.get $block (local.get $env)
                                   (global.get $env_curr_char))))
                          (i32.const 0))
@@ -304,12 +306,12 @@
                        (array.set $block (local.get $env)
                           (global.get $env_curr_char)
                           (array.get $block
-                             (ref.cast $block
+                             (ref.cast (ref $block)
                                 (array.get $block (local.get $tables)
                                    (global.get $tbl_transl_block)))
                              (i32.add
                                 (i31.get_u
-                                   (ref.cast i31
+                                   (ref.cast (ref i31)
                                       (array.get $block
                                          (local.get $arg) (i32.const 0))))
                                 (i32.const 1))))
@@ -319,11 +321,11 @@
                     (array.set $block (local.get $env)
                        (global.get $env_curr_char)
                        (array.get $block
-                          (ref.cast $block
+                          (ref.cast (ref $block)
                              (array.get $block (local.get $tables)
                                 (global.get $tbl_transl_const)))
                           (i32.add
-                             (i31.get_u (ref.cast i31 (local.get $varg)))
+                             (i31.get_u (ref.cast (ref i31) (local.get $varg)))
                              (i32.const 1))))
                     (array.set $block (local.get $env) (global.get $env_lval)
                        (i31.new (i32.const 0))))
@@ -337,7 +339,7 @@
                 (local.set $n2
                     (i32.add (local.get $n1)
                        (i31.get_s
-                          (ref.cast i31
+                          (ref.cast (ref i31)
                              (array.get $block (local.get $env)
                                 (global.get $env_curr_char))))))
                 (if (i32.and
@@ -346,7 +348,7 @@
                    (then
                       (if (i32.le_s (local.get $n2)
                              (i31.get_s
-                                (ref.cast i31
+                                (ref.cast (ref i31)
                                    (array.get $block (local.get $tables)
                                       (global.get $tbl_tablesize)))))
                          (then
@@ -364,7 +366,7 @@
                 (local.set $n2
                    (i32.add (local.get $n1)
                       (i31.get_s
-                         (ref.cast i31
+                         (ref.cast (ref i31)
                             (array.get $block (local.get $env)
                                (global.get $env_curr_char))))))
                 (if (i32.and
@@ -373,7 +375,7 @@
                    (then
                       (if (i32.le_s (local.get $n2)
                              (i31.get_s
-                                (ref.cast i31
+                                (ref.cast (ref i31)
                                    (array.get $block (local.get $tables)
                                       (global.get $tbl_tablesize)))))
                          (then
@@ -401,9 +403,9 @@
                      (loop $loop2
                        (local.set $state1
                           (i31.get_s
-                             (ref.cast i31
+                             (ref.cast (ref i31)
                                 (array.get $block
-                                   (ref.cast $block
+                                   (ref.cast (ref $block)
                                       (array.get $block (local.get $env)
                                          (global.get $env_s_stack)))
                                    (i32.add (local.get $sp) (i32.const 1))))))
@@ -418,7 +420,7 @@
                           (then
                              (if (i32.le_s (local.get $n2)
                                     (i31.get_s
-                                       (ref.cast i31
+                                       (ref.cast (ref i31)
                                           (array.get $block (local.get $tables)
                                              (global.get $tbl_tablesize)))))
                                 (then
@@ -446,7 +448,7 @@
                              (call $output_nl)))
                        (if (i32.le_s (local.get $sp)
                               (i31.get_s
-                                 (ref.cast i31
+                                 (ref.cast (ref i31)
                                     (array.get $block (local.get $env)
                                        (global.get $env_stackbase)))))
                           (then
@@ -498,7 +500,7 @@
              (local.set $sp (i32.add (local.get $sp) (i32.const 1)))
              (if (i32.ge_s (local.get $sp)
                     (i31.get_s
-                       (ref.cast i31
+                       (ref.cast (ref i31)
                            (array.get $block (local.get $env)
                               (global.get $env_stacksize)))))
                 (then
@@ -507,23 +509,23 @@
              ;; Fall through
             ;; STACKS_GROWN_1:
             (array.set $block
-               (ref.cast $block
+               (ref.cast (ref $block)
                   (array.get $block (local.get $env) (global.get $env_s_stack)))
                (i32.add (local.get $sp) (i32.const 1))
                (i31.new (local.get $state)))
             (array.set $block
-               (ref.cast $block
+               (ref.cast (ref $block)
                   (array.get $block (local.get $env) (global.get $env_v_stack)))
                (i32.add (local.get $sp) (i32.const 1))
                (array.get $block (local.get $env) (global.get $env_lval)))
             (array.set $block
-               (ref.cast $block
+               (ref.cast (ref $block)
                   (array.get $block (local.get $env)
                      (global.get $env_symb_start_stack)))
                (i32.add (local.get $sp) (i32.const 1))
                (array.get $block (local.get $env) (global.get $env_symb_start)))
             (array.set $block
-               (ref.cast $block
+               (ref.cast (ref $block)
                   (array.get $block (local.get $env)
                      (global.get $env_symb_end_stack)))
                (i32.add (local.get $sp) (i32.const 1))
@@ -550,9 +552,9 @@
            (local.set $m (call $get (local.get $tbl_lhs) (local.get $n)))
            (local.set $state1
               (i31.get_s
-                 (ref.cast i31
+                 (ref.cast (ref i31)
                     (array.get $block
-                       (ref.cast $block
+                       (ref.cast (ref $block)
                           (array.get $block (local.get $env)
                              (global.get $env_s_stack)))
                        (local.get $sp)))))
@@ -565,7 +567,7 @@
                  (then
                     (if (i32.le_s (local.get $n2)
                            (i31.get_s
-                              (ref.cast i31
+                              (ref.cast (ref i31)
                                  (array.get $block (local.get $tables)
                                     (global.get $tbl_tablesize)))))
                        (then
@@ -582,7 +584,7 @@
                  (call $get (local.get $tbl_dgoto) (local.get $m))))
            (if (i32.ge_s (local.get $sp)
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $env)
                            (global.get $env_stacksize)))))
               (then
@@ -594,26 +596,26 @@
           (br $exit))
          ;; SEMANTIC_ACTION_COMPUTED:
          (array.set $block
-            (ref.cast $block
+            (ref.cast (ref $block)
                (array.get $block (local.get $env) (global.get $env_s_stack)))
             (i32.add (local.get $sp) (i32.const 1))
             (i31.new (local.get $state)))
          (array.set $block
-            (ref.cast $block
+            (ref.cast (ref $block)
                (array.get $block (local.get $env) (global.get $env_v_stack)))
             (i32.add (local.get $sp) (i32.const 1))
             (local.get $varg))
          (local.set $asp
             (i31.get_s
-               (ref.cast i31
+               (ref.cast (ref i31)
                   (array.get $block (local.get $env) (global.get $env_asp)))))
          (array.set $block
-            (ref.cast $block
+            (ref.cast (ref $block)
                (array.get $block (local.get $env)
                   (global.get $env_symb_end_stack)))
             (i32.add (local.get $sp) (i32.const 1))
             (array.get $block
-               (ref.cast $block
+               (ref.cast (ref $block)
                   (array.get $block (local.get $env)
                      (global.get $env_symb_end_stack)))
                (i32.add (local.get $asp) (i32.const 1))))
@@ -621,12 +623,12 @@
             (then
             ;; This is an epsilon production. Take symb_start equal to symb_end.
                (array.set $block
-                  (ref.cast $block
+                  (ref.cast (ref $block)
                      (array.get $block (local.get $env)
                         (global.get $env_symb_start_stack)))
                   (i32.add (local.get $sp) (i32.const 1))
                   (array.get $block
-                     (ref.cast $block
+                     (ref.cast (ref $block)
                         (array.get $block (local.get $env)
                            (global.get $env_symb_end_stack)))
                      (i32.add (local.get $asp) (i32.const 1))))))
@@ -646,6 +648,7 @@
    (func (export "caml_set_parser_trace") (param (ref eq)) (result (ref eq))
       (local $oldflag i32)
       (local.set $oldflag (global.get $caml_parser_trace))
-      (global.set $caml_parser_trace (i31.get_s (ref.cast i31 (local.get 0))))
+      (global.set $caml_parser_trace
+         (i31.get_s (ref.cast (ref i31) (local.get 0))))
       (i31.new (local.get $oldflag)))
 )
diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat
index 52c8df6935..84679eca8c 100644
--- a/runtime/wasm/printexc.wat
+++ b/runtime/wasm/printexc.wat
@@ -33,7 +33,7 @@
       (local $s (ref $string))
       (local.set $pos (struct.get $buffer 0 (local.get $buf)))
       (local.set $data (struct.get $buffer 1 (local.get $buf)))
-      (local.set $s (ref.cast $string (local.get $v)))
+      (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $len (array.len (local.get $s)))
       (if (i32.gt_u (i32.add (local.get $pos) (local.get $len))
                     (array.len (local.get $data)))
@@ -53,7 +53,7 @@
       (local $v (ref eq))
       (local $bucket (ref $block))
       (local $i i32) (local $len i32)
-      (local.set $exn (ref.cast $block (local.get 0)))
+      (local.set $exn (ref.cast (ref $block) (local.get 0)))
       (if (result anyref)
           (ref.eq (array.get $block (local.get $exn) (i32.const 0))
                   (i31.new (i32.const 0)))
@@ -65,7 +65,7 @@
             (call $add_string
                (local.get $buf)
                (array.get $block
-                  (ref.cast $block
+                  (ref.cast (ref $block)
                      (array.get $block (local.get $exn) (i32.const 1)))
                   (i32.const 1)))
             (local.set $bucket
@@ -79,8 +79,9 @@
                               (array.get $block (local.get $exn) (i32.const 1)))))
                      (local.set $v
                         (array.get $block (local.get $exn) (i32.const 2)))
-                     (br_if $default (i32.eqz (ref.test $block (local.get $v))))
-                     (local.set $bucket (ref.cast $block (local.get $v)))
+                     (br_if $default
+                        (i32.eqz (ref.test (ref $block) (local.get $v))))
+                     (local.set $bucket (ref.cast (ref $block) (local.get $v)))
                      (br_if $default
                         (i32.eqz
                            (ref.eq
@@ -97,14 +98,14 @@
                  (loop $loop
                     (local.set $v
                        (array.get $block (local.get $bucket) (local.get $i)))
-                    (if (ref.test i31 (local.get $v))
+                    (if (ref.test (ref i31) (local.get $v))
                        (then
                            (call $add_string (local.get $buf)
                               (call $caml_format_int
-                                  (array.new_fixed $string
+                                  (array.new_fixed $string 2
                                      (i32.const 37) (i32.const 100)) ;; %d
-                                  (ref.cast i31 (local.get $v)))))
-                    (else (if (ref.test $string (local.get $v))
+                                  (ref.cast (ref i31) (local.get $v)))))
+                    (else (if (ref.test (ref $string) (local.get $v))
                        (then
                           (call $add_char (local.get $buf)
                              (i32.const 34)) ;; '\"'
@@ -121,7 +122,7 @@
                              (i32.const 44)) ;; ','
                           (br $loop))))
                  (call $add_char (local.get $buf) (i32.const 41)))) ;; '\)'
-           (string.new_wtf8_array replace
+           (string.new_lossy_utf8_array
               (struct.get $buffer 1 (local.get $buf)) (i32.const 0)
               (struct.get $buffer 0 (local.get $buf))))
          (else
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index 34cbfba1dc..87f9a69f5a 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -36,7 +36,7 @@
       (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64)
       (local $z i64)
       (local.set $data
-         (struct.get $bigarray 1 (ref.cast $bigarray (local.get $v))))
+         (struct.get $bigarray 1 (ref.cast (ref $bigarray) (local.get $v))))
       (local.set $a
          (i64.or
             (i64.extend_i32_u
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index 17582700b9..e67e7c970e 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -30,7 +30,7 @@
             (local.set $a
                (br_on_cast_fail $tail (ref null eq) (ref $assoc) (local.get $l)))
             (if (i31.get_u
-                   (ref.cast i31
+                   (ref.cast (ref i31)
                        (call $caml_string_equal
                           (local.get $s)
                           (struct.get $assoc 0 (local.get $a)))))
@@ -47,7 +47,7 @@
          (array.get $assoc_array (global.get $named_value_table)
             (i32.rem_u
                (i31.get_s
-                  (ref.cast i31
+                  (ref.cast (ref i31)
                      (call $caml_string_hash
                         (i31.new (i32.const 0)) (local.get $s))))
                (global.get $Named_value_size)))))
@@ -59,7 +59,7 @@
       (local.set $h
          (i32.rem_u
             (i31.get_s
-               (ref.cast i31
+               (ref.cast (ref i31)
                   (call $caml_string_hash
                      (i31.new (i32.const 0)) (local.get 0))))
             (global.get $Named_value_size)))
@@ -71,7 +71,7 @@
             (array.set $assoc_array
                (global.get $named_value_table) (local.get $h)
                (struct.new $assoc
-                  (ref.cast $string (local.get 0))
+                  (ref.cast (ref $string) (local.get 0))
                   (local.get 1) (local.get $r)))))
       (i31.new (i32.const 0)))
 
@@ -81,7 +81,7 @@
    (func (export "caml_register_global")
       (param (ref eq)) (param $v (ref eq)) (param (ref eq)) (result (ref eq))
       (local $i i32)
-      (local.set $i (i31.get_u (ref.cast i31 (local.get 0))))
+      (local.set $i (i31.get_u (ref.cast (ref i31) (local.get 0))))
       (if (i32.lt_u (local.get $i) (array.len (global.get $caml_global_data)))
          (then
             (array.set $block (global.get $caml_global_data)
diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat
index 39b29b454f..23195b64aa 100644
--- a/runtime/wasm/str.wat
+++ b/runtime/wasm/str.wat
@@ -10,7 +10,7 @@
    (type $int_array (array (mut i32)))
 
    (global $re_word_letters (ref $char_table)
-      (array.new_fixed $char_table
+      (array.new_fixed $char_table 32
          (i32.const 0x00) (i32.const 0x00)
          (i32.const 0x00) (i32.const 0x00)   ;; 0x00-0x1F: none
          (i32.const 0x00) (i32.const 0x00)
@@ -78,19 +78,24 @@
       (local $u (ref $undo))
       (local $p (ref $pos))
       (local.set $len (array.len (local.get $s)))
-      (local.set $re (ref.cast $block (local.get $vre)))
+      (local.set $re (ref.cast (ref $block) (local.get $vre)))
       (local.set $prog
-         (ref.cast $block (array.get $block (local.get $re) (i32.const 1))))
+         (ref.cast (ref $block)
+            (array.get $block (local.get $re) (i32.const 1))))
       (local.set $cpool
-         (ref.cast $block (array.get $block (local.get $re) (i32.const 2))))
+         (ref.cast (ref $block)
+            (array.get $block (local.get $re) (i32.const 2))))
       (local.set $normtable
-         (ref.cast $string (array.get $block (local.get $re) (i32.const 3))))
+         (ref.cast (ref $string)
+            (array.get $block (local.get $re) (i32.const 3))))
       (local.set $numgroups
          (i31.get_s
-            (ref.cast i31 (array.get $block (local.get $re) (i32.const 4)))))
+            (ref.cast (ref i31)
+               (array.get $block (local.get $re) (i32.const 4)))))
       (local.set $numregisters
          (i31.get_s
-            (ref.cast i31 (array.get $block (local.get $re) (i32.const 5)))))
+            (ref.cast (ref i31)
+               (array.get $block (local.get $re) (i32.const 5)))))
       (local.set $group_start
          (array.new $int_array (i32.const -1) (local.get $numgroups)))
       (local.set $group_end
@@ -125,7 +130,7 @@
                             (block $CHAR
                              (local.set $instr
                                 (i31.get_s
-                                   (ref.cast i31
+                                   (ref.cast (ref i31)
                                       (array.get $block (local.get $prog)
                                          (local.get $pc)))))
                              (local.set $pc
@@ -167,7 +172,7 @@
                           (local.set $arg
                              (i32.shr_u (local.get $instr) (i32.const 8)))
                           (local.set $s'
-                             (ref.cast $string
+                             (ref.cast (ref $string)
                                 (array.get $block (local.get $cpool)
                                    (i32.add (local.get $arg) (i32.const 1)))))
                           (local.set $i (i32.const 0))
@@ -194,7 +199,7 @@
                          (local.set $arg
                             (i32.shr_u (local.get $instr) (i32.const 8)))
                          (local.set $s'
-                            (ref.cast $string
+                            (ref.cast (ref $string)
                                (array.get $block (local.get $cpool)
                                   (i32.add (local.get $arg) (i32.const 1)))))
                          (local.set $i (i32.const 0))
@@ -227,7 +232,7 @@
                         (br_if $backtrack
                            (i32.eqz
                               (call $in_bitset
-                                 (ref.cast $string
+                                 (ref.cast (ref $string)
                                     (array.get $block (local.get $cpool)
                                        (i32.add (local.get $arg)
                                           (i32.const 1))))
@@ -341,7 +346,7 @@
                  (if (i32.lt_u (local.get $pos) (local.get $len))
                     (then
                        (if (call $in_bitset
-                              (ref.cast $string
+                              (ref.cast (ref $string)
                                  (array.get $block (local.get $cpool)
                                     (i32.add (local.get $arg) (i32.const 1))))
                               (array.get_u $string (local.get $s)
@@ -353,7 +358,7 @@
                 ;; SIMPLESTAR
                 (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8)))
                 (local.set $set
-                   (ref.cast $string
+                   (ref.cast (ref $string)
                       (array.get $block (local.get $cpool)
                       (i32.add (local.get $arg) (i32.const 1)))))
                 (loop $loop
@@ -371,7 +376,7 @@
                (br_if $prefix_match (i32.eq (local.get $pos) (local.get $len)))
                (local.set $arg (i32.shr_u (local.get $instr) (i32.const 8)))
                (local.set $set
-                  (ref.cast $string
+                  (ref.cast (ref $string)
                      (array.get $block (local.get $cpool)
                      (i32.add (local.get $arg) (i32.const 1)))))
                (br_if $backtrack
@@ -425,7 +430,7 @@
          ;; backtrack
          (loop $loop
             (local.set $u
-               (ref.cast $undo
+               (ref.cast (ref $undo)
                   (block $undo (result (ref $stack))
                      (local.set $p
                         (br_on_cast_fail $undo (ref eq) (ref $pos)
@@ -494,8 +499,8 @@
       (local $s (ref $string))
       (local $pos i32) (local $len i32)
       (local $res (ref eq))
-      (local.set $s (ref.cast $string (local.get $vs)))
-      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $s (ref.cast (ref $string) (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos))))
       (local.set $len (array.len (local.get $s)))
       (if (i32.gt_u (local.get $pos) (local.get $len))
          (then
@@ -506,12 +511,12 @@
          (local.set $res
             (call $re_match
                (local.get $re) (local.get $s) (local.get $pos) (i32.const 0)))
-         (if (ref.test $block (local.get $res))
+         (if (ref.test (ref $block) (local.get $res))
             (then
                (return (local.get $res))))
          (local.set $pos (i32.add (local.get $pos) (i32.const 1)))
          (br_if $loop (i32.le_u (local.get $pos) (local.get $len))))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (data $search_backward "Str.search_backward")
 
@@ -522,8 +527,8 @@
       (local $s (ref $string))
       (local $pos i32) (local $len i32)
       (local $res (ref eq))
-      (local.set $s (ref.cast $string (local.get $vs)))
-      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $s (ref.cast (ref $string) (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos))))
       (local.set $len (array.len (local.get $s)))
       (if (i32.gt_u (local.get $pos) (local.get $len))
          (then
@@ -534,12 +539,12 @@
          (local.set $res
             (call $re_match
                (local.get $re) (local.get $s) (local.get $pos) (i32.const 0)))
-         (if (ref.test $block (local.get $res))
+         (if (ref.test (ref $block) (local.get $res))
             (then
                (return (local.get $res))))
          (local.set $pos (i32.sub (local.get $pos) (i32.const 1)))
          (br_if $loop (i32.ge_s (local.get $pos) (i32.const 0))))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (data $string_match "Str.string_match")
 
@@ -550,8 +555,8 @@
       (local $s (ref $string))
       (local $pos i32) (local $len i32)
       (local $res (ref eq))
-      (local.set $s (ref.cast $string (local.get $vs)))
-      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $s (ref.cast (ref $string) (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos))))
       (local.set $len (array.len (local.get $s)))
       (if (i32.gt_u (local.get $pos) (local.get $len))
          (then
@@ -561,10 +566,10 @@
       (local.set $res
          (call $re_match
             (local.get $re) (local.get $s) (local.get $pos) (i32.const 0)))
-       (if (ref.test $block (local.get $res))
+       (if (ref.test (ref $block) (local.get $res))
           (then
             (return (local.get $res))))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (data $string_partial_match "Str.string_partial_match")
 
@@ -575,8 +580,8 @@
       (local $s (ref $string))
       (local $pos i32) (local $len i32)
       (local $res (ref eq))
-      (local.set $s (ref.cast $string (local.get $vs)))
-      (local.set $pos (i31.get_s (ref.cast i31 (local.get $vpos))))
+      (local.set $s (ref.cast (ref $string) (local.get $vs)))
+      (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos))))
       (local.set $len (array.len (local.get $s)))
       (if (i32.gt_u (local.get $pos) (local.get $len))
          (then
@@ -586,10 +591,10 @@
       (local.set $res
          (call $re_match
             (local.get $re) (local.get $s) (local.get $pos) (i32.const 1)))
-       (if (ref.test $block (local.get $res))
+       (if (ref.test (ref $block) (local.get $res))
           (then
             (return (local.get $res))))
-      (array.new_fixed $block (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (i31.new (i32.const 0))))
 
    (data $illegal_backslash "Str.replace: illegal backslash sequence")
    (data $unmatched_group "Str.replace: reference to unmatched group")
@@ -603,10 +608,10 @@
       (local $res (ref $string))
       (local $i i32) (local $j i32) (local $l i32) (local $len i32)
       (local $c i32) (local $start i32) (local $end i32)
-      (local.set $repl (ref.cast $string (local.get $vrepl)))
+      (local.set $repl (ref.cast (ref $string) (local.get $vrepl)))
       (local.set $l (array.len (local.get $repl)))
-      (local.set $groups (ref.cast $block (local.get $vgroups)))
-      (local.set $orig (ref.cast $string (local.get $vorig)))
+      (local.set $groups (ref.cast (ref $block) (local.get $vgroups)))
+      (local.set $orig (ref.cast (ref $string) (local.get $vorig)))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $l))
             (then
@@ -643,12 +648,12 @@
                            (i32.const 0) (i32.const 41)))))
                (local.set $start
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $groups)
                            (i32.add (local.get $c) (i32.const 1))))))
                (local.set $end
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $groups)
                            (i32.add (local.get $c) (i32.const 2))))))
                (if (i32.eq (local.get $start) (i32.const -1))
@@ -702,12 +707,12 @@
                            (i32.const 0) (i32.const 41)))))
                (local.set $start
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $groups)
                            (i32.add (local.get $c) (i32.const 1))))))
                (local.set $end
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                         (array.get $block (local.get $groups)
                            (i32.add (local.get $c) (i32.const 2))))))
                (local.set $len (i32.sub (local.get $end) (local.get $start)))
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index e0acd74fc8..8e1c39da5a 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -33,8 +33,8 @@
       (local $len i32) (local $i i32)
       (if (ref.eq (local.get $p1) (local.get $p2))
          (then (return (i31.new (i32.const 1)))))
-      (local.set $s1 (ref.cast $string (local.get $p1)))
-      (local.set $s2 (ref.cast $string (local.get $p2)))
+      (local.set $s1 (ref.cast (ref $string) (local.get $p1)))
+      (local.set $s2 (ref.cast (ref $string) (local.get $p2)))
       (local.set $len (array.len $string (local.get $s1)))
       (if (i32.ne (local.get $len) (array.len $string (local.get $s2)))
          (then (return (i31.new (i32.const 0)))))
@@ -53,7 +53,7 @@
    (func $caml_string_notequal (export "caml_string_notequal")
       (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
       (return
-         (i31.new (i32.eqz (i31.get_u (ref.cast i31
+         (i31.new (i32.eqz (i31.get_u (ref.cast (ref i31)
             (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
 
    (func $string_compare
@@ -63,8 +63,8 @@
       (local $c1 i32) (local $c2 i32)
       (if (ref.eq (local.get $p1) (local.get $p2))
          (then (return (i32.const 0))))
-      (local.set $s1 (ref.cast $string (local.get $p1)))
-      (local.set $s2 (ref.cast $string (local.get $p2)))
+      (local.set $s1 (ref.cast (ref $string) (local.get $p1)))
+      (local.set $s2 (ref.cast (ref $string) (local.get $p2)))
       (local.set $l1 (array.len $string (local.get $s1)))
       (local.set $l2 (array.len $string (local.get $s2)))
       (local.set $len (select (local.get $l1) (local.get $l2)
@@ -128,7 +128,7 @@
    (func (export "caml_create_bytes")
       (param $len (ref eq)) (result (ref eq))
       (local $l i32)
-      (local.set $l (i31.get_s (ref.cast i31 (local.get $len))))
+      (local.set $l (i31.get_s (ref.cast (ref i31) (local.get $len))))
       (if (i32.lt_s (local.get $l) (i32.const 0))
          (then
             (call $caml_invalid_argument
@@ -142,29 +142,29 @@
       (param $v2 (ref eq)) (param $i2 (ref eq))
       (param $n (ref eq)) (result (ref eq))
       (array.copy $string $string
-         (ref.cast $string (local.get $v2))
-         (i31.get_s (ref.cast i31 (local.get $i2)))
-         (ref.cast $string (local.get $v1))
-         (i31.get_s (ref.cast i31 (local.get $i1)))
-         (i31.get_s (ref.cast i31 (local.get $n))))
+         (ref.cast (ref $string) (local.get $v2))
+         (i31.get_s (ref.cast (ref i31) (local.get $i2)))
+         (ref.cast (ref $string) (local.get $v1))
+         (i31.get_s (ref.cast (ref i31) (local.get $i1)))
+         (i31.get_s (ref.cast (ref i31) (local.get $n))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_fill_bytes")
       (param $v (ref eq)) (param $offset (ref eq))
       (param $len (ref eq)) (param $init (ref eq))
       (result (ref eq))
-      (array.fill $string (ref.cast $string (local.get $v))
-         (i31.get_u (ref.cast i31 (local.get $offset)))
-         (i31.get_u (ref.cast i31 (local.get $init)))
-         (i31.get_u (ref.cast i31 (local.get $len))))
+      (array.fill $string (ref.cast (ref $string) (local.get $v))
+         (i31.get_u (ref.cast (ref i31) (local.get $offset)))
+         (i31.get_u (ref.cast (ref i31) (local.get $init)))
+         (i31.get_u (ref.cast (ref i31) (local.get $len))))
       (i31.new (i32.const 0)))
 
    (export "caml_string_get16" (func $caml_bytes_get16))
    (func $caml_bytes_get16 (export "caml_bytes_get16")
       (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
       (local $s (ref $string)) (local $p i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $s (ref.cast (ref $string) (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
@@ -180,8 +180,8 @@
    (func $caml_bytes_get32 (export "caml_bytes_get32")
       (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
       (local $s (ref $string)) (local $p i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $s (ref.cast (ref $string) (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -206,8 +206,8 @@
    (func $caml_bytes_get64 (export "caml_bytes_get64")
       (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
       (local $s (ref $string)) (local $p i32)
-      (local.set $s (ref.cast $string (local.get $v)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get $i))))
+      (local.set $s (ref.cast (ref $string) (local.get $v)))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
@@ -255,9 +255,9 @@
    (func (export "caml_bytes_set16")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       (local $s (ref $string)) (local $p i32) (local $v i32)
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $v (i31.get_s (ref.cast i31 (local.get 2))))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
+      (local.set $v (i31.get_s (ref.cast (ref i31) (local.get 2))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
@@ -272,9 +272,9 @@
    (func (export "caml_bytes_set32")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       (local $s (ref $string)) (local $p i32) (local $v i32)
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $v (struct.get $int32 1 (ref.cast $int32 (local.get 2))))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
+      (local.set $v (struct.get $int32 1 (ref.cast (ref $int32) (local.get 2))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -295,9 +295,9 @@
    (func (export "caml_bytes_set64")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       (local $s (ref $string)) (local $p i32) (local $v i64)
-      (local.set $s (ref.cast $string (local.get 0)))
-      (local.set $p (i31.get_s (ref.cast i31 (local.get 1))))
-      (local.set $v (struct.get $int64 1 (ref.cast $int64 (local.get 2))))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
+      (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
+      (local.set $v (struct.get $int64 1 (ref.cast (ref $int64) (local.get 2))))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index 22230e69e4..f66e56c57b 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -29,7 +29,7 @@
 
    (global $mutex_ops (ref $custom_operations)
       (struct.new $custom_operations
-         (array.new_fixed $string ;; "_mutex"
+         (array.new_fixed $string 6 ;; "_mutex"
             (i32.const 95) (i32.const 109) (i32.const 117) (i32.const 116)
             (i32.const 101) (i32.const 120))
          (ref.func $custom_compare_id)
@@ -51,7 +51,7 @@
 
    (func (export "caml_ml_mutex_lock") (param (ref eq)) (result (ref eq))
       (local $t (ref $mutex))
-      (local.set $t (ref.cast $mutex (local.get 0)))
+      (local.set $t (ref.cast (ref $mutex) (local.get 0)))
       (if (struct.get $mutex $state (local.get $t))
          (then
             (call $caml_failwith
@@ -62,7 +62,7 @@
 
    (func (export "caml_ml_try_lock") (param (ref eq)) (result (ref eq))
       (local $t (ref $mutex))
-      (local.set $t (ref.cast $mutex (local.get 0)))
+      (local.set $t (ref.cast (ref $mutex) (local.get 0)))
       (if (result (ref eq)) (struct.get $mutex $state (local.get $t))
          (then
             (i31.new (i32.const 0)))
@@ -71,7 +71,8 @@
             (i31.new (i32.const 1)))))
 
    (func (export "caml_ml_mutex_unlock") (param (ref eq)) (result (ref eq))
-      (struct.set $mutex $state (ref.cast $mutex (local.get 0)) (i32.const 0))
+      (struct.set $mutex $state
+         (ref.cast (ref $mutex) (local.get 0)) (i32.const 0))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_condition_new") (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index d399b806d0..3a55121949 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -28,7 +28,7 @@
    (tag $ocaml_exit (export "ocaml_exit") (param i32))
 
    (func (export "caml_sys_exit") (param (ref eq)) (result (ref eq))
-      (throw $ocaml_exit (i31.get_s (ref.cast i31 (local.get 0)))))
+      (throw $ocaml_exit (i31.get_s (ref.cast (ref i31) (local.get 0)))))
 
    (export "caml_sys_unsafe_getenv" (func $caml_sys_getenv))
    (func $caml_sys_getenv (export "caml_sys_getenv")
@@ -37,7 +37,7 @@
       (local.set $res
          (call $getenv
             (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
-      (if (i32.eqz (ref.test string (local.get $res)))
+      (if (i32.eqz (ref.test (ref string) (local.get $res)))
          (then
             (call $caml_raise_not_found)))
       (return_call $caml_string_of_jsstring (call $wrap (local.get $res))))
@@ -49,7 +49,7 @@
    (func (export "caml_sys_executable_name")
       (param (ref eq)) (result (ref eq))
       (array.get $block
-         (ref.cast $block (call $caml_js_to_string_array (call $argv)))
+         (ref.cast (ref $block) (call $caml_js_to_string_array (call $argv)))
          (i32.const 1)))
 
    (export "caml_sys_time_include_children" (func $caml_sys_time))
@@ -123,7 +123,7 @@
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       ;; (call $log_js (string.const "caml_sys_get_config"))
-      (array.new_fixed $block (i31.new (i32.const 0))
+      (array.new_fixed $block 4 (i31.new (i32.const 0))
          (array.new_data $string $Unix (i32.const 0) (i32.const 4))
          (i31.new (i32.const 32))
          (i31.new (i32.const 0))))
@@ -133,10 +133,10 @@
       (i31.new (i32.const 0)))
 
    (func (export "caml_runtime_variant") (param (ref eq)) (result (ref eq))
-      (array.new_fixed $string))
+      (array.new_fixed $string 0))
 
    (func (export "caml_runtime_parameters") (param (ref eq)) (result (ref eq))
-      (array.new_fixed $string))
+      (array.new_fixed $string 0))
 
    (func (export "caml_install_signal_handler")
       (param (ref eq)) (result (ref eq))
@@ -147,7 +147,7 @@
    (func (export "caml_ml_enable_runtime_warnings")
       (param (ref eq)) (result (ref eq))
       (global.set $caml_runtime_warnings
-         (i31.get_u (ref.cast i31 (local.get 0))))
+         (i31.get_u (ref.cast (ref i31) (local.get 0))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_runtime_warnings_enabled")
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index 32db54db34..99b9c481e6 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -20,7 +20,7 @@
       (param $sec i32) (param $min i32) (param $hour i32) (param $mday i32)
       (param $mon i32) (param $year i32) (param $wday i32) (param $yday i32)
       (param $isdst i32) (result (ref eq))
-      (array.new_fixed $block (i31.new (i32.const 0))
+      (array.new_fixed $block 10 (i31.new (i32.const 0))
          (i31.new (local.get $sec))
          (i31.new (local.get $min))
          (i31.new (local.get $hour))
@@ -33,12 +33,14 @@
 
    (export "caml_unix_gmtime" (func $unix_gmtime))
    (func $unix_gmtime (export "unix_gmtime") (param (ref eq)) (result (ref eq))
-      (call $gmtime (struct.get $float 0 (ref.cast $float (local.get 0)))))
+      (call $gmtime
+         (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
 
    (export "caml_unix_localtime" (func $unix_localtime))
    (func $unix_localtime (export "unix_localtime")
       (param (ref eq)) (result (ref eq))
-      (call $localtime (struct.get $float 0 (ref.cast $float (local.get 0)))))
+      (call $localtime
+         (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
 
    (export "caml_unix_time" (func $unix_time))
    (func $unix_time (export "unix_time") (param (ref eq)) (result (ref eq))
@@ -47,32 +49,32 @@
    (export "caml_unix_mktime" (func $unix_mktime))
    (func $unix_mktime (export "unix_mktime") (param (ref eq)) (result (ref eq))
       (local $tm (ref $block)) (local $t f64)
-      (local.set $tm (ref.cast $block (local.get 0)))
+      (local.set $tm (ref.cast (ref $block) (local.get 0)))
       (local.set $t
          (f64.div
             (call $mktime
                (i32.add
                   (i31.get_s
-                     (ref.cast i31
+                     (ref.cast (ref i31)
                        (array.get $block (local.get $tm) (i32.const 6))))
                   (i32.const 1900))
                (i31.get_s
-                  (ref.cast i31
+                  (ref.cast (ref i31)
                      (array.get $block (local.get $tm) (i32.const 5))))
                (i31.get_s
-                  (ref.cast i31
+                  (ref.cast (ref i31)
                      (array.get $block (local.get $tm) (i32.const 4))))
                (i31.get_s
-                  (ref.cast i31
+                  (ref.cast (ref i31)
                      (array.get $block (local.get $tm) (i32.const 3))))
                (i31.get_s
-                  (ref.cast i31
+                  (ref.cast (ref i31)
                      (array.get $block (local.get $tm) (i32.const 2))))
                (i31.get_s
-                  (ref.cast i31
+                  (ref.cast (ref i31)
                      (array.get $block (local.get $tm) (i32.const 1)))))
             (f64.const 1000)))
-      (array.new_fixed $block (i31.new (i32.const 0))
+      (array.new_fixed $block 3 (i31.new (i32.const 0))
          (struct.new $float (local.get $t))
          (call $localtime (local.get $t))))
 
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
index dc05b72f4c..b2043a3512 100644
--- a/runtime/wasm/weak.wat
+++ b/runtime/wasm/weak.wat
@@ -32,7 +32,7 @@
    (global $caml_ephe_key_offset i32 (i32.const 3))
 
    (global $caml_ephe_none (ref eq)
-      (array.new_fixed $block (i31.new (global.get $abstract_tag))))
+      (array.new_fixed $block 1 (i31.new (global.get $abstract_tag))))
 
    (func $caml_ephe_get_data (export "caml_ephe_get_data")
       (param $vx (ref eq)) (result (ref eq))
@@ -40,7 +40,7 @@
       (local $d (ref eq)) (local $v (ref eq))
       (local $m (ref any))
       (local $i i32) (local $len i32)
-      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (local.set $d
          (array.get $block (local.get $x) (global.get $caml_ephe_data_offset)))
       (block $no_data
@@ -58,7 +58,7 @@
                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
                      (br_if $loop
                         (ref.eq (local.get $v) (global.get $caml_ephe_none)))
-                     (br_if $loop (ref.test i31 (local.get $v)))
+                     (br_if $loop (ref.test (ref i31) (local.get $v)))
                      (local.set $v
                         (br_on_null $released
                            (call $weak_deref (call $unwrap (local.get $v)))))
@@ -67,8 +67,8 @@
                            (call $weak_map_get (local.get $m) (local.get $v))))
                      (br $loop))))
             (return
-              (array.new_fixed $block (i31.new (i32.const 0))
-                 (ref.cast eq (local.get $m)))))
+              (array.new_fixed $block 2 (i31.new (i32.const 0))
+                 (ref.cast (ref eq) (local.get $m)))))
          (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
             (global.get $caml_ephe_none)))
       (i31.new (i32.const 0)))
@@ -79,7 +79,7 @@
       (local.set $r (call $caml_ephe_get_data (local.get $x)))
       (drop (block $no_copy (result (ref eq))
          (return
-            (array.new_fixed $block (i31.new (i32.const 0))
+            (array.new_fixed $block 2 (i31.new (i32.const 0))
                (call $caml_obj_dup
                   (br_on_cast_fail $no_copy (ref eq) (ref $block)
                      (array.get $block
@@ -94,7 +94,7 @@
       (local $v (ref eq))
       (local $m (ref any)) (local $m' (ref any))
       (local $i i32)
-      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (local.set $i (array.len (local.get $x)))
       (local.set $m (local.get $data))
       (loop $loop
@@ -105,7 +105,7 @@
                   (array.get $block (local.get $x) (local.get $i)))
                (br_if $loop
                   (ref.eq (local.get $v) (global.get $caml_ephe_none)))
-               (br_if $loop (ref.test i31 (local.get $v)))
+               (br_if $loop (ref.test (ref i31) (local.get $v)))
                (block $released
                   (local.set $v
                      (br_on_null $released
@@ -125,7 +125,7 @@
    (func (export "caml_ephe_unset_data")
       (param $vx (ref eq)) (result (ref eq))
       (local $x (ref $block))
-      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
          (global.get $caml_ephe_none))
       (i31.new (i32.const 0)))
@@ -152,16 +152,16 @@
       (local $x (ref $block))
       (local $i i32)
       (local $v (ref eq))
-      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (local.set $i
          (i32.add (global.get $caml_ephe_key_offset)
-            (i31.get_s (ref.cast i31 (local.get $vi)))))
+            (i31.get_s (ref.cast (ref i31) (local.get $vi)))))
       (local.set $v (array.get $block (local.get $x) (local.get $i)))
       (block $value
          (block $no_value
             (br_if $no_value
                (ref.eq (local.get $v) (global.get $caml_ephe_none)))
-            (br_if $value (ref.test i31 (local.get $v)))
+            (br_if $value (ref.test (ref i31) (local.get $v)))
             (block $released
                (local.set $v
                   (br_on_null $released
@@ -172,7 +172,7 @@
             (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
                (global.get $caml_ephe_none)))
          (return (i31.new (i32.const 0))))
-      (array.new_fixed $block (i31.new (i32.const 0)) (local.get $v)))
+      (array.new_fixed $block 2 (i31.new (i32.const 0)) (local.get $v)))
 
    (export "caml_weak_get_copy" (func $caml_ephe_get_key_copy))
    (func $caml_ephe_get_key_copy (export "caml_ephe_get_key_copy")
@@ -181,7 +181,7 @@
       (local.set $r (call $caml_ephe_get_key (local.get $x) (local.get $i)))
       (drop (block $no_copy (result (ref eq))
          (return
-            (array.new_fixed $block (i31.new (i32.const 0))
+            (array.new_fixed $block 2 (i31.new (i32.const 0))
                (call $caml_obj_dup
                   (br_on_cast_fail $no_copy (ref eq) (ref $block)
                      (array.get $block
@@ -196,16 +196,16 @@
       (local $x (ref $block))
       (local $i i32)
       (local $v (ref eq))
-      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (local.set $i
-        (i32.add (i31.get_s (ref.cast i31 (local.get $vi)))
+        (i32.add (i31.get_s (ref.cast (ref i31) (local.get $vi)))
            (global.get $caml_ephe_key_offset)))
       (local.set $v (array.get $block (local.get $x) (local.get $i)))
       (block $value
          (block $no_value
             (br_if $no_value
                (ref.eq (local.get $v) (global.get $caml_ephe_none)))
-            (br_if $value (ref.test i31 (local.get $v)))
+            (br_if $value (ref.test (ref i31) (local.get $v)))
             (br_if $value
                (i32.eqz
                   (ref.is_null
@@ -223,14 +223,15 @@
       (local $x (ref $block))
       (local $d (ref eq))
       (local $i i32)
-      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (local.set $i
-         (i32.add (i31.get_s (ref.cast i31 (local.get $vi)))
+         (i32.add (i31.get_s (ref.cast (ref i31) (local.get $vi)))
             (global.get $caml_ephe_key_offset)))
       (local.set $d (i31.new (i32.const 0)))
-      (if (ref.test i31 (local.get $v))
+      (if (ref.test (ref i31) (local.get $v))
          (then
-            (if (ref.test $js (array.get $block (local.get $x) (local.get $i)))
+            (if (ref.test (ref $js)
+                   (array.get $block (local.get $x) (local.get $i)))
                (then
                   (local.set $d (call $caml_ephe_get_data (local.get $vx)))))
             (array.set $block (local.get $x) (local.get $i) (local.get $v)))
@@ -246,12 +247,12 @@
       (local $x (ref $block))
       (local $d (ref eq))
       (local $i i32)
-      (local.set $x (ref.cast $block (local.get $vx)))
+      (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (local.set $i
-         (i32.add (i31.get_s (ref.cast i31 (local.get $vi)))
+         (i32.add (i31.get_s (ref.cast (ref i31) (local.get $vi)))
             (global.get $caml_ephe_key_offset)))
       (local.set $d (i31.new (i32.const 0)))
-      (if (ref.test $js (array.get $block (local.get $x) (local.get $i)))
+      (if (ref.test (ref $js) (array.get $block (local.get $x) (local.get $i)))
          (then
             (local.set $d (call $caml_ephe_get_data (local.get $vx)))))
       (array.set $block (local.get $x) (local.get $i)
@@ -266,7 +267,7 @@
       (param $vlen (ref eq)) (result (ref eq))
       (local $len i32)
       (local $res (ref $block))
-      (local.set $len (i31.get_s (ref.cast i31 (local.get $vlen))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (if (i32.lt_s (local.get $len) (i32.const 0))
          (then
             (call $caml_invalid_argument
@@ -293,13 +294,13 @@
       (local $d (ref eq))
       (local.set $d (call $caml_ephe_get_data (local.get $y)))
       (array.copy $block $block
-         (ref.cast $block (local.get $y))
-         (i32.add (i31.get_s (ref.cast i31 (local.get $j)))
+         (ref.cast (ref $block) (local.get $y))
+         (i32.add (i31.get_s (ref.cast (ref i31) (local.get $j)))
             (global.get $caml_ephe_key_offset))
-         (ref.cast $block (local.get $x))
-         (i32.add (i31.get_s (ref.cast i31 (local.get $i)))
+         (ref.cast (ref $block) (local.get $x))
+         (i32.add (i31.get_s (ref.cast (ref i31) (local.get $i)))
             (global.get $caml_ephe_key_offset))
-         (i31.get_s (ref.cast i31 (local.get $l))))
+         (i31.get_s (ref.cast (ref i31) (local.get $l))))
       (call $caml_ephe_set_data_opt (local.get $y) (local.get $d))
       (i31.new (i32.const 0)))
 

From 4812c57aacbc597305eda6f77514d629aa16c864 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Aug 2023 12:00:32 +0200
Subject: [PATCH 118/481] Runtime: marshaling + fixes

---
 compiler/lib/wasm/wa_gc_target.ml  |   38 +
 runtime/wasm/bigarray.wat          |  373 +++++++-
 runtime/wasm/bigstring.wat         |   63 +-
 runtime/wasm/compare.wat           |   42 +-
 runtime/wasm/custom.wat            |   83 +-
 runtime/wasm/domain.wat            |    2 +-
 runtime/wasm/effect.wat            |    4 +-
 runtime/wasm/fail.wat              |    7 +
 runtime/wasm/hash.wat              |   28 +-
 runtime/wasm/int32.wat             |   79 +-
 runtime/wasm/int64.wat             |   46 +-
 runtime/wasm/io.wat                |  378 ++++++--
 runtime/wasm/jslib.wat             |    2 +-
 runtime/wasm/jslib_js_of_ocaml.wat |    2 +-
 runtime/wasm/marshal.wat           | 1427 +++++++++++++++++++++++++++-
 runtime/wasm/md5.wat               |   45 +-
 runtime/wasm/obj.wat               |   19 +-
 runtime/wasm/prng.wat              |   30 +-
 runtime/wasm/runtime.js            |    2 +-
 runtime/wasm/string.wat            |   45 +-
 runtime/wasm/sync.wat              |   30 +-
 21 files changed, 2429 insertions(+), 316 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 5e72e4e635..ec5d843d58 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -49,11 +49,40 @@ module Type = struct
           ; typ = W.Func { W.params = [ value ]; result = [ I32 ] }
           })
 
+  let fixed_length_type =
+    register_type "fixed_length" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ =
+              W.Struct
+                [ { mut = false; typ = Value I32 }; { mut = false; typ = Value I32 } ]
+          })
+
+  let serialize_type =
+    register_type "serialize" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Func { W.params = [ value; value ]; result = [ I32; I32 ] }
+          })
+
+  let deserialize_type =
+    register_type "deserialize" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Func { W.params = [ value ]; result = [ value; I32 ] }
+          })
+
   let custom_operations_type =
     register_type "custom_operations" (fun () ->
         let* string = string_type in
         let* compare = compare_type in
         let* hash = hash_type in
+        let* fixed_length = fixed_length_type in
+        let* serialize = serialize_type in
+        let* deserialize = deserialize_type in
         return
           { supertype = None
           ; final = true
@@ -69,6 +98,15 @@ module Type = struct
                   ; typ = Value (Ref { nullable = true; typ = Type compare })
                   }
                 ; { mut = false; typ = Value (Ref { nullable = true; typ = Type hash }) }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = true; typ = Type fixed_length })
+                  }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = true; typ = Type serialize })
+                  }
+                ; { mut = false
+                  ; typ = Value (Ref { nullable = true; typ = Type deserialize })
+                  }
                 ]
           })
 
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index f243fc83ef..9a8daad19d 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -49,14 +49,19 @@
    (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "int32" "caml_copy_int32"
       (func $caml_copy_int32 (param i32) (result (ref eq))))
+   (import "int32" "Int32_val"
+      (func $Int32_val (param (ref eq)) (result i32)))
    (import "int32" "caml_copy_nativeint"
       (func $caml_copy_nativeint (param i32) (result (ref eq))))
    (import "int64" "caml_copy_int64"
       (func $caml_copy_int64 (param i64) (result (ref eq))))
+   (import "int64" "Int64_val"
+      (func $Int64_val (param (ref eq)) (result i64)))
    (import "obj" "double_array_tag" (global $double_array_tag i32))
    (import "compare" "unordered" (global $unordered i32))
    (import "hash" "caml_hash_mix_int"
@@ -67,30 +72,51 @@
       (func $caml_hash_mix_float (param i32) (param f64) (result i32)))
    (import "hash" "caml_hash_mix_float32"
       (func $caml_hash_mix_float32 (param i32) (param f32) (result i32)))
+   (import "marshal" "caml_serialize_int_1"
+      (func $caml_serialize_int_1 (param (ref eq)) (param i32)))
+   (import "marshal" "caml_serialize_int_2"
+      (func $caml_serialize_int_2 (param (ref eq)) (param i32)))
+   (import "marshal" "caml_serialize_int_4"
+      (func $caml_serialize_int_4 (param (ref eq)) (param i32)))
+   (import "marshal" "caml_serialize_int_8"
+      (func $caml_serialize_int_8 (param (ref eq)) (param i64)))
+   (import "marshal" "caml_deserialize_uint_1"
+      (func $caml_deserialize_uint_1 (param (ref eq)) (result i32)))
+   (import "marshal" "caml_deserialize_sint_1"
+      (func $caml_deserialize_sint_1 (param (ref eq)) (result i32)))
+   (import "marshal" "caml_deserialize_uint_2"
+      (func $caml_deserialize_uint_2 (param (ref eq)) (result i32)))
+   (import "marshal" "caml_deserialize_sint_2"
+      (func $caml_deserialize_sint_2 (param (ref eq)) (result i32)))
+   (import "marshal" "caml_deserialize_int_4"
+      (func $caml_deserialize_int_4 (param (ref eq)) (result i32)))
+   (import "marshal" "caml_deserialize_int_8"
+      (func $caml_deserialize_int_8 (param (ref eq)) (result i64)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
-   (type $value->value->int->int
+
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
-   (type $int32
-      (sub final $custom (struct (field (ref $custom_operations)) (field i32))))
-   (type $int64
-      (sub final $custom (struct (field (ref $custom_operations)) (field i64))))
-   (type $int_array (array (mut i32)))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
 
-   (global $bigarray_ops (ref $custom_operations)
+   (global $bigarray_ops (export "bigarray_ops") (ref $custom_operations)
       ;; ZZZ
       (struct.new $custom_operations
          (array.new_fixed $string 9 ;; "_bigarr02"
@@ -98,8 +124,13 @@
             (i32.const 97) (i32.const 114) (i32.const 114) (i32.const 48)
             (i32.const 50))
          (ref.func $caml_ba_compare)
-         (ref.null $value->value->int->int)
-         (ref.func $bigarray_hash)))
+         (ref.null $compare)
+         (ref.func $bigarray_hash)
+         (ref.null $fixed_length)
+         (ref.func $bigarray_serialize)
+         (ref.func $bigarray_deserialize)))
+
+   (type $int_array (array (mut i32)))
 
    (type $bigarray
       (sub final $custom
@@ -118,8 +149,8 @@
       (local.set $b (ref.cast (ref $bigarray) (local.get 0)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
       (local.set $len (call $ta_length (local.get $data)))
-      (block $float32
-       (block $float64
+      (block $float64
+       (block $float32
         (block $int8
          (block $uint8
           (block $int16
@@ -164,7 +195,7 @@
             (return (local.get $h)))
            ;; uint16
            (if (i32.gt_u (local.get $len) (i32.const 128))
-              (then (local.set $len (i32.const 182))))
+              (then (local.set $len (i32.const 128))))
            (loop $loop
               (if (i32.le_u (i32.add (local.get $i) (i32.const 2))
                      (local.get $len))
@@ -187,7 +218,7 @@
            (return (local.get $h)))
           ;; int16
           (if (i32.gt_u (local.get $len) (i32.const 128))
-             (then (local.set $len (i32.const 182))))
+             (then (local.set $len (i32.const 128))))
           (loop $loop
              (if (i32.le_u (i32.add (local.get $i) (i32.const 2))
                     (local.get $len))
@@ -327,6 +358,287 @@
                (br $loop))))
       (return (local.get $h)))
 
+   (func $bigarray_serialize
+      (param $s (ref eq)) (param $v (ref eq)) (result i32) (result i32)
+      (local $b (ref $bigarray))
+      (local $num_dims i32) (local $dim (ref $int_array))
+      (local $data (ref extern))
+      (local $i i32) (local $len i32)
+      (local.set $b (ref.cast (ref $bigarray) (local.get $v)))
+      (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $b)))
+      (local.set $dim (struct.get $bigarray $ba_dim (local.get $b)))
+      (call $caml_serialize_int_4 (local.get $s) (local.get $num_dims))
+      (call $caml_serialize_int_4 (local.get $s)
+         (i32.or (struct.get $bigarray $ba_kind (local.get $b))
+            (i32.shl (struct.get $bigarray $ba_layout (local.get $b))
+               (i32.const 8))))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $num_dims))
+            (then
+               (local.set $len
+                  (array.get $int_array (local.get $dim) (local.get $i)))
+               (if (i32.lt_u (local.get $len) (i32.const 0xffff))
+                  (then
+                     (call $caml_serialize_int_2 (local.get $s)
+                        (local.get $len)))
+                  (else
+                     (call $caml_serialize_int_2 (local.get $s)
+                        (i32.const 0xffff))
+                     (call $caml_serialize_int_8 (local.get $s)
+                        (i64.extend_i32_u (local.get $len)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (block $done
+       (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
+       (local.set $len (call $ta_length (local.get $data)))
+       (local.set $i (i32.const 0))
+       (block $float64
+        (block $float32
+         (block $int8
+          (block $uint8
+           (block $int16
+            (block $uint16
+             (block $int32
+              (block $int
+               (block $int64
+                (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                          $int32 $int64 $int $int
+                          $float32 $float64 $uint8
+                   (struct.get $bigarray $ba_kind (local.get $b))))
+               ;; int64
+               (loop $loop
+                  (if (i32.lt_u (local.get $i) (local.get $len))
+                     (then
+                        (call $caml_serialize_int_8 (local.get $s)
+                           (i64.or
+                              (i64.extend_i32_u
+                                 (call $ta_get_i32 (local.get $data)
+                                    (local.get $i)))
+                              (i64.shl
+                                 (i64.extend_i32_u
+                                    (call $ta_get_i32 (local.get $data)
+                                       (i32.add (local.get $i) (i32.const 1))))
+                                 (i64.const 32))))
+                        (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                        (br $loop))))
+               (br $done))
+              ;; int
+              (call $caml_serialize_int_1 (local.get $s) (i32.const 0)))
+             ;; int32
+             (loop $loop
+                (if (i32.lt_u (local.get $i) (local.get $len))
+                   (then
+                      (call $caml_serialize_int_4 (local.get $s)
+                         (call $ta_get_i32 (local.get $data) (local.get $i)))
+                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                      (br $loop))))
+             (br $done))
+            ;; uint16
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (call $caml_serialize_int_2 (local.get $s)
+                        (call $ta_get_ui16 (local.get $data) (local.get $i)))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (br $done))
+           ;; int16
+           (loop $loop
+              (if (i32.lt_u (local.get $i) (local.get $len))
+                 (then
+                    (call $caml_serialize_int_2 (local.get $s)
+                       (call $ta_get_i16 (local.get $data) (local.get $i)))
+                    (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                    (br $loop))))
+           (br $done))
+          ;; uint8
+          (loop $loop
+             (if (i32.lt_u (local.get $i) (local.get $len))
+                (then
+                   (call $caml_serialize_int_1 (local.get $s)
+                      (call $ta_get_ui8 (local.get $data) (local.get $i)))
+                   (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                   (br $loop))))
+          (br $done))
+         ;; int8
+         (loop $loop
+            (if (i32.lt_u (local.get $i) (local.get $len))
+               (then
+                  (call $caml_serialize_int_1 (local.get $s)
+                     (call $ta_get_i8 (local.get $data) (local.get $i)))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (br $loop))))
+         (br $done))
+        ;; float32
+        (loop $loop
+           (if (i32.lt_u (local.get $i) (local.get $len))
+              (then
+                 (call $caml_serialize_int_4 (local.get $s)
+                    (i32.reinterpret_f32
+                       (f32.demote_f64
+                          (call $ta_get_f32 (local.get $data) (local.get $i)))))
+                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                 (br $loop))))
+        (br $done))
+       ;; float64
+       (loop $loop
+          (if (i32.lt_u (local.get $i) (local.get $len))
+             (then
+                (call $caml_serialize_int_8 (local.get $s)
+                   (i64.reinterpret_f64
+                      (call $ta_get_f64 (local.get $data) (local.get $i))))
+                (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                (br $loop)))))
+      (tuple.make
+         (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4))
+         (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 8))))
+
+   (data $intern_overflow
+      "input_value: cannot read bigarray with 64-bit OCaml ints")
+
+   (func $bigarray_deserialize
+      (param $s (ref eq)) (result (ref eq)) (result i32)
+      (local $b (ref $bigarray))
+      (local $num_dims i32) (local $dim (ref $int_array))
+      (local $flags i32) (local $kind i32)
+      (local $data (ref extern))
+      (local $i i32) (local $len i32)
+      (local $l i64)
+      (local.set $num_dims (call $caml_deserialize_int_4 (local.get $s)))
+      (local.set $flags (call $caml_deserialize_int_4 (local.get $s)))
+      (local.set $kind (i32.and (local.get $flags) (i32.const 0xff)))
+      (local.set $dim (array.new $int_array (i32.const 0) (local.get $num_dims)))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $num_dims))
+            (then
+               (local.set $len
+                  (call $caml_deserialize_uint_2 (local.get $s)))
+               (if (i32.eq (local.get $len) (i32.const 0xffff))
+                  (then
+                     ;; ZZZ overflows?
+                     (local.set $len
+                        (i32.wrap_i64
+                           (call $caml_deserialize_int_8 (local.get $s))))))
+               (array.set $int_array (local.get $dim) (local.get $i)
+                  (local.get $len))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (local.set $b
+         (struct.new $bigarray
+            (global.get $bigarray_ops)
+            (call $caml_ba_create_buffer (local.get $kind)
+               (call $caml_ba_get_size (local.get $dim)))
+            (local.get $dim)
+            (local.get $num_dims)
+            (local.get $kind)
+            (i32.shr_u (local.get $flags) (i32.const 8))))
+      (block $done
+       (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
+       (local.set $len (call $ta_length (local.get $data)))
+       (local.set $i (i32.const 0))
+       (block $float64
+        (block $float32
+         (block $int8
+          (block $uint8
+           (block $int16
+            (block $uint16
+             (block $int32
+              (block $int
+               (block $int64
+                (br_table $float32 $float64 $int8 $uint8 $int16 $uint16
+                          $int32 $int64 $int $int
+                          $float32 $float64 $uint8
+                   (struct.get $bigarray $ba_kind (local.get $b))))
+               ;; int64
+               (loop $loop
+                  (if (i32.lt_u (local.get $i) (local.get $len))
+                     (then
+                        (local.set $l
+                           (call $caml_deserialize_int_8 (local.get $s)))
+                        (call $ta_set_i32 (local.get $data) (local.get $i)
+                           (i32.wrap_i64 (local.get $l)))
+                        (call $ta_set_i32 (local.get $data)
+                           (i32.add (local.get $i) (i32.const 1))
+                           (i32.wrap_i64
+                              (i64.shr_u (local.get $l) (i64.const 32))))
+                        (local.set $i (i32.add (local.get $i) (i32.const 2)))
+                        (br $loop))))
+               (br $done))
+              ;; int
+              (if (call $caml_deserialize_uint_1 (local.get $s))
+                 (then
+                    (call $caml_failwith
+                       (array.new_data $string $intern_overflow
+                          (i32.const 0) (i32.const 56))))))
+             ;; int32
+             (loop $loop
+                (if (i32.lt_u (local.get $i) (local.get $len))
+                   (then
+                      (call $ta_set_i32 (local.get $data) (local.get $i)
+                         (call $caml_deserialize_int_4 (local.get $s)))
+                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                      (br $loop))))
+             (br $done))
+            ;; uint16
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (call $ta_set_ui16 (local.get $data) (local.get $i)
+                        (i31.new (call $caml_deserialize_uint_2 (local.get $s))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (br $done))
+           ;; int16
+           (loop $loop
+              (if (i32.lt_u (local.get $i) (local.get $len))
+                 (then
+                    (call $ta_set_i16 (local.get $data) (local.get $i)
+                       (i31.new (call $caml_deserialize_sint_2 (local.get $s))))
+                    (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                    (br $loop))))
+           (br $done))
+          ;; uint8
+          (loop $loop
+             (if (i32.lt_u (local.get $i) (local.get $len))
+                (then
+                   (call $ta_set_ui8 (local.get $data) (local.get $i)
+                      (i31.new (call $caml_deserialize_uint_1 (local.get $s))))
+                   (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                   (br $loop))))
+          (br $done))
+         ;; int8
+         (loop $loop
+            (if (i32.lt_u (local.get $i) (local.get $len))
+               (then
+                  (call $ta_set_i8 (local.get $data) (local.get $i)
+                     (i31.new (call $caml_deserialize_sint_1 (local.get $s))))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (br $loop))))
+         (br $done))
+        ;; float32
+        (loop $loop
+           (if (i32.lt_u (local.get $i) (local.get $len))
+              (then
+                 (call $ta_set_f32 (local.get $data) (local.get $i)
+                    (f64.promote_f32
+                       (f32.reinterpret_i32
+                          (call $caml_deserialize_int_4 (local.get $s)))))
+                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                 (br $loop))))
+        (br $done))
+       ;; float64
+       (loop $loop
+          (if (i32.lt_u (local.get $i) (local.get $len))
+             (then
+                (call $ta_set_f64 (local.get $data) (local.get $i)
+                   (f64.reinterpret_i64
+                      (call $caml_deserialize_int_8 (local.get $s))))
+                (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                (br $loop)))))
+      (tuple.make
+         (local.get $b)
+         (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4))))
+
    (func $caml_ba_get_size (param $dim (ref $int_array)) (result i32)
       (local $i i32) (local $n i32) (local $sz i64)
       (local.set $n (array.len (local.get $dim)))
@@ -577,7 +889,7 @@
                 (return))
                ;; nativeint
                (call $ta_set_i32 (local.get $data) (local.get $i)
-                  (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
+                  (call $Int32_val (local.get $v)))
                (return))
               ;; int
               (call $ta_set_i32 (local.get $data) (local.get $i)
@@ -585,8 +897,7 @@
               (return))
              ;; int64
              (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-             (local.set $l
-                (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
+             (local.set $l (call $Int64_val (local.get $v)))
              (call $ta_set_i32 (local.get $data) (local.get $i)
                 (i32.wrap_i64 (local.get $l)))
              (call $ta_set_i32 (local.get $data)
@@ -595,7 +906,7 @@
              (return))
             ;; int32
             (call $ta_set_i32 (local.get $data) (local.get $i)
-               (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
+               (call $Int32_val (local.get $v)))
             (return))
            ;; uint16
            (call $ta_set_ui16 (local.get $data) (local.get $i)
@@ -1207,8 +1518,7 @@
            (return (i31.new (i32.const 0))))
           ;; int64
           (local.set $len (call $ta_length (local.get $data)))
-          (local.set $l
-             (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
+          (local.set $l (call $Int64_val (local.get $v)))
           (local.set $i1 (i32.wrap_i64 (local.get $l)))
           (local.set $i2
              (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32))))
@@ -1224,8 +1534,7 @@
                    (br $loop))))
           (return (i31.new (i32.const 0))))
          ;; int32
-         (call $ta_fill_int (local.get $data)
-            (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
+         (call $ta_fill_int (local.get $data) (call $Int32_val (local.get $v)))
          (return (i31.new (i32.const 0))))
         ;; int
         (call $ta_fill_int (local.get $data)
@@ -1725,8 +2034,7 @@
       (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
-      (local.set $d
-         (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
+      (local.set $d (call $Int32_val (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -1756,8 +2064,7 @@
       (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
-      (local.set $d
-         (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
+      (local.set $d (call $Int64_val (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 7b9606b590..194d9d3bff 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -13,6 +13,8 @@
          (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "bigarray" "caml_ba_fill"
       (func $caml_ba_fill (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "bigarray" "caml_ba_get_data"
+      (func $caml_ba_get_data (param (ref eq)) (result (ref extern))))
    (import "bindings" "ta_create"
       (func $ta_create (param i32) (param anyref) (result anyref)))
    (import "bindings" "ta_get_ui8"
@@ -32,37 +34,12 @@
       (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
 
    (type $string (array (mut i8)))
-   (type $value->value->int->int
-      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
-      (func (param (ref eq)) (result i32)))
-   (type $custom_operations
-      (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
-   (type $int_array (array (mut i32)))
-   (type $bigarray
-      (sub final $custom
-         (struct
-            (field $ba_ops (ref $custom_operations))
-            (field $ba_data (mut (ref extern))) ;; data
-            (field $ba_dim (ref $int_array)) ;; size in each dimension
-            (field $ba_num_dims i8) ;; number of dimensions
-            (field $ba_kind i8) ;; kind
-            (field $ba_layout i8)))) ;; layout
 
    (func (export "caml_hash_mix_bigstring")
-      (param $h i32) (param $vb (ref eq)) (result i32)
-      (local $b (ref $bigarray))
+      (param $h i32) (param $b (ref eq)) (result i32)
       (local $data (ref extern))
       (local $len i32) (local $i i32) (local $w i32)
-      (local.set $b (ref.cast (ref $bigarray) (local.get $vb)))
-      (local.set $data (struct.get $bigarray $ba_data (local.get $b)))
+      (local.set $data (call $caml_ba_get_data (local.get $b)))
       (local.set $len (call $ta_len (local.get $data)))
       (loop $loop
          (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len))
@@ -139,13 +116,9 @@
       (local $c1 i32) (local $c2 i32)
       (local $d1 (ref extern))
       (local $d2 (ref extern))
-      (local.set $d1
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $s1))))
+      (local.set $d1 (call $caml_ba_get_data (local.get $s1)))
       (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
-      (local.set $d2
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $s2))))
+      (local.set $d2 (call $caml_ba_get_data (local.get $s2)))
       (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (loop $loop
@@ -172,9 +145,7 @@
       (local $c1 i32) (local $c2 i32)
       (local $d1 (ref extern))
       (local $s2 (ref $string))
-      (local.set $d1
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $s1))))
+      (local.set $d1 (call $caml_ba_get_data (local.get $s1)))
       (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
       (local.set $s2 (ref.cast (ref $string) (local.get $vs2)))
       (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
@@ -203,9 +174,7 @@
       (local.set $c (i31.get_s (ref.cast (ref i31) (local.get $vc))))
       (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (local.set $d
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $s))))
+      (local.set $d (call $caml_ba_get_data (local.get $s)))
       (loop $loop
          (if (i32.gt_s (local.get $len) (i32.const 0))
             (then
@@ -230,9 +199,7 @@
       (local $d2 (ref extern))
       (local.set $s1 (ref.cast (ref $string) (local.get $str1)))
       (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
-      (local.set $d2
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $ba2))))
+      (local.set $d2 (call $caml_ba_get_data (local.get $ba2)))
       (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (loop $loop
@@ -254,9 +221,7 @@
       (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
       (local $d1 (ref extern))
       (local $s2 (ref $string))
-      (local.set $d1
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $ba1))))
+      (local.set $d1 (call $caml_ba_get_data (local.get $ba1)))
       (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
       (local.set $s2 (ref.cast (ref $string) (local.get $str2)))
       (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
@@ -279,13 +244,9 @@
       (local $pos1 i32) (local $pos2 i32) (local $len i32)
       (local $d1 (ref extern))
       (local $d2 (ref extern))
-      (local.set $d1
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $ba1))))
+      (local.set $d1 (call $caml_ba_get_data (local.get $ba1)))
       (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1))))
-      (local.set $d2
-         (struct.get $bigarray $ba_data
-            (ref.cast (ref $bigarray) (local.get $ba2))))
+      (local.set $d2 (call $caml_ba_get_data (local.get $ba2)))
       (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
       (call $ta_set (local.get $d2)
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 9e01f8ddeb..caca2c22df 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -19,7 +19,7 @@
    (type $float (struct (field f64)))
    (type $js (struct (field anyref)))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
 
    (type $int_array (array (mut i32)))
    (type $block_array (array (mut (ref $block))))
@@ -28,19 +28,25 @@
               (field (ref $block_array)) ;; first value
               (field (ref $block_array)) ;; second value
               (field (ref $int_array)))) ;; position in value
-   (type $value->value->int->int
+
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $dummy_block (ref $block)
       (array.new $block (i31.new (i32.const 0)) (i32.const 0)))
@@ -240,10 +246,10 @@
                          (br_on_cast_fail $v2_not_custom (ref eq) (ref $custom)
                             (local.get $v2)))
                      (local.set $res
-                        (call_ref $value->value->int->int
+                        (call_ref $compare
                            (local.get $v1) (local.get $v2) (local.get $total)
                            (br_on_null $v2_not_comparable
-                              (struct.get $custom_operations $cust_compare_ext
+                              (struct.get $custom_operations $compare_ext
                                  (struct.get $custom 0 (local.get $c2))))))
                      (br_if $next_item (i32.eqz (local.get $res)))
                      (return (local.get $res)))))
@@ -273,10 +279,10 @@
                                $v1_not_custom (ref eq) (ref $custom)
                                (local.get $v1)))
                         (local.set $res
-                           (call_ref $value->value->int->int
+                           (call_ref $compare
                               (local.get $v1) (local.get $v2) (local.get $total)
                               (br_on_null $v1_not_comparable
-                                 (struct.get $custom_operations $cust_compare_ext
+                                 (struct.get $custom_operations $compare_ext
                                     (struct.get $custom 0 (local.get $c1))))))
                         (br_if $next_item (i32.eqz (local.get $res)))
                         (return (local.get $res)))))
@@ -421,18 +427,18 @@
                            (i31.get_s
                               (ref.cast (ref i31)
                                  (call $caml_string_compare
-                                    (struct.get $custom_operations $cust_id
+                                    (struct.get $custom_operations $id
                                        (struct.get $custom 0
                                           (local.get $c1)))
-                                    (struct.get $custom_operations $cust_id
+                                    (struct.get $custom_operations $id
                                        (struct.get $custom 0
                                           (local.get $c2)))))))))
                   (block $not_comparable
                      (local.set $res
-                        (call_ref $value->value->int->int
+                        (call_ref $compare
                            (local.get $v1) (local.get $v2) (local.get $total)
                            (br_on_null $not_comparable
-                              (struct.get $custom_operations $cust_compare
+                              (struct.get $custom_operations $compare
                                  (struct.get $custom 0 (local.get $c1))))))
                      (br_if $next_item (i32.eqz (local.get $res)))
                      (return (local.get $res)))
diff --git a/runtime/wasm/custom.wat b/runtime/wasm/custom.wat
index d38d844c4e..0583a91f8e 100644
--- a/runtime/wasm/custom.wat
+++ b/runtime/wasm/custom.wat
@@ -1,18 +1,33 @@
 (module
+   (import "int32" "int32_ops" (global $int32_ops (ref $custom_operations)))
+   (import "int32" "nativeint_ops"
+      (global $nativeint_ops (ref $custom_operations)))
+   (import "int64" "int64_ops" (global $int64_ops (ref $custom_operations)))
+   (import "bigarray" "bigarray_ops"
+      (global $bigarray_ops (ref $custom_operations)))
+   (import "string" "caml_string_equal"
+      (func $caml_string_equal
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+
    (type $string (array (mut i8)))
-   (type $value->value->int->int
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (type $custom_with_id
       (sub $custom
@@ -20,6 +35,9 @@
             (field (ref $custom_operations))
             (field $id i64))))
 
+   (func (export "caml_is_custom") (param (ref eq)) (result i32)
+      (ref.test (ref $custom) (local.get 0)))
+
    (func (export "custom_compare_id")
       (param (ref eq)) (param (ref eq)) (param i32) (result i32)
       (local $i1 i64) (local $i2 i64)
@@ -44,4 +62,51 @@
       (local.set $id (global.get $next_id))
       (global.set $next_id (i64.add (local.get $id) (i64.const 1)))
       (local.get $id))
+
+   (type $custom_operations_list
+      (struct
+         (field $ops (ref $custom_operations))
+         (field $next (ref null $custom_operations_list))))
+
+   (global $custom_operations
+      (mut (ref null $custom_operations_list))
+      (ref.null $custom_operations_list))
+
+   (func $caml_register_custom_operations
+      (export "caml_register_custom_operations")
+      (param $ops (ref $custom_operations))
+      (global.set $custom_operations
+         (struct.new $custom_operations_list
+            (local.get $ops) (global.get $custom_operations))))
+
+   (func (export "caml_find_custom_operations")
+      (param $id (ref $string)) (result (ref null $custom_operations))
+      (local $l (ref null $custom_operations_list))
+      (block $not_found
+         (local.set $l (br_on_null $not_found (global.get $custom_operations)))
+         (loop $loop
+            (if (i31.get_u
+                   (ref.cast (ref i31)
+                       (call $caml_string_equal (local.get $id)
+                         (struct.get $custom_operations $id
+                            (struct.get $custom_operations_list $ops
+                               (local.get $l))))))
+               (then
+                  (return
+                     (struct.get $custom_operations_list $ops (local.get $l)))))
+            (local.set $l
+               (br_on_null $not_found
+                  (struct.get $custom_operations_list $next (local.get $l))))
+            (br $loop)))
+      (ref.null $custom_operations))
+
+   (global $initialized (mut i32) (i32.const 0))
+
+   (func (export "caml_init_custom_operations")
+      (if (global.get $initialized) (then (return)))
+      (call $caml_register_custom_operations (global.get $int32_ops))
+      (call $caml_register_custom_operations (global.get $nativeint_ops))
+      (call $caml_register_custom_operations (global.get $int64_ops))
+      (call $caml_register_custom_operations (global.get $bigarray_ops))
+      (global.set $initialized (i32.const 1)))
 )
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index 9dcb507d81..51a32529d6 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -1,7 +1,7 @@
 (module
    (type $block (array (mut (ref eq))))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
    (import "sync" "caml_ml_mutex_unlock"
       (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
 
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index f80d6ae155..916519bb08 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -16,7 +16,7 @@
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
    (type $function_3
       (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
    (type $closure_3
@@ -48,7 +48,7 @@
    ;; Capturing the current continuation
 
    (type $cont_func (func (param (ref $pair)) (param (ref eq))))
-   (type $cont (struct (field $cont_func (ref $cont_func))))
+   (type $cont (sub (struct (field $cont_func (ref $cont_func)))))
 
    (type $called_with_continuation
       (func (param (ref $cont)) (param (ref eq))))
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 614273c5ee..16ac7a5864 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -61,6 +61,13 @@
          (array.new_data $string $index_out_of_bounds
             (i32.const 0) (i32.const 19))))
 
+   (global $END_OF_FILE_EXN i32 (i32.const 4))
+
+   (func (export "caml_raise_end_of_file")
+      (return_call $caml_raise_constant
+         (array.get $block (global.get $caml_global_data)
+                    (global.get $END_OF_FILE_EXN))))
+
    (global $ZERO_DIVIDE_EXN i32 (i32.const 5))
 
    (func (export "caml_raise_zero_divide")
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index aa70d0fad8..c873b01f6d 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -7,19 +7,25 @@
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
    (type $js (struct (field anyref)))
-   (type $value->value->int->int
+
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (func $caml_hash_mix_int (export "caml_hash_mix_int")
       (param $h i32) (param $d i32) (result i32)
@@ -260,10 +266,10 @@
                   (drop (block $not_custom (result (ref eq))
                      (local.set $h
                         (call $caml_hash_mix_int (local.get $h)
-                           (call_ref $value->int
+                           (call_ref $hash
                               (local.get $v)
                               (br_on_null $loop
-                                 (struct.get $custom_operations $cust_hash
+                                 (struct.get $custom_operations $hash
                                     (struct.get $custom 0
                                        (br_on_cast_fail $not_custom
                                           (ref eq) (ref $custom)
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 0b66c65e28..0814d0ccc8 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -5,28 +5,45 @@
    (import "ints" "format_int"
       (func $format_int
          (param (ref eq)) (param i32) (param i32) (result (ref eq))))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+   (import "marshal" "caml_serialize_int_1"
+      (func $caml_serialize_int_1 (param (ref eq)) (param i32)))
+   (import "marshal" "caml_serialize_int_4"
+      (func $caml_serialize_int_4 (param (ref eq)) (param i32)))
+   (import "marshal" "caml_deserialize_uint_1"
+      (func $caml_deserialize_uint_1 (param (ref eq)) (result i32)))
+   (import "marshal" "caml_deserialize_int_4"
+      (func $caml_deserialize_int_4 (param (ref eq)) (result i32)))
 
    (type $string (array (mut i8)))
-   (type $value->value->int->int
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $int32_ops (export "int32_ops") (ref $custom_operations)
       (struct.new $custom_operations
          (array.new_fixed $string 2 (i32.const 95) (i32.const 105)) ;; "_i"
          (ref.func $int32_cmp)
-         (ref.null $value->value->int->int)
-         (ref.func $int32_hash)))
+         (ref.null $compare)
+         (ref.func $int32_hash)
+         (struct.new $fixed_length (i32.const 4) (i32.const 4))
+         (ref.func $int32_serialize)
+         (ref.func $int32_deserialize)))
 
    (type $int32
       (sub final $custom (struct (field (ref $custom_operations)) (field i32))))
@@ -44,6 +61,18 @@
    (func $int32_hash (param $v (ref eq)) (result i32)
       (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
 
+   (func $int32_serialize
+      (param $s (ref eq)) (param $v (ref eq)) (result i32) (result i32)
+      (call $caml_serialize_int_4 (local.get $s)
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
+      (tuple.make (i32.const 4) (i32.const 4)))
+
+   (func $int32_deserialize (param $s (ref eq)) (result (ref eq)) (result i32)
+      (tuple.make
+         (struct.new $int32 (global.get $int32_ops)
+            (call $caml_deserialize_int_4 (local.get $s)))
+         (i32.const 4)))
+
    (func $caml_copy_int32 (export "caml_copy_int32")
       (param $i i32) (result (ref eq))
       (struct.new $int32 (global.get $int32_ops) (local.get $i)))
@@ -89,8 +118,32 @@
       (struct.new $custom_operations
          (array.new_fixed $string 2 (i32.const 95) (i32.const 110)) ;; "_n"
          (ref.func $int32_cmp)
-         (ref.null $value->value->int->int)
-         (ref.func $int32_hash)))
+         (ref.null $compare)
+         (ref.func $int32_hash)
+         (struct.new $fixed_length (i32.const 4) (i32.const 8))
+         (ref.func $nativeint_serialize)
+         (ref.func $nativeint_deserialize)))
+
+   (func $nativeint_serialize
+      (param $s (ref eq)) (param $v (ref eq)) (result i32) (result i32)
+      (call $caml_serialize_int_1 (local.get $s) (i32.const 1))
+      (call $caml_serialize_int_4 (local.get $s)
+         (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
+      (tuple.make (i32.const 4) (i32.const 4)))
+
+   (data $integer_too_large "input_value: native integer value too large")
+
+   (func $nativeint_deserialize
+      (param $s (ref eq)) (result (ref eq)) (result i32)
+      (if (i32.ne (call $caml_deserialize_uint_1 (local.get $s)) (i32.const 1))
+         (then
+            (call $caml_failwith
+               (array.new_data $string $integer_too_large
+                  (i32.const 0) (i32.const 43)))))
+      (tuple.make
+         (struct.new $int32 (global.get $nativeint_ops)
+            (call $caml_deserialize_int_4 (local.get $s)))
+         (i32.const 4)))
 
    (func $caml_copy_nativeint (export "caml_copy_nativeint")
       (param $i i32) (result (ref eq))
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index b0c65b2c77..4840182c4e 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -8,28 +8,40 @@
       (func $parse_int_format
          (param (ref $string)) (result i32 i32 i32 i32 i32)))
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+   (import "marshal" "caml_serialize_int_8"
+      (func $caml_serialize_int_8 (param (ref eq)) (param i64)))
+   (import "marshal" "caml_deserialize_int_8"
+      (func $caml_deserialize_int_8 (param (ref eq)) (result i64)))
 
    (type $string (array (mut i8)))
-   (type $value->value->int->int
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $int64_ops (export "int64_ops") (ref $custom_operations)
       (struct.new $custom_operations
          (array.new_fixed $string 2 (i32.const 95) (i32.const 106)) ;; "_j"
          (ref.func $int64_cmp)
-         (ref.null $value->value->int->int)
-         (ref.func $int64_hash)))
+         (ref.null $compare)
+         (ref.func $int64_hash)
+         (struct.new $fixed_length (i32.const 8) (i32.const 8))
+         (ref.func $int64_serialize)
+         (ref.func $int64_deserialize)))
 
    (type $int64
       (sub final $custom (struct (field (ref $custom_operations)) (field i64))))
@@ -52,6 +64,18 @@
          (i32.wrap_i64 (local.get $i))
          (i32.wrap_i64 (i64.shr_u (local.get $i) (i64.const 32)))))
 
+   (func $int64_serialize
+      (param $s (ref eq)) (param $v (ref eq)) (result i32) (result i32)
+      (call $caml_serialize_int_8 (local.get $s)
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
+      (tuple.make (i32.const 8) (i32.const 8)))
+
+   (func $int64_deserialize (param $s (ref eq)) (result (ref eq)) (result i32)
+      (tuple.make
+         (struct.new $int64 (global.get $int64_ops)
+            (call $caml_deserialize_int_8 (local.get $s)))
+         (i32.const 8)))
+
    (func $caml_copy_int64 (export "caml_copy_int64")
       (param $i i64) (result (ref eq))
       (struct.new $int64 (global.get $int64_ops) (local.get $i)))
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 380e8c6d9c..3929621ae9 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -1,5 +1,6 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
+   (import "fail" "caml_raise_end_of_file" (func $caml_raise_end_of_file))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "jslib" "caml_jsstring_of_string"
@@ -40,19 +41,24 @@
    (type $string (array (mut i8)))
    (type $offset_array (array (mut i64)))
 
-   (type $value->value->int->int
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
    (type $custom_with_id
       (sub $custom
          (struct
@@ -65,8 +71,11 @@
             (i32.const 95) (i32.const 99) (i32.const 104) (i32.const 97)
             (i32.const 110))
          (ref.func $custom_compare_id)
-         (ref.null $value->value->int->int)
-         (ref.func $custom_hash_id)))
+         (ref.null $compare)
+         (ref.func $custom_hash_id)
+         (ref.null $fixed_length)
+         (ref.null $serialize)
+         (ref.null $deserialize)))
 
    (type $channel
       (sub final $custom_with_id
@@ -211,6 +220,119 @@
             (call $close (local.get $fd))))
       (i31.new (i32.const 0)))
 
+   (func $copy_from_buffer
+      (param $buf (ref extern)) (param $curr i32)
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (local $i i32)
+      (loop $loop
+        (if (i32.lt_u (local.get $i) (local.get $len))
+           (then
+              (array.set $string (local.get $s)
+                 (i32.add (local.get $pos) (local.get $i))
+                 (call $ta_get_ui8 (local.get $buf)
+                    (i32.add (local.get $curr) (local.get $i))))
+              (local.set $i (i32.add (local.get $i) (i32.const 1)))
+              (br $loop)))))
+
+   (func $caml_refill (param $ch (ref $channel)) (result i32)
+      (local $n i32) (local $offset i64) (local $fd i32)
+      (local $buf (ref extern))
+      (local.set $buf (struct.get $channel $buffer (local.get $ch)))
+      (local.set $fd (struct.get $channel $fd (local.get $ch)))
+      (local.set $offset
+         (array.get $offset_array (global.get $fd_offsets)
+            (local.get $fd)))
+      (local.set $n
+         (call $read
+            (local.get $fd)
+            (local.get $buf)
+            (i32.const 0)
+            (struct.get $channel $size (local.get $ch))
+            (local.get $offset)))
+      (array.set $offset_array
+         (global.get $fd_offsets) (local.get $fd)
+         (i64.add (local.get $offset)
+            (i64.extend_i32_u (local.get $n))))
+      (if (i32.eqz (local.get $n))
+         (then (call $caml_raise_end_of_file)))
+      (struct.set $channel $max (local.get $ch) (local.get $n))
+      (struct.set $channel $curr (local.get $ch) (i32.const 1))
+      (return (call $ta_get_ui8 (local.get $buf) (i32.const 0))))
+
+   (func $caml_getblock (export "caml_getblock")
+      (param $vch (ref eq)) (param $s (ref $string))
+      (param $pos i32) (param $len i32)
+      (result i32)
+      (local $ch (ref $channel))
+      (local $avail i32)
+      (local $fd i32)
+      (local $buf (ref extern))
+      (local $offset i64) (local $nread i32)
+      (if (i32.eqz (local.get $len))
+         (then (return (i32.const 0))))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (local.set $avail
+         (i32.sub (struct.get $channel $max (local.get $ch))
+            (struct.get $channel $curr (local.get $ch))))
+      (if (local.get $avail)
+         (then
+            (if (i32.gt_u (local.get $len) (local.get $avail))
+               (then (local.set $len (local.get $avail))))
+            (call $copy_from_buffer
+               (struct.get $channel $buffer (local.get $ch))
+               (struct.get $channel $curr (local.get $ch))
+               (local.get $s) (local.get $pos)
+               (local.get $len))
+            (struct.set $channel $curr (local.get $ch)
+               (i32.add (struct.get $channel $curr (local.get $ch))
+                  (local.get $len)))
+            (return (local.get $len))))
+      (local.set $fd (struct.get $channel $fd (local.get $ch)))
+      (local.set $offset
+         (array.get $offset_array (global.get $fd_offsets)
+            (local.get $fd)))
+      (local.set $buf (struct.get $channel $buffer (local.get $ch)))
+      (local.set $nread
+         (call $read
+            (local.get $fd)
+            (local.get $buf)
+            (i32.const 0)
+            (struct.get $channel $size (local.get $ch))
+            (local.get $offset)))
+      (array.set $offset_array
+         (global.get $fd_offsets) (local.get $fd)
+         (i64.add (local.get $offset)
+            (i64.extend_i32_u (local.get $nread))))
+      (struct.set $channel $max (local.get $ch) (local.get $nread))
+      (if (i32.gt_u (local.get $len) (local.get $nread))
+         (then (local.set $len (local.get $nread))))
+      (call $copy_from_buffer
+         (local.get $buf)
+         (i32.const 0)
+         (local.get $s) (local.get $pos)
+         (local.get $len))
+      (struct.set $channel $curr (local.get $ch) (local.get $len))
+      (local.get $len))
+
+   (func (export "caml_really_getblock")
+      (param $ch (ref eq)) (param $s (ref $string))
+      (param $pos i32) (param $len i32)
+      (result i32)
+      (local $read i32) (local $n i32)
+      (local.set $n (local.get $len))
+      (loop $loop
+         (if (local.get $n)
+            (then
+               (local.set $read
+                  (call $caml_getblock(local.get $ch)
+                     (local.get $s) (local.get $pos) (local.get $n)))
+               (if (i32.eqz (local.get $read))
+                  (then (return (i32.sub (local.get $len) (local.get $n)))))
+               (local.set $pos (i32.add (local.get $pos) (local.get $read)))
+               (local.set $n (i32.sub (local.get $n) (local.get $read)))
+               (br $loop))))
+      (local.get $len))
+
    (func (export "caml_ml_input")
       (param $vch (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq))
       (param $vlen (ref eq)) (result (ref eq))
@@ -253,47 +375,68 @@
                   (local.set $curr (i32.const 0))
                   (if (i32.gt_u (local.get $len) (local.get $nread))
                      (then (local.set $len (local.get $nread))))))))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $len))
-            (then
-               (array.set $string (local.get $s)
-                  (i32.add (local.get $pos) (local.get $i))
-                  (call $ta_get_ui8 (local.get $buf)
-                     (i32.add (local.get $curr) (local.get $i))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (call $copy_from_buffer
+         (local.get $buf) (local.get $curr)
+         (local.get $s) (local.get $pos) (local.get $len))
       (struct.set $channel $curr (local.get $ch)
          (i32.add (local.get $curr) (local.get $len)))
       (i31.new (local.get $len)))
 
-   (func (export "caml_input_value") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_input_value"))
-      (i31.new (i32.const 0)))
+   (func $caml_getch (param $ch (ref $channel)) (result i32)
+      (local $curr i32)
+      (local.set $curr (struct.get $channel $curr (local.get $ch)))
+      (if (i32.ge_u (local.get $curr) (struct.get $channel $max (local.get $ch)))
+         (then (return_call $caml_refill (local.get $ch))))
+      (struct.set $channel $curr (local.get $ch)
+         (i32.add (local.get $curr) (i32.const 1)))
+      (return_call $ta_get_ui8
+         (struct.get $channel $buffer (local.get $ch))
+         (local.get $curr)))
 
    (func (export "caml_ml_input_char")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input_char"))
-      (i31.new (i32.const 0)))
+      (param $ch (ref eq)) (result (ref eq))
+      (i31.new (call $caml_getch (ref.cast (ref $channel) (local.get $ch)))))
 
    (func (export "caml_ml_input_int")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input_int"))
-      (i31.new (i32.const 0)))
+      (param $vch (ref eq)) (result (ref eq))
+      (local $ch (ref $channel)) (local $res i32)
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (local.set $res
+         (i32.shl (call $caml_getch (local.get $ch)) (i32.const 24)))
+      (local.set $res
+         (i32.or (local.get $res)
+            (i32.shl (call $caml_getch (local.get $ch)) (i32.const 16))))
+      (local.set $res
+         (i32.or (local.get $res)
+            (i32.shl (call $caml_getch (local.get $ch)) (i32.const 8))))
+      (return
+         (i31.new (i32.or (local.get $res) (call $caml_getch (local.get $ch))))))
 
    (func (export "caml_ml_pos_in")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_pos_in"))
-      (i31.new (i32.const 0)))
+      (param $vch (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (i31.new
+         (i32.sub
+            (i32.wrap_i64
+               (array.get $offset_array
+                  (global.get $fd_offsets)
+                  (struct.get $channel $fd (local.get $ch))))
+            (i32.sub
+              (struct.get $channel $max (local.get $ch))
+              (struct.get $channel $curr (local.get $ch))))))
 
    (func (export "caml_ml_pos_out")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_pos_out"))
-      (i31.new (i32.const 0)))
+      (param $vch (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (i31.new
+         (i32.add
+            (i32.wrap_i64
+               (array.get $offset_array
+                  (global.get $fd_offsets)
+                  (struct.get $channel $fd (local.get $ch))))
+            (struct.get $channel $curr (local.get $ch)))))
 
    (func (export "caml_ml_seek_in")
       (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
@@ -316,24 +459,96 @@
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_seek_out")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_seek_out"))
+      (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (call $caml_flush (local.get $ch))
+      ;; ZZZ Check for error
+      (array.set $offset_array
+         (global.get $fd_offsets)
+         (struct.get $channel $fd (local.get $ch))
+         (i64.extend_i32_s
+            (i31.get_s (ref.cast (ref i31) (local.get $voffset)))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_input_scan_line")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_input_scan_line"))
-      (i31.new (i32.const 0)))
+      (param $vch (ref eq)) (result (ref eq))
+      (local $ch (ref $channel)) (local $p i32) (local $n i32)
+      (local $offset i64) (local $fd i32)
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (local.set $p (struct.get $channel $curr (local.get $ch)))
+      (loop $loop
+         (if (i32.ge_u (local.get $p) (struct.get $channel $max (local.get $ch)))
+            (then
+               (if (struct.get $channel $curr (local.get $ch))
+                  (then
+                     (local.set $n (struct.get $channel $curr (local.get $ch)))
+                     (call $ta_copy
+                        (struct.get $channel $buffer (local.get $ch))
+                        (i32.const 0) (local.get $n)
+                        (i32.sub (struct.get $channel $max (local.get $ch))
+                           (struct.get $channel $curr (local.get $ch))))
+                     (struct.set $channel $curr (local.get $ch) (i32.const 0))
+                     (struct.set $channel $max (local.get $ch)
+                        (i32.sub (struct.get $channel $max (local.get $ch))
+                           (local.get $n)))
+                     (local.set $p (i32.sub (local.get $p) (local.get $n)))))
+               (if (i32.ge_u (struct.get $channel $max (local.get $ch))
+                      (struct.get $channel $size (local.get $ch)))
+                  (then
+                     (return
+                        (i31.new
+                           (i32.sub (struct.get $channel $curr (local.get $ch))
+                              (struct.get $channel $size (local.get $ch)))))))
+               ;; ZZZ Wrap in function caml_read_fd...
+               (local.set $fd (struct.get $channel $fd (local.get $ch)))
+               (local.set $offset
+                  (array.get $offset_array (global.get $fd_offsets)
+                     (local.get $fd)))
+               (local.set $n
+                  (call $read
+                     (local.get $fd)
+                     (struct.get $channel $buffer (local.get $ch))
+                     (struct.get $channel $max (local.get $ch))
+                     (i32.sub
+                        (struct.get $channel $size (local.get $ch))
+                        (struct.get $channel $max (local.get $ch)))
+                     (local.get $offset)))
+               (array.set $offset_array
+                  (global.get $fd_offsets) (local.get $fd)
+                  (i64.add (local.get $offset)
+                     (i64.extend_i32_u (local.get $n))))
+               (if (i32.eqz (local.get $n))
+                  (then
+                     (return
+                        (i31.new
+                           (i32.sub (struct.get $channel $curr (local.get $ch))
+                              (struct.get $channel $max (local.get $ch)))))))
+               (struct.set $channel $max (local.get $ch)
+                   (i32.add (struct.get $channel $max (local.get $ch))
+                      (local.get $n)))))
+         (if (i32.eq (i32.const 10) ;; '\n'
+               (call $ta_get_ui8 (struct.get $channel $buffer (local.get $ch))
+                  (local.get $p)))
+            (then
+               (return
+                  (i31.new
+                     (i32.add (i32.const 1)
+                        (i32.sub (local.get $p)
+                           (struct.get $channel $curr (local.get $ch))))))))
+         (local.set $p (i32.add (local.get $p) (i32.const 1)))
+         (br $loop)))
+
+   (func $caml_flush (param $ch (ref $channel))
+      (loop $loop
+         (br_if $loop (i32.eqz (call $caml_flush_partial (local.get $ch))))))
 
    (func $caml_ml_flush (export "caml_ml_flush")
-      (param $ch (ref eq)) (result (ref eq))
-      (loop $loop
-         (br_if $loop
-            (i32.eqz
-               (call $caml_flush_partial
-                  (ref.cast (ref $channel) (local.get $ch))))))
+      (param $vch (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (if (i32.ne (struct.get $channel $fd (local.get $ch)) (i32.const -1))
+         (then (call $caml_flush (local.get $ch))))
       (i31.new (i32.const 0)))
 
    (func $caml_flush_partial (param $ch (ref $channel)) (result i32)
@@ -391,6 +606,20 @@
          (then (drop (call $caml_flush_partial (local.get $ch)))))
       (local.get $len))
 
+   (func (export "caml_really_putblock")
+      (param $ch (ref eq)) (param $s (ref $string))
+      (param $pos i32) (param $len i32)
+      (local $written i32)
+      (loop $loop
+         (if (local.get $len)
+            (then
+               (local.set $written
+                  (call $caml_putblock (ref.cast (ref $channel) (local.get $ch))
+                     (local.get $s) (local.get $pos) (local.get $len)))
+               (local.set $pos (i32.add (local.get $pos) (local.get $written)))
+               (local.set $len (i32.sub (local.get $len) (local.get $written)))
+               (br $loop)))))
+
    (export "caml_ml_output_bytes" (func $caml_ml_output))
    (func $caml_ml_output (export "caml_ml_output")
       (param $ch (ref eq)) (param $s (ref eq)) (param $vpos (ref eq))
@@ -410,25 +639,38 @@
                (br $loop))))
       (i31.new (i32.const 0)))
 
+   (func $caml_putch (param $ch (ref $channel)) (param $c $i32)
+      (local $curr i32)
+      (if (i32.ge_u (struct.get $channel $curr (local.get $ch))
+             (struct.get $channel $size (local.get $ch)))
+         (then
+            (drop (call $caml_flush_partial (local.get $ch)))))
+     (local.set $curr (struct.get $channel $curr (local.get $ch)))
+     (call $ta_set_ui8 (struct.get $channel $buffer (local.get $ch))
+        (local.get $curr) (local.get $c))
+     (struct.set $channel $curr (local.get $ch)
+        (i32.add (local.get $curr) (i32.const 1))))
+
    (func (export "caml_ml_output_char")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      ;;(call $log_js (string.const "caml_ml_output_char"))
-      (return_call $caml_ml_output (local.get 0)
-         (array.new $string
-            (i31.get_u (ref.cast (ref i31) (local.get 1))) (i32.const 1))
-         (i31.new (i32.const 0)) (i31.new (i32.const 1))))
-
-   (func (export "caml_output_value")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_output_value"))
+      (param $ch (ref eq)) (param $c (ref eq)) (result (ref eq))
+      (call $caml_putch (ref.cast (ref $channel) (local.get $ch))
+         (i31.get_u (ref.cast (ref i31) (local.get 1))))
+      ;; ZZZ flush if unbuffered
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_output_int")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_output_int"))
+      (param $vch (ref eq)) (param $vn (ref eq)) (result (ref eq))
+      (local $ch (ref $channel)) (local $n i32)
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (local.set $n (i31.get_u (ref.cast (ref i31) (local.get 1))))
+      (call $caml_putch (local.get $ch)
+         (i32.shr_u (local.get $n) (i32.const 24)))
+      (call $caml_putch (local.get $ch)
+         (i32.shr_u (local.get $n) (i32.const 16)))
+      (call $caml_putch (local.get $ch)
+         (i32.shr_u (local.get $n) (i32.const 8)))
+      (call $caml_putch (local.get $ch) (local.get $n))
+      ;; ZZZ flush if unbuffered
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_is_buffered") (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 484b182195..1c5f59bd9c 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -65,7 +65,7 @@
    (type $string (array (mut i8)))
    (type $js (struct (field anyref)))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
    (type $closure_last_arg
       (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
 
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index 347e20f672..80330762ff 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -38,5 +38,5 @@
             (call $caml_js_global (i31.new (i32.const 0)))
             (call $wrap (string.const "XMLHttpRequest")))
          (call $caml_js_from_array
-            (array.new_fixed $block (i31.new (i32.const 0))))))
+            (array.new_fixed $block 1 (i31.new (i32.const 0))))))
 )
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 7c615b409b..dcdc5acc81 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -1,30 +1,1419 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+   (import "fail" "caml_invalid_argument"
+      (func $caml_invalid_argument (param (ref eq))))
+   (import "fail" "caml_raise_end_of_file" (func $caml_raise_end_of_file))
+   (import "obj" "double_array_tag" (global $double_array_tag i32))
+   (import "string" "caml_string_cat"
+      (func $caml_string_cat
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "effect" "caml_is_continuation"
+      (func $caml_is_continuation (param (ref eq)) (result i32)))
+   (import "bindings" "weak_map_new" (func $weak_map_new (result (ref any))))
+   (import "bindings" "weak_map_get"
+      (func $weak_map_get (param (ref any)) (param (ref eq)) (result i31ref)))
+   (import "bindings" "weak_map_set"
+      (func $weak_map_set (param (ref any)) (param (ref eq)) (param (ref i31))))
+   (import "io" "caml_really_putblock"
+      (func $caml_really_putblock
+         (param (ref eq)) (param (ref $string)) (param i32) (param i32)))
+   (import "io" "caml_really_getblock"
+      (func $caml_really_getblock
+         (param (ref eq)) (param (ref $string)) (param i32) (param i32)
+         (result i32)))
+   (import "custom" "caml_init_custom_operations"
+      (func $caml_init_custom_operations))
+   (import "custom" "caml_find_custom_operations"
+      (func $caml_find_custom_operations
+         (param (ref $string)) (result (ref null $custom_operations))))
 
+   (global $input_val_from_string (ref $string)
+      (array.new_fixed $string 21
+         (i32.const 105) (i32.const 110) (i32.const 112) (i32.const 117)
+         (i32.const 116) (i32.const 95) (i32.const 118) (i32.const 97)
+         (i32.const 108) (i32.const 95) (i32.const 102) (i32.const 114)
+         (i32.const 111) (i32.const 109) (i32.const 95) (i32.const 115)
+         (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110)
+         (i32.const 103)))
+
+   (export "caml_input_value_from_string" (func $caml_input_value_from_bytes))
+   (func $caml_input_value_from_bytes (export "caml_input_value_from_bytes")
+      (param $vstr (ref eq)) (param $vofs (ref eq)) (result (ref eq))
+      (local $str (ref $string))
+      (local $ofs i32)
+      (local $s (ref $intern_state))
+      (local $h (ref $marshal_header))
+      (local.set $str (ref.cast (ref $string) (local.get $vstr)))
+      (local.set $ofs (i31.get_u (ref.cast (ref i31) (local.get $vofs))))
+      (local.set $s
+         (call $get_intern_state (local.get $str) (local.get $ofs)))
+      (local.set $h
+         (call $parse_header (local.get $s) (global.get $input_val_from_string)))
+      (if (i32.gt_s
+             (i32.add (local.get $ofs)
+                (i32.add (struct.get $marshal_header $data_len (local.get $h))
+                   (i32.const 20)))
+             (array.len (local.get $str)))
+         (then
+            (call $bad_length (global.get $input_val_from_string))))
+      (return_call $intern_rec (local.get $s) (local.get $h)))
+
+   (data $truncated_obj "input_value: truncated object")
+
+   (global $input_value (ref $string)
+      (array.new_fixed $string 11
+         (i32.const 105) (i32.const 110) (i32.const 112) (i32.const 117)
+         (i32.const 116) (i32.const 95) (i32.const 118) (i32.const 97)
+         (i32.const 108) (i32.const 117) (i32.const 101)))
+
+   (func (export "caml_input_value") (param $ch (ref eq)) (result (ref eq))
+      ;; ZZZ check binary channel?
+      (local $r i32) (local $len i32)
+      (local $header (ref $string)) (local $buf (ref $string))
+      (local $s (ref $intern_state)) (local $h (ref $marshal_header))
+      (local.set $header (array.new $string (i32.const 0) (i32.const 20)))
+      (local.set $r
+         (call $caml_really_getblock
+            (local.get $ch) (local.get $header) (i32.const 0) (i32.const 20)))
+      (if (i32.eqz (local.get $r))
+         (then (call $caml_raise_end_of_file)))
+      (if (i32.lt_u (local.get $r) (i32.const 20))
+         (then
+            (call $caml_failwith
+               (array.new_data $string $truncated_obj
+                  (i32.const 0) (i32.const 29)))))
+      (local.set $s
+         (call $get_intern_state (local.get $header) (i32.const 0)))
+      (local.set $h
+         (call $parse_header (local.get $s) (global.get $input_value)))
+      (local.set $len (struct.get $marshal_header $data_len (local.get $h)))
+      (local.set $buf (array.new $string (i32.const 0) (local.get $len)))
+      (if (i32.lt_u
+             (call $caml_really_getblock (local.get $ch)
+                (local.get $buf) (i32.const 0) (local.get $len))
+             (local.get $len))
+         (then
+            (call $caml_failwith
+               (array.new_data $string $truncated_obj
+                  (i32.const 0) (i32.const 29)))))
+      (local.set $s (call $get_intern_state (local.get $buf) (i32.const 0)))
+      (return_call $intern_rec (local.get $s) (local.get $h)))
+
+   (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
+   (type $float (struct (field f64)))
+   (type $js (struct (field anyref)))
+   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
+   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
 
-   (func (export "caml_marshal_data_size")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_marshal_data_size"))
-      (i31.new (i32.const 0)))
+   (type $compare
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
+   (type $hash
+      (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
+
+   (global $Intext_magic_number_small i32 (i32.const 0x8495A6BE))
+   (global $Intext_magic_number_big i32 (i32.const 0x8495A6BF))
+
+   (global $PREFIX_SMALL_BLOCK i32 (i32.const 0x80))
+   (global $PREFIX_SMALL_INT i32 (i32.const 0x40))
+   (global $PREFIX_SMALL_STRING i32 (i32.const 0x20))
+   (global $CODE_INT8 i32 (i32.const 0x00))
+   (global $CODE_INT16 i32 (i32.const 0x01))
+   (global $CODE_INT32 i32 (i32.const 0x02))
+   (global $CODE_INT64 i32 (i32.const 0x03))
+   (global $CODE_SHARED8 i32 (i32.const 0x04))
+   (global $CODE_SHARED16 i32 (i32.const 0x05))
+   (global $CODE_SHARED32 i32 (i32.const 0x06))
+   (global $CODE_BLOCK32 i32 (i32.const 0x08))
+   (global $CODE_BLOCK64 i32 (i32.const 0x13))
+   (global $CODE_STRING8 i32 (i32.const 0x09))
+   (global $CODE_STRING32 i32 (i32.const 0x0A))
+   (global $CODE_DOUBLE_BIG i32 (i32.const 0x0B))
+   (global $CODE_DOUBLE_LITTLE i32 (i32.const 0x0C))
+   (global $CODE_DOUBLE_ARRAY8_BIG i32 (i32.const 0x0D))
+   (global $CODE_DOUBLE_ARRAY8_LITTLE i32 (i32.const 0x0E))
+   (global $CODE_DOUBLE_ARRAY32_BIG i32 (i32.const 0x0F))
+   (global $CODE_DOUBLE_ARRAY32_LITTLE i32 (i32.const 0x07))
+   (global $CODE_CODEPOINTER i32 (i32.const 0x10))
+   (global $CODE_INFIXPOINTER i32 (i32.const 0x11))
+   (global $CODE_CUSTOM i32 (i32.const 0x12))
+   (global $CODE_CUSTOM_LEN i32 (i32.const 0x18))
+   (global $CODE_CUSTOM_FIXED i32 (i32.const 0x19))
+
+   (type $intern_state
+      (struct
+         (field $src (ref $string))
+         (field $pos (mut i32))
+         (field $obj_table (mut (ref null $block)))
+         (field $obj_counter (mut i32))))
+
+   (func $get_intern_state
+      (param $src (ref $string)) (param $pos i32) (result (ref $intern_state))
+      (struct.new $intern_state
+         (local.get $src) (local.get $pos) (ref.null $block) (i32.const 0)))
+
+   (func $read8u (param $s (ref $intern_state)) (result i32)
+      (local $pos i32) (local $res i32)
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (local.set $res
+         (array.get_u $string
+            (struct.get $intern_state $src (local.get $s))
+            (local.get $pos)))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (i32.const 1)))
+      (local.get $res))
+
+   (func $read8s (param $s (ref $intern_state)) (result i32)
+      (local $pos i32) (local $res i32)
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (local.set $res
+         (array.get_s $string
+            (struct.get $intern_state $src (local.get $s))
+            (local.get $pos)))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (i32.const 1)))
+      (local.get $res))
+
+   (func $read16u (param $s (ref $intern_state)) (result i32)
+      (local $src (ref $string)) (local $pos i32) (local $res i32)
+      (local.set $src (struct.get $intern_state $src (local.get $s)))
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (local.set $res
+         (i32.or
+            (i32.shl
+               (array.get_u $string (local.get $src) (local.get $pos))
+               (i32.const 8))
+            (array.get_u $string (local.get $src)
+               (i32.add (local.get $pos) (i32.const 1)))))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (i32.const 2)))
+      (local.get $res))
+
+   (func $read16s (param $s (ref $intern_state)) (result i32)
+      (local $src (ref $string)) (local $pos i32) (local $res i32)
+      (local.set $src (struct.get $intern_state $src (local.get $s)))
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (local.set $res
+         (i32.or
+            (i32.shl
+               (array.get_s $string (local.get $src) (local.get $pos))
+               (i32.const 8))
+            (array.get_u $string (local.get $src)
+               (i32.add (local.get $pos) (i32.const 1)))))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (i32.const 2)))
+      (local.get $res))
+
+   (func $read32 (param $s (ref $intern_state)) (result i32)
+      (local $src (ref $string)) (local $pos i32) (local $res i32)
+      (local.set $src (struct.get $intern_state $src (local.get $s)))
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (local.set $res
+         (i32.or
+            (i32.or
+               (i32.shl
+                  (array.get_u $string (local.get $src) (local.get $pos))
+                  (i32.const 24))
+               (i32.shl
+                  (array.get_u $string (local.get $src)
+                     (i32.add (local.get $pos) (i32.const 1)))
+                  (i32.const 16)))
+            (i32.or
+               (i32.shl
+                  (array.get_u $string (local.get $src)
+                     (i32.add (local.get $pos) (i32.const 2)))
+                  (i32.const 8))
+               (array.get_u $string (local.get $src)
+                  (i32.add (local.get $pos) (i32.const 3))))))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (i32.const 4)))
+      (local.get $res))
+
+   (func $readblock (param $s (ref $intern_state)) (param $str (ref $string))
+      (local $len i32) (local $pos i32)
+      (local.set $len (array.len (local.get $str)))
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (array.copy $string $string
+         (local.get $str) (i32.const 0)
+         (struct.get $intern_state $src (local.get $s)) (local.get $pos)
+         (local.get $len))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (local.get $len))))
+
+   (func $readstr (param $s (ref $intern_state)) (result (ref $string))
+      (local $len i32) (local $pos i32) (local $res (ref $string))
+      (local $src (ref $string))
+      (local.set $src (struct.get $intern_state $src (local.get $s)))
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (loop $loop
+         (if (array.get_u $string (local.get $src)
+                (i32.add (local.get $pos) (local.get $len)))
+            (then
+               (local.set $len (i32.add (local.get $len) (i32.const 1)))
+               (br $loop))))
+      (local.set $res (array.new $string (i32.const 0) (local.get $len)))
+      (array.copy $string $string
+         (local.get $res) (i32.const 0)
+         (local.get $src) (local.get $pos)
+         (local.get $len))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (i32.add (local.get $len) (i32.const 1))))
+      (local.get $res))
+
+   (func $readfloat
+      (param $s (ref $intern_state)) (param $code i32) (result (ref eq))
+      (local $src (ref $string)) (local $pos i32) (local $res i32)
+      (local $d i64)
+      (local $i i32)
+      (local $v (ref eq))
+      (local.set $src (struct.get $intern_state $src (local.get $s)))
+      (local.set $pos (struct.get $intern_state $pos (local.get $s)))
+      (struct.set $intern_state $pos (local.get $s)
+         (i32.add (local.get $pos) (i32.const 8)))
+      (if (i32.eq (local.get $code) (global.get $CODE_DOUBLE_BIG))
+         (then
+            (loop $loop
+               (local.set $d
+                  (i64.or
+                     (i64.shl (local.get $d) (i64.const 8))
+                     (i64.extend_i32_u
+                        (array.get_u $string (local.get $src)
+                          (i32.add (local.get $pos) (local.get $i))))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br_if $loop (i32.lt_u (local.get $i) (i32.const 8)))))
+         (else
+            (loop $loop
+               (local.set $d
+                  (i64.rotr
+                     (i64.or (local.get $d)
+                        (i64.extend_i32_u
+                           (array.get_u $string (local.get $src)
+                             (i32.add (local.get $pos) (local.get $i)))))
+                     (i64.const 8)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br_if $loop (i32.lt_u (local.get $i) (i32.const 8))))))
+      (struct.new $float (f64.reinterpret_i64 (local.get $d))))
+
+   (func $readfloats
+      (param $s (ref $intern_state)) (param $code i32) (param $len i32)
+      (result (ref eq))
+      ;; ZZZ float array
+      (local $dest (ref $block))
+      (local $i i32)
+      (local.set $code
+         (select (global.get $CODE_DOUBLE_BIG) (global.get $CODE_DOUBLE_LITTLE)
+            (i32.or
+               (i32.eq (local.get $code) (global.get $CODE_DOUBLE_ARRAY8_BIG))
+               (i32.eq (local.get $code)
+                 (global.get $CODE_DOUBLE_ARRAY32_BIG)))))
+      (local.set $dest
+         (array.new $block (i31.new (i32.const 0))
+            (i32.add (local.get $len) (i32.const 1))))
+      (array.set $block (local.get $dest) (i32.const 0)
+         (i31.new (global.get $double_array_tag)))
+      (loop $loop
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (if (i32.le_u (local.get $i) (local.get $len))
+            (then
+               (array.set $block (local.get $dest) (local.get $i)
+                  (call $readfloat (local.get $s) (local.get $code)))
+               (br $loop))))
+      (local.get $dest))
+
+   (func (export "caml_deserialize_uint_1") (param $s (ref eq)) (result i32)
+      (return_call $read8u (ref.cast (ref $intern_state) (local.get $s))))
 
-   (func (export "caml_input_value_from_bytes")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_input_value_from_bytes"))
+   (func (export "caml_deserialize_sint_1") (param $s (ref eq)) (result i32)
+      (return_call $read8s (ref.cast (ref $intern_state) (local.get $s))))
+
+   (func (export "caml_deserialize_uint_2") (param $s (ref eq)) (result i32)
+      (return_call $read16u (ref.cast (ref $intern_state) (local.get $s))))
+
+   (func (export "caml_deserialize_sint_2") (param $s (ref eq)) (result i32)
+      (return_call $read16s (ref.cast (ref $intern_state) (local.get $s))))
+
+   (func (export "caml_deserialize_int_4") (param $s (ref eq)) (result i32)
+      (return_call $read32 (ref.cast (ref $intern_state) (local.get $s))))
+
+   (func (export "caml_deserialize_int_8") (param $vs (ref eq)) (result i64)
+      (local $s (ref $intern_state))
+      (local.set $s (ref.cast (ref $intern_state) (local.get $vs)))
+      (i64.or (i64.shl (i64.extend_i32_u (call $read32 (local.get $s)))
+                 (i64.const 32))
+         (i64.extend_i32_u (call $read32 (local.get $s)))))
+
+   (func $register_object (param $s (ref $intern_state)) (param $v (ref eq))
+      (local $obj_table (ref $block))
+      (local $p i32)
+      (block $exit
+         (local.set $obj_table
+            (br_on_null $exit
+               (struct.get $intern_state $obj_table (local.get $s))))
+         (local.set $p (struct.get $intern_state $obj_counter (local.get $s)))
+         (array.set $block (local.get $obj_table) (local.get $p) (local.get $v))
+         (struct.set $intern_state $obj_counter (local.get $s)
+            (i32.add (local.get $p) (i32.const 1)))))
+
+   (type $stack_item
+      (struct
+         (field $blk (ref $block))
+         (field $pos (mut i32))
+         (field $next (ref null $stack_item))))
+
+   (data $integer_too_large "input_value: integer too large")
+   (data $code_pointer "input_value: code pointer")
+   (data $ill_formed "input_value: ill-formed message")
+
+   (data $unknown_custom "input_value: unknown custom block identifier")
+   (data $expected_size "input_value: expected a fixed-size custom block")
+   (data $incorrect_size
+      "input_value: incorrect length of serialized custom block")
+
+   (func $intern_custom
+      (param $s (ref $intern_state)) (param $code i32) (result (ref eq))
+      (local $ops (ref $custom_operations))
+      (local $expected_size i32)
+      (local $r ((ref eq) i32))
+      (block $unknown
+         (local.set $ops
+            (br_on_null $unknown
+               (call
+                  $caml_find_custom_operations
+                  (call $readstr
+                     (local.get $s)))))
+         (block $no_length
+            (if (i32.eq (local.get $code) (global.get $CODE_CUSTOM_FIXED))
+               (then
+                  (local.set $expected_size
+                     (struct.get $fixed_length $bsize_32
+                        (br_on_null $no_length
+                           (struct.get $custom_operations $fixed_length
+                              (local.get $ops))))))
+            (else
+               (if (i32.eq (local.get $code) (global.get $CODE_CUSTOM_LEN))
+                  (then
+                     (local.set $expected_size (call $read32 (local.get $s)))
+                     (struct.set $intern_state $pos (local.get $s)
+                        (i32.add (struct.get $intern_state $pos (local.get $s))
+                           (i32.const 8)))))))
+            (local.set $r
+               (call_ref $deserialize (local.get $s)
+                  (struct.get $custom_operations $deserialize (local.get $ops))))
+            (if (i32.and
+                  (i32.ne (tuple.extract 1 (local.get $r))
+                     (local.get $expected_size))
+                  (i32.ne (local.get $code) (global.get $CODE_CUSTOM)))
+               (then
+                  (call $caml_failwith
+                     (array.new_data $string $incorrect_size
+                        (i32.const 0) (i32.const 56)))))
+            (return (tuple.extract 0 (local.get $r))))
+         (call $caml_failwith
+            (array.new_data $string $expected_size
+               (i32.const 0) (i32.const 47))))
+      (call $caml_failwith
+         (array.new_data $string $unknown_custom
+            (i32.const 0) (i32.const 44)))
       (i31.new (i32.const 0)))
 
+   (func $intern_rec
+      (param $s (ref $intern_state)) (param $h (ref $marshal_header))
+      (result (ref eq))
+      (local $res (ref $block)) (local $dest (ref $block))
+      (local $sp (ref null $stack_item))
+      (local $item (ref $stack_item))
+      (local $code i32)
+      (local $header i32) (local $tag i32) (local $size i32)
+      (local $len i32) (local $pos i32) (local $pos' i32) (local $ofs i32)
+      (local $b (ref $block))
+      (local $str (ref $string))
+      (local $v (ref eq))
+      (call $caml_init_custom_operations)
+      (local.set $res (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (local.set $sp
+         (struct.new $stack_item
+            (local.get $res) (i32.const 0) (ref.null $stack_item)))
+      (local.set $size (struct.get $marshal_header $num_objects (local.get $h)))
+      (if (local.get $size)
+         (then
+            (struct.set $intern_state $obj_table (local.get $s)
+               (array.new $block (i31.new (i32.const 0)) (local.get $size)))))
+      (local.set $v (i31.new (i32.const 0))) ;; keep validator happy
+      (block $exit
+       (loop $loop
+        (local.set $item (br_on_null $exit (local.get $sp)))
+        (local.set $dest (struct.get $stack_item $blk (local.get $item)))
+        (local.set $pos (struct.get $stack_item $pos (local.get $item)))
+        (local.set $pos' (i32.add (local.get $pos) (i32.const 1)))
+        (struct.set $stack_item $pos (local.get $item) (local.get $pos'))
+        (if (i32.eq (local.get $pos') (array.len (local.get $dest)))
+           (then
+               (local.set $sp
+                  (struct.get $stack_item $next (local.get $item)))))
+        (block $done
+         (block $read_block
+          (block $read_string
+           (block $read_double_array
+            (block $read_shared
+             (local.set $code (call $read8u (local.get $s)))
+             (if (i32.ge_u (local.get $code) (global.get $PREFIX_SMALL_INT))
+                (then
+                   (if (i32.ge_u (local.get $code) (global.get $PREFIX_SMALL_BLOCK))
+                      (then
+                         ;; Small block
+                         (local.set $tag
+                            (i32.and (local.get $code) (i32.const 0xF)))
+                         (local.set $size
+                            (i32.and (i32.shr_u (local.get $code) (i32.const 4))
+                               (i32.const 0x7)))
+                         (br $read_block))
+                      (else
+                         ;; Small int
+                         (local.set $v
+                            (i31.new
+                               (i32.and (local.get $code) (i32.const 0x3F))))
+                         (br $done))))
+                (else
+                   (if (i32.ge_u (local.get $code)
+                         (global.get $PREFIX_SMALL_STRING))
+                      (then
+                         (local.set $len
+                            (i32.and (local.get $code) (i32.const 0x1F)))
+                         (br $read_string))
+                      (else
+                         (block $INT8
+                          (block $INT16
+                           (block $INT32
+                            (block $INT64
+                             (block $SHARED8
+                              (block $SHARED16
+                               (block $SHARED32
+                                (block $BLOCK32
+                                 (block $STRING8
+                                  (block $STRING32
+                                   (block $DOUBLE
+                                    (block $DOUBLE_ARRAY8
+                                     (block $DOUBLE_ARRAY32
+                                      (block $CODEPOINTER
+                                       (block $CUSTOM
+                                        (block $default
+                                         (br_table $INT8 $INT16 $INT32 $INT64
+                                            $SHARED8 $SHARED16 $SHARED32
+                                            $DOUBLE_ARRAY32 $BLOCK32 $STRING8
+                                            $STRING32 $DOUBLE $DOUBLE
+                                            $DOUBLE_ARRAY8 $DOUBLE_ARRAY8
+                                            $DOUBLE_ARRAY32 $CODEPOINTER
+                                            $CODEPOINTER $CUSTOM $default
+                                            $default $default $default $default
+                                            $CUSTOM $CUSTOM $default
+                                            (local.get $code)))
+                                        ;; default
+                                        (call $caml_failwith
+                                           (array.new_data $string $ill_formed
+                                              (i32.const 0) (i32.const 31)))
+                                        (br $done))
+                                       ;; CUSTOM
+                                       (local.set $v
+                                          (call $intern_custom (local.get $s)
+                                             (local.get $code)))
+                                       (call $register_object (local.get $s)
+                                          (local.get $v))
+                                       (br $done))
+                                      ;; CODEPOINTER
+                                      (call $caml_failwith
+                                        (array.new_data $string $code_pointer
+                                           (i32.const 0) (i32.const 25)))
+                                      (br $done))
+                                     ;; DOUBLE_ARRAY32
+                                     (local.set $len
+                                        (call $read32 (local.get $s)))
+                                     (br $read_double_array))
+                                    ;; DOUBLE_ARRAY8
+                                    (local.set $len
+                                       (call $read8u (local.get $s)))
+                                    (br $read_double_array))
+                                   ;; DOUBLE
+                                   (local.set $v
+                                      (call $readfloat
+                                         (local.get $s) (local.get $code)))
+                                   (call $register_object
+                                      (local.get $s) (local.get $v))
+                                   (br $done))
+                                  ;; STRING32
+                                  (local.set $len (call $read32 (local.get $s)))
+                                  (br $read_string))
+                                 ;; STRING8
+                                 (local.set $len (call $read8u (local.get $s)))
+                                 (br $read_string))
+                                ;; BLOCK32
+                                (local.set $header (call $read32 (local.get $s)))
+                                (local.set $tag
+                                   (i32.and (local.get $header)
+                                      (i32.const 0xFF)))
+                                (local.set $size
+                                   (i32.shr_u (local.get $header)
+                                      (i32.const 10)))
+                                (br $read_block))
+                               ;; SHARED32
+                               (local.set $ofs (call $read32 (local.get $s)))
+                               (br $read_shared))
+                              ;; SHARED16
+                              (local.set $ofs (call $read16u (local.get $s)))
+                              (br $read_shared))
+                             ;; SHARED8
+                             (local.set $ofs (call $read8u (local.get $s)))
+                             (br $read_shared))
+                            ;; INT64
+                            (call $caml_failwith
+                               (array.new_data $string $integer_too_large
+                                  (i32.const 0) (i32.const 30)))
+                            (br $done))
+                           ;; INT32
+                           (local.set $v (i31.new (call $read32 (local.get $s))))
+                           (br $done))
+                          ;; INT16
+                          (local.set $v (i31.new (call $read16s (local.get $s))))
+                          (br $done))
+                         ;; INT8
+                         (local.set $v (i31.new (call $read8s (local.get $s))))
+                         (br $done))
+                        ))))
+            ;; read_shared
+            (local.set $ofs
+               (i32.sub
+                  (struct.get $intern_state $obj_counter (local.get $s))
+                  (local.get $ofs)))
+            (local.set $v
+               (array.get $block
+                  (ref.as_non_null
+                     (struct.get $intern_state $obj_table
+                        (local.get $s)))
+                  (local.get $ofs)))
+            (br $done))
+           ;; read_double_array
+           (local.set $v
+              (call $readfloats
+                 (local.get $s) (local.get $code) (local.get $len)))
+           (call $register_object (local.get $s) (local.get $v))
+           (br $done))
+          ;; read_string
+          (local.set $str (array.new $string (i32.const 0) (local.get $len)))
+          (call $readblock (local.get $s) (local.get $str))
+          (local.set $v (local.get $str))
+          (call $register_object (local.get $s) (local.get $v))
+          (br $done))
+         ;; read_block
+         (local.set $b
+            (array.new $block (i31.new (i32.const 0))
+               (i32.add (local.get $size) (i32.const 1))))
+         (array.set $block (local.get $b) (i32.const 0)
+            (i31.new (local.get $tag)))
+         (if (local.get $size)
+            (then
+               (call $register_object (local.get $s) (local.get $b))
+               (local.set $sp
+                  (struct.new $stack_item
+                     (local.get $b) (i32.const 1) (local.get $sp)))))
+         (local.set $v (local.get $b))
+         (br $done))
+        ;; done
+        (array.set $block (local.get $dest) (local.get $pos) (local.get $v))
+        (br $loop)))
+      (array.get $block (local.get $res) (i32.const 0)))
+
+   (data $too_large ": object too large to be read back on a 32-bit platform")
+
+   (func $too_large (param $prim (ref $string))
+      (call $caml_failwith
+         (call $caml_string_cat (local.get $prim)
+            (array.new_data $string $too_large (i32.const 0) (i32.const 55)))))
+
+   (data $bad_object ": bad object")
+
+   (func $bad_object (param $prim (ref $string))
+      (call $caml_failwith
+         (call $caml_string_cat (local.get $prim)
+            (array.new_data $string $bad_object (i32.const 0) (i32.const 12)))))
+
+   (data $bad_length ": bad length")
+
+   (func $bad_length (param $prim (ref $string))
+      (call $caml_failwith
+         (call $caml_string_cat (local.get $prim)
+            (array.new_data $string $bad_length (i32.const 0) (i32.const 12)))))
+
+   (type $marshal_header
+      (struct
+         (field $data_len i32)
+         (field $num_objects i32)))
+
+   (func $parse_header
+      (param $s (ref $intern_state)) (param $prim (ref $string))
+      (result (ref $marshal_header))
+      (local $magic i32)
+      (local $data_len i32) (local $num_objects i32) (local $whsize i32)
+      (local.set $magic (call $read32 (local.get $s)))
+      (if (i32.eq (local.get $magic) (global.get $Intext_magic_number_big))
+         (then
+            (call $too_large (local.get $prim))))
+      (if (i32.ne (local.get $magic) (global.get $Intext_magic_number_small))
+         (then
+            (call $bad_object (local.get $prim))))
+      (local.set $data_len (call $read32 (local.get $s)))
+      (local.set $num_objects (call $read32 (local.get $s)))
+      (drop (call $read32 (local.get $s)))
+      (drop (call $read32 (local.get $s)))
+      (struct.new $marshal_header
+         (local.get $data_len)
+         (local.get $num_objects)))
+
+   (data $marshal_data_size "Marshal.data_size")
+
+   (func (export "caml_marshal_data_size")
+      (param $buf (ref eq)) (param $ofs (ref eq)) (result (ref eq))
+      (local $s (ref $intern_state))
+      (local $magic i32)
+      (local.set $s
+         (call $get_intern_state
+            (ref.cast (ref $string) (local.get $buf))
+            (i31.get_u (ref.cast (ref i31) (local.get $ofs)))))
+      (local.set $magic (call $read32 (local.get $s)))
+      (if (i32.eq (local.get $magic) (global.get $Intext_magic_number_big))
+         (then
+            (call $too_large
+               (array.new_data $string $marshal_data_size
+                  (i32.const 0) (i32.const 17)))))
+      (if (i32.ne (local.get $magic) (global.get $Intext_magic_number_small))
+         (then
+            (call $bad_object
+               (array.new_data $string $marshal_data_size
+                  (i32.const 0) (i32.const 17)))))
+      (i31.new (call $read32 (local.get $s))))
+
+   (type $output_block
+      (struct
+         (field $next (mut (ref null $output_block)))
+         (field $end (mut i32))
+         (field $data (ref $string))))
+
+   (type $extern_state
+      (struct
+         ;; Flags
+         (field $no_sharing i32)
+         (field $user_provided_output i32)
+         ;; Header information
+         (field $obj_counter (mut i32))
+         (field $size_32 (mut i32))
+         (field $size_64 (mut i32))
+         ;; Position of already marshalled objects
+         (field $pos_table (ref any))
+         ;; Buffers
+         (field $buf (mut (ref $string)))
+         (field $pos (mut i32))
+         (field $limit (mut i32))
+         (field $output_first (ref $output_block))
+         (field $output_last (mut (ref $output_block)))))
+
+   (func $init_extern_state
+      (param $flags (ref eq)) (param $output (ref $output_block))
+      (param $pos i32) (param $user_provided_output i32)
+      (result (ref $extern_state))
+      (local $b (ref $block))
+      (local $no_sharing i32)
+      (loop $parse_flags
+         (drop (block $done (result (ref eq))
+            (local.set $b
+               (br_on_cast_fail $done (ref eq) (ref $block) (local.get $flags)))
+            (if (ref.eq (array.get $block (local.get $b) (i32.const 1))
+                   (i31.new (i32.const 0)))
+               (then (local.set $no_sharing (i32.const 1))))
+            (local.set $flags (array.get $block (local.get $b) (i32.const 2)))
+            (br $parse_flags))))
+      (struct.new $extern_state
+         (local.get $no_sharing)
+         (local.get $user_provided_output)
+         (i32.const 0)
+         (i32.const 0)
+         (i32.const 0)
+         (call $weak_map_new)
+         (struct.get $output_block $data (local.get $output))
+         (local.get $pos)
+         (struct.get $output_block $end (local.get $output))
+         (local.get $output)
+         (local.get $output)))
+
+   (data $buffer_overflow "Marshal.to_buffer: buffer overflow")
+
+   (global $SIZE_EXTERN_OUTPUT_BLOCK i32 (i32.const 8100))
+
+   (func $reserve_extern_output
+      (param $s (ref $extern_state)) (param $required i32) (result i32)
+      (local $last (ref $output_block)) (local $blk (ref $output_block))
+      (local $pos i32) (local $extra i32)
+      (local $buf (ref $string))
+      (local.set $pos (struct.get $extern_state $pos (local.get $s)))
+      (if (i32.le_u (i32.add (local.get $pos) (local.get $required))
+             (struct.get $extern_state $limit (local.get $s)))
+         (then
+            (struct.set $extern_state $pos (local.get $s)
+               (i32.add (local.get $pos) (local.get $required)))
+            (return (local.get $pos))))
+      (if (struct.get $extern_state $user_provided_output (local.get $s))
+         (then
+            (call $caml_failwith
+               (array.new_data $string $buffer_overflow
+                  (i32.const 0) (i32.const 34)))))
+      (local.set $last (struct.get $extern_state $output_last (local.get $s)))
+      (struct.set $output_block $end (local.get $last)
+         (struct.get $extern_state $pos (local.get $s)))
+      (if (i32.gt_s (local.get $required)
+             (i32.shr_u (global.get $SIZE_EXTERN_OUTPUT_BLOCK) (i32.const 1)))
+         (then
+            (local.set $extra (local.get $required))))
+      (local.set $buf
+         (array.new $string (i32.const 0)
+            (i32.add (global.get $SIZE_EXTERN_OUTPUT_BLOCK) (local.get $extra))))
+      (local.set $blk
+         (struct.new $output_block
+            (ref.null $output_block)
+            (i32.const 0)
+            (local.get $buf)))
+      (struct.set $output_block $next (local.get $last) (local.get $blk))
+      (struct.set $extern_state $output_last (local.get $s) (local.get $blk))
+      (struct.set $extern_state $buf (local.get $s) (local.get $buf))
+      (struct.set $extern_state $pos (local.get $s) (local.get $required))
+      (struct.set $extern_state $limit (local.get $s)
+         (array.len (local.get $buf)))
+      (i32.const 0))
+
+   (func $store16 (param $s (ref $string)) (param $pos i32) (param $n i32)
+      (array.set $string (local.get $s) (local.get $pos)
+         (i32.shr_u (local.get $n) (i32.const 8)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $pos) (i32.const 1)) (local.get $n)))
+
+   (func $store32 (param $s (ref $string)) (param $pos i32) (param $n i32)
+      (array.set $string (local.get $s) (local.get $pos)
+         (i32.shr_u (local.get $n) (i32.const 24)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $pos) (i32.const 1))
+         (i32.shr_u (local.get $n) (i32.const 16)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $pos) (i32.const 2))
+         (i32.shr_u (local.get $n) (i32.const 8)))
+      (array.set $string (local.get $s)
+         (i32.add (local.get $pos) (i32.const 3)) (local.get $n)))
+
+   (func $store64 (param $s (ref $string)) (param $pos i32) (param $n i64)
+      (call $store32 (local.get $s) (local.get $pos)
+         (i32.wrap_i64 (i64.shr_u (local.get $n) (i64.const 32))))
+      (call $store32 (local.get $s) (i32.add (local.get $pos) (i32.const 4))
+         (i32.wrap_i64 (local.get $n))))
+
+   (func $write (param $s (ref $extern_state)) (param $c i32)
+      (local $pos i32)
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 1)))
+      (array.set $string (struct.get $extern_state $buf (local.get $s))
+         (local.get $pos) (local.get $c)))
+
+   (func $writecode8
+      (param $s (ref $extern_state)) (param $c i32) (param $v i32)
+      (local $pos i32) (local $buf (ref $string))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 2)))
+      (local.set $buf (struct.get $extern_state $buf (local.get $s)))
+      (array.set $string (local.get $buf) (local.get $pos) (local.get $c))
+      (array.set $string (local.get $buf)
+         (i32.add (local.get $pos) (i32.const 1)) (local.get $v)))
+
+   (func $writecode16
+      (param $s (ref $extern_state)) (param $c i32) (param $v i32)
+      (local $pos i32) (local $buf (ref $string))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 3)))
+      (local.set $buf (struct.get $extern_state $buf (local.get $s)))
+      (array.set $string (local.get $buf) (local.get $pos) (local.get $c))
+      (call $store16 (local.get $buf) (i32.add (local.get $pos) (i32.const 1))
+         (local.get $v)))
+
+   (func $writecode32
+      (param $s (ref $extern_state)) (param $c i32) (param $v i32)
+      (local $pos i32) (local $buf (ref $string))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 5)))
+      (local.set $buf (struct.get $extern_state $buf (local.get $s)))
+      (array.set $string (local.get $buf) (local.get $pos) (local.get $c))
+      (call $store32 (local.get $buf) (i32.add (local.get $pos) (i32.const 1))
+         (local.get $v)))
+
+   (func $writeblock
+      (param $s (ref $extern_state)) (param $str (ref $string))
+      (local $len i32) (local $pos i32)
+      (local.set $len (array.len (local.get $str)))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (local.get $len)))
+      (array.copy $string $string
+         (struct.get $extern_state $buf (local.get $s)) (local.get $pos)
+         (local.get $str) (i32.const 0) (local.get $len)))
+
+   (func $writefloat
+      (param $s (ref $extern_state)) (param $f f64)
+      (local $pos i32) (local $buf (ref $string)) (local $d i64) (local $i i32)
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 8)))
+      (local.set $buf (struct.get $extern_state $buf (local.get $s)))
+      (local.set $d (i64.reinterpret_f64 (local.get $f)))
+      (loop $loop
+         (array.set $string (local.get $buf)
+            (i32.add (local.get $pos) (local.get $i))
+            (i32.wrap_i64
+               (i64.shr_u (local.get $d)
+                  (i64.extend_i32_u (i32.shl (local.get $i) (i32.const 3))))))
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (br_if $loop (i32.lt_u (local.get $i) (i32.const 8)))))
+
+   (func $writefloats
+      (param $s (ref $extern_state)) (param $b (ref $block))
+      (local $pos i32) (local $sz i32) (local $buf (ref $string)) (local $d i64)
+      (local $i i32) (local $j i32)
+      (local.set $sz (i32.sub (array.len (local.get $b)) (i32.const 1)))
+      (local.set $pos
+         (call $reserve_extern_output
+            (local.get $s) (i32.shl (local.get $sz) (i32.const 3))))
+      (local.set $buf (struct.get $extern_state $buf (local.get $s)))
+      (local.set $j (i32.const 1))
+      (loop $loop2
+         (if (i32.le_u (local.get $j) (local.get $sz))
+            (then
+               (local.set $d
+                  (i64.reinterpret_f64
+                     (struct.get $float 0
+                        (ref.cast (ref $float)
+                           (array.get $block (local.get $b) (local.get $j))))))
+               (local.set $i (i32.const 0))
+               (loop $loop
+                  (array.set $string (local.get $buf)
+                     (i32.add (local.get $pos) (local.get $i))
+                     (i32.wrap_i64
+                        (i64.shr_u (local.get $d)
+                           (i64.extend_i32_u
+                              (i32.shl (local.get $i) (i32.const 3))))))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (br_if $loop (i32.lt_u (local.get $i) (i32.const 8))))
+               (local.set $pos (i32.add (local.get $pos) (i32.const 8)))
+               (local.set $j (i32.add (local.get $j) (i32.const 1)))
+               (br $loop2)))))
+
+   (func $extern_lookup_position
+      (param $s (ref $extern_state)) (param $obj (ref eq)) (result i32)
+      (block $not_found
+         (br_if $not_found (struct.get $extern_state $no_sharing (local.get $s)))
+         (return
+            (i31.get_s
+               (br_on_null $not_found
+                  (call $weak_map_get
+                     (struct.get $extern_state $pos_table (local.get $s))
+                     (local.get $obj))))))
+      (i32.const -1))
+
+   (func $extern_record_location
+      (param $s (ref $extern_state)) (param $obj (ref eq))
+      (local $pos i32)
+      (if (struct.get $extern_state $no_sharing (local.get $s))
+         (then (return)))
+      (local.set $pos (struct.get $extern_state $obj_counter (local.get $s)))
+      (struct.set $extern_state $obj_counter (local.get $s)
+         (i32.add (local.get $pos) (i32.const 1)))
+      (call $weak_map_set
+         (struct.get $extern_state $pos_table (local.get $s))
+         (local.get $obj) (i31.new (local.get $pos))))
+
+   (func $extern_size
+      (param $s (ref $extern_state)) (param $s32 i32) (param $s64 i32)
+      (struct.set $extern_state $size_32 (local.get $s)
+         (i32.add (struct.get $extern_state $size_32 (local.get $s))
+            (i32.add (local.get $s32) (i32.const 1))))
+      (struct.set $extern_state $size_64 (local.get $s)
+         (i32.add (struct.get $extern_state $size_64 (local.get $s))
+            (i32.add (local.get $s64) (i32.const 1)))))
+
+   (func $extern_int (param $s (ref $extern_state)) (param $n i32)
+      (if (i32.and (i32.ge_s (local.get $n) (i32.const 0))
+             (i32.lt_s (local.get $n) (i32.const 0x40)))
+         (then
+            (call $write (local.get $s)
+               (i32.add (global.get $PREFIX_SMALL_INT) (local.get $n))))
+      (else (if (i32.and (i32.ge_s (local.get $n) (i32.const -128))
+                   (i32.lt_s (local.get $n) (i32.const 128)))
+         (then
+            (call $writecode8 (local.get $s) (global.get $CODE_INT8)
+               (local.get $n)))
+      (else (if (i32.and (i32.ge_s (local.get $n) (i32.const -32768))
+                   (i32.lt_s (local.get $n) (i32.const 32768)))
+         (then
+            (call $writecode16 (local.get $s) (global.get $CODE_INT16)
+               (local.get $n)))
+      (else
+         (call $writecode32 (local.get $s) (global.get $CODE_INT32)
+            (local.get $n)))))))))
+
+   (func $extern_shared_reference (param $s (ref $extern_state)) (param $d i32)
+      (if (i32.lt_u (local.get $d) (i32.const 0x100))
+         (then
+            (call $writecode8 (local.get $s) (global.get $CODE_SHARED8)
+               (local.get $d)))
+      (else (if (i32.lt_u (local.get $d) (i32.const 0x10000))
+         (then
+            (call $writecode16 (local.get $s) (global.get $CODE_SHARED16)
+               (local.get $d)))
+      (else
+         (call $writecode32 (local.get $s) (global.get $CODE_SHARED32)
+            (local.get $d)))))))
+
+   (func $extern_header
+      (param $s (ref $extern_state)) (param $sz (i32)) (param $tag i32)
+      (if (i32.and (i32.lt_u (local.get $tag) (i32.const 16))
+             (i32.lt_u (local.get $sz) (i32.const 8)))
+         (then
+             (call $write (local.get $s)
+                (i32.add (global.get $PREFIX_SMALL_BLOCK)
+                   (i32.or (local.get $tag)
+                      (i32.shl (local.get $sz) (i32.const 4))))))
+         (else
+            (call $writecode32 (local.get $s) (global.get $CODE_BLOCK32)
+               (i32.or (local.get $tag)
+                  (i32.shl (local.get $sz) (i32.const 10)))))))
+
+   (func $extern_string (param $s (ref $extern_state)) (param $v (ref $string))
+      (local $len i32)
+      (local.set $len (array.len (local.get $v)))
+      (if (i32.lt_u (local.get $len) (i32.const 0x20))
+         (then
+            (call $write (local.get $s)
+               (i32.add (global.get $PREFIX_SMALL_STRING) (local.get $len))))
+      (else (if (i32.lt_u (local.get $len) (i32.const 0x100))
+         (then
+            (call $writecode8 (local.get $s) (global.get $CODE_STRING8)
+               (local.get $len)))
+      (else
+         (call $writecode32 (local.get $s) (global.get $CODE_STRING32)
+            (local.get $len))))))
+      (call $writeblock (local.get $s) (local.get $v)))
+
+   (func $extern_float (param $s (ref $extern_state)) (param $v f64)
+      (call $write (local.get $s) (global.get $CODE_DOUBLE_LITTLE))
+      (call $writefloat (local.get $s) (local.get $v)))
+
+   (func $extern_float_array
+      (param $s (ref $extern_state)) (param $v (ref $block))
+      (local $nfloats i32)
+      (local.set $nfloats (array.len (local.get $v)))
+      (if (i32.lt_u (local.get $nfloats) (i32.const 0x100))
+         (then
+            (call $writecode8 (local.get $s)
+               (global.get $CODE_DOUBLE_ARRAY8_LITTLE) (local.get $nfloats)))
+         (else
+            (call $writecode32 (local.get $s)
+               (global.get $CODE_DOUBLE_ARRAY32_LITTLE) (local.get $nfloats))))
+      (call $writefloats (local.get $s) (local.get $v)))
+
+   (data $incorrect_sizes "output_value: incorrect fixed sizes specified by ")
+
+   (func $extern_custom
+      (param $s (ref $extern_state)) (param $v (ref $custom)) (result i32 i32)
+      (local $ops (ref $custom_operations))
+      (local $serialize (ref $serialize))
+      (local $fixed_length (ref $fixed_length))
+      (local $pos i32) (local $buf (ref $string))
+      (local $r (i32 i32))
+      (local.set $ops (struct.get $custom 0 (local.get $v)))
+      (block $abstract
+         (local.set $serialize
+            (br_on_null $abstract
+               (struct.get $custom_operations $serialize (local.get $ops))))
+         (block $variable_length
+            (local.set $fixed_length
+               (br_on_null $variable_length
+                  (struct.get $custom_operations $fixed_length
+                     (local.get $ops))))
+            (call $write (local.get $s) (global.get $CODE_CUSTOM_FIXED))
+            (call $writeblock (local.get $s)
+               (struct.get $custom_operations $id (local.get $ops)))
+            (call $write (local.get $s) (i32.const 0))
+            (local.set $r
+               (call_ref $serialize
+                  (local.get $s) (local.get $v) (local.get $serialize)))
+            (if (i32.or
+                   (i32.ne (tuple.extract 0 (local.get $r))
+                      (struct.get $fixed_length $bsize_32
+                        (local.get $fixed_length)))
+                   (i32.ne (tuple.extract 1 (local.get $r))
+                      (struct.get $fixed_length $bsize_64
+                        (local.get $fixed_length))))
+                (then
+                   (call $caml_failwith
+                      (call $caml_string_cat
+                         (array.new_data $string $incorrect_sizes
+                            (i32.const 0) (i32.const 49))
+                         (struct.get $custom_operations $id
+                            (local.get $ops))))))
+            (return (local.get $r)))
+         ;; variable length
+         (call $write (local.get $s) (global.get $CODE_CUSTOM_LEN))
+         (call $writeblock (local.get $s)
+            (struct.get $custom_operations $id (local.get $ops)))
+         (call $write (local.get $s) (i32.const 0))
+         (local.set $pos
+            (call $reserve_extern_output (local.get $s) (i32.const 12)))
+         (local.set $buf (struct.get $extern_state $buf (local.get $s)))
+         (local.set $r
+            (call_ref $serialize
+               (local.get $s) (local.get $v) (local.get $serialize)))
+         (call $store32 (local.get $buf) (local.get $pos)
+            (tuple.extract 0 (local.get $r)))
+         (call $store32 (local.get $buf) (i32.add (local.get $pos) (i32.const 8))
+            (tuple.extract 1 (local.get $r)))
+         (return (local.get $r)))
+      (call $caml_invalid_argument
+         (array.new_data $string $cust_value (i32.const 0) (i32.const 37)))
+      (return (tuple.make (i32.const 0) (i32.const 0))))
+
+   (data $func_value "output_value: functional value")
+   (data $cont_value "output_value: continuation value")
+   (data $js_value "output_value: abstract value (JavaScript value)")
+   (data $abstract_value "output_value: abstract value")
+   (data $cust_value "output_value: abstract value (Custom)")
+
+   (func $extern_rec (param $s (ref $extern_state)) (param $v (ref eq))
+      (local $sp (ref null $stack_item))
+      (local $item (ref $stack_item))
+      (local $b (ref $block)) (local $str (ref $string))
+      (local $hd i32) (local $tag i32) (local $sz i32)
+      (local $pos i32)
+      (local $r (i32 i32))
+      (loop $loop
+         (block $next_item
+            (drop (block $not_int (result (ref eq))
+               (call $extern_int (local.get $s)
+                  (i31.get_s
+                     (br_on_cast_fail $not_int (ref eq) (ref i31)
+                        (local.get $v))))
+               (br $next_item)))
+            (drop (block $not_block (result (ref eq))
+               (local.set $b
+                  (br_on_cast_fail $not_block (ref eq) (ref $block)
+                     (local.get $v)))
+               (local.set $tag
+                  (i31.get_u
+                     (ref.cast (ref i31)
+                        (array.get $block (local.get $b) (i32.const 0)))))
+               (local.set $sz (i32.sub (array.len (local.get $b)) (i32.const 1)))
+               (if (i32.eqz (local.get $sz))
+                  (then
+                     (call $extern_header
+                        (local.get $s) (i32.const 0) (local.get $tag))
+                     (br $next_item)))
+               (local.set $pos
+                  (call $extern_lookup_position (local.get $s) (local.get $v)))
+               (if (i32.ge_s (local.get $pos) (i32.const 0))
+                  (then
+                     (call $extern_shared_reference (local.get $s)
+                        (i32.sub
+                           (struct.get $extern_state $obj_counter (local.get $s))
+                           (local.get $pos)))
+                     (br $next_item)))
+               (call $extern_record_location (local.get $s) (local.get $v))
+               (if (i32.eq (local.get $tag) (global.get $double_array_tag))
+                  (then
+                     (call $extern_float_array (local.get $s) (local.get $b))
+                     (call $extern_size (local.get $s)
+                        (i32.mul (local.get $sz) (i32.const 2))
+                        (local.get $sz))
+                     (br $next_item)))
+               (call $extern_header
+                  (local.get $s) (local.get $sz) (local.get $tag))
+               (call $extern_size
+                  (local.get $s) (local.get $sz) (local.get $sz))
+               (if (i32.gt_u (local.get $sz) (i32.const 1))
+                  (then
+                     (local.set $sp
+                        (struct.new $stack_item
+                           (local.get $b)
+                           (i32.const 2)
+                           (local.get $sp)))))
+               (local.set $v (array.get $block (local.get $b) (i32.const 1)))
+               (br $loop)))
+            (local.set $pos
+               (call $extern_lookup_position (local.get $s) (local.get $v)))
+            (if (i32.ge_s (local.get $pos) (i32.const 0))
+               (then
+                  (call $extern_shared_reference (local.get $s)
+                     (i32.sub
+                        (struct.get $extern_state $obj_counter (local.get $s))
+                        (local.get $pos)))
+                  (br $next_item)))
+            (call $extern_record_location (local.get $s) (local.get $v))
+            (drop (block $not_string (result (ref eq))
+               (local.set $str
+                  (br_on_cast_fail $not_string (ref eq) (ref $string)
+                     (local.get $v)))
+               (call $extern_string (local.get $s) (local.get $str))
+               (local.set $sz (array.len (local.get $str)))
+               (call $extern_size (local.get $s)
+                  (i32.add (i32.const 1)
+                     (i32.shr_u (local.get $sz) (i32.const 2)))
+                  (i32.add (i32.const 1)
+                     (i32.shr_u (local.get $sz) (i32.const 3))))
+               (br $next_item)))
+            (drop (block $not_float (result (ref eq))
+               (call $extern_float (local.get $s)
+                  (struct.get $float 0
+                     (br_on_cast_fail $not_float (ref eq) (ref $float)
+                        (local.get $v))))
+               (call $extern_size (local.get $s) (i32.const 2) (i32.const 1))
+               (br $next_item)))
+            (drop (block $not_custom (result (ref eq))
+               (local.set $r
+                  (call $extern_custom (local.get $s)
+                     (br_on_cast_fail $not_custom (ref eq) (ref $custom)
+                        (local.get $v))))
+               (call $extern_size (local.get $s)
+                  (i32.shr_u
+                     (i32.add (tuple.extract 0 (local.get $r)) (i32.const 7))
+                        (i32.const 2))
+                  (i32.shr_u
+                     (i32.add (tuple.extract 1 (local.get $r)) (i32.const 15))
+                        (i32.const 3)))
+               (br $next_item)))
+            (if (ref.test (ref $closure) (local.get $v))
+               (then
+                  (call $caml_invalid_argument
+                     (array.new_data $string $func_value
+                        (i32.const 0) (i32.const 30)))))
+            (if (call $caml_is_continuation (local.get $v))
+               (then
+                  (call $caml_invalid_argument
+                     (array.new_data $string $cont_value
+                        (i32.const 0) (i32.const 32)))))
+            (if (ref.test (ref $js) (local.get $v))
+               (then
+                  (call $caml_invalid_argument
+                     (array.new_data $string $js_value
+                        (i32.const 0) (i32.const 47)))))
+            (call $caml_invalid_argument
+               (array.new_data $string $abstract_value
+                  (i32.const 0) (i32.const 28)))
+         )
+         ;; next_item
+         (block $done
+            (local.set $item (br_on_null $done (local.get $sp)))
+            (local.set $b (struct.get $stack_item $blk (local.get $item)))
+            (local.set $pos (struct.get $stack_item $pos (local.get $item)))
+            (local.set $v (array.get $block (local.get $b) (local.get $pos)))
+            (local.set $pos (i32.add (local.get $pos) (i32.const 1)))
+            (struct.set $stack_item $pos (local.get $item) (local.get $pos))
+            (if (i32.eq (local.get $pos) (array.len (local.get $b)))
+               (then
+                  (local.set $sp
+                     (struct.get $stack_item $next (local.get $item)))))
+            (br $loop))))
+
+   (func $extern_output_length
+      (param $s (ref $extern_state)) (param $pos i32) (result i32)
+      (local $len i32)
+      (local $output_block (ref $output_block))
+      (if (struct.get $extern_state $user_provided_output (local.get $s))
+         (then
+            (return
+               (i32.sub (struct.get $extern_state $pos (local.get $s))
+                  (local.get $pos))))
+         (else
+            (struct.set $output_block $end
+               (struct.get $extern_state $output_last (local.get $s))
+               (struct.get $extern_state $pos (local.get $s)))
+            (local.set $output_block
+               (struct.get $extern_state $output_first (local.get $s)))
+            (loop $loop
+               (block $done
+                  (local.set $len
+                     (i32.add (local.get $len)
+                        (struct.get $output_block $end
+                           (local.get $output_block))))
+                  (local.set $output_block
+                     (br_on_null $done
+                        (struct.get $output_block $next
+                           (local.get $output_block))))
+                  (br $loop)))
+            (return (local.get $len)))))
+
+   (func $extern_value
+      (param $flags (ref eq)) (param $output (ref $output_block))
+      (param $pos i32) (param $user_provided_output i32) (param $v (ref eq))
+      (result i32 (ref $string) (ref $extern_state))
+      (local $s (ref $extern_state)) (local $len i32)
+      (local $header (ref $string))
+      (local.set $s
+         (call $init_extern_state
+            (local.get $flags) (local.get $output) (local.get $pos)
+            (local.get $user_provided_output)))
+      (call $extern_rec (local.get $s) (local.get $v))
+      (local.set $len
+         (call $extern_output_length (local.get $s) (local.get $pos)))
+      (local.set $header (array.new $string (i32.const 0) (i32.const 20)))
+      (call $store32 (local.get $header) (i32.const 0)
+         (global.get $Intext_magic_number_small))
+      (call $store32 (local.get $header) (i32.const 4) (local.get $len))
+      (call $store32 (local.get $header) (i32.const 8)
+         (struct.get $extern_state $obj_counter (local.get $s)))
+      (call $store32 (local.get $header) (i32.const 12)
+         (struct.get $extern_state $size_32 (local.get $s)))
+      (call $store32 (local.get $header) (i32.const 16)
+         (struct.get $extern_state $size_64 (local.get $s)))
+      (tuple.make (local.get $len) (local.get $header) (local.get $s)))
+
+   (func (export "caml_output_value_to_string")
+      (param $v (ref eq)) (param $flags (ref eq)) (result (ref eq))
+      (local $r (i32 (ref $string) (ref $extern_state)))
+      (local $blk (ref $output_block)) (local $pos i32) (local $len i32)
+      (local $res (ref $string))
+      (local.set $blk
+         (struct.new $output_block
+            (ref.null $output_block)
+            (global.get $SIZE_EXTERN_OUTPUT_BLOCK)
+            (array.new $string (i32.const 0)
+               (global.get $SIZE_EXTERN_OUTPUT_BLOCK))))
+      (local.set $r
+         (call $extern_value
+            (local.get $flags) (local.get $blk)
+            (i32.const 0) (i32.const 0) (local.get $v)))
+      (local.set $res
+         (array.new $string (i32.const 0)
+            (i32.add (tuple.extract 0 (local.get $r)) (i32.const 20))))
+      (array.copy $string $string
+         (local.get $res) (i32.const 0)
+         (tuple.extract 1 (local.get $r)) (i32.const 0) (i32.const 20))
+      (local.set $pos (i32.const 20))
+      (loop $loop
+         (block $done
+            (local.set $len (struct.get $output_block $end (local.get $blk)))
+            (array.copy $string $string
+               (local.get $res) (local.get $pos)
+               (struct.get $output_block $data (local.get $blk)) (i32.const 0)
+               (local.get $len))
+            (local.set $pos (i32.add (local.get $pos) (local.get $len)))
+            (local.set $blk
+               (br_on_null $done
+                  (struct.get $output_block $next (local.get $blk))))
+            (br $loop)))
+      (local.get $res))
+
    (func (export "caml_output_value_to_buffer")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_output_value_to_buffer"))
+      (param $vbuf (ref eq)) (param $vpos (ref eq)) (param $vlen (ref eq))
+      (param $v (ref eq)) (param $flags (ref eq)) (result (ref eq))
+      (local $buf (ref $string)) (local $pos i32) (local $len i32)
+      (local $r (i32 (ref $string) (ref $extern_state)))
+      (local $blk (ref $output_block))
+      (local.set $buf (ref.cast (ref $string) (local.get $vbuf)))
+      (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
+      (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+      (local.set $blk
+         (struct.new $output_block
+            (ref.null $output_block)
+            (i32.add (local.get $pos) (local.get $len))
+            (local.get $buf)))
+      (local.set $r
+         (call $extern_value
+            (local.get $flags)
+            (local.get $blk)
+            (i32.add (local.get $pos) (i32.const 20))
+            (i32.const 1)
+            (local.get $v)))
+      (array.copy $string $string
+         (local.get $buf) (local.get $pos)
+         (tuple.extract 1 (local.get $r)) (i32.const 0) (i32.const 20))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_output_value_to_string")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_output_value_to_string"))
-      (array.new_fixed $string))
+   (func (export "caml_output_value")
+      (param $ch (ref eq)) (param $v (ref eq)) (param $flags (ref eq))
+      (result (ref eq))
+      (local $r (i32 (ref $string) (ref $extern_state)))
+      (local $blk (ref $output_block)) (local $len i32)
+      (local $res (ref $string))
+      ;; ZZZ check if binary channel?
+      (local.set $blk
+         (struct.new $output_block
+            (ref.null $output_block)
+            (global.get $SIZE_EXTERN_OUTPUT_BLOCK)
+            (array.new $string (i32.const 0)
+               (global.get $SIZE_EXTERN_OUTPUT_BLOCK))))
+      (local.set $r
+         (call $extern_value
+            (local.get $flags) (local.get $blk)
+            (i32.const 0) (i32.const 0) (local.get $v)))
+      (call $caml_really_putblock (local.get $ch)
+         (tuple.extract 1 (local.get $r)) (i32.const 0) (i32.const 20))
+      (loop $loop
+         (block $done
+            (local.set $len (struct.get $output_block $end (local.get $blk)))
+            (call $caml_really_putblock (local.get $ch)
+               (struct.get $output_block $data (local.get $blk))
+               (i32.const 0)
+               (struct.get $output_block $end (local.get $blk)))
+            (local.set $blk
+               (br_on_null $done
+                  (struct.get $output_block $next (local.get $blk))))
+            (br $loop)))
+      ;; ZZZ flush if unbuffered
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_serialize_int_1") (param $vs (ref eq)) (param $i i32)
+      (local $s (ref $extern_state))
+      (local $pos i32)
+      (local.set $s (ref.cast (ref $extern_state) (local.get $vs)))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 1)))
+      (array.set $string (struct.get $extern_state $buf (local.get $s))
+         (local.get $pos) (local.get $i)))
+
+   (func (export "caml_serialize_int_2") (param $vs (ref eq)) (param $i i32)
+      (local $s (ref $extern_state))
+      (local $pos i32)
+      (local.set $s (ref.cast (ref $extern_state) (local.get $vs)))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 2)))
+      (call $store16 (struct.get $extern_state $buf (local.get $s))
+         (local.get $pos) (local.get $i)))
+
+   (func (export "caml_serialize_int_4") (param $vs (ref eq)) (param $i i32)
+      (local $s (ref $extern_state))
+      (local $pos i32)
+      (local.set $s (ref.cast (ref $extern_state) (local.get $vs)))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 4)))
+      (call $store32 (struct.get $extern_state $buf (local.get $s))
+         (local.get $pos) (local.get $i)))
+
+   (func (export "caml_serialize_int_8") (param $vs (ref eq)) (param $i i64)
+      (local $s (ref $extern_state))
+      (local $pos i32)
+      (local.set $s (ref.cast (ref $extern_state) (local.get $vs)))
+      (local.set $pos
+         (call $reserve_extern_output (local.get $s) (i32.const 8)))
+      (call $store64 (struct.get $extern_state $buf (local.get $s))
+         (local.get $pos) (local.get $i)))
 )
diff --git a/runtime/wasm/md5.wat b/runtime/wasm/md5.wat
index d8985af715..e3ec9a54e1 100644
--- a/runtime/wasm/md5.wat
+++ b/runtime/wasm/md5.wat
@@ -1,5 +1,9 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "io" "caml_getblock"
+      (func $caml_getblock
+         (param (ref eq)) (param (ref $string)) (param i32) (param i32)
+         (result i32)))
+   (import "fail" "caml_raise_end_of_file" (func $caml_raise_end_of_file))
 
    (type $string (array (mut i8)))
    (type $int_array (array (mut i32)))
@@ -21,10 +25,41 @@
       (return_call $MD5Final (local.get $ctx)))
 
    (func (export "caml_md5_chan")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_md5_chan"))
-      (array.new $string (i32.const 0) (i32.const 16)))
+      (param $ch (ref eq)) (param $vlen (ref eq)) (result (ref eq))
+      (local $len i32) (local $read i32)
+      (local $buf (ref $string))
+      (local $ctx (ref $context))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
+      (local.set $buf (array.new $string (i32.const 0) (i32.const 4096)))
+      (local.set $ctx (call $MD5Init))
+      (if (i32.lt_s (local.get $len) (i32.const 0))
+         (then
+            (loop $loop
+               (local.set $read
+                  (call $caml_getblock (local.get $ch) (local.get $buf)
+                     (i32.const 0) (i32.const 4096)))
+               (if (local.get $read)
+                  (then
+                     (call $MD5Update (local.get $ctx) (local.get $buf)
+                        (i32.const 0) (local.get $read))
+                     (br $loop)))))
+         (else
+            (loop $loop
+               (if (local.get $len)
+                  (then
+                     (local.set $read
+                        (call $caml_getblock (local.get $ch) (local.get $buf)
+                           (i32.const 0)
+                           (select (local.get $len) (i32.const 4096)
+                              (i32.le_u (local.get $len) (i32.const 4096)))))
+                     (if (i32.eqz (local.get $read))
+                        (then (call $caml_raise_end_of_file)))
+                     (call $MD5Update (local.get $ctx) (local.get $buf)
+                        (i32.const 0) (local.get $read))
+                     (local.set $len
+                        (i32.sub (local.get $len) (local.get $read)))
+                     (br $loop))))))
+      (return_call $MD5Final (local.get $ctx)))
 
    (func $xx
       (param $q i32) (param $a i32) (param $b i32) (param $x i32) (param $s i32)
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 097c8d7f2c..ca36b86898 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -1,26 +1,15 @@
 (module
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
+   (import "custom" "caml_is_custom"
+      (func $caml_is_custom (param (ref eq)) (result i32)))
    (import "effect" "caml_is_continuation"
       (func $caml_is_continuation (param (ref eq)) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
-   (type $value->value->int->int
-      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
-      (func (param (ref eq)) (result i32)))
-   (type $custom_operations
-      (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-   (type $closure (struct (;(field i32);) (field (ref $function_1))))
+   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
    (type $closure_last_arg
       (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
 
@@ -183,7 +172,7 @@
          (then (return (i31.new (global.get $string_tag)))))
       (if (ref.test (ref $float) (local.get $v))
          (then (return (i31.new (global.get $float_tag)))))
-      (if (ref.test (ref $custom) (local.get $v))
+      (if (call $caml_is_custom (local.get $v))
          (then (return (i31.new (global.get $custom_tag)))))
       (if (ref.test (ref $closure) (local.get $v))
          (then (return (i31.new (global.get $closure_tag)))))
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index 87f9a69f5a..d0984ad795 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -5,38 +5,14 @@
       (func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_set_i32"
       (func $ta_set_i32 (param (ref extern)) (param i32) (param i32)))
-
-   (type $string (array (mut i8)))
-   (type $value->value->int->int
-      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
-      (func (param (ref eq)) (result i32)))
-   (type $custom_operations
-      (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
-   (type $int_array (array (mut i32)))
-   (type $bigarray
-      (sub $custom
-         (struct
-            (field (ref $custom_operations))
-            (field (mut (ref extern))) ;; data
-            (field (ref $int_array)) ;; size in each dimension
-            (field i8) ;; number of dimensions
-            (field i8) ;; kind
-            (field i8)))) ;; layout
+   (import "bigarray" "caml_ba_get_data"
+      (func $caml_ba_get_data (param (ref eq)) (result (ref extern))))
 
    (func (export "caml_lxm_next") (param $v (ref eq)) (result (ref eq))
       (local $data (ref extern))
       (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64)
       (local $z i64)
-      (local.set $data
-         (struct.get $bigarray 1 (ref.cast (ref $bigarray) (local.get $v))))
+      (local.set $data (call $caml_ba_get_data (local.get $v)))
       (local.set $a
          (i64.or
             (i64.extend_i32_u
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 7c8b7c9047..45c297e7d1 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -297,7 +297,7 @@
          weak_new:(v)=>new WeakRef(v),
          weak_deref:(w)=>{var v = w.deref(); return v==undefined?null:v},
          weak_map_new:()=>new WeakMap,
-         weak_map_get:(m,x)=>m.get(x),
+         weak_map_get:(m,x)=>{var v = m.get(x); return v==undefined?null:v},
          weak_map_set:(m,x,v)=>m.set(x,v),
          weak_map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 8e1c39da5a..75a9770552 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -4,27 +4,14 @@
       (func $caml_invalid_argument (param $arg (ref eq))))
    (import "int32" "caml_copy_int32"
       (func $caml_copy_int32 (param i32) (result (ref eq))))
+   (import "int32" "Int32_val"
+      (func $Int32_val (param (ref eq)) (result i32)))
    (import "int64" "caml_copy_int64"
       (func $caml_copy_int64 (param i64) (result (ref eq))))
+   (import "int64" "Int64_val"
+      (func $Int64_val (param (ref eq)) (result i64)))
 
    (type $string (array (mut i8)))
-   (type $value->value->int->int
-      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
-      (func (param (ref eq)) (result i32)))
-   (type $custom_operations
-      (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
-   (type $int32
-      (sub final $custom (struct (field (ref $custom_operations)) (field i32))))
-   (type $int64
-      (sub final $custom (struct (field (ref $custom_operations)) (field i64))))
 
    (export "caml_bytes_equal" (func $caml_string_equal))
    (func $caml_string_equal (export "caml_string_equal")
@@ -274,7 +261,7 @@
       (local $s (ref $string)) (local $p i32) (local $v i32)
       (local.set $s (ref.cast (ref $string) (local.get 0)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
-      (local.set $v (struct.get $int32 1 (ref.cast (ref $int32) (local.get 2))))
+      (local.set $v (call $Int32_val (local.get 2)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -297,7 +284,7 @@
       (local $s (ref $string)) (local $p i32) (local $v i64)
       (local.set $s (ref.cast (ref $string) (local.get 0)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
-      (local.set $v (struct.get $int64 1 (ref.cast (ref $int64) (local.get 2))))
+      (local.set $v (call $Int64_val (local.get 2)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
@@ -327,4 +314,24 @@
          (i32.add (local.get $p) (i32.const 7))
          (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 56))))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_string_cat")
+      (param $vs1 (ref eq)) (param $vs2 (ref eq)) (result (ref eq))
+      (local $s1 (ref $string)) (local $s2 (ref $string))
+      (local $s (ref $string))
+      (local $l1 i32) (local $l2 i32)
+      (local.set $s1 (ref.cast (ref $string) (local.get $vs1)))
+      (local.set $s2 (ref.cast (ref $string) (local.get $vs2)))
+      (local.set $l1 (array.len (local.get $s1)))
+      (local.set $l2 (array.len (local.get $s2)))
+      (local.set $s
+         (array.new $string (i32.const 0)
+            (i32.add (local.get $l1) (local.get $l2))))
+      (array.copy $string $string
+         (local.get $s) (i32.const 0) (local.get $s1) (i32.const 0)
+         (local.get $l1))
+      (array.copy $string $string
+         (local.get $s) (local.get $l1) (local.get $s2) (i32.const 0)
+         (local.get $l2))
+      (local.get $s))
 )
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index f66e56c57b..3672a9d9aa 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -8,19 +8,24 @@
    (import "custom" "custom_next_id" (func $custom_next_id (result i64)))
 
    (type $string (array (mut i8)))
-   (type $value->value->int->int
+   (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $value->int
+   (type $hash
       (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
    (type $custom_operations
       (struct
-         (field $cust_id (ref $string))
-         (field $cust_compare (ref null $value->value->int->int))
-         (field $cust_compare_ext (ref null $value->value->int->int))
-         (field $cust_hash (ref null $value->int))
-         ;; ZZZ
-      ))
-   (type $custom (struct (field (ref $custom_operations))))
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
    (type $custom_with_id
       (sub $custom
          (struct
@@ -33,8 +38,11 @@
             (i32.const 95) (i32.const 109) (i32.const 117) (i32.const 116)
             (i32.const 101) (i32.const 120))
          (ref.func $custom_compare_id)
-         (ref.null $value->value->int->int)
-         (ref.func $custom_hash_id)))
+         (ref.null $compare)
+         (ref.func $custom_hash_id)
+         (ref.null $fixed_length)
+         (ref.null $serialize)
+         (ref.null $deserialize)))
 
    (type $mutex
       (sub final $custom_with_id

From 693611170d087e0436024f63be0258bc5be589a7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Aug 2023 17:06:44 +0200
Subject: [PATCH 119/481] Exception handling fix

---
 compiler/lib/wasm/wa_core_target.ml | 2 +-
 compiler/lib/wasm/wa_gc_target.ml   | 4 ++--
 compiler/lib/wasm/wa_generate.ml    | 5 ++---
 compiler/lib/wasm/wa_target_sig.ml  | 5 ++++-
 4 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 4b6a4ab2ac..3f73662b41 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -606,7 +606,7 @@ module Math = struct
   let fmod f g = binary "fmod" f g
 end
 
-let exception_handler_body ~typ:_ b = b
+let exception_handler_body ~typ:_ ~context b = b context
 
 let entry_point ~context:_ =
   let code =
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ec5d843d58..a2677b0a28 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -978,7 +978,7 @@ module Math = struct
   let exp2 x = power (return (W.Const (F64 2.))) x
 end
 
-let exception_handler_body ~typ b =
+let exception_handler_body ~typ ~context b =
   let externref = W.Ref { nullable = true; typ = Extern } in
   let* js_tag = register_import ~name:"javascript_exception" (Tag externref) in
   let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
@@ -990,7 +990,7 @@ let exception_handler_body ~typ b =
   in
   try_
     { params = []; result = typ }
-    b
+    (b (`Skip :: context))
     js_tag
     (let* () = store ~always:true ~typ:externref x (return (W.Pop externref)) in
      let* exn = load x in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 87534078ee..6071238805 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -809,9 +809,8 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* tag = register_import ~name:exception_name (Tag Value.value) in
               try_
                 { params = []; result = result_typ }
-                (exception_handler_body
-                   ~typ:result_typ
-                   (translate_branch result_typ fall_through pc cont context' stack_ctx))
+                (exception_handler_body ~typ:result_typ ~context:context' (fun context' ->
+                     translate_branch result_typ fall_through pc cont context' stack_ctx))
                 tag
                 (let* () = store ~always:true x (return (W.Pop Value.value)) in
                  translate_branch result_typ fall_through pc cont' context' stack_ctx)
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 7f4f41a54a..2f94f1f8e3 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -254,7 +254,10 @@ module type S = sig
   end
 
   val exception_handler_body :
-    typ:Wa_ast.value_type list -> unit Wa_code_generation.t -> unit Wa_code_generation.t
+       typ:Wa_ast.value_type list
+    -> context:[ `Block of Code.Addr.t | `Skip ] list
+    -> ([ `Block of Code.Addr.t | `Skip ] list -> unit Wa_code_generation.t)
+    -> unit Wa_code_generation.t
 
   val entry_point :
     context:Wa_code_generation.context -> Wa_ast.func_type * unit Wa_code_generation.t

From 0fb0f5d5e9db7cdd2ef73f38bdf7ffc4c9cff71d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Aug 2023 18:24:21 +0200
Subject: [PATCH 120/481] Runtime: unbuffered output

---
 runtime/wasm/io.wat      | 36 ++++++++++++++++++++++++++----------
 runtime/wasm/marshal.wat |  4 +++-
 2 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 3929621ae9..7b04693122 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -87,7 +87,7 @@
             (field $curr (mut i32))
             (field $max (mut i32))
             (field $size (mut i32))
-            (field $flags (mut i32))))) ;; flags
+            (field $unbuffered (mut i32)))))
 
    (global $fd_offsets (export "fd_offsets") (mut (ref $offset_array))
       (array.new $offset_array (i64.const 0) (i32.const 3)))
@@ -543,6 +543,13 @@
       (loop $loop
          (br_if $loop (i32.eqz (call $caml_flush_partial (local.get $ch))))))
 
+   (func $caml_flush_if_unbuffered (export "caml_flush_if_unbuffered")
+      (param $vch (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (if (struct.get $channel $unbuffered (local.get $ch))
+         (then (call $caml_flush (local.get $ch)))))
+
    (func $caml_ml_flush (export "caml_ml_flush")
       (param $vch (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
@@ -637,6 +644,7 @@
                (local.set $pos (i32.add (local.get $pos) (local.get $written)))
                (local.set $len (i32.sub (local.get $len) (local.get $written)))
                (br $loop))))
+      (call $caml_flush_if_unbuffered (local.get $ch))
       (i31.new (i32.const 0)))
 
    (func $caml_putch (param $ch (ref $channel)) (param $c $i32)
@@ -655,7 +663,7 @@
       (param $ch (ref eq)) (param $c (ref eq)) (result (ref eq))
       (call $caml_putch (ref.cast (ref $channel) (local.get $ch))
          (i31.get_u (ref.cast (ref i31) (local.get 1))))
-      ;; ZZZ flush if unbuffered
+      (call $caml_flush_if_unbuffered (local.get $ch))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_output_int")
@@ -670,18 +678,26 @@
       (call $caml_putch (local.get $ch)
          (i32.shr_u (local.get $n) (i32.const 8)))
       (call $caml_putch (local.get $ch) (local.get $n))
-      ;; ZZZ flush if unbuffered
+      (call $caml_flush_if_unbuffered (local.get $ch))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_ml_is_buffered") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_is_buffered"))
-      (i31.new (i32.const 1)))
+   (func (export "caml_ml_is_buffered") (param $ch (ref eq)) (result (ref eq))
+      (i31.new
+         (i32.eqz
+            (struct.get $channel $unbuffered
+               (ref.cast (ref $channel) (local.get $ch))))))
 
    (func (export "caml_ml_set_buffered")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_set_buffered"))
+      (param $vch (ref eq)) (param $mode (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (if (i31.get_s (ref.cast (ref i31) (local.get $mode)))
+         (then
+            (struct.set $channel $unbuffered (local.get $ch) (i32.const 0)))
+         (else
+            (struct.set $channel $unbuffered (local.get $ch) (i32.const 1))
+            (if (i32.ne (struct.get $channel $fd (local.get $ch)) (i32.const -1))
+               (then (call $caml_flush (local.get $ch))))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_set_channel_refill")
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index dcdc5acc81..35326a1b3e 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -21,6 +21,8 @@
       (func $caml_really_getblock
          (param (ref eq)) (param (ref $string)) (param i32) (param i32)
          (result i32)))
+   (import "io" "caml_flush_if_unbuffered"
+      (func $caml_flush_if_unbuffered (param (ref eq))))
    (import "custom" "caml_init_custom_operations"
       (func $caml_init_custom_operations))
    (import "custom" "caml_find_custom_operations"
@@ -1378,7 +1380,7 @@
                (br_on_null $done
                   (struct.get $output_block $next (local.get $blk))))
             (br $loop)))
-      ;; ZZZ flush if unbuffered
+      (call $caml_flush_if_unbuffered (local.get $ch))
       (i31.new (i32.const 0)))
 
    (func (export "caml_serialize_int_1") (param $vs (ref eq)) (param $i i32)

From 00166d2e29202dc8102450a46e0b628acaffdd2c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Aug 2023 19:26:55 +0200
Subject: [PATCH 121/481] Runtime: I/O improvements

---
 runtime/wasm/io.wat     | 265 ++++++++++++++++++++++++++--------------
 runtime/wasm/runtime.js |   2 +-
 2 files changed, 175 insertions(+), 92 deletions(-)

diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 7b04693122..a1c006c6cf 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -12,11 +12,20 @@
    (import "bindings" "close" (func $close (param i32)))
    (import "bindings" "write"
       (func $write
-         (param i32) (param (ref extern)) (param i32) (param i32) (result i32)))
+         (param i32) (param (ref extern)) (param i32) (param i32) (param i64)
+         (result i32)))
+   (import "bindings" "write"
+      (func $write'
+         (param i32) (param (ref extern)) (param i32) (param i32)
+         (param nullexternref) (result i32)))
    (import "bindings" "read"
       (func $read
          (param i32) (param (ref extern)) (param i32) (param i32) (param i64)
          (result i32)))
+   (import "bindings" "read"
+      (func $read'
+         (param i32) (param (ref extern)) (param i32) (param i32)
+         (param nullexternref) (result i32)))
    (import "bindings" "file_size" (func $file_size (param i32) (result i64)))
    (import "bindings" "register_channel"
       (func $register_channel (param (ref eq))))
@@ -36,6 +45,10 @@
    (import "custom" "custom_hash_id"
       (func $custom_hash_id (param (ref eq)) (result i32)))
    (import "custom" "custom_next_id" (func $custom_next_id (result i64)))
+   (import "int64" "caml_copy_int64"
+      (func $caml_copy_int64 (param i64) (result (ref eq))))
+   (import "int64" "Int64_val"
+      (func $Int64_val (param (ref eq)) (result i64)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -91,10 +104,13 @@
 
    (global $fd_offsets (export "fd_offsets") (mut (ref $offset_array))
       (array.new $offset_array (i64.const 0) (i32.const 3)))
+   (global $fd_seeked (mut (ref $string))
+      (array.new $string (i32.const 0) (i32.const 3)))
 
    (func $initialize_fd_offset (param $fd i32) (param $offset i64)
       (local $len i32)
       (local $a (ref $offset_array))
+      (local $b (ref $string))
       (local.set $len (array.len (global.get $fd_offsets)))
       (if (i32.ge_u (local.get $fd) (local.get $len))
          (then
@@ -107,9 +123,17 @@
                (local.get $a) (i32.const 0)
                (global.get $fd_offsets) (i32.const 0)
                (array.len (global.get $fd_offsets)))
-             (global.set $fd_offsets (local.get $a))))
+            (global.set $fd_offsets (local.get $a))
+            (local.set $b
+               (array.new $string (i32.const 0) (local.get $len)))
+            (array.copy $string $string
+               (local.get $b) (i32.const 0)
+               (global.get $fd_seeked) (i32.const 0)
+               (array.len (global.get $fd_seeked)))
+            (global.set $fd_seeked (local.get $b))))
       (array.set $offset_array (global.get $fd_offsets) (local.get $fd)
-        (local.get $offset)))
+        (local.get $offset))
+      (array.set $string (global.get $fd_seeked) (local.get $fd) (i32.const 0)))
 
    (global $IO_BUFFER_SIZE i32 (i32.const 65536))
 
@@ -146,16 +170,18 @@
       (local.get $flags))
 
    (func (export "caml_sys_open")
-      (param $path (ref eq)) (param $flags (ref eq)) (param $perm (ref eq))
+      (param $path (ref eq)) (param $vflags (ref eq)) (param $perm (ref eq))
       (result (ref eq))
-      (local $fd i32)
+      (local $fd i32) (local $flags i32) (local $offset i64)
+      (local.set $flags (call $convert_flag_list (local.get $vflags)))
       (local.set $fd
          (call $open
             (call $unwrap (call $caml_jsstring_of_string (local.get $path)))
-            (call $convert_flag_list (local.get $flags))
+            (local.get $flags)
             (i31.get_u (ref.cast (ref i31) (local.get $perm)))))
-      ;; ZZZ initial offset is file size when appending
-      (call $initialize_fd_offset (local.get $fd) (i64.const 0))
+      (if (i32.and (local.get $flags) (i32.const 4)) ;; O_APPEND
+         (then (local.set $offset (call $file_size (local.get $fd)))))
+      (call $initialize_fd_offset (local.get $fd) (local.get $offset))
       (i31.new (local.get $fd)))
 
    (func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
@@ -220,6 +246,36 @@
             (call $close (local.get $fd))))
       (i31.new (i32.const 0)))
 
+   (func $caml_do_read
+      (param $ch (ref $channel)) (param $pos i32) (param $len i32) (result i32)
+      (local $fd i32)
+      (local $offset i64)
+      (local $n i32)
+      (local.set $fd (struct.get $channel $fd (local.get $ch)))
+      (local.set $offset
+         (array.get $offset_array (global.get $fd_offsets) (local.get $fd)))
+      (local.set $n
+         (if (result i32)
+             (array.get_u $string (global.get $fd_seeked) (local.get $fd))
+            (then
+               (call $read
+                  (local.get $fd)
+                  (struct.get $channel $buffer (local.get $ch))
+                  (local.get $pos)
+                  (local.get $len)
+                  (local.get $offset)))
+            (else
+               (call $read'
+                  (local.get $fd)
+                  (struct.get $channel $buffer (local.get $ch))
+                  (local.get $pos)
+                  (local.get $len)
+                  (ref.null noextern)))))
+      (array.set $offset_array
+         (global.get $fd_offsets) (local.get $fd)
+         (i64.add (local.get $offset) (i64.extend_i32_u (local.get $n))))
+      (local.get $n))
+
    (func $copy_from_buffer
       (param $buf (ref extern)) (param $curr i32)
       (param $s (ref $string)) (param $pos i32) (param $len i32)
@@ -235,24 +291,12 @@
               (br $loop)))))
 
    (func $caml_refill (param $ch (ref $channel)) (result i32)
-      (local $n i32) (local $offset i64) (local $fd i32)
+      (local $n i32)
       (local $buf (ref extern))
       (local.set $buf (struct.get $channel $buffer (local.get $ch)))
-      (local.set $fd (struct.get $channel $fd (local.get $ch)))
-      (local.set $offset
-         (array.get $offset_array (global.get $fd_offsets)
-            (local.get $fd)))
       (local.set $n
-         (call $read
-            (local.get $fd)
-            (local.get $buf)
-            (i32.const 0)
-            (struct.get $channel $size (local.get $ch))
-            (local.get $offset)))
-      (array.set $offset_array
-         (global.get $fd_offsets) (local.get $fd)
-         (i64.add (local.get $offset)
-            (i64.extend_i32_u (local.get $n))))
+         (call $caml_do_read (local.get $ch)
+            (i32.const 0) (struct.get $channel $size (local.get $ch))))
       (if (i32.eqz (local.get $n))
          (then (call $caml_raise_end_of_file)))
       (struct.set $channel $max (local.get $ch) (local.get $n))
@@ -265,9 +309,7 @@
       (result i32)
       (local $ch (ref $channel))
       (local $avail i32)
-      (local $fd i32)
-      (local $buf (ref extern))
-      (local $offset i64) (local $nread i32)
+      (local $nread i32)
       (if (i32.eqz (local.get $len))
          (then (return (i32.const 0))))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
@@ -287,27 +329,14 @@
                (i32.add (struct.get $channel $curr (local.get $ch))
                   (local.get $len)))
             (return (local.get $len))))
-      (local.set $fd (struct.get $channel $fd (local.get $ch)))
-      (local.set $offset
-         (array.get $offset_array (global.get $fd_offsets)
-            (local.get $fd)))
-      (local.set $buf (struct.get $channel $buffer (local.get $ch)))
       (local.set $nread
-         (call $read
-            (local.get $fd)
-            (local.get $buf)
-            (i32.const 0)
-            (struct.get $channel $size (local.get $ch))
-            (local.get $offset)))
-      (array.set $offset_array
-         (global.get $fd_offsets) (local.get $fd)
-         (i64.add (local.get $offset)
-            (i64.extend_i32_u (local.get $nread))))
+         (call $caml_do_read (local.get $ch)
+            (i32.const 0) (struct.get $channel $size (local.get $ch))))
       (struct.set $channel $max (local.get $ch) (local.get $nread))
       (if (i32.gt_u (local.get $len) (local.get $nread))
          (then (local.set $len (local.get $nread))))
       (call $copy_from_buffer
-         (local.get $buf)
+         (struct.get $channel $buffer (local.get $ch))
          (i32.const 0)
          (local.get $s) (local.get $pos)
          (local.get $len))
@@ -339,9 +368,7 @@
       (local $ch (ref $channel)) (local $s (ref $string))
       (local $pos i32) (local $len i32) (local $curr i32)
       (local $i i32) (local $avail i32) (local $nread $i32)
-      (local $fd i32)
       (local $buf (ref extern))
-      (local $offset i64)
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (local.set $s (ref.cast (ref $string) (local.get $vs)))
       (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
@@ -356,21 +383,10 @@
                (then
                   (local.set $len (local.get $avail)))
                (else
-                  (local.set $fd (struct.get $channel $fd (local.get $ch)))
-                  (local.set $offset
-                     (array.get $offset_array (global.get $fd_offsets)
-                        (local.get $fd)))
                   (local.set $nread
-                     (call $read
-                        (local.get $fd)
-                        (local.get $buf)
+                     (call $caml_do_read (local.get $ch)
                         (i32.const 0)
-                        (struct.get $channel $size (local.get $ch))
-                        (local.get $offset)))
-                  (array.set $offset_array
-                     (global.get $fd_offsets) (local.get $fd)
-                     (i64.add (local.get $offset)
-                        (i64.extend_i32_u (local.get $nread))))
+                        (struct.get $channel $size (local.get $ch))))
                   (struct.set $channel $max (local.get $ch) (local.get $nread))
                   (local.set $curr (i32.const 0))
                   (if (i32.gt_u (local.get $len) (local.get $nread))
@@ -426,6 +442,20 @@
               (struct.get $channel $max (local.get $ch))
               (struct.get $channel $curr (local.get $ch))))))
 
+   (func (export "caml_ml_pos_in_64")
+      (param $vch (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (call $caml_copy_int64
+         (i64.sub
+            (array.get $offset_array
+               (global.get $fd_offsets)
+               (struct.get $channel $fd (local.get $ch)))
+            (i64.extend_i32_s
+               (i32.sub
+                  (struct.get $channel $max (local.get $ch))
+                  (struct.get $channel $curr (local.get $ch)))))))
+
    (func (export "caml_ml_pos_out")
       (param $vch (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
@@ -438,27 +468,74 @@
                   (struct.get $channel $fd (local.get $ch))))
             (struct.get $channel $curr (local.get $ch)))))
 
+   (func (export "caml_ml_pos_out_64")
+      (param $vch (ref eq)) (result (ref eq))
+      (local $ch (ref $channel))
+      (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (call $caml_copy_int64
+         (i64.add
+            (array.get $offset_array
+               (global.get $fd_offsets)
+               (struct.get $channel $fd (local.get $ch)))
+            (i64.extend_i32_s (struct.get $channel $curr (local.get $ch))))))
+
+   (func $caml_seek_in
+      (param $ch (ref $channel)) (param $dest i64) (result (ref eq))
+      (local $fd i32) (local $offset i64)
+      (local.set $fd (struct.get $channel $fd (local.get $ch)))
+      (local.set $offset
+         (array.get $offset_array (global.get $fd_offsets) (local.get $fd)))
+      (if (i32.and
+             (i64.ge_s
+                (local.get $dest)
+                (i64.sub
+                   (local.get $offset)
+                   (i64.extend_i32_s
+                      (struct.get $channel $max (local.get $ch)))))
+             (i64.le_s (local.get $dest) (local.get $offset)))
+         (then
+            (struct.set $channel $curr (local.get $ch)
+               (i32.sub
+                  (struct.get $channel $max (local.get $ch))
+                  (i32.wrap_i64
+                     (i64.sub (local.get $offset) (local.get $dest))))))
+         (else
+            ;; ZZZ Check for error
+            (array.set $offset_array (global.get $fd_offsets) (local.get $fd)
+               (local.get $dest))
+            (array.set $string (global.get $fd_seeked) (local.get $fd)
+               (i32.const 1))
+            (struct.set $channel $curr (local.get $ch) (i32.const 0))
+            (struct.set $channel $max (local.get $ch) (i32.const 0))))
+      (i31.new (i32.const 0)))
+
    (func (export "caml_ml_seek_in")
+      (param $ch (ref eq)) (param $dest (ref eq)) (result (ref eq))
+      (return_call $caml_seek_in (ref.cast (ref $channel) (local.get $ch))
+         (i64.extend_i32_s
+            (i31.get_s (ref.cast (ref i31) (local.get $dest))))))
+
+   (func (export "caml_ml_seek_in_64")
+      (param $ch (ref eq)) (param $dest (ref eq)) (result (ref eq))
+      (return_call $caml_seek_in (ref.cast (ref $channel) (local.get $ch))
+         (call $Int64_val (local.get $dest))))
+
+   (func (export "caml_ml_seek_out")
       (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
+      (call $caml_flush (local.get $ch))
       ;; ZZZ Check for error
       (array.set $offset_array
          (global.get $fd_offsets)
          (struct.get $channel $fd (local.get $ch))
          (i64.extend_i32_s
             (i31.get_s (ref.cast (ref i31) (local.get $voffset)))))
-      (struct.set $channel $curr (local.get $ch) (i32.const 0))
-      (struct.set $channel $max (local.get $ch) (i32.const 0))
+      (array.set $string (global.get $fd_seeked)
+         (struct.get $channel $fd (local.get $ch)) (i32.const 1))
       (i31.new (i32.const 0)))
 
-   (func (export "caml_ml_seek_in_64")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_ml_seek_in_64"))
-      (i31.new (i32.const 0)))
-
-   (func (export "caml_ml_seek_out")
+   (func (export "caml_ml_seek_out_64")
       (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
@@ -467,14 +544,14 @@
       (array.set $offset_array
          (global.get $fd_offsets)
          (struct.get $channel $fd (local.get $ch))
-         (i64.extend_i32_s
-            (i31.get_s (ref.cast (ref i31) (local.get $voffset)))))
+         (call $Int64_val (local.get $voffset)))
+      (array.set $string (global.get $fd_seeked)
+         (struct.get $channel $fd (local.get $ch)) (i32.const 1))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_input_scan_line")
       (param $vch (ref eq)) (result (ref eq))
       (local $ch (ref $channel)) (local $p i32) (local $n i32)
-      (local $offset i64) (local $fd i32)
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (local.set $p (struct.get $channel $curr (local.get $ch)))
       (loop $loop
@@ -500,24 +577,13 @@
                         (i31.new
                            (i32.sub (struct.get $channel $curr (local.get $ch))
                               (struct.get $channel $size (local.get $ch)))))))
-               ;; ZZZ Wrap in function caml_read_fd...
-               (local.set $fd (struct.get $channel $fd (local.get $ch)))
-               (local.set $offset
-                  (array.get $offset_array (global.get $fd_offsets)
-                     (local.get $fd)))
                (local.set $n
-                  (call $read
-                     (local.get $fd)
-                     (struct.get $channel $buffer (local.get $ch))
+                  (call $caml_do_read
+                     (local.get $ch)
                      (struct.get $channel $max (local.get $ch))
                      (i32.sub
                         (struct.get $channel $size (local.get $ch))
-                        (struct.get $channel $max (local.get $ch)))
-                     (local.get $offset)))
-               (array.set $offset_array
-                  (global.get $fd_offsets) (local.get $fd)
-                  (i64.add (local.get $offset)
-                     (i64.extend_i32_u (local.get $n))))
+                        (struct.get $channel $max (local.get $ch)))))
                (if (i32.eqz (local.get $n))
                   (then
                      (return
@@ -560,23 +626,36 @@
 
    (func $caml_flush_partial (param $ch (ref $channel)) (result i32)
       (local $towrite i32) (local $written i32) (local $fd i32)
-      (local $buf (ref extern))
+      (local $offset i64) (local $buf (ref extern))
       (local.set $towrite (struct.get $channel $curr (local.get $ch)))
       (if (i32.gt_u (local.get $towrite) (i32.const 0))
          (then
             (local.set $buf (struct.get $channel $buffer (local.get $ch)))
             (local.set $fd (struct.get $channel $fd (local.get $ch)))
+            (local.set $offset
+               (array.get $offset_array
+                  (global.get $fd_offsets) (local.get $fd)))
             (local.set $written
-               (call $write
-                  (local.get $fd)
-                  (local.get $buf)
-                  (i32.const 0)
-                  (local.get $towrite)))
+               (if (result i32)
+                   (array.get_u $string (global.get $fd_seeked) (local.get $fd))
+                  (then
+                     (call $write
+                        (local.get $fd)
+                        (local.get $buf)
+                        (i32.const 0)
+                        (local.get $towrite)
+                        (local.get $offset)))
+                  (else
+                     (call $write'
+                        (local.get $fd)
+                        (local.get $buf)
+                        (i32.const 0)
+                        (local.get $towrite)
+                        (ref.null noextern)))))
             (array.set $offset_array
                (global.get $fd_offsets) (local.get $fd)
                (i64.add
-                  (array.get $offset_array
-                     (global.get $fd_offsets) (local.get $fd))
+                  (local.get $offset)
                   (i64.extend_i32_u (local.get $written))))
             (local.set $towrite
                (i32.sub (local.get $towrite) (local.get $written)))
@@ -712,6 +791,10 @@
          (i32.wrap_i64
             (call $file_size (call $caml_ml_get_channel_fd (local.get 0))))))
 
+   (func (export "caml_ml_channel_size_64") (param (ref eq)) (result (ref eq))
+      (call $caml_copy_int64
+         (call $file_size (call $caml_ml_get_channel_fd (local.get 0)))))
+
    (func $caml_ml_get_channel_fd (export "caml_ml_get_channel_fd")
       (param (ref eq)) (result i32)
       (struct.get $channel $fd (ref.cast (ref $channel) (local.get 0))))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 45c297e7d1..d798cb5eb8 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -270,7 +270,7 @@
            fs.openSync(p,open_flags.reduce((f,v,i)=>(flags&(1<<i))?(f|v):f,0),
                        perm),
          close:(fd)=>fs.closeSync(fd),
-         write:(fd,b,o,l)=>fs?fs.writeSync(fd,b,o,l):(console.log(new TextDecoder().decode(b.slice(o,o+l))),l),
+         write:(fd,b,o,l,p)=>fs?fs.writeSync(fd,b,o,l,p==null?p:Number(p)):(console.log(new TextDecoder().decode(b.slice(o,o+l))),l),
          read:(fd,b,o,l,p)=>fs.readSync(fd,b,o,l,p),
          file_size:(fd)=>fs.fstatSync(fd,{bigint:true}).size,
          register_channel,

From d44900cbda4e1f9726ce4a6b9ea448f4ca2511d9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 30 Aug 2023 10:25:16 +0200
Subject: [PATCH 122/481] Runtime: implement caml_sys_time and caml_sys_rename

---
 runtime/wasm/fs.wat     | 8 +++++---
 runtime/wasm/runtime.js | 2 ++
 runtime/wasm/sys.wat    | 6 +++---
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index 481c59da5c..489914fbba 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -7,6 +7,7 @@
       (func $readdir (param anyref) (result (ref extern))))
    (import "bindings" "file_exists"
       (func $file_exists (param anyref) (result (ref eq))))
+   (import "bindings" "rename" (func $rename (param anyref) (param anyref)))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "jslib" "caml_string_of_jsstring"
@@ -47,9 +48,10 @@
       (i31.new (i32.const 0)))
 
    (func (export "caml_sys_rename")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_rename"))
+      (param $o (ref eq)) (param $n (ref eq)) (result (ref eq))
+      (call $rename
+         (call $unwrap (call $caml_jsstring_of_string (local.get $o)))
+         (call $unwrap (call $caml_jsstring_of_string (local.get $n))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_sys_file_exists")
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index d798cb5eb8..9bcaf951af 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -282,11 +282,13 @@
            var res = require('child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
            return res.signal?128:res.status
          },
+         time:()=>performance.now(),
          getcwd:()=>isNode?process.cwd():'/static',
          chdir:(x)=>process.chdir(x),
          unlink:(p)=>fs.unlinkSync(p),
          readdir:(p)=>fs.readdirSync(p),
          file_exists:(p)=>+fs.existsSync(p),
+         rename:(o,n)=>fs.renameSync(o, n),
          start_fiber:(x)=>start_fiber(x),
          suspend_fiber:
          wrap_fun(
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 3a55121949..85f6a9ad9c 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -17,6 +17,7 @@
    (import "bindings" "argv" (func $argv (result (ref extern))))
    (import "bindings" "system" (func $system (param anyref) (result (ref eq))))
    (import "bindings" "getenv" (func $getenv (param anyref) (result anyref)))
+   (import "bindings" "time" (func $time (result f64)))
    (import "bindings" "array_length"
       (func $array_length (param (ref extern)) (result i32)))
    (import "bindings" "array_get"
@@ -24,6 +25,7 @@
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
+   (type $float (struct (field f64)))
 
    (tag $ocaml_exit (export "ocaml_exit") (param i32))
 
@@ -55,9 +57,7 @@
    (export "caml_sys_time_include_children" (func $caml_sys_time))
    (func $caml_sys_time (export "caml_sys_time")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_time"))
-      (i31.new (i32.const 0)))
+      (struct.new $float (f64.mul (call $time) (f64.const 0.001))))
 
    (func (export "caml_sys_system_command")
       (param (ref eq)) (result (ref eq))

From af2da214b62a4d478acf9473a636fd31f86d135a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 5 Sep 2023 12:03:37 +0200
Subject: [PATCH 123/481] Improved exception handlers

---
 compiler/lib/wasm/wa_code_generation.ml  |  7 +++---
 compiler/lib/wasm/wa_code_generation.mli |  2 +-
 compiler/lib/wasm/wa_core_target.ml      | 10 ++++++++-
 compiler/lib/wasm/wa_gc_target.ml        | 28 +++++++++++++++---------
 compiler/lib/wasm/wa_generate.ml         | 18 +++++++--------
 compiler/lib/wasm/wa_target_sig.ml       | 17 ++++++++++----
 6 files changed, 54 insertions(+), 28 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 5c66c070a6..5dc66129b1 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -385,10 +385,11 @@ let if_ ty e l1 l2 =
   | W.UnOp (I32 Eqz, e') -> instr (If (ty, e', instrs2, instrs1))
   | _ -> instr (If (ty, e, instrs1, instrs2))
 
-let try_ ty body exception_name handler =
+let try_ ty body handlers =
   let* body = blk body in
-  let* handler = blk handler in
-  instr (Try (ty, body, [ exception_name, handler ], None))
+  let tags = List.map ~f:fst handlers in
+  let* handler_bodies = expression_list blk (List.map ~f:snd handlers) in
+  instr (Try (ty, body, List.combine tags handler_bodies, None))
 
 let need_apply_fun ~arity st =
   let ctx = st.context in
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 4881d5e668..37285a2bbc 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -99,7 +99,7 @@ val block_expr : Wa_ast.func_type -> unit t -> expression
 
 val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
-val try_ : Wa_ast.func_type -> unit t -> Code.Var.t -> unit t -> unit t
+val try_ : Wa_ast.func_type -> unit t -> (Code.Var.t * unit t) list -> unit t
 
 val add_var : ?typ:Wa_ast.value_type -> Wa_ast.var -> int t
 
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 3f73662b41..6fe7f1cabd 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -606,7 +606,15 @@ module Math = struct
   let fmod f g = binary "fmod" f g
 end
 
-let exception_handler_body ~typ:_ ~context b = b context
+let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
+  let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
+  try_
+    { params = []; result = result_typ }
+    (body ~result_typ ~fall_through:(`Block (-1)) ~context)
+    [ ( ocaml_tag
+      , let* () = store ~always:true x (return (W.Pop Value.value)) in
+        exn_handler ~result_typ ~fall_through ~context )
+    ]
 
 let entry_point ~context:_ =
   let code =
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index a2677b0a28..e4e46e224a 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -978,23 +978,31 @@ module Math = struct
   let exp2 x = power (return (W.Const (F64 2.))) x
 end
 
-let exception_handler_body ~typ ~context b =
-  let externref = W.Ref { nullable = true; typ = Extern } in
+let externref = W.Ref { nullable = true; typ = Extern }
+
+let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
   let* js_tag = register_import ~name:"javascript_exception" (Tag externref) in
   let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
-  let x = Code.Var.fresh () in
   let* f =
     register_import
       ~name:"caml_wrap_exception"
       (Fun { params = [ externref ]; result = [ Value.value ] })
   in
-  try_
-    { params = []; result = typ }
-    (b (`Skip :: context))
-    js_tag
-    (let* () = store ~always:true ~typ:externref x (return (W.Pop externref)) in
-     let* exn = load x in
-     instr (Throw (ocaml_tag, W.Call (f, [ exn ]))))
+  block
+    { params = []; result = result_typ }
+    (let* () =
+       try_
+         { params = []; result = [] }
+         (body ~result_typ:[] ~fall_through:(`Block (-1)) ~context:(`Skip :: context))
+         [ ocaml_tag, store ~always:true x (return (W.Pop Value.value))
+         ; ( js_tag
+           , let exn = Code.Var.fresh () in
+             let* () = store ~always:true ~typ:externref exn (return (W.Pop externref)) in
+             let* exn = load exn in
+             store ~always:true x (return (W.Call (f, [ exn ]))) )
+         ]
+     in
+     exn_handler ~result_typ ~fall_through ~context)
 
 let entry_point ~context =
   let code =
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 6071238805..155264a5ff 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -805,15 +805,15 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* tag = register_import ~name:exception_name (Tag Value.value) in
               instr (Throw (tag, e))
           | Pushtrap (cont, x, cont', _) ->
-              let context' = extend_context fall_through context in
-              let* tag = register_import ~name:exception_name (Tag Value.value) in
-              try_
-                { params = []; result = result_typ }
-                (exception_handler_body ~typ:result_typ ~context:context' (fun context' ->
-                     translate_branch result_typ fall_through pc cont context' stack_ctx))
-                tag
-                (let* () = store ~always:true x (return (W.Pop Value.value)) in
-                 translate_branch result_typ fall_through pc cont' context' stack_ctx)
+              handle_exceptions
+                ~result_typ
+                ~fall_through
+                ~context:(extend_context fall_through context)
+                (fun ~result_typ ~fall_through ~context ->
+                  translate_branch result_typ fall_through pc cont context stack_ctx)
+                x
+                (fun ~result_typ ~fall_through ~context ->
+                  translate_branch result_typ fall_through pc cont' context stack_ctx)
           | Poptrap cont ->
               translate_branch result_typ fall_through pc cont context stack_ctx)
     and translate_branch result_typ fall_through src (dst, args) context stack_ctx =
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 2f94f1f8e3..6a5edd6d99 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -253,10 +253,19 @@ module type S = sig
     val round : expression -> expression
   end
 
-  val exception_handler_body :
-       typ:Wa_ast.value_type list
-    -> context:[ `Block of Code.Addr.t | `Skip ] list
-    -> ([ `Block of Code.Addr.t | `Skip ] list -> unit Wa_code_generation.t)
+  val handle_exceptions :
+       result_typ:Wa_ast.value_type list
+    -> fall_through:'a
+    -> context:([> `Skip ] as 'b) list
+    -> (   result_typ:Wa_ast.value_type list
+        -> fall_through:[> `Block of int ]
+        -> context:'b list
+        -> unit Wa_code_generation.t)
+    -> Wa_ast.var
+    -> (   result_typ:Wa_ast.value_type list
+        -> fall_through:'a
+        -> context:'b list
+        -> unit Wa_code_generation.t)
     -> unit Wa_code_generation.t
 
   val entry_point :

From 9d3e784207e0ba210741041c381e1d71906e2471 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 11 Sep 2023 13:53:49 +0200
Subject: [PATCH 124/481] Update required dune version

---
 dune-project                       | 2 +-
 js_of_ocaml-compiler.opam          | 2 +-
 js_of_ocaml-lwt.opam               | 2 +-
 js_of_ocaml-ppx.opam               | 2 +-
 js_of_ocaml-ppx_deriving_json.opam | 2 +-
 js_of_ocaml-toplevel.opam          | 2 +-
 js_of_ocaml-tyxml.opam             | 2 +-
 js_of_ocaml.opam                   | 2 +-
 wasm_of_ocaml-compiler.opam        | 2 +-
 9 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/dune-project b/dune-project
index 977e5bfeef..a8fa29678c 100644
--- a/dune-project
+++ b/dune-project
@@ -1,4 +1,4 @@
-(lang dune 3.7)
+(lang dune 3.11)
 (using menhir 2.0)
 (name js_of_ocaml)
 
diff --git a/js_of_ocaml-compiler.opam b/js_of_ocaml-compiler.opam
index 0630d7b7c1..bf328a6a58 100644
--- a/js_of_ocaml-compiler.opam
+++ b/js_of_ocaml-compiler.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08" & < "5.1"}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}
diff --git a/js_of_ocaml-lwt.opam b/js_of_ocaml-lwt.opam
index b0cc7c1784..4f1cdaf328 100644
--- a/js_of_ocaml-lwt.opam
+++ b/js_of_ocaml-lwt.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "js_of_ocaml-ppx" {= version}
diff --git a/js_of_ocaml-ppx.opam b/js_of_ocaml-ppx.opam
index 72e581304d..7b25cb474f 100644
--- a/js_of_ocaml-ppx.opam
+++ b/js_of_ocaml-ppx.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "ppxlib" {>= "0.15.0"}
diff --git a/js_of_ocaml-ppx_deriving_json.opam b/js_of_ocaml-ppx_deriving_json.opam
index 90cdfe507d..b801a671c8 100644
--- a/js_of_ocaml-ppx_deriving_json.opam
+++ b/js_of_ocaml-ppx_deriving_json.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "ppxlib" {>= "0.15"}
diff --git a/js_of_ocaml-toplevel.opam b/js_of_ocaml-toplevel.opam
index 844dbdfd46..1463580f29 100644
--- a/js_of_ocaml-toplevel.opam
+++ b/js_of_ocaml-toplevel.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml-compiler" {= version}
   "ocamlfind" {>= "1.5.1"}
diff --git a/js_of_ocaml-tyxml.opam b/js_of_ocaml-tyxml.opam
index 3d13fa9fa6..34d89bb0e4 100644
--- a/js_of_ocaml-tyxml.opam
+++ b/js_of_ocaml-tyxml.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "js_of_ocaml-ppx" {= version}
diff --git a/js_of_ocaml.opam b/js_of_ocaml.opam
index 284b04bc3e..c480de1528 100644
--- a/js_of_ocaml.opam
+++ b/js_of_ocaml.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml-compiler" {= version}
   "ppxlib" {>= "0.15"}
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
index 029ab9b481..5d825e93d0 100644
--- a/wasm_of_ocaml-compiler.opam
+++ b/wasm_of_ocaml-compiler.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.7"}
+  "dune" {>= "3.11"}
   "ocaml" {>= "4.08" & < "5.1"}
   "js_of_ocaml" {= version}
   "num" {with-test}

From 3be3d9df7640f095668d49e8572005402d16fe80 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 11 Sep 2023 13:54:20 +0200
Subject: [PATCH 125/481] Runtime / str: fix type

---
 runtime/wasm/str.wat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat
index 23195b64aa..789f7f1016 100644
--- a/runtime/wasm/str.wat
+++ b/runtime/wasm/str.wat
@@ -28,7 +28,7 @@
          (i32.const 0xFF) (i32.const 0xFF)   ;; 0xE0-0xFF:
          (i32.const 0x7F) (i32.const 0xFF))) ;; Latin-1 accented lowercase
 
-   (rec (type $stack (struct (field (ref null $stack)))))
+   (type $stack (sub (struct (field (ref null $stack)))))
    (type $pos
       (sub final $stack
          (struct

From e731e485849acda97d328efcef3859b3caaa63f2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 11 Sep 2023 13:48:13 +0200
Subject: [PATCH 126/481] Effects through CPS transformation

---
 compiler/lib/driver.ml                   |  10 +-
 compiler/lib/effects.ml                  |  31 +-
 compiler/lib/effects.mli                 |   4 +-
 compiler/lib/wasm/wa_code_generation.ml  |  66 +++-
 compiler/lib/wasm/wa_code_generation.mli |   9 +-
 compiler/lib/wasm/wa_core_target.ml      |  18 +-
 compiler/lib/wasm/wa_curry.ml            | 236 +++++++++++-
 compiler/lib/wasm/wa_gc_target.ml        | 244 ++++++++-----
 compiler/lib/wasm/wa_generate.ml         | 108 +++++-
 compiler/lib/wasm/wa_generate.mli        |   3 +-
 compiler/lib/wasm/wa_target_sig.ml       |  19 +-
 compiler/tests-jsoo/lib-effects/dune     |   2 +-
 compiler/tests-ocaml/lib-effects/dune    |   3 +
 dune                                     |   6 +
 lib/tests/dune.inc                       |   2 +-
 lib/tests/gen-rules/gen.ml               |   2 +-
 runtime/wasm/compare.wat                 |   9 +-
 runtime/wasm/domain.wat                  |   8 +-
 runtime/wasm/effect.wat                  | 438 ++++++++++++++++++++---
 runtime/wasm/jslib.wat                   |  48 ++-
 runtime/wasm/marshal.wat                 |   6 +-
 runtime/wasm/obj.wat                     |  47 ++-
 22 files changed, 1061 insertions(+), 258 deletions(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index ed62a65eb2..67b26f25e9 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -88,14 +88,14 @@ let phi p =
 
 let ( +> ) f g x = g (f x)
 
-let map_fst f (x, y) = f x, y
+let map_fst f (x, y, z) = f x, y, z
 
 let effects p =
   if Config.Flag.effects ()
   then (
     if debug () then Format.eprintf "Effects...@.";
     p |> Deadcode.f +> Effects.f +> map_fst Lambda_lifting.f)
-  else p, (Code.Var.Set.empty : Effects.cps_calls)
+  else p, (Code.Var.Set.empty : Effects.cps_calls), (Code.Var.Set.empty : Effects.in_cps)
 
 let exact_calls profile p =
   if not (Config.Flag.effects ())
@@ -179,7 +179,7 @@ let generate
     ~exported_runtime
     ~wrap_with_fun
     ~warn_on_unhandled_effect
-    ((p, live_vars), cps_calls) =
+    ((p, live_vars), cps_calls, _) =
   if times () then Format.eprintf "Start Generation...@.";
   let should_export = should_export wrap_with_fun in
   Generate.f
@@ -615,8 +615,8 @@ let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
   match target with
   | `JavaScript formatter -> emit formatter r
   | `Wasm ch ->
-      let (p, live_vars), _ = r in
-      Wa_generate.f ch ~live_vars p;
+      let (p, live_vars), _, in_cps = r in
+      Wa_generate.f ch ~live_vars ~in_cps p;
       None
 
 let full_no_source_map ~target ~standalone ~wrap_with_fun ~profile ~linkall d p =
diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml
index 71acf7af56..1dd38eb105 100644
--- a/compiler/lib/effects.ml
+++ b/compiler/lib/effects.ml
@@ -249,6 +249,8 @@ let jump_closures blocks_to_transform idom : jump_closures =
 
 type cps_calls = Var.Set.t
 
+type in_cps = Var.Set.t
+
 type st =
   { mutable new_blocks : Code.block Addr.Map.t * Code.Addr.t
   ; blocks : Code.block Addr.Map.t
@@ -264,6 +266,7 @@ type st =
   ; live_vars : Deadcode.variable_uses
   ; flow_info : Global_flow.info
   ; cps_calls : cps_calls ref
+  ; in_cps : in_cps ref
   }
 
 let add_block st block =
@@ -280,10 +283,11 @@ let allocate_closure ~st ~params ~body ~branch loc =
   let name = Var.fresh () in
   [ Let (name, Closure (params, (pc, []))), loc ], name
 
-let tail_call ~st ?(instrs = []) ~exact ~check ~f args loc =
+let tail_call ~st ?(instrs = []) ~exact ~in_cps ~check ~f args loc =
   assert (exact || check);
   let ret = Var.fresh () in
   if check then st.cps_calls := Var.Set.add ret !(st.cps_calls);
+  if in_cps then st.in_cps := Var.Set.add ret !(st.in_cps);
   instrs @ [ Let (ret, Apply { f; args; exact }), loc ], (Return ret, loc)
 
 let cps_branch ~st ~src (pc, args) loc =
@@ -302,7 +306,15 @@ let cps_branch ~st ~src (pc, args) loc =
       (* We check the stack depth only for backward edges (so, at
          least once per loop iteration) *)
       let check = Hashtbl.find st.block_order src >= Hashtbl.find st.block_order pc in
-      tail_call ~st ~instrs ~exact:true ~check ~f:(closure_of_pc ~st pc) args loc
+      tail_call
+        ~st
+        ~instrs
+        ~exact:true
+        ~in_cps:false
+        ~check
+        ~f:(closure_of_pc ~st pc)
+        args
+        loc
 
 let cps_jump_cont ~st ~src ((pc, _) as cont) loc =
   match Addr.Set.mem pc st.blocks_to_transform with
@@ -365,7 +377,7 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
       (* Is the number of successive 'returns' is unbounded is CPS, it
          means that we have an unbounded of calls in direct style
          (even with tail call optimization) *)
-      tail_call ~st ~exact:true ~check:false ~f:k [ x ] last_loc
+      tail_call ~st ~exact:true ~in_cps:false ~check:false ~f:k [ x ] last_loc
   | Raise (x, rmode) -> (
       assert (List.is_empty alloc_jump_closures);
       match Hashtbl.find_opt st.matching_exn_handler pc with
@@ -401,6 +413,7 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
             ~instrs:
               ((Let (exn_handler, Prim (Extern "caml_pop_trap", [])), noloc) :: instrs)
             ~exact:true
+            ~in_cps:false
             ~check:false
             ~f:exn_handler
             [ x ]
@@ -465,6 +478,7 @@ let cps_instr ~st (instr : instr) : instr =
       (* Add the continuation parameter, and change the initial block if
          needed *)
       let k, cont = Hashtbl.find st.closure_info pc in
+      st.in_cps := Var.Set.add x !(st.in_cps);
       Let (x, Closure (params @ [ k ], cont))
   | Let (x, Prim (Extern "caml_alloc_dummy_function", [ size; arity ])) -> (
       match arity with
@@ -535,7 +549,7 @@ let cps_block ~st ~k pc block =
             let exact =
               exact || Global_flow.exact_call st.flow_info f (List.length args)
             in
-            tail_call ~st ~exact ~check:true ~f (args @ [ k ]) loc)
+            tail_call ~st ~exact ~in_cps:true ~check:true ~f (args @ [ k ]) loc)
     | Prim (Extern "%resume", [ Pv stack; Pv f; Pv arg ]) ->
         Some
           (fun ~k ->
@@ -545,6 +559,7 @@ let cps_block ~st ~k pc block =
               ~instrs:
                 [ Let (k', Prim (Extern "caml_resume_stack", [ Pv stack; Pv k ])), noloc ]
               ~exact:(Global_flow.exact_call st.flow_info f 1)
+              ~in_cps:true
               ~check:true
               ~f
               [ arg; k' ]
@@ -603,6 +618,7 @@ let cps_block ~st ~k pc block =
 let cps_transform ~live_vars ~flow_info ~cps_needed p =
   let closure_info = Hashtbl.create 16 in
   let cps_calls = ref Var.Set.empty in
+  let in_cps = ref Var.Set.empty in
   let p =
     Code.fold_closures_innermost_first
       p
@@ -662,6 +678,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
           ; flow_info
           ; live_vars
           ; cps_calls
+          ; in_cps
           }
         in
         let function_needs_cps =
@@ -738,7 +755,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
         in
         { start = new_start; blocks; free_pc = new_start + 1 }
   in
-  p, !cps_calls
+  p, !cps_calls, !in_cps
 
 (****)
 
@@ -934,6 +951,6 @@ let f (p, live_vars) =
   let cps_needed = Partial_cps_analysis.f p flow_info in
   let p, cps_needed = rewrite_toplevel ~cps_needed p in
   let p = split_blocks ~cps_needed p in
-  let p, cps_calls = cps_transform ~live_vars ~flow_info ~cps_needed p in
+  let p, cps_calls, in_cps = cps_transform ~live_vars ~flow_info ~cps_needed p in
   if Debug.find "times" () then Format.eprintf "  effects: %a@." Timer.print t;
-  p, cps_calls
+  p, cps_calls, in_cps
diff --git a/compiler/lib/effects.mli b/compiler/lib/effects.mli
index c4afc03e72..f1a4d74502 100644
--- a/compiler/lib/effects.mli
+++ b/compiler/lib/effects.mli
@@ -18,4 +18,6 @@
 
 type cps_calls = Code.Var.Set.t
 
-val f : Code.program * Deadcode.variable_uses -> Code.program * cps_calls
+type in_cps = Code.Var.Set.t
+
+val f : Code.program * Deadcode.variable_uses -> Code.program * cps_calls * in_cps
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 5dc66129b1..574e0c8f1d 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -28,8 +28,11 @@ type context =
   ; mutable closure_envs : Var.t Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Var.t IntMap.t
+  ; mutable cps_apply_funs : Var.t IntMap.t
   ; mutable curry_funs : Var.t IntMap.t
+  ; mutable cps_curry_funs : Var.t IntMap.t
   ; mutable dummy_funs : Var.t IntMap.t
+  ; mutable cps_dummy_funs : Var.t IntMap.t
   ; mutable init_code : W.instruction list
   }
 
@@ -42,8 +45,11 @@ let make_context () =
   ; types = Hashtbl.create 128
   ; closure_envs = Var.Map.empty
   ; apply_funs = IntMap.empty
+  ; cps_apply_funs = IntMap.empty
   ; curry_funs = IntMap.empty
+  ; cps_curry_funs = IntMap.empty
   ; dummy_funs = IntMap.empty
+  ; cps_dummy_funs = IntMap.empty
   ; init_code = []
   }
 
@@ -391,31 +397,55 @@ let try_ ty body handlers =
   let* handler_bodies = expression_list blk (List.map ~f:snd handlers) in
   instr (Try (ty, body, List.combine tags handler_bodies, None))
 
-let need_apply_fun ~arity st =
+let need_apply_fun ~cps ~arity st =
   let ctx = st.context in
-  ( (try IntMap.find arity ctx.apply_funs
-     with Not_found ->
-       let x = Var.fresh_n (Printf.sprintf "apply_%d" arity) in
-       ctx.apply_funs <- IntMap.add arity x ctx.apply_funs;
-       x)
+  ( (if cps
+     then (
+       try IntMap.find arity ctx.cps_apply_funs
+       with Not_found ->
+         let x = Var.fresh_n (Printf.sprintf "cps_apply_%d" arity) in
+         ctx.cps_apply_funs <- IntMap.add arity x ctx.cps_apply_funs;
+         x)
+     else
+       try IntMap.find arity ctx.apply_funs
+       with Not_found ->
+         let x = Var.fresh_n (Printf.sprintf "apply_%d" arity) in
+         ctx.apply_funs <- IntMap.add arity x ctx.apply_funs;
+         x)
   , st )
 
-let need_curry_fun ~arity st =
+let need_curry_fun ~cps ~arity st =
   let ctx = st.context in
-  ( (try IntMap.find arity ctx.curry_funs
-     with Not_found ->
-       let x = Var.fresh_n (Printf.sprintf "curry_%d" arity) in
-       ctx.curry_funs <- IntMap.add arity x ctx.curry_funs;
-       x)
+  ( (if cps
+     then (
+       try IntMap.find arity ctx.cps_curry_funs
+       with Not_found ->
+         let x = Var.fresh_n (Printf.sprintf "cps_curry_%d" arity) in
+         ctx.cps_curry_funs <- IntMap.add arity x ctx.cps_curry_funs;
+         x)
+     else
+       try IntMap.find arity ctx.curry_funs
+       with Not_found ->
+         let x = Var.fresh_n (Printf.sprintf "curry_%d" arity) in
+         ctx.curry_funs <- IntMap.add arity x ctx.curry_funs;
+         x)
   , st )
 
-let need_dummy_fun ~arity st =
+let need_dummy_fun ~cps ~arity st =
   let ctx = st.context in
-  ( (try IntMap.find arity ctx.dummy_funs
-     with Not_found ->
-       let x = Var.fresh_n (Printf.sprintf "dummy_%d" arity) in
-       ctx.dummy_funs <- IntMap.add arity x ctx.dummy_funs;
-       x)
+  ( (if cps
+     then (
+       try IntMap.find arity ctx.cps_dummy_funs
+       with Not_found ->
+         let x = Var.fresh_n (Printf.sprintf "cps_dummy_%d" arity) in
+         ctx.cps_dummy_funs <- IntMap.add arity x ctx.cps_dummy_funs;
+         x)
+     else
+       try IntMap.find arity ctx.dummy_funs
+       with Not_found ->
+         let x = Var.fresh_n (Printf.sprintf "dummy_%d" arity) in
+         ctx.dummy_funs <- IntMap.add arity x ctx.dummy_funs;
+         x)
   , st )
 
 let init_code context = instrs context.init_code
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 37285a2bbc..e7320759eb 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -12,8 +12,11 @@ type context =
   ; mutable closure_envs : Code.Var.t Code.Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
+  ; mutable cps_apply_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable curry_funs : Code.Var.t Stdlib.IntMap.t
+  ; mutable cps_curry_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable dummy_funs : Code.Var.t Stdlib.IntMap.t
+  ; mutable cps_dummy_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable init_code : Wa_ast.instruction list
   }
 
@@ -139,11 +142,11 @@ val get_closure_env : Code.Var.t -> Code.Var.t t
 
 val is_closure : Code.Var.t -> bool t
 
-val need_apply_fun : arity:int -> Code.Var.t t
+val need_apply_fun : cps:bool -> arity:int -> Code.Var.t t
 
-val need_curry_fun : arity:int -> Code.Var.t t
+val need_curry_fun : cps:bool -> arity:int -> Code.Var.t t
 
-val need_dummy_fun : arity:int -> Code.Var.t t
+val need_dummy_fun : cps:bool -> arity:int -> Code.Var.t t
 
 val function_body :
      context:context
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 6fe7f1cabd..20e3df990d 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -119,15 +119,15 @@ module Memory = struct
 
   let set_field e idx e' = mem_store ~offset:(4 * idx) e e'
 
-  let load_function_pointer ~arity ?skip_cast:_ closure =
+  let load_function_pointer ~cps:_ ~arity ?skip_cast:_ closure =
     let* e = field closure (if arity = 1 then 0 else 2) in
     return (`Index, e)
 
   let load_function_arity closure = Arith.(field closure 1 lsr const 24l)
 
-  let load_real_closure ~arity:_ _ = assert false
+  let load_real_closure ~cps:_ ~arity:_ _ = assert false
 
-  let check_function_arity f arity if_match if_mismatch =
+  let check_function_arity f ~cps:_ ~arity if_match if_mismatch =
     let func_arity = load_function_arity (load f) in
     if_
       { params = []; result = [ I32 ] }
@@ -425,7 +425,7 @@ module Closure = struct
   let closure_info ~arity ~sz =
     W.Const (I32 Int32.(add (shift_left (of_int arity) 24) (of_int ((sz lsl 1) + 1))))
 
-  let translate ~context ~closures ~stack_ctx x =
+  let translate ~context ~closures ~stack_ctx ~cps x =
     let info = Code.Var.Map.find x closures in
     let f, _ = List.hd info.Wa_closure_conversion.functions in
     let* () = set_closure_env x x in
@@ -436,7 +436,7 @@ module Closure = struct
         List.fold_left
           ~f:(fun accu (f, arity) ->
             let* i, start = accu in
-            let* curry_fun = if arity > 1 then need_curry_fun ~arity else return f in
+            let* curry_fun = if arity > 1 then need_curry_fun ~cps ~arity else return f in
             let start =
               if i = 0
               then start
@@ -482,7 +482,7 @@ module Closure = struct
       let offset = Int32.of_int (4 * function_offset_in_closure info x) in
       Arith.(load f + const offset)
 
-  let bind_environment ~context ~closures f =
+  let bind_environment ~context ~closures ~cps:_ f =
     if Hashtbl.mem context.constants f
     then
       (* The closures are all constants and the environment is empty. *)
@@ -523,7 +523,7 @@ module Closure = struct
            ~init:(offset, return ())
            free_variables)
 
-  let curry_allocate ~stack_ctx ~x ~arity _ ~f ~closure ~arg =
+  let curry_allocate ~stack_ctx ~x ~cps:_ ~arity _ ~f ~closure ~arg =
     Memory.allocate
       stack_ctx
       x
@@ -534,10 +534,10 @@ module Closure = struct
       ; `Var arg
       ]
 
-  let curry_load ~arity:_ _ closure =
+  let curry_load ~cps:_ ~arity:_ _ closure =
     return (Memory.field (load closure) 3, Memory.field (load closure) 4, None)
 
-  let dummy ~arity:_ = assert false
+  let dummy ~cps:_ ~arity:_ = assert false
 end
 
 module Math = struct
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index 2d1b2026ce..04eaacf347 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -20,12 +20,16 @@ module Make (Target : Wa_target_sig.S) = struct
       ~init:(return ())
       l
 
-  let call ?typ ~arity closure args =
+  let call ?typ ~cps ~arity closure args =
     let funct = Var.fresh () in
     let* closure = tee ?typ funct closure in
     let args = args @ [ closure ] in
     let* kind, funct =
-      Memory.load_function_pointer ~arity ~skip_cast:(Option.is_some typ) (load funct)
+      Memory.load_function_pointer
+        ~cps
+        ~arity
+        ~skip_cast:(Option.is_some typ)
+        (load funct)
     in
     match kind with
     | `Index -> return (W.Call_indirect (func_type (List.length args), funct, args))
@@ -58,11 +62,18 @@ module Make (Target : Wa_target_sig.S) = struct
       let rec loop m args closure closure_typ =
         if m = arity
         then
-          let* e = call ?typ:closure_typ ~arity (load closure) (List.append args args') in
+          let* e =
+            call
+              ?typ:closure_typ
+              ~cps:false
+              ~arity
+              (load closure)
+              (List.append args args')
+          in
           instr (W.Push e)
         else
           let* load_arg, load_closure, closure_typ =
-            Closure.curry_load ~arity m closure
+            Closure.curry_load ~cps:false ~arity m closure
           in
           let* x = load_arg in
           let closure' = Code.Var.fresh_n "f" in
@@ -119,7 +130,15 @@ module Make (Target : Wa_target_sig.S) = struct
       let stack_ctx = Stack.start_function ~context stack_info in
       let* () =
         push
-          (Closure.curry_allocate ~stack_ctx ~x:res ~arity m ~f:name' ~closure:f ~arg:x)
+          (Closure.curry_allocate
+             ~stack_ctx
+             ~x:res
+             ~cps:false
+             ~arity
+             m
+             ~f:name'
+             ~closure:f
+             ~arg:x)
       in
       Stack.perform_spilling stack_ctx (`Instr ret)
     in
@@ -131,6 +150,112 @@ module Make (Target : Wa_target_sig.S) = struct
 
   let curry ~arity ~name = curry ~arity arity ~name
 
+  let cps_curry_app_name n m = Printf.sprintf "cps_curry_app %d_%d" n m
+
+  let cps_curry_app ~context ~arity m ~name =
+    let body =
+      let args =
+        List.init ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x_%d" i)) ~len:(m + 1)
+      in
+      let* () = bind_parameters args in
+      let f = Code.Var.fresh_n "f" in
+      let* _ = add_var f in
+      let* args' = expression_list load args in
+      let* _f = load f in
+      let rec loop m args closure closure_typ =
+        if m = arity
+        then
+          let* e =
+            call
+              ?typ:closure_typ
+              ~cps:true
+              ~arity:(arity + 1)
+              (load closure)
+              (List.append args args')
+          in
+          instr (W.Push e)
+        else
+          let* load_arg, load_closure, closure_typ =
+            Closure.curry_load ~cps:true ~arity m closure
+          in
+          let* x = load_arg in
+          let closure' = Code.Var.fresh_n "f" in
+          let* () = store ?typ:closure_typ closure' load_closure in
+          loop (m + 1) (x :: args) closure' closure_typ
+      in
+      loop m [] f None
+    in
+    let locals, body =
+      function_body ~context ~value_type:Value.value ~param_count:3 ~body
+    in
+    W.Function { name; exported_name = None; typ = func_type 2; locals; body }
+
+  let cps_curry_name n m = Printf.sprintf "cps_curry_%d_%d" n m
+
+  let rec cps_curry ~context ~arity m ~name =
+    assert (m > 1);
+    let name', functions =
+      if m = 2
+      then
+        let nm = Var.fresh_n (cps_curry_app_name arity 1) in
+        let func = cps_curry_app ~context ~arity 1 ~name:nm in
+        nm, [ func ]
+      else
+        let nm = Var.fresh_n (cps_curry_name arity (m - 1)) in
+        let functions = cps_curry ~context ~arity (m - 1) ~name:nm in
+        nm, functions
+    in
+    let body =
+      let x = Code.Var.fresh_n "x" in
+      let* _ = add_var x in
+      let cont = Code.Var.fresh_n "cont" in
+      let* _ = add_var cont in
+      let f = Code.Var.fresh_n "f" in
+      let* _ = add_var f in
+      let res = Code.Var.fresh_n "res" in
+      let stack_info, stack =
+        Stack.make_info ()
+        |> fun info ->
+        Stack.add_spilling
+          info
+          ~location:res
+          ~stack:[]
+          ~live_vars:Var.Set.empty
+          ~spilled_vars:(Var.Set.of_list [ x; f ])
+      in
+      let ret = Code.Var.fresh_n "ret" in
+      let stack_info, _ =
+        Stack.add_spilling
+          stack_info
+          ~location:ret
+          ~stack
+          ~live_vars:Var.Set.empty
+          ~spilled_vars:Var.Set.empty
+      in
+      let stack_ctx = Stack.start_function ~context stack_info in
+      let* e =
+        Closure.curry_allocate
+          ~stack_ctx
+          ~x:res
+          ~cps:true
+          ~arity
+          m
+          ~f:name'
+          ~closure:f
+          ~arg:x
+      in
+      let* () = Stack.perform_spilling stack_ctx (`Instr ret) in
+      let* c = call ~cps:false ~arity:1 (load cont) [ e ] in
+      instr (W.Return (Some c))
+    in
+    let locals, body =
+      function_body ~context ~value_type:Value.value ~param_count:3 ~body
+    in
+    W.Function { name; exported_name = None; typ = func_type 2; locals; body }
+    :: functions
+
+  let cps_curry ~arity ~name = cps_curry ~arity arity ~name
+
   let apply ~context ~arity ~name =
     assert (arity > 1);
     let body =
@@ -143,10 +268,11 @@ module Make (Target : Wa_target_sig.S) = struct
       let* _ = add_var f in
       Memory.check_function_arity
         f
-        arity
+        ~cps:false
+        ~arity
         (fun ~typ closure ->
           let* l = expression_list load l in
-          call ?typ ~arity closure l)
+          call ?typ ~cps:false ~arity closure l)
         (let rec build_spilling_info stack_info stack live_vars acc l =
            match l with
            | [] -> stack_info, List.rev acc
@@ -178,7 +304,7 @@ module Make (Target : Wa_target_sig.S) = struct
                let* () = Stack.perform_spilling stack_ctx (`Instr y') in
                let* x = load x in
                Stack.kill_variables stack_ctx;
-               let* () = store y' (call ~arity:1 y [ x ]) in
+               let* () = store y' (call ~cps:false ~arity:1 y [ x ]) in
                build_applies (load y') rem
          in
          build_applies (load f) l)
@@ -188,7 +314,8 @@ module Make (Target : Wa_target_sig.S) = struct
     in
     W.Function { name; exported_name = None; typ = func_type arity; locals; body }
 
-  let dummy ~context ~arity ~name =
+  let cps_apply ~context ~arity ~name =
+    assert (arity > 2);
     let body =
       let l =
         List.rev
@@ -197,10 +324,78 @@ module Make (Target : Wa_target_sig.S) = struct
       let* () = bind_parameters l in
       let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
-      let* typ, closure = Memory.load_real_closure ~arity (load f) in
+      Memory.check_function_arity
+        f
+        ~cps:true
+        ~arity:(arity - 1)
+        (fun ~typ closure ->
+          let* l = expression_list load l in
+          call ?typ ~cps:true ~arity closure l)
+        (let args = Code.Var.fresh_n "args" in
+         let stack_info, stack =
+           Stack.make_info ()
+           |> fun info ->
+           Stack.add_spilling
+             info
+             ~location:args
+             ~stack:[]
+             ~live_vars:(Var.Set.of_list (f :: l))
+             ~spilled_vars:(Var.Set.of_list (f :: l))
+         in
+         let ret = Code.Var.fresh_n "ret" in
+         let stack_info, _ =
+           Stack.add_spilling
+             stack_info
+             ~location:ret
+             ~stack
+             ~live_vars:Var.Set.empty
+             ~spilled_vars:Var.Set.empty
+         in
+         let stack_ctx = Stack.start_function ~context stack_info in
+         let* args =
+           Memory.allocate
+             stack_ctx
+             args
+             ~tag:0
+             (List.map ~f:(fun x -> `Var x) (List.tl l))
+         in
+         let* make_iterator =
+           register_import ~name:"caml_apply_continuation" (Fun (func_type 0))
+         in
+         Stack.kill_variables stack_ctx;
+         let iterate = Var.fresh_n "iterate" in
+         let* () = store iterate (return (W.Call (make_iterator, [ args ]))) in
+         let x = List.hd l in
+         let* () = Stack.perform_reloads stack_ctx (`Vars (Var.Set.of_list [ x; f ])) in
+         let* x = load x in
+         let* iterate = load iterate in
+         let* () = push (call ~cps:true ~arity:2 (load f) [ x; iterate ]) in
+         Stack.perform_spilling stack_ctx (`Instr ret))
+    in
+    let locals, body =
+      function_body ~context ~value_type:Value.value ~param_count:(arity + 1) ~body
+    in
+    W.Function { name; exported_name = None; typ = func_type arity; locals; body }
+
+  let dummy ~context ~cps ~arity ~name =
+    let arity = if cps then arity + 1 else arity in
+    let body =
+      let l =
+        List.rev
+          (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
+      in
+      let* () = bind_parameters l in
+      let f = Code.Var.fresh_n "f" in
+      let* _ = add_var f in
+      let* typ, closure = Memory.load_real_closure ~cps ~arity (load f) in
       let* l = expression_list load l in
       let* e =
-        call ~typ:(W.Ref { nullable = false; typ = Type typ }) ~arity (return closure) l
+        call
+          ~typ:(W.Ref { nullable = false; typ = Type typ })
+          ~cps
+          ~arity
+          (return closure)
+          l
       in
       instr (W.Return (Some e))
     in
@@ -215,6 +410,11 @@ module Make (Target : Wa_target_sig.S) = struct
         let f = apply ~context ~arity ~name in
         context.other_fields <- f :: context.other_fields)
       context.apply_funs;
+    IntMap.iter
+      (fun arity name ->
+        let f = cps_apply ~context ~arity ~name in
+        context.other_fields <- f :: context.other_fields)
+      context.cps_apply_funs;
     IntMap.iter
       (fun arity name ->
         let l = curry ~context ~arity ~name in
@@ -222,7 +422,17 @@ module Make (Target : Wa_target_sig.S) = struct
       context.curry_funs;
     IntMap.iter
       (fun arity name ->
-        let f = dummy ~context ~arity ~name in
+        let l = cps_curry ~context ~arity ~name in
+        context.other_fields <- List.rev_append l context.other_fields)
+      context.cps_curry_funs;
+    IntMap.iter
+      (fun arity name ->
+        let f = dummy ~context ~cps:false ~arity ~name in
+        context.other_fields <- f :: context.other_fields)
+      context.dummy_funs;
+    IntMap.iter
+      (fun arity name ->
+        let f = dummy ~context ~cps:true ~arity ~name in
         context.other_fields <- f :: context.other_fields)
-      context.dummy_funs
+      context.cps_dummy_funs
 end
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index e4e46e224a..66fc2defff 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -159,12 +159,13 @@ module Type = struct
   let func_type n =
     { W.params = List.init ~len:(n + 1) ~f:(fun _ -> value); result = [ value ] }
 
-  let function_type n =
+  let function_type ~cps n =
+    let n = if cps then n + 1 else n in
     register_type (Printf.sprintf "function_%d" n) (fun () ->
         return { supertype = None; final = true; typ = W.Func (func_type n) })
 
-  let closure_common_fields =
-    let* fun_ty = function_type 1 in
+  let closure_common_fields ~cps =
+    let* fun_ty = function_type ~cps 1 in
     return
       (let function_pointer =
          [ { W.mut = false; typ = W.Value (Ref { nullable = false; typ = Type fun_ty }) }
@@ -174,28 +175,52 @@ module Type = struct
        then { W.mut = false; typ = W.Value I32 } :: function_pointer
        else function_pointer)
 
-  let closure_type_1 =
-    register_type "closure" (fun () ->
-        let* fields = closure_common_fields in
+  let closure_type_1 ~cps =
+    register_type
+      (if cps then "cps_closure" else "closure")
+      (fun () ->
+        let* fields = closure_common_fields ~cps in
         return { supertype = None; final = false; typ = W.Struct fields })
 
-  let closure_last_arg_type =
-    register_type "closure_last_arg" (fun () ->
-        let* cl_typ = closure_type_1 in
-        let* fields = closure_common_fields in
+  let closure_last_arg_type ~cps =
+    register_type
+      (if cps then "cps_closure_last_arg" else "closure_last_arg")
+      (fun () ->
+        let* cl_typ = closure_type_1 ~cps in
+        let* fields = closure_common_fields ~cps in
         return { supertype = Some cl_typ; final = false; typ = W.Struct fields })
 
-  let closure_type ~usage arity =
+  let closure_type ~usage ~cps arity =
     if arity = 1
     then
       match usage with
-      | `Alloc -> closure_last_arg_type
-      | `Access -> closure_type_1
+      | `Alloc -> closure_last_arg_type ~cps
+      | `Access -> closure_type_1 ~cps
+    else if arity = 0
+    then
+      register_type
+        (if cps then "cps_closure_0" else "closure_0")
+        (fun () ->
+          let* fun_ty' = function_type ~cps arity in
+          return
+            { supertype = None
+            ; final = false
+            ; typ =
+                W.Struct
+                  [ { mut = false
+                    ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                    }
+                  ]
+            })
     else
-      register_type (Printf.sprintf "closure_%d" arity) (fun () ->
-          let* cl_typ = closure_type_1 in
-          let* common = closure_common_fields in
-          let* fun_ty' = function_type arity in
+      register_type
+        (if cps
+         then Printf.sprintf "cps_closure_%d" arity
+         else Printf.sprintf "closure_%d" arity)
+        (fun () ->
+          let* cl_typ = closure_type_1 ~cps in
+          let* common = closure_common_fields ~cps in
+          let* fun_ty' = function_type ~cps arity in
           return
             { supertype = Some cl_typ
             ; final = false
@@ -208,11 +233,15 @@ module Type = struct
                     ])
             })
 
-  let env_type ~arity n =
-    register_type (Printf.sprintf "env_%d_%d" arity n) (fun () ->
-        let* cl_typ = closure_type ~usage:`Alloc arity in
-        let* common = closure_common_fields in
-        let* fun_ty' = function_type arity in
+  let env_type ~cps ~arity n =
+    register_type
+      (if cps
+       then Printf.sprintf "cps_env_%d_%d" arity n
+       else Printf.sprintf "env_%d_%d" arity n)
+      (fun () ->
+        let* cl_typ = closure_type ~usage:`Alloc ~cps arity in
+        let* common = closure_common_fields ~cps in
+        let* fun_ty' = function_type ~cps arity in
         return
           { supertype = Some cl_typ
           ; final = true
@@ -220,6 +249,12 @@ module Type = struct
               W.Struct
                 ((if arity = 1
                   then common
+                  else if arity = 0
+                  then
+                    [ { mut = false
+                      ; typ = Value (Ref { nullable = false; typ = Type fun_ty' })
+                      }
+                    ]
                   else
                     common
                     @ [ { mut = false
@@ -251,13 +286,20 @@ module Type = struct
                    ~len:(function_count + free_variable_count))
           })
 
-  let rec_closure_type ~arity ~function_count ~free_variable_count =
+  let rec_closure_type ~cps ~arity ~function_count ~free_variable_count =
     register_type
-      (Printf.sprintf "closure_rec_%d_%d_%d" arity function_count free_variable_count)
+      (if cps
+       then
+         Printf.sprintf
+           "cps_closure_rec_%d_%d_%d"
+           arity
+           function_count
+           free_variable_count
+       else Printf.sprintf "closure_rec_%d_%d_%d" arity function_count free_variable_count)
       (fun () ->
-        let* cl_typ = closure_type ~usage:`Alloc arity in
-        let* common = closure_common_fields in
-        let* fun_ty' = function_type arity in
+        let* cl_typ = closure_type ~usage:`Alloc ~cps arity in
+        let* common = closure_common_fields ~cps in
+        let* fun_ty' = function_type ~cps arity in
         let* env_ty = rec_env_type ~function_count ~free_variable_count in
         return
           { supertype = Some cl_typ
@@ -278,12 +320,18 @@ module Type = struct
                   ])
           })
 
-  let rec curry_type arity m =
-    register_type (Printf.sprintf "curry_%d_%d" arity m) (fun () ->
-        let* cl_typ = closure_type ~usage:(if m = 2 then `Alloc else `Access) 1 in
-        let* common = closure_common_fields in
+  let rec curry_type ~cps arity m =
+    register_type
+      (if cps
+       then Printf.sprintf "cps_curry_%d_%d" arity m
+       else Printf.sprintf "curry_%d_%d" arity m)
+      (fun () ->
+        let* cl_typ = closure_type ~usage:(if m = 2 then `Alloc else `Access) ~cps 1 in
+        let* common = closure_common_fields ~cps in
         let* cl_ty =
-          if m = arity then closure_type ~usage:`Alloc arity else curry_type arity (m + 1)
+          if m = arity
+          then closure_type ~usage:`Alloc ~cps arity
+          else curry_type ~cps arity (m + 1)
         in
         return
           { supertype = Some cl_typ
@@ -298,12 +346,16 @@ module Type = struct
                   ])
           })
 
-  let dummy_closure_type ~arity =
-    register_type (Printf.sprintf "dummy_closure_%d" arity) (fun () ->
-        let* cl_typ = closure_type ~usage:`Alloc arity in
-        let* cl_typ' = closure_type ~usage:`Access arity in
-        let* common = closure_common_fields in
-        let* fun_ty' = function_type arity in
+  let dummy_closure_type ~cps ~arity =
+    register_type
+      (if cps
+       then Printf.sprintf "cps_dummy_closure_%d" arity
+       else Printf.sprintf "dummy_closure_%d" arity)
+      (fun () ->
+        let* cl_typ = closure_type ~cps ~usage:`Alloc arity in
+        let* cl_typ' = closure_type ~cps ~usage:`Access arity in
+        let* common = closure_common_fields ~cps in
+        let* fun_ty' = function_type ~cps arity in
         return
           { supertype = Some cl_typ
           ; final = true
@@ -466,25 +518,29 @@ module Memory = struct
   let set_field e idx e' = wasm_array_set e (Arith.const (Int32.of_int (idx + 1))) e'
 
   let env_start arity =
-    (if include_closure_arity then 1 else 0) + if arity = 1 then 1 else 2
-
-  let load_function_pointer ~arity ?(skip_cast = false) closure =
-    let* ty = Type.closure_type ~usage:`Access arity in
-    let* fun_ty = Type.function_type arity in
+    if arity = 0
+    then 1
+    else (if include_closure_arity then 1 else 0) + if arity = 1 then 1 else 2
+
+  let load_function_pointer ~cps ~arity ?(skip_cast = false) closure =
+    let arity = if cps then arity - 1 else arity in
+    let* ty = Type.closure_type ~usage:`Access ~cps arity in
+    let* fun_ty = Type.function_type ~cps arity in
     let casted_closure = if skip_cast then closure else wasm_cast ty closure in
     let* e = wasm_struct_get ty casted_closure (env_start arity - 1) in
     return (`Ref fun_ty, e)
 
-  let load_real_closure ~arity closure =
-    let* ty = Type.dummy_closure_type ~arity in
-    let* cl_typ = Type.closure_type ~usage:`Access arity in
+  let load_real_closure ~cps ~arity closure =
+    let arity = if cps then arity - 1 else arity in
+    let* ty = Type.dummy_closure_type ~cps ~arity in
+    let* cl_typ = Type.closure_type ~usage:`Access ~cps arity in
     let* e =
       wasm_cast cl_typ (wasm_struct_get ty (wasm_cast ty closure) (env_start arity))
     in
     return (cl_typ, e)
 
-  let check_function_arity f arity if_match if_mismatch =
-    let* fun_ty = Type.closure_type ~usage:`Access arity in
+  let check_function_arity f ~cps ~arity if_match if_mismatch =
+    let* fun_ty = Type.closure_type ~usage:`Access ~cps arity in
     let* closure = load f in
     let* () =
       drop
@@ -682,14 +738,15 @@ module Closure = struct
     | [ (g, _) ] -> Code.Var.equal f g
     | _ :: r -> is_last_fun r f
 
-  let translate ~context ~closures ~stack_ctx:_ f =
+  let translate ~context ~closures ~stack_ctx:_ ~cps f =
     let info = Code.Var.Map.find f closures in
     let free_variables = get_free_variables ~context info in
     let arity = List.assoc f info.functions in
-    let* curry_fun = if arity > 1 then need_curry_fun ~arity else return f in
+    let arity = if cps then arity - 1 else arity in
+    let* curry_fun = if arity > 1 then need_curry_fun ~cps ~arity else return f in
     if List.is_empty free_variables
     then
-      let* typ = Type.closure_type ~usage:`Alloc arity in
+      let* typ = Type.closure_type ~usage:`Alloc ~cps arity in
       let name = Code.Var.fresh_n "closure" in
       let* () =
         register_global
@@ -697,12 +754,15 @@ module Closure = struct
           { mut = false; typ = Type.value }
           (W.StructNew
              ( typ
-             , let code_pointers =
-                 if arity = 1 then [ W.RefFunc f ] else [ RefFunc curry_fun; RefFunc f ]
-               in
-               if include_closure_arity
-               then Const (I32 (Int32.of_int arity)) :: code_pointers
-               else code_pointers ))
+             , if arity = 0
+               then [ W.RefFunc f ]
+               else
+                 let code_pointers =
+                   if arity = 1 then [ W.RefFunc f ] else [ RefFunc curry_fun; RefFunc f ]
+                 in
+                 if include_closure_arity
+                 then Const (I32 (Int32.of_int arity)) :: code_pointers
+                 else code_pointers ))
       in
       return (W.GlobalGet (V name))
     else
@@ -710,19 +770,22 @@ module Closure = struct
       match info.Wa_closure_conversion.functions with
       | [] -> assert false
       | [ _ ] ->
-          let* typ = Type.env_type ~arity free_variable_count in
+          let* typ = Type.env_type ~cps ~arity free_variable_count in
           let* l = expression_list load free_variables in
           return
             (W.StructNew
                ( typ
-               , (let code_pointers =
-                    if arity = 1
-                    then [ W.RefFunc f ]
-                    else [ RefFunc curry_fun; RefFunc f ]
-                  in
-                  if include_closure_arity
-                  then W.Const (I32 (Int32.of_int arity)) :: code_pointers
-                  else code_pointers)
+               , (if arity = 0
+                  then [ W.RefFunc f ]
+                  else
+                    let code_pointers =
+                      if arity = 1
+                      then [ W.RefFunc f ]
+                      else [ RefFunc curry_fun; RefFunc f ]
+                    in
+                    if include_closure_arity
+                    then W.Const (I32 (Int32.of_int arity)) :: code_pointers
+                    else code_pointers)
                  @ l ))
       | (g, _) :: _ as functions ->
           let function_count = List.length functions in
@@ -747,7 +810,9 @@ module Closure = struct
               let* () = set_closure_env f env in
               load env
           in
-          let* typ = Type.rec_closure_type ~arity ~function_count ~free_variable_count in
+          let* typ =
+            Type.rec_closure_type ~cps ~arity ~function_count ~free_variable_count
+          in
           let res =
             let* env = env in
             return
@@ -781,7 +846,7 @@ module Closure = struct
               (load f)
           else res
 
-  let bind_environment ~context ~closures f =
+  let bind_environment ~context ~closures ~cps f =
     if Hashtbl.mem context.constants f
     then
       (* The closures are all constants and the environment is empty. *)
@@ -792,10 +857,11 @@ module Closure = struct
       let free_variables = get_free_variables ~context info in
       let free_variable_count = List.length free_variables in
       let arity = List.assoc f info.functions in
+      let arity = if cps then arity - 1 else arity in
       let offset = Memory.env_start arity in
       match info.Wa_closure_conversion.functions with
       | [ _ ] ->
-          let* typ = Type.env_type ~arity free_variable_count in
+          let* typ = Type.env_type ~cps ~arity free_variable_count in
           let* _ = add_var f in
           (*ZZZ Store env with right type in local variable? *)
           snd
@@ -808,7 +874,9 @@ module Closure = struct
                free_variables)
       | functions ->
           let function_count = List.length functions in
-          let* typ = Type.rec_closure_type ~arity ~function_count ~free_variable_count in
+          let* typ =
+            Type.rec_closure_type ~cps ~arity ~function_count ~free_variable_count
+          in
           let* _ = add_var f in
           let env = Code.Var.fresh_n "env" in
           let* env_typ = Type.rec_env_type ~function_count ~free_variable_count in
@@ -827,12 +895,12 @@ module Closure = struct
                ~init:(0, return ())
                (List.map ~f:fst functions @ free_variables))
 
-  let curry_allocate ~stack_ctx:_ ~x:_ ~arity m ~f ~closure ~arg =
-    let* ty = Type.curry_type arity m in
+  let curry_allocate ~stack_ctx:_ ~x:_ ~cps ~arity m ~f ~closure ~arg =
+    let* ty = Type.curry_type ~cps arity m in
     let* cl_ty =
       if m = arity
-      then Type.closure_type ~usage:`Alloc arity
-      else Type.curry_type arity (m + 1)
+      then Type.closure_type ~usage:`Alloc ~cps arity
+      else Type.curry_type ~cps arity (m + 1)
     in
     let* closure = Memory.wasm_cast cl_ty (load closure) in
     let* arg = load arg in
@@ -844,13 +912,13 @@ module Closure = struct
            then Const (I32 1l) :: closure_contents
            else closure_contents ))
 
-  let curry_load ~arity m closure =
+  let curry_load ~cps ~arity m closure =
     let m = m + 1 in
-    let* ty = Type.curry_type arity m in
+    let* ty = Type.curry_type ~cps arity m in
     let* cl_ty =
       if m = arity
-      then Type.closure_type ~usage:`Alloc arity
-      else Type.curry_type arity (m + 1)
+      then Type.closure_type ~usage:`Alloc ~cps arity
+      else Type.curry_type ~cps arity (m + 1)
     in
     let cast e = if m = 2 then Memory.wasm_cast ty e else e in
     let offset = Memory.env_start 1 in
@@ -859,13 +927,14 @@ module Closure = struct
       , Memory.wasm_struct_get ty (cast (load closure)) offset
       , Some (W.Ref { nullable = false; typ = Type cl_ty }) )
 
-  let dummy ~arity =
-    (* The runtime only handle function with arity up to 4 *)
-    let arity = if arity > 4 then 1 else arity in
-    let* dummy_fun = need_dummy_fun ~arity in
-    let* ty = Type.dummy_closure_type ~arity in
-    let* curry_fun = if arity > 1 then need_curry_fun ~arity else return dummy_fun in
-    let* cl_typ = Type.closure_type ~usage:`Alloc arity in
+  let dummy ~cps ~arity =
+    (* The runtime only handle function with arity up to 4
+       (1 for CPS functions) *)
+    let arity = if cps then 1 else if arity > 4 then 1 else arity in
+    let* dummy_fun = need_dummy_fun ~cps ~arity in
+    let* ty = Type.dummy_closure_type ~cps ~arity in
+    let* curry_fun = if arity > 1 then need_curry_fun ~cps ~arity else return dummy_fun in
+    let* cl_typ = Type.closure_type ~usage:`Alloc ~cps arity in
     let closure_contents =
       if arity = 1
       then [ W.RefFunc dummy_fun; RefNull (Type cl_typ) ]
@@ -1008,7 +1077,10 @@ let entry_point ~context =
   let code =
     let* f =
       register_import
-        ~name:"caml_initialize_effects"
+        ~name:
+          (if Config.Flag.effects ()
+           then "caml_cps_initialize_effects"
+           else "caml_initialize_effects")
         (Fun { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] })
     in
     let suspender = Code.Var.fresh () in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 155264a5ff..5284acd785 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -15,6 +15,7 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   type ctx =
     { live : int array
+    ; in_cps : Effects.in_cps
     ; blocks : block Addr.Map.t
     ; closures : Wa_closure_conversion.closure Var.Map.t
     ; global_context : Wa_code_generation.context
@@ -75,7 +76,8 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   let rec translate_expr ctx stack_ctx x e =
     match e with
-    | Apply { f; args; exact } when exact || List.length args = 1 ->
+    | Apply { f; args; exact }
+      when exact || List.length args = if Var.Set.mem x ctx.in_cps then 2 else 1 ->
         let* () = Stack.perform_spilling stack_ctx (`Instr x) in
         let rec loop acc l =
           match l with
@@ -83,7 +85,12 @@ module Generate (Target : Wa_target_sig.S) = struct
               let arity = List.length args in
               let funct = Var.fresh () in
               let* closure = tee funct (load f) in
-              let* kind, funct = Memory.load_function_pointer ~arity (load funct) in
+              let* kind, funct =
+                Memory.load_function_pointer
+                  ~cps:(Var.Set.mem x ctx.in_cps)
+                  ~arity
+                  (load funct)
+              in
               Stack.kill_variables stack_ctx;
               let* b = is_closure f in
               if b
@@ -108,7 +115,9 @@ module Generate (Target : Wa_target_sig.S) = struct
         loop [] args
     | Apply { f; args; _ } ->
         let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-        let* apply = need_apply_fun ~arity:(List.length args) in
+        let* apply =
+          need_apply_fun ~cps:(Var.Set.mem x ctx.in_cps) ~arity:(List.length args)
+        in
         let* args = expression_list load args in
         let* closure = load f in
         Stack.kill_variables stack_ctx;
@@ -117,12 +126,18 @@ module Generate (Target : Wa_target_sig.S) = struct
         Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
     | Field (x, n) -> Memory.field (load x) n
     | Closure _ ->
-        Closure.translate ~context:ctx.global_context ~closures:ctx.closures ~stack_ctx x
+        Closure.translate
+          ~context:ctx.global_context
+          ~closures:ctx.closures
+          ~stack_ctx
+          ~cps:(Var.Set.mem x ctx.in_cps)
+          x
     | Constant c -> Constant.translate c
     | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int (_, arity)) ])
-      when Poly.(target = `GC) -> Closure.dummy ~arity:(Int32.to_int arity)
+      when Poly.(target = `GC) ->
+        Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:(Int32.to_int arity)
     | Prim (Extern "caml_alloc_dummy_infix", _) when Poly.(target = `GC) ->
-        Closure.dummy ~arity:1
+        Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:1
     | Prim (p, l) -> (
         let l = List.map ~f:transl_prim_arg l in
         match p, l with
@@ -561,8 +576,25 @@ module Generate (Target : Wa_target_sig.S) = struct
             Value.val_int
               Arith.(
                 (Value.int_val j < Value.int_val i) - (Value.int_val i < Value.int_val j))
+        | Extern "%js_array", l ->
+            let* l =
+              List.fold_right
+                ~f:(fun x acc ->
+                  let* x = x in
+                  let* acc = acc in
+                  return (`Expr x :: acc))
+                l
+                ~init:(return [])
+            in
+            Memory.allocate stack_ctx x ~tag:0 l
         | Extern name, l ->
             (*ZZZ Different calling convention when large number of parameters *)
+            let name =
+              match name with
+              | "caml_callback" -> "caml_trampoline"
+              | "caml_alloc_stack" when Config.Flag.effects () -> "caml_cps_alloc_stack"
+              | _ -> name
+            in
             let* f = register_import ~name (Fun (func_type (List.length l))) in
             let* () = Stack.perform_spilling stack_ctx (`Instr x) in
             let rec loop acc l =
@@ -846,7 +878,11 @@ module Generate (Target : Wa_target_sig.S) = struct
       let* () = bind_parameters in
       match name_opt with
       | Some f ->
-          Closure.bind_environment ~context:ctx.global_context ~closures:ctx.closures f
+          Closure.bind_environment
+            ~context:ctx.global_context
+            ~closures:ctx.closures
+            ~cps:(Var.Set.mem f ctx.in_cps)
+            f
       | None -> return ()
     in
     (*
@@ -906,18 +942,21 @@ module Generate (Target : Wa_target_sig.S) = struct
   let f
       (p : Code.program)
       ~live_vars
-       (*
-    ~cps_calls
+      ~in_cps (*
     ~should_export
     ~warn_on_unhandled_effect
-      _debug *)
-      =
+      _debug *) =
     let p, closures = Wa_closure_conversion.f p in
     (*
   Code.Print.program (fun _ _ -> "") p;
 *)
     let ctx =
-      { live = live_vars; blocks = p.blocks; closures; global_context = make_context () }
+      { live = live_vars
+      ; in_cps
+      ; blocks = p.blocks
+      ; closures
+      ; global_context = make_context ()
+      }
     in
     let toplevel_name = Var.fresh_n "toplevel" in
     let functions =
@@ -958,13 +997,52 @@ let init () =
     ; "caml_ensure_stack_capacity", "%identity"
     ]
 
-let f ch (p : Code.program) ~live_vars =
+(* Make sure we can use [br_table] for switches *)
+let fix_switch_branches p =
+  let p' = ref p in
+  let updates = ref Addr.Map.empty in
+  let fix_branches l =
+    Array.iteri
+      ~f:(fun i ((pc, args) as cont) ->
+        if not (List.is_empty args)
+        then
+          l.(i) <-
+            ( (let l = try Addr.Map.find pc !updates with Not_found -> [] in
+               try List.assoc args l
+               with Not_found ->
+                 let pc' = !p'.free_pc in
+                 p' :=
+                   { !p' with
+                     blocks =
+                       Addr.Map.add
+                         pc'
+                         { params = []; body = []; branch = Branch cont, No }
+                         !p'.blocks
+                   ; free_pc = pc' + 1
+                   };
+                 updates := Addr.Map.add pc ((args, pc') :: l) !updates;
+                 pc')
+            , [] ))
+      l
+  in
+  Addr.Map.iter
+    (fun _ block ->
+      match fst block.branch with
+      | Switch (_, l, l') ->
+          fix_branches l;
+          fix_branches l'
+      | _ -> ())
+    p.blocks;
+  !p'
+
+let f ch (p : Code.program) ~live_vars ~in_cps =
+  let p = if Config.Flag.effects () then fix_switch_branches p else p in
   match target with
   | `Core ->
       let module G = Generate (Wa_core_target) in
-      let fields = G.f ~live_vars p in
+      let fields = G.f ~live_vars ~in_cps p in
       Wa_asm_output.f ch fields
   | `GC ->
       let module G = Generate (Wa_gc_target) in
-      let fields = G.f ~live_vars p in
+      let fields = G.f ~live_vars ~in_cps p in
       Wa_wat_output.f ch fields
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index 108958a9c5..05550212ca 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -1,3 +1,4 @@
 val init : unit -> unit
 
-val f : out_channel -> Code.program -> live_vars:int array -> unit
+val f :
+  out_channel -> Code.program -> live_vars:int array -> in_cps:Effects.in_cps -> unit
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 6a5edd6d99..492f1e663f 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -60,17 +60,22 @@ module type S = sig
       -> expression
 
     val load_function_pointer :
-         arity:int
+         cps:bool
+      -> arity:int
       -> ?skip_cast:bool
       -> expression
       -> ([ `Index | `Ref of Wa_ast.var ] * Wa_ast.expression) Wa_code_generation.t
 
     val load_real_closure :
-      arity:int -> expression -> (Wa_ast.var * Wa_ast.expression) Wa_code_generation.t
+         cps:bool
+      -> arity:int
+      -> expression
+      -> (Wa_ast.var * Wa_ast.expression) Wa_code_generation.t
 
     val check_function_arity :
          Code.Var.t
-      -> int
+      -> cps:bool
+      -> arity:int
       -> (typ:Wa_ast.value_type option -> expression -> expression)
       -> unit Wa_code_generation.t
       -> unit Wa_code_generation.t
@@ -173,18 +178,21 @@ module type S = sig
          context:Wa_code_generation.context
       -> closures:Wa_closure_conversion.closure Code.Var.Map.t
       -> stack_ctx:Stack.ctx
+      -> cps:bool
       -> Code.Var.t
       -> expression
 
     val bind_environment :
          context:Wa_code_generation.context
       -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+      -> cps:bool
       -> Code.Var.t
       -> unit Wa_code_generation.t
 
     val curry_allocate :
          stack_ctx:Stack.ctx
       -> x:Code.Var.t
+      -> cps:bool
       -> arity:int
       -> int
       -> f:Code.Var.t
@@ -193,12 +201,13 @@ module type S = sig
       -> Wa_ast.expression Wa_code_generation.t
 
     val curry_load :
-         arity:int
+         cps:bool
+      -> arity:int
       -> int
       -> Code.Var.t
       -> (expression * expression * Wa_ast.value_type option) Wa_code_generation.t
 
-    val dummy : arity:int -> Wa_ast.expression Wa_code_generation.t
+    val dummy : cps:bool -> arity:int -> Wa_ast.expression Wa_code_generation.t
   end
 
   module Math : sig
diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune
index 62319c8a50..b3e568e5ab 100644
--- a/compiler/tests-jsoo/lib-effects/dune
+++ b/compiler/tests-jsoo/lib-effects/dune
@@ -3,7 +3,7 @@
  (enabled_if
   (and
    (>= %{ocaml_version} 5)
-   (= %{profile} using-effects)))
+   (or (= %{profile} using-effects) (= %{profile} wasm-effects))))
  (inline_tests
   ;; This requires the unreleased dune 3.7 to work
   (enabled_if true)
diff --git a/compiler/tests-ocaml/lib-effects/dune b/compiler/tests-ocaml/lib-effects/dune
index 4f997d5fde..d7e7ecc5c0 100644
--- a/compiler/tests-ocaml/lib-effects/dune
+++ b/compiler/tests-ocaml/lib-effects/dune
@@ -5,6 +5,9 @@
  (wasm
   (flags
    (:standard -w -38)))
+ (wasm-effects
+  (flags
+   (:standard -w -38)))
  (_
   (flags
    (:standard -w -38))
diff --git a/dune b/dune
index 892aad19fe..9a502ee48f 100644
--- a/dune
+++ b/dune
@@ -13,6 +13,12 @@
   (binaries (tools/node_wrapper.sh as node))
   (js_of_ocaml
    (target wasm)))
+ (wasm-effects
+  (binaries (tools/node_wrapper.sh as node))
+  (js_of_ocaml
+   (flags
+    (:standard --enable effects))
+   (target wasm)))
  (bench_no_debug
   (flags
    (:standard \ -g))
diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc
index 410dfcebd7..c2dfe19149 100644
--- a/lib/tests/dune.inc
+++ b/lib/tests/dune.inc
@@ -42,7 +42,7 @@
 (library
  ;; lib/tests/test_json.ml
  (name test_json_75)
- (enabled_if (<> %{profile} wasm))
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_json)
  (libraries js_of_ocaml unix)
  (inline_tests (modes js))
diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml
index 57a16ee029..c226ba5bea 100644
--- a/lib/tests/gen-rules/gen.ml
+++ b/lib/tests/gen-rules/gen.ml
@@ -83,5 +83,5 @@ let () =
            | Any -> "true"
            | GE5 -> "(>= %{ocaml_version} 5)"
            | No_effects -> "(<> %{profile} using-effects)"
-           | Not_wasm -> "(<> %{profile} wasm)")
+           | Not_wasm -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))")
            basename)
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index caca2c22df..7c7c0cd95d 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -6,6 +6,8 @@
    (import "obj" "double_array_tag" (global $double_array_tag i32))
    (import "obj" "caml_obj_tag"
       (func $caml_obj_tag (param (ref eq)) (result (ref eq))))
+   (import "obj" "caml_is_closure"
+      (func $caml_is_closure (param (ref eq)) (result i32)))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
    (import "effect" "caml_is_continuation"
@@ -18,8 +20,6 @@
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
    (type $js (struct (field anyref)))
-   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
 
    (type $int_array (array (mut i32)))
    (type $block_array (array (mut (ref $block))))
@@ -474,11 +474,10 @@
                            (call $equals (local.get $js1) (local.get $js2)))
                         (return (global.get $unordered))))
                   (br $heterogeneous (i31.new (i32.const 0)))))
-               (if (ref.test (ref $closure) (local.get $v1))
+               (if (call $caml_is_closure (local.get $v1))
                   (then
                      (drop (br_if $heterogeneous (i31.new (i32.const 0))
-                              (i32.eqz
-                                 (ref.test (ref $closure) (local.get $v2)))))
+                              (i32.eqz (call $caml_is_closure (local.get $v2)))))
                      (call $clear_compare_stack)
                      (call $caml_invalid_argument
                         (array.new_data $string $functional_value
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index 51a32529d6..a53c63fe1c 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -4,6 +4,9 @@
    (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
    (import "sync" "caml_ml_mutex_unlock"
       (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
+   (import "obj" "caml_callback_1"
+      (func $caml_callback_1
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
 
    (func (export "caml_atomic_cas")
       (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
@@ -77,10 +80,7 @@
       (global.set $caml_domain_latest_id
          (i32.add (local.get $id) (i32.const 1)))
       (local.set $old (global.get $caml_domain_id))
-      (drop (call_ref $function_1 (i31.new (i32.const 0))
-               (local.get $f)
-                  (struct.get $closure 0
-                     (ref.cast (ref $closure) (local.get $f)))))
+      (drop (call $caml_callback_1 (local.get $f) (i31.new (i32.const 0))))
       (global.set $caml_domain_id (local.get $old))
       (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
       (i31.new (local.get $id)))
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 916519bb08..3614eb780a 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -90,16 +90,23 @@
 
    ;; Stack of fibers
 
-   (type $handlers (array (ref eq)))
+   (type $handlers
+      (struct
+         (field $value (ref eq))
+         (field $exn (ref eq))
+         (field $effect (ref eq))))
+
+   (type $generic_fiber (sub (struct (field $handlers (mut (ref $handlers))))))
 
    (type $fiber
-      (struct
-         (field $fiber_handlers (mut (ref $handlers)))
-         (field $fiber_cont (ref $cont))
-         (field $fiber_suspender externref)
-         (field $fiber_next (ref null $fiber))))
+      (sub final $generic_fiber
+         (struct
+            (field $handlers (mut (ref $handlers)))
+            (field $cont (ref $cont))
+            (field $suspender externref)
+            (field $next (ref null $fiber)))))
 
-   (type $continuation (struct (mut (ref null $fiber))))
+   (type $continuation (struct (mut eqref)))
 
    (data $effect_unhandled "Effect.Unhandled")
 
@@ -124,7 +131,7 @@
       (local $k' (ref $cont))
       (local.set $k'
          (call $push_stack
-            (ref.as_non_null
+            (ref.cast (ref $fiber)
                (struct.get $continuation 0
                   (ref.cast (ref $continuation) (local.get $cont))))
             (ref.cast (ref $cont) (local.get $k))))
@@ -142,9 +149,9 @@
    (func $default_continuation (param $p (ref $pair)) (param (ref eq))
       (drop (call $apply_pair (local.get $p))))
 
-   (global $fiber_stack (mut (ref null $fiber))
+   (global $stack (mut (ref null $fiber))
       (struct.new $fiber
-         (array.new_fixed $handlers 3
+         (struct.new $handlers
             (i31.new (i32.const 0))
             (i31.new (i32.const 0))
             (struct.new $closure_3
@@ -159,31 +166,31 @@
 
    (func $pop_fiber (result (ref $cont))
       (local $f (ref $fiber))
-      (local.set $f (ref.as_non_null (global.get $fiber_stack)))
-      (global.set $fiber_stack
-         (struct.get $fiber $fiber_next (local.get $f)))
+      (local.set $f (ref.as_non_null (global.get $stack)))
+      (global.set $stack
+         (struct.get $fiber $next (local.get $f)))
       (global.set $current_suspender
-         (struct.get $fiber $fiber_suspender (local.get $f)))
-      (struct.get $fiber $fiber_cont (local.get $f)))
+         (struct.get $fiber $suspender (local.get $f)))
+      (struct.get $fiber $cont (local.get $f)))
 
    (func $push_stack
       (param $stack (ref $fiber)) (param $k (ref $cont))
       (result (ref $cont))
       (block $done
          (loop $loop
-            (global.set $fiber_stack
+            (global.set $stack
                (struct.new $fiber
-                  (struct.get $fiber $fiber_handlers (local.get $stack))
+                  (struct.get $fiber $handlers (local.get $stack))
                   (local.get $k)
                   (global.get $current_suspender)
-                  (global.get $fiber_stack)))
+                  (global.get $stack)))
             (global.set $current_suspender
-               (struct.get $fiber $fiber_suspender (local.get $stack)))
+               (struct.get $fiber $suspender (local.get $stack)))
             (local.set $k
-               (struct.get $fiber $fiber_cont (local.get $stack)))
+               (struct.get $fiber $cont (local.get $stack)))
             (local.set $stack
                (br_on_null $done
-                  (struct.get $fiber $fiber_next (local.get $stack))))
+                  (struct.get $fiber $next (local.get $stack))))
             (br $loop)))
       (local.get $k))
 
@@ -197,7 +204,7 @@
          (ref.cast (ref $fiber) (struct.get $pair 0 (local.get $p))))
       (local.set $p (ref.cast (ref $pair) (struct.get $pair 1 (local.get $p))))
       (local.set $k (call $push_stack (local.get $stack) (local.get $k)))
-      (call_ref $cont_func (local.get $p) (local.get $k)
+      (return_call_ref $cont_func (local.get $p) (local.get $k)
          (struct.get $cont $cont_func (local.get $k))))
 
    (func (export "%resume")
@@ -252,19 +259,18 @@
       (local.set $cont
          (ref.cast (ref $continuation) (struct.get $pair 1 (local.get $p))))
       (local.set $handler
-         (array.get $handlers
-            (struct.get $fiber $fiber_handlers (global.get $fiber_stack))
-            (i32.const 2)))
+         (struct.get $handlers $effect
+            (struct.get $fiber $handlers (global.get $stack))))
       (struct.set $continuation 0
          (local.get $cont)
          (struct.new $fiber
-             (struct.get $fiber $fiber_handlers
-                (global.get $fiber_stack))
+             (struct.get $fiber $handlers (global.get $stack))
              (local.get $k0)
              (global.get $current_suspender)
-             (struct.get $continuation 0 (local.get $cont))))
+             (ref.cast (ref null $fiber)
+                (struct.get $continuation 0 (local.get $cont)))))
       (local.set $k1 (call $pop_fiber))
-      (call_ref $cont_func
+      (return_call_ref $cont_func
          (struct.new $pair
             (struct.new $call_handler_env
                (ref.func $call_effect_handler)
@@ -288,15 +294,11 @@
 
    ;; Allocate a stack
 
-   (func $call_handler (param $i i32) (param $x (ref eq))
+   (func $call_handler (param $f (ref eq)) (param $x (ref eq))
       ;; Propagate a value or an exception to the parent fiber
-      (local $f (ref eq))
       (local $cont (ref $cont))
-      (local.set $f
-         (array.get $handlers
-            (struct.get $fiber $fiber_handlers (global.get $fiber_stack))
-            (local.get $i)))
-      (call_ref $cont_func (struct.new $pair (local.get $f) (local.get $x))
+      (return_call_ref $cont_func
+         (struct.new $pair (local.get $f) (local.get $x))
          (local.tee $cont (call $pop_fiber))
          (struct.get $cont $cont_func (local.get $cont))))
 
@@ -317,9 +319,15 @@
                         (call $caml_wrap_exception (pop externref))))))
             (catch $ocaml_exception
                (local.set $exn (pop (ref eq)))
-               (call $call_handler (i32.const 1) (local.get $exn))
+               (call $call_handler
+                  (struct.get $handlers $exn
+                     (struct.get $fiber $handlers (global.get $stack)))
+                  (local.get $exn))
                (return))))
-      (call $call_handler (i32.const 0) (local.get $res)))
+      (call $call_handler
+         (struct.get $handlers $value
+            (struct.get $fiber $handlers (global.get $stack)))
+         (local.get $res)))
 
    (func $initial_cont (param $p (ref $pair)) (param (ref eq))
       (call $start_fiber (local.get $p)))
@@ -328,8 +336,7 @@
       (param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq))
       (result (ref eq))
       (struct.new $fiber
-         (array.new_fixed $handlers 3
-            (local.get $hv) (local.get $hx) (local.get $hf))
+         (struct.new $handlers (local.get $hv) (local.get $hx) (local.get $hf))
          (struct.new $cont (ref.func $initial_cont))
          (ref.null extern)
          (ref.null $fiber)))
@@ -339,27 +346,27 @@
    (func $caml_continuation_use_noexc (export "caml_continuation_use_noexc")
       (param (ref eq)) (result (ref eq))
       (local $cont (ref $continuation))
-      (local $stack (ref $fiber))
+      (local $stack (ref eq))
       (block $used
          (local.set $cont (ref.cast (ref $continuation) (local.get 0)))
          (local.set $stack
             (br_on_null $used (struct.get $continuation 0 (local.get $cont))))
-         (struct.set $continuation 0 (local.get $cont) (ref.null $fiber))
+         (struct.set $continuation 0 (local.get $cont) (ref.null eq))
          (return (local.get $stack)))
       (i31.new (i32.const 0)))
 
    (func (export "caml_continuation_use_and_update_handler_noexc")
       (param $cont (ref eq)) (param $hval (ref eq)) (param $hexn (ref eq))
       (param $heff (ref eq)) (result (ref eq))
-      (local $stack (ref $fiber))
-      (local.set $stack
-         (ref.cast (ref $fiber)
-            (call $caml_continuation_use_noexc (local.get $cont))))
-      (block $used
-         (struct.set $fiber $fiber_handlers
-            (br_on_null $used (local.get $stack))
-            (array.new_fixed $handlers 3
-               (local.get $hval) (local.get $hexn) (local.get $heff))))
+      (local $stack (ref eq))
+      (local.set $stack (call $caml_continuation_use_noexc (local.get $cont)))
+      (drop (block $used (result (ref eq))
+         (struct.set $generic_fiber $handlers
+            (br_on_cast_fail $used (ref eq) (ref $generic_fiber)
+               (local.get $stack))
+            (struct.new $handlers
+               (local.get $hval) (local.get $hexn) (local.get $heff)))
+         (i31.new (i32.const 0))))
       (local.get $stack))
 
    (func (export $caml_get_continuation_callstack)
@@ -371,4 +378,333 @@
 
    (func (export "caml_initialize_effects") (param $s externref)
       (global.set $current_suspender (local.get $s)))
+
+   ;; Effects through CPS transformation
+
+   (type $function_2
+      (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+   (type $function_4
+      (func (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
+         (result (ref eq))))
+   (type $cps_closure (sub (struct (field (ref $function_2)))))
+   (type $cps_closure_0 (sub (struct (field (ref $function_1)))))
+   (type $cps_closure_3
+      (sub $cps_closure
+         (struct (field (ref $function_2)) (field (ref $function_4)))))
+
+   (type $iterator
+     (sub $closure
+       (struct
+          (field (ref $function_1))
+          (field $i (mut i32))
+          (field $args (ref $block)))))
+
+   (type $exn_stack
+      (struct (field $h (ref eq)) (field $next (ref null $exn_stack))))
+
+   (type $cps_fiber
+      (sub final $generic_fiber
+         (struct
+            (field $handlers (mut (ref $handlers)))
+            (field $cont (ref eq))
+            (field $exn_stack (ref null $exn_stack))
+            (field $next (ref null $cps_fiber)))))
+
+   (global $exn_stack (mut (ref null $exn_stack)) (ref.null $exn_stack))
+
+   (func (export "caml_push_trap") (param $h (ref eq)) (result (ref eq))
+      (global.set $exn_stack
+         (struct.new $exn_stack (local.get $h) (global.get $exn_stack)))
+      (i31.new (i32.const 0)))
+
+   (func $raise_exception
+      (param $exn (ref eq)) (param (ref eq)) (result (ref eq))
+      (throw $ocaml_exception (local.get $exn)))
+
+   (global $raise_exception (ref eq)
+      (struct.new $closure (ref.func $raise_exception)))
+
+   (func (export "caml_pop_trap") (result (ref eq))
+      (local $top (ref $exn_stack))
+      (block $empty
+         (local.set $top (br_on_null $empty (global.get $exn_stack)))
+         (global.set $exn_stack
+            (struct.get $exn_stack $next (local.get $top)))
+         (return (struct.get $exn_stack $h (local.get $top))))
+      (global.get $raise_exception))
+
+   (func (export "caml_maybe_attach_backtrace")
+      (param $exn (ref eq)) (param (ref eq)) (result (ref eq))
+      (local.get $exn))
+
+   (func $identity (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (local.get 0))
+
+   (global $identity (ref $closure) (struct.new $closure (ref.func $identity)))
+
+   (func $trampoline_iterator
+      (param $f (ref eq)) (param $venv (ref eq)) (result (ref eq))
+      (local $env (ref $iterator))
+      (local $i i32) (local $args (ref $block))
+      (local.set $env (ref.cast (ref $iterator) (local.get $venv)))
+      (local.set $i (struct.get $iterator $i (local.get $env)))
+      (local.set $args (struct.get $iterator $args (local.get $env)))
+      (struct.set $iterator $i (local.get $env)
+         (i32.add (local.get $i) (i32.const 1)))
+      (return_call_ref $function_2
+         (array.get $block (local.get $args) (local.get $i))
+         (if (result (ref eq))
+             (i32.eq (i32.add (local.get $i) (i32.const 1))
+                (array.len (local.get $args)))
+            (then (global.get $identity))
+            (else (local.get $env)))
+         (local.get $f)
+         (struct.get $cps_closure 0
+            (ref.cast (ref $cps_closure) (local.get $f)))))
+
+   (func $apply_iterator
+      (param $f (ref eq)) (param $venv (ref eq)) (result (ref eq))
+      (local $env (ref $iterator))
+      (local $i i32) (local $args (ref $block))
+      (local.set $env (ref.cast (ref $iterator) (local.get $venv)))
+      (local.set $i (struct.get $iterator $i (local.get $env)))
+      (local.set $args (struct.get $iterator $args (local.get $env)))
+      (struct.set $iterator $i (local.get $env)
+         (i32.add (local.get $i) (i32.const 1)))
+      (return_call_ref $function_2
+         (array.get $block (local.get $args) (local.get $i))
+         (if (result (ref eq))
+             (i32.eq (i32.add (local.get $i) (i32.const 2))
+                (array.len (local.get $args)))
+            (then
+               (array.get $block (local.get $args)
+                  (i32.add (local.get $i) (i32.const 1))))
+            (else
+               (local.get $env)))
+         (local.get $f)
+         (struct.get $cps_closure 0
+            (ref.cast (ref $cps_closure) (local.get $f)))))
+
+   (func (export "caml_apply_continuation")
+      (param $args (ref eq)) (result (ref eq))
+      (struct.new $iterator
+         (ref.func $apply_iterator)
+         (i32.const 1)
+         (ref.cast (ref $block) (local.get $args))))
+
+   (func $dummy_cps_fun
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (unreachable))
+
+   (global $cps_fiber_stack (mut (ref null $cps_fiber)) (ref.null $cps_fiber))
+
+   (global $default_fiber_stack (ref null $cps_fiber)
+      (struct.new $cps_fiber
+         (struct.new $handlers
+            (i31.new (i32.const 0)) (i31.new (i32.const 0))
+            (struct.new $cps_closure_3
+               (ref.func $dummy_cps_fun)
+               (ref.func $cps_uncaught_effect_handler)))
+         (i31.new (i32.const 0))
+         (ref.null $exn_stack)
+         (ref.null $cps_fiber)))
+
+   (func $caml_trampoline (export "caml_trampoline")
+      (param $f (ref eq)) (param $vargs (ref eq)) (result (ref eq))
+      (local $args (ref $block))
+      (local $i i32) (local $res (ref eq))
+      (local $exn (ref eq)) (local $top (ref $exn_stack))
+      (local $saved_exn_stack (ref null $exn_stack))
+      (local $saved_fiber_stack (ref null $cps_fiber))
+      (local.set $saved_exn_stack (global.get $exn_stack))
+      (local.set $saved_fiber_stack (global.get $cps_fiber_stack))
+      (global.set $exn_stack (ref.null $exn_stack))
+      (global.set $cps_fiber_stack (global.get $default_fiber_stack))
+      (local.set $args (ref.cast (ref $block) (local.get $vargs)))
+      (local.set $exn
+         (try (result (ref eq))
+            (do
+               (local.set $res
+                  (if (result (ref eq))
+                      (i32.eq (array.len $block (local.get $args)) (i32.const 1))
+                     (then
+                        (call_ref $function_1 (global.get $identity)
+                           (local.get $f)
+                           (struct.get $cps_closure_0 0
+                              (ref.cast (ref $cps_closure_0) (local.get $f)))))
+                     (else
+                        (call_ref $function_2
+                           (array.get $block (local.get $args) (i32.const 1))
+                           (if (result (ref eq))
+                               (i32.eq (i32.const 2)
+                                       (array.len (local.get $args)))
+                              (then (global.get $identity))
+                              (else
+                                 (struct.new $iterator
+                                    (ref.func $trampoline_iterator)
+                                    (i32.const 2)
+                                    (local.get $args))))
+                           (local.get $f)
+                           (struct.get $cps_closure 0
+                              (ref.cast (ref $cps_closure) (local.get $f)))))))
+               (global.set $exn_stack (local.get $saved_exn_stack))
+               (global.set $cps_fiber_stack (local.get $saved_fiber_stack))
+               (return (local.get $res)))
+            (catch $ocaml_exception
+               (pop (ref eq)))
+            (catch $javascript_exception
+               (call $caml_wrap_exception (pop externref)))))
+      (loop $loop
+         (block $empty
+            (local.set $top
+               (br_on_null $empty (global.get $exn_stack)))
+            (global.set $exn_stack
+               (struct.get $exn_stack $next (local.get $top)))
+            (local.set $f (struct.get $exn_stack $h (local.get $top)))
+            (try
+               (do
+                  (local.set $res
+                     (call_ref $function_1
+                        (local.get $exn)
+                        (local.get $f)
+                        (struct.get $closure 0
+                           (ref.cast (ref $closure) (local.get $f)))))
+                  (global.set $exn_stack (local.get $saved_exn_stack))
+                  (global.set $cps_fiber_stack (local.get $saved_fiber_stack))
+                  (return (local.get $res)))
+               (catch $ocaml_exception
+                  (local.set $exn (pop (ref eq)))
+                  (br $loop))
+               (catch $javascript_exception
+                  (local.set $exn (call $caml_wrap_exception (pop externref)))
+                  (br $loop)))))
+      (global.set $exn_stack (local.get $saved_exn_stack))
+      (global.set $cps_fiber_stack (local.get $saved_fiber_stack))
+      (throw $ocaml_exception (local.get $exn)))
+
+   (global $caml_trampoline_ref (export "caml_trampoline_ref")
+      (mut (ref null $function_1)) (ref.null $function_1))
+
+   (func $caml_pop_fiber (result (ref eq))
+      (local $top (ref $cps_fiber))
+      (local.set $top (ref.as_non_null (global.get $cps_fiber_stack)))
+      (global.set $cps_fiber_stack
+         (struct.get $cps_fiber $next (local.get $top)))
+      (global.set $exn_stack
+         (struct.get $cps_fiber $exn_stack (local.get $top)))
+      (struct.get $cps_fiber $cont (local.get $top)))
+
+   (func $caml_resume_stack (export "caml_resume_stack")
+      (param $vstack (ref eq)) (param $k (ref eq)) (result (ref eq))
+      (local $stack (ref $cps_fiber))
+      (drop (block $already_resumed (result (ref eq))
+         (local.set $stack
+            (br_on_cast_fail $already_resumed (ref eq) (ref $cps_fiber)
+               (local.get $vstack)))
+         (block $done
+            (loop $loop
+               (global.set $cps_fiber_stack
+                  (struct.new $cps_fiber
+                     (struct.get $cps_fiber $handlers (local.get $stack))
+                     (local.get $k)
+                     (global.get $exn_stack)
+                     (global.get $cps_fiber_stack)))
+               (local.set $k (struct.get $cps_fiber $cont (local.get $stack)))
+               (global.set $exn_stack
+                  (struct.get $cps_fiber $exn_stack (local.get $stack)))
+               (local.set $stack
+                  (br_on_null $done
+                     (struct.get $cps_fiber $next (local.get $stack))))
+               (br $loop)))
+         (return (local.get $k))))
+      (call $caml_raise_constant
+         (ref.as_non_null
+            (call $caml_named_value
+               (string.const "Effect.Continuation_already_resumed"))))
+      (i31.new (i32.const 0)))
+
+   (func (export "caml_perform_effect")
+      (param $eff (ref eq)) (param $vcont (ref eq)) (param $k0 (ref eq))
+      (result (ref eq))
+      (local $handlers (ref $handlers))
+      (local $handler (ref eq)) (local $k1 (ref eq))
+      (local $cont (ref $continuation))
+      (local.set $cont
+         (block $reperform (result (ref $continuation))
+            (drop
+               (br_on_cast $reperform (ref eq) (ref $continuation)
+                 (local.get $vcont)))
+            (struct.new $continuation (ref.null eq))))
+      (local.set $handlers
+         (struct.get $cps_fiber $handlers
+            (ref.as_non_null (global.get $cps_fiber_stack))))
+      (local.set $handler
+         (struct.get $handlers $effect (local.get $handlers)))
+      (struct.set $continuation 0 (local.get $cont)
+         (struct.new $cps_fiber
+            (local.get $handlers)
+            (local.get $k0)
+            (global.get $exn_stack)
+            (ref.cast (ref null $cps_fiber)
+               (struct.get $continuation 0 (local.get $cont)))))
+      (local.set $k1 (call $caml_pop_fiber))
+      (return_call_ref $function_4
+         (local.get $eff) (local.get $cont) (local.get $k1) (local.get $k1)
+         (local.get $handler)
+         (struct.get $cps_closure_3 1
+            (ref.cast (ref $cps_closure_3) (local.get $handler)))))
+
+   (func $cps_call_handler
+      (param $handler (ref eq)) (param $x (ref eq)) (result (ref eq))
+      (return_call_ref $function_2
+         (local.get $x)
+         (call $caml_pop_fiber)
+         (local.get $handler)
+         (struct.get $cps_closure 0
+            (ref.cast (ref $cps_closure) (local.get $handler)))))
+
+   (func $value_handler (param $x (ref eq)) (param (ref eq)) (result (ref eq))
+      (return_call $cps_call_handler
+          (struct.get $handlers $value
+             (struct.get $cps_fiber $handlers
+                (ref.as_non_null (global.get $cps_fiber_stack))))
+          (local.get $x)))
+
+   (global $value_handler (ref $closure)
+      (struct.new $closure (ref.func $value_handler)))
+
+   (func $exn_handler (param $x (ref eq)) (param (ref eq)) (result (ref eq))
+      (return_call $cps_call_handler
+          (struct.get $handlers $exn
+             (struct.get $cps_fiber $handlers
+                (ref.as_non_null (global.get $cps_fiber_stack))))
+          (local.get $x)))
+
+   (global $exn_handler (ref $closure)
+      (struct.new $closure (ref.func $exn_handler)))
+
+   (func (export "caml_cps_alloc_stack")
+      (param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq))
+      (result (ref eq))
+      (struct.new $cps_fiber
+         (struct.new $handlers
+            (local.get $hv) (local.get $hx) (local.get $hf))
+         (global.get $value_handler)
+         (struct.new $exn_stack
+            (global.get $exn_handler) (ref.null $exn_stack))
+         (ref.null $cps_fiber)))
+
+   (func $cps_uncaught_effect_handler
+      (param $eff (ref eq)) (param $k (ref eq)) (param $ms (ref eq))
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (drop
+         (call $caml_resume_stack
+            (ref.as_non_null
+               (struct.get $continuation 0
+                  (ref.cast (ref $continuation) (local.get $k))))
+            (local.get $ms)))
+      (call $raise_unhandled (local.get $eff) (i31.new (i32.const 0))))
+
+   (func (export "caml_cps_initialize_effects")
+      (global.set $caml_trampoline_ref (ref.func $caml_trampoline)))
 )
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 1c5f59bd9c..57ea8b51b8 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -59,6 +59,13 @@
       (func $caml_failwith_tag (result (ref eq))))
    (import "stdlib" "caml_named_value"
       (func $caml_named_value (param anyref) (result (ref null eq))))
+   (import "obj" "caml_callback_1"
+      (func $caml_callback_1
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "obj" "caml_is_closure"
+      (func $caml_is_closure (param (ref eq)) (result i32)))
+   (import "obj" "caml_is_last_arg"
+      (func $caml_is_last_arg (param (ref eq)) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
@@ -66,8 +73,9 @@
    (type $js (struct (field anyref)))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
    (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
-   (type $closure_last_arg
-      (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
+   (type $function_2
+      (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+   (type $cps_closure (sub (struct (field (ref $function_2)))))
 
    (func $wrap (export "wrap") (param anyref) (result (ref eq))
       (block $is_eq (result (ref eq))
@@ -123,12 +131,8 @@
          (call $from_bool (i31.get_s (ref.cast (ref i31) (local.get 0))))))
 
   (func (export "caml_js_pure_expr")
-     (param (ref eq)) (result (ref eq))
-     (return_call_ref $function_1
-        (i31.new (i32.const 0))
-        (local.get 0)
-        (struct.get $closure 0
-           (ref.cast (ref $closure) (local.get 0)))))
+     (param $f (ref eq)) (result (ref eq))
+     (return_call $caml_callback_1 (local.get $f) (i31.new (i32.const 0))))
 
    (func (export "caml_js_fun_call")
       (param $f (ref eq)) (param $args (ref eq)) (result (ref eq))
@@ -341,44 +345,38 @@
       (param $f (ref eq)) (param $count i32) (param $args (ref extern))
       (param $kind i32) ;; 0 ==> strict / 2 ==> unsafe
       (result anyref)
-      (local $acc (ref eq)) (local $i i32)
+      (local $acc (ref eq)) (local $i i32) (local $arg (ref eq))
       (local.set $acc (local.get $f))
       (if (i32.eq (local.get $kind) (i32.const 2))
          (then
             (loop $loop
                (local.set $f (local.get $acc))
                (local.set $acc
-                  (call_ref $function_1
+                  (call $caml_callback_1 (local.get $acc)
                      (call $wrap
                         (call $get (local.get $args)
-                           (i31.new (local.get $i))))
-                     (local.get $acc)
-                     (struct.get $closure 0
-                        (ref.cast (ref $closure) (local.get $acc)))))
+                           (i31.new (local.get $i))))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop
-                  (i32.eqz (ref.test (ref $closure_last_arg) (local.get $f))))))
+                  (i32.eqz (call $caml_is_last_arg (local.get $f))))))
          (else
             (local.set $i (i32.const 0))
-            (drop (block $done (result (ref eq))
+            (block $done
                (loop $loop
                   (if (i32.lt_u (local.get $i) (local.get $count))
                      (then
+                        (br_if $done
+                           (i32.eqz (call $caml_is_closure (local.get $acc))))
                         (local.set $acc
-                           (call_ref $function_1
+                           (call $caml_callback_1 (local.get $acc)
                               (call $wrap
                                  (call $get (local.get $args)
-                                    (i31.new (local.get $i))))
-                              (local.get $acc)
-                              (struct.get $closure 0
-                                 (br_on_cast_fail $done (ref eq) (ref $closure)
-                                    (local.get $acc)))))
+                                    (i31.new (local.get $i))))))
                         (local.set $i (i32.add (local.get $i) (i32.const 1)))
-                        (br $loop))))
-               (i31.new (i32.const 0))))
+                        (br $loop)))))
             (if (local.get $kind)
                (then
-                  (if (ref.test (ref $closure) (local.get $acc))
+                  (if (call $caml_is_closure (local.get $acc))
                      (then (local.set $acc
                               (call $caml_js_wrap_callback
                                  (local.get $acc)))))))))
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 35326a1b3e..521c192cfa 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -7,6 +7,8 @@
    (import "string" "caml_string_cat"
       (func $caml_string_cat
          (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "obj" "caml_is_closure"
+      (func $caml_is_closure (param (ref eq)) (result i32)))
    (import "effect" "caml_is_continuation"
       (func $caml_is_continuation (param (ref eq)) (result i32)))
    (import "bindings" "weak_map_new" (func $weak_map_new (result (ref any))))
@@ -105,8 +107,6 @@
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
    (type $js (struct (field anyref)))
-   (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
-   (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
 
    (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
@@ -1202,7 +1202,7 @@
                      (i32.add (tuple.extract 1 (local.get $r)) (i32.const 15))
                         (i32.const 3)))
                (br $next_item)))
-            (if (ref.test (ref $closure) (local.get $v))
+            (if (call $caml_is_closure (local.get $v))
                (then
                   (call $caml_invalid_argument
                      (array.new_data $string $func_value
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index ca36b86898..14854f6392 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -4,6 +4,8 @@
       (func $caml_is_custom (param (ref eq)) (result i32)))
    (import "effect" "caml_is_continuation"
       (func $caml_is_continuation (param (ref eq)) (result i32)))
+   (import "effect" "caml_trampoline_ref"
+      (global $caml_trampoline_ref (mut (ref null $function_1))))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -12,6 +14,11 @@
    (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
    (type $closure_last_arg
       (sub $closure (struct (;(field i32);) (field (ref $function_1)))))
+   (type $function_2
+      (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+   (type $cps_closure (sub (struct (field (ref $function_2)))))
+   (type $cps_closure_last_arg
+      (sub $cps_closure (struct (field (ref $function_2)))))
 
    (type $int_array (array (mut i32)))
 
@@ -19,9 +26,6 @@
       (sub final $closure_last_arg
          (struct (field (ref $function_1)) (field (mut (ref null $closure))))))
 
-   (type $function_2
-      (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq))))
-
    (type $closure_2
       (sub $closure
          (struct (field (ref $function_1)) (field (ref $function_2)))))
@@ -55,6 +59,12 @@
          (struct (field (ref $function_1)) (field (ref $function_4))
             (field (mut (ref null $closure_4))))))
 
+   (type $cps_dummy_closure
+      (sub final $cps_closure_last_arg
+         (struct
+            (field (ref $function_2))
+            (field (mut (ref null $cps_closure))))))
+
    (global $forcing_tag i32 (i32.const 244))
    (global $cont_tag i32 (i32.const 245))
    (global $lazy_tag (export "lazy_tag") i32 (i32.const 246))
@@ -67,6 +77,16 @@
    (global $double_array_tag (export "double_array_tag") i32 (i32.const 254))
    (global $custom_tag i32 (i32.const 255))
 
+   (func $caml_is_closure (export "caml_is_closure")
+      (param $v (ref eq)) (result i32)
+      (i32.or (ref.test (ref $closure) (local.get $v))
+              (ref.test (ref $cps_closure) (local.get $v))))
+
+   (func (export "caml_is_last_arg")
+      (param $v (ref eq)) (result i32)
+      (i32.or (ref.test (ref $closure_last_arg) (local.get $v))
+              (ref.test (ref $cps_closure_last_arg) (local.get $v))))
+
    (func (export "caml_alloc_dummy") (param $size (ref eq)) (result (ref eq))
       (array.new $block (i31.new (i32.const 0))
                  (i32.add (i31.get_u (ref.cast (ref i31) (local.get $size)))
@@ -109,6 +129,12 @@
                (local.get $dummy))
             (ref.cast (ref $closure_4) (local.get $newval)))
          (return (i31.new (i32.const 0)))))
+      (drop (block $not_cps_closure (result (ref eq))
+         (struct.set $cps_dummy_closure 1
+            (br_on_cast_fail $not_cps_closure (ref eq) (ref $cps_dummy_closure)
+               (local.get $dummy))
+            (ref.cast (ref $cps_closure) (local.get $newval)))
+         (return (i31.new (i32.const 0)))))
       ;; ZZZ float array
       (unreachable))
 
@@ -174,7 +200,7 @@
          (then (return (i31.new (global.get $float_tag)))))
       (if (call $caml_is_custom (local.get $v))
          (then (return (i31.new (global.get $custom_tag)))))
-      (if (ref.test (ref $closure) (local.get $v))
+      (if (call $caml_is_closure (local.get $v))
          (then (return (i31.new (global.get $closure_tag)))))
       (if (call $caml_is_continuation (local.get $v))
          (then (return (i31.new (global.get $cont_tag)))))
@@ -374,4 +400,17 @@
 
    (func (export "caml_obj_reachable_words") (param (ref eq)) (result (ref eq))
       (i31.new (i32.const 0)))
+
+   (func (export "caml_callback_1")
+      (param $f (ref eq)) (param $x (ref eq)) (result (ref eq))
+      (drop (block $cps (result (ref eq))
+         (return_call_ref $function_1 (local.get $x)
+            (local.get $f)
+            (struct.get $closure 0
+               (br_on_cast_fail $cps (ref eq) (ref $closure)
+                  (local.get $f))))))
+      (return_call_ref $function_1
+         (local.get $f)
+         (array.new_fixed $block 2 (i31.new (i32.const 0)) (local.get $x))
+         (ref.as_non_null (global.get $caml_trampoline_ref))))
 )

From 0b3b1d7281f05979f40af9c0ff02e231f67ab574 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 13 Sep 2023 18:41:45 +0200
Subject: [PATCH 127/481] Properly handle system errors

---
 runtime/wasm/fail.wat   |   4 +-
 runtime/wasm/fs.wat     |  71 +++++++++++++++++++--------
 runtime/wasm/io.wat     | 106 ++++++++++++++++++++++++----------------
 runtime/wasm/runtime.js |   3 +-
 runtime/wasm/sys.wat    |  25 +++++++++-
 5 files changed, 142 insertions(+), 67 deletions(-)

diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 16ac7a5864..43d39a7564 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -27,11 +27,11 @@
 
    (global $SYS_ERROR_EXN i32 (i32.const 1))
 
-   (func (export "caml_raise_sys_error") (param $msg (ref $string))
+   (func (export "caml_raise_sys_error") (param $msg (ref eq))
        (return_call $caml_raise_with_arg
            (array.get $block (global.get $caml_global_data)
               (global.get $SYS_ERROR_EXN))
-           (local.get 0)))
+           (local.get $msg)))
 
    (global $FAILURE_EXN i32 (i32.const 2))
 
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index 489914fbba..24ef6e47bb 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -2,6 +2,7 @@
    (import "bindings" "log" (func $log_js (param anyref)))
    (import "bindings" "getcwd" (func $getcwd (result anyref)))
    (import "bindings" "chdir" (func $chdir (param anyref)))
+   (import "bindings" "mkdir" (func $mkdir (param anyref) (param i32)))
    (import "bindings" "unlink" (func $unlink (param anyref)))
    (import "bindings" "readdir"
       (func $readdir (param anyref) (result (ref extern))))
@@ -18,6 +19,10 @@
       (func $caml_js_to_string_array (param $a (ref extern)) (result (ref eq))))
    (import "fail" "caml_raise_sys_error"
       (func $caml_raise_sys_error (param (ref eq))))
+   (import "fail" "javascript_exception"
+      (tag $javascript_exception (param externref)))
+   (import "sys" "caml_handle_sys_error"
+      (func $caml_handle_sys_error (param externref)))
 
    (type $string (array (mut i8)))
 
@@ -26,38 +31,64 @@
       (return_call $caml_string_of_jsstring (call $wrap (call $getcwd))))
 
    (func (export "caml_sys_chdir")
-      (param (ref eq)) (result (ref eq))
-      (call $chdir (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
-      (i31.new (i32.const 0)))
+      (param $name (ref eq)) (result (ref eq))
+      (try
+         (do
+            (call $chdir
+               (call $unwrap (call $caml_jsstring_of_string (local.get $name)))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_sys_mkdir")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "caml_sys_mkdir"))
-      (i31.new (i32.const 0)))
+      (param $name (ref eq)) (param $perm (ref eq)) (result (ref eq))
+      (try
+         (do
+            (call $mkdir
+               (call $unwrap (call $caml_jsstring_of_string (local.get $name)))
+               (i31.get_u (ref.cast (ref i31) (local.get $perm)))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_sys_read_directory")
-      (param (ref eq)) (result (ref eq))
-      (return_call $caml_js_to_string_array
-         (call $readdir
-            (call $unwrap (call $caml_jsstring_of_string (local.get 0))))))
+      (param $name (ref eq)) (result (ref eq))
+      (try
+         (do
+            (return
+               (call $caml_js_to_string_array
+                  (call $readdir
+                     (call $unwrap
+                        (call $caml_jsstring_of_string (local.get $name)))))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))
+            (return (i31.new (i32.const 0))))))
 
    (func (export "caml_sys_remove")
-      (param (ref eq)) (result (ref eq))
-      (call $unlink (call $unwrap (call $caml_jsstring_of_string (local.get 0))))
-      (i31.new (i32.const 0)))
+      (param $name (ref eq)) (result (ref eq))
+      (try
+         (do
+            (call $unlink
+               (call $unwrap (call $caml_jsstring_of_string (local.get $name)))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_sys_rename")
       (param $o (ref eq)) (param $n (ref eq)) (result (ref eq))
-      (call $rename
-         (call $unwrap (call $caml_jsstring_of_string (local.get $o)))
-         (call $unwrap (call $caml_jsstring_of_string (local.get $n))))
-      (i31.new (i32.const 0)))
+      (try
+         (do
+            (call $rename
+               (call $unwrap (call $caml_jsstring_of_string (local.get $o)))
+               (call $unwrap (call $caml_jsstring_of_string (local.get $n)))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_sys_file_exists")
-      (param (ref eq)) (result (ref eq))
+      (param $name (ref eq)) (result (ref eq))
       (return_call $file_exists
-         (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
+         (call $unwrap (call $caml_jsstring_of_string (local.get $name)))))
 
    (data $no_such_file ": No such file or directory")
 
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index a1c006c6cf..3ecbeedfde 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -49,6 +49,10 @@
       (func $caml_copy_int64 (param i64) (result (ref eq))))
    (import "int64" "Int64_val"
       (func $Int64_val (param (ref eq)) (result i64)))
+   (import "fail" "javascript_exception"
+      (tag $javascript_exception (param externref)))
+   (import "sys" "caml_handle_sys_error"
+      (func $caml_handle_sys_error (param externref)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -174,18 +178,27 @@
       (result (ref eq))
       (local $fd i32) (local $flags i32) (local $offset i64)
       (local.set $flags (call $convert_flag_list (local.get $vflags)))
-      (local.set $fd
-         (call $open
-            (call $unwrap (call $caml_jsstring_of_string (local.get $path)))
-            (local.get $flags)
-            (i31.get_u (ref.cast (ref i31) (local.get $perm)))))
-      (if (i32.and (local.get $flags) (i32.const 4)) ;; O_APPEND
-         (then (local.set $offset (call $file_size (local.get $fd)))))
+      (try
+         (do
+            (local.set $fd
+               (call $open
+                  (call $unwrap
+                     (call $caml_jsstring_of_string (local.get $path)))
+                  (local.get $flags)
+                  (i31.get_u (ref.cast (ref i31) (local.get $perm)))))
+            (if (i32.and (local.get $flags) (i32.const 4)) ;; O_APPEND
+               (then (local.set $offset (call $file_size (local.get $fd))))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))))
       (call $initialize_fd_offset (local.get $fd) (local.get $offset))
       (i31.new (local.get $fd)))
 
    (func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
-      (call $close (i31.get_u (ref.cast (ref i31) (local.get 0))))
+      (try
+         (do
+            (call $close (i31.get_u (ref.cast (ref i31) (local.get 0)))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))))
       (i31.new (i32.const 0)))
 
    (func (export "caml_ml_set_channel_name")
@@ -254,23 +267,27 @@
       (local.set $fd (struct.get $channel $fd (local.get $ch)))
       (local.set $offset
          (array.get $offset_array (global.get $fd_offsets) (local.get $fd)))
-      (local.set $n
-         (if (result i32)
-             (array.get_u $string (global.get $fd_seeked) (local.get $fd))
-            (then
-               (call $read
-                  (local.get $fd)
-                  (struct.get $channel $buffer (local.get $ch))
-                  (local.get $pos)
-                  (local.get $len)
-                  (local.get $offset)))
-            (else
-               (call $read'
-                  (local.get $fd)
-                  (struct.get $channel $buffer (local.get $ch))
-                  (local.get $pos)
-                  (local.get $len)
-                  (ref.null noextern)))))
+      (try
+         (do
+            (local.set $n
+               (if (result i32)
+                   (array.get_u $string (global.get $fd_seeked) (local.get $fd))
+                  (then
+                     (call $read
+                        (local.get $fd)
+                        (struct.get $channel $buffer (local.get $ch))
+                        (local.get $pos)
+                        (local.get $len)
+                        (local.get $offset)))
+                  (else
+                     (call $read'
+                        (local.get $fd)
+                        (struct.get $channel $buffer (local.get $ch))
+                        (local.get $pos)
+                        (local.get $len)
+                        (ref.null noextern))))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))))
       (array.set $offset_array
          (global.get $fd_offsets) (local.get $fd)
          (i64.add (local.get $offset) (i64.extend_i32_u (local.get $n))))
@@ -635,23 +652,28 @@
             (local.set $offset
                (array.get $offset_array
                   (global.get $fd_offsets) (local.get $fd)))
-            (local.set $written
-               (if (result i32)
-                   (array.get_u $string (global.get $fd_seeked) (local.get $fd))
-                  (then
-                     (call $write
-                        (local.get $fd)
-                        (local.get $buf)
-                        (i32.const 0)
-                        (local.get $towrite)
-                        (local.get $offset)))
-                  (else
-                     (call $write'
-                        (local.get $fd)
-                        (local.get $buf)
-                        (i32.const 0)
-                        (local.get $towrite)
-                        (ref.null noextern)))))
+            (try
+               (do
+                  (local.set $written
+                     (if (result i32)
+                         (array.get_u $string (global.get $fd_seeked)
+                            (local.get $fd))
+                        (then
+                           (call $write
+                              (local.get $fd)
+                              (local.get $buf)
+                              (i32.const 0)
+                              (local.get $towrite)
+                              (local.get $offset)))
+                        (else
+                           (call $write'
+                              (local.get $fd)
+                              (local.get $buf)
+                              (i32.const 0)
+                              (local.get $towrite)
+                              (ref.null noextern))))))
+               (catch $javascript_exception
+                  (call $caml_handle_sys_error (pop externref))))
             (array.set $offset_array
                (global.get $fd_offsets) (local.get $fd)
                (i64.add
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 9bcaf951af..405e39ea40 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -280,11 +280,12 @@
          getenv:(n)=>isNode?process.env[n]:null,
          system:(c)=>{
            var res = require('child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
-           return res.signal?128:res.status
+           if(res.error)throw error; return res.signal?255:res.status
          },
          time:()=>performance.now(),
          getcwd:()=>isNode?process.cwd():'/static',
          chdir:(x)=>process.chdir(x),
+         mkdir:(p,m)=>fs.mkdirSync(p,m),
          unlink:(p)=>fs.unlinkSync(p),
          readdir:(p)=>fs.readdirSync(p),
          file_exists:(p)=>+fs.existsSync(p),
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 85f6a9ad9c..da3686bb10 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -13,6 +13,11 @@
       (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
    (import "jslib" "caml_js_to_string_array"
       (func $caml_js_to_string_array (param $a (ref extern)) (result (ref eq))))
+   (import "jslib" "caml_js_meth_call"
+      (func $caml_js_meth_call
+         (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "fail" "caml_raise_sys_error"
+      (func $caml_raise_sys_error (param (ref eq))))
    (import "fail" "caml_raise_not_found" (func $caml_raise_not_found))
    (import "bindings" "argv" (func $argv (result (ref extern))))
    (import "bindings" "system" (func $system (param anyref) (result (ref eq))))
@@ -22,6 +27,8 @@
       (func $array_length (param (ref extern)) (result i32)))
    (import "bindings" "array_get"
       (func $array_get (param (ref extern)) (param i32) (result anyref)))
+   (import "fail" "javascript_exception"
+      (tag $javascript_exception (param externref)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -62,8 +69,14 @@
    (func (export "caml_sys_system_command")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (return_call $system
-         (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
+      (try
+         (do
+            (return
+               (call $system
+                  (call $unwrap (call $caml_jsstring_of_string (local.get 0))))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))
+            (return (ref.i31 (i32.const 0))))))
 
    (func (export "caml_sys_random_seed")
       (param (ref eq)) (result (ref eq))
@@ -154,4 +167,12 @@
       (param (ref eq)) (result (ref eq))
       (i31.new (global.get $caml_runtime_warnings)))
 
+   (func $caml_handle_sys_error (export "caml_handle_sys_error")
+      (param $exn externref)
+      (call $caml_raise_sys_error
+         (call $caml_string_of_jsstring
+            (call $caml_js_meth_call
+               (call $wrap (extern.internalize (local.get $exn)))
+               (call $wrap (string.const "toString"))
+               (array.new_fixed $block 1 (ref.i31 (i32.const 0)))))))
 )

From a35d8c5512f5937d828a29f86e23caac102bc1a4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 11 Sep 2023 15:21:02 +0200
Subject: [PATCH 128/481] Rename i31.new into ref.i31

---
 compiler/lib/wasm/wa_asm_output.ml      |  2 +-
 compiler/lib/wasm/wa_ast.ml             |  2 +-
 compiler/lib/wasm/wa_code_generation.ml |  8 +--
 compiler/lib/wasm/wa_gc_target.ml       | 18 ++---
 compiler/lib/wasm/wa_wat_output.ml      |  2 +-
 runtime/wasm/array.wat                  | 22 +++---
 runtime/wasm/backtrace.wat              | 20 +++---
 runtime/wasm/bigarray.wat               | 92 ++++++++++++-------------
 runtime/wasm/bigstring.wat              | 20 +++---
 runtime/wasm/compare.wat                | 36 +++++-----
 runtime/wasm/domain.wat                 | 24 +++----
 runtime/wasm/dynlink.wat                |  4 +-
 runtime/wasm/effect.wat                 | 30 ++++----
 runtime/wasm/fail.wat                   |  2 +-
 runtime/wasm/float.wat                  | 12 ++--
 runtime/wasm/fs.wat                     |  6 +-
 runtime/wasm/gc.wat                     | 66 +++++++++---------
 runtime/wasm/hash.wat                   | 12 ++--
 runtime/wasm/int32.wat                  |  2 +-
 runtime/wasm/int64.wat                  |  4 +-
 runtime/wasm/ints.wat                   |  4 +-
 runtime/wasm/io.wat                     | 50 +++++++-------
 runtime/wasm/jslib.wat                  | 40 +++++------
 runtime/wasm/jslib_js_of_ocaml.wat      |  8 +--
 runtime/wasm/lexing.wat                 | 34 ++++-----
 runtime/wasm/marshal.wat                | 34 ++++-----
 runtime/wasm/nat.wat                    | 10 +--
 runtime/wasm/obj.wat                    | 70 +++++++++----------
 runtime/wasm/parsing.wat                | 46 ++++++-------
 runtime/wasm/printexc.wat               |  4 +-
 runtime/wasm/stdlib.wat                 | 10 +--
 runtime/wasm/str.wat                    | 20 +++---
 runtime/wasm/string.wat                 | 32 ++++-----
 runtime/wasm/sync.wat                   | 16 ++---
 runtime/wasm/sys.wat                    | 32 ++++-----
 runtime/wasm/toplevel.wat               |  2 +-
 runtime/wasm/unix.wat                   | 24 +++----
 runtime/wasm/weak.wat                   | 40 +++++------
 38 files changed, 430 insertions(+), 430 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index d6ed147556..0c55a6b7f0 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -303,7 +303,7 @@ module Output () = struct
     | Pop _ -> empty
     | RefFunc _
     | Call_ref _
-    | I31New _
+    | RefI31 _
     | I31Get _
     | ArrayNew _
     | ArrayNewFixed _
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 9db6620715..48b803635b 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -139,7 +139,7 @@ type expression =
   | Pop of value_type
   | RefFunc of var
   | Call_ref of var * expression * expression list
-  | I31New of expression
+  | RefI31 of expression
   | I31Get of signage * expression
   | ArrayNew of var * expression * expression
   | ArrayNewFixed of var * expression list
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 574e0c8f1d..98a91133db 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -208,7 +208,7 @@ let blk l st =
 let cast ?(nullable = false) typ e =
   let* e = e in
   match typ, e with
-  | W.I31, W.I31New _ -> return e
+  | W.I31, W.RefI31 _ -> return e
   | _ -> return (W.RefCast ({ W.nullable; typ }, e))
 
 module Arith = struct
@@ -297,18 +297,18 @@ module Arith = struct
     let* n = n in
     match n with
     | W.I31Get (S, n') -> return n'
-    | _ -> return (W.I31New n)
+    | _ -> return (W.RefI31 n)
 
   let of_int31 n =
     let* n = n in
     match n with
-    | W.I31New (Const (I32 n)) -> return (W.Const (I32 (Int31.wrap n)))
+    | W.RefI31 (Const (I32 n)) -> return (W.Const (I32 (Int31.wrap n)))
     | _ -> return (W.I31Get (S, n))
 end
 
 let is_small_constant e =
   match e with
-  | W.ConstSym _ | W.Const _ | W.I31New (W.Const _) | W.RefFunc _ -> return true
+  | W.ConstSym _ | W.Const _ | W.RefI31 (W.Const _) | W.RefFunc _ -> return true
   | W.GlobalGet (V name) -> global_is_constant name
   | _ -> return false
 
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 66fc2defff..a76f941896 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -379,7 +379,7 @@ end
 module Value = struct
   let value = Type.value
 
-  let unit = return (W.I31New (Const (I32 0l)))
+  let unit = return (W.RefI31 (Const (I32 0l)))
 
   let val_int = Arith.to_int31
 
@@ -387,7 +387,7 @@ module Value = struct
 
   let check_is_not_zero i =
     let* i = i in
-    return (W.UnOp (I32 Eqz, RefEq (i, W.I31New (Const (I32 0l)))))
+    return (W.UnOp (I32 Eqz, RefEq (i, W.RefI31 (Const (I32 0l)))))
 
   let check_is_int i =
     let* i = i in
@@ -453,7 +453,7 @@ module Memory = struct
         l
     in
     let* ty = Type.block_type in
-    return (W.ArrayNewFixed (ty, I31New (Const (I32 (Int32.of_int tag))) :: l))
+    return (W.ArrayNewFixed (ty, RefI31 (Const (I32 (Int32.of_int tag))) :: l))
   (*ZZZ Float array?*)
 
   let wasm_cast ty e =
@@ -625,7 +625,7 @@ module Constant = struct
 
   let rec translate_rec c =
     match c with
-    | Code.Int (Regular, i) -> return (true, W.I31New (Const (I32 i)))
+    | Code.Int (Regular, i) -> return (true, W.RefI31 (Const (I32 i)))
     | Tuple (tag, a, _) ->
         let* ty = Type.block_type in
         let* l =
@@ -639,9 +639,9 @@ module Constant = struct
         in
         let l = List.rev l in
         let l' =
-          List.map ~f:(fun (const, v) -> if const then v else W.I31New (Const (I32 0l))) l
+          List.map ~f:(fun (const, v) -> if const then v else W.RefI31 (Const (I32 0l))) l
         in
-        let c = W.ArrayNewFixed (ty, I31New (Const (I32 (Int32.of_int tag))) :: l') in
+        let c = W.ArrayNewFixed (ty, RefI31 (Const (I32 (Int32.of_int tag))) :: l') in
         if List.exists ~f:(fun (const, _) -> not const) l
         then
           let* c = store_in_global c in
@@ -695,7 +695,7 @@ module Constant = struct
           ( true
           , W.ArrayNewFixed
               ( bl_ty
-              , I31New (Const (I32 (Int32.of_int Obj.double_array_tag)))
+              , RefI31 (Const (I32 (Int32.of_int Obj.double_array_tag)))
                 :: List.map ~f:(fun f -> W.StructNew (ty, [ Const (F64 f) ])) l ) )
     | Int64 i ->
         let* e = Memory.make_int64 (return (W.Const (I64 i))) in
@@ -720,7 +720,7 @@ module Constant = struct
           ~constant:true
           (V name)
           { mut = true; typ = Type.value }
-          (W.I31New (Const (I32 0l)))
+          (W.RefI31 (Const (I32 0l)))
       in
       let* () = register_init_code (instr (W.GlobalSet (V name, c))) in
       return (W.GlobalGet (V name))
@@ -803,7 +803,7 @@ module Closure = struct
                    (W.StructNew
                       ( env_typ
                       , List.init ~len:function_count ~f:(fun _ ->
-                            W.I31New (W.Const (I32 0l)))
+                            W.RefI31 (W.Const (I32 0l)))
                         @ l )))
             else
               let* env = get_closure_env g in
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 45d82125a9..b375d86502 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -270,7 +270,7 @@ let expression_or_instructions ctx in_function =
             :: index f
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
-    | I31New e -> [ List (Atom "i31.new" :: expression e) ]
+    | RefI31 e -> [ List (Atom "ref.i31" :: expression e) ]
     | I31Get (s, e) -> [ List (Atom (signage "i31.get" s) :: expression e) ]
     | ArrayNew (typ, e, e') ->
         [ List (Atom "array.new" :: index typ :: (expression e @ expression e')) ]
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index b8ecb71705..a9abdebe53 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -23,7 +23,7 @@
             (i32.add (local.get $sz) (i32.const 1))))
       ;; ZZZ float array
       (array.set $block (local.get $b) (i32.const 0)
-         (i31.new
+         (ref.i31
             (select (global.get $double_array_tag) (i32.const 0)
                (i32.and
                   (local.get $sz) (ref.test (ref $float) (local.get $v))))))
@@ -42,7 +42,7 @@
       (local $a1 (ref $block)) (local $a2 (ref $block)) (local $len i32)
       (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
       (local.set $a1 (ref.cast (ref $block) (local.get $a)))
-      (local.set $a2 (array.new $block (i31.new (i32.const 0))
+      (local.set $a2 (array.new $block (ref.i31 (i32.const 0))
                         (i32.add (local.get $len) (i32.const 1))))
       (array.set $block (local.get $a2) (i32.const 0)
          (array.get $block (local.get $a1) (i32.const 0)))
@@ -64,17 +64,17 @@
       (local.set $a2 (ref.cast (ref $block) (local.get $va2)))
       (local.set $l2 (array.len (local.get $a2)))
       (local.set $a
-         (array.new $block (i31.new (i32.const 0))
+         (array.new $block (ref.i31 (i32.const 0))
             (i32.sub (i32.add (local.get $l1) (local.get $l2)) (i32.const 1))))
       ;; ZZZ float array
       (array.set $block (local.get $a) (i32.const 0)
-         (i31.new
+         (ref.i31
             (select (global.get $double_array_tag) (i32.const 0)
                (i32.or
                   (ref.eq (array.get $block (local.get $a1) (i32.const 0))
-                     (i31.new (global.get $double_array_tag)))
+                     (ref.i31 (global.get $double_array_tag)))
                   (ref.eq (array.get $block (local.get $a2) (i32.const 0))
-                     (i31.new (global.get $double_array_tag)))))))
+                     (ref.i31 (global.get $double_array_tag)))))))
       (array.copy $block $block
          (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
          (i32.sub (local.get $l1) (i32.const 1)))
@@ -103,16 +103,16 @@
                             (array.get $block (local.get $b) (i32.const 1))))
                       (i32.const 1))))
              (if (ref.eq (array.get $block (local.get $b) (i32.const 0))
-                    (i31.new (global.get $double_array_tag)))
+                    (ref.i31 (global.get $double_array_tag)))
                  (then (local.set $isfloat (i32.const 1))))
              (local.set $l (array.get $block (local.get $b) (i32.const 2)))
              (br $compute_length))))
       (local.set $a
-         (array.new $block (i31.new (i32.const 0)) (local.get $len)))
+         (array.new $block (ref.i31 (i32.const 0)) (local.get $len)))
       (if (local.get $isfloat)
          (then
             (array.set $block (local.get $a) (i32.const 0)
-               (i31.new (global.get $double_array_tag)))))
+               (ref.i31 (global.get $double_array_tag)))))
       (local.set $l (local.get 0))
       (local.set $i (i32.const 1))
       (loop $fill
@@ -147,7 +147,7 @@
          (i32.add
             (i31.get_s (ref.cast (ref i31) (local.get $i1))) (i32.const 1))
          (i31.get_s (ref.cast (ref i31) (local.get $len))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_array_fill")
       (param $a (ref eq)) (param $i (ref eq)) (param $len (ref eq))
@@ -156,5 +156,5 @@
          (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))
          (local.get $v)
          (i31.get_u (ref.cast (ref i31) (local.get $len))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat
index 11c0c8b53a..33a2c962b7 100644
--- a/runtime/wasm/backtrace.wat
+++ b/runtime/wasm/backtrace.wat
@@ -7,19 +7,19 @@
 
    (func (export "caml_get_exception_raw_backtrace")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_backtrace_status")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_convert_raw_backtrace")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_raw_backtrace_next_slot")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $raw_backtrace_slot_err
       "Printexc.get_raw_backtrace_slot: index out of bounds")
@@ -29,24 +29,24 @@
       (call $caml_invalid_argument
           (array.new_data $string $raw_backtrace_slot_err
              (i32.const 0) (i32.const 52)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_convert_raw_backtrace_slot")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_restore_raw_backtrace")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_get_current_callstack")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_ml_debug_info_status")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_record_backtrace") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 9a8daad19d..46c9e83b29 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -584,7 +584,7 @@
                (if (i32.lt_u (local.get $i) (local.get $len))
                   (then
                      (call $ta_set_ui16 (local.get $data) (local.get $i)
-                        (i31.new (call $caml_deserialize_uint_2 (local.get $s))))
+                        (ref.i31 (call $caml_deserialize_uint_2 (local.get $s))))
                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
                      (br $loop))))
             (br $done))
@@ -593,7 +593,7 @@
               (if (i32.lt_u (local.get $i) (local.get $len))
                  (then
                     (call $ta_set_i16 (local.get $data) (local.get $i)
-                       (i31.new (call $caml_deserialize_sint_2 (local.get $s))))
+                       (ref.i31 (call $caml_deserialize_sint_2 (local.get $s))))
                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
                     (br $loop))))
            (br $done))
@@ -602,7 +602,7 @@
              (if (i32.lt_u (local.get $i) (local.get $len))
                 (then
                    (call $ta_set_ui8 (local.get $data) (local.get $i)
-                      (i31.new (call $caml_deserialize_uint_1 (local.get $s))))
+                      (ref.i31 (call $caml_deserialize_uint_1 (local.get $s))))
                    (local.set $i (i32.add (local.get $i) (i32.const 1)))
                    (br $loop))))
           (br $done))
@@ -611,7 +611,7 @@
             (if (i32.lt_u (local.get $i) (local.get $len))
                (then
                   (call $ta_set_i8 (local.get $data) (local.get $i)
-                     (i31.new (call $caml_deserialize_sint_1 (local.get $s))))
+                     (ref.i31 (call $caml_deserialize_sint_1 (local.get $s))))
                   (local.set $i (i32.add (local.get $i) (i32.const 1)))
                   (br $loop))))
          (br $done))
@@ -784,7 +784,7 @@
                  (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                  (return
                     (array.new_fixed $block 3
-                       (i31.new (global.get $double_array_tag))
+                       (ref.i31 (global.get $double_array_tag))
                        (struct.new $float
                           (call $ta_get_f64 (local.get $data) (local.get $i)))
                        (struct.new $float
@@ -794,7 +794,7 @@
                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                 (return
                    (array.new_fixed $block 3
-                      (i31.new (global.get $double_array_tag))
+                      (ref.i31 (global.get $double_array_tag))
                       (struct.new $float
                          (call $ta_get_f32 (local.get $data) (local.get $i)))
                       (struct.new $float
@@ -805,7 +805,7 @@
                   (call $ta_get_i32 (local.get $data) (local.get $i))))
               ;; int
               (return
-                 (i31.new
+                 (ref.i31
                     (call $ta_get_i32 (local.get $data) (local.get $i)))))
              ;; int64
              (local.set $i (i32.shl (local.get $i) (i32.const 1)))
@@ -822,16 +822,16 @@
             (return_call $caml_copy_int32
                (call $ta_get_i32 (local.get $data) (local.get $i))))
            ;; uint16
-           (return (i31.new
+           (return (ref.i31
                       (call $ta_get_ui16 (local.get $data) (local.get $i)))))
           ;; int16
-          (return (i31.new
+          (return (ref.i31
                      (call $ta_get_i16 (local.get $data) (local.get $i)))))
          ;; uint8
-         (return (i31.new
+         (return (ref.i31
                     (call $ta_get_ui8 (local.get $data) (local.get $i)))))
         ;; int8
-        (return (i31.new
+        (return (ref.i31
                    (call $ta_get_i8 (local.get $data) (local.get $i)))))
        ;; float64
        (return (struct.new $float
@@ -947,10 +947,10 @@
          (then (call $caml_invalid_argument
                   (array.new_data $string $Bigarray_dim
                      (i32.const 0) (i32.const 12)))))
-      (i31.new (array.get $int_array (local.get $dim) (local.get $i))))
+      (ref.i31 (array.get $int_array (local.get $dim) (local.get $i))))
 
    (func (export "caml_ba_dim_1") (param (ref eq)) (result (ref eq))
-      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 0))))
+      (return_call $caml_ba_dim (local.get 0) (ref.i31 (i32.const 0))))
 
    (func (export "caml_ba_get_1")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
@@ -980,7 +980,7 @@
          (call $caml_bound_error))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $i) (local.get $v))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_get_2")
       (param $vba (ref eq)) (param $vi (ref eq)) (param $vj (ref eq))
@@ -1054,10 +1054,10 @@
             (call $caml_bound_error)))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $offset) (local.get $v))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_dim_2") (param (ref eq)) (result (ref eq))
-      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 1))))
+      (return_call $caml_ba_dim (local.get 0) (ref.i31 (i32.const 1))))
 
    (func (export "caml_ba_get_3")
       (param $vba (ref eq)) (param $vi (ref eq)) (param $vj (ref eq))
@@ -1165,10 +1165,10 @@
             (call $caml_bound_error)))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $offset) (local.get $v))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_dim_3") (param (ref eq)) (result (ref eq))
-      (return_call $caml_ba_dim (local.get 0) (i31.new (i32.const 2))))
+      (return_call $caml_ba_dim (local.get 0) (ref.i31 (i32.const 2))))
 
    (func $caml_ba_offset
       (param $b (ref $bigarray)) (param $index (ref $int_array)) (result i32)
@@ -1290,7 +1290,7 @@
          (call $caml_ba_offset' (local.get $ba)
             (ref.cast (ref $block) (local.get $index)))
          (local.get $v))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $too_many_indices "Bigarray.slice: too many indices")
 
@@ -1493,7 +1493,7 @@
                         (local.get $f2))
                      (local.set $i (i32.add (local.get $i) (i32.const 2)))
                      (br $loop))))
-            (return (i31.new (i32.const 0))))
+            (return (ref.i31 (i32.const 0))))
            ;; complex32
            (local.set $len (call $ta_length (local.get $data)))
            (local.set $b (ref.cast (ref $block) (local.get $v)))
@@ -1515,7 +1515,7 @@
                        (local.get $f2))
                     (local.set $i (i32.add (local.get $i) (i32.const 2)))
                     (br $loop))))
-           (return (i31.new (i32.const 0))))
+           (return (ref.i31 (i32.const 0))))
           ;; int64
           (local.set $len (call $ta_length (local.get $data)))
           (local.set $l (call $Int64_val (local.get $v)))
@@ -1532,18 +1532,18 @@
                       (local.get $i2))
                    (local.set $i (i32.add (local.get $i) (i32.const 2)))
                    (br $loop))))
-          (return (i31.new (i32.const 0))))
+          (return (ref.i31 (i32.const 0))))
          ;; int32
          (call $ta_fill_int (local.get $data) (call $Int32_val (local.get $v)))
-         (return (i31.new (i32.const 0))))
+         (return (ref.i31 (i32.const 0))))
         ;; int
         (call $ta_fill_int (local.get $data)
            (i31.get_s (ref.cast (ref i31) (local.get $v))))
-        (return (i31.new (i32.const 0))))
+        (return (ref.i31 (i32.const 0))))
        ;; float
        (call $ta_fill_float (local.get $data)
           (struct.get $float 0 (ref.cast (ref $float) (local.get $v))))
-       (return (i31.new (i32.const 0))))
+       (return (ref.i31 (i32.const 0))))
 
    (data $dim_mismatch "Bigarray.blit: dimension mismatch")
 
@@ -1578,7 +1578,7 @@
       (call $ta_blit
          (struct.get $bigarray $ba_data (local.get $src))
          (struct.get $bigarray $ba_data (local.get $dst)))
-     (i31.new (i32.const 0)))
+     (ref.i31 (i32.const 0)))
 
    (data $bad_number_dim "Bigarray.reshape: bad number of dimensions")
    (data $negative_dim "Bigarray.reshape: negative dimension")
@@ -1676,17 +1676,17 @@
             (local.get $vb))))
 
    (func (export "caml_ba_num_dims") (param (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (struct.get $bigarray $ba_num_dims
             (ref.cast (ref $bigarray) (local.get 0)))))
 
    (func (export "caml_ba_kind") (param (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (struct.get $bigarray $ba_kind
             (ref.cast (ref $bigarray) (local.get 0)))))
 
    (func (export "caml_ba_layout") (param (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (struct.get $bigarray $ba_layout
             (ref.cast (ref $bigarray) (local.get 0)))))
 
@@ -1912,7 +1912,7 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (i31.new (i32.or
+      (ref.i31 (i32.or
                   (call $ta_get_ui8 (local.get $data) (local.get $p))
                   (i32.shl (call $ta_get_ui8 (local.get $data)
                               (i32.add (local.get $p) (i32.const 1)))
@@ -2022,8 +2022,8 @@
       (call $ta_set_ui8 (local.get $data) (local.get $p) (local.get $d))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 1))
-         (i31.new (i32.shr_u (i31.get_s (local.get $d)) (i32.const 8))))
-      (i31.new (i32.const 0)))
+         (ref.i31 (i32.shr_u (i31.get_s (local.get $d)) (i32.const 8))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_uint8_set32")
       (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
@@ -2043,17 +2043,17 @@
                 (i32.const 0)))
          (then (call $caml_bound_error)))
       (call $ta_set_ui8 (local.get $data) (local.get $p)
-         (i31.new (local.get $d)))
+         (ref.i31 (local.get $d)))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 1))
-         (i31.new (i32.shr_u (local.get $d) (i32.const 8))))
+         (ref.i31 (i32.shr_u (local.get $d) (i32.const 8))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 2))
-         (i31.new (i32.shr_u (local.get $d) (i32.const 16))))
+         (ref.i31 (i32.shr_u (local.get $d) (i32.const 16))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 3))
-         (i31.new (i32.shr_u (local.get $d) (i32.const 24))))
-      (i31.new (i32.const 0)))
+         (ref.i31 (i32.shr_u (local.get $d) (i32.const 24))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_uint8_set64")
       (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
@@ -2073,29 +2073,29 @@
                 (i32.const 0)))
          (then (call $caml_bound_error)))
       (call $ta_set_ui8 (local.get $data) (local.get $p)
-         (i31.new (i32.wrap_i64 (local.get $d))))
+         (ref.i31 (i32.wrap_i64 (local.get $d))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 1))
-         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 8)))))
+         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 8)))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 2))
-         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 16)))))
+         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 16)))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 3))
-         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 24)))))
+         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 24)))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 4))
-         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
+         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 5))
-         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 40)))))
+         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 40)))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 6))
-         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 48)))))
+         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 48)))))
       (call $ta_set_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 7))
-         (i31.new (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 56)))))
-      (i31.new (i32.const 0)))
+         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 56)))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
       ;; used to convert a typed array to a string
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 194d9d3bff..18527b257d 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -133,9 +133,9 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop (i32.eq (local.get $c1) (local.get $c2)))
                (return
-                  (select (i31.new (i32.const -1)) (i31.new (i32.const 1))
+                  (select (ref.i31 (i32.const -1)) (ref.i31 (i32.const 1))
                      (i32.lt_u (local.get $c1) (local.get $c2)))))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_bigstring_memcmp_string")
       (param $s1 (ref eq)) (param $vpos1 (ref eq))
@@ -162,9 +162,9 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop (i32.eq (local.get $c1) (local.get $c2)))
                (return
-                  (select (i31.new (i32.const -1)) (i31.new (i32.const 1))
+                  (select (ref.i31 (i32.const -1)) (ref.i31 (i32.const 1))
                      (i32.lt_u (local.get $c1) (local.get $c2)))))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_bigstring_memchr")
       (param $s (ref eq)) (param $vc (ref eq))
@@ -181,11 +181,11 @@
                (if (i32.eq (local.get $c)
                       (call $ta_get_ui8 (local.get $d) (local.get $pos)))
                   (then
-                     (return (i31.new (local.get $pos)))))
+                     (return (ref.i31 (local.get $pos)))))
                (local.set $len (i32.sub (local.get $len) (i32.const 1)))
                (local.set $pos (i32.add (local.get $pos) (i32.const 1)))
                (br $loop))))
-     (i31.new (i32.const -1)))
+     (ref.i31 (i32.const -1)))
 
    (export "caml_bigstring_blit_string_to_ba"
       (func $caml_bigstring_blit_bytes_to_ba))
@@ -207,12 +207,12 @@
             (then
                (call $ta_set_ui8 (local.get $d2)
                   (i32.add (local.get $pos2) (local.get $i))
-                  (i31.new
+                  (ref.i31
                      (array.get_u $string (local.get $s1)
                         (i32.add (local.get $pos1) (local.get $i)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_bigstring_blit_ba_to_bytes")
       (param $ba1 (ref eq)) (param $vpos1 (ref eq))
@@ -235,7 +235,7 @@
                      (i32.add (local.get $pos1) (local.get $i))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_bigstring_blit_ba_to_ba")
       (param $ba1 (ref eq)) (param $vpos1 (ref eq))
@@ -253,5 +253,5 @@
          (call $ta_subarray (local.get $d1)
             (local.get $pos1) (i32.add (local.get $pos1) (local.get $len)))
          (local.get $pos2))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 7c7c0cd95d..59f3ed41e4 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -49,7 +49,7 @@
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $dummy_block (ref $block)
-      (array.new $block (i31.new (i32.const 0)) (i32.const 0)))
+      (array.new $block (ref.i31 (i32.const 0)) (i32.const 0)))
 
    (global $default_compare_stack (ref $compare_stack)
       (struct.new $compare_stack (i32.const -1)
@@ -239,7 +239,7 @@
                         (local.set $v2
                            (array.get $block (local.get $b2) (i32.const 1)))
                         (br $loop)))
-                  (i31.new (i32.const 1))))
+                  (ref.i31 (i32.const 1))))
                (block $v2_not_comparable
                   (drop (block $v2_not_custom (result (ref eq))
                      (local.set $c2
@@ -271,7 +271,7 @@
                            (local.set $v1
                               (array.get $block (local.get $b1) (i32.const 1)))
                            (br $loop)))
-                     (i31.new (i32.const 1))))
+                     (ref.i31 (i32.const 1))))
                   (block $v1_not_comparable
                      (drop (block $v1_not_custom (result (ref eq))
                         (local.set $c1
@@ -304,7 +304,7 @@
                      (i31.get_u
                         (ref.cast (ref i31)
                            (array.get $block (local.get $b2) (i32.const 0)))))
-                  (drop (br_if $heterogeneous (i31.new (i32.const 0))
+                  (drop (br_if $heterogeneous (ref.i31 (i32.const 0))
                      (i32.ne (local.get $t1) (local.get $t2))))
                   ;; forward tag
                   (if (i32.eq (local.get $t1) (global.get $forward_tag))
@@ -446,7 +446,7 @@
                   (call $caml_invalid_argument
                      (array.new_data $string $abstract_value
                         (i32.const 0) (i32.const 23)))
-                  (i31.new (i32.const 0))))
+                  (ref.i31 (i32.const 0))))
                ;; ZZZ float array (unboxed)
                (drop (block $v1_not_js (result (ref eq))
                   (local.set $js1
@@ -473,10 +473,10 @@
                         (br_if $next_item
                            (call $equals (local.get $js1) (local.get $js2)))
                         (return (global.get $unordered))))
-                  (br $heterogeneous (i31.new (i32.const 0)))))
+                  (br $heterogeneous (ref.i31 (i32.const 0)))))
                (if (call $caml_is_closure (local.get $v1))
                   (then
-                     (drop (br_if $heterogeneous (i31.new (i32.const 0))
+                     (drop (br_if $heterogeneous (ref.i31 (i32.const 0))
                               (i32.eqz (call $caml_is_closure (local.get $v2)))))
                      (call $clear_compare_stack)
                      (call $caml_invalid_argument
@@ -484,14 +484,14 @@
                            (i32.const 0) (i32.const 25)))))
                (if (call $caml_is_continuation (local.get $v1))
                   (then
-                     (drop (br_if $heterogeneous(i31.new (i32.const 0))
+                     (drop (br_if $heterogeneous(ref.i31 (i32.const 0))
                               (i32.eqz
                                  (call $caml_is_continuation (local.get $v2)))))
                      (call $clear_compare_stack)
                      (call $caml_invalid_argument
                         (array.new_data $string $continuation_value
                            (i32.const 0) (i32.const 27)))))
-               (i31.new (i32.const 0)))) ;; fall through
+               (ref.i31 (i32.const 0)))) ;; fall through
             ;; heterogeneous comparison
             (local.set $t1
                (i31.get_u
@@ -533,20 +533,20 @@
       (local.set $res
          (call $compare_val (local.get $v1) (local.get $v2) (i32.const 1)))
       (if (i32.lt_s (local.get $res) (i32.const 0))
-         (then (return (i31.new (i32.const -1)))))
+         (then (return (ref.i31 (i32.const -1)))))
       (if (i32.gt_s (local.get $res) (i32.const 0))
-         (then (return (i31.new (i32.const 1)))))
-      (i31.new (i32.const 0)))
+         (then (return (ref.i31 (i32.const 1)))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_equal")
       (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (i32.eqz
             (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
 
    (func (export "caml_notequal")
       (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (i32.ne (i32.const 0)
             (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
 
@@ -555,7 +555,7 @@
       (local $res i32)
       (local.set $res
          (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
-      (i31.new
+      (ref.i31
          (i32.and (i32.lt_s (local.get $res) (i32.const 0))
                   (i32.ne (local.get $res) (global.get $unordered)))))
 
@@ -564,17 +564,17 @@
       (local $res i32)
       (local.set $res
          (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))
-      (i31.new
+      (ref.i31
          (i32.and (i32.le_s (local.get $res) (i32.const 0))
                   (i32.ne (local.get $res) (global.get $unordered)))))
 
    (func (export "caml_greaterthan")
       (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new (i32.lt_s (i32.const 0)
+      (ref.i31 (i32.lt_s (i32.const 0)
          (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
 
    (func (export "caml_greaterequal")
       (param $v1 (ref eq)) (param $v2 (ref eq)) (result (ref eq))
-      (i31.new (i32.le_s (i32.const 0)
+      (ref.i31 (i32.le_s (i32.const 0)
          (call $compare_val (local.get $v1) (local.get $v2) (i32.const 0)))))
 )
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index a53c63fe1c..80b31ca773 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -18,9 +18,9 @@
                  (local.get $o))
          (then
             (array.set $block (local.get $b) (i32.const 1) (local.get $n))
-            (i31.new (i32.const 1)))
+            (ref.i31 (i32.const 1)))
          (else
-            (i31.new (i32.const 0)))))
+            (ref.i31 (i32.const 0)))))
 
    (func (export "caml_atomic_load") (param (ref eq)) (result (ref eq))
       (array.get $block (ref.cast (ref $block) (local.get 0)) (i32.const 1)))
@@ -32,7 +32,7 @@
       (local.set $b (ref.cast (ref $block) (local.get $ref)))
       (local.set $old (array.get $block (local.get $b) (i32.const 1)))
       (array.set $block (local.get $b) (i32.const 1)
-         (i31.new (i32.add (i31.get_s (ref.cast (ref i31) (local.get $old)))
+         (ref.i31 (i32.add (i31.get_s (ref.cast (ref i31) (local.get $old)))
                            (i31.get_s (ref.cast (ref i31) (local.get $i))))))
       (local.get $old))
 
@@ -46,17 +46,17 @@
       (local.get $r))
 
    (global $caml_domain_dls (mut (ref eq))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_domain_dls_set") (param $a (ref eq)) (result (ref eq))
       (global.set $caml_domain_dls (local.get $a))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_domain_dls_get") (param (ref eq)) (result (ref eq))
       (global.get $caml_domain_dls))
 
    (global $caml_ml_domain_unique_token (ref eq)
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_ml_domain_unique_token")
       (param (ref eq)) (result (ref eq))
@@ -64,11 +64,11 @@
 
    (func (export "caml_ml_domain_set_name")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_recommended_domain_count")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 1)))
+      (ref.i31 (i32.const 1)))
 
    (global $caml_domain_id (mut i32) (i32.const 0))
    (global $caml_domain_latest_id (mut i32) (i32.const 1))
@@ -80,14 +80,14 @@
       (global.set $caml_domain_latest_id
          (i32.add (local.get $id) (i32.const 1)))
       (local.set $old (global.get $caml_domain_id))
-      (drop (call $caml_callback_1 (local.get $f) (i31.new (i32.const 0))))
+      (drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
       (global.set $caml_domain_id (local.get $old))
       (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
-      (i31.new (local.get $id)))
+      (ref.i31 (local.get $id)))
 
    (func (export "caml_ml_domain_id") (param (ref eq)) (result (ref eq))
-      (i31.new (global.get $caml_domain_id)))
+      (ref.i31 (global.get $caml_domain_id)))
 
    (func (export "caml_ml_domain_cpu_relax") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/dynlink.wat b/runtime/wasm/dynlink.wat
index 59fc84c90a..f717aaf8e2 100644
--- a/runtime/wasm/dynlink.wat
+++ b/runtime/wasm/dynlink.wat
@@ -5,11 +5,11 @@
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_dynlink_close_lib"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_dynlink_lookup_symbol")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_dynlink_lookup_symbol"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 3614eb780a..97d8260a6d 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -119,11 +119,11 @@
                   (string.const "Effect.Unhandled")))
             (local.get $eff)))
       (call $caml_raise_constant
-         (array.new_fixed $block 3 (i31.new (i32.const 248))
+         (array.new_fixed $block 3 (ref.i31 (i32.const 248))
             (array.new_data $string $effect_unhandled
                (i32.const 0) (i32.const 16))
-            (call $caml_fresh_oo_id (i31.new (i32.const 0)))))
-      (i31.new (i32.const 0)))
+            (call $caml_fresh_oo_id (ref.i31 (i32.const 0)))))
+      (ref.i31 (i32.const 0)))
 
    (func $uncaught_effect_handler
       (param $eff (ref eq)) (param $cont (ref eq)) (param $k (ref eq))
@@ -141,7 +141,7 @@
             (local.get $eff))
          (local.get $k')
          (struct.get $cont $cont_func (local.get $k')))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $dummy_fun (param (ref eq)) (param (ref eq)) (result (ref eq))
       (unreachable))
@@ -152,8 +152,8 @@
    (global $stack (mut (ref null $fiber))
       (struct.new $fiber
          (struct.new $handlers
-            (i31.new (i32.const 0))
-            (i31.new (i32.const 0))
+            (ref.i31 (i32.const 0))
+            (ref.i31 (i32.const 0))
             (struct.new $closure_3
                (ref.func $dummy_fun)
                (ref.func $uncaught_effect_handler)))
@@ -212,7 +212,7 @@
       (result (ref eq))
       (local $k (ref $cont))
       (local $pair (ref $pair))
-      (if (ref.eq (local.get $stack) (i31.new (i32.const 0)))
+      (if (ref.eq (local.get $stack) (ref.i31 (i32.const 0)))
          (then
             (call $caml_raise_constant
                (ref.as_non_null
@@ -353,7 +353,7 @@
             (br_on_null $used (struct.get $continuation 0 (local.get $cont))))
          (struct.set $continuation 0 (local.get $cont) (ref.null eq))
          (return (local.get $stack)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_continuation_use_and_update_handler_noexc")
       (param $cont (ref eq)) (param $hval (ref eq)) (param $hexn (ref eq))
@@ -366,12 +366,12 @@
                (local.get $stack))
             (struct.new $handlers
                (local.get $hval) (local.get $hexn) (local.get $heff)))
-         (i31.new (i32.const 0))))
+         (ref.i31 (i32.const 0))))
       (local.get $stack))
 
    (func (export $caml_get_continuation_callstack)
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_is_continuation") (param (ref eq)) (result i32)
       (ref.test (ref $continuation) (local.get 0)))
@@ -415,7 +415,7 @@
    (func (export "caml_push_trap") (param $h (ref eq)) (result (ref eq))
       (global.set $exn_stack
          (struct.new $exn_stack (local.get $h) (global.get $exn_stack)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $raise_exception
       (param $exn (ref eq)) (param (ref eq)) (result (ref eq))
@@ -501,11 +501,11 @@
    (global $default_fiber_stack (ref null $cps_fiber)
       (struct.new $cps_fiber
          (struct.new $handlers
-            (i31.new (i32.const 0)) (i31.new (i32.const 0))
+            (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
             (struct.new $cps_closure_3
                (ref.func $dummy_cps_fun)
                (ref.func $cps_uncaught_effect_handler)))
-         (i31.new (i32.const 0))
+         (ref.i31 (i32.const 0))
          (ref.null $exn_stack)
          (ref.null $cps_fiber)))
 
@@ -621,7 +621,7 @@
          (ref.as_non_null
             (call $caml_named_value
                (string.const "Effect.Continuation_already_resumed"))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_perform_effect")
       (param $eff (ref eq)) (param $vcont (ref eq)) (param $k0 (ref eq))
@@ -703,7 +703,7 @@
                (struct.get $continuation 0
                   (ref.cast (ref $continuation) (local.get $k))))
             (local.get $ms)))
-      (call $raise_unhandled (local.get $eff) (i31.new (i32.const 0))))
+      (call $raise_unhandled (local.get $eff) (ref.i31 (i32.const 0))))
 
    (func (export "caml_cps_initialize_effects")
       (global.set $caml_trampoline_ref (ref.func $caml_trampoline)))
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 43d39a7564..0dc30649bb 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -16,7 +16,7 @@
       (param $tag (ref eq)) (param $arg (ref eq))
       (throw $ocaml_exception
          (array.new_fixed $block 3
-            (i31.new (i32.const 0)) (local.get $tag) (local.get $arg))))
+            (ref.i31 (i32.const 0)) (local.get $tag) (local.get $arg))))
 
    (global $OUT_OF_MEMORY_EXN i32 (i32.const 0))
 
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index dcf91cf54b..955bca78a1 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -667,7 +667,7 @@
       (local $a f64)
       (local.set $a
          (f64.abs (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
-      (i31.new
+      (ref.i31
          (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
             (then
                (if (result i32) (f64.lt (local.get $a) (f64.const infinity))
@@ -699,7 +699,7 @@
          (else ;; zero or nan
             (local.set $i (local.get $x))
             (local.set $f (local.get $x))))
-      (array.new_fixed $block 3 (i31.new (i32.const 0))
+      (array.new_fixed $block 3 (ref.i31 (i32.const 0))
          (struct.new $float (local.get $f)) (struct.new $float (local.get $i))))
 
    (func $ldexp (param $x f64) (param $n i32) (result f64)
@@ -774,12 +774,12 @@
       (local.set $r
          (call $frexp
             (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
-      (array.new_fixed $block 3 (i31.new (i32.const 0))
+      (array.new_fixed $block 3 (ref.i31 (i32.const 0))
          (struct.new $float (tuple.extract 0 (local.get $r)))
-         (i31.new (tuple.extract 1 (local.get $r)))))
+         (ref.i31 (tuple.extract 1 (local.get $r)))))
 
    (func (export "caml_signbit_float") (param (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (i32.wrap_i64
             (i64.shr_u
                (i64.reinterpret_f64
@@ -850,7 +850,7 @@
       (local $x f64) (local $y f64)
       (local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
       (local.set $y (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
-      (i31.new
+      (ref.i31
          (i32.add
             (i32.sub (f64.gt (local.get $x) (local.get $y))
                      (f64.lt (local.get $x) (local.get $y)))
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index 24ef6e47bb..27e5526514 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -62,7 +62,7 @@
                         (call $caml_jsstring_of_string (local.get $name)))))))
          (catch $javascript_exception
             (call $caml_handle_sys_error (pop externref))
-            (return (i31.new (i32.const 0))))))
+            (return (ref.i31 (i32.const 0))))))
 
    (func (export "caml_sys_remove")
       (param $name (ref eq)) (result (ref eq))
@@ -113,8 +113,8 @@
       ;; ZZZ
       (call $log_js (string.const "caml_read_file_content"))
       (call $caml_raise_no_such_file (local.get 0))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_fs_init") (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat
index 8dac52a4f1..58daf87379 100644
--- a/runtime/wasm/gc.wat
+++ b/runtime/wasm/gc.wat
@@ -5,21 +5,21 @@
    (type $block (array (mut (ref eq))))
 
    (func (export "caml_gc_minor") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_major") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_full_major") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_compaction") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_counters") (param (ref eq)) (result (ref eq))
       (local $f (ref eq))
       (local.set $f (struct.new $float (f64.const 0)))
-      (array.new_fixed $block 4 (i31.new (i32.const 0))
+      (array.new_fixed $block 4 (ref.i31 (i32.const 0))
          (local.get $f) (local.get $f) (local.get $f)))
 
    (export "caml_gc_quick_stat" (func $caml_gc_stat))
@@ -27,47 +27,47 @@
       (param (ref eq)) (result (ref eq))
       (local $f (ref eq))
       (local.set $f (struct.new $float (f64.const 0)))
-      (array.new_fixed $block 18 (i31.new (i32.const 0))
+      (array.new_fixed $block 18 (ref.i31 (i32.const 0))
          (local.get $f) (local.get $f) (local.get $f)
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))))
 
    (func (export "caml_gc_set") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_get") (param (ref eq)) (result (ref eq))
       (array.new_fixed $block 12
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))
-         (i31.new (i32.const 0)) (i31.new (i32.const 0))))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))
+         (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0))))
 
    (func (export "caml_gc_huge_fallback_count")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_major_slice")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_major_bucket")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_major_credit")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_minor_free")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_gc_minor_words")
       (param (ref eq)) (result (ref eq))
@@ -75,29 +75,29 @@
 
    (func (export "caml_final_register")
       (param (ref eq) (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_final_register_called_without_value")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ Use FinalizationRegistry?
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_final_release") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_memprof_start")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_memprof_set") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_memprof_stop") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_eventlog_pause") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_eventlog_resume") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index c873b01f6d..69059a11f7 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -144,7 +144,7 @@
    (global $MAX_FORWARD_DEREFERENCE i32 (i32.const 1000))
 
    (global $caml_hash_queue (ref $block)
-      (array.new $block (i31.new (i32.const 0)) (global.get $HASH_QUEUE_SIZE)))
+      (array.new $block (ref.i31 (i32.const 0)) (global.get $HASH_QUEUE_SIZE)))
 
    (func (export "caml_hash")
       (param $count (ref eq)) (param $limit (ref eq)) (param $seed (ref eq))
@@ -220,7 +220,7 @@
                                        (ref.eq
                                           (array.get $block (local.get $b)
                                              (i32.const 0))
-                                          (i31.new (global.get $forward_tag)))))
+                                          (ref.i31 (global.get $forward_tag)))))
                                  (local.set $i
                                     (i32.add (local.get $i) (i32.const 1)))
                                  (br_if $loop
@@ -286,19 +286,19 @@
                            (string.hash
                               (br_on_cast_fail $not_jsstring anyref (ref string)
                                  (local.get $str)))))
-                     (i31.new (i32.const 0))))
+                     (ref.i31 (i32.const 0))))
                   ;; closures and continuations and other js values are ignored
                   (br $loop)))))
       ;; clear the queue to avoid a memory leak
       (array.fill $block (global.get $caml_hash_queue)
-         (i32.const 0) (i31.new (i32.const 0)) (local.get $wr))
-      (i31.new (i32.and (call $caml_hash_mix_final (local.get $h))
+         (i32.const 0) (ref.i31 (i32.const 0)) (local.get $wr))
+      (ref.i31 (i32.and (call $caml_hash_mix_final (local.get $h))
                         (i32.const 0x3FFFFFFF))))
 
    (func (export "caml_string_hash")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $h i32)
-      (i31.new
+      (ref.i31
          (i32.and
             (call $caml_hash_mix_final
                (call $caml_hash_mix_string
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 0814d0ccc8..43e322330e 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -111,7 +111,7 @@
          (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
       (local.set $i2
          (struct.get $int32 1 (ref.cast (ref $int32) (local.get 1))))
-      (i31.new (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
+      (ref.i31 (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
                         (i32.lt_s (local.get $i1) (local.get $i2)))))
 
    (global $nativeint_ops (export "nativeint_ops") (ref $custom_operations)
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 4840182c4e..19ff60422d 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -106,7 +106,7 @@
          (struct.get $int64 1 (ref.cast (ref $int64) (local.get 0))))
       (local.set $i2
          (struct.get $int64 1 (ref.cast (ref $int64) (local.get 1))))
-      (i31.new (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
+      (ref.i31 (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
                         (i64.lt_s (local.get $i1) (local.get $i2)))))
 
    (global $INT64_ERRMSG (ref $string)
@@ -176,7 +176,7 @@
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ does not really make sense
       (call $log_js (string.const "caml_int64_create_lo_mi_hi"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $format_int64_default (param $d i64) (result (ref eq))
       (local $s (ref $string))
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index bd2dc1ffd2..c0e1082095 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -147,14 +147,14 @@
 
    (func (export "caml_int_of_string")
       (param $v (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (call $parse_int
             (local.get $v) (i32.const 31) (global.get $INT_ERRMSG))))
 
    (func (export "caml_bswap16") (param (ref eq)) (result (ref eq))
       (local $x i32)
       (local.set $x (i31.get_s (ref.cast (ref i31) (local.get 0))))
-      (i31.new
+      (ref.i31
          (i32.or
             (i32.shl (i32.and (local.get $x) (i32.const 0xFF)) (i32.const 8))
             (i32.and
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 3ecbeedfde..32ab0d479e 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -191,7 +191,7 @@
          (catch $javascript_exception
             (call $caml_handle_sys_error (pop externref))))
       (call $initialize_fd_offset (local.get $fd) (local.get $offset))
-      (i31.new (local.get $fd)))
+      (ref.i31 (local.get $fd)))
 
    (func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
       (try
@@ -199,11 +199,11 @@
             (call $close (i31.get_u (ref.cast (ref i31) (local.get 0)))))
          (catch $javascript_exception
             (call $caml_handle_sys_error (pop externref))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_set_channel_name")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_out_channels_list")
       (param (ref eq)) (result (ref eq))
@@ -222,7 +222,7 @@
          (i32.const 0)))
 
    (global $caml_stderr (export "caml_stderr")
-      (mut (ref eq)) (i31.new (i32.const 0)))
+      (mut (ref eq)) (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_open_descriptor_out")
       (param $fd (ref eq)) (result (ref eq))
@@ -238,7 +238,7 @@
             (global.get $IO_BUFFER_SIZE)
             (i32.const 0)))
       (call $register_channel (local.get $res))
-      (if (ref.eq (local.get $fd) (i31.new (i32.const 2)))
+      (if (ref.eq (local.get $fd) (ref.i31 (i32.const 2)))
          (then
             (global.set $caml_stderr (local.get $res))))
       (local.get $res))
@@ -257,7 +257,7 @@
             (struct.set $channel $fd (local.get $ch) (i32.const -1))
             (call $unregister_channel (local.get $ch))
             (call $close (local.get $fd))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $caml_do_read
       (param $ch (ref $channel)) (param $pos i32) (param $len i32) (result i32)
@@ -413,7 +413,7 @@
          (local.get $s) (local.get $pos) (local.get $len))
       (struct.set $channel $curr (local.get $ch)
          (i32.add (local.get $curr) (local.get $len)))
-      (i31.new (local.get $len)))
+      (ref.i31 (local.get $len)))
 
    (func $caml_getch (param $ch (ref $channel)) (result i32)
       (local $curr i32)
@@ -428,7 +428,7 @@
 
    (func (export "caml_ml_input_char")
       (param $ch (ref eq)) (result (ref eq))
-      (i31.new (call $caml_getch (ref.cast (ref $channel) (local.get $ch)))))
+      (ref.i31 (call $caml_getch (ref.cast (ref $channel) (local.get $ch)))))
 
    (func (export "caml_ml_input_int")
       (param $vch (ref eq)) (result (ref eq))
@@ -443,13 +443,13 @@
          (i32.or (local.get $res)
             (i32.shl (call $caml_getch (local.get $ch)) (i32.const 8))))
       (return
-         (i31.new (i32.or (local.get $res) (call $caml_getch (local.get $ch))))))
+         (ref.i31 (i32.or (local.get $res) (call $caml_getch (local.get $ch))))))
 
    (func (export "caml_ml_pos_in")
       (param $vch (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
-      (i31.new
+      (ref.i31
          (i32.sub
             (i32.wrap_i64
                (array.get $offset_array
@@ -477,7 +477,7 @@
       (param $vch (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
-      (i31.new
+      (ref.i31
          (i32.add
             (i32.wrap_i64
                (array.get $offset_array
@@ -524,7 +524,7 @@
                (i32.const 1))
             (struct.set $channel $curr (local.get $ch) (i32.const 0))
             (struct.set $channel $max (local.get $ch) (i32.const 0))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_seek_in")
       (param $ch (ref eq)) (param $dest (ref eq)) (result (ref eq))
@@ -550,7 +550,7 @@
             (i31.get_s (ref.cast (ref i31) (local.get $voffset)))))
       (array.set $string (global.get $fd_seeked)
          (struct.get $channel $fd (local.get $ch)) (i32.const 1))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_seek_out_64")
       (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
@@ -564,7 +564,7 @@
          (call $Int64_val (local.get $voffset)))
       (array.set $string (global.get $fd_seeked)
          (struct.get $channel $fd (local.get $ch)) (i32.const 1))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_input_scan_line")
       (param $vch (ref eq)) (result (ref eq))
@@ -591,7 +591,7 @@
                       (struct.get $channel $size (local.get $ch)))
                   (then
                      (return
-                        (i31.new
+                        (ref.i31
                            (i32.sub (struct.get $channel $curr (local.get $ch))
                               (struct.get $channel $size (local.get $ch)))))))
                (local.set $n
@@ -604,7 +604,7 @@
                (if (i32.eqz (local.get $n))
                   (then
                      (return
-                        (i31.new
+                        (ref.i31
                            (i32.sub (struct.get $channel $curr (local.get $ch))
                               (struct.get $channel $max (local.get $ch)))))))
                (struct.set $channel $max (local.get $ch)
@@ -615,7 +615,7 @@
                   (local.get $p)))
             (then
                (return
-                  (i31.new
+                  (ref.i31
                      (i32.add (i32.const 1)
                         (i32.sub (local.get $p)
                            (struct.get $channel $curr (local.get $ch))))))))
@@ -639,7 +639,7 @@
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (if (i32.ne (struct.get $channel $fd (local.get $ch)) (i32.const -1))
          (then (call $caml_flush (local.get $ch))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $caml_flush_partial (param $ch (ref $channel)) (result i32)
       (local $towrite i32) (local $written i32) (local $fd i32)
@@ -746,7 +746,7 @@
                (local.set $len (i32.sub (local.get $len) (local.get $written)))
                (br $loop))))
       (call $caml_flush_if_unbuffered (local.get $ch))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $caml_putch (param $ch (ref $channel)) (param $c $i32)
       (local $curr i32)
@@ -765,7 +765,7 @@
       (call $caml_putch (ref.cast (ref $channel) (local.get $ch))
          (i31.get_u (ref.cast (ref i31) (local.get 1))))
       (call $caml_flush_if_unbuffered (local.get $ch))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_output_int")
       (param $vch (ref eq)) (param $vn (ref eq)) (result (ref eq))
@@ -780,10 +780,10 @@
          (i32.shr_u (local.get $n) (i32.const 8)))
       (call $caml_putch (local.get $ch) (local.get $n))
       (call $caml_flush_if_unbuffered (local.get $ch))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_is_buffered") (param $ch (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (i32.eqz
             (struct.get $channel $unbuffered
                (ref.cast (ref $channel) (local.get $ch))))))
@@ -799,17 +799,17 @@
             (struct.set $channel $unbuffered (local.get $ch) (i32.const 1))
             (if (i32.ne (struct.get $channel $fd (local.get $ch)) (i32.const -1))
                (then (call $caml_flush (local.get $ch))))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_set_channel_refill")
       (param (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "caml_ml_set_channel_refill"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_channel_size") (param (ref eq)) (result (ref eq))
       ;; ZZZ check for overflow
-      (i31.new
+      (ref.i31
          (i32.wrap_i64
             (call $file_size (call $caml_ml_get_channel_fd (local.get 0))))))
 
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 57ea8b51b8..e097a0c126 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -90,12 +90,12 @@
 
    (func (export "caml_js_equals")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $equals
+      (ref.i31 (call $equals
                   (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
 
    (func (export "caml_js_strict_equals")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $strict_equals
+      (ref.i31 (call $strict_equals
                   (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
 
    ;; ZZZ We should generate JavaScript code instead of using 'eval'
@@ -123,7 +123,7 @@
             (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))))
 
    (func (export "caml_js_to_bool") (param (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (call $to_bool (struct.get $js 0 (ref.cast (ref $js) (local.get 0))))))
 
    (func (export "caml_js_from_bool") (param (ref eq)) (result (ref eq))
@@ -132,7 +132,7 @@
 
   (func (export "caml_js_pure_expr")
      (param $f (ref eq)) (result (ref eq))
-     (return_call $caml_callback_1 (local.get $f) (i31.new (i32.const 0))))
+     (return_call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
 
    (func (export "caml_js_fun_call")
       (param $f (ref eq)) (param $args (ref eq)) (result (ref eq))
@@ -176,7 +176,7 @@
             (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (call $set (call $unwrap (local.get 0)) (call $unwrap (local.get 1))
          (call $unwrap (local.get 2)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_js_delete")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
@@ -184,11 +184,11 @@
          (then
             (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (call $delete (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_js_instanceof")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $instanceof
+      (ref.i31 (call $instanceof
                   (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
 
    (func (export "caml_js_typeof")
@@ -211,7 +211,7 @@
       (param $o (ref eq)) (param $f (ref eq)) (result (ref eq))
       (call $iter_props
          (call $unwrap (local.get $o)) (call $unwrap (local.get $f)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_js_object")
       (param (ref eq)) (result (ref eq))
@@ -266,7 +266,7 @@
          (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
       (local.set $l (call $array_length (local.get $a)))
       (local.set $a'
-         (array.new $block (i31.new (i32.const 0))
+         (array.new $block (ref.i31 (i32.const 0))
             (i32.add (local.get $l) (i32.const 1))))
       (local.set $i (i32.const 0))
       (loop $loop
@@ -284,7 +284,7 @@
       (local $a' (ref $block)) (local $l i32) (local $i i32)
       (local.set $l (call $array_length (local.get $a)))
       (local.set $a'
-         (array.new $block (i31.new (i32.const 0))
+         (array.new $block (ref.i31 (i32.const 0))
             (i32.add (local.get $l) (i32.const 1))))
       (local.set $i (i32.const 0))
       (loop $loop
@@ -355,7 +355,7 @@
                   (call $caml_callback_1 (local.get $acc)
                      (call $wrap
                         (call $get (local.get $args)
-                           (i31.new (local.get $i))))))
+                           (ref.i31 (local.get $i))))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop
                   (i32.eqz (call $caml_is_last_arg (local.get $f))))))
@@ -371,7 +371,7 @@
                            (call $caml_callback_1 (local.get $acc)
                               (call $wrap
                                  (call $get (local.get $args)
-                                    (i31.new (local.get $i))))))
+                                    (ref.i31 (local.get $i))))))
                         (local.set $i (i32.add (local.get $i) (i32.const 1)))
                         (br $loop)))))
             (if (local.get $kind)
@@ -551,12 +551,12 @@
          (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
       (local.set $len (call $array_length (local.get $a)))
       (local.set $i (i32.const 0))
-      (local.set $l (i31.new (i32.const 0)))
+      (local.set $l (ref.i31 (i32.const 0)))
       (loop $loop
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
                (local.set $l
-                  (array.new_fixed $block 3 (i31.new (i32.const 0))
+                  (array.new_fixed $block 3 (ref.i31 (i32.const 0))
                      (call $wrap
                         (call $array_get (local.get $a) (local.get $i)))
                      (local.get $l)))
@@ -570,11 +570,11 @@
       ;; ZZZ special case for stack overflows?
       (block $undef
          (return
-            (array.new_fixed $block 3 (i31.new (i32.const 0))
+            (array.new_fixed $block 3 (ref.i31 (i32.const 0))
                (br_on_null $undef
                   (call $caml_named_value (string.const "jsError")))
                (call $wrap (local.get $exn)))))
-      (array.new_fixed $block 3 (i31.new (i32.const 0))
+      (array.new_fixed $block 3 (ref.i31 (i32.const 0))
          (call $caml_failwith_tag)
          (call $caml_string_of_jsstring
             (call $wrap
@@ -588,22 +588,22 @@
       (local $exn (ref $block))
       (local.set $exn (ref.cast (ref $block) (local.get $0)))
       (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
-                  (i31.new (i32.const 0)))
+                  (ref.i31 (i32.const 0)))
          (then
             (if (ref.eq (array.get $block (local.get $exn) (i32.const 1))
                    (call $caml_named_value (string.const "jsError")))
                (then
                   (return
-                     (array.new_fixed $block 2 (i31.new (i32.const 0))
+                     (array.new_fixed $block 2 (ref.i31 (i32.const 0))
                         (array.get $block (local.get $exn) (i32.const 2))))))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_js_error_of_exception")
       (param (ref eq)) (result (ref eq))
       (local $exn (ref $block))
       (local.set $exn (ref.cast (ref $block) (local.get $0)))
       (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
-                  (i31.new (i32.const 0)))
+                  (ref.i31 (i32.const 0)))
          (then
             (if (ref.eq (array.get $block (local.get $exn) (i32.const 1))
                    (call $caml_named_value (string.const "jsError")))
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index 80330762ff..168b362c02 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -18,7 +18,7 @@
    (type $block (array (mut (ref eq))))
 
    (func (export "caml_js_on_ie") (param (ref eq)) (result (ref eq))
-      (i31.new (call $caml_js_on_ie)))
+      (ref.i31 (call $caml_js_on_ie)))
 
    (func (export "caml_js_html_escape") (param (ref eq)) (result (ref eq))
       (return_call $wrap
@@ -29,14 +29,14 @@
          (call $caml_js_html_entities (call $unwrap (local.get 0)))))
 
    (func (export "caml_js_get_console") (param (ref eq)) (result (ref eq))
-      (return_call $caml_js_get (call $caml_js_global (i31.new (i32.const 0)))
+      (return_call $caml_js_get (call $caml_js_global (ref.i31 (i32.const 0)))
          (call $wrap (string.const "console"))))
 
    (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
       (return_call $caml_js_new
          (call $caml_js_get
-            (call $caml_js_global (i31.new (i32.const 0)))
+            (call $caml_js_global (ref.i31 (i32.const 0)))
             (call $wrap (string.const "XMLHttpRequest")))
          (call $caml_js_from_array
-            (array.new_fixed $block 1 (i31.new (i32.const 0))))))
+            (array.new_fixed $block 1 (ref.i31 (i32.const 0))))))
 )
diff --git a/runtime/wasm/lexing.wat b/runtime/wasm/lexing.wat
index 509923c11b..03e2c37891 100644
--- a/runtime/wasm/lexing.wat
+++ b/runtime/wasm/lexing.wat
@@ -70,7 +70,7 @@
             (array.set $block (local.get $lexbuf) (global.get $lex_start_pos)
                (local.get $vpos))
             (array.set $block (local.get $lexbuf) (global.get $lex_last_action)
-               (i31.new (i32.const -1))))
+               (ref.i31 (i32.const -1))))
          (else
             (local.set $state (i32.sub (i32.const -1) (local.get $state)))))
       (local.set $lex_base
@@ -95,7 +95,7 @@
          (local.set $base (call $get (local.get $lex_base) (local.get $state)))
          (if (i32.lt_s (local.get $base) (i32.const 0))
             (then
-               (return (i31.new (i32.sub (i32.const -1) (local.get $base))))))
+               (return (ref.i31 (i32.sub (i32.const -1) (local.get $base))))))
          (local.set $backtrk
             (call $get (local.get $lex_backtrk) (local.get $state)))
          (if (i32.ge_s (local.get $backtrk) (i32.const 0))
@@ -105,7 +105,7 @@
                      (global.get $lex_curr_pos)))
                (array.set $block (local.get $lexbuf)
                   (global.get $lex_last_action)
-                  (i31.new (local.get $backtrk)))))
+                  (ref.i31 (local.get $backtrk)))))
          (if (i32.ge_s
                 (i31.get_s
                    (ref.cast (ref i31)
@@ -119,10 +119,10 @@
                (if (ref.eq
                       (array.get $block (local.get $lexbuf)
                          (global.get $lex_eof_reached))
-                      (i31.new (i32.const 0)))
+                      (ref.i31 (i32.const 0)))
                   (then
                      (return
-                        (i31.new (i32.sub (i32.const -1) (local.get $state)))))
+                        (ref.i31 (i32.sub (i32.const -1) (local.get $state)))))
                   (else
                      (local.set $c (i32.const 256)))))
             (else
@@ -134,7 +134,7 @@
                (local.set $c
                   (array.get_u $string (local.get $buffer) (local.get $pos)))
                (array.set $block (local.get $lexbuf) (global.get $lex_curr_pos)
-                  (i31.new (i32.add (local.get $pos) (i32.const 1))))))
+                  (ref.i31 (i32.add (local.get $pos) (i32.const 1))))))
          (if (i32.eq
                 (call $get (local.get $lex_check)
                    (i32.add (local.get $base) (local.get $c)))
@@ -154,7 +154,7 @@
                (local.set $action
                   (array.get $block (local.get $lexbuf)
                      (global.get $lex_last_action)))
-               (if (ref.eq (local.get $action) (i31.new (i32.const -1)))
+               (if (ref.eq (local.get $action) (ref.i31 (i32.const -1)))
                   (then
                      (call $caml_failwith
                         (array.new_data $string $lexing_empty_token
@@ -164,7 +164,7 @@
             (then
                (array.set $block (local.get $lexbuf)
                   (global.get $lex_eof_reached)
-                  (i31.new (i32.const 0)))))
+                  (ref.i31 (i32.const 0)))))
          (br $loop)))
 
    (func $run_mem
@@ -196,7 +196,7 @@
    (func $run_tag
       (param $s (ref $string)) (param $i i32) (param $lexbuf (ref $block))
       (return_call $run_mem (local.get $s) (local.get $i) (local.get $lexbuf)
-         (i31.new (i32.const -1))))
+         (ref.i31 (i32.const -1))))
 
    (func (export "caml_new_lex_engine")
       (param $vtbl (ref eq)) (param $start_state (ref eq))
@@ -237,7 +237,7 @@
             (array.set $block (local.get $lexbuf) (global.get $lex_start_pos)
                (local.get $vpos))
             (array.set $block (local.get $lexbuf) (global.get $lex_last_action)
-               (i31.new (i32.const -1))))
+               (ref.i31 (i32.const -1))))
          (else
             (local.set $state (i32.sub (i32.const -1) (local.get $state)))))
       (local.set $lex_code
@@ -281,7 +281,7 @@
                   (call $get (local.get $lex_base_code) (local.get $state)))
                (call $run_tag (local.get $lex_code) (local.get $pc_off)
                   (local.get $lexbuf))
-               (return (i31.new (i32.sub (i32.const -1) (local.get $base))))))
+               (return (ref.i31 (i32.sub (i32.const -1) (local.get $base))))))
          (local.set $backtrk
             (call $get (local.get $lex_backtrk) (local.get $state)))
          (if (i32.ge_s (local.get $backtrk) (i32.const 0))
@@ -295,7 +295,7 @@
                      (global.get $lex_curr_pos)))
                (array.set $block (local.get $lexbuf)
                   (global.get $lex_last_action)
-                  (i31.new (local.get $backtrk)))))
+                  (ref.i31 (local.get $backtrk)))))
          (if (i32.ge_s
                 (i31.get_s
                    (ref.cast (ref i31)
@@ -309,10 +309,10 @@
                (if (ref.eq
                       (array.get $block (local.get $lexbuf)
                          (global.get $lex_eof_reached))
-                      (i31.new (i32.const 0)))
+                      (ref.i31 (i32.const 0)))
                   (then
                      (return
-                        (i31.new (i32.sub (i32.const -1) (local.get $state)))))
+                        (ref.i31 (i32.sub (i32.const -1) (local.get $state)))))
                   (else
                      (local.set $c (i32.const 256)))))
             (else
@@ -324,7 +324,7 @@
                (local.set $c
                   (array.get_u $string (local.get $buffer) (local.get $pos)))
                (array.set $block (local.get $lexbuf) (global.get $lex_curr_pos)
-                  (i31.new (i32.add (local.get $pos) (i32.const 1))))))
+                  (ref.i31 (i32.add (local.get $pos) (i32.const 1))))))
          (local.set $pstate (local.get $state))
          (if (i32.eq
                 (call $get (local.get $lex_check)
@@ -345,7 +345,7 @@
                (local.set $action
                   (array.get $block (local.get $lexbuf)
                      (global.get $lex_last_action)))
-               (if (ref.eq (local.get $action) (i31.new (i32.const -1)))
+               (if (ref.eq (local.get $action) (ref.i31 (i32.const -1)))
                   (then
                      (call $caml_failwith
                         (array.new_data $string $lexing_empty_token
@@ -372,6 +372,6 @@
             (then
                (array.set $block (local.get $lexbuf)
                   (global.get $lex_eof_reached)
-                  (i31.new (i32.const 0)))))
+                  (ref.i31 (i32.const 0)))))
          (br $loop)))
 )
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 521c192cfa..bb61186303 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -323,10 +323,10 @@
                (i32.eq (local.get $code)
                  (global.get $CODE_DOUBLE_ARRAY32_BIG)))))
       (local.set $dest
-         (array.new $block (i31.new (i32.const 0))
+         (array.new $block (ref.i31 (i32.const 0))
             (i32.add (local.get $len) (i32.const 1))))
       (array.set $block (local.get $dest) (i32.const 0)
-         (i31.new (global.get $double_array_tag)))
+         (ref.i31 (global.get $double_array_tag)))
       (loop $loop
          (local.set $i (i32.add (local.get $i) (i32.const 1)))
          (if (i32.le_u (local.get $i) (local.get $len))
@@ -430,7 +430,7 @@
       (call $caml_failwith
          (array.new_data $string $unknown_custom
             (i32.const 0) (i32.const 44)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $intern_rec
       (param $s (ref $intern_state)) (param $h (ref $marshal_header))
@@ -445,7 +445,7 @@
       (local $str (ref $string))
       (local $v (ref eq))
       (call $caml_init_custom_operations)
-      (local.set $res (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (local.set $res (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
       (local.set $sp
          (struct.new $stack_item
             (local.get $res) (i32.const 0) (ref.null $stack_item)))
@@ -453,8 +453,8 @@
       (if (local.get $size)
          (then
             (struct.set $intern_state $obj_table (local.get $s)
-               (array.new $block (i31.new (i32.const 0)) (local.get $size)))))
-      (local.set $v (i31.new (i32.const 0))) ;; keep validator happy
+               (array.new $block (ref.i31 (i32.const 0)) (local.get $size)))))
+      (local.set $v (ref.i31 (i32.const 0))) ;; keep validator happy
       (block $exit
        (loop $loop
         (local.set $item (br_on_null $exit (local.get $sp)))
@@ -486,7 +486,7 @@
                       (else
                          ;; Small int
                          (local.set $v
-                            (i31.new
+                            (ref.i31
                                (i32.and (local.get $code) (i32.const 0x3F))))
                          (br $done))))
                 (else
@@ -585,13 +585,13 @@
                                   (i32.const 0) (i32.const 30)))
                             (br $done))
                            ;; INT32
-                           (local.set $v (i31.new (call $read32 (local.get $s))))
+                           (local.set $v (ref.i31 (call $read32 (local.get $s))))
                            (br $done))
                           ;; INT16
-                          (local.set $v (i31.new (call $read16s (local.get $s))))
+                          (local.set $v (ref.i31 (call $read16s (local.get $s))))
                           (br $done))
                          ;; INT8
-                         (local.set $v (i31.new (call $read8s (local.get $s))))
+                         (local.set $v (ref.i31 (call $read8s (local.get $s))))
                          (br $done))
                         ))))
             ;; read_shared
@@ -620,10 +620,10 @@
           (br $done))
          ;; read_block
          (local.set $b
-            (array.new $block (i31.new (i32.const 0))
+            (array.new $block (ref.i31 (i32.const 0))
                (i32.add (local.get $size) (i32.const 1))))
          (array.set $block (local.get $b) (i32.const 0)
-            (i31.new (local.get $tag)))
+            (ref.i31 (local.get $tag)))
          (if (local.get $size)
             (then
                (call $register_object (local.get $s) (local.get $b))
@@ -704,7 +704,7 @@
             (call $bad_object
                (array.new_data $string $marshal_data_size
                   (i32.const 0) (i32.const 17)))))
-      (i31.new (call $read32 (local.get $s))))
+      (ref.i31 (call $read32 (local.get $s))))
 
    (type $output_block
       (struct
@@ -741,7 +741,7 @@
             (local.set $b
                (br_on_cast_fail $done (ref eq) (ref $block) (local.get $flags)))
             (if (ref.eq (array.get $block (local.get $b) (i32.const 1))
-                   (i31.new (i32.const 0)))
+                   (ref.i31 (i32.const 0)))
                (then (local.set $no_sharing (i32.const 1))))
             (local.set $flags (array.get $block (local.get $b) (i32.const 2)))
             (br $parse_flags))))
@@ -943,7 +943,7 @@
          (i32.add (local.get $pos) (i32.const 1)))
       (call $weak_map_set
          (struct.get $extern_state $pos_table (local.get $s))
-         (local.get $obj) (i31.new (local.get $pos))))
+         (local.get $obj) (ref.i31 (local.get $pos))))
 
    (func $extern_size
       (param $s (ref $extern_state)) (param $s32 i32) (param $s64 i32)
@@ -1348,7 +1348,7 @@
       (array.copy $string $string
          (local.get $buf) (local.get $pos)
          (tuple.extract 1 (local.get $r)) (i32.const 0) (i32.const 20))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_output_value")
       (param $ch (ref eq)) (param $v (ref eq)) (param $flags (ref eq))
@@ -1381,7 +1381,7 @@
                   (struct.get $output_block $next (local.get $blk))))
             (br $loop)))
       (call $caml_flush_if_unbuffered (local.get $ch))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_serialize_int_1") (param $vs (ref eq)) (param $i i32)
       (local $s (ref $extern_state))
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index 668214830f..91a2af0b78 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -5,27 +5,27 @@
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "create_nat"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "incr_nat")
       (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "incr_nat"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "initialize_nat")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "set_digit_nat")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "set_digit_nat"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "set_to_zero_nat")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ
       (call $log_js (string.const "set_to_zero_nat"))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 14854f6392..b061f04d0f 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -88,7 +88,7 @@
               (ref.test (ref $cps_closure_last_arg) (local.get $v))))
 
    (func (export "caml_alloc_dummy") (param $size (ref eq)) (result (ref eq))
-      (array.new $block (i31.new (i32.const 0))
+      (array.new $block (ref.i31 (i32.const 0))
                  (i32.add (i31.get_u (ref.cast (ref i31) (local.get $size)))
                           (i32.const 1))))
 
@@ -104,37 +104,37 @@
          (array.copy $block $block
             (local.get $dst) (i32.const 0) (local.get $src) (i32.const 0)
             (array.len (local.get $dst)))
-         (return (i31.new (i32.const 0)))))
+         (return (ref.i31 (i32.const 0)))))
       (drop (block $not_closure_1 (result (ref eq))
          (struct.set $dummy_closure_1 1
             (br_on_cast_fail $not_closure_1 (ref eq) (ref $dummy_closure_1)
                (local.get $dummy))
             (ref.cast (ref $closure) (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
+         (return (ref.i31 (i32.const 0)))))
       (drop (block $not_closure_2 (result (ref eq))
          (struct.set $dummy_closure_2 2
             (br_on_cast_fail $not_closure_2 (ref eq) (ref $dummy_closure_2)
                (local.get $dummy))
             (ref.cast (ref $closure_2) (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
+         (return (ref.i31 (i32.const 0)))))
       (drop (block $not_closure_3 (result (ref eq))
          (struct.set $dummy_closure_3 2
             (br_on_cast_fail $not_closure_3 (ref eq) (ref $dummy_closure_3)
                (local.get $dummy))
             (ref.cast (ref $closure_3) (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
+         (return (ref.i31 (i32.const 0)))))
       (drop (block $not_closure_4 (result (ref eq))
          (struct.set $dummy_closure_4 2
             (br_on_cast_fail $not_closure_4 (ref eq) (ref $dummy_closure_4)
                (local.get $dummy))
             (ref.cast (ref $closure_4) (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
+         (return (ref.i31 (i32.const 0)))))
       (drop (block $not_cps_closure (result (ref eq))
          (struct.set $cps_dummy_closure 1
             (br_on_cast_fail $not_cps_closure (ref eq) (ref $cps_dummy_closure)
                (local.get $dummy))
             (ref.cast (ref $cps_closure) (local.get $newval)))
-         (return (i31.new (i32.const 0)))))
+         (return (ref.i31 (i32.const 0)))))
       ;; ZZZ float array
       (unreachable))
 
@@ -180,7 +180,7 @@
       ;; ZZZ float array / specific types
       (local.set $res
          (array.new $block
-            (i31.new (i32.const 0))
+            (ref.i31 (i32.const 0))
             (i32.add (i31.get_s (ref.cast (ref i31) (local.get $size)))
                      (i32.const 1))))
       (array.set $block (local.get $res) (i32.const 0) (local.get $tag))
@@ -188,37 +188,37 @@
 
    (func (export "caml_obj_tag") (param $v (ref eq)) (result (ref eq))
       (if (ref.test (ref i31) (local.get $v))
-         (then (return (i31.new (i32.const 1000)))))
+         (then (return (ref.i31 (i32.const 1000)))))
       (drop (block $not_block (result (ref eq))
          (return
             (array.get $block
               (br_on_cast_fail $not_block (ref eq) (ref $block) (local.get $v))
               (i32.const 0)))))
       (if (ref.test (ref $string) (local.get $v))
-         (then (return (i31.new (global.get $string_tag)))))
+         (then (return (ref.i31 (global.get $string_tag)))))
       (if (ref.test (ref $float) (local.get $v))
-         (then (return (i31.new (global.get $float_tag)))))
+         (then (return (ref.i31 (global.get $float_tag)))))
       (if (call $caml_is_custom (local.get $v))
-         (then (return (i31.new (global.get $custom_tag)))))
+         (then (return (ref.i31 (global.get $custom_tag)))))
       (if (call $caml_is_closure (local.get $v))
-         (then (return (i31.new (global.get $closure_tag)))))
+         (then (return (ref.i31 (global.get $closure_tag)))))
       (if (call $caml_is_continuation (local.get $v))
-         (then (return (i31.new (global.get $cont_tag)))))
+         (then (return (ref.i31 (global.get $cont_tag)))))
       ;; ZZZ float array
-      (i31.new (global.get $abstract_tag)))
+      (ref.i31 (global.get $abstract_tag)))
 
    (func (export "caml_obj_make_forward")
       (param $b (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $block (ref $block))
       (local.set $block (ref.cast (ref $block) (local.get $b)))
       (array.set $block (local.get $block)
-         (i32.const 0) (i31.new (global.get $forward_tag)))
+         (i32.const 0) (ref.i31 (global.get $forward_tag)))
       (array.set $block (local.get $block) (i32.const 1) (local.get $v))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_lazy_make_forward")
       (param (ref eq)) (result (ref eq))
-      (array.new_fixed $block 2 (i31.new (global.get $forward_tag))
+      (array.new_fixed $block 2 (ref.i31 (global.get $forward_tag))
          (local.get 0)))
 
    (func $obj_update_tag
@@ -226,10 +226,10 @@
       (local $b (ref $block))
       (local.set $b (ref.cast (ref $block) (local.get 0)))
       (if (result i32) (ref.eq (array.get $block (local.get $b) (i32.const 0))
-                               (i31.new (local.get $o)))
+                               (ref.i31 (local.get $o)))
          (then
             (array.set $block (local.get $b) (i32.const 0)
-               (i31.new (local.get $n)))
+               (ref.i31 (local.get $n)))
             (i32.const 1))
          (else
             (i32.const 0))))
@@ -237,12 +237,12 @@
    (func (export "caml_lazy_reset_to_lazy") (param (ref eq)) (result (ref eq))
       (drop (call $obj_update_tag (local.get 0)
                (global.get $forcing_tag) (global.get $lazy_tag)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_lazy_update_to_forward") (param (ref eq)) (result (ref eq))
       (drop (call $obj_update_tag (local.get 0)
                (global.get $forcing_tag) (global.get $forward_tag)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_lazy_update_to_forcing")
       (param (ref eq)) (result (ref eq))
@@ -250,8 +250,8 @@
          (then
             (if (call $obj_update_tag (local.get 0)
                    (global.get $lazy_tag) (global.get $forcing_tag))
-               (then (return (i31.new (i32.const 0)))))))
-      (i31.new (i32.const 1)))
+               (then (return (ref.i31 (i32.const 0)))))))
+      (ref.i31 (i32.const 1)))
 
    (func (export "caml_obj_compare_and_swap")
       (param (ref eq)) (param (ref eq))
@@ -266,12 +266,12 @@
             (array.get $block (local.get $b) (local.get $i)) (local.get $old))
          (then
             (array.set $block (local.get $b) (local.get $i) (local.get $new))
-            (i31.new (i32.const 1)))
+            (ref.i31 (i32.const 1)))
          (else
-            (i31.new (i32.const 0)))))
+            (ref.i31 (i32.const 0)))))
 
    (func (export "caml_obj_is_shared") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 1)))
+      (ref.i31 (i32.const 1)))
 
    (func (export "caml_obj_raw_field")
       (param $o (ref eq)) (param $i (ref eq)) (result (ref eq))
@@ -285,7 +285,7 @@
       (array.set $block (ref.cast (ref $block) (local.get $o))
          (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))
          (local.get $v))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $not_implemented "Obj.add_offset is not supported")
 
@@ -293,7 +293,7 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (call $caml_failwith
          (array.new_data $string $not_implemented (i32.const 0) (i32.const 31)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $truncate_not_implemented "Obj.truncate is not supported")
 
@@ -302,7 +302,7 @@
       (call $caml_failwith
          (array.new_data $string $truncate_not_implemented
             (i32.const 0) (i32.const 29)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (global $method_cache (mut (ref $int_array))
       (array.new $int_array (i32.const 0) (i32.const 8)))
@@ -380,7 +380,7 @@
          (then
             (array.get $block (local.get $meths) (local.get $li)))
          (else
-            (i31.new (i32.const 0)))))
+            (ref.i31 (i32.const 0)))))
 
    (global $caml_oo_last_id (mut i32) (i32.const 0))
 
@@ -388,7 +388,7 @@
       (local $id i32)
       (local.set $id (global.get $caml_oo_last_id))
       (array.set $block (ref.cast (ref $block) (local.get 0)) (i32.const 2)
-         (i31.new (local.get $id)))
+         (ref.i31 (local.get $id)))
       (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
       (local.get 0))
 
@@ -396,10 +396,10 @@
       (local $id i32)
       (local.set $id (global.get $caml_oo_last_id))
       (global.set $caml_oo_last_id (i32.add (local.get $id) (i32.const 1)))
-      (i31.new (local.get $id)))
+      (ref.i31 (local.get $id)))
 
    (func (export "caml_obj_reachable_words") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_callback_1")
       (param $f (ref eq)) (param $x (ref eq)) (result (ref eq))
@@ -411,6 +411,6 @@
                   (local.get $f))))))
       (return_call_ref $function_1
          (local.get $f)
-         (array.new_fixed $block 2 (i31.new (i32.const 0)) (local.get $x))
+         (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $x))
          (ref.as_non_null (global.get $caml_trampoline_ref))))
 )
diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat
index 25e7d87dcf..27bf3c9bef 100644
--- a/runtime/wasm/parsing.wat
+++ b/runtime/wasm/parsing.wat
@@ -131,14 +131,14 @@
       (local.set $s (ref.cast (ref $string) (local.get 0)))
       (drop
          (call $caml_ml_output (global.get $caml_stderr)
-            (local.get $s) (i31.new (i32.const 0))
-            (i31.new (array.len (local.get $s))))))
+            (local.get $s) (ref.i31 (i32.const 0))
+            (ref.i31 (array.len (local.get $s))))))
 
    (func $output_nl
       (drop
          (call $caml_ml_output (global.get $caml_stderr)
             (array.new_fixed $string 1 (i32.const 10))
-            (i31.new (i32.const 0)) (i31.new (i32.const 1))))
+            (ref.i31 (i32.const 0)) (ref.i31 (i32.const 1))))
       (drop (call $caml_ml_flush (global.get $caml_stderr))))
 
    (func $output_str (param (ref string))
@@ -148,7 +148,7 @@
       (call $output
          (call $caml_format_int
             (array.new_fixed $string 2 (i32.const 37) (i32.const 100))
-            (i31.new (local.get 0)))))
+            (ref.i31 (local.get 0)))))
 
    (func $print_token
       (param $tables (ref $block)) (param $state i32) (param $tok (ref eq))
@@ -328,7 +328,7 @@
                              (i31.get_u (ref.cast (ref i31) (local.get $varg)))
                              (i32.const 1))))
                     (array.set $block (local.get $env) (global.get $env_lval)
-                       (i31.new (i32.const 0))))
+                       (ref.i31 (i32.const 0))))
                  (if (global.get $caml_parser_trace)
                     (then (call $print_token (local.get $tables)
                        (local.get $state) (local.get $varg)))))
@@ -353,7 +353,7 @@
                                       (global.get $tbl_tablesize)))))
                          (then
                             (if (ref.eq
-                                   (i31.new
+                                   (ref.i31
                                       (call $get (local.get $tbl_check)
                                          (local.get $n2)))
                                    (array.get $block (local.get $env)
@@ -380,7 +380,7 @@
                                       (global.get $tbl_tablesize)))))
                          (then
                             (if (ref.eq
-                                   (i31.new
+                                   (ref.i31
                                       (call $get (local.get $tbl_check)
                                          (local.get $n2)))
                                    (array.get $block (local.get $env)
@@ -458,16 +458,16 @@
                                       (string.const
                                          "No more states to discard"))
                                    (call $output_nl)))
-                             (return (i31.new (global.get $RAISE_PARSE_ERROR)))))
+                             (return (ref.i31 (global.get $RAISE_PARSE_ERROR)))))
                        (local.set $sp (i32.sub (local.get $sp) (i32.const 1)))
                        (br $loop2)))
                   (else
                      (if (ref.eq
                             (array.get $block (local.get $env)
                                (global.get $env_curr_char))
-                            (i31.new (i32.const 0)))
+                            (ref.i31 (i32.const 0)))
                         (then
-                           (return (i31.new (global.get $RAISE_PARSE_ERROR)))))
+                           (return (ref.i31 (global.get $RAISE_PARSE_ERROR)))))
                      (if (global.get $caml_parser_trace)
                         (then
                            (call $output_str
@@ -475,12 +475,12 @@
                            (call $output_nl)))
                      (array.set $block (local.get $env)
                         (global.get $env_curr_char)
-                        (i31.new (i32.const -1)))
+                        (ref.i31 (i32.const -1)))
                      (local.set $cmd (global.get $loop))
                      (br $next))))
               ;; shift:
               (array.set $block (local.get $env) (global.get $env_curr_char)
-                 (i31.new (i32.const -1)))
+                 (ref.i31 (i32.const -1)))
               (if (i32.gt_s (local.get $errflag) (i32.const 0))
                  (then
                     (local.set $errflag
@@ -512,7 +512,7 @@
                (ref.cast (ref $block)
                   (array.get $block (local.get $env) (global.get $env_s_stack)))
                (i32.add (local.get $sp) (i32.const 1))
-               (i31.new (local.get $state)))
+               (ref.i31 (local.get $state)))
             (array.set $block
                (ref.cast (ref $block)
                   (array.get $block (local.get $env) (global.get $env_v_stack)))
@@ -542,11 +542,11 @@
                  (call $output_nl)))
            (local.set $m (call $get (local.get $tbl_len) (local.get $n)))
            (array.set $block (local.get $env) (global.get $env_asp)
-              (i31.new (local.get $sp)))
+              (ref.i31 (local.get $sp)))
            (array.set $block (local.get $env) (global.get $env_rule_number)
-              (i31.new (local.get $n)))
+              (ref.i31 (local.get $n)))
            (array.set $block (local.get $env) (global.get $env_rule_len)
-              (i31.new (local.get $m)))
+              (ref.i31 (local.get $m)))
            (local.set $sp
               (i32.add (local.get $sp) (i32.sub (i32.const 1) (local.get $m))))
            (local.set $m (call $get (local.get $tbl_lhs) (local.get $n)))
@@ -599,7 +599,7 @@
             (ref.cast (ref $block)
                (array.get $block (local.get $env) (global.get $env_s_stack)))
             (i32.add (local.get $sp) (i32.const 1))
-            (i31.new (local.get $state)))
+            (ref.i31 (local.get $state)))
          (array.set $block
             (ref.cast (ref $block)
                (array.get $block (local.get $env) (global.get $env_v_stack)))
@@ -635,20 +635,20 @@
          (local.set $cmd (global.get $loop))
          (br $next))
         ;; default:
-        (return (i31.new (global.get $RAISE_PARSE_ERROR)))))
+        (return (ref.i31 (global.get $RAISE_PARSE_ERROR)))))
       ;; SAVE
       (array.set $block (local.get $env) (global.get $env_sp)
-         (i31.new (local.get $sp)))
+         (ref.i31 (local.get $sp)))
       (array.set $block (local.get $env) (global.get $env_state)
-         (i31.new (local.get $state)))
+         (ref.i31 (local.get $state)))
       (array.set $block (local.get $env) (global.get $env_errflag)
-         (i31.new (local.get $errflag)))
-      (i31.new (local.get $res)))
+         (ref.i31 (local.get $errflag)))
+      (ref.i31 (local.get $res)))
 
    (func (export "caml_set_parser_trace") (param (ref eq)) (result (ref eq))
       (local $oldflag i32)
       (local.set $oldflag (global.get $caml_parser_trace))
       (global.set $caml_parser_trace
          (i31.get_s (ref.cast (ref i31) (local.get 0))))
-      (i31.new (local.get $oldflag)))
+      (ref.i31 (local.get $oldflag)))
 )
diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat
index 84679eca8c..d39323f3d1 100644
--- a/runtime/wasm/printexc.wat
+++ b/runtime/wasm/printexc.wat
@@ -56,7 +56,7 @@
       (local.set $exn (ref.cast (ref $block) (local.get 0)))
       (if (result anyref)
           (ref.eq (array.get $block (local.get $exn) (i32.const 0))
-                  (i31.new (i32.const 0)))
+                  (ref.i31 (i32.const 0)))
          (then
             (local.set $buf
                (struct.new $buffer
@@ -86,7 +86,7 @@
                         (i32.eqz
                            (ref.eq
                               (array.get $block (local.get $bucket) (i32.const 0))
-                              (i31.new (i32.const 0)))))
+                              (ref.i31 (i32.const 0)))))
                     (local.set $i (i32.const 1))
                     (br $continue (local.get $bucket)))
                  (local.set $i (i32.const 2))
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index e67e7c970e..d3da4c7d81 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -49,7 +49,7 @@
                (i31.get_s
                   (ref.cast (ref i31)
                      (call $caml_string_hash
-                        (i31.new (i32.const 0)) (local.get $s))))
+                        (ref.i31 (i32.const 0)) (local.get $s))))
                (global.get $Named_value_size)))))
 
    (func (export "caml_register_named_value")
@@ -61,7 +61,7 @@
             (i31.get_s
                (ref.cast (ref i31)
                   (call $caml_string_hash
-                     (i31.new (i32.const 0)) (local.get 0))))
+                     (ref.i31 (i32.const 0)) (local.get 0))))
             (global.get $Named_value_size)))
       (local.set $r
          (array.get $assoc_array
@@ -73,10 +73,10 @@
                (struct.new $assoc
                   (ref.cast (ref $string) (local.get 0))
                   (local.get 1) (local.get $r)))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (global $caml_global_data (export "caml_global_data") (mut (ref $block))
-      (array.new $block (i31.new (i32.const 0)) (i32.const 12)))
+      (array.new $block (ref.i31 (i32.const 0)) (i32.const 12)))
 
    (func (export "caml_register_global")
       (param (ref eq)) (param $v (ref eq)) (param (ref eq)) (result (ref eq))
@@ -86,7 +86,7 @@
          (then
             (array.set $block (global.get $caml_global_data)
                (local.get $i) (local.get $v))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_get_global_data") (param (ref eq)) (result (ref eq))
       (global.get $caml_global_data))
diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat
index 789f7f1016..10d8ccdccb 100644
--- a/runtime/wasm/str.wat
+++ b/runtime/wasm/str.wat
@@ -449,7 +449,7 @@
        (array.set $int_array
           (local.get $group_end) (i32.const 0) (local.get $pos))
        (local.set $res
-          (array.new $block (i31.new (i32.const 0))
+          (array.new $block (ref.i31 (i32.const 0))
              (i32.add (i32.shl (local.get $numgroups) (i32.const 1))
                 (i32.const 1))))
        (local.set $i (i32.const 0))
@@ -469,26 +469,26 @@
                    (then
                       (array.set $block (local.get $res)
                          (i32.add (local.get $j) (i32.const 1))
-                         (i31.new (i32.const -1)))
+                         (ref.i31 (i32.const -1)))
                       (array.set $block (local.get $res)
                          (i32.add (local.get $j) (i32.const 2))
-                         (i31.new (i32.const -1))))
+                         (ref.i31 (i32.const -1))))
                    (else
                       (array.set $block (local.get $res)
                          (i32.add (local.get $j) (i32.const 1))
-                         (i31.new
+                         (ref.i31
                             (array.get $int_array (local.get $group_start)
                                (local.get $i))))
                       (array.set $block (local.get $res)
                          (i32.add (local.get $j) (i32.const 2))
-                         (i31.new
+                         (ref.i31
                             (array.get $int_array (local.get $group_end)
                                (local.get $i))))))
                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
                 (br $loop))))
        (return (local.get $res)))
       ;; reject
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $search_forward "Str.search_forward")
 
@@ -516,7 +516,7 @@
                (return (local.get $res))))
          (local.set $pos (i32.add (local.get $pos) (i32.const 1)))
          (br_if $loop (i32.le_u (local.get $pos) (local.get $len))))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (data $search_backward "Str.search_backward")
 
@@ -544,7 +544,7 @@
                (return (local.get $res))))
          (local.set $pos (i32.sub (local.get $pos) (i32.const 1)))
          (br_if $loop (i32.ge_s (local.get $pos) (i32.const 0))))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (data $string_match "Str.string_match")
 
@@ -569,7 +569,7 @@
        (if (ref.test (ref $block) (local.get $res))
           (then
             (return (local.get $res))))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (data $string_partial_match "Str.string_partial_match")
 
@@ -594,7 +594,7 @@
        (if (ref.test (ref $block) (local.get $res))
           (then
             (return (local.get $res))))
-      (array.new_fixed $block 1 (i31.new (i32.const 0))))
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (data $illegal_backslash "Str.replace: illegal backslash sequence")
    (data $unmatched_group "Str.replace: reference to unmatched group")
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 75a9770552..ad059c13c2 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -19,28 +19,28 @@
       (local $s1 (ref $string)) (local $s2 (ref $string))
       (local $len i32) (local $i i32)
       (if (ref.eq (local.get $p1) (local.get $p2))
-         (then (return (i31.new (i32.const 1)))))
+         (then (return (ref.i31 (i32.const 1)))))
       (local.set $s1 (ref.cast (ref $string) (local.get $p1)))
       (local.set $s2 (ref.cast (ref $string) (local.get $p2)))
       (local.set $len (array.len $string (local.get $s1)))
       (if (i32.ne (local.get $len) (array.len $string (local.get $s2)))
-         (then (return (i31.new (i32.const 0)))))
+         (then (return (ref.i31 (i32.const 0)))))
       (local.set $i (i32.const 0))
       (loop $loop
          (if (i32.lt_s (local.get $i) (local.get $len))
             (then
                (if (i32.ne (array.get_u $string (local.get $s1) (local.get $i))
                            (array.get_u $string (local.get $s2) (local.get $i)))
-                  (then (return (i31.new (i32.const 0)))))
+                  (then (return (ref.i31 (i32.const 0)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
-      (i31.new (i32.const 1)))
+      (ref.i31 (i32.const 1)))
 
    (export "caml_bytes_notequal" (func $caml_string_notequal))
    (func $caml_string_notequal (export "caml_string_notequal")
       (param $p1 (ref eq)) (param $p2 (ref eq)) (result (ref eq))
       (return
-         (i31.new (i32.eqz (i31.get_u (ref.cast (ref i31)
+         (ref.i31 (i32.eqz (i31.get_u (ref.cast (ref i31)
             (call $caml_string_equal (local.get $p1) (local.get $p2))))))))
 
    (func $string_compare
@@ -79,30 +79,30 @@
    (export "caml_bytes_compare" (func $caml_string_compare))
    (func $caml_string_compare (export "caml_string_compare")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (call $string_compare (local.get 0) (local.get 1))))
+      (ref.i31 (call $string_compare (local.get 0) (local.get 1))))
 
    (export "caml_bytes_lessequal" (func $caml_string_lessequal))
    (func $caml_string_lessequal (export "caml_string_lessequal")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.le_s (call $string_compare (local.get 0) (local.get 1))
+      (ref.i31 (i32.le_s (call $string_compare (local.get 0) (local.get 1))
                          (i32.const 0))))
 
    (export "caml_bytes_lessthan" (func $caml_string_lessthan))
    (func $caml_string_lessthan (export "caml_string_lessthan")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.lt_s (call $string_compare (local.get 0) (local.get 1))
+      (ref.i31 (i32.lt_s (call $string_compare (local.get 0) (local.get 1))
                          (i32.const 0))))
 
    (export "caml_bytes_greaterequal" (func $caml_string_greaterequal))
    (func $caml_string_greaterequal (export "caml_string_greaterequal")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.ge_s (call $string_compare (local.get 0) (local.get 1))
+      (ref.i31 (i32.ge_s (call $string_compare (local.get 0) (local.get 1))
                          (i32.const 0))))
 
    (export "caml_bytes_greaterthan" (func $caml_string_greaterthan))
    (func $caml_string_greaterthan (export "caml_string_greaterthan")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (i31.new (i32.gt_s (call $string_compare (local.get 0) (local.get 1))
+      (ref.i31 (i32.gt_s (call $string_compare (local.get 0) (local.get 1))
                          (i32.const 0))))
 
    (export "caml_bytes_of_string" (func $caml_string_of_bytes))
@@ -134,7 +134,7 @@
          (ref.cast (ref $string) (local.get $v1))
          (i31.get_s (ref.cast (ref i31) (local.get $i1)))
          (i31.get_s (ref.cast (ref i31) (local.get $n))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_fill_bytes")
       (param $v (ref eq)) (param $offset (ref eq))
@@ -144,7 +144,7 @@
          (i31.get_u (ref.cast (ref i31) (local.get $offset)))
          (i31.get_u (ref.cast (ref i31) (local.get $init)))
          (i31.get_u (ref.cast (ref i31) (local.get $len))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (export "caml_string_get16" (func $caml_bytes_get16))
    (func $caml_bytes_get16 (export "caml_bytes_get16")
@@ -157,7 +157,7 @@
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
                     (array.len (local.get $s)))
          (then (call $caml_bound_error)))
-      (i31.new (i32.or
+      (ref.i31 (i32.or
                   (array.get_u $string (local.get $s) (local.get $p))
                   (i32.shl (array.get_u $string (local.get $s)
                               (i32.add (local.get $p) (i32.const 1)))
@@ -254,7 +254,7 @@
       (array.set $string (local.get $s)
          (i32.add (local.get $p) (i32.const 1))
          (i32.shr_u (local.get $v) (i32.const 8)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_bytes_set32")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
@@ -277,7 +277,7 @@
       (array.set $string (local.get $s)
          (i32.add (local.get $p) (i32.const 3))
          (i32.shr_u (local.get $v) (i32.const 24)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_bytes_set64")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
@@ -313,7 +313,7 @@
       (array.set $string (local.get $s)
          (i32.add (local.get $p) (i32.const 7))
          (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 56))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_string_cat")
       (param $vs1 (ref eq)) (param $vs2 (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index 3672a9d9aa..eec85e875a 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -66,25 +66,25 @@
                (array.new_data $string $lock_failure
                   (i32.const 0) (i32.const 46)))))
       (struct.set $mutex $state (local.get $t) (i32.const 1))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_try_lock") (param (ref eq)) (result (ref eq))
       (local $t (ref $mutex))
       (local.set $t (ref.cast (ref $mutex) (local.get 0)))
       (if (result (ref eq)) (struct.get $mutex $state (local.get $t))
          (then
-            (i31.new (i32.const 0)))
+            (ref.i31 (i32.const 0)))
          (else
             (struct.set $mutex $state (local.get $t) (i32.const 1))
-            (i31.new (i32.const 1)))))
+            (ref.i31 (i32.const 1)))))
 
    (func (export "caml_ml_mutex_unlock") (param (ref eq)) (result (ref eq))
       (struct.set $mutex $state
          (ref.cast (ref $mutex) (local.get 0)) (i32.const 0))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_condition_new") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $condition_failure "Condition.wait: cannot wait")
 
@@ -93,12 +93,12 @@
       (call $caml_failwith
          (array.new_data $string $condition_failure
             (i32.const 0) (i32.const 27)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_condition_signal") (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_condition_broadcast")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index da3686bb10..157b5bb893 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -86,7 +86,7 @@
       (local.set $r (call $random_seed))
       (local.set $n (call $ta_length (local.get $r)))
       (local.set $a
-         (array.new $block (i31.new (i32.const 0))
+         (array.new $block (ref.i31 (i32.const 0))
             (i32.add (local.get $n) (i32.const 1))))
       (local.set $i (i32.const 0))
       (loop $loop
@@ -94,41 +94,41 @@
             (then
                (array.set $block
                   (local.get $a) (i32.add (local.get $i) (i32.const 1))
-                  (i31.new (call $ta_get_i32 (local.get $r) (local.get $i))))
+                  (ref.i31 (call $ta_get_i32 (local.get $r) (local.get $i))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
       (local.get $a))
 
    (func (export "caml_sys_const_bigendian")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_sys_const_word_size")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 32)))
+      (ref.i31 (i32.const 32)))
 
    (func (export "caml_sys_const_int_size")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 31)))
+      (ref.i31 (i32.const 31)))
 
    (func (export "caml_sys_const_max_wosize")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0xfffffff)))
+      (ref.i31 (i32.const 0xfffffff)))
 
    (func (export "caml_sys_const_ostype_unix")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (i31.new (i32.const 1)))
+      (ref.i31 (i32.const 1)))
 
    (func (export "caml_sys_const_ostype_win32")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_sys_const_ostype_cygwin")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $Unix "Unix")
 
@@ -136,14 +136,14 @@
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
       ;; (call $log_js (string.const "caml_sys_get_config"))
-      (array.new_fixed $block 4 (i31.new (i32.const 0))
+      (array.new_fixed $block 4 (ref.i31 (i32.const 0))
          (array.new_data $string $Unix (i32.const 0) (i32.const 4))
-         (i31.new (i32.const 32))
-         (i31.new (i32.const 0))))
+         (ref.i31 (i32.const 32))
+         (ref.i31 (i32.const 0))))
 
    (func (export "caml_sys_isatty")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_runtime_variant") (param (ref eq)) (result (ref eq))
       (array.new_fixed $string 0))
@@ -153,7 +153,7 @@
 
    (func (export "caml_install_signal_handler")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (global $caml_runtime_warnings (mut i32) (i32.const 0))
 
@@ -161,11 +161,11 @@
       (param (ref eq)) (result (ref eq))
       (global.set $caml_runtime_warnings
          (i31.get_u (ref.cast (ref i31) (local.get 0))))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_runtime_warnings_enabled")
       (param (ref eq)) (result (ref eq))
-      (i31.new (global.get $caml_runtime_warnings)))
+      (ref.i31 (global.get $caml_runtime_warnings)))
 
    (func $caml_handle_sys_error (export "caml_handle_sys_error")
       (param $exn externref)
diff --git a/runtime/wasm/toplevel.wat b/runtime/wasm/toplevel.wat
index b7f612afe9..d103fd5c34 100644
--- a/runtime/wasm/toplevel.wat
+++ b/runtime/wasm/toplevel.wat
@@ -1,5 +1,5 @@
 (module
    (func (export "caml_terminfo_rows")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index 99b9c481e6..bf47dfcde4 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -20,16 +20,16 @@
       (param $sec i32) (param $min i32) (param $hour i32) (param $mday i32)
       (param $mon i32) (param $year i32) (param $wday i32) (param $yday i32)
       (param $isdst i32) (result (ref eq))
-      (array.new_fixed $block 10 (i31.new (i32.const 0))
-         (i31.new (local.get $sec))
-         (i31.new (local.get $min))
-         (i31.new (local.get $hour))
-         (i31.new (local.get $mday))
-         (i31.new (local.get $mon))
-         (i31.new (local.get $year))
-         (i31.new (local.get $wday))
-         (i31.new (local.get $yday))
-         (i31.new (local.get $isdst))))
+      (array.new_fixed $block 10 (ref.i31 (i32.const 0))
+         (ref.i31 (local.get $sec))
+         (ref.i31 (local.get $min))
+         (ref.i31 (local.get $hour))
+         (ref.i31 (local.get $mday))
+         (ref.i31 (local.get $mon))
+         (ref.i31 (local.get $year))
+         (ref.i31 (local.get $wday))
+         (ref.i31 (local.get $yday))
+         (ref.i31 (local.get $isdst))))
 
    (export "caml_unix_gmtime" (func $unix_gmtime))
    (func $unix_gmtime (export "unix_gmtime") (param (ref eq)) (result (ref eq))
@@ -74,12 +74,12 @@
                   (ref.cast (ref i31)
                      (array.get $block (local.get $tm) (i32.const 1)))))
             (f64.const 1000)))
-      (array.new_fixed $block 3 (i31.new (i32.const 0))
+      (array.new_fixed $block 3 (ref.i31 (i32.const 0))
          (struct.new $float (local.get $t))
          (call $localtime (local.get $t))))
 
    (export "caml_unix_inet_addr_of_string" (func $unix_inet_addr_of_string))
    (func $unix_inet_addr_of_string (export "unix_inet_addr_of_string")
       (param (ref eq)) (result (ref eq))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
index b2043a3512..e856fa5f82 100644
--- a/runtime/wasm/weak.wat
+++ b/runtime/wasm/weak.wat
@@ -32,7 +32,7 @@
    (global $caml_ephe_key_offset i32 (i32.const 3))
 
    (global $caml_ephe_none (ref eq)
-      (array.new_fixed $block 1 (i31.new (global.get $abstract_tag))))
+      (array.new_fixed $block 1 (ref.i31 (global.get $abstract_tag))))
 
    (func $caml_ephe_get_data (export "caml_ephe_get_data")
       (param $vx (ref eq)) (result (ref eq))
@@ -67,11 +67,11 @@
                            (call $weak_map_get (local.get $m) (local.get $v))))
                      (br $loop))))
             (return
-              (array.new_fixed $block 2 (i31.new (i32.const 0))
+              (array.new_fixed $block 2 (ref.i31 (i32.const 0))
                  (ref.cast (ref eq) (local.get $m)))))
          (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
             (global.get $caml_ephe_none)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ephe_get_data_copy")
       (param $x (ref eq)) (result (ref eq))
@@ -79,7 +79,7 @@
       (local.set $r (call $caml_ephe_get_data (local.get $x)))
       (drop (block $no_copy (result (ref eq))
          (return
-            (array.new_fixed $block 2 (i31.new (i32.const 0))
+            (array.new_fixed $block 2 (ref.i31 (i32.const 0))
                (call $caml_obj_dup
                   (br_on_cast_fail $no_copy (ref eq) (ref $block)
                      (array.get $block
@@ -120,7 +120,7 @@
                (br $loop))))
       (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
          (call $wrap (local.get $m)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ephe_unset_data")
       (param $vx (ref eq)) (result (ref eq))
@@ -128,14 +128,14 @@
       (local.set $x (ref.cast (ref $block) (local.get $vx)))
       (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
          (global.get $caml_ephe_none))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_ephe_check_data")
       (param $x (ref eq)) (result (ref eq))
-      (i31.new
+      (ref.i31
          (i32.eqz
             (ref.eq (call $caml_ephe_get_data (local.get $x))
-               (i31.new (i32.const 0))))))
+               (ref.i31 (i32.const 0))))))
 
    (func $caml_ephe_set_data_opt
       (param $x (ref eq)) (param $opt_data (ref eq))
@@ -171,8 +171,8 @@
                (global.get $caml_ephe_none))
             (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
                (global.get $caml_ephe_none)))
-         (return (i31.new (i32.const 0))))
-      (array.new_fixed $block 2 (i31.new (i32.const 0)) (local.get $v)))
+         (return (ref.i31 (i32.const 0))))
+      (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $v)))
 
    (export "caml_weak_get_copy" (func $caml_ephe_get_key_copy))
    (func $caml_ephe_get_key_copy (export "caml_ephe_get_key_copy")
@@ -181,7 +181,7 @@
       (local.set $r (call $caml_ephe_get_key (local.get $x) (local.get $i)))
       (drop (block $no_copy (result (ref eq))
          (return
-            (array.new_fixed $block 2 (i31.new (i32.const 0))
+            (array.new_fixed $block 2 (ref.i31 (i32.const 0))
                (call $caml_obj_dup
                   (br_on_cast_fail $no_copy (ref eq) (ref $block)
                      (array.get $block
@@ -214,8 +214,8 @@
                (global.get $caml_ephe_none))
             (array.set $block (local.get $x) (global.get $caml_ephe_data_offset)
                (global.get $caml_ephe_none)))
-         (return (i31.new (i32.const 0))))
-      (i31.new (i32.const 1)))
+         (return (ref.i31 (i32.const 0))))
+      (ref.i31 (i32.const 1)))
 
    (func $caml_ephe_set_key (export "caml_ephe_set_key")
       (param $vx (ref eq)) (param $vi (ref eq)) (param $v (ref eq))
@@ -227,7 +227,7 @@
       (local.set $i
          (i32.add (i31.get_s (ref.cast (ref i31) (local.get $vi)))
             (global.get $caml_ephe_key_offset)))
-      (local.set $d (i31.new (i32.const 0)))
+      (local.set $d (ref.i31 (i32.const 0)))
       (if (ref.test (ref i31) (local.get $v))
          (then
             (if (ref.test (ref $js)
@@ -240,7 +240,7 @@
             (array.set $block (local.get $x) (local.get $i)
                (call $wrap (call $weak_new (local.get $v))))))
       (call $caml_ephe_set_data_opt (local.get $vx) (local.get $d))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func $caml_ephe_unset_key (export "caml_ephe_unset_key")
       (param $vx (ref eq)) (param $vi (ref eq)) (result (ref eq))
@@ -251,14 +251,14 @@
       (local.set $i
          (i32.add (i31.get_s (ref.cast (ref i31) (local.get $vi)))
             (global.get $caml_ephe_key_offset)))
-      (local.set $d (i31.new (i32.const 0)))
+      (local.set $d (ref.i31 (i32.const 0)))
       (if (ref.test (ref $js) (array.get $block (local.get $x) (local.get $i)))
          (then
             (local.set $d (call $caml_ephe_get_data (local.get $vx)))))
       (array.set $block (local.get $x) (local.get $i)
          (global.get $caml_ephe_none))
       (call $caml_ephe_set_data_opt (local.get $vx) (local.get $d))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (data $Weak_create "Weak.create")
 
@@ -277,14 +277,14 @@
          (array.new $block (global.get $caml_ephe_none)
             (i32.add (local.get $len) (global.get $caml_ephe_key_offset))))
       (array.set $block (local.get $res) (i32.const 0)
-         (i31.new (global.get $abstract_tag)))
+         (ref.i31 (global.get $abstract_tag)))
       (local.get $res))
 
    (func (export "caml_ephe_blit_data")
       (param $x (ref eq)) (param $y (ref eq)) (result (ref eq))
       (call $caml_ephe_set_data_opt
          (local.get $y) (call $caml_ephe_get_data (local.get $x)))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (export "caml_weak_blit" (func $caml_ephe_blit_key))
    (func $caml_ephe_blit_key (export "caml_ephe_blit_key")
@@ -302,7 +302,7 @@
             (global.get $caml_ephe_key_offset))
          (i31.get_s (ref.cast (ref i31) (local.get $l))))
       (call $caml_ephe_set_data_opt (local.get $y) (local.get $d))
-      (i31.new (i32.const 0)))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_weak_set")
       (param $x (ref eq)) (param $i (ref eq)) (param $v (ref eq))

From 7edd42213f5ec51c51eedde22898f39c23c16e93 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 14 Sep 2023 14:34:33 +0200
Subject: [PATCH 129/481] Runtime: use Map objects rather than WeakMap for
 marshalling

---
 runtime/wasm/marshal.wat | 16 ++++++++--------
 runtime/wasm/runtime.js  |  6 +++---
 runtime/wasm/weak.wat    | 14 ++++++--------
 3 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index bb61186303..4fdfdfcbe8 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -11,11 +11,11 @@
       (func $caml_is_closure (param (ref eq)) (result i32)))
    (import "effect" "caml_is_continuation"
       (func $caml_is_continuation (param (ref eq)) (result i32)))
-   (import "bindings" "weak_map_new" (func $weak_map_new (result (ref any))))
-   (import "bindings" "weak_map_get"
-      (func $weak_map_get (param (ref any)) (param (ref eq)) (result i31ref)))
-   (import "bindings" "weak_map_set"
-      (func $weak_map_set (param (ref any)) (param (ref eq)) (param (ref i31))))
+   (import "bindings" "map_new" (func $map_new (result (ref any))))
+   (import "bindings" "map_get"
+      (func $map_get (param (ref any)) (param (ref eq)) (result i31ref)))
+   (import "bindings" "map_set"
+      (func $map_set (param (ref any)) (param (ref eq)) (param (ref i31))))
    (import "io" "caml_really_putblock"
       (func $caml_really_putblock
          (param (ref eq)) (param (ref $string)) (param i32) (param i32)))
@@ -751,7 +751,7 @@
          (i32.const 0)
          (i32.const 0)
          (i32.const 0)
-         (call $weak_map_new)
+         (call $map_new)
          (struct.get $output_block $data (local.get $output))
          (local.get $pos)
          (struct.get $output_block $end (local.get $output))
@@ -928,7 +928,7 @@
          (return
             (i31.get_s
                (br_on_null $not_found
-                  (call $weak_map_get
+                  (call $map_get
                      (struct.get $extern_state $pos_table (local.get $s))
                      (local.get $obj))))))
       (i32.const -1))
@@ -941,7 +941,7 @@
       (local.set $pos (struct.get $extern_state $obj_counter (local.get $s)))
       (struct.set $extern_state $obj_counter (local.get $s)
          (i32.add (local.get $pos) (i32.const 1)))
-      (call $weak_map_set
+      (call $map_set
          (struct.get $extern_state $pos_table (local.get $s))
          (local.get $obj) (ref.i31 (local.get $pos))))
 
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 405e39ea40..e896d05a0c 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -300,9 +300,9 @@
          weak_new:(v)=>new WeakRef(v),
          weak_deref:(w)=>{var v = w.deref(); return v==undefined?null:v},
          weak_map_new:()=>new WeakMap,
-         weak_map_get:(m,x)=>{var v = m.get(x); return v==undefined?null:v},
-         weak_map_set:(m,x,v)=>m.set(x,v),
-         weak_map_delete:(m,x)=>m.delete(x),
+         map_new:()=>new Map,
+         map_get:(m,x)=>{var v = m.get(x); return v==undefined?null:v},
+         map_set:(m,x,v)=>m.set(x,v),
          log:(x)=>console.log('ZZZZZ', x)
         }
     const imports = {Math:math,bindings:bindings,env:{},js:js}
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
index e856fa5f82..c1b60acafe 100644
--- a/runtime/wasm/weak.wat
+++ b/runtime/wasm/weak.wat
@@ -9,12 +9,10 @@
    (import "bindings" "weak_deref"
       (func $weak_deref (param anyref) (result eqref)))
    (import "bindings" "weak_map_new" (func $weak_map_new (result (ref any))))
-   (import "bindings" "weak_map_get"
-      (func $weak_map_get (param (ref any)) (param (ref eq)) (result anyref)))
-   (import "bindings" "weak_map_set"
-      (func $weak_map_set (param (ref any)) (param (ref eq)) (param (ref any))))
-   (import "bindings" "weak_map_delete"
-      (func $weak_map_delete (param (ref any)) (param (ref eq))))
+   (import "bindings" "map_get"
+      (func $map_get (param (ref any)) (param (ref eq)) (result anyref)))
+   (import "bindings" "map_set"
+      (func $map_set (param (ref any)) (param (ref eq)) (param (ref any))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (type $block (array (mut (ref eq))))
@@ -64,7 +62,7 @@
                            (call $weak_deref (call $unwrap (local.get $v)))))
                      (local.set $m
                         (br_on_null $released
-                           (call $weak_map_get (local.get $m) (local.get $v))))
+                           (call $map_get (local.get $m) (local.get $v))))
                      (br $loop))))
             (return
               (array.new_fixed $block 2 (ref.i31 (i32.const 0))
@@ -111,7 +109,7 @@
                      (br_on_null $released
                         (call $weak_deref (call $unwrap (local.get $v)))))
                   (local.set $m' (call $weak_map_new))
-                  (call $weak_map_set (local.get $m') (local.get $v)
+                  (call $map_set (local.get $m') (local.get $v)
                      (local.get $m))
                   (local.set $m (local.get $m'))
                   (br $loop))

From 1297217d6328138f97139c8d5587e32da9280189 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 14 Sep 2023 14:46:48 +0200
Subject: [PATCH 130/481] =?UTF-8?q?Implement=20accurate=20fused=20multiply?=
 =?UTF-8?q?=E2=80=93add?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 runtime/wasm/float.wat | 301 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 294 insertions(+), 7 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 955bca78a1..555bcae014 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -835,15 +835,302 @@
                (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))))
 
    (func (export "caml_fma_float")
-      (param $x (ref eq)) (param $y (ref eq)) (param $z (ref eq))
+      (param $vx (ref eq)) (param $vy (ref eq)) (param $vz (ref eq))
       (result (ref eq))
-      ;; ZZZ not accurate
-      (struct.new $float
-         (f64.add
+      (local $x f64)
+      (local $y f64)
+      (local $z f64)
+      (local $3 i64)
+      (local $4 i64)
+      (local $5 i64)
+      (local $6 i64)
+      (local $7 i64)
+      (local $8 i64)
+      (local $9 i32)
+      (local $10 i32)
+      (local $11 f64)
+      (local $12 f64)
+      (local $13 f64)
+      (local $14 f64)
+      (local $15 f64)
+      (local.set $x
+         (struct.get $float 0 (ref.cast (ref $float) (local.get $vx))))
+      (local.set $y
+         (struct.get $float 0 (ref.cast (ref $float) (local.get $vy))))
+      (local.set $z
+         (struct.get $float 0 (ref.cast (ref $float) (local.get $vz))))
+      (local.set $7
+         (i64.add
+            (local.tee $4
+               (i64.and
+                  (i64.shr_u
+                     (local.tee $3 (i64.reinterpret_f64 (local.get $y)))
+                     (i64.const 52))
+                  (i64.const 2047)))
+         (local.tee $6
+            (i64.and
+               (i64.shr_u
+                  (local.tee $5 (i64.reinterpret_f64 (local.get $x)))
+                  (i64.const 52))
+               (i64.const 2047)))))
+      (local.set $8 (i64.reinterpret_f64 (local.get $z)))
+      (block $label$1
+         (block $label$2
+            (br_if $label$2 (i64.gt_u (local.get $4) (i64.const 1993)))
+            (br_if $label$2 (i64.gt_u (local.get $6) (i64.const 1993)))
+            (br_if $label$2 (i64.gt_u (local.get $7) (i64.const 3016)))
+            (br_if $label$2
+               (i64.gt_u
+                  (i64.and (local.get $8) (i64.const 0x7fe0000000000000))
+                  (i64.const 0x7c90000000000000)))
+            (local.set $9 (i32.const 0))
+            (br_if $label$2 (i64.le_u (local.get $7) (i64.const 1076)))
+            (local.set $10 (i32.const 0))
+            (br $label$1))
+         (local.set $8
+            (i64.and (i64.shr_u (local.get $8) (i64.const 52))
+               (i64.const 2047)))
+         (block $cont
+            (br_if $cont (i64.eq (local.get $4) (i64.const 2047)))
+            (br_if $cont (i64.eq (local.get $6) (i64.const 2047)))
+            (br_if $cont (i64.ne (local.get $8) (i64.const 2047)))
+            (return
+               (struct.new $float
+                  (f64.add (f64.add (local.get $x) (local.get $z))
+                     (local.get $y)))))
+         (block $cont
+            (br_if $cont (f64.eq (local.get $y) (f64.const 0)))
+            (br_if $cont (f64.eq (local.get $x) (f64.const 0)))
+            (br_if $cont (f64.ne (local.get $z) (f64.const 0)))
+            (return
+               (struct.new $float
+                  (f64.mul (local.get $x) (local.get $y)))))
+         (block $cont
+            (block $then
+               (br_if $then (i64.eq (local.get $6) (i64.const 2047)))
+               (br_if $then (i64.eq (local.get $4) (i64.const 2047)))
+               (br_if $then (f64.eq (local.get $y) (f64.const 0)))
+               (br_if $then (f64.eq (local.get $x) (f64.const 0)))
+               (br_if $cont (i64.ne (local.get $8) (i64.const 2047))))
+            (return
+               (struct.new $float
+                  (f64.add (f64.mul (local.get $x) (local.get $y))
+                     (local.get $z)))))
+         (block $cont
+            (br_if $cont (i64.lt_u (local.get $7) (i64.const 3071)))
+            (return
+               (struct.new $float (f64.mul (local.get $x) (local.get $y)))))
+         (block $cont
+            (br_if $cont (i64.gt_u (local.get $7) (i64.const 967)))
+            (local.set $y
+               (select
+                  (f64.const 0x1p-1074)
+                  (f64.const -0x1p-1074)
+                  (i64.gt_s (i64.xor (local.get $3) (local.get $5))
+                     (i64.const -1))))
+            (block $cont2
+               (br_if $cont2 (i64.lt_u (local.get $8) (i64.const 3)))
+               (return
+                  (struct.new $float(f64.add (local.get $y) (local.get $z)))))
+            (return
+               (struct.new $float
+                  (f64.mul
+                     (f64.add (f64.mul (local.get $z) (f64.const 0x1p54))
+                        (local.get $y))
+                     (f64.const 0x1p-54)))))
+         (block $label$10
+            (block $label$11
+               (block $label$12
+                  (br_if $label$12 (i64.lt_u (local.get $7) (i64.const 3017)))
+                  (local.set $z
+                     (select
+                        (f64.mul (local.get $z) (f64.const 0x1p-53))
+                        (local.get $z)
+                        (i64.gt_u (local.get $8) (i64.const 53))))
+                  (local.set $x
+                     (select
+                        (f64.mul (local.get $x) (f64.const 0x1p-53))
+                        (local.get $x)
+                        (local.tee $9 (i64.gt_u (local.get $6) (local.get $4)))))
+                  (local.set $y
+                     (select
+                        (local.get $y)
+                        (f64.mul (local.get $y) (f64.const 0x1p-53))
+                        (local.get $9)))
+                  (br $label$11))
+               (br_if $label$10 (i64.lt_u (local.get $8) (i64.const 1994)))
+               (block $label$13
+                  (block $label$14
+                     (br_if $label$14 (i64.gt_u (local.get $7) (i64.const 1129)))
+                     (block $label$15
+                        (br_if $label$15
+                           (i64.le_u (local.get $6) (local.get $4)))
+                        (local.set $x
+                           (f64.mul (local.get $x) (f64.const 0x1p108)))
+                        (br $label$13))
+                     (local.set $y (f64.mul (local.get $y) (f64.const 0x1p108)))
+                     (br $label$13))
+                  (block $label$16
+                     (br_if $label$16 (i64.le_u (local.get $6) (local.get $4)))
+                     (local.set $x
+                        (select
+                           (f64.mul (local.get $x) (f64.const 0x1p-53))
+                           (local.get $x)
+                           (i64.gt_u (local.get $6) (i64.const 53))))
+                     (br $label$13))
+                  (local.set $y
+                     (select
+                        (f64.mul (local.get $y) (f64.const 0x1p-53))
+                        (local.get $y)
+                        (i64.gt_u (local.get $4) (i64.const 53)))))
+               (local.set $z (f64.mul (local.get $z) (f64.const 0x1p-53))))
+            (local.set $10 (i32.const 0))
+            (local.set $9 (i32.const 1))
+            (br $label$1))
+         (block $label$17
+            (block $label$18
+               (br_if $label$18 (i64.lt_u (local.get $6) (i64.const 1994)))
+               (local.set $y (f64.mul (local.get $y) (f64.const 0x1p53)))
+               (local.set $x (f64.mul (local.get $x) (f64.const 0x1p-53)))
+               (br $label$17))
+            (block $label$19
+               (br_if $label$19 (i64.lt_u (local.get $4) (i64.const 1994)))
+               (local.set $x (f64.mul (local.get $x) (f64.const 0x1p53)))
+               (local.set $y (f64.mul (local.get $y) (f64.const 0x1p-53)))
+               (br $label$17))
+            (local.set $z
+               (select
+                  (f64.mul (local.get $z) (f64.const 0x1p108))
+                  (local.get $z)
+                  (local.tee $10 (i64.lt_u (local.get $8) (i64.const 219)))))
+            (local.set $x
+               (select
+                  (f64.mul (local.get $x) (f64.const 0x1p108))
+                  (local.get $x)
+                  (local.tee $9 (i64.gt_u (local.get $6) (local.get $4)))))
+            (local.set $y
+               (select
+                  (local.get $y)
+                  (f64.mul (local.get $y) (f64.const 0x1p108))
+                  (local.get $9)))
+            (local.set $9 (i32.const 0))
+            (br $label$1))
+         (local.set $9 (i32.const 0))
+         (local.set $10 (i32.const 0)))
+      (block $cont
+         (br_if $cont (f64.ne (local.get $z) (f64.const 0)))
+         (br_if $cont
+            (i32.eqz
+               (i32.or
+                  (f64.eq (local.get $y) (f64.const 0))
+                  (f64.eq (local.get $x) (f64.const 0)))))
+         (return
+            (struct.new $float
+               (f64.add
+                  (f64.mul (local.get $x) (local.get $y)) (local.get $z)))))
+      (local.set $x
+         (f64.sub
             (f64.mul
-               (struct.get $float 0 (ref.cast (ref $float) (local.get $x)))
-               (struct.get $float 0 (ref.cast (ref $float) (local.get $y))))
-            (struct.get $float 0 (ref.cast (ref $float) (local.get $z))))))
+               (local.tee $12
+                  (f64.sub
+                     (local.get $x)
+                     (local.tee $11
+                        (f64.sub
+                           (local.tee $11
+                              (f64.mul (local.get $x) (f64.const 0x8000001)))
+                        (f64.sub (local.get $11) (local.get $x))))))
+               (local.tee $14
+                  (f64.sub
+                     (local.get $y)
+                     (local.tee $13
+                     (f64.sub
+                        (local.tee $13
+                           (f64.mul (local.get $y) (f64.const 0x8000001)))
+                        (f64.sub (local.get $13) (local.get $y)))))))
+            (f64.sub
+               (f64.sub
+                  (f64.sub
+                     (local.tee $15 (f64.mul (local.get $y) (local.get $x)))
+                     (f64.mul (local.get $11) (local.get $13)))
+                  (f64.mul (local.get $12) (local.get $13)))
+               (f64.mul (local.get $11) (local.get $14)))))
+      (block $label$21
+         (block $label$22
+            (br_if $label$22
+               (f64.ne
+                  (local.tee $y (f64.add (local.get $z) (local.get $15)))
+                  (f64.const 0)))
+            (br_if $label$21 (f64.eq (local.get $x) (f64.const 0))))
+         (block $cont
+            (br_if $cont
+               (f64.eq
+                  (local.tee $z
+                     (f64.add
+                        (local.tee $11
+                           (f64.add
+                              (f64.sub (local.get $x)
+                                 (local.tee $13
+                                    (f64.sub
+                                       (local.tee $z
+                                          (f64.add
+                                             (local.tee $11
+                                                (f64.add
+                                                   (f64.sub (local.get $15)
+                                                      (local.tee $11
+                                                         (f64.sub
+                                                            (local.get $y)
+                                                            (local.get $z))))
+                                                   (f64.sub (local.get $z)
+                                                      (f64.sub
+                                                         (local.get $y)
+                                                         (local.get $11)))))
+                                             (local.get $x)))
+                                          (local.get $11))))
+                              (f64.sub (local.get $11)
+                                 (f64.sub (local.get $z) (local.get $13)))))
+                        (f64.sub
+                           (local.tee $y
+                              (f64.add
+                                 (f64.sub (local.get $z)
+                                    (local.tee $13
+                                       (f64.sub
+                                          (local.tee $x
+                                             (f64.add (local.get $y)
+                                                (local.get $z)))
+                                          (local.get $y))))
+                                 (f64.sub
+                                    (local.get $y)
+                                    (f64.sub (local.get $x) (local.get $13)))))
+                           (local.tee $y
+                              (f64.add (local.get $11) (local.get $y))))))
+                  (f64.const 0)))
+            (br_if $cont
+               (i32.and
+                  (i32.wrap_i64
+                     (local.tee $4 (i64.reinterpret_f64 (local.get $y))))
+                  (i32.const 1)))
+            (local.set $y
+               (f64.reinterpret_i64
+                  (i64.add
+                     (select
+                        (i64.const 1)
+                        (i64.const -1)
+                        (i32.xor
+                           (f64.lt (local.get $y) (f64.const 0))
+                           (f64.gt (local.get $z) (f64.const 0))))
+                     (local.get $4)))))
+         (local.set $y (f64.add (local.get $x) (local.get $y)))
+         (block $cont
+            (br_if $cont (i32.eqz (local.get $9)))
+            (return
+               (struct.new $float
+                  (f64.mul (local.get $y) (f64.const 0x1p53)))))
+         (local.set $y
+            (select
+               (f64.mul (local.get $y) (f64.const 0x1p-108))
+               (local.get $y)
+               (local.get $10))))
+      (struct.new $float (local.get $y)))
 
    (func (export "caml_float_compare")
       (param (ref eq)) (param (ref eq)) (result (ref eq))

From 9e6496fb3b93dca5aebec81042ada389504539e6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 14 Sep 2023 14:54:11 +0200
Subject: [PATCH 131/481] Jsoo: remove spurious newline when outputing uncaught
 exception

---
 compiler/tests-compiler/error.ml                             | 5 -----
 compiler/tests-jsoo/bin/error1-unregister.expected           | 1 -
 compiler/tests-jsoo/bin/error2-unregister.expected           | 1 -
 .../tests-ocaml/lib-effects/unhandled_unlinked.reference     | 1 -
 runtime/sys.js                                               | 2 +-
 5 files changed, 1 insertion(+), 9 deletions(-)

diff --git a/compiler/tests-compiler/error.ml b/compiler/tests-compiler/error.ml
index ba32032f09..2faf9b1131 100644
--- a/compiler/tests-compiler/error.ml
+++ b/compiler/tests-compiler/error.ml
@@ -32,7 +32,6 @@ let%expect_test "uncaugh error" =
     {|
     Fatal error: exception Not_found
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   compile_and_run_bytecode prog;
@@ -57,7 +56,6 @@ let _ = raise C |}
     {|
     Fatal error: exception Test.C
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   let prog =
@@ -74,7 +72,6 @@ let _ = raise (D(2,"test",43L))
     {|
     Fatal error: exception Test.D(2, "test", _)
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   let prog =
@@ -89,7 +86,6 @@ let _ = assert false |}
     {|
     Fatal error: exception Assert_failure("test.ml", 4, 8)
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   let prog =
@@ -104,7 +100,6 @@ let () = Callback.register "Printexc.handle_uncaught_exception" null
     {|
     Fatal error: exception Match_failure("test.ml", 4, 33)
 
-
     process exited with error code 2
      %{NODE} test.js |}];
 
diff --git a/compiler/tests-jsoo/bin/error1-unregister.expected b/compiler/tests-jsoo/bin/error1-unregister.expected
index 203ebe2e92..fa6fc3697b 100644
--- a/compiler/tests-jsoo/bin/error1-unregister.expected
+++ b/compiler/tests-jsoo/bin/error1-unregister.expected
@@ -1,2 +1 @@
 Fatal error: exception Dune__exe__Error1.D(2, "test", _)
-
diff --git a/compiler/tests-jsoo/bin/error2-unregister.expected b/compiler/tests-jsoo/bin/error2-unregister.expected
index d0b406a4bf..f622dbe18b 100644
--- a/compiler/tests-jsoo/bin/error2-unregister.expected
+++ b/compiler/tests-jsoo/bin/error2-unregister.expected
@@ -1,2 +1 @@
 Fatal error: exception Match_failure("compiler/tests-jsoo/bin/error2.ml", 13, 2)
-
diff --git a/compiler/tests-ocaml/lib-effects/unhandled_unlinked.reference b/compiler/tests-ocaml/lib-effects/unhandled_unlinked.reference
index 25154b793c..73cee5f415 100644
--- a/compiler/tests-ocaml/lib-effects/unhandled_unlinked.reference
+++ b/compiler/tests-ocaml/lib-effects/unhandled_unlinked.reference
@@ -1,2 +1 @@
 Fatal error: exception Effect.Unhandled
-
diff --git a/runtime/sys.js b/runtime/sys.js
index e06a3d7402..02c57da15b 100644
--- a/runtime/sys.js
+++ b/runtime/sys.js
@@ -90,7 +90,7 @@ function caml_fatal_uncaught_exception(err){
       var msg = caml_format_exception(err);
       var at_exit = caml_named_value("Pervasives.do_at_exit");
       if(at_exit) caml_callback(at_exit, [0]);
-      console.error("Fatal error: exception " + msg + "\n");
+      console.error("Fatal error: exception " + msg);
       if(err.js_error) throw err.js_error;
     }
   }

From 89469e0a58ee92492c86aeb27f5e17375d164bbb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 14 Sep 2023 18:27:39 +0200
Subject: [PATCH 132/481] Unboxed float arrays

---
 compiler/lib/eval.ml                |  12 +-
 compiler/lib/generate.ml            |   4 +
 compiler/lib/global_flow.ml         |  10 +-
 compiler/lib/parse_bytecode.ml      |  20 +-
 compiler/lib/specialize_js.ml       |  80 +++++--
 compiler/lib/wasm/wa_core_target.ml |  14 ++
 compiler/lib/wasm/wa_gc_target.ml   | 183 ++++++++++++---
 compiler/lib/wasm/wa_generate.ml    |  42 +++-
 compiler/lib/wasm/wa_target_sig.ml  |  18 +-
 runtime/wasm/array.wat              | 340 +++++++++++++++++++---------
 runtime/wasm/bigarray.wat           |  69 ++----
 runtime/wasm/compare.wat            |  81 ++++---
 runtime/wasm/marshal.wat            |  57 +++--
 runtime/wasm/obj.wat                |  36 ++-
 14 files changed, 678 insertions(+), 288 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index c7bdd00494..ba6f08828b 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -242,7 +242,17 @@ let eval_instr ~target info ((x, loc) as i) =
           let c = Constant (Int (Regular, c)) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
-  | Let (_, Prim (Extern ("caml_array_unsafe_get" | "caml_array_unsafe_set"), _)) ->
+  | Let
+      ( _
+      , Prim
+          ( ( Extern
+                ( "caml_array_unsafe_get"
+                | "caml_array_unsafe_set"
+                | "caml_floatarray_unsafe_get"
+                | "caml_floatarray_unsafe_set"
+                | "caml_array_unsafe_set_addr" )
+            | Array_get )
+          , _ ) ) ->
       (* Fresh parameters can be introduced for these primitives
            in Specialize_js, which would make the call to [the_const_of]
            below fail. *)
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index fd431eeb59..202c4773c5 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1131,6 +1131,8 @@ let _ =
   register_bin_prim "caml_fmod_float" `Pure (fun cx cy _ -> J.EBin (J.Mod, cx, cy));
   register_tern_prim "caml_array_unsafe_set" (fun cx cy cz _ ->
       J.EBin (J.Eq, Mlvalue.Array.field cx cy, cz));
+  register_tern_prim "caml_array_unsafe_set_addr" (fun cx cy cz _ ->
+      J.EBin (J.Eq, Mlvalue.Array.field cx cy, cz));
   register_un_prim "caml_alloc_dummy" `Pure (fun _ _ -> J.array []);
   register_un_prim "caml_obj_dup" `Mutable (fun cx loc ->
       J.call (J.dot cx (Utf8_string.of_string_exn "slice")) [] loc);
@@ -2154,6 +2156,8 @@ let init () =
     ; "caml_floatarray_unsafe_get", "caml_array_unsafe_get"
     ; "caml_array_unsafe_set_float", "caml_array_unsafe_set"
     ; "caml_floatarray_unsafe_set", "caml_array_unsafe_set"
+    ; "caml_check_bound_gen", "caml_check_bound"
+    ; "caml_check_bound_float", "caml_check_bound"
     ; "caml_alloc_dummy_float", "caml_alloc_dummy"
     ; "caml_make_array", "%identity"
     ; "caml_ensure_stack_capacity", "%identity"
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index 849b3456c6..61d9cbda36 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -153,7 +153,11 @@ let expr_deps blocks st x e =
   match e with
   | Constant _ | Prim ((Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) | Block _
     -> ()
-  | Prim ((Extern ("caml_check_bound" | "caml_array_unsafe_get") | Array_get), l) ->
+  | Prim
+      ( ( Extern
+            ("caml_check_bound" | "caml_array_unsafe_get" | "caml_floatarray_unsafe_get")
+        | Array_get )
+      , l ) ->
       (* The analysis knowns about these primitives, and will compute
          an approximation of the value they return based on an
          approximation of their arguments *)
@@ -415,7 +419,9 @@ let propagate st ~update approx x =
                 known
           | Top -> Top)
       | Prim (Extern "caml_check_bound", [ Pv y; _ ]) -> Var.Tbl.get approx y
-      | Prim ((Array_get | Extern "caml_array_unsafe_get"), [ Pv y; _ ]) -> (
+      | Prim
+          ( (Array_get | Extern ("caml_array_unsafe_get" | "caml_floatarray_unsafe_get"))
+          , [ Pv y; _ ] ) -> (
           if st.fast
           then Domain.others
           else
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index d3e73b6aca..65421c1405 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -1480,7 +1480,17 @@ and compile infos pc state instrs =
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
-        compile infos (pc + 2) state ((Let (x, Field (y, n)), loc) :: instrs)
+        compile
+          infos
+          (pc + 2)
+          state
+          (( Let
+               ( x
+               , Prim
+                   ( Extern "caml_floatarray_unsafe_get"
+                   , [ Pv y; Pc (Int (Regular, Int32.of_int n)) ] ) )
+           , loc )
+          :: instrs)
     | SETFIELD0 ->
         let y, _ = State.accu state in
         let z, _ = State.peek 0 state in
@@ -1554,7 +1564,13 @@ and compile infos pc state instrs =
           infos
           (pc + 2)
           (State.pop 1 state)
-          ((Let (x, const 0l), loc) :: (Set_field (y, n, z), loc) :: instrs)
+          (( Let
+               ( x
+               , Prim
+                   ( Extern "caml_floatarray_unsafe_set"
+                   , [ Pv y; Pc (Int (Regular, Int32.of_int n)); Pv z ] ) )
+           , loc )
+          :: instrs)
     | VECTLENGTH ->
         let y, _ = State.accu state in
         let x, state = State.fresh_var state loc in
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 91502ab82e..2b3825ff0c 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -160,50 +160,90 @@ let specialize_instrs ~target info l =
            the array access. The bound checking function returns the array,
            which allows to produce more compact code. *)
         match i with
-        | Let (x, Prim (Extern "caml_array_get", [ y; z ]))
-        | Let (x, Prim (Extern "caml_array_get_float", [ y; z ]))
-        | Let (x, Prim (Extern "caml_floatarray_get", [ y; z ]))
-        | Let (x, Prim (Extern "caml_array_get_addr", [ y; z ])) ->
+        | Let
+            ( x
+            , Prim
+                ( Extern
+                    (( "caml_array_get"
+                     | "caml_array_get_float"
+                     | "caml_floatarray_get"
+                     | "caml_array_get_addr" ) as prim)
+                , [ y; z ] ) ) ->
             let idx =
               match the_int info z with
               | Some idx -> `Cst idx
               | None -> `Var z
             in
+            let instr y =
+              let prim =
+                match prim with
+                | "caml_array_get" -> Extern "caml_array_unsafe_get"
+                | "caml_array_get_float" | "caml_floatarray_get" ->
+                    Extern "caml_floatarray_unsafe_get"
+                | "caml_array_get_addr" -> Array_get
+                | _ -> assert false
+              in
+              Let (x, Prim (prim, [ y; z ])), loc
+            in
             if List.mem (y, idx) ~set:checks
             then
-              let acc =
-                (Let (x, Prim (Extern "caml_array_unsafe_get", [ y; z ])), loc) :: acc
-              in
+              let acc = instr y :: acc in
               aux info checks r acc
             else
+              let check =
+                match prim with
+                | "caml_array_get" -> "caml_check_bound_gen"
+                | "caml_array_get_float" | "caml_floatarray_get" ->
+                    "caml_check_bound_float"
+                | "caml_array_get_addr" -> "caml_check_bound"
+                | _ -> assert false
+              in
               let y' = Code.Var.fresh () in
               let acc =
-                (Let (x, Prim (Extern "caml_array_unsafe_get", [ Pv y'; z ])), loc)
-                :: (Let (y', Prim (Extern "caml_check_bound", [ y; z ])), noloc)
-                :: acc
+                instr (Pv y') :: (Let (y', Prim (Extern check, [ y; z ])), noloc) :: acc
               in
               aux info ((y, idx) :: checks) r acc
-        | Let (x, Prim (Extern "caml_array_set", [ y; z; t ]))
-        | Let (x, Prim (Extern "caml_array_set_float", [ y; z; t ]))
-        | Let (x, Prim (Extern "caml_floatarray_set", [ y; z; t ]))
-        | Let (x, Prim (Extern "caml_array_set_addr", [ y; z; t ])) ->
+        | Let
+            ( x
+            , Prim
+                ( Extern
+                    (( "caml_array_set"
+                     | "caml_array_set_float"
+                     | "caml_floatarray_set"
+                     | "caml_array_set_addr" ) as prim)
+                , [ y; z; t ] ) ) ->
             let idx =
               match the_int info z with
               | Some idx -> `Cst idx
               | None -> `Var z
             in
+            let instr y =
+              let prim =
+                match prim with
+                | "caml_array_set" -> "caml_array_unsafe_set"
+                | "caml_array_set_float" | "caml_floatarray_set" ->
+                    "caml_floatarray_unsafe_set"
+                | "caml_array_set_addr" -> "caml_array_unsafe_set_addr"
+                | _ -> assert false
+              in
+              Let (x, Prim (Extern prim, [ y; z; t ])), loc
+            in
             if List.mem (y, idx) ~set:checks
             then
-              let acc =
-                (Let (x, Prim (Extern "caml_array_unsafe_set", [ y; z; t ])), loc) :: acc
-              in
+              let acc = instr y :: acc in
               aux info checks r acc
             else
+              let check =
+                match prim with
+                | "caml_array_set" -> "caml_check_bound_gen"
+                | "caml_array_set_float" | "caml_floatarray_set" ->
+                    "caml_check_bound_float"
+                | "caml_array_set_addr" -> "caml_check_bound"
+                | _ -> assert false
+              in
               let y' = Code.Var.fresh () in
               let acc =
-                (Let (x, Prim (Extern "caml_array_unsafe_set", [ Pv y'; z; t ])), loc)
-                :: (Let (y', Prim (Extern "caml_check_bound", [ y; z ])), noloc)
-                :: acc
+                instr (Pv y') :: (Let (y', Prim (Extern check, [ y; z ])), noloc) :: acc
               in
               aux info ((y, idx) :: checks) r acc
         | _ ->
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 20e3df990d..827e22ba69 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -99,6 +99,20 @@ module Memory = struct
 
   let array_set e e' e'' = mem_store Arith.(e + ((e' - const 1l) lsl const 1l)) e''
 
+  let float_array_get = array_get
+
+  let float_array_set = array_set
+
+  let gen_array_get = array_get
+
+  let gen_array_set = array_set
+
+  let array_length = block_length
+
+  let float_array_length = array_length
+
+  let gen_array_length = array_length
+
   let bytes_length e =
     let l = Code.Var.fresh () in
     Arith.(
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index a76f941896..c7fcd43073 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -33,6 +33,14 @@ module Type = struct
           ; typ = W.Struct [ { mut = false; typ = Value F64 } ]
           })
 
+  let float_array_type =
+    register_type "float_array" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Array { mut = true; typ = Value F64 }
+          })
+
   let compare_type =
     register_type "compare" (fun () ->
         return
@@ -443,19 +451,6 @@ module Value = struct
 end
 
 module Memory = struct
-  let allocate _ _ ~tag l =
-    let* l =
-      expression_list
-        (fun v ->
-          match v with
-          | `Var y -> load y
-          | `Expr e -> return e)
-        l
-    in
-    let* ty = Type.block_type in
-    return (W.ArrayNewFixed (ty, RefI31 (Const (I32 (Int32.of_int tag))) :: l))
-  (*ZZZ Float array?*)
-
   let wasm_cast ty e =
     let* e = e in
     return (W.RefCast ({ nullable = false; typ = Type ty }, e))
@@ -491,17 +486,152 @@ module Memory = struct
     let* e'' = e'' in
     instr (W.ArraySet (ty, e, e', e''))
 
+  let box_float _ _ e =
+    let* ty = Type.float_type in
+    let* e = e in
+    return (W.StructNew (ty, [ e ]))
+
+  let unbox_float e =
+    let* ty = Type.float_type in
+    wasm_struct_get ty (wasm_cast ty e) 0
+
+  let allocate _ _ ~tag l =
+    if tag = 254
+    then
+      let* l =
+        expression_list
+          (fun v ->
+            unbox_float
+              (match v with
+              | `Var y -> load y
+              | `Expr e -> return e))
+          l
+      in
+      let* ty = Type.float_array_type in
+      return (W.ArrayNewFixed (ty, l))
+    else
+      let* l =
+        expression_list
+          (fun v ->
+            match v with
+            | `Var y -> load y
+            | `Expr e -> return e)
+          l
+      in
+      let* ty = Type.block_type in
+      return (W.ArrayNewFixed (ty, RefI31 (Const (I32 (Int32.of_int tag))) :: l))
+
   let tag e = Value.int_val (wasm_array_get e (Arith.const 0l))
 
-  let block_length e =
-    let* ty = Type.block_type in
-    let* e = wasm_cast ty e in
-    Arith.(return (W.ArrayLen e) - const 1l)
+  let array_length e =
+    let* block = Type.block_type in
+    let* e = e in
+    Arith.(
+      return (W.ArrayLen (W.RefCast ({ nullable = false; typ = Type block }, e)))
+      - const 1l)
+
+  let float_array_length e =
+    let* float_array = Type.float_array_type in
+    let* e = e in
+    return (W.ArrayLen (W.RefCast ({ nullable = false; typ = Type float_array }, e)))
+
+  let gen_array_length e =
+    let a = Code.Var.fresh_n "a" in
+    block_expr
+      { params = []; result = [ I32 ] }
+      (let* () = store a e in
+       let* () =
+         drop
+           (block_expr
+              { params = []; result = [ Type.value ] }
+              (let* block = Type.block_type in
+               let* a = load a in
+               let* e =
+                 Arith.(
+                   return
+                     (W.ArrayLen
+                        (W.Br_on_cast_fail
+                           ( 0
+                           , { nullable = false; typ = Eq }
+                           , { nullable = false; typ = Type block }
+                           , a )))
+                   - const 1l)
+               in
+               instr (Br (1, Some e))))
+       in
+       let* e = float_array_length (load a) in
+       instr (W.Push e))
 
   let array_get e e' = wasm_array_get e Arith.(Value.int_val e' + const 1l)
 
   let array_set e e' e'' = wasm_array_set e Arith.(Value.int_val e' + const 1l) e''
 
+  let float_array_get e e' =
+    box_float () () (wasm_array_get ~ty:Type.float_array_type e (Value.int_val e'))
+
+  let float_array_set e e' e'' =
+    wasm_array_set ~ty:Type.float_array_type e (Value.int_val e') (unbox_float e'')
+
+  let gen_array_get e e' =
+    let a = Code.Var.fresh_n "a" in
+    let i = Code.Var.fresh_n "i" in
+    block_expr
+      { params = []; result = [ Value.value ] }
+      (let* () = store a e in
+       let* () = store ~typ:I32 i (Value.int_val e') in
+       let* () =
+         drop
+           (block_expr
+              { params = []; result = [ Value.value ] }
+              (let* block = Type.block_type in
+               let* a = load a in
+               let* e =
+                 wasm_array_get
+                   (return
+                      (W.Br_on_cast_fail
+                         ( 0
+                         , { nullable = false; typ = Eq }
+                         , { nullable = false; typ = Type block }
+                         , a )))
+                   Arith.(load i + const 1l)
+               in
+               instr (Br (1, Some e))))
+       in
+       let* e =
+         box_float () () (wasm_array_get ~ty:Type.float_array_type (load a) (load i))
+       in
+       instr (W.Push e))
+
+  let gen_array_set e e' e'' =
+    let a = Code.Var.fresh_n "a" in
+    let i = Code.Var.fresh_n "i" in
+    let v = Code.Var.fresh_n "v" in
+    let* () = store a e in
+    let* () = store ~typ:I32 i (Value.int_val e') in
+    let* () = store v e'' in
+    block
+      { params = []; result = [] }
+      (let* () =
+         drop
+           (block_expr
+              { params = []; result = [ Value.value ] }
+              (let* block = Type.block_type in
+               let* a = load a in
+               let* () =
+                 wasm_array_set
+                   (return
+                      (W.Br_on_cast_fail
+                         ( 0
+                         , { nullable = false; typ = Eq }
+                         , { nullable = false; typ = Type block }
+                         , a )))
+                   Arith.(load i + const 1l)
+                   (load v)
+               in
+               instr (Br (1, None))))
+       in
+       wasm_array_set ~ty:Type.float_array_type (load a) (load i) (unbox_float (load v)))
+
   let bytes_length e =
     let* ty = Type.string_type in
     let* e = wasm_cast ty e in
@@ -560,15 +690,6 @@ module Memory = struct
     in
     if_mismatch
 
-  let box_float _ _ e =
-    let* ty = Type.float_type in
-    let* e = e in
-    return (W.StructNew (ty, [ e ]))
-
-  let unbox_float e =
-    let* ty = Type.float_type in
-    wasm_struct_get ty (wasm_cast ty e) 0
-
   let make_int32 ~kind e =
     let* custom_operations = Type.custom_operations_type in
     let* int32_ops =
@@ -688,15 +809,9 @@ module Constant = struct
         return (true, W.StructNew (ty, [ Const (F64 f) ]))
     | Float_array l ->
         let l = Array.to_list l in
-        let* bl_ty = Type.block_type in
-        let* ty = Type.float_type in
+        let* ty = Type.float_array_type in
         (*ZZZ Boxed array? *)
-        return
-          ( true
-          , W.ArrayNewFixed
-              ( bl_ty
-              , RefI31 (Const (I32 (Int32.of_int Obj.double_array_tag)))
-                :: List.map ~f:(fun f -> W.StructNew (ty, [ Const (F64 f) ])) l ) )
+        return (true, W.ArrayNewFixed (ty, List.map ~f:(fun f -> W.Const (F64 f)) l))
     | Int64 i ->
         let* e = Memory.make_int64 (return (W.Const (I64 i))) in
         return (true, e)
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 5284acd785..d97259eef2 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -141,11 +141,14 @@ module Generate (Target : Wa_target_sig.S) = struct
     | Prim (p, l) -> (
         let l = List.map ~f:transl_prim_arg l in
         match p, l with
-        (*ZZZ array operations need to deal with array of unboxed floats *)
-        | Extern ("caml_array_unsafe_get" | "caml_floatarray_unsafe_get"), [ x; y ] ->
-            Memory.array_get x y
-        | Extern ("caml_array_unsafe_set" | "caml_floatarray_unsafe_set"), [ x; y; z ] ->
+        | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.gen_array_get x y
+        | Extern "caml_floatarray_unsafe_get", [ x; y ] -> Memory.float_array_get x y
+        | Extern "caml_array_unsafe_set", [ x; y; z ] ->
+            seq (Memory.gen_array_set x y z) Value.unit
+        | Extern "caml_array_unsafe_set_addr", [ x; y; z ] ->
             seq (Memory.array_set x y z) Value.unit
+        | Extern "caml_floatarray_unsafe_set", [ x; y; z ] ->
+            seq (Memory.float_array_set x y z) Value.unit
         | Extern ("caml_string_unsafe_get" | "caml_bytes_unsafe_get"), [ x; y ] ->
             Memory.bytes_get x y
         | Extern ("caml_string_unsafe_set" | "caml_bytes_unsafe_set"), [ x; y; z ] ->
@@ -226,7 +229,29 @@ module Generate (Target : Wa_target_sig.S) = struct
             seq
               (if_
                  { params = []; result = [] }
-                 (Arith.uge (Value.int_val y) (Memory.block_length x))
+                 (Arith.uge (Value.int_val y) (Memory.array_length x))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              x
+        | Extern "caml_check_bound_gen", [ x; y ] ->
+            let* f =
+              register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
+            in
+            seq
+              (if_
+                 { params = []; result = [] }
+                 (Arith.uge (Value.int_val y) (Memory.gen_array_length x))
+                 (instr (CallInstr (f, [])))
+                 (return ()))
+              x
+        | Extern "caml_check_bound_float", [ x; y ] ->
+            let* f =
+              register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
+            in
+            seq
+              (if_
+                 { params = []; result = [] }
+                 (Arith.uge (Value.int_val y) (Memory.float_array_length x))
                  (instr (CallInstr (f, [])))
                  (return ()))
               x
@@ -615,7 +640,7 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Ult, [ x; y ] -> Value.ult x y
         | Array_get, [ x; y ] -> Memory.array_get x y
         | IsInt, [ x ] -> Value.is_int x
-        | Vectlength, [ x ] -> Value.val_int (Memory.block_length x)
+        | Vectlength, [ x ] -> Value.val_int (Memory.gen_array_length x)
         | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
             assert false)
 
@@ -992,10 +1017,7 @@ end
 let init () =
   List.iter
     ~f:(fun (nm, nm') -> Primitive.alias nm nm')
-    [ "caml_alloc_dummy_float", "caml_alloc_dummy" (*ZZZ*)
-    ; "caml_make_array", "%identity"
-    ; "caml_ensure_stack_capacity", "%identity"
-    ]
+    [ "caml_make_array", "%identity"; "caml_ensure_stack_capacity", "%identity" ]
 
 (* Make sure we can use [br_table] for switches *)
 let fix_switch_branches p =
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 492f1e663f..69637a15a5 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -90,14 +90,28 @@ module type S = sig
 
     val array_set : expression -> expression -> expression -> unit Wa_code_generation.t
 
+    val float_array_get : expression -> expression -> expression
+
+    val float_array_set :
+      expression -> expression -> expression -> unit Wa_code_generation.t
+
+    val gen_array_get : expression -> expression -> expression
+
+    val gen_array_set :
+      expression -> expression -> expression -> unit Wa_code_generation.t
+
+    val array_length : expression -> expression
+
+    val float_array_length : expression -> expression
+
+    val gen_array_length : expression -> expression
+
     val bytes_length : expression -> expression
 
     val bytes_get : expression -> expression -> expression
 
     val bytes_set : expression -> expression -> expression -> unit Wa_code_generation.t
 
-    val block_length : expression -> expression
-
     val box_float : Stack.ctx -> Code.Var.t -> expression -> expression
 
     val unbox_float : expression -> expression
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index a9abdebe53..311a2cb9b5 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -1,160 +1,296 @@
 (module
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
-   (import "obj" "double_array_tag" (global $double_array_tag i32))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
+   (type $float_array (array (mut f64)))
 
    (data $Array_make "Array.make")
 
+   (global $empty_array (ref eq)
+      (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
+
    (func $caml_make_vect (export "caml_make_vect")
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
-      (local $sz i32) (local $b (ref $block))
+      (local $sz i32) (local $b (ref $block)) (local $f f64)
       (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
       (if (i32.lt_s (local.get $sz) (i32.const 0))
          (then
             (call $caml_invalid_argument
                (array.new_data $string $Array_make
                                (i32.const 0) (i32.const 10)))))
+      (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array))))
+      (drop (block $not_float (result (ref eq))
+         (local.set $f
+            (struct.get $float 0
+               (br_on_cast_fail $not_float (ref eq) (ref $float)
+                  (local.get $v))))
+         (return (array.new $float_array (local.get $f) (local.get $sz)))))
       (local.set $b
          (array.new $block (local.get $v)
             (i32.add (local.get $sz) (i32.const 1))))
-      ;; ZZZ float array
-      (array.set $block (local.get $b) (i32.const 0)
-         (ref.i31
-            (select (global.get $double_array_tag) (i32.const 0)
-               (i32.and
-                  (local.get $sz) (ref.test (ref $float) (local.get $v))))))
+      (array.set $block (local.get $b) (i32.const 0) (ref.i31 (i32.const 0)))
       (local.get $b))
 
    (export "caml_make_float_vect" (func $caml_floatarray_create))
    (func $caml_floatarray_create (export "caml_floatarray_create")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ float array
-      (return_call $caml_make_vect
-         (local.get 0) (struct.new $float (f64.const 0))))
+      (param $n (ref eq)) (result (ref eq))
+      (local $sz i32)
+      (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
+      (if (i32.lt_s (local.get $sz) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Array_make
+                               (i32.const 0) (i32.const 10)))))
+      (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array))))
+      (array.new $float_array (f64.const 0) (local.get $sz)))
+
+   (func (export "caml_floatarray_unsafe_get")
+      (param $a (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (struct.new $float
+         (array.get $float_array (ref.cast (ref $float_array) (local.get $a))
+            (i31.get_s (ref.cast (ref i31) (local.get $i))))))
+
+   (func (export "caml_floatarray_unsafe_set")
+      (param $a (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (result (ref eq))
+      (array.set $float_array (ref.cast (ref $float_array) (local.get $a))
+         (i31.get_s (ref.cast (ref i31) (local.get $i)))
+         (struct.get $float 0 (ref.cast (ref $float) (local.get $v))))
+      (ref.i31 (i32.const 0)))
 
    (func (export "caml_array_sub")
       (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
       (result (ref eq))
       (local $a1 (ref $block)) (local $a2 (ref $block)) (local $len i32)
+      (local $fa1 (ref $float_array)) (local $fa2 (ref $float_array))
       (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
-      (local.set $a1 (ref.cast (ref $block) (local.get $a)))
-      (local.set $a2 (array.new $block (ref.i31 (i32.const 0))
-                        (i32.add (local.get $len) (i32.const 1))))
-      (array.set $block (local.get $a2) (i32.const 0)
-         (array.get $block (local.get $a1) (i32.const 0)))
-      (if (local.get $len)
-         (then
-            (array.copy $block $block
-               (local.get $a2) (i32.const 1) (local.get $a1)
-               (i32.add
-                  (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))
-               (local.get $len))))
-      (local.get $a2))
+      (if (i32.eqz (local.get $len)) (then (return (global.get $empty_array))))
+      (drop (block $not_block (result (ref eq))
+         (local.set $a1
+            (br_on_cast_fail $not_block (ref eq) (ref $block) (local.get $a)))
+         (local.set $a2 (array.new $block (ref.i31 (i32.const 0))
+                           (i32.add (local.get $len) (i32.const 1))))
+         (array.set $block (local.get $a2) (i32.const 0)
+            (array.get $block (local.get $a1) (i32.const 0)))
+         (array.copy $block $block
+            (local.get $a2) (i32.const 1) (local.get $a1)
+            (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i)))
+               (i32.const 1))
+            (local.get $len))
+         (return (local.get $a2))))
+      (local.set $fa1 (ref.cast (ref $float_array) (local.get $a)))
+      (local.set $fa2 (array.new $float_array (f64.const 0) (local.get $len)))
+      (array.copy $float_array $float_array
+         (local.get $fa2) (i32.const 0) (local.get $fa1)
+         (i31.get_u (ref.cast (ref i31) (local.get $i)))
+         (local.get $len))
+      (local.get $fa2))
+
+   (func $caml_floatarray_dup (param $a (ref $float_array)) (result (ref eq))
+      (local $a' (ref $float_array))
+      (local $len i32)
+      (local.set $len (array.len (local.get $a)))
+      (local.set $a' (array.new $float_array (f64.const 0) (local.get $len)))
+      (array.copy $float_array $float_array
+         (local.get $a') (i32.const 0) (local.get $a) (i32.const 0)
+         (local.get $len))
+      (local.get $a'))
 
    (func (export "caml_array_append")
       (param $va1 (ref eq)) (param $va2 (ref eq)) (result (ref eq))
       (local $a1 (ref $block)) (local $a2 (ref $block)) (local $a (ref $block))
+      (local $fa1 (ref $float_array)) (local $fa2 (ref $float_array))
+      (local $fa (ref $float_array))
       (local $l1 i32) (local $l2 i32)
-      (local.set $a1 (ref.cast (ref $block) (local.get $va1)))
-      (local.set $l1 (array.len (local.get $a1)))
-      (local.set $a2 (ref.cast (ref $block) (local.get $va2)))
-      (local.set $l2 (array.len (local.get $a2)))
-      (local.set $a
-         (array.new $block (ref.i31 (i32.const 0))
-            (i32.sub (i32.add (local.get $l1) (local.get $l2)) (i32.const 1))))
-      ;; ZZZ float array
-      (array.set $block (local.get $a) (i32.const 0)
-         (ref.i31
-            (select (global.get $double_array_tag) (i32.const 0)
-               (i32.or
-                  (ref.eq (array.get $block (local.get $a1) (i32.const 0))
-                     (ref.i31 (global.get $double_array_tag)))
-                  (ref.eq (array.get $block (local.get $a2) (i32.const 0))
-                     (ref.i31 (global.get $double_array_tag)))))))
-      (array.copy $block $block
-         (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
-         (i32.sub (local.get $l1) (i32.const 1)))
-      (array.copy $block $block
-         (local.get $a) (local.get $l1) (local.get $a2) (i32.const 1)
-         (i32.sub (local.get $l2) (i32.const 1)))
-      (local.get $a))
+      (drop (block $a1_not_block (result (ref eq))
+         (local.set $a1
+            (br_on_cast_fail $a1_not_block (ref eq) (ref $block)
+               (local.get $va1)))
+         (drop (block $a2_not_block (result (ref eq))
+            (local.set $a2
+               (br_on_cast_fail $a2_not_block (ref eq) (ref $block)
+                  (local.get $va2)))
+            (local.set $l1 (array.len (local.get $a1)))
+            (local.set $l2 (array.len (local.get $a2)))
+            (local.set $a
+               (array.new $block (ref.i31 (i32.const 0))
+                  (i32.sub (i32.add (local.get $l1) (local.get $l2))
+                     (i32.const 1))))
+            (array.copy $block $block
+               (local.get $a) (i32.const 1) (local.get $a1) (i32.const 1)
+               (i32.sub (local.get $l1) (i32.const 1)))
+            (array.copy $block $block
+               (local.get $a) (local.get $l1) (local.get $a2) (i32.const 1)
+               (i32.sub (local.get $l2) (i32.const 1)))
+            (return (local.get $a))))
+         (return_call $caml_floatarray_dup
+            (ref.cast (ref $float_array) (local.get $va2)))))
+      (local.set $fa1 (ref.cast (ref $float_array) (local.get $va1)))
+      (drop (block $a2_not_float_array (result (ref eq))
+         (local.set $fa2
+            (br_on_cast_fail $a2_not_float_array (ref eq) (ref $float_array)
+               (local.get $va2)))
+         (local.set $l1 (array.len (local.get $fa1)))
+         (local.set $l2 (array.len (local.get $fa2)))
+         (local.set $fa
+            (array.new $float_array (f64.const 0)
+               (i32.add (local.get $l1) (local.get $l2))))
+         (array.copy $float_array $float_array
+            (local.get $fa) (i32.const 0) (local.get $fa1) (i32.const 0)
+            (local.get $l1))
+         (array.copy $float_array $float_array
+            (local.get $fa) (local.get $l1) (local.get $fa2) (i32.const 0)
+            (local.get $l2))
+         (return (local.get $fa))))
+      (return_call $caml_floatarray_dup (local.get $fa1)))
 
    (func (export "caml_array_concat") (param (ref eq)) (result (ref eq))
-      ;; ZZZ float array
       (local $i i32) (local $len i32)
-      (local $l (ref eq))
+      (local $l (ref eq)) (local $v (ref eq))
       (local $isfloat i32)
-      (local $a (ref $block)) (local $a' (ref $block)) (local $b (ref $block))
+      (local $b (ref $block))
+      (local $a (ref $block)) (local $a' (ref $block))
+      (local $fa (ref $float_array)) (local $fa' (ref $float_array))
       (local.set $l (local.get 0))
-      (local.set $len (i32.const 1))
+      (local.set $len (i32.const 0))
       (loop $compute_length
          (drop (block $exit (result (ref eq))
              (local.set $b
                 (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l)))
-             (local.set $len
-                (i32.add (local.get $len)
-                   (i32.sub
-                      (array.len
-                         (ref.cast (ref $block)
-                            (array.get $block (local.get $b) (i32.const 1))))
-                      (i32.const 1))))
-             (if (ref.eq (array.get $block (local.get $b) (i32.const 0))
-                    (ref.i31 (global.get $double_array_tag)))
-                 (then (local.set $isfloat (i32.const 1))))
+             (local.set $v (array.get $block (local.get $b) (i32.const 1)))
+             (block $continue
+                (drop (block $not_block (result (ref eq))
+                   (local.set $len
+                      (i32.add (local.get $len)
+                         (i32.sub
+                            (array.len
+                               (br_on_cast_fail $not_block (ref eq) (ref $block)
+                                  (local.get $v)))
+                            (i32.const 1))))
+                   (br $continue)))
+                (local.set $len
+                   (i32.add (local.get $len)
+                      (array.len (ref.cast (ref $float_array) (local.get $v)))))
+                (local.set $isfloat (i32.const 1)))
              (local.set $l (array.get $block (local.get $b) (i32.const 2)))
              (br $compute_length))))
-      (local.set $a
-         (array.new $block (ref.i31 (i32.const 0)) (local.get $len)))
-      (if (local.get $isfloat)
+      (if (result (ref eq)) (local.get $isfloat)
          (then
-            (array.set $block (local.get $a) (i32.const 0)
-               (ref.i31 (global.get $double_array_tag)))))
-      (local.set $l (local.get 0))
-      (local.set $i (i32.const 1))
-      (loop $fill
-         (drop (block $exit (result (ref eq))
-             (local.set $b
-                (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l)))
-             (local.set $a'
-                (ref.cast (ref $block)
-                   (array.get $block (local.get $b) (i32.const 1))))
-             (local.set $len
-                (i32.sub (array.len (local.get $a')) (i32.const 1)))
-             (array.copy $block $block
-                (local.get $a) (local.get $i)
-                (local.get $a') (i32.const 1)
-                (local.get $len))
-             (local.set $i (i32.add (local.get $i) (local.get $len)))
-             (local.set $l (array.get $block (local.get $b) (i32.const 2)))
-             (br $fill))))
-      (local.get $a))
+            (local.set $fa
+               (array.new $float_array (f64.const 0) (local.get $len)))
+            (local.set $l (local.get 0))
+            (local.set $i (i32.const 0))
+            (loop $fill
+               (drop (block $exit (result (ref eq))
+                   (local.set $b
+                      (br_on_cast_fail $exit (ref eq) (ref $block)
+                         (local.get $l)))
+                   (local.set $l (array.get $block (local.get $b) (i32.const 2)))
+                   (drop (block $not_float (result (ref eq))
+                      (local.set $fa'
+                         (br_on_cast_fail $not_float (ref eq) (ref $float_array)
+                            (array.get $block (local.get $b) (i32.const 1))))
+                      (local.set $len (array.len (local.get $fa')))
+                      (array.copy $float_array $float_array
+                         (local.get $fa) (local.get $i)
+                         (local.get $fa') (i32.const 0)
+                         (local.get $len))
+                      (local.set $i (i32.add (local.get $i) (local.get $len)))
+                      (br $fill)))
+                   (br $fill))))
+            (local.get $fa))
+         (else
+            (local.set $a
+               (array.new $block (ref.i31 (i32.const 0))
+                  (i32.add (local.get $len) (i32.const 1))))
+            (local.set $l (local.get 0))
+            (local.set $i (i32.const 1))
+            (loop $fill
+               (drop (block $exit (result (ref eq))
+                   (local.set $b
+                      (br_on_cast_fail $exit (ref eq) (ref $block)
+                         (local.get $l)))
+                   (local.set $a'
+                      (ref.cast (ref $block)
+                         (array.get $block (local.get $b) (i32.const 1))))
+                   (local.set $len
+                      (i32.sub (array.len (local.get $a')) (i32.const 1)))
+                   (array.copy $block $block
+                      (local.get $a) (local.get $i)
+                      (local.get $a') (i32.const 1)
+                      (local.get $len))
+                   (local.set $i (i32.add (local.get $i) (local.get $len)))
+                   (local.set $l (array.get $block (local.get $b) (i32.const 2)))
+                   (br $fill))))
+            (local.get $a))))
 
-   (export "caml_floatarray_blit" (func $caml_array_blit))
-   (func $caml_array_blit (export "caml_array_blit")
+   (func $caml_floatarray_blit (export "caml_floatarray_blit")
       (param $a1 (ref eq)) (param $i1 (ref eq))
       (param $a2 (ref eq)) (param $i2 (ref eq))
-      (param $len (ref eq))
+      (param $vlen (ref eq))
       (result (ref eq))
-      (array.copy $block $block
-         (ref.cast (ref $block) (local.get $a2))
-         (i32.add
-            (i31.get_s (ref.cast (ref i31) (local.get $i2))) (i32.const 1))
-         (ref.cast (ref $block) (local.get $a1))
-         (i32.add
-            (i31.get_s (ref.cast (ref i31) (local.get $i1))) (i32.const 1))
-         (i31.get_s (ref.cast (ref i31) (local.get $len))))
+      (local $len i32)
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
+      (if (local.get $len)
+         (then
+            (array.copy $float_array $float_array
+               (ref.cast (ref $float_array) (local.get $a2))
+               (i31.get_s (ref.cast (ref i31) (local.get $i2)))
+               (ref.cast (ref $float_array) (local.get $a1))
+               (i31.get_s (ref.cast (ref i31) (local.get $i1)))
+               (local.get $len))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_array_blit")
+      (param $a1 (ref eq)) (param $i1 (ref eq))
+      (param $a2 (ref eq)) (param $i2 (ref eq))
+      (param $vlen (ref eq))
+      (result (ref eq))
+      (local $len i32)
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
+      (if (local.get $len)
+         (then
+            (if (ref.test (ref $float_array) (local.get $a1))
+               (then
+                  (return_call $caml_floatarray_blit
+                     (local.get $a1) (local.get $i1)
+                     (local.get $a2) (local.get $i2) (local.get $vlen)))
+               (else
+                  (array.copy $block $block
+                     (ref.cast (ref $block) (local.get $a2))
+                     (i32.add
+                        (i31.get_s
+                           (ref.cast (ref i31) (local.get $i2))) (i32.const 1))
+                     (ref.cast (ref $block) (local.get $a1))
+                     (i32.add
+                        (i31.get_s
+                           (ref.cast (ref i31) (local.get $i1))) (i32.const 1))
+                     (local.get $len))))))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_array_fill")
-      (param $a (ref eq)) (param $i (ref eq)) (param $len (ref eq))
+      (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
       (param $v (ref eq)) (result (ref eq))
-      (array.fill $block (ref.cast (ref $block) (local.get $a))
-         (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))
-         (local.get $v)
-         (i31.get_u (ref.cast (ref i31) (local.get $len))))
+      (local $len i32)
+      (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+      (if $done (local.get $len)
+         (then
+            (drop (block $not_block (result (ref eq))
+               (array.fill $block
+                  (br_on_cast_fail $not_block (ref eq) (ref $block)
+                     (local.get $a))
+                  (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i)))
+                     (i32.const 1))
+                  (local.get $v)
+                  (local.get $len))
+               (br $done)))
+            (array.fill $float_array
+               (ref.cast (ref $float_array) (local.get $a))
+               (i31.get_u (ref.cast (ref i31) (local.get $i)))
+               (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))
+               (local.get $len))))
       (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 46c9e83b29..f62217bccf 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -96,6 +96,7 @@
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
+   (type $float_array (array (mut f64)))
 
    (type $compare
       (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
@@ -783,23 +784,17 @@
                  ;; complex64
                  (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                  (return
-                    (array.new_fixed $block 3
-                       (ref.i31 (global.get $double_array_tag))
-                       (struct.new $float
-                          (call $ta_get_f64 (local.get $data) (local.get $i)))
-                       (struct.new $float
-                          (call $ta_get_f64 (local.get $data)
-                             (i32.add (local.get $i) (i32.const 1)))))))
+                    (array.new_fixed $float_array 2
+                       (call $ta_get_f64 (local.get $data) (local.get $i))
+                       (call $ta_get_f64 (local.get $data)
+                          (i32.add (local.get $i) (i32.const 1))))))
                 ;; complex32
                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
                 (return
-                   (array.new_fixed $block 3
-                      (ref.i31 (global.get $double_array_tag))
-                      (struct.new $float
-                         (call $ta_get_f32 (local.get $data) (local.get $i)))
-                      (struct.new $float
-                         (call $ta_get_f32 (local.get $data)
-                            (i32.add (local.get $i) (i32.const 1)))))))
+                   (array.new_fixed $float_array 2
+                      (call $ta_get_f32 (local.get $data) (local.get $i))
+                      (call $ta_get_f32 (local.get $data)
+                         (i32.add (local.get $i) (i32.const 1))))))
                ;; nativeint
                (return_call $caml_copy_nativeint
                   (call $ta_get_i32 (local.get $data) (local.get $i))))
@@ -843,7 +838,7 @@
    (func $caml_ba_set_at_offset
       (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq))
       (local $data (ref extern))
-      (local $b (ref $block)) (local $l i64)
+      (local $b (ref $float_array)) (local $l i64)
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (block $float32
        (block $float64
@@ -863,29 +858,21 @@
                      (struct.get $bigarray $ba_kind (local.get $ba))))
                  ;; complex64
                  (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                 (local.set $b (ref.cast (ref $block) (local.get $v)))
+                 (local.set $b (ref.cast (ref $float_array) (local.get $v)))
                  (call $ta_set_f64 (local.get $data) (local.get $i)
-                    (struct.get $float 0
-                       (ref.cast (ref $float)
-                          (array.get $block (local.get $b) (i32.const 1)))))
+                    (array.get $float_array (local.get $b) (i32.const 0)))
                  (call $ta_set_f64 (local.get $data)
                     (i32.add (local.get $i) (i32.const 1))
-                    (struct.get $float 0
-                       (ref.cast (ref $float)
-                         (array.get $block (local.get $b) (i32.const 2)))))
+                    (array.get $float_array (local.get $b) (i32.const 1)))
                  (return))
                 ;; complex32
                 (local.set $i (i32.shl (local.get $i) (i32.const 1)))
-                (local.set $b (ref.cast (ref $block) (local.get $v)))
+                (local.set $b (ref.cast (ref $float_array) (local.get $v)))
                 (call $ta_set_f32 (local.get $data) (local.get $i)
-                   (struct.get $float 0
-                      (ref.cast (ref $float)
-                         (array.get $block (local.get $b) (i32.const 1)))))
+                   (array.get $float_array (local.get $b) (i32.const 0)))
                 (call $ta_set_f32 (local.get $data)
                    (i32.add (local.get $i) (i32.const 1))
-                   (struct.get $float 0
-                      (ref.cast (ref $float)
-                         (array.get $block (local.get $b) (i32.const 2)))))
+                   (array.get $float_array (local.get $b) (i32.const 1)))
                 (return))
                ;; nativeint
                (call $ta_set_i32 (local.get $data) (local.get $i)
@@ -1460,7 +1447,7 @@
       (local $l i64)
       (local $i i32) (local $len i32) (local $i1 i32) (local $i2 i32)
       (local $f1 f64) (local $f2 f64)
-      (local $b (ref $block))
+      (local $b (ref $float_array))
       (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (block $float
@@ -1474,15 +1461,11 @@
                (struct.get $bigarray $ba_kind (local.get $ba))))
             ;; complex64
             (local.set $len (call $ta_length (local.get $data)))
-            (local.set $b (ref.cast (ref $block) (local.get $v)))
+            (local.set $b (ref.cast (ref $float_array) (local.get $v)))
             (local.set $f1
-               (struct.get $float 0
-                  (ref.cast (ref $float)
-                     (array.get $block (local.get $b) (i32.const 1)))))
+               (array.get $float_array (local.get $b) (i32.const 0)))
             (local.set $f2
-               (struct.get $float 0
-                  (ref.cast (ref $float)
-                     (array.get $block (local.get $b) (i32.const 2)))))
+               (array.get $float_array (local.get $b) (i32.const 1)))
             (loop $loop
                (if (i32.lt_u (local.get $i) (local.get $len))
                   (then
@@ -1496,15 +1479,9 @@
             (return (ref.i31 (i32.const 0))))
            ;; complex32
            (local.set $len (call $ta_length (local.get $data)))
-           (local.set $b (ref.cast (ref $block) (local.get $v)))
-           (local.set $f1
-              (struct.get $float 0
-                 (ref.cast (ref $float)
-                    (array.get $block (local.get $b) (i32.const 1)))))
-           (local.set $f2
-              (struct.get $float 0
-                 (ref.cast (ref $float)
-                    (array.get $block (local.get $b) (i32.const 2)))))
+           (local.set $b (ref.cast (ref $float_array) (local.get $v)))
+           (local.set $f1 (array.get $float_array (local.get $b) (i32.const 0)))
+           (local.set $f2 (array.get $float_array (local.get $b) (i32.const 1)))
            (loop $loop
               (if (i32.lt_u (local.get $i) (local.get $len))
                  (then
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 59f3ed41e4..bcbf25b7b5 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -19,6 +19,7 @@
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
+   (type $float_array (array (mut f64)))
    (type $js (struct (field anyref)))
 
    (type $int_array (array (mut i32)))
@@ -202,6 +203,7 @@
       (local $t1 i32) (local $t2 i32)
       (local $s1 i32) (local $s2 i32)
       (local $f1 f64) (local $f2 f64)
+      (local $fa1 (ref $float_array)) (local $fa2 (ref $float_array))
       (local $str1 (ref $string)) (local $str2 (ref $string))
       (local $c1 (ref $custom)) (local $c2 (ref $custom))
       (local $js1 anyref) (local $js2 anyref)
@@ -333,41 +335,6 @@
                   (if (i32.ne (local.get $s1) (local.get $s2))
                      (then
                         (return (i32.sub (local.get $s1) (local.get $s2)))))
-                  (if (i32.eq (local.get $t1) (global.get $double_array_tag))
-                     (then
-                        (local.set $i (i32.const 1))
-                        (loop $float_array
-                           (if (i32.lt_s (local.get $i) (local.get $s1))
-                              (then
-                                 (local.set $f1
-                                    (struct.get $float 0
-                                       (ref.cast (ref $float)
-                                          (array.get $block (local.get $b1)
-                                             (local.get $i)))))
-                                 (local.set $f2
-                                    (struct.get $float 0
-                                       (ref.cast (ref $float)
-                                          (array.get $block (local.get $b2)
-                                          (local.get $i)))))
-                                 (if (f64.lt (local.get $f1) (local.get $f2))
-                                    (then (return (i32.const -1))))
-                                 (if (f64.gt (local.get $f1) (local.get $f2))
-                                    (then (return (i32.const 1))))
-                                 (if (f64.ne (local.get $f1) (local.get $f2))
-                                    (then
-                                       (if (i32.eqz (local.get $total))
-                                          (then
-                                             (return (global.get $unordered))))
-                                       (if (f64.eq (local.get $f1)
-                                                   (local.get $f1))
-                                          (then (return (i32.const 1))))
-                                       (if (f64.eq (local.get $f2)
-                                                   (local.get $f2))
-                                          (then (return (i32.const -1))))))
-                                 (local.set $i
-                                    (i32.add (local.get $i) (i32.const 1)))
-                                 (br $float_array))))
-                        (br $next_item)))
                   (br_if $next_item (i32.eq (local.get $s1) (i32.const 1)))
                   (if (i32.gt_u (local.get $s1) (i32.const 2))
                      (then
@@ -412,6 +379,49 @@
                      (call $compare_strings (local.get $str1) (local.get $str2)))
                   (br_if $next_item (i32.eqz (local.get $res)))
                   (return (local.get $res))))
+               (drop (block $v1_not_float_array (result (ref eq))
+                  (local.set $fa1
+                     (br_on_cast_fail $v1_not_float_array
+                        (ref eq) (ref $float_array)
+                        (local.get $v1)))
+                  (local.set $fa2
+                      (br_on_cast_fail $heterogeneous
+                         (ref eq) (ref $float_array)
+                         (local.get $v2)))
+                  (local.set $s1 (array.len (local.get $fa1)))
+                  (local.set $s2 (array.len (local.get $fa2)))
+                  (if (i32.ne (local.get $s1) (local.get $s2))
+                     (then
+                        (return (i32.sub (local.get $s1) (local.get $s2)))))
+                  (local.set $i (i32.const 0))
+                  (loop $float_array
+                     (if (i32.lt_s (local.get $i) (local.get $s1))
+                        (then
+                           (local.set $f1
+                              (array.get $float_array (local.get $fa1)
+                                 (local.get $i)))
+                           (local.set $f2
+                              (array.get $float_array (local.get $fa2)
+                                 (local.get $i)))
+                           (if (f64.lt (local.get $f1) (local.get $f2))
+                              (then (return (i32.const -1))))
+                           (if (f64.gt (local.get $f1) (local.get $f2))
+                              (then (return (i32.const 1))))
+                           (if (f64.ne (local.get $f1) (local.get $f2))
+                              (then
+                                 (if (i32.eqz (local.get $total))
+                                    (then
+                                       (return (global.get $unordered))))
+                                 (if (f64.eq (local.get $f1)
+                                             (local.get $f1))
+                                    (then (return (i32.const 1))))
+                                 (if (f64.eq (local.get $f2)
+                                             (local.get $f2))
+                                    (then (return (i32.const -1))))))
+                           (local.set $i
+                              (i32.add (local.get $i) (i32.const 1)))
+                           (br $float_array))))
+                  (br $next_item)))
                (drop (block $v1_not_custom (result (ref eq))
                   (local.set $c1
                      (br_on_cast_fail $v1_not_custom (ref eq) (ref $custom)
@@ -447,7 +457,6 @@
                      (array.new_data $string $abstract_value
                         (i32.const 0) (i32.const 23)))
                   (ref.i31 (i32.const 0))))
-               ;; ZZZ float array (unboxed)
                (drop (block $v1_not_js (result (ref eq))
                   (local.set $js1
                      (struct.get $js 0
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 4fdfdfcbe8..d02d774d0a 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -106,6 +106,7 @@
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
+   (type $float_array (array (mut f64)))
    (type $js (struct (field anyref)))
 
    (type $compare
@@ -277,7 +278,7 @@
       (local.get $res))
 
    (func $readfloat
-      (param $s (ref $intern_state)) (param $code i32) (result (ref eq))
+      (param $s (ref $intern_state)) (param $code i32) (result f64)
       (local $src (ref $string)) (local $pos i32) (local $res i32)
       (local $d i64)
       (local $i i32)
@@ -308,13 +309,12 @@
                      (i64.const 8)))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop (i32.lt_u (local.get $i) (i32.const 8))))))
-      (struct.new $float (f64.reinterpret_i64 (local.get $d))))
+      (f64.reinterpret_i64 (local.get $d)))
 
    (func $readfloats
       (param $s (ref $intern_state)) (param $code i32) (param $len i32)
       (result (ref eq))
-      ;; ZZZ float array
-      (local $dest (ref $block))
+      (local $dest (ref $float_array))
       (local $i i32)
       (local.set $code
          (select (global.get $CODE_DOUBLE_BIG) (global.get $CODE_DOUBLE_LITTLE)
@@ -322,17 +322,13 @@
                (i32.eq (local.get $code) (global.get $CODE_DOUBLE_ARRAY8_BIG))
                (i32.eq (local.get $code)
                  (global.get $CODE_DOUBLE_ARRAY32_BIG)))))
-      (local.set $dest
-         (array.new $block (ref.i31 (i32.const 0))
-            (i32.add (local.get $len) (i32.const 1))))
-      (array.set $block (local.get $dest) (i32.const 0)
-         (ref.i31 (global.get $double_array_tag)))
+      (local.set $dest (array.new $float_array (f64.const 0) (local.get $len)))
       (loop $loop
-         (local.set $i (i32.add (local.get $i) (i32.const 1)))
-         (if (i32.le_u (local.get $i) (local.get $len))
+         (if (i32.lt_u (local.get $i) (local.get $len))
             (then
-               (array.set $block (local.get $dest) (local.get $i)
+               (array.set $float_array (local.get $dest) (local.get $i)
                   (call $readfloat (local.get $s) (local.get $code)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
       (local.get $dest))
 
@@ -550,8 +546,9 @@
                                     (br $read_double_array))
                                    ;; DOUBLE
                                    (local.set $v
-                                      (call $readfloat
-                                         (local.get $s) (local.get $code)))
+                                      (struct.new $float
+                                         (call $readfloat
+                                            (local.get $s) (local.get $code))))
                                    (call $register_object
                                       (local.get $s) (local.get $v))
                                    (br $done))
@@ -890,23 +887,21 @@
          (br_if $loop (i32.lt_u (local.get $i) (i32.const 8)))))
 
    (func $writefloats
-      (param $s (ref $extern_state)) (param $b (ref $block))
+      (param $s (ref $extern_state)) (param $b (ref $float_array))
       (local $pos i32) (local $sz i32) (local $buf (ref $string)) (local $d i64)
       (local $i i32) (local $j i32)
-      (local.set $sz (i32.sub (array.len (local.get $b)) (i32.const 1)))
+      (local.set $sz (array.len (local.get $b)))
       (local.set $pos
          (call $reserve_extern_output
             (local.get $s) (i32.shl (local.get $sz) (i32.const 3))))
       (local.set $buf (struct.get $extern_state $buf (local.get $s)))
-      (local.set $j (i32.const 1))
+      (local.set $j (i32.const 0))
       (loop $loop2
-         (if (i32.le_u (local.get $j) (local.get $sz))
+         (if (i32.lt_u (local.get $j) (local.get $sz))
             (then
                (local.set $d
                   (i64.reinterpret_f64
-                     (struct.get $float 0
-                        (ref.cast (ref $float)
-                           (array.get $block (local.get $b) (local.get $j))))))
+                     (array.get $float_array (local.get $b) (local.get $j))))
                (local.set $i (i32.const 0))
                (loop $loop
                   (array.set $string (local.get $buf)
@@ -1022,7 +1017,7 @@
       (call $writefloat (local.get $s) (local.get $v)))
 
    (func $extern_float_array
-      (param $s (ref $extern_state)) (param $v (ref $block))
+      (param $s (ref $extern_state)) (param $v (ref $float_array))
       (local $nfloats i32)
       (local.set $nfloats (array.len (local.get $v)))
       (if (i32.lt_u (local.get $nfloats) (i32.const 0x100))
@@ -1105,6 +1100,7 @@
       (local $sp (ref null $stack_item))
       (local $item (ref $stack_item))
       (local $b (ref $block)) (local $str (ref $string))
+      (local $fa (ref $float_array))
       (local $hd i32) (local $tag i32) (local $sz i32)
       (local $pos i32)
       (local $r (i32 i32))
@@ -1140,13 +1136,6 @@
                            (local.get $pos)))
                      (br $next_item)))
                (call $extern_record_location (local.get $s) (local.get $v))
-               (if (i32.eq (local.get $tag) (global.get $double_array_tag))
-                  (then
-                     (call $extern_float_array (local.get $s) (local.get $b))
-                     (call $extern_size (local.get $s)
-                        (i32.mul (local.get $sz) (i32.const 2))
-                        (local.get $sz))
-                     (br $next_item)))
                (call $extern_header
                   (local.get $s) (local.get $sz) (local.get $tag))
                (call $extern_size
@@ -1189,6 +1178,16 @@
                         (local.get $v))))
                (call $extern_size (local.get $s) (i32.const 2) (i32.const 1))
                (br $next_item)))
+            (drop (block $not_float_array (result (ref eq))
+               (local.set $fa
+                  (br_on_cast_fail $not_float_array (ref eq) (ref $float_array)
+                     (local.get $v)))
+               (local.set $sz (array.len (local.get $fa)))
+               (call $extern_float_array (local.get $s) (local.get $fa))
+               (call $extern_size (local.get $s)
+                  (i32.mul (local.get $sz) (i32.const 2))
+                  (local.get $sz))
+               (br $next_item)))
             (drop (block $not_custom (result (ref eq))
                (local.set $r
                   (call $extern_custom (local.get $s)
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index b061f04d0f..0d58c966a4 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -10,6 +10,7 @@
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $float (struct (field f64)))
+   (type $float_array (array (mut f64)))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
    (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
    (type $closure_last_arg
@@ -92,10 +93,16 @@
                  (i32.add (i31.get_u (ref.cast (ref i31) (local.get $size)))
                           (i32.const 1))))
 
+   (func (export "caml_alloc_dummy_float")
+      (param $size (ref eq)) (result (ref eq))
+      (array.new $float_array (f64.const 0)
+         (i31.get_u (ref.cast (ref i31) (local.get $size)))))
+
    (func (export "caml_update_dummy")
       (param $dummy (ref eq)) (param $newval (ref eq)) (result (ref eq))
       (local $i i32)
-      (local $dst (ref $block)) (local $src (ref $block))
+      (local $dst (ref $block)) (local $fdst (ref $float_array))
+      (local $src (ref $block))
       (drop (block $not_block (result (ref eq))
          (local.set $dst
             (br_on_cast_fail $not_block (ref eq) (ref $block)
@@ -105,6 +112,15 @@
             (local.get $dst) (i32.const 0) (local.get $src) (i32.const 0)
             (array.len (local.get $dst)))
          (return (ref.i31 (i32.const 0)))))
+      (drop (block $not_float_array (result (ref eq))
+         (local.set $fdst
+            (br_on_cast_fail $not_float_array (ref eq) (ref $float_array)
+               (local.get $dummy)))
+         (array.copy $float_array $float_array
+            (local.get $fdst) (i32.const 0)
+            (ref.cast (ref $float_array) (local.get $newval)) (i32.const 0)
+            (array.len (local.get $fdst)))
+         (return (ref.i31 (i32.const 0)))))
       (drop (block $not_closure_1 (result (ref eq))
          (struct.set $dummy_closure_1 1
             (br_on_cast_fail $not_closure_1 (ref eq) (ref $dummy_closure_1)
@@ -135,12 +151,12 @@
                (local.get $dummy))
             (ref.cast (ref $cps_closure) (local.get $newval)))
          (return (ref.i31 (i32.const 0)))))
-      ;; ZZZ float array
       (unreachable))
 
    (func $caml_obj_dup (export "caml_obj_dup")
       (param (ref eq)) (result (ref eq))
       (local $orig (ref $block)) (local $res (ref $block))
+      (local $forig (ref $float_array)) (local $fres (ref $float_array))
       (local $s (ref $string)) (local $s' (ref $string))
       (local $len i32)
       (drop (block $not_block (result (ref eq))
@@ -154,6 +170,17 @@
             (local.get $res) (i32.const 1) (local.get $orig) (i32.const 1)
             (i32.sub (local.get $len) (i32.const 1)))
          (return (local.get $res))))
+      (drop (block $not_float_array (result (ref eq))
+         (local.set $forig
+            (br_on_cast_fail $not_float_array (ref eq) (ref $float_array)
+               (local.get 0)))
+         (local.set $len (array.len (local.get $forig)))
+         (local.set $fres
+            (array.new $float_array (f64.const 0) (local.get $len)))
+         (array.copy $float_array $float_array
+            (local.get $fres) (i32.const 0) (local.get $forig) (i32.const 0)
+            (local.get $len))
+         (return (local.get $fres))))
       (drop (block $not_string (result (ref eq))
          (local.set $s (br_on_cast_fail $not_string (ref eq) (ref $string)
             (local.get 0)))
@@ -177,7 +204,7 @@
    (func (export "caml_obj_block")
       (param $tag (ref eq)) (param $size (ref eq)) (result (ref eq))
       (local $res (ref $block))
-      ;; ZZZ float array / specific types
+      ;; ZZZ float array / specific types?
       (local.set $res
          (array.new $block
             (ref.i31 (i32.const 0))
@@ -198,13 +225,14 @@
          (then (return (ref.i31 (global.get $string_tag)))))
       (if (ref.test (ref $float) (local.get $v))
          (then (return (ref.i31 (global.get $float_tag)))))
+      (if (ref.test (ref $float_array) (local.get $v))
+         (then (return (ref.i31 (global.get $double_array_tag)))))
       (if (call $caml_is_custom (local.get $v))
          (then (return (ref.i31 (global.get $custom_tag)))))
       (if (call $caml_is_closure (local.get $v))
          (then (return (ref.i31 (global.get $closure_tag)))))
       (if (call $caml_is_continuation (local.get $v))
          (then (return (ref.i31 (global.get $cont_tag)))))
-      ;; ZZZ float array
       (ref.i31 (global.get $abstract_tag)))
 
    (func (export "caml_obj_make_forward")

From c7433ee4ac1f42781da6ff9833b3153d17d44351 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Sep 2023 11:03:34 +0200
Subject: [PATCH 133/481] Make the tests for uncaught exceptions more portable

---
 compiler/tests-jsoo/bin/dune      |  3 +-
 compiler/tests-jsoo/bin/error1.ml |  6 ++--
 compiler/tests-jsoo/bin/error2.ml |  6 ++--
 compiler/tests-jsoo/bin/error3.ml | 10 +++----
 runtime/stdlib.js                 | 11 +++++++-
 runtime/wasm/stdlib.wat           | 47 ++++++++++++++++++++++++++++++-
 6 files changed, 68 insertions(+), 15 deletions(-)

diff --git a/compiler/tests-jsoo/bin/dune b/compiler/tests-jsoo/bin/dune
index 10b130ed90..fb3f64d526 100644
--- a/compiler/tests-jsoo/bin/dune
+++ b/compiler/tests-jsoo/bin/dune
@@ -1,6 +1,7 @@
 (executables
  (names error1 error2 error3)
- (modes byte js))
+ (modes js)
+ (libraries js_of_ocaml))
 
 (rule
  (target error1.actual)
diff --git a/compiler/tests-jsoo/bin/error1.ml b/compiler/tests-jsoo/bin/error1.ml
index 2e806c85d0..c496260604 100644
--- a/compiler/tests-jsoo/bin/error1.ml
+++ b/compiler/tests-jsoo/bin/error1.ml
@@ -1,8 +1,8 @@
+external unregister : string -> unit = "caml_unregister_named_value"
+
 let () =
   match Array.to_list Sys.argv with
-  | _ :: "unregister" :: _ ->
-      let null = Array.unsafe_get [| 1 |] 1 in
-      Callback.register "Printexc.handle_uncaught_exception" null
+  | _ :: "unregister" :: _ -> unregister "Printexc.handle_uncaught_exception"
   | _ -> ()
 
 exception D of int * string * Int64.t
diff --git a/compiler/tests-jsoo/bin/error2.ml b/compiler/tests-jsoo/bin/error2.ml
index f0274d9be8..1769540564 100644
--- a/compiler/tests-jsoo/bin/error2.ml
+++ b/compiler/tests-jsoo/bin/error2.ml
@@ -1,10 +1,10 @@
+external unregister : string -> unit = "caml_unregister_named_value"
+
 let () =
   (* Make sure Printexc is linked *)
   let _ = Printexc.to_string Not_found in
   match Array.to_list Sys.argv with
-  | _ :: "unregister" :: _ ->
-      let null = Array.unsafe_get [| 1 |] 1 in
-      Callback.register "Printexc.handle_uncaught_exception" null
+  | _ :: "unregister" :: _ -> unregister "Printexc.handle_uncaught_exception"
   | _ -> ()
 
 [@@@ocaml.warning "-8"]
diff --git a/compiler/tests-jsoo/bin/error3.ml b/compiler/tests-jsoo/bin/error3.ml
index 284a01ed2d..6fe0faee9c 100644
--- a/compiler/tests-jsoo/bin/error3.ml
+++ b/compiler/tests-jsoo/bin/error3.ml
@@ -1,10 +1,8 @@
+external unregister : string -> unit = "caml_unregister_named_value"
+
 let () =
   match Array.to_list Sys.argv with
-  | _ :: "unregister" :: _ ->
-      let null = Array.unsafe_get [| 1 |] 1 in
-      Callback.register "Printexc.handle_uncaught_exception" null
+  | _ :: "unregister" :: _ -> unregister "Printexc.handle_uncaught_exception"
   | _ -> ()
 
-let null : _ -> _ -> _ = Array.unsafe_get [||] 0
-
-let _ = null 1 2
+let _ = (Obj.magic Js_of_ocaml.Js.null : int -> int -> unit) 1 2
diff --git a/runtime/stdlib.js b/runtime/stdlib.js
index 4029305135..9b5a966830 100644
--- a/runtime/stdlib.js
+++ b/runtime/stdlib.js
@@ -131,7 +131,16 @@ var caml_named_values = {};
 //Provides: caml_register_named_value (const,mutable)
 //Requires: caml_named_values, caml_jsbytes_of_string
 function caml_register_named_value(nm,v) {
-  caml_named_values[caml_jsbytes_of_string(nm)] = v;
+  nm = caml_jsbytes_of_string(nm);
+  if (!caml_named_values.hasOwnProperty(nm)) caml_named_values[nm] = v;
+  return 0;
+}
+
+//Provides: caml_unregister_named_value (const)
+//Requires: caml_named_values, caml_jsbytes_of_string
+function caml_unregister_named_value(nm) {
+  nm = caml_jsbytes_of_string(nm);
+  delete caml_named_values[nm];
   return 0;
 }
 
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index d3da4c7d81..7c8b71360c 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -13,7 +13,10 @@
    (type $string (array (mut i8)))
 
    (type $assoc
-      (struct (field (ref $string)) (field (ref eq)) (field (ref null $assoc))))
+      (struct
+         (field (ref $string))
+         (field (ref eq))
+         (field (mut (ref null $assoc)))))
 
    (type $assoc_array (array (field (mut (ref null $assoc)))))
 
@@ -75,6 +78,48 @@
                   (local.get 1) (local.get $r)))))
       (ref.i31 (i32.const 0)))
 
+   (func (export "caml_unregister_named_value")
+      (param $name (ref eq)) (result (ref eq))
+      (local $h i32)
+      (local $r (ref null $assoc)) (local $a (ref $assoc))
+      (local.set $h
+         (i32.rem_u
+            (i31.get_s
+               (ref.cast (ref i31)
+                  (call $caml_string_hash
+                     (ref.i31 (i32.const 0)) (local.get $name))))
+            (global.get $Named_value_size)))
+      (local.set $r
+         (array.get $assoc_array
+            (global.get $named_value_table) (local.get $h)))
+      (block $done
+         (local.set $a (br_on_null $done (local.get $r)))
+         (local.set $r (struct.get $assoc 2 (local.get $a)))
+         (if (i31.get_u
+                (ref.cast (ref i31)
+                    (call $caml_string_equal
+                       (local.get $name)
+                       (struct.get $assoc 0 (local.get $a)))))
+            (then
+               (array.set $assoc_array
+                  (global.get $named_value_table) (local.get $h)
+                  (local.get $r))
+               (br $done)))
+         (loop $loop
+            (local.set $a (br_on_null $done (local.get $r)))
+            (if (i31.get_u
+                   (ref.cast (ref i31)
+                       (call $caml_string_equal
+                          (local.get $name)
+                          (struct.get $assoc 0 (local.get $a)))))
+               (then
+                  (struct.set $assoc 2 (local.get $r)
+                     (struct.get $assoc 2 (local.get $a)))
+                  (br $done)))
+            (local.set $r (struct.get $assoc 2 (local.get $a)))
+            (br $loop)))
+      (ref.i31 (i32.const 0)))
+
    (global $caml_global_data (export "caml_global_data") (mut (ref $block))
       (array.new $block (ref.i31 (i32.const 0)) (i32.const 12)))
 

From 7b4f602c038377e41aca0647bd150a5d5230c7bf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Sep 2023 11:03:49 +0200
Subject: [PATCH 134/481] Runtime: fix printing of uncaught exceptions

---
 runtime/wasm/printexc.wat | 2 ++
 runtime/wasm/runtime.js   | 3 +--
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat
index d39323f3d1..8abd38fc4d 100644
--- a/runtime/wasm/printexc.wat
+++ b/runtime/wasm/printexc.wat
@@ -120,6 +120,8 @@
                        (then
                           (call $add_char (local.get $buf)
                              (i32.const 44)) ;; ','
+                          (call $add_char (local.get $buf)
+                             (i32.const 32)) ;; ' '
                           (br $loop))))
                  (call $add_char (local.get $buf) (i32.const 41)))) ;; '\)'
            (string.new_lossy_utf8_array
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index e896d05a0c..8940e1d109 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -349,8 +349,7 @@
                       (at_exit, 1, [0], 0);
                 console.error (
                     "Fatal error: exception " +
-                        wasmModule.instance.exports.caml_format_exception(exn) +
-                        "\n"
+                        wasmModule.instance.exports.caml_format_exception(exn)
                 )
             }
             isNode && process.exit(2)

From 3466bae2bca8ded0fe4560bf3c0371a7dcd97aab Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Sep 2023 13:32:39 +0200
Subject: [PATCH 135/481] Improved handling of uncaught exceptions

---
 compiler/lib/wasm/wa_core_target.ml |  5 +-
 compiler/lib/wasm/wa_gc_target.ml   | 10 +++-
 compiler/lib/wasm/wa_generate.ml    |  6 +--
 compiler/lib/wasm/wa_target_sig.ml  |  4 +-
 runtime/wasm/deps.json              | 16 +-----
 runtime/wasm/effect.wat             | 19 ++++---
 runtime/wasm/jslib.wat              | 13 +++--
 runtime/wasm/printexc.wat           | 20 +++++---
 runtime/wasm/runtime.js             | 58 ++++++---------------
 runtime/wasm/stdlib.wat             | 80 +++++++++++++++++++++++++++--
 10 files changed, 145 insertions(+), 86 deletions(-)

diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 827e22ba69..98cb1f8111 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -630,7 +630,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
         exn_handler ~result_typ ~fall_through ~context )
     ]
 
-let entry_point ~context:_ =
+let entry_point ~context:_ ~toplevel_fun =
   let code =
     let declare_global name =
       register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
@@ -646,6 +646,7 @@ let entry_point ~context:_ =
     let* high = Arith.((return (W.MemoryGrow (0, sz)) + const 3l) lsl const 16l) in
     let* () = instr (W.GlobalSet (S "young_ptr", high)) in
     let low = W.ConstSym (S "__heap_base", 0) in
-    instr (W.GlobalSet (S "young_limit", low))
+    let* () = instr (W.GlobalSet (S "young_limit", low)) in
+    drop (return (W.Call (toplevel_fun, [])))
   in
   { W.params = []; result = [] }, code
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index c7fcd43073..b7887e2d69 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1188,7 +1188,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
      in
      exn_handler ~result_typ ~fall_through ~context)
 
-let entry_point ~context =
+let entry_point ~context ~toplevel_fun =
   let code =
     let* f =
       register_import
@@ -1202,6 +1202,12 @@ let entry_point ~context =
     let* _ = add_var suspender in
     let* s = load suspender in
     let* () = instr (W.CallInstr (f, [ s ])) in
-    init_code context
+    let* () = init_code context in
+    let* main =
+      register_import
+        ~name:"caml_main"
+        (Fun { params = [ W.Ref { nullable = false; typ = Func } ]; result = [] })
+    in
+    instr (W.CallInstr (main, [ RefFunc toplevel_fun ]))
   in
   { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] }, code
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index d97259eef2..e749770c42 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -942,11 +942,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     :: acc
 
   let entry_point ctx toplevel_fun entry_name =
-    let typ, code = entry_point ~context:ctx.global_context in
-    let body =
-      let* () = code in
-      drop (return (W.Call (toplevel_fun, [])))
-    in
+    let typ, body = entry_point ~context:ctx.global_context ~toplevel_fun in
     let locals, body =
       function_body
         ~context:ctx.global_context
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 69637a15a5..12758f5244 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -292,5 +292,7 @@ module type S = sig
     -> unit Wa_code_generation.t
 
   val entry_point :
-    context:Wa_code_generation.context -> Wa_ast.func_type * unit Wa_code_generation.t
+       context:Wa_code_generation.context
+    -> toplevel_fun:Wa_ast.var
+    -> Wa_ast.func_type * unit Wa_code_generation.t
 end
diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 16f7edaac7..71a21473a2 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,28 +1,16 @@
 [
   {
     "name": "root",
-    "reaches": ["init", "exn", "exit", "named_values", "format_exn", "callback"],
+    "reaches": ["init","exn"],
     "root": true
   },
   {
     "name": "init",
     "export": "_initialize"
   },
-  {
-    "name": "named_values",
-    "export": "caml_named_value"
-  },
-  {
-    "name": "format_exn",
-    "export": "caml_format_exception"
-  },
   {
     "name": "exn",
-    "export": "ocaml_exception"
-  },
-  {
-    "name": "exit",
-    "export": "ocaml_exit"
+    "export": "caml_handle_uncaught_exception"
   },
   {
     "name": "callback",
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 97d8260a6d..ab0dbf8055 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -6,7 +6,7 @@
    (import "obj" "caml_fresh_oo_id"
      (func $caml_fresh_oo_id (param (ref eq)) (result (ref eq))))
    (import "stdlib" "caml_named_value"
-      (func $caml_named_value (param anyref) (result (ref null eq))))
+      (func $caml_named_value (param (ref $string)) (result (ref null eq))))
    (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
    (import "fail" "javascript_exception"
       (tag $javascript_exception (param externref)))
@@ -112,16 +112,19 @@
 
    (func $raise_unhandled
       (param $eff (ref eq)) (param (ref eq)) (result (ref eq))
+      (local $effect_unhandled (ref $string))
+      (local.set $effect_unhandled
+         (array.new_data $string $effect_unhandled
+            (i32.const 0) (i32.const 16)))
       (block $null
          (call $caml_raise_with_arg
             (br_on_null $null
                (call $caml_named_value
-                  (string.const "Effect.Unhandled")))
+                  (local.get $effect_unhandled)))
             (local.get $eff)))
       (call $caml_raise_constant
          (array.new_fixed $block 3 (ref.i31 (i32.const 248))
-            (array.new_data $string $effect_unhandled
-               (i32.const 0) (i32.const 16))
+            (local.get $effect_unhandled)
             (call $caml_fresh_oo_id (ref.i31 (i32.const 0)))))
       (ref.i31 (i32.const 0)))
 
@@ -207,6 +210,8 @@
       (return_call_ref $cont_func (local.get $p) (local.get $k)
          (struct.get $cont $cont_func (local.get $k))))
 
+   (data $already_resumed "Effect.Continuation_already_resumed")
+
    (func (export "%resume")
       (param $stack (ref eq)) (param $f (ref eq)) (param $v (ref eq))
       (result (ref eq))
@@ -217,7 +222,8 @@
             (call $caml_raise_constant
                (ref.as_non_null
                   (call $caml_named_value
-                     (string.const "Effect.Continuation_already_resumed"))))))
+                     (array.new_data $string $already_resumed
+                        (i32.const 0) (i32.const 35)))))))
       (call $capture_continuation
          (ref.func $do_resume)
           (struct.new $pair
@@ -620,7 +626,8 @@
       (call $caml_raise_constant
          (ref.as_non_null
             (call $caml_named_value
-               (string.const "Effect.Continuation_already_resumed"))))
+               (array.new_data $string $already_resumed
+                  (i32.const 0) (i32.const 35)))))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_perform_effect")
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index e097a0c126..5fffe24374 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -58,7 +58,7 @@
    (import "fail" "caml_failwith_tag"
       (func $caml_failwith_tag (result (ref eq))))
    (import "stdlib" "caml_named_value"
-      (func $caml_named_value (param anyref) (result (ref null eq))))
+      (func $caml_named_value (param (ref $string)) (result (ref null eq))))
    (import "obj" "caml_callback_1"
       (func $caml_callback_1
          (param (ref eq)) (param (ref eq)) (result (ref eq))))
@@ -564,6 +564,11 @@
                (br $loop))))
       (local.get $l))
 
+   (global $jsError (ref $string)
+      (array.new_fixed $string 7 ;; 'jsError'
+         (i32.const 106) (i32.const 115) (i32.const 69) (i32.const 114)
+         (i32.const 114) (i32.const 111) (i32.const 114)))
+
    (func (export "caml_wrap_exception") (param (externref)) (result (ref eq))
       (local $exn anyref)
       (local.set $exn (extern.internalize (local.get 0)))
@@ -572,7 +577,7 @@
          (return
             (array.new_fixed $block 3 (ref.i31 (i32.const 0))
                (br_on_null $undef
-                  (call $caml_named_value (string.const "jsError")))
+                  (call $caml_named_value (global.get $jsError)))
                (call $wrap (local.get $exn)))))
       (array.new_fixed $block 3 (ref.i31 (i32.const 0))
          (call $caml_failwith_tag)
@@ -591,7 +596,7 @@
                   (ref.i31 (i32.const 0)))
          (then
             (if (ref.eq (array.get $block (local.get $exn) (i32.const 1))
-                   (call $caml_named_value (string.const "jsError")))
+                   (call $caml_named_value (global.get $jsError)))
                (then
                   (return
                      (array.new_fixed $block 2 (ref.i31 (i32.const 0))
@@ -606,7 +611,7 @@
                   (ref.i31 (i32.const 0)))
          (then
             (if (ref.eq (array.get $block (local.get $exn) (i32.const 1))
-                   (call $caml_named_value (string.const "jsError")))
+                   (call $caml_named_value (global.get $jsError)))
                (then
                   (return
                      (array.get $block (local.get $exn) (i32.const 2)))))))
diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat
index 8abd38fc4d..915a2d031f 100644
--- a/runtime/wasm/printexc.wat
+++ b/runtime/wasm/printexc.wat
@@ -47,14 +47,15 @@
       (struct.set $buffer 0 (local.get $buf)
          (i32.add (local.get $pos) (local.get $len))))
 
-   (func (export "caml_format_exception") (param (ref eq)) (result anyref)
+   (func (export "caml_format_exception") (param (ref eq)) (result (ref eq))
       (local $exn (ref $block))
       (local $buf (ref $buffer))
       (local $v (ref eq))
       (local $bucket (ref $block))
       (local $i i32) (local $len i32)
+      (local $s (ref $string))
       (local.set $exn (ref.cast (ref $block) (local.get 0)))
-      (if (result anyref)
+      (if (result (ref eq))
           (ref.eq (array.get $block (local.get $exn) (i32.const 0))
                   (ref.i31 (i32.const 0)))
          (then
@@ -124,11 +125,14 @@
                              (i32.const 32)) ;; ' '
                           (br $loop))))
                  (call $add_char (local.get $buf) (i32.const 41)))) ;; '\)'
-           (string.new_lossy_utf8_array
-              (struct.get $buffer 1 (local.get $buf)) (i32.const 0)
-              (struct.get $buffer 0 (local.get $buf))))
+            (local.set $s
+               (array.new $string (i32.const 0)
+                  (struct.get $buffer 0 (local.get $buf))))
+            (array.copy $string $string
+               (local.get $s) (i32.const 0)
+               (struct.get $buffer 1 (local.get $buf)) (i32.const 0)
+               (struct.get $buffer 0 (local.get $buf)))
+            (local.get $s))
          (else
-            (call $unwrap
-               (call $caml_jsstring_of_string
-                  (array.get $block (local.get $exn) (i32.const 1)))))))
+            (array.get $block (local.get $exn) (i32.const 1)))))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 8940e1d109..5a0bd3c57f 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -270,12 +270,13 @@
            fs.openSync(p,open_flags.reduce((f,v,i)=>(flags&(1<<i))?(f|v):f,0),
                        perm),
          close:(fd)=>fs.closeSync(fd),
-         write:(fd,b,o,l,p)=>fs?fs.writeSync(fd,b,o,l,p==null?p:Number(p)):(console.log(new TextDecoder().decode(b.slice(o,o+l))),l),
+         write:(fd,b,o,l,p)=>fs?fs.writeSync(fd,b,o,l,p==null?p:Number(p)):(console[fd==2?'error':'log'](typeof b=='string'?b:new TextDecoder().decode(b.slice(o,o+l))),l),
          read:(fd,b,o,l,p)=>fs.readSync(fd,b,o,l,p),
          file_size:(fd)=>fs.fstatSync(fd,{bigint:true}).size,
          register_channel,
          unregister_channel,
          channel_list,
+         exit:(n)=>isNode&&process.exit(n),
          argv:()=>isNode?process.argv.slice(1):['a.out'],
          getenv:(n)=>isNode?process.env[n]:null,
          system:(c)=>{
@@ -290,6 +291,7 @@
          readdir:(p)=>fs.readdirSync(p),
          file_exists:(p)=>+fs.existsSync(p),
          rename:(o,n)=>fs.renameSync(o, n),
+         throw:(e)=>{throw e},
          start_fiber:(x)=>start_fiber(x),
          suspend_fiber:
          wrap_fun(
@@ -310,53 +312,27 @@
           isNode?await WebAssembly.instantiate(await code, imports)
                 :await WebAssembly.instantiateStreaming(code,imports)
 
-    caml_callback = wasmModule.instance.exports.caml_callback;
-    caml_alloc_tm = wasmModule.instance.exports.caml_alloc_tm;
+    var {caml_callback,caml_alloc_tm, caml_start_fiber,
+         caml_handle_uncaught_exception, _initialize} =
+        wasmModule.instance.exports;
 
     start_fiber = wrap_fun(
         {parameters: ['eqref'], results: ['externref']},
-        wasmModule.instance.exports.caml_start_fiber,
-        {promising: 'first'}
+        caml_start_fiber, {promising: 'first'}
     )
     var _initialize = wrap_fun(
         {parameters: [], results: ['externref']},
-        wasmModule.instance.exports._initialize,
-        {promising: 'first'}
+        _initialize, {promising: 'first'}
     )
-
-    try {
-        await _initialize()
-    } catch (e) {
-        if (e instanceof WebAssembly.Exception) {
-          const exit_tag = wasmModule.instance.exports.ocaml_exit;
-          if (exit_tag && e.is(exit_tag))
-            isNode && process.exit(e.getArg(exit_tag, 0));
-          const exn_tag = wasmModule.instance.exports.ocaml_exception;
-          if (exn_tag && e.is(exn_tag)) {
-            var exn = e.getArg(exn_tag, 0)
-            var handle_uncaught_exception =
-              wasmModule.instance.exports.caml_named_value
-                ('Printexc.handle_uncaught_exception');
-            if (handle_uncaught_exception)
-              wasmModule.instance.exports.caml_callback
-                (handle_uncaught_exception, 2, [exn, 0], 0)
-            else {
-                var at_exit =
-                    wasmModule.instance.exports.caml_named_value
-                      ('Pervasives.do_at_exit');
-                if (at_exit)
-                    wasmModule.instance.exports.caml_callback
-                      (at_exit, 1, [0], 0);
-                console.error (
-                    "Fatal error: exception " +
-                        wasmModule.instance.exports.caml_format_exception(exn)
-                )
-            }
-            isNode && process.exit(2)
-          }
-        } else {
-            throw e;
-        }
+    var process = globalThis.process;
+    if(process && process.on) {
+        process.on('uncaughtException', (err, origin) =>
+            caml_handle_uncaught_exception(err))
+    }
+    else if(globalThis.addEventListener){
+        globalThis.addEventListener('error', event=>
+            event.error&&caml_handle_uncaught_exception(event.error))
     }
+    await _initialize();
 })(((joo_global_object,globalThis)=>(x)=>eval(x))(globalThis,globalThis),
    PRIMITIVES);
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index 7c8b71360c..d4f3820eb0 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -7,7 +7,22 @@
          (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "jslib" "caml_string_of_jsstring"
       (func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))))
+   (import "jslib" "caml_jsstring_of_string"
+      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
+   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "obj" "caml_callback_1"
+      (func $caml_callback_1
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "bindings" "write" (func $write (param i32) (param anyref)))
+   (import "string" "caml_string_cat"
+      (func $caml_string_cat
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "printexc" "caml_format_exception"
+      (func $caml_format_exception (param (ref eq)) (result (ref eq))))
+   (import "sys" "ocaml_exit" (tag $ocaml_exit (param i32)))
+   (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
+   (import "bindings" "exit" (func $exit (param i32)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -42,9 +57,8 @@
             (local.set $l (struct.get $assoc 2 (local.get $a)))
             (br $loop))))
 
-   (func (export "caml_named_value") (param anyref) (result (ref null eq))
-      (local $s (ref eq))
-      (local.set $s (call $caml_string_of_jsstring (call $wrap (local.get $0))))
+   (func $caml_named_value (export "caml_named_value")
+      (param $s (ref $string)) (result (ref null eq))
       (return_call $find_named_value
          (local.get $s)
          (array.get $assoc_array (global.get $named_value_table)
@@ -135,4 +149,64 @@
 
    (func (export "caml_get_global_data") (param (ref eq)) (result (ref eq))
       (global.get $caml_global_data))
+
+   (type $func (func (result (ref eq))))
+
+   (data $fatal_error "Fatal error: exception ")
+   (data $handle_uncaught_exception "Printexc.handle_uncaught_exception")
+   (data $do_at_exit "Pervasives.do_at_exit")
+
+   (global $uncaught_exception (mut externref) (ref.null extern))
+
+   (import "bindings" "throw" (func $throw (param externref)))
+
+   (func $reraise_exception (result (ref eq))
+      (call $throw (global.get $uncaught_exception))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_handle_uncaught_exception") (param $exn externref)
+      (global.set $uncaught_exception (local.get $exn))
+      (call $caml_main (ref.func $reraise_exception)))
+
+   (func $caml_main (export "caml_main") (param $start (ref func))
+      (local $exn (ref eq))
+      (try
+         (do
+            (drop (call_ref $func (ref.cast (ref $func) (local.get $start)))))
+         (catch $ocaml_exit
+            (call $exit (pop i32)))
+         (catch $ocaml_exception
+            (local.set $exn (pop (ref eq)))
+            (block $exit
+               (block $not_registered
+                  (drop
+                     (call $caml_callback_1
+                        (call $caml_callback_1
+                           (br_on_null $not_registered
+                              (call $caml_named_value
+                                  (array.new_data $string
+                                     $handle_uncaught_exception
+                                     (i32.const 0) (i32.const 34))))
+                           (local.get $exn))
+                     (ref.i31 (i32.const 0))))
+                  (br $exit))
+               (block $null
+                  (drop
+                     (call $caml_callback_1
+                        (br_on_null $null
+                           (call $caml_named_value
+                              (array.new_data $string $do_at_exit
+                                 (i32.const 0) (i32.const 21))))
+                        (ref.i31 (i32.const 0)))))
+               (call $write (i32.const 2)
+                  (call $unwrap
+                     (call $caml_jsstring_of_string
+                        (call $caml_string_cat
+                           (array.new_data $string $fatal_error
+                              (i32.const 0) (i32.const 23))
+                           (call $caml_string_cat
+                              (call $caml_format_exception (local.get $exn))
+                              (array.new_fixed $string 1
+                                 (i32.const 10)))))))) ;; `\n`
+               (call $exit (i32.const 2)))))
 )

From 787acf3a30e4cf07f765eb502cb764aea58834d1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Sep 2023 13:53:34 +0200
Subject: [PATCH 136/481] Runtime: utility function

---
 runtime/wasm/jslib.wat | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 5fffe24374..9e4eeeb315 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -382,14 +382,20 @@
                                  (local.get $acc)))))))))
       (return_call $unwrap (local.get $acc)))
 
+   (func $caml_jsstring_of_substring (export "caml_jsstring_of_substring")
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (result (ref eq))
+      (struct.new $js
+         (string.new_lossy_utf8_array (local.get $s) (local.get $pos)
+            (i32.add (local.get $pos) (local.get $len)))))
+
    (export "caml_js_from_string" (func $caml_jsstring_of_string))
    (func $caml_jsstring_of_string (export "caml_jsstring_of_string")
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
       (local.set $s (ref.cast (ref $string) (local.get 0)))
-      (struct.new $js
-         (string.new_lossy_utf8_array (local.get $s) (i32.const 0)
-           (array.len (local.get $s)))))
+      (return_call $caml_jsstring_of_substring
+         (local.get $s) (i32.const 0) (array.len (local.get $s))))
 
    (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
       (param (ref eq)) (result (ref eq))

From 50a4e12cb3549594f0ddcdafa2d1f800bba8f702 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Sep 2023 17:27:29 +0200
Subject: [PATCH 137/481] Runtime: partial implementation of nat

---
 runtime/wasm/nat.wat | 504 +++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 489 insertions(+), 15 deletions(-)

diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index 91a2af0b78..9f10c3ca34 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -1,31 +1,505 @@
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
+   (import "custom" "caml_register_custom_operations"
+      (func $caml_register_custom_operations
+         (param $ops (ref $custom_operations))))
+   (import "int32" "Nativeint_val"
+      (func $Nativeint_val (param (ref eq)) (result i32)))
+   (import "int32" "caml_copy_nativeint"
+      (func $caml_copy_nativeint (param i32) (result (ref eq))))
 
-   (func (export "create_nat")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "create_nat"))
-      (ref.i31 (i32.const 0)))
+   (type $string (array (mut i8)))
+   (type $data (array (mut i32)))
+   (type $compare
+      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
+   (type $hash
+      (func (param (ref eq)) (result i32)))
+   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
+   (type $serialize
+      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
+   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $custom_operations
+      (struct
+         (field $id (ref $string))
+         (field $compare (ref null $compare))
+         (field $compare_ext (ref null $compare))
+         (field $hash (ref null $hash))
+         (field $fixed_length (ref null $fixed_length))
+         (field $serialize (ref null $serialize))
+         (field $deserialize (ref null $deserialize))))
+   (type $custom (sub (struct (field (ref $custom_operations)))))
 
-   (func (export "incr_nat")
-      (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "incr_nat"))
-      (ref.i31 (i32.const 0)))
+   (global $nat_ops (ref $custom_operations)
+      (struct.new $custom_operations
+         (array.new_fixed $string 3
+            (i32.const 110) (i32.const 97) (i32.const 116)) ;; "_nat"
+         (ref.null $compare)
+         (ref.null $compare)
+         (ref.func $hash_nat)
+         (ref.null $fixed_length)
+         (ref.func $serialize_nat)
+         (ref.func $deserialize_nat)))
+
+   (type $nat
+      (sub final $custom
+         (struct
+            (field (ref $custom_operations))
+            (field $data (ref $data)))))
 
    (func (export "initialize_nat")
       (param (ref eq)) (result (ref eq))
+      (call $caml_register_custom_operations (global.get $nat_ops))
       (ref.i31 (i32.const 0)))
 
+   (func (export "create_nat")
+      (param $sz (ref eq)) (result (ref eq))
+      (struct.new $nat
+         (global.get $nat_ops)
+         (array.new $data (i32.const 0)
+            (i31.get_u (ref.cast (ref i31) (local.get $sz))))))
+
+   (func (export "incr_nat")
+      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
+      (param $carry_in (ref eq)) (result (ref eq))
+      (local $data (ref $data))
+      (local $carry i32) (local $i i32) (local $ofs i32) (local $len i32)
+      (local $x i32)
+      (local.set $data
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat))))
+      (local.set $carry (i31.get_s (ref.cast (ref i31) (local.get $carry_in))))
+      (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
+      (if (i32.eqz (local.get $carry)) (return (ref.i31 (i32.const 0))))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $x
+                  (i32.add
+                     (array.get $data (local.get $data) (local.get $ofs))
+                     (i32.const 1)))
+               (array.set $data (local.get $data) (local.get $ofs)
+                  (local.get $x))
+               (if (local.get $x)
+                  (then
+                     (return (ref.i31 (i32.const 0)))))
+               (local.set $ofs (i32.add (local.get $ofs) (i32.const 1)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (ref.i31 (i32.const 1)))
+
+   (func (export "decr_nat")
+      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
+      (param $carry_in (ref eq)) (result (ref eq))
+      (local $data (ref $data))
+      (local $carry i32) (local $i i32) (local $ofs i32) (local $len i32)
+      (local $x i32)
+      (local.set $data
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat))))
+      (local.set $carry (i31.get_s (ref.cast (ref i31) (local.get $carry_in))))
+      (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
+      (if (i32.eqz (local.get $carry)) (return (ref.i31 (i32.const 0))))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len))
+            (then
+               (local.set $x
+                  (array.get $data (local.get $data) (local.get $ofs)))
+               (array.set $data (local.get $data) (local.get $ofs)
+                  (i32.sub (local.get $x) (i32.const 1)))
+               (if (local.get $x)
+                  (then
+                     (return (ref.i31 (i32.const 0)))))
+               (local.set $ofs (i32.add (local.get $ofs) (i32.const 1)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (ref.i31 (i32.const 1)))
+
    (func (export "set_digit_nat")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_js (string.const "set_digit_nat"))
+      (param $nat (ref eq)) (param $ofs (ref eq)) (param $digit (ref eq))
+      (result (ref eq))
+      (array.set $data
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+         (i31.get_s (ref.cast (ref i31) (local.get $ofs)))
+         (i31.get_s (ref.cast (ref i31) (local.get $digit))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "set_digit_nat_native")
+      (param $nat (ref eq)) (param $ofs (ref eq)) (param $digit (ref eq))
+      (result (ref eq))
+      (array.set $data
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+         (i31.get_s (ref.cast (ref i31) (local.get $ofs)))
+         (call $Nativeint_val (local.get $digit)))
       (ref.i31 (i32.const 0)))
 
+   (func (export "nth_digit_nat")
+      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
+      (ref.i31
+         (array.get $data
+            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+            (i31.get_s (ref.cast (ref i31) (local.get $ofs))))))
+
+   (func (export "nth_digit_nat_native")
+      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
+      (call $caml_copy_nativeint
+         (array.get $data
+            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+            (i31.get_s (ref.cast (ref i31) (local.get $ofs))))))
+
+   (func (export "is_digit_zero")
+      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
+      (ref.i31
+         (i32.eqz
+            (array.get $data
+               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
+
+   (func (export "num_leading_zero_bits_in_digit")
+      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
+      (ref.i31
+         (i32.clz
+            (array.get $data
+               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
+
+   (func (export "is_digit_odd")
+      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
+      (ref.i31
+         (i32.and (i32.const 1)
+            (array.get $data
+               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
+
+   (func (export "is_digit_int")
+      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
+      (ref.i31
+         (i32.ge_u (i32.const 0x40000000)
+            (array.get $data
+               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
+
    (func (export "set_to_zero_nat")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (param $nat (ref eq)) (param $ofs (ref eq)) (param $len (ref eq))
+      (result (ref eq))
+      (array.fill $data
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
+         (i31.get_s (ref.cast (ref i31) (local.get $ofs)))
+         (i32.const 0)
+         (i31.get_s (ref.cast (ref i31) (local.get $len))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "blit_nat")
+      (param $nat1 (ref eq)) (param $ofs1 (ref eq))
+      (param $nat2 (ref eq)) (param $ofs2 (ref eq))
+      (param $len (ref eq)) (result (ref eq))
+      (array.copy $data $data
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1)))
+         (i31.get_s (ref.cast (ref i31) (local.get $ofs1)))
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2)))
+         (i31.get_s (ref.cast (ref i31) (local.get $ofs2)))
+         (i31.get_s (ref.cast (ref i31) (local.get $len))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "num_digits_nat")
+      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
+      (result (ref eq))
+      (local $ofs i32) (local $len i32) (local $data (ref $data))
+      (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
+      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
+      (local.set $data
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat))))
+      (local.set $ofs
+         (i32.add (local.get $ofs) (i32.sub (local.get $len) (i32.const 1))))
+      (loop $loop
+         (if (i32.eqz (local.get $len)) (then (return (ref.i31 (i32.const 1)))))
+         (if (array.get $data (local.get $data) (local.get $ofs))
+            (then (return (ref.i31 (local.get $len)))))
+         (local.set $len (i32.sub (local.get $len) (i32.const 1)))
+         (local.set $ofs (i32.sub (local.get $ofs) (i32.const 1)))
+         (br $loop)))
+
+   (func (export "compare_digits_nat")
+      (param $nat1 (ref eq)) (param $ofs1 (ref eq))
+      (param $nat2 (ref eq)) (param $ofs2 (ref eq)) (result (ref eq))
+      (local $d1 i32) (local $d2 i32)
+      (local.set $d1
+         (array.get $data
+            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1)))
+            (i31.get_s (ref.cast (ref i31) (local.get $ofs1)))))
+      (local.set $d2
+         (array.get $data
+            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2)))
+            (i31.get_s (ref.cast (ref i31) (local.get $ofs2)))))
+      (if (i32.gt_u (local.get $d1) (local.get $d2))
+         (then (return (ref.i31 (i32.const 1)))))
+      (if (i32.lt_u (local.get $d1) (local.get $d2))
+         (then (return (ref.i31 (i32.const -1)))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "compare_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
+      (result (ref eq))
+      (local $ofs1 i32) (local $len1 i32) (local $data1 (ref $data))
+      (local $ofs2 i32) (local $len2 i32) (local $data2 (ref $data))
+      (local $d1 i32) (local $d2 i32)
+      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
+      (local.set $len1 (i31.get_s (ref.cast (ref i31) (local.get $vlen1))))
+      (local.set $data1
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
+      (local.set $ofs1
+         (i32.add (local.get $ofs1) (i32.sub (local.get $len1) (i32.const 1))))
+      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
+      (local.set $len2 (i31.get_s (ref.cast (ref i31) (local.get $vlen2))))
+      (local.set $data2
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
+      (local.set $ofs2
+         (i32.add (local.get $ofs2) (i32.sub (local.get $len2) (i32.const 1))))
+      (loop $loop
+         (if (local.get $len1)
+            (then
+               (if (i32.eqz
+                      (array.get $data (local.get $data1) (local.get $ofs1)))
+                  (then
+                     (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
+                     (local.set $ofs1 (i32.sub (local.get $ofs1) (i32.const 1)))
+                     (br $loop))))))
+      (loop $loop
+         (if (local.get $len2)
+            (then
+               (if (i32.eqz
+                      (array.get $data (local.get $data2) (local.get $ofs2)))
+                  (then
+                     (local.set $len2 (i32.sub (local.get $len2) (i32.const 1)))
+                     (local.set $ofs2 (i32.sub (local.get $ofs2) (i32.const 1)))
+                     (br $loop))))))
+      (if (i32.gt_u (local.get $len1) (local.get $len2))
+         (then (return (ref.i31 (i32.const 1)))))
+      (if (i32.lt_u (local.get $len2) (local.get $len1))
+         (then (return (ref.i31 (i32.const -1)))))
+      (loop $loop
+         (if (local.get $len1)
+            (then
+               (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
+               (local.set $d1
+                  (array.get $data (local.get $data1) (local.get $ofs1)))
+               (local.set $d2
+                  (array.get $data (local.get $data2) (local.get $ofs2)))
+               (if (i32.gt_u (local.get $d1) (local.get $d2))
+                  (then (return (ref.i31 (i32.const 1)))))
+               (if (i32.lt_u (local.get $d1) (local.get $d2))
+                  (then (return (ref.i31 (i32.const -1)))))
+               (local.set $ofs1 (i32.sub (local.get $ofs1) (i32.const 1)))
+               (local.set $ofs2 (i32.sub (local.get $ofs2) (i32.const 1)))
+               (br $loop))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "mult_digit_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
+      (param $nat3 (ref eq)) (param $vofs3 (ref eq)) (result (ref eq))
+      (local $ofs1 i32) (local $len1 i32) (local $data1 (ref $data))
+      (local $ofs2 i32) (local $len2 i32) (local $data2 (ref $data))
+      (local $i i32) (local $d i64) (local $x i64) (local $carry i64)
+      (local $y i32)
+      (local.set $d
+         (i64.extend_i32_u
+            (array.get $data
+               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat3)))
+               (i31.get_s (ref.cast (ref i31) (local.get $vofs3))))))
+      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
+      (local.set $len1 (i31.get_s (ref.cast (ref i31) (local.get $vlen1))))
+      (local.set $data1
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
+      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
+      (local.set $len2 (i31.get_s (ref.cast (ref i31) (local.get $vlen2))))
+      (local.set $data2
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
+      (local.set $len1 (i32.sub (local.get $len1) (local.get $len2)))
+      (loop $loop
+         (if (i32.lt_s (local.get $i) (local.get $len2))
+            (then
+               (local.set $x
+                  (i64.add
+                     (i64.add (local.get $carry)
+                        (i64.extend_i32_u
+                           (array.get $data (local.get $data1)
+                              (local.get $ofs1))))
+                     (i64.mul (local.get $d)
+                        (i64.extend_i32_u
+                           (array.get $data (local.get $data2)
+                              (local.get $ofs2))))))
+               (array.set $data (local.get $data1) (local.get $ofs1)
+                  (i32.wrap_i64 (local.get $x)))
+               (local.set $carry (i64.shr_u (local.get $x) (i64.const 32)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (local.set $ofs1 (i32.add (local.get $ofs1) (i32.const 1)))
+               (local.set $ofs2 (i32.add (local.get $ofs2) (i32.const 1)))
+               (br $loop))))
+      (if (i32.eqz (local.get $len1))
+         (then (return (ref.i31 (i32.wrap_i64 (local.get $carry))))))
+      (local.set $x
+         (i64.add (local.get $carry)
+            (i64.extend_i32_u
+               (array.get $data (local.get $data1) (local.get $ofs1)))))
+      (array.set $data (local.get $data1) (local.get $ofs1)
+         (i32.wrap_i64 (local.get $x)))
+      (local.set $carry (i64.shr_u (local.get $x) (i64.const 32)))
+      (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
+      (if (i64.eqz (local.get $carry)) (then (return (ref.i31 (i32.const 0)))))
+      (if (i32.eqz (local.get $len1))
+         (then (return (ref.i31 (i32.wrap_i64 (local.get $carry))))))
+      (local.set $ofs1 (i32.add (local.get $ofs1) (i32.const 1)))
+      (loop $loop
+         (local.set $y
+            (i32.add
+               (array.get $data (local.get $data1) (local.get $ofs1))
+                  (i32.const 1)))
+         (array.set $data (local.get $data1) (local.get $ofs1) (local.get $y))
+         (if (local.get $y) (then (return (ref.i31 (i32.const 0)))))
+         (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
+         (local.set $ofs1 (i32.add (local.get $ofs1) (i32.const 1)))
+         (if (local.get $len1) (then (br $loop))))
+      (i31.new (i32.const 1)))
+
+   (func (export "mult_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
+      (param $nat3 (ref eq)) (param $vofs3 (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "mult_nat"))
+      (unreachable))
+
+   (func (export "square_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "square_nat"))
+      (unreachable))
+
+   (func (export "shift_left_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vnbits (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "shift_left_nat"))
+      (unreachable))
+
+   (func (export "shift_right_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vnbits (ref eq))
+      (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "set_to_zero_nat"))
+      (call $log_js (string.const "shift_right_nat"))
+      (unreachable))
+
+   (func (export "div_digit_nat")
+      (param $natq (ref eq)) (param $ofsq (ref eq))
+      (param $natr (ref eq)) (param $ofsr (ref eq))
+      (param $nat1 (ref eq)) (param $ofs1 (ref eq)) (param $len (ref eq))
+      (param $nat2 (ref eq)) (param $ofs2 (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "div_digit_nat"))
+      (unreachable))
+
+   (func (export "div_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "div_nat"))
+      (unreachable))
+
+   (func (export "add_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
+      (param $carry_in (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "add_nat"))
+      (unreachable))
+
+   (func (export "sub_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
+      (param $carry_in (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "sub_nat"))
+      (unreachable))
+
+   (func (export "complement_nat")
+      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
+      (result (ref eq))
+      ;; ZZZ
+      (call $log_js (string.const "complement_nat"))
+      (unreachable))
+
+   (func (export "land_digit_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq))
+      (result (ref eq))
+      (local $ofs1 i32) (local $data1 (ref $data))
+      (local $ofs2 i32) (local $data2 (ref $data))
+      (local.set $data1
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
+      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
+      (local.set $data2
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
+      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
+      (array.set $data (local.get $data1) (local.get $ofs1)
+         (i32.and (array.get $data (local.get $data1) (local.get $ofs1))
+            (array.get $data (local.get $data2) (local.get $ofs2))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "lxor_digit_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq))
+      (result (ref eq))
+      (local $ofs1 i32) (local $data1 (ref $data))
+      (local $ofs2 i32) (local $data2 (ref $data))
+      (local.set $data1
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
+      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
+      (local.set $data2
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
+      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
+      (array.set $data (local.get $data1) (local.get $ofs1)
+         (i32.xor (array.get $data (local.get $data1) (local.get $ofs1))
+            (array.get $data (local.get $data2) (local.get $ofs2))))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "lor_digit_nat")
+      (param $nat1 (ref eq)) (param $vofs1 (ref eq))
+      (param $nat2 (ref eq)) (param $vofs2 (ref eq))
+      (result (ref eq))
+      (local $ofs1 i32) (local $data1 (ref $data))
+      (local $ofs2 i32) (local $data2 (ref $data))
+      (local.set $data1
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
+      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
+      (local.set $data2
+         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
+      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
+      (array.set $data (local.get $data1) (local.get $ofs1)
+         (i32.or (array.get $data (local.get $data1) (local.get $ofs1))
+            (array.get $data (local.get $data2) (local.get $ofs2))))
       (ref.i31 (i32.const 0)))
+
+   (func $hash_nat (param (ref eq)) (result i32)
+      ;; ZZZ
+      (call $log_js (string.const "hash_nat"))
+      (unreachable))
+
+   (func $serialize_nat
+      (param (ref eq)) (param (ref eq)) (result i32) (result i32)
+      ;; ZZZ
+      (call $log_js (string.const "serialize_nat"))
+      (unreachable))
+
+   (func $deserialize_nat (param (ref eq)) (result (ref eq)) (result i32)
+      ;; ZZZ
+      (call $log_js (string.const "deserialize_nat"))
+      (unreachable))
 )

From 9bf5268082f8b4b7c5b316856d90bda8ed158b49 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 18 Sep 2023 11:40:16 +0200
Subject: [PATCH 138/481] Cast the env once at the beginning of the functions

---
 compiler/lib/wasm/wa_gc_target.ml | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index b7887e2d69..ae1dda1736 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -978,13 +978,19 @@ module Closure = struct
       | [ _ ] ->
           let* typ = Type.env_type ~cps ~arity free_variable_count in
           let* _ = add_var f in
-          (*ZZZ Store env with right type in local variable? *)
+          let env = Code.Var.fresh_n "env" in
+          let* () =
+            store
+              ~typ:(W.Ref { nullable = false; typ = Type typ })
+              env
+              Memory.(wasm_cast typ (load f))
+          in
           snd
             (List.fold_left
                ~f:(fun (i, prev) x ->
                  ( i + 1
                  , let* () = prev in
-                   define_var x Memory.(wasm_struct_get typ (wasm_cast typ (load f)) i) ))
+                   define_var x Memory.(wasm_struct_get typ (load env) i) ))
                ~init:(offset, return ())
                free_variables)
       | functions ->

From c01963b189e4e03723c3f5ea30da99ef6e4d309b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 18 Sep 2023 13:16:33 +0200
Subject: [PATCH 139/481] Generate better code for conditionals

---
 compiler/lib/wasm/wa_code_generation.ml  | 62 ++++++++++++++++++++++++
 compiler/lib/wasm/wa_code_generation.mli |  2 +
 compiler/lib/wasm/wa_gc_target.ml        |  8 ++-
 3 files changed, 71 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 98a91133db..6f6adac377 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -312,6 +312,68 @@ let is_small_constant e =
   | W.GlobalGet (V name) -> global_is_constant name
   | _ -> return false
 
+let un_op_is_smi op =
+  match op with
+  | W.Clz | Ctz | Popcnt | Eqz -> true
+  | TruncSatF64 _ | ReinterpretF -> false
+
+let bin_op_is_smi (op : W.int_bin_op) =
+  match op with
+  | W.Add | Sub | Mul | Div _ | Rem _ | And | Or | Xor | Shl | Shr _ | Rotl | Rotr ->
+      false
+  | Eq | Ne | Lt _ | Gt _ | Le _ | Ge _ -> true
+
+let is_smi e =
+  match e with
+  | W.Const (I32 i) -> Int32.equal (Int31.wrap i) i
+  | UnOp ((I32 op | I64 op), _) -> un_op_is_smi op
+  | BinOp ((I32 op | I64 op), _, _) -> bin_op_is_smi op
+  | Const (I64 _ | F32 _ | F64 _)
+  | ConstSym _
+  | UnOp ((F32 _ | F64 _), _)
+  | BinOp ((F32 _ | F64 _), _, _)
+  | I32WrapI64 _
+  | I64ExtendI32 _
+  | F32DemoteF64 _
+  | F64PromoteF32 _
+  | Load _
+  | Load8 _
+  | LocalGet _
+  | LocalTee _
+  | GlobalGet _
+  | BlockExpr _
+  | Call_indirect _
+  | Call _
+  | MemoryGrow _
+  | Seq _
+  | Pop _
+  | RefFunc _
+  | Call_ref _
+  | RefI31 _
+  | I31Get _
+  | ArrayNew _
+  | ArrayNewFixed _
+  | ArrayNewData _
+  | ArrayGet _
+  | ArrayLen _
+  | StructNew _
+  | StructGet _
+  | RefCast _
+  | RefNull _
+  | ExternInternalize _
+  | ExternExternalize _
+  | Br_on_cast _
+  | Br_on_cast_fail _ -> false
+  | RefTest _ | RefEq _ -> true
+
+let get_i31_value x st =
+  match st.instrs with
+  | LocalSet (x', RefI31 e) :: rem when x = x' && is_smi e ->
+      let x = Var.fresh_n "cond" in
+      let x, st = add_var ~typ:I32 x st in
+      Some x, { st with instrs = LocalSet (x', RefI31 (LocalTee (x, e))) :: rem }
+  | _ -> None, st
+
 let load x =
   let* x = var x in
   match x with
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index e7320759eb..8ea33e6674 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -110,6 +110,8 @@ val define_var : Wa_ast.var -> expression -> unit t
 
 val is_small_constant : Wa_ast.expression -> bool t
 
+val get_i31_value : int -> int option t
+
 type type_def =
   { supertype : Wa_ast.var option
   ; final : bool
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ae1dda1736..6aa426f4f9 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -395,7 +395,13 @@ module Value = struct
 
   let check_is_not_zero i =
     let* i = i in
-    return (W.UnOp (I32 Eqz, RefEq (i, W.RefI31 (Const (I32 0l)))))
+    match i with
+    | W.LocalGet x -> (
+        let* x_opt = get_i31_value x in
+        match x_opt with
+        | Some x' -> return (W.LocalGet x')
+        | None -> return (W.UnOp (I32 Eqz, RefEq (i, W.RefI31 (Const (I32 0l))))))
+    | _ -> return (W.UnOp (I32 Eqz, RefEq (i, W.RefI31 (Const (I32 0l)))))
 
   let check_is_int i =
     let* i = i in

From 738172be98e88e15776cb83a773f613c32d8fc40 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 18 Sep 2023 11:38:29 +0200
Subject: [PATCH 140/481] Hack to make binaryen eliminate redundant casts

---
 compiler/lib/wasm/wa_gc_target.ml | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 6aa426f4f9..29e2564287 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -459,7 +459,13 @@ end
 module Memory = struct
   let wasm_cast ty e =
     let* e = e in
-    return (W.RefCast ({ nullable = false; typ = Type ty }, e))
+    match e with
+    | W.LocalGet x ->
+        return
+          (W.RefCast
+             ( { nullable = false; typ = Type ty }
+             , W.LocalTee (x, W.RefCast ({ nullable = false; typ = Type ty }, e)) ))
+    | _ -> return (W.RefCast ({ nullable = false; typ = Type ty }, e))
 
   let wasm_struct_get ty e i =
     let* e = e in
@@ -531,15 +537,13 @@ module Memory = struct
 
   let array_length e =
     let* block = Type.block_type in
-    let* e = e in
-    Arith.(
-      return (W.ArrayLen (W.RefCast ({ nullable = false; typ = Type block }, e)))
-      - const 1l)
+    let* e = wasm_cast block e in
+    Arith.(return (W.ArrayLen e) - const 1l)
 
   let float_array_length e =
     let* float_array = Type.float_array_type in
-    let* e = e in
-    return (W.ArrayLen (W.RefCast ({ nullable = false; typ = Type float_array }, e)))
+    let* e = wasm_cast float_array e in
+    return (W.ArrayLen e)
 
   let gen_array_length e =
     let a = Code.Var.fresh_n "a" in

From 2e40ca694c9eced4b0b24f814fdca658f056c514 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 26 Sep 2023 15:48:02 +0200
Subject: [PATCH 141/481] Remove dependency on stringref proposal

---
 runtime/wasm/bigstring.wat         |   4 +-
 runtime/wasm/compare.wat           |  19 +--
 runtime/wasm/deps.json             |  10 +-
 runtime/wasm/float.wat             |  13 +--
 runtime/wasm/hash.wat              |  18 ++-
 runtime/wasm/jslib.wat             |  69 +++++------
 runtime/wasm/jslib_js_of_ocaml.wat |  10 +-
 runtime/wasm/jsstring.wat          | 180 +++++++++++++++++++++++++++++
 runtime/wasm/parsing.wat           |  72 ++++++++----
 runtime/wasm/runtime.js            |  46 +++++++-
 runtime/wasm/sys.wat               |   8 +-
 11 files changed, 352 insertions(+), 97 deletions(-)
 create mode 100644 runtime/wasm/jsstring.wat

diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 18527b257d..d7ad6d4ad3 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -84,11 +84,13 @@
          (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
       (i32.xor (local.get $h) (local.get $len)))
 
+   (data $buffer "buffer")
+
    (func (export "bigstring_to_array_buffer")
       (param $bs (ref eq)) (result (ref eq))
       (return_call $caml_js_get
          (call $caml_ba_to_typed_array (local.get $bs))
-         (call $wrap (string.const "buffer"))))
+         (array.new_data $string $buffer (i32.const 0) (i32.const 6))))
 
    (export "bigstring_to_typed_array" (func $caml_ba_to_typed_array))
 
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index bcbf25b7b5..255e27d2ad 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -15,6 +15,10 @@
    (import "string" "caml_string_compare"
       (func $caml_string_compare
         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "jsstring" "jsstring_test"
+      (func $jsstring_test (param anyref) (result i32)))
+   (import "jsstring" "jsstring_compare"
+      (func $jsstring_compare (param anyref) (param anyref) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -466,15 +470,16 @@
                      (struct.get $js 0
                         (br_on_cast_fail $heterogeneous (ref eq) (ref $js)
                            (local.get $v2))))
-                  (drop (block $not_jsstring (result anyref)
+                  (block $not_jsstring
+                     (br_if $not_jsstring
+                        (i32.eqz (call $jsstring_test (local.get $js1))))
+                     (br_if $not_jsstring
+                         (i32.eqz (call $jsstring_test (local.get $js2))))
                      (local.set $res
-                        (string.compare
-                           (br_on_cast_fail $not_jsstring anyref (ref string)
-                              (local.get $js1))
-                           (br_on_cast_fail $not_jsstring anyref (ref string)
-                              (local.get $js2))))
+                        (call $jsstring_compare
+                           (local.get $js1) (local.get $js2)))
                      (br_if $next_item (i32.eqz (local.get $res)))
-                     (return (local.get $res))))
+                     (return (local.get $res)))
                   ;; We cannot order two JavaScript objects,
                   ;; but we can tell whether they are equal or not
                   (if (i32.eqz (local.get $total))
diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 71a21473a2..2f93773eca 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,7 +1,7 @@
 [
   {
     "name": "root",
-    "reaches": ["init","exn"],
+    "reaches": ["init","exn","mem","strings"],
     "root": true
   },
   {
@@ -12,6 +12,14 @@
     "name": "exn",
     "export": "caml_handle_uncaught_exception"
   },
+  {
+    "name": "mem",
+    "export": "caml_buffer"
+  },
+  {
+    "name": "strings",
+    "export": "caml_extract_string"
+  },
   {
     "name": "callback",
     "export": "caml_callback"
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 555bcae014..37ec99cd66 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -4,7 +4,7 @@
       (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
    (import "bindings" "format_float"
       (func $format_float
-         (param i32) (param i32) (param f64) (result (ref string))))
+         (param i32) (param i32) (param f64) (result anyref)))
    (import "bindings" "identity"
       (func $parse_float (param anyref) (result f64)))
    (import "Math" "exp" (func $exp (param f64) (result f64)))
@@ -13,6 +13,9 @@
       (func $caml_invalid_argument (param (ref eq))))
    (import "ints" "lowercase_hex_table"
       (global $lowercase_hex_table (ref $chars)))
+   (import "jsstring" "string_of_jsstring"
+      (func $string_of_jsstring
+         (param anyref) (param i32) (result (ref $string))))
 
    (type $float (struct (field f64)))
    (type $string (array (mut i8)))
@@ -249,7 +252,7 @@
       (local $exp i32) (local $m i64)
       (local $i i32) (local $len i32) (local $c i32)
       (local $s (ref $string)) (local $txt (ref $chars))
-      (local $num (ref string))
+      (local $num anyref)
       (local.set $f (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
       (local.set $b (i64.reinterpret_f64 (local.get $f)))
       (local.set $format
@@ -292,12 +295,8 @@
                (call $format_float
                   (local.get $precision) (local.get $conversion)
                   (f64.abs (local.get $f))))
-            (local.set $len (string.measure_wtf8 (local.get $num)))
             (local.set $s
-               (array.new $string (i32.const 0)
-                  (i32.add (local.get $len) (local.get $i))))
-            (drop (string.encode_lossy_utf8_array
-                     (local.get $num) (local.get $s) (local.get $i)))
+               (call $string_of_jsstring (local.get $num) (local.get $i)))
             (br $sign (local.get $s))))
       (if (local.get $negative)
          (then
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index 69059a11f7..0d35c59462 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -1,7 +1,10 @@
 (module
    (import "obj" "object_tag" (global $object_tag i32))
    (import "obj" "forward_tag" (global $forward_tag i32))
-   (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
+   (import "jsstring" "jsstring_test"
+      (func $jsstring_test (param anyref) (result i32)))
+   (import "jsstring" "jsstring_hash"
+      (func $jsstring_hash (param i32) (param anyref) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -135,11 +138,6 @@
          (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w))))
       (i32.xor (local.get $h) (local.get $len)))
 
-   (func $caml_hash_mix_jsstring
-      (param $h i32) (param $s (ref eq)) (result i32)
-      (return_call $caml_hash_mix_int (local.get $h)
-         (string.hash (ref.cast (ref string) (call $unwrap (local.get $s))))))
-
    (global $HASH_QUEUE_SIZE i32 (i32.const 256))
    (global $MAX_FORWARD_DEREFERENCE i32 (i32.const 1000))
 
@@ -281,11 +279,11 @@
                         (struct.get $js 0
                            (br_on_cast_fail $not_jsstring (ref eq) (ref $js)
                               (local.get $v))))
+                     (drop (br_if $not_jsstring
+                        (ref.i31 (i32.const 0))
+                        (i32.eqz (call $jsstring_test (local.get $str)))))
                      (local.set $h
-                        (call $caml_hash_mix_int (local.get $h)
-                           (string.hash
-                              (br_on_cast_fail $not_jsstring anyref (ref string)
-                                 (local.get $str)))))
+                        (call $jsstring_hash (local.get $h) (local.get $str)))
                      (ref.i31 (i32.const 0))))
                   ;; closures and continuations and other js values are ignored
                   (br $loop)))))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 9e4eeeb315..8ee6467fc0 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -66,6 +66,12 @@
       (func $caml_is_closure (param (ref eq)) (result i32)))
    (import "obj" "caml_is_last_arg"
       (func $caml_is_last_arg (param (ref eq)) (result i32)))
+   (import "jsstring" "jsstring_of_substring"
+      (func $jsstring_of_substring
+         (param (ref $string)) (param i32) (param i32) (result anyref)))
+   (import "jsstring" "string_of_jsstring"
+      (func $string_of_jsstring
+         (param anyref) (param i32) (result (ref $string))))
 
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
@@ -108,8 +114,8 @@
       (local.set $s (ref.cast (ref $string) (local.get 0)))
       (return_call $wrap
          (call $eval
-            (string.new_lossy_utf8_array
-               (local.get $s) (i32.const 0) (array.len (local.get $s))))))
+             (call $jsstring_of_substring
+                (local.get $s) (i32.const 0) (array.len (local.get $s))))))
 
    (func (export "caml_js_global") (param (ref eq)) (result (ref eq))
       (call $wrap (global.get $global_this)))
@@ -382,20 +388,15 @@
                                  (local.get $acc)))))))))
       (return_call $unwrap (local.get $acc)))
 
-   (func $caml_jsstring_of_substring (export "caml_jsstring_of_substring")
-      (param $s (ref $string)) (param $pos i32) (param $len i32)
-      (result (ref eq))
-      (struct.new $js
-         (string.new_lossy_utf8_array (local.get $s) (local.get $pos)
-            (i32.add (local.get $pos) (local.get $len)))))
-
    (export "caml_js_from_string" (func $caml_jsstring_of_string))
    (func $caml_jsstring_of_string (export "caml_jsstring_of_string")
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
       (local.set $s (ref.cast (ref $string) (local.get 0)))
-      (return_call $caml_jsstring_of_substring
-         (local.get $s) (i32.const 0) (array.len (local.get $s))))
+      (return
+         (struct.new $js
+            (call $jsstring_of_substring
+               (local.get $s) (i32.const 0) (array.len (local.get $s))))))
 
    (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
       (param (ref eq)) (result (ref eq))
@@ -418,8 +419,8 @@
          (then
             (return
                (struct.new $js
-                  (string.new_utf8_array (local.get $s) (i32.const 0)
-                     (local.get $i))))))
+                  (call $jsstring_of_substring
+                     (local.get $s) (i32.const 0) (local.get $i))))))
       (local.set $s'
          (array.new $string (i32.const 0)
             (i32.add (local.get $i) (local.get $n))))
@@ -446,37 +447,27 @@
                      (local.set $n (i32.add (local.get $n) (i32.const 2)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $fill))))
-      (struct.new $js
-         (string.new_utf8_array (local.get $s') (i32.const 0)
-            (local.get $n))))
+      (return
+         (struct.new $js
+            (call $jsstring_of_substring
+               (local.get $s') (i32.const 0) (local.get $n)))))
 
    (export "caml_js_to_string" (func $caml_string_of_jsstring))
    (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
-      (param (ref eq)) (result (ref eq))
-      (local $s (ref string))
-      (local $l i32)
-      (local $s' (ref $string))
-      (local.set $s
-         (ref.cast (ref string)
-            (struct.get $js 0 (ref.cast (ref $js) (local.get 0)))))
-      (local.set $l (string.measure_wtf8 (local.get $s)))
-      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
-      (drop (string.encode_lossy_utf8_array
-               (local.get $s) (local.get $s') (i32.const 0)))
-      (local.get $s'))
+      (param $s (ref eq)) (result (ref eq))
+      (return_call $string_of_jsstring
+         (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))
+         (i32.const 0)))
 
    (func (export "caml_string_of_jsbytes")
-      (param (ref eq)) (result (ref eq))
-      (local $s (ref string))
+      (param $s (ref eq)) (result (ref eq))
       (local $l i32) (local $i i32) (local $n i32) (local $c i32)
       (local $s' (ref $string)) (local $s'' (ref $string))
-      (local.set $s
-         (ref.cast (ref string)
-            (struct.get $js 0 (ref.cast (ref $js) (local.get 0)))))
-      (local.set $l (string.measure_wtf8 (local.get $s)))
-      (local.set $s' (array.new $string (i32.const 0) (local.get $l)))
-      (drop (string.encode_lossy_utf8_array
-               (local.get $s) (local.get $s') (i32.const 0)))
+      (local.set $s'
+         (call $string_of_jsstring
+            (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))
+            (i32.const 0)))
+      (local.set $l (array.len (local.get $s')))
       (local.set $i (i32.const 0))
       (local.set $n (i32.const 0))
       (loop $count
@@ -575,6 +566,8 @@
          (i32.const 106) (i32.const 115) (i32.const 69) (i32.const 114)
          (i32.const 114) (i32.const 111) (i32.const 114)))
 
+   (data $toString "toString")
+
    (func (export "caml_wrap_exception") (param (externref)) (result (ref eq))
       (local $exn anyref)
       (local.set $exn (extern.internalize (local.get 0)))
@@ -591,7 +584,7 @@
             (call $wrap
                (call $meth_call
                   (local.get $exn)
-                  (string.const "toString")
+                  (array.new_data $string $toString (i32.const 0) (i32.const 8))
                   (extern.internalize (call $new_array (i32.const 0))))))))
 
    (func (export "caml_js_error_option_of_exception")
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index 168b362c02..73eb4bd482 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -16,6 +16,7 @@
       (func $caml_js_html_entities (param anyref) (result anyref)))
 
    (type $block (array (mut (ref eq))))
+   (type $string (array (mut i8)))
 
    (func (export "caml_js_on_ie") (param (ref eq)) (result (ref eq))
       (ref.i31 (call $caml_js_on_ie)))
@@ -28,15 +29,20 @@
       (return_call $wrap
          (call $caml_js_html_entities (call $unwrap (local.get 0)))))
 
+   (data $console "console")
+
    (func (export "caml_js_get_console") (param (ref eq)) (result (ref eq))
       (return_call $caml_js_get (call $caml_js_global (ref.i31 (i32.const 0)))
-         (call $wrap (string.const "console"))))
+         (array.new_data $string $console (i32.const 0) (i32.const 7))))
+
+   (data $XMLHttpRequest "XMLHttpRequest")
 
    (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq))
       (return_call $caml_js_new
          (call $caml_js_get
             (call $caml_js_global (ref.i31 (i32.const 0)))
-            (call $wrap (string.const "XMLHttpRequest")))
+            (array.new_data $string $XMLHttpRequest
+               (i32.const 0) (i32.const 14)))
          (call $caml_js_from_array
             (array.new_fixed $block 1 (ref.i31 (i32.const 0))))))
 )
diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
new file mode 100644
index 0000000000..0413e65999
--- /dev/null
+++ b/runtime/wasm/jsstring.wat
@@ -0,0 +1,180 @@
+(module
+   (import "bindings" "log" (func $log_js (param anyref)))
+
+   (import "bindings" "read_string"
+      (func $read_string (param i32) (result anyref)))
+   (import "bindings" "read_string_stream"
+      (func $read_string_stream (param i32) (param i32) (result anyref)))
+   (import "bindings" "write_string"
+      (func $write_string (param anyref) (result i32)))
+   (import "bindings" "append_string"
+      (func $append_string (param anyref) (param anyref) (result anyref)))
+   (import "bindings" "compare_strings"
+      (func $compare_strings
+         (param anyref) (param anyref) (result i32)))
+   (import "bindings" "hash_string"
+      (func $hash_string (param i32) (param anyref) (result i32)))
+   (import "bindings" "is_string"
+      (func $is_string (param anyref) (result i32)))
+
+   (type $string (array (mut i8)))
+
+   (memory (export "caml_buffer") 1)
+
+   (global $buffer_size i32 (i32.const 65536))
+
+   (func $write_to_buffer
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (local $i i32)
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (i32.store8 (local.get $i)
+                  (array.get_u $string (local.get $s)
+                     (i32.add (local.get $pos) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop)))))
+
+   (func $jsstring_of_substring (export "jsstring_of_substring")
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (result anyref)
+      (local $s' anyref)
+      (local $continued i32)
+      (if (i32.le_u (local.get $len) (global.get $buffer_size))
+         (then
+            (call $write_to_buffer
+               (local.get $s) (local.get $pos) (local.get $len))
+            (return_call $read_string (local.get $len))))
+      (call $write_to_buffer
+         (local.get $s) (local.get $pos) (global.get $buffer_size))
+      (local.set $s'
+         (call $read_string_stream (global.get $buffer_size) (i32.const 1)))
+      (loop $loop
+         (local.set $len (i32.sub (local.get $len) (global.get $buffer_size)))
+         (local.set $pos (i32.add (local.get $pos) (global.get $buffer_size)))
+         (local.set $continued
+            (i32.gt_u (local.get $len) (global.get $buffer_size)))
+         (call $write_to_buffer
+            (local.get $s) (local.get $pos)
+            (select (global.get $buffer_size) (local.get $len)
+               (local.get $continued)))
+         (local.set $s'
+            (call $append_string (local.get $s')
+               (call $read_string_stream
+                  (select (global.get $buffer_size) (local.get $len)
+                     (local.get $continued))
+                  (local.get $continued))))
+         (br_if $loop (local.get $continued)))
+      (local.get $s'))
+
+   (func $read_from_buffer
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (local $i i32)
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (array.set $string (local.get $s)
+                  (i32.add (local.get $pos) (local.get $i))
+                  (i32.load8_u (local.get $i)))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop)))))
+
+   (type $stack
+      (struct (field $s (ref $string)) (field $next (ref null $stack))))
+   (global $stack (mut (ref null $stack)) (ref.null $stack))
+
+   (func $string_of_jsstring (export "string_of_jsstring")
+      (param $s anyref) (param $ofs i32) (result (ref $string))
+      (local $len i32)
+      (local $s' (ref $string)) (local $s'' (ref $string))
+      (local $item (ref $stack))
+      (local.set $len (call $write_string (local.get $s)))
+      (if (ref.is_null (global.get $stack))
+         (then
+            (local.set $s'
+               (array.new $string
+                  (i32.const 0) (i32.add (local.get $len) (local.get $ofs))))
+            (call $read_from_buffer
+               (local.get $s') (local.get $ofs) (local.get $len))
+            (return (local.get $s'))))
+      (block $done
+         (local.set $item (br_on_null $done (global.get $stack)))
+         (loop $loop
+            (local.set $ofs
+               (i32.add (local.get $ofs)
+                  (array.len (struct.get $stack $s (local.get $item)))))
+            (local.set $item
+               (br_on_null $done (struct.get $stack $next (local.get $item))))
+            (br $loop)))
+      (local.set $s'
+         (array.new $string (i32.const 0)
+            (i32.add (local.get $len) (local.get $ofs))))
+      (call $read_from_buffer
+         (local.get $s') (local.get $ofs) (local.get $len))
+      (block $done
+         (local.set $item (br_on_null $done (global.get $stack)))
+         (global.set $stack (ref.null $stack))
+         (loop $loop
+            (local.set $s'' (struct.get $stack $s (local.get $item)))
+            (local.set $len (array.len (local.get $s'')))
+            (local.set $ofs (i32.sub (local.get $ofs) (local.get $len)))
+            (array.copy $string $string
+               (local.get $s') (local.get $ofs)
+               (local.get $s'') (i32.const 0)
+               (local.get $len))
+            (local.set $item
+               (br_on_null $done (struct.get $stack $next (local.get $item))))
+            (br $loop)))
+      (local.get $s'))
+
+   (func (export "caml_extract_string") (param $len i32)
+      (local $s (ref $string))
+      (local.set $s (array.new $string (i32.const 0) (local.get $len)))
+      (call $read_from_buffer (local.get $s) (i32.const 0) (local.get $len))
+      (global.set $stack (struct.new $stack (local.get $s) (global.get $stack))))
+
+   (export "jsstring_compare" (func $compare_strings))
+   (export "jsstring_hash" (func $hash_string))
+   (export "jsstring_test" (func $is_string))
+
+(;
+   ;; stringref implementation
+
+   (import "hash" "caml_hash_mix_int"
+      (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
+
+   (func $jsstring_of_substring (export "jsstring_of_substring")
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (result anyref)
+      (string.new_lossy_utf8_array (local.get $s) (local.get $pos)
+         (i32.add (local.get $pos) (local.get $len))))
+
+   (func $string_of_jsstring (export "string_of_jsstring")
+      (param $s0 anyref) (param $ofs i32) (result (ref $string))
+      (local $l i32)
+      (local $s (ref string))
+      (local $s' (ref $string))
+      (local.set $s (ref.cast (ref string) (local.get $s0)))
+      (local.set $l (string.measure_wtf8 (local.get $s)))
+      (local.set $s'
+         (array.new $string
+            (i32.const 0) (i32.add (local.get $l) (local.get $ofs))))
+      (drop (string.encode_lossy_utf8_array
+               (local.get $s) (local.get $s') (local.get $ofs)))
+      (local.get $s'))
+
+   (func (export "jsstring_compare")
+      (param $s anyref) (param $s' anyref) (result i32)
+      (string.compare
+         (ref.cast (ref string) (local.get $s))
+         (ref.cast (ref string) (local.get $s'))))
+
+   (func (export "jsstring_hash")
+      (param $h i32) (param $s anyref) (result i32)
+      (return_call $caml_hash_mix_int (local.get $h)
+         (string.hash (ref.cast (ref string) (local.get $s)))))
+
+   (func (export "jsstring_test") (param $s anyref) (result i32)
+      (ref.test (ref string) (local.get $s)))
+;)
+)
diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat
index 27bf3c9bef..d9b458e5c4 100644
--- a/runtime/wasm/parsing.wat
+++ b/runtime/wasm/parsing.wat
@@ -141,24 +141,26 @@
             (ref.i31 (i32.const 0)) (ref.i31 (i32.const 1))))
       (drop (call $caml_ml_flush (global.get $caml_stderr))))
 
-   (func $output_str (param (ref string))
-      (call $output (call $caml_string_of_jsstring (call $wrap (local.get 0)))))
-
    (func $output_int (param i32)
       (call $output
          (call $caml_format_int
             (array.new_fixed $string 2 (i32.const 37) (i32.const 100))
             (ref.i31 (local.get 0)))))
 
+   (data $State "State ")
+   (data $read_token ": read token ")
+
    (func $print_token
       (param $tables (ref $block)) (param $state i32) (param $tok (ref eq))
       (local $b (ref $block))
       (local $v (ref eq))
       (if (ref.test (ref i31) (local.get $tok))
          (then
-            (call $output_str (string.const "State "))
+            (call $output
+               (array.new_data $string $State (i32.const 0) (i32.const 6)))
             (call $output_int (local.get $state))
-            (call $output_str (string.const ": read token "))
+            (call $output
+               (array.new_data $string $read_token (i32.const 0) (i32.const 13)))
             (call $output
                (call $token_name
                   (array.get $block (local.get $tables)
@@ -166,9 +168,11 @@
                   (i31.get_u (ref.cast (ref i31) (local.get $tok)))))
             (call $output_nl))
          (else
-            (call $output_str (string.const "State "))
+            (call $output
+               (array.new_data $string $State (i32.const 0) (i32.const 6)))
             (call $output_int (local.get $state))
-            (call $output_str (string.const ": read token "))
+            (call $output
+               (array.new_data $string $read_token (i32.const 0) (i32.const 13)))
             (local.set $b (ref.cast (ref $block) (local.get $tok)))
             (call $output
                (call $token_name
@@ -177,7 +181,7 @@
                   (i31.get_u
                      (ref.cast (ref i31)
                         (array.get $block (local.get $b) (i32.const 0))))))
-            (call $output_str (string.const "("))
+            (call $output (array.new_fixed $string 1 (i32.const 40))) ;; "("
             (local.set $v (array.get $block (local.get $b) (i32.const 1)))
             (if (ref.test (ref i31) (local.get $v))
                (then
@@ -193,10 +197,18 @@
                            (i32.const 37) (i32.const 103))
                         (local.get $v))))
             (else
-               (call $output_str (string.const "_"))))))))
-            (call $output_str (string.const ")"))
+               (call $output
+                  (array.new_fixed $string 1 (i32.const 95))))))))) ;; '_'
+            (call $output (array.new_fixed $string 1 (i32.const 41))) ;; ")"
             (call $output_nl))))
 
+   (data $recovering_in_state "Recovering in state ")
+   (data $discarding_state "Discarding state ")
+   (data $no_more_states_to_discard "No more states to discard")
+   (data $discarding_last_token_read "Discarding last token read")
+   (data $shift_to_state ": shift to state ")
+   (data $reduce_by_rule ": reduce by rule ")
+
    (func (export "caml_parse_engine")
       (param $vtables (ref eq)) (param $venv (ref eq)) (param $vcmd (ref eq))
       (param $varg (ref eq)) (result (ref eq))
@@ -431,9 +443,11 @@
                                       (then
                                          (if (global.get $caml_parser_trace)
                                             (then
-                                               (call $output_str
-                                                  (string.const
-                                                     "Recovering in state "))
+                                               (call $output
+                                                  (array.new_data $string
+                                                     $recovering_in_state
+                                                     (i32.const 0)
+                                                     (i32.const 20)))
                                                (call $output_int
                                                   (local.get $state1))
                                                (call $output_nl)))
@@ -442,8 +456,9 @@
                                          (br $next)))))))
                        (if (global.get $caml_parser_trace)
                           (then
-                             (call $output_str
-                                (string.const "Discarding state "))
+                             (call $output
+                                (array.new_data $string $discarding_state
+                                   (i32.const 0) (i32.const 17)))
                              (call $output_int (local.get $state1))
                              (call $output_nl)))
                        (if (i32.le_s (local.get $sp)
@@ -454,9 +469,10 @@
                           (then
                              (if (global.get $caml_parser_trace)
                                 (then
-                                   (call $output_str
-                                      (string.const
-                                         "No more states to discard"))
+                                   (call $output
+                                      (array.new_data $string
+                                          $no_more_states_to_discard
+                                          (i32.const 0) (i32.const 25)))
                                    (call $output_nl)))
                              (return (ref.i31 (global.get $RAISE_PARSE_ERROR)))))
                        (local.set $sp (i32.sub (local.get $sp) (i32.const 1)))
@@ -470,8 +486,9 @@
                            (return (ref.i31 (global.get $RAISE_PARSE_ERROR)))))
                      (if (global.get $caml_parser_trace)
                         (then
-                           (call $output_str
-                              (string.const "Discarding last token read"))
+                           (call $output
+                              (array.new_data $string $discarding_last_token_read
+                                 (i32.const 0) (i32.const 26)))
                            (call $output_nl)))
                      (array.set $block (local.get $env)
                         (global.get $env_curr_char)
@@ -489,9 +506,13 @@
              ;; shift_recover:
              (if (global.get $caml_parser_trace)
                 (then
-                   (call $output_str (string.const "State "))
+                   (call $output
+                      (array.new_data $string $State
+                         (i32.const 0) (i32.const 6)))
                    (call $output_int (local.get $state))
-                   (call $output_str (string.const ": shift to state "))
+                   (call $output
+                      (array.new_data $string $shift_to_state
+                         (i32.const 0) (i32.const 17)))
                    (call $output_int
                       (call $get (local.get $tbl_table) (local.get $n2)))
                    (call $output_nl)))
@@ -535,9 +556,12 @@
            ;; reduce:
            (if (global.get $caml_parser_trace)
               (then
-                 (call $output_str (string.const "State "))
+                 (call $output
+                    (array.new_data $string $State (i32.const 0) (i32.const 6)))
                  (call $output_int (local.get $state))
-                 (call $output_str (string.const ": reduce by rule "))
+                 (call $output
+                    (array.new_data $string $reduce_by_rule
+                       (i32.const 0) (i32.const 17)))
                  (call $output_int (local.get $n))
                  (call $output_nl)))
            (local.set $m (call $get (local.get $tbl_len) (local.get $n)))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 5a0bd3c57f..58f4007246 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -10,8 +10,6 @@
     const isNode = globalThis?.process?.versions?.node;
     const code = isNode?loadRelative(src):fetch(src);
 
-    var caml_callback, caml_alloc_tm;
-
     let math =
         {cos:Math.cos, sin:Math.sin, tan:Math.tan,
          acos:Math.acos, asin:Math.asin, atan:Math.atan,
@@ -72,6 +70,22 @@
        }
     }
 
+    const decoder = new TextDecoder('utf-8', {ignoreBOM: 1});
+    const encoder = new TextEncoder;
+
+    function hash_int(h,d) {
+      d = Math.imul(d, 0xcc9e2d51|0);
+      d = (d << 15) | (d >>> 17); // ROTL32(d, 15);
+      d = Math.imul(d, 0x1b873593);
+      h ^= d;
+      h = (h << 13) | (h >>> 19);   //ROTL32(h, 13);
+      return (((h + (h << 2))|0) + (0xe6546b64|0))|0;
+    }
+    function hash_string(h,s) {
+      for (var i = 0; i < s.length; i++) h = hash_int(h,s.charCodeAt(i));
+      return h ^ s.length;
+    }
+
     let bindings =
         {jstag:WebAssembly.JSTag,
          identity:(x)=>x,
@@ -94,6 +108,24 @@
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,
+         read_string:(l)=>
+           decoder.decode(new Uint8Array(buffer, 0, l)),
+         read_string_stream:(l, stream)=>
+           decoder.decode(new Uint8Array(buffer, 0, l), {stream}),
+         append_string:(s1,s2)=>s1+s2,
+         write_string:(s)=>{
+           var start = 0, len = s.length;
+           while (1) {
+             let {read,written} = encoder.encodeInto(s.slice(start), out_buffer);
+             len -= read;
+             if (!len) return written;
+             caml_extract_string(written);
+             start += read;
+           }
+         },
+         compare_strings:(s1,s2)=>(s1<s2)?-1:+(s1>s2),
+         hash_string,
+         is_string:(v)=>+(typeof v==="string"),
          ta_create:(k,sz)=> new(typed_arrays[k])(sz),
          ta_normalize:(a)=>
            a instanceof Uint32Array?
@@ -270,7 +302,7 @@
            fs.openSync(p,open_flags.reduce((f,v,i)=>(flags&(1<<i))?(f|v):f,0),
                        perm),
          close:(fd)=>fs.closeSync(fd),
-         write:(fd,b,o,l,p)=>fs?fs.writeSync(fd,b,o,l,p==null?p:Number(p)):(console[fd==2?'error':'log'](typeof b=='string'?b:new TextDecoder().decode(b.slice(o,o+l))),l),
+         write:(fd,b,o,l,p)=>fs?fs.writeSync(fd,b,o,l,p==null?p:Number(p)):(console[fd==2?'error':'log'](typeof b=='string'?b:decoder.decode(b.slice(o,o+l))),l),
          read:(fd,b,o,l,p)=>fs.readSync(fd,b,o,l,p),
          file_size:(fd)=>fs.fstatSync(fd,{bigint:true}).size,
          register_channel,
@@ -312,10 +344,14 @@
           isNode?await WebAssembly.instantiate(await code, imports)
                 :await WebAssembly.instantiateStreaming(code,imports)
 
-    var {caml_callback,caml_alloc_tm, caml_start_fiber,
-         caml_handle_uncaught_exception, _initialize} =
+    var {caml_callback, caml_alloc_tm, caml_start_fiber,
+         caml_handle_uncaught_exception, caml_buffer,
+         caml_extract_string, _initialize} =
         wasmModule.instance.exports;
 
+    var buffer = caml_buffer?.buffer
+    var out_buffer = buffer&&new Uint8Array(buffer,0,buffer.length)
+
     start_fiber = wrap_fun(
         {parameters: ['eqref'], results: ['externref']},
         caml_start_fiber, {promising: 'first'}
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 157b5bb893..b5748714cb 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -29,6 +29,8 @@
       (func $array_get (param (ref extern)) (param i32) (result anyref)))
    (import "fail" "javascript_exception"
       (tag $javascript_exception (param externref)))
+   (import "jsstring" "jsstring_test"
+      (func $jsstring_test (param anyref) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -46,7 +48,7 @@
       (local.set $res
          (call $getenv
             (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
-      (if (i32.eqz (ref.test (ref string) (local.get $res)))
+      (if (i32.eqz (call $jsstring_test (local.get $res)))
          (then
             (call $caml_raise_not_found)))
       (return_call $caml_string_of_jsstring (call $wrap (local.get $res))))
@@ -167,12 +169,14 @@
       (param (ref eq)) (result (ref eq))
       (ref.i31 (global.get $caml_runtime_warnings)))
 
+   (data $toString "toString")
+
    (func $caml_handle_sys_error (export "caml_handle_sys_error")
       (param $exn externref)
       (call $caml_raise_sys_error
          (call $caml_string_of_jsstring
             (call $caml_js_meth_call
                (call $wrap (extern.internalize (local.get $exn)))
-               (call $wrap (string.const "toString"))
+               (array.new_data $string $toString (i32.const 0) (i32.const 8))
                (array.new_fixed $block 1 (ref.i31 (i32.const 0)))))))
 )

From 50e7fd4ad22a3e3157ef9af0b45d34bae13c66b4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 28 Sep 2023 11:43:33 +0200
Subject: [PATCH 142/481] Out of band handler for bound check errors and
 division by zero

The resulting code is easier to optimize
---
 compiler/lib/code.ml               |  18 ++
 compiler/lib/code.mli              |   2 +
 compiler/lib/wasm/wa_asm_output.ml |   1 +
 compiler/lib/wasm/wa_ast.ml        |   1 +
 compiler/lib/wasm/wa_generate.ml   | 293 ++++++++++++++---------------
 compiler/lib/wasm/wa_tail_call.ml  |   1 +
 compiler/lib/wasm/wa_wat_output.ml |   1 +
 7 files changed, 165 insertions(+), 152 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index c8f8393d9d..efdbc4f52c 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -616,6 +616,24 @@ let fold_children blocks pc f accu =
       let accu = Array.fold_right ~init:accu ~f:(fun (pc, _) accu -> f pc accu) a2 in
       accu
 
+let fold_children_skip_try_body blocks pc f accu =
+  let block = Addr.Map.find pc blocks in
+  match fst block.branch with
+  | Return _ | Raise _ | Stop -> accu
+  | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
+  | Pushtrap (_, _, (pc_h, _), pcs) ->
+      let accu = Addr.Set.fold f pcs accu in
+      let accu = f pc_h accu in
+      accu
+  | Cond (_, (pc1, _), (pc2, _)) ->
+      let accu = f pc1 accu in
+      let accu = f pc2 accu in
+      accu
+  | Switch (_, a1, a2) ->
+      let accu = Array.fold_right ~init:accu ~f:(fun (pc, _) accu -> f pc accu) a1 in
+      let accu = Array.fold_right ~init:accu ~f:(fun (pc, _) accu -> f pc accu) a2 in
+      accu
+
 type 'c fold_blocs = block Addr.Map.t -> Addr.t -> (Addr.t -> 'c -> 'c) -> 'c -> 'c
 
 type fold_blocs_poly = { fold : 'a. 'a fold_blocs } [@@unboxed]
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index b61b093032..13f036fd14 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -269,6 +269,8 @@ val fold_closures_outermost_first :
 
 val fold_children : 'c fold_blocs
 
+val fold_children_skip_try_body : 'c fold_blocs
+
 val traverse :
   fold_blocs_poly -> (Addr.t -> 'c -> 'c) -> Addr.t -> block Addr.Map.t -> 'c -> 'c
 
diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 0c55a6b7f0..76cb73ad84 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -363,6 +363,7 @@ module Output () = struct
              ^^ string "}")
     | Br (i, Some e) -> expression e ^^ instruction (Br (i, None))
     | Br (i, None) -> line (string "br " ^^ integer i)
+    | Br_if (i, e) -> expression e ^^ line (string "br_if " ^^ integer i)
     | Return (Some e) -> expression e ^^ instruction (Return None)
     | Return None -> line (string "return")
     | CallInstr (x, l) -> concat_map expression l ^^ line (string "call " ^^ index x)
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 48b803635b..5eddd4c1bc 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -168,6 +168,7 @@ and instruction =
   | If of func_type * expression * instruction list * instruction list
   | Br_table of expression * int list * int
   | Br of int * expression option
+  | Br_if of int * expression
   | Return of expression option
   | CallInstr of var * expression list
   | Nop
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index e749770c42..c10c723b1a 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -74,7 +74,20 @@ module Generate (Target : Wa_target_sig.S) = struct
     let* g = Value.int_val g in
     Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 op, f, g)))
 
-  let rec translate_expr ctx stack_ctx x e =
+  let label_index context pc =
+    let rec index_rec context pc i =
+      match context with
+      | `Block pc' :: _ when pc = pc' -> i
+      | (`Block _ | `Skip) :: rem -> index_rec rem pc (i + 1)
+      | [] -> assert false
+    in
+    index_rec context pc 0
+
+  let bound_error_pc = -1
+
+  let zero_divide_pc = -2
+
+  let rec translate_expr ctx stack_ctx context x e =
     match e with
     | Apply { f; args; exact }
       when exact || List.length args = if Var.Set.mem x ctx.in_cps then 2 else 1 ->
@@ -155,31 +168,13 @@ module Generate (Target : Wa_target_sig.S) = struct
             seq (Memory.bytes_set x y z) Value.unit
         | Extern ("caml_string_get" | "caml_bytes_get"), [ x; y ] ->
             seq
-              (let* f =
-                 register_import
-                   ~name:"caml_bound_error"
-                   (Fun { params = []; result = [] })
-               in
-               if_
-                 { params = []; result = [] }
-                 (Arith.uge (Value.int_val y) (Memory.bytes_length x))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+              (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in
+               instr (W.Br_if (label_index context bound_error_pc, cond)))
               (Memory.bytes_get x y)
         | Extern ("caml_string_set" | "caml_bytes_set"), [ x; y; z ] ->
             seq
-              (let* f =
-                 register_import
-                   ~name:"caml_bound_error"
-                   (Fun { params = []; result = [] })
-               in
-               let* () =
-                 if_
-                   { params = []; result = [] }
-                   (Arith.uge (Value.int_val y) (Memory.bytes_length x))
-                   (instr (CallInstr (f, [])))
-                   (return ())
-               in
+              (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in
+               let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
                Memory.bytes_set x y z)
               Value.unit
         | Extern ("caml_ml_string_length" | "caml_ml_bytes_length"), [ x ] ->
@@ -189,30 +184,14 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
         | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y
         | Extern "%int_div", [ x; y ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             seq
-              (if_
-                 { params = []; result = [] }
-                 (Arith.eqz (Value.int_val y))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+              (let* cond = Arith.eqz (Value.int_val y) in
+               instr (W.Br_if (label_index context zero_divide_pc, cond)))
               (Value.int_div x y)
         | Extern "%int_mod", [ x; y ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             seq
-              (if_
-                 { params = []; result = [] }
-                 (Arith.eqz (Value.int_val y))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+              (let* cond = Arith.eqz (Value.int_val y) in
+               instr (W.Br_if (label_index context zero_divide_pc, cond)))
               (Value.int_mod x y)
         | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
         | Extern "%int_neg", [ x ] -> Value.int_neg x
@@ -223,37 +202,19 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
         | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
         | Extern "caml_check_bound", [ x; y ] ->
-            let* f =
-              register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
-            in
             seq
-              (if_
-                 { params = []; result = [] }
-                 (Arith.uge (Value.int_val y) (Memory.array_length x))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+              (let* cond = Arith.uge (Value.int_val y) (Memory.array_length x) in
+               instr (W.Br_if (label_index context bound_error_pc, cond)))
               x
         | Extern "caml_check_bound_gen", [ x; y ] ->
-            let* f =
-              register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
-            in
             seq
-              (if_
-                 { params = []; result = [] }
-                 (Arith.uge (Value.int_val y) (Memory.gen_array_length x))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+              (let* cond = Arith.uge (Value.int_val y) (Memory.gen_array_length x) in
+               instr (W.Br_if (label_index context bound_error_pc, cond)))
               x
         | Extern "caml_check_bound_float", [ x; y ] ->
-            let* f =
-              register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
-            in
             seq
-              (if_
-                 { params = []; result = [] }
-                 (Arith.uge (Value.int_val y) (Memory.float_array_length x))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+              (let* cond = Arith.uge (Value.int_val y) (Memory.float_array_length x) in
+               instr (W.Br_if (label_index context bound_error_pc, cond)))
               x
         | Extern "caml_add_float", [ f; g ] -> float_bin_op stack_ctx x Add f g
         | Extern "caml_sub_float", [ f; g ] -> float_bin_op stack_ctx x Sub f g
@@ -335,11 +296,6 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_int32_or", [ i; j ] -> int32_bin_op stack_ctx x Or i j
         | Extern "caml_int32_xor", [ i; j ] -> int32_bin_op stack_ctx x Xor i j
         | Extern "caml_int32_div", [ i; j ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             let res = Var.fresh () in
             (*ZZZ Can we do better?*)
             let i' = Var.fresh () in
@@ -347,12 +303,8 @@ module Generate (Target : Wa_target_sig.S) = struct
             seq
               (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
                let* () =
-                 if_
-                   { params = []; result = [] }
-                   (let* j = load j' in
-                    return (W.UnOp (I32 Eqz, j)))
-                   (instr (CallInstr (f, [])))
-                   (return ())
+                 let* j = load j' in
+                 instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))
                in
                let* () = store ~typ:I32 i' (Memory.unbox_int32 i) in
                if_
@@ -372,20 +324,11 @@ module Generate (Target : Wa_target_sig.S) = struct
                      return (W.BinOp (I32 (Div S), i, j)))))
               (Memory.box_int32 stack_ctx x (load res))
         | Extern "caml_int32_mod", [ i; j ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             let j' = Var.fresh () in
             seq
               (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
-               if_
-                 { params = []; result = [] }
-                 (let* j = load j' in
-                  return (W.UnOp (I32 Eqz, j)))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+               let* j = load j' in
+               instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
               (let* i = Memory.unbox_int32 i in
                let* j = load j' in
                Memory.box_int32 stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
@@ -419,11 +362,6 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_int64_or", [ i; j ] -> int64_bin_op stack_ctx x Or i j
         | Extern "caml_int64_xor", [ i; j ] -> int64_bin_op stack_ctx x Xor i j
         | Extern "caml_int64_div", [ i; j ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             let res = Var.fresh () in
             (*ZZZ Can we do better?*)
             let i' = Var.fresh () in
@@ -431,12 +369,8 @@ module Generate (Target : Wa_target_sig.S) = struct
             seq
               (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
                let* () =
-                 if_
-                   { params = []; result = [] }
-                   (let* j = load j' in
-                    return (W.UnOp (I64 Eqz, j)))
-                   (instr (CallInstr (f, [])))
-                   (return ())
+                 let* j = load j' in
+                 instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j)))
                in
                let* () = store ~typ:I64 i' (Memory.unbox_int64 i) in
                if_
@@ -456,20 +390,11 @@ module Generate (Target : Wa_target_sig.S) = struct
                      return (W.BinOp (I64 (Div S), i, j)))))
               (Memory.box_int64 stack_ctx x (load res))
         | Extern "caml_int64_mod", [ i; j ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             let j' = Var.fresh () in
             seq
               (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
-               if_
-                 { params = []; result = [] }
-                 (let* j = load j' in
-                  return (W.UnOp (I64 Eqz, j)))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+               let* j = load j' in
+               instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j))))
               (let* i = Memory.unbox_int64 i in
                let* j = load j' in
                Memory.box_int64 stack_ctx x (return (W.BinOp (I64 (Rem S), i, j))))
@@ -533,11 +458,6 @@ module Generate (Target : Wa_target_sig.S) = struct
         | Extern "caml_nativeint_or", [ i; j ] -> nativeint_bin_op stack_ctx x Or i j
         | Extern "caml_nativeint_xor", [ i; j ] -> nativeint_bin_op stack_ctx x Xor i j
         | Extern "caml_nativeint_div", [ i; j ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             let res = Var.fresh () in
             (*ZZZ Can we do better?*)
             let i' = Var.fresh () in
@@ -545,12 +465,8 @@ module Generate (Target : Wa_target_sig.S) = struct
             seq
               (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
                let* () =
-                 if_
-                   { params = []; result = [] }
-                   (let* j = load j' in
-                    return (W.UnOp (I32 Eqz, j)))
-                   (instr (CallInstr (f, [])))
-                   (return ())
+                 let* j = load j' in
+                 instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))
                in
                let* () = store ~typ:I32 i' (Memory.unbox_nativeint i) in
                if_
@@ -570,20 +486,11 @@ module Generate (Target : Wa_target_sig.S) = struct
                      return (W.BinOp (I32 (Div S), i, j)))))
               (Memory.box_nativeint stack_ctx x (load res))
         | Extern "caml_nativeint_mod", [ i; j ] ->
-            let* f =
-              register_import
-                ~name:"caml_raise_zero_divide"
-                (Fun { params = []; result = [] })
-            in
             let j' = Var.fresh () in
             seq
               (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
-               if_
-                 { params = []; result = [] }
-                 (let* j = load j' in
-                  return (W.UnOp (I32 Eqz, j)))
-                 (instr (CallInstr (f, [])))
-                 (return ()))
+               let* j = load j' in
+               instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
               (let* i = Memory.unbox_nativeint i in
                let* j = load j' in
                Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
@@ -644,15 +551,15 @@ module Generate (Target : Wa_target_sig.S) = struct
         | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
             assert false)
 
-  and translate_instr ctx stack_ctx (i, _) =
+  and translate_instr ctx stack_ctx context (i, _) =
     match i with
     | Assign (x, y) ->
         let* () = assign x (load y) in
         Stack.assign stack_ctx x
     | Let (x, e) ->
         if ctx.live.(Var.idx x) = 0
-        then drop (translate_expr ctx stack_ctx x e)
-        else store x (translate_expr ctx stack_ctx x e)
+        then drop (translate_expr ctx stack_ctx context x e)
+        else store x (translate_expr ctx stack_ctx context x e)
     | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
     | Offset_ref (x, n) ->
         Memory.set_field
@@ -662,13 +569,13 @@ module Generate (Target : Wa_target_sig.S) = struct
              Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
     | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
 
-  and translate_instrs ctx stack_ctx l =
+  and translate_instrs ctx stack_ctx context l =
     match l with
     | [] -> return ()
     | i :: rem ->
         let* () = Stack.perform_reloads stack_ctx (`Instr (fst i)) in
-        let* () = translate_instr ctx stack_ctx i in
-        translate_instrs ctx stack_ctx rem
+        let* () = translate_instr ctx stack_ctx context i in
+        translate_instrs ctx stack_ctx context rem
 
   let parallel_renaming params args =
     let rec visit visited prev s m x l =
@@ -720,6 +627,84 @@ module Generate (Target : Wa_target_sig.S) = struct
     | `Block _ as b -> b :: context
     | `Return -> `Skip :: context
 
+  let needed_handlers (p : program) pc =
+    Code.traverse
+      { fold = fold_children_skip_try_body }
+      (fun pc n ->
+        let block = Addr.Map.find pc p.blocks in
+        List.fold_left
+          ~f:(fun n (i, _) ->
+            match i with
+            | Let
+                ( _
+                , Prim
+                    ( Extern
+                        ( "caml_string_get"
+                        | "caml_bytes_get"
+                        | "caml_string_set"
+                        | "caml_bytes_set"
+                        | "caml_check_bound"
+                        | "caml_check_bound_gen"
+                        | "caml_check_bound_float" )
+                    , _ ) ) -> fst n, true
+            | Let
+                ( _
+                , Prim
+                    ( Extern
+                        ( "%int_div"
+                        | "%int_mod"
+                        | "caml_int32_div"
+                        | "caml_int32_mod"
+                        | "caml_int64_div"
+                        | "caml_int64_mod"
+                        | "caml_nativeint_div"
+                        | "caml_nativeint_mod" )
+                    , _ ) ) -> true, snd n
+            | _ -> n)
+          ~init:n
+          block.body)
+      pc
+      p.blocks
+      (false, false)
+
+  let wrap_with_handler needed pc handler ~result_typ ~fall_through ~context body =
+    if needed
+    then
+      let* () =
+        block
+          { params = []; result = [] }
+          (body ~result_typ:[] ~fall_through:(`Block pc) ~context:(`Block pc :: context))
+      in
+      if List.is_empty result_typ
+      then handler
+      else
+        let* () = handler in
+        instr (W.Return (Some (RefI31 (Const (I32 0l)))))
+    else body ~result_typ ~fall_through ~context
+
+  let wrap_with_handlers p pc ~result_typ ~fall_through ~context body =
+    let need_zero_divide_handler, need_bound_error_handler = needed_handlers p pc in
+    wrap_with_handler
+      need_bound_error_handler
+      bound_error_pc
+      (let* f =
+         register_import ~name:"caml_bound_error" (Fun { params = []; result = [] })
+       in
+       instr (CallInstr (f, [])))
+      (wrap_with_handler
+         need_zero_divide_handler
+         zero_divide_pc
+         (let* f =
+            register_import
+              ~name:"caml_raise_zero_divide"
+              (Fun { params = []; result = [] })
+          in
+          instr (CallInstr (f, [])))
+         body)
+      ~result_typ
+      ~fall_through
+      ~context
+
   let translate_function p ctx name_opt toplevel_name params ((pc, _) as cont) acc =
     let stack_info =
       Stack.generate_spilling_information
@@ -735,12 +720,6 @@ module Generate (Target : Wa_target_sig.S) = struct
     in
     let g = Wa_structure.build_graph ctx.blocks pc in
     let dom = Wa_structure.dominator_tree g in
-    let rec index pc i context =
-      match context with
-      | `Block pc' :: _ when pc = pc' -> i
-      | (`Block _ | `Skip) :: rem -> index pc (i + 1) rem
-      | [] -> assert false
-    in
     let rec translate_tree result_typ fall_through pc context =
       let block = Addr.Map.find pc ctx.blocks in
       let is_switch =
@@ -794,7 +773,7 @@ module Generate (Target : Wa_target_sig.S) = struct
           let block = Addr.Map.find pc ctx.blocks in
           let* global_context = get_context in
           let stack_ctx = Stack.start_block ~context:global_context stack_info pc in
-          let* () = translate_instrs ctx stack_ctx block.body in
+          let* () = translate_instrs ctx stack_ctx context block.body in
           let* () = Stack.perform_reloads stack_ctx (`Branch (fst block.branch)) in
           let* () = Stack.perform_spilling stack_ctx (`Block pc) in
           match fst block.branch with
@@ -828,7 +807,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                 let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
                 let dest (pc, args) =
                   assert (List.is_empty args);
-                  index pc 0 context
+                  label_index context pc
                 in
                 let* e = e in
                 instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
@@ -842,7 +821,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                         (nest rem (`Block pc' :: context))
                     in
                     let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
-                    instr (Br (index pc' 0 context, None))
+                    instr (Br (label_index context pc', None))
                 | [] -> (
                     match a1, a2 with
                     | [||], _ -> br_table (Memory.tag (load x)) a2 context
@@ -866,8 +845,11 @@ module Generate (Target : Wa_target_sig.S) = struct
                 ~result_typ
                 ~fall_through
                 ~context:(extend_context fall_through context)
-                (fun ~result_typ ~fall_through ~context ->
-                  translate_branch result_typ fall_through pc cont context stack_ctx)
+                (wrap_with_handlers
+                   p
+                   (fst cont)
+                   (fun ~result_typ ~fall_through ~context ->
+                     translate_branch result_typ fall_through pc cont context stack_ctx))
                 x
                 (fun ~result_typ ~fall_through ~context ->
                   translate_branch result_typ fall_through pc cont' context stack_ctx)
@@ -887,7 +869,7 @@ module Generate (Target : Wa_target_sig.S) = struct
       then
         match fall_through with
         | `Block dst' when dst = dst' -> return ()
-        | _ -> instr (Br (index dst 0 context, None))
+        | _ -> instr (Br (label_index context dst, None))
       else translate_tree result_typ fall_through dst context
     in
     let bind_parameters =
@@ -927,7 +909,14 @@ module Generate (Target : Wa_target_sig.S) = struct
           (let* () = build_initial_env in
            let stack_ctx = Stack.start_function ~context:ctx.global_context stack_info in
            let* () = Stack.perform_spilling stack_ctx `Function in
-           translate_branch [ Value.value ] `Return (-1) cont [] stack_ctx)
+           wrap_with_handlers
+             p
+             pc
+             ~result_typ:[ Value.value ]
+             ~fall_through:`Return
+             ~context:[]
+             (fun ~result_typ ~fall_through ~context ->
+               translate_branch result_typ fall_through (-1) cont context stack_ctx))
     in
     W.Function
       { name =
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index 8053092c90..36cc5466f5 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -26,6 +26,7 @@ let rec instruction ~tail i =
   | GlobalSet _
   | Br_table _
   | Br _
+  | Br_if _
   | Return _
   | Throw _
   | Rethrow _
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index b375d86502..7d27f7348e 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -392,6 +392,7 @@ let expression_or_instructions ctx in_function =
             | None -> []
             | Some e -> expression e))
         ]
+    | Br_if (i, e) -> [ List (Atom "br_if" :: Atom (string_of_int i) :: expression e) ]
     | Return e ->
         [ List
             (Atom "return"

From 7a19956883c15cac50f29fbfc242bd96bb2acec2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 28 Sep 2023 11:45:39 +0200
Subject: [PATCH 143/481] Make all tests pass

---
 compiler/tests-check-prim/main.output         |   1 +
 compiler/tests-check-prim/unix-unix.output    |   1 +
 compiler/tests-full/stdlib.cma.expected.js    | 400 +++++++++---------
 compiler/tests-num/dune                       |   3 +
 compiler/tests-ocaml/lib-effects/evenodd.ml   |   2 +-
 .../tests-ocaml/lib-effects/evenodd.reference |   2 +-
 compiler/tests-ocaml/lib-hashtbl/dune         |   8 +
 .../lib-hashtbl/hfun.reference-wasm           |  27 ++
 compiler/tests-sourcemap/dune                 |   4 +-
 examples/hyperbolic/hypertree.ml              |   4 +-
 lib/tests/dune.inc                            |   2 +-
 lib/tests/gen-rules/gen.ml                    |   5 +-
 lib/tests/test_fun_call.ml                    |  28 +-
 lib/tests/test_poly_compare.ml                |  39 +-
 tools/node_wrapper.sh                         |   2 +-
 toplevel/examples/lwt_toplevel/dune           |   2 +
 16 files changed, 288 insertions(+), 242 deletions(-)
 create mode 100644 compiler/tests-ocaml/lib-hashtbl/hfun.reference-wasm

diff --git a/compiler/tests-check-prim/main.output b/compiler/tests-check-prim/main.output
index cbff808085..ca4d01f3ce 100644
--- a/compiler/tests-check-prim/main.output
+++ b/compiler/tests-check-prim/main.output
@@ -199,6 +199,7 @@ caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
 caml_register_global
+caml_unregister_named_value
 
 From +str.js:
 caml_str_initialize
diff --git a/compiler/tests-check-prim/unix-unix.output b/compiler/tests-check-prim/unix-unix.output
index ee0d0dcacb..8d157ea013 100644
--- a/compiler/tests-check-prim/unix-unix.output
+++ b/compiler/tests-check-prim/unix-unix.output
@@ -308,6 +308,7 @@ caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
 caml_register_global
+caml_unregister_named_value
 
 From +str.js:
 caml_str_initialize
diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js
index 498240028e..c4be1fc1d2 100644
--- a/compiler/tests-full/stdlib.cma.expected.js
+++ b/compiler/tests-full/stdlib.cma.expected.js
@@ -1243,6 +1243,7 @@
    var
     runtime = globalThis.jsoo_runtime,
     cst_Obj_extension_constructor$1 = "Obj.extension_constructor",
+    caml_check_bound = runtime.caml_check_bound,
     caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace,
     caml_obj_tag = runtime.caml_obj_tag;
     /*<<?>>*/ function caml_call1(f, a0){
@@ -1268,9 +1269,14 @@
    function is_block(a){
      /*<<obj.ml:26:34>>*/ return 1 - (typeof a === "number" ? 1 : 0);
     /*<<obj.ml:26:48>>*/ }
+   function double_field(x, i){
+     /*<<obj.ml:38:40>>*/ return caml_check_bound(x, i)[1 + i];
+    /*<<obj.ml:38:77>>*/ }
+   function set_double_field(x, i, v){
+     /*<<obj.ml:40:2>>*/ caml_check_bound(x, i)[1 + i] = v;
+     /*<<obj.ml:40:2>>*/ return 0;
+    /*<<obj.ml:40:41>>*/ }
    var
-    double_field = runtime.caml_array_get,
-    set_double_field = runtime.caml_array_set,
     first_non_constant_constructor = 0,
     last_non_constant_constructor_ = 243,
     forcing_tag = 244,
@@ -7693,8 +7699,7 @@
     runtime = globalThis.jsoo_runtime,
     cst_Float_array_blit$1 = "Float.array.blit",
     cst_float_ml = "float.ml",
-    caml_array_get = runtime.caml_array_get,
-    caml_array_set = runtime.caml_array_set,
+    caml_check_bound = runtime.caml_check_bound,
     caml_float_compare = runtime.caml_float_compare,
     caml_floatarray_blit = runtime.caml_floatarray_blit,
     caml_floatarray_create = runtime.caml_floatarray_create,
@@ -7760,8 +7765,8 @@
     pi = 3.141592653589793;
    function is_integer(x){
      /*<<float.ml:111:19>>*/ var
-     _aq_ = x ==  /*<<float.ml:111:23>>*/ runtime.caml_trunc_float(x) ? 1 : 0;
-    return _aq_ ? is_finite(x) : _aq_;
+     _aQ_ = x ==  /*<<float.ml:111:23>>*/ runtime.caml_trunc_float(x) ? 1 : 0;
+    return _aQ_ ? is_finite(x) : _aQ_;
     /*<<float.ml:111:45>>*/ }
    function succ(x){
      /*<<float.ml:116:13>>*/ return  /*<<float.ml:116:13>>*/ caml_nextafter_float
@@ -7858,32 +7863,32 @@
             (10, 100, 0, x);
     /*<<float.ml:164:41>>*/ }
    function unsafe_fill(a, ofs, len, v){
-     /*<<float.ml:178:4>>*/ var _ao_ = (ofs + len | 0) - 1 | 0;
-    if(_ao_ >= ofs){
+     /*<<float.ml:178:4>>*/ var _aO_ = (ofs + len | 0) - 1 | 0;
+    if(_aO_ >= ofs){
      var i = ofs;
      for(;;){
        /*<<float.ml:178:36>>*/ a[1 + i] = v;
-       /*<<float.ml:178:36>>*/  /*<<float.ml:178:36>>*/ var _ap_ = i + 1 | 0;
-      if(_ao_ !== i){var i = _ap_; continue;}
+       /*<<float.ml:178:36>>*/  /*<<float.ml:178:36>>*/ var _aP_ = i + 1 | 0;
+      if(_aO_ !== i){var i = _aP_; continue;}
       break;
      }
     }
     return 0;
     /*<<float.ml:178:57>>*/ }
    function check(a, ofs, len, msg){
-     /*<<float.ml:184:4>>*/ var _ak_ = ofs < 0 ? 1 : 0;
-    if(_ak_)
-     var _al_ = _ak_;
+     /*<<float.ml:184:4>>*/ var _aK_ = ofs < 0 ? 1 : 0;
+    if(_aK_)
+     var _aL_ = _aK_;
     else{
-     var _am_ = len < 0 ? 1 : 0;
-     if(_am_)
-      var _al_ = _am_;
+     var _aM_ = len < 0 ? 1 : 0;
+     if(_aM_)
+      var _aL_ = _aM_;
      else
       var
-       _an_ = (ofs + len | 0) < 0 ? 1 : 0,
-       _al_ = _an_ || (a.length - 1 < (ofs + len | 0) ? 1 : 0);
+       _aN_ = (ofs + len | 0) < 0 ? 1 : 0,
+       _aL_ = _aN_ || (a.length - 1 < (ofs + len | 0) ? 1 : 0);
     }
-    return _al_ ?  /*<<float.ml:185:6>>*/ caml_call1(Stdlib[1], msg) : _al_;
+    return _aL_ ?  /*<<float.ml:185:6>>*/ caml_call1(Stdlib[1], msg) : _aL_;
     /*<<float.ml:185:21>>*/ }
    function make(n, v){
      /*<<float.ml:188:4>>*/  /*<<float.ml:188:17>>*/ var
@@ -7898,15 +7903,15 @@
      /*<<float.ml:195:16>>*/ var
       /*<<float.ml:195:16>>*/ res =
         /*<<float.ml:195:16>>*/ caml_floatarray_create(l),
-      /*<<float.ml:196:6>>*/ _ai_ = l - 1 | 0,
-      /*<<float.ml:195:16>>*/ _ah_ = 0;
-    if(_ai_ >= 0){
-     var i = _ah_;
+      /*<<float.ml:196:6>>*/ _aI_ = l - 1 | 0,
+      /*<<float.ml:195:16>>*/ _aH_ = 0;
+    if(_aI_ >= 0){
+     var i = _aH_;
      for(;;){
        /*<<float.ml:197:8>>*/ res[1 + i] =
         /*<<float.ml:197:25>>*/ caml_call1(f, i);
-       /*<<float.ml:197:8>>*/  /*<<float.ml:197:8>>*/ var _aj_ = i + 1 | 0;
-      if(_ai_ !== i){var i = _aj_; continue;}
+       /*<<float.ml:197:8>>*/  /*<<float.ml:197:8>>*/ var _aJ_ = i + 1 | 0;
+      if(_aI_ !== i){var i = _aJ_; continue;}
       break;
      }
     }
@@ -7991,11 +7996,11 @@
             (src, sofs, dst, dofs, len);
     /*<<float.ml:250:37>>*/ }
    function to_list(a){
-     /*<<float.ml:253:25>>*/ function _af_(_ag_){
-      /*<<?>>*/ return a[1 + _ag_];
+     /*<<float.ml:253:25>>*/ function _aF_(_aG_){
+      /*<<?>>*/ return a[1 + _aG_];
     }
      /*<<float.ml:253:25>>*/ return  /*<<float.ml:253:25>>*/ caml_call2
-            (Stdlib_List[10], a.length - 1, _af_);
+            (Stdlib_List[10], a.length - 1, _aF_);
     /*<<float.ml:253:39>>*/ }
    function of_list(l){
      /*<<float.ml:256:4>>*/ var
@@ -8016,15 +8021,15 @@
     /*<<float.ml:262:12>>*/ }
    function iter(f, a){
      /*<<float.ml:266:4>>*/ var
-     _ad_ = a.length - 1 - 1 | 0,
-      /*<<float.ml:266:4>>*/ _ac_ = 0;
-    if(_ad_ >= 0){
-     var i = _ac_;
+     _aD_ = a.length - 1 - 1 | 0,
+      /*<<float.ml:266:4>>*/ _aC_ = 0;
+    if(_aD_ >= 0){
+     var i = _aC_;
      for(;;){
        /*<<float.ml:266:33>>*/  /*<<float.ml:266:33>>*/ caml_call1
        (f, a[1 + i]);
-       /*<<float.ml:266:33>>*/  /*<<float.ml:266:33>>*/ var _ae_ = i + 1 | 0;
-      if(_ad_ !== i){var i = _ae_; continue;}
+       /*<<float.ml:266:33>>*/  /*<<float.ml:266:33>>*/ var _aE_ = i + 1 | 0;
+      if(_aD_ !== i){var i = _aE_; continue;}
       break;
      }
     }
@@ -8035,15 +8040,15 @@
       /*<<float.ml:271:6>>*/ return  /*<<float.ml:271:6>>*/ caml_call1
              (Stdlib[1], cst_Float_Array_iter2_arrays_m);
      /*<<float.ml:273:6>>*/ var
-     _aa_ = a.length - 1 - 1 | 0,
-      /*<<float.ml:273:6>>*/ _$_ = 0;
-    if(_aa_ >= 0){
-     var i = _$_;
+     _aA_ = a.length - 1 - 1 | 0,
+      /*<<float.ml:273:6>>*/ _az_ = 0;
+    if(_aA_ >= 0){
+     var i = _az_;
      for(;;){
        /*<<float.ml:273:35>>*/  /*<<float.ml:273:35>>*/ caml_call2
        (f, a[1 + i], b[1 + i]);
-       /*<<float.ml:273:35>>*/  /*<<float.ml:273:35>>*/ var _ab_ = i + 1 | 0;
-      if(_aa_ !== i){var i = _ab_; continue;}
+       /*<<float.ml:273:35>>*/  /*<<float.ml:273:35>>*/ var _aB_ = i + 1 | 0;
+      if(_aA_ !== i){var i = _aB_; continue;}
       break;
      }
     }
@@ -8054,15 +8059,15 @@
      l = a.length - 1,
       /*<<float.ml:277:12>>*/ r =
         /*<<float.ml:277:12>>*/ caml_floatarray_create(l),
-      /*<<float.ml:278:4>>*/ _Z_ = l - 1 | 0,
-      /*<<float.ml:277:12>>*/ _Y_ = 0;
-    if(_Z_ >= 0){
-     var i = _Y_;
+      /*<<float.ml:278:4>>*/ _ax_ = l - 1 | 0,
+      /*<<float.ml:277:12>>*/ _aw_ = 0;
+    if(_ax_ >= 0){
+     var i = _aw_;
      for(;;){
        /*<<float.ml:279:6>>*/ r[1 + i] =
         /*<<float.ml:279:21>>*/ caml_call1(f, a[1 + i]);
-       /*<<float.ml:279:6>>*/  /*<<float.ml:279:6>>*/ var ___ = i + 1 | 0;
-      if(_Z_ !== i){var i = ___; continue;}
+       /*<<float.ml:279:6>>*/  /*<<float.ml:279:6>>*/ var _ay_ = i + 1 | 0;
+      if(_ax_ !== i){var i = _ay_; continue;}
       break;
      }
     }
@@ -8078,15 +8083,15 @@
      /*<<float.ml:289:14>>*/ var
       /*<<float.ml:289:14>>*/ r =
         /*<<float.ml:289:14>>*/ caml_floatarray_create(la),
-      /*<<float.ml:290:6>>*/ _W_ = la - 1 | 0,
-      /*<<float.ml:289:14>>*/ _V_ = 0;
-    if(_W_ >= 0){
-     var i = _V_;
+      /*<<float.ml:290:6>>*/ _au_ = la - 1 | 0,
+      /*<<float.ml:289:14>>*/ _at_ = 0;
+    if(_au_ >= 0){
+     var i = _at_;
      for(;;){
        /*<<float.ml:291:8>>*/ r[1 + i] =
         /*<<float.ml:291:23>>*/ caml_call2(f, a[1 + i], b[1 + i]);
-       /*<<float.ml:291:8>>*/  /*<<float.ml:291:8>>*/ var _X_ = i + 1 | 0;
-      if(_W_ !== i){var i = _X_; continue;}
+       /*<<float.ml:291:8>>*/  /*<<float.ml:291:8>>*/ var _av_ = i + 1 | 0;
+      if(_au_ !== i){var i = _av_; continue;}
       break;
      }
     }
@@ -8094,15 +8099,15 @@
     /*<<float.ml:294:7>>*/ }
    function iteri(f, a){
      /*<<float.ml:298:4>>*/ var
-     _T_ = a.length - 1 - 1 | 0,
-      /*<<float.ml:298:4>>*/ _S_ = 0;
-    if(_T_ >= 0){
-     var i = _S_;
+     _ar_ = a.length - 1 - 1 | 0,
+      /*<<float.ml:298:4>>*/ _aq_ = 0;
+    if(_ar_ >= 0){
+     var i = _aq_;
      for(;;){
        /*<<float.ml:298:33>>*/  /*<<float.ml:298:33>>*/ caml_call2
        (f, i, a[1 + i]);
-       /*<<float.ml:298:33>>*/  /*<<float.ml:298:33>>*/ var _U_ = i + 1 | 0;
-      if(_T_ !== i){var i = _U_; continue;}
+       /*<<float.ml:298:33>>*/  /*<<float.ml:298:33>>*/ var _as_ = i + 1 | 0;
+      if(_ar_ !== i){var i = _as_; continue;}
       break;
      }
     }
@@ -8113,15 +8118,15 @@
      l = a.length - 1,
       /*<<float.ml:302:12>>*/ r =
         /*<<float.ml:302:12>>*/ caml_floatarray_create(l),
-      /*<<float.ml:303:4>>*/ _Q_ = l - 1 | 0,
-      /*<<float.ml:302:12>>*/ _P_ = 0;
-    if(_Q_ >= 0){
-     var i = _P_;
+      /*<<float.ml:303:4>>*/ _ao_ = l - 1 | 0,
+      /*<<float.ml:302:12>>*/ _an_ = 0;
+    if(_ao_ >= 0){
+     var i = _an_;
      for(;;){
        /*<<float.ml:304:6>>*/ r[1 + i] =
         /*<<float.ml:304:21>>*/ caml_call2(f, i, a[1 + i]);
-       /*<<float.ml:304:6>>*/  /*<<float.ml:304:6>>*/ var _R_ = i + 1 | 0;
-      if(_Q_ !== i){var i = _R_; continue;}
+       /*<<float.ml:304:6>>*/  /*<<float.ml:304:6>>*/ var _ap_ = i + 1 | 0;
+      if(_ao_ !== i){var i = _ap_; continue;}
       break;
      }
     }
@@ -8130,14 +8135,14 @@
    function fold_left(f, x, a){
      /*<<float.ml:310:4>>*/ var
       /*<<float.ml:310:12>>*/ r = [0, x],
-     _N_ = a.length - 1 - 1 | 0,
-      /*<<float.ml:310:12>>*/ _M_ = 0;
-    if(_N_ >= 0){
-     var i = _M_;
+     _al_ = a.length - 1 - 1 | 0,
+      /*<<float.ml:310:12>>*/ _ak_ = 0;
+    if(_al_ >= 0){
+     var i = _ak_;
      for(;;){
       r[1] =  /*<<float.ml:312:11>>*/ caml_call2(f, r[1], a[1 + i]);
-       /*<<float.ml:311:4>>*/  /*<<float.ml:311:4>>*/ var _O_ = i + 1 | 0;
-      if(_N_ !== i){var i = _O_; continue;}
+       /*<<float.ml:311:4>>*/  /*<<float.ml:311:4>>*/ var _am_ = i + 1 | 0;
+      if(_al_ !== i){var i = _am_; continue;}
       break;
      }
     }
@@ -8146,13 +8151,13 @@
    function fold_right(f, a, x){
      /*<<float.ml:318:4>>*/ var
       /*<<float.ml:318:12>>*/ r = [0, x],
-      /*<<float.ml:319:4>>*/ _K_ = a.length - 1 - 1 | 0;
-    if(_K_ >= 0){
-     var i = _K_;
+      /*<<float.ml:319:4>>*/ _ai_ = a.length - 1 - 1 | 0;
+    if(_ai_ >= 0){
+     var i = _ai_;
      for(;;){
       r[1] =  /*<<float.ml:320:11>>*/ caml_call2(f, a[1 + i], r[1]);
-       /*<<float.ml:319:4>>*/  /*<<float.ml:319:4>>*/ var _L_ = i - 1 | 0;
-      if(0 !== i){var i = _L_; continue;}
+       /*<<float.ml:319:4>>*/  /*<<float.ml:319:4>>*/ var _aj_ = i - 1 | 0;
+      if(0 !== i){var i = _aj_; continue;}
       break;
      }
     }
@@ -8211,42 +8216,46 @@
       i31 = ((i + i | 0) + i | 0) + 1 | 0,
        /*<<float.ml:367:14>>*/ x = [0, i31];
      if((i31 + 2 | 0) < l){
+       /*<<float.ml:368:24>>*/ var
+        /*<<float.ml:368:24>>*/ _ab_ = i31 + 1 | 0,
+        /*<<float.ml:369:27>>*/ _ac_ = caml_check_bound(a, _ab_)[1 + _ab_];
       if
        ( /*<<float.ml:369:11>>*/ caml_call2
-         (cmp,
-           /*<<float.ml:369:15>>*/ caml_array_get(a, i31),
-           /*<<float.ml:369:27>>*/ caml_array_get(a, i31 + 1 | 0))
+         (cmp, caml_check_bound(a, i31)[1 + i31], _ac_)
         < 0)
        x[1] = i31 + 1 | 0;
+       /*<<float.ml:370:8>>*/ var
+        /*<<float.ml:370:8>>*/ _ad_ = i31 + 2 | 0,
+        /*<<float.ml:370:26>>*/ _ae_ = caml_check_bound(a, _ad_)[1 + _ad_],
+       _af_ = x[1];
       if
        ( /*<<float.ml:370:11>>*/ caml_call2
-         (cmp,
-           /*<<float.ml:370:15>>*/ caml_array_get(a, x[1]),
-           /*<<float.ml:370:26>>*/ caml_array_get(a, i31 + 2 | 0))
+         (cmp, caml_check_bound(a, _af_)[1 + _af_], _ae_)
         < 0)
        x[1] = i31 + 2 | 0;
       return x[1];
      }
-      /*<<float.ml:373:24>>*/ if
-      ((i31 + 1 | 0) < l
-       &&
-        0
+     if((i31 + 1 | 0) < l){
+       /*<<float.ml:373:40>>*/ var
+       _ag_ = i31 + 1 | 0,
+        /*<<float.ml:373:40>>*/ _ah_ = caml_check_bound(a, _ag_)[1 + _ag_];
+       /*<<float.ml:373:24>>*/ if
+       (0
         >
           /*<<float.ml:373:24>>*/ caml_call2
-          (cmp,
-            /*<<float.ml:373:28>>*/ caml_array_get(a, i31),
-            /*<<float.ml:373:40>>*/ caml_array_get(a, i31 + 1 | 0)))
-       /*<<float.ml:374:13>>*/ return i31 + 1 | 0;
+          (cmp, caml_check_bound(a, i31)[1 + i31], _ah_))
+        /*<<float.ml:374:13>>*/ return i31 + 1 | 0;
+     }
      if(i31 < l)  /*<<float.ml:375:29>>*/ return i31;
       /*<<float.ml:375:38>>*/ throw  /*<<float.ml:375:38>>*/ caml_maybe_attach_backtrace
             ([0, Bottom, i], 1);
      /*<<float.ml:375:54>>*/ }
-    var l = a.length - 1, _E_ = ((l + 1 | 0) / 3 | 0) - 1 | 0;
-    if(_E_ >= 0){
-     var i$6 = _E_;
+    var l = a.length - 1, _X_ = ((l + 1 | 0) / 3 | 0) - 1 | 0;
+    if(_X_ >= 0){
+     var i$6 = _X_;
      for(;;){
        /*<<float.ml:404:52>>*/  /*<<float.ml:404:52>>*/ var
-       e$1 =  /*<<float.ml:404:52>>*/ caml_array_get(a, i$6);
+       e$1 = caml_check_bound(a, i$6)[1 + i$6];
        /*<<float.ml:386:24>>*/ try{
        var i = i$6;
         /*<<float.ml:378:6>>*/ for(;;){
@@ -8256,14 +8265,14 @@
          (0
           <
             /*<<float.ml:379:9>>*/ caml_call2
-            (cmp,  /*<<float.ml:379:13>>*/ caml_array_get(a, j), e$1)){
-          /*<<float.ml:380:8>>*/  /*<<float.ml:380:8>>*/ caml_array_set
-          (a, i,  /*<<float.ml:380:16>>*/ caml_array_get(a, j));
+            (cmp, caml_check_bound(a, j)[1 + j], e$1)){
+          /*<<float.ml:380:16>>*/  /*<<float.ml:380:16>>*/ var
+          _U_ = caml_check_bound(a, j)[1 + j];
+          /*<<float.ml:380:8>>*/ caml_check_bound(a, i)[1 + i] = _U_;
          var i = j;
          continue;
         }
-         /*<<float.ml:382:15>>*/  /*<<float.ml:382:15>>*/ caml_array_set
-         (a, i, e$1);
+         /*<<float.ml:382:15>>*/ caml_check_bound(a, i)[1 + i] = e$1;
         break;
        }
       }
@@ -8271,31 +8280,30 @@
        var exn = caml_wrap_exception(exn$0);
        if(exn[1] !== Bottom) throw caml_maybe_attach_backtrace(exn, 0);
        var i$0 = exn[2];
-        /*<<float.ml:386:63>>*/  /*<<float.ml:386:63>>*/ caml_array_set
-        (a, i$0, e$1);
+        /*<<float.ml:386:63>>*/ caml_check_bound(a, i$0)[1 + i$0] = e$1;
       }
-       /*<<float.ml:404:40>>*/  /*<<float.ml:404:40>>*/ var _J_ = i$6 - 1 | 0;
-      if(0 !== i$6){var i$6 = _J_; continue;}
+       /*<<float.ml:404:40>>*/  /*<<float.ml:404:40>>*/ var
+       _aa_ = i$6 - 1 | 0;
+      if(0 !== i$6){var i$6 = _aa_; continue;}
       break;
      }
     }
-     /*<<float.ml:405:4>>*/  /*<<float.ml:405:4>>*/ var _F_ = l - 1 | 0;
-    if(_F_ >= 2){
-     var i$4 = _F_;
+     /*<<float.ml:405:4>>*/  /*<<float.ml:405:4>>*/ var _Y_ = l - 1 | 0;
+    if(_Y_ >= 2){
+     var i$4 = _Y_;
      a:
      for(;;){
        /*<<float.ml:406:14>>*/  /*<<float.ml:406:14>>*/ var
-       e$0 =  /*<<float.ml:406:14>>*/ caml_array_get(a, i$4);
-       /*<<float.ml:407:6>>*/  /*<<float.ml:407:6>>*/ caml_array_set
-       (a, i$4,  /*<<float.ml:407:14>>*/ caml_array_get(a, 0));
+       e$0 = caml_check_bound(a, i$4)[1 + i$4];
+       /*<<float.ml:407:6>>*/ a[1 + i$4] = caml_check_bound(a, 0)[1];
       var i$5 = 0;
        /*<<float.ml:392:21>>*/ try{
        var i$1 = i$5;
         /*<<float.ml:388:6>>*/ for(;;){
-         /*<<float.ml:388:14>>*/  /*<<float.ml:388:14>>*/ var
-         j$0 = maxson(i$4, i$1);
-         /*<<float.ml:389:6>>*/  /*<<float.ml:389:6>>*/ caml_array_set
-         (a, i$1,  /*<<float.ml:389:14>>*/ caml_array_get(a, j$0));
+         /*<<float.ml:388:14>>*/ var
+          /*<<float.ml:388:14>>*/ j$0 = maxson(i$4, i$1),
+          /*<<float.ml:389:14>>*/ _V_ = caml_check_bound(a, j$0)[1 + j$0];
+         /*<<float.ml:389:6>>*/ caml_check_bound(a, i$1)[1 + i$1] = _V_;
         var i$1 = j$0;
        }
       }
@@ -8312,35 +8320,34 @@
          (0
           <=
             /*<<float.ml:396:9>>*/ caml_call2
-            (cmp,  /*<<float.ml:396:13>>*/ caml_array_get(a, father), e$0))
-          /*<<float.ml:399:15>>*/  /*<<float.ml:399:15>>*/ caml_array_set
-          (a, i$3, e$0);
+            (cmp, caml_check_bound(a, father)[1 + father], e$0))
+          /*<<float.ml:399:15>>*/ caml_check_bound(a, i$3)[1 + i$3] = e$0;
         else{
-          /*<<float.ml:397:8>>*/  /*<<float.ml:397:8>>*/ caml_array_set
-          (a, i$3,  /*<<float.ml:397:16>>*/ caml_array_get(a, father));
+          /*<<float.ml:397:16>>*/  /*<<float.ml:397:16>>*/ var
+          _W_ = caml_check_bound(a, father)[1 + father];
+          /*<<float.ml:397:8>>*/ caml_check_bound(a, i$3)[1 + i$3] = _W_;
          if(0 < father){var i$3 = father; continue;}
-          /*<<float.ml:398:51>>*/  /*<<float.ml:398:51>>*/ caml_array_set
-          (a, 0, e$0);
+          /*<<float.ml:398:51>>*/ caml_check_bound(a, 0)[1] = e$0;
         }
-         /*<<float.ml:405:4>>*/  /*<<float.ml:405:4>>*/ var _I_ = i$4 - 1 | 0;
-        if(2 !== i$4){var i$4 = _I_; continue a;}
+         /*<<float.ml:405:4>>*/  /*<<float.ml:405:4>>*/ var _$_ = i$4 - 1 | 0;
+        if(2 !== i$4){var i$4 = _$_; continue a;}
         break;
        }
       }
       break;
      }
     }
-    var _G_ = 1 < l ? 1 : 0;
-    if(_G_){
+    var _Z_ = 1 < l ? 1 : 0;
+    if(_Z_){
       /*<<float.ml:410:27>>*/  /*<<float.ml:410:27>>*/ var
-      e =  /*<<float.ml:410:27>>*/ caml_array_get(a, 1);
-      /*<<float.ml:410:40>>*/  /*<<float.ml:410:40>>*/ caml_array_set
-      (a, 1,  /*<<float.ml:410:48>>*/ caml_array_get(a, 0));
-     var _H_ =  /*<<float.ml:410:59>>*/ caml_array_set(a, 0, e);
+      e = caml_check_bound(a, 1)[2];
+      /*<<float.ml:410:40>>*/ a[2] = caml_check_bound(a, 0)[1];
+      /*<<float.ml:410:59>>*/ a[1] = e;
+     var ___ = 0;
     }
     else
-     var _H_ = _G_;
-     /*<<float.ml:410:59>>*/ return _H_;
+     var ___ = _Z_;
+     /*<<float.ml:410:59>>*/ return ___;
     /*<<float.ml:410:69>>*/ }
    function stable_sort(cmp, a){
     function merge(src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs){
@@ -8348,9 +8355,9 @@
       src1r = src1ofs + src1len | 0,
       src2r = src2ofs + src2len | 0,
        /*<<float.ml:433:46>>*/ s2$1 =
-         /*<<float.ml:433:46>>*/ caml_array_get(src2, src2ofs),
+        caml_check_bound(src2, src2ofs)[1 + src2ofs],
        /*<<float.ml:433:22>>*/ s1$1 =
-         /*<<float.ml:433:22>>*/ caml_array_get(a, src1ofs),
+        caml_check_bound(a, src1ofs)[1 + src1ofs],
       i1 = src1ofs,
       s1 = s1$1,
       i2 = src2ofs,
@@ -8359,28 +8366,24 @@
       /*<<float.ml:418:8>>*/ for(;;){
        /*<<float.ml:418:11>>*/ if
        (0 <  /*<<float.ml:418:11>>*/ caml_call2(cmp, s1, s2)){
-        /*<<float.ml:426:10>>*/  /*<<float.ml:426:10>>*/ caml_array_set
-        (dst, d, s2);
+        /*<<float.ml:426:10>>*/ caml_check_bound(dst, d)[1 + d] = s2;
         /*<<float.ml:426:10>>*/  /*<<float.ml:426:10>>*/ var
         i2$0 = i2 + 1 | 0;
        if(i2$0 >= src2r) return blit(a, i1, dst, d + 1 | 0, src1r - i1 | 0);
         /*<<float.ml:429:12>>*/ var
          /*<<float.ml:429:12>>*/ d$0 = d + 1 | 0,
-         /*<<float.ml:429:26>>*/ s2$0 =
-           /*<<float.ml:429:26>>*/ caml_array_get(src2, i2$0),
+         /*<<float.ml:429:26>>*/ s2$0 = caml_check_bound(src2, i2$0)[1 + i2$0],
         i2 = i2$0,
         s2 = s2$0,
         d = d$0;
        continue;
       }
-       /*<<float.ml:419:10>>*/  /*<<float.ml:419:10>>*/ caml_array_set
-       (dst, d, s1);
+       /*<<float.ml:419:10>>*/ caml_check_bound(dst, d)[1 + d] = s1;
        /*<<float.ml:419:10>>*/  /*<<float.ml:419:10>>*/ var i1$0 = i1 + 1 | 0;
       if(i1$0 >= src1r) return blit(src2, i2, dst, d + 1 | 0, src2r - i2 | 0);
        /*<<float.ml:422:12>>*/ var
         /*<<float.ml:422:12>>*/ d$1 = d + 1 | 0,
-        /*<<float.ml:422:20>>*/ s1$0 =
-          /*<<float.ml:422:20>>*/ caml_array_get(a, i1$0),
+        /*<<float.ml:422:20>>*/ s1$0 = caml_check_bound(a, i1$0)[1 + i1$0],
        i1 = i1$0,
        s1 = s1$0,
        d = d$1;
@@ -8388,35 +8391,37 @@
      /*<<float.ml:433:72>>*/ }
     function isortto(srcofs, dst, dstofs, len){
       /*<<float.ml:436:6>>*/ var
-      _C_ = len - 1 | 0,
-       /*<<float.ml:436:6>>*/ _B_ = 0;
-     if(_C_ >= 0){
-      var i = _B_;
+      _M_ = len - 1 | 0,
+       /*<<float.ml:436:6>>*/ _L_ = 0;
+     if(_M_ >= 0){
+      var i = _L_;
       a:
       for(;;){
         /*<<float.ml:437:16>>*/ var
-         /*<<float.ml:437:16>>*/ e =
-           /*<<float.ml:437:16>>*/ caml_array_get(a, srcofs + i | 0),
+        _N_ = srcofs + i | 0,
+         /*<<float.ml:437:16>>*/ e = caml_check_bound(a, _N_)[1 + _N_],
          /*<<float.ml:438:16>>*/ j = [0, (dstofs + i | 0) - 1 | 0];
        for(;;){
-         /*<<float.ml:439:31>>*/ if
-         (dstofs <= j[1]
-          &&
-           0
+        if(dstofs <= j[1]){
+         var _O_ = j[1];
+          /*<<float.ml:439:31>>*/ if
+          (0
            <
              /*<<float.ml:439:31>>*/ caml_call2
-             (cmp,  /*<<float.ml:439:35>>*/ caml_array_get(dst, j[1]), e)){
-          /*<<float.ml:440:10>>*/  /*<<float.ml:440:10>>*/ caml_array_set
-          (dst,
-           j[1] + 1 | 0,
-            /*<<float.ml:440:27>>*/ caml_array_get(dst, j[1]));
-         j[1] += -1;
-         continue;
+             (cmp, caml_check_bound(dst, _O_)[1 + _O_], e)){
+           /*<<float.ml:440:27>>*/ var
+           _P_ = j[1],
+            /*<<float.ml:440:27>>*/ _Q_ = caml_check_bound(dst, _P_)[1 + _P_],
+           _R_ = j[1] + 1 | 0;
+           /*<<float.ml:440:10>>*/ caml_check_bound(dst, _R_)[1 + _R_] = _Q_;
+          j[1] += -1;
+          continue;
+         }
         }
-         /*<<float.ml:443:8>>*/  /*<<float.ml:443:8>>*/ caml_array_set
-         (dst, j[1] + 1 | 0, e);
-         /*<<float.ml:436:6>>*/  /*<<float.ml:436:6>>*/ var _D_ = i + 1 | 0;
-        if(_C_ !== i){var i = _D_; continue a;}
+        var _S_ = j[1] + 1 | 0;
+         /*<<float.ml:443:8>>*/ caml_check_bound(dst, _S_)[1 + _S_] = e;
+         /*<<float.ml:436:6>>*/  /*<<float.ml:436:6>>*/ var _T_ = i + 1 | 0;
+        if(_M_ !== i){var i = _T_; continue a;}
         break;
        }
        break;
@@ -8450,14 +8455,14 @@
        /*<<float.ml:474:11>>*/ return 0;
       /*<<float.ml:472:16>>*/ var
        /*<<float.ml:472:16>>*/ x = a[1 + i],
-       /*<<float.ml:472:16>>*/ _z_ = i + 1 | 0;
+       /*<<float.ml:472:16>>*/ _J_ = i + 1 | 0;
       /*<<float.ml:473:8>>*/ return [0,
              x,
-             function(_A_){ /*<<?>>*/ return aux(_z_, _A_);}];
+             function(_K_){ /*<<?>>*/ return aux(_J_, _K_);}];
      /*<<float.ml:474:18>>*/ }
-     /*<<float.ml:476:4>>*/  /*<<float.ml:476:4>>*/ var _x_ = 0;
-     /*<<float.ml:476:4>>*/ return function(_y_){
-      /*<<?>>*/ return aux(_x_, _y_);};
+     /*<<float.ml:476:4>>*/  /*<<float.ml:476:4>>*/ var _H_ = 0;
+     /*<<float.ml:476:4>>*/ return function(_I_){
+      /*<<?>>*/ return aux(_H_, _I_);};
     /*<<float.ml:476:9>>*/ }
    function to_seqi(a){
     function aux(i, param){
@@ -8465,23 +8470,23 @@
        /*<<float.ml:485:11>>*/ return 0;
       /*<<float.ml:483:16>>*/ var
        /*<<float.ml:483:16>>*/ x = a[1 + i],
-       /*<<float.ml:483:16>>*/ _v_ = i + 1 | 0;
+       /*<<float.ml:483:16>>*/ _F_ = i + 1 | 0;
       /*<<float.ml:484:8>>*/ return [0,
              [0, i, x],
-             function(_w_){ /*<<?>>*/ return aux(_v_, _w_);}];
+             function(_G_){ /*<<?>>*/ return aux(_F_, _G_);}];
      /*<<float.ml:485:18>>*/ }
-     /*<<float.ml:487:4>>*/  /*<<float.ml:487:4>>*/ var _t_ = 0;
-     /*<<float.ml:487:4>>*/ return function(_u_){
-      /*<<?>>*/ return aux(_t_, _u_);};
+     /*<<float.ml:487:4>>*/  /*<<float.ml:487:4>>*/ var _D_ = 0;
+     /*<<float.ml:487:4>>*/ return function(_E_){
+      /*<<?>>*/ return aux(_D_, _E_);};
     /*<<float.ml:487:9>>*/ }
    function of_seq(i$2){
-     /*<<float.ml:501:4>>*/ var _r_ = 0;
-    function _s_(acc, x){
+     /*<<float.ml:501:4>>*/ var _B_ = 0;
+    function _C_(acc, x){
       /*<<float.ml:501:40>>*/ return [0, x, acc];
      /*<<float.ml:501:46>>*/ }
      /*<<float.ml:501:12>>*/ var
       /*<<float.ml:501:12>>*/ l =
-        /*<<float.ml:501:12>>*/ caml_call3(Stdlib_Seq[5], _s_, _r_, i$2),
+        /*<<float.ml:501:12>>*/ caml_call3(Stdlib_Seq[5], _C_, _B_, i$2),
       /*<<float.ml:491:14>>*/ len =
         /*<<float.ml:491:14>>*/ caml_call1(Stdlib_List[1], l),
       /*<<float.ml:492:12>>*/ a =
@@ -8506,15 +8511,15 @@
       /*<<float.ml:508:14>>*/ r =
         /*<<float.ml:508:14>>*/ runtime.caml_make_vect
         (l,  /*<<float.ml:508:27>>*/ caml_call1(f, a[1])),
-      /*<<float.ml:509:6>>*/ _p_ = l - 1 | 0,
-      /*<<float.ml:508:14>>*/ _o_ = 1;
-    if(_p_ >= 1){
-     var i = _o_;
+      /*<<float.ml:509:6>>*/ _z_ = l - 1 | 0,
+      /*<<float.ml:508:14>>*/ _y_ = 1;
+    if(_z_ >= 1){
+     var i = _y_;
      for(;;){
        /*<<float.ml:510:8>>*/ r[1 + i] =
         /*<<float.ml:510:29>>*/ caml_call1(f, a[1 + i]);
-       /*<<float.ml:510:8>>*/  /*<<float.ml:510:8>>*/ var _q_ = i + 1 | 0;
-      if(_p_ !== i){var i = _q_; continue;}
+       /*<<float.ml:510:8>>*/  /*<<float.ml:510:8>>*/ var _A_ = i + 1 | 0;
+      if(_z_ !== i){var i = _A_; continue;}
       break;
      }
     }
@@ -8525,27 +8530,32 @@
      l = a.length - 1,
       /*<<float.ml:517:12>>*/ r =
         /*<<float.ml:517:12>>*/ caml_floatarray_create(l),
-      /*<<float.ml:518:4>>*/ _m_ = l - 1 | 0,
-      /*<<float.ml:517:12>>*/ _l_ = 0;
-    if(_m_ >= 0){
-     var i = _l_;
+      /*<<float.ml:518:4>>*/ _w_ = l - 1 | 0,
+      /*<<float.ml:517:12>>*/ _v_ = 0;
+    if(_w_ >= 0){
+     var i = _v_;
      for(;;){
        /*<<float.ml:519:6>>*/ r[1 + i] =
         /*<<float.ml:519:21>>*/ caml_call1(f, a[1 + i]);
-       /*<<float.ml:519:6>>*/  /*<<float.ml:519:6>>*/ var _n_ = i + 1 | 0;
-      if(_m_ !== i){var i = _n_; continue;}
+       /*<<float.ml:519:6>>*/  /*<<float.ml:519:6>>*/ var _x_ = i + 1 | 0;
+      if(_w_ !== i){var i = _x_; continue;}
       break;
      }
     }
      /*<<float.ml:521:4>>*/ return r;
     /*<<float.ml:521:5>>*/ }
+   var _c_ = caml_floatarray_create;
+   function _d_(_u_, _t_, _s_){
+     /*<<?>>*/ caml_check_bound(_u_, _t_)[1 + _t_] = _s_;
+    return 0;
+   }
+   function _e_(_r_, _q_){
+     /*<<?>>*/ return caml_check_bound(_r_, _q_)[1 + _q_];
+   }
    var
-    _c_ = caml_floatarray_create,
-    _d_ = caml_array_set,
-    _e_ = caml_array_get,
     _f_ =
       [0,
-       function(_k_){ /*<<?>>*/ return _k_.length - 1;},
+       function(_p_){ /*<<?>>*/ return _p_.length - 1;},
        _e_,
        _d_,
        make,
@@ -8579,9 +8589,15 @@
        of_seq,
        map_to_array,
        map_from_array],
-    _g_ = caml_floatarray_create,
-    _h_ = caml_array_set,
-    _i_ = caml_array_get,
+    _g_ = caml_floatarray_create;
+   function _h_(_o_, _n_, _m_){
+     /*<<?>>*/ caml_check_bound(_o_, _n_)[1 + _n_] = _m_;
+    return 0;
+   }
+   function _i_(_l_, _k_){
+     /*<<?>>*/ return caml_check_bound(_l_, _k_)[1 + _k_];
+   }
+   var
     Stdlib_Float =
       [0,
        zero,
diff --git a/compiler/tests-num/dune b/compiler/tests-num/dune
index 6cb923a8d5..42c3a0a1e6 100644
--- a/compiler/tests-num/dune
+++ b/compiler/tests-num/dune
@@ -9,6 +9,7 @@
 
 (rule
  (target main.referencejs)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps main.bc.js)
  (action
   (with-stdout-to
@@ -25,6 +26,8 @@
 
 (rule
  (alias runtest)
+ ;; ZZZ Need to modify the num library
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps main.reference main.referencejs)
  (action
   (diff main.reference main.referencejs)))
diff --git a/compiler/tests-ocaml/lib-effects/evenodd.ml b/compiler/tests-ocaml/lib-effects/evenodd.ml
index 035308b58f..b7bdd86463 100644
--- a/compiler/tests-ocaml/lib-effects/evenodd.ml
+++ b/compiler/tests-ocaml/lib-effects/evenodd.ml
@@ -18,5 +18,5 @@ and odd n =
   else even (n-1)
 
 let _ =
-  let n = 100_000 in
+  let n = 10_000 in
   Printf.printf "even %d is %B\n%!" n (even n)
diff --git a/compiler/tests-ocaml/lib-effects/evenodd.reference b/compiler/tests-ocaml/lib-effects/evenodd.reference
index 8682371075..00b9bd6f70 100644
--- a/compiler/tests-ocaml/lib-effects/evenodd.reference
+++ b/compiler/tests-ocaml/lib-effects/evenodd.reference
@@ -1 +1 @@
-even 100000 is true
+even 10000 is true
diff --git a/compiler/tests-ocaml/lib-hashtbl/dune b/compiler/tests-ocaml/lib-hashtbl/dune
index 2f402e17c8..3ceba9fbd0 100644
--- a/compiler/tests-ocaml/lib-hashtbl/dune
+++ b/compiler/tests-ocaml/lib-hashtbl/dune
@@ -22,10 +22,18 @@
 
 (rule
  (alias runtest)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps hfun.referencejs hfun.reference)
  (action
   (diff hfun.referencejs hfun.reference)))
 
+(rule
+ (alias runtest)
+ (enabled_if (or (= %{profile} wasm) (= %{profile} wasm-effects)))
+ (deps hfun.referencejs hfun.reference-wasm)
+ (action
+  (diff hfun.referencejs hfun.reference-wasm)))
+
 (rule
  (target htbl.referencejs)
  (enabled_if
diff --git a/compiler/tests-ocaml/lib-hashtbl/hfun.reference-wasm b/compiler/tests-ocaml/lib-hashtbl/hfun.reference-wasm
new file mode 100644
index 0000000000..2e92cf439d
--- /dev/null
+++ b/compiler/tests-ocaml/lib-hashtbl/hfun.reference-wasm
@@ -0,0 +1,27 @@
+-- Strings:
+""		00000000
+"Hello world"	364b8272
+-- Integers:
+0		07be548a
+-1		3653e015
+42		1792870b
+2^30-1		23c392d0
+-2^30		0c66fde3
+-- Floats:
++0.0		0f478b8c
+-0.0		0f478b8c
++infty		23ea56fb
+-infty		059f7872
+NaN		3228858d
+NaN#2		3228858d
+NaN#3		3228858d
+-- Native integers:
+0		3f19274a
+-1		3653e015
+42		3e33aef8
+2^30-1		3711bf46
+-2^30		2e71f39c
+-- Lists:
+[0..10]		0ade0fc9
+[0..12]		0ade0fc9
+[10..0]		0cd6259d
diff --git a/compiler/tests-sourcemap/dune b/compiler/tests-sourcemap/dune
index 1cc6f530b9..e54c02d915 100644
--- a/compiler/tests-sourcemap/dune
+++ b/compiler/tests-sourcemap/dune
@@ -21,7 +21,7 @@
 (rule
  (target dump)
  (enabled_if
-  (and (<> %{profile} using-effects) (<> %{profile} wasm)))
+  (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (with-stdout-to
    %{target}
@@ -30,7 +30,7 @@
 (rule
  (alias runtest)
  (enabled_if
-  (and (<> %{profile} using-effects) (<> %{profile} wasm)))
+  (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps dump.reference dump)
  (action
   (diff dump.reference dump)))
diff --git a/examples/hyperbolic/hypertree.ml b/examples/hyperbolic/hypertree.ml
index b203a345c8..c119ccde8d 100644
--- a/examples/hyperbolic/hypertree.ml
+++ b/examples/hyperbolic/hypertree.ml
@@ -105,9 +105,9 @@ let option var = Js.Optdef.get var (fun () -> Js.Unsafe.coerce (new%js Js.array_
 
 class type style =
   object
-    method border : float Js.t Js.optdef Js.readonly_prop
+    method border : Js.number Js.t Js.optdef Js.readonly_prop
 
-    method padding : float Js.t Js.optdef Js.readonly_prop
+    method padding : Js.number Js.t Js.optdef Js.readonly_prop
 
     method backgroundColor : Js.js_string Js.t Js.optdef Js.readonly_prop
 
diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc
index c2dfe19149..e219fc10e7 100644
--- a/lib/tests/dune.inc
+++ b/lib/tests/dune.inc
@@ -82,7 +82,7 @@
 (library
  ;; lib/tests/test_sys.ml
  (name test_sys_75)
- (enabled_if (>= %{ocaml_version} 5))
+ (enabled_if (and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_sys)
  (libraries js_of_ocaml unix)
  (inline_tests (modes js))
diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml
index c226ba5bea..cc42105ce8 100644
--- a/lib/tests/gen-rules/gen.ml
+++ b/lib/tests/gen-rules/gen.ml
@@ -81,7 +81,10 @@ let () =
            (Hashtbl.hash prefix mod 100)
            (match enabled_if basename with
            | Any -> "true"
-           | GE5 -> "(>= %{ocaml_version} 5)"
+           | GE5 ->
+               (* ZZZ /static not yet implemented *)
+               "(and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} \
+                wasm-effects))"
            | No_effects -> "(<> %{profile} using-effects)"
            | Not_wasm -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))")
            basename)
diff --git a/lib/tests/test_fun_call.ml b/lib/tests/test_fun_call.ml
index 1481c2aacf..70c1098511 100644
--- a/lib/tests/test_fun_call.ml
+++ b/lib/tests/test_fun_call.ml
@@ -146,7 +146,7 @@ let%expect_test "wrap_callback_strict" =
     (Js.Unsafe.callback_with_arity 2 cb3)
     {| (function(f){ return f(1,2,3) }) |};
   [%expect {|
-    Result: function#1#1 |}];
+    Result: other |}];
   call_and_log
     (Js.Unsafe.callback_with_arity 2 cb3)
     ~cont:(fun g -> g 4)
@@ -163,7 +163,7 @@ let%expect_test "wrap_callback_strict" =
     Result: 0 |}];
   call_and_log (Js.Unsafe.callback_with_arity 2 cb3) {| (function(f){ return f(1,2) }) |};
   [%expect {|
-    Result: function#1#1 |}]
+    Result: other |}]
 
 let%expect_test "wrap_callback_strict" =
   call_and_log
@@ -290,7 +290,7 @@ let%expect_test "wrap_meth_callback_strict" =
     (Js.Unsafe.meth_callback_with_arity 2 cb4)
     {| (function(f){ return f.apply("this",[1,2,3]) }) |};
   [%expect {|
-    Result: function#1#1 |}];
+    Result: other |}];
   call_and_log
     (Js.Unsafe.meth_callback_with_arity 2 cb4)
     ~cont:(fun g -> g 4)
@@ -308,7 +308,7 @@ let%expect_test "wrap_meth_callback_strict" =
   call_and_log
     (Js.Unsafe.meth_callback_with_arity 2 cb4)
     {| (function(f){ return f.apply("this",[1,2]) }) |};
-  [%expect {| Result: function#1#1 |}]
+  [%expect {| Result: other |}]
 
 let%expect_test "wrap_meth_callback_strict" =
   call_and_log
@@ -353,14 +353,15 @@ let%expect_test "partial application, extra arguments set to undefined" =
 let%expect_test _ =
   call_and_log cb3 ~cont:(fun g -> g 1) {| (function(f){ return f }) |};
   [%expect {|
-    Result: function#2#2 |}]
+    Result: other |}]
 
 (*
 let%expect_test _ =
-  cal_and_log cb3 ~cont:(fun g -> g 1 2 3 4) {| (function(f){ return f }) |};
+  call_and_log cb3 ~cont:(fun g -> g 1 2 3 4) {| (function(f){ return f }) |};
   [%expect {|
     got 1, 2, 3, done
     Result: 0 |}]
+*)
 
 let%expect_test _ =
   let f cb =
@@ -369,15 +370,16 @@ let%expect_test _ =
     | _ -> Printf.printf "Error: unknown"
   in
   f cb5;
-  [%expect {| Result: function#1#1 |}];
+  [%expect {| Result: other |}];
   f cb4;
   [%expect {|
     got 1, 1, 2, 3, done
     Result: 0 |}];
-  f cb3;
-  [%expect {|
-    got 1, 1, 2, done
-    Result: 0 |}]
+  ()
+(* f cb3;
+   [%expect {|
+     got 1, 1, 2, done
+     Result: 0 |}]
 *)
 
 let%expect_test _ =
@@ -402,10 +404,10 @@ let%expect_test _ =
     Result: 0 |}];
   f (Obj.magic cb4);
   [%expect {|
-    Result: function#1#1 |}];
+    Result: other |}];
   f (Obj.magic cb5);
   [%expect {|
-    Result: function#2#2 |}]
+    Result: other |}]
 
 (*ZZZ
   let%expect_test _ =
diff --git a/lib/tests/test_poly_compare.ml b/lib/tests/test_poly_compare.ml
index 62c47b46b8..ff60a3fcba 100644
--- a/lib/tests/test_poly_compare.ml
+++ b/lib/tests/test_poly_compare.ml
@@ -25,6 +25,7 @@ let%expect_test "poly equal" =
   assert (List.mem obj1 [ obj2; obj1 ]);
   assert (not (List.mem obj1 [ obj2 ]));
   ()
+[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
 
 let%expect_test "poly equal neg" =
   let obj1 = Js.Unsafe.obj [||] in
@@ -49,7 +50,8 @@ let%expect_test "poly compare" =
       then print_endline "preserve"
       else print_endline "not preserve"
   | _ -> assert false);
-  [%expect {| not preserve |}]
+  [%expect.unreachable]
+[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
 
 type pack = Pack : 'a -> pack
 
@@ -63,6 +65,7 @@ let%expect_test "number comparison" =
   assert (
     Pack (Js.Unsafe.js_expr "new Number(2.1)")
     = Pack (Js.Unsafe.js_expr "new Number(2.1)"))
+[@@expect.uncaught_exn {| "Assert_failure lib/tests/test_poly_compare.ml:59:2" |}]
 
 let js_string_enabled = Js.typeof (Obj.magic "") == Js.string "string"
 
@@ -79,6 +82,7 @@ let%expect_test "string comparison" =
   assert (
     Pack (Js.Unsafe.js_expr "new String('abcd')")
     = Pack (Js.Unsafe.js_expr "new String('abcd')"))
+[@@expect.uncaught_exn {| "Assert_failure lib/tests/test_poly_compare.ml:82:2" |}]
 
 let%expect_test "symbol comparison" =
   let s1 = Pack (Js.Unsafe.js_expr "Symbol('2')") in
@@ -88,6 +92,7 @@ let%expect_test "symbol comparison" =
   assert (compare s1 s1 = 0);
   assert (compare s1 s2 = 1);
   assert (compare s2 s1 = 1)
+[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
 
 let%expect_test "object comparison" =
   let s1 = Pack (Js.Unsafe.js_expr "{}") in
@@ -97,6 +102,7 @@ let%expect_test "object comparison" =
   assert (compare s1 s1 = 0);
   assert (compare s1 s2 = 1);
   assert (compare s2 s1 = 1)
+[@@expect.uncaught_exn {| "Assert_failure lib/tests/test_poly_compare.ml:100:2" |}]
 
 let%expect_test "poly compare" =
   let l =
@@ -114,36 +120,13 @@ let%expect_test "poly compare" =
   let l' = List.sort (fun (_, a) (_, b) -> compare a b) l in
   List.iter (fun (i, _) -> Printf.printf "%d\n" i) l';
   print_endline "";
-  [%expect {|
-    1
-    3
-    2
-    0
-    6
-    7
-    5
-    4 |}];
+  [%expect.unreachable];
   let l' = List.sort (fun (_, a) (_, b) -> compare a b) (List.rev l) in
   let l'' = List.sort (fun (_, a) (_, b) -> compare a b) (List.rev l') in
   List.iter (fun (i, _) -> Printf.printf "%d\n" i) l';
   print_endline "";
-  [%expect {|
-    3
-    1
-    2
-    0
-    4
-    5
-    7
-    6 |}];
+  [%expect.unreachable];
   List.iter (fun (i, _) -> Printf.printf "%d\n" i) l'';
   print_endline "";
-  [%expect {|
-    1
-    3
-    2
-    0
-    4
-    5
-    6
-    7 |}]
+  [%expect.unreachable]
+[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh
index c65c19f001..932e86353d 100755
--- a/tools/node_wrapper.sh
+++ b/tools/node_wrapper.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively
-exec node --experimental-wasm-stringref --experimental-wasm-gc --experimental-wasm-stack-switching "$@"
+exec node --experimental-wasm-stringref --experimental-wasm-gc --experimental-wasm-stack-switching --wasm-stack-switching-stack-size=90 "$@"
diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune
index d296456c1c..c9afcb2013 100644
--- a/toplevel/examples/lwt_toplevel/dune
+++ b/toplevel/examples/lwt_toplevel/dune
@@ -1,5 +1,6 @@
 (executables
  (names toplevel)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (libraries
   js_of_ocaml-compiler
   js_of_ocaml-tyxml
@@ -121,6 +122,7 @@
 
 (rule
  (targets toplevel.js)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (run
    %{bin:js_of_ocaml}

From 6ef1e04eae0091bd87b595791db7ada10b3c4d77 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 27 Sep 2023 21:30:33 +0200
Subject: [PATCH 144/481] Set-up continuous integration

---
 .github/workflows/build.yml     | 257 +++++++++++++++++++-------------
 .github/workflows/changelog.yml |  20 ---
 2 files changed, 152 insertions(+), 125 deletions(-)
 delete mode 100644 .github/workflows/changelog.yml

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 947efe471c..bfcf012228 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -3,63 +3,21 @@ name: build
 on:
   pull_request:
   push:
-    branches:
-      - master
-  schedule:
-    # Prime the caches every Monday
-    - cron: 0 1 * * MON
 
 jobs:
   build:
+    env:
+      OPAMJOBS: 2
+      OPAMYES: true
+
     strategy:
       fail-fast: false
       matrix:
         os:
           - ubuntu-latest
         ocaml-compiler:
-          - 4.08.x
-          - 4.09.x
-          - 4.10.x
-          - 4.11.x
-          - 4.12.x
-          - 4.13.x
-        skip-test:
-          - true
-        skip-doc:
-          - true
-        skip-effects:
-          - true
-        include:
-          - os: ubuntu-latest
-            ocaml-compiler: 4.14.x
-            skip-effects: true
-            skip-test: false
-            skip-doc: true
-          - os: macos-latest
-            ocaml-compiler: 4.14.x
-            skip-effects: true
-            skip-test: false
-            skip-doc: true
-          - os: windows-latest
-            ocaml-compiler: 4.14.x
-            skip-effects: true
-            skip-test: false
-            skip-doc: true
-          - os: ubuntu-latest
-            ocaml-compiler: 5.0.x
-            skip-effects: false
-            skip-test: false
-            skip-doc: false
-          - os: macos-latest
-            ocaml-compiler: 5.0.x
-            skip-effects: true
-            skip-test: false
-            skip-doc: true
-          - os: windows-latest
-            ocaml-compiler: ocaml.5.0.0,ocaml-option-mingw
-            skip-effects: false
-            skip-test: false
-            skip-doc: true
+          - 4.14.x
+          - 5.00.x
 
     runs-on: ${{ matrix.os }}
 
@@ -70,84 +28,173 @@ jobs:
           git config --global core.eol lf
           git config --global core.ignorecase false
 
-      - name: Checkout code
-        uses: actions/checkout@v3
-
-      - name: Use Node.js 16.x
+      - name: Install node
         uses: actions/setup-node@v3
         with:
-          node-version: 16.x
+          node-version: v21.0.0-v8-canary20230928fe8cd53052
 
+      - name: Restore cached binaryen
+        id: cache-binaryen
+        uses: actions/cache/restore@v3
+        with:
+          path: binaryen
+          key: ${{ runner.os }}-binaryen-version_116
 
-      - name: Use OCaml ${{ matrix.ocaml-compiler }}
-        if: runner.os == 'Windows'
-        uses: ocaml/setup-ocaml@v2
+      - name: Checkout binaryen
+        if: steps.cache-binaryen.outputs.cache-hit != 'true'
+        uses: actions/checkout@v4
         with:
-          ocaml-compiler: ${{ matrix.ocaml-compiler }}
-          opam-repositories: |
-            dra27: https://github.com/dra27/opam-repository.git#windows-5.0
-            default: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset
-            opam: https://github.com/ocaml/opam-repository.git
-          dune-cache: true
-          opam-depext: ${{ !matrix.skip-test }}
-          opam-depext-flags: --with-test
+          repository: WebAssembly/binaryen
+          path: binaryen
+          submodules: true
+          ref: version_116
+
+      - name: Install ninja
+        if: steps.cache-binaryen.outputs.cache-hit != 'true'
+        run: sudo apt-get install ninja-build
+
+      - name: Build binaryen
+        if: steps.cache-binaryen.outputs.cache-hit != 'true'
+        working-directory: ./binaryen
+        run: |
+          cmake -G Ninja .
+          ninja
 
-      - name: Use OCaml ${{ matrix.ocaml-compiler }}
-        if: runner.os != 'Windows'
+      - name: Cache binaryen
+        if: steps.cache-binaryen.outputs.cache-hit != 'true'
+        uses: actions/cache/save@v3
+        with:
+          path: binaryen
+          key: ${{ runner.os }}-binaryen-version_116
+
+      - name: Set binaryen's path
+        run: |
+          echo "$GITHUB_WORKSPACE/binaryen/bin" >> $GITHUB_PATH
+
+      - name: Restore cached OCaml
+        id: cache-ocaml
+        uses: actions/cache/restore@v3
+        with:
+          path: |
+            ~/.opam
+            _opam
+            /opt/hostedtoolcache/opam/2.1.5/x86_64/opam
+          key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
+
+      - name: Install OCaml ${{ matrix.ocaml-compiler }}
+        if: steps.cache-ocaml.outputs.cache-hit != 'true'
         uses: ocaml/setup-ocaml@v2
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
-          dune-cache: ${{ matrix.os != 'macos-latest' }}
-          opam-depext: ${{ !matrix.skip-test }}
+          dune-cache: true
+          opam-depext: true
           opam-depext-flags: --with-test
 
-      - run: opam pin add zarith git+https://github.com/hhugo/Zarith.git#win-fix
-        if: runner.os == 'Windows'
+      - name: Install packages
+        if: steps.cache-ocaml.outputs.cache-hit
+        run: sudo apt-get install bubblewrap
 
-      - run: opam install . --best-effort
-        if: ${{ matrix.skip-test }}
-
-      - run: opam install . --with-test
-        if: ${{ !matrix.skip-test }}
+      - name: Set opam path
+        if: steps.cache-ocaml.outputs.cache-hit
+        run: |
+          echo /opt/hostedtoolcache/opam/2.1.5/x86_64 >> $GITHUB_PATH
 
-      - run: opam exec -- make all
-        if: ${{ !matrix.skip-test }}
+      - name: Cache OCaml
+        if: steps.cache-ocaml.outputs.cache-hit != 'true'
+        uses: actions/cache/save@v3
+        with:
+          path: |
+            ~/.opam
+            _opam
+            /opt/hostedtoolcache/opam/2.1.5/x86_64/opam
+          key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
 
-      - run: opam exec -- make tests
-        if: ${{ !matrix.skip-test }}
+      - name: Pin dune
+        run: |
+          opam pin add -n dune.3.11 https://github.com/ocaml-wasm/dune.git#wasm
 
-      - run: opam exec -- dune build @all @runtest --profile using-effects
-        if: ${{ !matrix.skip-effects }}
+      - name: Pin packages
+        run: |
+          opam pin add -n alcotest https://github.com/ocaml-wasm/alcotest.git#wasm
+          opam pin add -n async_js https://github.com/ocaml-wasm/async_js.git#wasm
+          opam pin add -n base https://github.com/ocaml-wasm/base.git#wasm
+          opam pin add -n base_bigstring https://github.com/ocaml-wasm/base_bigstring.git#wasm
+          opam pin add -n bigstringaf https://github.com/ocaml-wasm/bigstringaf.git#wasm
+          opam pin add -n bin_prot https://github.com/ocaml-wasm/bin_prot.git#wasm
+          opam pin add -n bonsai https://github.com/ocaml-wasm/bonsai.git#wasm
+          opam pin add -n brr https://github.com/ocaml-wasm/brr.git#wasm
+          opam pin add -n core https://github.com/ocaml-wasm/core.git#wasm
+          opam pin add -n core_kernel https://github.com/ocaml-wasm/core_kernel.git#wasm
+          opam pin add -n cstruct https://github.com/ocaml-wasm/ocaml-cstruct.git#wasm
+          opam pin add -n gen_js_api https://github.com/ocaml-wasm/gen_js_api.git#wasm
+          opam pin add -n incr_dom https://github.com/ocaml-wasm/incr_dom.git#wasm
+          opam pin add -n js_of_ocaml_patches https://github.com/ocaml-wasm/js_of_ocaml_patches.git#wasm
+          opam pin add -n ppx_css https://github.com/ocaml-wasm/ppx_css.git#wasm
+          opam pin add -n ppx_expect https://github.com/ocaml-wasm/ppx_expect.git#wasm
+          opam pin add -n ppx_inline_test https://github.com/ocaml-wasm/ppx_inline_test.git#wasm
+          opam pin add -n string_dict https://github.com/ocaml-wasm/string_dict.git#wasm
+          opam pin add -n time_now https://github.com/ocaml-wasm/time_now.git#wasm
+          opam pin add -n virtual_dom https://github.com/ocaml-wasm/virtual_dom.git#wasm
+          opam pin add -n zarith_stubs_js https://github.com/ocaml-wasm/zarith_stubs_js.git#wasm
+
+      - name: Update dune and test dependencies
+        run: opam install dune num cohttp-lwt-unix graphics ppx_expect zarith.1.12
 
-      - run: opam exec -- git diff --exit-code
-        if: ${{ !matrix.skip-test }}
+      - name: Checkout code
+        uses: actions/checkout@v4
+        with:
+          path: wasm_of_ocaml
 
-      - name: build doc
-        if: ${{ !matrix.skip-doc && github.event_name == 'push' && github.ref == 'refs/heads/master'}}
+      - name: Build wasm_of_ocaml
+        working-directory: ./wasm_of_ocaml
         run: |
-          opam install odoc lwt_log cohttp-lwt-unix yojson ocp-indent graphics higlo
-          opam exec -- make doc
+           for i in *.opam; do opam pin add -n `basename $i .opam`.`< VERSION` .; done
+           opam install `basename -s .opam *.opam`
+
+      - name: Run tests
+        working-directory: ./wasm_of_ocaml
+        run: opam exec -- dune build @all @runtest --profile wasm
+
+      - name: Run tests with CPS effects
+        if: ${{ matrix.ocaml-compiler >= '5.' }}
+        working-directory: ./wasm_of_ocaml
+        run: opam exec -- dune build @all @runtest --profile wasm-effects
+
+      - name: Install bonsai and zarith_stubs_js
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        run: opam install dune bonsai zarith_stubs_js
 
-      - name: synchronize doc
-        if: ${{ !matrix.skip-doc && github.event_name == 'push' && github.ref == 'refs/heads/master' }}
-        uses: JamesIves/github-pages-deploy-action@v4
+      - name: Checkout zarith_stubs_js
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        uses: actions/checkout@v4
         with:
-          branch: wikidoc
-          folder: doc-dev
-          clean: true
-          target-folder: doc/dev/
+          repository: ocaml-wasm/zarith_stubs_js
+          path: zarith
+          ref: wasm
 
-  lint-fmt:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout code
-        uses: actions/checkout@v3
+      - name: Run zarith_stubs_js tests
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        working-directory: ./zarith
+        run: |
+           opam exec -- dune build @runtest --profile wasm
 
-      - name: Use OCaml 4.14.x
-        uses: ocaml/setup-ocaml@v2
+      - name: Checkout bonsai
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        uses: actions/checkout@v4
         with:
-          ocaml-compiler: 4.14.x
-          dune-cache: true
+          repository: ocaml-wasm/bonsai
+          path: bonsai
+          ref: wasm
+
+      - name: Install bonsai dependencies
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        working-directory: ./bonsai
+        run: |
+           sudo apt-get install libgraph-easy-perl
+           npm install deasync
 
-      - name: Lint fmt
-        uses: ocaml/setup-ocaml/lint-fmt@v2
+      - name: Run bonsai tests
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        working-directory: ./bonsai
+        run: |
+           opam exec -- dune build @runtest --profile wasm
diff --git a/.github/workflows/changelog.yml b/.github/workflows/changelog.yml
deleted file mode 100644
index ae4ac990e8..0000000000
--- a/.github/workflows/changelog.yml
+++ /dev/null
@@ -1,20 +0,0 @@
-name: Check changelog
-
-on:
-  pull_request:
-    branches:
-      - master
-    types:
-      - labeled
-      - opened
-      - reopened
-      - synchronize
-      - unlabeled
-
-jobs:
-  check-changelog:
-    name: Check changelog
-    runs-on: ubuntu-latest
-    steps:
-      - name: Check changelog
-        uses: tarides/changelog-check-action@v1

From f16e57ff71661453f798c6e5cd8c72c20047245f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 2 Oct 2023 11:43:58 +0200
Subject: [PATCH 145/481] Runtime: support conversion of Uint8ClampedArray
 typed arrays to bigarrays

---
 runtime/wasm/bigarray.wat | 2 ++
 runtime/wasm/runtime.js   | 2 +-
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index f62217bccf..0cbc15dafa 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -741,6 +741,8 @@
             (call $caml_invalid_argument
                (array.new_data $string $ta_unsupported_kind
                   (i32.const 0) (i32.const 41)))))
+      (if (i32.eq (local.get $kind) (i32.const 13)) ;; Uint8ClampedArray
+         (then (local.set $kind (i32.const 3))))
       (local.set $len (call $ta_length (local.get $data)))
       (if (i32.lt_s (local.get $len) (i32.const 0))
          (then
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 58f4007246..cc1f11f364 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -23,7 +23,7 @@
     let typed_arrays =
       [Float32Array, Float64Array, Int8Array, Uint8Array, Int16Array,
        Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
-       Float32Array, Float64Array, Uint8Array]
+       Float32Array, Float64Array, Uint8Array, Uint8ClampedArray]
 
     const fs = isNode&&require('fs')
 

From 4ae918d5efdf43d5d6b01b67285729e80a805931 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 2 Oct 2023 11:44:40 +0200
Subject: [PATCH 146/481] Bindings: conversion between JavaScript numbers and
 OCaml int32 and nativeint

---
 runtime/wasm/jslib.wat | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 8ee6467fc0..cb7d00441b 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -2,6 +2,8 @@
    (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
    (import "bindings" "identity" (func $from_float (param f64) (result anyref)))
    (import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
+   (import "bindings" "identity" (func $to_int32 (param anyref) (result i32)))
+   (import "bindings" "identity" (func $from_int32 (param i32) (result anyref)))
    (import "bindings" "from_bool" (func $from_bool (param i32) (result anyref)))
    (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
    (import "bindings" "get"
@@ -72,6 +74,14 @@
    (import "jsstring" "string_of_jsstring"
       (func $string_of_jsstring
          (param anyref) (param i32) (result (ref $string))))
+   (import "int32" "caml_copy_int32"
+      (func $caml_copy_int32 (param i32) (result (ref eq))))
+   (import "int32" "Int32_val"
+      (func $Int32_val (param (ref eq)) (result i32)))
+   (import "int32" "caml_copy_nativeint"
+      (func $caml_copy_nativeint (param i32) (result (ref eq))))
+   (import "int32" "Nativeint_val"
+      (func $Nativeint_val (param (ref eq)) (result i32)))
 
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
@@ -136,6 +146,20 @@
       (struct.new $js
          (call $from_bool (i31.get_s (ref.cast (ref i31) (local.get 0))))))
 
+   (func (export "caml_js_to_int32") (param (ref eq)) (result (ref eq))
+      (return_call $caml_copy_int32
+         (call $to_int32 (call $unwrap (local.get 0)))))
+
+   (func (export "caml_js_from_int32") (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $from_int32 (call $Int32_val (local.get 0)))))
+
+   (func (export "caml_js_to_nativeint") (param (ref eq)) (result (ref eq))
+      (return_call $caml_copy_nativeint
+         (call $to_int32 (call $unwrap (local.get 0)))))
+
+   (func (export "caml_js_from_nativeint") (param (ref eq)) (result (ref eq))
+      (return_call $wrap (call $from_int32 (call $Nativeint_val (local.get 0)))))
+
   (func (export "caml_js_pure_expr")
      (param $f (ref eq)) (result (ref eq))
      (return_call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))

From 67d94235d7d5ccc64d508a60c866a44c85b51683 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 2 Oct 2023 11:45:07 +0200
Subject: [PATCH 147/481] Compatibility with Firefox

---
 runtime/wasm/runtime.js | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index cc1f11f364..0e45bfa449 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -87,7 +87,10 @@
     }
 
     let bindings =
-        {jstag:WebAssembly.JSTag,
+        {jstag:
+         WebAssembly.JSTag||
+         // ZZZ not supported in Firefox yet
+         new WebAssembly.Tag({parameters:['externref'],results:[]}),
          identity:(x)=>x,
          from_bool:(x)=>!!x,
          get:(x,y)=>x[y],

From ead7f133cf6bb812a449ac3542c02b43f71fb7dc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 2 Oct 2023 11:47:36 +0200
Subject: [PATCH 148/481] Update requirements

---
 README.md               | 8 ++++----
 runtime/wasm/runtime.js | 1 -
 tools/node_wrapper.sh   | 2 +-
 3 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/README.md b/README.md
index 6ed5006d2f..da4818eb8b 100644
--- a/README.md
+++ b/README.md
@@ -4,11 +4,11 @@ Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssem
 
 ## Requirements
 
-Wasm_of_ocaml relies on the Binaryen toolchain. At the moment, you need to install it [from the main branch on GitHub](https://github.com/WebAssembly/binaryen/).
+Wasm_of_ocaml relies on the Binaryen toolchain ([version 116](https://github.com/WebAssembly/binaryen/releases/tag/version_116) or greater).
 
 ## Supported engines
 
-The generated code works with [Chrome beta](https://www.google.com/chrome/beta/) and [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230711fb76fe1ec2/). For Chrome, you need to enable WebAssembly Garbage Collection and WebAssembly Stringref from chrome://flags/. For node, you need to use the following flags:`--experimental-wasm-gc  --experimental-wasm-stringref`.
+The generated code works with Chrome 11.9 (currently, [Chrome Beta](https://www.google.com/chrome/beta/) or [Chrome for developpers](https://www.google.com/chrome/dev/)), [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and Firefox 120 (currently, [Firefox nightly](https://www.mozilla.org/en-US/firefox/channel/desktop/)).
 
 ## Installation
 
@@ -42,14 +42,14 @@ This outputs a file `cubes.js` which loads the WebAssembly code from file `cube.
 python3 -m http.server 8000 --directory .
 ```
 
-As a larger example, you can try [CAMLBOY](https://github.com/linoscope/CAMLBOY). You need to install a forked version of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm). Once the Js_of_ocaml UI is compiled (with `dune build`), you can generate WebAssembly code instead with the following command:
+As a larger example, you can try [CAMLBOY](https://github.com/linoscope/CAMLBOY). You need to install a forked version of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm). Once the Js_of_ocaml UI is compiled (with `dune build --profile release`), you can generate WebAssembly code instead with the following command:
 ```
 wasm_of_ocaml _build/default/bin/web/index.bc-for-jsoo
 ```
 
 ## Implementation status
 
-A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions, marshaling and dynamic linking are not supported yet.
+A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions and dynamic linking are not supported yet.
 
 Separate compilation is not implemented yet.
 
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 0e45bfa449..09065a6d8b 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,4 +1,3 @@
-#!/usr/bin/env -S node --experimental-wasm-stringref --experimental-wasm-gc
 (async function (eval_function, js) {
     "use strict";
     const src = 'CODE';
diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh
index 932e86353d..0f54c51fe4 100755
--- a/tools/node_wrapper.sh
+++ b/tools/node_wrapper.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively
-exec node --experimental-wasm-stringref --experimental-wasm-gc --experimental-wasm-stack-switching --wasm-stack-switching-stack-size=90 "$@"
+exec node --experimental-wasm-stack-switching --wasm-stack-switching-stack-size=90 "$@"

From 66bdc141e07fc6f490f49712f93484e1c223ecc2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 2 Oct 2023 11:50:41 +0200
Subject: [PATCH 149/481] Runtime: no longer use string.const

---
 runtime/wasm/bigarray.wat  |  1 -
 runtime/wasm/bigstring.wat |  1 -
 runtime/wasm/dynlink.wat   | 16 ++++++++--
 runtime/wasm/fs.wat        |  8 +++--
 runtime/wasm/gc.wat        |  2 --
 runtime/wasm/int64.wat     |  8 +++--
 runtime/wasm/io.wat        |  8 +++--
 runtime/wasm/jslib.wat     |  5 +++
 runtime/wasm/jsstring.wat  |  2 --
 runtime/wasm/nat.wat       | 62 ++++++++++++++++++++++++++++++--------
 runtime/wasm/sys.wat       |  1 -
 11 files changed, 85 insertions(+), 29 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 0cbc15dafa..50ef39f888 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -1,5 +1,4 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
    (import "bindings" "ta_create"
       (func $ta_create (param i32) (param i32) (result (ref extern))))
    (import "bindings" "ta_normalize"
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index d7ad6d4ad3..11e7175aa1 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -1,5 +1,4 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "jslib" "caml_js_get"
diff --git a/runtime/wasm/dynlink.wat b/runtime/wasm/dynlink.wat
index f717aaf8e2..fca3f1bec4 100644
--- a/runtime/wasm/dynlink.wat
+++ b/runtime/wasm/dynlink.wat
@@ -1,15 +1,25 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "log_str" (func $log_str (param (ref $string))))
+
+   (type $string (array (mut i8)))
+
+   (data $caml_dynlink_close_lib "caml_dynlink_close_lib")
 
    (func (export "caml_dynlink_close_lib")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_dynlink_close_lib"))
+      (call $log_str
+         (array.new_data $string $caml_dynlink_close_lib
+            (i32.const 0) (i32.const 22)))
       (ref.i31 (i32.const 0)))
 
+   (data $caml_dynlink_lookup_symbol "caml_dynlink_lookup_symbol")
+
    (func (export "caml_dynlink_lookup_symbol")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_dynlink_lookup_symbol"))
+      (call $log_str
+         (array.new_data $string $caml_dynlink_lookup_symbol
+            (i32.const 0) (i32.const 26)))
       (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index 27e5526514..acf98f57c1 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -1,5 +1,5 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "bindings" "getcwd" (func $getcwd (result anyref)))
    (import "bindings" "chdir" (func $chdir (param anyref)))
    (import "bindings" "mkdir" (func $mkdir (param anyref) (param i32)))
@@ -108,10 +108,14 @@
          (local.get $msg) (local.get $len) (i32.const 0) (i32.const 27))
       (call $caml_raise_sys_error (local.get $msg)))
 
+   (data $caml_read_file_content "caml_read_file_content")
+
    (func (export "caml_read_file_content")
       (param (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_read_file_content"))
+      (call $log_str
+         (array.new_data $string $caml_read_file_content
+            (i32.const 0) (i32.const 22)))
       (call $caml_raise_no_such_file (local.get 0))
       (ref.i31 (i32.const 0)))
 
diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat
index 58daf87379..7092618dcb 100644
--- a/runtime/wasm/gc.wat
+++ b/runtime/wasm/gc.wat
@@ -1,6 +1,4 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
-
    (type $float (struct (field f64)))
    (type $block (array (mut (ref eq))))
 
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 19ff60422d..f67d0ad2e1 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -1,5 +1,5 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "ints" "parse_sign_and_base"
       (func $parse_sign_and_base
          (param (ref $string)) (result i32 i32 i32 i32)))
@@ -172,10 +172,14 @@
          (then (local.set $res (i64.sub (i64.const 0) (local.get $res)))))
       (return_call $caml_copy_int64 (local.get $res)))
 
+   (data $caml_int64_create_lo_mi_hi "caml_int64_create_lo_mi_hi")
+
    (func (export "caml_int64_create_lo_mi_hi")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ does not really make sense
-      (call $log_js (string.const "caml_int64_create_lo_mi_hi"))
+      (call $log_str
+         (array.new_data $string $caml_int64_create_lo_mi_hi
+            (i32.const 0) (i32.const 26)))
       (ref.i31 (i32.const 0)))
 
    (func $format_int64_default (param $d i64) (result (ref eq))
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 32ab0d479e..404944fc22 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -1,5 +1,5 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "fail" "caml_raise_end_of_file" (func $caml_raise_end_of_file))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
@@ -801,10 +801,14 @@
                (then (call $caml_flush (local.get $ch))))))
       (ref.i31 (i32.const 0)))
 
+   (data $caml_ml_set_channel_refill "caml_ml_set_channel_refill")
+
    (func (export "caml_ml_set_channel_refill")
       (param (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "caml_ml_set_channel_refill"))
+      (call $log_str
+         (array.new_data $string $caml_ml_set_channel_refill
+            (i32.const 0) (i32.const 26)))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_channel_size") (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index cb7d00441b..c7444b2367 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -1,4 +1,5 @@
 (module
+   (import "bindings" "log" (func $log_js (param anyref)))
    (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
    (import "bindings" "identity" (func $from_float (param f64) (result anyref)))
    (import "bindings" "identity" (func $to_bool (param anyref) (result i32)))
@@ -639,4 +640,8 @@
                   (return
                      (array.get $block (local.get $exn) (i32.const 2)))))))
       (call $wrap (ref.null any)))
+
+   (func (export "log_str") (param $s (ref $string))
+      (call $log_js
+         (call $unwrap (call $caml_jsstring_of_string (local.get $s)))))
 )
diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
index 0413e65999..3a2a25320e 100644
--- a/runtime/wasm/jsstring.wat
+++ b/runtime/wasm/jsstring.wat
@@ -1,6 +1,4 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
-
    (import "bindings" "read_string"
       (func $read_string (param i32) (result anyref)))
    (import "bindings" "read_string_stream"
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index 9f10c3ca34..4694dbf460 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -1,5 +1,5 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
+   (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "custom" "caml_register_custom_operations"
       (func $caml_register_custom_operations
          (param $ops (ref $custom_operations))))
@@ -362,78 +362,105 @@
          (if (local.get $len1) (then (br $loop))))
       (i31.new (i32.const 1)))
 
+   (data $mult_nat "mult_nat")
+
    (func (export "mult_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
       (param $nat3 (ref eq)) (param $vofs3 (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "mult_nat"))
+      (call $log_str
+         (array.new_data $string $mult_nat (i32.const 0) (i32.const 8)))
       (unreachable))
 
+   (data $square_nat "square_nat")
+
    (func (export "square_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
       (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "square_nat"))
+      (call $log_str
+         (array.new_data $string $square_nat (i32.const 0) (i32.const 10)))
       (unreachable))
 
+   (data $shift_left_nat "shift_left_nat")
+
    (func (export "shift_left_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vnbits (ref eq))
       (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "shift_left_nat"))
+      (call $log_str
+         (array.new_data $string $shift_left_nat (i32.const 0) (i32.const 14)))
       (unreachable))
 
+   (data $shift_right_nat "shift_right_nat")
+
    (func (export "shift_right_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vnbits (ref eq))
       (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "shift_right_nat"))
+      (call $log_str
+         (array.new_data $string $shift_right_nat (i32.const 0) (i32.const 15)))
       (unreachable))
 
+   (data $div_digit_nat "div_digit_nat")
+
    (func (export "div_digit_nat")
       (param $natq (ref eq)) (param $ofsq (ref eq))
       (param $natr (ref eq)) (param $ofsr (ref eq))
       (param $nat1 (ref eq)) (param $ofs1 (ref eq)) (param $len (ref eq))
       (param $nat2 (ref eq)) (param $ofs2 (ref eq)) (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "div_digit_nat"))
+      (call $log_str
+         (array.new_data $string $div_digit_nat (i32.const 0) (i32.const 13)))
       (unreachable))
 
+   (data $div_nat "div_nat")
+
    (func (export "div_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
       (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "div_nat"))
+      (call $log_str
+         (array.new_data $string $div_nat (i32.const 0) (i32.const 7)))
       (unreachable))
 
+   (data $add_nat "add_nat")
+
    (func (export "add_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
       (param $carry_in (ref eq))
       (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "add_nat"))
+      (call $log_str
+         (array.new_data $string $add_nat (i32.const 0) (i32.const 7)))
       (unreachable))
 
+   (data $sub_nat "sub_nat")
+
    (func (export "sub_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
       (param $carry_in (ref eq))
       (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "sub_nat"))
+      (call $log_str
+         (array.new_data $string $sub_nat (i32.const 0) (i32.const 7)))
       (unreachable))
 
+   (data $complement_nat "complement_nat")
+
    (func (export "complement_nat")
       (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
       (result (ref eq))
       ;; ZZZ
-      (call $log_js (string.const "complement_nat"))
+      (call $log_str
+         (array.new_data $string $complement_nat (i32.const 0) (i32.const 14)))
       (unreachable))
 
    (func (export "land_digit_nat")
@@ -487,19 +514,28 @@
             (array.get $data (local.get $data2) (local.get $ofs2))))
       (ref.i31 (i32.const 0)))
 
+   (data $hash_nat "hash_nat")
+
    (func $hash_nat (param (ref eq)) (result i32)
       ;; ZZZ
-      (call $log_js (string.const "hash_nat"))
+      (call $log_str
+         (array.new_data $string $hash_nat (i32.const 0) (i32.const 8)))
       (unreachable))
 
+   (data $serialize_nat "serialize_nat")
+
    (func $serialize_nat
       (param (ref eq)) (param (ref eq)) (result i32) (result i32)
       ;; ZZZ
-      (call $log_js (string.const "serialize_nat"))
+      (call $log_str
+         (array.new_data $string $serialize_nat (i32.const 0) (i32.const 13)))
       (unreachable))
 
+   (data $deserialize_nat "deserialize_nat")
+
    (func $deserialize_nat (param (ref eq)) (result (ref eq)) (result i32)
       ;; ZZZ
-      (call $log_js (string.const "deserialize_nat"))
+      (call $log_str
+         (array.new_data $string $serialize_nat (i32.const 0) (i32.const 15)))
       (unreachable))
 )
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index b5748714cb..22f1cebce0 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -1,5 +1,4 @@
 (module
-   (import "bindings" "log" (func $log_js (param anyref)))
    (import "bindings" "ta_length"
       (func $ta_length (param (ref extern)) (result i32)))
    (import "bindings" "ta_get_i32"

From d67c0536f01f783441cd946cc641a63d901d4ba0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 5 Oct 2023 12:38:27 +0200
Subject: [PATCH 150/481] Runtime: add a caml_callback_2 function

---
 runtime/wasm/obj.wat    | 23 ++++++++++++++++++++++-
 runtime/wasm/stdlib.wat | 20 +++++++++++---------
 2 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 0d58c966a4..ac23a51511 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -429,7 +429,7 @@
    (func (export "caml_obj_reachable_words") (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
 
-   (func (export "caml_callback_1")
+   (func $caml_callback_1 (export "caml_callback_1")
       (param $f (ref eq)) (param $x (ref eq)) (result (ref eq))
       (drop (block $cps (result (ref eq))
          (return_call_ref $function_1 (local.get $x)
@@ -441,4 +441,25 @@
          (local.get $f)
          (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $x))
          (ref.as_non_null (global.get $caml_trampoline_ref))))
+
+   (func (export "caml_callback_2")
+      (param $f (ref eq)) (param $x (ref eq)) (param $y (ref eq))
+      (result (ref eq))
+      (drop (block $not_direct (result (ref eq))
+         (return_call_ref $function_2 (local.get $x) (local.get $y)
+            (local.get $f)
+            (struct.get $closure_2 1
+               (br_on_cast_fail $not_direct (ref eq) (ref $closure_2)
+                  (local.get $f))))))
+      (if (ref.test (ref $closure) (local.get $f))
+         (then
+            (return_call $caml_callback_1
+               (call $caml_callback_1 (local.get $f) (local.get $x))
+               (local.get $y)))
+         (else
+            (return_call_ref $function_1
+               (local.get $f)
+               (array.new_fixed $block 3 (ref.i31 (i32.const 0))
+                 (local.get $x) (local.get $y))
+               (ref.as_non_null (global.get $caml_trampoline_ref))))))
 )
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index d4f3820eb0..fc1441d764 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -14,6 +14,9 @@
    (import "obj" "caml_callback_1"
       (func $caml_callback_1
          (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "obj" "caml_callback_2"
+      (func $caml_callback_2
+         (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "bindings" "write" (func $write (param i32) (param anyref)))
    (import "string" "caml_string_cat"
       (func $caml_string_cat
@@ -180,15 +183,14 @@
             (block $exit
                (block $not_registered
                   (drop
-                     (call $caml_callback_1
-                        (call $caml_callback_1
-                           (br_on_null $not_registered
-                              (call $caml_named_value
-                                  (array.new_data $string
-                                     $handle_uncaught_exception
-                                     (i32.const 0) (i32.const 34))))
-                           (local.get $exn))
-                     (ref.i31 (i32.const 0))))
+                     (call $caml_callback_2
+                        (br_on_null $not_registered
+                           (call $caml_named_value
+                               (array.new_data $string
+                                  $handle_uncaught_exception
+                                  (i32.const 0) (i32.const 34))))
+                        (local.get $exn)
+                        (ref.i31 (i32.const 0))))
                   (br $exit))
                (block $null
                   (drop

From bfc7d5719821b45919614ba29b42e4e29c94f907 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 5 Oct 2023 12:39:32 +0200
Subject: [PATCH 151/481] Runtime: small fixes

---
 runtime/wasm/ints.wat              | 2 ++
 runtime/wasm/jslib.wat             | 2 +-
 runtime/wasm/jslib_js_of_ocaml.wat | 3 +--
 3 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index c0e1082095..c56319b40e 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -94,6 +94,8 @@
       (local.set $sign (tuple.extract 2 (local.get $t)))
       (local.set $base (tuple.extract 3 (local.get $t)))
       (local.set $threshold (i32.div_u (i32.const -1) (local.get $base)))
+      (if (i32.ge_s (local.get $i) (local.get $len))
+         (then (call $caml_failwith (local.get $errmsg))))
       (local.set $d
          (call $parse_digit (array.get_u $string (local.get $s) (local.get $i))))
       (if (i32.ge_u (local.get $d) (local.get $base))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index c7444b2367..8bc2f0d54e 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -141,7 +141,7 @@
 
    (func (export "caml_js_to_bool") (param (ref eq)) (result (ref eq))
       (ref.i31
-         (call $to_bool (struct.get $js 0 (ref.cast (ref $js) (local.get 0))))))
+         (call $to_bool (call $unwrap (local.get 0)))))
 
    (func (export "caml_js_from_bool") (param (ref eq)) (result (ref eq))
       (struct.new $js
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index 73eb4bd482..a77ecb2f6a 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -43,6 +43,5 @@
             (call $caml_js_global (ref.i31 (i32.const 0)))
             (array.new_data $string $XMLHttpRequest
                (i32.const 0) (i32.const 14)))
-         (call $caml_js_from_array
-            (array.new_fixed $block 1 (ref.i31 (i32.const 0))))))
+         (array.new_fixed $block 1 (ref.i31 (i32.const 0)))))
 )

From c93403ef1500ec9fb910884d6be9d8299771cbbe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 5 Oct 2023 12:40:37 +0200
Subject: [PATCH 152/481] Runtime: search the Wasm file relatively to the
 JavaScript loader script

---
 runtime/wasm/runtime.js | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 09065a6d8b..ed8a609ecb 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -6,8 +6,12 @@
       const f = path.join(path.dirname(require.main.filename),src);
       return require('fs/promises').readFile(f)
     }
+    function fetchRelative(src) {
+      const url = new URL (src, document.currentScript?.src || document.baseURI).href
+      return fetch(url)
+    }
     const isNode = globalThis?.process?.versions?.node;
-    const code = isNode?loadRelative(src):fetch(src);
+    const code = isNode?loadRelative(src):fetchRelative(src);
 
     let math =
         {cos:Math.cos, sin:Math.sin, tan:Math.tan,

From d2e8eef04117db07318faf36e6619cf4b4eea132 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 9 Oct 2023 10:48:36 +0200
Subject: [PATCH 153/481] Runtime: implement Json.output

---
 lib/js_of_ocaml/js_of_ocaml_stubs.c |  4 ++
 lib/js_of_ocaml/json.ml             | 94 ++++++++++++++++++++++++++++-
 runtime/obj.js                      |  6 ++
 runtime/wasm/custom.wat             |  4 ++
 4 files changed, 106 insertions(+), 2 deletions(-)

diff --git a/lib/js_of_ocaml/js_of_ocaml_stubs.c b/lib/js_of_ocaml/js_of_ocaml_stubs.c
index b325541db6..4617e0720b 100644
--- a/lib/js_of_ocaml/js_of_ocaml_stubs.c
+++ b/lib/js_of_ocaml/js_of_ocaml_stubs.c
@@ -1,5 +1,9 @@
 #include <stdlib.h>
 #include <stdio.h>
+void caml_custom_identifier () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_custom_identifier!\n");
+  exit(1);
+}
 void caml_js_error_of_exception () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_error_of_exception!\n");
   exit(1);
diff --git a/lib/js_of_ocaml/json.ml b/lib/js_of_ocaml/json.ml
index 3d666ab968..d584ab8e83 100644
--- a/lib/js_of_ocaml/json.ml
+++ b/lib/js_of_ocaml/json.ml
@@ -20,6 +20,88 @@
 open Js
 open! Import
 
+(****)
+
+let write_string buffer s =
+  Buffer.add_char buffer '\"';
+  for i = 0 to String.length s - 1 do
+    match s.[i] with
+    | '\"' -> Buffer.add_string buffer "\\\""
+    | '\\' -> Buffer.add_string buffer "\\\\"
+    | '\b' -> Buffer.add_string buffer "\\b"
+    | '\x0C' -> Buffer.add_string buffer "\\f"
+    | '\n' -> Buffer.add_string buffer "\\n"
+    | '\r' -> Buffer.add_string buffer "\\r"
+    | '\t' -> Buffer.add_string buffer "\\t"
+    | c when Poly.(c <= '\x1F') ->
+        (* Other control characters are escaped. *)
+        Printf.bprintf buffer "\\u%04X" (int_of_char c)
+    | c when Poly.(c < '\x80') -> Buffer.add_char buffer s.[i]
+    | _c (* >= '\x80' *) ->
+        (* Bytes greater than 127 are embedded in a UTF-8 sequence. *)
+        Buffer.add_char buffer (Char.chr (0xC2 lor (Char.code s.[i] lsr 6)));
+        Buffer.add_char buffer (Char.chr (0x80 lor (Char.code s.[i] land 0x3F)))
+  done;
+  Buffer.add_char buffer '\"'
+
+let write_float buffer f =
+  (* "%.15g" can be (much) shorter; "%.17g" is round-trippable *)
+  let s = Printf.sprintf "%.15g" f in
+  if Poly.(float_of_string s = f)
+  then Buffer.add_string buffer s
+  else Printf.bprintf buffer "%.17g" f
+
+external custom_identifier : Obj.t -> string = "caml_custom_identifier"
+
+let rec write b v =
+  if Obj.is_int v
+  then Printf.bprintf b "%d" (Obj.obj v : int)
+  else
+    let t = Obj.tag v in
+    if t <= Obj.last_non_constant_constructor_tag
+    then (
+      Printf.bprintf b "[%d" t;
+      for i = 0 to Obj.size v - 1 do
+        Buffer.add_char b ',';
+        write b (Obj.field v i)
+      done;
+      Buffer.add_char b ']')
+    else if t = Obj.string_tag
+    then write_string b (Obj.obj v : string)
+    else if t = Obj.double_tag
+    then write_float b (Obj.obj v : float)
+    else if t = Obj.double_array_tag
+    then (
+      Printf.bprintf b "[%d" t;
+      for i = 0 to Obj.size v - 1 do
+        Buffer.add_char b ',';
+        write_float b (Obj.double_field v i)
+      done;
+      Buffer.add_char b ']')
+    else if t = Obj.custom_tag
+    then
+      match custom_identifier v with
+      | "_i" -> Printf.bprintf b "%ld" (Obj.obj v : int32)
+      | "_j" ->
+          let i : int64 = Obj.obj v in
+          let mask16 = Int64.of_int 0xffff in
+          let mask24 = Int64.of_int 0xffffff in
+          Printf.bprintf
+            b
+            "[255,%Ld,%Ld,%Ld]"
+            (Int64.logand i mask24)
+            (Int64.logand (Int64.shift_right i 24) mask24)
+            (Int64.logand (Int64.shift_right i 48) mask16)
+      | id -> failwith (Printf.sprintf "Json.output: unsupported custom value %s " id)
+    else failwith (Printf.sprintf "Json.output: unsupported tag %d " t)
+
+let to_json v =
+  let buf = Buffer.create 50 in
+  write buf v;
+  Buffer.contents buf
+
+(****)
+
 class type json =
   object
     method parse : 'a. js_string t -> 'a meth
@@ -52,7 +134,10 @@ let input_reviver =
   in
   wrap_meth_callback reviver
 
-let unsafe_input s = json##parse_ s input_reviver
+let unsafe_input s =
+  match Sys.backend_type with
+  | Other "wasm_of_ocaml" -> failwith "Json.unsafe_input: not implemented"
+  | _ -> json##parse_ s input_reviver
 
 class type obj =
   object
@@ -60,6 +145,8 @@ class type obj =
   end
 
 let mlInt64_constr =
+  Js.Unsafe.pure_expr
+  @@ fun () ->
   let dummy_int64 = 1L in
   let dummy_obj : obj t = Obj.magic dummy_int64 in
   dummy_obj##.constructor
@@ -73,4 +160,7 @@ let output_reviver _key (value : Unsafe.any) : Obj.t =
     Obj.repr (array [| 255; value##.lo; value##.mi; value##.hi |])
   else Obj.repr value
 
-let output obj = json##stringify_ obj (Js.wrap_callback output_reviver)
+let output obj =
+  match Sys.backend_type with
+  | Other "wasm_of_ocaml" -> Js.string (to_json (Obj.repr obj))
+  | _ -> json##stringify_ obj (Js.wrap_callback output_reviver)
diff --git a/runtime/obj.js b/runtime/obj.js
index fa1cbda2b0..9ed63d8db4 100644
--- a/runtime/obj.js
+++ b/runtime/obj.js
@@ -214,3 +214,9 @@ function caml_is_continuation_tag(t) {
 function caml_is_continuation_tag(t) {
   return (t == 245) ? 1 : 0;
 }
+
+//Provides: caml_custom_identifier
+//Requires: caml_string_of_jsstring
+function caml_custom_identifier (o) {
+  return caml_string_of_jsstring(o.custom_tag);
+}
diff --git a/runtime/wasm/custom.wat b/runtime/wasm/custom.wat
index 0583a91f8e..f4dd7cd821 100644
--- a/runtime/wasm/custom.wat
+++ b/runtime/wasm/custom.wat
@@ -109,4 +109,8 @@
       (call $caml_register_custom_operations (global.get $int64_ops))
       (call $caml_register_custom_operations (global.get $bigarray_ops))
       (global.set $initialized (i32.const 1)))
+
+  (func (export "caml_custom_identifier") (param $v (ref eq)) (result (ref eq))
+     (struct.get $custom_operations $id
+        (struct.get $custom 0 (ref.cast (ref $custom) (local.get $v)))))
 )

From 3d7b79a932d2d0c45b99af0fb304e8b025ff3b99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 9 Oct 2023 10:50:41 +0200
Subject: [PATCH 154/481] Jslib: conversion of float arrays

---
 runtime/wasm/jslib.wat | 66 +++++++++++++++++++++++++++++++++---------
 1 file changed, 52 insertions(+), 14 deletions(-)

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 8bc2f0d54e..8e309ab92f 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -86,6 +86,7 @@
 
    (type $block (array (mut (ref eq))))
    (type $float (struct (field f64)))
+   (type $float_array (array (mut f64)))
    (type $string (array (mut i8)))
    (type $js (struct (field anyref)))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
@@ -270,32 +271,69 @@
       (struct.new $js (local.get $o)))
 
    (func $caml_js_from_array (export "caml_js_from_array")
-      (param (ref eq)) (result (ref eq))
+      (param $va (ref eq)) (result (ref eq))
       (local $a (ref $block))
+      (local $fa (ref $float_array))
       (local $a' (ref extern))
       (local $i i32) (local $l i32)
-      (local.set $a (ref.cast (ref $block) (local.get 0)))
-      (local.set $l (i32.sub (array.len (local.get $a)) (i32.const 1)))
-      (local.set $a' (call $new_array (local.get $l)))
-      (local.set $i (i32.const 0))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $l))
-            (then
-               (call $array_set (local.get $a') (local.get $i)
-                  (call $unwrap (array.get $block (local.get $a)
-                                   (i32.add (local.get $i) (i32.const 1)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (struct.new $js (extern.internalize (local.get $a'))))
+      (drop (block $not_array (result (ref eq))
+         (local.set $a
+            (br_on_cast_fail $not_array (ref eq) (ref $block) (local.get $va)))
+         (local.set $l (i32.sub (array.len (local.get $a)) (i32.const 1)))
+         (local.set $a' (call $new_array (local.get $l)))
+         (local.set $i (i32.const 0))
+         (loop $loop
+            (if (i32.lt_u (local.get $i) (local.get $l))
+               (then
+                  (call $array_set (local.get $a') (local.get $i)
+                     (call $unwrap (array.get $block (local.get $a)
+                                      (i32.add (local.get $i) (i32.const 1)))))
+                  (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                  (br $loop))))
+         (return (struct.new $js (extern.internalize (local.get $a'))))))
+     (local.set $fa (ref.cast (ref $float_array) (local.get $va)))
+     (local.set $l (array.len (local.get $fa)))
+     (local.set $a' (call $new_array (local.get $l)))
+     (local.set $i (i32.const 0))
+     (loop $loop
+        (if (i32.lt_u (local.get $i) (local.get $l))
+           (then
+              (call $array_set (local.get $a') (local.get $i)
+                 (struct.new $float
+                    (array.get $float_array (local.get $fa) (local.get $i))))
+              (local.set $i (i32.add (local.get $i) (i32.const 1)))
+              (br $loop))))
+     (struct.new $js (extern.internalize (local.get $a'))))
 
    (func (export "caml_js_to_array")
       (param (ref eq)) (result (ref eq))
       (local $a (ref extern))
       (local $a' (ref $block))
+      (local $fa (ref $float_array))
       (local $i i32) (local $l i32)
       (local.set $a
          (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
       (local.set $l (call $array_length (local.get $a)))
+      (if (local.get $l)
+         (then
+            (if (ref.test (ref $float)
+                   (call $array_get (local.get $a) (i32.const 0)))
+               (then
+                  (local.set $fa
+                     (array.new $float_array (f64.const 0) (local.get $l)))
+                  (local.set $i (i32.const 0))
+                  (loop $loop
+                     (if (i32.lt_u (local.get $i) (local.get $l))
+                        (then
+                           (array.set $float_array (local.get $fa)
+                              (local.get $i)
+                              (struct.get $float 0
+                                 (ref.cast (ref $float)
+                                    (call $array_get
+                                       (local.get $a) (local.get $i)))))
+                           (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                           (br $loop))))
+                  (return (local.get $fa))))))
       (local.set $a'
          (array.new $block (ref.i31 (i32.const 0))
             (i32.add (local.get $l) (i32.const 1))))

From f6b1af66bc43ced22d28b28d4c8ff3ef0641f4ce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 9 Oct 2023 10:54:44 +0200
Subject: [PATCH 155/481] Runtime: Js.export

---
 lib/js_of_ocaml/js.ml      |  9 ++++++---
 lib/tests/test_fun_call.ml | 24 +++++++++++-------------
 runtime/wasm/runtime.js    |  2 +-
 3 files changed, 18 insertions(+), 17 deletions(-)

diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index 3349b04ec5..4816228542 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -838,9 +838,12 @@ let export_js (field : js_string t) x =
   Unsafe.set
     (Unsafe.pure_js_expr "jsoo_exports")
     field
-    (if String.equal (Js.to_string (typeof (Obj.magic x))) "function"
-        (* function with arity/length equal to zero are already wrapped *)
-        && Unsafe.get (Obj.magic x) (Js.string "length") > 0
+    (if match Sys.backend_type with
+        | Other "wasm_of_ocaml" -> Obj.tag (Obj.repr x) = Obj.closure_tag
+        | _ ->
+            String.equal (Js.to_string (typeof (Obj.magic x))) "function"
+            (* function with arity/length equal to zero are already wrapped *)
+            && Unsafe.get (Obj.magic x) (Js.string "length") > 0
      then Obj.magic (wrap_callback (Obj.magic x))
      else x)
 
diff --git a/lib/tests/test_fun_call.ml b/lib/tests/test_fun_call.ml
index 70c1098511..f36b0b871b 100644
--- a/lib/tests/test_fun_call.ml
+++ b/lib/tests/test_fun_call.ml
@@ -409,16 +409,14 @@ let%expect_test _ =
   [%expect {|
     Result: other |}]
 
-(*ZZZ
-  let%expect_test _ =
-    let open Js_of_ocaml in
-    let f = Js.wrap_callback (fun s -> print_endline s) in
-    Js.export "f" f;
-    let () =
-      Js.Unsafe.fun_call
-        (Js.Unsafe.pure_js_expr "jsoo_exports")##.f
-        [| Js.Unsafe.coerce (Js.string "hello") |]
-    in
-    ();
-    [%expect {| hello |}]
-*)
+let%expect_test _ =
+  let open Js_of_ocaml in
+  let f = Js.wrap_callback (fun s -> print_endline (Js.to_string s)) in
+  Js.export "f" f;
+  let () =
+    Js.Unsafe.fun_call
+      (Js.Unsafe.pure_js_expr "jsoo_exports")##.f
+      [| Js.Unsafe.coerce (Js.string "hello") |]
+  in
+  ();
+  [%expect {| hello |}]
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index ed8a609ecb..31ba054a38 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -376,5 +376,5 @@
             event.error&&caml_handle_uncaught_exception(event.error))
     }
     await _initialize();
-})(((joo_global_object,globalThis)=>(x)=>eval(x))(globalThis,globalThis),
+})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval(x))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
    PRIMITIVES);

From 19b3839518d13e061a0141c5c5673b59b3a8898c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 25 Oct 2023 12:24:17 +0200
Subject: [PATCH 156/481] Runtime: small fixes

---
 runtime/wasm/bigstring.wat |  6 +++---
 runtime/wasm/float.wat     |  5 +++--
 runtime/wasm/int32.wat     | 10 ++++++++++
 runtime/wasm/ints.wat      |  4 ++--
 4 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 11e7175aa1..c06443644b 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -25,8 +25,8 @@
          (param (ref extern)) (param i32) (param i32) (result (ref extern))))
    (import "bindings" "ta_set"
       (func $ta_set (param (ref extern)) (param (ref extern)) (param i32)))
-   (import "bindings" "ta_len"
-      (func $ta_len (param (ref extern)) (result i32)))
+   (import "bindings" "ta_length"
+      (func $ta_length (param (ref extern)) (result i32)))
    (import "bindings" "ta_bytes"
       (func $ta_bytes (param anyref) (result anyref)))
    (import "hash" "caml_hash_mix_int"
@@ -39,7 +39,7 @@
       (local $data (ref extern))
       (local $len i32) (local $i i32) (local $w i32)
       (local.set $data (call $caml_ba_get_data (local.get $b)))
-      (local.set $len (call $ta_len (local.get $data)))
+      (local.set $len (call $ta_length (local.get $data)))
       (loop $loop
          (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len))
             (then
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 37ec99cd66..b30ce1de6b 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -506,6 +506,7 @@
                            (local.set $j
                               (i32.add (local.get $j) (i32.const 1)))))
                      (br $copy))))
+            (local.set $len (array.len (local.get $s')))
             (local.set $s (local.get $s'))))
       (block $error
          (br_if $error (i32.eqz (local.get $len)))
@@ -632,12 +633,12 @@
                                        ))))))))))))))))))
          (local.set $f
             (call $parse_float
-               (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))
+               (call $unwrap (call $caml_jsstring_of_string (local.get $s)))))
          (br_if $error (f64.ne (local.get $f) (local.get $f)))
          (return (struct.new $float (local.get $f))))
       (call $caml_failwith
          (array.new_data $string $float_of_string (i32.const 0) (i32.const 15)))
-      (return (struct.new $float (f64.const 0))))
+      (return (i31.new (i32.const 0))))
 
    (func (export "caml_nextafter_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 43e322330e..4174f321f5 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -149,6 +149,16 @@
       (param $i i32) (result (ref eq))
       (struct.new $int32 (global.get $nativeint_ops) (local.get $i)))
 
+   (func (export "caml_nativeint_bswap") (param (ref eq)) (result (ref eq))
+      (local $i i32)
+      (local.set $i (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
+      (return_call $caml_copy_nativeint
+         (i32.or
+            (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
+                      (i32.const 8))
+            (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00))
+                      (i32.const 8)))))
+
    (global $NATIVEINT_ERRMSG (ref $string)
       (array.new_fixed $string 16 ;; "Nativeint.of_string"
          (i32.const 78) (i32.const 97) (i32.const 116) (i32.const 105)
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index c56319b40e..47da923c71 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -141,8 +141,8 @@
       (local.get $res))
 
    (global $INT_ERRMSG (ref $string)
-      (array.new_fixed $string 13 ;; "Int.of_string"
-         (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 46)
+      (array.new_fixed $string 13 ;; "int.of_string"
+         (i32.const 105) (i32.const 110) (i32.const 116) (i32.const 95)
          (i32.const 111) (i32.const 102) (i32.const 95) (i32.const 115)
          (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110)
          (i32.const 103)))

From 30034414fcee0c8c0cc3df552cf64713a6162230 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 25 Oct 2023 12:24:45 +0200
Subject: [PATCH 157/481] Fix: do not duplicate constant floats

---
 compiler/lib/eval.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index ba6f08828b..6c1a264650 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -306,7 +306,8 @@ let eval_instr ~target info ((x, loc) as i) =
                     ( prim
                     , List.map2 prim_args prim_args' ~f:(fun arg c ->
                           match c, target with
-                          | Some ((Int _ | Float _ | NativeString _) as c), _ -> Pc c
+                          | Some ((Int _ | NativeString _) as c), _ -> Pc c
+                          | Some (Float _ as c), `JavaScript -> Pc c
                           | Some (String _ as c), `JavaScript
                             when Config.Flag.use_js_string () -> Pc c
                           | Some _, _

From 84a1ec97741653b8cc9038f6fa278ba639107c22 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 25 Oct 2023 10:21:55 +0200
Subject: [PATCH 158/481] Runtime: make caml_obj_dup support more values

---
 compiler/lib/wasm/wa_gc_target.ml | 10 ++++++++++
 runtime/wasm/bigarray.wat         |  7 +++++--
 runtime/wasm/compare.wat          |  4 +++-
 runtime/wasm/custom.wat           | 14 +++++++++++++-
 runtime/wasm/hash.wat             |  4 +++-
 runtime/wasm/int32.wat            | 17 ++++++++++++++---
 runtime/wasm/int64.wat            | 11 +++++++++--
 runtime/wasm/io.wat               |  7 +++++--
 runtime/wasm/marshal.wat          |  4 +++-
 runtime/wasm/nat.wat              |  7 +++++--
 runtime/wasm/obj.wat              | 11 +++++++++--
 runtime/wasm/sync.wat             |  7 +++++--
 12 files changed, 84 insertions(+), 19 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 29e2564287..e0277080b6 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -83,6 +83,14 @@ module Type = struct
           ; typ = W.Func { W.params = [ value ]; result = [ value; I32 ] }
           })
 
+  let dup_type =
+    register_type "dup" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ = W.Func { W.params = [ value ]; result = [ value ] }
+          })
+
   let custom_operations_type =
     register_type "custom_operations" (fun () ->
         let* string = string_type in
@@ -91,6 +99,7 @@ module Type = struct
         let* fixed_length = fixed_length_type in
         let* serialize = serialize_type in
         let* deserialize = deserialize_type in
+        let* dup = dup_type in
         return
           { supertype = None
           ; final = true
@@ -115,6 +124,7 @@ module Type = struct
                 ; { mut = false
                   ; typ = Value (Ref { nullable = true; typ = Type deserialize })
                   }
+                ; { mut = false; typ = Value (Ref { nullable = true; typ = Type dup }) }
                 ]
           })
 
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 50ef39f888..495d8ef4e5 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -105,6 +105,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -113,7 +114,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $bigarray_ops (export "bigarray_ops") (ref $custom_operations)
@@ -128,7 +130,8 @@
          (ref.func $bigarray_hash)
          (ref.null $fixed_length)
          (ref.func $bigarray_serialize)
-         (ref.func $bigarray_deserialize)))
+         (ref.func $bigarray_deserialize)
+         (ref.null $dup)))
 
    (type $int_array (array (mut i32)))
 
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 255e27d2ad..0b3e85e1e5 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -42,6 +42,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -50,7 +51,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $dummy_block (ref $block)
diff --git a/runtime/wasm/custom.wat b/runtime/wasm/custom.wat
index f4dd7cd821..808e055048 100644
--- a/runtime/wasm/custom.wat
+++ b/runtime/wasm/custom.wat
@@ -18,6 +18,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -26,7 +27,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (type $custom_with_id
@@ -38,6 +40,16 @@
    (func (export "caml_is_custom") (param (ref eq)) (result i32)
       (ref.test (ref $custom) (local.get 0)))
 
+   (func (export "caml_dup_custom") (param $v (ref eq)) (result (ref eq))
+      (call_ref $dup (local.get $v)
+         (ref.as_non_null
+            (struct.get $custom_operations $dup
+               (struct.get $custom 0
+                  (block $custom (result (ref $custom))
+                     (drop (br_on_cast $custom (ref eq) (ref $custom)
+                        (local.get $v)))
+                     (unreachable)))))))
+
    (func (export "custom_compare_id")
       (param (ref eq)) (param (ref eq)) (param i32) (result i32)
       (local $i1 i64) (local $i2 i64)
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index 0d35c59462..a6d5f65063 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -19,6 +19,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -27,7 +28,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (func $caml_hash_mix_int (export "caml_hash_mix_int")
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 4174f321f5..d80535a6ba 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -24,6 +24,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -32,7 +33,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $int32_ops (export "int32_ops") (ref $custom_operations)
@@ -43,7 +45,8 @@
          (ref.func $int32_hash)
          (struct.new $fixed_length (i32.const 4) (i32.const 4))
          (ref.func $int32_serialize)
-         (ref.func $int32_deserialize)))
+         (ref.func $int32_deserialize)
+         (ref.func $int32_dup)))
 
    (type $int32
       (sub final $custom (struct (field (ref $custom_operations)) (field i32))))
@@ -73,6 +76,13 @@
             (call $caml_deserialize_int_4 (local.get $s)))
          (i32.const 4)))
 
+   (func $int32_dup (param $v (ref eq)) (result (ref eq))
+      (local $d (ref $int32))
+      (local.set $d (ref.cast (ref $int32) (local.get $v)))
+      (struct.new $int32
+         (struct.get $int32 0 (local.get $d))
+         (struct.get $int32 1 (local.get $d))))
+
    (func $caml_copy_int32 (export "caml_copy_int32")
       (param $i i32) (result (ref eq))
       (struct.new $int32 (global.get $int32_ops) (local.get $i)))
@@ -122,7 +132,8 @@
          (ref.func $int32_hash)
          (struct.new $fixed_length (i32.const 4) (i32.const 8))
          (ref.func $nativeint_serialize)
-         (ref.func $nativeint_deserialize)))
+         (ref.func $nativeint_deserialize)
+         (ref.func $int32_dup)))
 
    (func $nativeint_serialize
       (param $s (ref eq)) (param $v (ref eq)) (result i32) (result i32)
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index f67d0ad2e1..f3a42e634c 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -22,6 +22,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -30,7 +31,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $int64_ops (export "int64_ops") (ref $custom_operations)
@@ -41,7 +43,8 @@
          (ref.func $int64_hash)
          (struct.new $fixed_length (i32.const 8) (i32.const 8))
          (ref.func $int64_serialize)
-         (ref.func $int64_deserialize)))
+         (ref.func $int64_deserialize)
+         (ref.func $int64_dup)))
 
    (type $int64
       (sub final $custom (struct (field (ref $custom_operations)) (field i64))))
@@ -76,6 +79,10 @@
             (call $caml_deserialize_int_8 (local.get $s)))
          (i32.const 8)))
 
+   (func $int64_dup (param $v (ref eq)) (result (ref eq))
+      (struct.new $int64 (global.get $int64_ops)
+         (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v)))))
+
    (func $caml_copy_int64 (export "caml_copy_int64")
       (param $i i64) (result (ref eq))
       (struct.new $int64 (global.get $int64_ops) (local.get $i)))
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 404944fc22..47c5f506ed 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -66,6 +66,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -74,7 +75,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
    (type $custom_with_id
       (sub $custom
@@ -92,7 +94,8 @@
          (ref.func $custom_hash_id)
          (ref.null $fixed_length)
          (ref.null $serialize)
-         (ref.null $deserialize)))
+         (ref.null $deserialize)
+         (ref.null $dup)))
 
    (type $channel
       (sub final $custom_with_id
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index d02d774d0a..71cd4dc323 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -117,6 +117,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -125,7 +126,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $Intext_magic_number_small i32 (i32.const 0x8495A6BE))
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index 4694dbf460..f684c01f58 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -18,6 +18,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -26,7 +27,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $nat_ops (ref $custom_operations)
@@ -38,7 +40,8 @@
          (ref.func $hash_nat)
          (ref.null $fixed_length)
          (ref.func $serialize_nat)
-         (ref.func $deserialize_nat)))
+         (ref.func $deserialize_nat)
+         (ref.null $dup)))
 
    (type $nat
       (sub final $custom
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index ac23a51511..303b4ad64d 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -2,6 +2,8 @@
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "custom" "caml_is_custom"
       (func $caml_is_custom (param (ref eq)) (result i32)))
+   (import "custom" "caml_dup_custom"
+      (func $caml_dup_custom (param (ref eq)) (result (ref eq))))
    (import "effect" "caml_is_continuation"
       (func $caml_is_continuation (param (ref eq)) (result i32)))
    (import "effect" "caml_trampoline_ref"
@@ -190,8 +192,13 @@
             (local.get $s') (i32.const 0) (local.get $s) (i32.const 0)
             (local.get $len))
          (return (local.get $s'))))
-      ;; ZZZ Deal with other values?
-      (unreachable))
+      (drop (block $not_float (result (ref eq))
+         (return
+            (struct.new $float
+               (struct.get $float 0
+                  (br_on_cast_fail $not_float (ref eq) (ref $float)
+                     (local.get 0)))))))
+      (call $caml_dup_custom (local.get 0)))
 
    (func (export "caml_obj_with_tag")
       (param $tag (ref eq)) (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index eec85e875a..744481cf75 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -16,6 +16,7 @@
    (type $serialize
       (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
    (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
+   (type $dup (func (param (ref eq)) (result (ref eq))))
    (type $custom_operations
       (struct
          (field $id (ref $string))
@@ -24,7 +25,8 @@
          (field $hash (ref null $hash))
          (field $fixed_length (ref null $fixed_length))
          (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))))
+         (field $deserialize (ref null $deserialize))
+         (field $dup (ref null $dup))))
    (type $custom (sub (struct (field (ref $custom_operations)))))
    (type $custom_with_id
       (sub $custom
@@ -42,7 +44,8 @@
          (ref.func $custom_hash_id)
          (ref.null $fixed_length)
          (ref.null $serialize)
-         (ref.null $deserialize)))
+         (ref.null $deserialize)
+         (ref.null $dup)))
 
    (type $mutex
       (sub final $custom_with_id

From 3965761ae66189fd2d27df1f00312c7e1e5aa0be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 26 Oct 2023 12:40:31 +0200
Subject: [PATCH 159/481] Support for constant JavaScript strings

---
 compiler/bin-js_of_ocaml/build_fs.ml     |  2 +-
 compiler/bin-js_of_ocaml/compile.ml      |  2 +-
 compiler/bin-wasm_of_ocaml/compile.ml    | 41 +++++++++++++++-------
 compiler/lib/driver.ml                   |  9 ++---
 compiler/lib/driver.mli                  |  2 +-
 compiler/lib/specialize_js.ml            |  6 ++--
 compiler/lib/stdlib.ml                   | 13 ++++---
 compiler/lib/wasm/wa_ast.ml              |  1 +
 compiler/lib/wasm/wa_code_generation.ml  | 16 +++++++++
 compiler/lib/wasm/wa_code_generation.mli |  5 +++
 compiler/lib/wasm/wa_gc_target.ml        | 44 +++++++++++++++++++++++-
 compiler/lib/wasm/wa_generate.ml         | 17 +++++----
 compiler/lib/wasm/wa_generate.mli        |  6 +++-
 compiler/lib/wasm/wa_wat_output.ml       |  1 +
 runtime/wasm/runtime.js                  |  6 ++--
 15 files changed, 131 insertions(+), 40 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml
index 0acc861ff8..68f5642d36 100644
--- a/compiler/bin-js_of_ocaml/build_fs.ml
+++ b/compiler/bin-js_of_ocaml/build_fs.ml
@@ -73,7 +73,7 @@ function jsoo_create_file_extern(name,content){
   let code = Code.prepend Code.empty instr in
   Filename.gen_file output_file (fun chan ->
       let pfs_fmt = Pretty_print.to_out_channel chan in
-      let (_ : Source_map.t option) =
+      let (_ : Source_map.t option), _ =
         Driver.f
           ~target:(`JavaScript pfs_fmt)
           ~standalone:true
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 22bf3650a3..47ab638895 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -179,7 +179,7 @@ let run
   let output (one : Parse_bytecode.one) ~standalone ~source_map ~linkall output_file =
     check_debug one;
     let init_pseudo_fs = fs_external && standalone in
-    let sm =
+    let sm, _ =
       match output_file with
       | `Stdout, fmt ->
           let instr =
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 1e077084e8..6ab6fe175c 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -162,7 +162,7 @@ let escape_string s =
   done;
   Buffer.contents b
 
-let build_js_runtime primitives wasm_file output_file =
+let build_js_runtime primitives (strings : string list) wasm_file output_file =
   let always_required_js, primitives =
     let l =
       StringSet.fold
@@ -187,15 +187,28 @@ let build_js_runtime primitives wasm_file output_file =
   let f = Pretty_print.to_buffer b' in
   Pretty_print.set_compact f (not (Config.Flag.pretty ()));
   ignore (Js_output.program f [ primitives ]);
+  let b'' = Buffer.create 1024 in
+  let f = Pretty_print.to_buffer b'' in
+  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
+  ignore
+    (Js_output.program
+       f
+       [ ( Javascript.Expression_statement
+             (EArr
+                (List.map
+                   ~f:(fun s -> Javascript.Element (EStr (Utf8_string.of_string_exn s)))
+                   strings))
+         , Javascript.N )
+       ]);
   let s = Wa_runtime.js_runtime in
   let rec find pat i =
     if String.equal (String.sub s ~pos:i ~len:(String.length pat)) pat
     then i
     else find pat (i + 1)
   in
-  let i = String.index s '\n' + 1 in
-  let j = find "CODE" 0 in
-  let k = find "PRIMITIVES" 0 in
+  let i = find "CODE" 0 in
+  let j = find "PRIMITIVES" 0 in
+  let k = find "STRINGS" 0 in
   let rec trim_semi s =
     let l = String.length s in
     if l = 0
@@ -207,13 +220,14 @@ let build_js_runtime primitives wasm_file output_file =
   in
   write_file
     output_file
-    (String.sub s ~pos:0 ~len:i
-    ^ Buffer.contents b
-    ^ String.sub s ~pos:i ~len:(j - i)
+    (Buffer.contents b
+    ^ String.sub s ~pos:0 ~len:i
     ^ escape_string (Filename.basename wasm_file)
-    ^ String.sub s ~pos:(j + 4) ~len:(k - j - 4)
+    ^ String.sub s ~pos:(i + 4) ~len:(j - i - 4)
     ^ trim_semi (Buffer.contents b')
-    ^ String.sub s ~pos:(k + 10) ~len:(String.length s - k - 10))
+    ^ String.sub s ~pos:(j + 10) ~len:(k - j - 10)
+    ^ trim_semi (Buffer.contents b'')
+    ^ String.sub s ~pos:(k + 7) ~len:(String.length s - k - 7))
 
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
   Wa_generate.init ();
@@ -256,7 +270,7 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
   let need_debug = Config.Flag.debuginfo () in
   let output (one : Parse_bytecode.one) ~standalone ch =
     let code = one.code in
-    let _ =
+    let _, strings =
       Driver.f
         ~target:(`Wasm ch)
         ~standalone
@@ -266,7 +280,8 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
         one.debug
         code
     in
-    if times () then Format.eprintf "compilation: %a@." Timer.print t
+    if times () then Format.eprintf "compilation: %a@." Timer.print t;
+    strings
   in
   (let kind, ic, close_ic, include_dirs =
      let ch = open_in_bin input_file in
@@ -296,9 +311,9 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
        if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
        let wat_file = Filename.chop_extension (fst output_file) ^ ".wat" in
        let wasm_file = Filename.chop_extension (fst output_file) ^ ".wasm" in
-       output_gen wat_file (output code ~standalone:true);
+       let strings = output_gen wat_file (output code ~standalone:true) in
        let primitives = link_and_optimize runtime_wasm_files wat_file wasm_file in
-       build_js_runtime primitives wasm_file (fst output_file)
+       build_js_runtime primitives strings wasm_file (fst output_file)
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());
   Debug.stop_profiling ()
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 67b26f25e9..fad0ce0bb1 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -613,14 +613,15 @@ let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
   let r = opt p in
   let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
   match target with
-  | `JavaScript formatter -> emit formatter r
+  | `JavaScript formatter ->
+      let source_map = emit formatter r in
+      source_map, []
   | `Wasm ch ->
       let (p, live_vars), _, in_cps = r in
-      Wa_generate.f ch ~live_vars ~in_cps p;
-      None
+      None, Wa_generate.f ch ~live_vars ~in_cps p
 
 let full_no_source_map ~target ~standalone ~wrap_with_fun ~profile ~linkall d p =
-  let (_ : Source_map.t option) =
+  let (_ : Source_map.t option * string list) =
     full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map:None d p
   in
   ()
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 975e8be2ea..5ca2b795df 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -29,7 +29,7 @@ val f :
   -> ?source_map:Source_map.t
   -> Parse_bytecode.Debug.t
   -> Code.program
-  -> Source_map.t option
+  -> Source_map.t option * string list
 
 val f' :
      ?standalone:bool
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 2b3825ff0c..87097c2eca 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -123,13 +123,13 @@ let specialize_instr ~target info i =
       match the_native_string_of info f with
       | Some s -> Let (x, Prim (Extern "caml_js_delete", [ o; Pc (NativeString s) ]))
       | _ -> i)
-  | ( Let (x, Prim (Extern ("caml_jsstring_of_string" | "caml_js_from_string"), [ y ]))
-    , `JavaScript ) -> (
+  | Let (x, Prim (Extern ("caml_jsstring_of_string" | "caml_js_from_string"), [ y ])), _
+    -> (
       match the_string_of info y with
       | Some s when String.is_valid_utf_8 s ->
           Let (x, Constant (NativeString (Native_string.of_string s)))
       | Some _ | None -> i)
-  | Let (x, Prim (Extern "caml_jsbytes_of_string", [ y ])), `JavaScript -> (
+  | Let (x, Prim (Extern "caml_jsbytes_of_string", [ y ])), _ -> (
       match the_string_of info y with
       | Some s -> Let (x, Constant (NativeString (Native_string.of_bytestring s)))
       | None -> i)
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index ccc23392fd..a44be69d24 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -1163,13 +1163,16 @@ module Filename = struct
     in
     try
       let ch = open_out_bin f_tmp in
-      (try f ch
-       with e ->
-         close_out ch;
-         raise e);
+      let res =
+        try f ch
+        with e ->
+          close_out ch;
+          raise e
+      in
       close_out ch;
       (try Sys.remove file with Sys_error _ -> ());
-      Sys.rename f_tmp file
+      Sys.rename f_tmp file;
+      res
     with exc ->
       Sys.remove f_tmp;
       raise exc
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 5eddd4c1bc..193e744825 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -11,6 +11,7 @@ type packed_type =
 type heap_type =
   | Func
   | Extern
+  | Any
   | Eq
   | I31
   | Type of var
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 6f6adac377..b4eb3cdcef 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -34,6 +34,9 @@ type context =
   ; mutable dummy_funs : Var.t IntMap.t
   ; mutable cps_dummy_funs : Var.t IntMap.t
   ; mutable init_code : W.instruction list
+  ; mutable string_count : int
+  ; mutable strings : string list
+  ; mutable string_index : int StringMap.t
   }
 
 let make_context () =
@@ -51,6 +54,9 @@ let make_context () =
   ; dummy_funs = IntMap.empty
   ; cps_dummy_funs = IntMap.empty
   ; init_code = []
+  ; string_count = 0
+  ; strings = []
+  ; string_index = StringMap.empty
   }
 
 type var =
@@ -171,6 +177,16 @@ let register_init_code code st =
   st.context.init_code <- st'.instrs @ st.context.init_code;
   (), st
 
+let register_string s st =
+  let context = st.context in
+  try StringMap.find s context.string_index, st
+  with Not_found ->
+    let n = context.string_count in
+    context.string_count <- 1 + context.string_count;
+    context.strings <- s :: context.strings;
+    context.string_index <- StringMap.add s n context.string_index;
+    n, st
+
 let set_closure_env f env st =
   st.context.closure_envs <- Var.Map.add f env st.context.closure_envs;
   (), st
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 8ea33e6674..f8db7bf5d7 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -18,6 +18,9 @@ type context =
   ; mutable dummy_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable cps_dummy_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable init_code : Wa_ast.instruction list
+  ; mutable string_count : int
+  ; mutable strings : string list
+  ; mutable string_index : int StringMap.t
   }
 
 val make_context : unit -> context
@@ -136,6 +139,8 @@ val register_init_code : unit t -> unit t
 
 val init_code : context -> unit t
 
+val register_string : string -> int t
+
 val get_context : context t
 
 val set_closure_env : Code.Var.t -> Code.Var.t -> unit t
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index e0277080b6..2da6da7746 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -41,6 +41,16 @@ module Type = struct
           ; typ = W.Array { mut = true; typ = Value F64 }
           })
 
+  let js_type =
+    register_type "js" (fun () ->
+        return
+          { supertype = None
+          ; final = true
+          ; typ =
+              W.Struct
+                [ { mut = false; typ = Value (Ref { nullable = true; typ = Any }) } ]
+          })
+
   let compare_type =
     register_type "compare" (fun () ->
         return
@@ -764,6 +774,23 @@ module Constant = struct
     let* () = register_global (V name) { mut = false; typ = Type.value } c in
     return (W.GlobalGet (V name))
 
+  let str_js_utf8 s =
+    let b = Buffer.create (String.length s) in
+    String.iter s ~f:(function
+        | '\\' -> Buffer.add_string b "\\\\"
+        | c -> Buffer.add_char b c);
+    Buffer.contents b
+
+  let str_js_byte s =
+    let b = Buffer.create (String.length s) in
+    String.iter s ~f:(function
+        | '\\' -> Buffer.add_string b "\\\\"
+        | '\128' .. '\255' as c ->
+            Buffer.add_string b "\\x";
+            Buffer.add_char_hex b c
+        | c -> Buffer.add_char b c);
+    Buffer.contents b
+
   let rec translate_rec c =
     match c with
     | Code.Int (Regular, i) -> return (true, W.RefI31 (Const (I32 i)))
@@ -805,7 +832,22 @@ module Constant = struct
           in
           return (true, c)
         else return (true, c)
-    | NativeString (Byte s | Utf (Utf8 s)) | String s ->
+    | NativeString s ->
+        let s =
+          match s with
+          | Utf (Utf8 s) -> str_js_utf8 s
+          | Byte s -> str_js_byte s
+        in
+        let* i = register_string s in
+        let* x =
+          register_import
+            ~import_module:"strings"
+            ~name:(string_of_int i)
+            (Global { mut = false; typ = Ref { nullable = false; typ = Any } })
+        in
+        let* ty = Type.js_type in
+        return (true, W.StructNew (ty, [ GlobalGet (V x) ]))
+    | String s ->
         let* ty = Type.string_type in
         if String.length s > string_length_threshold
         then
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index c10c723b1a..e5bffcb687 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -994,9 +994,10 @@ module Generate (Target : Wa_target_sig.S) = struct
           W.Data { name; read_only = true; active; contents })
         (Var.Map.bindings ctx.global_context.data_segments)
     in
-    List.rev_append
-      ctx.global_context.other_fields
-      (imports @ functions @ (start_function :: constant_data))
+    ( List.rev_append
+        ctx.global_context.other_fields
+        (imports @ functions @ (start_function :: constant_data))
+    , List.rev ctx.global_context.strings )
 end
 
 let init () =
@@ -1047,9 +1048,11 @@ let f ch (p : Code.program) ~live_vars ~in_cps =
   match target with
   | `Core ->
       let module G = Generate (Wa_core_target) in
-      let fields = G.f ~live_vars ~in_cps p in
-      Wa_asm_output.f ch fields
+      let fields, strings = G.f ~live_vars ~in_cps p in
+      Wa_asm_output.f ch fields;
+      strings
   | `GC ->
       let module G = Generate (Wa_gc_target) in
-      let fields = G.f ~live_vars ~in_cps p in
-      Wa_wat_output.f ch fields
+      let fields, strings = G.f ~live_vars ~in_cps p in
+      Wa_wat_output.f ch fields;
+      strings
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index 05550212ca..f040ba50d5 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -1,4 +1,8 @@
 val init : unit -> unit
 
 val f :
-  out_channel -> Code.program -> live_vars:int array -> in_cps:Effects.in_cps -> unit
+     out_channel
+  -> Code.program
+  -> live_vars:int array
+  -> in_cps:Effects.in_cps
+  -> string list
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 7d27f7348e..56868977e5 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -26,6 +26,7 @@ let heap_type (ty : heap_type) =
   match ty with
   | Func -> Atom "func"
   | Extern -> Atom "extern"
+  | Any -> Atom "any"
   | Eq -> Atom "eq"
   | I31 -> Atom "i31"
   | Type t -> index t
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 31ba054a38..8347936117 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,4 +1,4 @@
-(async function (eval_function, js) {
+(async function (eval_function, js, strings) {
     "use strict";
     const src = 'CODE';
     function loadRelative(src) {
@@ -345,7 +345,7 @@
          map_set:(m,x,v)=>m.set(x,v),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const imports = {Math:math,bindings:bindings,env:{},js:js}
+    const imports = {Math:math,bindings,env:{},js,strings}
     const wasmModule =
           isNode?await WebAssembly.instantiate(await code, imports)
                 :await WebAssembly.instantiateStreaming(code,imports)
@@ -377,4 +377,4 @@
     }
     await _initialize();
 })(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval(x))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
-   PRIMITIVES);
+   PRIMITIVES, STRINGS);

From 7fc91243178fe4d78a8392b812d9abbe8b557f56 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 27 Oct 2023 12:17:36 +0200
Subject: [PATCH 160/481] Primitive renaming/alias fix

---
 compiler/bin-js_of_ocaml/compile.ml   |  2 +-
 compiler/bin-wasm_of_ocaml/compile.ml |  2 +-
 compiler/lib/wasm/wa_generate.ml      | 23 ++++++++++++++---------
 3 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 47ab638895..39990fc6c8 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -88,10 +88,10 @@ let run
     ; export_file
     ; keep_unit_names
     } =
-  Generate.init ();
   let include_cmis = toplevel && not no_cmis in
   let custom_header = common.Jsoo_cmdline.Arg.custom_header in
   Jsoo_cmdline.Arg.eval common;
+  Generate.init ();
   (match output_file with
   | `Stdout, _ -> ()
   | `Name name, _ when debug_mem () -> Debug.start_profiling name
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 6ab6fe175c..8c72052958 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -230,8 +230,8 @@ let build_js_runtime primitives (strings : string list) wasm_file output_file =
     ^ String.sub s ~pos:(k + 7) ~len:(String.length s - k - 7))
 
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
-  Wa_generate.init ();
   Jsoo_cmdline.Arg.eval common;
+  Wa_generate.init ();
   (match output_file with
   | name, _ when debug_mem () -> Debug.start_profiling name
   | _, _ -> ());
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index e5bffcb687..4133b4c332 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -520,13 +520,8 @@ module Generate (Target : Wa_target_sig.S) = struct
             in
             Memory.allocate stack_ctx x ~tag:0 l
         | Extern name, l ->
+            let name = Primitive.resolve name in
             (*ZZZ Different calling convention when large number of parameters *)
-            let name =
-              match name with
-              | "caml_callback" -> "caml_trampoline"
-              | "caml_alloc_stack" when Config.Flag.effects () -> "caml_cps_alloc_stack"
-              | _ -> name
-            in
             let* f = register_import ~name (Fun (func_type (List.length l))) in
             let* () = Stack.perform_spilling stack_ctx (`Instr x) in
             let rec loop acc l =
@@ -1001,9 +996,19 @@ module Generate (Target : Wa_target_sig.S) = struct
 end
 
 let init () =
-  List.iter
-    ~f:(fun (nm, nm') -> Primitive.alias nm nm')
-    [ "caml_make_array", "%identity"; "caml_ensure_stack_capacity", "%identity" ]
+  let l =
+    [ "caml_make_array", "%identity"
+    ; "caml_ensure_stack_capacity", "%identity"
+    ; "caml_callback", "caml_trampoline"
+    ]
+  in
+
+  let l =
+    if Config.Flag.effects ()
+    then ("caml_alloc_stack", "caml_cps_alloc_stack") :: l
+    else l
+  in
+  List.iter ~f:(fun (nm, nm') -> Primitive.alias nm nm') l
 
 (* Make sure we can use [br_table] for switches *)
 let fix_switch_branches p =

From a17d190291ed2a8fbe51fd7701a77e3069049eaa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 27 Oct 2023 14:46:43 +0200
Subject: [PATCH 161/481] Some JavaScript interface optimizations

Avoid allocating an array to pass parameters by generating specific
JavaScript code for function and method calls.
---
 compiler/bin-wasm_of_ocaml/compile.ml    |  19 +-
 compiler/lib/driver.ml                   |   4 +-
 compiler/lib/driver.mli                  |   2 +-
 compiler/lib/specialize_js.ml            |   8 +-
 compiler/lib/wasm/wa_code_generation.ml  |   8 +
 compiler/lib/wasm/wa_code_generation.mli |   3 +
 compiler/lib/wasm/wa_core_target.ml      |   2 +
 compiler/lib/wasm/wa_gc_target.ml        | 149 ++++
 compiler/lib/wasm/wa_generate.ml         | 849 ++++++++++++-----------
 compiler/lib/wasm/wa_generate.mli        |   2 +-
 compiler/lib/wasm/wa_target_sig.ml       |   3 +
 runtime/wasm/runtime.js                  |   4 +-
 12 files changed, 647 insertions(+), 406 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 8c72052958..2563549263 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -162,7 +162,7 @@ let escape_string s =
   done;
   Buffer.contents b
 
-let build_js_runtime primitives (strings : string list) wasm_file output_file =
+let build_js_runtime primitives (strings, fragments) wasm_file output_file =
   let always_required_js, primitives =
     let l =
       StringSet.fold
@@ -200,6 +200,21 @@ let build_js_runtime primitives (strings : string list) wasm_file output_file =
                    strings))
          , Javascript.N )
        ]);
+  let fragment_buffer = Buffer.create 1024 in
+  let f = Pretty_print.to_buffer fragment_buffer in
+  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
+  ignore
+    (Js_output.program
+       f
+       [ ( Javascript.Expression_statement
+             (EObj
+                (List.map
+                   ~f:(fun (nm, f) ->
+                     let id = Utf8_string.of_string_exn nm in
+                     Javascript.Property (PNI id, f))
+                   fragments))
+         , Javascript.N )
+       ]);
   let s = Wa_runtime.js_runtime in
   let rec find pat i =
     if String.equal (String.sub s ~pos:i ~len:(String.length pat)) pat
@@ -227,6 +242,8 @@ let build_js_runtime primitives (strings : string list) wasm_file output_file =
     ^ trim_semi (Buffer.contents b')
     ^ String.sub s ~pos:(j + 10) ~len:(k - j - 10)
     ^ trim_semi (Buffer.contents b'')
+    ^ ","
+    ^ trim_semi (Buffer.contents fragment_buffer)
     ^ String.sub s ~pos:(k + 7) ~len:(String.length s - k - 7))
 
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index fad0ce0bb1..f3cd7837e3 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -615,13 +615,13 @@ let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
   match target with
   | `JavaScript formatter ->
       let source_map = emit formatter r in
-      source_map, []
+      source_map, ([], [])
   | `Wasm ch ->
       let (p, live_vars), _, in_cps = r in
       None, Wa_generate.f ch ~live_vars ~in_cps p
 
 let full_no_source_map ~target ~standalone ~wrap_with_fun ~profile ~linkall d p =
-  let (_ : Source_map.t option * string list) =
+  let (_ : Source_map.t option * _) =
     full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map:None d p
   in
   ()
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 5ca2b795df..9b27c91f10 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -29,7 +29,7 @@ val f :
   -> ?source_map:Source_map.t
   -> Parse_bytecode.Debug.t
   -> Code.program
-  -> Source_map.t option * string list
+  -> Source_map.t option * (string list * (string * Javascript.expression) list)
 
 val f' :
      ?standalone:bool
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 87097c2eca..c562f18bef 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -53,19 +53,19 @@ let specialize_instr ~target info i =
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
       | Some _ -> Let (x, Constant (Int (Regular, 0l)))
       | None -> i)
-  | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), `JavaScript -> (
+  | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), _ -> (
       match the_def_of info a with
       | Some (Block (_, a, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_call", f :: o :: Array.to_list a))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])), `JavaScript -> (
+  | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])), _ -> (
       match the_def_of info a with
       | Some (Block (_, a, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), `JavaScript -> (
+  | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), _ -> (
       match the_string_of info m with
       | Some m when Javascript.is_ident m -> (
           match the_def_of info a with
@@ -80,7 +80,7 @@ let specialize_instr ~target info i =
                       :: Array.to_list a ) )
           | _ -> i)
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_new", [ c; a ])), `JavaScript -> (
+  | Let (x, Prim (Extern "caml_js_new", [ c; a ])), _ -> (
       match the_def_of info a with
       | Some (Block (_, a, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index b4eb3cdcef..6ef0daca15 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -37,6 +37,7 @@ type context =
   ; mutable string_count : int
   ; mutable strings : string list
   ; mutable string_index : int StringMap.t
+  ; mutable fragments : Javascript.expression StringMap.t
   }
 
 let make_context () =
@@ -57,6 +58,7 @@ let make_context () =
   ; string_count = 0
   ; strings = []
   ; string_index = StringMap.empty
+  ; fragments = StringMap.empty
   }
 
 type var =
@@ -187,6 +189,12 @@ let register_string s st =
     context.string_index <- StringMap.add s n context.string_index;
     n, st
 
+let register_fragment name f st =
+  let context = st.context in
+  if not (StringMap.mem name context.fragments)
+  then context.fragments <- StringMap.add name (f ()) context.fragments;
+  (), st
+
 let set_closure_env f env st =
   st.context.closure_envs <- Var.Map.add f env st.context.closure_envs;
   (), st
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index f8db7bf5d7..dec0939dda 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -21,6 +21,7 @@ type context =
   ; mutable string_count : int
   ; mutable strings : string list
   ; mutable string_index : int StringMap.t
+  ; mutable fragments : Javascript.expression StringMap.t
   }
 
 val make_context : unit -> context
@@ -141,6 +142,8 @@ val init_code : context -> unit t
 
 val register_string : string -> int t
 
+val register_fragment : string -> (unit -> Javascript.expression) -> unit t
+
 val get_context : context t
 
 val set_closure_env : Code.Var.t -> Code.Var.t -> unit t
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 98cb1f8111..fc11dbf308 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -620,6 +620,8 @@ module Math = struct
   let fmod f g = binary "fmod" f g
 end
 
+let internal_primitives = Hashtbl.create 0
+
 let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
   let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
   try_
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 2da6da7746..5cadcfd359 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1230,6 +1230,155 @@ module Math = struct
   let exp2 x = power (return (W.Const (F64 2.))) x
 end
 
+module JavaScript = struct
+  let anyref = W.Ref { nullable = true; typ = Any }
+
+  let invoke_fragment name args =
+    let* f =
+      register_import
+        ~import_module:"fragments"
+        ~name
+        (Fun { params = List.map ~f:(fun _ -> anyref) args; result = [ anyref ] })
+    in
+    let* wrap =
+      register_import ~name:"wrap" (Fun { params = [ anyref ]; result = [ Type.value ] })
+    in
+    let* unwrap =
+      register_import
+        ~name:"unwrap"
+        (Fun { params = [ Type.value ]; result = [ anyref ] })
+    in
+    let* args =
+      expression_list
+        (fun e ->
+          let* e = e in
+          return (W.Call (unwrap, [ e ])))
+        args
+    in
+    return (W.Call (wrap, [ Call (f, args) ]))
+end
+
+let internal_primitives = Hashtbl.create 100
+
+let () =
+  let register name f = Hashtbl.add internal_primitives name f in
+  let module J = Javascript in
+  register "%caml_js_opt_call" (fun transl_prim_arg l ->
+      let arity = List.length l - 2 in
+      let name = Printf.sprintf "call_%d" arity in
+      let* () =
+        register_fragment name (fun () ->
+            let f = Utf8_string.of_string_exn "f" in
+            let o = Utf8_string.of_string_exn "o" in
+            let params =
+              List.init ~len:arity ~f:(fun i ->
+                  Utf8_string.of_string_exn (Printf.sprintf "x%d" i))
+            in
+            EArrow
+              ( J.fun_
+                  (List.map ~f:J.ident (f :: params))
+                  [ ( Return_statement
+                        (Some
+                           (J.call
+                              (J.dot
+                                 (EVar (J.ident f))
+                                 (Utf8_string.of_string_exn "call"))
+                              (List.map ~f:(fun x -> J.EVar (J.ident x)) (o :: params))
+                              N))
+                    , N )
+                  ]
+                  N
+              , AUnknown ))
+      in
+      let l = List.map ~f:transl_prim_arg l in
+      JavaScript.invoke_fragment name l);
+  register "%caml_js_opt_fun_call" (fun transl_prim_arg l ->
+      let arity = List.length l - 1 in
+      let name = Printf.sprintf "fun_call_%d" arity in
+      let* () =
+        register_fragment name (fun () ->
+            let f = Utf8_string.of_string_exn "f" in
+            let params =
+              List.init ~len:arity ~f:(fun i ->
+                  Utf8_string.of_string_exn (Printf.sprintf "x%d" i))
+            in
+            EArrow
+              ( J.fun_
+                  (List.map ~f:J.ident (f :: params))
+                  [ ( Return_statement
+                        (Some
+                           (J.call
+                              (EVar (J.ident f))
+                              (List.map ~f:(fun x -> J.EVar (J.ident x)) params)
+                              N))
+                    , N )
+                  ]
+                  N
+              , AUnknown ))
+      in
+      let l = List.map ~f:transl_prim_arg l in
+      JavaScript.invoke_fragment name l);
+  register "%caml_js_opt_meth_call" (fun transl_prim_arg l ->
+      match l with
+      | o :: Code.Pc (NativeString (Utf meth)) :: args ->
+          let arity = List.length args in
+          let name =
+            let (Utf8 name) = meth in
+            Printf.sprintf "meth_call_%d_%s" arity name
+          in
+          let* () =
+            register_fragment name (fun () ->
+                let o = Utf8_string.of_string_exn "o" in
+                let params =
+                  List.init ~len:arity ~f:(fun i ->
+                      Utf8_string.of_string_exn (Printf.sprintf "x%d" i))
+                in
+                EArrow
+                  ( J.fun_
+                      (List.map ~f:J.ident (o :: params))
+                      [ ( Return_statement
+                            (Some
+                               (J.call
+                                  (J.dot (EVar (J.ident o)) meth)
+                                  (List.map ~f:(fun x -> J.EVar (J.ident x)) params)
+                                  N))
+                        , N )
+                      ]
+                      N
+                  , AUnknown ))
+          in
+          let o = transl_prim_arg o in
+          let args = List.map ~f:transl_prim_arg args in
+          JavaScript.invoke_fragment name (o :: args)
+      | _ -> assert false);
+  register "%caml_js_opt_new" (fun transl_prim_arg l ->
+      let arity = List.length l - 1 in
+      let name = Printf.sprintf "new_%d" arity in
+      let* () =
+        register_fragment name (fun () ->
+            let c = Utf8_string.of_string_exn "c" in
+            let params =
+              List.init ~len:arity ~f:(fun i ->
+                  Utf8_string.of_string_exn (Printf.sprintf "x%d" i))
+            in
+            EArrow
+              ( J.fun_
+                  (List.map ~f:J.ident (c :: params))
+                  [ ( Return_statement
+                        (Some
+                           (ENew
+                              ( EVar (J.ident c)
+                              , Some
+                                  (List.map ~f:(fun x -> J.Arg (EVar (J.ident x))) params)
+                              )))
+                    , N )
+                  ]
+                  N
+              , AUnknown ))
+      in
+      let l = List.map ~f:transl_prim_arg l in
+      JavaScript.invoke_fragment name l)
+
 let externref = W.Ref { nullable = true; typ = Extern }
 
 let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 4133b4c332..4bda507ba6 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -152,399 +152,457 @@ module Generate (Target : Wa_target_sig.S) = struct
     | Prim (Extern "caml_alloc_dummy_infix", _) when Poly.(target = `GC) ->
         Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:1
     | Prim (p, l) -> (
-        let l = List.map ~f:transl_prim_arg l in
-        match p, l with
-        | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.gen_array_get x y
-        | Extern "caml_floatarray_unsafe_get", [ x; y ] -> Memory.float_array_get x y
-        | Extern "caml_array_unsafe_set", [ x; y; z ] ->
-            seq (Memory.gen_array_set x y z) Value.unit
-        | Extern "caml_array_unsafe_set_addr", [ x; y; z ] ->
-            seq (Memory.array_set x y z) Value.unit
-        | Extern "caml_floatarray_unsafe_set", [ x; y; z ] ->
-            seq (Memory.float_array_set x y z) Value.unit
-        | Extern ("caml_string_unsafe_get" | "caml_bytes_unsafe_get"), [ x; y ] ->
-            Memory.bytes_get x y
-        | Extern ("caml_string_unsafe_set" | "caml_bytes_unsafe_set"), [ x; y; z ] ->
-            seq (Memory.bytes_set x y z) Value.unit
-        | Extern ("caml_string_get" | "caml_bytes_get"), [ x; y ] ->
-            seq
-              (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in
-               instr (W.Br_if (label_index context bound_error_pc, cond)))
-              (Memory.bytes_get x y)
-        | Extern ("caml_string_set" | "caml_bytes_set"), [ x; y; z ] ->
-            seq
-              (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in
-               let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
-               Memory.bytes_set x y z)
-              Value.unit
-        | Extern ("caml_ml_string_length" | "caml_ml_bytes_length"), [ x ] ->
-            Value.val_int (Memory.bytes_length x)
-        | Extern "%int_add", [ x; y ] -> Value.int_add x y
-        | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
-        | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
-        | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y
-        | Extern "%int_div", [ x; y ] ->
-            seq
-              (let* cond = Arith.eqz (Value.int_val y) in
-               instr (W.Br_if (label_index context zero_divide_pc, cond)))
-              (Value.int_div x y)
-        | Extern "%int_mod", [ x; y ] ->
-            seq
-              (let* cond = Arith.eqz (Value.int_val y) in
-               instr (W.Br_if (label_index context zero_divide_pc, cond)))
-              (Value.int_mod x y)
-        | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
-        | Extern "%int_neg", [ x ] -> Value.int_neg x
-        | Extern "%int_or", [ x; y ] -> Value.int_or x y
-        | Extern "%int_and", [ x; y ] -> Value.int_and x y
-        | Extern "%int_xor", [ x; y ] -> Value.int_xor x y
-        | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y
-        | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
-        | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
-        | Extern "caml_check_bound", [ x; y ] ->
-            seq
-              (let* cond = Arith.uge (Value.int_val y) (Memory.array_length x) in
-               instr (W.Br_if (label_index context bound_error_pc, cond)))
-              x
-        | Extern "caml_check_bound_gen", [ x; y ] ->
-            seq
-              (let* cond = Arith.uge (Value.int_val y) (Memory.gen_array_length x) in
-               instr (W.Br_if (label_index context bound_error_pc, cond)))
-              x
-        | Extern "caml_check_bound_float", [ x; y ] ->
-            seq
-              (let* cond = Arith.uge (Value.int_val y) (Memory.float_array_length x) in
-               instr (W.Br_if (label_index context bound_error_pc, cond)))
-              x
-        | Extern "caml_add_float", [ f; g ] -> float_bin_op stack_ctx x Add f g
-        | Extern "caml_sub_float", [ f; g ] -> float_bin_op stack_ctx x Sub f g
-        | Extern "caml_mul_float", [ f; g ] -> float_bin_op stack_ctx x Mul f g
-        | Extern "caml_div_float", [ f; g ] -> float_bin_op stack_ctx x Div f g
-        | Extern "caml_copysign_float", [ f; g ] -> float_bin_op stack_ctx x CopySign f g
-        | Extern "caml_signbit_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            let sign = W.BinOp (F64 CopySign, Const (F64 1.), f) in
-            Value.val_int (return (W.BinOp (F64 Lt, sign, Const (F64 0.))))
-        | Extern "caml_neg_float", [ f ] -> float_un_op stack_ctx x Neg f
-        | Extern "caml_abs_float", [ f ] -> float_un_op stack_ctx x Abs f
-        | Extern "caml_ceil_float", [ f ] -> float_un_op stack_ctx x Ceil f
-        | Extern "caml_floor_float", [ f ] -> float_un_op stack_ctx x Floor f
-        | Extern "caml_trunc_float", [ f ] -> float_un_op stack_ctx x Trunc f
-        | Extern "caml_round_float", [ f ] -> float_un_op' stack_ctx x Math.round f
-        | Extern "caml_sqrt_float", [ f ] -> float_un_op stack_ctx x Sqrt f
-        | Extern "caml_eq_float", [ f; g ] -> float_comparison Eq f g
-        | Extern "caml_neq_float", [ f; g ] -> float_comparison Ne f g
-        | Extern "caml_ge_float", [ f; g ] -> float_comparison Ge f g
-        | Extern "caml_le_float", [ f; g ] -> float_comparison Le f g
-        | Extern "caml_gt_float", [ f; g ] -> float_comparison Gt f g
-        | Extern "caml_lt_float", [ f; g ] -> float_comparison Lt f g
-        | Extern "caml_int_of_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            Value.val_int (return (W.UnOp (I32 (TruncSatF64 S), f)))
-        | Extern "caml_float_of_int", [ n ] ->
-            let* n = Value.int_val n in
-            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I32, S)), n)))
-        | Extern "caml_cos_float", [ f ] -> float_un_op' stack_ctx x Math.cos f
-        | Extern "caml_sin_float", [ f ] -> float_un_op' stack_ctx x Math.sin f
-        | Extern "caml_tan_float", [ f ] -> float_un_op' stack_ctx x Math.tan f
-        | Extern "caml_acos_float", [ f ] -> float_un_op' stack_ctx x Math.acos f
-        | Extern "caml_asin_float", [ f ] -> float_un_op' stack_ctx x Math.asin f
-        | Extern "caml_atan_float", [ f ] -> float_un_op' stack_ctx x Math.atan f
-        | Extern "caml_atan2_float", [ f; g ] -> float_bin_op' stack_ctx x Math.atan2 f g
-        | Extern "caml_cosh_float", [ f ] -> float_un_op' stack_ctx x Math.cosh f
-        | Extern "caml_sinh_float", [ f ] -> float_un_op' stack_ctx x Math.sinh f
-        | Extern "caml_tanh_float", [ f ] -> float_un_op' stack_ctx x Math.tanh f
-        | Extern "caml_acosh_float", [ f ] -> float_un_op' stack_ctx x Math.acosh f
-        | Extern "caml_asinh_float", [ f ] -> float_un_op' stack_ctx x Math.asinh f
-        | Extern "caml_atanh_float", [ f ] -> float_un_op' stack_ctx x Math.atanh f
-        | Extern "caml_cbrt_float", [ f ] -> float_un_op' stack_ctx x Math.cbrt f
-        | Extern "caml_exp_float", [ f ] -> float_un_op' stack_ctx x Math.exp f
-        | Extern "caml_exp2_float", [ f ] -> float_un_op' stack_ctx x Math.exp2 f
-        | Extern "caml_log_float", [ f ] -> float_un_op' stack_ctx x Math.log f
-        | Extern "caml_expm1_float", [ f ] -> float_un_op' stack_ctx x Math.expm1 f
-        | Extern "caml_log1p_float", [ f ] -> float_un_op' stack_ctx x Math.log1p f
-        | Extern "caml_log2_float", [ f ] -> float_un_op' stack_ctx x Math.log2 f
-        | Extern "caml_log10_float", [ f ] -> float_un_op' stack_ctx x Math.log10 f
-        | Extern "caml_power_float", [ f; g ] -> float_bin_op' stack_ctx x Math.power f g
-        | Extern "caml_hypot_float", [ f; g ] -> float_bin_op' stack_ctx x Math.hypot f g
-        | Extern "caml_fmod_float", [ f; g ] -> float_bin_op' stack_ctx x Math.fmod f g
-        | Extern "caml_int32_bits_of_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            Memory.box_int32
-              stack_ctx
-              x
-              (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
-        | Extern "caml_int32_float_of_bits", [ i ] ->
-            let* i = Memory.unbox_int64 i in
-            Memory.box_float
-              stack_ctx
-              x
-              (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
-        | Extern "caml_int32_of_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            Memory.box_int32 stack_ctx x (return (W.UnOp (I32 (TruncSatF64 S), f)))
-        | Extern "caml_int32_to_float", [ n ] ->
-            let* n = Memory.unbox_int32 n in
-            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I32, S)), n)))
-        | Extern "caml_int32_neg", [ i ] ->
-            let* i = Memory.unbox_int32 i in
-            Memory.box_int32 stack_ctx x (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
-        | Extern "caml_int32_add", [ i; j ] -> int32_bin_op stack_ctx x Add i j
-        | Extern "caml_int32_sub", [ i; j ] -> int32_bin_op stack_ctx x Sub i j
-        | Extern "caml_int32_mul", [ i; j ] -> int32_bin_op stack_ctx x Mul i j
-        | Extern "caml_int32_and", [ i; j ] -> int32_bin_op stack_ctx x And i j
-        | Extern "caml_int32_or", [ i; j ] -> int32_bin_op stack_ctx x Or i j
-        | Extern "caml_int32_xor", [ i; j ] -> int32_bin_op stack_ctx x Xor i j
-        | Extern "caml_int32_div", [ i; j ] ->
-            let res = Var.fresh () in
-            (*ZZZ Can we do better?*)
-            let i' = Var.fresh () in
-            let j' = Var.fresh () in
-            seq
-              (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
-               let* () =
-                 let* j = load j' in
-                 instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))
-               in
-               let* () = store ~typ:I32 i' (Memory.unbox_int32 i) in
-               if_
-                 { params = []; result = [] }
-                 Arith.(
-                   (let* j = load j' in
-                    return (W.BinOp (I32 Eq, j, Const (I32 (-1l)))))
-                   land let* i = load i' in
-                        return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int))))
-                 (store ~always:true ~typ:I32 res (return (W.Const (I32 Int32.min_int))))
-                 (store
-                    ~always:true
-                    ~typ:I32
-                    res
-                    (let* i = load i' in
+        match p with
+        | Extern name when Hashtbl.mem internal_primitives name ->
+            Hashtbl.find internal_primitives name transl_prim_arg l
+        | _ -> (
+            let l = List.map ~f:transl_prim_arg l in
+            match p, l with
+            | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.gen_array_get x y
+            | Extern "caml_floatarray_unsafe_get", [ x; y ] -> Memory.float_array_get x y
+            | Extern "caml_array_unsafe_set", [ x; y; z ] ->
+                seq (Memory.gen_array_set x y z) Value.unit
+            | Extern "caml_array_unsafe_set_addr", [ x; y; z ] ->
+                seq (Memory.array_set x y z) Value.unit
+            | Extern "caml_floatarray_unsafe_set", [ x; y; z ] ->
+                seq (Memory.float_array_set x y z) Value.unit
+            | Extern ("caml_string_unsafe_get" | "caml_bytes_unsafe_get"), [ x; y ] ->
+                Memory.bytes_get x y
+            | Extern ("caml_string_unsafe_set" | "caml_bytes_unsafe_set"), [ x; y; z ] ->
+                seq (Memory.bytes_set x y z) Value.unit
+            | Extern ("caml_string_get" | "caml_bytes_get"), [ x; y ] ->
+                seq
+                  (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in
+                   instr (W.Br_if (label_index context bound_error_pc, cond)))
+                  (Memory.bytes_get x y)
+            | Extern ("caml_string_set" | "caml_bytes_set"), [ x; y; z ] ->
+                seq
+                  (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in
+                   let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
+                   Memory.bytes_set x y z)
+                  Value.unit
+            | Extern ("caml_ml_string_length" | "caml_ml_bytes_length"), [ x ] ->
+                Value.val_int (Memory.bytes_length x)
+            | Extern "%int_add", [ x; y ] -> Value.int_add x y
+            | Extern "%int_sub", [ x; y ] -> Value.int_sub x y
+            | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y
+            | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y
+            | Extern "%int_div", [ x; y ] ->
+                seq
+                  (let* cond = Arith.eqz (Value.int_val y) in
+                   instr (W.Br_if (label_index context zero_divide_pc, cond)))
+                  (Value.int_div x y)
+            | Extern "%int_mod", [ x; y ] ->
+                seq
+                  (let* cond = Arith.eqz (Value.int_val y) in
+                   instr (W.Br_if (label_index context zero_divide_pc, cond)))
+                  (Value.int_mod x y)
+            | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y
+            | Extern "%int_neg", [ x ] -> Value.int_neg x
+            | Extern "%int_or", [ x; y ] -> Value.int_or x y
+            | Extern "%int_and", [ x; y ] -> Value.int_and x y
+            | Extern "%int_xor", [ x; y ] -> Value.int_xor x y
+            | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y
+            | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
+            | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
+            | Extern "caml_check_bound", [ x; y ] ->
+                seq
+                  (let* cond = Arith.uge (Value.int_val y) (Memory.array_length x) in
+                   instr (W.Br_if (label_index context bound_error_pc, cond)))
+                  x
+            | Extern "caml_check_bound_gen", [ x; y ] ->
+                seq
+                  (let* cond = Arith.uge (Value.int_val y) (Memory.gen_array_length x) in
+                   instr (W.Br_if (label_index context bound_error_pc, cond)))
+                  x
+            | Extern "caml_check_bound_float", [ x; y ] ->
+                seq
+                  (let* cond =
+                     Arith.uge (Value.int_val y) (Memory.float_array_length x)
+                   in
+                   instr (W.Br_if (label_index context bound_error_pc, cond)))
+                  x
+            | Extern "caml_add_float", [ f; g ] -> float_bin_op stack_ctx x Add f g
+            | Extern "caml_sub_float", [ f; g ] -> float_bin_op stack_ctx x Sub f g
+            | Extern "caml_mul_float", [ f; g ] -> float_bin_op stack_ctx x Mul f g
+            | Extern "caml_div_float", [ f; g ] -> float_bin_op stack_ctx x Div f g
+            | Extern "caml_copysign_float", [ f; g ] ->
+                float_bin_op stack_ctx x CopySign f g
+            | Extern "caml_signbit_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                let sign = W.BinOp (F64 CopySign, Const (F64 1.), f) in
+                Value.val_int (return (W.BinOp (F64 Lt, sign, Const (F64 0.))))
+            | Extern "caml_neg_float", [ f ] -> float_un_op stack_ctx x Neg f
+            | Extern "caml_abs_float", [ f ] -> float_un_op stack_ctx x Abs f
+            | Extern "caml_ceil_float", [ f ] -> float_un_op stack_ctx x Ceil f
+            | Extern "caml_floor_float", [ f ] -> float_un_op stack_ctx x Floor f
+            | Extern "caml_trunc_float", [ f ] -> float_un_op stack_ctx x Trunc f
+            | Extern "caml_round_float", [ f ] -> float_un_op' stack_ctx x Math.round f
+            | Extern "caml_sqrt_float", [ f ] -> float_un_op stack_ctx x Sqrt f
+            | Extern "caml_eq_float", [ f; g ] -> float_comparison Eq f g
+            | Extern "caml_neq_float", [ f; g ] -> float_comparison Ne f g
+            | Extern "caml_ge_float", [ f; g ] -> float_comparison Ge f g
+            | Extern "caml_le_float", [ f; g ] -> float_comparison Le f g
+            | Extern "caml_gt_float", [ f; g ] -> float_comparison Gt f g
+            | Extern "caml_lt_float", [ f; g ] -> float_comparison Lt f g
+            | Extern "caml_int_of_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                Value.val_int (return (W.UnOp (I32 (TruncSatF64 S), f)))
+            | Extern "caml_float_of_int", [ n ] ->
+                let* n = Value.int_val n in
+                Memory.box_float
+                  stack_ctx
+                  x
+                  (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+            | Extern "caml_cos_float", [ f ] -> float_un_op' stack_ctx x Math.cos f
+            | Extern "caml_sin_float", [ f ] -> float_un_op' stack_ctx x Math.sin f
+            | Extern "caml_tan_float", [ f ] -> float_un_op' stack_ctx x Math.tan f
+            | Extern "caml_acos_float", [ f ] -> float_un_op' stack_ctx x Math.acos f
+            | Extern "caml_asin_float", [ f ] -> float_un_op' stack_ctx x Math.asin f
+            | Extern "caml_atan_float", [ f ] -> float_un_op' stack_ctx x Math.atan f
+            | Extern "caml_atan2_float", [ f; g ] ->
+                float_bin_op' stack_ctx x Math.atan2 f g
+            | Extern "caml_cosh_float", [ f ] -> float_un_op' stack_ctx x Math.cosh f
+            | Extern "caml_sinh_float", [ f ] -> float_un_op' stack_ctx x Math.sinh f
+            | Extern "caml_tanh_float", [ f ] -> float_un_op' stack_ctx x Math.tanh f
+            | Extern "caml_acosh_float", [ f ] -> float_un_op' stack_ctx x Math.acosh f
+            | Extern "caml_asinh_float", [ f ] -> float_un_op' stack_ctx x Math.asinh f
+            | Extern "caml_atanh_float", [ f ] -> float_un_op' stack_ctx x Math.atanh f
+            | Extern "caml_cbrt_float", [ f ] -> float_un_op' stack_ctx x Math.cbrt f
+            | Extern "caml_exp_float", [ f ] -> float_un_op' stack_ctx x Math.exp f
+            | Extern "caml_exp2_float", [ f ] -> float_un_op' stack_ctx x Math.exp2 f
+            | Extern "caml_log_float", [ f ] -> float_un_op' stack_ctx x Math.log f
+            | Extern "caml_expm1_float", [ f ] -> float_un_op' stack_ctx x Math.expm1 f
+            | Extern "caml_log1p_float", [ f ] -> float_un_op' stack_ctx x Math.log1p f
+            | Extern "caml_log2_float", [ f ] -> float_un_op' stack_ctx x Math.log2 f
+            | Extern "caml_log10_float", [ f ] -> float_un_op' stack_ctx x Math.log10 f
+            | Extern "caml_power_float", [ f; g ] ->
+                float_bin_op' stack_ctx x Math.power f g
+            | Extern "caml_hypot_float", [ f; g ] ->
+                float_bin_op' stack_ctx x Math.hypot f g
+            | Extern "caml_fmod_float", [ f; g ] ->
+                float_bin_op' stack_ctx x Math.fmod f g
+            | Extern "caml_int32_bits_of_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                Memory.box_int32
+                  stack_ctx
+                  x
+                  (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
+            | Extern "caml_int32_float_of_bits", [ i ] ->
+                let* i = Memory.unbox_int64 i in
+                Memory.box_float
+                  stack_ctx
+                  x
+                  (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
+            | Extern "caml_int32_of_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                Memory.box_int32 stack_ctx x (return (W.UnOp (I32 (TruncSatF64 S), f)))
+            | Extern "caml_int32_to_float", [ n ] ->
+                let* n = Memory.unbox_int32 n in
+                Memory.box_float
+                  stack_ctx
+                  x
+                  (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+            | Extern "caml_int32_neg", [ i ] ->
+                let* i = Memory.unbox_int32 i in
+                Memory.box_int32
+                  stack_ctx
+                  x
+                  (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
+            | Extern "caml_int32_add", [ i; j ] -> int32_bin_op stack_ctx x Add i j
+            | Extern "caml_int32_sub", [ i; j ] -> int32_bin_op stack_ctx x Sub i j
+            | Extern "caml_int32_mul", [ i; j ] -> int32_bin_op stack_ctx x Mul i j
+            | Extern "caml_int32_and", [ i; j ] -> int32_bin_op stack_ctx x And i j
+            | Extern "caml_int32_or", [ i; j ] -> int32_bin_op stack_ctx x Or i j
+            | Extern "caml_int32_xor", [ i; j ] -> int32_bin_op stack_ctx x Xor i j
+            | Extern "caml_int32_div", [ i; j ] ->
+                let res = Var.fresh () in
+                (*ZZZ Can we do better?*)
+                let i' = Var.fresh () in
+                let j' = Var.fresh () in
+                seq
+                  (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
+                   let* () =
                      let* j = load j' in
-                     return (W.BinOp (I32 (Div S), i, j)))))
-              (Memory.box_int32 stack_ctx x (load res))
-        | Extern "caml_int32_mod", [ i; j ] ->
-            let j' = Var.fresh () in
-            seq
-              (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
-               let* j = load j' in
-               instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
-              (let* i = Memory.unbox_int32 i in
-               let* j = load j' in
-               Memory.box_int32 stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
-        | Extern "caml_int32_shift_left", [ i; j ] -> int32_shift_op stack_ctx x Shl i j
-        | Extern "caml_int32_shift_right", [ i; j ] ->
-            int32_shift_op stack_ctx x (Shr S) i j
-        | Extern "caml_int32_shift_right_unsigned", [ i; j ] ->
-            int32_shift_op stack_ctx x (Shr U) i j
-        | Extern "caml_int32_to_int", [ i ] -> Value.val_int (Memory.unbox_int32 i)
-        | Extern "caml_int32_of_int", [ i ] ->
-            Memory.box_int32 stack_ctx x (Value.int_val i)
-        | Extern "caml_int64_bits_of_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            Memory.box_int64 stack_ctx x (return (W.UnOp (I64 ReinterpretF, f)))
-        | Extern "caml_int64_float_of_bits", [ i ] ->
-            let* i = Memory.unbox_int64 i in
-            Memory.box_float stack_ctx x (return (W.UnOp (F64 ReinterpretI, i)))
-        | Extern "caml_int64_of_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            Memory.box_int64 stack_ctx x (return (W.UnOp (I64 (TruncSatF64 S), f)))
-        | Extern "caml_int64_to_float", [ n ] ->
-            let* n = Memory.unbox_int64 n in
-            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I64, S)), n)))
-        | Extern "caml_int64_neg", [ i ] ->
-            let* i = Memory.unbox_int64 i in
-            Memory.box_int64 stack_ctx x (return (W.BinOp (I64 Sub, Const (I64 0L), i)))
-        | Extern "caml_int64_add", [ i; j ] -> int64_bin_op stack_ctx x Add i j
-        | Extern "caml_int64_sub", [ i; j ] -> int64_bin_op stack_ctx x Sub i j
-        | Extern "caml_int64_mul", [ i; j ] -> int64_bin_op stack_ctx x Mul i j
-        | Extern "caml_int64_and", [ i; j ] -> int64_bin_op stack_ctx x And i j
-        | Extern "caml_int64_or", [ i; j ] -> int64_bin_op stack_ctx x Or i j
-        | Extern "caml_int64_xor", [ i; j ] -> int64_bin_op stack_ctx x Xor i j
-        | Extern "caml_int64_div", [ i; j ] ->
-            let res = Var.fresh () in
-            (*ZZZ Can we do better?*)
-            let i' = Var.fresh () in
-            let j' = Var.fresh () in
-            seq
-              (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
-               let* () =
-                 let* j = load j' in
-                 instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j)))
-               in
-               let* () = store ~typ:I64 i' (Memory.unbox_int64 i) in
-               if_
-                 { params = []; result = [] }
-                 Arith.(
-                   (let* j = load j' in
-                    return (W.BinOp (I64 Eq, j, Const (I64 (-1L)))))
-                   land let* i = load i' in
-                        return (W.BinOp (I64 Eq, i, Const (I64 Int64.min_int))))
-                 (store ~always:true ~typ:I64 res (return (W.Const (I64 Int64.min_int))))
-                 (store
-                    ~always:true
-                    ~typ:I64
-                    res
-                    (let* i = load i' in
+                     instr
+                       (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))
+                   in
+                   let* () = store ~typ:I32 i' (Memory.unbox_int32 i) in
+                   if_
+                     { params = []; result = [] }
+                     Arith.(
+                       (let* j = load j' in
+                        return (W.BinOp (I32 Eq, j, Const (I32 (-1l)))))
+                       land let* i = load i' in
+                            return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int))))
+                     (store
+                        ~always:true
+                        ~typ:I32
+                        res
+                        (return (W.Const (I32 Int32.min_int))))
+                     (store
+                        ~always:true
+                        ~typ:I32
+                        res
+                        (let* i = load i' in
+                         let* j = load j' in
+                         return (W.BinOp (I32 (Div S), i, j)))))
+                  (Memory.box_int32 stack_ctx x (load res))
+            | Extern "caml_int32_mod", [ i; j ] ->
+                let j' = Var.fresh () in
+                seq
+                  (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in
+                   let* j = load j' in
+                   instr
+                     (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
+                  (let* i = Memory.unbox_int32 i in
+                   let* j = load j' in
+                   Memory.box_int32 stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
+            | Extern "caml_int32_shift_left", [ i; j ] ->
+                int32_shift_op stack_ctx x Shl i j
+            | Extern "caml_int32_shift_right", [ i; j ] ->
+                int32_shift_op stack_ctx x (Shr S) i j
+            | Extern "caml_int32_shift_right_unsigned", [ i; j ] ->
+                int32_shift_op stack_ctx x (Shr U) i j
+            | Extern "caml_int32_to_int", [ i ] -> Value.val_int (Memory.unbox_int32 i)
+            | Extern "caml_int32_of_int", [ i ] ->
+                Memory.box_int32 stack_ctx x (Value.int_val i)
+            | Extern "caml_int64_bits_of_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                Memory.box_int64 stack_ctx x (return (W.UnOp (I64 ReinterpretF, f)))
+            | Extern "caml_int64_float_of_bits", [ i ] ->
+                let* i = Memory.unbox_int64 i in
+                Memory.box_float stack_ctx x (return (W.UnOp (F64 ReinterpretI, i)))
+            | Extern "caml_int64_of_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                Memory.box_int64 stack_ctx x (return (W.UnOp (I64 (TruncSatF64 S), f)))
+            | Extern "caml_int64_to_float", [ n ] ->
+                let* n = Memory.unbox_int64 n in
+                Memory.box_float
+                  stack_ctx
+                  x
+                  (return (W.UnOp (F64 (Convert (`I64, S)), n)))
+            | Extern "caml_int64_neg", [ i ] ->
+                let* i = Memory.unbox_int64 i in
+                Memory.box_int64
+                  stack_ctx
+                  x
+                  (return (W.BinOp (I64 Sub, Const (I64 0L), i)))
+            | Extern "caml_int64_add", [ i; j ] -> int64_bin_op stack_ctx x Add i j
+            | Extern "caml_int64_sub", [ i; j ] -> int64_bin_op stack_ctx x Sub i j
+            | Extern "caml_int64_mul", [ i; j ] -> int64_bin_op stack_ctx x Mul i j
+            | Extern "caml_int64_and", [ i; j ] -> int64_bin_op stack_ctx x And i j
+            | Extern "caml_int64_or", [ i; j ] -> int64_bin_op stack_ctx x Or i j
+            | Extern "caml_int64_xor", [ i; j ] -> int64_bin_op stack_ctx x Xor i j
+            | Extern "caml_int64_div", [ i; j ] ->
+                let res = Var.fresh () in
+                (*ZZZ Can we do better?*)
+                let i' = Var.fresh () in
+                let j' = Var.fresh () in
+                seq
+                  (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
+                   let* () =
                      let* j = load j' in
-                     return (W.BinOp (I64 (Div S), i, j)))))
-              (Memory.box_int64 stack_ctx x (load res))
-        | Extern "caml_int64_mod", [ i; j ] ->
-            let j' = Var.fresh () in
-            seq
-              (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
-               let* j = load j' in
-               instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j))))
-              (let* i = Memory.unbox_int64 i in
-               let* j = load j' in
-               Memory.box_int64 stack_ctx x (return (W.BinOp (I64 (Rem S), i, j))))
-        | Extern "caml_int64_shift_left", [ i; j ] -> int64_shift_op stack_ctx x Shl i j
-        | Extern "caml_int64_shift_right", [ i; j ] ->
-            int64_shift_op stack_ctx x (Shr S) i j
-        | Extern "caml_int64_shift_right_unsigned", [ i; j ] ->
-            int64_shift_op stack_ctx x (Shr U) i j
-        | Extern "caml_int64_to_int", [ i ] ->
-            let* i = Memory.unbox_int64 i in
-            Value.val_int (return (W.I32WrapI64 i))
-        | Extern "caml_int64_of_int", [ i ] ->
-            let* i = Value.int_val i in
-            Memory.box_int64
-              stack_ctx
-              x
-              (return
-                 (match i with
-                 | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i))
-                 | _ -> W.I64ExtendI32 (S, i)))
-        | Extern "caml_int64_to_int32", [ i ] ->
-            let* i = Memory.unbox_int64 i in
-            Memory.box_int32 stack_ctx x (return (W.I32WrapI64 i))
-        | Extern "caml_int64_of_int32", [ i ] ->
-            let* i = Memory.unbox_int32 i in
-            Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
-        | Extern "caml_int64_to_nativeint", [ i ] ->
-            let* i = Memory.unbox_int64 i in
-            Memory.box_nativeint stack_ctx x (return (W.I32WrapI64 i))
-        | Extern "caml_int64_of_nativeint", [ i ] ->
-            let* i = Memory.unbox_nativeint i in
-            Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
-        | Extern "caml_nativeint_bits_of_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            Memory.box_nativeint
-              stack_ctx
-              x
-              (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
-        | Extern "caml_nativeint_float_of_bits", [ i ] ->
-            let* i = Memory.unbox_int64 i in
-            Memory.box_float
-              stack_ctx
-              x
-              (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
-        | Extern "caml_nativeint_of_float", [ f ] ->
-            let* f = Memory.unbox_float f in
-            Memory.box_nativeint stack_ctx x (return (W.UnOp (I32 (TruncSatF64 S), f)))
-        | Extern "caml_nativeint_to_float", [ n ] ->
-            let* n = Memory.unbox_nativeint n in
-            Memory.box_float stack_ctx x (return (W.UnOp (F64 (Convert (`I32, S)), n)))
-        | Extern "caml_nativeint_neg", [ i ] ->
-            let* i = Memory.unbox_nativeint i in
-            Memory.box_nativeint
-              stack_ctx
-              x
-              (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
-        | Extern "caml_nativeint_add", [ i; j ] -> nativeint_bin_op stack_ctx x Add i j
-        | Extern "caml_nativeint_sub", [ i; j ] -> nativeint_bin_op stack_ctx x Sub i j
-        | Extern "caml_nativeint_mul", [ i; j ] -> nativeint_bin_op stack_ctx x Mul i j
-        | Extern "caml_nativeint_and", [ i; j ] -> nativeint_bin_op stack_ctx x And i j
-        | Extern "caml_nativeint_or", [ i; j ] -> nativeint_bin_op stack_ctx x Or i j
-        | Extern "caml_nativeint_xor", [ i; j ] -> nativeint_bin_op stack_ctx x Xor i j
-        | Extern "caml_nativeint_div", [ i; j ] ->
-            let res = Var.fresh () in
-            (*ZZZ Can we do better?*)
-            let i' = Var.fresh () in
-            let j' = Var.fresh () in
-            seq
-              (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
-               let* () =
-                 let* j = load j' in
-                 instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))
-               in
-               let* () = store ~typ:I32 i' (Memory.unbox_nativeint i) in
-               if_
-                 { params = []; result = [] }
-                 Arith.(
-                   (let* j = load j' in
-                    return (W.BinOp (I32 Eq, j, Const (I32 (-1l)))))
-                   land let* i = load i' in
-                        return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int))))
-                 (store ~always:true ~typ:I32 res (return (W.Const (I32 Int32.min_int))))
-                 (store
-                    ~always:true
-                    ~typ:I32
-                    res
-                    (let* i = load i' in
+                     instr
+                       (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j)))
+                   in
+                   let* () = store ~typ:I64 i' (Memory.unbox_int64 i) in
+                   if_
+                     { params = []; result = [] }
+                     Arith.(
+                       (let* j = load j' in
+                        return (W.BinOp (I64 Eq, j, Const (I64 (-1L)))))
+                       land let* i = load i' in
+                            return (W.BinOp (I64 Eq, i, Const (I64 Int64.min_int))))
+                     (store
+                        ~always:true
+                        ~typ:I64
+                        res
+                        (return (W.Const (I64 Int64.min_int))))
+                     (store
+                        ~always:true
+                        ~typ:I64
+                        res
+                        (let* i = load i' in
+                         let* j = load j' in
+                         return (W.BinOp (I64 (Div S), i, j)))))
+                  (Memory.box_int64 stack_ctx x (load res))
+            | Extern "caml_int64_mod", [ i; j ] ->
+                let j' = Var.fresh () in
+                seq
+                  (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in
+                   let* j = load j' in
+                   instr
+                     (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j))))
+                  (let* i = Memory.unbox_int64 i in
+                   let* j = load j' in
+                   Memory.box_int64 stack_ctx x (return (W.BinOp (I64 (Rem S), i, j))))
+            | Extern "caml_int64_shift_left", [ i; j ] ->
+                int64_shift_op stack_ctx x Shl i j
+            | Extern "caml_int64_shift_right", [ i; j ] ->
+                int64_shift_op stack_ctx x (Shr S) i j
+            | Extern "caml_int64_shift_right_unsigned", [ i; j ] ->
+                int64_shift_op stack_ctx x (Shr U) i j
+            | Extern "caml_int64_to_int", [ i ] ->
+                let* i = Memory.unbox_int64 i in
+                Value.val_int (return (W.I32WrapI64 i))
+            | Extern "caml_int64_of_int", [ i ] ->
+                let* i = Value.int_val i in
+                Memory.box_int64
+                  stack_ctx
+                  x
+                  (return
+                     (match i with
+                     | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i))
+                     | _ -> W.I64ExtendI32 (S, i)))
+            | Extern "caml_int64_to_int32", [ i ] ->
+                let* i = Memory.unbox_int64 i in
+                Memory.box_int32 stack_ctx x (return (W.I32WrapI64 i))
+            | Extern "caml_int64_of_int32", [ i ] ->
+                let* i = Memory.unbox_int32 i in
+                Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
+            | Extern "caml_int64_to_nativeint", [ i ] ->
+                let* i = Memory.unbox_int64 i in
+                Memory.box_nativeint stack_ctx x (return (W.I32WrapI64 i))
+            | Extern "caml_int64_of_nativeint", [ i ] ->
+                let* i = Memory.unbox_nativeint i in
+                Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
+            | Extern "caml_nativeint_bits_of_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                Memory.box_nativeint
+                  stack_ctx
+                  x
+                  (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
+            | Extern "caml_nativeint_float_of_bits", [ i ] ->
+                let* i = Memory.unbox_int64 i in
+                Memory.box_float
+                  stack_ctx
+                  x
+                  (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
+            | Extern "caml_nativeint_of_float", [ f ] ->
+                let* f = Memory.unbox_float f in
+                Memory.box_nativeint
+                  stack_ctx
+                  x
+                  (return (W.UnOp (I32 (TruncSatF64 S), f)))
+            | Extern "caml_nativeint_to_float", [ n ] ->
+                let* n = Memory.unbox_nativeint n in
+                Memory.box_float
+                  stack_ctx
+                  x
+                  (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+            | Extern "caml_nativeint_neg", [ i ] ->
+                let* i = Memory.unbox_nativeint i in
+                Memory.box_nativeint
+                  stack_ctx
+                  x
+                  (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
+            | Extern "caml_nativeint_add", [ i; j ] ->
+                nativeint_bin_op stack_ctx x Add i j
+            | Extern "caml_nativeint_sub", [ i; j ] ->
+                nativeint_bin_op stack_ctx x Sub i j
+            | Extern "caml_nativeint_mul", [ i; j ] ->
+                nativeint_bin_op stack_ctx x Mul i j
+            | Extern "caml_nativeint_and", [ i; j ] ->
+                nativeint_bin_op stack_ctx x And i j
+            | Extern "caml_nativeint_or", [ i; j ] -> nativeint_bin_op stack_ctx x Or i j
+            | Extern "caml_nativeint_xor", [ i; j ] ->
+                nativeint_bin_op stack_ctx x Xor i j
+            | Extern "caml_nativeint_div", [ i; j ] ->
+                let res = Var.fresh () in
+                (*ZZZ Can we do better?*)
+                let i' = Var.fresh () in
+                let j' = Var.fresh () in
+                seq
+                  (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
+                   let* () =
                      let* j = load j' in
-                     return (W.BinOp (I32 (Div S), i, j)))))
-              (Memory.box_nativeint stack_ctx x (load res))
-        | Extern "caml_nativeint_mod", [ i; j ] ->
-            let j' = Var.fresh () in
-            seq
-              (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
-               let* j = load j' in
-               instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
-              (let* i = Memory.unbox_nativeint i in
-               let* j = load j' in
-               Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
-        | Extern "caml_nativeint_shift_left", [ i; j ] ->
-            nativeint_shift_op stack_ctx x Shl i j
-        | Extern "caml_nativeint_shift_right", [ i; j ] ->
-            nativeint_shift_op stack_ctx x (Shr S) i j
-        | Extern "caml_nativeint_shift_right_unsigned", [ i; j ] ->
-            nativeint_shift_op stack_ctx x (Shr U) i j
-        | Extern "caml_nativeint_to_int", [ i ] ->
-            Value.val_int (Memory.unbox_nativeint i)
-        | Extern "caml_nativeint_of_int", [ i ] ->
-            Memory.box_nativeint stack_ctx x (Value.int_val i)
-        | Extern "caml_int_compare", [ i; j ] ->
-            Value.val_int
-              Arith.(
-                (Value.int_val j < Value.int_val i) - (Value.int_val i < Value.int_val j))
-        | Extern "%js_array", l ->
-            let* l =
-              List.fold_right
-                ~f:(fun x acc ->
-                  let* x = x in
-                  let* acc = acc in
-                  return (`Expr x :: acc))
-                l
-                ~init:(return [])
-            in
-            Memory.allocate stack_ctx x ~tag:0 l
-        | Extern name, l ->
-            let name = Primitive.resolve name in
-            (*ZZZ Different calling convention when large number of parameters *)
-            let* f = register_import ~name (Fun (func_type (List.length l))) in
-            let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-            let rec loop acc l =
-              match l with
-              | [] ->
-                  Stack.kill_variables stack_ctx;
-                  return (W.Call (f, List.rev acc))
-              | x :: r ->
-                  let* x = x in
-                  loop (x :: acc) r
-            in
-            loop [] l
-        | Not, [ x ] -> Value.not x
-        | Lt, [ x; y ] -> Value.lt x y
-        | Le, [ x; y ] -> Value.le x y
-        | Eq, [ x; y ] -> Value.eq x y
-        | Neq, [ x; y ] -> Value.neq x y
-        | Ult, [ x; y ] -> Value.ult x y
-        | Array_get, [ x; y ] -> Memory.array_get x y
-        | IsInt, [ x ] -> Value.is_int x
-        | Vectlength, [ x ] -> Value.val_int (Memory.gen_array_length x)
-        | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
-            assert false)
+                     instr
+                       (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))
+                   in
+                   let* () = store ~typ:I32 i' (Memory.unbox_nativeint i) in
+                   if_
+                     { params = []; result = [] }
+                     Arith.(
+                       (let* j = load j' in
+                        return (W.BinOp (I32 Eq, j, Const (I32 (-1l)))))
+                       land let* i = load i' in
+                            return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int))))
+                     (store
+                        ~always:true
+                        ~typ:I32
+                        res
+                        (return (W.Const (I32 Int32.min_int))))
+                     (store
+                        ~always:true
+                        ~typ:I32
+                        res
+                        (let* i = load i' in
+                         let* j = load j' in
+                         return (W.BinOp (I32 (Div S), i, j)))))
+                  (Memory.box_nativeint stack_ctx x (load res))
+            | Extern "caml_nativeint_mod", [ i; j ] ->
+                let j' = Var.fresh () in
+                seq
+                  (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in
+                   let* j = load j' in
+                   instr
+                     (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
+                  (let* i = Memory.unbox_nativeint i in
+                   let* j = load j' in
+                   Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
+            | Extern "caml_nativeint_shift_left", [ i; j ] ->
+                nativeint_shift_op stack_ctx x Shl i j
+            | Extern "caml_nativeint_shift_right", [ i; j ] ->
+                nativeint_shift_op stack_ctx x (Shr S) i j
+            | Extern "caml_nativeint_shift_right_unsigned", [ i; j ] ->
+                nativeint_shift_op stack_ctx x (Shr U) i j
+            | Extern "caml_nativeint_to_int", [ i ] ->
+                Value.val_int (Memory.unbox_nativeint i)
+            | Extern "caml_nativeint_of_int", [ i ] ->
+                Memory.box_nativeint stack_ctx x (Value.int_val i)
+            | Extern "caml_int_compare", [ i; j ] ->
+                Value.val_int
+                  Arith.(
+                    (Value.int_val j < Value.int_val i)
+                    - (Value.int_val i < Value.int_val j))
+            | Extern "%js_array", l ->
+                let* l =
+                  List.fold_right
+                    ~f:(fun x acc ->
+                      let* x = x in
+                      let* acc = acc in
+                      return (`Expr x :: acc))
+                    l
+                    ~init:(return [])
+                in
+                Memory.allocate stack_ctx x ~tag:0 l
+            | Extern name, l ->
+                let name = Primitive.resolve name in
+                (*ZZZ Different calling convention when large number of parameters *)
+                let* f = register_import ~name (Fun (func_type (List.length l))) in
+                let* () = Stack.perform_spilling stack_ctx (`Instr x) in
+                let rec loop acc l =
+                  match l with
+                  | [] ->
+                      Stack.kill_variables stack_ctx;
+                      return (W.Call (f, List.rev acc))
+                  | x :: r ->
+                      let* x = x in
+                      loop (x :: acc) r
+                in
+                loop [] l
+            | Not, [ x ] -> Value.not x
+            | Lt, [ x; y ] -> Value.lt x y
+            | Le, [ x; y ] -> Value.le x y
+            | Eq, [ x; y ] -> Value.eq x y
+            | Neq, [ x; y ] -> Value.neq x y
+            | Ult, [ x; y ] -> Value.ult x y
+            | Array_get, [ x; y ] -> Memory.array_get x y
+            | IsInt, [ x ] -> Value.is_int x
+            | Vectlength, [ x ] -> Value.val_int (Memory.gen_array_length x)
+            | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
+                assert false))
 
   and translate_instr ctx stack_ctx context (i, _) =
     match i with
@@ -992,7 +1050,8 @@ module Generate (Target : Wa_target_sig.S) = struct
     ( List.rev_append
         ctx.global_context.other_fields
         (imports @ functions @ (start_function :: constant_data))
-    , List.rev ctx.global_context.strings )
+    , ( List.rev ctx.global_context.strings
+      , StringMap.bindings ctx.global_context.fragments ) )
 end
 
 let init () =
@@ -1053,11 +1112,11 @@ let f ch (p : Code.program) ~live_vars ~in_cps =
   match target with
   | `Core ->
       let module G = Generate (Wa_core_target) in
-      let fields, strings = G.f ~live_vars ~in_cps p in
+      let fields, js_code = G.f ~live_vars ~in_cps p in
       Wa_asm_output.f ch fields;
-      strings
+      js_code
   | `GC ->
       let module G = Generate (Wa_gc_target) in
-      let fields, strings = G.f ~live_vars ~in_cps p in
+      let fields, js_code = G.f ~live_vars ~in_cps p in
       Wa_wat_output.f ch fields;
-      strings
+      js_code
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index f040ba50d5..a5138ea823 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -5,4 +5,4 @@ val f :
   -> Code.program
   -> live_vars:int array
   -> in_cps:Effects.in_cps
-  -> string list
+  -> string list * (string * Javascript.expression) list
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 12758f5244..ee43e854a2 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -276,6 +276,9 @@ module type S = sig
     val round : expression -> expression
   end
 
+  val internal_primitives :
+    (string, (Code.prim_arg -> expression) -> Code.prim_arg list -> expression) Hashtbl.t
+
   val handle_exceptions :
        result_typ:Wa_ast.value_type list
     -> fall_through:'a
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 8347936117..f72a649a5c 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,4 +1,4 @@
-(async function (eval_function, js, strings) {
+(async function (eval_function, js, strings, fragments) {
     "use strict";
     const src = 'CODE';
     function loadRelative(src) {
@@ -345,7 +345,7 @@
          map_set:(m,x,v)=>m.set(x,v),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const imports = {Math:math,bindings,env:{},js,strings}
+    const imports = {Math:math,bindings,env:{},js,strings,fragments}
     const wasmModule =
           isNode?await WebAssembly.instantiate(await code, imports)
                 :await WebAssembly.instantiateStreaming(code,imports)

From 767134ace25d8612965fd8352370ce7354f911b0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 3 Nov 2023 14:29:38 +0100
Subject: [PATCH 162/481] More optimizations: caml_js_get, caml_js_set, and
 caml_js_object

---
 compiler/lib/specialize_js.ml     |  2 +-
 compiler/lib/wasm/wa_gc_target.ml | 95 +++++++++++++++++++++++++++++++
 2 files changed, 96 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index c562f18bef..651fa4cbd8 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -86,7 +86,7 @@ let specialize_instr ~target info i =
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_new", c :: Array.to_list a))
       | _ -> i)
-  | Let (x, Prim (Extern "caml_js_object", [ a ])), `JavaScript -> (
+  | Let (x, Prim (Extern "caml_js_object", [ a ])), _ -> (
       try
         let a =
           match the_def_of info a with
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 5cadcfd359..34349e38cc 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1377,6 +1377,101 @@ let () =
               , AUnknown ))
       in
       let l = List.map ~f:transl_prim_arg l in
+      JavaScript.invoke_fragment name l);
+  register "caml_js_get" (fun transl_prim_arg l ->
+      match l with
+      | [ x; Code.Pc (NativeString (Utf prop)) ] when J.is_ident' prop ->
+          let name =
+            let (Utf8 name) = prop in
+            Printf.sprintf "get_%s" name
+          in
+          let* () =
+            register_fragment name (fun () ->
+                let o = Utf8_string.of_string_exn "o" in
+                EArrow
+                  ( J.fun_
+                      [ J.ident o ]
+                      [ Return_statement (Some (J.dot (EVar (J.ident o)) prop)), N ]
+                      N
+                  , AUnknown ))
+          in
+          JavaScript.invoke_fragment name [ transl_prim_arg x ]
+      | [ _; _ ] ->
+          let* f = register_import ~name:"caml_js_get" (Fun (Type.func_type 1)) in
+          let l = List.map ~f:transl_prim_arg l in
+          let* l = expression_list (fun e -> e) l in
+          return (W.Call (f, l))
+      | _ -> assert false);
+  register "caml_js_set" (fun transl_prim_arg l ->
+      match l with
+      | [ x; Code.Pc (NativeString (Utf prop)); y ] when J.is_ident' prop ->
+          let name =
+            let (Utf8 name) = prop in
+            Printf.sprintf "set_%s" name
+          in
+          let* () =
+            register_fragment name (fun () ->
+                let o = Utf8_string.of_string_exn "o" in
+                let v = Utf8_string.of_string_exn "v" in
+                EArrow
+                  ( J.fun_
+                      [ J.ident o; J.ident v ]
+                      [ ( Return_statement
+                            (Some
+                               (J.EBin
+                                  (J.Eq, J.dot (EVar (J.ident o)) prop, EVar (J.ident v))))
+                        , N )
+                      ]
+                      N
+                  , AUnknown ))
+          in
+          let l = List.map ~f:transl_prim_arg [ x; y ] in
+          JavaScript.invoke_fragment name l
+      | [ _; _; _ ] ->
+          let* f = register_import ~name:"caml_js_set" (Fun (Type.func_type 2)) in
+          let l = List.map ~f:transl_prim_arg l in
+          let* l = expression_list (fun e -> e) l in
+          return (W.Call (f, l))
+      | _ -> assert false);
+  let counter = ref (-1) in
+  register "%caml_js_opt_object" (fun transl_prim_arg l ->
+      let rec split kl vl l =
+        match l with
+        | [] -> List.rev kl, List.rev vl
+        | Code.Pc (NativeString (Utf k)) :: v :: r -> split (k :: kl) (v :: vl) r
+        | _ -> assert false
+      in
+      let kl, vl = split [] [] l in
+      let name =
+        incr counter;
+        Printf.sprintf "obj_%d" !counter
+      in
+      let* () =
+        register_fragment name (fun () ->
+            let arity = List.length kl in
+            let params =
+              List.init ~len:arity ~f:(fun i ->
+                  Utf8_string.of_string_exn (Printf.sprintf "x%d" i))
+            in
+            EArrow
+              ( J.fun_
+                  (List.map ~f:J.ident params)
+                  [ ( Return_statement
+                        (Some
+                           (EObj
+                              (List.map2
+                                 ~f:(fun k x ->
+                                   J.Property
+                                     ( (if J.is_ident' k then J.PNI k else J.PNS k)
+                                     , EVar (J.ident x) ))
+                                 kl
+                                 params)))
+                    , N )
+                  ]
+                  N
+              , AUnknown ))
+      in
+      let l = List.map ~f:transl_prim_arg vl in
       JavaScript.invoke_fragment name l)
 
 let externref = W.Ref { nullable = true; typ = Extern }

From e94652b3f557418b5098604c0acf1320529536b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 3 Nov 2023 14:35:18 +0100
Subject: [PATCH 163/481] Runtime: missing tail calls in effect implementation

Some might not be necessary, but I got a stack overflow in %resume
without this change.
---
 runtime/wasm/effect.wat | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index ab0dbf8055..adb2a4f5f1 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -63,7 +63,7 @@
             (field $cont_resolver externref))))
 
    (func $invoke_promise_resolver (param $p (ref $pair)) (param (ref eq))
-      (call $resume_fiber
+      (return_call $resume_fiber
          (struct.get $cont_resume $cont_resolver
             (ref.cast (ref $cont_resume) (local.get 1)))
          (local.get $p)))
@@ -224,7 +224,7 @@
                   (call $caml_named_value
                      (array.new_data $string $already_resumed
                         (i32.const 0) (i32.const 35)))))))
-      (call $capture_continuation
+      (return_call $capture_continuation
          (ref.func $do_resume)
           (struct.new $pair
              (local.get $stack)
@@ -290,7 +290,7 @@
    (func $reperform (export "%reperform")
       (param $eff (ref eq)) (param $cont (ref eq))
       (result (ref eq))
-      (call $capture_continuation
+      (return_call $capture_continuation
          (ref.func $do_perform)
          (struct.new $pair (local.get $eff) (local.get $cont))))
 
@@ -325,18 +325,17 @@
                         (call $caml_wrap_exception (pop externref))))))
             (catch $ocaml_exception
                (local.set $exn (pop (ref eq)))
-               (call $call_handler
+               (return_call $call_handler
                   (struct.get $handlers $exn
                      (struct.get $fiber $handlers (global.get $stack)))
-                  (local.get $exn))
-               (return))))
-      (call $call_handler
+                  (local.get $exn)))))
+      (return_call $call_handler
          (struct.get $handlers $value
             (struct.get $fiber $handlers (global.get $stack)))
          (local.get $res)))
 
    (func $initial_cont (param $p (ref $pair)) (param (ref eq))
-      (call $start_fiber (local.get $p)))
+      (return_call $start_fiber (local.get $p)))
 
    (func (export "caml_alloc_stack")
       (param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq))

From f517bbcafd81de486cf9951f401bd45a69ec4ae8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 14 Nov 2023 09:55:08 +0100
Subject: [PATCH 164/481] Shrink loops (move code outside of the loop when
 possible)

---
 compiler/lib/wasm/wa_structure.ml | 94 ++++++++++++++++++++++++++++++-
 1 file changed, 92 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
index 95cfbc02b9..38ec812289 100644
--- a/compiler/lib/wasm/wa_structure.ml
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -87,8 +87,14 @@ let build_graph blocks pc =
       if leave_try_body block_order preds blocks leave_pc
       then (
         (* Add an edge to limit the [try] body *)
-        Hashtbl.add succs enter_pc (Addr.Set.add leave_pc (Hashtbl.find succs enter_pc));
-        Hashtbl.add preds leave_pc (Addr.Set.add enter_pc (Hashtbl.find preds leave_pc))));
+        Hashtbl.replace
+          succs
+          enter_pc
+          (Addr.Set.add leave_pc (Hashtbl.find succs enter_pc));
+        Hashtbl.replace
+          preds
+          leave_pc
+          (Addr.Set.add enter_pc (Hashtbl.find preds leave_pc))));
   { succs; preds; reverse_post_order = !l; block_order }
 
 let reversed_dominator_tree g =
@@ -139,3 +145,87 @@ let sort_in_post_order g l =
     ~cmp:(fun b b' ->
       compare (Hashtbl.find g.block_order b') (Hashtbl.find g.block_order b))
     l
+
+(* Compute a map from each block to the set of loops it belongs to *)
+let mark_loops g =
+  let in_loop = Hashtbl.create 16 in
+  Hashtbl.iter
+    (fun pc preds ->
+      let rec mark_loop pc' =
+        if not (Addr.Set.mem pc (get_edges in_loop pc'))
+        then (
+          add_edge in_loop pc' pc;
+          if pc' <> pc then Addr.Set.iter mark_loop (Hashtbl.find g.preds pc'))
+      in
+      Addr.Set.iter (fun pc' -> if is_backward g pc' pc then mark_loop pc') preds)
+    g.preds;
+  in_loop
+
+let rec measure blocks g pc limit =
+  let b = Addr.Map.find pc blocks in
+  let limit = limit - List.length b.body in
+  if limit < 0
+  then limit
+  else
+    Addr.Set.fold
+      (fun pc limit -> if limit < 0 then limit else measure blocks g pc limit)
+      (get_edges g.succs pc)
+      limit
+
+let is_small blocks g pc = measure blocks g pc 20 >= 0
+
+(* V8 uses the distance between the position of a backward jump and
+   the loop header as an estimation of the cost of executing the loop,
+   to decide whether to optimize a function containing a loop. So, for
+   a large function when the loop includes all the remaining code, the
+   estimation can be widely off. In particular, it may decide to
+   optimize the toplevel code, which is especially costly since it is
+   very large, and uncessary since it is executed only once. *)
+let shrink_loops blocks ({ succs; preds; reverse_post_order; _ } as g) =
+  let add_edge pred succ =
+    Hashtbl.replace succs pred (Addr.Set.add succ (Hashtbl.find succs pred));
+    Hashtbl.replace preds succ (Addr.Set.add pred (Hashtbl.find preds succ))
+  in
+  let in_loop = mark_loops g in
+  let dom = dominator_tree g in
+  let root = List.hd reverse_post_order in
+  let rec traverse ignored pc =
+    let succs = get_edges dom pc in
+    let loops = get_edges in_loop pc in
+    let block = Addr.Map.find pc blocks in
+    Addr.Set.iter
+      (fun pc' ->
+        (* Whatever is in the scope of an exception handler should not be
+           moved outside *)
+        let ignored =
+          match fst block.branch with
+          | Pushtrap ((body_pc, _), _, _, _) when pc' = body_pc ->
+              Addr.Set.union ignored loops
+          | _ -> ignored
+        in
+        let loops' = get_edges in_loop pc' in
+        let left_loops = Addr.Set.diff (Addr.Set.diff loops loops') ignored in
+        (* If we leave a loop, we add an edge from a predecessor of
+           the loop header to the current block, so that it is
+           considered outside of the loop. *)
+        if not (Addr.Set.is_empty left_loops || is_small blocks g pc')
+        then
+          Addr.Set.iter
+            (fun pc0 ->
+              match
+                Addr.Set.find_first
+                  (fun pc -> is_forward g pc pc0)
+                  (get_edges g.preds pc0)
+              with
+              | pc -> add_edge pc pc'
+              | exception Not_found -> ())
+            left_loops;
+        traverse ignored pc')
+      succs
+  in
+  traverse Addr.Set.empty root
+
+let build_graph blocks pc =
+  let g = build_graph blocks pc in
+  shrink_loops blocks g;
+  g

From fba64d2c19e1aed642f530456646cb1efc5f95f3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 22 Nov 2023 21:28:59 +0100
Subject: [PATCH 165/481] Runtime: Fix caml_update_dummy

---
 runtime/wasm/obj.wat | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 303b4ad64d..9c9c66fec5 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -51,7 +51,8 @@
             (field (mut (ref null $closure_3))))))
 
    (type $function_4
-      (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
+      (func (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
+         (result (ref eq))))
 
    (type $closure_4
       (sub $closure

From 8ed4e1848978e99feee0904f6d94b226bece73ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 27 Oct 2023 17:58:25 +0200
Subject: [PATCH 166/481] JavaScript strings: Firefox workaround

Firefox cannot (yet) import strings with type anyref.
---
 compiler/lib/wasm/wa_gc_target.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 34349e38cc..737177c6d6 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -843,10 +843,10 @@ module Constant = struct
           register_import
             ~import_module:"strings"
             ~name:(string_of_int i)
-            (Global { mut = false; typ = Ref { nullable = false; typ = Any } })
+            (Global { mut = false; typ = Ref { nullable = false; typ = Extern } })
         in
         let* ty = Type.js_type in
-        return (true, W.StructNew (ty, [ GlobalGet (V x) ]))
+        return (true, W.StructNew (ty, [ ExternInternalize (GlobalGet (V x)) ]))
     | String s ->
         let* ty = Type.string_type in
         if String.length s > string_length_threshold

From 8d0987da1a38558bbecb852400ff5b633cb5b86e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 23 Nov 2023 09:36:06 +0100
Subject: [PATCH 167/481] Fix launch script to work in Web workers

Fixes #9
---
 runtime/wasm/runtime.js | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index f72a649a5c..79682150b4 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -7,7 +7,8 @@
       return require('fs/promises').readFile(f)
     }
     function fetchRelative(src) {
-      const url = new URL (src, document.currentScript?.src || document.baseURI).href
+      const base = globalThis?.document?.currentScript?.src;
+      const url = base?new URL(src, base):src;
       return fetch(url)
     }
     const isNode = globalThis?.process?.versions?.node;

From d09d81e2ae6654cacb0d0f04845d8d9ce5316439 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 23 Nov 2023 09:36:57 +0100
Subject: [PATCH 168/481] Update README

Fixes #8
---
 README.md | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/README.md b/README.md
index da4818eb8b..21deff115c 100644
--- a/README.md
+++ b/README.md
@@ -8,12 +8,13 @@ Wasm_of_ocaml relies on the Binaryen toolchain ([version 116](https://github.com
 
 ## Supported engines
 
-The generated code works with Chrome 11.9 (currently, [Chrome Beta](https://www.google.com/chrome/beta/) or [Chrome for developpers](https://www.google.com/chrome/dev/)), [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and Firefox 120 (currently, [Firefox nightly](https://www.mozilla.org/en-US/firefox/channel/desktop/)).
+The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and Firefox 121 (currently, [Firefox Beta](https://www.mozilla.org/en-US/firefox/channel/desktop/)).
 
 ## Installation
 
 The following commands will perform a minimal installation:
 ```
+opam pin add dune.3.11 https://github.com/ocaml-wasm/dune.git
 opam pin add -n --with-version 5.3.0 .
 opam install wasm_of_ocaml-compiler
 ```

From 5ea9899537ade67f95809cc1ec6c4ad188bafd9a Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Thu, 23 Nov 2023 17:23:53 +0100
Subject: [PATCH 169/481] Document the requires extensions

---
 README.md | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/README.md b/README.md
index 21deff115c..52ec06d8d5 100644
--- a/README.md
+++ b/README.md
@@ -10,6 +10,12 @@ Wasm_of_ocaml relies on the Binaryen toolchain ([version 116](https://github.com
 
 The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and Firefox 121 (currently, [Firefox Beta](https://www.mozilla.org/en-US/firefox/channel/desktop/)).
 
+In particular, the output code requires the following [Wasm extensions](https://webassembly.org/roadmap/) to run:
+- [the GC extension](https://github.com/WebAssembly/gc), including functional references and 31-bit integers
+- [the tail-call extension](https://github.com/WebAssembly/tail-call/blob/main/proposals/tail-call/Overview.md)
+- [the exception handling extension](https://github.com/WebAssembly/exception-handling/blob/master/proposals/exception-handling/Exceptions.md)
+
+
 ## Installation
 
 The following commands will perform a minimal installation:

From 0e366284a53493c429870f828811570e66fa5cf7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 27 Nov 2023 12:10:43 +0100
Subject: [PATCH 170/481] Runtime: fix ldexp

---
 runtime/wasm/float.wat | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index b30ce1de6b..0670a12fd9 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -713,7 +713,7 @@
                   (local.set $x (f64.mul (local.get $x) (f64.const 0x1p1023)))
                   (local.set $n (i32.sub (local.get $n) (i32.const 1023)))
                   (if (i32.gt_s (local.get $n) (i32.const 1023))
-                     (then (local.set $n (i32.const 1023))))))
+                     (then (local.set $n (i32.const 1023)))))))
          (else
             (if (i32.lt_s (local.get $n) (i32.const -1022))
                (then
@@ -725,7 +725,7 @@
                            (f64.mul (local.get $x) (f64.const 0x1p-969)))
                         (local.set $n (i32.add (local.get $n) (i32.const 969)))
                         (if (i32.lt_s (local.get $n) (i32.const -1022))
-                           (then (local.set $n (i32.const -1022)))))))))))
+                           (then (local.set $n (i32.const -1022))))))))))
       (f64.mul (local.get $x)
          (f64.reinterpret_i64
             (i64.shl (i64.add (i64.extend_i32_s (local.get $n))

From d67c2159cd31efa9551dec3411307f7bd0d2f6d5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 27 Nov 2023 12:11:48 +0100
Subject: [PATCH 171/481] Fix handling of native int constants

They were wrongly truncated to 31 bits.
---
 compiler/lib/parse_bytecode.ml | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 65421c1405..a2b9daa47a 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -468,11 +468,7 @@ end = struct
         | Some name when same_ident name ident_32 -> Int (Int32, (Obj.magic x : int32))
         | Some name when same_ident name ident_native ->
             let i : nativeint = Obj.magic x in
-            Int
-              ( Native
-              , match target with
-                | `JavaScript -> Int32.of_nativeint_warning_on_overflow i
-                | `Wasm -> Int31.of_nativeint_warning_on_overflow i )
+            Int (Native, Int32.of_nativeint_warning_on_overflow i)
         | Some name when same_ident name ident_64 -> Int64 (Obj.magic x : int64)
         | Some name ->
             failwith

From 931ded65c5385af83327ed605226b938095680b1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 23 Nov 2023 16:22:09 +0100
Subject: [PATCH 172/481] CI: run some Jane Street tests

---
 .github/workflows/build.yml | 104 +++++++-------
 tools/ci_setup.ml           | 263 ++++++++++++++++++++++++++++++++++++
 2 files changed, 312 insertions(+), 55 deletions(-)
 create mode 100644 tools/ci_setup.ml

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index bfcf012228..b3de222ae9 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -109,42 +109,30 @@ jobs:
             /opt/hostedtoolcache/opam/2.1.5/x86_64/opam
           key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
 
+      - name: Checkout code
+        uses: actions/checkout@v4
+        with:
+          path: wasm_of_ocaml
+
+      - name: Checkout Jane Street opam repository
+        uses: actions/checkout@v4
+        with:
+          repository: janestreet/opam-repository
+          path: jane-street/opam-repository
+
       - name: Pin dune
         run: |
           opam pin add -n dune.3.11 https://github.com/ocaml-wasm/dune.git#wasm
 
-      - name: Pin packages
-        run: |
-          opam pin add -n alcotest https://github.com/ocaml-wasm/alcotest.git#wasm
-          opam pin add -n async_js https://github.com/ocaml-wasm/async_js.git#wasm
-          opam pin add -n base https://github.com/ocaml-wasm/base.git#wasm
-          opam pin add -n base_bigstring https://github.com/ocaml-wasm/base_bigstring.git#wasm
-          opam pin add -n bigstringaf https://github.com/ocaml-wasm/bigstringaf.git#wasm
-          opam pin add -n bin_prot https://github.com/ocaml-wasm/bin_prot.git#wasm
-          opam pin add -n bonsai https://github.com/ocaml-wasm/bonsai.git#wasm
-          opam pin add -n brr https://github.com/ocaml-wasm/brr.git#wasm
-          opam pin add -n core https://github.com/ocaml-wasm/core.git#wasm
-          opam pin add -n core_kernel https://github.com/ocaml-wasm/core_kernel.git#wasm
-          opam pin add -n cstruct https://github.com/ocaml-wasm/ocaml-cstruct.git#wasm
-          opam pin add -n gen_js_api https://github.com/ocaml-wasm/gen_js_api.git#wasm
-          opam pin add -n incr_dom https://github.com/ocaml-wasm/incr_dom.git#wasm
-          opam pin add -n js_of_ocaml_patches https://github.com/ocaml-wasm/js_of_ocaml_patches.git#wasm
-          opam pin add -n ppx_css https://github.com/ocaml-wasm/ppx_css.git#wasm
-          opam pin add -n ppx_expect https://github.com/ocaml-wasm/ppx_expect.git#wasm
-          opam pin add -n ppx_inline_test https://github.com/ocaml-wasm/ppx_inline_test.git#wasm
-          opam pin add -n string_dict https://github.com/ocaml-wasm/string_dict.git#wasm
-          opam pin add -n time_now https://github.com/ocaml-wasm/time_now.git#wasm
-          opam pin add -n virtual_dom https://github.com/ocaml-wasm/virtual_dom.git#wasm
-          opam pin add -n zarith_stubs_js https://github.com/ocaml-wasm/zarith_stubs_js.git#wasm
+      - name: Install opam file parser
+        run: opam install opam-format ocamlfind
+
+      - name: Checkout Jane Street packages
+        run: opam exec -- ocaml wasm_of_ocaml/tools/ci_setup.ml
 
       - name: Update dune and test dependencies
         run: opam install dune num cohttp-lwt-unix graphics ppx_expect zarith.1.12
 
-      - name: Checkout code
-        uses: actions/checkout@v4
-        with:
-          path: wasm_of_ocaml
-
       - name: Build wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
         run: |
@@ -160,41 +148,47 @@ jobs:
         working-directory: ./wasm_of_ocaml
         run: opam exec -- dune build @all @runtest --profile wasm-effects
 
-      - name: Install bonsai and zarith_stubs_js
+      - name: Run Base tests
         if: ${{ matrix.ocaml-compiler < '5.' }}
-        run: opam install dune bonsai zarith_stubs_js
+        working-directory: ./jane-street/lib/base
+        run: opam exec -- dune runtest
 
-      - name: Checkout zarith_stubs_js
+      - name: Run Base bigstring tests
         if: ${{ matrix.ocaml-compiler < '5.' }}
-        uses: actions/checkout@v4
-        with:
-          repository: ocaml-wasm/zarith_stubs_js
-          path: zarith
-          ref: wasm
+        working-directory: ./jane-street/lib/base_bigstring
+        run: opam exec -- dune runtest
 
-      - name: Run zarith_stubs_js tests
+      - name: Run Core tests
         if: ${{ matrix.ocaml-compiler < '5.' }}
-        working-directory: ./zarith
-        run: |
-           opam exec -- dune build @runtest --profile wasm
+        working-directory: ./jane-street/lib/core
+        run: opam exec -- dune runtest
 
-      - name: Checkout bonsai
+      - name: Run Bignum tests
         if: ${{ matrix.ocaml-compiler < '5.' }}
-        uses: actions/checkout@v4
-        with:
-          repository: ocaml-wasm/bonsai
-          path: bonsai
-          ref: wasm
+        working-directory: ./jane-street/lib/bignum
+        run: opam exec -- dune runtest
 
-      - name: Install bonsai dependencies
+      - name: Run Bin_prot tests
         if: ${{ matrix.ocaml-compiler < '5.' }}
-        working-directory: ./bonsai
-        run: |
-           sudo apt-get install libgraph-easy-perl
-           npm install deasync
+        working-directory: ./jane-street/lib/bin_prot
+        run: opam exec -- dune runtest
 
-      - name: Run bonsai tests
+      - name: Run String_dict tests
         if: ${{ matrix.ocaml-compiler < '5.' }}
-        working-directory: ./bonsai
-        run: |
-           opam exec -- dune build @runtest --profile wasm
+        working-directory: ./jane-street/lib/string_dict
+        run: opam exec -- dune runtest
+
+      - name: Run Zarith tests
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        working-directory: ./jane-street/lib/zarith_stubs_js
+        run: opam exec -- dune runtest
+
+      - name: Run Virtual_dom tests
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        working-directory: ./jane-street/lib/virtual_dom
+        run: opam exec -- dune runtest
+
+      - name: Run Bonsai tests
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        working-directory: ./jane-street/lib/bonsai
+        run: opam exec -- dune runtest
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
new file mode 100644
index 0000000000..772086a144
--- /dev/null
+++ b/tools/ci_setup.ml
@@ -0,0 +1,263 @@
+#use "topfind"
+
+#require "opam-format"
+
+#require "unix"
+
+#require "str"
+
+module StringSet = Set.Make (String)
+
+(****)
+
+let repo = "jane-street/opam-repository/packages"
+
+let roots = [ "bonsai"; "string_dict" ]
+
+let omitted_others = StringSet.of_list [ "cohttp-async"; "cohttp"; "uri"; "uri-sexp" ]
+
+let omitted_js = StringSet.of_list [ "sexplib0" ]
+
+let do_not_pin = StringSet.of_list [ "wasocaml"; "wasm_of_ocaml" ]
+
+let do_pin = StringSet.of_list [ "base"; "ppx_expect"; "ppx_inline_test"; "time_now" ]
+
+let aliases = [ "ocaml-cstruct", "cstruct" ]
+
+let dune_workspace =
+  {|(lang dune 3.11)
+(env
+ (_
+  (env-vars (TESTING_FRAMEWORK inline-test))
+  (js_of_ocaml (target wasm))
+  (flags :standard -warn-error -8-32-34-49-52-55 -w -67-69)))
+|}
+
+let patches =
+  [ ( "sexp_grammar"
+    , {|
+diff --git a/sexp_grammar_validation.opam b/sexp_grammar_validation.opam
+new file mode 100644
+index 0000000..e69de29
+diff --git a/validation/src/dune b/validation/src/dune
+index 5c51676..b371eaa 100644
+--- a/validation/src/dune
++++ b/validation/src/dune
+@@ -1,4 +1,5 @@
+ (library (name sexp_grammar_validation)
++ (public_name sexp_grammar_validation)
+  (libraries bignum.bigint core
+   expect_test_helpers_core.expect_test_helpers_base sexp_grammar)
+  (preprocess (pps ppx_jane)))
+\ No newline at end of file
+|}
+    )
+  ; ( "bignum"
+    , {bignum|
+diff --git a/test/src/dune b/test/src/dune
+index 89ab13d..12133a8 100644
+--- a/test/src/dune
++++ b/test/src/dune
+@@ -1,4 +1,5 @@
+ (library (name bignum_test)
+  (libraries bigint bignum core expect_test_helpers_core
+   sexp_grammar_validation)
+- (preprocess (pps ppx_jane)))
+\ No newline at end of file
++ (inline_tests (flags -drop-tag no-js -drop-tag no-wasm -drop-tag 64-bits-only) (modes js))
++ (preprocess (pps ppx_jane)))
+diff --git a/test/src/test_bignum.ml b/test/src/test_bignum.ml
+index 47ca701..a096d6c 100644
+--- a/test/src/test_bignum.ml
++++ b/test/src/test_bignum.ml
+@@ -3,6 +3,11 @@ open! Expect_test_helpers_core
+ open Bignum
+ open Bignum.For_testing
+ 
++module Zarith = struct
++  module Q = Q
++  module Z = Z
++end
++
+ let%test_unit "Bignum.(//)" =
+   let open Bignum.O in
+   for i = -4 to 4 do
+@@ -62,7 +67,7 @@ let%expect_test "Bignum.sexp_of_t does use Scientific Notation" =
+ let compare_floats ~of_float x =
+   let x' = x |> of_float |> Bignum.to_float in
+   if not (Float.( = ) x x' || (Float.is_nan x && Float.is_nan x'))
+-  then raise_s [%message "mismatch" (x : float) (x' : float)]
++  then raise_s [%message "mismatch" (x : float) (x' : float) (x |> of_float : Bignum.t)]
+ ;;
+ 
+ let%expect_test "roundtrip: f |> Bignum.of_float_decimal |> Bignum.to_float" =
+@@ -774,7 +779,7 @@ let%test_module _ =
+          -1073741825 -> ( 6) \001\253\255\255\255\191 |}]
+     ;;
+ 
+-    let%expect_test ("bin_io serialization V2 (javascript)" [@tags "js-only"]) =
++    let%expect_test ("bin_io serialization V2 (javascript)" [@tags "js-only", "no-wasm"]) =
+       bin_io_tests (module V2);
+       [%expect
+         {|
+@@ -802,6 +807,34 @@ let%test_module _ =
+          -1073741825 -> ( 6) \001\253\255\255\255\191 |}]
+     ;;
+ 
++    let%expect_test ("bin_io serialization V2 (Wasm)" [@tags "wasm-only"]) =
++      bin_io_tests (module V2);
++      [%expect
++        {|
++                   0 -> ( 1) \000
++                   1 -> ( 2) \001\001
++                  -1 -> ( 3) \001\255\255
++           100000001 -> ( 6) \001\253\001\225\245\005
++           1000000.1 -> ( 6) \002\253\129\150\152\000
++           100000.01 -> ( 6) \003\253\129\150\152\000
++           10000.001 -> ( 6) \004\253\129\150\152\000
++           1000.0001 -> ( 6) \005\253\129\150\152\000
++           100.00001 -> ( 6) \006\253\129\150\152\000
++           10.000001 -> ( 6) \007\253\129\150\152\000
++           1.0000001 -> ( 6) \008\253\129\150\152\000
++          0.10000001 -> ( 6) \009\253\129\150\152\000
++         0.010000001 -> (11) \010\253\129\150\152\000\253\000\202\154\059
++        0.0010000001 -> (22) \011\02010000001\04710000000000
++      10000000000000 -> (16) \011\01410000000000000
++     -10000000000000 -> (17) \011\015\04510000000000000
++12345678901234567.12345678901234567 -> (55) \01151234567890123456712345678901234567\047100000000000000000
++       1099511627775 -> (15) \011\0131099511627775
++          1073741823 -> ( 6) \001\253\255\255\255\063
++         -1073741824 -> ( 6) \001\253\000\000\000\192
++          1073741824 -> (12) \011\0101073741824
++         -1073741825 -> (13) \011\011\0451073741825 |}]
++    ;;
++
+     let%expect_test "bin_io de-serialization V2" =
+       (* Some bignums will have two bin_io representation depending on where their
+          were serialized.  Make sure we're able to parse things back regardless of the
+|bignum}
+    )
+  ]
+
+(****)
+
+let read_opam_file filename =
+  OpamPp.parse
+    OpamPp.Op.(OpamFormat.I.file -| OpamPp.map_snd OpamFile.OPAM.pp_raw_fields)
+    ~pos:{ filename; start = 0, 0; stop = 0, 0 }
+    (OpamParser.FullPos.file (Filename.concat (Filename.concat repo filename) "opam"))
+
+let dependencies (_, { OpamFile.OPAM.depends }) =
+  let open OpamFormula in
+  depends
+  |> map (fun (nm, _) -> Atom (nm, None))
+  |> of_atom_formula
+  |> atoms
+  |> List.map fst
+  |> List.map OpamPackage.Name.to_string
+
+let packages =
+  repo
+  |> Sys.readdir
+  |> Array.to_list
+  |> List.map (fun s -> String.sub s 0 (String.index s '.'), read_opam_file s)
+
+let rec traverse visited p =
+  if StringSet.mem p visited
+  then visited
+  else
+    let visited = StringSet.add p visited in
+    match List.assoc p packages with
+    | exception Not_found -> visited
+    | opam ->
+        let l = dependencies opam in
+        List.fold_left traverse visited l
+
+let forked_packages =
+  let ch =
+    Unix.open_process_in
+      "curl -L -H 'Accept: application/vnd.github+json' -H 'X-GitHub-Api-Version: \
+       2022-11-28' https://api.github.com/orgs/ocaml-wasm/repos 2> /dev/null | jq -r \
+       '.[] | .name'"
+  in
+  let l = Str.(split (regexp "\n")) (In_channel.input_all ch) in
+  close_in ch;
+  StringSet.of_list l
+
+let is_forked p = StringSet.mem p forked_packages
+
+let exec_async ~delay cmd =
+  let p =
+    Unix.open_process_out (Printf.sprintf "sleep %f; %s" (float delay /. 10.) cmd)
+  in
+  fun () -> ignore (Unix.close_process_out p)
+
+let sync_exec f l =
+  let l = List.mapi f l in
+  List.iter (fun f -> f ()) l
+
+let pin delay nm =
+  exec_async
+    ~delay
+    (Printf.sprintf
+       "opam pin add -n %s https://github.com/ocaml-wasm/%s.git#wasm"
+       (try List.assoc nm aliases with Not_found -> nm)
+       nm)
+
+let pin_packages js =
+  sync_exec
+    pin
+    (StringSet.elements
+       (StringSet.union
+          (StringSet.diff (StringSet.diff forked_packages js) do_not_pin)
+          do_pin))
+
+let install_others others =
+  let others = StringSet.elements (StringSet.diff others omitted_others) in
+  ignore (Sys.command ("opam install -y " ^ String.concat " " others))
+
+let clone delay ?branch nm src =
+  exec_async
+    ~delay
+    (Printf.sprintf
+       "git clone -q --depth 1 %s%s jane-street/lib/%s"
+       (match branch with
+       | None -> ""
+       | Some b -> Printf.sprintf "-b %s " b)
+       src
+       nm)
+
+let () =
+  Out_channel.(
+    with_open_bin "jane-street/dune-workspace"
+    @@ fun ch -> output_string ch dune_workspace)
+
+let () =
+  let js, others =
+    List.fold_left traverse StringSet.empty roots
+    |> StringSet.partition (fun p -> List.mem_assoc p packages)
+  in
+  pin_packages js;
+  install_others others;
+  sync_exec (fun i () -> clone i "ocaml-uri" "https://github.com/mirage/ocaml-uri") [ () ];
+  sync_exec
+    (fun i nm ->
+      clone
+        i
+        ?branch:(if is_forked nm then Some "wasm" else None)
+        nm
+        (Printf.sprintf
+           "https://github.com/%s/%s"
+           (if is_forked nm then "ocaml-wasm" else "janestreet")
+           nm))
+    (StringSet.elements (StringSet.diff js omitted_js))
+
+let () =
+  List.iter
+    (fun (dir, patch) ->
+      let ch =
+        Unix.open_process_out (Printf.sprintf "cd jane-street/lib/%s && patch -p 1" dir)
+      in
+      output_string ch patch;
+      ignore (Unix.close_process_out ch))
+    patches

From 5661cc690f494437b84f55220808b2a091dd7852 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 28 Nov 2023 21:53:25 +0100
Subject: [PATCH 173/481] Dune update

---
 .github/workflows/build.yml           |  2 +-
 README.md                             |  2 +-
 compiler/bin-wasm_of_ocaml/compile.ml | 15 +++++++++------
 dune                                  |  4 ++--
 tools/ci_setup.ml                     |  4 ++--
 5 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index b3de222ae9..f436c74628 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -122,7 +122,7 @@ jobs:
 
       - name: Pin dune
         run: |
-          opam pin add -n dune.3.11 https://github.com/ocaml-wasm/dune.git#wasm
+          opam pin add -n dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm
 
       - name: Install opam file parser
         run: opam install opam-format ocamlfind
diff --git a/README.md b/README.md
index 52ec06d8d5..072d6f93fa 100644
--- a/README.md
+++ b/README.md
@@ -20,7 +20,7 @@ In particular, the output code requires the following [Wasm extensions](https://
 
 The following commands will perform a minimal installation:
 ```
-opam pin add dune.3.11 https://github.com/ocaml-wasm/dune.git
+opam pin add dune.3.13 https://github.com/ocaml-wasm/dune.git
 opam pin add -n --with-version 5.3.0 .
 opam install wasm_of_ocaml-compiler
 ```
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 2563549263..2191b5e9d6 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -249,9 +249,8 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
   Jsoo_cmdline.Arg.eval common;
   Wa_generate.init ();
-  (match output_file with
-  | name, _ when debug_mem () -> Debug.start_profiling name
-  | _, _ -> ());
+  let output_file = fst output_file in
+  if debug_mem () then Debug.start_profiling output_file;
   List.iter params ~f:(fun (s, v) -> Config.Param.set s v);
   let t = Timer.make () in
   let include_dirs = List.filter_map [ "+stdlib/" ] ~f:(fun d -> Findlib.find [] d) in
@@ -326,11 +325,15 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
            ic
        in
        if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-       let wat_file = Filename.chop_extension (fst output_file) ^ ".wat" in
-       let wasm_file = Filename.chop_extension (fst output_file) ^ ".wasm" in
+       let wat_file = Filename.chop_extension output_file ^ ".wat" in
+       let wasm_file =
+         if Filename.check_suffix output_file ".wasm.js"
+         then Filename.chop_extension output_file
+         else Filename.chop_extension output_file ^ ".wasm"
+       in
        let strings = output_gen wat_file (output code ~standalone:true) in
        let primitives = link_and_optimize runtime_wasm_files wat_file wasm_file in
-       build_js_runtime primitives strings wasm_file (fst output_file)
+       build_js_runtime primitives strings wasm_file output_file
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());
   Debug.stop_profiling ()
diff --git a/dune b/dune
index 9a502ee48f..332a723017 100644
--- a/dune
+++ b/dune
@@ -12,13 +12,13 @@
  (wasm
   (binaries (tools/node_wrapper.sh as node))
   (js_of_ocaml
-   (target wasm)))
+   (targets wasm)))
  (wasm-effects
   (binaries (tools/node_wrapper.sh as node))
   (js_of_ocaml
    (flags
     (:standard --enable effects))
-   (target wasm)))
+   (targets wasm)))
  (bench_no_debug
   (flags
    (:standard \ -g))
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index 772086a144..dc4b2bc81a 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -25,11 +25,11 @@ let do_pin = StringSet.of_list [ "base"; "ppx_expect"; "ppx_inline_test"; "time_
 let aliases = [ "ocaml-cstruct", "cstruct" ]
 
 let dune_workspace =
-  {|(lang dune 3.11)
+  {|(lang dune 3.13)
 (env
  (_
   (env-vars (TESTING_FRAMEWORK inline-test))
-  (js_of_ocaml (target wasm))
+  (js_of_ocaml (targets wasm))
   (flags :standard -warn-error -8-32-34-49-52-55 -w -67-69)))
 |}
 

From b0dc26ef47760b72de2eadd7e9ea7d3326fd0382 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 28 Nov 2023 21:53:45 +0100
Subject: [PATCH 174/481] CI clean-up

---
 .github/workflows/build.yml | 17 ++++++++++-------
 README.md                   |  2 +-
 VERSION                     |  2 +-
 3 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index f436c74628..6d8323f284 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -124,20 +124,23 @@ jobs:
         run: |
           opam pin add -n dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm
 
+      - name: Pin wasm_of_ocaml
+        working-directory: ./wasm_of_ocaml
+        run: |
+           for i in *.opam; do opam pin add -n `basename $i .opam`.`< VERSION` .; done
+
       - name: Install opam file parser
-        run: opam install opam-format ocamlfind
+        run: opam install opam-format ocamlfind dune graphics
 
       - name: Checkout Jane Street packages
         run: opam exec -- ocaml wasm_of_ocaml/tools/ci_setup.ml
 
-      - name: Update dune and test dependencies
-        run: opam install dune num cohttp-lwt-unix graphics ppx_expect zarith.1.12
+      - name: Update test dependencies
+        run: opam install num cohttp-lwt-unix ppx_expect
 
-      - name: Build wasm_of_ocaml
+      - name: Install wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
-        run: |
-           for i in *.opam; do opam pin add -n `basename $i .opam`.`< VERSION` .; done
-           opam install `basename -s .opam *.opam`
+        run: opam install `basename -s .opam *.opam`
 
       - name: Run tests
         working-directory: ./wasm_of_ocaml
diff --git a/README.md b/README.md
index 072d6f93fa..8564f262d1 100644
--- a/README.md
+++ b/README.md
@@ -21,7 +21,7 @@ In particular, the output code requires the following [Wasm extensions](https://
 The following commands will perform a minimal installation:
 ```
 opam pin add dune.3.13 https://github.com/ocaml-wasm/dune.git
-opam pin add -n --with-version 5.3.0 .
+opam pin add -n --with-version 5.3.0-wasm .
 opam install wasm_of_ocaml-compiler
 ```
 You may want to install additional packages. For instance:
diff --git a/VERSION b/VERSION
index 03f488b076..f15f9c5810 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-5.3.0
+5.3.0-wasm

From 28f27d9236ed162e78ee4c5658f39dc4ccabf76c Mon Sep 17 00:00:00 2001
From: Jan Midtgaard <mail@janmidtgaard.dk>
Date: Fri, 1 Dec 2023 16:12:32 +0100
Subject: [PATCH 175/481] Document the JSPI extension too

---
 README.md | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/README.md b/README.md
index 8564f262d1..683998da2c 100644
--- a/README.md
+++ b/README.md
@@ -15,6 +15,12 @@ In particular, the output code requires the following [Wasm extensions](https://
 - [the tail-call extension](https://github.com/WebAssembly/tail-call/blob/main/proposals/tail-call/Overview.md)
 - [the exception handling extension](https://github.com/WebAssembly/exception-handling/blob/master/proposals/exception-handling/Exceptions.md)
 
+OCaml 5.x code using effect handlers can be compiled in two different ways:
+One can enable the CPS transformation from `js_of_ocaml` by passing the
+`--enable=effects` flag. Without the flag `wasm_of_ocaml` will instead emit code
+utilizing
+- [the JavaScript-Promise Integration extension](https://github.com/WebAssembly/js-promise-integration/blob/main/proposals/js-promise-integration/Overview.md)
+
 
 ## Installation
 

From 13536aa7c550528bfb70f7f6b451d18dbd2e22fd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 19 Dec 2023 17:16:26 +0100
Subject: [PATCH 176/481] Runtime: use map to store file descriptor information

So that it still works when file descriptors are not small integers.
Fixes #18.
---
 runtime/wasm/io.wat     | 156 ++++++++++++++++++++++------------------
 runtime/wasm/runtime.js |   1 +
 2 files changed, 87 insertions(+), 70 deletions(-)

diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 47c5f506ed..9eb222851b 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -54,6 +54,16 @@
    (import "sys" "caml_handle_sys_error"
       (func $caml_handle_sys_error (param externref)))
 
+   (import "bindings" "map_new" (func $map_new (result (ref extern))))
+   (import "bindings" "map_get"
+      (func $map_get
+         (param (ref extern)) (param i32) (result (ref $fd_offset))))
+   (import "bindings" "map_set"
+      (func $map_set
+         (param (ref extern)) (param i32) (param (ref $fd_offset))))
+   (import "bindings" "map_delete"
+      (func $map_delete (param (ref extern)) (param i32)))
+
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
    (type $offset_array (array (mut i64)))
@@ -109,38 +119,35 @@
             (field $size (mut i32))
             (field $unbuffered (mut i32)))))
 
-   (global $fd_offsets (export "fd_offsets") (mut (ref $offset_array))
-      (array.new $offset_array (i64.const 0) (i32.const 3)))
-   (global $fd_seeked (mut (ref $string))
-      (array.new $string (i32.const 0) (i32.const 3)))
+   (type $fd_offset
+      (struct (field $offset (mut i64)) (field $seeked (mut i32))))
 
-   (func $initialize_fd_offset (param $fd i32) (param $offset i64)
-      (local $len i32)
-      (local $a (ref $offset_array))
-      (local $b (ref $string))
-      (local.set $len (array.len (global.get $fd_offsets)))
-      (if (i32.ge_u (local.get $fd) (local.get $len))
+   (global $fd_offsets (mut externref) (ref.null extern))
+
+   (func $get_fd_offsets (result (ref extern))
+      (local $m (ref extern))
+      (if (ref.is_null (global.get $fd_offsets))
          (then
-            (loop $loop
-               (local.set $len (i32.shl (local.get $len) (i32.const 1)))
-               (br_if $loop (i32.ge_u (local.get $fd) (local.get $len))))
-            (local.set $a
-               (array.new $offset_array (i64.const 0) (local.get $len)))
-            (array.copy $offset_array $offset_array
-               (local.get $a) (i32.const 0)
-               (global.get $fd_offsets) (i32.const 0)
-               (array.len (global.get $fd_offsets)))
-            (global.set $fd_offsets (local.get $a))
-            (local.set $b
-               (array.new $string (i32.const 0) (local.get $len)))
-            (array.copy $string $string
-               (local.get $b) (i32.const 0)
-               (global.get $fd_seeked) (i32.const 0)
-               (array.len (global.get $fd_seeked)))
-            (global.set $fd_seeked (local.get $b))))
-      (array.set $offset_array (global.get $fd_offsets) (local.get $fd)
-        (local.get $offset))
-      (array.set $string (global.get $fd_seeked) (local.get $fd) (i32.const 0)))
+            (local.set $m (call $map_new))
+            (call $map_set (local.get $m) (i32.const 0)
+               (struct.new $fd_offset (i64.const 0) (i32.const 0)))
+            (call $map_set (local.get $m) (i32.const 1)
+               (struct.new $fd_offset (i64.const 0) (i32.const 0)))
+            (call $map_set (local.get $m) (i32.const 2)
+               (struct.new $fd_offset (i64.const 0) (i32.const 0)))
+            (global.set $fd_offsets (local.get $m))))
+      (ref.as_non_null (global.get $fd_offsets)))
+
+   (func $initialize_fd_offset (param $fd i32) (param $offset i64)
+      (call $map_set (call $get_fd_offsets)
+         (local.get $fd)
+         (struct.new $fd_offset (local.get $offset) (i32.const 0))))
+
+   (func $release_fd_offset (param $fd i32)
+      (call $map_delete (call $get_fd_offsets) (local.get $fd)))
+
+   (func $get_fd_offset (param $fd i32) (result (ref $fd_offset))
+      (call $map_get (call $get_fd_offsets) (local.get $fd)))
 
    (global $IO_BUFFER_SIZE i32 (i32.const 65536))
 
@@ -197,9 +204,12 @@
       (ref.i31 (local.get $fd)))
 
    (func (export "caml_sys_close") (param (ref eq)) (result (ref eq))
+      (local $fd i32)
+      (local.set $fd (i31.get_u (ref.cast (ref i31) (local.get 0))))
+      (call $release_fd_offset (local.get $fd))
       (try
          (do
-            (call $close (i31.get_u (ref.cast (ref i31) (local.get 0)))))
+            (call $close (local.get $fd)))
          (catch $javascript_exception
             (call $caml_handle_sys_error (pop externref))))
       (ref.i31 (i32.const 0)))
@@ -259,22 +269,24 @@
          (then
             (struct.set $channel $fd (local.get $ch) (i32.const -1))
             (call $unregister_channel (local.get $ch))
+            (call $release_fd_offset (local.get $fd))
             (call $close (local.get $fd))))
       (ref.i31 (i32.const 0)))
 
    (func $caml_do_read
       (param $ch (ref $channel)) (param $pos i32) (param $len i32) (result i32)
       (local $fd i32)
+      (local $fd_offset (ref $fd_offset))
       (local $offset i64)
       (local $n i32)
       (local.set $fd (struct.get $channel $fd (local.get $ch)))
-      (local.set $offset
-         (array.get $offset_array (global.get $fd_offsets) (local.get $fd)))
+      (local.set $fd_offset (call $get_fd_offset (local.get $fd)))
+      (local.set $offset (struct.get $fd_offset $offset (local.get $fd_offset)))
       (try
          (do
             (local.set $n
                (if (result i32)
-                   (array.get_u $string (global.get $fd_seeked) (local.get $fd))
+                   (struct.get $fd_offset $seeked (local.get $fd_offset))
                   (then
                      (call $read
                         (local.get $fd)
@@ -291,8 +303,8 @@
                         (ref.null noextern))))))
          (catch $javascript_exception
             (call $caml_handle_sys_error (pop externref))))
-      (array.set $offset_array
-         (global.get $fd_offsets) (local.get $fd)
+      (struct.set $fd_offset $offset
+         (local.get $fd_offset)
          (i64.add (local.get $offset) (i64.extend_i32_u (local.get $n))))
       (local.get $n))
 
@@ -455,9 +467,9 @@
       (ref.i31
          (i32.sub
             (i32.wrap_i64
-               (array.get $offset_array
-                  (global.get $fd_offsets)
-                  (struct.get $channel $fd (local.get $ch))))
+               (struct.get $fd_offset $offset
+                  (call $get_fd_offset
+                     (struct.get $channel $fd (local.get $ch)))))
             (i32.sub
               (struct.get $channel $max (local.get $ch))
               (struct.get $channel $curr (local.get $ch))))))
@@ -468,9 +480,9 @@
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (call $caml_copy_int64
          (i64.sub
-            (array.get $offset_array
-               (global.get $fd_offsets)
-               (struct.get $channel $fd (local.get $ch)))
+            (struct.get $fd_offset $offset
+               (call $get_fd_offset
+                  (struct.get $channel $fd (local.get $ch))))
             (i64.extend_i32_s
                (i32.sub
                   (struct.get $channel $max (local.get $ch))
@@ -483,9 +495,9 @@
       (ref.i31
          (i32.add
             (i32.wrap_i64
-               (array.get $offset_array
-                  (global.get $fd_offsets)
-                  (struct.get $channel $fd (local.get $ch))))
+               (struct.get $fd_offset $offset
+                  (call $get_fd_offset
+                     (struct.get $channel $fd (local.get $ch)))))
             (struct.get $channel $curr (local.get $ch)))))
 
    (func (export "caml_ml_pos_out_64")
@@ -494,17 +506,19 @@
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (call $caml_copy_int64
          (i64.add
-            (array.get $offset_array
-               (global.get $fd_offsets)
-               (struct.get $channel $fd (local.get $ch)))
+            (struct.get $fd_offset $offset
+               (call $get_fd_offset
+                  (struct.get $channel $fd (local.get $ch))))
             (i64.extend_i32_s (struct.get $channel $curr (local.get $ch))))))
 
    (func $caml_seek_in
       (param $ch (ref $channel)) (param $dest i64) (result (ref eq))
       (local $fd i32) (local $offset i64)
+      (local $fd_offset (ref $fd_offset))
       (local.set $fd (struct.get $channel $fd (local.get $ch)))
+      (local.set $fd_offset (call $get_fd_offset (local.get $fd)))
       (local.set $offset
-         (array.get $offset_array (global.get $fd_offsets) (local.get $fd)))
+         (struct.get $fd_offset $offset (local.get $fd_offset)))
       (if (i32.and
              (i64.ge_s
                 (local.get $dest)
@@ -521,9 +535,9 @@
                      (i64.sub (local.get $offset) (local.get $dest))))))
          (else
             ;; ZZZ Check for error
-            (array.set $offset_array (global.get $fd_offsets) (local.get $fd)
+            (struct.set $fd_offset $offset (local.get $fd_offset)
                (local.get $dest))
-            (array.set $string (global.get $fd_seeked) (local.get $fd)
+            (struct.set $fd_offset $seeked (local.get $fd_offset)
                (i32.const 1))
             (struct.set $channel $curr (local.get $ch) (i32.const 0))
             (struct.set $channel $max (local.get $ch) (i32.const 0))))
@@ -543,30 +557,30 @@
    (func (export "caml_ml_seek_out")
       (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
+      (local $fd_offset (ref $fd_offset))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (call $caml_flush (local.get $ch))
       ;; ZZZ Check for error
-      (array.set $offset_array
-         (global.get $fd_offsets)
-         (struct.get $channel $fd (local.get $ch))
+      (local.set $fd_offset
+         (call $get_fd_offset (struct.get $channel $fd (local.get $ch))))
+      (struct.set $fd_offset $offset (local.get $fd_offset)
          (i64.extend_i32_s
             (i31.get_s (ref.cast (ref i31) (local.get $voffset)))))
-      (array.set $string (global.get $fd_seeked)
-         (struct.get $channel $fd (local.get $ch)) (i32.const 1))
+      (struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_seek_out_64")
       (param $vch (ref eq)) (param $voffset (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
+      (local $fd_offset (ref $fd_offset))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (call $caml_flush (local.get $ch))
       ;; ZZZ Check for error
-      (array.set $offset_array
-         (global.get $fd_offsets)
-         (struct.get $channel $fd (local.get $ch))
+      (local.set $fd_offset
+         (call $get_fd_offset (struct.get $channel $fd (local.get $ch))))
+      (struct.set $fd_offset $offset (local.get $fd_offset)
          (call $Int64_val (local.get $voffset)))
-      (array.set $string (global.get $fd_seeked)
-         (struct.get $channel $fd (local.get $ch)) (i32.const 1))
+      (struct.set $fd_offset $seeked (local.get $fd_offset) (i32.const 1))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_ml_input_scan_line")
@@ -646,21 +660,21 @@
 
    (func $caml_flush_partial (param $ch (ref $channel)) (result i32)
       (local $towrite i32) (local $written i32) (local $fd i32)
+      (local $fd_offset (ref $fd_offset))
       (local $offset i64) (local $buf (ref extern))
       (local.set $towrite (struct.get $channel $curr (local.get $ch)))
       (if (i32.gt_u (local.get $towrite) (i32.const 0))
          (then
             (local.set $buf (struct.get $channel $buffer (local.get $ch)))
             (local.set $fd (struct.get $channel $fd (local.get $ch)))
+            (local.set $fd_offset (call $get_fd_offset (local.get $fd)))
             (local.set $offset
-               (array.get $offset_array
-                  (global.get $fd_offsets) (local.get $fd)))
+               (struct.get $fd_offset $offset (local.get $fd_offset)))
             (try
                (do
                   (local.set $written
                      (if (result i32)
-                         (array.get_u $string (global.get $fd_seeked)
-                            (local.get $fd))
+                         (struct.get $fd_offset $seeked (local.get $fd_offset))
                         (then
                            (call $write
                               (local.get $fd)
@@ -677,8 +691,8 @@
                               (ref.null noextern))))))
                (catch $javascript_exception
                   (call $caml_handle_sys_error (pop externref))))
-            (array.set $offset_array
-               (global.get $fd_offsets) (local.get $fd)
+            (struct.set $fd_offset $offset
+               (local.get $fd_offset)
                (i64.add
                   (local.get $offset)
                   (i64.extend_i32_u (local.get $written))))
@@ -832,7 +846,9 @@
       (struct.set $channel $fd
          (ref.cast (ref $channel) (local.get 0)) (local.get 1)))
 
-   (func (export "caml_ml_get_channel_offset") (param (ref eq)) (result i64)
-      (array.get $offset_array (global.get $fd_offsets)
-         (struct.get $channel $fd (ref.cast (ref $channel) (local.get 0)))))
+   (func (export "caml_ml_get_channel_offset") (param $ch (ref eq)) (result i64)
+      (struct.get $fd_offset $offset
+         (call $get_fd_offset
+            (struct.get $channel $fd
+               (ref.cast (ref $channel) (local.get $ch))))))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 79682150b4..2fecc5c14e 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -344,6 +344,7 @@
          map_new:()=>new Map,
          map_get:(m,x)=>{var v = m.get(x); return v==undefined?null:v},
          map_set:(m,x,v)=>m.set(x,v),
+         map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
         }
     const imports = {Math:math,bindings,env:{},js,strings,fragments}

From b7eeca15af401005101eb8db58cdab3efe9df4c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 19 Dec 2023 17:17:55 +0100
Subject: [PATCH 177/481] Runtime: ignore exception when closing a channel

---
 runtime/wasm/io.wat | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 9eb222851b..6c93a15da9 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -270,7 +270,12 @@
             (struct.set $channel $fd (local.get $ch) (i32.const -1))
             (call $unregister_channel (local.get $ch))
             (call $release_fd_offset (local.get $fd))
-            (call $close (local.get $fd))))
+            (try
+               (do
+                  (call $close (local.get $fd)))
+               (catch $javascript_exception
+                  ;; ignore exception
+                  (drop (pop externref))))))
       (ref.i31 (i32.const 0)))
 
    (func $caml_do_read

From 697c110fdf32212741d93bd493435abf7483b477 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 30 Jan 2024 17:30:42 +0100
Subject: [PATCH 178/481] Update Firefox version information in readme (no
 longer beta)

I believe that Firefox 121 is no longer in beta.
---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 683998da2c..dd95304a24 100644
--- a/README.md
+++ b/README.md
@@ -8,7 +8,7 @@ Wasm_of_ocaml relies on the Binaryen toolchain ([version 116](https://github.com
 
 ## Supported engines
 
-The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and Firefox 121 (currently, [Firefox Beta](https://www.mozilla.org/en-US/firefox/channel/desktop/)).
+The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and [Firefox 121](https://www.mozilla.org/en-US/firefox/channel/desktop/).
 
 In particular, the output code requires the following [Wasm extensions](https://webassembly.org/roadmap/) to run:
 - [the GC extension](https://github.com/WebAssembly/gc), including functional references and 31-bit integers

From 0aeed9e7c8880a09ac08eb6b1608a9bb7b6a52db Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 30 Jan 2024 17:51:12 +0100
Subject: [PATCH 179/481] Use better link

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index dd95304a24..f45a5cb103 100644
--- a/README.md
+++ b/README.md
@@ -8,7 +8,7 @@ Wasm_of_ocaml relies on the Binaryen toolchain ([version 116](https://github.com
 
 ## Supported engines
 
-The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and [Firefox 121](https://www.mozilla.org/en-US/firefox/channel/desktop/).
+The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and [Firefox 121](https://www.mozilla.org/en-US/firefox/new/).
 
 In particular, the output code requires the following [Wasm extensions](https://webassembly.org/roadmap/) to run:
 - [the GC extension](https://github.com/WebAssembly/gc), including functional references and 31-bit integers

From b20bbd64d782cded0595a147dc0909b6472d7bd6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 31 Jan 2024 17:14:17 +0100
Subject: [PATCH 180/481] README: fix dune install process

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index f45a5cb103..f98e351397 100644
--- a/README.md
+++ b/README.md
@@ -26,7 +26,7 @@ utilizing
 
 The following commands will perform a minimal installation:
 ```
-opam pin add dune.3.13 https://github.com/ocaml-wasm/dune.git
+opam pin add dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm
 opam pin add -n --with-version 5.3.0-wasm .
 opam install wasm_of_ocaml-compiler
 ```

From 3f13a252e1e074ad5b2934e7731eb4d1ca3aeb59 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 31 Jan 2024 18:19:47 +0100
Subject: [PATCH 181/481] Add Stdlib.String.fold_{left,right} to build on OCaml
 < 4.13

---
 compiler/lib/stdlib.ml | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index a44be69d24..7afd1cd326 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -589,6 +589,20 @@ module Bytes = struct
   include BytesLabels
 
   let sub_string b ~pos:ofs ~len = unsafe_to_string (Bytes.sub b ofs len)
+
+  let fold_left ~f ~init b =
+    let r = ref init in
+    for i = 0 to length b - 1 do
+      r := f !r (unsafe_get b i)
+    done;
+    !r
+
+  let fold_right ~f b ~init =
+    let r = ref init in
+    for i = length b - 1 downto 0 do
+      r := f (unsafe_get b i) !r
+    done;
+    !r
 end
 
 module String = struct
@@ -998,6 +1012,10 @@ module String = struct
         | _ -> false
     in
     loop (length b - 1) b 0
+
+  let fold_left ~f ~init s = Bytes.fold_left ~f ~init (Bytes.unsafe_of_string s)
+
+  let fold_right ~f s ~init = Bytes.fold_right ~f ~init (Bytes.unsafe_of_string s)
 end
 
 module Utf8_string : sig

From 722e681189d1efada7de6ddb586b734cd2c3add8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 19 Feb 2024 16:32:30 +0100
Subject: [PATCH 182/481] Update CI

---
 tools/ci_setup.ml | 39 +++++++++++++++++++--------------------
 1 file changed, 19 insertions(+), 20 deletions(-)

diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index dc4b2bc81a..699557dd2a 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -40,34 +40,33 @@ diff --git a/sexp_grammar_validation.opam b/sexp_grammar_validation.opam
 new file mode 100644
 index 0000000..e69de29
 diff --git a/validation/src/dune b/validation/src/dune
-index 5c51676..b371eaa 100644
+index 91933ec..849e4d7 100644
 --- a/validation/src/dune
 +++ b/validation/src/dune
-@@ -1,4 +1,5 @@
- (library (name sexp_grammar_validation)
+@@ -1,5 +1,6 @@
+ (library
+  (name sexp_grammar_validation)
 + (public_name sexp_grammar_validation)
   (libraries bignum.bigint core
-   expect_test_helpers_core.expect_test_helpers_base sexp_grammar)
-  (preprocess (pps ppx_jane)))
-\ No newline at end of file
+    expect_test_helpers_core.expect_test_helpers_base sexp_grammar)
+  (preprocess
 |}
     )
   ; ( "bignum"
     , {bignum|
 diff --git a/test/src/dune b/test/src/dune
-index 89ab13d..12133a8 100644
+index f93ae3f..3f00557 100644
 --- a/test/src/dune
 +++ b/test/src/dune
-@@ -1,4 +1,5 @@
- (library (name bignum_test)
+@@ -2,5 +2,6 @@
+  (name bignum_test)
   (libraries bigint bignum core expect_test_helpers_core
-   sexp_grammar_validation)
-- (preprocess (pps ppx_jane)))
-\ No newline at end of file
+    sexp_grammar_validation)
 + (inline_tests (flags -drop-tag no-js -drop-tag no-wasm -drop-tag 64-bits-only) (modes js))
-+ (preprocess (pps ppx_jane)))
+  (preprocess
+   (pps ppx_jane)))
 diff --git a/test/src/test_bignum.ml b/test/src/test_bignum.ml
-index 47ca701..a096d6c 100644
+index c6d09fb..61b1e5b 100644
 --- a/test/src/test_bignum.ml
 +++ b/test/src/test_bignum.ml
 @@ -3,6 +3,11 @@ open! Expect_test_helpers_core
@@ -79,10 +78,10 @@ index 47ca701..a096d6c 100644
 +  module Z = Z
 +end
 +
- let%test_unit "Bignum.(//)" =
-   let open Bignum.O in
-   for i = -4 to 4 do
-@@ -62,7 +67,7 @@ let%expect_test "Bignum.sexp_of_t does use Scientific Notation" =
+ let%expect_test "Bignum.abs" =
+   let test t =
+     let t' = require_no_allocation [%here] (fun () -> abs t) in
+@@ -71,7 +76,7 @@ let%expect_test "Bignum.sexp_of_t does use Scientific Notation" =
  let compare_floats ~of_float x =
    let x' = x |> of_float |> Bignum.to_float in
    if not (Float.( = ) x x' || (Float.is_nan x && Float.is_nan x'))
@@ -91,7 +90,7 @@ index 47ca701..a096d6c 100644
  ;;
  
  let%expect_test "roundtrip: f |> Bignum.of_float_decimal |> Bignum.to_float" =
-@@ -774,7 +779,7 @@ let%test_module _ =
+@@ -783,7 +788,7 @@ let%test_module _ =
           -1073741825 -> ( 6) \001\253\255\255\255\191 |}]
      ;;
  
@@ -100,7 +99,7 @@ index 47ca701..a096d6c 100644
        bin_io_tests (module V2);
        [%expect
          {|
-@@ -802,6 +807,34 @@ let%test_module _ =
+@@ -811,6 +816,34 @@ let%test_module _ =
           -1073741825 -> ( 6) \001\253\255\255\255\191 |}]
      ;;
  

From 879ac0c741d56141be97c1820ee96c6b9e36a3aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 20 Feb 2024 15:39:56 +0100
Subject: [PATCH 183/481] Generate valid Wasm code

- Ensure that locals are always explicitely initialized before being used
- Do not declare a memory if not used
---
 compiler/bin-wasm_of_ocaml/compile.ml      |   1 -
 compiler/lib/wasm/wa_code_generation.ml    |   3 +-
 compiler/lib/wasm/wa_core_target.ml        |   2 +
 compiler/lib/wasm/wa_gc_target.ml          |   2 +
 compiler/lib/wasm/wa_generate.ml           |   1 +
 compiler/lib/wasm/wa_initialize_locals.ml  | 112 +++++++++++++++++++++
 compiler/lib/wasm/wa_initialize_locals.mli |   5 +
 compiler/lib/wasm/wa_target_sig.ml         |   6 ++
 compiler/lib/wasm/wa_wat_output.ml         |  11 +-
 9 files changed, 138 insertions(+), 5 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_initialize_locals.ml
 create mode 100644 compiler/lib/wasm/wa_initialize_locals.mli

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 2191b5e9d6..c70a990f23 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -64,7 +64,6 @@ let common_binaryen_options =
   ; "--enable-nontrapping-float-to-int"
   ; "--enable-strings"
   ; "-g"
-  ; "-n"
   ]
 
 let link runtime_files input_file output_file =
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 6ef0daca15..fd9061acc0 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -446,7 +446,8 @@ let drop e =
   match e with
   | W.Seq (l, e') ->
       let* b = is_small_constant e' in
-      if b then instrs l else instr (Drop e)
+      let* () = instrs l in
+      if b then return () else instr (Drop e')
   | _ -> instr (Drop e)
 
 let push e =
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index fc11dbf308..ddec0394a2 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -632,6 +632,8 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
         exn_handler ~result_typ ~fall_through ~context )
     ]
 
+let post_process_function_body ~param_count:_ ~locals:_ instrs = instrs
+
 let entry_point ~context:_ ~toplevel_fun =
   let code =
     let declare_global name =
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 737177c6d6..ec98462cc1 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1500,6 +1500,8 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
      in
      exn_handler ~result_typ ~fall_through ~context)
 
+let post_process_function_body = Wa_initialize_locals.f
+
 let entry_point ~context ~toplevel_fun =
   let code =
     let* f =
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 4bda507ba6..3782eefc5a 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -971,6 +971,7 @@ module Generate (Target : Wa_target_sig.S) = struct
              (fun ~result_typ ~fall_through ~context ->
                translate_branch result_typ fall_through (-1) cont context stack_ctx))
     in
+    let body = post_process_function_body ~param_count ~locals body in
     W.Function
       { name =
           (match name_opt with
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
new file mode 100644
index 0000000000..0f09311356
--- /dev/null
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -0,0 +1,112 @@
+open Stdlib
+
+type ctx =
+  { mutable initialized : IntSet.t
+  ; uninitialized : IntSet.t ref
+  }
+
+let mark_initialized ctx i = ctx.initialized <- IntSet.add i ctx.initialized
+
+let fork_context { initialized; uninitialized } = { initialized; uninitialized }
+
+let check_initialized ctx i =
+  if not (IntSet.mem i ctx.initialized)
+  then ctx.uninitialized := IntSet.add i !(ctx.uninitialized)
+
+let rec scan_expression ctx e =
+  match e with
+  | Wa_ast.Const _ | ConstSym _ | GlobalGet _ | Pop _ | RefFunc _ | RefNull _ -> ()
+  | UnOp (_, e')
+  | I32WrapI64 e'
+  | I64ExtendI32 (_, e')
+  | F32DemoteF64 e'
+  | F64PromoteF32 e'
+  | Load (_, e')
+  | Load8 (_, _, e')
+  | MemoryGrow (_, e')
+  | RefI31 e'
+  | I31Get (_, e')
+  | ArrayLen e'
+  | StructGet (_, _, _, e')
+  | RefCast (_, e')
+  | RefTest (_, e')
+  | Br_on_cast (_, _, _, e')
+  | Br_on_cast_fail (_, _, _, e')
+  | ExternInternalize e'
+  | ExternExternalize e' -> scan_expression ctx e'
+  | BinOp (_, e', e'')
+  | ArrayNew (_, e', e'')
+  | ArrayNewData (_, _, e', e'')
+  | ArrayGet (_, _, e', e'')
+  | RefEq (e', e'') ->
+      scan_expression ctx e';
+      scan_expression ctx e''
+  | LocalGet i -> check_initialized ctx i
+  | LocalTee (i, e') ->
+      scan_expression ctx e';
+      mark_initialized ctx i
+  | Call_indirect (_, e', l) | Call_ref (_, e', l) ->
+      scan_expressions ctx l;
+      scan_expression ctx e'
+  | Call (_, l) | ArrayNewFixed (_, l) | StructNew (_, l) -> scan_expressions ctx l
+  | BlockExpr (_, l) -> scan_instructions ctx l
+  | Seq (l, e') -> scan_instructions ctx (l @ [ Push e' ])
+
+and scan_expressions ctx l = List.iter ~f:(fun e -> scan_expression ctx e) l
+
+and scan_instruction ctx i =
+  match i with
+  | Wa_ast.Drop e
+  | GlobalSet (_, e)
+  | Br (_, Some e)
+  | Br_if (_, e)
+  | Br_table (e, _, _)
+  | Throw (_, e)
+  | Return (Some e)
+  | Push e -> scan_expression ctx e
+  | Store (_, e, e') | Store8 (_, e, e') | StructSet (_, _, e, e') ->
+      scan_expression ctx e;
+      scan_expression ctx e'
+  | LocalSet (i, e) ->
+      scan_expression ctx e;
+      mark_initialized ctx i
+  | Loop (_, l) | Block (_, l) -> scan_instructions ctx l
+  | If (_, e, l, l') ->
+      scan_expression ctx e;
+      scan_instructions ctx l;
+      scan_instructions ctx l'
+  | Try (_, body, catches, catch_all) ->
+      scan_instructions ctx body;
+      List.iter ~f:(fun (_, l) -> scan_instructions ctx l) catches;
+      Option.iter ~f:(fun l -> scan_instructions ctx l) catch_all
+  | CallInstr (_, l) | Return_call (_, l) -> scan_expressions ctx l
+  | Br (_, None) | Return None | Rethrow _ | Nop -> ()
+  | ArraySet (_, e, e', e'') ->
+      scan_expression ctx e;
+      scan_expression ctx e';
+      scan_expression ctx e''
+  | Return_call_indirect (_, e', l) | Return_call_ref (_, e', l) ->
+      scan_expressions ctx l;
+      scan_expression ctx e'
+
+and scan_instructions ctx l =
+  let ctx = fork_context ctx in
+  List.iter ~f:(fun i -> scan_instruction ctx i) l
+
+let f ~param_count ~locals instrs =
+  let ctx = { initialized = IntSet.empty; uninitialized = ref IntSet.empty } in
+  for i = 0 to param_count - 1 do
+    mark_initialized ctx i
+  done;
+  List.iteri
+    ~f:(fun i typ ->
+      match (typ : Wa_ast.value_type) with
+      | I32 | I64 | F32 | F64 | Ref { nullable = true; _ } ->
+          mark_initialized ctx (i + param_count)
+      | Ref { nullable = false; _ } -> ())
+    locals;
+  scan_instructions ctx instrs;
+  List.map
+    ~f:(fun i -> Wa_ast.LocalSet (i, RefI31 (Const (I32 0l))))
+    (IntSet.elements !(ctx.uninitialized))
+  @ instrs
diff --git a/compiler/lib/wasm/wa_initialize_locals.mli b/compiler/lib/wasm/wa_initialize_locals.mli
new file mode 100644
index 0000000000..53e7520699
--- /dev/null
+++ b/compiler/lib/wasm/wa_initialize_locals.mli
@@ -0,0 +1,5 @@
+val f :
+     param_count:int
+  -> locals:Wa_ast.value_type list
+  -> Wa_ast.instruction list
+  -> Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index ee43e854a2..5083d39462 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -294,6 +294,12 @@ module type S = sig
         -> unit Wa_code_generation.t)
     -> unit Wa_code_generation.t
 
+  val post_process_function_body :
+       param_count:int
+    -> locals:Wa_ast.value_type list
+    -> Wa_ast.instruction list
+    -> Wa_ast.instruction list
+
   val entry_point :
        context:Wa_code_generation.context
     -> toplevel_fun:Wa_ast.var
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 56868977e5..9f67ed28ca 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -601,9 +601,14 @@ let f ch fields =
     (List
        (Atom "module"
        :: (List.concat (List.map ~f:import fields)
-          @ [ List
-                [ Atom "memory"; Atom (string_of_int ((heap_base + 0xffff) / 0x10000)) ]
-            ]
+          @ (if Code.Var.Map.is_empty addresses
+             then []
+             else
+               [ List
+                   [ Atom "memory"
+                   ; Atom (string_of_int ((heap_base + 0xffff) / 0x10000))
+                   ]
+               ])
           @ funct_table
           @ funct_decl
           @ other_fields)))

From 5f808b256902eca288701dbf29ee30e9dfaa3091 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 21 Feb 2024 17:28:23 +0100
Subject: [PATCH 184/481] Export helper for i64 parsing

---
 runtime/wasm/int64.wat | 56 ++++++++++++++++++++++++++++--------------
 1 file changed, 37 insertions(+), 19 deletions(-)

diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index f3a42e634c..ffd203cd6c 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -123,27 +123,26 @@
          (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114)
          (i32.const 105) (i32.const 110) (i32.const 103)))
 
-   (func (export "caml_int64_of_string") (param $v (ref eq)) (result (ref eq))
-      (local $s (ref $string))
-      (local $i i32) (local $len i32) (local $d i32) (local $c i32)
-      (local $signedness i32) (local $sign i32) (local $base i32)
+   ;; Parse a sequence of digits into an i64 as dicted by $base,
+   ;; $signedness and $sign. The sequence is read in $s starting from $i.
+   ;; In case of failure raise [Failure $errmsg].
+   ;; Used by $caml_int64_of_string below and by $caml_uint64_of_string in
+   ;; package "integers".
+   (func $caml_i64_of_digits (export "caml_i64_of_digits")
+      (param $base i32) (param $signedness i32) (param $sign i32)
+      (param $s (ref $string)) (param $i i32) (param $errmsg (ref $string))
+      (result i64)
+      (local $len i32) (local $d i32) (local $c i32)
       (local $res i64) (local $threshold i64)
-      (local $t (i32 i32 i32 i32))
-      (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $len (array.len (local.get $s)))
       (if (i32.eqz (local.get $len))
-        (then (call $caml_failwith (global.get $INT64_ERRMSG))))
-      (local.set $t (call $parse_sign_and_base (local.get $s)))
-      (local.set $i (tuple.extract 0 (local.get $t)))
-      (local.set $signedness (tuple.extract 1 (local.get $t)))
-      (local.set $sign (tuple.extract 2 (local.get $t)))
-      (local.set $base (tuple.extract 3 (local.get $t)))
+        (then (call $caml_failwith (local.get $errmsg))))
       (local.set $threshold
          (i64.div_u (i64.const -1) (i64.extend_i32_u (local.get $base))))
       (local.set $d
          (call $parse_digit (array.get_u $string (local.get $s) (local.get $i))))
       (if (i32.ge_u (local.get $d) (local.get $base))
-         (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+         (then (call $caml_failwith (local.get $errmsg))))
       (local.set $res (i64.extend_i32_u (local.get $d)))
       (loop $loop
          (local.set $i (i32.add (local.get $i) (i32.const 1)))
@@ -153,15 +152,15 @@
                (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_'
                (local.set $d (call $parse_digit (local.get $c)))
                (if (i32.ge_u (local.get $d) (local.get $base))
-                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+                  (then (call $caml_failwith (local.get $errmsg))))
                (if (i64.gt_u (local.get $res) (local.get $threshold))
-                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+                  (then (call $caml_failwith (local.get $errmsg))))
                (local.set $res
                   (i64.add (i64.mul (local.get $res)
                               (i64.extend_i32_u (local.get $base)))
                            (i64.extend_i32_u (local.get $d))))
                (if (i64.lt_u (local.get $res) (i64.extend_i32_u (local.get $d)))
-                  (then (call $caml_failwith (global.get $INT64_ERRMSG))))
+                  (then (call $caml_failwith (local.get $errmsg))))
                (br $loop))))
       (if (local.get $signedness)
          (then
@@ -169,15 +168,34 @@
                (then
                   (if (i64.ge_u (local.get $res)
                                 (i64.shl (i64.const 1) (i64.const 63)))
-                     (then (call $caml_failwith (global.get $INT64_ERRMSG)))))
+                     (then (call $caml_failwith (local.get $errmsg)))))
                (else
                   (if (i64.gt_u (local.get $res)
                                 (i64.shl (i64.const 1) (i64.const 63)))
                      (then
-                        (call $caml_failwith (global.get $INT64_ERRMSG))))))))
+                        (call $caml_failwith (local.get $errmsg))))))))
       (if (i32.lt_s (local.get $sign) (i32.const 0))
          (then (local.set $res (i64.sub (i64.const 0) (local.get $res)))))
-      (return_call $caml_copy_int64 (local.get $res)))
+      (local.get $res))
+
+   (func (export "caml_int64_of_string") (param $v (ref eq)) (result (ref eq))
+      (local $s (ref $string))
+      (local $i i32) (local $signedness i32) (local $sign i32) (local $base i32)
+      (local $t (i32 i32 i32 i32))
+      (local.set $s (ref.cast (ref $string) (local.get $v)))
+      (local.set $t (call $parse_sign_and_base (local.get $s)))
+      (local.set $i (tuple.extract 0 (local.get $t)))
+      (local.set $signedness (tuple.extract 1 (local.get $t)))
+      (local.set $sign (tuple.extract 2 (local.get $t)))
+      (local.set $base (tuple.extract 3 (local.get $t)))
+      (return_call
+        $caml_copy_int64
+        (call $caml_i64_of_digits (local.get $base)
+                                  (local.get $signedness)
+                                  (local.get $sign)
+                                  (local.get $s)
+                                  (local.get $i)
+                                  (global.get $INT64_ERRMSG))))
 
    (data $caml_int64_create_lo_mi_hi "caml_int64_create_lo_mi_hi")
 

From 5c2c88249fa5f8dae50072e62d2452d834ff5675 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 14:05:01 +0100
Subject: [PATCH 185/481] Fix compilation of conditionals

Conditional where miscompiled (duplicated code) when the two branches
pointed to the same code block. This presumably happens only after CPS
transformation.
---
 compiler/lib/wasm/wa_generate.ml | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 3782eefc5a..fbb650e2b0 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -775,10 +775,11 @@ module Generate (Target : Wa_target_sig.S) = struct
     let dom = Wa_structure.dominator_tree g in
     let rec translate_tree result_typ fall_through pc context =
       let block = Addr.Map.find pc ctx.blocks in
-      let is_switch =
+      let keep_ouside pc' =
         match fst block.branch with
         | Switch _ -> true
-        | _ -> false
+        | Cond (_, (pc1, _), (pc2, _)) when pc' = pc1 && pc' = pc2 -> true
+        | _ -> Wa_structure.is_merge_node g pc'
       in
       let code ~context =
         translate_node_within
@@ -789,7 +790,7 @@ module Generate (Target : Wa_target_sig.S) = struct
             (pc
             |> Wa_structure.get_edges dom
             |> Addr.Set.elements
-            |> List.filter ~f:(fun pc' -> is_switch || Wa_structure.is_merge_node g pc')
+            |> List.filter ~f:keep_ouside
             |> Wa_structure.sort_in_post_order g)
           ~context
       in
@@ -917,13 +918,13 @@ module Generate (Target : Wa_target_sig.S) = struct
           parallel_renaming block.params args
       in
       let* () = Stack.adjust_stack stack_ctx ~src ~dst in
-      if (src >= 0 && Wa_structure.is_backward g src dst)
-         || Wa_structure.is_merge_node g dst
-      then
-        match fall_through with
-        | `Block dst' when dst = dst' -> return ()
-        | _ -> instr (Br (label_index context dst, None))
-      else translate_tree result_typ fall_through dst context
+      match fall_through with
+      | `Block dst' when dst = dst' -> return ()
+      | _ ->
+          if (src >= 0 && Wa_structure.is_backward g src dst)
+             || Wa_structure.is_merge_node g dst
+          then instr (Br (label_index context dst, None))
+          else translate_tree result_typ fall_through dst context
     in
     let bind_parameters =
       List.fold_left

From 42ba1d45866db0d31f2a620ff21498494bb336f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 14:16:16 +0100
Subject: [PATCH 186/481] CI: update node version

---
 .github/workflows/build.yml | 2 +-
 tools/node_wrapper.sh       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 6d8323f284..5245c857a7 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -31,7 +31,7 @@ jobs:
       - name: Install node
         uses: actions/setup-node@v3
         with:
-          node-version: v21.0.0-v8-canary20230928fe8cd53052
+          node-version: v22.0.0-v8-canary20231204cf8ac0f493
 
       - name: Restore cached binaryen
         id: cache-binaryen
diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh
index 0f54c51fe4..27602aadc1 100755
--- a/tools/node_wrapper.sh
+++ b/tools/node_wrapper.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively
-exec node --experimental-wasm-stack-switching --wasm-stack-switching-stack-size=90 "$@"
+exec node --experimental-wasm-stack-switching --stack-size=7000 "$@"

From 60a5094c825a4f15aca1513260bfeee8d94fd29e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 14:17:50 +0100
Subject: [PATCH 187/481] Fix compilation of caml_int32_float_of_bits

---
 compiler/lib/wasm/wa_generate.ml   | 4 ++--
 compiler/lib/wasm/wa_wat_output.ml | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index fbb650e2b0..5103209bce 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -289,11 +289,11 @@ module Generate (Target : Wa_target_sig.S) = struct
                   x
                   (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
             | Extern "caml_int32_float_of_bits", [ i ] ->
-                let* i = Memory.unbox_int64 i in
+                let* i = Memory.unbox_int32 i in
                 Memory.box_float
                   stack_ctx
                   x
-                  (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
+                  (return (W.F64PromoteF32 (UnOp (F32 ReinterpretI, i))))
             | Extern "caml_int32_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
                 Memory.box_int32 stack_ctx x (return (W.UnOp (I32 (TruncSatF64 S), f)))
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 9f67ed28ca..9c9e075796 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -226,7 +226,7 @@ let expression_or_instructions ctx in_function =
     | I32WrapI64 e -> [ List (Atom "i32.wrap_i64" :: expression e) ]
     | I64ExtendI32 (s, e) -> [ List (Atom (signage "i64.extend_i32" s) :: expression e) ]
     | F32DemoteF64 e -> [ List (Atom "f32.demote_f64" :: expression e) ]
-    | F64PromoteF32 e -> [ List (Atom "f64.promote_f64" :: expression e) ]
+    | F64PromoteF32 e -> [ List (Atom "f64.promote_f32" :: expression e) ]
     | Load (offset, e') ->
         let offs _ i =
           if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]

From a9546e98a26ab8d39bcb4f5f6eb3af3c946c8d2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 14:19:44 +0100
Subject: [PATCH 188/481] Small optimization of float comparisons

---
 compiler/lib/wasm/wa_code_generation.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index fd9061acc0..9fcdc5ec24 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -355,7 +355,6 @@ let is_smi e =
   | Const (I64 _ | F32 _ | F64 _)
   | ConstSym _
   | UnOp ((F32 _ | F64 _), _)
-  | BinOp ((F32 _ | F64 _), _, _)
   | I32WrapI64 _
   | I64ExtendI32 _
   | F32DemoteF64 _
@@ -388,7 +387,7 @@ let is_smi e =
   | ExternExternalize _
   | Br_on_cast _
   | Br_on_cast_fail _ -> false
-  | RefTest _ | RefEq _ -> true
+  | BinOp ((F32 _ | F64 _), _, _) | RefTest _ | RefEq _ -> true
 
 let get_i31_value x st =
   match st.instrs with

From 23abb1ce6b8688a5fa29bd92036abc703c0bfc77 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 14:24:27 +0100
Subject: [PATCH 189/481] Add dummy options --[no-]sourcemap

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index 431a3c74fe..0e043591de 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -49,6 +49,14 @@ let options =
     let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in
     Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc)
   in
+  let no_sourcemap =
+    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
+  in
+  let sourcemap =
+    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    Arg.(value & flag & info [ "sourcemap"; "source-map" ] ~doc)
+  in
   let sourcemap_inline_in_js =
     let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
     Arg.(value & flag & info [ "source-map-inline" ] ~doc)
@@ -61,7 +69,7 @@ let options =
       & opt_all (list (pair ~sep:'=' (enum all) string)) []
       & info [ "set" ] ~docv:"PARAM=VALUE" ~doc)
   in
-  let build_t common set_param profile _ output_file input_file runtime_files =
+  let build_t common set_param profile _ _ _ output_file input_file runtime_files =
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let output_file =
       match output_file with
@@ -77,6 +85,8 @@ let options =
       $ Jsoo_cmdline.Arg.t
       $ set_param
       $ profile
+      $ no_sourcemap
+      $ sourcemap
       $ sourcemap_inline_in_js
       $ output_file
       $ input_file

From 1b8998aebff5e02b01feba2d6cf14c973da43419 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 14:31:01 +0100
Subject: [PATCH 190/481] Write output to temporary files to ensure atomicity

---
 compiler/bin-wasm_of_ocaml/compile.ml | 26 +++++++++++++++++++++++---
 1 file changed, 23 insertions(+), 3 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index c70a990f23..1e31b66af6 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -32,6 +32,21 @@ let command cmdline =
   assert (res = 0)
 (*ZZZ*)
 
+let gen_file file f =
+  let f_tmp =
+    Filename.temp_file_name
+      ~temp_dir:(Filename.dirname file)
+      (Filename.basename file)
+      ".tmp"
+  in
+  try
+    f f_tmp;
+    (try Sys.remove file with Sys_error _ -> ());
+    Sys.rename f_tmp file
+  with exc ->
+    (try Sys.remove f_tmp with Sys_error _ -> ());
+    raise exc
+
 let write_file name contents =
   let ch = open_out name in
   output_string ch contents;
@@ -232,8 +247,10 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
       | ';' | '\n' -> trim_semi (String.sub s ~pos:0 ~len:(l - 1))
       | _ -> s
   in
+  gen_file output_file
+  @@ fun tmp_output_file ->
   write_file
-    output_file
+    tmp_output_file
     (Buffer.contents b
     ^ String.sub s ~pos:0 ~len:i
     ^ escape_string (Filename.basename wasm_file)
@@ -324,14 +341,17 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
            ic
        in
        if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-       let wat_file = Filename.chop_extension output_file ^ ".wat" in
+       gen_file (Filename.chop_extension output_file ^ ".wat")
+       @@ fun wat_file ->
        let wasm_file =
          if Filename.check_suffix output_file ".wasm.js"
          then Filename.chop_extension output_file
          else Filename.chop_extension output_file ^ ".wasm"
        in
+       gen_file wasm_file
+       @@ fun tmp_wasm_file ->
        let strings = output_gen wat_file (output code ~standalone:true) in
-       let primitives = link_and_optimize runtime_wasm_files wat_file wasm_file in
+       let primitives = link_and_optimize runtime_wasm_files wat_file tmp_wasm_file in
        build_js_runtime primitives strings wasm_file output_file
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());

From 7b1e09492190415084111eb00447b3e242810e12 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 14:43:05 +0100
Subject: [PATCH 191/481] Set binaryen options depending on flags --opt and
 --pretty

---
 compiler/bin-wasm_of_ocaml/compile.ml | 88 ++++++++++++++++-----------
 1 file changed, 51 insertions(+), 37 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 1e31b66af6..386bebcf05 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -69,26 +69,29 @@ let output_gen output_file f =
   Code.Var.set_stable (Config.Flag.stable_var ());
   Filename.gen_file output_file f
 
-let common_binaryen_options =
-  [ "--enable-gc"
-  ; "--enable-multivalue"
-  ; "--enable-exception-handling"
-  ; "--enable-reference-types"
-  ; "--enable-tail-call"
-  ; "--enable-bulk-memory"
-  ; "--enable-nontrapping-float-to-int"
-  ; "--enable-strings"
-  ; "-g"
-  ]
+let common_binaryen_options () =
+  let l =
+    [ "--enable-gc"
+    ; "--enable-multivalue"
+    ; "--enable-exception-handling"
+    ; "--enable-reference-types"
+    ; "--enable-tail-call"
+    ; "--enable-bulk-memory"
+    ; "--enable-nontrapping-float-to-int"
+    ; "--enable-strings"
+    ]
+  in
+  if Config.Flag.pretty () then "-g" :: l else l
 
 let link runtime_files input_file output_file =
   command
-    (("wasm-merge" :: common_binaryen_options)
-    @ List.flatten
-        (List.map
-           ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ])
-           runtime_files)
-    @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ])
+    ("wasm-merge"
+    :: (common_binaryen_options ()
+       @ List.flatten
+           (List.map
+              ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ])
+              runtime_files)
+       @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ]))
 
 let generate_dependencies primitives =
   Yojson.Basic.to_string
@@ -124,28 +127,37 @@ let dead_code_elimination in_file out_file =
   let primitives = Linker.get_provided () in
   write_file deps_file (generate_dependencies primitives);
   command
-    (("wasm-metadce" :: common_binaryen_options)
-    @ [ "--graph-file"
-      ; Filename.quote deps_file
-      ; Filename.quote in_file
-      ; "-o"
-      ; Filename.quote out_file
-      ; ">"
-      ; Filename.quote usage_file
-      ]);
+    ("wasm-metadce"
+    :: (common_binaryen_options ()
+       @ [ "--graph-file"
+         ; Filename.quote deps_file
+         ; Filename.quote in_file
+         ; "-o"
+         ; Filename.quote out_file
+         ; ">"
+         ; Filename.quote usage_file
+         ]));
   filter_unused_primitives primitives usage_file
 
-let optimize in_file out_file =
+let optimization_options =
+  [| [ "-O2"; "--skip-pass=inlining-optimizing" ]
+   ; [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+   ; [ "-O3"; "--traps-never-happen" ]
+  |]
+
+let optimize ~profile in_file out_file =
+  let level =
+    match profile with
+    | None -> 1
+    | Some p -> fst (List.find ~f:(fun (_, p') -> Poly.equal p p') Driver.profiles)
+  in
   command
-    (("wasm-opt" :: common_binaryen_options)
-    @ [ "-O2"
-      ; "--skip-pass=inlining-optimizing"
-      ; Filename.quote in_file
-      ; "-o"
-      ; Filename.quote out_file
-      ])
+    ("wasm-opt"
+    :: (common_binaryen_options ()
+       @ optimization_options.(level - 1)
+       @ [ Filename.quote in_file; "-o"; Filename.quote out_file ]))
 
-let link_and_optimize runtime_wasm_files wat_file output_file =
+let link_and_optimize ~profile runtime_wasm_files wat_file output_file =
   with_intermediate_file (Filename.temp_file "runtime" ".wasm")
   @@ fun runtime_file ->
   write_file runtime_file Wa_runtime.wasm_runtime;
@@ -155,7 +167,7 @@ let link_and_optimize runtime_wasm_files wat_file output_file =
   with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
   @@ fun temp_file' ->
   let primitives = dead_code_elimination temp_file temp_file' in
-  optimize temp_file' output_file;
+  optimize ~profile temp_file' output_file;
   primitives
 
 let escape_string s =
@@ -351,7 +363,9 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
        gen_file wasm_file
        @@ fun tmp_wasm_file ->
        let strings = output_gen wat_file (output code ~standalone:true) in
-       let primitives = link_and_optimize runtime_wasm_files wat_file tmp_wasm_file in
+       let primitives =
+         link_and_optimize ~profile runtime_wasm_files wat_file tmp_wasm_file
+       in
        build_js_runtime primitives strings wasm_file output_file
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());

From 17e95d0a13af0e93218b4587c9323bb293feacec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 23 Feb 2024 16:04:34 +0100
Subject: [PATCH 192/481] CI: update actions

---
 .github/workflows/build.yml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 5245c857a7..933f89b8da 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -29,13 +29,13 @@ jobs:
           git config --global core.ignorecase false
 
       - name: Install node
-        uses: actions/setup-node@v3
+        uses: actions/setup-node@v4
         with:
           node-version: v22.0.0-v8-canary20231204cf8ac0f493
 
       - name: Restore cached binaryen
         id: cache-binaryen
-        uses: actions/cache/restore@v3
+        uses: actions/cache/restore@v4
         with:
           path: binaryen
           key: ${{ runner.os }}-binaryen-version_116
@@ -62,7 +62,7 @@ jobs:
 
       - name: Cache binaryen
         if: steps.cache-binaryen.outputs.cache-hit != 'true'
-        uses: actions/cache/save@v3
+        uses: actions/cache/save@v4
         with:
           path: binaryen
           key: ${{ runner.os }}-binaryen-version_116
@@ -73,7 +73,7 @@ jobs:
 
       - name: Restore cached OCaml
         id: cache-ocaml
-        uses: actions/cache/restore@v3
+        uses: actions/cache/restore@v4
         with:
           path: |
             ~/.opam
@@ -101,7 +101,7 @@ jobs:
 
       - name: Cache OCaml
         if: steps.cache-ocaml.outputs.cache-hit != 'true'
-        uses: actions/cache/save@v3
+        uses: actions/cache/save@v4
         with:
           path: |
             ~/.opam

From 197127424338f3e342027727d315ebf1e7c69497 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Mar 2024 18:37:55 +0100
Subject: [PATCH 193/481] Make Json.output work with JavaScript values

---
 lib/js_of_ocaml/json.ml | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/lib/js_of_ocaml/json.ml b/lib/js_of_ocaml/json.ml
index d584ab8e83..a99b3a521a 100644
--- a/lib/js_of_ocaml/json.ml
+++ b/lib/js_of_ocaml/json.ml
@@ -93,6 +93,10 @@ let rec write b v =
             (Int64.logand (Int64.shift_right i 24) mask24)
             (Int64.logand (Int64.shift_right i 48) mask16)
       | id -> failwith (Printf.sprintf "Json.output: unsupported custom value %s " id)
+    else if t = Obj.abstract_tag
+    then
+      (* Presumably a JavaScript value *)
+      Buffer.add_string b (Js.to_string (Unsafe.global##_JSON##stringify v))
     else failwith (Printf.sprintf "Json.output: unsupported tag %d " t)
 
 let to_json v =

From 2948ad4088e669c0e8a97d1d013520a9c030a404 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Mar 2024 18:38:47 +0100
Subject: [PATCH 194/481] Runtime: fix wasm-metadce dependency file

---
 runtime/wasm/deps.json | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 2f93773eca..12c5230deb 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -45,23 +45,23 @@
     "reaches": ["callback"]
   },
   {
-    "name": "meth_wrap_callback",
-    "import": ["bindings", "meth_wrap_callback"],
+    "name": "wrap_meth_callback",
+    "import": ["bindings", "wrap_meth_callback"],
     "reaches": ["callback"]
   },
   {
-    "name": "meth_wrap_callback_args",
-    "import": ["bindings", "meth_wrap_callback_args"],
+    "name": "wrap_meth_callback_args",
+    "import": ["bindings", "wrap_meth_callback_args"],
     "reaches": ["callback"]
   },
   {
-    "name": "meth_wrap_callback_strict",
-    "import": ["bindings", "meth_wrap_callback_strict"],
+    "name": "wrap_meth_callback_strict",
+    "import": ["bindings", "wrap_meth_callback_strict"],
     "reaches": ["callback"]
   },
   {
-    "name": "meth_wrap_callback_unsafe",
-    "import": ["bindings", "meth_wrap_callback_unsafe"],
+    "name": "wrap_meth_callback_unsafe",
+    "import": ["bindings", "wrap_meth_callback_unsafe"],
     "reaches": ["callback"]
   },
   {

From b15a002da258341c8415b037c6112cd5e2b20c22 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Mar 2024 18:40:35 +0100
Subject: [PATCH 195/481] float_of_string: allow leading whitespaces

---
 runtime/wasm/float.wat | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 0670a12fd9..31c4f9b38d 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -508,10 +508,18 @@
                      (br $copy))))
             (local.set $len (array.len (local.get $s')))
             (local.set $s (local.get $s'))))
+      (local.set $i (i32.const 0))
+      (loop $skip_spaces
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (if (i32.eq (i32.const 32) ;; ' '
+                           (array.get $string (local.get $s) (local.get $i)))
+                  (then
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $skip_spaces))))))
       (block $error
-         (br_if $error (i32.eqz (local.get $len)))
+         (br_if $error (i32.eq (local.get $i) (local.get $len)))
          (local.set $c (array.get_u $string (local.get $s) (i32.const 0)))
-         (local.set $i (i32.const 0))
          (if (i32.eq (local.get $c) (i32.const 45)) ;; '-'
             (then
                (local.set $negative (i32.const 1))

From 74385069975cfd66f190bca40f0b05f10e6ca6ba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Mar 2024 18:41:12 +0100
Subject: [PATCH 196/481] Runtime: fix caml_wrap_exception

---
 runtime/wasm/jslib.wat | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 8e309ab92f..008ce560f0 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -647,7 +647,10 @@
             (call $wrap
                (call $meth_call
                   (local.get $exn)
-                  (array.new_data $string $toString (i32.const 0) (i32.const 8))
+                  (call $unwrap
+                     (call $caml_jsstring_of_string
+                        (array.new_data $string $toString
+                           (i32.const 0) (i32.const 8))))
                   (extern.internalize (call $new_array (i32.const 0))))))))
 
    (func (export "caml_js_error_option_of_exception")

From 3da57a7b3d95c13cfc6d8cb8653d6d23ea37486b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Mar 2024 18:41:43 +0100
Subject: [PATCH 197/481] Runtime: fix caml_ojs_iterate_properties

---
 runtime/wasm/runtime.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 2fecc5c14e..02345f0915 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -111,7 +111,7 @@
          new_obj:()=>({}),
          new:(c,args)=>new c(...args),
          global_this:globalThis,
-         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwnsProperty(nm)) f(nm)},
+         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwnProperty(nm)) f(nm)},
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,

From 4e1fa990085091089dee27a71b54184f39d4e1ee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Mar 2024 19:50:37 +0100
Subject: [PATCH 198/481] Runtime: fix eval to work with any JavaScript
 exception

---
 lib/tests/test_poly_compare.ml | 2 +-
 runtime/wasm/runtime.js        | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/tests/test_poly_compare.ml b/lib/tests/test_poly_compare.ml
index ff60a3fcba..b9799cc8db 100644
--- a/lib/tests/test_poly_compare.ml
+++ b/lib/tests/test_poly_compare.ml
@@ -102,7 +102,7 @@ let%expect_test "object comparison" =
   assert (compare s1 s1 = 0);
   assert (compare s1 s2 = 1);
   assert (compare s2 s1 = 1)
-[@@expect.uncaught_exn {| "Assert_failure lib/tests/test_poly_compare.ml:100:2" |}]
+[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
 
 let%expect_test "poly compare" =
   let l =
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 02345f0915..ba356f46a1 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -378,5 +378,5 @@
             event.error&&caml_handle_uncaught_exception(event.error))
     }
     await _initialize();
-})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval(x))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
+})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval("("+x+")"))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
    PRIMITIVES, STRINGS);

From 7305847fe0c2a6a06060dd4ef72792e792778d07 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Mar 2024 19:50:52 +0100
Subject: [PATCH 199/481] Runtime: add stub for caml_sys_is_directory

---
 runtime/wasm/fs.wat | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index acf98f57c1..d1653ea7f7 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -121,4 +121,13 @@
 
    (func (export "caml_fs_init") (result (ref eq))
       (ref.i31 (i32.const 0)))
+
+   (data $caml_sys_is_directory "caml_sys_is_directory")
+
+   (func (export "caml_sys_is_directory") (param (ref eq)) (result (ref eq))
+      ;; ZZZ
+      (call $log_str
+         (array.new_data $string $caml_sys_is_directory
+            (i32.const 0) (i32.const 21)))
+      (ref.i31 (i32.const 0)))
 )

From a1eb7bc9b0a8c96288c4d0dc90c7a2cd86b989c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Mar 2024 23:25:11 +0100
Subject: [PATCH 200/481] Effects/runtime: export the current suspender

---
 runtime/wasm/effect.wat | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index adb2a4f5f1..299024bf13 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -43,7 +43,8 @@
    (import "bindings" "resume_fiber"
       (func $resume_fiber (param externref) (param (ref eq))))
 
-   (global $current_suspender (mut (externref)) (ref.null extern))
+   (global $current_suspender (export "current_suspender")
+      (mut (externref)) (ref.null extern))
 
    ;; Capturing the current continuation
 

From 63209157d8bf6df5b9db347b542f053252859c51 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Mar 2024 23:27:00 +0100
Subject: [PATCH 201/481] Runtime: fix printing of negative NaN

---
 runtime/wasm/float.wat | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 31c4f9b38d..070f9888ac 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -65,9 +65,6 @@
                         (then
                            (global.get $infinity))
                         (else
-                           (local.set $sign (i32.const 0))
-                           (local.set $i
-                              (i32.ne (local.get $style) (i32.const 45)))
                            (global.get $nan))))
                   (local.set $len (array.len (local.get $txt)))
                   (local.set $s

From 5741b980a4800f1060a64880b39cca6657d03e68 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Mar 2024 23:40:20 +0100
Subject: [PATCH 202/481] Runtime: rename some internal hash functions for
 consistency

---
 runtime/wasm/bigarray.wat | 10 +++++-----
 runtime/wasm/hash.wat     |  6 +++---
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 495d8ef4e5..0f31b2b3ea 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -67,10 +67,10 @@
       (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
    (import "hash" "caml_hash_mix_int64"
       (func $caml_hash_mix_int64 (param i32) (param i64) (result i32)))
+   (import "hash" "caml_hash_mix_double"
+      (func $caml_hash_mix_double (param i32) (param f64) (result i32)))
    (import "hash" "caml_hash_mix_float"
-      (func $caml_hash_mix_float (param i32) (param f64) (result i32)))
-   (import "hash" "caml_hash_mix_float32"
-      (func $caml_hash_mix_float32 (param i32) (param f32) (result i32)))
+      (func $caml_hash_mix_float (param i32) (param f32) (result i32)))
    (import "marshal" "caml_serialize_int_1"
       (func $caml_serialize_int_1 (param (ref eq)) (param i32)))
    (import "marshal" "caml_serialize_int_2"
@@ -342,7 +342,7 @@
           (if (i32.lt_u (local.get $i) (local.get $len))
              (then
                 (local.set $h
-                   (call $caml_hash_mix_float32 (local.get $h)
+                   (call $caml_hash_mix_float (local.get $h)
                       (f32.demote_f64
                          (call $ta_get_f32 (local.get $data) (local.get $i)))))
                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
@@ -355,7 +355,7 @@
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
                (local.set $h
-                  (call $caml_hash_mix_float (local.get $h)
+                  (call $caml_hash_mix_double (local.get $h)
                      (call $ta_get_f64 (local.get $data) (local.get $i))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index a6d5f65063..64a2139a33 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -64,7 +64,7 @@
          (call $caml_hash_mix_int (local.get $h) (i32.wrap_i64 (local.get $d)))
          (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
 
-   (func $caml_hash_mix_float (export "caml_hash_mix_float")
+   (func $caml_hash_mix_double (export "caml_hash_mix_double")
       (param $h i32) (param $d f64) (result i32)
       (local $i i64)
       (local.set $i (i64.reinterpret_f64 (local.get $d)))
@@ -78,7 +78,7 @@
          (then (local.set $i (i64.const 0))))
       (return_call $caml_hash_mix_int64 (local.get $h) (local.get $i)))
 
-   (func $caml_hash_mix_float32 (export "caml_hash_mix_float32")
+   (func $caml_hash_mix_float (export "caml_hash_mix_float")
       (param $h i32) (param $d f32) (result i32)
       (local $i i32)
       (local.set $i (i32.reinterpret_f32 (local.get $d)))
@@ -257,7 +257,7 @@
                         (br $block_iter))))
                   (drop (block $not_float (result (ref eq))
                      (local.set $h
-                        (call $caml_hash_mix_float (local.get $h)
+                        (call $caml_hash_mix_double (local.get $h)
                            (struct.get $float 0
                               (br_on_cast_fail $not_float (ref eq) (ref $float)
                                  (local.get $v)))))

From 6218e0f1cc550f6202d7e14da05632fcbaae96ed Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Mar 2024 23:13:48 +0100
Subject: [PATCH 203/481] Runtime: add a global 'caml_marhsal_header_size'

---
 runtime/wasm/marshal.wat | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 71cd4dc323..c764abe36b 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -31,6 +31,9 @@
       (func $caml_find_custom_operations
          (param (ref $string)) (result (ref null $custom_operations))))
 
+   (global $caml_marshal_header_size (export "caml_marshal_header_size")
+      (mut i32) (i32.const 20))
+
    (global $input_val_from_string (ref $string)
       (array.new_fixed $string 21
          (i32.const 105) (i32.const 110) (i32.const 112) (i32.const 117)
@@ -703,7 +706,11 @@
             (call $bad_object
                (array.new_data $string $marshal_data_size
                   (i32.const 0) (i32.const 17)))))
-      (ref.i31 (call $read32 (local.get $s))))
+      (ref.i31
+         (i32.add
+            (i32.sub (i32.const 20)
+               (global.get $caml_marshal_header_size))
+            (call $read32 (local.get $s)))))
 
    (type $output_block
       (struct

From f99659dcb20486bafeafa3854b46972e511fda43 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 9 Mar 2024 00:55:34 +0100
Subject: [PATCH 204/481] Fix CI

Pin a fixed version of the Jane Street opam repository.
---
 .github/workflows/build.yml |  1 +
 tools/ci_setup.ml           | 32 ++++++++++++++++++++++++++++----
 2 files changed, 29 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 933f89b8da..2a66055b2e 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -118,6 +118,7 @@ jobs:
         uses: actions/checkout@v4
         with:
           repository: janestreet/opam-repository
+          ref: feaf8f831051fd5f316963b28efd728cf0b0eca1
           path: jane-street/opam-repository
 
       - name: Pin dune
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index 699557dd2a..72f48c99c1 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -191,6 +191,8 @@ let exec_async ~delay cmd =
   in
   fun () -> ignore (Unix.close_process_out p)
 
+let ( let* ) (f : unit -> 'a) (g : 'a -> unit -> 'b) : unit -> 'b = g (f ())
+
 let sync_exec f l =
   let l = List.mapi f l in
   List.iter (fun f -> f ()) l
@@ -215,17 +217,27 @@ let install_others others =
   let others = StringSet.elements (StringSet.diff others omitted_others) in
   ignore (Sys.command ("opam install -y " ^ String.concat " " others))
 
-let clone delay ?branch nm src =
+let clone delay ?branch ?(depth = 1) nm src =
   exec_async
     ~delay
     (Printf.sprintf
-       "git clone -q --depth 1 %s%s jane-street/lib/%s"
+       "git clone -q --depth %d %s%s jane-street/lib/%s"
+       depth
        (match branch with
        | None -> ""
        | Some b -> Printf.sprintf "-b %s " b)
        src
        nm)
 
+let clone' delay ?branch ?commit nm src =
+  match commit with
+  | None -> clone delay ?branch nm src
+  | Some commit ->
+      let* () = clone delay ?branch ~depth:10 nm src in
+      exec_async
+        ~delay:0
+        (Printf.sprintf "cd jane-street/lib/%s && git checkout %s" nm commit)
+
 let () =
   Out_channel.(
     with_open_bin "jane-street/dune-workspace"
@@ -241,9 +253,21 @@ let () =
   sync_exec (fun i () -> clone i "ocaml-uri" "https://github.com/mirage/ocaml-uri") [ () ];
   sync_exec
     (fun i nm ->
-      clone
+      let branch = if is_forked nm then Some "wasm" else None in
+      let commit =
+        if is_forked nm
+        then None
+        else
+          Some
+            (let _, opam = List.assoc nm packages in
+             let url = OpamUrl.to_string (Option.get (OpamFile.OPAM.get_url opam)) in
+             let tar_file = Filename.basename url in
+             String.sub tar_file 0 (String.index tar_file '.'))
+      in
+      clone'
         i
-        ?branch:(if is_forked nm then Some "wasm" else None)
+        ?branch
+        ?commit
         nm
         (Printf.sprintf
            "https://github.com/%s/%s"

From bdf39848bc00ceff9ac26f36ca38fb3d04e75166 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Mar 2024 04:14:37 +0100
Subject: [PATCH 205/481] Runtime: syntax fixes

---
 runtime/wasm/bigarray.wat  | 31 +++++++++++++++++--------------
 runtime/wasm/bigstring.wat |  4 ++--
 runtime/wasm/compare.wat   |  4 ++--
 runtime/wasm/effect.wat    | 23 +++++++++++------------
 runtime/wasm/float.wat     | 14 +++++++-------
 runtime/wasm/hash.wat      |  2 +-
 runtime/wasm/int64.wat     | 10 ++++------
 runtime/wasm/ints.wat      |  4 ++--
 runtime/wasm/io.wat        |  4 ++--
 runtime/wasm/jslib.wat     | 10 +++++-----
 runtime/wasm/marshal.wat   |  2 +-
 runtime/wasm/nat.wat       |  6 ++++--
 runtime/wasm/obj.wat       |  2 +-
 runtime/wasm/stdlib.wat    |  3 +--
 runtime/wasm/string.wat    |  8 ++++----
 15 files changed, 64 insertions(+), 63 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 0f31b2b3ea..f969ed227a 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -954,7 +954,7 @@
       (if (i32.ge_u (local.get $i)
              (array.get $int_array (struct.get $bigarray 2 (local.get $ba))
                 (i32.const 0)))
-         (call $caml_bound_error))
+         (then (call $caml_bound_error)))
       (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i)))
 
    (func (export "caml_ba_set_1")
@@ -968,7 +968,7 @@
       (if (i32.ge_u (local.get $i)
              (array.get $int_array (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
-         (call $caml_bound_error))
+         (then (call $caml_bound_error)))
       (call $caml_ba_set_at_offset
          (local.get $ba) (local.get $i) (local.get $v))
       (ref.i31 (i32.const 0)))
@@ -1548,14 +1548,16 @@
       (local.set $ddim (struct.get $bigarray $ba_dim (local.get $dst)))
       (loop $loop
          (if (i32.lt_s (local.get $i) (local.get $len))
-            (if (i32.ne (array.get $int_array (local.get $sdim) (local.get $i))
-                        (array.get $int_array (local.get $ddim) (local.get $i)))
-               (then
-                  (call $caml_invalid_argument
-                     (array.new_data $string $dim_mismatch
-                        (i32.const 0) (i32.const 33)))))
-            (local.set $i (i32.add (local.get $i) (i32.const 1)))
-            (br $loop)))
+            (then
+               (if (i32.ne
+                      (array.get $int_array (local.get $sdim) (local.get $i))
+                      (array.get $int_array (local.get $ddim) (local.get $i)))
+                  (then
+                     (call $caml_invalid_argument
+                        (array.new_data $string $dim_mismatch
+                           (i32.const 0) (i32.const 33)))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
       (call $ta_blit
          (struct.get $bigarray $ba_data (local.get $src))
          (struct.get $bigarray $ba_data (local.get $dst)))
@@ -1710,9 +1712,10 @@
                       (struct.get $bigarray $ba_dim (local.get $b2))
                       (local.get $i)))
                 (if (i32.ne (local.get $i1) (local.get $i2))
-                   (return
-                      (select (i32.const -1) (i32.const 1)
-                         (i32.lt_u (local.get $i1) (local.get $i2)))))
+                   (then
+                      (return
+                         (select (i32.const -1) (i32.const 1)
+                            (i32.lt_u (local.get $i1) (local.get $i2))))))
                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
                 (br $loop))))
       (local.set $d1 (struct.get $bigarray $ba_data (local.get $b1)))
@@ -2107,7 +2110,7 @@
 
    (func (export "caml_ba_set_data") (param (ref eq)) (param (ref extern))
       (struct.set $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0))
-         (local.get $1)))
+         (local.get 1)))
 
    (func (export "caml_ba_get_dim") (param (ref eq)) (result (ref $int_array))
       (struct.get $bigarray $ba_dim (ref.cast (ref $bigarray) (local.get 0))))
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index c06443644b..549a9fb742 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -96,11 +96,11 @@
    (func (export "bigstring_of_array_buffer") (param (ref eq)) (result (ref eq))
        (return_call $caml_ba_from_typed_array
           (call $wrap
-             (call $ta_create (i32.const 12) (call $unwrap (local.get $0))))))
+             (call $ta_create (i32.const 12) (call $unwrap (local.get 0))))))
 
    (func (export "bigstring_of_typed_array") (param (ref eq)) (result (ref eq))
        (return_call $caml_ba_from_typed_array
-          (call $wrap (call $ta_bytes (call $unwrap (local.get $0))))))
+          (call $wrap (call $ta_bytes (call $unwrap (local.get 0))))))
 
    (func (export "caml_bigstring_memset")
       (param $s (ref eq)) (param $pos (ref eq)) (param $len (ref eq))
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 0b3e85e1e5..71779e42b7 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -148,8 +148,8 @@
       (local $c1 i32) (local $c2 i32)
       (if (ref.eq (local.get $s1) (local.get $s2))
          (then (return (i32.const 0))))
-      (local.set $l1 (array.len $string (local.get $s1)))
-      (local.set $l2 (array.len $string (local.get $s2)))
+      (local.set $l1 (array.len (local.get $s1)))
+      (local.set $l2 (array.len (local.get $s2)))
       (local.set $len (select (local.get $l1) (local.get $l2)
                          (i32.le_u (local.get $l1) (local.get $l2))))
       (local.set $i (i32.const 0))
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 299024bf13..8c08e0f476 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -12,6 +12,13 @@
       (tag $javascript_exception (param externref)))
    (import "jslib" "caml_wrap_exception"
       (func $caml_wrap_exception (param externref) (result (ref eq))))
+   (import "bindings" "start_fiber" (func $start_fiber (param (ref eq))))
+   (import "bindings" "suspend_fiber"
+      (func $suspend_fiber
+         (param externref) (param $f funcref) (param $env eqref)
+         (result eqref)))
+   (import "bindings" "resume_fiber"
+      (func $resume_fiber (param externref) (param (ref eq))))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -35,16 +42,8 @@
 
    ;; Low-level primitives
 
-   (import "bindings" "start_fiber" (func $start_fiber (param (ref eq))))
-   (import "bindings" "suspend_fiber"
-      (func $suspend_fiber
-         (param externref) (param $f funcref) (param $env eqref)
-         (result eqref)))
-   (import "bindings" "resume_fiber"
-      (func $resume_fiber (param externref) (param (ref eq))))
-
-   (global $current_suspender (export "current_suspender")
-      (mut (externref)) (ref.null extern))
+   (global $current_suspender (export "current_suspender") (mut externref)
+      (ref.null extern))
 
    ;; Capturing the current continuation
 
@@ -375,7 +374,7 @@
          (ref.i31 (i32.const 0))))
       (local.get $stack))
 
-   (func (export $caml_get_continuation_callstack)
+   (func (export "caml_get_continuation_callstack")
       (param (ref eq)) (result (ref eq))
       (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
@@ -532,7 +531,7 @@
             (do
                (local.set $res
                   (if (result (ref eq))
-                      (i32.eq (array.len $block (local.get $args)) (i32.const 1))
+                      (i32.eq (array.len (local.get $args)) (i32.const 1))
                      (then
                         (call_ref $function_1 (global.get $identity)
                            (local.get $f)
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 070f9888ac..36972f5f2a 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -410,7 +410,7 @@
                            (then
                               (return (f64.const 0)))
                            (else
-                              (return (f64.const infinity))))))
+                              (return (f64.const inf))))))
                   (if (i32.and (i32.ge_u (local.get $c) (i32.const 48))
                                (i32.le_u (local.get $c) (i32.const 57)))
                      (then
@@ -575,8 +575,8 @@
                            (return
                               (struct.new $float
                                  (select
-                                    (f64.const -infinity)
-                                    (f64.const infinity)
+                                    (f64.const -inf)
+                                    (f64.const inf)
                                     (local.get $negative))))))))))))
          (if (i32.eq (i32.add (local.get $i) (i32.const 8)) (local.get $len))
             (then
@@ -632,8 +632,8 @@
                                        (return
                                           (struct.new $float
                                              (select
-                                                (f64.const -infinity)
-                                                (f64.const infinity)
+                                                (f64.const -inf)
+                                                (f64.const inf)
                                                 (local.get $negative))))
                                        ))))))))))))))))))
          (local.set $f
@@ -675,7 +675,7 @@
       (ref.i31
          (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
             (then
-               (if (result i32) (f64.lt (local.get $a) (f64.const infinity))
+               (if (result i32) (f64.lt (local.get $a) (f64.const inf))
                   (then (i32.const 0)) ;; normal
                   (else (i32.const 3)))) ;; infinity
             (else
@@ -692,7 +692,7 @@
       (local.set $a (f64.abs (local.get $x)))
       (if (f64.ge (local.get $a) (f64.const 0))
          (then
-            (if (f64.lt (local.get $a) (f64.const infinity))
+            (if (f64.lt (local.get $a) (f64.const inf))
                (then ;; normal
                   (local.set $i (f64.floor (local.get $a)))
                   (local.set $f (f64.sub (local.get $a) (local.get $i)))
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index 64a2139a33..7aa9965b30 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -276,7 +276,7 @@
                                           (local.get $v))))))))
                      (local.set $num (i32.sub (local.get $num) (i32.const 1)))
                      (br $loop)))
-                  (drop (block $not_jsstring anyref
+                  (drop (block $not_jsstring (result anyref)
                      (local.set $str
                         (struct.get $js 0
                            (br_on_cast_fail $not_jsstring (ref eq) (ref $js)
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index f3a42e634c..70fb6621b6 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -12,6 +12,10 @@
       (func $caml_serialize_int_8 (param (ref eq)) (param i64)))
    (import "marshal" "caml_deserialize_int_8"
       (func $caml_deserialize_int_8 (param (ref eq)) (result i64)))
+   (import "ints" "lowercase_hex_table"
+      (global $lowercase_hex_table (ref $chars)))
+   (import "ints" "uppercase_hex_table"
+      (global $uppercase_hex_table (ref $chars)))
 
    (type $string (array (mut i8)))
    (type $compare
@@ -218,12 +222,6 @@
 
    (type $chars (array i8))
 
-   (import "ints" "lowercase_hex_table"
-      (global $lowercase_hex_table (ref $chars)))
-
-   (import "ints" "uppercase_hex_table"
-      (global $uppercase_hex_table (ref $chars)))
-
    (func (export "caml_int64_format")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $d i64)
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index 47da923c71..addfedcd9e 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -26,9 +26,9 @@
             (if (i32.eq (local.get $c) (i32.const 45))
                (then
                   (local.set $sign (i32.const -1))
-                  (local.set $i (i32.const 1))))
+                  (local.set $i (i32.const 1)))
                (else (if (i32.eq (local.get $c) (i32.const 43))
-                  (then (local.set $i (i32.const 1)))))))
+                  (then (local.set $i (i32.const 1))))))))
       (if (i32.lt_s (i32.add (local.get $i) (i32.const 1)) (local.get $len))
          (then (if (i32.eq (array.get_u $string (local.get $s) (local.get $i))
                            (i32.const 48))
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 6c93a15da9..1115bf2323 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -404,7 +404,7 @@
       (param $vlen (ref eq)) (result (ref eq))
       (local $ch (ref $channel)) (local $s (ref $string))
       (local $pos i32) (local $len i32) (local $curr i32)
-      (local $i i32) (local $avail i32) (local $nread $i32)
+      (local $i i32) (local $avail i32) (local $nread i32)
       (local $buf (ref extern))
       (local.set $ch (ref.cast (ref $channel) (local.get $vch)))
       (local.set $s (ref.cast (ref $string) (local.get $vs)))
@@ -770,7 +770,7 @@
       (call $caml_flush_if_unbuffered (local.get $ch))
       (ref.i31 (i32.const 0)))
 
-   (func $caml_putch (param $ch (ref $channel)) (param $c $i32)
+   (func $caml_putch (param $ch (ref $channel)) (param $c i32)
       (local $curr i32)
       (if (i32.ge_u (struct.get $channel $curr (local.get $ch))
              (struct.get $channel $size (local.get $ch)))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 008ce560f0..a0bff6e1e9 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -561,11 +561,11 @@
                      (array.set $string (local.get $s'')
                         (local.get $n)
                         (i32.sub
-                           (i32.or
+                           (i32.add
                               (i32.shl (local.get $c) (i32.const 6))
                               (array.get_u $string (local.get $s')
                                  (i32.add (local.get $i) (i32.const 1))))
-                           (i32.const 0X3080)))
+                           (i32.const 0x3080)))
                      (local.set $i (i32.add (local.get $i) (i32.const 2)))))
                (local.set $n (i32.add (local.get $n) (i32.const 1)))
                (br $fill))))
@@ -631,7 +631,7 @@
 
    (data $toString "toString")
 
-   (func (export "caml_wrap_exception") (param (externref)) (result (ref eq))
+   (func (export "caml_wrap_exception") (param externref) (result (ref eq))
       (local $exn anyref)
       (local.set $exn (extern.internalize (local.get 0)))
       ;; ZZZ special case for stack overflows?
@@ -656,7 +656,7 @@
    (func (export "caml_js_error_option_of_exception")
       (param (ref eq)) (result (ref eq))
       (local $exn (ref $block))
-      (local.set $exn (ref.cast (ref $block) (local.get $0)))
+      (local.set $exn (ref.cast (ref $block) (local.get 0)))
       (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
                   (ref.i31 (i32.const 0)))
          (then
@@ -671,7 +671,7 @@
    (func (export "caml_js_error_of_exception")
       (param (ref eq)) (result (ref eq))
       (local $exn (ref $block))
-      (local.set $exn (ref.cast (ref $block) (local.get $0)))
+      (local.set $exn (ref.cast (ref $block) (local.get 0)))
       (if (ref.eq (array.get $block (local.get $exn) (i32.const 0))
                   (ref.i31 (i32.const 0)))
          (then
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index c764abe36b..1e00a47796 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -992,7 +992,7 @@
             (local.get $d)))))))
 
    (func $extern_header
-      (param $s (ref $extern_state)) (param $sz (i32)) (param $tag i32)
+      (param $s (ref $extern_state)) (param $sz i32) (param $tag i32)
       (if (i32.and (i32.lt_u (local.get $tag) (i32.const 16))
              (i32.lt_u (local.get $sz) (i32.const 8)))
          (then
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index f684c01f58..bac430d8cc 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -72,7 +72,8 @@
       (local.set $carry (i31.get_s (ref.cast (ref i31) (local.get $carry_in))))
       (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (if (i32.eqz (local.get $carry)) (return (ref.i31 (i32.const 0))))
+      (if (i32.eqz (local.get $carry))
+         (then (return (ref.i31 (i32.const 0)))))
       (loop $loop
          (if (i32.lt_s (local.get $i) (local.get $len))
             (then
@@ -101,7 +102,8 @@
       (local.set $carry (i31.get_s (ref.cast (ref i31) (local.get $carry_in))))
       (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (if (i32.eqz (local.get $carry)) (return (ref.i31 (i32.const 0))))
+      (if (i32.eqz (local.get $carry))
+         (then (return (ref.i31 (i32.const 0)))))
       (loop $loop
          (if (i32.lt_s (local.get $i) (local.get $len))
             (then
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 9c9c66fec5..402028e983 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -344,7 +344,7 @@
       (array.new $int_array (i32.const 0) (i32.const 8)))
 
    (func (export "caml_get_public_method")
-      (param $obj (ref eq) (ref eq) (ref eq)) (result (ref eq))
+      (param $obj (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $meths (ref $block))
       (local $tag i32) (local $cacheid i32) (local $ofs i32)
       (local $li i32) (local $mi i32) (local $hi i32)
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index fc1441d764..d91c2a744e 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -26,6 +26,7 @@
    (import "sys" "ocaml_exit" (tag $ocaml_exit (param i32)))
    (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
    (import "bindings" "exit" (func $exit (param i32)))
+   (import "bindings" "throw" (func $throw (param externref)))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -161,8 +162,6 @@
 
    (global $uncaught_exception (mut externref) (ref.null extern))
 
-   (import "bindings" "throw" (func $throw (param externref)))
-
    (func $reraise_exception (result (ref eq))
       (call $throw (global.get $uncaught_exception))
       (ref.i31 (i32.const 0)))
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index ad059c13c2..b59309911c 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -22,8 +22,8 @@
          (then (return (ref.i31 (i32.const 1)))))
       (local.set $s1 (ref.cast (ref $string) (local.get $p1)))
       (local.set $s2 (ref.cast (ref $string) (local.get $p2)))
-      (local.set $len (array.len $string (local.get $s1)))
-      (if (i32.ne (local.get $len) (array.len $string (local.get $s2)))
+      (local.set $len (array.len (local.get $s1)))
+      (if (i32.ne (local.get $len) (array.len (local.get $s2)))
          (then (return (ref.i31 (i32.const 0)))))
       (local.set $i (i32.const 0))
       (loop $loop
@@ -52,8 +52,8 @@
          (then (return (i32.const 0))))
       (local.set $s1 (ref.cast (ref $string) (local.get $p1)))
       (local.set $s2 (ref.cast (ref $string) (local.get $p2)))
-      (local.set $l1 (array.len $string (local.get $s1)))
-      (local.set $l2 (array.len $string (local.get $s2)))
+      (local.set $l1 (array.len (local.get $s1)))
+      (local.set $l2 (array.len (local.get $s2)))
       (local.set $len (select (local.get $l1) (local.get $l2)
                           (i32.le_u (local.get $l1) (local.get $l2))))
       (local.set $i (i32.const 0))

From a345e5438e6a01641121860e9ae9ddd7173d40a3 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 12 Mar 2024 15:06:42 +0100
Subject: [PATCH 206/481] Correction and precision about Binaryen version

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index f98e351397..e828d42ee5 100644
--- a/README.md
+++ b/README.md
@@ -4,7 +4,7 @@ Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssem
 
 ## Requirements
 
-Wasm_of_ocaml relies on the Binaryen toolchain ([version 116](https://github.com/WebAssembly/binaryen/releases/tag/version_116) or greater).
+Wasm_of_ocaml relies on the Binaryen toolchain; currently, only [version 116](https://github.com/WebAssembly/binaryen/releases/tag/version_116) is supported. Binaryen commands must be in the PATH for wasm_of_ocaml to function.
 
 ## Supported engines
 

From 9ea1891a10a2e522bd41f3459eb86b34fa0d6f92 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 12 Mar 2024 16:29:31 +0100
Subject: [PATCH 207/481] CI: fix checkout performance

---
 tools/ci_setup.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index 72f48c99c1..fb162b2be3 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -191,7 +191,7 @@ let exec_async ~delay cmd =
   in
   fun () -> ignore (Unix.close_process_out p)
 
-let ( let* ) (f : unit -> 'a) (g : 'a -> unit -> 'b) : unit -> 'b = g (f ())
+let ( let* ) (f : unit -> 'a) (g : 'a -> unit -> 'b) : unit -> 'b = fun () -> g (f ()) ()
 
 let sync_exec f l =
   let l = List.mapi f l in

From 4e0ff8142ec77589d01cfafaa0abfa966c6dd504 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 9 Mar 2024 05:18:13 +0100
Subject: [PATCH 208/481] Correct elimination of access of a known structure

We could generate invalid code for `Obj.set_field x 0 (Obj.repr f)` in
`Lazy.from_fun` (OCaml 4.14) when `f` is a known function.
---
 compiler/lib/wasm/wa_code_generation.ml  | 40 +++++++++++++++++++++---
 compiler/lib/wasm/wa_code_generation.mli |  5 ++-
 compiler/lib/wasm/wa_gc_target.ml        | 14 ++++++---
 3 files changed, 48 insertions(+), 11 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 9fcdc5ec24..2f5f25671c 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -24,7 +24,8 @@ type context =
   ; mutable constant_globals : constant_global Var.Map.t
   ; mutable other_fields : W.module_field list
   ; mutable imports : (Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
-  ; types : (string, Var.t) Hashtbl.t
+  ; type_names : (string, Var.t) Hashtbl.t
+  ; types : (Var.t, Wa_ast.type_field) Hashtbl.t
   ; mutable closure_envs : Var.t Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Var.t IntMap.t
@@ -46,6 +47,7 @@ let make_context () =
   ; constant_globals = Var.Map.empty
   ; other_fields = []
   ; imports = StringMap.empty
+  ; type_names = Hashtbl.create 128
   ; types = Hashtbl.create 128
   ; closure_envs = Var.Map.empty
   ; apply_funs = IntMap.empty
@@ -114,15 +116,43 @@ type type_def =
 let register_type nm gen_typ st =
   let context = st.context in
   let { supertype; final; typ }, st = gen_typ () st in
-  ( (try Hashtbl.find context.types nm
+  ( (try Hashtbl.find context.type_names nm
      with Not_found ->
        let name = Var.fresh_n nm in
-       context.other_fields <-
-         Type [ { name; typ; supertype; final } ] :: context.other_fields;
-       Hashtbl.add context.types nm name;
+       let type_field = { Wa_ast.name; typ; supertype; final } in
+       context.other_fields <- Type [ type_field ] :: context.other_fields;
+       Hashtbl.add context.type_names nm name;
+       Hashtbl.add context.types name type_field;
        name)
   , st )
 
+let rec type_index_sub ty ty' st =
+  if Var.equal ty ty'
+  then true, st
+  else
+    let type_field = Hashtbl.find st.context.types ty in
+    match type_field.supertype with
+    | None -> false, st
+    | Some ty -> type_index_sub ty ty' st
+
+let heap_type_sub (ty : W.heap_type) (ty' : W.heap_type) st =
+  match ty, ty' with
+  | Func, Func
+  | Extern, Extern
+  | (Any | Eq | I31 | Type _), Any
+  | (Eq | I31 | Type _), Eq
+  | I31, I31 -> true, st
+  | Type t, Type t' -> type_index_sub t t' st
+  (* Func and Extern are only in suptyping relation with themselves *)
+  | Func, _
+  | _, Func
+  | Extern, _
+  | _, Extern
+  (* Any has no supertype *)
+  | Any, _
+  (* I31, struct and arrays have no subtype (of a different kind) *)
+  | _, (I31 | Type _) -> false, st
+
 let register_global name ?(constant = false) typ init st =
   st.context.other_fields <- W.Global { name; typ; init } :: st.context.other_fields;
   (match name with
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index dec0939dda..bdc0f0800d 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -8,7 +8,8 @@ type context =
   ; mutable constant_globals : constant_global Code.Var.Map.t
   ; mutable other_fields : Wa_ast.module_field list
   ; mutable imports : (Code.Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
-  ; types : (string, Code.Var.t) Hashtbl.t
+  ; type_names : (string, Code.Var.t) Hashtbl.t
+  ; types : (Code.Var.t, Wa_ast.type_field) Hashtbl.t
   ; mutable closure_envs : Code.Var.t Code.Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
@@ -124,6 +125,8 @@ type type_def =
 
 val register_type : string -> (unit -> type_def t) -> Wa_ast.var t
 
+val heap_type_sub : Wa_ast.heap_type -> Wa_ast.heap_type -> bool t
+
 val register_import :
   ?import_module:string -> name:string -> Wa_ast.import_desc -> Wa_ast.var t
 
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ec98462cc1..d72102593a 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -490,13 +490,17 @@ module Memory = struct
   let wasm_struct_get ty e i =
     let* e = e in
     match e with
-    | W.RefCast (_, GlobalGet (V nm)) -> (
+    | W.RefCast ({ typ; _ }, GlobalGet (V nm)) -> (
         let* init = get_global nm in
         match init with
-        | Some (W.StructNew (_, l)) ->
-            let e = List.nth l i in
-            let* b = is_small_constant e in
-            if b then return e else return (W.StructGet (None, ty, i, e))
+        | Some (W.StructNew (ty', l)) ->
+            let* b = heap_type_sub (Type ty') typ in
+            if b
+            then
+              let e' = List.nth l i in
+              let* b = is_small_constant e' in
+              if b then return e' else return (W.StructGet (None, ty, i, e))
+            else return (W.StructGet (None, ty, i, e))
         | _ -> return (W.StructGet (None, ty, i, e)))
     | _ -> return (W.StructGet (None, ty, i, e))
 

From 0005b54529ca4270683d7a3be855a9996217bb46 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 9 Mar 2024 00:22:40 +0100
Subject: [PATCH 209/481] Store some toplevel values into globals. Any variable
 which is used a number of instructions after being defined is stored into a
 global instead of a local. The goals are the following: - Turn a large number
 of closures into constant closures, which has a   significant impact on
 performance - Reduce the compilation time of the toplevel function in case
 the   Wasm engine decide to optimize it: reduce the register pressure by  
 avoiding long-lived registers in the toplevel function, and make   load
 elimination less expensive by reducing the number of constant   structures
 defined in this function.

---
 compiler/lib/freevars.ml                 |  16 +++-
 compiler/lib/freevars.mli                |   2 +
 compiler/lib/wasm/wa_code_generation.ml  |  44 ++++++++--
 compiler/lib/wasm/wa_code_generation.mli |   5 +-
 compiler/lib/wasm/wa_curry.ml            |  28 ++----
 compiler/lib/wasm/wa_gc_target.ml        |  13 ++-
 compiler/lib/wasm/wa_generate.ml         |   7 +-
 compiler/lib/wasm/wa_globalize.ml        | 103 +++++++++++++++++++++++
 compiler/lib/wasm/wa_globalize.mli       |   5 ++
 compiler/lib/wasm/wa_structure.ml        |   2 +
 compiler/lib/wasm/wa_structure.mli       |   2 +
 11 files changed, 188 insertions(+), 39 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_globalize.ml
 create mode 100644 compiler/lib/wasm/wa_globalize.mli

diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml
index 2301ddebd6..f7e3daf3be 100644
--- a/compiler/lib/freevars.ml
+++ b/compiler/lib/freevars.ml
@@ -100,8 +100,8 @@ type st =
   ; mutable revisited : bool
   }
 
-let find_loops p =
-  let in_loop = ref Addr.Map.empty in
+let find_loops p in_loop pc =
+  let in_loop = ref in_loop in
   let index = ref 0 in
   let state = ref Addr.Map.empty in
   let stack = Stack.create () in
@@ -141,9 +141,17 @@ let find_loops p =
       if st.revisited
       then List.iter !l ~f:(fun pc' -> in_loop := Addr.Map.add pc' pc !in_loop))
   in
-  Code.fold_closures p (fun _ _ (pc, _) () -> traverse pc) ();
+  traverse pc;
   !in_loop
 
+let find_loops_in_closure p pc = find_loops p Addr.Map.empty pc
+
+let find_all_loops p =
+  Code.fold_closures
+    p
+    (fun _ _ (pc, _) (in_loop : _ Addr.Map.t) -> find_loops p in_loop pc)
+    Addr.Map.empty
+
 let mark_variables in_loop p =
   let vars = Var.Tbl.make () (-1) in
   let visited = BitSet.create' p.free_pc in
@@ -210,7 +218,7 @@ let free_variables vars in_loop p =
 let f p =
   Code.invariant p;
   let t = Timer.make () in
-  let in_loop = find_loops p in
+  let in_loop = find_all_loops p in
   let vars = mark_variables in_loop p in
   let free_vars = free_variables vars in_loop p in
   if times () then Format.eprintf "  free vars: %a@." Timer.print t;
diff --git a/compiler/lib/freevars.mli b/compiler/lib/freevars.mli
index 3a41483741..95a2a4fdb2 100644
--- a/compiler/lib/freevars.mli
+++ b/compiler/lib/freevars.mli
@@ -27,4 +27,6 @@ val iter_instr_free_vars : (Code.Var.t -> unit) -> Code.instr -> unit
 
 val iter_last_free_var : (Code.Var.t -> unit) -> Code.last -> unit
 
+val find_loops_in_closure : Code.program -> Code.Addr.t -> Code.Addr.t Code.Addr.Map.t
+
 val f : Code.program -> Code.Var.Set.t Code.Addr.Map.t
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 2f5f25671c..114521940c 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -39,9 +39,11 @@ type context =
   ; mutable strings : string list
   ; mutable string_index : int StringMap.t
   ; mutable fragments : Javascript.expression StringMap.t
+  ; mutable globalized_variables : Var.Set.t
+  ; value_type : W.value_type
   }
 
-let make_context () =
+let make_context ~value_type =
   { constants = Hashtbl.create 128
   ; data_segments = Var.Map.empty
   ; constant_globals = Var.Map.empty
@@ -61,6 +63,8 @@ let make_context () =
   ; strings = []
   ; string_index = StringMap.empty
   ; fragments = StringMap.empty
+  ; globalized_variables = Var.Set.empty
+  ; value_type
   }
 
 type var =
@@ -167,6 +171,10 @@ let register_global name ?(constant = false) typ init st =
           st.context.constant_globals);
   (), st
 
+let global_is_registered name =
+  let* ctx = get_context in
+  return (Var.Map.mem name ctx.constant_globals)
+
 let global_is_constant name =
   let* ctx = get_context in
   return
@@ -444,6 +452,10 @@ let tee ?typ x e =
     let* i = add_var ?typ x in
     return (W.LocalTee (i, e))
 
+let should_make_global x st = Var.Set.mem x st.context.globalized_variables, st
+
+let value_type st = st.context.value_type, st
+
 let rec store ?(always = false) ?typ x e =
   let* e = e in
   match e with
@@ -455,8 +467,30 @@ let rec store ?(always = false) ?typ x e =
       if b && not always
       then register_constant x e
       else
-        let* i = add_var ?typ x in
-        instr (LocalSet (i, e))
+        let* b = should_make_global x in
+        if b
+        then
+          let* typ =
+            match typ with
+            | Some typ -> return typ
+            | None -> value_type
+          in
+          let* () =
+            let* b = global_is_registered x in
+            if b
+            then return ()
+            else
+              register_global
+                ~constant:true
+                (V x)
+                { mut = true; typ }
+                (W.RefI31 (Const (I32 0l)))
+          in
+          let* () = register_constant x (W.GlobalGet (V x)) in
+          instr (GlobalSet (V x, e))
+        else
+          let* i = add_var ?typ x in
+          instr (LocalSet (i, e))
 
 let assign x e =
   let* x = var x in
@@ -566,7 +600,7 @@ let need_dummy_fun ~cps ~arity st =
 
 let init_code context = instrs context.init_code
 
-let function_body ~context ~value_type ~param_count ~body =
+let function_body ~context ~param_count ~body =
   let st = { var_count = 0; vars = Var.Map.empty; instrs = []; context } in
   let (), st = body st in
   let local_count, body = st.var_count, List.rev st.instrs in
@@ -580,7 +614,7 @@ let function_body ~context ~value_type ~param_count ~body =
   let body = Wa_tail_call.f body in
   let locals =
     local_types
-    |> Array.map ~f:(fun v -> Option.value ~default:value_type v)
+    |> Array.map ~f:(fun v -> Option.value ~default:context.value_type v)
     |> (fun a -> Array.sub a ~pos:param_count ~len:(Array.length a - param_count))
     |> Array.to_list
   in
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index bdc0f0800d..40c67c16ff 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -23,9 +23,11 @@ type context =
   ; mutable strings : string list
   ; mutable string_index : int StringMap.t
   ; mutable fragments : Javascript.expression StringMap.t
+  ; mutable globalized_variables : Code.Var.Set.t
+  ; value_type : Wa_ast.value_type
   }
 
-val make_context : unit -> context
+val make_context : value_type:Wa_ast.value_type -> context
 
 type 'a t
 
@@ -163,7 +165,6 @@ val need_dummy_fun : cps:bool -> arity:int -> Code.Var.t t
 
 val function_body :
      context:context
-  -> value_type:Wa_ast.value_type
   -> param_count:int
   -> body:unit t
   -> Wa_ast.value_type list * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index 04eaacf347..0123e13f08 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -82,9 +82,7 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       loop m [] f None
     in
-    let locals, body =
-      function_body ~context ~value_type:Value.value ~param_count:2 ~body
-    in
+    let locals, body = function_body ~context ~param_count:2 ~body in
     W.Function { name; exported_name = None; typ = func_type 1; locals; body }
 
   let curry_name n m = Printf.sprintf "curry_%d_%d" n m
@@ -142,9 +140,7 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       Stack.perform_spilling stack_ctx (`Instr ret)
     in
-    let locals, body =
-      function_body ~context ~value_type:Value.value ~param_count:2 ~body
-    in
+    let locals, body = function_body ~context ~param_count:2 ~body in
     W.Function { name; exported_name = None; typ = func_type 1; locals; body }
     :: functions
 
@@ -185,9 +181,7 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       loop m [] f None
     in
-    let locals, body =
-      function_body ~context ~value_type:Value.value ~param_count:3 ~body
-    in
+    let locals, body = function_body ~context ~param_count:3 ~body in
     W.Function { name; exported_name = None; typ = func_type 2; locals; body }
 
   let cps_curry_name n m = Printf.sprintf "cps_curry_%d_%d" n m
@@ -248,9 +242,7 @@ module Make (Target : Wa_target_sig.S) = struct
       let* c = call ~cps:false ~arity:1 (load cont) [ e ] in
       instr (W.Return (Some c))
     in
-    let locals, body =
-      function_body ~context ~value_type:Value.value ~param_count:3 ~body
-    in
+    let locals, body = function_body ~context ~param_count:3 ~body in
     W.Function { name; exported_name = None; typ = func_type 2; locals; body }
     :: functions
 
@@ -309,9 +301,7 @@ module Make (Target : Wa_target_sig.S) = struct
          in
          build_applies (load f) l)
     in
-    let locals, body =
-      function_body ~context ~value_type:Value.value ~param_count:(arity + 1) ~body
-    in
+    let locals, body = function_body ~context ~param_count:(arity + 1) ~body in
     W.Function { name; exported_name = None; typ = func_type arity; locals; body }
 
   let cps_apply ~context ~arity ~name =
@@ -372,9 +362,7 @@ module Make (Target : Wa_target_sig.S) = struct
          let* () = push (call ~cps:true ~arity:2 (load f) [ x; iterate ]) in
          Stack.perform_spilling stack_ctx (`Instr ret))
     in
-    let locals, body =
-      function_body ~context ~value_type:Value.value ~param_count:(arity + 1) ~body
-    in
+    let locals, body = function_body ~context ~param_count:(arity + 1) ~body in
     W.Function { name; exported_name = None; typ = func_type arity; locals; body }
 
   let dummy ~context ~cps ~arity ~name =
@@ -399,9 +387,7 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       instr (W.Return (Some e))
     in
-    let locals, body =
-      function_body ~context ~value_type:Value.value ~param_count:(arity + 1) ~body
-    in
+    let locals, body = function_body ~context ~param_count:(arity + 1) ~body in
     W.Function { name; exported_name = None; typ = func_type arity; locals; body }
 
   let f ~context =
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index d72102593a..3c1f34d944 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -922,6 +922,11 @@ module Closure = struct
   let translate ~context ~closures ~stack_ctx:_ ~cps f =
     let info = Code.Var.Map.find f closures in
     let free_variables = get_free_variables ~context info in
+    assert (
+      not
+        (List.exists
+           ~f:(fun x -> Code.Var.Set.mem x context.globalized_variables)
+           free_variables));
     let arity = List.assoc f info.functions in
     let arity = if cps then arity - 1 else arity in
     let* curry_fun = if arity > 1 then need_curry_fun ~cps ~arity else return f in
@@ -1028,15 +1033,15 @@ module Closure = struct
           else res
 
   let bind_environment ~context ~closures ~cps f =
-    if Hashtbl.mem context.constants f
+    let info = Code.Var.Map.find f closures in
+    let free_variables = get_free_variables ~context info in
+    let free_variable_count = List.length free_variables in
+    if free_variable_count = 0
     then
       (* The closures are all constants and the environment is empty. *)
       let* _ = add_var (Code.Var.fresh ()) in
       return ()
     else
-      let info = Code.Var.Map.find f closures in
-      let free_variables = get_free_variables ~context info in
-      let free_variable_count = List.length free_variables in
       let arity = List.assoc f info.functions in
       let arity = if cps then arity - 1 else arity in
       let offset = Memory.env_start arity in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 5103209bce..1a7e831461 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -954,10 +954,12 @@ module Generate (Target : Wa_target_sig.S) = struct
       | None -> 0
       | Some _ -> List.length params + 1
     in
+    (match name_opt with
+    | None -> ctx.global_context.globalized_variables <- Wa_globalize.f p g ctx.closures
+    | Some _ -> ());
     let locals, body =
       function_body
         ~context:ctx.global_context
-        ~value_type:Value.value
         ~param_count
         ~body:
           (let* () = build_initial_env in
@@ -990,7 +992,6 @@ module Generate (Target : Wa_target_sig.S) = struct
     let locals, body =
       function_body
         ~context:ctx.global_context
-        ~value_type:Value.value
         ~param_count:(List.length typ.W.params)
         ~body
     in
@@ -1020,7 +1021,7 @@ module Generate (Target : Wa_target_sig.S) = struct
       ; in_cps
       ; blocks = p.blocks
       ; closures
-      ; global_context = make_context ()
+      ; global_context = make_context ~value_type:Value.value
       }
     in
     let toplevel_name = Var.fresh_n "toplevel" in
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib/wasm/wa_globalize.ml
new file mode 100644
index 0000000000..6bac837663
--- /dev/null
+++ b/compiler/lib/wasm/wa_globalize.ml
@@ -0,0 +1,103 @@
+(*
+
+Store some toplevel values into globals. Any variable which is used a
+number of instructions after being defined is stored into a global
+instead of a local. The goals are the following:
+- Turn a large number of closures into constant closures, which has a
+  significant impact on performance
+- Reduce the compilation time of the toplevel function in case the
+  Wasm engine decide to optimize it: reduce the register pressure by
+  avoiding long-lived registers in the toplevel function, and make
+  load elimination less expensive by reducing the number of constant
+  structures defined in this function.
+*)
+
+open Stdlib
+
+type st =
+  { pos : int
+  ; visited_variables : int Code.Var.Map.t
+  ; globals : Code.Var.Set.t
+  ; closures : Wa_closure_conversion.closure Code.Var.Map.t
+  }
+
+let threshold = 1000
+
+let rec globalize st x =
+  if Code.Var.Set.mem x st.globals
+  then st
+  else
+    let st = { st with globals = Code.Var.Set.add x st.globals } in
+    globalize_closure st x
+
+and globalize_closure st x =
+  (* If a function is stored in a global variable, its free variables
+     are also stored in a global variable, since they are retained
+     anyway. *)
+  match Code.Var.Map.find x st.closures with
+  | { free_variables; _ } ->
+      List.fold_left
+        ~f:(fun st x ->
+          if Code.Var.Map.mem x st.visited_variables then globalize st x else st)
+        ~init:st
+        free_variables
+  | exception Not_found -> st
+
+let use x st =
+  match Code.Var.Map.find x st.visited_variables with
+  | pos -> if st.pos > pos + threshold then globalize st x else st
+  | exception Not_found -> st
+
+let declare x st =
+  { st with visited_variables = Code.Var.Map.add x st.pos st.visited_variables }
+
+let traverse_expression x e st =
+  match e with
+  | Code.Apply { f; args; _ } ->
+      st |> use f |> fun st -> List.fold_left ~f:(fun st x -> use x st) ~init:st args
+  | Block (_, a, _) -> Array.fold_right ~f:use a ~init:st
+  | Field (x, _) -> st |> use x
+  | Closure _ ->
+      List.fold_left
+        ~f:(fun st x -> use x st)
+        ~init:st
+        (Code.Var.Map.find x st.closures).Wa_closure_conversion.free_variables
+  | Constant _ -> st
+  | Prim (_, args) ->
+      List.fold_left
+        ~f:(fun st a ->
+          match a with
+          | Code.Pv x -> st |> use x
+          | Pc _ -> st)
+        ~init:st
+        args
+
+let traverse_instruction st i =
+  let st = { st with pos = st.pos + 1 } in
+  match fst i with
+  | Code.Let (x, e) -> st |> declare x |> traverse_expression x e
+  | Assign (_, x) | Offset_ref (x, _) -> st |> use x
+  | Set_field (x, _, y) -> st |> use x |> use y
+  | Array_set (x, y, z) -> st |> use x |> use y |> use z
+
+let traverse_block p st pc =
+  let b = Code.Addr.Map.find pc p.Code.blocks in
+  let st = List.fold_left ~f:(fun st x -> declare x st) ~init:st b.Code.params in
+  List.fold_left ~f:(fun st i -> traverse_instruction st i) ~init:st b.Code.body
+
+let f p g closures =
+  let l = Wa_structure.blocks_in_reverse_post_order g in
+  let in_loop = Freevars.find_loops_in_closure p p.Code.start in
+  let st =
+    List.fold_left
+      ~f:(fun st pc ->
+        if Code.Addr.Map.mem pc in_loop then st else traverse_block p st pc)
+      ~init:
+        { pos = 0
+        ; visited_variables = Code.Var.Map.empty
+        ; globals = Code.Var.Set.empty
+        ; closures
+        }
+      l
+  in
+  st.globals
diff --git a/compiler/lib/wasm/wa_globalize.mli b/compiler/lib/wasm/wa_globalize.mli
new file mode 100644
index 0000000000..53616b683e
--- /dev/null
+++ b/compiler/lib/wasm/wa_globalize.mli
@@ -0,0 +1,5 @@
+val f :
+     Code.program
+  -> Wa_structure.control_flow_graph
+  -> Wa_closure_conversion.closure Code.Var.Map.t
+  -> Code.Var.Set.t
diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
index 38ec812289..ae64646cac 100644
--- a/compiler/lib/wasm/wa_structure.ml
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -146,6 +146,8 @@ let sort_in_post_order g l =
       compare (Hashtbl.find g.block_order b') (Hashtbl.find g.block_order b))
     l
 
+let blocks_in_reverse_post_order g = g.reverse_post_order
+
 (* Compute a map from each block to the set of loops it belongs to *)
 let mark_loops g =
   let in_loop = Hashtbl.create 16 in
diff --git a/compiler/lib/wasm/wa_structure.mli b/compiler/lib/wasm/wa_structure.mli
index db1dfc9c80..0f0a0de7c0 100644
--- a/compiler/lib/wasm/wa_structure.mli
+++ b/compiler/lib/wasm/wa_structure.mli
@@ -15,3 +15,5 @@ val is_merge_node : control_flow_graph -> Code.Addr.t -> bool
 val is_backward : control_flow_graph -> Code.Addr.t -> Code.Addr.t -> bool
 
 val sort_in_post_order : control_flow_graph -> Code.Addr.t list -> Code.Addr.t list
+
+val blocks_in_reverse_post_order : control_flow_graph -> Code.Addr.t list

From 5ca926f33b922eb13018ded9ab52605deea4c565 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 14 Mar 2024 11:58:42 +0100
Subject: [PATCH 210/481] Check that the right version of Binaryen tools are in
 the path when building

---
 runtime/wasm/dune | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 520fb664ec..5f662069a1 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -7,9 +7,12 @@
    (target runtime.wasm)
    (deps args (glob_files *.wat))
    (action
-      (pipe-stdout
-         (run wasm-merge -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{read-lines:args} -o -)
-         (run wasm-opt -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory - -O3 -o %{target}))))
+      (progn
+         (system "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
+         (system "wasm-merge --version | grep -q 'version 116' || (echo 'Error: Binaryen version 116 is currently required'; false)")
+         (pipe-stdout
+            (run wasm-merge -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{read-lines:args} -o -)
+            (run wasm-opt -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory - -O3 -o %{target})))))
 
 (rule (target args)
    (deps args.ml (glob_files *.wat))

From 0a8a73609ee88f28287be59570459eb0f2a37f13 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 8 Mar 2024 10:33:33 -0500
Subject: [PATCH 211/481] Avoid using 'eval' for statically known strings
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When using functions such as `Js.Unsafe.eval_string` in Wasm, when the
string is known at compile time, it can be emitted as an external
Javascript fragment, rather than using the infamous `eval`.

Co-authored-by: Jérôme Vouillon <jerome.vouillon@gmail.com>
---
 compiler/bin-wasm_of_ocaml/compile.ml |  5 ++-
 compiler/lib/specialize_js.ml         |  2 +-
 compiler/lib/wasm/wa_gc_target.ml     | 58 +++++++++++++++++++++++----
 runtime/wasm/runtime.js               | 41 ++++++++++---------
 4 files changed, 75 insertions(+), 31 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 386bebcf05..9d46185c05 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -250,6 +250,7 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
   let i = find "CODE" 0 in
   let j = find "PRIMITIVES" 0 in
   let k = find "STRINGS" 0 in
+  let l = find "FRAGMENTS" 0 in
   let rec trim_semi s =
     let l = String.length s in
     if l = 0
@@ -270,9 +271,9 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
     ^ trim_semi (Buffer.contents b')
     ^ String.sub s ~pos:(j + 10) ~len:(k - j - 10)
     ^ trim_semi (Buffer.contents b'')
-    ^ ","
+    ^ String.sub s ~pos:(k + 7) ~len:(l - k - 7)
     ^ trim_semi (Buffer.contents fragment_buffer)
-    ^ String.sub s ~pos:(k + 7) ~len:(String.length s - k - 7))
+    ^ String.sub s ~pos:(l + 9) ~len:(String.length s - l - 9))
 
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
   Jsoo_cmdline.Arg.eval common;
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 651fa4cbd8..808c6d62a4 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -41,7 +41,7 @@ let specialize_instr ~target info i =
         , Prim
             ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim)
             , [ (Pv _ as y) ] ) )
-    , `JavaScript )
+    , _ )
     when Config.Flag.safe_string () -> (
       match the_string_of info y with
       | Some s -> Let (x, Prim (Extern prim, [ Pc (String s) ]))
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ec98462cc1..14cc7e843b 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1263,6 +1263,54 @@ let internal_primitives = Hashtbl.create 100
 let () =
   let register name f = Hashtbl.add internal_primitives name f in
   let module J = Javascript in
+  let call_prim ~transl_prim_arg name args =
+    let arity = List.length args in
+    (* [Type.func_type] counts one additional argument for the closure environment (absent
+       here) *)
+    let* f = register_import ~name (Fun (Type.func_type (arity - 1))) in
+    let args = List.map ~f:transl_prim_arg args in
+    let* args = expression_list Fun.id args in
+    return (W.Call (f, args))
+  in
+  let register_js_expr prim_name =
+    register prim_name (fun transl_prim_arg l ->
+      let* wrap =
+        register_import
+          ~name:"wrap"
+          (Fun { params = [ JavaScript.anyref ]; result = [ Value.value ] })
+      in
+      match l with
+      | Code.[ Pc (String str) ] ->
+        (try
+           let lex = Parse_js.Lexer.of_string str in
+           let e = Parse_js.parse_expr lex in
+           let name = Printf.sprintf "js_expr_%x" (String.hash str) in
+           let* () = register_fragment name (fun () ->
+             EArrow
+               ( J.fun_
+                   []
+                   [ (Return_statement (Some e), N) ]
+                   N
+               , AUnknown ))
+           in
+           let* js_val = JavaScript.invoke_fragment name [] in
+           return (W.Call (wrap, [ js_val ]))
+         with Parse_js.Parsing_error pi ->
+           failwith
+             (Printf.sprintf
+                "Parse error in argument of %s %S at position %d:%d"
+                prim_name
+                str
+                pi.Parse_info.line
+                pi.Parse_info.col))
+      | [ Pv _ ] ->
+          call_prim ~transl_prim_arg prim_name l
+      | [] | _ :: _ ->
+         failwith (Printf.sprintf "Wrong number argument to primitive %s" prim_name)
+    )
+  in
+  List.iter ~f:register_js_expr
+    [ "caml_js_expr"; "caml_pure_js_expr"; "caml_js_var"; "caml_js_eval_string" ];
   register "%caml_js_opt_call" (fun transl_prim_arg l ->
       let arity = List.length l - 2 in
       let name = Printf.sprintf "call_%d" arity in
@@ -1397,10 +1445,7 @@ let () =
           in
           JavaScript.invoke_fragment name [ transl_prim_arg x ]
       | [ _; _ ] ->
-          let* f = register_import ~name:"caml_js_get" (Fun (Type.func_type 1)) in
-          let l = List.map ~f:transl_prim_arg l in
-          let* l = expression_list (fun e -> e) l in
-          return (W.Call (f, l))
+          call_prim ~transl_prim_arg "caml_js_get" l
       | _ -> assert false);
   register "caml_js_set" (fun transl_prim_arg l ->
       match l with
@@ -1428,10 +1473,7 @@ let () =
           let l = List.map ~f:transl_prim_arg [ x; y ] in
           JavaScript.invoke_fragment name l
       | [ _; _; _ ] ->
-          let* f = register_import ~name:"caml_js_set" (Fun (Type.func_type 2)) in
-          let l = List.map ~f:transl_prim_arg l in
-          let* l = expression_list (fun e -> e) l in
-          return (W.Call (f, l))
+          call_prim ~transl_prim_arg "caml_js_set" l
       | _ -> assert false);
   let counter = ref (-1) in
   register "%caml_js_opt_object" (fun transl_prim_arg l ->
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index ba356f46a1..27729b465d 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -360,23 +360,24 @@
     var buffer = caml_buffer?.buffer
     var out_buffer = buffer&&new Uint8Array(buffer,0,buffer.length)
 
-    start_fiber = wrap_fun(
-        {parameters: ['eqref'], results: ['externref']},
-        caml_start_fiber, {promising: 'first'}
-    )
-    var _initialize = wrap_fun(
-        {parameters: [], results: ['externref']},
-        _initialize, {promising: 'first'}
-    )
-    var process = globalThis.process;
-    if(process && process.on) {
-        process.on('uncaughtException', (err, origin) =>
-            caml_handle_uncaught_exception(err))
-    }
-    else if(globalThis.addEventListener){
-        globalThis.addEventListener('error', event=>
-            event.error&&caml_handle_uncaught_exception(event.error))
-    }
-    await _initialize();
-})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval("("+x+")"))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
-   PRIMITIVES, STRINGS);
+  start_fiber = wrap_fun(
+    {parameters: ['eqref'], results: ['externref']},
+    caml_start_fiber, {promising: 'first'}
+  )
+  var _initialize = wrap_fun(
+    {parameters: [], results: ['externref']},
+    _initialize, {promising: 'first'}
+  )
+  var process = globalThis.process;
+  if(process && process.on) {
+    process.on('uncaughtException', (err, origin) =>
+      caml_handle_uncaught_exception(err))
+  }
+  else if(globalThis.addEventListener){
+    globalThis.addEventListener('error', event=>
+      event.error&&caml_handle_uncaught_exception(event.error))
+  }
+  await _initialize();
+})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>{return eval("("+x+")")})(globalThis,globalThis?.module?.exports||globalThis,globalThis),
+   PRIMITIVES, STRINGS,
+   ((joo_global_object,jsoo_exports,globalThis)=>FRAGMENTS)(globalThis,globalThis?.module?.exports||globalThis,globalThis))
\ No newline at end of file

From d108f55470d52313e77310f6f6fef3df4953b35f Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 8 Mar 2024 11:06:56 -0500
Subject: [PATCH 212/481] Have physical equality inspect Javascript objects
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Currently in wasm, physical equality behaves differently from in
Javascript: Javascript objects are boxed, and non-equality of the
pointers causes the values to be physically not equal. This can be an
issue for some folks who rely on the JS-object-inspecting semantics of
physical equality to implement things such as memoizing.

This restores the fact that physical equality inspects Javascript
objects. Other values are unaffected. This entails to pay an additional
cost of between one and two Wasm runtime type tests in physical
equality. A quick benchmark performing a few million `(==)` in an array
of integers show a slowdown of 20~25 %. Since typical programs should
perform physical equality much less frequently, we expect the overhead
to be in the noise in practice.

That being said, we may want to make this behaviour opt-in using a flag.

Co-authored-by: Jérôme Vouillon <jerome.vouillon@gmail.com>
---
 compiler/lib/wasm/wa_asm_output.ml        |  7 +++
 compiler/lib/wasm/wa_ast.ml               |  1 +
 compiler/lib/wasm/wa_code_generation.ml   |  6 +-
 compiler/lib/wasm/wa_gc_target.ml         | 69 +++++++++++++++++++++--
 compiler/lib/wasm/wa_initialize_locals.ml |  4 ++
 compiler/lib/wasm/wa_wat_output.ml        |  8 +++
 6 files changed, 87 insertions(+), 8 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 76cb73ad84..42dfc32d17 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -301,6 +301,13 @@ module Output () = struct
     | MemoryGrow (mem, e) -> expression e ^^ line (string "memory.grow " ^^ integer mem)
     | Seq (l, e') -> concat_map instruction l ^^ expression e'
     | Pop _ -> empty
+    | IfExpr (ty, e, e1, e2) ->
+        expression e
+        ^^ line (string "if" ^^ block_type { params = []; result = [ ty ] })
+        ^^ indent (expression e1)
+        ^^ line (string "else")
+        ^^ indent (expression e2)
+        ^^ line (string "end_if")
     | RefFunc _
     | Call_ref _
     | RefI31 _
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 193e744825..a5641e7169 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -157,6 +157,7 @@ type expression =
   | ExternExternalize of expression
   | Br_on_cast of int * ref_type * ref_type * expression
   | Br_on_cast_fail of int * ref_type * ref_type * expression
+  | IfExpr of value_type * expression * expression * expression
 
 and instruction =
   | Drop of expression
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 9fcdc5ec24..ab8a10849d 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -347,11 +347,13 @@ let bin_op_is_smi (op : W.int_bin_op) =
       false
   | Eq | Ne | Lt _ | Gt _ | Le _ | Ge _ -> true
 
-let is_smi e =
+let rec is_smi e =
   match e with
   | W.Const (I32 i) -> Int32.equal (Int31.wrap i) i
   | UnOp ((I32 op | I64 op), _) -> un_op_is_smi op
   | BinOp ((I32 op | I64 op), _, _) -> bin_op_is_smi op
+  | I31Get (S, _) -> true
+  | I31Get (U, _)
   | Const (I64 _ | F32 _ | F64 _)
   | ConstSym _
   | UnOp ((F32 _ | F64 _), _)
@@ -373,7 +375,6 @@ let is_smi e =
   | RefFunc _
   | Call_ref _
   | RefI31 _
-  | I31Get _
   | ArrayNew _
   | ArrayNewFixed _
   | ArrayNewData _
@@ -388,6 +389,7 @@ let is_smi e =
   | Br_on_cast _
   | Br_on_cast_fail _ -> false
   | BinOp ((F32 _ | F64 _), _, _) | RefTest _ | RefEq _ -> true
+  | IfExpr (_, _, ift, iff) -> is_smi ift && is_smi iff
 
 let get_i31_value x st =
   match st.instrs with
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ec98462cc1..60e07927ba 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -435,15 +435,72 @@ module Value = struct
 
   let le = binop Arith.( <= )
 
-  let eq i i' =
+  let ref_eq i i' =
     let* i = i in
     let* i' = i' in
-    val_int (return (W.RefEq (i, i')))
+    return (W.RefEq (i, i'))
 
-  let neq i i' =
-    let* i = i in
-    let* i' = i' in
-    val_int (Arith.eqz (return (W.RefEq (i, i'))))
+  let ref ty =
+    { W.nullable = false; typ = Type ty }
+
+  let ref_test typ e =
+    let* e = e in
+    return (W.RefTest (typ, e))
+
+  let caml_js_strict_equals x y =
+    let* x = x in
+    let* y = y in
+    let* f =
+      register_import
+        ~name:"caml_js_strict_equals"
+        ~import_module:"env"
+        (Fun { params = [ Type.value; Type.value ]; result = [ Type.value ] })
+    in
+    return (W.Call (f, [ x; y ]))
+
+  let if_expr ty cond ift iff =
+    let* cond = cond in
+    let* ift = ift in
+    let* iff = iff in
+    return (W.IfExpr (ty, cond, ift, iff))
+
+  let map f x =
+    let* x = x in
+    return (f x)
+
+  let (>>|) x f = map f x
+
+  let eq_gen ~negate x y =
+    let xv  = Code.Var.fresh () in
+    let yv  = Code.Var.fresh () in
+    let* js = Type.js_type in
+    let n =
+      if_expr
+        I32
+        (* We mimic an "and" on the two conditions, but in a way that is nicer to the
+           binaryen optimizer. *)
+        (if_expr
+          I32
+          (ref_test (ref js) (load xv))
+          (ref_test (ref js) (load yv))
+          (Arith.const 0l))
+        (caml_js_strict_equals (load xv) (load yv)
+          >>| (fun e -> W.RefCast ({ nullable = false; typ = I31 }, e))
+          >>| (fun e -> W.I31Get (S, e)))
+        (ref_eq (load xv) (load yv))
+    in
+    seq
+      (let* () = store xv x in
+        let* () = store yv y in
+        return ())
+      (val_int (if negate then Arith.eqz n else n))
+
+
+  let eq x y =
+    eq_gen ~negate:false x y
+
+  let neq x y =
+    eq_gen ~negate:true x y
 
   let ult = binop Arith.(ult)
 
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
index 0f09311356..969a6fd23f 100644
--- a/compiler/lib/wasm/wa_initialize_locals.ml
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -51,6 +51,10 @@ let rec scan_expression ctx e =
   | Call (_, l) | ArrayNewFixed (_, l) | StructNew (_, l) -> scan_expressions ctx l
   | BlockExpr (_, l) -> scan_instructions ctx l
   | Seq (l, e') -> scan_instructions ctx (l @ [ Push e' ])
+  | IfExpr (_, cond, e1, e2) ->
+      scan_expression ctx cond;
+      scan_expression (fork_context ctx) e1;
+      scan_expression (fork_context ctx) e2
 
 and scan_expressions ctx l = List.iter ~f:(fun e -> scan_expression ctx e) l
 
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 9c9e075796..7253974f11 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -331,6 +331,14 @@ let expression_or_instructions ctx in_function =
         ]
     | ExternInternalize e -> [ List (Atom "extern.internalize" :: expression e) ]
     | ExternExternalize e -> [ List (Atom "extern.externalize" :: expression e) ]
+    | IfExpr (ty, cond, ift, iff) ->
+        [ List
+            (Atom "if"
+            :: (block_type { params = []; result = [ ty ] })
+               @ expression cond
+               @ [ List (Atom "then" :: expression ift) ]
+               @ [ List (Atom "else" :: expression iff) ])
+        ]
   and instruction i =
     match i with
     | Drop e -> [ List (Atom "drop" :: expression e) ]

From 1a8fc198911fe9e0a57ca93302a37c20b00f192b Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 15 Mar 2024 19:20:57 +0100
Subject: [PATCH 213/481] ocamlformat and add newline at end of file

---
 compiler/lib/wasm/wa_gc_target.ml | 71 ++++++++++++++-----------------
 runtime/wasm/runtime.js           | 39 +++++++++--------
 2 files changed, 51 insertions(+), 59 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 14cc7e843b..9076915e57 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1274,42 +1274,37 @@ let () =
   in
   let register_js_expr prim_name =
     register prim_name (fun transl_prim_arg l ->
-      let* wrap =
-        register_import
-          ~name:"wrap"
-          (Fun { params = [ JavaScript.anyref ]; result = [ Value.value ] })
-      in
-      match l with
-      | Code.[ Pc (String str) ] ->
-        (try
-           let lex = Parse_js.Lexer.of_string str in
-           let e = Parse_js.parse_expr lex in
-           let name = Printf.sprintf "js_expr_%x" (String.hash str) in
-           let* () = register_fragment name (fun () ->
-             EArrow
-               ( J.fun_
-                   []
-                   [ (Return_statement (Some e), N) ]
-                   N
-               , AUnknown ))
-           in
-           let* js_val = JavaScript.invoke_fragment name [] in
-           return (W.Call (wrap, [ js_val ]))
-         with Parse_js.Parsing_error pi ->
-           failwith
-             (Printf.sprintf
-                "Parse error in argument of %s %S at position %d:%d"
-                prim_name
-                str
-                pi.Parse_info.line
-                pi.Parse_info.col))
-      | [ Pv _ ] ->
-          call_prim ~transl_prim_arg prim_name l
-      | [] | _ :: _ ->
-         failwith (Printf.sprintf "Wrong number argument to primitive %s" prim_name)
-    )
+        let* wrap =
+          register_import
+            ~name:"wrap"
+            (Fun { params = [ JavaScript.anyref ]; result = [ Value.value ] })
+        in
+        match l with
+        | Code.[ Pc (String str) ] -> (
+            try
+              let lex = Parse_js.Lexer.of_string str in
+              let e = Parse_js.parse_expr lex in
+              let name = Printf.sprintf "js_expr_%x" (String.hash str) in
+              let* () =
+                register_fragment name (fun () ->
+                    EArrow (J.fun_ [] [ Return_statement (Some e), N ] N, AUnknown))
+              in
+              let* js_val = JavaScript.invoke_fragment name [] in
+              return (W.Call (wrap, [ js_val ]))
+            with Parse_js.Parsing_error pi ->
+              failwith
+                (Printf.sprintf
+                   "Parse error in argument of %s %S at position %d:%d"
+                   prim_name
+                   str
+                   pi.Parse_info.line
+                   pi.Parse_info.col))
+        | [ Pv _ ] -> call_prim ~transl_prim_arg prim_name l
+        | [] | _ :: _ ->
+            failwith (Printf.sprintf "Wrong number argument to primitive %s" prim_name))
   in
-  List.iter ~f:register_js_expr
+  List.iter
+    ~f:register_js_expr
     [ "caml_js_expr"; "caml_pure_js_expr"; "caml_js_var"; "caml_js_eval_string" ];
   register "%caml_js_opt_call" (fun transl_prim_arg l ->
       let arity = List.length l - 2 in
@@ -1444,8 +1439,7 @@ let () =
                   , AUnknown ))
           in
           JavaScript.invoke_fragment name [ transl_prim_arg x ]
-      | [ _; _ ] ->
-          call_prim ~transl_prim_arg "caml_js_get" l
+      | [ _; _ ] -> call_prim ~transl_prim_arg "caml_js_get" l
       | _ -> assert false);
   register "caml_js_set" (fun transl_prim_arg l ->
       match l with
@@ -1472,8 +1466,7 @@ let () =
           in
           let l = List.map ~f:transl_prim_arg [ x; y ] in
           JavaScript.invoke_fragment name l
-      | [ _; _; _ ] ->
-          call_prim ~transl_prim_arg "caml_js_set" l
+      | [ _; _; _ ] -> call_prim ~transl_prim_arg "caml_js_set" l
       | _ -> assert false);
   let counter = ref (-1) in
   register "%caml_js_opt_object" (fun transl_prim_arg l ->
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 27729b465d..5775992bc8 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -360,24 +360,23 @@
     var buffer = caml_buffer?.buffer
     var out_buffer = buffer&&new Uint8Array(buffer,0,buffer.length)
 
-  start_fiber = wrap_fun(
-    {parameters: ['eqref'], results: ['externref']},
-    caml_start_fiber, {promising: 'first'}
-  )
-  var _initialize = wrap_fun(
-    {parameters: [], results: ['externref']},
-    _initialize, {promising: 'first'}
-  )
-  var process = globalThis.process;
-  if(process && process.on) {
-    process.on('uncaughtException', (err, origin) =>
-      caml_handle_uncaught_exception(err))
-  }
-  else if(globalThis.addEventListener){
-    globalThis.addEventListener('error', event=>
-      event.error&&caml_handle_uncaught_exception(event.error))
-  }
-  await _initialize();
+    start_fiber = wrap_fun(
+        {parameters: ['eqref'], results: ['externref']},
+        caml_start_fiber, {promising: 'first'}
+    )
+    var _initialize = wrap_fun(
+        {parameters: [], results: ['externref']},
+        _initialize, {promising: 'first'}
+    )
+    var process = globalThis.process;
+    if(process && process.on) {
+        process.on('uncaughtException', (err, origin) =>
+            caml_handle_uncaught_exception(err))
+    }
+    else if(globalThis.addEventListener){
+        globalThis.addEventListener('error', event=>
+            event.error&&caml_handle_uncaught_exception(event.error))
+    }
+    await _initialize();
 })(((joo_global_object,jsoo_exports,globalThis)=>(x)=>{return eval("("+x+")")})(globalThis,globalThis?.module?.exports||globalThis,globalThis),
-   PRIMITIVES, STRINGS,
-   ((joo_global_object,jsoo_exports,globalThis)=>FRAGMENTS)(globalThis,globalThis?.module?.exports||globalThis,globalThis))
\ No newline at end of file
+   PRIMITIVES, STRINGS, FRAGMENTS);

From 27ee666ab99e1a14e012cdaa5784489ba168fc61 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Mon, 18 Mar 2024 14:26:08 +0100
Subject: [PATCH 214/481] Fix incorrect export of fragments in runtime.js
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Co-authored-by: Jérôme Vouillon <jerome.vouillon@gmail.com>
---
 runtime/wasm/runtime.js | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 5775992bc8..cb29c4fbd0 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -378,5 +378,6 @@
             event.error&&caml_handle_uncaught_exception(event.error))
     }
     await _initialize();
-})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>{return eval("("+x+")")})(globalThis,globalThis?.module?.exports||globalThis,globalThis),
-   PRIMITIVES, STRINGS, FRAGMENTS);
+})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval("("+x+")"))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
+   PRIMITIVES, STRINGS,
+   ((joo_global_object,jsoo_exports,globalThis)=>FRAGMENTS)(globalThis,globalThis?.module?.exports||globalThis,globalThis))

From 199c30a563ec692a512bca09719e33ff65b2ad01 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 19 Mar 2024 11:57:35 +0100
Subject: [PATCH 215/481] Runtime: small fixes

---
 compiler/lib/wasm/wa_gc_target.ml | 2 +-
 runtime/wasm/bigarray.wat         | 1 -
 runtime/wasm/effect.wat           | 6 +++---
 runtime/wasm/gc.wat               | 2 +-
 runtime/wasm/nat.wat              | 3 ++-
 runtime/wasm/runtime.js           | 2 +-
 runtime/wasm/sys.wat              | 2 +-
 7 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ec98462cc1..8c0939dde4 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1276,7 +1276,7 @@ let () =
             in
             EArrow
               ( J.fun_
-                  (List.map ~f:J.ident (f :: params))
+                  (List.map ~f:J.ident (f :: o :: params))
                   [ ( Return_statement
                         (Some
                            (J.call
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index f969ed227a..7c9ec05d1d 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -119,7 +119,6 @@
    (type $custom (sub (struct (field (ref $custom_operations)))))
 
    (global $bigarray_ops (export "bigarray_ops") (ref $custom_operations)
-      ;; ZZZ
       (struct.new $custom_operations
          (array.new_fixed $string 9 ;; "_bigarr02"
             (i32.const 95) (i32.const 98) (i32.const 105) (i32.const 103)
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 8c08e0f476..0e3470e817 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -375,7 +375,7 @@
       (local.get $stack))
 
    (func (export "caml_get_continuation_callstack")
-      (param (ref eq)) (result (ref eq))
+      (param (ref eq) (ref eq)) (result (ref eq))
       (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_is_continuation") (param (ref eq)) (result i32)
@@ -398,7 +398,7 @@
          (struct (field (ref $function_2)) (field (ref $function_4)))))
 
    (type $iterator
-     (sub $closure
+     (sub final $closure
        (struct
           (field (ref $function_1))
           (field $i (mut i32))
@@ -711,6 +711,6 @@
             (local.get $ms)))
       (call $raise_unhandled (local.get $eff) (ref.i31 (i32.const 0))))
 
-   (func (export "caml_cps_initialize_effects")
+   (func (export "caml_cps_initialize_effects") (param externref)
       (global.set $caml_trampoline_ref (ref.func $caml_trampoline)))
 )
diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat
index 7092618dcb..f8452f92bc 100644
--- a/runtime/wasm/gc.wat
+++ b/runtime/wasm/gc.wat
@@ -76,7 +76,7 @@
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_final_register_called_without_value")
-      (param (ref eq)) (result (ref eq))
+      (param (ref eq) (ref eq)) (result (ref eq))
       ;; ZZZ Use FinalizationRegistry?
       (ref.i31 (i32.const 0)))
 
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index bac430d8cc..9cdffaab6d 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -372,7 +372,8 @@
    (func (export "mult_nat")
       (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
       (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (param $nat3 (ref eq)) (param $vofs3 (ref eq)) (result (ref eq))
+      (param $nat3 (ref eq)) (param $vofs3 (ref eq)) (param $vlen3 (ref eq))
+      (result (ref eq))
       ;; ZZZ
       (call $log_str
          (array.new_data $string $mult_nat (i32.const 0) (i32.const 8)))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index ba356f46a1..17e1b9bdc3 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -320,7 +320,7 @@
          getenv:(n)=>isNode?process.env[n]:null,
          system:(c)=>{
            var res = require('child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
-           if(res.error)throw error; return res.signal?255:res.status
+           if(res.error)throw res.error; return res.signal?255:res.status
          },
          time:()=>performance.now(),
          getcwd:()=>isNode?process.cwd():'/static',
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 22f1cebce0..8fba4c08ad 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -153,7 +153,7 @@
       (array.new_fixed $string 0))
 
    (func (export "caml_install_signal_handler")
-      (param (ref eq)) (result (ref eq))
+      (param (ref eq) (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
 
    (global $caml_runtime_warnings (mut i32) (i32.const 0))

From 1a09fa572d45ee9f7da59eaff96136435fdc8cb0 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 22 Mar 2024 14:12:26 +0100
Subject: [PATCH 216/481] ocamlformat

---
 compiler/lib/wasm/wa_closure_conversion.ml |  2 +-
 compiler/lib/wasm/wa_gc_target.ml          | 32 ++++++++++------------
 compiler/lib/wasm/wa_wat_output.ml         |  9 +++---
 3 files changed, 19 insertions(+), 24 deletions(-)

diff --git a/compiler/lib/wasm/wa_closure_conversion.ml b/compiler/lib/wasm/wa_closure_conversion.ml
index d00ad741fd..7ba591e928 100644
--- a/compiler/lib/wasm/wa_closure_conversion.ml
+++ b/compiler/lib/wasm/wa_closure_conversion.ml
@@ -59,7 +59,7 @@ let collect_free_vars program var_depth depth pc closures =
 
 let mark_bound_variables var_depth block depth =
   Freevars.iter_block_bound_vars (fun x -> var_depth.(Var.idx x) <- depth) block;
-  List.iter block.body ~f:(fun( i,_) ->
+  List.iter block.body ~f:(fun (i, _) ->
       match i with
       | Let (_, Closure (params, _)) ->
           List.iter params ~f:(fun x -> var_depth.(Var.idx x) <- depth + 1)
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 60e07927ba..19f6ad7978 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -440,8 +440,7 @@ module Value = struct
     let* i' = i' in
     return (W.RefEq (i, i'))
 
-  let ref ty =
-    { W.nullable = false; typ = Type ty }
+  let ref ty = { W.nullable = false; typ = Type ty }
 
   let ref_test typ e =
     let* e = e in
@@ -468,11 +467,11 @@ module Value = struct
     let* x = x in
     return (f x)
 
-  let (>>|) x f = map f x
+  let ( >>| ) x f = map f x
 
   let eq_gen ~negate x y =
-    let xv  = Code.Var.fresh () in
-    let yv  = Code.Var.fresh () in
+    let xv = Code.Var.fresh () in
+    let yv = Code.Var.fresh () in
     let* js = Type.js_type in
     let n =
       if_expr
@@ -480,27 +479,24 @@ module Value = struct
         (* We mimic an "and" on the two conditions, but in a way that is nicer to the
            binaryen optimizer. *)
         (if_expr
-          I32
-          (ref_test (ref js) (load xv))
-          (ref_test (ref js) (load yv))
-          (Arith.const 0l))
+           I32
+           (ref_test (ref js) (load xv))
+           (ref_test (ref js) (load yv))
+           (Arith.const 0l))
         (caml_js_strict_equals (load xv) (load yv)
-          >>| (fun e -> W.RefCast ({ nullable = false; typ = I31 }, e))
-          >>| (fun e -> W.I31Get (S, e)))
+        >>| (fun e -> W.RefCast ({ nullable = false; typ = I31 }, e))
+        >>| fun e -> W.I31Get (S, e))
         (ref_eq (load xv) (load yv))
     in
     seq
       (let* () = store xv x in
-        let* () = store yv y in
-        return ())
+       let* () = store yv y in
+       return ())
       (val_int (if negate then Arith.eqz n else n))
 
+  let eq x y = eq_gen ~negate:false x y
 
-  let eq x y =
-    eq_gen ~negate:false x y
-
-  let neq x y =
-    eq_gen ~negate:true x y
+  let neq x y = eq_gen ~negate:true x y
 
   let ult = binop Arith.(ult)
 
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 7253974f11..b3b00dfe73 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -333,11 +333,10 @@ let expression_or_instructions ctx in_function =
     | ExternExternalize e -> [ List (Atom "extern.externalize" :: expression e) ]
     | IfExpr (ty, cond, ift, iff) ->
         [ List
-            (Atom "if"
-            :: (block_type { params = []; result = [ ty ] })
-               @ expression cond
-               @ [ List (Atom "then" :: expression ift) ]
-               @ [ List (Atom "else" :: expression iff) ])
+            ((Atom "if" :: block_type { params = []; result = [ ty ] })
+            @ expression cond
+            @ [ List (Atom "then" :: expression ift) ]
+            @ [ List (Atom "else" :: expression iff) ])
         ]
   and instruction i =
     match i with

From 462373f4f791b3d8714cb92a47c5336b5f6bd37d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Mar 2024 18:24:55 +0100
Subject: [PATCH 217/481] Fix translation of constants in cmo files

---
 compiler/lib/ocaml_compiler.ml | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
index 120126d58a..33ddbc6e64 100644
--- a/compiler/lib/ocaml_compiler.ml
+++ b/compiler/lib/ocaml_compiler.ml
@@ -35,15 +35,11 @@ let rec constant_of_const ~target c : Code.constant =
   | Const_base (Const_int32 i) -> Int (Int32, i)
   | Const_base (Const_int64 i) -> Int64 i
   | Const_base (Const_nativeint i) ->
-      Int
-        ( Native
-        , match target with
-          | `JavaScript -> Int32.of_nativeint_warning_on_overflow i
-          | `Wasm -> Int31.of_nativeint_warning_on_overflow i )
+      Int (Native, Int32.of_nativeint_warning_on_overflow i)
   | Const_immstring s -> String s
   | Const_float_array sl ->
-      let l = List.map ~f:(fun f -> Code.Float (float_of_string f)) sl in
-      Tuple (Obj.double_array_tag, Array.of_list l, Unknown)
+      let l = List.map ~f:(fun f -> float_of_string f) sl in
+      Float_array (Array.of_list l)
   | ((Const_pointer i) [@if ocaml_version < (4, 12, 0)]) ->
       Int
         (match target with

From 41e57117816a6a3fc0ebea073b75aaa2e01af382 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Mar 2024 19:33:04 +0100
Subject: [PATCH 218/481] Fix JS output: no newline after async keyword

---
 compiler/lib/js_output.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index f724f093ec..de8e5f4b63 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -440,7 +440,7 @@ struct
         (match k with
         | { async = true; generator = false } ->
             PP.string f "async";
-            PP.space f
+            PP.non_breaking_space f
         | { async = false; generator = false } -> ()
         | { async = true | false; generator = true } -> assert false);
         PP.break f;
@@ -878,7 +878,7 @@ struct
                PP.space f
            | { async = true; generator = false } ->
                PP.string f "async";
-               PP.space f
+               PP.non_breaking_space f
            | { async = true; generator = true } ->
                PP.string f "async*";
                PP.space f);

From 75a96df467e2d08c0a15f7b4a074b1d8a6266829 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Mar 2024 19:37:49 +0100
Subject: [PATCH 219/481] Typo

---
 runtime/wasm/sync.wat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index 744481cf75..056c4a4bfc 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -71,7 +71,7 @@
       (struct.set $mutex $state (local.get $t) (i32.const 1))
       (ref.i31 (i32.const 0)))
 
-   (func (export "caml_ml_try_lock") (param (ref eq)) (result (ref eq))
+   (func (export "caml_ml_mutex_try_lock") (param (ref eq)) (result (ref eq))
       (local $t (ref $mutex))
       (local.set $t (ref.cast (ref $mutex) (local.get 0)))
       (if (result (ref eq)) (struct.get $mutex $state (local.get $t))

From 3e1a839f763528b9c132e6c3762555fbec73c4ca Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Mar 2024 19:09:40 +0100
Subject: [PATCH 220/481] Disable JavaScript tests

---
 compiler/tests-compiler/dune.inc         | 184 +++++++++++------------
 compiler/tests-compiler/gen-rules/gen.ml |  12 +-
 compiler/tests-dynlink-js/dune           |   4 +
 compiler/tests-dynlink/dune              |   4 +
 compiler/tests-toplevel/dune             |   4 +
 examples/namespace/dune                  |   1 +
 examples/separate_compilation/dune       |   2 +
 toplevel/examples/eval/dune              |   4 +
 toplevel/examples/lwt_toplevel/dune      |   1 +
 toplevel/test/dune                       |   1 +
 10 files changed, 121 insertions(+), 96 deletions(-)

diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index 16031627fa..a049c39a1a 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -2,11 +2,11 @@
 (library
  ;; compiler/tests-compiler/array_access.ml
  (name array_access_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules array_access)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -17,11 +17,11 @@
 (library
  ;; compiler/tests-compiler/build_path_prefix_map.ml
  (name build_path_prefix_map_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules build_path_prefix_map)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -32,11 +32,11 @@
 (library
  ;; compiler/tests-compiler/call_gen.ml
  (name call_gen_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules call_gen)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -47,11 +47,11 @@
 (library
  ;; compiler/tests-compiler/cond.ml
  (name cond_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules cond)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -62,11 +62,11 @@
 (library
  ;; compiler/tests-compiler/direct_calls.ml
  (name direct_calls_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules direct_calls)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -77,11 +77,11 @@
 (library
  ;; compiler/tests-compiler/effects.ml
  (name effects_15)
- (enabled_if (>= %{ocaml_version} 5))
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
  (modules effects)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -92,11 +92,11 @@
 (library
  ;; compiler/tests-compiler/effects_continuations.ml
  (name effects_continuations_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules effects_continuations)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -107,11 +107,11 @@
 (library
  ;; compiler/tests-compiler/effects_exceptions.ml
  (name effects_exceptions_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules effects_exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -122,11 +122,11 @@
 (library
  ;; compiler/tests-compiler/effects_toplevel.ml
  (name effects_toplevel_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules effects_toplevel)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -137,11 +137,11 @@
 (library
  ;; compiler/tests-compiler/eliminate_exception_handler.ml
  (name eliminate_exception_handler_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules eliminate_exception_handler)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -152,11 +152,11 @@
 (library
  ;; compiler/tests-compiler/empty_cma.ml
  (name empty_cma_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules empty_cma)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -167,11 +167,11 @@
 (library
  ;; compiler/tests-compiler/end_to_end.ml
  (name end_to_end_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules end_to_end)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -182,11 +182,11 @@
 (library
  ;; compiler/tests-compiler/error.ml
  (name error_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules error)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -197,11 +197,11 @@
 (library
  ;; compiler/tests-compiler/es6.ml
  (name es6_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules es6)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -212,11 +212,11 @@
 (library
  ;; compiler/tests-compiler/exceptions.ml
  (name exceptions_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -227,11 +227,11 @@
 (library
  ;; compiler/tests-compiler/exports.ml
  (name exports_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules exports)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -242,11 +242,11 @@
 (library
  ;; compiler/tests-compiler/getenv.ml
  (name getenv_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules getenv)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -257,11 +257,11 @@
 (library
  ;; compiler/tests-compiler/gh1007.ml
  (name gh1007_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1007)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -272,11 +272,11 @@
 (library
  ;; compiler/tests-compiler/gh1051.ml
  (name gh1051_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1051)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -287,11 +287,11 @@
 (library
  ;; compiler/tests-compiler/gh1320.ml
  (name gh1320_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1320)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -302,11 +302,11 @@
 (library
  ;; compiler/tests-compiler/gh1349.ml
  (name gh1349_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1349)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -317,11 +317,11 @@
 (library
  ;; compiler/tests-compiler/gh1354.ml
  (name gh1354_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1354)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -332,11 +332,11 @@
 (library
  ;; compiler/tests-compiler/gh1390.ml
  (name gh1390_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1390)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -347,11 +347,11 @@
 (library
  ;; compiler/tests-compiler/gh747.ml
  (name gh747_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh747)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -362,11 +362,11 @@
 (library
  ;; compiler/tests-compiler/gl507.ml
  (name gl507_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gl507)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -377,11 +377,11 @@
 (library
  ;; compiler/tests-compiler/inlining.ml
  (name inlining_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules inlining)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -392,11 +392,11 @@
 (library
  ;; compiler/tests-compiler/js_parser_printer.ml
  (name js_parser_printer_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules js_parser_printer)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -407,11 +407,11 @@
 (library
  ;; compiler/tests-compiler/jsopt.ml
  (name jsopt_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules jsopt)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -422,11 +422,11 @@
 (library
  ;; compiler/tests-compiler/lambda_lifting.ml
  (name lambda_lifting_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules lambda_lifting)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -437,11 +437,11 @@
 (library
  ;; compiler/tests-compiler/lazy.ml
  (name lazy_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules lazy)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (>= %{ocaml_version} 5))
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -452,11 +452,11 @@
 (library
  ;; compiler/tests-compiler/loops.ml
  (name loops_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules loops)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -467,11 +467,11 @@
 (library
  ;; compiler/tests-compiler/macro.ml
  (name macro_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules macro)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -482,11 +482,11 @@
 (library
  ;; compiler/tests-compiler/match_with_exn.ml
  (name match_with_exn_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules match_with_exn)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -497,11 +497,11 @@
 (library
  ;; compiler/tests-compiler/minify.ml
  (name minify_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules minify)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -512,11 +512,11 @@
 (library
  ;; compiler/tests-compiler/mutable_closure.ml
  (name mutable_closure_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules mutable_closure)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -527,11 +527,11 @@
 (library
  ;; compiler/tests-compiler/obj.ml
  (name obj_15)
- (enabled_if (>= %{ocaml_version} 5))
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
  (modules obj)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (>= %{ocaml_version} 5))
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -542,11 +542,11 @@
 (library
  ;; compiler/tests-compiler/obj_dup.ml
  (name obj_dup_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules obj_dup)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -557,11 +557,11 @@
 (library
  ;; compiler/tests-compiler/side_effect.ml
  (name side_effect_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules side_effect)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -572,11 +572,11 @@
 (library
  ;; compiler/tests-compiler/sourcemap.ml
  (name sourcemap_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules sourcemap)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -587,11 +587,11 @@
 (library
  ;; compiler/tests-compiler/static_eval.ml
  (name static_eval_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules static_eval)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -602,11 +602,11 @@
 (library
  ;; compiler/tests-compiler/sys_command.ml
  (name sys_command_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules sys_command)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -617,11 +617,11 @@
 (library
  ;; compiler/tests-compiler/sys_fs.ml
  (name sys_fs_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules sys_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -632,11 +632,11 @@
 (library
  ;; compiler/tests-compiler/tailcall.ml
  (name tailcall_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules tailcall)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -647,11 +647,11 @@
 (library
  ;; compiler/tests-compiler/target_env.ml
  (name target_env_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules target_env)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -662,11 +662,11 @@
 (library
  ;; compiler/tests-compiler/unix_fs.ml
  (name unix_fs_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules unix_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -677,11 +677,11 @@
 (library
  ;; compiler/tests-compiler/variable_declaration_output.ml
  (name variable_declaration_output_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules variable_declaration_output)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml
index a74855765d..67f7fb9077 100644
--- a/compiler/tests-compiler/gen-rules/gen.ml
+++ b/compiler/tests-compiler/gen-rules/gen.ml
@@ -85,9 +85,13 @@ let () =
            basename
            (Hashtbl.hash prefix mod 100)
            (match lib_enabled_if basename with
-           | Any -> "true"
-           | GE5 -> "(>= %{ocaml_version} 5)")
+           | Any -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))"
+           | GE5 ->
+               "(and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= \
+                %{ocaml_version} 5))")
            basename
            (match test_enabled_if basename with
-           | Any -> "true"
-           | GE5 -> "(>= %{ocaml_version} 5)"))
+           | Any -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))"
+           | GE5 ->
+               "(and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= \
+                %{ocaml_version} 5))"))
diff --git a/compiler/tests-dynlink-js/dune b/compiler/tests-dynlink-js/dune
index 064ea7b5a8..6096c6f521 100644
--- a/compiler/tests-dynlink-js/dune
+++ b/compiler/tests-dynlink-js/dune
@@ -1,11 +1,13 @@
 (executable
  (name main)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules main)
  (libraries js_of_ocaml)
  (modes byte))
 
 (rule
  (target main.js)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (run %{bin:js_of_ocaml} --linkall -o %{target} %{dep:main.bc})))
 
@@ -21,6 +23,7 @@
 
 (rule
  (target main.out)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps plugin.js)
  (action
   (with-outputs-to
@@ -29,5 +32,6 @@
 
 (rule
  (alias runtest)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (diff main.out.expected main.out)))
diff --git a/compiler/tests-dynlink/dune b/compiler/tests-dynlink/dune
index 07e8b4e9e3..21c980c985 100644
--- a/compiler/tests-dynlink/dune
+++ b/compiler/tests-dynlink/dune
@@ -1,11 +1,13 @@
 (executable
  (name main)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules main)
  (libraries dynlink js_of_ocaml-compiler.dynlink)
  (modes byte))
 
 (rule
  (target main.js)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps plugin.cmo export)
  (action
   (run
@@ -25,6 +27,7 @@
 
 (rule
  (target main.out)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps plugin.cmo)
  (action
   (with-outputs-to
@@ -33,5 +36,6 @@
 
 (rule
  (alias runtest)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (diff main.out.expected main.out)))
diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune
index 4e1a49ba36..f045ca36c7 100644
--- a/compiler/tests-toplevel/dune
+++ b/compiler/tests-toplevel/dune
@@ -1,5 +1,6 @@
 (executables
  (names test_toplevel)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (libraries js_of_ocaml-compiler.dynlink compiler-libs.toplevel)
  (flags
   (:standard -linkall))
@@ -7,11 +8,13 @@
 
 (rule
  (targets test_toplevel.js)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (run %{bin:js_of_ocaml} --toplevel %{dep:test_toplevel.bc} -o %{targets})))
 
 (rule
  (target test_toplevel.referencejs)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps test_toplevel.js)
  (action
   (with-stdout-to
@@ -20,6 +23,7 @@
 
 (rule
  (alias runtest)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps test_toplevel.reference test_toplevel.referencejs)
  (action
   (diff test_toplevel.reference test_toplevel.referencejs)))
diff --git a/examples/namespace/dune b/examples/namespace/dune
index 9e18547e5c..fcc31a7fa3 100644
--- a/examples/namespace/dune
+++ b/examples/namespace/dune
@@ -59,5 +59,6 @@
 
 (rule
  (alias runtest)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (diff %{dep:for-node.expected} %{dep:for-node.actual})))
diff --git a/examples/separate_compilation/dune b/examples/separate_compilation/dune
index 4115a57ce8..78322b385c 100644
--- a/examples/separate_compilation/dune
+++ b/examples/separate_compilation/dune
@@ -110,12 +110,14 @@
 
 (rule
  (alias runtest)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps bin.reference bin.referencejs)
  (action
   (diff bin.reference bin.referencejs)))
 
 (alias
  (name default)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps
   myruntime.js
   stdlib.cma.js
diff --git a/toplevel/examples/eval/dune b/toplevel/examples/eval/dune
index a9f4c6827d..f261b2cf64 100644
--- a/toplevel/examples/eval/dune
+++ b/toplevel/examples/eval/dune
@@ -1,5 +1,6 @@
 (executables
  (names eval)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (libraries js_of_ocaml-compiler js_of_ocaml-toplevel)
  (link_flags
   (:standard -linkall))
@@ -9,12 +10,14 @@
 
 (rule
  (targets export.txt)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps eval.bc)
  (action
   (run jsoo_listunits -o %{targets} stdlib)))
 
 (rule
  (targets eval.js)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (action
   (run
    %{bin:js_of_ocaml}
@@ -28,4 +31,5 @@
 
 (alias
  (name default)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps eval.js index.html))
diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune
index c9afcb2013..50ef34ece4 100644
--- a/toplevel/examples/lwt_toplevel/dune
+++ b/toplevel/examples/lwt_toplevel/dune
@@ -149,4 +149,5 @@
 
 (alias
  (name default)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps toplevel.js toplevel.bc.js index.html))
diff --git a/toplevel/test/dune b/toplevel/test/dune
index e7fe80e479..54cfd5c5d4 100644
--- a/toplevel/test/dune
+++ b/toplevel/test/dune
@@ -36,6 +36,7 @@
 
 (rule
  (alias runtest)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (deps test_toplevel.reference test_toplevel.referencejs)
  (action
   (diff test_toplevel.reference test_toplevel.referencejs)))

From d9a33fe43c63cd3f42d8572329b3b4e00a6a284a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Mar 2024 09:27:44 +0100
Subject: [PATCH 221/481] Small peephole optimizations

Simplify ref.test and if expressions. This allows to optimize away some JavaScript equality tests.
---
 compiler/lib/wasm/wa_gc_target.ml | 59 +++++++++++++++++++++++++++++--
 1 file changed, 56 insertions(+), 3 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 40d19a619b..5e017f2d00 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -442,9 +442,21 @@ module Value = struct
 
   let ref ty = { W.nullable = false; typ = Type ty }
 
-  let ref_test typ e =
+  let ref_test (typ : W.ref_type) e =
     let* e = e in
-    return (W.RefTest (typ, e))
+    match e with
+    | W.RefI31 _ -> (
+        match typ.typ with
+        | W.I31 | Eq | Any -> return (W.Const (I32 1l))
+        | Type _ | Func | Extern -> return (W.Const (I32 0l)))
+    | GlobalGet (V nm) -> (
+        let* init = get_global nm in
+        match init with
+        | Some (W.ArrayNewFixed (t, _) | W.StructNew (t, _)) ->
+            let* b = heap_type_sub (Type t) typ.typ in
+            if b then return (W.Const (I32 1l)) else return (W.Const (I32 0l))
+        | _ -> return (W.RefTest (typ, e)))
+    | _ -> return (W.RefTest (typ, e))
 
   let caml_js_strict_equals x y =
     let* x = x in
@@ -457,11 +469,52 @@ module Value = struct
     in
     return (W.Call (f, [ x; y ]))
 
+  let rec effect_free e =
+    match e with
+    | W.Const _ | ConstSym _ | LocalGet _ | GlobalGet _ | RefFunc _ | RefNull _ -> true
+    | UnOp (_, e')
+    | I32WrapI64 e'
+    | I64ExtendI32 (_, e')
+    | F32DemoteF64 e'
+    | F64PromoteF32 e'
+    | Load (_, e')
+    | Load8 (_, _, e')
+    | RefI31 e'
+    | I31Get (_, e')
+    | ArrayLen e'
+    | StructGet (_, _, _, e')
+    | RefCast (_, e')
+    | RefTest (_, e')
+    | ExternInternalize e'
+    | ExternExternalize e' -> effect_free e'
+    | BinOp (_, e1, e2)
+    | ArrayNew (_, e1, e2)
+    | ArrayNewData (_, _, e1, e2)
+    | ArrayGet (_, _, e1, e2)
+    | RefEq (e1, e2) -> effect_free e1 && effect_free e2
+    | LocalTee _
+    | BlockExpr _
+    | Call_indirect _
+    | Call _
+    | MemoryGrow _
+    | Seq _
+    | Pop _
+    | Call_ref _
+    | Br_on_cast _
+    | Br_on_cast_fail _ -> false
+    | IfExpr (_, e1, e2, e3) -> effect_free e1 && effect_free e2 && effect_free e3
+    | ArrayNewFixed (_, l) | StructNew (_, l) -> List.for_all ~f:effect_free l
+
   let if_expr ty cond ift iff =
     let* cond = cond in
     let* ift = ift in
     let* iff = iff in
-    return (W.IfExpr (ty, cond, ift, iff))
+    match cond with
+    | W.Const (I32 n) -> return (if Int32.equal n 0l then iff else ift)
+    | _ ->
+        if Poly.equal ift iff && effect_free cond
+        then return ift
+        else return (W.IfExpr (ty, cond, ift, iff))
 
   let map f x =
     let* x = x in

From ab98abbff7615cfc19d7f13318ce24ce1597168f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Mar 2024 09:39:21 +0100
Subject: [PATCH 222/481] Better variable names

In particular, include part of the string contents in the name for short strings.
---
 compiler/lib/wasm/wa_code_generation.ml |  2 +-
 compiler/lib/wasm/wa_gc_target.ml       | 94 +++++++++++++++----------
 2 files changed, 57 insertions(+), 39 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index fdc9de35fd..300afc219d 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -432,7 +432,7 @@ let rec is_smi e =
 let get_i31_value x st =
   match st.instrs with
   | LocalSet (x', RefI31 e) :: rem when x = x' && is_smi e ->
-      let x = Var.fresh_n "cond" in
+      let x = Var.fresh () in
       let x, st = add_var ~typ:I32 x st in
       Some x, { st with instrs = LocalSet (x', RefI31 (LocalTee (x, e))) :: rem }
   | _ -> None, st
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 5e017f2d00..ebc3c2d296 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -879,8 +879,8 @@ end
 module Constant = struct
   let string_length_threshold = 100
 
-  let store_in_global c =
-    let name = Code.Var.fresh_n "const" in
+  let store_in_global ?(name = "const") c =
+    let name = Code.Var.fresh_n name in
     let* () = register_global (V name) { mut = false; typ = Type.value } c in
     return (W.GlobalGet (V name))
 
@@ -901,9 +901,14 @@ module Constant = struct
         | c -> Buffer.add_char b c);
     Buffer.contents b
 
+  type t =
+    | Const
+    | Const_named of string
+    | Mutated
+
   let rec translate_rec c =
     match c with
-    | Code.Int (Regular, i) -> return (true, W.RefI31 (Const (I32 i)))
+    | Code.Int (Regular, i) -> return (Const, W.RefI31 (Const (I32 i)))
     | Tuple (tag, a, _) ->
         let* ty = Type.block_type in
         let* l =
@@ -917,10 +922,20 @@ module Constant = struct
         in
         let l = List.rev l in
         let l' =
-          List.map ~f:(fun (const, v) -> if const then v else W.RefI31 (Const (I32 0l))) l
+          List.map
+            ~f:(fun (const, v) ->
+              match const with
+              | Const | Const_named _ -> v
+              | Mutated -> W.RefI31 (Const (I32 0l)))
+            l
         in
         let c = W.ArrayNewFixed (ty, RefI31 (Const (I32 (Int32.of_int tag))) :: l') in
-        if List.exists ~f:(fun (const, _) -> not const) l
+        if List.exists
+             ~f:(fun (const, _) ->
+               match const with
+               | Const | Const_named _ -> false
+               | Mutated -> true)
+             l
         then
           let* c = store_in_global c in
           let* () =
@@ -930,18 +945,18 @@ module Constant = struct
                     ~f:(fun (i, before) (const, v) ->
                       ( i + 1
                       , let* () = before in
-                        if const
-                        then return ()
-                        else
-                          Memory.wasm_array_set
-                            (return c)
-                            (Arith.const (Int32.of_int i))
-                            (return v) ))
+                        match const with
+                        | Const | Const_named _ -> return ()
+                        | Mutated ->
+                            Memory.wasm_array_set
+                              (return c)
+                              (Arith.const (Int32.of_int i))
+                              (return v) ))
                     ~init:(1, return ())
                     l))
           in
-          return (true, c)
-        else return (true, c)
+          return (Const, c)
+        else return (Const, c)
     | NativeString s ->
         let s =
           match s with
@@ -956,7 +971,9 @@ module Constant = struct
             (Global { mut = false; typ = Ref { nullable = false; typ = Extern } })
         in
         let* ty = Type.js_type in
-        return (true, W.StructNew (ty, [ ExternInternalize (GlobalGet (V x)) ]))
+        return
+          ( Const_named ("str_" ^ s)
+          , W.StructNew (ty, [ ExternInternalize (GlobalGet (V x)) ]) )
     | String s ->
         let* ty = Type.string_type in
         if String.length s > string_length_threshold
@@ -964,7 +981,7 @@ module Constant = struct
           let name = Code.Var.fresh_n "string" in
           let* () = register_data_segment name ~active:false [ DataBytes s ] in
           return
-            ( false
+            ( Mutated
             , W.ArrayNewData
                 (ty, name, Const (I32 0l), Const (I32 (Int32.of_int (String.length s))))
             )
@@ -975,42 +992,43 @@ module Constant = struct
               s
               ~init:[]
           in
-          return (true, W.ArrayNewFixed (ty, l))
+          return (Const_named ("str_" ^ s), W.ArrayNewFixed (ty, l))
     | Float f ->
         let* ty = Type.float_type in
-        return (true, W.StructNew (ty, [ Const (F64 f) ]))
+        return (Const, W.StructNew (ty, [ Const (F64 f) ]))
     | Float_array l ->
         let l = Array.to_list l in
         let* ty = Type.float_array_type in
         (*ZZZ Boxed array? *)
-        return (true, W.ArrayNewFixed (ty, List.map ~f:(fun f -> W.Const (F64 f)) l))
+        return (Const, W.ArrayNewFixed (ty, List.map ~f:(fun f -> W.Const (F64 f)) l))
     | Int64 i ->
         let* e = Memory.make_int64 (return (W.Const (I64 i))) in
-        return (true, e)
+        return (Const, e)
     | Int (Int32, i) ->
         let* e = Memory.make_int32 ~kind:`Int32 (return (W.Const (I32 i))) in
-        return (true, e)
+        return (Const, e)
     | Int (Native, i) ->
         let* e = Memory.make_int32 ~kind:`Nativeint (return (W.Const (I32 i))) in
-        return (true, e)
+        return (Const, e)
 
   let translate c =
     let* const, c = translate_rec c in
-    if const
-    then
-      let* b = is_small_constant c in
-      if b then return c else store_in_global c
-    else
-      let name = Code.Var.fresh_n "const" in
-      let* () =
-        register_global
-          ~constant:true
-          (V name)
-          { mut = true; typ = Type.value }
-          (W.RefI31 (Const (I32 0l)))
-      in
-      let* () = register_init_code (instr (W.GlobalSet (V name, c))) in
-      return (W.GlobalGet (V name))
+    match const with
+    | Const ->
+        let* b = is_small_constant c in
+        if b then return c else store_in_global c
+    | Const_named name -> store_in_global ~name c
+    | Mutated ->
+        let name = Code.Var.fresh_n "const" in
+        let* () =
+          register_global
+            ~constant:true
+            (V name)
+            { mut = true; typ = Type.value }
+            (W.RefI31 (Const (I32 0l)))
+        in
+        let* () = register_init_code (instr (W.GlobalSet (V name, c))) in
+        return (W.GlobalGet (V name))
 end
 
 module Closure = struct
@@ -1039,7 +1057,7 @@ module Closure = struct
     if List.is_empty free_variables
     then
       let* typ = Type.closure_type ~usage:`Alloc ~cps arity in
-      let name = Code.Var.fresh_n "closure" in
+      let name = Code.Var.fork f in
       let* () =
         register_global
           (V name)

From 862274b5e1d53c0c4394b0db65ccf162df0d9904 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Mar 2024 09:43:25 +0100
Subject: [PATCH 223/481] Simpler code to import JavaScript strings

We had to work around some Firefox limitations which are now fixed.
This reverts commit 8ed4e1848978e99feee0904f6d94b226bece73ea.
---
 README.md                         | 2 +-
 compiler/lib/wasm/wa_gc_target.ml | 6 ++----
 2 files changed, 3 insertions(+), 5 deletions(-)

diff --git a/README.md b/README.md
index e828d42ee5..5767cc9866 100644
--- a/README.md
+++ b/README.md
@@ -8,7 +8,7 @@ Wasm_of_ocaml relies on the Binaryen toolchain; currently, only [version 116](ht
 
 ## Supported engines
 
-The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and [Firefox 121](https://www.mozilla.org/en-US/firefox/new/).
+The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and [Firefox 122](https://www.mozilla.org/en-US/firefox/new/).
 
 In particular, the output code requires the following [Wasm extensions](https://webassembly.org/roadmap/) to run:
 - [the GC extension](https://github.com/WebAssembly/gc), including functional references and 31-bit integers
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ebc3c2d296..10204b09ed 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -968,12 +968,10 @@ module Constant = struct
           register_import
             ~import_module:"strings"
             ~name:(string_of_int i)
-            (Global { mut = false; typ = Ref { nullable = false; typ = Extern } })
+            (Global { mut = false; typ = Ref { nullable = false; typ = Any } })
         in
         let* ty = Type.js_type in
-        return
-          ( Const_named ("str_" ^ s)
-          , W.StructNew (ty, [ ExternInternalize (GlobalGet (V x)) ]) )
+        return (Const_named ("str_" ^ s), W.StructNew (ty, [ GlobalGet (V x) ]))
     | String s ->
         let* ty = Type.string_type in
         if String.length s > string_length_threshold

From 070788633c7f1dd93b22c221e26682ac375e8d34 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Mar 2024 09:46:12 +0100
Subject: [PATCH 224/481] Use a fragment to call the JavaScript 'eval' function

The call to 'eval' is usually optimized away. So only generate it if needed.
---
 compiler/lib/wasm/wa_gc_target.ml | 10 +++++++++-
 runtime/wasm/jslib.wat            | 14 --------------
 runtime/wasm/runtime.js           |  6 ++----
 3 files changed, 11 insertions(+), 19 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 10204b09ed..86544aec46 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1430,7 +1430,15 @@ let () =
                    str
                    pi.Parse_info.line
                    pi.Parse_info.col))
-        | [ Pv _ ] -> call_prim ~transl_prim_arg prim_name l
+        | [ Pv _ ] ->
+            let* () =
+              register_fragment "eval" (fun () ->
+                  let lex = Parse_js.Lexer.of_string {|(x)=>eval("("+x+")")|} in
+                  Parse_js.parse_expr lex)
+            in
+            JavaScript.invoke_fragment
+              "eval"
+              [ call_prim ~transl_prim_arg "caml_jsstring_of_string" l ]
         | [] | _ :: _ ->
             failwith (Printf.sprintf "Wrong number argument to primitive %s" prim_name))
   in
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index a0bff6e1e9..48386856b5 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -6,7 +6,6 @@
    (import "bindings" "identity" (func $to_int32 (param anyref) (result i32)))
    (import "bindings" "identity" (func $from_int32 (param i32) (result anyref)))
    (import "bindings" "from_bool" (func $from_bool (param i32) (result anyref)))
-   (import "bindings" "eval" (func $eval (param anyref) (result anyref)))
    (import "bindings" "get"
       (func $get (param (ref extern)) (param anyref) (result anyref)))
    (import "bindings" "set"
@@ -116,19 +115,6 @@
       (ref.i31 (call $strict_equals
                   (call $unwrap (local.get 0)) (call $unwrap (local.get 1)))))
 
-   ;; ZZZ We should generate JavaScript code instead of using 'eval'
-   (export "caml_pure_js_expr" (func $caml_js_expr))
-   (export "caml_js_var" (func $caml_js_expr))
-   (export "caml_js_eval_string" (func $caml_js_expr))
-   (func $caml_js_expr (export "caml_js_expr")
-      (param (ref eq)) (result (ref eq))
-      (local $s (ref $string))
-      (local.set $s (ref.cast (ref $string) (local.get 0)))
-      (return_call $wrap
-         (call $eval
-             (call $jsstring_of_substring
-                (local.get $s) (i32.const 0) (array.len (local.get $s))))))
-
    (func (export "caml_js_global") (param (ref eq)) (result (ref eq))
       (call $wrap (global.get $global_this)))
 
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 32f7bf1a25..58b5dbb3d4 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,4 +1,4 @@
-(async function (eval_function, js, strings, fragments) {
+(async function (js, strings, fragments) {
     "use strict";
     const src = 'CODE';
     function loadRelative(src) {
@@ -102,7 +102,6 @@
          delete:(x,y)=>delete x[y],
          instanceof:(x,y)=>x instanceof y,
          typeof:(x)=>typeof x,
-         eval:eval_function,
          equals:(x,y)=>x==y,
          strict_equals:(x,y)=>x===y,
          fun_call:(f,o,args)=>f.apply(o,args),
@@ -378,6 +377,5 @@
             event.error&&caml_handle_uncaught_exception(event.error))
     }
     await _initialize();
-})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval("("+x+")"))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
-   PRIMITIVES, STRINGS,
+})(PRIMITIVES, STRINGS,
    ((joo_global_object,jsoo_exports,globalThis)=>FRAGMENTS)(globalThis,globalThis?.module?.exports||globalThis,globalThis))

From 8d259a2c2a9d8a969e7f385a5336ec1344031f30 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Mar 2024 09:47:21 +0100
Subject: [PATCH 225/481] Split off the wasm_of_ocaml-compiler library

No file in compiler/lib depends on a file in compiler/lib/wasm, so we no
longer need to compile these two directories together.
---
 compiler/bin-js_of_ocaml/build_fs.ml  |  4 +-
 compiler/bin-js_of_ocaml/compile.ml   |  6 +--
 compiler/bin-wasm_of_ocaml/compile.ml |  6 ++-
 compiler/bin-wasm_of_ocaml/dune       |  2 +-
 compiler/lib/driver.ml                | 72 ++++++++++++++++-----------
 compiler/lib/driver.mli               |  8 ++-
 compiler/lib/dune                     |  2 -
 compiler/lib/wasm/dune                |  7 +++
 8 files changed, 66 insertions(+), 41 deletions(-)
 create mode 100644 compiler/lib/wasm/dune

diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml
index 68f5642d36..1b5931aefb 100644
--- a/compiler/bin-js_of_ocaml/build_fs.ml
+++ b/compiler/bin-js_of_ocaml/build_fs.ml
@@ -73,9 +73,9 @@ function jsoo_create_file_extern(name,content){
   let code = Code.prepend Code.empty instr in
   Filename.gen_file output_file (fun chan ->
       let pfs_fmt = Pretty_print.to_out_channel chan in
-      let (_ : Source_map.t option), _ =
+      let (_ : Source_map.t option) =
         Driver.f
-          ~target:(`JavaScript pfs_fmt)
+          ~target:(JavaScript pfs_fmt)
           ~standalone:true
           ~wrap_with_fun:`Iife
           (Parse_bytecode.Debug.create ~include_cmis:false false)
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 39990fc6c8..8a7e584e3f 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -179,7 +179,7 @@ let run
   let output (one : Parse_bytecode.one) ~standalone ~source_map ~linkall output_file =
     check_debug one;
     let init_pseudo_fs = fs_external && standalone in
-    let sm, _ =
+    let sm =
       match output_file with
       | `Stdout, fmt ->
           let instr =
@@ -191,7 +191,7 @@ let run
           in
           let code = Code.prepend one.code instr in
           Driver.f
-            ~target:(`JavaScript fmt)
+            ~target:(JavaScript fmt)
             ~standalone
             ?profile
             ~linkall
@@ -215,7 +215,7 @@ let run
           let code = Code.prepend one.code instr in
           let res =
             Driver.f
-              ~target:(`JavaScript fmt)
+              ~target:(JavaScript fmt)
               ~standalone
               ?profile
               ~linkall
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 9d46185c05..7ee727c9f0 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -18,6 +18,7 @@
 
 open! Js_of_ocaml_compiler.Stdlib
 open Js_of_ocaml_compiler
+open Wasm_of_ocaml_compiler
 
 let times = Debug.find "times"
 
@@ -315,9 +316,9 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
   let need_debug = Config.Flag.debuginfo () in
   let output (one : Parse_bytecode.one) ~standalone ch =
     let code = one.code in
-    let _, strings =
+    let live_vars, in_cps, p =
       Driver.f
-        ~target:(`Wasm ch)
+        ~target:Wasm
         ~standalone
         ?profile
         ~linkall:false
@@ -325,6 +326,7 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
         one.debug
         code
     in
+    let strings = Wa_generate.f ch ~live_vars ~in_cps p in
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
     strings
   in
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index 77efec5eb8..3505a409de 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -4,7 +4,7 @@
  (package wasm_of_ocaml-compiler)
  (libraries
   jsoo_cmdline
-  js_of_ocaml-compiler
+  wasm_of_ocaml-compiler
   cmdliner
   compiler-libs.common
   js_of_ocaml-compiler.runtime-files
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index f3cd7837e3..c34ae1ca1c 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -574,10 +574,14 @@ let configure formatter =
   Code.Var.set_pretty (pretty && not (Config.Flag.shortvar ()));
   Code.Var.set_stable (Config.Flag.stable_var ())
 
-let target_flag t =
+type 'a target =
+  | JavaScript : Pretty_print.t -> Source_map.t option target
+  | Wasm : (Deadcode.variable_uses * Effects.in_cps * Code.program) target
+
+let target_flag (type a) (t : a target) =
   match t with
-  | `JavaScript _ -> `JavaScript
-  | `Wasm _ -> `Wasm
+  | JavaScript _ -> `JavaScript
+  | Wasm -> `Wasm
 
 let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(linkall = false) p =
   p
@@ -586,8 +590,16 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(linkall = fals
   |> coloring
   |> check_js
 
-let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
-  let exported_runtime = not standalone in
+let full
+    (type result)
+    ~(target : result target)
+    ~standalone
+    ~wrap_with_fun
+    ~profile
+    ~linkall
+    ~source_map
+    d
+    p : result =
   let opt =
     specialize_js_once
     +> (match profile with
@@ -599,30 +611,39 @@ let full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p =
     +> effects
     +> map_fst
          ((match target with
-          | `JavaScript _ -> Generate_closure.f
-          | `Wasm _ -> Fun.id)
+          | JavaScript _ -> Generate_closure.f
+          | Wasm -> Fun.id)
          +> deadcode')
   in
-  let emit formatter =
-    generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
-    +> link_and_pack ~standalone ~wrap_with_fun ~linkall
-    +> output formatter ~source_map ()
-  in
   if times () then Format.eprintf "Start Optimizing...@.";
   let t = Timer.make () in
   let r = opt p in
   let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
   match target with
-  | `JavaScript formatter ->
+  | JavaScript formatter ->
+      let exported_runtime = not standalone in
+      let emit formatter =
+        generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
+        +> link_and_pack ~standalone ~wrap_with_fun ~linkall
+        +> output formatter ~source_map ()
+      in
       let source_map = emit formatter r in
-      source_map, ([], [])
-  | `Wasm ch ->
+      source_map
+  | Wasm ->
       let (p, live_vars), _, in_cps = r in
-      None, Wa_generate.f ch ~live_vars ~in_cps p
-
-let full_no_source_map ~target ~standalone ~wrap_with_fun ~profile ~linkall d p =
-  let (_ : Source_map.t option * _) =
-    full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map:None d p
+      live_vars, in_cps, p
+
+let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~linkall d p =
+  let (_ : Source_map.t option) =
+    full
+      ~target:(JavaScript formatter)
+      ~standalone
+      ~wrap_with_fun
+      ~profile
+      ~linkall
+      ~source_map:None
+      d
+      p
   in
   ()
 
@@ -645,19 +666,12 @@ let f'
     formatter
     d
     p =
-  full_no_source_map
-    ~target:(`JavaScript formatter)
-    ~standalone
-    ~wrap_with_fun
-    ~profile
-    ~linkall
-    d
-    p
+  full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~linkall d p
 
 let from_string ~prims ~debug s formatter =
   let p, d = Parse_bytecode.from_string ~prims ~debug s in
   full_no_source_map
-    ~target:(`JavaScript formatter)
+    ~formatter
     ~standalone:false
     ~wrap_with_fun:`Anonymous
     ~profile:O1
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 9b27c91f10..b35e57f94d 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -20,8 +20,12 @@
 
 type profile
 
+type 'a target =
+  | JavaScript : Pretty_print.t -> Source_map.t option target
+  | Wasm : (Deadcode.variable_uses * Effects.in_cps * Code.program) target
+
 val f :
-     target:[ `JavaScript of Pretty_print.t | `Wasm of out_channel ]
+     target:'result target
   -> ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
   -> ?profile:profile
@@ -29,7 +33,7 @@ val f :
   -> ?source_map:Source_map.t
   -> Parse_bytecode.Debug.t
   -> Code.program
-  -> Source_map.t option * (string list * (string * Javascript.expression) list)
+  -> 'result
 
 val f' :
      ?standalone:bool
diff --git a/compiler/lib/dune b/compiler/lib/dune
index 04d44f7053..b03e41bdf8 100644
--- a/compiler/lib/dune
+++ b/compiler/lib/dune
@@ -41,8 +41,6 @@
  (modules annot_parser)
  (flags --explain))
 
-(include_subdirs unqualified)
-
 (rule
  (targets compiler_version.ml)
  (deps
diff --git a/compiler/lib/wasm/dune b/compiler/lib/wasm/dune
new file mode 100644
index 0000000000..2a54c9316f
--- /dev/null
+++ b/compiler/lib/wasm/dune
@@ -0,0 +1,7 @@
+(library
+ (name wasm_of_ocaml_compiler)
+ (public_name wasm_of_ocaml-compiler)
+ (synopsis "Wasm_of_ocaml compiler library")
+ (libraries js_of_ocaml_compiler)
+ (flags
+  (:standard -w -7-37 -safe-string -open Js_of_ocaml_compiler)))

From dba50934b6a938dd588a70c5ad72082b00c491bd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Mar 2024 14:25:27 +0100
Subject: [PATCH 226/481] Simpler string conversion functions

---
 runtime/wasm/float.wat    | 16 +++++++---------
 runtime/wasm/jslib.wat    | 27 ++++++++-------------------
 runtime/wasm/jsstring.wat | 21 ++++++++++-----------
 runtime/wasm/runtime.js   |  4 ++--
 4 files changed, 27 insertions(+), 41 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 36972f5f2a..4f4fa24ff7 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -1,10 +1,8 @@
 (module
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
-   (import "jslib" "caml_jsstring_of_string"
-      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
    (import "bindings" "format_float"
       (func $format_float
-         (param i32) (param i32) (param f64) (result anyref)))
+         (param i32) (param i32) (param i32) (param f64) (result anyref)))
    (import "bindings" "identity"
       (func $parse_float (param anyref) (result f64)))
    (import "Math" "exp" (func $exp (param f64) (result f64)))
@@ -13,9 +11,10 @@
       (func $caml_invalid_argument (param (ref eq))))
    (import "ints" "lowercase_hex_table"
       (global $lowercase_hex_table (ref $chars)))
+   (import "jsstring" "jsstring_of_string"
+      (func $jsstring_of_string (param (ref $string)) (result anyref)))
    (import "jsstring" "string_of_jsstring"
-      (func $string_of_jsstring
-         (param anyref) (param i32) (result (ref $string))))
+      (func $string_of_jsstring (param anyref) (result (ref $string))))
 
    (type $float (struct (field f64)))
    (type $string (array (mut i8)))
@@ -291,9 +290,9 @@
             (local.set $num
                (call $format_float
                   (local.get $precision) (local.get $conversion)
+                  (local.get $i)
                   (f64.abs (local.get $f))))
-            (local.set $s
-               (call $string_of_jsstring (local.get $num) (local.get $i)))
+            (local.set $s (call $string_of_jsstring (local.get $num)))
             (br $sign (local.get $s))))
       (if (local.get $negative)
          (then
@@ -637,8 +636,7 @@
                                                 (local.get $negative))))
                                        ))))))))))))))))))
          (local.set $f
-            (call $parse_float
-               (call $unwrap (call $caml_jsstring_of_string (local.get $s)))))
+            (call $parse_float (call $jsstring_of_string (local.get $s))))
          (br_if $error (f64.ne (local.get $f) (local.get $f)))
          (return (struct.new $float (local.get $f))))
       (call $caml_failwith
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 48386856b5..8cdb041d11 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -68,12 +68,10 @@
       (func $caml_is_closure (param (ref eq)) (result i32)))
    (import "obj" "caml_is_last_arg"
       (func $caml_is_last_arg (param (ref eq)) (result i32)))
-   (import "jsstring" "jsstring_of_substring"
-      (func $jsstring_of_substring
-         (param (ref $string)) (param i32) (param i32) (result anyref)))
+   (import "jsstring" "jsstring_of_string"
+      (func $jsstring_of_string (param (ref $string)) (result anyref)))
    (import "jsstring" "string_of_jsstring"
-      (func $string_of_jsstring
-         (param anyref) (param i32) (result (ref $string))))
+      (func $string_of_jsstring (param anyref) (result (ref $string))))
    (import "int32" "caml_copy_int32"
       (func $caml_copy_int32 (param i32) (result (ref eq))))
    (import "int32" "Int32_val"
@@ -442,10 +440,7 @@
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
       (local.set $s (ref.cast (ref $string) (local.get 0)))
-      (return
-         (struct.new $js
-            (call $jsstring_of_substring
-               (local.get $s) (i32.const 0) (array.len (local.get $s))))))
+      (return (struct.new $js (call $jsstring_of_string (local.get $s)))))
 
    (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
       (param (ref eq)) (result (ref eq))
@@ -468,8 +463,7 @@
          (then
             (return
                (struct.new $js
-                  (call $jsstring_of_substring
-                     (local.get $s) (i32.const 0) (local.get $i))))))
+                  (call $jsstring_of_string (local.get $s))))))
       (local.set $s'
          (array.new $string (i32.const 0)
             (i32.add (local.get $i) (local.get $n))))
@@ -496,17 +490,13 @@
                      (local.set $n (i32.add (local.get $n) (i32.const 2)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $fill))))
-      (return
-         (struct.new $js
-            (call $jsstring_of_substring
-               (local.get $s') (i32.const 0) (local.get $n)))))
+      (return (struct.new $js (call $jsstring_of_string (local.get $s')))))
 
    (export "caml_js_to_string" (func $caml_string_of_jsstring))
    (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
       (param $s (ref eq)) (result (ref eq))
       (return_call $string_of_jsstring
-         (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))
-         (i32.const 0)))
+         (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))))
 
    (func (export "caml_string_of_jsbytes")
       (param $s (ref eq)) (result (ref eq))
@@ -514,8 +504,7 @@
       (local $s' (ref $string)) (local $s'' (ref $string))
       (local.set $s'
          (call $string_of_jsstring
-            (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))
-            (i32.const 0)))
+            (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))))
       (local.set $l (array.len (local.get $s')))
       (local.set $i (i32.const 0))
       (local.set $n (i32.const 0))
diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
index 3a2a25320e..11c18426c2 100644
--- a/runtime/wasm/jsstring.wat
+++ b/runtime/wasm/jsstring.wat
@@ -33,18 +33,18 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop)))))
 
-   (func $jsstring_of_substring (export "jsstring_of_substring")
-      (param $s (ref $string)) (param $pos i32) (param $len i32)
-      (result anyref)
+   (func (export "jsstring_of_string") (param $s (ref $string)) (result anyref)
       (local $s' anyref)
       (local $continued i32)
+      (local $pos i32) (local $len i32)
+      (local.set $len (array.len (local.get $s)))
       (if (i32.le_u (local.get $len) (global.get $buffer_size))
          (then
             (call $write_to_buffer
-               (local.get $s) (local.get $pos) (local.get $len))
+               (local.get $s) (i32.const 0) (local.get $len))
             (return_call $read_string (local.get $len))))
       (call $write_to_buffer
-         (local.get $s) (local.get $pos) (global.get $buffer_size))
+         (local.get $s) (i32.const 0) (global.get $buffer_size))
       (local.set $s'
          (call $read_string_stream (global.get $buffer_size) (i32.const 1)))
       (loop $loop
@@ -81,19 +81,18 @@
       (struct (field $s (ref $string)) (field $next (ref null $stack))))
    (global $stack (mut (ref null $stack)) (ref.null $stack))
 
-   (func $string_of_jsstring (export "string_of_jsstring")
-      (param $s anyref) (param $ofs i32) (result (ref $string))
-      (local $len i32)
+   (func (export "string_of_jsstring")
+      (param $s anyref) (result (ref $string))
+      (local $ofs i32) (local $len i32)
       (local $s' (ref $string)) (local $s'' (ref $string))
       (local $item (ref $stack))
       (local.set $len (call $write_string (local.get $s)))
       (if (ref.is_null (global.get $stack))
          (then
             (local.set $s'
-               (array.new $string
-                  (i32.const 0) (i32.add (local.get $len) (local.get $ofs))))
+               (array.new $string (i32.const 0) (local.get $len)))
             (call $read_from_buffer
-               (local.get $s') (local.get $ofs) (local.get $len))
+               (local.get $s') (i32.const 0) (local.get $len))
             (return (local.get $s'))))
       (block $done
          (local.set $item (br_on_null $done (global.get $stack)))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 58b5dbb3d4..82a9edd695 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -218,7 +218,7 @@
              return caml_callback(f, args.length, args, 2);
          },
          wrap_fun_arguments:(f)=>function(){return f(arguments)},
-         format_float:(prec, conversion, x)=>{
+         format_float:(prec, conversion, pad, x)=>{
            function toFixed(x,dp) {
              if (Math.abs(x) < 1.0) {
                return x.toFixed(dp);
@@ -273,7 +273,7 @@
              }
              break;
            }
-           return s
+           return pad?" "+s:s
          },
          gettimeofday:()=>(new Date()).getTime() / 1000,
          gmtime:(t)=>{

From e04f9189b774866fc8e7a87b6df6af6ad4b81073 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Mar 2024 18:20:21 +0100
Subject: [PATCH 227/481] Use JS String Builtins for string conversions

https://github.com/WebAssembly/js-string-builtins

Enabled with flag --experimental-wasm-imported-strings in node, and
through chrome://flags/#enable-experimental-webassembly-features in
Chrome.
---
 .github/workflows/build.yml |   2 +-
 runtime/wasm/jsstring.wat   | 136 ++++++++++++++++++++----------------
 runtime/wasm/runtime.js     |  19 +++--
 tools/node_wrapper.sh       |   2 +-
 4 files changed, 92 insertions(+), 67 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 2a66055b2e..8039855b52 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -31,7 +31,7 @@ jobs:
       - name: Install node
         uses: actions/setup-node@v4
         with:
-          node-version: v22.0.0-v8-canary20231204cf8ac0f493
+          node-version: v22.0.0-v8-canary2024030314ed92e804
 
       - name: Restore cached binaryen
         id: cache-binaryen
diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
index 11c18426c2..758f0ae084 100644
--- a/runtime/wasm/jsstring.wat
+++ b/runtime/wasm/jsstring.wat
@@ -1,4 +1,19 @@
 (module
+   (import "wasm:js-string" "compare"
+      (func $compare_strings (param externref externref) (result i32)))
+   (import "wasm:js-string" "test"
+      (func $is_string (param externref) (result i32)))
+   (import "wasm:js-string" "hash"
+      (func $hash_string (param i32) (param anyref) (result i32)))
+
+   (import "wasm:text-decoder" "decodeStringFromUTF8Array"
+      (func $decodeStringFromUTF8Array
+         (param (ref null $string)) (param i32) (param i32)
+         (result (ref extern))))
+   (import "wasm:text-encoder" "encodeStringToUTF8Array"
+      (func $encodeStringToUTF8Array
+         (param externref) (result (ref $string))))
+
    (import "bindings" "read_string"
       (func $read_string (param i32) (result anyref)))
    (import "bindings" "read_string_stream"
@@ -7,16 +22,65 @@
       (func $write_string (param anyref) (result i32)))
    (import "bindings" "append_string"
       (func $append_string (param anyref) (param anyref) (result anyref)))
-   (import "bindings" "compare_strings"
-      (func $compare_strings
-         (param anyref) (param anyref) (result i32)))
-   (import "bindings" "hash_string"
-      (func $hash_string (param i32) (param anyref) (result i32)))
-   (import "bindings" "is_string"
-      (func $is_string (param anyref) (result i32)))
 
    (type $string (array (mut i8)))
 
+   (global $builtins_available (mut i32) (i32.const 0))
+
+   (start $init)
+
+   (func $init
+      ;; Our dummy implementation of string conversion always returns
+      ;; the empty string.
+      (global.set $builtins_available
+         (i32.ne
+            (i32.const 0)
+            (call $compare_strings
+               (call $decodeStringFromUTF8Array
+                  (array.new_fixed $string 1 (i32.const 0))
+                  (i32.const 0) (i32.const 1))
+               (call $decodeStringFromUTF8Array
+                  (array.new_fixed $string 1 (i32.const 1))
+                   (i32.const 0) (i32.const 1))))))
+
+   (func (export "jsstring_compare")
+      (param $s anyref) (param $s' anyref) (result i32)
+      (return_call $compare_strings
+         (extern.externalize (local.get $s))
+         (extern.externalize (local.get $s'))))
+
+   (func (export "jsstring_test") (param $s anyref) (result i32)
+      (return_call $is_string (extern.externalize (local.get $s))))
+
+   (export "jsstring_hash" (func $hash_string))
+
+   ;; Used by package zarith_stubs_js
+   (func $jsstring_of_substring (export "jsstring_of_substring")
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (result anyref)
+      (if (global.get $builtins_available)
+         (then
+            (return
+               (extern.internalize
+                  (call $decodeStringFromUTF8Array (local.get $s)
+                     (local.get $pos)
+                     (i32.add (local.get $pos) (local.get $len)))))))
+      (return_call $jsstring_of_substring_fallback
+         (local.get $s) (local.get $pos) (local.get $len)))
+
+   (func (export "jsstring_of_string") (param $s (ref $string)) (result anyref)
+      (return_call $jsstring_of_substring
+         (local.get $s) (i32.const 0) (array.len (local.get $s))))
+
+   (func (export "string_of_jsstring") (param $s anyref) (result (ref $string))
+      (if (global.get $builtins_available)
+         (then
+            (return_call $encodeStringToUTF8Array
+               (extern.externalize (local.get $s)))))
+      (return_call $string_of_jsstring_fallback (local.get $s)))
+
+   ;; Fallback implementation of string conversion functions
+
    (memory (export "caml_buffer") 1)
 
    (global $buffer_size i32 (i32.const 65536))
@@ -33,18 +97,18 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop)))))
 
-   (func (export "jsstring_of_string") (param $s (ref $string)) (result anyref)
+   (func $jsstring_of_substring_fallback
+      (param $s (ref $string)) (param $pos i32) (param $len i32)
+      (result anyref)
       (local $s' anyref)
       (local $continued i32)
-      (local $pos i32) (local $len i32)
-      (local.set $len (array.len (local.get $s)))
       (if (i32.le_u (local.get $len) (global.get $buffer_size))
          (then
             (call $write_to_buffer
-               (local.get $s) (i32.const 0) (local.get $len))
+               (local.get $s) (local.get $pos) (local.get $len))
             (return_call $read_string (local.get $len))))
       (call $write_to_buffer
-         (local.get $s) (i32.const 0) (global.get $buffer_size))
+         (local.get $s) (local.get $pos) (global.get $buffer_size))
       (local.set $s'
          (call $read_string_stream (global.get $buffer_size) (i32.const 1)))
       (loop $loop
@@ -81,8 +145,7 @@
       (struct (field $s (ref $string)) (field $next (ref null $stack))))
    (global $stack (mut (ref null $stack)) (ref.null $stack))
 
-   (func (export "string_of_jsstring")
-      (param $s anyref) (result (ref $string))
+   (func $string_of_jsstring_fallback (param $s anyref) (result (ref $string))
       (local $ofs i32) (local $len i32)
       (local $s' (ref $string)) (local $s'' (ref $string))
       (local $item (ref $stack))
@@ -129,49 +192,4 @@
       (local.set $s (array.new $string (i32.const 0) (local.get $len)))
       (call $read_from_buffer (local.get $s) (i32.const 0) (local.get $len))
       (global.set $stack (struct.new $stack (local.get $s) (global.get $stack))))
-
-   (export "jsstring_compare" (func $compare_strings))
-   (export "jsstring_hash" (func $hash_string))
-   (export "jsstring_test" (func $is_string))
-
-(;
-   ;; stringref implementation
-
-   (import "hash" "caml_hash_mix_int"
-      (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
-
-   (func $jsstring_of_substring (export "jsstring_of_substring")
-      (param $s (ref $string)) (param $pos i32) (param $len i32)
-      (result anyref)
-      (string.new_lossy_utf8_array (local.get $s) (local.get $pos)
-         (i32.add (local.get $pos) (local.get $len))))
-
-   (func $string_of_jsstring (export "string_of_jsstring")
-      (param $s0 anyref) (param $ofs i32) (result (ref $string))
-      (local $l i32)
-      (local $s (ref string))
-      (local $s' (ref $string))
-      (local.set $s (ref.cast (ref string) (local.get $s0)))
-      (local.set $l (string.measure_wtf8 (local.get $s)))
-      (local.set $s'
-         (array.new $string
-            (i32.const 0) (i32.add (local.get $l) (local.get $ofs))))
-      (drop (string.encode_lossy_utf8_array
-               (local.get $s) (local.get $s') (local.get $ofs)))
-      (local.get $s'))
-
-   (func (export "jsstring_compare")
-      (param $s anyref) (param $s' anyref) (result i32)
-      (string.compare
-         (ref.cast (ref string) (local.get $s))
-         (ref.cast (ref string) (local.get $s'))))
-
-   (func (export "jsstring_hash")
-      (param $h i32) (param $s anyref) (result i32)
-      (return_call $caml_hash_mix_int (local.get $h)
-         (string.hash (ref.cast (ref string) (local.get $s)))))
-
-   (func (export "jsstring_test") (param $s anyref) (result i32)
-      (ref.test (ref string) (local.get $s)))
-;)
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 82a9edd695..61482cbb5a 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -129,9 +129,6 @@
              start += read;
            }
          },
-         compare_strings:(s1,s2)=>(s1<s2)?-1:+(s1>s2),
-         hash_string,
-         is_string:(v)=>+(typeof v==="string"),
          ta_create:(k,sz)=> new(typed_arrays[k])(sz),
          ta_normalize:(a)=>
            a instanceof Uint32Array?
@@ -346,10 +343,20 @@
          map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const imports = {Math:math,bindings,env:{},js,strings,fragments}
+    let string_ops =
+        {test:(v)=>+(typeof v==="string"),
+         compare:(s1,s2)=>(s1<s2)?-1:+(s1>s2),
+         hash:hash_string,
+         decodeStringFromUTF8Array:()=>"",
+         encodeStringToUTF8Array:()=>0}
+    const imports =
+        {Math:math,bindings,"wasm:js-string":string_ops,
+         "wasm:text-decoder":string_ops,"wasm:text-encoder":string_ops,
+         env:{},js,strings,fragments}
+    const options = { builtins: ['js-string', 'text-decoder', 'text-encoder'] }
     const wasmModule =
-          isNode?await WebAssembly.instantiate(await code, imports)
-                :await WebAssembly.instantiateStreaming(code,imports)
+          isNode?await WebAssembly.instantiate(await code, imports, options)
+                :await WebAssembly.instantiateStreaming(code,imports, options)
 
     var {caml_callback, caml_alloc_tm, caml_start_fiber,
          caml_handle_uncaught_exception, caml_buffer,
diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh
index 27602aadc1..8e09e597e7 100755
--- a/tools/node_wrapper.sh
+++ b/tools/node_wrapper.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively
-exec node --experimental-wasm-stack-switching --stack-size=7000 "$@"
+exec node --experimental-wasm-imported-strings --experimental-wasm-stack-switching --stack-size=7000 "$@"

From 628d4e007f4b1bbe6bdc1f7f0c184fa0456c3351 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 8 Mar 2024 12:34:54 -0500
Subject: [PATCH 228/481] Sourcemap support for wasm
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Implement mapping between source and wasm locations.

To work, this requires a version of Binaryen compiled with Jérôme's
patch WebAssembly/binaryen#6372.

Single-stepping can jump around in slightly surprising ways in the OCaml
code, due to the different order of operations in wasm. This could be
improved by modifying Binaryen to support “no location” annotations.
Another future improvement can be to support mapping Wasm identifiers to
OCaml ones.

Co-authored-by: Jérôme Vouillon <jerome.vouillon@gmail.com>
---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml     |  29 ++-
 compiler/bin-wasm_of_ocaml/cmd_arg.mli    |   1 +
 compiler/bin-wasm_of_ocaml/compile.ml     |  98 +++++++---
 compiler/bin-wasm_of_ocaml/dune           |   3 +-
 compiler/lib/driver.ml                    |   6 +-
 compiler/lib/driver.mli                   |   4 +-
 compiler/lib/generate.ml                  |  27 +--
 compiler/lib/generate.mli                 |   6 +
 compiler/lib/link_js.ml                   |   2 +-
 compiler/lib/source_map_io.mli            |  11 +-
 compiler/lib/source_map_io.yojson.ml      |  53 +++---
 compiler/lib/wasm/wa_asm_output.ml        |   3 +
 compiler/lib/wasm/wa_ast.ml               |   2 +
 compiler/lib/wasm/wa_code_generation.ml   |  11 ++
 compiler/lib/wasm/wa_code_generation.mli  |   2 +
 compiler/lib/wasm/wa_generate.ml          | 207 ++++++++++++----------
 compiler/lib/wasm/wa_generate.mli         |   1 +
 compiler/lib/wasm/wa_initialize_locals.ml |   1 +
 compiler/lib/wasm/wa_tail_call.ml         |  37 ++--
 compiler/lib/wasm/wa_wat_output.ml        |  22 ++-
 compiler/lib/wasm/wa_wat_output.mli       |   2 +-
 compiler/tests-jsoo/lib-effects/dune      |   4 +-
 compiler/tests-num/dune                   |  10 +-
 compiler/tests-ocaml/lib-hashtbl/dune     |  10 +-
 compiler/tests-sourcemap/dune             |  10 +-
 25 files changed, 373 insertions(+), 189 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index 0e043591de..83a2010a1a 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -28,6 +28,7 @@ type t =
   ; runtime_files : string list
   ; output_file : string * bool
   ; input_file : string
+  ; enable_source_maps : bool
   ; params : (string * string) list
   }
 
@@ -50,11 +51,11 @@ let options =
     Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc)
   in
   let no_sourcemap =
-    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    let doc = "Disable sourcemap output." in
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
   in
   let sourcemap =
-    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    let doc = "Output source locations in a separate sourcemap file." in
     Arg.(value & flag & info [ "sourcemap"; "source-map" ] ~doc)
   in
   let sourcemap_inline_in_js =
@@ -69,7 +70,16 @@ let options =
       & opt_all (list (pair ~sep:'=' (enum all) string)) []
       & info [ "set" ] ~docv:"PARAM=VALUE" ~doc)
   in
-  let build_t common set_param profile _ _ _ output_file input_file runtime_files =
+  let build_t
+      common
+      set_param
+      profile
+      sourcemap
+      no_sourcemap
+      _
+      output_file
+      input_file
+      runtime_files =
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let output_file =
       match output_file with
@@ -77,7 +87,16 @@ let options =
       | None -> chop_extension input_file ^ ".js", false
     in
     let params : (string * string) list = List.flatten set_param in
-    `Ok { common; params; profile; output_file; input_file; runtime_files }
+    let enable_source_maps = (not no_sourcemap) && sourcemap in
+    `Ok
+      { common
+      ; params
+      ; profile
+      ; output_file
+      ; input_file
+      ; runtime_files
+      ; enable_source_maps
+      }
   in
   let t =
     Term.(
@@ -85,8 +104,8 @@ let options =
       $ Jsoo_cmdline.Arg.t
       $ set_param
       $ profile
-      $ no_sourcemap
       $ sourcemap
+      $ no_sourcemap
       $ sourcemap_inline_in_js
       $ output_file
       $ input_file
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
index 1f0c36cdae..d5224169bd 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.mli
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
@@ -26,6 +26,7 @@ type t =
   ; runtime_files : string list
   ; output_file : string * bool
   ; input_file : string
+  ; enable_source_maps : bool
   ; params : (string * string) list
   }
 
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 7ee727c9f0..7327b2e56b 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -84,7 +84,7 @@ let common_binaryen_options () =
   in
   if Config.Flag.pretty () then "-g" :: l else l
 
-let link runtime_files input_file output_file =
+let link ~enable_source_maps runtime_files input_file output_file =
   command
     ("wasm-merge"
     :: (common_binaryen_options ()
@@ -92,7 +92,11 @@ let link runtime_files input_file output_file =
            (List.map
               ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ])
               runtime_files)
-       @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ]))
+       @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ]
+       @
+       if enable_source_maps
+       then [ "--output-source-map"; Filename.quote (output_file ^ ".map") ]
+       else []))
 
 let generate_dependencies primitives =
   Yojson.Basic.to_string
@@ -120,7 +124,7 @@ let filter_unused_primitives primitives usage_file =
    with End_of_file -> ());
   !s
 
-let dead_code_elimination in_file out_file =
+let dead_code_elimination ~enable_source_maps in_file out_file =
   with_intermediate_file (Filename.temp_file "deps" ".json")
   @@ fun deps_file ->
   with_intermediate_file (Filename.temp_file "usage" ".txt")
@@ -130,14 +134,15 @@ let dead_code_elimination in_file out_file =
   command
     ("wasm-metadce"
     :: (common_binaryen_options ()
-       @ [ "--graph-file"
-         ; Filename.quote deps_file
-         ; Filename.quote in_file
-         ; "-o"
-         ; Filename.quote out_file
-         ; ">"
-         ; Filename.quote usage_file
-         ]));
+       @ [ "--graph-file"; Filename.quote deps_file; Filename.quote in_file ]
+       @ (if enable_source_maps
+          then [ "--input-source-map"; Filename.quote (in_file ^ ".map") ]
+          else [])
+       @ [ "-o"; Filename.quote out_file ]
+       @ (if enable_source_maps
+          then [ "--output-source-map"; Filename.quote (out_file ^ ".map") ]
+          else [])
+       @ [ ">"; Filename.quote usage_file ]));
   filter_unused_primitives primitives usage_file
 
 let optimization_options =
@@ -146,7 +151,7 @@ let optimization_options =
    ; [ "-O3"; "--traps-never-happen" ]
   |]
 
-let optimize ~profile in_file out_file =
+let optimize ~profile ?sourcemap_file in_file out_file =
   let level =
     match profile with
     | None -> 1
@@ -154,21 +159,54 @@ let optimize ~profile in_file out_file =
   in
   command
     ("wasm-opt"
-    :: (common_binaryen_options ()
-       @ optimization_options.(level - 1)
-       @ [ Filename.quote in_file; "-o"; Filename.quote out_file ]))
+     :: (common_binaryen_options ()
+        @ optimization_options.(level - 1)
+        @ [ Filename.quote in_file; "-o"; Filename.quote out_file ])
+    @
+    match sourcemap_file with
+    | Some sourcemap_file ->
+        [ "--input-source-map"
+        ; Filename.quote (in_file ^ ".map")
+        ; "--output-source-map"
+        ; Filename.quote sourcemap_file
+        ; "--output-source-map-url"
+        ; Filename.quote sourcemap_file
+        ]
+    | None -> [])
 
-let link_and_optimize ~profile runtime_wasm_files wat_file output_file =
+let link_and_optimize ~profile ?sourcemap_file runtime_wasm_files wat_file output_file =
+  let sourcemap_file =
+    (* Check that Binaryen supports the necessary sourcemaps options (requires
+       version >= 118) *)
+    match sourcemap_file with
+    | Some _ when Sys.command "wasm-merge -osm foo 2> /dev/null" <> 0 -> None
+    | Some _ | None -> sourcemap_file
+  in
+  let enable_source_maps = Option.is_some sourcemap_file in
   with_intermediate_file (Filename.temp_file "runtime" ".wasm")
   @@ fun runtime_file ->
   write_file runtime_file Wa_runtime.wasm_runtime;
   with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
   @@ fun temp_file ->
-  link (runtime_file :: runtime_wasm_files) wat_file temp_file;
+  link ~enable_source_maps (runtime_file :: runtime_wasm_files) wat_file temp_file;
   with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
   @@ fun temp_file' ->
-  let primitives = dead_code_elimination temp_file temp_file' in
-  optimize ~profile temp_file' output_file;
+  let primitives = dead_code_elimination ~enable_source_maps temp_file temp_file' in
+  optimize ~profile ?sourcemap_file temp_file' output_file;
+  (* Add source file contents to source map *)
+  Option.iter sourcemap_file ~f:(fun sourcemap_file ->
+      let open Source_map in
+      let source_map, mappings = Source_map_io.of_file_no_mappings sourcemap_file in
+      assert (List.is_empty (Option.value source_map.sources_content ~default:[]));
+      let sources_content =
+        Some
+          (List.map source_map.sources ~f:(fun file ->
+               if Sys.file_exists file && not (Sys.is_directory file)
+               then Some (Fs.read_file file)
+               else None))
+      in
+      let source_map = { source_map with sources_content } in
+      Source_map_io.to_file ?mappings source_map ~file:sourcemap_file);
   primitives
 
 let escape_string s =
@@ -276,7 +314,15 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
     ^ trim_semi (Buffer.contents fragment_buffer)
     ^ String.sub s ~pos:(l + 9) ~len:(String.length s - l - 9))
 
-let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
+let run
+    { Cmd_arg.common
+    ; profile
+    ; runtime_files
+    ; input_file
+    ; output_file
+    ; enable_source_maps
+    ; params
+    } =
   Jsoo_cmdline.Arg.eval common;
   Wa_generate.init ();
   let output_file = fst output_file in
@@ -316,7 +362,7 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
   let need_debug = Config.Flag.debuginfo () in
   let output (one : Parse_bytecode.one) ~standalone ch =
     let code = one.code in
-    let live_vars, in_cps, p =
+    let live_vars, in_cps, p, debug =
       Driver.f
         ~target:Wasm
         ~standalone
@@ -326,7 +372,7 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
         one.debug
         code
     in
-    let strings = Wa_generate.f ch ~live_vars ~in_cps p in
+    let strings = Wa_generate.f ch ~debug ~live_vars ~in_cps p in
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
     strings
   in
@@ -367,7 +413,13 @@ let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; param
        @@ fun tmp_wasm_file ->
        let strings = output_gen wat_file (output code ~standalone:true) in
        let primitives =
-         link_and_optimize ~profile runtime_wasm_files wat_file tmp_wasm_file
+         link_and_optimize
+           ~profile
+           ?sourcemap_file:
+             (if enable_source_maps then Some (wasm_file ^ ".map") else None)
+           runtime_wasm_files
+           wat_file
+           tmp_wasm_file
        in
        build_js_runtime primitives strings wasm_file output_file
    | `Cmo _ | `Cma _ -> assert false);
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index 3505a409de..cd5f1a468a 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -43,5 +43,4 @@
 (install
  (section man)
  (package wasm_of_ocaml-compiler)
- (files
-  wasm_of_ocaml.1))
+ (files wasm_of_ocaml.1))
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index c34ae1ca1c..7c0ed54ff6 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -576,7 +576,9 @@ let configure formatter =
 
 type 'a target =
   | JavaScript : Pretty_print.t -> Source_map.t option target
-  | Wasm : (Deadcode.variable_uses * Effects.in_cps * Code.program) target
+  | Wasm
+      : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
+        target
 
 let target_flag (type a) (t : a target) =
   match t with
@@ -631,7 +633,7 @@ let full
       source_map
   | Wasm ->
       let (p, live_vars), _, in_cps = r in
-      live_vars, in_cps, p
+      live_vars, in_cps, p, d
 
 let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~linkall d p =
   let (_ : Source_map.t option) =
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index b35e57f94d..58c3c19c0e 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -22,7 +22,9 @@ type profile
 
 type 'a target =
   | JavaScript : Pretty_print.t -> Source_map.t option target
-  | Wasm : (Deadcode.variable_uses * Effects.in_cps * Code.program) target
+  | Wasm
+      : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
+        target
 
 val f :
      target:'result target
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 202c4773c5..a6146d1e53 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -341,11 +341,14 @@ let bool e = J.ECond (e, one, zero)
 
 (****)
 
-let source_location ctx ?force (pc : Code.loc) =
-  match Parse_bytecode.Debug.find_loc ctx.Ctx.debug ?force pc with
+let source_location debug ?force (pc : Code.loc) =
+  match Parse_bytecode.Debug.find_loc debug ?force pc with
   | Some pi -> J.Pi pi
   | None -> J.N
 
+let source_location_ctx ctx ?force (pc : Code.loc) =
+  source_location ctx.Ctx.debug ?force pc
+
 (****)
 
 let float_const f = J.ENum (J.Num.of_float f)
@@ -1240,13 +1243,13 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
       let (px, cx), queue = access_queue queue x in
       (Mlvalue.Block.field cx n, or_p px mutable_p, queue), []
   | Closure (args, ((pc, _) as cont)) ->
-      let loc = source_location ctx ~force:After (After pc) in
+      let loc = source_location_ctx ctx ~force:After (After pc) in
       let clo = compile_closure ctx cont in
       let clo =
         match clo with
         | (st, x) :: rem ->
             let loc =
-              match x, source_location ctx (Before pc) with
+              match x, source_location_ctx ctx (Before pc) with
               | (J.U | J.N), (J.U | J.N) -> J.U
               | x, (J.U | J.N) -> x
               | (J.U | J.N), x -> x
@@ -1495,14 +1498,14 @@ and translate_instr ctx expr_queue instr =
   let instr, pc = instr in
   match instr with
   | Assign (x, y) ->
-      let loc = source_location ctx pc in
+      let loc = source_location_ctx ctx pc in
       let (_py, cy), expr_queue = access_queue expr_queue y in
       flush_queue
         expr_queue
         mutator_p
         [ J.Expression_statement (J.EBin (J.Eq, J.EVar (J.V x), cy)), loc ]
   | Let (x, e) -> (
-      let loc = source_location ctx pc in
+      let loc = source_location_ctx ctx pc in
       let (ce, prop, expr_queue), instrs = translate_expr ctx expr_queue loc x e 0 in
       let keep_name x =
         match Code.Var.get_name x with
@@ -1533,7 +1536,7 @@ and translate_instr ctx expr_queue instr =
             prop
             (instrs @ [ J.variable_declaration [ J.V x, (ce, loc) ], loc ]))
   | Set_field (x, n, y) ->
-      let loc = source_location ctx pc in
+      let loc = source_location_ctx ctx pc in
       let (_px, cx), expr_queue = access_queue expr_queue x in
       let (_py, cy), expr_queue = access_queue expr_queue y in
       flush_queue
@@ -1541,7 +1544,7 @@ and translate_instr ctx expr_queue instr =
         mutator_p
         [ J.Expression_statement (J.EBin (J.Eq, Mlvalue.Block.field cx n, cy)), loc ]
   | Offset_ref (x, 1) ->
-      let loc = source_location ctx pc in
+      let loc = source_location_ctx ctx pc in
       (* FIX: may overflow.. *)
       let (_px, cx), expr_queue = access_queue expr_queue x in
       flush_queue
@@ -1549,7 +1552,7 @@ and translate_instr ctx expr_queue instr =
         mutator_p
         [ J.Expression_statement (J.EUn (J.IncrA, Mlvalue.Block.field cx 0)), loc ]
   | Offset_ref (x, n) ->
-      let loc = source_location ctx pc in
+      let loc = source_location_ctx ctx pc in
       (* FIX: may overflow.. *)
       let (_px, cx), expr_queue = access_queue expr_queue x in
       flush_queue
@@ -1558,7 +1561,7 @@ and translate_instr ctx expr_queue instr =
         [ J.Expression_statement (J.EBin (J.PlusEq, Mlvalue.Block.field cx 0, int n)), loc
         ]
   | Array_set (x, y, z) ->
-      let loc = source_location ctx pc in
+      let loc = source_location_ctx ctx pc in
       let (_px, cx), expr_queue = access_queue expr_queue x in
       let (_py, cy), expr_queue = access_queue expr_queue y in
       let (_pz, cz), expr_queue = access_queue expr_queue z in
@@ -1619,7 +1622,7 @@ and compile_block st queue (pc : Addr.t) loop_stack frontier interm =
                      else (
                        if debug () then Format.eprintf "break;@;}@]@,";
                        body @ [ J.Break_statement None, J.N ])) )
-            , source_location st.ctx (Code.location_of_pc pc) )
+            , source_location_ctx st.ctx (Code.location_of_pc pc) )
           in
           let label = if !lab_used then Some lab else None in
           let for_loop =
@@ -1854,7 +1857,7 @@ and compile_conditional st queue last loop_stack backs frontier interm =
      | Stop -> Format.eprintf "stop;@;"
      | Cond (x, _, _) -> Format.eprintf "@[<hv 2>cond(%a){@;" Code.Var.print x
      | Switch (x, _, _) -> Format.eprintf "@[<hv 2>switch(%a){@;" Code.Var.print x);
-  let loc = source_location st.ctx pc in
+  let loc = source_location_ctx st.ctx pc in
   let res =
     match last with
     | Return x ->
diff --git a/compiler/lib/generate.mli b/compiler/lib/generate.mli
index 66053fdc2c..21bb63ff5a 100644
--- a/compiler/lib/generate.mli
+++ b/compiler/lib/generate.mli
@@ -29,3 +29,9 @@ val f :
   -> Javascript.program
 
 val init : unit -> unit
+
+val source_location :
+     Parse_bytecode.Debug.t
+  -> ?force:Parse_bytecode.Debug.force
+  -> Code.loc
+  -> Javascript.location
diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml
index 6b45f29ca3..65418e2df8 100644
--- a/compiler/lib/link_js.ml
+++ b/compiler/lib/link_js.ml
@@ -469,7 +469,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
               let s = sourceMappingURL_base64 ^ Base64.encode_exn data in
               Line_writer.write oc s
           | Some file ->
-              Source_map_io.to_file sm file;
+              Source_map_io.to_file sm ~file;
               let s = sourceMappingURL ^ Filename.basename file in
               Line_writer.write oc s));
       if times () then Format.eprintf "  sourcemap: %a@." Timer.print t
diff --git a/compiler/lib/source_map_io.mli b/compiler/lib/source_map_io.mli
index 65c6b905b2..c27288de00 100644
--- a/compiler/lib/source_map_io.mli
+++ b/compiler/lib/source_map_io.mli
@@ -23,6 +23,13 @@ val enabled : bool
 
 val to_string : t -> string
 
-val to_file : t -> string -> unit
-
 val of_string : string -> t
+
+val of_file_no_mappings : string -> t * string option
+(** Read source map from a file without parsing the mappings (which can be costly). The
+    [mappings] field is returned empty and the raw string is returned alongside the map.
+ *)
+
+val to_file : ?mappings:string -> t -> file:string -> unit
+(** Write to a file. If a string is supplied as [mappings], use it instead of the
+    sourcemap's [mappings]. *)
diff --git a/compiler/lib/source_map_io.yojson.ml b/compiler/lib/source_map_io.yojson.ml
index 05f0975e63..b9833d40a1 100644
--- a/compiler/lib/source_map_io.yojson.ml
+++ b/compiler/lib/source_map_io.yojson.ml
@@ -19,7 +19,7 @@
 
 open Source_map
 
-let json t =
+let json ?replace_mappings t =
   let rewrite_path path =
     if Filename.is_relative path
     then path
@@ -38,7 +38,8 @@ let json t =
           | Some s -> rewrite_path s) )
     ; "names", `List (List.map (fun s -> `String s) t.names)
     ; "sources", `List (List.map (fun s -> `String (rewrite_path s)) t.sources)
-    ; "mappings", `String (string_of_mapping t.mappings)
+    ; ( "mappings"
+      , `String (Option.value ~default:(string_of_mapping t.mappings) replace_mappings) )
     ; ( "sourcesContent"
       , `List
           (match t.sources_content with
@@ -51,7 +52,7 @@ let json t =
                 l) )
     ]
 
-let invalid () = invalid_arg "Source_map.of_json"
+let invalid () = invalid_arg "Source_map_io.of_json"
 
 let string name rest =
   try
@@ -88,34 +89,44 @@ let list_string_opt name rest =
     | _ -> invalid ()
   with Not_found -> None
 
-let of_json json =
-  match json with
-  | `Assoc (("version", `Float version) :: rest) when int_of_float version = 3 ->
-      let def v d =
-        match v with
-        | None -> d
-        | Some v -> v
-      in
-      let file = string "file" rest in
-      let sourceroot = string "sourceRoot" rest in
-      let names = list_string "names" rest in
-      let sources = list_string "sources" rest in
-      let sources_content = list_string_opt "sourcesContent" rest in
-      let mappings = string "mappings" rest in
-      { version = int_of_float version
+let of_json ~parse_mappings json =
+  let parse ~version rest =
+    let def v d =
+      match v with
+      | None -> d
+      | Some v -> v
+    in
+    let file = string "file" rest in
+    let sourceroot = string "sourceRoot" rest in
+    let names = list_string "names" rest in
+    let sources = list_string "sources" rest in
+    let sources_content = list_string_opt "sourcesContent" rest in
+    let mappings = string "mappings" rest in
+    ( { version
       ; file = def file ""
       ; sourceroot
       ; names = def names []
       ; sources_content
       ; sources = def sources []
-      ; mappings = mapping_of_string (def mappings "")
+      ; mappings = (if parse_mappings then mapping_of_string (def mappings "") else [])
       }
+    , if parse_mappings then None else mappings )
+  in
+  match json with
+  | `Assoc (("version", `Float version) :: rest) when int_of_float version = 3 ->
+      parse ~version:3 rest
+  | `Assoc (("version", `Int 3) :: rest) -> parse ~version:3 rest
   | _ -> invalid ()
 
-let of_string s = of_json (Yojson.Basic.from_string s)
+let of_string s = of_json ~parse_mappings:true (Yojson.Basic.from_string s) |> fst
 
 let to_string m = Yojson.Basic.to_string (json m)
 
-let to_file m file = Yojson.Basic.to_file file (json m)
+let to_file ?mappings m ~file =
+  let replace_mappings = mappings in
+  Yojson.Basic.to_file file (json ?replace_mappings m)
+
+let of_file_no_mappings filename =
+  of_json ~parse_mappings:false (Yojson.Basic.from_file filename)
 
 let enabled = true
diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 42dfc32d17..1769376faa 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -402,6 +402,9 @@ module Output () = struct
     | Return_call (x, l) ->
         Feature.require tail_call;
         concat_map expression l ^^ line (string "return_call " ^^ index x)
+    | Location (_, i) ->
+        (* Source maps not supported for the non-GC target *)
+        instruction i
     | ArraySet _ | StructSet _ | Return_call_ref _ -> assert false (* Not supported *)
 
   let escape_string s =
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index a5641e7169..7fe539031f 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -187,6 +187,8 @@ and instruction =
   | Return_call_indirect of func_type * expression * expression list
   | Return_call of var * expression list
   | Return_call_ref of var * expression * expression list
+  | Location of Code.loc * instruction
+      (** Instruction with attached location information *)
 
 type import_desc =
   | Fun of func_type
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 300afc219d..0ee5fe6d2b 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -267,6 +267,17 @@ let blk l st =
   let (), st = l { st with instrs = [] } in
   List.rev st.instrs, { st with instrs }
 
+let with_location loc instrs st =
+  let current_instrs = st.instrs in
+  let (), st = instrs { st with instrs = [] } in
+  let[@tail_mod_cons] rec add_loc loc = function
+    | [] -> current_instrs
+    | W.Nop :: rem -> W.Nop :: add_loc loc rem
+    | Location _ :: _ as l -> l @ current_instrs (* Stop on the first location *)
+    | i :: rem -> W.Location (loc, i) :: add_loc loc rem
+  in
+  (), { st with instrs = add_loc loc st.instrs }
+
 let cast ?(nullable = false) typ e =
   let* e = e in
   match typ, e with
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 40c67c16ff..bb81bf291c 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -119,6 +119,8 @@ val is_small_constant : Wa_ast.expression -> bool t
 
 val get_i31_value : int -> int option t
 
+val with_location : Code.loc -> unit t -> unit t
+
 type type_def =
   { supertype : Wa_ast.var option
   ; final : bool
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 1a7e831461..f46c1c3e01 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -604,23 +604,30 @@ module Generate (Target : Wa_target_sig.S) = struct
             | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
                 assert false))
 
-  and translate_instr ctx stack_ctx context (i, _) =
-    match i with
-    | Assign (x, y) ->
-        let* () = assign x (load y) in
-        Stack.assign stack_ctx x
-    | Let (x, e) ->
-        if ctx.live.(Var.idx x) = 0
-        then drop (translate_expr ctx stack_ctx context x e)
-        else store x (translate_expr ctx stack_ctx context x e)
-    | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
-    | Offset_ref (x, n) ->
-        Memory.set_field
-          (load x)
-          0
-          (Value.val_int
-             Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
-    | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
+  and emit_location loc instrs =
+    match loc with
+    | No -> instrs
+    | Before _ | After _ -> with_location loc instrs
+
+  and translate_instr ctx stack_ctx context (i, loc) =
+    emit_location
+      loc
+      (match i with
+      | Assign (x, y) ->
+          let* () = assign x (load y) in
+          Stack.assign stack_ctx x
+      | Let (x, e) ->
+          if ctx.live.(Var.idx x) = 0
+          then drop (translate_expr ctx stack_ctx context x e)
+          else store x (translate_expr ctx stack_ctx context x e)
+      | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
+      | Offset_ref (x, n) ->
+          Memory.set_field
+            (load x)
+            0
+            (Value.val_int
+               Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
+      | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z))
 
   and translate_instrs ctx stack_ctx context l =
     match l with
@@ -823,92 +830,96 @@ module Generate (Target : Wa_target_sig.S) = struct
             else code ~context
           in
           translate_tree result_typ fall_through pc' context
-      | [] -> (
+      | [] ->
           let block = Addr.Map.find pc ctx.blocks in
           let* global_context = get_context in
           let stack_ctx = Stack.start_block ~context:global_context stack_info pc in
           let* () = translate_instrs ctx stack_ctx context block.body in
           let* () = Stack.perform_reloads stack_ctx (`Branch (fst block.branch)) in
           let* () = Stack.perform_spilling stack_ctx (`Block pc) in
-          match fst block.branch with
-          | Branch cont ->
-              translate_branch result_typ fall_through pc cont context stack_ctx
-          | Return x -> (
-              let* e = load x in
-              match fall_through with
-              | `Return -> instr (Push e)
-              | `Block _ -> instr (Return (Some e)))
-          | Cond (x, cont1, cont2) ->
-              let context' = extend_context fall_through context in
-              if_
-                { params = []; result = result_typ }
-                (Value.check_is_not_zero (load x))
-                (translate_branch result_typ fall_through pc cont1 context' stack_ctx)
-                (translate_branch result_typ fall_through pc cont2 context' stack_ctx)
-          | Stop -> (
-              let* e = Value.unit in
-              match fall_through with
-              | `Return -> instr (Push e)
-              | `Block _ -> instr (Return (Some e)))
-          | Switch (x, a1, a2) ->
-              let l =
-                List.filter
-                  ~f:(fun pc' -> Stack.stack_adjustment_needed stack_ctx ~src:pc ~dst:pc')
-                  (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc)))
-              in
-              let br_table e a context =
-                let len = Array.length a in
-                let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
-                let dest (pc, args) =
-                  assert (List.is_empty args);
-                  label_index context pc
+          let branch, loc = block.branch in
+          emit_location
+            loc
+            (match branch with
+            | Branch cont ->
+                translate_branch result_typ fall_through pc cont context stack_ctx
+            | Return x -> (
+                let* e = load x in
+                match fall_through with
+                | `Return -> instr (Push e)
+                | `Block _ -> instr (Return (Some e)))
+            | Cond (x, cont1, cont2) ->
+                let context' = extend_context fall_through context in
+                if_
+                  { params = []; result = result_typ }
+                  (Value.check_is_not_zero (load x))
+                  (translate_branch result_typ fall_through pc cont1 context' stack_ctx)
+                  (translate_branch result_typ fall_through pc cont2 context' stack_ctx)
+            | Stop -> (
+                let* e = Value.unit in
+                match fall_through with
+                | `Return -> instr (Push e)
+                | `Block _ -> instr (Return (Some e)))
+            | Switch (x, a1, a2) ->
+                let l =
+                  List.filter
+                    ~f:(fun pc' ->
+                      Stack.stack_adjustment_needed stack_ctx ~src:pc ~dst:pc')
+                    (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc)))
                 in
-                let* e = e in
-                instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
-              in
-              let rec nest l context =
-                match l with
-                | pc' :: rem ->
-                    let* () =
-                      Wa_code_generation.block
-                        { params = []; result = [] }
-                        (nest rem (`Block pc' :: context))
-                    in
-                    let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
-                    instr (Br (label_index context pc', None))
-                | [] -> (
-                    match a1, a2 with
-                    | [||], _ -> br_table (Memory.tag (load x)) a2 context
-                    | _, [||] -> br_table (Value.int_val (load x)) a1 context
-                    | _ ->
-                        (*ZZZ Use Br_on_cast *)
-                        let context' = extend_context fall_through context in
-                        if_
-                          { params = []; result = result_typ }
-                          (Value.check_is_int (load x))
-                          (br_table (Value.int_val (load x)) a1 context')
-                          (br_table (Memory.tag (load x)) a2 context'))
-              in
-              nest l context
-          | Raise (x, _) ->
-              let* e = load x in
-              let* tag = register_import ~name:exception_name (Tag Value.value) in
-              instr (Throw (tag, e))
-          | Pushtrap (cont, x, cont', _) ->
-              handle_exceptions
-                ~result_typ
-                ~fall_through
-                ~context:(extend_context fall_through context)
-                (wrap_with_handlers
-                   p
-                   (fst cont)
-                   (fun ~result_typ ~fall_through ~context ->
-                     translate_branch result_typ fall_through pc cont context stack_ctx))
-                x
-                (fun ~result_typ ~fall_through ~context ->
-                  translate_branch result_typ fall_through pc cont' context stack_ctx)
-          | Poptrap cont ->
-              translate_branch result_typ fall_through pc cont context stack_ctx)
+                let br_table e a context =
+                  let len = Array.length a in
+                  let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
+                  let dest (pc, args) =
+                    assert (List.is_empty args);
+                    label_index context pc
+                  in
+                  let* e = e in
+                  instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
+                in
+                let rec nest l context =
+                  match l with
+                  | pc' :: rem ->
+                      let* () =
+                        Wa_code_generation.block
+                          { params = []; result = [] }
+                          (nest rem (`Block pc' :: context))
+                      in
+                      let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
+                      instr (Br (label_index context pc', None))
+                  | [] -> (
+                      match a1, a2 with
+                      | [||], _ -> br_table (Memory.tag (load x)) a2 context
+                      | _, [||] -> br_table (Value.int_val (load x)) a1 context
+                      | _ ->
+                          (*ZZZ Use Br_on_cast *)
+                          let context' = extend_context fall_through context in
+                          if_
+                            { params = []; result = result_typ }
+                            (Value.check_is_int (load x))
+                            (br_table (Value.int_val (load x)) a1 context')
+                            (br_table (Memory.tag (load x)) a2 context'))
+                in
+                nest l context
+            | Raise (x, _) ->
+                let* e = load x in
+                let* tag = register_import ~name:exception_name (Tag Value.value) in
+                instr (Throw (tag, e))
+            | Pushtrap (cont, x, cont', _) ->
+                handle_exceptions
+                  ~result_typ
+                  ~fall_through
+                  ~context:(extend_context fall_through context)
+                  (wrap_with_handlers
+                     p
+                     (fst cont)
+                     (fun ~result_typ ~fall_through ~context ->
+                       translate_branch result_typ fall_through pc cont context stack_ctx))
+                  x
+                  (fun ~result_typ ~fall_through ~context ->
+                    translate_branch result_typ fall_through pc cont' context stack_ctx)
+            | Poptrap cont ->
+                translate_branch result_typ fall_through pc cont context stack_ctx)
     and translate_branch result_typ fall_through src (dst, args) context stack_ctx =
       let* () =
         if List.is_empty args
@@ -1110,7 +1121,7 @@ let fix_switch_branches p =
     p.blocks;
   !p'
 
-let f ch (p : Code.program) ~live_vars ~in_cps =
+let f ch (p : Code.program) ~live_vars ~in_cps ~debug =
   let p = if Config.Flag.effects () then fix_switch_branches p else p in
   match target with
   | `Core ->
@@ -1121,5 +1132,5 @@ let f ch (p : Code.program) ~live_vars ~in_cps =
   | `GC ->
       let module G = Generate (Wa_gc_target) in
       let fields, js_code = G.f ~live_vars ~in_cps p in
-      Wa_wat_output.f ch fields;
+      Wa_wat_output.f ~debug ch fields;
       js_code
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index a5138ea823..8684e875b4 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -5,4 +5,5 @@ val f :
   -> Code.program
   -> live_vars:int array
   -> in_cps:Effects.in_cps
+  -> debug:Parse_bytecode.Debug.t
   -> string list * (string * Javascript.expression) list
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
index 969a6fd23f..6566a76cd7 100644
--- a/compiler/lib/wasm/wa_initialize_locals.ml
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -92,6 +92,7 @@ and scan_instruction ctx i =
   | Return_call_indirect (_, e', l) | Return_call_ref (_, e', l) ->
       scan_expressions ctx l;
       scan_expression ctx e'
+  | Location (_, i) -> scan_instruction ctx i
 
 and scan_instructions ctx l =
   let ctx = fork_context ctx in
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index 36cc5466f5..5ae9d2f1d6 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -1,5 +1,22 @@
 open! Stdlib
 
+let rec get_return ~tail i =
+  match i with
+  | Wa_ast.Location (_, i') -> get_return ~tail i'
+  | Return (Some (LocalGet y)) -> Some y
+  | Push (LocalGet y) when tail -> Some y
+  | _ -> None
+
+let rec rewrite_tail_call ~y i =
+  match i with
+  | Wa_ast.Location (loc, i') ->
+      Option.map ~f:(fun i -> Wa_ast.Location (loc, i)) (rewrite_tail_call ~y i')
+  | LocalSet (x, Call (symb, l)) when x = y -> Some (Return_call (symb, l))
+  | LocalSet (x, Call_indirect (ty, e, l)) when x = y ->
+      Some (Return_call_indirect (ty, e, l))
+  | LocalSet (x, Call_ref (ty, e, l)) when x = y -> Some (Return_call_ref (ty, e, l))
+  | _ -> None
+
 let rec instruction ~tail i =
   match i with
   | Wa_ast.Loop (ty, l) -> Wa_ast.Loop (ty, instructions ~tail l)
@@ -17,6 +34,7 @@ let rec instruction ~tail i =
   | Push (Call (symb, l)) when tail -> Return_call (symb, l)
   | Push (Call_indirect (ty, e, l)) when tail -> Return_call_indirect (ty, e, l)
   | Push (Call_ref (ty, e, l)) when tail -> Return_call_ref (ty, e, l)
+  | Location (loc, i) -> Location (loc, instruction ~tail i)
   | Push (Call_ref _) -> i
   | Drop (BlockExpr (typ, l)) -> Drop (BlockExpr (typ, instructions ~tail:false l))
   | Drop _
@@ -43,20 +61,15 @@ and instructions ~tail l =
   match l with
   | [] -> []
   | [ i ] -> [ instruction ~tail i ]
-  | [ LocalSet (x, Call (symb, l)); Return (Some (LocalGet y)) ] when x = y ->
-      [ Return_call (symb, l) ]
-  | [ LocalSet (x, Call_indirect (ty, e, l)); Return (Some (LocalGet y)) ] when x = y ->
-      [ Return_call_indirect (ty, e, l) ]
-  | [ LocalSet (x, Call_ref (ty, e, l)); Return (Some (LocalGet y)) ] when x = y ->
-      [ Return_call_ref (ty, e, l) ]
-  | [ LocalSet (x, Call (symb, l)); Push (LocalGet y) ] when tail && x = y ->
-      [ Return_call (symb, l) ]
-  | [ LocalSet (x, Call_indirect (ty, e, l)); Push (LocalGet y) ] when tail && x = y ->
-      [ Return_call_indirect (ty, e, l) ]
-  | [ LocalSet (x, Call_ref (ty, e, l)); Push (LocalGet y) ] when tail && x = y ->
-      [ Return_call_ref (ty, e, l) ]
   | i :: Nop :: rem -> instructions ~tail (i :: rem)
   | i :: i' :: Nop :: rem -> instructions ~tail (i :: i' :: rem)
+  | [ i; i' ] -> (
+      match get_return ~tail i' with
+      | None -> [ instruction ~tail:false i; instruction ~tail i' ]
+      | Some y -> (
+          match rewrite_tail_call ~y i with
+          | None -> [ instruction ~tail:false i; instruction ~tail i' ]
+          | Some i'' -> [ i'' ]))
   | i :: rem -> instruction ~tail:false i :: instructions ~tail rem
 
 let f l = instructions ~tail:true l
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index b3b00dfe73..355d1d5fa7 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -6,14 +6,23 @@ let target = `Binaryen (*`Reference*)
 type sexp =
   | Atom of string
   | List of sexp list
+  | Comment of string
+      (** Line comment. String [s] is rendered as [;;s], on its own line,
+                          without space after the double semicolon. *)
 
 let rec format_sexp f s =
   match s with
   | Atom s -> Format.fprintf f "%s" s
   | List l ->
-      Format.fprintf f "@[<2>(";
+      if List.exists l ~f:(function
+             | Comment _ -> true
+             | _ -> false)
+      then (* Ensure comments are on their own line *)
+        Format.fprintf f "@[<v 2>("
+      else Format.fprintf f "@[<2>(";
       Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f "@ ") format_sexp f l;
       Format.fprintf f ")@]"
+  | Comment s -> Format.fprintf f ";;%s" s
 
 let index x = Atom ("$" ^ Code.Var.to_string x)
 
@@ -169,6 +178,7 @@ type ctx =
   ; mutable functions : int Code.Var.Map.t
   ; mutable function_refs : Code.Var.Set.t
   ; mutable function_count : int
+  ; debug : Parse_bytecode.Debug.t
   }
 
 let reference_function ctx f = ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
@@ -441,6 +451,13 @@ let expression_or_instructions ctx in_function =
             :: index typ
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
+    | Location (loc, i) -> (
+        let loc = Generate.source_location ctx.debug loc in
+        match loc with
+        | Javascript.N | U | Pi Parse_info.{ src = None; _ } -> instruction i
+        | Pi Parse_info.{ src = Some src; col; line; _ } ->
+            let loc = Format.sprintf "%s:%d:%d" src line col in
+            Comment ("@ " ^ loc) :: instruction i)
   and instructions l = List.concat (List.map ~f:instruction l) in
   expression, instructions
 
@@ -560,13 +577,14 @@ let data_offsets fields =
     ~init:(0, Code.Var.Map.empty)
     fields
 
-let f ch fields =
+let f ~debug ch fields =
   let heap_base, addresses = data_offsets fields in
   let ctx =
     { addresses
     ; functions = Code.Var.Map.empty
     ; function_refs = Code.Var.Set.empty
     ; function_count = 0
+    ; debug
     }
   in
   let other_fields = List.concat (List.map ~f:(fun f -> field ctx f) fields) in
diff --git a/compiler/lib/wasm/wa_wat_output.mli b/compiler/lib/wasm/wa_wat_output.mli
index 59f2b93d9a..537798744e 100644
--- a/compiler/lib/wasm/wa_wat_output.mli
+++ b/compiler/lib/wasm/wa_wat_output.mli
@@ -1 +1 @@
-val f : out_channel -> Wa_ast.module_field list -> unit
+val f : debug:Parse_bytecode.Debug.t -> out_channel -> Wa_ast.module_field list -> unit
diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune
index b3e568e5ab..0ac00bf21e 100644
--- a/compiler/tests-jsoo/lib-effects/dune
+++ b/compiler/tests-jsoo/lib-effects/dune
@@ -3,7 +3,9 @@
  (enabled_if
   (and
    (>= %{ocaml_version} 5)
-   (or (= %{profile} using-effects) (= %{profile} wasm-effects))))
+   (or
+    (= %{profile} using-effects)
+    (= %{profile} wasm-effects))))
  (inline_tests
   ;; This requires the unreleased dune 3.7 to work
   (enabled_if true)
diff --git a/compiler/tests-num/dune b/compiler/tests-num/dune
index 42c3a0a1e6..1bd90f4076 100644
--- a/compiler/tests-num/dune
+++ b/compiler/tests-num/dune
@@ -9,7 +9,10 @@
 
 (rule
  (target main.referencejs)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps main.bc.js)
  (action
   (with-stdout-to
@@ -27,7 +30,10 @@
 (rule
  (alias runtest)
  ;; ZZZ Need to modify the num library
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps main.reference main.referencejs)
  (action
   (diff main.reference main.referencejs)))
diff --git a/compiler/tests-ocaml/lib-hashtbl/dune b/compiler/tests-ocaml/lib-hashtbl/dune
index 3ceba9fbd0..f167976635 100644
--- a/compiler/tests-ocaml/lib-hashtbl/dune
+++ b/compiler/tests-ocaml/lib-hashtbl/dune
@@ -22,14 +22,20 @@
 
 (rule
  (alias runtest)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps hfun.referencejs hfun.reference)
  (action
   (diff hfun.referencejs hfun.reference)))
 
 (rule
  (alias runtest)
- (enabled_if (or (= %{profile} wasm) (= %{profile} wasm-effects)))
+ (enabled_if
+  (or
+   (= %{profile} wasm)
+   (= %{profile} wasm-effects)))
  (deps hfun.referencejs hfun.reference-wasm)
  (action
   (diff hfun.referencejs hfun.reference-wasm)))
diff --git a/compiler/tests-sourcemap/dune b/compiler/tests-sourcemap/dune
index e54c02d915..acc9ebe61c 100644
--- a/compiler/tests-sourcemap/dune
+++ b/compiler/tests-sourcemap/dune
@@ -21,7 +21,10 @@
 (rule
  (target dump)
  (enabled_if
-  (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (and
+   (<> %{profile} using-effects)
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (with-stdout-to
    %{target}
@@ -30,7 +33,10 @@
 (rule
  (alias runtest)
  (enabled_if
-  (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (and
+   (<> %{profile} using-effects)
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps dump.reference dump)
  (action
   (diff dump.reference dump)))

From b4c710355283409038e93f0777590efe4a496225 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Mar 2024 10:55:56 +0100
Subject: [PATCH 229/481] Tuple syntax changes

---
 .github/workflows/build.yml |  6 +++---
 README.md                   |  2 +-
 runtime/wasm/bigarray.wat   |  4 ++--
 runtime/wasm/compare.wat    | 11 +++++-----
 runtime/wasm/dune           |  2 +-
 runtime/wasm/float.wat      | 31 ++++++++++++++--------------
 runtime/wasm/int32.wat      |  8 ++++----
 runtime/wasm/int64.wat      | 27 +++++++++++++------------
 runtime/wasm/ints.wat       | 26 ++++++++++++------------
 runtime/wasm/marshal.wat    | 40 ++++++++++++++++++-------------------
 10 files changed, 80 insertions(+), 77 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 2a66055b2e..93912d0994 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -38,7 +38,7 @@ jobs:
         uses: actions/cache/restore@v4
         with:
           path: binaryen
-          key: ${{ runner.os }}-binaryen-version_116
+          key: ${{ runner.os }}-binaryen-version_117
 
       - name: Checkout binaryen
         if: steps.cache-binaryen.outputs.cache-hit != 'true'
@@ -47,7 +47,7 @@ jobs:
           repository: WebAssembly/binaryen
           path: binaryen
           submodules: true
-          ref: version_116
+          ref: version_117
 
       - name: Install ninja
         if: steps.cache-binaryen.outputs.cache-hit != 'true'
@@ -65,7 +65,7 @@ jobs:
         uses: actions/cache/save@v4
         with:
           path: binaryen
-          key: ${{ runner.os }}-binaryen-version_116
+          key: ${{ runner.os }}-binaryen-version_117
 
       - name: Set binaryen's path
         run: |
diff --git a/README.md b/README.md
index e828d42ee5..1ac2a04074 100644
--- a/README.md
+++ b/README.md
@@ -4,7 +4,7 @@ Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssem
 
 ## Requirements
 
-Wasm_of_ocaml relies on the Binaryen toolchain; currently, only [version 116](https://github.com/WebAssembly/binaryen/releases/tag/version_116) is supported. Binaryen commands must be in the PATH for wasm_of_ocaml to function.
+Wasm_of_ocaml relies on the Binaryen toolchain; currently, only [version 117](https://github.com/WebAssembly/binaryen/releases/tag/version_117) is supported. Binaryen commands must be in the PATH for wasm_of_ocaml to function.
 
 ## Supported engines
 
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index f969ed227a..14c59fa138 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -492,7 +492,7 @@
                       (call $ta_get_f64 (local.get $data) (local.get $i))))
                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
                 (br $loop)))))
-      (tuple.make
+      (tuple.make 2
          (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4))
          (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 8))))
 
@@ -638,7 +638,7 @@
                       (call $caml_deserialize_int_8 (local.get $s))))
                 (local.set $i (i32.add (local.get $i) (i32.const 1)))
                 (br $loop)))))
-      (tuple.make
+      (tuple.make 2
          (local.get $b)
          (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4))))
 
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 71779e42b7..55f18a66b5 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -95,8 +95,9 @@
                (local.get $i) (global.get $dummy_block))
             (struct.set $compare_stack 0 (local.get $stack)
                (i32.sub (local.get $i) (i32.const 1)))))
-      (tuple.make (array.get $block (local.get $v1) (local.get $p))
-                  (array.get $block (local.get $v2) (local.get $p))))
+      (tuple.make 2
+         (array.get $block (local.get $v1) (local.get $p))
+         (array.get $block (local.get $v2) (local.get $p))))
 
    (func $push_compare_stack (param $stack (ref $compare_stack))
       (param $v1 (ref $block)) (param $v2 (ref $block)) (param $p i32)
@@ -213,7 +214,7 @@
       (local $str1 (ref $string)) (local $str2 (ref $string))
       (local $c1 (ref $custom)) (local $c2 (ref $custom))
       (local $js1 anyref) (local $js2 anyref)
-      (local $tuple ((ref eq) (ref eq)))
+      (local $tuple (tuple (ref eq) (ref eq)))
       (local $res i32)
       (loop $loop
          (block $next_item
@@ -538,8 +539,8 @@
          (if (call $compare_stack_is_not_empty (local.get $stack))
             (then
                (local.set $tuple (call $pop_compare_stack (local.get $stack)))
-               (local.set $v1 (tuple.extract 0 (local.get $tuple)))
-               (local.set $v2 (tuple.extract 1 (local.get $tuple)))
+               (local.set $v1 (tuple.extract 2 0 (local.get $tuple)))
+               (local.set $v2 (tuple.extract 2 1 (local.get $tuple)))
                (br $loop))))
      (i32.const 0))
 
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 5f662069a1..b1c4c7745a 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -9,7 +9,7 @@
    (action
       (progn
          (system "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
-         (system "wasm-merge --version | grep -q 'version 116' || (echo 'Error: Binaryen version 116 is currently required'; false)")
+         (system "wasm-merge --version | grep -q 'version 117' || (echo 'Error: Binaryen version 117 is currently required'; false)")
          (pipe-stdout
             (run wasm-merge -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{read-lines:args} -o -)
             (run wasm-opt -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory - -O3 -o %{target})))))
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 36972f5f2a..fbba707159 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -230,7 +230,7 @@
          (call $caml_invalid_argument
             (array.new_data $string $format_error
                (i32.const 0) (i32.const 22))))
-      (tuple.make
+      (tuple.make 4
          (local.get $sign_style)
          (local.get $precision)
          (local.get $conversion)
@@ -242,7 +242,7 @@
 
    (func (export "caml_format_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $f f64) (local $b i64) (local $format (i32 i32 i32 i32))
+      (local $f f64) (local $b i64) (local $format (tuple i32 i32 i32 i32))
       (local $sign_style i32) (local $precision i32)
       (local $conversion i32) (local $uppercase i32)
       (local $negative i32)
@@ -254,10 +254,10 @@
       (local.set $b (i64.reinterpret_f64 (local.get $f)))
       (local.set $format
          (call $parse_format (ref.cast (ref $string) (local.get 0))))
-      (local.set $sign_style (tuple.extract 0 (local.get $format)))
-      (local.set $precision (tuple.extract 1 (local.get $format)))
-      (local.set $conversion (tuple.extract 2 (local.get $format)))
-      (local.set $uppercase (tuple.extract 3 (local.get $format)))
+      (local.set $sign_style (tuple.extract 4 0 (local.get $format)))
+      (local.set $precision (tuple.extract 4 1 (local.get $format)))
+      (local.set $conversion (tuple.extract 4 2 (local.get $format)))
+      (local.set $uppercase (tuple.extract 4 3 (local.get $format)))
       (local.set $negative
          (i32.wrap_i64 (i64.shr_u (local.get $b) (i64.const 63))))
       (local.set $i
@@ -747,7 +747,7 @@
    (func $frexp (param $x f64) (result f64 i32)
       (local $y i64)
       (local $e i32)
-      (local $r (f64 i32))
+      (local $r (tuple f64 i32))
       (local.set $y (i64.reinterpret_f64 (local.get $x)))
       (local.set $e
          (i32.and (i32.const 0x7ff)
@@ -759,29 +759,30 @@
                   (local.set $r
                      (call $frexp (f64.mul (local.get $x) (f64.const 0x1p64))))
                   (return
-                     (tuple.make (tuple.extract 0 (local.get $r))
-                        (i32.sub (tuple.extract 1 (local.get $r))
+                     (tuple.make 2
+                        (tuple.extract 2 0 (local.get $r))
+                        (i32.sub (tuple.extract 2 1 (local.get $r))
                            (i32.const 64)))))
                (else
-                  (return (tuple.make (local.get $x) (i32.const 0))))))
+                  (return (tuple.make 2 (local.get $x) (i32.const 0))))))
          (else
             (if (i32.eq (local.get $e) (i32.const 0x7ff))
                (then
-                  (return (tuple.make (local.get $x) (i32.const 0)))))))
-      (tuple.make
+                  (return (tuple.make 2 (local.get $x) (i32.const 0)))))))
+      (tuple.make 2
          (f64.reinterpret_i64
             (i64.or (i64.and (local.get $y) (i64.const 0x800fffffffffffff))
                (i64.const 0x3fe0000000000000)))
          (i32.sub (local.get $e) (i32.const 0x3fe))))
 
    (func (export "caml_frexp_float") (param (ref eq)) (result (ref eq))
-      (local $r (f64 i32))
+      (local $r (tuple f64 i32))
       (local.set $r
          (call $frexp
             (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
       (array.new_fixed $block 3 (ref.i31 (i32.const 0))
-         (struct.new $float (tuple.extract 0 (local.get $r)))
-         (ref.i31 (tuple.extract 1 (local.get $r)))))
+         (struct.new $float (tuple.extract 2 0 (local.get $r)))
+         (ref.i31 (tuple.extract 2 1 (local.get $r)))))
 
    (func (export "caml_signbit_float") (param (ref eq)) (result (ref eq))
       (ref.i31
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index d80535a6ba..ca17127a0a 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -68,10 +68,10 @@
       (param $s (ref eq)) (param $v (ref eq)) (result i32) (result i32)
       (call $caml_serialize_int_4 (local.get $s)
          (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
-      (tuple.make (i32.const 4) (i32.const 4)))
+      (tuple.make 2 (i32.const 4) (i32.const 4)))
 
    (func $int32_deserialize (param $s (ref eq)) (result (ref eq)) (result i32)
-      (tuple.make
+      (tuple.make 2
          (struct.new $int32 (global.get $int32_ops)
             (call $caml_deserialize_int_4 (local.get $s)))
          (i32.const 4)))
@@ -140,7 +140,7 @@
       (call $caml_serialize_int_1 (local.get $s) (i32.const 1))
       (call $caml_serialize_int_4 (local.get $s)
          (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
-      (tuple.make (i32.const 4) (i32.const 4)))
+      (tuple.make 2 (i32.const 4) (i32.const 4)))
 
    (data $integer_too_large "input_value: native integer value too large")
 
@@ -151,7 +151,7 @@
             (call $caml_failwith
                (array.new_data $string $integer_too_large
                   (i32.const 0) (i32.const 43)))))
-      (tuple.make
+      (tuple.make 2
          (struct.new $int32 (global.get $nativeint_ops)
             (call $caml_deserialize_int_4 (local.get $s)))
          (i32.const 4)))
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 30f2243df9..2d4b632c28 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -75,10 +75,10 @@
       (param $s (ref eq)) (param $v (ref eq)) (result i32) (result i32)
       (call $caml_serialize_int_8 (local.get $s)
          (struct.get $int64 1 (ref.cast (ref $int64) (local.get $v))))
-      (tuple.make (i32.const 8) (i32.const 8)))
+      (tuple.make 2 (i32.const 8) (i32.const 8)))
 
    (func $int64_deserialize (param $s (ref eq)) (result (ref eq)) (result i32)
-      (tuple.make
+      (tuple.make 2
          (struct.new $int64 (global.get $int64_ops)
             (call $caml_deserialize_int_8 (local.get $s)))
          (i32.const 8)))
@@ -185,13 +185,13 @@
    (func (export "caml_int64_of_string") (param $v (ref eq)) (result (ref eq))
       (local $s (ref $string))
       (local $i i32) (local $signedness i32) (local $sign i32) (local $base i32)
-      (local $t (i32 i32 i32 i32))
+      (local $t (tuple i32 i32 i32 i32))
       (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $t (call $parse_sign_and_base (local.get $s)))
-      (local.set $i (tuple.extract 0 (local.get $t)))
-      (local.set $signedness (tuple.extract 1 (local.get $t)))
-      (local.set $sign (tuple.extract 2 (local.get $t)))
-      (local.set $base (tuple.extract 3 (local.get $t)))
+      (local.set $i (tuple.extract 4 0 (local.get $t)))
+      (local.set $signedness (tuple.extract 4 1 (local.get $t)))
+      (local.set $sign (tuple.extract 4 2 (local.get $t)))
+      (local.set $base (tuple.extract 4 3 (local.get $t)))
       (return_call
         $caml_copy_int64
         (call $caml_i64_of_digits (local.get $base)
@@ -244,7 +244,7 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $d i64)
       (local $s (ref $string))
-      (local $format (i32 i32 i32 i32 i32))
+      (local $format (tuple i32 i32 i32 i32 i32))
       (local $sign_style i32) (local $alternate i32) (local $signed i32)
       (local $base i64) (local $uppercase i32)
       (local $negative i32)
@@ -259,11 +259,12 @@
                         (i32.const 100)) ;; 'd'
                (then (return_call $format_int64_default (local.get $d))))))
       (local.set $format (call $parse_int_format (local.get $s)))
-      (local.set $sign_style (tuple.extract 0 (local.get $format)))
-      (local.set $alternate (tuple.extract 1 (local.get $format)))
-      (local.set $signed (tuple.extract 2 (local.get $format)))
-      (local.set $base (i64.extend_i32_u (tuple.extract 3 (local.get $format))))
-      (local.set $uppercase (tuple.extract 4 (local.get $format)))
+      (local.set $sign_style (tuple.extract 5 0 (local.get $format)))
+      (local.set $alternate (tuple.extract 5 1 (local.get $format)))
+      (local.set $signed (tuple.extract 5 2 (local.get $format)))
+      (local.set $base
+         (i64.extend_i32_u (tuple.extract 5 3 (local.get $format))))
+      (local.set $uppercase (tuple.extract 5 4 (local.get $format)))
       (if (i32.and (local.get $signed) (i64.lt_s (local.get $d) (i64.const 0)))
          (then
             (local.set $negative (i32.const 1))
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index addfedcd9e..2ba2c5592a 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -60,7 +60,7 @@
                      (local.set $signedness (i32.const 0))
                      (local.set $i (i32.add (local.get $i)
                         (i32.const 2)))))))))))))))
-      (tuple.make
+      (tuple.make 4
          (local.get $i) (local.get $signedness) (local.get $sign)
          (local.get $base)))
 
@@ -83,16 +83,16 @@
       (local $i i32) (local $len i32) (local $d i32) (local $c i32)
       (local $signedness i32) (local $sign i32) (local $base i32)
       (local $res i32) (local $threshold i32)
-      (local $t (i32 i32 i32 i32))
+      (local $t (tuple i32 i32 i32 i32))
       (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $len (array.len (local.get $s)))
       (if (i32.eqz (local.get $len))
         (then (call $caml_failwith (local.get $errmsg))))
       (local.set $t (call $parse_sign_and_base (local.get $s)))
-      (local.set $i (tuple.extract 0 (local.get $t)))
-      (local.set $signedness (tuple.extract 1 (local.get $t)))
-      (local.set $sign (tuple.extract 2 (local.get $t)))
-      (local.set $base (tuple.extract 3 (local.get $t)))
+      (local.set $i (tuple.extract 4 0 (local.get $t)))
+      (local.set $signedness (tuple.extract 4 1 (local.get $t)))
+      (local.set $sign (tuple.extract 4 2 (local.get $t)))
+      (local.set $base (tuple.extract 4 3 (local.get $t)))
       (local.set $threshold (i32.div_u (i32.const -1) (local.get $base)))
       (if (i32.ge_s (local.get $i) (local.get $len))
          (then (call $caml_failwith (local.get $errmsg))))
@@ -269,7 +269,7 @@
          (call $caml_invalid_argument
             (array.new_data $string $format_error
                (i32.const 0) (i32.const 22))))
-      (tuple.make
+      (tuple.make 5
          (local.get $sign_style)
          (local.get $alternate)
          (local.get $signed)
@@ -279,7 +279,7 @@
    (func $format_int (export "format_int")
       (param (ref eq)) (param $d i32) (param $small i32) (result (ref eq))
       (local $s (ref $string))
-      (local $format (i32 i32 i32 i32 i32))
+      (local $format (tuple i32 i32 i32 i32 i32))
       (local $sign_style i32) (local $alternate i32) (local $signed i32)
       (local $base i32) (local $uppercase i32)
       (local $negative i32)
@@ -293,11 +293,11 @@
                         (i32.const 100)) ;; 'd'
                (then (return_call $format_int_default (local.get $d))))))
       (local.set $format (call $parse_int_format (local.get $s)))
-      (local.set $sign_style (tuple.extract 0 (local.get $format)))
-      (local.set $alternate (tuple.extract 1 (local.get $format)))
-      (local.set $signed (tuple.extract 2 (local.get $format)))
-      (local.set $base (tuple.extract 3 (local.get $format)))
-      (local.set $uppercase (tuple.extract 4 (local.get $format)))
+      (local.set $sign_style (tuple.extract 5 0 (local.get $format)))
+      (local.set $alternate (tuple.extract 5 1 (local.get $format)))
+      (local.set $signed (tuple.extract 5 2 (local.get $format)))
+      (local.set $base (tuple.extract 5 3 (local.get $format)))
+      (local.set $uppercase (tuple.extract 5 4 (local.get $format)))
       (if (i32.lt_s (local.get $d) (i32.const 0))
          (then
             (if (local.get $signed)
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 1e00a47796..0c46b4fe4f 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -390,7 +390,7 @@
       (param $s (ref $intern_state)) (param $code i32) (result (ref eq))
       (local $ops (ref $custom_operations))
       (local $expected_size i32)
-      (local $r ((ref eq) i32))
+      (local $r (tuple (ref eq) i32))
       (block $unknown
          (local.set $ops
             (br_on_null $unknown
@@ -417,14 +417,14 @@
                (call_ref $deserialize (local.get $s)
                   (struct.get $custom_operations $deserialize (local.get $ops))))
             (if (i32.and
-                  (i32.ne (tuple.extract 1 (local.get $r))
+                  (i32.ne (tuple.extract 2 1 (local.get $r))
                      (local.get $expected_size))
                   (i32.ne (local.get $code) (global.get $CODE_CUSTOM)))
                (then
                   (call $caml_failwith
                      (array.new_data $string $incorrect_size
                         (i32.const 0) (i32.const 56)))))
-            (return (tuple.extract 0 (local.get $r))))
+            (return (tuple.extract 2 0 (local.get $r))))
          (call $caml_failwith
             (array.new_data $string $expected_size
                (i32.const 0) (i32.const 47))))
@@ -1046,7 +1046,7 @@
       (local $serialize (ref $serialize))
       (local $fixed_length (ref $fixed_length))
       (local $pos i32) (local $buf (ref $string))
-      (local $r (i32 i32))
+      (local $r (tuple i32 i32))
       (local.set $ops (struct.get $custom 0 (local.get $v)))
       (block $abstract
          (local.set $serialize
@@ -1065,10 +1065,10 @@
                (call_ref $serialize
                   (local.get $s) (local.get $v) (local.get $serialize)))
             (if (i32.or
-                   (i32.ne (tuple.extract 0 (local.get $r))
+                   (i32.ne (tuple.extract 2 0 (local.get $r))
                       (struct.get $fixed_length $bsize_32
                         (local.get $fixed_length)))
-                   (i32.ne (tuple.extract 1 (local.get $r))
+                   (i32.ne (tuple.extract 2 1 (local.get $r))
                       (struct.get $fixed_length $bsize_64
                         (local.get $fixed_length))))
                 (then
@@ -1091,13 +1091,13 @@
             (call_ref $serialize
                (local.get $s) (local.get $v) (local.get $serialize)))
          (call $store32 (local.get $buf) (local.get $pos)
-            (tuple.extract 0 (local.get $r)))
+            (tuple.extract 2 0 (local.get $r)))
          (call $store32 (local.get $buf) (i32.add (local.get $pos) (i32.const 8))
-            (tuple.extract 1 (local.get $r)))
+            (tuple.extract 2 1 (local.get $r)))
          (return (local.get $r)))
       (call $caml_invalid_argument
          (array.new_data $string $cust_value (i32.const 0) (i32.const 37)))
-      (return (tuple.make (i32.const 0) (i32.const 0))))
+      (return (tuple.make 2 (i32.const 0) (i32.const 0))))
 
    (data $func_value "output_value: functional value")
    (data $cont_value "output_value: continuation value")
@@ -1112,7 +1112,7 @@
       (local $fa (ref $float_array))
       (local $hd i32) (local $tag i32) (local $sz i32)
       (local $pos i32)
-      (local $r (i32 i32))
+      (local $r (tuple i32 i32))
       (loop $loop
          (block $next_item
             (drop (block $not_int (result (ref eq))
@@ -1204,10 +1204,10 @@
                         (local.get $v))))
                (call $extern_size (local.get $s)
                   (i32.shr_u
-                     (i32.add (tuple.extract 0 (local.get $r)) (i32.const 7))
+                     (i32.add (tuple.extract 2 0 (local.get $r)) (i32.const 7))
                         (i32.const 2))
                   (i32.shr_u
-                     (i32.add (tuple.extract 1 (local.get $r)) (i32.const 15))
+                     (i32.add (tuple.extract 2 1 (local.get $r)) (i32.const 15))
                         (i32.const 3)))
                (br $next_item)))
             (if (call $caml_is_closure (local.get $v))
@@ -1294,11 +1294,11 @@
          (struct.get $extern_state $size_32 (local.get $s)))
       (call $store32 (local.get $header) (i32.const 16)
          (struct.get $extern_state $size_64 (local.get $s)))
-      (tuple.make (local.get $len) (local.get $header) (local.get $s)))
+      (tuple.make 3 (local.get $len) (local.get $header) (local.get $s)))
 
    (func (export "caml_output_value_to_string")
       (param $v (ref eq)) (param $flags (ref eq)) (result (ref eq))
-      (local $r (i32 (ref $string) (ref $extern_state)))
+      (local $r (tuple i32 (ref $string) (ref $extern_state)))
       (local $blk (ref $output_block)) (local $pos i32) (local $len i32)
       (local $res (ref $string))
       (local.set $blk
@@ -1313,10 +1313,10 @@
             (i32.const 0) (i32.const 0) (local.get $v)))
       (local.set $res
          (array.new $string (i32.const 0)
-            (i32.add (tuple.extract 0 (local.get $r)) (i32.const 20))))
+            (i32.add (tuple.extract 3 0 (local.get $r)) (i32.const 20))))
       (array.copy $string $string
          (local.get $res) (i32.const 0)
-         (tuple.extract 1 (local.get $r)) (i32.const 0) (i32.const 20))
+         (tuple.extract 3 1 (local.get $r)) (i32.const 0) (i32.const 20))
       (local.set $pos (i32.const 20))
       (loop $loop
          (block $done
@@ -1336,7 +1336,7 @@
       (param $vbuf (ref eq)) (param $vpos (ref eq)) (param $vlen (ref eq))
       (param $v (ref eq)) (param $flags (ref eq)) (result (ref eq))
       (local $buf (ref $string)) (local $pos i32) (local $len i32)
-      (local $r (i32 (ref $string) (ref $extern_state)))
+      (local $r (tuple i32 (ref $string) (ref $extern_state)))
       (local $blk (ref $output_block))
       (local.set $buf (ref.cast (ref $string) (local.get $vbuf)))
       (local.set $pos (i31.get_u (ref.cast (ref i31) (local.get $vpos))))
@@ -1355,13 +1355,13 @@
             (local.get $v)))
       (array.copy $string $string
          (local.get $buf) (local.get $pos)
-         (tuple.extract 1 (local.get $r)) (i32.const 0) (i32.const 20))
+         (tuple.extract 3 1 (local.get $r)) (i32.const 0) (i32.const 20))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_output_value")
       (param $ch (ref eq)) (param $v (ref eq)) (param $flags (ref eq))
       (result (ref eq))
-      (local $r (i32 (ref $string) (ref $extern_state)))
+      (local $r (tuple i32 (ref $string) (ref $extern_state)))
       (local $blk (ref $output_block)) (local $len i32)
       (local $res (ref $string))
       ;; ZZZ check if binary channel?
@@ -1376,7 +1376,7 @@
             (local.get $flags) (local.get $blk)
             (i32.const 0) (i32.const 0) (local.get $v)))
       (call $caml_really_putblock (local.get $ch)
-         (tuple.extract 1 (local.get $r)) (i32.const 0) (i32.const 20))
+         (tuple.extract 3 1 (local.get $r)) (i32.const 0) (i32.const 20))
       (loop $loop
          (block $done
             (local.set $len (struct.get $output_block $end (local.get $blk)))

From 3dd3b28eb82b74b4be46ae406e6a908bdc6d3750 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Mar 2024 09:57:32 +0100
Subject: [PATCH 230/481] Name locals in WAT ouput

We were just numbering them. This should make the output more readable
since we are propagating names from the OCaml source code.
---
 compiler/lib/wasm/wa_asm_output.ml         | 125 ++++++++++++---------
 compiler/lib/wasm/wa_ast.ml                |   9 +-
 compiler/lib/wasm/wa_code_generation.ml    |  26 +++--
 compiler/lib/wasm/wa_code_generation.mli   |   8 +-
 compiler/lib/wasm/wa_core_target.ml        |   4 +-
 compiler/lib/wasm/wa_curry.ml              |  98 +++++++++-------
 compiler/lib/wasm/wa_gc_target.ml          |   6 +-
 compiler/lib/wasm/wa_generate.ml           |  22 ++--
 compiler/lib/wasm/wa_initialize_locals.ml  |  29 +++--
 compiler/lib/wasm/wa_initialize_locals.mli |   4 +-
 compiler/lib/wasm/wa_tail_call.ml          |   7 +-
 compiler/lib/wasm/wa_target_sig.ml         |   6 +-
 compiler/lib/wasm/wa_wat_output.ml         |  29 +++--
 13 files changed, 209 insertions(+), 164 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 1769376faa..00d443c4e7 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -249,7 +249,7 @@ module Output () = struct
 
   let offs _ i = Int32.to_string i
 
-  let rec expression e =
+  let rec expression m e =
     match e with
     | Const op ->
         line
@@ -259,54 +259,55 @@ module Output () = struct
     | ConstSym (name, offset) ->
         line (type_prefix (I32 ()) ^^ string "const " ^^ symbol name offset)
     | UnOp (op, e') ->
-        expression e'
+        expression m e'
         ^^ line
              (type_prefix op
              ^^ string (select int_un_op int_un_op float_un_op float_un_op op))
     | BinOp (op, e1, e2) ->
-        expression e1
-        ^^ expression e2
+        expression m e1
+        ^^ expression m e2
         ^^ line
              (type_prefix op
              ^^ string (select int_bin_op int_bin_op float_bin_op float_bin_op op))
-    | I32WrapI64 e -> expression e ^^ line (string "i32.wrap_i64")
-    | I64ExtendI32 (s, e) -> expression e ^^ line (string (signage "i64.extend_i32" s))
-    | F32DemoteF64 e -> expression e ^^ line (string "f32.demote_f64")
-    | F64PromoteF32 e -> expression e ^^ line (string "f64.promote_f32")
+    | I32WrapI64 e -> expression m e ^^ line (string "i32.wrap_i64")
+    | I64ExtendI32 (s, e) -> expression m e ^^ line (string (signage "i64.extend_i32" s))
+    | F32DemoteF64 e -> expression m e ^^ line (string "f32.demote_f64")
+    | F64PromoteF32 e -> expression m e ^^ line (string "f64.promote_f32")
     | Load (offset, e') ->
-        expression e'
+        expression m e'
         ^^ line
              (type_prefix offset
              ^^ string "load "
              ^^ string (select offs offs offs offs offset))
     | Load8 (s, offset, e') ->
-        expression e'
+        expression m e'
         ^^ line
              (type_prefix offset
              ^^ string (signage "load8" s)
              ^^ string " "
              ^^ string (select offs offs offs offs offset))
-    | LocalGet i -> line (string "local.get " ^^ integer i)
-    | LocalTee (i, e') -> expression e' ^^ line (string "local.tee " ^^ integer i)
+    | LocalGet i -> line (string "local.get " ^^ integer (Hashtbl.find m i))
+    | LocalTee (i, e') ->
+        expression m e' ^^ line (string "local.tee " ^^ integer (Hashtbl.find m i))
     | GlobalGet nm -> line (string "global.get " ^^ symbol nm 0)
     | BlockExpr (ty, l) ->
         line (string "block" ^^ block_type ty)
-        ^^ indent (concat_map instruction l)
+        ^^ indent (concat_map (instruction m) l)
         ^^ line (string "end_block")
     | Call_indirect (typ, f, l) ->
-        concat_map expression l
-        ^^ expression f
+        concat_map (expression m) l
+        ^^ expression m f
         ^^ line (string "call_indirect " ^^ func_type typ)
-    | Call (x, l) -> concat_map expression l ^^ line (string "call " ^^ index x)
-    | MemoryGrow (mem, e) -> expression e ^^ line (string "memory.grow " ^^ integer mem)
-    | Seq (l, e') -> concat_map instruction l ^^ expression e'
+    | Call (x, l) -> concat_map (expression m) l ^^ line (string "call " ^^ index x)
+    | MemoryGrow (mem, e) -> expression m e ^^ line (string "memory.grow " ^^ integer mem)
+    | Seq (l, e') -> concat_map (instruction m) l ^^ expression m e'
     | Pop _ -> empty
     | IfExpr (ty, e, e1, e2) ->
-        expression e
+        expression m e
         ^^ line (string "if" ^^ block_type { params = []; result = [ ty ] })
-        ^^ indent (expression e1)
+        ^^ indent (expression m e1)
         ^^ line (string "else")
-        ^^ indent (expression e2)
+        ^^ indent (expression m e2)
         ^^ line (string "end_if")
     | RefFunc _
     | Call_ref _
@@ -328,83 +329,85 @@ module Output () = struct
     | ExternExternalize _
     | ExternInternalize _ -> assert false (* Not supported *)
 
-  and instruction i =
+  and instruction m i =
     match i with
-    | Drop e -> expression e ^^ line (string "drop")
+    | Drop e -> expression m e ^^ line (string "drop")
     | Store (offset, e, e') ->
-        expression e
-        ^^ expression e'
+        expression m e
+        ^^ expression m e'
         ^^ line
              (type_prefix offset
              ^^ string "store "
              ^^ string (select offs offs offs offs offset))
     | Store8 (offset, e, e') ->
-        expression e
-        ^^ expression e'
+        expression m e
+        ^^ expression m e'
         ^^ line
              (type_prefix offset
              ^^ string "store8 "
              ^^ string (select offs offs offs offs offset))
-    | LocalSet (i, e) -> expression e ^^ line (string "local.set " ^^ integer i)
-    | GlobalSet (nm, e) -> expression e ^^ line (string "global.set " ^^ symbol nm 0)
+    | LocalSet (i, e) ->
+        expression m e ^^ line (string "local.set " ^^ integer (Hashtbl.find m i))
+    | GlobalSet (nm, e) -> expression m e ^^ line (string "global.set " ^^ symbol nm 0)
     | Loop (ty, l) ->
         line (string "loop" ^^ block_type ty)
-        ^^ indent (concat_map instruction l)
+        ^^ indent (concat_map (instruction m) l)
         ^^ line (string "end_loop")
     | Block (ty, l) ->
         line (string "block" ^^ block_type ty)
-        ^^ indent (concat_map instruction l)
+        ^^ indent (concat_map (instruction m) l)
         ^^ line (string "end_block")
     | If (ty, e, l1, l2) ->
-        expression e
+        expression m e
         ^^ line (string "if" ^^ block_type ty)
-        ^^ indent (concat_map instruction l1)
+        ^^ indent (concat_map (instruction m) l1)
         ^^ line (string "else")
-        ^^ indent (concat_map instruction l2)
+        ^^ indent (concat_map (instruction m) l2)
         ^^ line (string "end_if")
     | Br_table (e, l, i) ->
-        expression e
+        expression m e
         ^^ line
              (string "br_table {"
              ^^ separate_map (string ", ") integer (l @ [ i ])
              ^^ string "}")
-    | Br (i, Some e) -> expression e ^^ instruction (Br (i, None))
+    | Br (i, Some e) -> expression m e ^^ instruction m (Br (i, None))
     | Br (i, None) -> line (string "br " ^^ integer i)
-    | Br_if (i, e) -> expression e ^^ line (string "br_if " ^^ integer i)
-    | Return (Some e) -> expression e ^^ instruction (Return None)
+    | Br_if (i, e) -> expression m e ^^ line (string "br_if " ^^ integer i)
+    | Return (Some e) -> expression m e ^^ instruction m (Return None)
     | Return None -> line (string "return")
-    | CallInstr (x, l) -> concat_map expression l ^^ line (string "call " ^^ index x)
+    | CallInstr (x, l) -> concat_map (expression m) l ^^ line (string "call " ^^ index x)
     | Nop -> empty
-    | Push e -> expression e
+    | Push e -> expression m e
     | Try (ty, body, catches, catch_all) ->
         Feature.require exception_handling;
         line (string "try" ^^ block_type ty)
-        ^^ indent (concat_map instruction body)
+        ^^ indent (concat_map (instruction m) body)
         ^^ concat_map
              (fun (tag, l) ->
-               line (string "catch " ^^ index tag) ^^ indent (concat_map instruction l))
+               line (string "catch " ^^ index tag)
+               ^^ indent (concat_map (instruction m) l))
              catches
         ^^ (match catch_all with
            | None -> empty
-           | Some l -> line (string "catch_all") ^^ indent (concat_map instruction l))
+           | Some l -> line (string "catch_all") ^^ indent (concat_map (instruction m) l))
         ^^ line (string "end_try")
     | Throw (i, e) ->
         Feature.require exception_handling;
-        expression e ^^ line (string "throw " ^^ index i)
+        expression m e ^^ line (string "throw " ^^ index i)
     | Rethrow i ->
         Feature.require exception_handling;
         line (string "rethrow " ^^ integer i)
     | Return_call_indirect (typ, f, l) ->
         Feature.require tail_call;
-        concat_map expression l
-        ^^ expression f
+        concat_map (expression m) l
+        ^^ expression m f
         ^^ line (string "return_call_indirect " ^^ func_type typ)
     | Return_call (x, l) ->
         Feature.require tail_call;
-        concat_map expression l ^^ line (string "return_call " ^^ index x)
+        concat_map (expression m) l ^^ line (string "return_call " ^^ index x)
     | Location (_, i) ->
         (* Source maps not supported for the non-GC target *)
-        instruction i
+        instruction m i
     | ArraySet _ | StructSet _ | Return_call_ref _ -> assert false (* Not supported *)
 
   let escape_string s =
@@ -595,7 +598,24 @@ module Output () = struct
       concat_map
         (fun f ->
           match f with
-          | Function { name; exported_name; typ; locals; body } ->
+          | Function { name; exported_name; typ; param_names; locals; body } ->
+              let local_names = Hashtbl.create 8 in
+              let idx =
+                List.fold_left
+                  ~f:(fun idx x ->
+                    Hashtbl.add local_names x idx;
+                    idx + 1)
+                  ~init:0
+                  param_names
+              in
+              let _ =
+                List.fold_left
+                  ~f:(fun idx (x, _) ->
+                    Hashtbl.add local_names x idx;
+                    idx + 1)
+                  ~init:idx
+                  locals
+              in
               indent
                 (section_header "text" (V name)
                 ^^ define_symbol (V name)
@@ -616,8 +636,11 @@ module Output () = struct
                        else
                          line
                            (string ".local "
-                           ^^ separate_map (string ", ") value_type locals))
-                   ^^ concat_map instruction body
+                           ^^ separate_map
+                                (string ", ")
+                                (fun (_, ty) -> value_type ty)
+                                locals))
+                   ^^ concat_map (instruction local_names) body
                    ^^ line (string "end_function"))
           | Import _ | Data _ | Global _ | Tag _ | Type _ -> empty)
         fields
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 7fe539031f..14fb07c5a2 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -129,8 +129,8 @@ type expression =
   | F64PromoteF32 of expression
   | Load of (memarg, memarg, memarg, memarg) op * expression
   | Load8 of signage * (memarg, memarg, memarg, memarg) op * expression
-  | LocalGet of int
-  | LocalTee of int * expression
+  | LocalGet of var
+  | LocalTee of var * expression
   | GlobalGet of symbol
   | BlockExpr of func_type * instruction list
   | Call_indirect of func_type * expression * expression list
@@ -163,7 +163,7 @@ and instruction =
   | Drop of expression
   | Store of (memarg, memarg, memarg, memarg) op * expression * expression
   | Store8 of (memarg, memarg, memarg, memarg) op * expression * expression
-  | LocalSet of int * expression
+  | LocalSet of var * expression
   | GlobalSet of symbol * expression
   | Loop of func_type * instruction list
   | Block of func_type * instruction list
@@ -215,7 +215,8 @@ type module_field =
       { name : var
       ; exported_name : string option
       ; typ : func_type
-      ; locals : value_type list
+      ; param_names : var list
+      ; locals : (var * value_type) list
       ; body : instruction list
       }
   | Data of
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 0ee5fe6d2b..2a75c88b67 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -68,7 +68,7 @@ let make_context ~value_type =
   }
 
 type var =
-  | Local of int * W.value_type option
+  | Local of int * Var.t * W.value_type option
   | Expr of W.expression t
 
 and state =
@@ -247,14 +247,14 @@ let var x st =
 
 let add_var ?typ x ({ var_count; vars; _ } as st) =
   match Var.Map.find_opt x vars with
-  | Some (Local (i, typ')) ->
+  | Some (Local (_, x', typ')) ->
       assert (Poly.equal typ typ');
-      i, st
+      x', st
   | Some (Expr _) -> assert false
   | None ->
       let i = var_count in
-      let vars = Var.Map.add x (Local (i, typ)) vars in
-      i, { st with var_count = var_count + 1; vars }
+      let vars = Var.Map.add x (Local (i, x, typ)) vars in
+      x, { st with var_count = var_count + 1; vars }
 
 let define_var x e st = (), { st with vars = Var.Map.add x (Expr e) st.vars }
 
@@ -442,7 +442,7 @@ let rec is_smi e =
 
 let get_i31_value x st =
   match st.instrs with
-  | LocalSet (x', RefI31 e) :: rem when x = x' && is_smi e ->
+  | LocalSet (x', RefI31 e) :: rem when Code.Var.equal x x' && is_smi e ->
       let x = Var.fresh () in
       let x, st = add_var ~typ:I32 x st in
       Some x, { st with instrs = LocalSet (x', RefI31 (LocalTee (x, e))) :: rem }
@@ -451,7 +451,7 @@ let get_i31_value x st =
 let load x =
   let* x = var x in
   match x with
-  | Local (x, _) -> return (W.LocalGet x)
+  | Local (_, x, _) -> return (W.LocalGet x)
   | Expr e -> e
 
 let tee ?typ x e =
@@ -509,7 +509,7 @@ let assign x e =
   let* x = var x in
   let* e = e in
   match x with
-  | Local (x, _) -> instr (W.LocalSet (x, e))
+  | Local (_, x, _) -> instr (W.LocalSet (x, e))
   | Expr _ -> assert false
 
 let seq l e =
@@ -613,21 +613,23 @@ let need_dummy_fun ~cps ~arity st =
 
 let init_code context = instrs context.init_code
 
-let function_body ~context ~param_count ~body =
+let function_body ~context ~param_names ~body =
   let st = { var_count = 0; vars = Var.Map.empty; instrs = []; context } in
   let (), st = body st in
   let local_count, body = st.var_count, List.rev st.instrs in
-  let local_types = Array.make local_count None in
+  let local_types = Array.make local_count (Var.fresh (), None) in
+  List.iteri ~f:(fun i x -> local_types.(i) <- x, None) param_names;
   Var.Map.iter
     (fun _ v ->
       match v with
-      | Local (i, typ) -> local_types.(i) <- typ
+      | Local (i, x, typ) -> local_types.(i) <- x, typ
       | Expr _ -> ())
     st.vars;
   let body = Wa_tail_call.f body in
+  let param_count = List.length param_names in
   let locals =
     local_types
-    |> Array.map ~f:(fun v -> Option.value ~default:context.value_type v)
+    |> Array.map ~f:(fun (x, v) -> x, Option.value ~default:context.value_type v)
     |> (fun a -> Array.sub a ~pos:param_count ~len:(Array.length a - param_count))
     |> Array.to_list
   in
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index bb81bf291c..8c87b39669 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -111,13 +111,13 @@ val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
 val try_ : Wa_ast.func_type -> unit t -> (Code.Var.t * unit t) list -> unit t
 
-val add_var : ?typ:Wa_ast.value_type -> Wa_ast.var -> int t
+val add_var : ?typ:Wa_ast.value_type -> Wa_ast.var -> Wa_ast.var t
 
 val define_var : Wa_ast.var -> expression -> unit t
 
 val is_small_constant : Wa_ast.expression -> bool t
 
-val get_i31_value : int -> int option t
+val get_i31_value : Wa_ast.var -> Wa_ast.var option t
 
 val with_location : Code.loc -> unit t -> unit t
 
@@ -167,6 +167,6 @@ val need_dummy_fun : cps:bool -> arity:int -> Code.Var.t t
 
 val function_body :
      context:context
-  -> param_count:int
+  -> param_names:Code.Var.t list
   -> body:unit t
-  -> Wa_ast.value_type list * Wa_ast.instruction list
+  -> (Wa_ast.var * Wa_ast.value_type) list * Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index ddec0394a2..b42bf70279 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -632,7 +632,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
         exn_handler ~result_typ ~fall_through ~context )
     ]
 
-let post_process_function_body ~param_count:_ ~locals:_ instrs = instrs
+let post_process_function_body ~param_names:_ ~locals:_ instrs = instrs
 
 let entry_point ~context:_ ~toplevel_fun =
   let code =
@@ -653,4 +653,4 @@ let entry_point ~context:_ ~toplevel_fun =
     let* () = instr (W.GlobalSet (S "young_limit", low)) in
     drop (return (W.Call (toplevel_fun, [])))
   in
-  { W.params = []; result = [] }, code
+  { W.params = []; result = [] }, [], code
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index 0123e13f08..b86948ad0d 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -50,12 +50,12 @@ module Make (Target : Wa_target_sig.S) = struct
         (load_func (local.get closure_0)) (field 3 (local.get closure_1)) (field 3 (local.get closure_2)) ... (local.get closure_{n - m})) (local.get x1) ... (local.get xm) (local.get closure_0))
   *)
   let curry_app ~context ~arity m ~name =
+    let args =
+      List.init ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x_%d" i)) ~len:m
+    in
+    let f = Code.Var.fresh_n "f" in
     let body =
-      let args =
-        List.init ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x_%d" i)) ~len:m
-      in
       let* () = bind_parameters args in
-      let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
       let* args' = expression_list load args in
       let* _f = load f in
@@ -82,8 +82,10 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       loop m [] f None
     in
-    let locals, body = function_body ~context ~param_count:2 ~body in
-    W.Function { name; exported_name = None; typ = func_type 1; locals; body }
+    let param_names = args @ [ f ] in
+    let locals, body = function_body ~context ~param_names ~body in
+    W.Function
+      { name; exported_name = None; typ = func_type 1; param_names; locals; body }
 
   let curry_name n m = Printf.sprintf "curry_%d_%d" n m
 
@@ -100,10 +102,10 @@ module Make (Target : Wa_target_sig.S) = struct
         let functions = curry ~context ~arity (m - 1) ~name:nm in
         nm, functions
     in
+    let x = Code.Var.fresh_n "x" in
+    let f = Code.Var.fresh_n "f" in
     let body =
-      let x = Code.Var.fresh_n "x" in
       let* _ = add_var x in
-      let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
       let res = Code.Var.fresh_n "res" in
       let stack_info, stack =
@@ -140,8 +142,10 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       Stack.perform_spilling stack_ctx (`Instr ret)
     in
-    let locals, body = function_body ~context ~param_count:2 ~body in
-    W.Function { name; exported_name = None; typ = func_type 1; locals; body }
+    let param_names = [ x; f ] in
+    let locals, body = function_body ~context ~param_names ~body in
+    W.Function
+      { name; exported_name = None; typ = func_type 1; param_names; locals; body }
     :: functions
 
   let curry ~arity ~name = curry ~arity arity ~name
@@ -149,12 +153,12 @@ module Make (Target : Wa_target_sig.S) = struct
   let cps_curry_app_name n m = Printf.sprintf "cps_curry_app %d_%d" n m
 
   let cps_curry_app ~context ~arity m ~name =
+    let args =
+      List.init ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x_%d" i)) ~len:(m + 1)
+    in
+    let f = Code.Var.fresh_n "f" in
     let body =
-      let args =
-        List.init ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x_%d" i)) ~len:(m + 1)
-      in
       let* () = bind_parameters args in
-      let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
       let* args' = expression_list load args in
       let* _f = load f in
@@ -181,8 +185,10 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       loop m [] f None
     in
-    let locals, body = function_body ~context ~param_count:3 ~body in
-    W.Function { name; exported_name = None; typ = func_type 2; locals; body }
+    let param_names = args @ [ f ] in
+    let locals, body = function_body ~context ~param_names ~body in
+    W.Function
+      { name; exported_name = None; typ = func_type 2; param_names; locals; body }
 
   let cps_curry_name n m = Printf.sprintf "cps_curry_%d_%d" n m
 
@@ -199,12 +205,12 @@ module Make (Target : Wa_target_sig.S) = struct
         let functions = cps_curry ~context ~arity (m - 1) ~name:nm in
         nm, functions
     in
+    let x = Code.Var.fresh_n "x" in
+    let cont = Code.Var.fresh_n "cont" in
+    let f = Code.Var.fresh_n "f" in
     let body =
-      let x = Code.Var.fresh_n "x" in
       let* _ = add_var x in
-      let cont = Code.Var.fresh_n "cont" in
       let* _ = add_var cont in
-      let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
       let res = Code.Var.fresh_n "res" in
       let stack_info, stack =
@@ -242,21 +248,23 @@ module Make (Target : Wa_target_sig.S) = struct
       let* c = call ~cps:false ~arity:1 (load cont) [ e ] in
       instr (W.Return (Some c))
     in
-    let locals, body = function_body ~context ~param_count:3 ~body in
-    W.Function { name; exported_name = None; typ = func_type 2; locals; body }
+    let param_names = [ x; cont; f ] in
+    let locals, body = function_body ~context ~param_names ~body in
+    W.Function
+      { name; exported_name = None; typ = func_type 2; param_names; locals; body }
     :: functions
 
   let cps_curry ~arity ~name = cps_curry ~arity arity ~name
 
   let apply ~context ~arity ~name =
     assert (arity > 1);
+    let l =
+      List.rev
+        (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
+    in
+    let f = Code.Var.fresh_n "f" in
     let body =
-      let l =
-        List.rev
-          (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
-      in
       let* () = bind_parameters l in
-      let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
       Memory.check_function_arity
         f
@@ -301,18 +309,20 @@ module Make (Target : Wa_target_sig.S) = struct
          in
          build_applies (load f) l)
     in
-    let locals, body = function_body ~context ~param_count:(arity + 1) ~body in
-    W.Function { name; exported_name = None; typ = func_type arity; locals; body }
+    let param_names = l @ [ f ] in
+    let locals, body = function_body ~context ~param_names ~body in
+    W.Function
+      { name; exported_name = None; typ = func_type arity; param_names; locals; body }
 
   let cps_apply ~context ~arity ~name =
     assert (arity > 2);
+    let l =
+      List.rev
+        (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
+    in
+    let f = Code.Var.fresh_n "f" in
     let body =
-      let l =
-        List.rev
-          (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
-      in
       let* () = bind_parameters l in
-      let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
       Memory.check_function_arity
         f
@@ -362,18 +372,20 @@ module Make (Target : Wa_target_sig.S) = struct
          let* () = push (call ~cps:true ~arity:2 (load f) [ x; iterate ]) in
          Stack.perform_spilling stack_ctx (`Instr ret))
     in
-    let locals, body = function_body ~context ~param_count:(arity + 1) ~body in
-    W.Function { name; exported_name = None; typ = func_type arity; locals; body }
+    let param_names = l @ [ f ] in
+    let locals, body = function_body ~context ~param_names ~body in
+    W.Function
+      { name; exported_name = None; typ = func_type arity; param_names; locals; body }
 
   let dummy ~context ~cps ~arity ~name =
     let arity = if cps then arity + 1 else arity in
+    let l =
+      List.rev
+        (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
+    in
+    let f = Code.Var.fresh_n "f" in
     let body =
-      let l =
-        List.rev
-          (List.init ~len:arity ~f:(fun i -> Code.Var.fresh_n (Printf.sprintf "x%d" i)))
-      in
       let* () = bind_parameters l in
-      let f = Code.Var.fresh_n "f" in
       let* _ = add_var f in
       let* typ, closure = Memory.load_real_closure ~cps ~arity (load f) in
       let* l = expression_list load l in
@@ -387,8 +399,10 @@ module Make (Target : Wa_target_sig.S) = struct
       in
       instr (W.Return (Some e))
     in
-    let locals, body = function_body ~context ~param_count:(arity + 1) ~body in
-    W.Function { name; exported_name = None; typ = func_type arity; locals; body }
+    let param_names = l @ [ f ] in
+    let locals, body = function_body ~context ~param_names ~body in
+    W.Function
+      { name; exported_name = None; typ = func_type arity; param_names; locals; body }
 
   let f ~context =
     IntMap.iter
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 86544aec46..28406bf9b5 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1677,6 +1677,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
 let post_process_function_body = Wa_initialize_locals.f
 
 let entry_point ~context ~toplevel_fun =
+  let suspender = Code.Var.fresh () in
   let code =
     let* f =
       register_import
@@ -1686,7 +1687,6 @@ let entry_point ~context ~toplevel_fun =
            else "caml_initialize_effects")
         (Fun { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] })
     in
-    let suspender = Code.Var.fresh () in
     let* _ = add_var suspender in
     let* s = load suspender in
     let* () = instr (W.CallInstr (f, [ s ])) in
@@ -1698,4 +1698,6 @@ let entry_point ~context ~toplevel_fun =
     in
     instr (W.CallInstr (main, [ RefFunc toplevel_fun ]))
   in
-  { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] }, code
+  ( { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] }
+  , [ suspender ]
+  , code )
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index f46c1c3e01..eb28a1435d 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -960,18 +960,19 @@ module Generate (Target : Wa_target_sig.S) = struct
     (*
   Format.eprintf "=== %d ===@." pc;
 *)
-    let param_count =
+    let param_names =
       match name_opt with
-      | None -> 0
-      | Some _ -> List.length params + 1
+      | None -> []
+      | Some f -> params @ [ f ]
     in
+    let param_count = List.length param_names in
     (match name_opt with
     | None -> ctx.global_context.globalized_variables <- Wa_globalize.f p g ctx.closures
     | Some _ -> ());
     let locals, body =
       function_body
         ~context:ctx.global_context
-        ~param_count
+        ~param_names
         ~body:
           (let* () = build_initial_env in
            let stack_ctx = Stack.start_function ~context:ctx.global_context stack_info in
@@ -985,13 +986,14 @@ module Generate (Target : Wa_target_sig.S) = struct
              (fun ~result_typ ~fall_through ~context ->
                translate_branch result_typ fall_through (-1) cont context stack_ctx))
     in
-    let body = post_process_function_body ~param_count ~locals body in
+    let body = post_process_function_body ~param_names ~locals body in
     W.Function
       { name =
           (match name_opt with
           | None -> toplevel_name
           | Some x -> x)
       ; exported_name = None
+      ; param_names
       ; typ = func_type param_count
       ; locals
       ; body
@@ -999,17 +1001,13 @@ module Generate (Target : Wa_target_sig.S) = struct
     :: acc
 
   let entry_point ctx toplevel_fun entry_name =
-    let typ, body = entry_point ~context:ctx.global_context ~toplevel_fun in
-    let locals, body =
-      function_body
-        ~context:ctx.global_context
-        ~param_count:(List.length typ.W.params)
-        ~body
-    in
+    let typ, param_names, body = entry_point ~context:ctx.global_context ~toplevel_fun in
+    let locals, body = function_body ~context:ctx.global_context ~param_names ~body in
     W.Function
       { name = Var.fresh_n "entry_point"
       ; exported_name = Some entry_name
       ; typ
+      ; param_names
       ; locals
       ; body
       }
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
index 6566a76cd7..b638f1aa1d 100644
--- a/compiler/lib/wasm/wa_initialize_locals.ml
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -1,17 +1,17 @@
 open Stdlib
 
 type ctx =
-  { mutable initialized : IntSet.t
-  ; uninitialized : IntSet.t ref
+  { mutable initialized : Code.Var.Set.t
+  ; uninitialized : Code.Var.Set.t ref
   }
 
-let mark_initialized ctx i = ctx.initialized <- IntSet.add i ctx.initialized
+let mark_initialized ctx i = ctx.initialized <- Code.Var.Set.add i ctx.initialized
 
 let fork_context { initialized; uninitialized } = { initialized; uninitialized }
 
 let check_initialized ctx i =
-  if not (IntSet.mem i ctx.initialized)
-  then ctx.uninitialized := IntSet.add i !(ctx.uninitialized)
+  if not (Code.Var.Set.mem i ctx.initialized)
+  then ctx.uninitialized := Code.Var.Set.add i !(ctx.uninitialized)
 
 let rec scan_expression ctx e =
   match e with
@@ -98,20 +98,19 @@ and scan_instructions ctx l =
   let ctx = fork_context ctx in
   List.iter ~f:(fun i -> scan_instruction ctx i) l
 
-let f ~param_count ~locals instrs =
-  let ctx = { initialized = IntSet.empty; uninitialized = ref IntSet.empty } in
-  for i = 0 to param_count - 1 do
-    mark_initialized ctx i
-  done;
-  List.iteri
-    ~f:(fun i typ ->
+let f ~param_names ~locals instrs =
+  let ctx =
+    { initialized = Code.Var.Set.empty; uninitialized = ref Code.Var.Set.empty }
+  in
+  List.iter ~f:(fun x -> mark_initialized ctx x) param_names;
+  List.iter
+    ~f:(fun (var, typ) ->
       match (typ : Wa_ast.value_type) with
-      | I32 | I64 | F32 | F64 | Ref { nullable = true; _ } ->
-          mark_initialized ctx (i + param_count)
+      | I32 | I64 | F32 | F64 | Ref { nullable = true; _ } -> mark_initialized ctx var
       | Ref { nullable = false; _ } -> ())
     locals;
   scan_instructions ctx instrs;
   List.map
     ~f:(fun i -> Wa_ast.LocalSet (i, RefI31 (Const (I32 0l))))
-    (IntSet.elements !(ctx.uninitialized))
+    (Code.Var.Set.elements !(ctx.uninitialized))
   @ instrs
diff --git a/compiler/lib/wasm/wa_initialize_locals.mli b/compiler/lib/wasm/wa_initialize_locals.mli
index 53e7520699..d3a89de191 100644
--- a/compiler/lib/wasm/wa_initialize_locals.mli
+++ b/compiler/lib/wasm/wa_initialize_locals.mli
@@ -1,5 +1,5 @@
 val f :
-     param_count:int
-  -> locals:Wa_ast.value_type list
+     param_names:Wa_ast.var list
+  -> locals:(Wa_ast.var * Wa_ast.value_type) list
   -> Wa_ast.instruction list
   -> Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index 5ae9d2f1d6..a05d53ac78 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -11,10 +11,11 @@ let rec rewrite_tail_call ~y i =
   match i with
   | Wa_ast.Location (loc, i') ->
       Option.map ~f:(fun i -> Wa_ast.Location (loc, i)) (rewrite_tail_call ~y i')
-  | LocalSet (x, Call (symb, l)) when x = y -> Some (Return_call (symb, l))
-  | LocalSet (x, Call_indirect (ty, e, l)) when x = y ->
+  | LocalSet (x, Call (symb, l)) when Code.Var.equal x y -> Some (Return_call (symb, l))
+  | LocalSet (x, Call_indirect (ty, e, l)) when Code.Var.equal x y ->
       Some (Return_call_indirect (ty, e, l))
-  | LocalSet (x, Call_ref (ty, e, l)) when x = y -> Some (Return_call_ref (ty, e, l))
+  | LocalSet (x, Call_ref (ty, e, l)) when Code.Var.equal x y ->
+      Some (Return_call_ref (ty, e, l))
   | _ -> None
 
 let rec instruction ~tail i =
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 5083d39462..18902e242a 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -295,13 +295,13 @@ module type S = sig
     -> unit Wa_code_generation.t
 
   val post_process_function_body :
-       param_count:int
-    -> locals:Wa_ast.value_type list
+       param_names:Wa_ast.var list
+    -> locals:(Wa_ast.var * Wa_ast.value_type) list
     -> Wa_ast.instruction list
     -> Wa_ast.instruction list
 
   val entry_point :
        context:Wa_code_generation.context
     -> toplevel_fun:Wa_ast.var
-    -> Wa_ast.func_type * unit Wa_code_generation.t
+    -> Wa_ast.func_type * Wa_ast.var list * unit Wa_code_generation.t
 end
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 355d1d5fa7..9b17fdd880 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -62,8 +62,15 @@ let list ?(always = false) name f l =
 
 let value_type_list name tl = list name (fun tl -> List.map ~f:value_type tl) tl
 
-let func_type { params; result } =
-  value_type_list "param" params @ value_type_list "result" result
+let func_type ?param_names { params; result } =
+  (match param_names with
+  | None -> value_type_list "param" params
+  | Some names ->
+      List.map2
+        ~f:(fun i typ -> List [ Atom "param"; index i; value_type typ ])
+        names
+        params)
+  @ value_type_list "result" result
 
 let storage_type typ =
   match typ with
@@ -254,9 +261,8 @@ let expression_or_instructions ctx in_function =
              :: select offs offs offs offs offset
             @ expression e')
         ]
-    | LocalGet i -> [ List [ Atom "local.get"; Atom (string_of_int i) ] ]
-    | LocalTee (i, e') ->
-        [ List (Atom "local.tee" :: Atom (string_of_int i) :: expression e') ]
+    | LocalGet i -> [ List [ Atom "local.get"; index i ] ]
+    | LocalTee (i, e') -> [ List (Atom "local.tee" :: index i :: expression e') ]
     | GlobalGet nm -> [ List [ Atom "global.get"; symbol nm ] ]
     | BlockExpr (ty, l) -> [ List (Atom "block" :: (block_type ty @ instructions l)) ]
     | Call_indirect (typ, e, l) ->
@@ -368,8 +374,7 @@ let expression_or_instructions ctx in_function =
             :: (select offs offs offs offs offset @ expression e1 @ expression e2))
         ]
     | LocalSet (i, Seq (l, e)) -> instructions (l @ [ LocalSet (i, e) ])
-    | LocalSet (i, e) ->
-        [ List (Atom "local.set" :: Atom (string_of_int i) :: expression e) ]
+    | LocalSet (i, e) -> [ List (Atom "local.set" :: index i :: expression e) ]
     | GlobalSet (nm, e) -> [ List (Atom "global.set" :: symbol nm :: expression e) ]
     | Loop (ty, l) -> [ List (Atom "loop" :: (block_type ty @ instructions l)) ]
     | Block (ty, l) -> [ List (Atom "block" :: (block_type ty @ instructions l)) ]
@@ -465,11 +470,11 @@ let expression ctx = fst (expression_or_instructions ctx false)
 
 let instructions ctx = snd (expression_or_instructions ctx true)
 
-let funct ctx name exported_name typ locals body =
+let funct ctx name exported_name typ param_names locals body =
   List
     ((Atom "func" :: index name :: export exported_name)
-    @ func_type typ
-    @ value_type_list "local" locals
+    @ func_type ~param_names typ
+    @ List.map ~f:(fun (i, t) -> List [ Atom "local"; index i; value_type t ]) locals
     @ instructions ctx body)
 
 let import f =
@@ -531,8 +536,8 @@ let type_field { name; typ; supertype; final } =
 
 let field ctx f =
   match f with
-  | Function { name; exported_name; typ; locals; body } ->
-      [ funct ctx name exported_name typ locals body ]
+  | Function { name; exported_name; typ; param_names; locals; body } ->
+      [ funct ctx name exported_name typ param_names locals body ]
   | Global { name; typ; init } ->
       [ List (Atom "global" :: symbol name :: global_type typ :: expression ctx init) ]
   | Tag { name; typ } ->

From 6cb2f7e54c0c275743098cc31c6da9130f525f3e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Mar 2024 10:02:25 +0100
Subject: [PATCH 231/481] Use shorter names in WAT output

Directly use the name from the OCaml code if possible, with a suffix in
case of ambiguity. Use short names for not explictly named variables.
---
 compiler/lib/wasm/wa_wat_output.ml | 327 ++++++++++++++++++++---------
 1 file changed, 233 insertions(+), 94 deletions(-)

diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 9b17fdd880..88cbcb662c 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -3,6 +3,89 @@ open Wa_ast
 
 let target = `Binaryen (*`Reference*)
 
+let assign_names ?(reversed = true) f names =
+  let used = ref StringSet.empty in
+  let rec find_available_name used name i =
+    let nm = Printf.sprintf "%s$%d" name i in
+    if StringSet.mem nm used then find_available_name used name (i + 1) else nm
+  in
+  let names = if reversed then List.rev names else names in
+  let names =
+    List.map
+      ~f:(fun x ->
+        match f x with
+        | None -> x, None
+        | Some nm ->
+            let nm =
+              if StringSet.mem nm !used then find_available_name !used nm 1 else nm
+            in
+            used := StringSet.add nm !used;
+            x, Some nm)
+      names
+  in
+  let printer = Var_printer.create Var_printer.Alphabet.javascript in
+  let i = ref 0 in
+  let rec first_available_name () =
+    let nm = Var_printer.to_string printer !i in
+    incr i;
+    if StringSet.mem nm !used then first_available_name () else nm
+  in
+  let tbl = Hashtbl.create 16 in
+  List.iter
+    ~f:(fun (x, nm) ->
+      Hashtbl.add
+        tbl
+        x
+        (match nm with
+        | Some nm -> nm
+        | None -> first_available_name ()))
+    names;
+  tbl
+
+type st =
+  { type_names : (var, string) Hashtbl.t
+  ; func_names : (var, string) Hashtbl.t
+  ; global_names : (symbol, string) Hashtbl.t
+  ; data_names : (var, string) Hashtbl.t
+  ; tag_names : (var, string) Hashtbl.t
+  ; local_names : (var, string) Hashtbl.t
+  }
+
+let build_name_tables fields =
+  let type_names = ref [] in
+  let func_names = ref [] in
+  let data_names = ref [] in
+  let global_names = ref [] in
+  let tag_names = ref [] in
+  let push l v = l := v :: !l in
+  List.iter
+    ~f:(fun field ->
+      match field with
+      | Function { name; _ } -> push func_names name
+      | Type l -> List.iter ~f:(fun { name; _ } -> push type_names name) l
+      | Data { name; _ } -> push data_names name
+      | Global { name; _ } -> push global_names name
+      | Tag { name; _ } -> push tag_names name
+      | Import { name; desc; _ } -> (
+          match desc with
+          | Fun _ -> push func_names name
+          | Global _ -> push global_names (V name)
+          | Tag _ -> push tag_names name))
+    fields;
+  let index = Code.Var.get_name in
+  let symbol name =
+    match name with
+    | V name -> Code.Var.get_name name
+    | S name -> Some name
+  in
+  { type_names = assign_names index !type_names
+  ; func_names = assign_names index !func_names
+  ; global_names = assign_names symbol !global_names
+  ; data_names = assign_names index !data_names
+  ; tag_names = assign_names index !tag_names
+  ; local_names = Hashtbl.create 1
+  }
+
 type sexp =
   | Atom of string
   | List of sexp list
@@ -24,33 +107,30 @@ let rec format_sexp f s =
       Format.fprintf f ")@]"
   | Comment s -> Format.fprintf f ";;%s" s
 
-let index x = Atom ("$" ^ Code.Var.to_string x)
+let index tbl x = Atom ("$" ^ Hashtbl.find tbl x)
 
-let symbol name =
-  match name with
-  | V name -> index name
-  | S name -> Atom ("$" ^ name)
+let symbol tbl name = index tbl.global_names name
 
-let heap_type (ty : heap_type) =
+let heap_type st (ty : heap_type) =
   match ty with
   | Func -> Atom "func"
   | Extern -> Atom "extern"
   | Any -> Atom "any"
   | Eq -> Atom "eq"
   | I31 -> Atom "i31"
-  | Type t -> index t
+  | Type t -> index st.type_names t
 
-let ref_type { nullable; typ } =
-  let r = [ heap_type typ ] in
+let ref_type st { nullable; typ } =
+  let r = [ heap_type st typ ] in
   List (Atom "ref" :: (if nullable then Atom "null" :: r else r))
 
-let value_type (t : value_type) =
+let value_type st (t : value_type) =
   match t with
   | I32 -> Atom "i32"
   | I64 -> Atom "i64"
   | F32 -> Atom "f32"
   | F64 -> Atom "f64"
-  | Ref ty -> ref_type ty
+  | Ref ty -> ref_type st ty
 
 let packed_type t =
   match t with
@@ -60,35 +140,37 @@ let packed_type t =
 let list ?(always = false) name f l =
   if (not always) && List.is_empty l then [] else [ List (Atom name :: f l) ]
 
-let value_type_list name tl = list name (fun tl -> List.map ~f:value_type tl) tl
+let value_type_list st name tl =
+  list name (fun tl -> List.map ~f:(fun t -> value_type st t) tl) tl
 
-let func_type ?param_names { params; result } =
+let func_type st ?param_names { params; result } =
   (match param_names with
-  | None -> value_type_list "param" params
+  | None -> value_type_list st "param" params
   | Some names ->
       List.map2
-        ~f:(fun i typ -> List [ Atom "param"; index i; value_type typ ])
+        ~f:(fun i typ -> List [ Atom "param"; index st.local_names i; value_type st typ ])
         names
         params)
-  @ value_type_list "result" result
+  @ value_type_list st "result" result
 
-let storage_type typ =
+let storage_type st typ =
   match typ with
-  | Value typ -> value_type typ
+  | Value typ -> value_type st typ
   | Packed typ -> packed_type typ
 
 let mut_type f { mut; typ } = if mut then List [ Atom "mut"; f typ ] else f typ
 
-let field_type typ = mut_type storage_type typ
+let field_type st typ = mut_type (fun t -> storage_type st t) typ
 
-let global_type typ = mut_type value_type typ
+let global_type st typ = mut_type (fun t -> value_type st t) typ
 
-let str_type typ =
+let str_type st typ =
   match typ with
-  | Func ty -> List (Atom "func" :: func_type ty)
+  | Func ty -> List (Atom "func" :: func_type st ty)
   | Struct l ->
-      List (Atom "struct" :: List.map ~f:(fun f -> List [ Atom "field"; field_type f ]) l)
-  | Array ty -> List [ Atom "array"; field_type ty ]
+      List
+        (Atom "struct" :: List.map ~f:(fun f -> List [ Atom "field"; field_type st f ]) l)
+  | Array ty -> List [ Atom "array"; field_type st ty ]
 
 let block_type = func_type
 
@@ -209,7 +291,7 @@ let float64 _ f = Printf.sprintf "%h" f (*ZZZ*)
 
 let float32 _ f = Printf.sprintf "%h" f (*ZZZ*)
 
-let expression_or_instructions ctx in_function =
+let expression_or_instructions ctx st in_function =
   let rec expression e =
     match e with
     | Const op ->
@@ -261,95 +343,113 @@ let expression_or_instructions ctx in_function =
              :: select offs offs offs offs offset
             @ expression e')
         ]
-    | LocalGet i -> [ List [ Atom "local.get"; index i ] ]
-    | LocalTee (i, e') -> [ List (Atom "local.tee" :: index i :: expression e') ]
-    | GlobalGet nm -> [ List [ Atom "global.get"; symbol nm ] ]
-    | BlockExpr (ty, l) -> [ List (Atom "block" :: (block_type ty @ instructions l)) ]
+    | LocalGet i -> [ List [ Atom "local.get"; index st.local_names i ] ]
+    | LocalTee (i, e') ->
+        [ List (Atom "local.tee" :: index st.local_names i :: expression e') ]
+    | GlobalGet nm -> [ List [ Atom "global.get"; symbol st nm ] ]
+    | BlockExpr (ty, l) -> [ List (Atom "block" :: (block_type st ty @ instructions l)) ]
     | Call_indirect (typ, e, l) ->
         [ List
-            ((Atom "call_indirect" :: func_type typ)
+            ((Atom "call_indirect" :: func_type st typ)
             @ List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | Call (f, l) ->
-        [ List (Atom "call" :: index f :: List.concat (List.map ~f:expression l)) ]
+        [ List
+            (Atom "call"
+            :: index st.func_names f
+            :: List.concat (List.map ~f:expression l))
+        ]
     | MemoryGrow (_, e) -> [ List (Atom "memory.grow" :: expression e) ]
     | Seq (l, e) -> instructions l @ expression e
     | Pop ty -> (
         match target with
-        | `Binaryen -> [ List [ Atom "pop"; value_type ty ] ]
+        | `Binaryen -> [ List [ Atom "pop"; value_type st ty ] ]
         | `Reference -> [])
     | RefFunc symb ->
         if in_function then reference_function ctx symb;
-        [ List [ Atom "ref.func"; index symb ] ]
+        [ List [ Atom "ref.func"; index st.func_names symb ] ]
     | Call_ref (f, e, l) ->
         [ List
             (Atom "call_ref"
-            :: index f
+            :: index st.type_names f
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | RefI31 e -> [ List (Atom "ref.i31" :: expression e) ]
     | I31Get (s, e) -> [ List (Atom (signage "i31.get" s) :: expression e) ]
     | ArrayNew (typ, e, e') ->
-        [ List (Atom "array.new" :: index typ :: (expression e @ expression e')) ]
+        [ List
+            (Atom "array.new" :: index st.type_names typ :: (expression e @ expression e'))
+        ]
     | ArrayNewFixed (typ, l) ->
         [ List
             (Atom "array.new_fixed"
-            :: index typ
+            :: index st.type_names typ
             :: Atom (string_of_int (List.length l))
             :: List.concat (List.map ~f:expression l))
         ]
     | ArrayNewData (typ, data, e, e') ->
         [ List
             (Atom "array.new_data"
-            :: index typ
-            :: index data
+            :: index st.type_names typ
+            :: index st.data_names data
             :: (expression e @ expression e'))
         ]
     | ArrayGet (None, typ, e, e') ->
-        [ List (Atom "array.get" :: index typ :: (expression e @ expression e')) ]
+        [ List
+            (Atom "array.get" :: index st.type_names typ :: (expression e @ expression e'))
+        ]
     | ArrayGet (Some s, typ, e, e') ->
         [ List
-            (Atom (signage "array.get" s) :: index typ :: (expression e @ expression e'))
+            (Atom (signage "array.get" s)
+            :: index st.type_names typ
+            :: (expression e @ expression e'))
         ]
     | ArrayLen e -> [ List (Atom "array.len" :: expression e) ]
     | StructNew (typ, l) ->
-        [ List (Atom "struct.new" :: index typ :: List.concat (List.map ~f:expression l))
+        [ List
+            (Atom "struct.new"
+            :: index st.type_names typ
+            :: List.concat (List.map ~f:expression l))
         ]
     | StructGet (None, typ, i, e) ->
-        [ List (Atom "struct.get" :: index typ :: Atom (string_of_int i) :: expression e)
+        [ List
+            (Atom "struct.get"
+            :: index st.type_names typ
+            :: Atom (string_of_int i)
+            :: expression e)
         ]
     | StructGet (Some s, typ, i, e) ->
         [ List
             (Atom (signage "struct.get" s)
-            :: index typ
+            :: index st.type_names typ
             :: Atom (string_of_int i)
             :: expression e)
         ]
-    | RefCast (ty, e) -> [ List (Atom "ref.cast" :: ref_type ty :: expression e) ]
-    | RefTest (ty, e) -> [ List (Atom "ref.test" :: ref_type ty :: expression e) ]
+    | RefCast (ty, e) -> [ List (Atom "ref.cast" :: ref_type st ty :: expression e) ]
+    | RefTest (ty, e) -> [ List (Atom "ref.test" :: ref_type st ty :: expression e) ]
     | RefEq (e, e') -> [ List (Atom "ref.eq" :: (expression e @ expression e')) ]
-    | RefNull ty -> [ List [ Atom "ref.null"; heap_type ty ] ]
+    | RefNull ty -> [ List [ Atom "ref.null"; heap_type st ty ] ]
     | Br_on_cast (i, ty, ty', e) ->
         [ List
             (Atom "br_on_cast"
             :: Atom (string_of_int i)
-            :: ref_type ty
-            :: ref_type ty'
+            :: ref_type st ty
+            :: ref_type st ty'
             :: expression e)
         ]
     | Br_on_cast_fail (i, ty, ty', e) ->
         [ List
             (Atom "br_on_cast_fail"
             :: Atom (string_of_int i)
-            :: ref_type ty
-            :: ref_type ty'
+            :: ref_type st ty
+            :: ref_type st ty'
             :: expression e)
         ]
     | ExternInternalize e -> [ List (Atom "extern.internalize" :: expression e) ]
     | ExternExternalize e -> [ List (Atom "extern.externalize" :: expression e) ]
     | IfExpr (ty, cond, ift, iff) ->
         [ List
-            ((Atom "if" :: block_type { params = []; result = [ ty ] })
+            ((Atom "if" :: block_type st { params = []; result = [ ty ] })
             @ expression cond
             @ [ List (Atom "then" :: expression ift) ]
             @ [ List (Atom "else" :: expression iff) ])
@@ -374,14 +474,15 @@ let expression_or_instructions ctx in_function =
             :: (select offs offs offs offs offset @ expression e1 @ expression e2))
         ]
     | LocalSet (i, Seq (l, e)) -> instructions (l @ [ LocalSet (i, e) ])
-    | LocalSet (i, e) -> [ List (Atom "local.set" :: index i :: expression e) ]
-    | GlobalSet (nm, e) -> [ List (Atom "global.set" :: symbol nm :: expression e) ]
-    | Loop (ty, l) -> [ List (Atom "loop" :: (block_type ty @ instructions l)) ]
-    | Block (ty, l) -> [ List (Atom "block" :: (block_type ty @ instructions l)) ]
+    | LocalSet (i, e) ->
+        [ List (Atom "local.set" :: index st.local_names i :: expression e) ]
+    | GlobalSet (nm, e) -> [ List (Atom "global.set" :: symbol st nm :: expression e) ]
+    | Loop (ty, l) -> [ List (Atom "loop" :: (block_type st ty @ instructions l)) ]
+    | Block (ty, l) -> [ List (Atom "block" :: (block_type st ty @ instructions l)) ]
     | If (ty, e, l1, l2) ->
         [ List
             (Atom "if"
-            :: (block_type ty
+            :: (block_type st ty
                @ expression e
                @ list ~always:true "then" instructions (remove_nops l1)
                @ list "else" instructions (remove_nops l2)))
@@ -389,11 +490,11 @@ let expression_or_instructions ctx in_function =
     | Try (ty, body, catches, catch_all) ->
         [ List
             (Atom "try"
-            :: (block_type ty
+            :: (block_type st ty
                @ List (Atom "do" :: instructions body)
                  :: (List.map
                        ~f:(fun (tag, l) ->
-                         List (Atom "catch" :: index tag :: instructions l))
+                         List (Atom "catch" :: index st.tag_names tag :: instructions l))
                        catches
                     @
                     match catch_all with
@@ -424,36 +525,44 @@ let expression_or_instructions ctx in_function =
             | None -> []
             | Some e -> expression e))
         ]
-    | Throw (tag, e) -> [ List (Atom "throw" :: index tag :: expression e) ]
+    | Throw (tag, e) -> [ List (Atom "throw" :: index st.tag_names tag :: expression e) ]
     | Rethrow i -> [ List [ Atom "rethrow"; Atom (string_of_int i) ] ]
     | CallInstr (f, l) ->
-        [ List (Atom "call" :: index f :: List.concat (List.map ~f:expression l)) ]
+        [ List
+            (Atom "call"
+            :: index st.func_names f
+            :: List.concat (List.map ~f:expression l))
+        ]
     | Nop -> []
     | Push e -> expression e
     | ArraySet (typ, e, e', e'') ->
         [ List
             (Atom "array.set"
-            :: index typ
+            :: index st.type_names typ
             :: (expression e @ expression e' @ expression e''))
         ]
     | StructSet (typ, i, e, e') ->
         [ List
             (Atom "struct.set"
-            :: index typ
+            :: index st.type_names typ
             :: Atom (string_of_int i)
             :: (expression e @ expression e'))
         ]
     | Return_call_indirect (typ, e, l) ->
         [ List
-            ((Atom "return_call_indirect" :: func_type typ)
+            ((Atom "return_call_indirect" :: func_type st typ)
             @ List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | Return_call (f, l) ->
-        [ List (Atom "return_call" :: index f :: List.concat (List.map ~f:expression l)) ]
+        [ List
+            (Atom "return_call"
+            :: index st.func_names f
+            :: List.concat (List.map ~f:expression l))
+        ]
     | Return_call_ref (typ, e, l) ->
         [ List
             (Atom "return_call_ref"
-            :: index typ
+            :: index st.type_names typ
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | Location (loc, i) -> (
@@ -466,18 +575,29 @@ let expression_or_instructions ctx in_function =
   and instructions l = List.concat (List.map ~f:instruction l) in
   expression, instructions
 
-let expression ctx = fst (expression_or_instructions ctx false)
+let expression ctx st = fst (expression_or_instructions ctx st false)
 
-let instructions ctx = snd (expression_or_instructions ctx true)
+let instructions ctx st = snd (expression_or_instructions ctx st true)
 
-let funct ctx name exported_name typ param_names locals body =
+let funct ctx st name exported_name typ param_names locals body =
+  let st =
+    { st with
+      local_names =
+        assign_names
+          ~reversed:false
+          Code.Var.get_name
+          (param_names @ List.map ~f:fst locals)
+    }
+  in
   List
-    ((Atom "func" :: index name :: export exported_name)
-    @ func_type ~param_names typ
-    @ List.map ~f:(fun (i, t) -> List [ Atom "local"; index i; value_type t ]) locals
-    @ instructions ctx body)
-
-let import f =
+    ((Atom "func" :: index st.func_names name :: export exported_name)
+    @ func_type st ~param_names typ
+    @ List.map
+        ~f:(fun (i, t) -> List [ Atom "local"; index st.local_names i; value_type st t ])
+        locals
+    @ instructions ctx st body)
+
+let import st f =
   match f with
   | Function _ | Global _ | Data _ | Tag _ | Type _ -> []
   | Import { import_module; import_name; name; desc } ->
@@ -487,9 +607,13 @@ let import f =
           ; quoted_name import_name
           ; List
               (match desc with
-              | Fun typ -> Atom "func" :: index name :: func_type typ
-              | Global ty -> [ Atom "global"; index name; global_type ty ]
-              | Tag ty -> [ Atom "tag"; index name; List [ Atom "param"; value_type ty ] ])
+              | Fun typ -> Atom "func" :: index st.func_names name :: func_type st typ
+              | Global ty -> [ Atom "global"; symbol st (V name); global_type st ty ]
+              | Tag ty ->
+                  [ Atom "tag"
+                  ; index st.tag_names name
+                  ; List [ Atom "param"; value_type st ty ]
+                  ])
           ]
       ]
 
@@ -518,43 +642,53 @@ let data_contents ctx contents =
     contents;
   escape_string (Buffer.contents b)
 
-let type_field { name; typ; supertype; final } =
+let type_field st { name; typ; supertype; final } =
   if final && Option.is_none supertype
-  then List [ Atom "type"; index name; str_type typ ]
+  then List [ Atom "type"; index st.type_names name; str_type st typ ]
   else
     List
       [ Atom "type"
-      ; index name
+      ; index st.type_names name
       ; List
           (Atom "sub"
           :: ((if final then [ Atom "final" ] else [])
              @ (match supertype with
-               | Some supertype -> [ index supertype ]
+               | Some supertype -> [ index st.type_names supertype ]
                | None -> [])
-             @ [ str_type typ ]))
+             @ [ str_type st typ ]))
       ]
 
-let field ctx f =
+let field ctx st f =
   match f with
   | Function { name; exported_name; typ; param_names; locals; body } ->
-      [ funct ctx name exported_name typ param_names locals body ]
+      [ funct ctx st name exported_name typ param_names locals body ]
   | Global { name; typ; init } ->
-      [ List (Atom "global" :: symbol name :: global_type typ :: expression ctx init) ]
+      [ List
+          (Atom "global" :: symbol st name :: global_type st typ :: expression ctx st init)
+      ]
   | Tag { name; typ } ->
-      [ List [ Atom "tag"; index name; List [ Atom "param"; value_type typ ] ] ]
+      [ List
+          [ Atom "tag"
+          ; index st.tag_names name
+          ; List [ Atom "param"; value_type st typ ]
+          ]
+      ]
   | Import _ -> []
   | Data { name; active; contents; _ } ->
       [ List
           (Atom "data"
-          :: index name
+          :: index st.data_names name
           :: ((if active
                then
-                 expression ctx (Const (I32 (Int32.of_int (lookup_symbol ctx (V name)))))
+                 expression
+                   ctx
+                   st
+                   (Const (I32 (Int32.of_int (lookup_symbol ctx (V name)))))
                else [])
              @ [ Atom ("\"" ^ data_contents ctx contents ^ "\"") ]))
       ]
-  | Type [ t ] -> [ type_field t ]
-  | Type l -> [ List (Atom "rec" :: List.map ~f:type_field l) ]
+  | Type [ t ] -> [ type_field st t ]
+  | Type l -> [ List (Atom "rec" :: List.map ~f:(type_field st) l) ]
 
 let data_size contents =
   List.fold_left
@@ -583,6 +717,7 @@ let data_offsets fields =
     fields
 
 let f ~debug ch fields =
+  let st = build_name_tables fields in
   let heap_base, addresses = data_offsets fields in
   let ctx =
     { addresses
@@ -592,7 +727,7 @@ let f ~debug ch fields =
     ; debug
     }
   in
-  let other_fields = List.concat (List.map ~f:(fun f -> field ctx f) fields) in
+  let other_fields = List.concat (List.map ~f:(fun f -> field ctx st f) fields) in
   let funct_table =
     let functions =
       List.map
@@ -607,7 +742,7 @@ let f ~debug ch fields =
       [ List
           [ Atom "table"
           ; Atom "funcref"
-          ; List (Atom "elem" :: List.map ~f:index functions)
+          ; List (Atom "elem" :: List.map ~f:(index st.func_names) functions)
           ]
       ]
   in
@@ -621,7 +756,11 @@ let f ~debug ch fields =
     if List.is_empty functions
     then []
     else
-      [ List (Atom "elem" :: Atom "declare" :: Atom "func" :: List.map ~f:index functions)
+      [ List
+          (Atom "elem"
+          :: Atom "declare"
+          :: Atom "func"
+          :: List.map ~f:(index st.func_names) functions)
       ]
   in
   Format.fprintf
@@ -630,7 +769,7 @@ let f ~debug ch fields =
     format_sexp
     (List
        (Atom "module"
-       :: (List.concat (List.map ~f:import fields)
+       :: (List.concat (List.map ~f:(fun i -> import st i) fields)
           @ (if Code.Var.Map.is_empty addresses
              then []
              else

From 753732ef810ee002128bb74b645bad4e1064e525 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 14:48:26 +0100
Subject: [PATCH 232/481] Source map fixes and improvements

- more options
- do not keep temp files
- use a relative path as a sourcemap url
---
 compiler/bin-js_of_ocaml/compile.ml    |   2 +-
 compiler/bin-wasm_of_ocaml/cmd_arg.ml  |  51 ++++++--
 compiler/bin-wasm_of_ocaml/cmd_arg.mli |   3 +
 compiler/bin-wasm_of_ocaml/compile.ml  | 162 +++++++++++++++++--------
 4 files changed, 158 insertions(+), 60 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 8a7e584e3f..312e535bcd 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -53,7 +53,7 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f
               let data = Source_map_io.to_string sm in
               "data:application/json;base64," ^ Base64.encode_exn data
           | Some output_file ->
-              Source_map_io.to_file sm output_file;
+              Source_map_io.to_file sm ~file:output_file;
               Filename.basename output_file
         in
         Pretty_print.newline fmt;
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index 83a2010a1a..f2e12cfd3d 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -21,6 +21,24 @@ open! Js_of_ocaml_compiler.Stdlib
 open Js_of_ocaml_compiler
 open Cmdliner
 
+let is_dir_sep = function
+  | '/' -> true
+  | '\\' when String.equal Filename.dir_sep "\\" -> true
+  | _ -> false
+
+let trim_trailing_dir_sep s =
+  if String.equal s ""
+  then s
+  else
+    let len = String.length s in
+    let j = ref (len - 1) in
+    while !j >= 0 && is_dir_sep (String.unsafe_get s !j) do
+      decr j
+    done;
+    if !j >= 0 then String.sub s ~pos:0 ~len:(!j + 1) else String.sub s ~pos:0 ~len:1
+
+let normalize_include_dirs dirs = List.map dirs ~f:trim_trailing_dir_sep
+
 type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
@@ -29,7 +47,10 @@ type t =
   ; output_file : string * bool
   ; input_file : string
   ; enable_source_maps : bool
+  ; sourcemap_root : string option
+  ; sourcemap_don't_inline_content : bool
   ; params : (string * string) list
+  ; include_dirs : string list
   }
 
 let options =
@@ -55,12 +76,16 @@ let options =
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
   in
   let sourcemap =
-    let doc = "Output source locations in a separate sourcemap file." in
-    Arg.(value & flag & info [ "sourcemap"; "source-map" ] ~doc)
+    let doc = "Output source locations." in
+    Arg.(value & flag & info [ "sourcemap"; "source-map"; "source-map-inline" ] ~doc)
   in
-  let sourcemap_inline_in_js =
-    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
-    Arg.(value & flag & info [ "source-map-inline" ] ~doc)
+  let sourcemap_don't_inline_content =
+    let doc = "Do not inline sources in source map." in
+    Arg.(value & flag & info [ "source-map-no-source" ] ~doc)
+  in
+  let sourcemap_root =
+    let doc = "root dir for source map." in
+    Arg.(value & opt (some string) None & info [ "source-map-root" ] ~doc)
   in
   let set_param =
     let doc = "Set compiler options." in
@@ -70,13 +95,19 @@ let options =
       & opt_all (list (pair ~sep:'=' (enum all) string)) []
       & info [ "set" ] ~docv:"PARAM=VALUE" ~doc)
   in
+  let include_dirs =
+    let doc = "Add [$(docv)] to the list of include directories." in
+    Arg.(value & opt_all string [] & info [ "I" ] ~docv:"DIR" ~doc)
+  in
   let build_t
       common
       set_param
+      include_dirs
       profile
       sourcemap
       no_sourcemap
-      _
+      sourcemap_don't_inline_content
+      sourcemap_root
       output_file
       input_file
       runtime_files =
@@ -88,14 +119,18 @@ let options =
     in
     let params : (string * string) list = List.flatten set_param in
     let enable_source_maps = (not no_sourcemap) && sourcemap in
+    let include_dirs = normalize_include_dirs include_dirs in
     `Ok
       { common
       ; params
+      ; include_dirs
       ; profile
       ; output_file
       ; input_file
       ; runtime_files
       ; enable_source_maps
+      ; sourcemap_root
+      ; sourcemap_don't_inline_content
       }
   in
   let t =
@@ -103,10 +138,12 @@ let options =
       const build_t
       $ Jsoo_cmdline.Arg.t
       $ set_param
+      $ include_dirs
       $ profile
       $ sourcemap
       $ no_sourcemap
-      $ sourcemap_inline_in_js
+      $ sourcemap_don't_inline_content
+      $ sourcemap_root
       $ output_file
       $ input_file
       $ runtime_files)
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
index d5224169bd..fd9de45dd5 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.mli
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
@@ -27,7 +27,10 @@ type t =
   ; output_file : string * bool
   ; input_file : string
   ; enable_source_maps : bool
+  ; sourcemap_root : string option
+  ; sourcemap_don't_inline_content : bool
   ; params : (string * string) list
+  ; include_dirs : string list
   }
 
 val options : t Cmdliner.Term.t
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 7327b2e56b..4b5bca9438 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -48,6 +48,11 @@ let gen_file file f =
     (try Sys.remove f_tmp with Sys_error _ -> ());
     raise exc
 
+let opt_with action x f =
+  match x with
+  | None -> f None
+  | Some x -> action x (fun y -> f (Some y))
+
 let write_file name contents =
   let ch = open_out name in
   output_string ch contents;
@@ -56,10 +61,10 @@ let write_file name contents =
 let remove_file filename =
   try if Sys.file_exists filename then Sys.remove filename with Sys_error _msg -> ()
 
-let with_intermediate_file ?(keep = false) name f =
+let with_intermediate_file name f =
   match f name with
   | res ->
-      if not keep then remove_file name;
+      remove_file name;
       res
   | exception e ->
       remove_file name;
@@ -84,7 +89,12 @@ let common_binaryen_options () =
   in
   if Config.Flag.pretty () then "-g" :: l else l
 
-let link ~enable_source_maps runtime_files input_file output_file =
+let opt_flag flag v =
+  match v with
+  | None -> []
+  | Some v -> [ flag; Filename.quote v ]
+
+let link runtime_files input_file opt_output_sourcemap output_file =
   command
     ("wasm-merge"
     :: (common_binaryen_options ()
@@ -93,10 +103,7 @@ let link ~enable_source_maps runtime_files input_file output_file =
               ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ])
               runtime_files)
        @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ]
-       @
-       if enable_source_maps
-       then [ "--output-source-map"; Filename.quote (output_file ^ ".map") ]
-       else []))
+       @ opt_flag "--output-source-map" opt_output_sourcemap))
 
 let generate_dependencies primitives =
   Yojson.Basic.to_string
@@ -124,7 +131,7 @@ let filter_unused_primitives primitives usage_file =
    with End_of_file -> ());
   !s
 
-let dead_code_elimination ~enable_source_maps in_file out_file =
+let dead_code_elimination ~opt_input_sourcemap ~opt_output_sourcemap in_file out_file =
   with_intermediate_file (Filename.temp_file "deps" ".json")
   @@ fun deps_file ->
   with_intermediate_file (Filename.temp_file "usage" ".txt")
@@ -135,13 +142,9 @@ let dead_code_elimination ~enable_source_maps in_file out_file =
     ("wasm-metadce"
     :: (common_binaryen_options ()
        @ [ "--graph-file"; Filename.quote deps_file; Filename.quote in_file ]
-       @ (if enable_source_maps
-          then [ "--input-source-map"; Filename.quote (in_file ^ ".map") ]
-          else [])
+       @ opt_flag "--input-source-map" opt_input_sourcemap
        @ [ "-o"; Filename.quote out_file ]
-       @ (if enable_source_maps
-          then [ "--output-source-map"; Filename.quote (out_file ^ ".map") ]
-          else [])
+       @ opt_flag "--output-source-map" opt_output_sourcemap
        @ [ ">"; Filename.quote usage_file ]));
   filter_unused_primitives primitives usage_file
 
@@ -151,7 +154,13 @@ let optimization_options =
    ; [ "-O3"; "--traps-never-happen" ]
   |]
 
-let optimize ~profile ?sourcemap_file in_file out_file =
+let optimize
+    ~profile
+    ~opt_input_sourcemap
+    ~opt_output_sourcemap
+    ~opt_sourcemap_url
+    in_file
+    out_file =
   let level =
     match profile with
     | None -> 1
@@ -162,51 +171,88 @@ let optimize ~profile ?sourcemap_file in_file out_file =
      :: (common_binaryen_options ()
         @ optimization_options.(level - 1)
         @ [ Filename.quote in_file; "-o"; Filename.quote out_file ])
-    @
-    match sourcemap_file with
-    | Some sourcemap_file ->
-        [ "--input-source-map"
-        ; Filename.quote (in_file ^ ".map")
-        ; "--output-source-map"
-        ; Filename.quote sourcemap_file
-        ; "--output-source-map-url"
-        ; Filename.quote sourcemap_file
-        ]
-    | None -> [])
+    @ opt_flag "--input-source-map" opt_input_sourcemap
+    @ opt_flag "--output-source-map" opt_output_sourcemap
+    @ opt_flag "--output-source-map-url" opt_sourcemap_url)
+
+let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_file =
+  if Option.is_some sourcemap_root || not sourcemap_don't_inline_content
+  then (
+    let open Source_map in
+    let source_map, mappings = Source_map_io.of_file_no_mappings sourcemap_file in
+    assert (List.is_empty (Option.value source_map.sources_content ~default:[]));
+    (* Add source file contents to source map *)
+    let sources_content =
+      if sourcemap_don't_inline_content
+      then None
+      else
+        Some
+          (List.map source_map.sources ~f:(fun file ->
+               if Sys.file_exists file && not (Sys.is_directory file)
+               then Some (Fs.read_file file)
+               else None))
+    in
+    let source_map =
+      { source_map with
+        sources_content
+      ; sourceroot =
+          (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot)
+      }
+    in
+    Source_map_io.to_file ?mappings source_map ~file:sourcemap_file)
 
-let link_and_optimize ~profile ?sourcemap_file runtime_wasm_files wat_file output_file =
-  let sourcemap_file =
+let link_and_optimize
+    ~profile
+    ~sourcemap_root
+    ~sourcemap_don't_inline_content
+    ~opt_sourcemap
+    ~opt_sourcemap_url
+    runtime_wasm_files
+    wat_file
+    output_file =
+  let opt_sourcemap_file =
     (* Check that Binaryen supports the necessary sourcemaps options (requires
        version >= 118) *)
-    match sourcemap_file with
+    match opt_sourcemap with
     | Some _ when Sys.command "wasm-merge -osm foo 2> /dev/null" <> 0 -> None
-    | Some _ | None -> sourcemap_file
+    | Some _ | None -> opt_sourcemap
   in
-  let enable_source_maps = Option.is_some sourcemap_file in
+  let enable_source_maps = Option.is_some opt_sourcemap_file in
   with_intermediate_file (Filename.temp_file "runtime" ".wasm")
   @@ fun runtime_file ->
   write_file runtime_file Wa_runtime.wasm_runtime;
   with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
   @@ fun temp_file ->
-  link ~enable_source_maps (runtime_file :: runtime_wasm_files) wat_file temp_file;
+  opt_with
+    with_intermediate_file
+    (if enable_source_maps
+     then Some (Filename.temp_file "wasm-merged" ".wasm.map")
+     else None)
+  @@ fun opt_temp_sourcemap ->
+  link (runtime_file :: runtime_wasm_files) wat_file opt_temp_sourcemap temp_file;
   with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
   @@ fun temp_file' ->
-  let primitives = dead_code_elimination ~enable_source_maps temp_file temp_file' in
-  optimize ~profile ?sourcemap_file temp_file' output_file;
-  (* Add source file contents to source map *)
-  Option.iter sourcemap_file ~f:(fun sourcemap_file ->
-      let open Source_map in
-      let source_map, mappings = Source_map_io.of_file_no_mappings sourcemap_file in
-      assert (List.is_empty (Option.value source_map.sources_content ~default:[]));
-      let sources_content =
-        Some
-          (List.map source_map.sources ~f:(fun file ->
-               if Sys.file_exists file && not (Sys.is_directory file)
-               then Some (Fs.read_file file)
-               else None))
-      in
-      let source_map = { source_map with sources_content } in
-      Source_map_io.to_file ?mappings source_map ~file:sourcemap_file);
+  opt_with
+    with_intermediate_file
+    (if enable_source_maps then Some (Filename.temp_file "wasm-dce" ".wasm.map") else None)
+  @@ fun opt_temp_sourcemap' ->
+  let primitives =
+    dead_code_elimination
+      ~opt_input_sourcemap:opt_temp_sourcemap
+      ~opt_output_sourcemap:opt_temp_sourcemap'
+      temp_file
+      temp_file'
+  in
+  optimize
+    ~profile
+    ~opt_input_sourcemap:opt_temp_sourcemap'
+    ~opt_output_sourcemap:opt_sourcemap
+    ~opt_sourcemap_url
+    temp_file'
+    output_file;
+  Option.iter
+    ~f:(update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content)
+    opt_sourcemap_file;
   primitives
 
 let escape_string s =
@@ -322,6 +368,9 @@ let run
     ; output_file
     ; enable_source_maps
     ; params
+    ; include_dirs
+    ; sourcemap_root
+    ; sourcemap_don't_inline_content
     } =
   Jsoo_cmdline.Arg.eval common;
   Wa_generate.init ();
@@ -329,7 +378,9 @@ let run
   if debug_mem () then Debug.start_profiling output_file;
   List.iter params ~f:(fun (s, v) -> Config.Param.set s v);
   let t = Timer.make () in
-  let include_dirs = List.filter_map [ "+stdlib/" ] ~f:(fun d -> Findlib.find [] d) in
+  let include_dirs =
+    List.filter_map (include_dirs @ [ "+stdlib/" ]) ~f:(fun d -> Findlib.find [] d)
+  in
   let runtime_wasm_files, runtime_js_files =
     List.partition runtime_files ~f:(fun name ->
         List.exists
@@ -359,7 +410,7 @@ let run
   Linker.check_deps ();
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
-  let need_debug = Config.Flag.debuginfo () in
+  let need_debug = enable_source_maps || Config.Flag.debuginfo () in
   let output (one : Parse_bytecode.one) ~standalone ch =
     let code = one.code in
     let live_vars, in_cps, p, debug =
@@ -411,12 +462,19 @@ let run
        in
        gen_file wasm_file
        @@ fun tmp_wasm_file ->
+       opt_with gen_file (if enable_source_maps then Some (wasm_file ^ ".map") else None)
+       @@ fun opt_tmp_sourcemap ->
        let strings = output_gen wat_file (output code ~standalone:true) in
        let primitives =
          link_and_optimize
            ~profile
-           ?sourcemap_file:
-             (if enable_source_maps then Some (wasm_file ^ ".map") else None)
+           ~sourcemap_root
+           ~sourcemap_don't_inline_content
+           ~opt_sourcemap:opt_tmp_sourcemap
+           ~opt_sourcemap_url:
+             (if enable_source_maps
+              then Some (Filename.basename wasm_file ^ ".map")
+              else None)
            runtime_wasm_files
            wat_file
            tmp_wasm_file

From 2188fc76d61cef85adb9f9a687fd12770fa4b900 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 09:28:48 +0100
Subject: [PATCH 233/481] Minify runtime

---
 compiler/bin-wasm_of_ocaml/compile.ml | 202 +++++++++++++++-----------
 runtime/wasm/runtime.js               |  16 +-
 2 files changed, 123 insertions(+), 95 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 4b5bca9438..c2bb0b8a8e 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -255,25 +255,94 @@ let link_and_optimize
     opt_sourcemap_file;
   primitives
 
-let escape_string s =
-  let l = String.length s in
-  let b = Buffer.create (String.length s + 2) in
-  for i = 0 to l - 1 do
-    let c = s.[i] in
-    match c with
-    (* https://github.com/ocsigen/js_of_ocaml/issues/898 *)
-    | '/' when i > 0 && Char.equal s.[i - 1] '<' -> Buffer.add_string b "\\/"
-    | '\000' .. '\031' | '\127' ->
-        Buffer.add_string b "\\x";
-        Buffer.add_char_hex b c
-    | '"' ->
-        Buffer.add_char b '\\';
-        Buffer.add_char b c
-    | c -> Buffer.add_char b c
-  done;
+let build_runtime_arguments ~wasm_file ~generated_js:(strings, fragments) =
+  let obj l =
+    Javascript.EObj
+      (List.map
+         ~f:(fun (nm, v) ->
+           let id = Utf8_string.of_string_exn nm in
+           Javascript.Property (PNS id, v))
+         l)
+  in
+  let generated_js =
+    let strings =
+      if List.is_empty strings
+      then []
+      else
+        [ ( "strings"
+          , Javascript.EArr
+              (List.map
+                 ~f:(fun s -> Javascript.Element (EStr (Utf8_string.of_string_exn s)))
+                 strings) )
+        ]
+    in
+    let fragments =
+      if List.is_empty fragments then [] else [ "fragments", obj fragments ]
+    in
+    strings @ fragments
+  in
+  let generated_js =
+    if List.is_empty generated_js
+    then obj generated_js
+    else
+      let var ident e =
+        Javascript.variable_declaration [ Javascript.ident ident, (e, N) ], Javascript.N
+      in
+      Javascript.call
+        (EArrow
+           ( Javascript.fun_
+               [ Javascript.ident Constant.global_object_ ]
+               [ var
+                   Constant.old_global_object_
+                   (EVar (Javascript.ident Constant.global_object_))
+               ; var
+                   Constant.exports_
+                   (EBin
+                      ( Or
+                      , EDot
+                          ( EDot
+                              ( EVar (Javascript.ident Constant.global_object_)
+                              , ANullish
+                              , Utf8_string.of_string_exn "module" )
+                          , ANullish
+                          , Utf8_string.of_string_exn "export" )
+                      , EVar (Javascript.ident Constant.global_object_) ))
+               ; Return_statement (Some (obj generated_js)), N
+               ]
+               N
+           , AUnknown ))
+        [ EVar (Javascript.ident Constant.global_object_) ]
+        N
+  in
+  obj
+    [ "generated", generated_js
+    ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_file))
+    ]
+
+let output_js js =
+  Code.Var.reset ();
+  let b = Buffer.create 1024 in
+  let f = Pretty_print.to_buffer b in
+  Driver.configure f;
+  let traverse = new Js_traverse.free in
+  let js = traverse#program js in
+  let free = traverse#get_free in
+  Javascript.IdentSet.iter
+    (fun x ->
+      match x with
+      | V _ -> assert false
+      | S { name = Utf8 x; _ } -> Var_printer.add_reserved x)
+    free;
+  let js =
+    if Config.Flag.shortvar () then (new Js_traverse.rename_variable)#program js else js
+  in
+  let js = (new Js_traverse.simpl)#program js in
+  let js = (new Js_traverse.clean)#program js in
+  let js = Js_assign.program js in
+  ignore (Js_output.program f js);
   Buffer.contents b
 
-let build_js_runtime primitives (strings, fragments) wasm_file output_file =
+let build_js_runtime ~primitives ~runtime_arguments =
   let always_required_js, primitives =
     let l =
       StringSet.fold
@@ -290,75 +359,26 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
     | Some x -> x
     | None -> assert false
   in
-  let b = Buffer.create 1024 in
-  let f = Pretty_print.to_buffer b in
-  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
-  ignore (Js_output.program f always_required_js);
-  let b' = Buffer.create 1024 in
-  let f = Pretty_print.to_buffer b' in
-  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
-  ignore (Js_output.program f [ primitives ]);
-  let b'' = Buffer.create 1024 in
-  let f = Pretty_print.to_buffer b'' in
-  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
-  ignore
-    (Js_output.program
-       f
-       [ ( Javascript.Expression_statement
-             (EArr
-                (List.map
-                   ~f:(fun s -> Javascript.Element (EStr (Utf8_string.of_string_exn s)))
-                   strings))
-         , Javascript.N )
-       ]);
-  let fragment_buffer = Buffer.create 1024 in
-  let f = Pretty_print.to_buffer fragment_buffer in
-  Pretty_print.set_compact f (not (Config.Flag.pretty ()));
-  ignore
-    (Js_output.program
-       f
-       [ ( Javascript.Expression_statement
-             (EObj
-                (List.map
-                   ~f:(fun (nm, f) ->
-                     let id = Utf8_string.of_string_exn nm in
-                     Javascript.Property (PNI id, f))
-                   fragments))
-         , Javascript.N )
-       ]);
-  let s = Wa_runtime.js_runtime in
-  let rec find pat i =
-    if String.equal (String.sub s ~pos:i ~len:(String.length pat)) pat
-    then i
-    else find pat (i + 1)
+  let primitives =
+    match primitives with
+    | Javascript.Expression_statement e, N -> e
+    | _ -> assert false
   in
-  let i = find "CODE" 0 in
-  let j = find "PRIMITIVES" 0 in
-  let k = find "STRINGS" 0 in
-  let l = find "FRAGMENTS" 0 in
-  let rec trim_semi s =
-    let l = String.length s in
-    if l = 0
-    then s
-    else
-      match s.[l - 1] with
-      | ';' | '\n' -> trim_semi (String.sub s ~pos:0 ~len:(l - 1))
-      | _ -> s
+  let prelude = output_js always_required_js in
+  let init_fun =
+    match Parse_js.parse (Parse_js.Lexer.of_string Wa_runtime.js_runtime) with
+    | [ (Expression_statement f, _) ] -> f
+    | _ -> assert false
+  in
+  let launcher =
+    let js =
+      let js = Javascript.call init_fun [ primitives ] N in
+      let js = Javascript.call js [ runtime_arguments ] N in
+      [ Javascript.Expression_statement js, Javascript.N ]
+    in
+    output_js js
   in
-  gen_file output_file
-  @@ fun tmp_output_file ->
-  write_file
-    tmp_output_file
-    (Buffer.contents b
-    ^ String.sub s ~pos:0 ~len:i
-    ^ escape_string (Filename.basename wasm_file)
-    ^ String.sub s ~pos:(i + 4) ~len:(j - i - 4)
-    ^ trim_semi (Buffer.contents b')
-    ^ String.sub s ~pos:(j + 10) ~len:(k - j - 10)
-    ^ trim_semi (Buffer.contents b'')
-    ^ String.sub s ~pos:(k + 7) ~len:(l - k - 7)
-    ^ trim_semi (Buffer.contents fragment_buffer)
-    ^ String.sub s ~pos:(l + 9) ~len:(String.length s - l - 9))
+  prelude ^ launcher
 
 let run
     { Cmd_arg.common
@@ -423,9 +443,9 @@ let run
         one.debug
         code
     in
-    let strings = Wa_generate.f ch ~debug ~live_vars ~in_cps p in
+    let generated_js = Wa_generate.f ch ~debug ~live_vars ~in_cps p in
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
-    strings
+    generated_js
   in
   (let kind, ic, close_ic, include_dirs =
      let ch = open_in_bin input_file in
@@ -464,7 +484,7 @@ let run
        @@ fun tmp_wasm_file ->
        opt_with gen_file (if enable_source_maps then Some (wasm_file ^ ".map") else None)
        @@ fun opt_tmp_sourcemap ->
-       let strings = output_gen wat_file (output code ~standalone:true) in
+       let generated_js = output_gen wat_file (output code ~standalone:true) in
        let primitives =
          link_and_optimize
            ~profile
@@ -479,7 +499,13 @@ let run
            wat_file
            tmp_wasm_file
        in
-       build_js_runtime primitives strings wasm_file output_file
+       let js_runtime =
+         build_js_runtime
+           ~primitives
+           ~runtime_arguments:(build_runtime_arguments ~wasm_file ~generated_js)
+       in
+       gen_file output_file
+       @@ fun tmp_output_file -> write_file tmp_output_file js_runtime
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());
   Debug.stop_profiling ()
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 61482cbb5a..259218f31d 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,6 +1,6 @@
-(async function (js, strings, fragments) {
+((js) => async (args) => {
     "use strict";
-    const src = 'CODE';
+    let {src, generated} = args;
     function loadRelative(src) {
       const path = require('path');
       const f = path.join(path.dirname(require.main.filename),src);
@@ -350,9 +350,12 @@
          decodeStringFromUTF8Array:()=>"",
          encodeStringToUTF8Array:()=>0}
     const imports =
-        {Math:math,bindings,"wasm:js-string":string_ops,
-         "wasm:text-decoder":string_ops,"wasm:text-encoder":string_ops,
-         env:{},js,strings,fragments}
+        Object.assign({Math:math, bindings, js,
+                       "wasm:js-string":string_ops,
+                       "wasm:text-decoder":string_ops,
+                       "wasm:text-encoder":string_ops,
+                       env:{}},
+                      generated)
     const options = { builtins: ['js-string', 'text-decoder', 'text-encoder'] }
     const wasmModule =
           isNode?await WebAssembly.instantiate(await code, imports, options)
@@ -384,5 +387,4 @@
             event.error&&caml_handle_uncaught_exception(event.error))
     }
     await _initialize();
-})(PRIMITIVES, STRINGS,
-   ((joo_global_object,jsoo_exports,globalThis)=>FRAGMENTS)(globalThis,globalThis?.module?.exports||globalThis,globalThis))
+})

From d4c5423b8faa59d371ac0f2ec456920cfbf0a301 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 29 Apr 2024 15:39:12 +0200
Subject: [PATCH 234/481] WAT output: fix float output

---
 compiler/lib/wasm/wa_wat_output.ml | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 355d1d5fa7..422f0ff934 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -198,9 +198,15 @@ let lookup_symbol ctx (x : symbol) =
 
 let remove_nops l = List.filter ~f:(fun i -> not (Poly.equal i Nop)) l
 
-let float64 _ f = Printf.sprintf "%h" f (*ZZZ*)
+let float64 _ f =
+  match classify_float f with
+  | FP_normal | FP_subnormal | FP_zero | FP_nan -> Printf.sprintf "%h" f
+  | FP_infinite -> if Float.(f > 0.) then "inf" else "-inf"
 
-let float32 _ f = Printf.sprintf "%h" f (*ZZZ*)
+let float32 _ f =
+  match classify_float f with
+  | FP_normal | FP_subnormal | FP_zero | FP_nan -> Printf.sprintf "%h" f
+  | FP_infinite -> if Float.(f > 0.) then "inf" else "-inf"
 
 let expression_or_instructions ctx in_function =
   let rec expression e =
@@ -212,8 +218,8 @@ let expression_or_instructions ctx in_function =
                 (select
                    (fun _ i -> Int32.to_string i)
                    (fun _ i -> Int64.to_string i)
-                   float64
                    float32
+                   float64
                    op)
             ]
         ]

From a7dcef8e95091d33b18566f8934a34eb34153daa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 27 Mar 2024 20:07:49 +0100
Subject: [PATCH 235/481] Move binaryen related operations to a distinct file

---
 compiler/bin-wasm_of_ocaml/compile.ml | 206 +++++---------------------
 compiler/lib/fs.ml                    |  26 ++++
 compiler/lib/fs.mli                   |   6 +
 compiler/lib/wasm/wa_binaryen.ml      | 118 +++++++++++++++
 compiler/lib/wasm/wa_binaryen.mli     |  23 +++
 5 files changed, 210 insertions(+), 169 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_binaryen.ml
 create mode 100644 compiler/lib/wasm/wa_binaryen.mli

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index c2bb0b8a8e..3df26ade1e 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -26,155 +26,6 @@ let debug_mem = Debug.find "mem"
 
 let () = Sys.catch_break true
 
-let command cmdline =
-  let cmdline = String.concat ~sep:" " cmdline in
-  let res = Sys.command cmdline in
-  if res = 127 then raise (Sys_error cmdline);
-  assert (res = 0)
-(*ZZZ*)
-
-let gen_file file f =
-  let f_tmp =
-    Filename.temp_file_name
-      ~temp_dir:(Filename.dirname file)
-      (Filename.basename file)
-      ".tmp"
-  in
-  try
-    f f_tmp;
-    (try Sys.remove file with Sys_error _ -> ());
-    Sys.rename f_tmp file
-  with exc ->
-    (try Sys.remove f_tmp with Sys_error _ -> ());
-    raise exc
-
-let opt_with action x f =
-  match x with
-  | None -> f None
-  | Some x -> action x (fun y -> f (Some y))
-
-let write_file name contents =
-  let ch = open_out name in
-  output_string ch contents;
-  close_out ch
-
-let remove_file filename =
-  try if Sys.file_exists filename then Sys.remove filename with Sys_error _msg -> ()
-
-let with_intermediate_file name f =
-  match f name with
-  | res ->
-      remove_file name;
-      res
-  | exception e ->
-      remove_file name;
-      raise e
-
-let output_gen output_file f =
-  Code.Var.set_pretty true;
-  Code.Var.set_stable (Config.Flag.stable_var ());
-  Filename.gen_file output_file f
-
-let common_binaryen_options () =
-  let l =
-    [ "--enable-gc"
-    ; "--enable-multivalue"
-    ; "--enable-exception-handling"
-    ; "--enable-reference-types"
-    ; "--enable-tail-call"
-    ; "--enable-bulk-memory"
-    ; "--enable-nontrapping-float-to-int"
-    ; "--enable-strings"
-    ]
-  in
-  if Config.Flag.pretty () then "-g" :: l else l
-
-let opt_flag flag v =
-  match v with
-  | None -> []
-  | Some v -> [ flag; Filename.quote v ]
-
-let link runtime_files input_file opt_output_sourcemap output_file =
-  command
-    ("wasm-merge"
-    :: (common_binaryen_options ()
-       @ List.flatten
-           (List.map
-              ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ])
-              runtime_files)
-       @ [ Filename.quote input_file; "exec"; "-o"; Filename.quote output_file ]
-       @ opt_flag "--output-source-map" opt_output_sourcemap))
-
-let generate_dependencies primitives =
-  Yojson.Basic.to_string
-    (`List
-      (StringSet.fold
-         (fun nm s ->
-           `Assoc
-             [ "name", `String ("js:" ^ nm)
-             ; "import", `List [ `String "js"; `String nm ]
-             ]
-           :: s)
-         primitives
-         (Yojson.Basic.Util.to_list (Yojson.Basic.from_string Wa_runtime.dependencies))))
-
-let filter_unused_primitives primitives usage_file =
-  let ch = open_in usage_file in
-  let s = ref primitives in
-  (try
-     while true do
-       let l = input_line ch in
-       match String.drop_prefix ~prefix:"unused: js:" l with
-       | Some nm -> s := StringSet.remove nm !s
-       | None -> ()
-     done
-   with End_of_file -> ());
-  !s
-
-let dead_code_elimination ~opt_input_sourcemap ~opt_output_sourcemap in_file out_file =
-  with_intermediate_file (Filename.temp_file "deps" ".json")
-  @@ fun deps_file ->
-  with_intermediate_file (Filename.temp_file "usage" ".txt")
-  @@ fun usage_file ->
-  let primitives = Linker.get_provided () in
-  write_file deps_file (generate_dependencies primitives);
-  command
-    ("wasm-metadce"
-    :: (common_binaryen_options ()
-       @ [ "--graph-file"; Filename.quote deps_file; Filename.quote in_file ]
-       @ opt_flag "--input-source-map" opt_input_sourcemap
-       @ [ "-o"; Filename.quote out_file ]
-       @ opt_flag "--output-source-map" opt_output_sourcemap
-       @ [ ">"; Filename.quote usage_file ]));
-  filter_unused_primitives primitives usage_file
-
-let optimization_options =
-  [| [ "-O2"; "--skip-pass=inlining-optimizing" ]
-   ; [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-   ; [ "-O3"; "--traps-never-happen" ]
-  |]
-
-let optimize
-    ~profile
-    ~opt_input_sourcemap
-    ~opt_output_sourcemap
-    ~opt_sourcemap_url
-    in_file
-    out_file =
-  let level =
-    match profile with
-    | None -> 1
-    | Some p -> fst (List.find ~f:(fun (_, p') -> Poly.equal p p') Driver.profiles)
-  in
-  command
-    ("wasm-opt"
-     :: (common_binaryen_options ()
-        @ optimization_options.(level - 1)
-        @ [ Filename.quote in_file; "-o"; Filename.quote out_file ])
-    @ opt_flag "--input-source-map" opt_input_sourcemap
-    @ opt_flag "--output-source-map" opt_output_sourcemap
-    @ opt_flag "--output-source-map-url" opt_sourcemap_url)
-
 let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_file =
   if Option.is_some sourcemap_root || not sourcemap_don't_inline_content
   then (
@@ -201,6 +52,16 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
     in
     Source_map_io.to_file ?mappings source_map ~file:sourcemap_file)
 
+let opt_with action x f =
+  match x with
+  | None -> f None
+  | Some x -> action x (fun y -> f (Some y))
+
+let output_gen output_file f =
+  Code.Var.set_pretty true;
+  Code.Var.set_stable (Config.Flag.stable_var ());
+  Filename.gen_file output_file f
+
 let link_and_optimize
     ~profile
     ~sourcemap_root
@@ -208,7 +69,7 @@ let link_and_optimize
     ~opt_sourcemap
     ~opt_sourcemap_url
     runtime_wasm_files
-    wat_file
+    wat_files
     output_file =
   let opt_sourcemap_file =
     (* Check that Binaryen supports the necessary sourcemaps options (requires
@@ -218,38 +79,43 @@ let link_and_optimize
     | Some _ | None -> opt_sourcemap
   in
   let enable_source_maps = Option.is_some opt_sourcemap_file in
-  with_intermediate_file (Filename.temp_file "runtime" ".wasm")
+  Fs.with_intermediate_file (Filename.temp_file "runtime" ".wasm")
   @@ fun runtime_file ->
-  write_file runtime_file Wa_runtime.wasm_runtime;
-  with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
+  Fs.write_file ~name:runtime_file ~contents:Wa_runtime.wasm_runtime;
+  Fs.with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
   @@ fun temp_file ->
   opt_with
-    with_intermediate_file
+    Fs.with_intermediate_file
     (if enable_source_maps
      then Some (Filename.temp_file "wasm-merged" ".wasm.map")
      else None)
   @@ fun opt_temp_sourcemap ->
-  link (runtime_file :: runtime_wasm_files) wat_file opt_temp_sourcemap temp_file;
-  with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
+  Wa_binaryen.link
+    ~runtime_files:(runtime_file :: runtime_wasm_files)
+    ~input_files:wat_files
+    ~opt_output_sourcemap:opt_temp_sourcemap
+    ~output_file:temp_file;
+  Fs.with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm")
   @@ fun temp_file' ->
   opt_with
-    with_intermediate_file
+    Fs.with_intermediate_file
     (if enable_source_maps then Some (Filename.temp_file "wasm-dce" ".wasm.map") else None)
   @@ fun opt_temp_sourcemap' ->
   let primitives =
-    dead_code_elimination
+    Wa_binaryen.dead_code_elimination
+      ~dependencies:Wa_runtime.dependencies
       ~opt_input_sourcemap:opt_temp_sourcemap
       ~opt_output_sourcemap:opt_temp_sourcemap'
-      temp_file
-      temp_file'
+      ~input_file:temp_file
+      ~output_file:temp_file'
   in
-  optimize
+  Wa_binaryen.optimize
     ~profile
     ~opt_input_sourcemap:opt_temp_sourcemap'
     ~opt_output_sourcemap:opt_sourcemap
     ~opt_sourcemap_url
-    temp_file'
-    output_file;
+    ~input_file:temp_file'
+    ~output_file;
   Option.iter
     ~f:(update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content)
     opt_sourcemap_file;
@@ -473,16 +339,18 @@ let run
            ic
        in
        if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-       gen_file (Filename.chop_extension output_file ^ ".wat")
+       Fs.gen_file (Filename.chop_extension output_file ^ ".wat")
        @@ fun wat_file ->
        let wasm_file =
          if Filename.check_suffix output_file ".wasm.js"
          then Filename.chop_extension output_file
          else Filename.chop_extension output_file ^ ".wasm"
        in
-       gen_file wasm_file
+       Fs.gen_file wasm_file
        @@ fun tmp_wasm_file ->
-       opt_with gen_file (if enable_source_maps then Some (wasm_file ^ ".map") else None)
+       opt_with
+         Fs.gen_file
+         (if enable_source_maps then Some (wasm_file ^ ".map") else None)
        @@ fun opt_tmp_sourcemap ->
        let generated_js = output_gen wat_file (output code ~standalone:true) in
        let primitives =
@@ -496,7 +364,7 @@ let run
               then Some (Filename.basename wasm_file ^ ".map")
               else None)
            runtime_wasm_files
-           wat_file
+           [ wat_file ]
            tmp_wasm_file
        in
        let js_runtime =
@@ -504,8 +372,8 @@ let run
            ~primitives
            ~runtime_arguments:(build_runtime_arguments ~wasm_file ~generated_js)
        in
-       gen_file output_file
-       @@ fun tmp_output_file -> write_file tmp_output_file js_runtime
+       Fs.gen_file output_file
+       @@ fun tmp_output_file -> Fs.write_file ~name:tmp_output_file ~contents:js_runtime
    | `Cmo _ | `Cma _ -> assert false);
    close_ic ());
   Debug.stop_profiling ()
diff --git a/compiler/lib/fs.ml b/compiler/lib/fs.ml
index 4e5495af4c..000d8a6428 100644
--- a/compiler/lib/fs.ml
+++ b/compiler/lib/fs.ml
@@ -48,3 +48,29 @@ let read_file f =
     Bytes.unsafe_to_string s
   with e ->
     failwith (Printf.sprintf "Cannot read content of %s.\n%s" f (Printexc.to_string e))
+
+let write_file ~name ~contents =
+  let ch = open_out_bin name in
+  output_string ch contents;
+  close_out ch
+
+let remove_file file = try Sys.remove file with Sys_error _ -> ()
+
+let gen_file file f =
+  let f_tmp =
+    Filename.temp_file_name
+      ~temp_dir:(Filename.dirname file)
+      (Filename.basename file)
+      ".tmp"
+  in
+  try
+    let res = f f_tmp in
+    remove_file file;
+    Sys.rename f_tmp file;
+    res
+  with exc ->
+    remove_file f_tmp;
+    raise exc
+
+let with_intermediate_file name f =
+  Fun.protect ~finally:(fun () -> remove_file name) (fun () -> f name)
diff --git a/compiler/lib/fs.mli b/compiler/lib/fs.mli
index fbdcc65b44..f8e804906f 100644
--- a/compiler/lib/fs.mli
+++ b/compiler/lib/fs.mli
@@ -21,3 +21,9 @@ val find_in_path : string list -> string -> string option
 val absolute_path : string -> string
 
 val read_file : string -> string
+
+val write_file : name:string -> contents:string -> unit
+
+val gen_file : string -> (string -> 'a) -> 'a
+
+val with_intermediate_file : string -> (string -> 'a) -> 'a
diff --git a/compiler/lib/wasm/wa_binaryen.ml b/compiler/lib/wasm/wa_binaryen.ml
new file mode 100644
index 0000000000..bb9683efb5
--- /dev/null
+++ b/compiler/lib/wasm/wa_binaryen.ml
@@ -0,0 +1,118 @@
+open Stdlib
+
+let debug = Debug.find "binaryen"
+
+let command cmdline =
+  let cmdline = String.concat ~sep:" " cmdline in
+  if debug () then Format.eprintf "+ %s@." cmdline;
+  let res = Sys.command cmdline in
+  if res <> 0 then failwith ("the following command terminated unsuccessfully: " ^ cmdline)
+
+let common_options () =
+  let l =
+    [ "--enable-gc"
+    ; "--enable-multivalue"
+    ; "--enable-exception-handling"
+    ; "--enable-reference-types"
+    ; "--enable-tail-call"
+    ; "--enable-bulk-memory"
+    ; "--enable-nontrapping-float-to-int"
+    ; "--enable-strings"
+    ]
+  in
+  if Config.Flag.pretty () then "-g" :: l else l
+
+let opt_flag flag v =
+  match v with
+  | None -> []
+  | Some v -> [ flag; Filename.quote v ]
+
+let link ~runtime_files ~input_files ~opt_output_sourcemap ~output_file =
+  command
+    ("wasm-merge"
+    :: (common_options ()
+       @ List.flatten
+           (List.map
+              ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ])
+              runtime_files)
+       @ List.flatten
+           (List.map
+              ~f:(fun input_file -> [ Filename.quote input_file; "OCaml" ])
+              input_files)
+       @ [ "-o"; Filename.quote output_file ]
+       @ opt_flag "--output-source-map" opt_output_sourcemap))
+
+let generate_dependencies ~dependencies primitives =
+  Yojson.Basic.to_string
+    (`List
+      (StringSet.fold
+         (fun nm s ->
+           `Assoc
+             [ "name", `String ("js:" ^ nm)
+             ; "import", `List [ `String "js"; `String nm ]
+             ]
+           :: s)
+         primitives
+         (Yojson.Basic.Util.to_list (Yojson.Basic.from_string dependencies))))
+
+let filter_unused_primitives primitives usage_file =
+  let ch = open_in usage_file in
+  let s = ref primitives in
+  (try
+     while true do
+       let l = input_line ch in
+       match String.drop_prefix ~prefix:"unused: js:" l with
+       | Some nm -> s := StringSet.remove nm !s
+       | None -> ()
+     done
+   with End_of_file -> ());
+  !s
+
+let dead_code_elimination
+    ~dependencies
+    ~opt_input_sourcemap
+    ~input_file
+    ~opt_output_sourcemap
+    ~output_file =
+  Fs.with_intermediate_file (Filename.temp_file "deps" ".json")
+  @@ fun deps_file ->
+  Fs.with_intermediate_file (Filename.temp_file "usage" ".txt")
+  @@ fun usage_file ->
+  let primitives = Linker.get_provided () in
+  Fs.write_file ~name:deps_file ~contents:(generate_dependencies ~dependencies primitives);
+  command
+    ("wasm-metadce"
+    :: (common_options ()
+       @ [ "--graph-file"; Filename.quote deps_file; Filename.quote input_file ]
+       @ opt_flag "--input-source-map" opt_input_sourcemap
+       @ [ "-o"; Filename.quote output_file ]
+       @ opt_flag "--output-source-map" opt_output_sourcemap
+       @ [ ">"; Filename.quote usage_file ]));
+  filter_unused_primitives primitives usage_file
+
+let optimization_options =
+  [| [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+   ; [ "-O2"; "--traps-never-happen" ]
+   ; [ "-O3"; "--traps-never-happen" ]
+  |]
+
+let optimize
+    ~profile
+    ~opt_input_sourcemap
+    ~input_file
+    ~opt_output_sourcemap
+    ~opt_sourcemap_url
+    ~output_file =
+  let level =
+    match profile with
+    | None -> 1
+    | Some p -> fst (List.find ~f:(fun (_, p') -> Poly.equal p p') Driver.profiles)
+  in
+  command
+    ("wasm-opt"
+     :: (common_options ()
+        @ optimization_options.(level - 1)
+        @ [ Filename.quote input_file; "-o"; Filename.quote output_file ])
+    @ opt_flag "--input-source-map" opt_input_sourcemap
+    @ opt_flag "--output-source-map" opt_output_sourcemap
+    @ opt_flag "--output-source-map-url" opt_sourcemap_url)
diff --git a/compiler/lib/wasm/wa_binaryen.mli b/compiler/lib/wasm/wa_binaryen.mli
new file mode 100644
index 0000000000..e08899a3bf
--- /dev/null
+++ b/compiler/lib/wasm/wa_binaryen.mli
@@ -0,0 +1,23 @@
+val link :
+     runtime_files:string list
+  -> input_files:string list
+  -> opt_output_sourcemap:string option
+  -> output_file:string
+  -> unit
+
+val dead_code_elimination :
+     dependencies:string
+  -> opt_input_sourcemap:string option
+  -> input_file:string
+  -> opt_output_sourcemap:string option
+  -> output_file:string
+  -> Stdlib.StringSet.t
+
+val optimize :
+     profile:Driver.profile option
+  -> opt_input_sourcemap:string option
+  -> input_file:string
+  -> opt_output_sourcemap:string option
+  -> opt_sourcemap_url:string option
+  -> output_file:string
+  -> unit

From 4a5ed465c2083f7495056051ecf4acde8bb9fdc6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 09:44:05 +0100
Subject: [PATCH 236/481] Generate code for reporting missing primitives

---
 compiler/bin-wasm_of_ocaml/compile.ml |  55 +++++++++-
 compiler/lib/wasm/wa_link.ml          | 150 ++++++++++++++++++++++++++
 compiler/lib/wasm/wa_link.mli         |  27 +++++
 3 files changed, 230 insertions(+), 2 deletions(-)
 create mode 100644 compiler/lib/wasm/wa_link.ml
 create mode 100644 compiler/lib/wasm/wa_link.mli

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 3df26ade1e..cea13205bc 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -121,7 +121,21 @@ let link_and_optimize
     opt_sourcemap_file;
   primitives
 
-let build_runtime_arguments ~wasm_file ~generated_js:(strings, fragments) =
+let report_missing_primitives missing =
+  if not (List.is_empty missing)
+  then (
+    warn "There are some missing Wasm primitives@.";
+    warn "Dummy implementations (raising an exception) ";
+    warn "will be provided.@.";
+    warn "Missing primitives:@.";
+    List.iter ~f:(fun nm -> warn "  %s@." nm) missing)
+
+let build_runtime_arguments
+    ~missing_primitives
+    ~wasm_file
+    ~generated_js:(strings, fragments) =
+  let missing_primitives = if Config.Flag.genprim () then missing_primitives else [] in
+  report_missing_primitives missing_primitives;
   let obj l =
     Javascript.EObj
       (List.map
@@ -147,6 +161,35 @@ let build_runtime_arguments ~wasm_file ~generated_js:(strings, fragments) =
     in
     strings @ fragments
   in
+  let generated_js =
+    if not (List.is_empty missing_primitives)
+    then
+      ( "env"
+      , obj
+          (List.map
+             ~f:(fun nm ->
+               ( nm
+               , Javascript.EArrow
+                   ( Javascript.fun_
+                       []
+                       [ ( Throw_statement
+                             (ENew
+                                ( EVar
+                                    (Javascript.ident (Utf8_string.of_string_exn "Error"))
+                                , Some
+                                    [ Arg
+                                        (EStr
+                                           (Utf8_string.of_string_exn
+                                              (nm ^ " not implemented")))
+                                    ] ))
+                         , N )
+                       ]
+                       N
+                   , AUnknown ) ))
+             missing_primitives) )
+      :: generated_js
+    else generated_js
+  in
   let generated_js =
     if List.is_empty generated_js
     then obj generated_js
@@ -368,9 +411,17 @@ let run
            tmp_wasm_file
        in
        let js_runtime =
+         let missing_primitives =
+           let l = Wa_link.Wasm_binary.read_imports ~file:tmp_wasm_file in
+           List.filter_map
+             ~f:(fun { Wa_link.Wasm_binary.module_; name; _ } ->
+               if String.equal module_ "env" then Some name else None)
+             l
+         in
          build_js_runtime
            ~primitives
-           ~runtime_arguments:(build_runtime_arguments ~wasm_file ~generated_js)
+           ~runtime_arguments:
+             (build_runtime_arguments ~missing_primitives ~wasm_file ~generated_js)
        in
        Fs.gen_file output_file
        @@ fun tmp_output_file -> Fs.write_file ~name:tmp_output_file ~contents:js_runtime
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
new file mode 100644
index 0000000000..16502a2bfe
--- /dev/null
+++ b/compiler/lib/wasm/wa_link.ml
@@ -0,0 +1,150 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2017 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open Stdlib
+
+module Wasm_binary = struct
+  let header = "\000asm\001\000\000\000"
+
+  let check_header file ch =
+    let s = really_input_string ch 8 in
+    if not (String.equal s header)
+    then failwith (file ^ " is not a Wasm binary file (bad magic)")
+
+  type t =
+    { ch : in_channel
+    ; limit : int
+    }
+
+  let open_in f =
+    let ch = open_in_bin f in
+    check_header f ch;
+    { ch; limit = in_channel_length ch }
+
+  let rec read_uint ?(n = 5) ch =
+    let i = input_byte ch in
+    if n = 1 then assert (i < 16);
+    if i < 128 then i else i - 128 + (read_uint ~n:(n - 1) ch lsl 7)
+
+  let rec read_sint ?(n = 5) ch =
+    let i = input_byte ch in
+    if n = 1 then assert (i < 8 || (i > 120 && i < 128));
+    if i < 64
+    then i
+    else if i < 128
+    then i - 128
+    else i - 128 + (read_sint ~n:(n - 1) ch lsl 7)
+
+  type section =
+    { id : int
+    ; size : int
+    }
+
+  let next_section ch =
+    if pos_in ch.ch = ch.limit
+    then None
+    else
+      let id = input_byte ch.ch in
+      let size = read_uint ch.ch in
+      Some { id; size }
+
+  let skip_section ch { size; _ } = seek_in ch.ch (pos_in ch.ch + size)
+
+  let vec f ch =
+    let rec loop acc n = if n = 0 then List.rev acc else loop (f ch :: acc) (n - 1) in
+    loop [] (read_uint ch)
+
+  let name ch =
+    let n = read_uint ch in
+    really_input_string ch n
+
+  let heaptype ch = ignore (read_sint ch)
+
+  let reftype' i ch =
+    match i with
+    | 0x6a | 0x6b | 0x6c | 0x6d | 0x6e | 0x6f | 0x70 | 0x71 | 0x72 | 0x73 -> ()
+    | 0x63 | 0x64 -> heaptype ch
+    | _ ->
+        Format.eprintf "Unknown reftype %x@." i;
+        assert false
+
+  let reftype ch = reftype' (input_byte ch) ch
+
+  let valtype ch =
+    let i = read_uint ch in
+    match i with
+    | 0x7b | 0x7c | 0x7d | 0x7e | 0x7f -> ()
+    | _ -> reftype' i ch
+
+  let limits ch =
+    match input_byte ch with
+    | 0 -> ignore (read_uint ch)
+    | 1 ->
+        ignore (read_uint ch);
+        ignore (read_uint ch)
+    | _ -> assert false
+
+  let memtype = limits
+
+  let tabletype ch =
+    reftype ch;
+    limits ch
+
+  type import =
+    { module_ : string
+    ; name : string
+    }
+
+  let import ch =
+    let module_ = name ch in
+    let name = name ch in
+    let d = read_uint ch in
+    let _ =
+      match d with
+      | 0 -> ignore (read_uint ch)
+      | 1 -> tabletype ch
+      | 2 -> memtype ch
+      | 3 ->
+          let _typ = valtype ch in
+          let _mut = input_byte ch in
+          ()
+      | 4 ->
+          assert (read_uint ch = 0);
+          ignore (read_uint ch)
+      | _ ->
+          Format.eprintf "Unknown import %x@." d;
+          assert false
+    in
+    { module_; name }
+
+  let read_imports ~file =
+    let ch = open_in file in
+    let rec find_section () =
+      match next_section ch with
+      | None -> false
+      | Some s ->
+          s.id = 2
+          ||
+          (skip_section ch s;
+           find_section ())
+    in
+    let res = if find_section () then vec import ch.ch else [] in
+    close_in ch.ch;
+    res
+end
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
new file mode 100644
index 0000000000..33570879bd
--- /dev/null
+++ b/compiler/lib/wasm/wa_link.mli
@@ -0,0 +1,27 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2017 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+module Wasm_binary : sig
+  type import =
+    { module_ : string
+    ; name : string
+    }
+
+  val read_imports : file:string -> import list
+end

From bf1a8fac57cbab2cc7baa6bc7449d43091bbe142 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Mar 2024 18:57:01 +0100
Subject: [PATCH 237/481] AST: allow to export globals

---
 compiler/lib/wasm/wa_asm_output.ml       | 29 +++++++++++++-----------
 compiler/lib/wasm/wa_ast.ml              |  1 +
 compiler/lib/wasm/wa_code_generation.ml  |  5 ++--
 compiler/lib/wasm/wa_code_generation.mli |  7 +++++-
 compiler/lib/wasm/wa_wat_output.ml       |  6 +++--
 5 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 00d443c4e7..86114426e6 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -463,6 +463,13 @@ module Output () = struct
               ~f:(fun f -> line (string ".ascii \"+\"") ^^ len_string f)
               (Feature.get features)))
 
+  let export name exported_name =
+    match exported_name with
+    | None -> empty
+    | Some exported_name ->
+        line
+          (string ".export_name " ^^ symbol name 0 ^^ string "," ^^ string exported_name)
+
   let f ch fields =
     List.iter
       ~f:(fun f ->
@@ -492,7 +499,7 @@ module Output () = struct
           | Import { import_module; import_name; name; desc = Global typ } ->
               if typ.mut then Feature.require mutable_globals;
               Some (V name, typ, Some (import_module, import_name))
-          | Global { name; typ; init } ->
+          | Global { name; typ; init; _ } ->
               assert (Poly.equal init (Const (I32 0l)));
               Some (name, typ, None))
         fields
@@ -586,9 +593,13 @@ module Output () = struct
                               string ".int32 " ^^ symbol name offset
                           | DataSpace n -> string ".space " ^^ integer n))
                       contents)
-          | Global { name; _ } ->
-              indent (section_header "data" name ^^ define_symbol name)
-              ^^ line (symbol name 0 ^^ string ":")
+          | Global { name; exported_name; typ; _ } ->
+              if typ.mut && Option.is_some exported_name
+              then Feature.require mutable_globals;
+              indent
+                (section_header "data" name
+                ^^ define_symbol name
+                ^^ export name exported_name)
           | Tag { name; _ } ->
               indent (section_header "data" (V name) ^^ define_symbol (V name))
               ^^ line (index name ^^ string ":"))
@@ -619,15 +630,7 @@ module Output () = struct
               indent
                 (section_header "text" (V name)
                 ^^ define_symbol (V name)
-                ^^
-                match exported_name with
-                | None -> empty
-                | Some exported_name ->
-                    line
-                      (string ".export_name "
-                      ^^ index name
-                      ^^ string ","
-                      ^^ string exported_name))
+                ^^ export (V name) exported_name)
               ^^ line (index name ^^ string ":")
               ^^ indent
                    (declare_func_type name typ None
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 14fb07c5a2..093238f2f2 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -227,6 +227,7 @@ type module_field =
       }
   | Global of
       { name : symbol
+      ; exported_name : string option
       ; typ : global_type
       ; init : expression
       }
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 2a75c88b67..7e63b6e0ed 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -157,8 +157,9 @@ let heap_type_sub (ty : W.heap_type) (ty' : W.heap_type) st =
   (* I31, struct and arrays have no subtype (of a different kind) *)
   | _, (I31 | Type _) -> false, st
 
-let register_global name ?(constant = false) typ init st =
-  st.context.other_fields <- W.Global { name; typ; init } :: st.context.other_fields;
+let register_global name ?exported_name ?(constant = false) typ init st =
+  st.context.other_fields <-
+    W.Global { name; exported_name; typ; init } :: st.context.other_fields;
   (match name with
   | S _ -> ()
   | V name ->
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 8c87b39669..4c454a1cbb 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -135,7 +135,12 @@ val register_import :
   ?import_module:string -> name:string -> Wa_ast.import_desc -> Wa_ast.var t
 
 val register_global :
-  Wa_ast.symbol -> ?constant:bool -> Wa_ast.global_type -> Wa_ast.expression -> unit t
+     Wa_ast.symbol
+  -> ?exported_name:string
+  -> ?constant:bool
+  -> Wa_ast.global_type
+  -> Wa_ast.expression
+  -> unit t
 
 val get_global : Code.Var.t -> Wa_ast.expression option t
 
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index e6c61dc1e9..952213da56 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -668,9 +668,11 @@ let field ctx st f =
   match f with
   | Function { name; exported_name; typ; param_names; locals; body } ->
       [ funct ctx st name exported_name typ param_names locals body ]
-  | Global { name; typ; init } ->
+  | Global { name; exported_name; typ; init } ->
       [ List
-          (Atom "global" :: symbol st name :: global_type st typ :: expression ctx st init)
+          (Atom "global"
+          :: symbol st name
+          :: (export exported_name @ (global_type st typ :: expression ctx st init)))
       ]
   | Tag { name; typ } ->
       [ List

From 91ad556143a74b8202f0e07b8a2f8d399b45ae27 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 10:08:08 +0100
Subject: [PATCH 238/481] Move code around

---
 compiler/bin-wasm_of_ocaml/compile.ml | 139 ++------------------------
 compiler/lib/wasm/wa_link.ml          | 130 ++++++++++++++++++++++++
 compiler/lib/wasm/wa_link.mli         |   8 ++
 3 files changed, 144 insertions(+), 133 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index cea13205bc..303d32fcd2 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -121,136 +121,6 @@ let link_and_optimize
     opt_sourcemap_file;
   primitives
 
-let report_missing_primitives missing =
-  if not (List.is_empty missing)
-  then (
-    warn "There are some missing Wasm primitives@.";
-    warn "Dummy implementations (raising an exception) ";
-    warn "will be provided.@.";
-    warn "Missing primitives:@.";
-    List.iter ~f:(fun nm -> warn "  %s@." nm) missing)
-
-let build_runtime_arguments
-    ~missing_primitives
-    ~wasm_file
-    ~generated_js:(strings, fragments) =
-  let missing_primitives = if Config.Flag.genprim () then missing_primitives else [] in
-  report_missing_primitives missing_primitives;
-  let obj l =
-    Javascript.EObj
-      (List.map
-         ~f:(fun (nm, v) ->
-           let id = Utf8_string.of_string_exn nm in
-           Javascript.Property (PNS id, v))
-         l)
-  in
-  let generated_js =
-    let strings =
-      if List.is_empty strings
-      then []
-      else
-        [ ( "strings"
-          , Javascript.EArr
-              (List.map
-                 ~f:(fun s -> Javascript.Element (EStr (Utf8_string.of_string_exn s)))
-                 strings) )
-        ]
-    in
-    let fragments =
-      if List.is_empty fragments then [] else [ "fragments", obj fragments ]
-    in
-    strings @ fragments
-  in
-  let generated_js =
-    if not (List.is_empty missing_primitives)
-    then
-      ( "env"
-      , obj
-          (List.map
-             ~f:(fun nm ->
-               ( nm
-               , Javascript.EArrow
-                   ( Javascript.fun_
-                       []
-                       [ ( Throw_statement
-                             (ENew
-                                ( EVar
-                                    (Javascript.ident (Utf8_string.of_string_exn "Error"))
-                                , Some
-                                    [ Arg
-                                        (EStr
-                                           (Utf8_string.of_string_exn
-                                              (nm ^ " not implemented")))
-                                    ] ))
-                         , N )
-                       ]
-                       N
-                   , AUnknown ) ))
-             missing_primitives) )
-      :: generated_js
-    else generated_js
-  in
-  let generated_js =
-    if List.is_empty generated_js
-    then obj generated_js
-    else
-      let var ident e =
-        Javascript.variable_declaration [ Javascript.ident ident, (e, N) ], Javascript.N
-      in
-      Javascript.call
-        (EArrow
-           ( Javascript.fun_
-               [ Javascript.ident Constant.global_object_ ]
-               [ var
-                   Constant.old_global_object_
-                   (EVar (Javascript.ident Constant.global_object_))
-               ; var
-                   Constant.exports_
-                   (EBin
-                      ( Or
-                      , EDot
-                          ( EDot
-                              ( EVar (Javascript.ident Constant.global_object_)
-                              , ANullish
-                              , Utf8_string.of_string_exn "module" )
-                          , ANullish
-                          , Utf8_string.of_string_exn "export" )
-                      , EVar (Javascript.ident Constant.global_object_) ))
-               ; Return_statement (Some (obj generated_js)), N
-               ]
-               N
-           , AUnknown ))
-        [ EVar (Javascript.ident Constant.global_object_) ]
-        N
-  in
-  obj
-    [ "generated", generated_js
-    ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_file))
-    ]
-
-let output_js js =
-  Code.Var.reset ();
-  let b = Buffer.create 1024 in
-  let f = Pretty_print.to_buffer b in
-  Driver.configure f;
-  let traverse = new Js_traverse.free in
-  let js = traverse#program js in
-  let free = traverse#get_free in
-  Javascript.IdentSet.iter
-    (fun x ->
-      match x with
-      | V _ -> assert false
-      | S { name = Utf8 x; _ } -> Var_printer.add_reserved x)
-    free;
-  let js =
-    if Config.Flag.shortvar () then (new Js_traverse.rename_variable)#program js else js
-  in
-  let js = (new Js_traverse.simpl)#program js in
-  let js = (new Js_traverse.clean)#program js in
-  let js = Js_assign.program js in
-  ignore (Js_output.program f js);
-  Buffer.contents b
-
 let build_js_runtime ~primitives ~runtime_arguments =
   let always_required_js, primitives =
     let l =
@@ -273,7 +143,7 @@ let build_js_runtime ~primitives ~runtime_arguments =
     | Javascript.Expression_statement e, N -> e
     | _ -> assert false
   in
-  let prelude = output_js always_required_js in
+  let prelude = Wa_link.output_js always_required_js in
   let init_fun =
     match Parse_js.parse (Parse_js.Lexer.of_string Wa_runtime.js_runtime) with
     | [ (Expression_statement f, _) ] -> f
@@ -285,7 +155,7 @@ let build_js_runtime ~primitives ~runtime_arguments =
       let js = Javascript.call js [ runtime_arguments ] N in
       [ Javascript.Expression_statement js, Javascript.N ]
     in
-    output_js js
+    Wa_link.output_js js
   in
   prelude ^ launcher
 
@@ -421,7 +291,10 @@ let run
          build_js_runtime
            ~primitives
            ~runtime_arguments:
-             (build_runtime_arguments ~missing_primitives ~wasm_file ~generated_js)
+             (Wa_link.build_runtime_arguments
+                ~missing_primitives
+                ~wasm_file
+                ~generated_js)
        in
        Fs.gen_file output_file
        @@ fun tmp_output_file -> Fs.write_file ~name:tmp_output_file ~contents:js_runtime
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 16502a2bfe..bf31c084a9 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -148,3 +148,133 @@ module Wasm_binary = struct
     close_in ch.ch;
     res
 end
+
+let output_js js =
+  Code.Var.reset ();
+  let b = Buffer.create 1024 in
+  let f = Pretty_print.to_buffer b in
+  Driver.configure f;
+  let traverse = new Js_traverse.free in
+  let js = traverse#program js in
+  let free = traverse#get_free in
+  Javascript.IdentSet.iter
+    (fun x ->
+      match x with
+      | V _ -> assert false
+      | S { name = Utf8 x; _ } -> Var_printer.add_reserved x)
+    free;
+  let js =
+    if Config.Flag.shortvar () then (new Js_traverse.rename_variable)#program js else js
+  in
+  let js = (new Js_traverse.simpl)#program js in
+  let js = (new Js_traverse.clean)#program js in
+  let js = Js_assign.program js in
+  ignore (Js_output.program f js);
+  Buffer.contents b
+
+let report_missing_primitives missing =
+  if not (List.is_empty missing)
+  then (
+    warn "There are some missing Wasm primitives@.";
+    warn "Dummy implementations (raising an exception) ";
+    warn "will be provided.@.";
+    warn "Missing primitives:@.";
+    List.iter ~f:(fun nm -> warn "  %s@." nm) missing)
+
+let build_runtime_arguments
+    ~missing_primitives
+    ~wasm_file
+    ~generated_js:(strings, fragments) =
+  let missing_primitives = if Config.Flag.genprim () then missing_primitives else [] in
+  report_missing_primitives missing_primitives;
+  let obj l =
+    Javascript.EObj
+      (List.map
+         ~f:(fun (nm, v) ->
+           let id = Utf8_string.of_string_exn nm in
+           Javascript.Property (PNS id, v))
+         l)
+  in
+  let generated_js =
+    let strings =
+      if List.is_empty strings
+      then []
+      else
+        [ ( "strings"
+          , Javascript.EArr
+              (List.map
+                 ~f:(fun s -> Javascript.Element (EStr (Utf8_string.of_string_exn s)))
+                 strings) )
+        ]
+    in
+    let fragments =
+      if List.is_empty fragments then [] else [ "fragments", obj fragments ]
+    in
+    strings @ fragments
+  in
+  let generated_js =
+    if not (List.is_empty missing_primitives)
+    then
+      ( "env"
+      , obj
+          (List.map
+             ~f:(fun nm ->
+               ( nm
+               , Javascript.EArrow
+                   ( Javascript.fun_
+                       []
+                       [ ( Throw_statement
+                             (ENew
+                                ( EVar
+                                    (Javascript.ident (Utf8_string.of_string_exn "Error"))
+                                , Some
+                                    [ Arg
+                                        (EStr
+                                           (Utf8_string.of_string_exn
+                                              (nm ^ " not implemented")))
+                                    ] ))
+                         , N )
+                       ]
+                       N
+                   , AUnknown ) ))
+             missing_primitives) )
+      :: generated_js
+    else generated_js
+  in
+  let generated_js =
+    if List.is_empty generated_js
+    then obj generated_js
+    else
+      let var ident e =
+        Javascript.variable_declaration [ Javascript.ident ident, (e, N) ], Javascript.N
+      in
+      Javascript.call
+        (EArrow
+           ( Javascript.fun_
+               [ Javascript.ident Constant.global_object_ ]
+               [ var
+                   Constant.old_global_object_
+                   (EVar (Javascript.ident Constant.global_object_))
+               ; var
+                   Constant.exports_
+                   (EBin
+                      ( Or
+                      , EDot
+                          ( EDot
+                              ( EVar (Javascript.ident Constant.global_object_)
+                              , ANullish
+                              , Utf8_string.of_string_exn "module" )
+                          , ANullish
+                          , Utf8_string.of_string_exn "export" )
+                      , EVar (Javascript.ident Constant.global_object_) ))
+               ; Return_statement (Some (obj generated_js)), N
+               ]
+               N
+           , AUnknown ))
+        [ EVar (Javascript.ident Constant.global_object_) ]
+        N
+  in
+  obj
+    [ "generated", generated_js
+    ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_file))
+    ]
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index 33570879bd..ee0a4dc692 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -25,3 +25,11 @@ module Wasm_binary : sig
 
   val read_imports : file:string -> import list
 end
+
+val build_runtime_arguments :
+     missing_primitives:string list
+  -> wasm_file:string
+  -> generated_js:string list * (string * Javascript.expression) list
+  -> Javascript.expression
+
+val output_js : Javascript.program -> string

From 5b063bb9099bc5ee55973f3f602d9d9ce8c5f3aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 17:39:19 +0100
Subject: [PATCH 239/481] Separate compilation: handle set/get globals +
 predefined exceptions

---
 compiler/bin-js_of_ocaml/compile.ml |   2 +-
 compiler/lib/parse_bytecode.ml      | 159 +++++++++++++++++++---------
 compiler/lib/parse_bytecode.mli     |   2 +-
 compiler/lib/wasm/wa_core_target.ml |   6 ++
 compiler/lib/wasm/wa_gc_target.ml   |  13 +++
 compiler/lib/wasm/wa_generate.ml    |  30 ++++++
 compiler/lib/wasm/wa_target_sig.ml  |   6 ++
 7 files changed, 168 insertions(+), 50 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 312e535bcd..926f393774 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -251,7 +251,7 @@ let run
    then (
      let prims = Primitive.get_external () |> StringSet.elements in
      assert (List.length prims > 0);
-     let code, uinfo = Parse_bytecode.predefined_exceptions () in
+     let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`JavaScript in
      let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in
      let code : Parse_bytecode.one =
        { code
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index a2b9daa47a..29c2078cff 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -757,8 +757,25 @@ let access_global g i =
       g.vars.(i) <- Some x;
       x
 
-let register_global ?(force = false) g i loc rem =
-  if force || g.is_exported.(i)
+let register_global ~target ?(force = false) g i loc rem =
+  if g.is_exported.(i)
+     &&
+     match target with
+     | `Wasm -> true
+     | `JavaScript -> false
+  then (
+    let name =
+      match g.named_value.(i) with
+      | None -> assert false
+      | Some name -> name
+    in
+    Code.Var.name (access_global g i) name;
+    ( Let
+        ( Var.fresh ()
+        , Prim (Extern "caml_set_global", [ Pc (String name); Pv (access_global g i) ]) )
+    , loc )
+    :: rem)
+  else if force || g.is_exported.(i)
   then
     let args =
       match g.named_value.(i) with
@@ -776,25 +793,40 @@ let register_global ?(force = false) g i loc rem =
     :: rem
   else rem
 
-let get_global state instrs i loc =
+let get_global ~target state instrs i loc =
   State.size_globals state (i + 1);
   let g = State.globals state in
   match g.vars.(i) with
   | Some x ->
       if debug_parser () then Format.printf "(global access %a)@." Var.print x;
       x, State.set_accu state x loc, instrs
-  | None ->
+  | None -> (
       if i < Array.length g.constants && Constants.inlined g.constants.(i)
       then
         let x, state = State.fresh_var state loc in
         let cst = g.constants.(i) in
         x, state, (Let (x, Constant cst), loc) :: instrs
-      else (
+      else if i < Array.length g.constants
+              ||
+              match target with
+              | `Wasm -> false
+              | `JavaScript -> true
+      then (
         g.is_const.(i) <- true;
         let x, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = CONST(%d)@." Var.print x i;
         g.vars.(i) <- Some x;
         x, state, instrs)
+      else
+        match g.named_value.(i) with
+        | None -> assert false
+        | Some name ->
+            let x, state = State.fresh_var state loc in
+            if debug_parser () then Format.printf "%a = get_global(%s)@." Var.print x name;
+            ( x
+            , state
+            , (Let (x, Prim (Extern "caml_get_global", [ Pc (String name) ])), loc)
+              :: instrs ))
 
 let tagged_blocks = ref Addr.Set.empty
 
@@ -811,6 +843,7 @@ type compile_info =
   ; code : string
   ; limit : int
   ; debug : Debug.t
+  ; target : [ `JavaScript | `Wasm ]
   }
 
 let string_of_addr debug_data addr =
@@ -838,7 +871,7 @@ let ( ||| ) x y =
   | No -> y
   | _ -> x
 
-let rec compile_block blocks debug_data code pc state =
+let rec compile_block blocks debug_data ~target code pc state =
   if not (Addr.Set.mem pc !tagged_blocks)
   then (
     let limit = Blocks.next blocks pc in
@@ -847,19 +880,21 @@ let rec compile_block blocks debug_data code pc state =
     let state = State.start_block pc state in
     tagged_blocks := Addr.Set.add pc !tagged_blocks;
     let instr, last, state' =
-      compile { blocks; code; limit; debug = debug_data } pc state []
+      compile { blocks; code; limit; debug = debug_data; target } pc state []
     in
     assert (not (Addr.Map.mem pc !compiled_blocks));
     compiled_blocks := Addr.Map.add pc (state, List.rev instr, last) !compiled_blocks;
     match fst last with
     | Branch (pc', _) | Poptrap (pc', _) ->
-        compile_block blocks debug_data code pc' state'
+        compile_block blocks debug_data ~target code pc' state'
     | Cond (_, (pc1, _), (pc2, _)) ->
-        compile_block blocks debug_data code pc1 state';
-        compile_block blocks debug_data code pc2 state'
+        compile_block blocks debug_data ~target code pc1 state';
+        compile_block blocks debug_data ~target code pc2 state'
     | Switch (_, l1, l2) ->
-        Array.iter l1 ~f:(fun (pc', _) -> compile_block blocks debug_data code pc' state');
-        Array.iter l2 ~f:(fun (pc', _) -> compile_block blocks debug_data code pc' state')
+        Array.iter l1 ~f:(fun (pc', _) ->
+            compile_block blocks debug_data ~target code pc' state');
+        Array.iter l2 ~f:(fun (pc', _) ->
+            compile_block blocks debug_data ~target code pc' state')
     | Pushtrap _ | Raise _ | Return _ | Stop -> ())
 
 and compile infos pc state instrs =
@@ -1195,7 +1230,7 @@ and compile infos pc state instrs =
         let params, state' = State.make_stack nparams state' loc in
         if debug_parser () then Format.printf ") {@.";
         let state' = State.clear_accu state' in
-        compile_block infos.blocks infos.debug code addr state';
+        compile_block infos.blocks infos.debug ~target:infos.target code addr state';
         if debug_parser () then Format.printf "}@.";
         let args = State.stack_vars state' in
         let state'', _, _ = Addr.Map.find addr !compiled_blocks in
@@ -1252,7 +1287,7 @@ and compile infos pc state instrs =
               let params, state' = State.make_stack nparams state' loc in
               if debug_parser () then Format.printf ") {@.";
               let state' = State.clear_accu state' in
-              compile_block infos.blocks infos.debug code addr state';
+              compile_block infos.blocks infos.debug ~target:infos.target code addr state';
               if debug_parser () then Format.printf "}@.";
               let args = State.stack_vars state' in
               let state'', _, _ = Addr.Map.find addr !compiled_blocks in
@@ -1282,16 +1317,16 @@ and compile infos pc state instrs =
         compile infos (pc + 2) (State.env_acc n state) instrs
     | GETGLOBAL ->
         let i = getu code (pc + 1) in
-        let _, state, instrs = get_global state instrs i loc in
+        let _, state, instrs = get_global ~target:infos.target state instrs i loc in
         compile infos (pc + 2) state instrs
     | PUSHGETGLOBAL ->
         let state = State.push state loc in
         let i = getu code (pc + 1) in
-        let _, state, instrs = get_global state instrs i loc in
+        let _, state, instrs = get_global ~target:infos.target state instrs i loc in
         compile infos (pc + 2) state instrs
     | GETGLOBALFIELD ->
         let i = getu code (pc + 1) in
-        let x, state, instrs = get_global state instrs i loc in
+        let x, state, instrs = get_global ~target:infos.target state instrs i loc in
         let j = getu code (pc + 2) in
         let y, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
@@ -1300,7 +1335,7 @@ and compile infos pc state instrs =
         let state = State.push state loc in
 
         let i = getu code (pc + 1) in
-        let x, state, instrs = get_global state instrs i loc in
+        let x, state, instrs = get_global ~target:infos.target state instrs i loc in
         let j = getu code (pc + 2) in
         let y, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
@@ -1325,7 +1360,7 @@ and compile infos pc state instrs =
         in
         let x, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = 0@." Var.print x;
-        let instrs = register_global g i loc instrs in
+        let instrs = register_global ~target:infos.target g i loc instrs in
         compile infos (pc + 2) state ((Let (x, const 0l), loc) :: instrs)
     | ATOM0 ->
         let x, state = State.fresh_var state loc in
@@ -1696,10 +1731,17 @@ and compile infos pc state instrs =
                   , Addr.Set.empty )
               , loc ) )
             !compiled_blocks;
-        compile_block infos.blocks infos.debug code handler_addr handler_state;
         compile_block
           infos.blocks
           infos.debug
+          ~target:infos.target
+          code
+          handler_addr
+          handler_state;
+        compile_block
+          infos.blocks
+          infos.debug
+          ~target:infos.target
           code
           body_addr
           { (State.push_handler handler_ctx_state) with
@@ -1723,6 +1765,7 @@ and compile infos pc state instrs =
         compile_block
           infos.blocks
           infos.debug
+          ~target:infos.target
           code
           addr
           (State.pop 4 (State.pop_handler state));
@@ -2426,7 +2469,7 @@ type one =
   ; debug : Debug.t
   }
 
-let parse_bytecode code globals debug_data =
+let parse_bytecode code globals debug_data ~target =
   let state = State.initial globals in
   Code.Var.reset ();
   let blocks = Blocks.analyse debug_data code in
@@ -2441,7 +2484,7 @@ let parse_bytecode code globals debug_data =
     if not (Blocks.is_empty blocks')
     then (
       let start = 0 in
-      compile_block blocks' debug_data code start state;
+      compile_block blocks' debug_data ~target code start state;
       let blocks =
         Addr.Map.mapi
           (fun _ (state, instr, last) ->
@@ -2625,12 +2668,12 @@ let from_exe
     Ocaml_compiler.Symtable.GlobalMap.iter symbols ~f:(fun id n ->
         globals.named_value.(n) <- Some (Ocaml_compiler.Symtable.Global.name id);
         globals.is_exported.(n) <- true);
-  let p = parse_bytecode code globals debug_data in
+  let p = parse_bytecode code globals debug_data ~target in
   (* register predefined exception *)
   let body =
     List.fold_left predefined_exceptions ~init:[] ~f:(fun body (i, name) ->
         globals.named_value.(i) <- Some name;
-        let body = register_global ~force:true globals i noloc body in
+        let body = register_global ~target ~force:true globals i noloc body in
         globals.is_exported.(i) <- false;
         body)
   in
@@ -2638,7 +2681,7 @@ let from_exe
     Array.fold_right_i globals.constants ~init:body ~f:(fun i _ l ->
         match globals.vars.(i) with
         | Some x when globals.is_const.(i) ->
-            let l = register_global globals i noloc l in
+            let l = register_global globals ~target i noloc l in
             (Let (x, Constant globals.constants.(i)), noloc) :: l
         | _ -> l)
   in
@@ -2754,7 +2797,7 @@ let from_bytes ~prims ~debug (code : bytecode) =
     t
   in
   let globals = make_globals 0 [||] prims in
-  let p = parse_bytecode code globals debug_data in
+  let p = parse_bytecode code globals debug_data ~target:`JavaScript in
   let gdata = Var.fresh_n "global_data" in
   let need_gdata = ref false in
   let find_name i =
@@ -2902,7 +2945,7 @@ let from_compilation_units ~target ~includes:_ ~include_cmis ~debug_data l =
     let l = List.map l ~f:(fun (_, c) -> Bytes.to_string c) in
     String.concat ~sep:"" l
   in
-  let prog = parse_bytecode code globals debug_data in
+  let prog = parse_bytecode code globals debug_data ~target in
   let gdata = Var.fresh_n "global_data" in
   let need_gdata = ref false in
   let body =
@@ -2911,7 +2954,7 @@ let from_compilation_units ~target ~includes:_ ~include_cmis ~debug_data l =
         | Some x when globals.is_const.(i) -> (
             match globals.named_value.(i) with
             | None ->
-                let l = register_global globals i noloc l in
+                let l = register_global ~target globals i noloc l in
                 let cst = globals.constants.(i) in
                 (match cst, Code.Var.get_name x with
                 | String str, None -> Code.Var.name x (Printf.sprintf "cst_%s" str)
@@ -3026,7 +3069,7 @@ let from_channel ic =
           `Exe
       | _ -> raise Magic_number.(Bad_magic_number (to_string magic)))
 
-let predefined_exceptions () =
+let predefined_exceptions ~target =
   let body =
     let open Code in
     List.map predefined_exceptions ~f:(fun (index, name) ->
@@ -3035,25 +3078,45 @@ let predefined_exceptions () =
         let v_name = Var.fresh () in
         let v_name_js = Var.fresh () in
         let v_index = Var.fresh () in
-        [ Let (v_name, Constant (String name)), noloc
-        ; Let (v_name_js, Constant (NativeString (Native_string.of_string name))), noloc
-        ; ( Let
-              ( v_index
-              , Constant
-                  (Int
-                     ( (* Predefined exceptions are registered in
-                          Symtable.init with [-index - 1] *)
-                       Regular
-                     , Int32.of_int (-index - 1) )) )
-          , noloc )
-        ; Let (exn, Block (248, [| v_name; v_index |], NotArray)), noloc
-        ; ( Let
-              ( Var.fresh ()
-              , Prim
-                  ( Extern "caml_register_global"
-                  , [ Pc (Int (Regular, Int32.of_int index)); Pv exn; Pv v_name_js ] ) )
-          , noloc )
-        ])
+        [ Let (v_name, Constant (String name)), noloc ]
+        @ (match target with
+          | `Wasm -> []
+          | `JavaScript ->
+              [ ( Let (v_name_js, Constant (NativeString (Native_string.of_string name)))
+                , noloc )
+              ])
+        @ [ ( Let
+                ( v_index
+                , Constant
+                    (Int
+                       ( (* Predefined exceptions are registered in
+                            Symtable.init with [-index - 1] *)
+                         Regular
+                       , Int32.of_int (-index - 1) )) )
+            , noloc )
+          ; Let (exn, Block (248, [| v_name; v_index |], NotArray)), noloc
+          ; ( Let
+                ( Var.fresh ()
+                , Prim
+                    ( Extern "caml_register_global"
+                    , [ Pc (Int (Regular, Int32.of_int index))
+                      ; Pv exn
+                      ; Pv
+                          (match target with
+                          | `JavaScript -> v_name_js
+                          | `Wasm -> v_name)
+                      ] ) )
+            , noloc )
+          ]
+        @
+        match target with
+        | `JavaScript -> []
+        | `Wasm ->
+            [ ( Let
+                  ( Var.fresh ()
+                  , Prim (Extern "caml_set_global", [ Pc (String name); Pv exn ]) )
+              , noloc )
+            ])
     |> List.concat
   in
   let block = { params = []; body; branch = Stop, noloc } in
diff --git a/compiler/lib/parse_bytecode.mli b/compiler/lib/parse_bytecode.mli
index f357266b1f..5500e4f4ab 100644
--- a/compiler/lib/parse_bytecode.mli
+++ b/compiler/lib/parse_bytecode.mli
@@ -90,7 +90,7 @@ val from_string :
   -> string
   -> Code.program * Debug.t
 
-val predefined_exceptions : unit -> Code.program * Unit_info.t
+val predefined_exceptions : target:[ `JavaScript | `Wasm ] -> Code.program * Unit_info.t
 
 val link_info :
      target:[ `JavaScript | `Wasm ]
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index b42bf70279..11efcc6f99 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -270,8 +270,14 @@ end
 module Value = struct
   let value : W.value_type = I32
 
+  let block_type = return value
+
   let unit = Arith.const 1l
 
+  let dummy_block = unit
+
+  let as_block e = e
+
   let val_int i = Arith.((i lsl const 1l) + const 1l)
 
   let int_val i = Arith.(i asr const 1l)
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 28406bf9b5..0665a99129 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -407,6 +407,19 @@ end
 module Value = struct
   let value = Type.value
 
+  let block_type =
+    let* t = Type.block_type in
+    return (W.Ref { nullable = false; typ = Type t })
+
+  let dummy_block =
+    let* t = Type.block_type in
+    return (W.ArrayNewFixed (t, []))
+
+  let as_block e =
+    let* t = Type.block_type in
+    let* e = e in
+    return (W.RefCast ({ nullable = false; typ = Type t }, e))
+
   let unit = return (W.RefI31 (Const (I32 0l)))
 
   let val_int = Arith.to_int31
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index eb28a1435d..397b130fb7 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -151,6 +151,36 @@ module Generate (Target : Wa_target_sig.S) = struct
         Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:(Int32.to_int arity)
     | Prim (Extern "caml_alloc_dummy_infix", _) when Poly.(target = `GC) ->
         Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:1
+    | Prim (Extern "caml_get_global", [ Pc (String name) ]) ->
+        let* x =
+          let* context = get_context in
+          match
+            List.find_map
+              ~f:(fun f ->
+                match f with
+                | W.Global { name = V name'; exported_name = Some exported_name; _ }
+                  when String.equal exported_name name -> Some name'
+                | _ -> None)
+              context.other_fields
+          with
+          | Some x -> return x
+          | _ ->
+              let* typ = Value.block_type in
+              register_import ~import_module:"OCaml" ~name (Global { mut = true; typ })
+        in
+        return (W.GlobalGet (V x))
+    | Prim (Extern "caml_set_global", [ Pc (String name); v ]) ->
+        let v = transl_prim_arg v in
+        let x = Var.fresh_n name in
+        let* () =
+          let* typ = Value.block_type in
+          let* dummy = Value.dummy_block in
+          register_global (V x) ~exported_name:name { mut = true; typ } dummy
+        in
+        seq
+          (let* v = Value.as_block v in
+           instr (W.GlobalSet (V x, v)))
+          Value.unit
     | Prim (p, l) -> (
         match p with
         | Extern name when Hashtbl.mem internal_primitives name ->
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 18902e242a..cf4fe96fa8 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -181,6 +181,12 @@ module type S = sig
     val int_lsr : expression -> expression -> expression
 
     val int_asr : expression -> expression -> expression
+
+    val block_type : Wa_ast.value_type Wa_code_generation.t
+
+    val dummy_block : expression
+
+    val as_block : expression -> expression
   end
 
   module Constant : sig

From a7f25df50f482ccca3f150a7a51fbc2bf7b4c915 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 17:42:46 +0100
Subject: [PATCH 240/481] JSON serialization of build and unit info

---
 compiler/lib/build_info.ml  | 11 +++++++++++
 compiler/lib/build_info.mli |  4 ++++
 compiler/lib/unit_info.ml   | 35 +++++++++++++++++++++++++++++++++++
 compiler/lib/unit_info.mli  |  4 ++++
 4 files changed, 54 insertions(+)

diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml
index c9e21131fe..261d4fef56 100644
--- a/compiler/lib/build_info.ml
+++ b/compiler/lib/build_info.ml
@@ -90,6 +90,17 @@ let parse s =
       in
       Some t
 
+let to_json info : Yojson.Basic.t =
+  `Assoc (info |> StringMap.bindings |> List.map ~f:(fun (k, v) -> k, `String v))
+
+let from_json (info : Yojson.Basic.t) =
+  let open Yojson.Basic.Util in
+  info
+  |> to_assoc
+  |> List.fold_left
+       ~f:(fun m (k, v) -> StringMap.add k (to_string v) m)
+       ~init:StringMap.empty
+
 exception
   Incompatible_build_info of
     { key : string
diff --git a/compiler/lib/build_info.mli b/compiler/lib/build_info.mli
index 9bb1254a78..918200d27e 100644
--- a/compiler/lib/build_info.mli
+++ b/compiler/lib/build_info.mli
@@ -34,6 +34,10 @@ val to_string : t -> string
 
 val parse : string -> t option
 
+val to_json : t -> Yojson.Basic.t
+
+val from_json : Yojson.Basic.t -> t
+
 val with_kind : t -> kind -> t
 
 exception
diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml
index 900f9aea97..e3f5296001 100644
--- a/compiler/lib/unit_info.ml
+++ b/compiler/lib/unit_info.ml
@@ -140,3 +140,38 @@ let parse acc s =
       | Some ("Effects_without_cps", b) ->
           Some { acc with effects_without_cps = bool_of_string (String.trim b) }
       | Some (_, _) -> None)
+
+let to_json t : Yojson.Basic.t =
+  let add nm skip v rem = if skip then rem else (nm, v) :: rem in
+  let set nm f rem =
+    add
+      nm
+      (List.equal ~eq:String.equal (f empty) (f t))
+      (`List (List.map ~f:(fun x -> `String x) (f t)))
+      rem
+  in
+  let bool nm f rem = add nm (Bool.equal (f empty) (f t)) (`Bool (f t)) rem in
+  `Assoc
+    ([]
+    |> bool "effects_without_cps" (fun t -> t.effects_without_cps)
+    |> set "primitives" (fun t -> t.primitives)
+    |> bool "force_link" (fun t -> t.force_link)
+    |> set "requires" (fun t -> StringSet.elements t.requires)
+    |> add "provides" false (`String (StringSet.choose t.provides)))
+
+let from_json t =
+  let open Yojson.Basic.Util in
+  let opt_list l = l |> to_option to_list |> Option.map ~f:(List.map ~f:to_string) in
+  let list default l = Option.value ~default (opt_list l) in
+  let set default l =
+    Option.value ~default (Option.map ~f:StringSet.of_list (opt_list l))
+  in
+  let bool default v = Option.value ~default (to_option to_bool v) in
+  { provides = t |> member "provides" |> to_string |> StringSet.singleton
+  ; requires = t |> member "requires" |> set empty.requires
+  ; primitives = t |> member "primitives" |> list empty.primitives
+  ; force_link = t |> member "force_link" |> bool empty.force_link
+  ; effects_without_cps =
+      t |> member "effects_without_cps" |> bool empty.effects_without_cps
+  ; crcs = StringMap.empty
+  }
diff --git a/compiler/lib/unit_info.mli b/compiler/lib/unit_info.mli
index 848905accd..806f9e0f2b 100644
--- a/compiler/lib/unit_info.mli
+++ b/compiler/lib/unit_info.mli
@@ -39,3 +39,7 @@ val prefix : string
 val to_string : t -> string
 
 val parse : t -> string -> t option
+
+val to_json : t -> Yojson.Basic.t
+
+val from_json : Yojson.Basic.t -> t

From d1902c0b052fd0340cfc42f4bd7b51957cd0d39f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 17:43:30 +0100
Subject: [PATCH 241/481] Code generation changes

---
 compiler/bin-wasm_of_ocaml/compile.ml    |   7 +-
 compiler/lib/wasm/wa_code_generation.ml  |   4 +
 compiler/lib/wasm/wa_code_generation.mli |   3 +
 compiler/lib/wasm/wa_core_target.ml      |   2 +-
 compiler/lib/wasm/wa_gc_target.ml        |  15 ++-
 compiler/lib/wasm/wa_generate.ml         | 145 ++++++++++++++++++-----
 compiler/lib/wasm/wa_generate.mli        |  16 ++-
 compiler/lib/wasm/wa_target_sig.ml       |   3 +-
 8 files changed, 155 insertions(+), 40 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 303d32fcd2..88198d48da 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -222,7 +222,12 @@ let run
         one.debug
         code
     in
-    let generated_js = Wa_generate.f ch ~debug ~live_vars ~in_cps p in
+    let context = Wa_generate.start () in
+    let toplevel_name, generated_js =
+      Wa_generate.f ~context ~unit_name:None ~live_vars ~in_cps p
+    in
+    Wa_generate.add_start_function ~context toplevel_name;
+    Wa_generate.output ch ~context ~debug;
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
     generated_js
   in
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 7e63b6e0ed..e6aa0b3e22 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -41,6 +41,7 @@ type context =
   ; mutable fragments : Javascript.expression StringMap.t
   ; mutable globalized_variables : Var.Set.t
   ; value_type : W.value_type
+  ; mutable unit_name : string option
   }
 
 let make_context ~value_type =
@@ -65,6 +66,7 @@ let make_context ~value_type =
   ; fragments = StringMap.empty
   ; globalized_variables = Var.Set.empty
   ; value_type
+  ; unit_name = None
   }
 
 type var =
@@ -242,6 +244,8 @@ let get_closure_env f st = Var.Map.find f st.context.closure_envs, st
 
 let is_closure f st = Var.Map.mem f st.context.closure_envs, st
 
+let unit_name st = st.context.unit_name, st
+
 let var x st =
   try Var.Map.find x st.vars, st
   with Not_found -> Expr (return (Hashtbl.find st.context.constants x)), st
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 4c454a1cbb..848e5ea60b 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -25,6 +25,7 @@ type context =
   ; mutable fragments : Javascript.expression StringMap.t
   ; mutable globalized_variables : Code.Var.Set.t
   ; value_type : Wa_ast.value_type
+  ; mutable unit_name : string option
   }
 
 val make_context : value_type:Wa_ast.value_type -> context
@@ -164,6 +165,8 @@ val get_closure_env : Code.Var.t -> Code.Var.t t
 
 val is_closure : Code.Var.t -> bool t
 
+val unit_name : string option t
+
 val need_apply_fun : cps:bool -> arity:int -> Code.Var.t t
 
 val need_curry_fun : cps:bool -> arity:int -> Code.Var.t t
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 11efcc6f99..0db0786ae4 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -640,7 +640,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
 
 let post_process_function_body ~param_names:_ ~locals:_ instrs = instrs
 
-let entry_point ~context:_ ~toplevel_fun =
+let entry_point ~toplevel_fun =
   let code =
     let declare_global name =
       register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 0665a99129..d2a3da1f5d 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -978,8 +978,12 @@ module Constant = struct
         in
         let* i = register_string s in
         let* x =
+          let* name = unit_name in
           register_import
-            ~import_module:"strings"
+            ~import_module:
+              (match name with
+              | None -> "strings"
+              | Some name -> name ^ ".strings")
             ~name:(string_of_int i)
             (Global { mut = false; typ = Ref { nullable = false; typ = Any } })
         in
@@ -1379,8 +1383,12 @@ module JavaScript = struct
 
   let invoke_fragment name args =
     let* f =
+      let* unit = unit_name in
       register_import
-        ~import_module:"fragments"
+        ~import_module:
+          (match unit with
+          | None -> "fragments"
+          | Some unit -> unit ^ ".fragments")
         ~name
         (Fun { params = List.map ~f:(fun _ -> anyref) args; result = [ anyref ] })
     in
@@ -1689,7 +1697,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
 
 let post_process_function_body = Wa_initialize_locals.f
 
-let entry_point ~context ~toplevel_fun =
+let entry_point ~toplevel_fun =
   let suspender = Code.Var.fresh () in
   let code =
     let* f =
@@ -1703,7 +1711,6 @@ let entry_point ~context ~toplevel_fun =
     let* _ = add_var suspender in
     let* s = load suspender in
     let* () = instr (W.CallInstr (f, [ s ])) in
-    let* () = init_code context in
     let* main =
       register_import
         ~name:"caml_main"
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 397b130fb7..36aa729897 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -795,7 +795,15 @@ module Generate (Target : Wa_target_sig.S) = struct
       ~fall_through
       ~context
 
-  let translate_function p ctx name_opt toplevel_name params ((pc, _) as cont) acc =
+  let translate_function
+      p
+      ctx
+      name_opt
+      ~toplevel_name
+      ~unit_name
+      params
+      ((pc, _) as cont)
+      acc =
     let stack_info =
       Stack.generate_spilling_information
         p
@@ -1022,7 +1030,10 @@ module Generate (Target : Wa_target_sig.S) = struct
           (match name_opt with
           | None -> toplevel_name
           | Some x -> x)
-      ; exported_name = None
+      ; exported_name =
+          (match name_opt with
+          | None -> Option.map ~f:(fun name -> name ^ ".init") unit_name
+          | Some _ -> None)
       ; param_names
       ; typ = func_type param_count
       ; locals
@@ -1030,9 +1041,32 @@ module Generate (Target : Wa_target_sig.S) = struct
       }
     :: acc
 
-  let entry_point ctx toplevel_fun entry_name =
-    let typ, param_names, body = entry_point ~context:ctx.global_context ~toplevel_fun in
-    let locals, body = function_body ~context:ctx.global_context ~param_names ~body in
+  let init_function ~context ~to_link =
+    let name = Code.Var.fresh_n "initialize" in
+    let typ = { W.params = []; result = [ Value.value ] } in
+    let locals, body =
+      function_body
+        ~context
+        ~param_names:[]
+        ~body:
+          (List.fold_right
+             ~f:(fun name cont ->
+               let* f =
+                 register_import ~import_module:"OCaml" ~name:(name ^ ".init") (Fun typ)
+               in
+               let* () = instr (Drop (Call (f, []))) in
+               cont)
+             ~init:(instr (Push (RefI31 (Const (I32 0l)))))
+             to_link)
+    in
+    context.other_fields <-
+      W.Function { name; exported_name = None; typ; param_names = []; locals; body }
+      :: context.other_fields;
+    name
+
+  let entry_point context toplevel_fun entry_name =
+    let typ, param_names, body = entry_point ~toplevel_fun in
+    let locals, body = function_body ~context ~param_names ~body in
     W.Function
       { name = Var.fresh_n "entry_point"
       ; exported_name = Some entry_name
@@ -1044,35 +1078,58 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   module Curry = Wa_curry.Make (Target)
 
+  let add_start_function ~context toplevel_name =
+    context.other_fields <-
+      entry_point context toplevel_name "_initialize" :: context.other_fields
+
+  let add_init_function ~context ~to_link =
+    add_start_function ~context (init_function ~context ~to_link)
+
   let f
+      ~context:global_context
+      ~unit_name
       (p : Code.program)
       ~live_vars
       ~in_cps (*
     ~should_export
     ~warn_on_unhandled_effect
       _debug *) =
+    global_context.unit_name <- unit_name;
     let p, closures = Wa_closure_conversion.f p in
     (*
   Code.Print.program (fun _ _ -> "") p;
 *)
-    let ctx =
-      { live = live_vars
-      ; in_cps
-      ; blocks = p.blocks
-      ; closures
-      ; global_context = make_context ~value_type:Value.value
-      }
-    in
+    let ctx = { live = live_vars; in_cps; blocks = p.blocks; closures; global_context } in
     let toplevel_name = Var.fresh_n "toplevel" in
     let functions =
       Code.fold_closures_outermost_first
         p
         (fun name_opt params cont ->
-          translate_function p ctx name_opt toplevel_name params cont)
+          translate_function p ctx name_opt ~toplevel_name ~unit_name params cont)
         []
     in
-    Curry.f ~context:ctx.global_context;
-    let start_function = entry_point ctx toplevel_name "_initialize" in
+    let functions =
+      List.map
+        ~f:(fun f ->
+          match f with
+          | W.Function ({ name; _ } as f) when Code.Var.equal name toplevel_name ->
+              W.Function { f with body = global_context.init_code @ f.body }
+          | _ -> f)
+        functions
+    in
+    global_context.init_code <- [];
+    global_context.other_fields <- List.rev_append functions global_context.other_fields;
+    let js_code =
+      List.rev global_context.strings, StringMap.bindings global_context.fragments
+    in
+    global_context.string_count <- 0;
+    global_context.strings <- [];
+    global_context.string_index <- StringMap.empty;
+    global_context.fragments <- StringMap.empty;
+    toplevel_name, js_code
+
+  let output ~context =
+    Curry.f ~context;
     let imports =
       List.concat
         (List.map
@@ -1081,19 +1138,15 @@ module Generate (Target : Wa_target_sig.S) = struct
                ~f:(fun (import_name, (name, desc)) ->
                  W.Import { import_module; import_name; name; desc })
                (StringMap.bindings m))
-           (StringMap.bindings ctx.global_context.imports))
+           (StringMap.bindings context.imports))
     in
     let constant_data =
       List.map
         ~f:(fun (name, (active, contents)) ->
           W.Data { name; read_only = true; active; contents })
-        (Var.Map.bindings ctx.global_context.data_segments)
+        (Var.Map.bindings context.data_segments)
     in
-    ( List.rev_append
-        ctx.global_context.other_fields
-        (imports @ functions @ (start_function :: constant_data))
-    , ( List.rev ctx.global_context.strings
-      , StringMap.bindings ctx.global_context.fragments ) )
+    List.rev_append context.other_fields (imports @ constant_data)
 end
 
 let init () =
@@ -1149,16 +1202,48 @@ let fix_switch_branches p =
     p.blocks;
   !p'
 
-let f ch (p : Code.program) ~live_vars ~in_cps ~debug =
+let start () =
+  make_context
+    ~value_type:
+      (match target with
+      | `Core -> Wa_core_target.Value.value
+      | `GC -> Wa_gc_target.Value.value)
+
+let f ~context ~unit_name p ~live_vars ~in_cps =
   let p = if Config.Flag.effects () then fix_switch_branches p else p in
   match target with
   | `Core ->
       let module G = Generate (Wa_core_target) in
-      let fields, js_code = G.f ~live_vars ~in_cps p in
-      Wa_asm_output.f ch fields;
-      js_code
+      G.f ~context ~unit_name ~live_vars ~in_cps p
+  | `GC ->
+      let module G = Generate (Wa_gc_target) in
+      G.f ~context ~unit_name ~live_vars ~in_cps p
+
+let add_start_function =
+  match target with
+  | `Core ->
+      let module G = Generate (Wa_core_target) in
+      G.add_start_function
+  | `GC ->
+      let module G = Generate (Wa_gc_target) in
+      G.add_start_function
+
+let add_init_function =
+  match target with
+  | `Core ->
+      let module G = Generate (Wa_core_target) in
+      G.add_init_function
+  | `GC ->
+      let module G = Generate (Wa_gc_target) in
+      G.add_init_function
+
+let output ch ~context ~debug =
+  match target with
+  | `Core ->
+      let module G = Generate (Wa_core_target) in
+      let fields = G.output ~context in
+      Wa_asm_output.f ch fields
   | `GC ->
       let module G = Generate (Wa_gc_target) in
-      let fields, js_code = G.f ~live_vars ~in_cps p in
-      Wa_wat_output.f ~debug ch fields;
-      js_code
+      let fields = G.output ~context in
+      Wa_wat_output.f ~debug ch fields
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index 8684e875b4..0ff7c7d782 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -1,9 +1,21 @@
 val init : unit -> unit
 
+val start : unit -> Wa_code_generation.context
+
 val f :
-     out_channel
+     context:Wa_code_generation.context
+  -> unit_name:string option
   -> Code.program
   -> live_vars:int array
   -> in_cps:Effects.in_cps
+  -> Wa_ast.var * (string list * (string * Javascript.expression) list)
+
+val add_start_function : context:Wa_code_generation.context -> Wa_ast.var -> unit
+
+val add_init_function : context:Wa_code_generation.context -> to_link:string list -> unit
+
+val output :
+     out_channel
+  -> context:Wa_code_generation.context
   -> debug:Parse_bytecode.Debug.t
-  -> string list * (string * Javascript.expression) list
+  -> unit
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index cf4fe96fa8..8dabb7df31 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -307,7 +307,6 @@ module type S = sig
     -> Wa_ast.instruction list
 
   val entry_point :
-       context:Wa_code_generation.context
-    -> toplevel_fun:Wa_ast.var
+       toplevel_fun:Wa_ast.var
     -> Wa_ast.func_type * Wa_ast.var list * unit Wa_code_generation.t
 end

From 2d66d6acebb7c19960535b6cdb60358491996271 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 17:44:46 +0100
Subject: [PATCH 242/481] Reading/writing zip file

---
 compiler/lib/wasm/zip.ml  | 451 ++++++++++++++++++++++++++++++++++++++
 compiler/lib/wasm/zip.mli |  27 +++
 2 files changed, 478 insertions(+)
 create mode 100644 compiler/lib/wasm/zip.ml
 create mode 100644 compiler/lib/wasm/zip.mli

diff --git a/compiler/lib/wasm/zip.ml b/compiler/lib/wasm/zip.ml
new file mode 100644
index 0000000000..f175a9b9d1
--- /dev/null
+++ b/compiler/lib/wasm/zip.ml
@@ -0,0 +1,451 @@
+let stdlib_close_out = close_out
+
+open Stdlib
+
+module type CRC = sig
+  type t
+
+  val start : t
+
+  val update_from_bytes : bytes -> int -> int -> t -> t
+
+  val update_from_string : string -> int -> int -> t -> t
+
+  val finish : t -> int32
+end
+
+module CRC32 : CRC = struct
+  let compute_table () =
+    let open Int32 in
+    let tbl = Array.make 256 zero in
+    let poly = 0xedb88320l in
+    for i = 0 to 255 do
+      let n = ref (of_int i) in
+      for _ = 0 to 7 do
+        if logand !n one = one
+        then n := logxor (shift_right_logical !n 1) poly
+        else n := shift_right_logical !n 1
+      done;
+      tbl.(i) <- !n
+    done;
+    tbl
+
+  module CRC32 : CRC with type t = int32 = struct
+    type t = int32
+
+    let table = lazy (compute_table ())
+
+    let start = 0xffffffffl
+
+    let update_from_bytes s pos len crc =
+      assert (pos >= 0 && len >= 0 && pos <= Bytes.length s - len);
+      let open Int32 in
+      let tbl = Lazy.force table in
+      let crc = ref crc in
+      for i = pos to pos + len - 1 do
+        crc :=
+          logxor
+            (shift_right_logical !crc 8)
+            (Array.unsafe_get
+               tbl
+               (to_int !crc land 0xff lxor Char.code (Bytes.unsafe_get s i)))
+      done;
+      !crc
+
+    let update_from_string s pos len crc =
+      assert (pos >= 0 && len >= 0 && pos <= String.length s - len);
+      let open Int32 in
+      let tbl = Lazy.force table in
+      let crc = ref crc in
+      for i = pos to pos + len - 1 do
+        crc :=
+          logxor
+            (shift_right_logical !crc 8)
+            (Array.unsafe_get tbl (to_int !crc land 0xff lxor Char.code s.[i]))
+      done;
+      !crc
+
+    let finish crc = Int32.(logxor crc start)
+  end
+
+  module CRC64 : CRC with type t = int = struct
+    type t = int
+
+    let start = (1 lsl 32) - 1
+
+    let next_table tbl tbl' =
+      lazy
+        (let tbl = Lazy.force tbl in
+         let tbl' = Lazy.force tbl' in
+         Array.init 256 ~f:(fun i -> (tbl'.(i) lsr 8) lxor tbl.(tbl'.(i) land 0xFF)))
+
+    let table1 =
+      lazy (Array.map ~f:(fun i -> Int32.to_int i land start) (compute_table ()))
+
+    let table2 = next_table table1 table1
+
+    let table3 = next_table table1 table2
+
+    let table4 = next_table table1 table3
+
+    let table5 = next_table table1 table4
+
+    let table6 = next_table table1 table5
+
+    let table7 = next_table table1 table6
+
+    let table8 = next_table table1 table7
+
+    let update_from_bytes s pos len crc =
+      assert (pos >= 0 && len >= 0 && pos <= Bytes.length s - len);
+      let tbl1 = Lazy.force table1 in
+      let tbl2 = Lazy.force table2 in
+      let tbl3 = Lazy.force table3 in
+      let tbl4 = Lazy.force table4 in
+      let tbl5 = Lazy.force table5 in
+      let tbl6 = Lazy.force table6 in
+      let tbl7 = Lazy.force table7 in
+      let tbl8 = Lazy.force table8 in
+      let crc = ref crc in
+      for i = 0 to (len / 8) - 1 do
+        let pos = pos + (i lsl 3) in
+        crc :=
+          let crc = !crc in
+          Array.unsafe_get tbl8 (crc lxor Char.code (Bytes.unsafe_get s pos) land 0xff)
+          lxor Array.unsafe_get
+                 tbl7
+                 ((crc lsr 8) lxor Char.code (Bytes.unsafe_get s (pos + 1)) land 0xff)
+          lxor (Array.unsafe_get
+                  tbl6
+                  ((crc lsr 16) lxor Char.code (Bytes.unsafe_get s (pos + 2)) land 0xff)
+               lxor Array.unsafe_get
+                      tbl5
+                      ((crc lsr 24) lxor Char.code (Bytes.unsafe_get s (pos + 3))))
+          lxor (Array.unsafe_get tbl4 (Char.code (Bytes.unsafe_get s (pos + 4)))
+               lxor Array.unsafe_get tbl3 (Char.code (Bytes.unsafe_get s (pos + 5)))
+               lxor Array.unsafe_get tbl2 (Char.code (Bytes.unsafe_get s (pos + 6)))
+               lxor Array.unsafe_get tbl1 (Char.code (Bytes.unsafe_get s (pos + 7))))
+      done;
+      for i = pos + (len land -8) to pos + len - 1 do
+        crc :=
+          (!crc lsr 8)
+          lxor Array.unsafe_get tbl1 (!crc land 0xff lxor Char.code (Bytes.unsafe_get s i))
+      done;
+      !crc
+
+    let update_from_string s pos len crc =
+      assert (pos >= 0 && len >= 0 && pos <= String.length s - len);
+      let tbl = Lazy.force table1 in
+      let crc = ref crc in
+      for i = pos to pos + len - 1 do
+        crc := (!crc lsr 8) lxor Array.unsafe_get tbl (!crc land 0xff lxor Char.code s.[i])
+      done;
+      !crc
+
+    let finish crc = Int32.of_int (crc lxor start)
+  end
+
+  module Repr = Sys.Immediate64.Make (Int) (Int32)
+
+  include
+    (val match Repr.repr with
+         | Immediate -> (module CRC64 : CRC)
+         | Non_immediate -> (module CRC32 : CRC)
+        : CRC)
+end
+
+let buffer = lazy (Bytes.create 65536)
+
+let copy in_ch out_ch ?(iter = fun _ _ _ -> ()) len =
+  let buffer = Lazy.force buffer in
+  let buffer_len = Bytes.length buffer in
+  let rec copy rem =
+    if rem > 0
+    then (
+      let n = input in_ch buffer 0 (min buffer_len rem) in
+      if n = 0 then raise End_of_file;
+      iter buffer 0 n;
+      output out_ch buffer 0 n;
+      copy (rem - n))
+  in
+  copy len
+
+type file =
+  { name : string
+  ; pos : int
+  ; len : int
+  ; mutable crc : int32
+  }
+
+type output =
+  { ch : out_channel
+  ; mutable files : file list
+  }
+
+let open_out name = { ch = open_out_bin name; files = [] }
+
+let output_16 ch c =
+  output_byte ch c;
+  output_byte ch (c lsr 8)
+
+let output_32 ch c =
+  output_16 ch c;
+  output_16 ch (c lsr 16)
+
+let output_crc ch crc =
+  output_16 ch (Int32.to_int crc);
+  output_16 ch (Int32.to_int (Int32.shift_right_logical crc 16))
+
+let output_local_file_header ch ?(crc = 0l) { name; len; _ } =
+  output_32 ch 0x04034b50;
+  (* version needed to extract *)
+  output_16 ch 10;
+  (* general purpose but flag *)
+  output_16 ch 0x0;
+  (* compression method *)
+  output_16 ch 0x0;
+  (* time / date *)
+  output_16 ch 0x0;
+  output_16 ch 0x5821;
+  (* CRC *)
+  let crc_pos = pos_out ch in
+  output_crc ch crc;
+  (* compressed / uncompressed size *)
+  output_32 ch len;
+  output_32 ch len;
+  (* file name length *)
+  output_16 ch (String.length name);
+  (* extra field length *)
+  output_16 ch 0;
+  (* file name *)
+  output_string ch name;
+  crc_pos
+
+let add_file z ~name ~file =
+  let ch = open_in_bin file in
+  let pos = pos_out z.ch in
+  let len = in_channel_length ch in
+  let file = { name; pos; len; crc = 0l } in
+  z.files <- file :: z.files;
+  let crc_pos = output_local_file_header z.ch file in
+  let crc = ref CRC32.start in
+  copy ch z.ch ~iter:(fun b pos len -> crc := CRC32.update_from_bytes b pos len !crc) len;
+  let crc = CRC32.finish !crc in
+  file.crc <- crc;
+  let pos = pos_out z.ch in
+  seek_out z.ch crc_pos;
+  output_crc z.ch crc;
+  seek_out z.ch pos
+
+let add_entry z ~name ~contents =
+  let pos = pos_out z.ch in
+  let len = String.length contents in
+  let crc = CRC32.start |> CRC32.update_from_string contents 0 len |> CRC32.finish in
+  let file = { name; pos; len; crc } in
+  z.files <- file :: z.files;
+  let _crc_pos = output_local_file_header z.ch ~crc file in
+  output_string z.ch contents
+
+let output_file_header ch { name; pos; len; crc } =
+  output_32 ch 0x02014b50;
+  (* versions: made by / needed to extract *)
+  output_16 ch 10;
+  output_16 ch 10;
+  (* general purpose but flag *)
+  output_16 ch 0x0;
+  (* compression method *)
+  output_16 ch 0x0;
+  (* time / date *)
+  output_16 ch 0x0;
+  output_16 ch 0x5821;
+  (* CRC *)
+  output_crc ch crc;
+  (* compressed / uncompressed size *)
+  output_32 ch len;
+  output_32 ch len;
+  (* file name length *)
+  output_16 ch (String.length name);
+  (* extra field length *)
+  output_16 ch 0;
+  (* file comment length *)
+  output_16 ch 0;
+  (* disk number start *)
+  output_16 ch 0;
+  (* file attributes *)
+  output_16 ch 0;
+  output_32 ch 0;
+  (* relative offset of local header *)
+  output_32 ch pos;
+  (* file name *)
+  output_string ch name
+
+let output_end_of_directory z pos len =
+  let ch = z.ch in
+  output_32 ch 0x06054b50;
+  (* disk numbers *)
+  output_16 ch 0;
+  output_16 ch 0;
+  (* number of entries *)
+  let n = List.length z.files in
+  output_16 ch n;
+  output_16 ch n;
+  (* size of the central directory *)
+  output_32 ch len;
+  (* offset of the central directory *)
+  output_32 ch pos;
+  (* comment length *)
+  output_16 ch 0
+
+let output_directory z =
+  let pos = pos_out z.ch in
+  List.iter ~f:(output_file_header z.ch) (List.rev z.files);
+  let pos' = pos_out z.ch in
+  output_end_of_directory z pos (pos' - pos)
+
+let close_out z =
+  output_directory z;
+  close_out z.ch
+
+(****)
+
+type entry =
+  { pos : int
+  ; len : int
+  ; crc : int32
+  }
+
+let input_16 ch =
+  let c = input_byte ch in
+  c lor (input_byte ch lsl 8)
+
+let input_32 ch =
+  let c = input_16 ch in
+  c lor (input_16 ch lsl 16)
+
+let input_32' ch =
+  let c = input_16 ch in
+  Int32.(logor (of_int c) (shift_left (of_int (input_16 ch)) 16))
+
+let read_local_file_header ch pos =
+  let pos = pos + 14 in
+  seek_in ch pos;
+  let crc = input_32' ch in
+  let _ = input_32 ch in
+  let len = input_32 ch in
+  let name_len = input_16 ch in
+  let extra_len = input_16 ch in
+  { pos = pos + 16 + name_len + extra_len; len; crc }
+
+let read_file_header ch =
+  let signature = input_32' ch in
+  if not (Int32.equal signature 0x02014b50l) then failwith "bad signature";
+  (* versions: made by / needed to extract *)
+  ignore (input_16 ch);
+  let v = input_16 ch in
+  if v > 10 then failwith "unsupported file format";
+  (* general purpose but flag *)
+  ignore (input_16 ch);
+  (* compression method *)
+  ignore (input_16 ch);
+  (* time / date *)
+  ignore (input_32 ch);
+  (* CRC *)
+  ignore (input_32' ch);
+  (* compressed / uncompressed size *)
+  ignore (input_32 ch);
+  ignore (input_32 ch);
+  (* file name length *)
+  let name_len = input_16 ch in
+  (* extra field length *)
+  let extra_len = input_16 ch in
+  (* file comment length *)
+  let comment_len = input_16 ch in
+  (* disk number start *)
+  ignore (input_16 ch);
+  (* file attributes *)
+  ignore (input_16 ch);
+  ignore (input_32 ch);
+  (* relative offset of local header *)
+  let pos = input_32 ch in
+  (* file name *)
+  let name = really_input_string ch name_len in
+  ignore (really_input_string ch extra_len);
+  ignore (really_input_string ch comment_len);
+  name, pos
+
+type input =
+  { ch : in_channel
+  ; files : int StringMap.t
+  }
+
+let open_in name =
+  let ch = open_in_bin name in
+  let len = in_channel_length ch in
+  let find_directory_end offset =
+    seek_in ch (len - 22 - offset);
+    let c = ref 0l in
+    let p = ref (-1) in
+    for i = 0 to offset + 3 do
+      (c := Int32.(add (shift_left !c 8) (of_int (input_byte ch))));
+      if Int32.equal !c 0x504b0506l then p := 22 + 3 + offset - i
+    done;
+    !p
+  in
+  let p = find_directory_end 0 in
+  let p = if p = -1 then find_directory_end 65535 else p in
+  if p = -1 then failwith "not a ZIP file";
+  seek_in ch (len - p + 10);
+  (* number of entries *)
+  let n = input_16 ch in
+  (* size of the directory *)
+  ignore (input_32 ch);
+  (* offset of the directory *)
+  let offset = input_32 ch in
+  seek_in ch offset;
+  let m = ref StringMap.empty in
+  for _ = 0 to n - 1 do
+    let name, entry = read_file_header ch in
+    m := StringMap.add name entry !m
+  done;
+  { ch; files = !m }
+
+let with_open_in name f =
+  let z = open_in name in
+  Fun.protect ~finally:(fun () -> close_in_noerr z.ch) (fun () -> f z)
+
+let get_pos z ~name =
+  try StringMap.find name z.files
+  with Not_found -> failwith (Printf.sprintf "File %s not found in archive" name)
+
+let has_entry z ~name = StringMap.mem name z.files
+
+let read_entry z ~name =
+  let pos = get_pos z ~name in
+  let { pos; len; _ } = read_local_file_header z.ch pos in
+  seek_in z.ch pos;
+  really_input_string z.ch len
+
+let get_entry z ~name =
+  let pos = get_pos z ~name in
+  let { pos; len; _ } = read_local_file_header z.ch pos in
+  z.ch, pos, len
+
+let extract_file z ~name ~file =
+  let pos = get_pos z ~name in
+  let { pos; len; _ } = read_local_file_header z.ch pos in
+  seek_in z.ch pos;
+  let ch = open_out_bin file in
+  copy z.ch ch len;
+  stdlib_close_out ch
+
+let close_in z = close_in z.ch
+
+let copy_file z (z' : output) ~src_name ~dst_name =
+  let pos = StringMap.find src_name z.files in
+  let { pos; len; crc } = read_local_file_header z.ch pos in
+  seek_in z.ch pos;
+  let pos' = pos_out z'.ch in
+  let file = { name = dst_name; pos = pos'; len; crc } in
+  z'.files <- file :: z'.files;
+  let _ = output_local_file_header z'.ch ~crc file in
+  copy z.ch z'.ch len
diff --git a/compiler/lib/wasm/zip.mli b/compiler/lib/wasm/zip.mli
new file mode 100644
index 0000000000..ac81ebe825
--- /dev/null
+++ b/compiler/lib/wasm/zip.mli
@@ -0,0 +1,27 @@
+type output
+
+val open_out : string -> output
+
+val add_entry : output -> name:string -> contents:string -> unit
+
+val add_file : output -> name:string -> file:string -> unit
+
+val close_out : output -> unit
+
+type input
+
+val open_in : string -> input
+
+val with_open_in : string -> (input -> 'a) -> 'a
+
+val has_entry : input -> name:string -> bool
+
+val read_entry : input -> name:string -> string
+
+val get_entry : input -> name:string -> in_channel * int (* pos *) * int (* len *)
+
+val extract_file : input -> name:string -> file:string -> unit
+
+val copy_file : input -> output -> src_name:string -> dst_name:string -> unit
+
+val close_in : input -> unit

From 555cb4ecdb9e2704b1c9b6415681532587818fa6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Mar 2024 18:39:28 +0100
Subject: [PATCH 243/481] Separate compilation

---
 compiler/bin-wasm_of_ocaml/build_runtime.ml  |  33 ++
 compiler/bin-wasm_of_ocaml/build_runtime.mli |  20 +
 compiler/bin-wasm_of_ocaml/cmd_arg.ml        |  95 +++-
 compiler/bin-wasm_of_ocaml/cmd_arg.mli       |   5 +-
 compiler/bin-wasm_of_ocaml/compile.ml        | 282 ++++++++---
 compiler/bin-wasm_of_ocaml/link.ml           |  87 ++++
 compiler/bin-wasm_of_ocaml/link.mli          |  20 +
 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml  |   2 +-
 compiler/lib/parse_bytecode.ml               |   2 +-
 compiler/lib/wasm/wa_link.ml                 | 486 ++++++++++++++++++-
 compiler/lib/wasm/wa_link.mli                |  33 +-
 runtime/wasm/runtime.js                      |  51 +-
 12 files changed, 1000 insertions(+), 116 deletions(-)
 create mode 100644 compiler/bin-wasm_of_ocaml/build_runtime.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/build_runtime.mli
 create mode 100644 compiler/bin-wasm_of_ocaml/link.ml
 create mode 100644 compiler/bin-wasm_of_ocaml/link.mli

diff --git a/compiler/bin-wasm_of_ocaml/build_runtime.ml b/compiler/bin-wasm_of_ocaml/build_runtime.ml
new file mode 100644
index 0000000000..b0dbc4fb1a
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/build_runtime.ml
@@ -0,0 +1,33 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open! Js_of_ocaml_compiler.Stdlib
+
+let info =
+  Info.make
+    ~name:"build-runtime"
+    ~doc:"Build standalone runtime. Used for separate compilation."
+    ~description:
+      "Js_of_ocaml is a compiler from OCaml bytecode to Javascript. It makes it possible \
+       to run pure OCaml programs in JavaScript environments like web browsers and \
+       Node.js."
+
+let command =
+  let t = Cmdliner.Term.(const Compile.run $ Cmd_arg.options_runtime_only) in
+  Cmdliner.Cmd.v info t
diff --git a/compiler/bin-wasm_of_ocaml/build_runtime.mli b/compiler/bin-wasm_of_ocaml/build_runtime.mli
new file mode 100644
index 0000000000..969933f7a7
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/build_runtime.mli
@@ -0,0 +1,20 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val command : unit Cmdliner.Cmd.t
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index f2e12cfd3d..b1b414f594 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -44,8 +44,9 @@ type t =
   ; (* compile option *)
     profile : Driver.profile option
   ; runtime_files : string list
+  ; runtime_only : bool
   ; output_file : string * bool
-  ; input_file : string
+  ; input_file : string option
   ; enable_source_maps : bool
   ; sourcemap_root : string option
   ; sourcemap_don't_inline_content : bool
@@ -113,9 +114,17 @@ let options =
       runtime_files =
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let output_file =
+      let ext =
+        try
+          snd
+            (List.find
+               ~f:(fun (ext, _) -> Filename.check_suffix input_file ext)
+               [ ".cmo", ".wasmo"; ".cma", ".wasma" ])
+        with Not_found -> ".js"
+      in
       match output_file with
       | Some s -> s, true
-      | None -> chop_extension input_file ^ ".js", false
+      | None -> chop_extension input_file ^ ext, false
     in
     let params : (string * string) list = List.flatten set_param in
     let enable_source_maps = (not no_sourcemap) && sourcemap in
@@ -126,8 +135,9 @@ let options =
       ; include_dirs
       ; profile
       ; output_file
-      ; input_file
+      ; input_file = Some input_file
       ; runtime_files
+      ; runtime_only = false
       ; enable_source_maps
       ; sourcemap_root
       ; sourcemap_don't_inline_content
@@ -149,3 +159,82 @@ let options =
       $ runtime_files)
   in
   Term.ret t
+
+let options_runtime_only =
+  let runtime_files =
+    let doc = "Link JavaScript and WebAssembly files [$(docv)]. " in
+    Arg.(value & pos_all string [] & info [] ~docv:"RUNTIME_FILES" ~doc)
+  in
+  let output_file =
+    let doc = "Set output file name to [$(docv)]." in
+    Arg.(required & opt (some string) None & info [ "o" ] ~docv:"FILE" ~doc)
+  in
+  let no_sourcemap =
+    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
+  in
+  let sourcemap =
+    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    Arg.(value & flag & info [ "sourcemap"; "source-map"; "source-map-inline" ] ~doc)
+  in
+  let sourcemap_don't_inline_content =
+    let doc = "Do not inline sources in source map." in
+    Arg.(value & flag & info [ "source-map-no-source" ] ~doc)
+  in
+  let sourcemap_root =
+    let doc = "root dir for source map." in
+    Arg.(value & opt (some string) None & info [ "source-map-root" ] ~doc)
+  in
+  let include_dirs =
+    let doc = "Add [$(docv)] to the list of include directories." in
+    Arg.(value & opt_all string [] & info [ "I" ] ~docv:"DIR" ~doc)
+  in
+  let set_param =
+    let doc = "Set compiler options." in
+    let all = List.map (Config.Param.all ()) ~f:(fun (x, _) -> x, x) in
+    Arg.(
+      value
+      & opt_all (list (pair ~sep:'=' (enum all) string)) []
+      & info [ "set" ] ~docv:"PARAM=VALUE" ~doc)
+  in
+  let build_t
+      common
+      set_param
+      include_dirs
+      sourcemap
+      no_sourcemap
+      sourcemap_don't_inline_content
+      sourcemap_root
+      output_file
+      runtime_files =
+    let params : (string * string) list = List.flatten set_param in
+    let enable_source_maps = (not no_sourcemap) && sourcemap in
+    let include_dirs = normalize_include_dirs include_dirs in
+    `Ok
+      { common
+      ; params
+      ; include_dirs
+      ; profile = None
+      ; output_file = output_file, true
+      ; input_file = None
+      ; runtime_files
+      ; runtime_only = true
+      ; enable_source_maps
+      ; sourcemap_root
+      ; sourcemap_don't_inline_content
+      }
+  in
+  let t =
+    Term.(
+      const build_t
+      $ Jsoo_cmdline.Arg.t
+      $ set_param
+      $ include_dirs
+      $ sourcemap
+      $ no_sourcemap
+      $ sourcemap_don't_inline_content
+      $ sourcemap_root
+      $ output_file
+      $ runtime_files)
+  in
+  Term.ret t
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
index fd9de45dd5..0bacf92e10 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.mli
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
@@ -24,8 +24,9 @@ type t =
   ; (* compile option *)
     profile : Driver.profile option
   ; runtime_files : string list
+  ; runtime_only : bool
   ; output_file : string * bool
-  ; input_file : string
+  ; input_file : string option
   ; enable_source_maps : bool
   ; sourcemap_root : string option
   ; sourcemap_don't_inline_content : bool
@@ -34,3 +35,5 @@ type t =
   }
 
 val options : t Cmdliner.Term.t
+
+val options_runtime_only : t Cmdliner.Term.t
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 88198d48da..b91be415cf 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -121,7 +121,54 @@ let link_and_optimize
     opt_sourcemap_file;
   primitives
 
-let build_js_runtime ~primitives ~runtime_arguments =
+let link_runtime ~profile runtime_wasm_files output_file =
+  Fs.with_intermediate_file (Filename.temp_file "runtime" ".wasm")
+  @@ fun runtime_file ->
+  Fs.write_file ~name:runtime_file ~contents:Wa_runtime.wasm_runtime;
+  Fs.with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
+  @@ fun temp_file ->
+  Wa_binaryen.link
+    ~opt_output_sourcemap:None
+    ~runtime_files:(runtime_file :: runtime_wasm_files)
+    ~input_files:[]
+    ~output_file:temp_file;
+  Wa_binaryen.optimize
+    ~profile
+    ~opt_input_sourcemap:None
+    ~opt_output_sourcemap:None
+    ~opt_sourcemap_url:None
+    ~input_file:temp_file
+    ~output_file
+
+let generate_prelude ~out_file =
+  Filename.gen_file out_file
+  @@ fun ch ->
+  let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`Wasm in
+  let live_vars, in_cps, p, debug =
+    Driver.f ~target:Wasm (Parse_bytecode.Debug.create ~include_cmis:false false) code
+  in
+  let context = Wa_generate.start () in
+  let _ = Wa_generate.f ~context ~unit_name:(Some "prelude") ~live_vars ~in_cps p in
+  Wa_generate.output ch ~context ~debug;
+  uinfo.provides
+
+let build_prelude z =
+  Fs.with_intermediate_file (Filename.temp_file "prelude" ".wasm")
+  @@ fun prelude_file ->
+  Fs.with_intermediate_file (Filename.temp_file "prelude_file" ".wasm")
+  @@ fun tmp_prelude_file ->
+  let predefined_exceptions = generate_prelude ~out_file:prelude_file in
+  Wa_binaryen.optimize
+    ~profile:(Driver.profile 1)
+    ~input_file:prelude_file
+    ~output_file:tmp_prelude_file
+    ~opt_input_sourcemap:None
+    ~opt_output_sourcemap:None
+    ~opt_sourcemap_url:None;
+  Zip.add_file z ~name:"prelude.wasm" ~file:tmp_prelude_file;
+  predefined_exceptions
+
+let build_js_runtime ~primitives ?runtime_arguments () =
   let always_required_js, primitives =
     let l =
       StringSet.fold
@@ -152,7 +199,11 @@ let build_js_runtime ~primitives ~runtime_arguments =
   let launcher =
     let js =
       let js = Javascript.call init_fun [ primitives ] N in
-      let js = Javascript.call js [ runtime_arguments ] N in
+      let js =
+        match runtime_arguments with
+        | None -> js
+        | Some runtime_arguments -> Javascript.call js [ runtime_arguments ] N
+      in
       [ Javascript.Expression_statement js, Javascript.N ]
     in
     Wa_link.output_js js
@@ -162,6 +213,7 @@ let build_js_runtime ~primitives ~runtime_arguments =
 let run
     { Cmd_arg.common
     ; profile
+    ; runtime_only
     ; runtime_files
     ; input_file
     ; output_file
@@ -210,101 +262,179 @@ let run
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
   let need_debug = enable_source_maps || Config.Flag.debuginfo () in
-  let output (one : Parse_bytecode.one) ~standalone ch =
+  let output (one : Parse_bytecode.one) ~unit_name ch =
     let code = one.code in
+    let standalone = Option.is_none unit_name in
     let live_vars, in_cps, p, debug =
-      Driver.f
-        ~target:Wasm
-        ~standalone
-        ?profile
-        ~linkall:false
-        ~wrap_with_fun:`Iife
-        one.debug
-        code
+      Driver.f ~target:Wasm ~standalone ?profile one.debug code
     in
     let context = Wa_generate.start () in
     let toplevel_name, generated_js =
-      Wa_generate.f ~context ~unit_name:None ~live_vars ~in_cps p
+      Wa_generate.f ~context ~unit_name ~live_vars ~in_cps p
     in
-    Wa_generate.add_start_function ~context toplevel_name;
+    if standalone then Wa_generate.add_start_function ~context toplevel_name;
     Wa_generate.output ch ~context ~debug;
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
     generated_js
   in
-  (let kind, ic, close_ic, include_dirs =
-     let ch = open_in_bin input_file in
-     let res = Parse_bytecode.from_channel ch in
-     let include_dirs = Filename.dirname input_file :: include_dirs in
-     res, ch, (fun () -> close_in ch), include_dirs
-   in
-   (match kind with
-   | `Exe ->
+  (if runtime_only
+   then (
+     Fs.gen_file output_file
+     @@ fun tmp_output_file ->
+     Fs.with_intermediate_file (Filename.temp_file "wasm" ".wasm")
+     @@ fun tmp_wasm_file ->
+     link_runtime ~profile runtime_wasm_files tmp_wasm_file;
+     let primitives =
+       tmp_wasm_file
+       |> (fun file -> Wa_link.Wasm_binary.read_imports ~file)
+       |> List.filter_map ~f:(fun { Wa_link.Wasm_binary.module_; name; _ } ->
+              if String.equal module_ "js" then Some name else None)
+       |> StringSet.of_list
+     in
+     let js_runtime = build_js_runtime ~primitives () in
+     let z = Zip.open_out tmp_output_file in
+     Zip.add_file z ~name:"runtime.wasm" ~file:tmp_wasm_file;
+     Zip.add_entry z ~name:"runtime.js" ~contents:js_runtime;
+     let predefined_exceptions = build_prelude z in
+     Wa_link.add_info
+       z
+       ~predefined_exceptions
+       ~build_info:(Build_info.create `Runtime)
+       ~unit_data:[]
+       ();
+     Zip.close_out z)
+   else
+     let kind, ic, close_ic, include_dirs =
+       let input_file =
+         match input_file with
+         | None -> assert false
+         | Some f -> f
+       in
+       let ch = open_in_bin input_file in
+       let res = Parse_bytecode.from_channel ch in
+       let include_dirs = Filename.dirname input_file :: include_dirs in
+       res, ch, (fun () -> close_in ch), include_dirs
+     in
+     let compile_cmo z cmo =
        let t1 = Timer.make () in
-       (* The OCaml compiler can generate code using the
-          "caml_string_greaterthan" primitive but does not use it
-          itself. This is (was at some point at least) the only primitive
-          in this case.  Ideally, Js_of_ocaml should parse the .mli files
-          for primitives as well as marking this primitive as potentially
-          used. But the -linkall option is probably good enough. *)
        let code =
-         Parse_bytecode.from_exe
+         Parse_bytecode.from_cmo
            ~target:`Wasm
            ~includes:include_dirs
-           ~include_cmis:false
-           ~link_info:false
-           ~linkall:false
            ~debug:need_debug
+           cmo
            ic
        in
-       if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-       Fs.gen_file (Filename.chop_extension output_file ^ ".wat")
+       let unit_info = Unit_info.of_cmo cmo in
+       let unit_name = StringSet.choose unit_info.provides in
+       if times () then Format.eprintf "  parsing: %a (%s)@." Timer.print t1 unit_name;
+       Fs.with_intermediate_file (Filename.temp_file unit_name ".wat")
        @@ fun wat_file ->
-       let wasm_file =
-         if Filename.check_suffix output_file ".wasm.js"
-         then Filename.chop_extension output_file
-         else Filename.chop_extension output_file ^ ".wasm"
-       in
-       Fs.gen_file wasm_file
+       Fs.with_intermediate_file (Filename.temp_file unit_name ".wasm")
        @@ fun tmp_wasm_file ->
-       opt_with
-         Fs.gen_file
-         (if enable_source_maps then Some (wasm_file ^ ".map") else None)
-       @@ fun opt_tmp_sourcemap ->
-       let generated_js = output_gen wat_file (output code ~standalone:true) in
-       let primitives =
-         link_and_optimize
-           ~profile
-           ~sourcemap_root
-           ~sourcemap_don't_inline_content
-           ~opt_sourcemap:opt_tmp_sourcemap
-           ~opt_sourcemap_url:
-             (if enable_source_maps
-              then Some (Filename.basename wasm_file ^ ".map")
-              else None)
-           runtime_wasm_files
-           [ wat_file ]
-           tmp_wasm_file
+       Fs.with_intermediate_file (Filename.temp_file unit_name ".wasm.map")
+       @@ fun tmp_map_file ->
+       let strings, fragments =
+         output_gen wat_file (output code ~unit_name:(Some unit_name))
        in
-       let js_runtime =
-         let missing_primitives =
-           let l = Wa_link.Wasm_binary.read_imports ~file:tmp_wasm_file in
-           List.filter_map
-             ~f:(fun { Wa_link.Wasm_binary.module_; name; _ } ->
-               if String.equal module_ "env" then Some name else None)
-             l
-         in
-         build_js_runtime
-           ~primitives
-           ~runtime_arguments:
-             (Wa_link.build_runtime_arguments
-                ~missing_primitives
-                ~wasm_file
-                ~generated_js)
+       let opt_output_sourcemap =
+         if enable_source_maps then Some tmp_map_file else None
        in
-       Fs.gen_file output_file
-       @@ fun tmp_output_file -> Fs.write_file ~name:tmp_output_file ~contents:js_runtime
-   | `Cmo _ | `Cma _ -> assert false);
-   close_ic ());
+       Wa_binaryen.optimize
+         ~profile
+         ~opt_input_sourcemap:None
+         ~opt_output_sourcemap
+         ~opt_sourcemap_url:
+           (if enable_source_maps then Some (unit_name ^ ".wasm.map") else None)
+         ~input_file:wat_file
+         ~output_file:tmp_wasm_file;
+       Option.iter
+         ~f:(update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content)
+         opt_output_sourcemap;
+       Zip.add_file z ~name:(unit_name ^ ".wasm") ~file:tmp_wasm_file;
+       if enable_source_maps
+       then Zip.add_file z ~name:(unit_name ^ ".wasm.map") ~file:tmp_map_file;
+       { Wa_link.unit_info; strings; fragments }
+     in
+     (match kind with
+     | `Exe ->
+         let t1 = Timer.make () in
+         let code =
+           Parse_bytecode.from_exe
+             ~target:`Wasm
+             ~includes:include_dirs
+             ~include_cmis:false
+             ~link_info:false
+             ~linkall:false
+             ~debug:need_debug
+             ic
+         in
+         if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
+         Fs.gen_file (Filename.chop_extension output_file ^ ".wat")
+         @@ fun wat_file ->
+         let wasm_file =
+           if Filename.check_suffix output_file ".wasm.js"
+           then Filename.chop_extension output_file
+           else Filename.chop_extension output_file ^ ".wasm"
+         in
+         Fs.gen_file wasm_file
+         @@ fun tmp_wasm_file ->
+         opt_with
+           Fs.gen_file
+           (if enable_source_maps then Some (wasm_file ^ ".map") else None)
+         @@ fun opt_tmp_sourcemap ->
+         let generated_js = output_gen wat_file (output code ~unit_name:None) in
+         let primitives =
+           link_and_optimize
+             ~profile
+             ~sourcemap_root
+             ~sourcemap_don't_inline_content
+             ~opt_sourcemap:opt_tmp_sourcemap
+             ~opt_sourcemap_url:
+               (if enable_source_maps
+                then Some (Filename.basename wasm_file ^ ".map")
+                else None)
+             runtime_wasm_files
+             [ wat_file ]
+             tmp_wasm_file
+         in
+         let js_runtime =
+           let missing_primitives =
+             let l = Wa_link.Wasm_binary.read_imports ~file:tmp_wasm_file in
+             List.filter_map
+               ~f:(fun { Wa_link.Wasm_binary.module_; name; _ } ->
+                 if String.equal module_ "env" then Some name else None)
+               l
+           in
+           build_js_runtime
+             ~primitives
+             ~runtime_arguments:
+               (Wa_link.build_runtime_arguments
+                  ~missing_primitives
+                  ~wasm_file
+                  ~generated_js:[ None, generated_js ]
+                  ())
+             ()
+         in
+         Fs.gen_file output_file
+         @@ fun tmp_output_file ->
+         Fs.write_file ~name:tmp_output_file ~contents:js_runtime
+     | `Cmo cmo ->
+         Fs.gen_file output_file
+         @@ fun tmp_output_file ->
+         let z = Zip.open_out tmp_output_file in
+         let unit_data = [ compile_cmo z cmo ] in
+         Wa_link.add_info z ~build_info:(Build_info.create `Cmo) ~unit_data ();
+         Zip.close_out z
+     | `Cma cma ->
+         Fs.gen_file output_file
+         @@ fun tmp_output_file ->
+         let z = Zip.open_out tmp_output_file in
+         let unit_data = List.map ~f:(fun cmo -> compile_cmo z cmo) cma.lib_units in
+         let unit_data = Wa_link.simplify_unit_info unit_data in
+         Wa_link.add_info z ~build_info:(Build_info.create `Cma) ~unit_data ();
+         Zip.close_out z);
+     close_ic ());
   Debug.stop_profiling ()
 
 let info name =
diff --git a/compiler/bin-wasm_of_ocaml/link.ml b/compiler/bin-wasm_of_ocaml/link.ml
new file mode 100644
index 0000000000..7fa8011249
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/link.ml
@@ -0,0 +1,87 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open! Js_of_ocaml_compiler.Stdlib
+open Wasm_of_ocaml_compiler
+open Cmdliner
+
+type t =
+  { common : Jsoo_cmdline.Arg.t
+  ; files : string list
+  ; output_file : string
+  ; linkall : bool
+  ; enable_source_maps : bool
+  }
+
+let options =
+  let output_file =
+    let doc = "Set output file name to [$(docv)]." in
+    Arg.(required & opt (some string) None & info [ "o" ] ~docv:"FILE" ~doc)
+  in
+  let no_sourcemap =
+    let doc = "Disable sourcemap output." in
+    Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
+  in
+  let sourcemap =
+    let doc = "Output source locations." in
+    Arg.(value & flag & info [ "sourcemap"; "source-map"; "source-map-inline" ] ~doc)
+  in
+  let files =
+    let doc =
+      "Link the archive files [$(docv)]. The first archive must be a runtime produced by \
+       $(b,wasm_of_ocaml build-runtime). The other archives can be produced by compiling \
+       .cma or .cmo files."
+    in
+    Arg.(non_empty & pos_all string [] & info [] ~docv:"FILES" ~doc)
+  in
+  let linkall =
+    let doc = "Link all compilation units." in
+    Arg.(value & flag & info [ "linkall" ] ~doc)
+  in
+  let build_t common no_sourcemap sourcemap output_file files linkall =
+    let enable_source_maps = (not no_sourcemap) && sourcemap in
+    `Ok { common; output_file; files; linkall; enable_source_maps }
+  in
+  let t =
+    Term.(
+      const build_t
+      $ Jsoo_cmdline.Arg.t
+      $ no_sourcemap
+      $ sourcemap
+      $ output_file
+      $ files
+      $ linkall)
+  in
+  Term.ret t
+
+let f { common; output_file; files; linkall; enable_source_maps } =
+  Jsoo_cmdline.Arg.eval common;
+  Wa_link.link ~output_file ~linkall ~enable_source_maps ~files
+
+let info =
+  Info.make
+    ~name:"link"
+    ~doc:"Wasm_of_ocaml linker"
+    ~description:
+      "wasm_of_ocaml-link is a JavaScript linker. It can concatenate multiple JavaScript \
+       files keeping sourcemap information."
+
+let command =
+  let t = Cmdliner.Term.(const f $ options) in
+  Cmdliner.Cmd.v info t
diff --git a/compiler/bin-wasm_of_ocaml/link.mli b/compiler/bin-wasm_of_ocaml/link.mli
new file mode 100644
index 0000000000..969933f7a7
--- /dev/null
+++ b/compiler/bin-wasm_of_ocaml/link.mli
@@ -0,0 +1,20 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+val command : unit Cmdliner.Cmd.t
diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
index 313c8bb412..1ea4787d2d 100644
--- a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
+++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
@@ -50,7 +50,7 @@ let () =
         (Cmdliner.Cmd.group
            ~default:Compile.term
            (Compile.info "wasm_of_ocaml")
-           [ Compile.command ])
+           [ Link.command; Build_runtime.command; Compile.command ])
     with
     | Ok (`Ok () | `Help | `Version) ->
         if !warnings > 0 && !werror
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 29c2078cff..22568f8323 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -2681,7 +2681,7 @@ let from_exe
     Array.fold_right_i globals.constants ~init:body ~f:(fun i _ l ->
         match globals.vars.(i) with
         | Some x when globals.is_const.(i) ->
-            let l = register_global globals ~target i noloc l in
+            let l = register_global ~target globals i noloc l in
             (Let (x, Constant globals.constants.(i)), noloc) :: l
         | _ -> l)
   in
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index bf31c084a9..d9edfab906 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -19,6 +19,8 @@
 
 open Stdlib
 
+let times = Debug.find "times"
+
 module Wasm_binary = struct
   let header = "\000asm\001\000\000\000"
 
@@ -37,6 +39,11 @@ module Wasm_binary = struct
     check_header f ch;
     { ch; limit = in_channel_length ch }
 
+  let from_channel ~name ch pos len =
+    seek_in ch pos;
+    check_header name ch;
+    { ch; limit = pos + len }
+
   let rec read_uint ?(n = 5) ch =
     let i = input_byte ch in
     if n = 1 then assert (i < 16);
@@ -133,6 +140,16 @@ module Wasm_binary = struct
     in
     { module_; name }
 
+  let export ch =
+    let name = name ch in
+    let d = read_uint ch in
+    if d > 4
+    then (
+      Format.eprintf "Unknown export %x@." d;
+      assert false);
+    ignore (read_uint ch);
+    name
+
   let read_imports ~file =
     let ch = open_in file in
     let rec find_section () =
@@ -147,8 +164,151 @@ module Wasm_binary = struct
     let res = if find_section () then vec import ch.ch else [] in
     close_in ch.ch;
     res
+
+  type interface =
+    { imports : import list
+    ; exports : string list
+    }
+
+  let read_interface ch =
+    let rec find_sections i =
+      match next_section ch with
+      | None -> i
+      | Some s ->
+          if s.id = 2
+          then find_sections { i with imports = vec import ch.ch }
+          else if s.id = 7
+          then { i with exports = vec export ch.ch }
+          else (
+            skip_section ch s;
+            find_sections i)
+    in
+    find_sections { imports = []; exports = [] }
 end
 
+let trim_semi s =
+  let l = ref (String.length s) in
+  while
+    !l > 0
+    &&
+    match s.[!l - 1] with
+    | ';' | '\n' -> true
+    | _ -> false
+  do
+    decr l
+  done;
+  String.sub s ~pos:0 ~len:!l
+
+type unit_data =
+  { unit_info : Unit_info.t
+  ; strings : string list
+  ; fragments : (string * Javascript.expression) list
+  }
+
+let info_to_json ~predefined_exceptions ~build_info ~unit_data =
+  let add nm skip v rem = if skip then rem else (nm, v) :: rem in
+  let units =
+    List.map
+      ~f:(fun { unit_info; strings; fragments } ->
+        `Assoc
+          (Unit_info.to_json unit_info
+          |> Yojson.Basic.Util.to_assoc
+          |> add
+               "strings"
+               (List.is_empty strings)
+               (`List (List.map ~f:(fun s -> `String s) strings))
+          |> add
+               "fragments"
+               (List.is_empty fragments)
+               (`String (Marshal.to_string fragments []))))
+      unit_data
+  in
+  `Assoc
+    ([]
+    |> add
+         "predefined_exceptions"
+         (StringSet.is_empty predefined_exceptions)
+         (`List
+           (List.map ~f:(fun s -> `String s) (StringSet.elements predefined_exceptions)))
+    |> add "units" (List.is_empty unit_data) (`List units)
+    |> add "build_info" false (Build_info.to_json build_info))
+
+let info_from_json info =
+  let open Yojson.Basic.Util in
+  let build_info = info |> member "build_info" |> Build_info.from_json in
+  let predefined_exceptions =
+    info
+    |> member "predefined_exceptions"
+    |> to_option to_list
+    |> Option.value ~default:[]
+    |> List.map ~f:to_string
+    |> StringSet.of_list
+  in
+  let unit_data =
+    info
+    |> member "units"
+    |> to_option to_list
+    |> Option.value ~default:[]
+    |> List.map ~f:(fun u ->
+           let unit_info = u |> Unit_info.from_json in
+           let strings =
+             u
+             |> member "strings"
+             |> to_option to_list
+             |> Option.value ~default:[]
+             |> List.map ~f:to_string
+           in
+           let fragments =
+             u
+             |> member "fragments"
+             |> to_option to_string
+             |> Option.map ~f:(fun s -> Marshal.from_string s 0)
+             |> Option.value ~default:[]
+             (*
+                           |> to_option to_assoc
+                           |> Option.value ~default:[]
+                           |> List.map ~f:(fun (nm, e) ->
+                                  ( nm
+                                  , let lex = Parse_js.Lexer.of_string (to_string e) in
+                                    Parse_js.parse_expr lex ))*)
+           in
+           { unit_info; strings; fragments })
+  in
+  build_info, predefined_exceptions, unit_data
+
+let add_info z ?(predefined_exceptions = StringSet.empty) ~build_info ~unit_data () =
+  Zip.add_entry
+    z
+    ~name:"info.json"
+    ~contents:
+      (Yojson.Basic.to_string
+         (info_to_json ~predefined_exceptions ~build_info ~unit_data))
+
+let read_info z =
+  info_from_json (Yojson.Basic.from_string (Zip.read_entry z ~name:"info.json"))
+
+let generate_start_function ~to_link ~out_file =
+  let t1 = Timer.make () in
+  Fs.gen_file out_file
+  @@ fun wasm_file ->
+  let wat_file = Filename.chop_extension out_file ^ ".wat" in
+  (Filename.gen_file wat_file
+  @@ fun ch ->
+  let context = Wa_generate.start () in
+  Wa_generate.add_init_function ~context ~to_link:("prelude" :: to_link);
+  Wa_generate.output
+    ch
+    ~context
+    ~debug:(Parse_bytecode.Debug.create ~include_cmis:false false));
+  Wa_binaryen.optimize
+    ~profile:(Driver.profile 1)
+    ~opt_input_sourcemap:None
+    ~opt_output_sourcemap:None
+    ~opt_sourcemap_url:None
+    ~input_file:wat_file
+    ~output_file:wasm_file;
+  if times () then Format.eprintf "    generate start: %a@." Timer.print t1
+
 let output_js js =
   Code.Var.reset ();
   let b = Buffer.create 1024 in
@@ -182,11 +342,14 @@ let report_missing_primitives missing =
     List.iter ~f:(fun nm -> warn "  %s@." nm) missing)
 
 let build_runtime_arguments
+    ?(link_spec = [])
+    ?(separate_compilation = false)
     ~missing_primitives
     ~wasm_file
-    ~generated_js:(strings, fragments) =
+    ~generated_js
+    () =
   let missing_primitives = if Config.Flag.genprim () then missing_primitives else [] in
-  report_missing_primitives missing_primitives;
+  if not separate_compilation then report_missing_primitives missing_primitives;
   let obj l =
     Javascript.EObj
       (List.map
@@ -196,21 +359,31 @@ let build_runtime_arguments
          l)
   in
   let generated_js =
-    let strings =
-      if List.is_empty strings
-      then []
-      else
-        [ ( "strings"
-          , Javascript.EArr
-              (List.map
-                 ~f:(fun s -> Javascript.Element (EStr (Utf8_string.of_string_exn s)))
-                 strings) )
-        ]
-    in
-    let fragments =
-      if List.is_empty fragments then [] else [ "fragments", obj fragments ]
-    in
-    strings @ fragments
+    List.concat
+    @@ List.map
+         ~f:(fun (unit_name, (strings, fragments)) ->
+           let name s =
+             match unit_name with
+             | None -> s
+             | Some nm -> nm ^ "." ^ s
+           in
+           let strings =
+             if List.is_empty strings
+             then []
+             else
+               [ ( name "strings"
+                 , Javascript.EArr
+                     (List.map
+                        ~f:(fun s ->
+                          Javascript.Element (EStr (Utf8_string.of_string_exn s)))
+                        strings) )
+               ]
+           in
+           let fragments =
+             if List.is_empty fragments then [] else [ name "fragments", obj fragments ]
+           in
+           strings @ fragments)
+         generated_js
   in
   let generated_js =
     if not (List.is_empty missing_primitives)
@@ -275,6 +448,283 @@ let build_runtime_arguments
         N
   in
   obj
-    [ "generated", generated_js
+    [ ( "link"
+      , if List.is_empty link_spec
+        then ENum (Javascript.Num.of_int32 (if separate_compilation then 1l else 0l))
+        else
+          EArr
+            (List.map
+               ~f:(fun (m, deps) ->
+                 Javascript.Element
+                   (EArr
+                      [ Element (EStr (Utf8_string.of_string_exn m))
+                      ; Element
+                          (match deps with
+                          | None -> ENum (Javascript.Num.of_int32 0l)
+                          | Some l ->
+                              EArr
+                                (List.map
+                                   ~f:(fun i ->
+                                     Javascript.Element
+                                       (ENum (Javascript.Num.of_int32 (Int32.of_int i))))
+                                   l))
+                      ]))
+               link_spec) )
+    ; "generated", generated_js
     ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_file))
     ]
+
+let link_to_directory ~set_to_link ~files ~enable_source_maps ~dir =
+  let read_interface z ~name =
+    Wasm_binary.read_interface
+      (let ch, pos, len = Zip.get_entry z ~name in
+       Wasm_binary.from_channel ~name ch pos len)
+  in
+  let z = Zip.open_in (fst (List.hd files)) in
+  let runtime_intf = read_interface z ~name:"runtime.wasm" in
+  Zip.extract_file z ~name:"runtime.wasm" ~file:(Filename.concat dir "runtime.wasm");
+  Zip.extract_file z ~name:"prelude.wasm" ~file:(Filename.concat dir "prelude.wasm");
+  Zip.close_in z;
+  let intfs = ref [] in
+  List.iter
+    ~f:(fun (file, (_, units)) ->
+      let z = Zip.open_in file in
+      List.iter
+        ~f:(fun { unit_info; _ } ->
+          let unit_name = StringSet.choose unit_info.provides in
+          if StringSet.mem unit_name set_to_link
+          then (
+            let name = unit_name ^ ".wasm" in
+            intfs := read_interface z ~name :: !intfs;
+            Zip.extract_file z ~name ~file:(Filename.concat dir name);
+            let map = name ^ ".map" in
+            if enable_source_maps && Zip.has_entry z ~name:map
+            then Zip.extract_file z ~name:map ~file:(Filename.concat dir map)))
+        units;
+      Zip.close_in z)
+    files;
+  runtime_intf, List.rev !intfs
+
+(* Remove some unnecessary dependencies *)
+let simplify_unit_info l =
+  let t = Timer.make () in
+  let prev_requires = Hashtbl.create 16 in
+  let res =
+    List.map
+      ~f:(fun (unit_data : unit_data) ->
+        let info = unit_data.unit_info in
+        assert (StringSet.cardinal info.provides = 1);
+        let name = StringSet.choose info.provides in
+        assert (not (StringSet.mem name info.requires));
+        let requires =
+          StringSet.fold
+            (fun dep (requires : StringSet.t) ->
+              match Hashtbl.find prev_requires dep with
+              | exception Not_found -> requires
+              | s -> StringSet.union s requires)
+            info.requires
+            StringSet.empty
+        in
+        let info = { info with requires = StringSet.diff info.requires requires } in
+        Hashtbl.add prev_requires name (StringSet.union info.requires requires);
+        { unit_data with unit_info = info })
+      l
+  in
+  if times () then Format.eprintf "unit info simplification: %a@." Timer.print t;
+  res
+
+let compute_dependencies ~set_to_link ~files =
+  let h = Hashtbl.create 128 in
+  let l = List.concat (List.map ~f:(fun (_, (_, units)) -> units) files) in
+  (*
+  let l = simplify_unit_info l in
+  *)
+  List.filter_map
+    ~f:(fun { unit_info; _ } ->
+      let unit_name = StringSet.choose unit_info.provides in
+      if StringSet.mem unit_name set_to_link
+      then (
+        Hashtbl.add h unit_name (Hashtbl.length h);
+        Some
+          ( unit_name
+          , Some
+              (List.sort ~cmp:compare
+              @@ List.filter_map
+                   ~f:(fun req -> Option.map ~f:(fun i -> i + 2) (Hashtbl.find_opt h req))
+                   (StringSet.elements unit_info.requires)) ))
+      else None)
+    l
+
+let compute_missing_primitives (runtime_intf, intfs) =
+  let provided_primitives = StringSet.of_list runtime_intf.Wasm_binary.exports in
+  StringSet.elements
+  @@ List.fold_left
+       ~f:(fun s { Wasm_binary.imports; _ } ->
+         List.fold_left
+           ~f:(fun s { Wasm_binary.module_; name; _ } ->
+             if String.equal module_ "env" && not (StringSet.mem name provided_primitives)
+             then StringSet.add name s
+             else s)
+           ~init:s
+           imports)
+       ~init:StringSet.empty
+       intfs
+
+let load_information files =
+  match files with
+  | [] -> assert false
+  | runtime :: other_files ->
+      let build_info, predefined_exceptions, _unit_data =
+        Zip.with_open_in runtime read_info
+      in
+      ( predefined_exceptions
+      , (runtime, (build_info, []))
+        :: List.map other_files ~f:(fun file ->
+               let build_info, _predefined_exceptions, unit_data =
+                 Zip.with_open_in file read_info
+               in
+               file, (build_info, unit_data)) )
+
+let link ~output_file ~linkall ~enable_source_maps ~files =
+  let rec loop n =
+    if times () then Format.eprintf "linking@.";
+    let t = Timer.make () in
+    let predefined_exceptions, files = load_information files in
+    (match files with
+    | [] -> assert false
+    | (file, (bi, _)) :: r ->
+        (match Build_info.kind bi with
+        | `Runtime -> ()
+        | _ ->
+            failwith
+              "The first input file should be a runtime built using 'wasm_of_ocaml \
+               build-runtime'.");
+        Build_info.configure bi;
+        ignore
+          (List.fold_left
+             ~init:bi
+             ~f:(fun bi (file', (bi', _)) ->
+               (match Build_info.kind bi' with
+               | `Runtime ->
+                   failwith "The runtime file should be listed first on the command line."
+               | _ -> ());
+               Build_info.merge file bi file' bi')
+             r));
+    if times () then Format.eprintf "    reading information: %a@." Timer.print t;
+    let t1 = Timer.make () in
+    let missing, to_link =
+      List.fold_right
+        files
+        ~init:(StringSet.empty, [])
+        ~f:(fun (_file, (build_info, units)) acc ->
+          let cmo_file =
+            match Build_info.kind build_info with
+            | `Cmo -> true
+            | `Cma | `Exe | `Runtime | `Unknown -> false
+          in
+          List.fold_right units ~init:acc ~f:(fun { unit_info; _ } (requires, to_link) ->
+              if (not (Config.Flag.auto_link ()))
+                 || cmo_file
+                 || linkall
+                 || unit_info.force_link
+                 || not (StringSet.is_empty (StringSet.inter requires unit_info.provides))
+              then
+                ( StringSet.diff
+                    (StringSet.union unit_info.requires requires)
+                    unit_info.provides
+                , StringSet.elements unit_info.provides @ to_link )
+              else requires, to_link))
+    in
+    let set_to_link = StringSet.of_list to_link in
+    let files =
+      if linkall
+      then files
+      else
+        List.filter
+          ~f:(fun (_file, (build_info, units)) ->
+            (match Build_info.kind build_info with
+            | `Cma | `Exe | `Unknown -> false
+            | `Cmo | `Runtime -> true)
+            || List.exists
+                 ~f:(fun { unit_info; _ } ->
+                   StringSet.exists
+                     (fun nm -> StringSet.mem nm set_to_link)
+                     unit_info.provides)
+                 units)
+          files
+    in
+    let missing = StringSet.diff missing predefined_exceptions in
+    if not (StringSet.is_empty missing)
+    then
+      failwith
+        (Printf.sprintf
+           "Could not find compilation unit for %s"
+           (String.concat ~sep:", " (StringSet.elements missing)));
+    if times () then Format.eprintf "    finding what to link: %a@." Timer.print t1;
+    if times () then Format.eprintf "  scan: %a@." Timer.print t;
+    let t = Timer.make () in
+    let interfaces, wasm_file, link_spec =
+      let dir = Filename.chop_extension output_file ^ ".assets" in
+      Fs.gen_file dir
+      @@ fun tmp_dir ->
+      Sys.mkdir tmp_dir 0o777;
+      generate_start_function ~to_link ~out_file:(Filename.concat tmp_dir "start.wasm");
+      ( link_to_directory ~set_to_link ~files ~enable_source_maps ~dir:tmp_dir
+      , dir
+      , let to_link = compute_dependencies ~set_to_link ~files in
+        ("runtime", None) :: ("prelude", None) :: (to_link @ [ "start", None ]) )
+    in
+    let missing_primitives = compute_missing_primitives interfaces in
+    if times () then Format.eprintf "    copy wasm files: %a@." Timer.print t;
+    let t1 = Timer.make () in
+    let js_runtime =
+      match files with
+      | (file, _) :: _ ->
+          Zip.with_open_in file (fun z -> Zip.read_entry z ~name:"runtime.js")
+      | _ -> assert false
+    in
+    let generated_js =
+      List.concat
+      @@ List.map files ~f:(fun (_, (_, units)) ->
+             List.map units ~f:(fun { unit_info; strings; fragments } ->
+                 Some (StringSet.choose unit_info.provides), (strings, fragments)))
+    in
+    let runtime_args =
+      let js =
+        build_runtime_arguments
+          ~link_spec
+          ~separate_compilation:true
+          ~missing_primitives
+          ~wasm_file
+          ~generated_js
+          ()
+      in
+      output_js [ Javascript.Expression_statement js, Javascript.N ]
+    in
+    Fs.gen_file output_file
+    @@ fun tmp_output_file ->
+    Fs.write_file
+      ~name:tmp_output_file
+      ~contents:(trim_semi js_runtime ^ "\n" ^ runtime_args);
+    if times () then Format.eprintf "    build JS runtime: %a@." Timer.print t1;
+    if times () then Format.eprintf "  emit: %a@." Timer.print t;
+    if n > 0 then loop (n - 1)
+  in
+  loop 0
+
+let link ~output_file ~linkall ~enable_source_maps ~files =
+  try link ~output_file ~linkall ~enable_source_maps ~files
+  with Build_info.Incompatible_build_info { key; first = f1, v1; second = f2, v2 } ->
+    let string_of_v = function
+      | None -> "<empty>"
+      | Some v -> v
+    in
+    failwith
+      (Printf.sprintf
+         "Incompatible build info detected while linking.\n - %s: %s=%s\n - %s: %s=%s"
+         f1
+         key
+         (string_of_v v1)
+         f2
+         key
+         (string_of_v v2))
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index ee0a4dc692..3601efcc83 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -17,6 +17,8 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
+open Stdlib
+
 module Wasm_binary : sig
   type import =
     { module_ : string
@@ -26,10 +28,37 @@ module Wasm_binary : sig
   val read_imports : file:string -> import list
 end
 
+type unit_data =
+  { unit_info : Unit_info.t
+  ; strings : string list
+  ; fragments : (string * Javascript.expression) list
+  }
+
+val add_info :
+     Zip.output
+  -> ?predefined_exceptions:StringSet.t
+  -> build_info:Build_info.t
+  -> unit_data:unit_data list
+  -> unit
+  -> unit
+
 val build_runtime_arguments :
-     missing_primitives:string list
+     ?link_spec:(string * int list option) list
+  -> ?separate_compilation:bool
+  -> missing_primitives:string list
   -> wasm_file:string
-  -> generated_js:string list * (string * Javascript.expression) list
+  -> generated_js:
+       (string option * (string list * (string * Javascript.expression) list)) list
+  -> unit
   -> Javascript.expression
 
+val simplify_unit_info : unit_data list -> unit_data list
+
 val output_js : Javascript.program -> string
+
+val link :
+     output_file:string
+  -> linkall:bool
+  -> enable_source_maps:bool
+  -> files:string list
+  -> unit
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 259218f31d..2576ec624d 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,18 +1,8 @@
 ((js) => async (args) => {
     "use strict";
-    let {src, generated} = args;
-    function loadRelative(src) {
-      const path = require('path');
-      const f = path.join(path.dirname(require.main.filename),src);
-      return require('fs/promises').readFile(f)
-    }
-    function fetchRelative(src) {
-      const base = globalThis?.document?.currentScript?.src;
-      const url = base?new URL(src, base):src;
-      return fetch(url)
-    }
+    let {link, src, generated} = args;
+
     const isNode = globalThis?.process?.versions?.node;
-    const code = isNode?loadRelative(src):fetchRelative(src);
 
     let math =
         {cos:Math.cos, sin:Math.sin, tan:Math.tan,
@@ -357,9 +347,42 @@
                        env:{}},
                       generated)
     const options = { builtins: ['js-string', 'text-decoder', 'text-encoder'] }
+
+    function loadRelative(src) {
+      const path = require('path');
+      const f = path.join(path.dirname(require.main.filename),src);
+      return require('fs/promises').readFile(f)
+    }
+    function fetchRelative(src) {
+      const base = globalThis?.document?.currentScript?.src;
+      const url = base?new URL(src, base):src;
+      return fetch(url)
+    }
+    const loadCode= isNode?loadRelative:fetchRelative;
+    async function instantiateModule(code) {
+      return isNode?WebAssembly.instantiate(await code, imports, options)
+               :WebAssembly.instantiateStreaming(code,imports, options)
+    }
+    async function instantiateFromDir() {
+      imports.OCaml = {};
+      const deps = []
+      for (const module of link) {
+        const sync = module[1].constructor !== Array
+        async function instantiate () {
+          const code = loadCode(src + "/" + module[0] + ".wasm")
+          await Promise.all(sync?deps:module[1].map((i)=>deps[i]));
+          const wasmModule = await instantiateModule(code)
+          Object.assign(deps.length?imports.OCaml:imports.env,
+                        wasmModule.instance.exports);
+        }
+        deps.push(sync?await instantiate():instantiate())
+      }
+      await deps.pop();
+      return {instance:{exports: Object.assign(imports.env, imports.OCaml)}}
+    }
     const wasmModule =
-          isNode?await WebAssembly.instantiate(await code, imports, options)
-                :await WebAssembly.instantiateStreaming(code,imports, options)
+      await ((link)?instantiateFromDir()
+                   :instantiateModule(loadCode(src)))
 
     var {caml_callback, caml_alloc_tm, caml_start_fiber,
          caml_handle_uncaught_exception, caml_buffer,

From db69298196334c2884bdacb6cea5bf06779aecea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 2 Apr 2024 12:21:34 +0200
Subject: [PATCH 244/481] CI updates for separate compilation

---
 .github/workflows/build.yml | 2 +-
 dune                        | 2 ++
 tools/ci_setup.ml           | 2 +-
 3 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index efd6d6cfe9..72b8554fa0 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -123,7 +123,7 @@ jobs:
 
       - name: Pin dune
         run: |
-          opam pin add -n dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm
+          opam pin add -n dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm-separate-compilation
 
       - name: Pin wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
diff --git a/dune b/dune
index 332a723017..692e051020 100644
--- a/dune
+++ b/dune
@@ -12,10 +12,12 @@
  (wasm
   (binaries (tools/node_wrapper.sh as node))
   (js_of_ocaml
+   (compilation_mode separate)
    (targets wasm)))
  (wasm-effects
   (binaries (tools/node_wrapper.sh as node))
   (js_of_ocaml
+   (compilation_mode separate)
    (flags
     (:standard --enable effects))
    (targets wasm)))
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index fb162b2be3..c37ae4918d 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -18,7 +18,7 @@ let omitted_others = StringSet.of_list [ "cohttp-async"; "cohttp"; "uri"; "uri-s
 
 let omitted_js = StringSet.of_list [ "sexplib0" ]
 
-let do_not_pin = StringSet.of_list [ "wasocaml"; "wasm_of_ocaml" ]
+let do_not_pin = StringSet.of_list [ "wasocaml"; "wasm_of_ocaml"; "dune" ]
 
 let do_pin = StringSet.of_list [ "base"; "ppx_expect"; "ppx_inline_test"; "time_now" ]
 

From 1ef25faee5608d671fd18c2f928bc4edf077c893 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 27 Apr 2024 00:23:37 +0200
Subject: [PATCH 245/481] Limit parallelism when loading Wasm modules

---
 runtime/wasm/runtime.js | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 2576ec624d..cfdb0ca6f5 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -366,18 +366,28 @@
     async function instantiateFromDir() {
       imports.OCaml = {};
       const deps = []
-      for (const module of link) {
+      async function loadModule(module, isRuntime) {
         const sync = module[1].constructor !== Array
         async function instantiate () {
           const code = loadCode(src + "/" + module[0] + ".wasm")
           await Promise.all(sync?deps:module[1].map((i)=>deps[i]));
           const wasmModule = await instantiateModule(code)
-          Object.assign(deps.length?imports.OCaml:imports.env,
+          Object.assign(isRuntime?imports.env:imports.OCaml,
                         wasmModule.instance.exports);
         }
-        deps.push(sync?await instantiate():instantiate())
+        const promise = instantiate();
+        deps.push(promise);
+        return promise;
       }
-      await deps.pop();
+      async function loadModules(lst) {
+        for (const module of lst) {
+          await loadModule(module);
+        }
+      }
+      await loadModule(link[0], 1);
+      await loadModule(link[1]);
+      const workers = new Array(20).fill(link.slice(2).values()).map(loadModules);
+      await Promise.all(workers);
       return {instance:{exports: Object.assign(imports.env, imports.OCaml)}}
     }
     const wasmModule =

From 92080d2eb1898cb3282d0a68ec2fff3b2e2d2ff2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 6 May 2024 16:09:19 +0200
Subject: [PATCH 246/481] Use unique file names to avoid cache issues

---
 compiler/lib/wasm/wa_link.ml | 91 ++++++++++++++++++++++--------------
 compiler/lib/wasm/zip.ml     |  4 +-
 compiler/lib/wasm/zip.mli    |  3 +-
 3 files changed, 60 insertions(+), 38 deletions(-)

diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index d9edfab906..0834f3794d 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -475,35 +475,45 @@ let build_runtime_arguments
     ]
 
 let link_to_directory ~set_to_link ~files ~enable_source_maps ~dir =
-  let read_interface z ~name =
-    Wasm_binary.read_interface
-      (let ch, pos, len = Zip.get_entry z ~name in
-       Wasm_binary.from_channel ~name ch pos len)
+  let process_file z ~name =
+    let ch, pos, len, crc = Zip.get_entry z ~name:(name ^ ".wasm") in
+    let intf = Wasm_binary.read_interface (Wasm_binary.from_channel ~name ch pos len) in
+    let name' = Printf.sprintf "%s-%08lx" name crc in
+    Zip.extract_file
+      z
+      ~name:(name ^ ".wasm")
+      ~file:(Filename.concat dir (name' ^ ".wasm"));
+    name', intf
   in
   let z = Zip.open_in (fst (List.hd files)) in
-  let runtime_intf = read_interface z ~name:"runtime.wasm" in
-  Zip.extract_file z ~name:"runtime.wasm" ~file:(Filename.concat dir "runtime.wasm");
-  Zip.extract_file z ~name:"prelude.wasm" ~file:(Filename.concat dir "prelude.wasm");
+  let runtime, runtime_intf = process_file z ~name:"runtime" in
+  let prelude, _ = process_file z ~name:"prelude" in
   Zip.close_in z;
-  let intfs = ref [] in
-  List.iter
-    ~f:(fun (file, (_, units)) ->
-      let z = Zip.open_in file in
-      List.iter
-        ~f:(fun { unit_info; _ } ->
-          let unit_name = StringSet.choose unit_info.provides in
-          if StringSet.mem unit_name set_to_link
-          then (
-            let name = unit_name ^ ".wasm" in
-            intfs := read_interface z ~name :: !intfs;
-            Zip.extract_file z ~name ~file:(Filename.concat dir name);
-            let map = name ^ ".map" in
-            if enable_source_maps && Zip.has_entry z ~name:map
-            then Zip.extract_file z ~name:map ~file:(Filename.concat dir map)))
-        units;
-      Zip.close_in z)
-    files;
-  runtime_intf, List.rev !intfs
+  let lst =
+    List.map
+      ~f:(fun (file, (_, units)) ->
+        let z = Zip.open_in file in
+        let res =
+          List.map
+            ~f:(fun { unit_info; _ } ->
+              let unit_name = StringSet.choose unit_info.provides in
+              if StringSet.mem unit_name set_to_link
+              then (
+                let name = unit_name ^ ".wasm" in
+                let res = process_file z ~name:unit_name in
+                let map = name ^ ".map" in
+                if enable_source_maps && Zip.has_entry z ~name:map
+                then Zip.extract_file z ~name:map ~file:(Filename.concat dir map);
+                Some res)
+              else None)
+            units
+        in
+        Zip.close_in z;
+        List.filter_map ~f:(fun x -> x) res)
+      files
+    |> List.flatten
+  in
+  runtime :: prelude :: List.map ~f:fst lst, (runtime_intf, List.map ~f:snd lst)
 
 (* Remove some unnecessary dependencies *)
 let simplify_unit_info l =
@@ -546,12 +556,11 @@ let compute_dependencies ~set_to_link ~files =
       then (
         Hashtbl.add h unit_name (Hashtbl.length h);
         Some
-          ( unit_name
-          , Some
-              (List.sort ~cmp:compare
-              @@ List.filter_map
-                   ~f:(fun req -> Option.map ~f:(fun i -> i + 2) (Hashtbl.find_opt h req))
-                   (StringSet.elements unit_info.requires)) ))
+          (Some
+             (List.sort ~cmp:compare
+             @@ List.filter_map
+                  ~f:(fun req -> Option.map ~f:(fun i -> i + 2) (Hashtbl.find_opt h req))
+                  (StringSet.elements unit_info.requires))))
       else None)
     l
 
@@ -668,11 +677,23 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
       Fs.gen_file dir
       @@ fun tmp_dir ->
       Sys.mkdir tmp_dir 0o777;
-      generate_start_function ~to_link ~out_file:(Filename.concat tmp_dir "start.wasm");
-      ( link_to_directory ~set_to_link ~files ~enable_source_maps ~dir:tmp_dir
+      let start_module =
+        "start-"
+        ^ String.sub
+            (Digest.to_hex (Digest.string (String.concat ~sep:"/" to_link)))
+            ~pos:0
+            ~len:8
+      in
+      generate_start_function
+        ~to_link
+        ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm"));
+      let module_names, interfaces =
+        link_to_directory ~set_to_link ~files ~enable_source_maps ~dir:tmp_dir
+      in
+      ( interfaces
       , dir
       , let to_link = compute_dependencies ~set_to_link ~files in
-        ("runtime", None) :: ("prelude", None) :: (to_link @ [ "start", None ]) )
+        List.combine module_names (None :: None :: to_link) @ [ start_module, None ] )
     in
     let missing_primitives = compute_missing_primitives interfaces in
     if times () then Format.eprintf "    copy wasm files: %a@." Timer.print t;
diff --git a/compiler/lib/wasm/zip.ml b/compiler/lib/wasm/zip.ml
index f175a9b9d1..0479f96ba7 100644
--- a/compiler/lib/wasm/zip.ml
+++ b/compiler/lib/wasm/zip.ml
@@ -427,8 +427,8 @@ let read_entry z ~name =
 
 let get_entry z ~name =
   let pos = get_pos z ~name in
-  let { pos; len; _ } = read_local_file_header z.ch pos in
-  z.ch, pos, len
+  let { pos; len; crc } = read_local_file_header z.ch pos in
+  z.ch, pos, len, crc
 
 let extract_file z ~name ~file =
   let pos = get_pos z ~name in
diff --git a/compiler/lib/wasm/zip.mli b/compiler/lib/wasm/zip.mli
index ac81ebe825..bf65cc5390 100644
--- a/compiler/lib/wasm/zip.mli
+++ b/compiler/lib/wasm/zip.mli
@@ -18,7 +18,8 @@ val has_entry : input -> name:string -> bool
 
 val read_entry : input -> name:string -> string
 
-val get_entry : input -> name:string -> in_channel * int (* pos *) * int (* len *)
+val get_entry :
+  input -> name:string -> in_channel * int (* pos *) * int (* len *) * int32 (* crc *)
 
 val extract_file : input -> name:string -> file:string -> unit
 

From 7903a8d583d9cb05a2ba3a762a78d72f227360db Mon Sep 17 00:00:00 2001
From: Benkb <ben@jakobar.com>
Date: Thu, 16 May 2024 17:24:14 +0200
Subject: [PATCH 247/481] improving installation instructions #37

---
 README.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/README.md b/README.md
index 14cfea83f7..bd18d1a83a 100644
--- a/README.md
+++ b/README.md
@@ -26,6 +26,8 @@ utilizing
 
 The following commands will perform a minimal installation:
 ```
+git clone https://github.com/ocaml-wasm/wasm_of_ocaml
+cd wasm_of_ocaml
 opam pin add dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm
 opam pin add -n --with-version 5.3.0-wasm .
 opam install wasm_of_ocaml-compiler

From 3e586e378b801801476446c4f7b6faa997570706 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 21 May 2024 14:54:40 +0200
Subject: [PATCH 248/481] Partial application fix

---
 compiler/lib/wasm/wa_generate.ml | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index eb28a1435d..5e5dcaf4ca 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -112,9 +112,10 @@ module Generate (Target : Wa_target_sig.S) = struct
                 match kind, funct with
                 | `Index, W.ConstSym (V g, 0) | `Ref _, W.RefFunc g ->
                     (* Functions with constant closures ignore their
-                       environment *)
-                    let* unit = Value.unit in
-                    return (W.Call (g, List.rev (unit :: acc)))
+                       environment. In case of partial application, we
+                       still need the closure. *)
+                    let* cl = if exact then Value.unit else return closure in
+                    return (W.Call (g, List.rev (cl :: acc)))
                 | `Index, _ ->
                     return
                       (W.Call_indirect

From 9eb33a69b5445fcd9a413dcdc159c83fe0c0b178 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 23 May 2024 15:21:38 +0200
Subject: [PATCH 249/481] Add test

---
 compiler/tests-wasm_of_ocaml/dune    | 13 +++++++++++++
 compiler/tests-wasm_of_ocaml/gh38.ml |  3 +++
 2 files changed, 16 insertions(+)
 create mode 100644 compiler/tests-wasm_of_ocaml/dune
 create mode 100644 compiler/tests-wasm_of_ocaml/gh38.ml

diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune
new file mode 100644
index 0000000000..157c8af8d2
--- /dev/null
+++ b/compiler/tests-wasm_of_ocaml/dune
@@ -0,0 +1,13 @@
+(executables
+ (names gh38)
+ (modes js)
+ (js_of_ocaml (flags :standard --disable optcall)))
+
+(rule
+ (target gh38.actual)
+ (enabled_if (= %{profile} wasm))
+ (alias runtest)
+ (action
+  (with-outputs-to
+   %{target}
+   (run node %{dep:gh38.bc.js}))))
diff --git a/compiler/tests-wasm_of_ocaml/gh38.ml b/compiler/tests-wasm_of_ocaml/gh38.ml
new file mode 100644
index 0000000000..5fec74de67
--- /dev/null
+++ b/compiler/tests-wasm_of_ocaml/gh38.ml
@@ -0,0 +1,3 @@
+let f () () = ()
+
+let (_ : _ -> _) = f ()

From 33f15771e684eb3974bbdf6117f901a80eaada87 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 13 May 2024 17:13:14 +0200
Subject: [PATCH 250/481] CI updates

---
 .github/workflows/build.yml | 6 +++---
 tools/ci_setup.ml           | 3 ++-
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 72b8554fa0..e4351ea629 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -78,7 +78,7 @@ jobs:
           path: |
             ~/.opam
             _opam
-            /opt/hostedtoolcache/opam/2.1.5/x86_64/opam
+            /opt/hostedtoolcache/opam
           key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
 
       - name: Install OCaml ${{ matrix.ocaml-compiler }}
@@ -97,7 +97,7 @@ jobs:
       - name: Set opam path
         if: steps.cache-ocaml.outputs.cache-hit
         run: |
-          echo /opt/hostedtoolcache/opam/2.1.5/x86_64 >> $GITHUB_PATH
+          echo /opt/hostedtoolcache/opam/*/x86_64 >> $GITHUB_PATH
 
       - name: Cache OCaml
         if: steps.cache-ocaml.outputs.cache-hit != 'true'
@@ -106,7 +106,7 @@ jobs:
           path: |
             ~/.opam
             _opam
-            /opt/hostedtoolcache/opam/2.1.5/x86_64/opam
+            /opt/hostedtoolcache/opam
           key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
 
       - name: Checkout code
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index c37ae4918d..5b15026e74 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -202,7 +202,8 @@ let pin delay nm =
     ~delay
     (Printf.sprintf
        "opam pin add -n %s https://github.com/ocaml-wasm/%s.git#wasm"
-       (try List.assoc nm aliases with Not_found -> nm)
+       (try List.assoc nm aliases
+        with Not_found -> if List.mem_assoc nm packages then nm ^ ".v0.16.0" else nm)
        nm)
 
 let pin_packages js =

From ef56d39c8efa73addb55339c5d77c7070ce9eef7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 17 May 2024 14:42:41 +0200
Subject: [PATCH 251/481] Source maps: emit annotations to indicate code with
 no debug location

---
 compiler/lib/wasm/wa_generate.ml   | 9 ++-------
 compiler/lib/wasm/wa_wat_output.ml | 3 ++-
 2 files changed, 4 insertions(+), 8 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 8eebc7891c..c860a82261 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -635,13 +635,8 @@ module Generate (Target : Wa_target_sig.S) = struct
             | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
                 assert false))
 
-  and emit_location loc instrs =
-    match loc with
-    | No -> instrs
-    | Before _ | After _ -> with_location loc instrs
-
   and translate_instr ctx stack_ctx context (i, loc) =
-    emit_location
+    with_location
       loc
       (match i with
       | Assign (x, y) ->
@@ -877,7 +872,7 @@ module Generate (Target : Wa_target_sig.S) = struct
           let* () = Stack.perform_reloads stack_ctx (`Branch (fst block.branch)) in
           let* () = Stack.perform_spilling stack_ctx (`Block pc) in
           let branch, loc = block.branch in
-          emit_location
+          with_location
             loc
             (match branch with
             | Branch cont ->
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 952213da56..39667eaeba 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -574,7 +574,8 @@ let expression_or_instructions ctx st in_function =
     | Location (loc, i) -> (
         let loc = Generate.source_location ctx.debug loc in
         match loc with
-        | Javascript.N | U | Pi Parse_info.{ src = None; _ } -> instruction i
+        | Javascript.N | U | Pi Parse_info.{ src = None; _ } ->
+            Comment "@" :: instruction i
         | Pi Parse_info.{ src = Some src; col; line; _ } ->
             let loc = Format.sprintf "%s:%d:%d" src line col in
             Comment ("@ " ^ loc) :: instruction i)

From e375df2c992061ec8bf8ff4db5e3e8206b1154e5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 19 Jun 2024 11:15:15 +0200
Subject: [PATCH 252/481] Remove caml_js_global primitive

Not really needed since Js.pure_js_expr is optimized.
---
 compiler/lib/generate.ml                | 2 --
 lib/js_of_ocaml/js.ml                   | 4 +---
 lib/runtime/js_of_ocaml_runtime_stubs.c | 4 ----
 lib/runtime/jsoo_runtime.ml             | 2 --
 runtime/jslib.js                        | 3 ---
 5 files changed, 1 insertion(+), 14 deletions(-)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index a6146d1e53..650dd2cb69 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1395,8 +1395,6 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
            | Extern "caml_js_delete", [ _; Pc (String _) ] -> assert false
            ]}
         *)
-        | Extern "caml_js_global", _ ->
-            J.EVar (J.ident Constant.global_object_), const_p, queue
         | Extern "%overrideMod", [ Pc (String m); Pc (String f) ] ->
             runtime_fun ctx (Printf.sprintf "caml_%s_%s" m f), const_p, queue
         | Extern "%overrideMod", _ -> assert false
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index 4816228542..032c1c0cd8 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -66,9 +66,7 @@ module Js = struct
 
     external pure_js_expr : string -> 'a = "caml_pure_js_expr"
 
-    external get_global : unit -> 'a = "caml_js_global"
-
-    let global = get_global ()
+    let global = pure_js_expr "globalThis"
 
     external callback : ('a -> 'b) -> ('c, 'a -> 'b) meth_callback
       = "caml_js_wrap_callback_unsafe"
diff --git a/lib/runtime/js_of_ocaml_runtime_stubs.c b/lib/runtime/js_of_ocaml_runtime_stubs.c
index a09130a2d8..c6688b1b85 100644
--- a/lib/runtime/js_of_ocaml_runtime_stubs.c
+++ b/lib/runtime/js_of_ocaml_runtime_stubs.c
@@ -96,10 +96,6 @@ void caml_js_get () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_get!\n");
   exit(1);
 }
-void caml_js_global () {
-  fprintf(stderr, "Unimplemented Javascript primitive caml_js_global!\n");
-  exit(1);
-}
 void caml_js_instanceof () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_instanceof!\n");
   exit(1);
diff --git a/lib/runtime/jsoo_runtime.ml b/lib/runtime/jsoo_runtime.ml
index 8f42e9f6d1..d1c8a1b1a9 100644
--- a/lib/runtime/jsoo_runtime.ml
+++ b/lib/runtime/jsoo_runtime.ml
@@ -45,8 +45,6 @@ module Js = struct
 
   external delete : t -> t -> unit = "caml_js_delete"
 
-  external get_global : unit -> t = "caml_js_global"
-
   external call : t -> t -> t array -> t = "caml_js_call"
 
   external fun_call : t -> t array -> t = "caml_js_fun_call"
diff --git a/runtime/jslib.js b/runtime/jslib.js
index da75a133e3..59d954d91f 100644
--- a/runtime/jslib.js
+++ b/runtime/jslib.js
@@ -30,9 +30,6 @@ function caml_js_get(o,f) { return o[f]; }
 //Provides: caml_js_delete (mutable, const)
 function caml_js_delete(o,f) { delete o[f]; return 0}
 
-//Provides: caml_js_global const
-function caml_js_global () { return globalThis }
-
 //Provides: caml_js_instanceof (const, const)
 function caml_js_instanceof(o,c) { return (o instanceof c) ? 1 : 0; }
 

From 8852bc7af795cd9d7bc84aea84f44df4a46f16c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 19 Jun 2024 11:33:15 +0200
Subject: [PATCH 253/481] Put back wasm-opt flag
 --skip-pass=inlining-optimizing

---
 compiler/lib/wasm/wa_binaryen.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_binaryen.ml b/compiler/lib/wasm/wa_binaryen.ml
index bb9683efb5..15d32dccd0 100644
--- a/compiler/lib/wasm/wa_binaryen.ml
+++ b/compiler/lib/wasm/wa_binaryen.ml
@@ -92,8 +92,8 @@ let dead_code_elimination
 
 let optimization_options =
   [| [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
-   ; [ "-O2"; "--traps-never-happen" ]
-   ; [ "-O3"; "--traps-never-happen" ]
+   ; [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
+   ; [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
   |]
 
 let optimize

From 29c67a98fab7ec74332acc123985d86afb9f43fa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 19 Jun 2024 15:46:07 +0200
Subject: [PATCH 254/481] Array handling fix + clean-up

---
 compiler/lib/generate.ml    |  3 +--
 compiler/lib/global_flow.ml | 10 ++++++++--
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 650dd2cb69..cafd0748af 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1134,8 +1134,6 @@ let _ =
   register_bin_prim "caml_fmod_float" `Pure (fun cx cy _ -> J.EBin (J.Mod, cx, cy));
   register_tern_prim "caml_array_unsafe_set" (fun cx cy cz _ ->
       J.EBin (J.Eq, Mlvalue.Array.field cx cy, cz));
-  register_tern_prim "caml_array_unsafe_set_addr" (fun cx cy cz _ ->
-      J.EBin (J.Eq, Mlvalue.Array.field cx cy, cz));
   register_un_prim "caml_alloc_dummy" `Pure (fun _ _ -> J.array []);
   register_un_prim "caml_obj_dup" `Mutable (fun cx loc ->
       J.call (J.dot cx (Utf8_string.of_string_exn "slice")) [] loc);
@@ -2156,6 +2154,7 @@ let init () =
     ; "caml_array_unsafe_get_float", "caml_array_unsafe_get"
     ; "caml_floatarray_unsafe_get", "caml_array_unsafe_get"
     ; "caml_array_unsafe_set_float", "caml_array_unsafe_set"
+    ; "caml_array_unsafe_set_addr", "caml_array_unsafe_set"
     ; "caml_floatarray_unsafe_set", "caml_array_unsafe_set"
     ; "caml_check_bound_gen", "caml_check_bound"
     ; "caml_check_bound_float", "caml_check_bound"
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index 61d9cbda36..15b3837765 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -155,7 +155,11 @@ let expr_deps blocks st x e =
     -> ()
   | Prim
       ( ( Extern
-            ("caml_check_bound" | "caml_array_unsafe_get" | "caml_floatarray_unsafe_get")
+            ( "caml_check_bound"
+            | "caml_check_bound_float"
+            | "caml_check_bound_gen"
+            | "caml_array_unsafe_get"
+            | "caml_floatarray_unsafe_get" )
         | Array_get )
       , l ) ->
       (* The analysis knowns about these primitives, and will compute
@@ -418,7 +422,9 @@ let propagate st ~update approx x =
                   | Phi _ | Expr _ -> assert false)
                 known
           | Top -> Top)
-      | Prim (Extern "caml_check_bound", [ Pv y; _ ]) -> Var.Tbl.get approx y
+      | Prim
+          ( Extern ("caml_check_bound" | "caml_check_bound_float" | "caml_check_bound_gen")
+          , [ Pv y; _ ] ) -> Var.Tbl.get approx y
       | Prim
           ( (Array_get | Extern ("caml_array_unsafe_get" | "caml_floatarray_unsafe_get"))
           , [ Pv y; _ ] ) -> (

From a63f95289b73c01966bec4d942a4d95f5fce1166 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 3 Apr 2024 14:10:16 +0200
Subject: [PATCH 255/481] Use sexps rather than Json for metadata

---
 compiler/lib/build_info.ml   |  17 ++--
 compiler/lib/build_info.mli  |   4 +-
 compiler/lib/sexp.ml         | 161 +++++++++++++++++++++++++++++++++++
 compiler/lib/sexp.mli        |  21 +++++
 compiler/lib/unit_info.ml    |  37 ++++----
 compiler/lib/unit_info.mli   |   4 +-
 compiler/lib/wasm/wa_link.ml |  56 ++++++------
 7 files changed, 241 insertions(+), 59 deletions(-)
 create mode 100644 compiler/lib/sexp.ml
 create mode 100644 compiler/lib/sexp.mli

diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml
index 261d4fef56..df09835ca6 100644
--- a/compiler/lib/build_info.ml
+++ b/compiler/lib/build_info.ml
@@ -90,15 +90,18 @@ let parse s =
       in
       Some t
 
-let to_json info : Yojson.Basic.t =
-  `Assoc (info |> StringMap.bindings |> List.map ~f:(fun (k, v) -> k, `String v))
-
-let from_json (info : Yojson.Basic.t) =
-  let open Yojson.Basic.Util in
+let to_sexp info =
+  Sexp.List
+    (info
+    |> StringMap.bindings
+    |> List.map ~f:(fun (k, v) -> Sexp.List [ Atom k; Atom v ]))
+
+let from_sexp info =
+  let open Sexp.Util in
   info
-  |> to_assoc
+  |> assoc
   |> List.fold_left
-       ~f:(fun m (k, v) -> StringMap.add k (to_string v) m)
+       ~f:(fun m (k, v) -> StringMap.add k (single string v) m)
        ~init:StringMap.empty
 
 exception
diff --git a/compiler/lib/build_info.mli b/compiler/lib/build_info.mli
index 918200d27e..34c72abbc5 100644
--- a/compiler/lib/build_info.mli
+++ b/compiler/lib/build_info.mli
@@ -34,9 +34,9 @@ val to_string : t -> string
 
 val parse : string -> t option
 
-val to_json : t -> Yojson.Basic.t
+val to_sexp : t -> Sexp.t
 
-val from_json : Yojson.Basic.t -> t
+val from_sexp : Sexp.t -> t
 
 val with_kind : t -> kind -> t
 
diff --git a/compiler/lib/sexp.ml b/compiler/lib/sexp.ml
new file mode 100644
index 0000000000..046e6d67f5
--- /dev/null
+++ b/compiler/lib/sexp.ml
@@ -0,0 +1,161 @@
+(* ()#;"" space <-- reserved *)
+open Stdlib
+
+type t =
+  | Atom of string
+  | List of t list
+
+let reserved_char c =
+  match c with
+  | '\x00' .. ' ' | '(' | ')' | '#' | ';' | '"' | '\x7f' .. '\xff' -> true
+  | _ -> false
+
+let need_escaping s =
+  let len = String.length s in
+  len = 0
+  ||
+  let res = ref false in
+  for i = 0 to len - 1 do
+    res := !res || reserved_char s.[i]
+  done;
+  !res
+
+let should_quote c =
+  match c with
+  | '\x00' .. '\x1F' | '"' | '\\' | '\x7f' .. '\xff' -> true
+  | _ -> false
+
+let escape_to_buffer buf s =
+  let start = ref 0 in
+  let len = String.length s in
+  Buffer.add_char buf '"';
+  for i = 0 to len - 1 do
+    let c = s.[i] in
+    if should_quote c
+    then (
+      if !start < i then Buffer.add_substring buf s !start (i - !start);
+      Buffer.add_char buf '\\';
+      let c = Char.code c in
+      Buffer.add_uint8 buf ((c / 100) + 48);
+      Buffer.add_uint8 buf ((c / 10 mod 10) + 48);
+      Buffer.add_uint8 buf ((c mod 10) + 48);
+      start := i + 1)
+  done;
+  if !start < len then Buffer.add_substring buf s !start (len - !start);
+  Buffer.add_char buf '"'
+
+let rec add_to_buffer buf v =
+  match v with
+  | Atom s -> if need_escaping s then escape_to_buffer buf s else Buffer.add_string buf s
+  | List l ->
+      Buffer.add_char buf '(';
+      List.iteri
+        ~f:(fun i v' ->
+          if i > 0 then Buffer.add_char buf ' ';
+          add_to_buffer buf v')
+        l;
+      Buffer.add_char buf ')'
+
+let to_string v =
+  let b = Buffer.create 128 in
+  add_to_buffer b v;
+  Buffer.contents b
+
+let parse_error () = failwith "parse error"
+
+let rec parse buf s pos : t * int =
+  match s.[pos] with
+  | '(' -> parse_list buf s [] (pos + 1)
+  | '\"' ->
+      Buffer.clear buf;
+      parse_quoted_atom buf s (pos + 1) (pos + 1)
+  | _ -> parse_atom buf s pos pos
+
+and parse_list buf s acc pos =
+  match s.[pos] with
+  | ' ' -> parse_list buf s acc (pos + 1)
+  | ')' -> List (List.rev acc), pos + 1
+  | _ ->
+      let v, pos' = parse buf s pos in
+      parse_list buf s (v :: acc) pos'
+
+and parse_atom buf s pos0 pos =
+  if reserved_char s.[pos]
+  then (
+    if pos0 = pos then parse_error ();
+    Atom (String.sub s ~pos:pos0 ~len:(pos - pos0)), pos)
+  else parse_atom buf s pos0 (pos + 1)
+
+and parse_quoted_atom buf s pos0 pos =
+  match s.[pos] with
+  | '\"' ->
+      if pos0 < pos then Buffer.add_substring buf s pos0 (pos - pos0);
+      Atom (Buffer.contents buf), pos + 1
+  | '\\' ->
+      if pos0 < pos then Buffer.add_substring buf s pos0 (pos - pos0);
+      Buffer.add_uint8
+        buf
+        (((Char.code s.[pos + 1] - 48) * 100)
+        + ((Char.code s.[pos + 2] - 48) * 10)
+        + Char.code s.[pos + 3]
+        - 48);
+      parse_quoted_atom buf s (pos + 4) (pos + 4)
+  | _ -> parse_quoted_atom buf s pos0 (pos + 1)
+
+let from_string s =
+  let v, pos = parse (Buffer.create 16) s 0 in
+  if pos < String.length s then parse_error ();
+  v
+
+module Util = struct
+  let single f v =
+    match v with
+    | [ v ] -> f v
+    | _ -> assert false
+
+  let string v =
+    match v with
+    | Atom s -> s
+    | _ -> assert false
+
+  let assoc v =
+    match v with
+    | List l ->
+        List.map
+          ~f:(fun p ->
+            match p with
+            | List (Atom k :: v) -> k, v
+            | _ -> assert false)
+          l
+    | Atom _ -> assert false
+
+  let member nm v =
+    match v with
+    | Atom _ -> assert false
+    | List l ->
+        List.find_map
+          ~f:(fun p ->
+            match p with
+            | List (Atom nm' :: v) when String.equal nm nm' -> Some v
+            | _ -> None)
+          l
+
+  let bool v =
+    match v with
+    | Atom "true" -> true
+    | Atom "false" -> false
+    | _ -> assert false
+
+  let mandatory f v =
+    match v with
+    | Some v -> f v
+    | None -> assert false
+end
+(*
+parse
+  (to_string
+     (List
+        [ List [ Atom "provides"; Atom "toto" ]
+        ; List [ Atom "requires"; Atom "foo"; Atom "bar"; Atom "foo\n bar" ]
+        ]))
+*)
diff --git a/compiler/lib/sexp.mli b/compiler/lib/sexp.mli
new file mode 100644
index 0000000000..c0a6cb404b
--- /dev/null
+++ b/compiler/lib/sexp.mli
@@ -0,0 +1,21 @@
+type t =
+  | Atom of string
+  | List of t list
+
+val to_string : t -> string
+
+val from_string : string -> t
+
+module Util : sig
+  val single : (t -> 'a) -> t list -> 'a
+
+  val mandatory : (t list -> 'a) -> t list option -> 'a
+
+  val string : t -> string
+
+  val bool : t -> bool
+
+  val assoc : t -> (string * t list) list
+
+  val member : string -> t -> t list option
+end
diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml
index e3f5296001..e99acd6d6c 100644
--- a/compiler/lib/unit_info.ml
+++ b/compiler/lib/unit_info.ml
@@ -141,33 +141,38 @@ let parse acc s =
           Some { acc with effects_without_cps = bool_of_string (String.trim b) }
       | Some (_, _) -> None)
 
-let to_json t : Yojson.Basic.t =
-  let add nm skip v rem = if skip then rem else (nm, v) :: rem in
+let to_sexp t =
+  let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in
   let set nm f rem =
     add
       nm
       (List.equal ~eq:String.equal (f empty) (f t))
-      (`List (List.map ~f:(fun x -> `String x) (f t)))
+      (List.map ~f:(fun x -> Sexp.Atom x) (f t))
       rem
   in
-  let bool nm f rem = add nm (Bool.equal (f empty) (f t)) (`Bool (f t)) rem in
-  `Assoc
-    ([]
-    |> bool "effects_without_cps" (fun t -> t.effects_without_cps)
-    |> set "primitives" (fun t -> t.primitives)
-    |> bool "force_link" (fun t -> t.force_link)
-    |> set "requires" (fun t -> StringSet.elements t.requires)
-    |> add "provides" false (`String (StringSet.choose t.provides)))
+  let bool nm f rem =
+    add
+      nm
+      (Bool.equal (f empty) (f t))
+      (if f t then [ Atom "true" ] else [ Atom "false" ])
+      rem
+  in
+  []
+  |> bool "effects_without_cps" (fun t -> t.effects_without_cps)
+  |> set "primitives" (fun t -> t.primitives)
+  |> bool "force_link" (fun t -> t.force_link)
+  |> set "requires" (fun t -> StringSet.elements t.requires)
+  |> add "provides" false [ Atom (StringSet.choose t.provides) ]
 
-let from_json t =
-  let open Yojson.Basic.Util in
-  let opt_list l = l |> to_option to_list |> Option.map ~f:(List.map ~f:to_string) in
+let from_sexp t =
+  let open Sexp.Util in
+  let opt_list l = l |> Option.map ~f:(List.map ~f:string) in
   let list default l = Option.value ~default (opt_list l) in
   let set default l =
     Option.value ~default (Option.map ~f:StringSet.of_list (opt_list l))
   in
-  let bool default v = Option.value ~default (to_option to_bool v) in
-  { provides = t |> member "provides" |> to_string |> StringSet.singleton
+  let bool default v = Option.value ~default (Option.map ~f:(single bool) v) in
+  { provides = t |> member "provides" |> mandatory (single string) |> StringSet.singleton
   ; requires = t |> member "requires" |> set empty.requires
   ; primitives = t |> member "primitives" |> list empty.primitives
   ; force_link = t |> member "force_link" |> bool empty.force_link
diff --git a/compiler/lib/unit_info.mli b/compiler/lib/unit_info.mli
index 806f9e0f2b..8e93e0e5af 100644
--- a/compiler/lib/unit_info.mli
+++ b/compiler/lib/unit_info.mli
@@ -40,6 +40,6 @@ val to_string : t -> string
 
 val parse : t -> string -> t option
 
-val to_json : t -> Yojson.Basic.t
+val to_sexp : t -> Sexp.t list
 
-val from_json : Yojson.Basic.t -> t
+val from_sexp : Sexp.t -> t
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 0834f3794d..7b4b1c9dbe 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -205,64 +205,58 @@ type unit_data =
   ; fragments : (string * Javascript.expression) list
   }
 
-let info_to_json ~predefined_exceptions ~build_info ~unit_data =
-  let add nm skip v rem = if skip then rem else (nm, v) :: rem in
+let info_to_sexp ~predefined_exceptions ~build_info ~unit_data =
+  let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in
   let units =
     List.map
       ~f:(fun { unit_info; strings; fragments } ->
-        `Assoc
-          (Unit_info.to_json unit_info
-          |> Yojson.Basic.Util.to_assoc
+        Sexp.List
+          (Unit_info.to_sexp unit_info
           |> add
                "strings"
                (List.is_empty strings)
-               (`List (List.map ~f:(fun s -> `String s) strings))
+               (List.map ~f:(fun s -> Sexp.Atom s) strings)
           |> add
                "fragments"
                (List.is_empty fragments)
-               (`String (Marshal.to_string fragments []))))
+               [ Sexp.Atom (Base64.encode_string (Marshal.to_string fragments [])) ]))
       unit_data
   in
-  `Assoc
+  Sexp.List
     ([]
     |> add
          "predefined_exceptions"
          (StringSet.is_empty predefined_exceptions)
-         (`List
-           (List.map ~f:(fun s -> `String s) (StringSet.elements predefined_exceptions)))
-    |> add "units" (List.is_empty unit_data) (`List units)
-    |> add "build_info" false (Build_info.to_json build_info))
-
-let info_from_json info =
-  let open Yojson.Basic.Util in
-  let build_info = info |> member "build_info" |> Build_info.from_json in
+         (List.map ~f:(fun s -> Sexp.Atom s) (StringSet.elements predefined_exceptions))
+    |> add "units" (List.is_empty unit_data) units
+    |> add "build_info" false [ Build_info.to_sexp build_info ])
+
+let info_from_sexp info =
+  let open Sexp.Util in
+  let build_info =
+    info |> member "build_info" |> mandatory (single Build_info.from_sexp)
+  in
   let predefined_exceptions =
     info
     |> member "predefined_exceptions"
-    |> to_option to_list
     |> Option.value ~default:[]
-    |> List.map ~f:to_string
+    |> List.map ~f:string
     |> StringSet.of_list
   in
   let unit_data =
     info
     |> member "units"
-    |> to_option to_list
     |> Option.value ~default:[]
     |> List.map ~f:(fun u ->
-           let unit_info = u |> Unit_info.from_json in
+           let unit_info = u |> Unit_info.from_sexp in
            let strings =
-             u
-             |> member "strings"
-             |> to_option to_list
-             |> Option.value ~default:[]
-             |> List.map ~f:to_string
+             u |> member "strings" |> Option.value ~default:[] |> List.map ~f:string
            in
            let fragments =
              u
              |> member "fragments"
-             |> to_option to_string
-             |> Option.map ~f:(fun s -> Marshal.from_string s 0)
+             |> Option.map ~f:(single string)
+             |> Option.map ~f:(fun s -> Marshal.from_string (Base64.decode_exn s) 0)
              |> Option.value ~default:[]
              (*
                            |> to_option to_assoc
@@ -279,13 +273,11 @@ let info_from_json info =
 let add_info z ?(predefined_exceptions = StringSet.empty) ~build_info ~unit_data () =
   Zip.add_entry
     z
-    ~name:"info.json"
+    ~name:"info.sexp"
     ~contents:
-      (Yojson.Basic.to_string
-         (info_to_json ~predefined_exceptions ~build_info ~unit_data))
+      (Sexp.to_string (info_to_sexp ~predefined_exceptions ~build_info ~unit_data))
 
-let read_info z =
-  info_from_json (Yojson.Basic.from_string (Zip.read_entry z ~name:"info.json"))
+let read_info z = info_from_sexp (Sexp.from_string (Zip.read_entry z ~name:"info.sexp"))
 
 let generate_start_function ~to_link ~out_file =
   let t1 = Timer.make () in

From bfe333145f73f6180f351addada0d91ed3296098 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 7 Jun 2024 11:17:33 +0200
Subject: [PATCH 256/481] Bump ocamlformat

---
 .ocamlformat                             |    2 +-
 compiler/lib/base64.ml                   |    2 +-
 compiler/lib/dgraph.ml                   |   22 +-
 compiler/lib/dgraph.mli                  |   22 +-
 compiler/lib/js_output.ml                |   58 +-
 compiler/lib/js_traverse.ml              |  137 +-
 compiler/lib/js_traverse.mli             |  143 +-
 compiler/lib/ocaml_compiler.ml           |   14 +-
 compiler/lib/parse_bytecode.ml           |    2 +-
 compiler/tests-dynlink-js/dune           |   20 +-
 compiler/tests-dynlink/dune              |   20 +-
 compiler/tests-toplevel/dune             |   20 +-
 compiler/tests-wasm_of_ocaml/dune        |    6 +-
 dune                                     |    6 +-
 examples/hyperbolic/hypertree.ml         |   46 +-
 examples/namespace/dune                  |    5 +-
 examples/separate_compilation/dune       |   10 +-
 lib/js_of_ocaml/dom.ml                   |  217 +-
 lib/js_of_ocaml/dom.mli                  |  206 +-
 lib/js_of_ocaml/dom_html.ml              | 2388 ++++++++++-----------
 lib/js_of_ocaml/dom_html.mli             | 2433 +++++++++++-----------
 lib/js_of_ocaml/dom_svg.ml               | 1540 +++++++-------
 lib/js_of_ocaml/dom_svg.mli              | 1538 +++++++-------
 lib/js_of_ocaml/eventSource.ml           |   41 +-
 lib/js_of_ocaml/eventSource.mli          |   41 +-
 lib/js_of_ocaml/file.ml                  |  102 +-
 lib/js_of_ocaml/file.mli                 |  105 +-
 lib/js_of_ocaml/firebug.ml               |  105 +-
 lib/js_of_ocaml/firebug.mli              |  105 +-
 lib/js_of_ocaml/form.ml                  |   31 +-
 lib/js_of_ocaml/form.mli                 |    9 +-
 lib/js_of_ocaml/geolocation.ml           |   81 +-
 lib/js_of_ocaml/geolocation.mli          |   81 +-
 lib/js_of_ocaml/intersectionObserver.ml  |   49 +-
 lib/js_of_ocaml/intersectionObserver.mli |   49 +-
 lib/js_of_ocaml/intl.ml                  |  337 ++-
 lib/js_of_ocaml/intl.mli                 |  317 ++-
 lib/js_of_ocaml/js.ml                    |  412 ++--
 lib/js_of_ocaml/js.mli                   |  424 ++--
 lib/js_of_ocaml/json.ml                  |   24 +-
 lib/js_of_ocaml/mutationObserver.ml      |   53 +-
 lib/js_of_ocaml/mutationObserver.mli     |   53 +-
 lib/js_of_ocaml/performanceObserver.ml   |   38 +-
 lib/js_of_ocaml/performanceObserver.mli  |   38 +-
 lib/js_of_ocaml/resizeObserver.ml        |   44 +-
 lib/js_of_ocaml/resizeObserver.mli       |   44 +-
 lib/js_of_ocaml/typed_array.ml           |  114 +-
 lib/js_of_ocaml/typed_array.mli          |  114 +-
 lib/js_of_ocaml/webGL.ml                 | 1409 +++++++------
 lib/js_of_ocaml/webGL.mli                | 1400 ++++++-------
 lib/js_of_ocaml/webSockets.ml            |   71 +-
 lib/js_of_ocaml/webSockets.mli           |   71 +-
 lib/js_of_ocaml/worker.ml                |   41 +-
 lib/js_of_ocaml/worker.mli               |   41 +-
 lib/js_of_ocaml/xmlHttpRequest.ml        |   72 +-
 lib/js_of_ocaml/xmlHttpRequest.mli       |   72 +-
 lib/lwt/graphics/graphics_js.ml          |    7 +-
 lib/tyxml/tyxml_js.ml                    |    9 +-
 runtime/wasm/dune                        |   59 +-
 toplevel/examples/eval/dune              |   20 +-
 toplevel/examples/lwt_toplevel/dune      |   15 +-
 toplevel/lib/jsooTop.ml                  |    4 +-
 toplevel/test/dune                       |    5 +-
 63 files changed, 7263 insertions(+), 7701 deletions(-)

diff --git a/.ocamlformat b/.ocamlformat
index 3eb12ecaf6..b880169c2f 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -10,5 +10,5 @@ break-separators=before
 dock-collection-brackets=false
 margin=90
 module-item-spacing=sparse
-version=0.25.1
+version=0.26.2
 ocaml-version=4.08.0
diff --git a/compiler/lib/base64.ml b/compiler/lib/base64.ml
index 0928c3aa3a..5757bef9bb 100644
--- a/compiler/lib/base64.ml
+++ b/compiler/lib/base64.ml
@@ -39,7 +39,7 @@ let unsafe_get_uint8 t off = Char.code (String.unsafe_get t off)
 let unsafe_set_uint8 t off v = Bytes.unsafe_set t off (Char.chr v)
 
 external unsafe_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16u"
-  [@@noalloc]
+[@@noalloc]
 
 external unsafe_get_uint16 : string -> int -> int = "%caml_string_get16u" [@@noalloc]
 
diff --git a/compiler/lib/dgraph.ml b/compiler/lib/dgraph.ml
index 6834620095..d09ea4f823 100644
--- a/compiler/lib/dgraph.ml
+++ b/compiler/lib/dgraph.ml
@@ -19,11 +19,12 @@
  *)
 open! Stdlib
 
-module Make (N : sig
-  type t
-end)
-(NSet : Set.S with type elt = N.t)
-(NMap : Map.S with type key = N.t) =
+module Make
+    (N : sig
+      type t
+    end)
+    (NSet : Set.S with type elt = N.t)
+    (NMap : Map.S with type key = N.t) =
 struct
   type t =
     { domain : NSet.t
@@ -175,11 +176,12 @@ module type Tbl = sig
   val make : size -> 'a -> 'a t
 end
 
-module Make_Imperative (N : sig
-  type t
-end)
-(NSet : ISet with type elt = N.t)
-(NTbl : Tbl with type key = N.t) =
+module Make_Imperative
+    (N : sig
+      type t
+    end)
+    (NSet : ISet with type elt = N.t)
+    (NTbl : Tbl with type key = N.t) =
 struct
   type t =
     { domain : NSet.t
diff --git a/compiler/lib/dgraph.mli b/compiler/lib/dgraph.mli
index 337569f3ae..406eca92cb 100644
--- a/compiler/lib/dgraph.mli
+++ b/compiler/lib/dgraph.mli
@@ -17,11 +17,12 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
-module Make (N : sig
-  type t
-end)
-(NSet : Set.S with type elt = N.t)
-(NMap : Map.S with type key = N.t) : sig
+module Make
+    (N : sig
+      type t
+    end)
+    (NSet : Set.S with type elt = N.t)
+    (NMap : Map.S with type key = N.t) : sig
   type t =
     { domain : NSet.t
     ; fold_children : 'a. (N.t -> 'a -> 'a) -> N.t -> 'a -> 'a
@@ -72,11 +73,12 @@ module type Tbl = sig
   val make : size -> 'a -> 'a t
 end
 
-module Make_Imperative (N : sig
-  type t
-end)
-(NSet : ISet with type elt = N.t)
-(NTbl : Tbl with type key = N.t) : sig
+module Make_Imperative
+    (N : sig
+      type t
+    end)
+    (NSet : ISet with type elt = N.t)
+    (NTbl : Tbl with type key = N.t) : sig
   type t =
     { domain : NSet.t
     ; iter_children : (N.t -> unit) -> N.t -> unit
diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index de8e5f4b63..82ba0c5559 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -856,35 +856,35 @@ struct
     | CoverInitializedName (e, _, _) -> early_error e
 
   and method_ : 'a. _ -> (PP.t -> 'a -> unit) -> 'a -> method_ -> unit =
-    fun (type a) f (name : PP.t -> a -> unit) (n : a) (m : method_) ->
-     match m with
-     | MethodGet (k, l, b, loc') | MethodSet (k, l, b, loc') ->
-         (match k with
-         | { async = false; generator = false } -> ()
-         | _ -> assert false);
-         let prefix =
-           match m with
-           | MethodGet _ -> "get"
-           | MethodSet _ -> "set"
-           | _ -> assert false
-         in
-         function_declaration f prefix name (Some n) l b loc'
-     | Method (k, l, b, loc') ->
-         let fpn f () =
-           (match k with
-           | { async = false; generator = false } -> ()
-           | { async = false; generator = true } ->
-               PP.string f "*";
-               PP.space f
-           | { async = true; generator = false } ->
-               PP.string f "async";
-               PP.non_breaking_space f
-           | { async = true; generator = true } ->
-               PP.string f "async*";
-               PP.space f);
-           name f n
-         in
-         function_declaration f "" fpn (Some ()) l b loc'
+   fun (type a) f (name : PP.t -> a -> unit) (n : a) (m : method_) ->
+    match m with
+    | MethodGet (k, l, b, loc') | MethodSet (k, l, b, loc') ->
+        (match k with
+        | { async = false; generator = false } -> ()
+        | _ -> assert false);
+        let prefix =
+          match m with
+          | MethodGet _ -> "get"
+          | MethodSet _ -> "set"
+          | _ -> assert false
+        in
+        function_declaration f prefix name (Some n) l b loc'
+    | Method (k, l, b, loc') ->
+        let fpn f () =
+          (match k with
+          | { async = false; generator = false } -> ()
+          | { async = false; generator = true } ->
+              PP.string f "*";
+              PP.space f
+          | { async = true; generator = false } ->
+              PP.string f "async";
+              PP.non_breaking_space f
+          | { async = true; generator = true } ->
+              PP.string f "async*";
+              PP.space f);
+          name f n
+        in
+        function_declaration f "" fpn (Some ()) l b loc'
 
   and element_list f el = comma_list f element el
 
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index aea8e01557..41efb1a781 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -20,57 +20,56 @@
 open! Stdlib
 open Javascript
 
-class type mapper =
-  object
-    method loc : Javascript.location -> Javascript.location
+class type mapper = object
+  method loc : Javascript.location -> Javascript.location
 
-    method expression : Javascript.expression -> Javascript.expression
+  method expression : Javascript.expression -> Javascript.expression
 
-    method expression_o : Javascript.expression option -> Javascript.expression option
+  method expression_o : Javascript.expression option -> Javascript.expression option
 
-    method switch_case : Javascript.expression -> Javascript.expression
+  method switch_case : Javascript.expression -> Javascript.expression
 
-    method block : Javascript.statement_list -> Javascript.statement_list
+  method block : Javascript.statement_list -> Javascript.statement_list
 
-    method fun_decl : Javascript.function_declaration -> Javascript.function_declaration
+  method fun_decl : Javascript.function_declaration -> Javascript.function_declaration
 
-    method class_decl : Javascript.class_declaration -> Javascript.class_declaration
+  method class_decl : Javascript.class_declaration -> Javascript.class_declaration
 
-    method initialiser :
-         Javascript.expression * Javascript.location
-      -> Javascript.expression * Javascript.location
+  method initialiser :
+       Javascript.expression * Javascript.location
+    -> Javascript.expression * Javascript.location
 
-    method initialiser_o :
-         (Javascript.expression * Javascript.location) option
-      -> (Javascript.expression * Javascript.location) option
+  method initialiser_o :
+       (Javascript.expression * Javascript.location) option
+    -> (Javascript.expression * Javascript.location) option
 
-    method for_binding :
-         Javascript.variable_declaration_kind
-      -> Javascript.for_binding
-      -> Javascript.for_binding
+  method for_binding :
+       Javascript.variable_declaration_kind
+    -> Javascript.for_binding
+    -> Javascript.for_binding
 
-    method variable_declaration :
-         Javascript.variable_declaration_kind
-      -> Javascript.variable_declaration
-      -> Javascript.variable_declaration
+  method variable_declaration :
+       Javascript.variable_declaration_kind
+    -> Javascript.variable_declaration
+    -> Javascript.variable_declaration
 
-    method statement : Javascript.statement -> Javascript.statement
+  method statement : Javascript.statement -> Javascript.statement
 
-    method statement_o :
-         (Javascript.statement * Javascript.location) option
-      -> (Javascript.statement * Javascript.location) option
+  method statement_o :
+       (Javascript.statement * Javascript.location) option
+    -> (Javascript.statement * Javascript.location) option
 
-    method statements : Javascript.statement_list -> Javascript.statement_list
+  method statements : Javascript.statement_list -> Javascript.statement_list
 
-    method formal_parameter_list :
-      Javascript.formal_parameter_list -> Javascript.formal_parameter_list
+  method formal_parameter_list :
+    Javascript.formal_parameter_list -> Javascript.formal_parameter_list
 
-    method ident : Javascript.ident -> Javascript.ident
+  method ident : Javascript.ident -> Javascript.ident
 
-    method program : Javascript.program -> Javascript.program
+  method program : Javascript.program -> Javascript.program
 
-    method function_body : statement_list -> statement_list
-  end
+  method function_body : statement_list -> statement_list
+end
 
 (* generic js ast walk/map *)
 class map : mapper =
@@ -303,42 +302,41 @@ class map : mapper =
     method function_body x = m#statements x
   end
 
-class type iterator =
-  object
-    method fun_decl : Javascript.function_declaration -> unit
+class type iterator = object
+  method fun_decl : Javascript.function_declaration -> unit
 
-    method early_error : Javascript.early_error -> unit
+  method early_error : Javascript.early_error -> unit
 
-    method expression : Javascript.expression -> unit
+  method expression : Javascript.expression -> unit
 
-    method expression_o : Javascript.expression option -> unit
+  method expression_o : Javascript.expression option -> unit
 
-    method switch_case : Javascript.expression -> unit
+  method switch_case : Javascript.expression -> unit
 
-    method block : Javascript.statement_list -> unit
+  method block : Javascript.statement_list -> unit
 
-    method initialiser : Javascript.expression * Javascript.location -> unit
+  method initialiser : Javascript.expression * Javascript.location -> unit
 
-    method initialiser_o : (Javascript.expression * Javascript.location) option -> unit
+  method initialiser_o : (Javascript.expression * Javascript.location) option -> unit
 
-    method for_binding :
-      Javascript.variable_declaration_kind -> Javascript.for_binding -> unit
+  method for_binding :
+    Javascript.variable_declaration_kind -> Javascript.for_binding -> unit
 
-    method variable_declaration :
-      Javascript.variable_declaration_kind -> Javascript.variable_declaration -> unit
+  method variable_declaration :
+    Javascript.variable_declaration_kind -> Javascript.variable_declaration -> unit
 
-    method statement : Javascript.statement -> unit
+  method statement : Javascript.statement -> unit
 
-    method statement_o : (Javascript.statement * Javascript.location) option -> unit
+  method statement_o : (Javascript.statement * Javascript.location) option -> unit
 
-    method statements : Javascript.statement_list -> unit
+  method statements : Javascript.statement_list -> unit
 
-    method ident : Javascript.ident -> unit
+  method ident : Javascript.ident -> unit
 
-    method program : Javascript.program -> unit
+  method program : Javascript.program -> unit
 
-    method function_body : Javascript.statement_list -> unit
-  end
+  method function_body : Javascript.statement_list -> unit
+end
 
 (* generic js ast iterator *)
 class iter : iterator =
@@ -717,32 +715,31 @@ type block =
   | Params of formal_parameter_list
   | Normal
 
-class type freevar =
-  object ('a)
-    inherit mapper
+class type freevar = object ('a)
+  inherit mapper
 
-    method merge_info : 'a -> unit
+  method merge_info : 'a -> unit
 
-    method merge_block_info : 'a -> unit
+  method merge_block_info : 'a -> unit
 
-    method record_block : block -> unit
+  method record_block : block -> unit
 
-    method state : t
+  method state : t
 
-    method def_var : Javascript.ident -> unit
+  method def_var : Javascript.ident -> unit
 
-    method def_local : Javascript.ident -> unit
+  method def_local : Javascript.ident -> unit
 
-    method use_var : Javascript.ident -> unit
+  method use_var : Javascript.ident -> unit
 
-    method get_count : int Javascript.IdentMap.t
+  method get_count : int Javascript.IdentMap.t
 
-    method get_free : IdentSet.t
+  method get_free : IdentSet.t
 
-    method get_def : IdentSet.t
+  method get_def : IdentSet.t
 
-    method get_use : IdentSet.t
-  end
+  method get_use : IdentSet.t
+end
 
 class free =
   object (m : 'test)
diff --git a/compiler/lib/js_traverse.mli b/compiler/lib/js_traverse.mli
index 855449b7e7..ba625bab20 100644
--- a/compiler/lib/js_traverse.mli
+++ b/compiler/lib/js_traverse.mli
@@ -19,99 +19,94 @@
 open! Stdlib
 open Javascript
 
-class type mapper =
-  object
-    method loc : Javascript.location -> Javascript.location
+class type mapper = object
+  method loc : Javascript.location -> Javascript.location
 
-    method expression : expression -> expression
+  method expression : expression -> expression
 
-    method expression_o : expression option -> expression option
+  method expression_o : expression option -> expression option
 
-    method switch_case : expression -> expression
+  method switch_case : expression -> expression
 
-    method block : Javascript.statement_list -> Javascript.statement_list
+  method block : Javascript.statement_list -> Javascript.statement_list
 
-    method fun_decl : Javascript.function_declaration -> Javascript.function_declaration
+  method fun_decl : Javascript.function_declaration -> Javascript.function_declaration
 
-    method class_decl : Javascript.class_declaration -> Javascript.class_declaration
+  method class_decl : Javascript.class_declaration -> Javascript.class_declaration
 
-    method initialiser : expression * location -> expression * location
+  method initialiser : expression * location -> expression * location
 
-    method initialiser_o :
-      (expression * location) option -> (expression * location) option
+  method initialiser_o : (expression * location) option -> (expression * location) option
 
-    method for_binding :
-         Javascript.variable_declaration_kind
-      -> Javascript.for_binding
-      -> Javascript.for_binding
+  method for_binding :
+       Javascript.variable_declaration_kind
+    -> Javascript.for_binding
+    -> Javascript.for_binding
 
-    method variable_declaration :
-         Javascript.variable_declaration_kind
-      -> Javascript.variable_declaration
-      -> Javascript.variable_declaration
+  method variable_declaration :
+       Javascript.variable_declaration_kind
+    -> Javascript.variable_declaration
+    -> Javascript.variable_declaration
 
-    method statement : statement -> statement
+  method statement : statement -> statement
 
-    method statements : statement_list -> statement_list
+  method statements : statement_list -> statement_list
 
-    method statement_o : (statement * location) option -> (statement * location) option
+  method statement_o : (statement * location) option -> (statement * location) option
 
-    method ident : ident -> ident
+  method ident : ident -> ident
 
-    method formal_parameter_list :
-      Javascript.formal_parameter_list -> Javascript.formal_parameter_list
+  method formal_parameter_list :
+    Javascript.formal_parameter_list -> Javascript.formal_parameter_list
 
-    method program : program -> program
+  method program : program -> program
 
-    method function_body : statement_list -> statement_list
-  end
+  method function_body : statement_list -> statement_list
+end
 
-class type iterator =
-  object
-    method fun_decl : Javascript.function_declaration -> unit
+class type iterator = object
+  method fun_decl : Javascript.function_declaration -> unit
 
-    method early_error : Javascript.early_error -> unit
+  method early_error : Javascript.early_error -> unit
 
-    method expression : Javascript.expression -> unit
+  method expression : Javascript.expression -> unit
 
-    method expression_o : Javascript.expression option -> unit
+  method expression_o : Javascript.expression option -> unit
 
-    method switch_case : Javascript.expression -> unit
+  method switch_case : Javascript.expression -> unit
 
-    method block : Javascript.statement_list -> unit
+  method block : Javascript.statement_list -> unit
 
-    method initialiser : Javascript.expression * Javascript.location -> unit
+  method initialiser : Javascript.expression * Javascript.location -> unit
 
-    method initialiser_o : (Javascript.expression * Javascript.location) option -> unit
+  method initialiser_o : (Javascript.expression * Javascript.location) option -> unit
 
-    method for_binding :
-      Javascript.variable_declaration_kind -> Javascript.for_binding -> unit
+  method for_binding :
+    Javascript.variable_declaration_kind -> Javascript.for_binding -> unit
 
-    method variable_declaration :
-      Javascript.variable_declaration_kind -> Javascript.variable_declaration -> unit
+  method variable_declaration :
+    Javascript.variable_declaration_kind -> Javascript.variable_declaration -> unit
 
-    method statement : Javascript.statement -> unit
+  method statement : Javascript.statement -> unit
 
-    method statement_o : (Javascript.statement * Javascript.location) option -> unit
+  method statement_o : (Javascript.statement * Javascript.location) option -> unit
 
-    method statements : Javascript.statement_list -> unit
+  method statements : Javascript.statement_list -> unit
 
-    method ident : Javascript.ident -> unit
+  method ident : Javascript.ident -> unit
 
-    method program : Javascript.program -> unit
+  method program : Javascript.program -> unit
 
-    method function_body : Javascript.statement_list -> unit
-  end
+  method function_body : Javascript.statement_list -> unit
+end
 
 class map : mapper
 
 class iter : iterator
 
-class subst :
-  (ident -> ident)
-  -> object
-       inherit mapper
-     end
+class subst : (ident -> ident) -> object
+  inherit mapper
+end
 
 type t =
   { use : IdentSet.t
@@ -124,32 +119,31 @@ type block =
   | Params of formal_parameter_list
   | Normal
 
-class type freevar =
-  object ('a)
-    inherit mapper
+class type freevar = object ('a)
+  inherit mapper
 
-    method merge_info : 'a -> unit
+  method merge_info : 'a -> unit
 
-    method merge_block_info : 'a -> unit
+  method merge_block_info : 'a -> unit
 
-    method record_block : block -> unit
+  method record_block : block -> unit
 
-    method def_var : ident -> unit
+  method def_var : ident -> unit
 
-    method def_local : Javascript.ident -> unit
+  method def_local : Javascript.ident -> unit
 
-    method use_var : ident -> unit
+  method use_var : ident -> unit
 
-    method state : t
+  method state : t
 
-    method get_count : int IdentMap.t
+  method get_count : int IdentMap.t
 
-    method get_free : IdentSet.t
+  method get_free : IdentSet.t
 
-    method get_def : IdentSet.t
+  method get_def : IdentSet.t
 
-    method get_use : IdentSet.t
-  end
+  method get_use : IdentSet.t
+end
 
 class free : freevar
 
@@ -157,12 +151,11 @@ class rename_variable : mapper
 
 class share_constant : mapper
 
-class compact_vardecl :
-  object ('a)
-    inherit free
+class compact_vardecl : object ('a)
+  inherit free
 
-    method exc : IdentSet.t
-  end
+  method exc : IdentSet.t
+end
 
 class clean : mapper
 
diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
index 33ddbc6e64..5709ada026 100644
--- a/compiler/lib/ocaml_compiler.ml
+++ b/compiler/lib/ocaml_compiler.ml
@@ -181,16 +181,16 @@ module Symtable = struct
   [@@if ocaml_version >= (5, 2, 0)]
 
   let reloc_get_of_string name = Cmo_format.Reloc_getglobal (Ident.create_persistent name)
-    [@@if ocaml_version < (5, 2, 0)]
+  [@@if ocaml_version < (5, 2, 0)]
 
   let reloc_set_of_string name = Cmo_format.Reloc_setglobal (Ident.create_persistent name)
-    [@@if ocaml_version < (5, 2, 0)]
+  [@@if ocaml_version < (5, 2, 0)]
 
   let reloc_get_of_string name = Cmo_format.Reloc_getcompunit (Compunit name)
-    [@@if ocaml_version >= (5, 2, 0)]
+  [@@if ocaml_version >= (5, 2, 0)]
 
   let reloc_set_of_string name = Cmo_format.Reloc_setcompunit (Compunit name)
-    [@@if ocaml_version >= (5, 2, 0)]
+  [@@if ocaml_version >= (5, 2, 0)]
 
   let reloc_ident name =
     let buf = Bytes.create 4 in
@@ -216,13 +216,13 @@ module Cmo_format = struct
   let name (t : t) =
     let (Compunit name) = t.cu_name in
     name
-    [@@if ocaml_version >= (5, 2, 0)]
+  [@@if ocaml_version >= (5, 2, 0)]
 
   let requires (t : t) = List.map ~f:Ident.name t.cu_required_globals
-    [@@if ocaml_version < (5, 2, 0)]
+  [@@if ocaml_version < (5, 2, 0)]
 
   let requires (t : t) = List.map t.cu_required_compunits ~f:(fun (Compunit u) -> u)
-    [@@if ocaml_version >= (5, 2, 0)]
+  [@@if ocaml_version >= (5, 2, 0)]
 
   let primitives (t : t) = t.cu_primitives
 
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 22568f8323..6646b2ba5b 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -2857,7 +2857,7 @@ module Reloc = struct
     }
 
   let constant_of_const x = Ocaml_compiler.constant_of_const x
-    [@@if ocaml_version < (5, 1, 0)]
+  [@@if ocaml_version < (5, 1, 0)]
 
   let constant_of_const x = Constants.parse x [@@if ocaml_version >= (5, 1, 0)]
 
diff --git a/compiler/tests-dynlink-js/dune b/compiler/tests-dynlink-js/dune
index 6096c6f521..dad62b1aac 100644
--- a/compiler/tests-dynlink-js/dune
+++ b/compiler/tests-dynlink-js/dune
@@ -1,13 +1,19 @@
 (executable
  (name main)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (modules main)
  (libraries js_of_ocaml)
  (modes byte))
 
 (rule
  (target main.js)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (run %{bin:js_of_ocaml} --linkall -o %{target} %{dep:main.bc})))
 
@@ -23,7 +29,10 @@
 
 (rule
  (target main.out)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps plugin.js)
  (action
   (with-outputs-to
@@ -32,6 +41,9 @@
 
 (rule
  (alias runtest)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (diff main.out.expected main.out)))
diff --git a/compiler/tests-dynlink/dune b/compiler/tests-dynlink/dune
index 21c980c985..6722682903 100644
--- a/compiler/tests-dynlink/dune
+++ b/compiler/tests-dynlink/dune
@@ -1,13 +1,19 @@
 (executable
  (name main)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (modules main)
  (libraries dynlink js_of_ocaml-compiler.dynlink)
  (modes byte))
 
 (rule
  (target main.js)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps plugin.cmo export)
  (action
   (run
@@ -27,7 +33,10 @@
 
 (rule
  (target main.out)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps plugin.cmo)
  (action
   (with-outputs-to
@@ -36,6 +45,9 @@
 
 (rule
  (alias runtest)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (diff main.out.expected main.out)))
diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune
index f045ca36c7..be8e3b3041 100644
--- a/compiler/tests-toplevel/dune
+++ b/compiler/tests-toplevel/dune
@@ -1,6 +1,9 @@
 (executables
  (names test_toplevel)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (libraries js_of_ocaml-compiler.dynlink compiler-libs.toplevel)
  (flags
   (:standard -linkall))
@@ -8,13 +11,19 @@
 
 (rule
  (targets test_toplevel.js)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (run %{bin:js_of_ocaml} --toplevel %{dep:test_toplevel.bc} -o %{targets})))
 
 (rule
  (target test_toplevel.referencejs)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps test_toplevel.js)
  (action
   (with-stdout-to
@@ -23,7 +32,10 @@
 
 (rule
  (alias runtest)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps test_toplevel.reference test_toplevel.referencejs)
  (action
   (diff test_toplevel.reference test_toplevel.referencejs)))
diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune
index 157c8af8d2..c3ad4d7d11 100644
--- a/compiler/tests-wasm_of_ocaml/dune
+++ b/compiler/tests-wasm_of_ocaml/dune
@@ -1,11 +1,13 @@
 (executables
  (names gh38)
  (modes js)
- (js_of_ocaml (flags :standard --disable optcall)))
+ (js_of_ocaml
+  (flags :standard --disable optcall)))
 
 (rule
  (target gh38.actual)
- (enabled_if (= %{profile} wasm))
+ (enabled_if
+  (= %{profile} wasm))
  (alias runtest)
  (action
   (with-outputs-to
diff --git a/dune b/dune
index 692e051020..1ea17bb722 100644
--- a/dune
+++ b/dune
@@ -10,12 +10,14 @@
    (build_runtime_flags
     (:standard --enable effects))))
  (wasm
-  (binaries (tools/node_wrapper.sh as node))
+  (binaries
+   (tools/node_wrapper.sh as node))
   (js_of_ocaml
    (compilation_mode separate)
    (targets wasm)))
  (wasm-effects
-  (binaries (tools/node_wrapper.sh as node))
+  (binaries
+   (tools/node_wrapper.sh as node))
   (js_of_ocaml
    (compilation_mode separate)
    (flags
diff --git a/examples/hyperbolic/hypertree.ml b/examples/hyperbolic/hypertree.ml
index c119ccde8d..64bb28c4f5 100644
--- a/examples/hyperbolic/hypertree.ml
+++ b/examples/hyperbolic/hypertree.ml
@@ -103,49 +103,47 @@ let outside_color = Js.string (*"#0c1a0d"*) "#070718"
 
 let option var = Js.Optdef.get var (fun () -> Js.Unsafe.coerce (new%js Js.array_empty))
 
-class type style =
-  object
-    method border : Js.number Js.t Js.optdef Js.readonly_prop
+class type style = object
+  method border : Js.number Js.t Js.optdef Js.readonly_prop
 
-    method padding : Js.number Js.t Js.optdef Js.readonly_prop
+  method padding : Js.number Js.t Js.optdef Js.readonly_prop
 
-    method backgroundColor : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method backgroundColor : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method boundaryColor : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method boundaryColor : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method treeColor : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method treeColor : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method nodeColor : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method nodeColor : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method nodeBackgroundColor : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method nodeBackgroundColor : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method nodeFont : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method nodeFont : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method buttonColor : Js.js_string Js.t Js.optdef Js.readonly_prop
-  end
+  method buttonColor : Js.js_string Js.t Js.optdef Js.readonly_prop
+end
 
 let style : style Js.t = option Js.Unsafe.global##.hyp_style_
 
-class type messages =
-  object
-    method info : Js.js_string Js.t Js.optdef Js.readonly_prop
+class type messages = object
+  method info : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method recenter : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method recenter : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method noRef : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method noRef : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method close : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method close : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method wikimediaCommons : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method wikimediaCommons : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method language : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method language : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method noRef : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method noRef : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method languages : Js.js_string Js.t Js.optdef Js.readonly_prop
+  method languages : Js.js_string Js.t Js.optdef Js.readonly_prop
 
-    method ok : Js.js_string Js.t Js.optdef Js.readonly_prop
-  end
+  method ok : Js.js_string Js.t Js.optdef Js.readonly_prop
+end
 
 let opt_style v default = Js.Optdef.get v (fun () -> default)
 
diff --git a/examples/namespace/dune b/examples/namespace/dune
index fcc31a7fa3..addb88684b 100644
--- a/examples/namespace/dune
+++ b/examples/namespace/dune
@@ -59,6 +59,9 @@
 
 (rule
  (alias runtest)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (diff %{dep:for-node.expected} %{dep:for-node.actual})))
diff --git a/examples/separate_compilation/dune b/examples/separate_compilation/dune
index 78322b385c..39b4261aef 100644
--- a/examples/separate_compilation/dune
+++ b/examples/separate_compilation/dune
@@ -110,14 +110,20 @@
 
 (rule
  (alias runtest)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps bin.reference bin.referencejs)
  (action
   (diff bin.reference bin.referencejs)))
 
 (alias
  (name default)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps
   myruntime.js
   stdlib.cma.js
diff --git a/lib/js_of_ocaml/dom.ml b/lib/js_of_ocaml/dom.ml
index cd99f1d902..c3ecbf0550 100644
--- a/lib/js_of_ocaml/dom.ml
+++ b/lib/js_of_ocaml/dom.ml
@@ -21,12 +21,11 @@
 open Js
 open! Import
 
-class type ['node] nodeList =
-  object
-    method item : int -> 'node t opt meth
+class type ['node] nodeList = object
+  method item : int -> 'node t opt meth
 
-    method length : int readonly_prop
-  end
+  method length : int readonly_prop
+end
 
 let list_of_nodeList (nodeList : 'a nodeList t) =
   let length = nodeList##.length in
@@ -80,46 +79,45 @@ module DocumentPosition = struct
   let ( + ) = add
 end
 
-class type node =
-  object
-    method nodeName : js_string t readonly_prop
+class type node = object
+  method nodeName : js_string t readonly_prop
 
-    method nodeValue : js_string t opt readonly_prop
+  method nodeValue : js_string t opt readonly_prop
 
-    method nodeType : nodeType readonly_prop
+  method nodeType : nodeType readonly_prop
 
-    method parentNode : node t opt prop
+  method parentNode : node t opt prop
 
-    method childNodes : node nodeList t prop
+  method childNodes : node nodeList t prop
 
-    method firstChild : node t opt prop
+  method firstChild : node t opt prop
 
-    method lastChild : node t opt prop
+  method lastChild : node t opt prop
 
-    method previousSibling : node t opt prop
+  method previousSibling : node t opt prop
 
-    method nextSibling : node t opt prop
+  method nextSibling : node t opt prop
 
-    method namespaceURI : js_string t opt prop
+  method namespaceURI : js_string t opt prop
 
-    method insertBefore : node t -> node t opt -> node t meth
+  method insertBefore : node t -> node t opt -> node t meth
 
-    method replaceChild : node t -> node t -> node t meth
+  method replaceChild : node t -> node t -> node t meth
 
-    method removeChild : node t -> node t meth
+  method removeChild : node t -> node t meth
 
-    method appendChild : node t -> node t meth
+  method appendChild : node t -> node t meth
 
-    method hasChildNodes : bool t meth
+  method hasChildNodes : bool t meth
 
-    method cloneNode : bool t -> node t meth
+  method cloneNode : bool t -> node t meth
 
-    method compareDocumentPosition : node t -> DocumentPosition.t meth
+  method compareDocumentPosition : node t -> DocumentPosition.t meth
 
-    method lookupNamespaceURI : js_string t -> js_string t opt meth
+  method lookupNamespaceURI : js_string t -> js_string t opt meth
 
-    method lookupPrefix : js_string t -> js_string t opt meth
-  end
+  method lookupPrefix : js_string t -> js_string t opt meth
+end
 
 let appendChild (p : #node t) (n : #node t) = ignore (p##appendChild (n :> node t))
 
@@ -132,89 +130,85 @@ let insertBefore (p : #node t) (n : #node t) (o : #node t opt) =
   ignore (p##insertBefore (n :> node t) (o :> node t opt))
 
 (** Specification of [Attr] objects. *)
-class type attr =
-  object
-    inherit node
+class type attr = object
+  inherit node
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method specified : bool t readonly_prop
+  method specified : bool t readonly_prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method ownerElement : element t prop
-  end
+  method ownerElement : element t prop
+end
 
 (** Specification of [NamedNodeMap] objects. *)
-and ['node] namedNodeMap =
-  object
-    method getNamedItem : js_string t -> 'node t opt meth
+and ['node] namedNodeMap = object
+  method getNamedItem : js_string t -> 'node t opt meth
 
-    method setNamedItem : 'node t -> 'node t opt meth
+  method setNamedItem : 'node t -> 'node t opt meth
 
-    method removeNamedItem : js_string t -> 'node t opt meth
+  method removeNamedItem : js_string t -> 'node t opt meth
 
-    method item : int -> 'node t opt meth
+  method item : int -> 'node t opt meth
 
-    method length : int readonly_prop
-  end
+  method length : int readonly_prop
+end
 
 (** Specification of [Element] objects. *)
-and element =
-  object
-    inherit node
+and element = object
+  inherit node
 
-    method tagName : js_string t readonly_prop
+  method tagName : js_string t readonly_prop
 
-    method getAttribute : js_string t -> js_string t opt meth
+  method getAttribute : js_string t -> js_string t opt meth
 
-    method setAttribute : js_string t -> js_string t -> unit meth
+  method setAttribute : js_string t -> js_string t -> unit meth
 
-    method removeAttribute : js_string t -> unit meth
+  method removeAttribute : js_string t -> unit meth
 
-    method hasAttribute : js_string t -> bool t meth
+  method hasAttribute : js_string t -> bool t meth
 
-    method getAttributeNS : js_string t -> js_string t -> js_string t opt meth
+  method getAttributeNS : js_string t -> js_string t -> js_string t opt meth
 
-    method setAttributeNS : js_string t -> js_string t -> js_string t -> unit meth
+  method setAttributeNS : js_string t -> js_string t -> js_string t -> unit meth
 
-    method removeAttributeNS : js_string t -> js_string t -> unit meth
+  method removeAttributeNS : js_string t -> js_string t -> unit meth
 
-    method hasAttributeNS : js_string t -> js_string t -> bool t meth
+  method hasAttributeNS : js_string t -> js_string t -> bool t meth
 
-    method getAttributeNode : js_string t -> attr t opt meth
+  method getAttributeNode : js_string t -> attr t opt meth
 
-    method setAttributeNode : attr t -> attr t opt meth
+  method setAttributeNode : attr t -> attr t opt meth
 
-    method removeAttributeNode : attr t -> attr t meth
+  method removeAttributeNode : attr t -> attr t meth
 
-    method getAttributeNodeNS : js_string t -> js_string t -> attr t opt meth
+  method getAttributeNodeNS : js_string t -> js_string t -> attr t opt meth
 
-    method setAttributeNodeNS : attr t -> attr t opt meth
+  method setAttributeNodeNS : attr t -> attr t opt meth
 
-    method getElementsByTagName : js_string t -> element nodeList t meth
+  method getElementsByTagName : js_string t -> element nodeList t meth
 
-    method attributes : attr namedNodeMap t readonly_prop
-  end
+  method attributes : attr namedNodeMap t readonly_prop
+end
 
-class type characterData =
-  object
-    inherit node
+class type characterData = object
+  inherit node
 
-    method data : js_string t prop
+  method data : js_string t prop
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method subjs_stringData : int -> int -> js_string t meth
+  method subjs_stringData : int -> int -> js_string t meth
 
-    method appendData : js_string t -> unit meth
+  method appendData : js_string t -> unit meth
 
-    method insertData : int -> js_string t -> unit meth
+  method insertData : int -> js_string t -> unit meth
 
-    method deleteData : int -> int -> unit meth
+  method deleteData : int -> int -> unit meth
 
-    method replaceData : int -> int -> js_string t -> unit meth
-  end
+  method replaceData : int -> int -> js_string t -> unit meth
+end
 
 class type comment = characterData
 
@@ -222,32 +216,31 @@ class type text = characterData
 
 class type documentFragment = node
 
-class type ['element] document =
-  object
-    inherit node
+class type ['element] document = object
+  inherit node
 
-    method documentElement : 'element t readonly_prop
+  method documentElement : 'element t readonly_prop
 
-    method createDocumentFragment : documentFragment t meth
+  method createDocumentFragment : documentFragment t meth
 
-    method createElement : js_string t -> 'element t meth
+  method createElement : js_string t -> 'element t meth
 
-    method createElementNS : js_string t -> js_string t -> 'element t meth
+  method createElementNS : js_string t -> js_string t -> 'element t meth
 
-    method createTextNode : js_string t -> text t meth
+  method createTextNode : js_string t -> text t meth
 
-    method createAttribute : js_string t -> attr t meth
+  method createAttribute : js_string t -> attr t meth
 
-    method createComment : js_string t -> comment t meth
+  method createComment : js_string t -> comment t meth
 
-    method getElementById : js_string t -> 'element t opt meth
+  method getElementById : js_string t -> 'element t opt meth
 
-    method getElementsByTagName : js_string t -> 'element nodeList t meth
+  method getElementsByTagName : js_string t -> 'element nodeList t meth
 
-    method importNode : element t -> bool t -> 'element t meth
+  method importNode : element t -> bool t -> 'element t meth
 
-    method adoptNode : element t -> 'element t meth
-  end
+  method adoptNode : element t -> 'element t meth
+end
 
 type node_type =
   | Element of element t
@@ -281,24 +274,22 @@ type ('a, 'b) event_listener = ('a, 'b -> bool t) meth_callback opt
       ['a] is the type of the target object; the second parameter
       ['b] is the type of the event object. *)
 
-class type ['a] event =
-  object
-    method _type : js_string t readonly_prop
+class type ['a] event = object
+  method _type : js_string t readonly_prop
 
-    method target : 'a t opt readonly_prop
+  method target : 'a t opt readonly_prop
 
-    method currentTarget : 'a t opt readonly_prop
+  method currentTarget : 'a t opt readonly_prop
 
-    (* Legacy methods *)
-    method srcElement : 'a t opt readonly_prop
-  end
+  (* Legacy methods *)
+  method srcElement : 'a t opt readonly_prop
+end
 
-class type ['a, 'b] customEvent =
-  object
-    inherit ['a] event
+class type ['a, 'b] customEvent = object
+  inherit ['a] event
 
-    method detail : 'b Js.opt Js.readonly_prop
-  end
+  method detail : 'b Js.opt Js.readonly_prop
+end
 
 let no_handler : ('a, 'b) event_listener = Js.null
 
@@ -360,14 +351,13 @@ end
 
 type event_listener_id = unit -> unit
 
-class type event_listener_options =
-  object
-    method capture : bool t writeonly_prop
+class type event_listener_options = object
+  method capture : bool t writeonly_prop
 
-    method once : bool t writeonly_prop
+  method once : bool t writeonly_prop
 
-    method passive : bool t writeonly_prop
-  end
+  method passive : bool t writeonly_prop
+end
 
 let addEventListenerWithOptions (e : (< .. > as 'a) t) typ ?capture ?once ?passive h =
   if not (Js.Optdef.test (Js.Unsafe.coerce e)##.addEventListener)
@@ -419,11 +409,10 @@ let createCustomEvent ?bubbles ?cancelable ?detail typ =
 
 (* IE < 9 *)
 
-class type stringList =
-  object
-    method item : int -> js_string t opt meth
+class type stringList = object
+  method item : int -> js_string t opt meth
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method contains : js_string t -> bool t meth
-  end
+  method contains : js_string t -> bool t meth
+end
diff --git a/lib/js_of_ocaml/dom.mli b/lib/js_of_ocaml/dom.mli
index 9e066e64a2..da1180817c 100644
--- a/lib/js_of_ocaml/dom.mli
+++ b/lib/js_of_ocaml/dom.mli
@@ -28,12 +28,11 @@ open Js
 (** {2 DOM objects} *)
 
 (** Specification of [NodeList] objects. *)
-class type ['node] nodeList =
-  object
-    method item : int -> 'node t opt meth
+class type ['node] nodeList = object
+  method item : int -> 'node t opt meth
 
-    method length : int readonly_prop
-  end
+  method length : int readonly_prop
+end
 
 type nodeType =
   | OTHER
@@ -76,132 +75,127 @@ module DocumentPosition : sig
 end
 
 (** Specification of [Node] objects. *)
-class type node =
-  object
-    method nodeName : js_string t readonly_prop
+class type node = object
+  method nodeName : js_string t readonly_prop
 
-    method nodeValue : js_string t opt readonly_prop
+  method nodeValue : js_string t opt readonly_prop
 
-    method nodeType : nodeType readonly_prop
+  method nodeType : nodeType readonly_prop
 
-    method parentNode : node t opt prop
+  method parentNode : node t opt prop
 
-    method childNodes : node nodeList t prop
+  method childNodes : node nodeList t prop
 
-    method firstChild : node t opt prop
+  method firstChild : node t opt prop
 
-    method lastChild : node t opt prop
+  method lastChild : node t opt prop
 
-    method previousSibling : node t opt prop
+  method previousSibling : node t opt prop
 
-    method nextSibling : node t opt prop
+  method nextSibling : node t opt prop
 
-    method namespaceURI : js_string t opt prop
+  method namespaceURI : js_string t opt prop
 
-    method insertBefore : node t -> node t opt -> node t meth
+  method insertBefore : node t -> node t opt -> node t meth
 
-    method replaceChild : node t -> node t -> node t meth
+  method replaceChild : node t -> node t -> node t meth
 
-    method removeChild : node t -> node t meth
+  method removeChild : node t -> node t meth
 
-    method appendChild : node t -> node t meth
+  method appendChild : node t -> node t meth
 
-    method hasChildNodes : bool t meth
+  method hasChildNodes : bool t meth
 
-    method cloneNode : bool t -> node t meth
+  method cloneNode : bool t -> node t meth
 
-    method compareDocumentPosition : node t -> DocumentPosition.t meth
+  method compareDocumentPosition : node t -> DocumentPosition.t meth
 
-    method lookupNamespaceURI : js_string t -> js_string t opt meth
+  method lookupNamespaceURI : js_string t -> js_string t opt meth
 
-    method lookupPrefix : js_string t -> js_string t opt meth
-  end
+  method lookupPrefix : js_string t -> js_string t opt meth
+end
 
 (** Specification of [Attr] objects. *)
-class type attr =
-  object
-    inherit node
+class type attr = object
+  inherit node
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method specified : bool t readonly_prop
+  method specified : bool t readonly_prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method ownerElement : element t prop
-  end
+  method ownerElement : element t prop
+end
 
 (** Specification of [NamedNodeMap] objects. *)
-and ['node] namedNodeMap =
-  object
-    method getNamedItem : js_string t -> 'node t opt meth
+and ['node] namedNodeMap = object
+  method getNamedItem : js_string t -> 'node t opt meth
 
-    method setNamedItem : 'node t -> 'node t opt meth
+  method setNamedItem : 'node t -> 'node t opt meth
 
-    method removeNamedItem : js_string t -> 'node t opt meth
+  method removeNamedItem : js_string t -> 'node t opt meth
 
-    method item : int -> 'node t opt meth
+  method item : int -> 'node t opt meth
 
-    method length : int readonly_prop
-  end
+  method length : int readonly_prop
+end
 
 (** Specification of [Element] objects. *)
-and element =
-  object
-    inherit node
+and element = object
+  inherit node
 
-    method tagName : js_string t readonly_prop
+  method tagName : js_string t readonly_prop
 
-    method getAttribute : js_string t -> js_string t opt meth
+  method getAttribute : js_string t -> js_string t opt meth
 
-    method setAttribute : js_string t -> js_string t -> unit meth
+  method setAttribute : js_string t -> js_string t -> unit meth
 
-    method removeAttribute : js_string t -> unit meth
+  method removeAttribute : js_string t -> unit meth
 
-    method hasAttribute : js_string t -> bool t meth
+  method hasAttribute : js_string t -> bool t meth
 
-    method getAttributeNS : js_string t -> js_string t -> js_string t opt meth
+  method getAttributeNS : js_string t -> js_string t -> js_string t opt meth
 
-    method setAttributeNS : js_string t -> js_string t -> js_string t -> unit meth
+  method setAttributeNS : js_string t -> js_string t -> js_string t -> unit meth
 
-    method removeAttributeNS : js_string t -> js_string t -> unit meth
+  method removeAttributeNS : js_string t -> js_string t -> unit meth
 
-    method hasAttributeNS : js_string t -> js_string t -> bool t meth
+  method hasAttributeNS : js_string t -> js_string t -> bool t meth
 
-    method getAttributeNode : js_string t -> attr t opt meth
+  method getAttributeNode : js_string t -> attr t opt meth
 
-    method setAttributeNode : attr t -> attr t opt meth
+  method setAttributeNode : attr t -> attr t opt meth
 
-    method removeAttributeNode : attr t -> attr t meth
+  method removeAttributeNode : attr t -> attr t meth
 
-    method getAttributeNodeNS : js_string t -> js_string t -> attr t opt meth
+  method getAttributeNodeNS : js_string t -> js_string t -> attr t opt meth
 
-    method setAttributeNodeNS : attr t -> attr t opt meth
+  method setAttributeNodeNS : attr t -> attr t opt meth
 
-    method getElementsByTagName : js_string t -> element nodeList t meth
+  method getElementsByTagName : js_string t -> element nodeList t meth
 
-    method attributes : attr namedNodeMap t readonly_prop
-  end
+  method attributes : attr namedNodeMap t readonly_prop
+end
 
 (** Specification of [CharacterData] objects. *)
-class type characterData =
-  object
-    inherit node
+class type characterData = object
+  inherit node
 
-    method data : js_string t prop
+  method data : js_string t prop
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method subjs_stringData : int -> int -> js_string t meth
+  method subjs_stringData : int -> int -> js_string t meth
 
-    method appendData : js_string t -> unit meth
+  method appendData : js_string t -> unit meth
 
-    method insertData : int -> js_string t -> unit meth
+  method insertData : int -> js_string t -> unit meth
 
-    method deleteData : int -> int -> unit meth
+  method deleteData : int -> int -> unit meth
 
-    method replaceData : int -> int -> js_string t -> unit meth
-  end
+  method replaceData : int -> int -> js_string t -> unit meth
+end
 
 class type comment = characterData
 (** Specification of [Comment] objects *)
@@ -213,32 +207,31 @@ class type documentFragment = node
 (** Specification of [DocumentFragment] objects. *)
 
 (** Specification of [Document] objects. *)
-class type ['element] document =
-  object
-    inherit node
+class type ['element] document = object
+  inherit node
 
-    method documentElement : 'element t readonly_prop
+  method documentElement : 'element t readonly_prop
 
-    method createDocumentFragment : documentFragment t meth
+  method createDocumentFragment : documentFragment t meth
 
-    method createElement : js_string t -> 'element t meth
+  method createElement : js_string t -> 'element t meth
 
-    method createElementNS : js_string t -> js_string t -> 'element t meth
+  method createElementNS : js_string t -> js_string t -> 'element t meth
 
-    method createTextNode : js_string t -> text t meth
+  method createTextNode : js_string t -> text t meth
 
-    method createAttribute : js_string t -> attr t meth
+  method createAttribute : js_string t -> attr t meth
 
-    method createComment : js_string t -> comment t meth
+  method createComment : js_string t -> comment t meth
 
-    method getElementById : js_string t -> 'element t opt meth
+  method getElementById : js_string t -> 'element t opt meth
 
-    method getElementsByTagName : js_string t -> 'element nodeList t meth
+  method getElementsByTagName : js_string t -> 'element nodeList t meth
 
-    method importNode : element t -> bool t -> 'element t meth
+  method importNode : element t -> bool t -> 'element t meth
 
-    method adoptNode : element t -> 'element t meth
-  end
+  method adoptNode : element t -> 'element t meth
+end
 
 (** {2 Helper functions} *)
 
@@ -292,24 +285,22 @@ type (-'a, -'b) event_listener
       ['a] is the type of the target object; the second parameter
       ['b] is the type of the event object. *)
 
-class type ['a] event =
-  object
-    method _type : js_string t readonly_prop
+class type ['a] event = object
+  method _type : js_string t readonly_prop
 
-    method target : 'a t opt readonly_prop
+  method target : 'a t opt readonly_prop
 
-    method currentTarget : 'a t opt readonly_prop
+  method currentTarget : 'a t opt readonly_prop
 
-    (* Legacy methods *)
-    method srcElement : 'a t opt readonly_prop
-  end
+  (* Legacy methods *)
+  method srcElement : 'a t opt readonly_prop
+end
 
-class type ['a, 'b] customEvent =
-  object
-    inherit ['a] event
+class type ['a, 'b] customEvent = object
+  inherit ['a] event
 
-    method detail : 'b Js.opt Js.readonly_prop
-  end
+  method detail : 'b Js.opt Js.readonly_prop
+end
 
 (** {2 Event handlers} *)
 
@@ -380,11 +371,10 @@ val createCustomEvent :
 
 (** {2 Other DOM objects} *)
 
-class type stringList =
-  object
-    method item : int -> js_string t opt meth
+class type stringList = object
+  method item : int -> js_string t opt meth
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method contains : js_string t -> bool t meth
-  end
+  method contains : js_string t -> bool t meth
+end
diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index ae2f81eca6..38ed36d2e7 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -32,239 +32,238 @@ external html_entities : js_string t -> js_string t opt = "caml_js_html_entities
 let decode_html_entities s =
   Js.Opt.get (html_entities s) (fun () -> failwith ("Invalid entity " ^ Js.to_string s))
 
-class type cssStyleDeclaration =
-  object
-    method setProperty :
-      js_string t -> js_string t -> js_string t optdef -> js_string t meth
+class type cssStyleDeclaration = object
+  method setProperty :
+    js_string t -> js_string t -> js_string t optdef -> js_string t meth
 
-    method getPropertyValue : js_string t -> js_string t meth
+  method getPropertyValue : js_string t -> js_string t meth
 
-    method getPropertyPriority : js_string t -> js_string t meth
+  method getPropertyPriority : js_string t -> js_string t meth
 
-    method removeProperty : js_string t -> js_string t meth
+  method removeProperty : js_string t -> js_string t meth
 
-    method animation : js_string t prop
+  method animation : js_string t prop
 
-    method animationDelay : js_string t prop
+  method animationDelay : js_string t prop
 
-    method animationDirection : js_string t prop
+  method animationDirection : js_string t prop
 
-    method animationDuration : js_string t prop
+  method animationDuration : js_string t prop
 
-    method animationFillMode : js_string t prop
+  method animationFillMode : js_string t prop
 
-    method animationIterationCount : js_string t prop
+  method animationIterationCount : js_string t prop
 
-    method animationName : js_string t prop
+  method animationName : js_string t prop
 
-    method animationPlayState : js_string t prop
+  method animationPlayState : js_string t prop
 
-    method animationTimingFunction : js_string t prop
+  method animationTimingFunction : js_string t prop
 
-    method background : js_string t prop
+  method background : js_string t prop
 
-    method backgroundAttachment : js_string t prop
+  method backgroundAttachment : js_string t prop
 
-    method backgroundColor : js_string t prop
+  method backgroundColor : js_string t prop
 
-    method backgroundImage : js_string t prop
+  method backgroundImage : js_string t prop
 
-    method backgroundPosition : js_string t prop
+  method backgroundPosition : js_string t prop
 
-    method backgroundRepeat : js_string t prop
+  method backgroundRepeat : js_string t prop
 
-    method border : js_string t prop
+  method border : js_string t prop
 
-    method borderBottom : js_string t prop
+  method borderBottom : js_string t prop
 
-    method borderBottomColor : js_string t prop
+  method borderBottomColor : js_string t prop
 
-    method borderBottomStyle : js_string t prop
+  method borderBottomStyle : js_string t prop
 
-    method borderBottomWidth : js_string t prop
+  method borderBottomWidth : js_string t prop
 
-    method borderCollapse : js_string t prop
+  method borderCollapse : js_string t prop
 
-    method borderColor : js_string t prop
+  method borderColor : js_string t prop
 
-    method borderLeft : js_string t prop
+  method borderLeft : js_string t prop
 
-    method borderLeftColor : js_string t prop
+  method borderLeftColor : js_string t prop
 
-    method borderLeftStyle : js_string t prop
+  method borderLeftStyle : js_string t prop
 
-    method borderLeftWidth : js_string t prop
+  method borderLeftWidth : js_string t prop
 
-    method borderRadius : js_string t prop
+  method borderRadius : js_string t prop
 
-    method borderRight : js_string t prop
+  method borderRight : js_string t prop
 
-    method borderRightColor : js_string t prop
+  method borderRightColor : js_string t prop
 
-    method borderRightStyle : js_string t prop
+  method borderRightStyle : js_string t prop
 
-    method borderRightWidth : js_string t prop
+  method borderRightWidth : js_string t prop
 
-    method borderSpacing : js_string t prop
+  method borderSpacing : js_string t prop
 
-    method borderStyle : js_string t prop
+  method borderStyle : js_string t prop
 
-    method borderTop : js_string t prop
+  method borderTop : js_string t prop
 
-    method borderTopColor : js_string t prop
+  method borderTopColor : js_string t prop
 
-    method borderTopStyle : js_string t prop
+  method borderTopStyle : js_string t prop
 
-    method borderTopWidth : js_string t prop
+  method borderTopWidth : js_string t prop
 
-    method borderWidth : js_string t prop
+  method borderWidth : js_string t prop
 
-    method bottom : js_string t prop
+  method bottom : js_string t prop
 
-    method captionSide : js_string t prop
+  method captionSide : js_string t prop
 
-    method clear : js_string t prop
+  method clear : js_string t prop
 
-    method clip : js_string t prop
+  method clip : js_string t prop
 
-    method color : js_string t prop
+  method color : js_string t prop
 
-    method content : js_string t prop
+  method content : js_string t prop
 
-    method counterIncrement : js_string t prop
+  method counterIncrement : js_string t prop
 
-    method counterReset : js_string t prop
+  method counterReset : js_string t prop
 
-    method cssFloat : js_string t prop
+  method cssFloat : js_string t prop
 
-    method cssText : js_string t prop
+  method cssText : js_string t prop
 
-    method cursor : js_string t prop
+  method cursor : js_string t prop
 
-    method direction : js_string t prop
+  method direction : js_string t prop
 
-    method display : js_string t prop
+  method display : js_string t prop
 
-    method emptyCells : js_string t prop
+  method emptyCells : js_string t prop
 
-    method fill : js_string t prop
+  method fill : js_string t prop
 
-    method font : js_string t prop
+  method font : js_string t prop
 
-    method fontFamily : js_string t prop
+  method fontFamily : js_string t prop
 
-    method fontSize : js_string t prop
+  method fontSize : js_string t prop
 
-    method fontStyle : js_string t prop
+  method fontStyle : js_string t prop
 
-    method fontVariant : js_string t prop
+  method fontVariant : js_string t prop
 
-    method fontWeight : js_string t prop
+  method fontWeight : js_string t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method left : js_string t prop
+  method left : js_string t prop
 
-    method letterSpacing : js_string t prop
+  method letterSpacing : js_string t prop
 
-    method lineHeight : js_string t prop
+  method lineHeight : js_string t prop
 
-    method listStyle : js_string t prop
+  method listStyle : js_string t prop
 
-    method listStyleImage : js_string t prop
+  method listStyleImage : js_string t prop
 
-    method listStylePosition : js_string t prop
+  method listStylePosition : js_string t prop
 
-    method listStyleType : js_string t prop
+  method listStyleType : js_string t prop
 
-    method margin : js_string t prop
+  method margin : js_string t prop
 
-    method marginBottom : js_string t prop
+  method marginBottom : js_string t prop
 
-    method marginLeft : js_string t prop
+  method marginLeft : js_string t prop
 
-    method marginRight : js_string t prop
+  method marginRight : js_string t prop
 
-    method marginTop : js_string t prop
+  method marginTop : js_string t prop
 
-    method maxHeight : js_string t prop
+  method maxHeight : js_string t prop
 
-    method maxWidth : js_string t prop
+  method maxWidth : js_string t prop
 
-    method minHeight : js_string t prop
+  method minHeight : js_string t prop
 
-    method minWidth : js_string t prop
+  method minWidth : js_string t prop
 
-    method opacity : js_string t optdef prop
+  method opacity : js_string t optdef prop
 
-    method outline : js_string t prop
+  method outline : js_string t prop
 
-    method outlineColor : js_string t prop
+  method outlineColor : js_string t prop
 
-    method outlineOffset : js_string t prop
+  method outlineOffset : js_string t prop
 
-    method outlineStyle : js_string t prop
+  method outlineStyle : js_string t prop
 
-    method outlineWidth : js_string t prop
+  method outlineWidth : js_string t prop
 
-    method overflow : js_string t prop
+  method overflow : js_string t prop
 
-    method overflowX : js_string t prop
+  method overflowX : js_string t prop
 
-    method overflowY : js_string t prop
+  method overflowY : js_string t prop
 
-    method padding : js_string t prop
+  method padding : js_string t prop
 
-    method paddingBottom : js_string t prop
+  method paddingBottom : js_string t prop
 
-    method paddingLeft : js_string t prop
+  method paddingLeft : js_string t prop
 
-    method paddingRight : js_string t prop
+  method paddingRight : js_string t prop
 
-    method paddingTop : js_string t prop
+  method paddingTop : js_string t prop
 
-    method pageBreakAfter : js_string t prop
+  method pageBreakAfter : js_string t prop
 
-    method pageBreakBefore : js_string t prop
+  method pageBreakBefore : js_string t prop
 
-    method pointerEvents : js_string t prop
+  method pointerEvents : js_string t prop
 
-    method position : js_string t prop
+  method position : js_string t prop
 
-    method right : js_string t prop
+  method right : js_string t prop
 
-    method stroke : js_string t prop
+  method stroke : js_string t prop
 
-    method strokeWidth : js_string t prop
+  method strokeWidth : js_string t prop
 
-    method tableLayout : js_string t prop
+  method tableLayout : js_string t prop
 
-    method textAlign : js_string t prop
+  method textAlign : js_string t prop
 
-    method textAnchor : js_string t prop
+  method textAnchor : js_string t prop
 
-    method textDecoration : js_string t prop
+  method textDecoration : js_string t prop
 
-    method textIndent : js_string t prop
+  method textIndent : js_string t prop
 
-    method textTransform : js_string t prop
+  method textTransform : js_string t prop
 
-    method top : js_string t prop
+  method top : js_string t prop
 
-    method transform : js_string t prop
+  method transform : js_string t prop
 
-    method verticalAlign : js_string t prop
+  method verticalAlign : js_string t prop
 
-    method visibility : js_string t prop
+  method visibility : js_string t prop
 
-    method whiteSpace : js_string t prop
+  method whiteSpace : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method wordSpacing : js_string t prop
+  method wordSpacing : js_string t prop
 
-    method zIndex : js_string t prop
-  end
+  method zIndex : js_string t prop
+end
 
 type ('a, 'b) event_listener = ('a, 'b) Dom.event_listener
 
@@ -279,519 +278,489 @@ type delta_mode =
   | Delta_line
   | Delta_page
 
-class type event =
-  object
-    inherit [element] Dom.event
-  end
+class type event = object
+  inherit [element] Dom.event
+end
 
-and ['a] customEvent =
-  object
-    inherit [element, 'a] Dom.customEvent
-  end
+and ['a] customEvent = object
+  inherit [element, 'a] Dom.customEvent
+end
 
-and focusEvent =
-  object
-    inherit event
+and focusEvent = object
+  inherit event
 
-    method relatedTarget : element t opt optdef readonly_prop
-  end
+  method relatedTarget : element t opt optdef readonly_prop
+end
 
-and mouseEvent =
-  object
-    inherit event
+and mouseEvent = object
+  inherit event
 
-    method relatedTarget : element t opt optdef readonly_prop
+  method relatedTarget : element t opt optdef readonly_prop
 
-    method clientX : int readonly_prop
+  method clientX : int readonly_prop
 
-    method clientY : int readonly_prop
+  method clientY : int readonly_prop
 
-    method screenX : int readonly_prop
+  method screenX : int readonly_prop
 
-    method screenY : int readonly_prop
+  method screenY : int readonly_prop
 
-    method offsetX : int readonly_prop
+  method offsetX : int readonly_prop
 
-    method offsetY : int readonly_prop
+  method offsetY : int readonly_prop
 
-    method ctrlKey : bool t readonly_prop
+  method ctrlKey : bool t readonly_prop
 
-    method shiftKey : bool t readonly_prop
+  method shiftKey : bool t readonly_prop
 
-    method altKey : bool t readonly_prop
+  method altKey : bool t readonly_prop
 
-    method metaKey : bool t readonly_prop
+  method metaKey : bool t readonly_prop
 
-    method button : int readonly_prop
+  method button : int readonly_prop
 
-    method which : mouse_button optdef readonly_prop
+  method which : mouse_button optdef readonly_prop
 
-    method fromElement : element t opt optdef readonly_prop
+  method fromElement : element t opt optdef readonly_prop
 
-    method toElement : element t opt optdef readonly_prop
+  method toElement : element t opt optdef readonly_prop
 
-    method pageX : int optdef readonly_prop
+  method pageX : int optdef readonly_prop
 
-    method pageY : int optdef readonly_prop
-  end
+  method pageY : int optdef readonly_prop
+end
 
-and keyboardEvent =
-  object
-    inherit event
+and keyboardEvent = object
+  inherit event
 
-    method altKey : bool t readonly_prop
+  method altKey : bool t readonly_prop
 
-    method shiftKey : bool t readonly_prop
+  method shiftKey : bool t readonly_prop
 
-    method ctrlKey : bool t readonly_prop
+  method ctrlKey : bool t readonly_prop
 
-    method metaKey : bool t readonly_prop
+  method metaKey : bool t readonly_prop
 
-    method location : int readonly_prop
+  method location : int readonly_prop
 
-    method key : js_string t optdef readonly_prop
+  method key : js_string t optdef readonly_prop
 
-    method code : js_string t optdef readonly_prop
+  method code : js_string t optdef readonly_prop
 
-    method which : int optdef readonly_prop
+  method which : int optdef readonly_prop
 
-    method charCode : int optdef readonly_prop
+  method charCode : int optdef readonly_prop
 
-    method keyCode : int readonly_prop
+  method keyCode : int readonly_prop
 
-    method getModifierState : js_string t -> bool t meth
+  method getModifierState : js_string t -> bool t meth
 
-    method keyIdentifier : js_string t optdef readonly_prop
-  end
+  method keyIdentifier : js_string t optdef readonly_prop
+end
 
-and mousewheelEvent =
-  object
-    (* All modern browsers *)
-    inherit mouseEvent
+and mousewheelEvent = object
+  (* All modern browsers *)
+  inherit mouseEvent
 
-    method wheelDelta : int readonly_prop
+  method wheelDelta : int readonly_prop
 
-    method wheelDeltaX : int optdef readonly_prop
+  method wheelDeltaX : int optdef readonly_prop
 
-    method wheelDeltaY : int optdef readonly_prop
+  method wheelDeltaY : int optdef readonly_prop
 
-    method deltaX : number t readonly_prop
+  method deltaX : number t readonly_prop
 
-    method deltaY : number t readonly_prop
+  method deltaY : number t readonly_prop
 
-    method deltaZ : number t readonly_prop
+  method deltaZ : number t readonly_prop
 
-    method deltaMode : delta_mode readonly_prop
-  end
+  method deltaMode : delta_mode readonly_prop
+end
 
-and mouseScrollEvent =
-  object
-    (* Firefox *)
-    inherit mouseEvent
+and mouseScrollEvent = object
+  (* Firefox *)
+  inherit mouseEvent
 
-    method detail : int readonly_prop
+  method detail : int readonly_prop
 
-    method axis : int optdef readonly_prop
+  method axis : int optdef readonly_prop
 
-    method _HORIZONTAL_AXIS : int optdef readonly_prop
+  method _HORIZONTAL_AXIS : int optdef readonly_prop
 
-    method _VERTICAL_AXIS : int optdef readonly_prop
-  end
+  method _VERTICAL_AXIS : int optdef readonly_prop
+end
 
-and touchEvent =
-  object
-    inherit event
+and touchEvent = object
+  inherit event
 
-    method touches : touchList t readonly_prop
+  method touches : touchList t readonly_prop
 
-    method targetTouches : touchList t readonly_prop
+  method targetTouches : touchList t readonly_prop
 
-    method changedTouches : touchList t readonly_prop
+  method changedTouches : touchList t readonly_prop
 
-    method ctrlKey : bool t readonly_prop
+  method ctrlKey : bool t readonly_prop
 
-    method shiftKey : bool t readonly_prop
+  method shiftKey : bool t readonly_prop
 
-    method altKey : bool t readonly_prop
+  method altKey : bool t readonly_prop
 
-    method metaKey : bool t readonly_prop
+  method metaKey : bool t readonly_prop
 
-    method relatedTarget : element t opt optdef readonly_prop
-  end
+  method relatedTarget : element t opt optdef readonly_prop
+end
 
-and touchList =
-  object
-    method length : int readonly_prop
+and touchList = object
+  method length : int readonly_prop
 
-    method item : int -> touch t optdef meth
-  end
+  method item : int -> touch t optdef meth
+end
 
-and touch =
-  object
-    method identifier : int readonly_prop
+and touch = object
+  method identifier : int readonly_prop
 
-    method target : element t optdef readonly_prop
+  method target : element t optdef readonly_prop
 
-    method screenX : int readonly_prop
+  method screenX : int readonly_prop
 
-    method screenY : int readonly_prop
+  method screenY : int readonly_prop
 
-    method clientX : int readonly_prop
+  method clientX : int readonly_prop
 
-    method clientY : int readonly_prop
+  method clientY : int readonly_prop
 
-    method pageX : int readonly_prop
+  method pageX : int readonly_prop
 
-    method pageY : int readonly_prop
-  end
+  method pageY : int readonly_prop
+end
 
-and submitEvent =
-  object
-    inherit event
+and submitEvent = object
+  inherit event
 
-    method submitter : element t optdef readonly_prop
-  end
+  method submitter : element t optdef readonly_prop
+end
 
-and dragEvent =
-  object
-    inherit mouseEvent
+and dragEvent = object
+  inherit mouseEvent
 
-    method dataTransfer : dataTransfer t readonly_prop
-  end
+  method dataTransfer : dataTransfer t readonly_prop
+end
 
-and clipboardEvent =
-  object
-    inherit event
+and clipboardEvent = object
+  inherit event
 
-    method clipboardData : dataTransfer t readonly_prop
-  end
+  method clipboardData : dataTransfer t readonly_prop
+end
 
-and dataTransfer =
-  object
-    method dropEffect : js_string t prop
+and dataTransfer = object
+  method dropEffect : js_string t prop
 
-    method effectAllowed : js_string t prop
+  method effectAllowed : js_string t prop
 
-    method files : File.fileList t readonly_prop
+  method files : File.fileList t readonly_prop
 
-    method types : js_string t js_array t readonly_prop
+  method types : js_string t js_array t readonly_prop
 
-    method addElement : element t -> unit meth
+  method addElement : element t -> unit meth
 
-    method clearData : js_string t -> unit meth
+  method clearData : js_string t -> unit meth
 
-    method clearData_all : unit meth
+  method clearData_all : unit meth
 
-    method getData : js_string t -> js_string t meth
+  method getData : js_string t -> js_string t meth
 
-    method setData : js_string t -> js_string t -> unit meth
+  method setData : js_string t -> js_string t -> unit meth
 
-    method setDragImage : element t -> int -> int -> unit meth
-  end
+  method setDragImage : element t -> int -> int -> unit meth
+end
 
-and eventTarget =
-  object ('self)
-    method onclick : ('self t, mouseEvent t) event_listener writeonly_prop
+and eventTarget = object ('self)
+  method onclick : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method ondblclick : ('self t, mouseEvent t) event_listener writeonly_prop
+  method ondblclick : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmousedown : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmousedown : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmouseup : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmouseup : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmouseover : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmouseover : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmousemove : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmousemove : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmouseout : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmouseout : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onkeypress : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onkeypress : ('self t, keyboardEvent t) event_listener writeonly_prop
 
-    method onkeydown : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onkeydown : ('self t, keyboardEvent t) event_listener writeonly_prop
 
-    method onkeyup : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onkeyup : ('self t, keyboardEvent t) event_listener writeonly_prop
 
-    method onscroll : ('self t, event t) event_listener writeonly_prop
+  method onscroll : ('self t, event t) event_listener writeonly_prop
 
-    method onwheel : ('self t, mousewheelEvent t) event_listener writeonly_prop
+  method onwheel : ('self t, mousewheelEvent t) event_listener writeonly_prop
 
-    method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragenter : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragenter : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragover : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragover : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragleave : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragleave : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondrag : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondrag : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondrop : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondrop : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method onanimationstart : ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationstart : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method onanimationend : ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationend : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method onanimationiteration :
-      ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationiteration : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method onanimationcancel : ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationcancel : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method ontransitionrun : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitionrun : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ontransitionstart : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitionstart : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ontransitionend : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitionend : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ontransitioncancel : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitioncancel : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ongotpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
+  method ongotpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onlostpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onlostpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerenter : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerenter : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointercancel : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointercancel : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerdown : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerdown : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerleave : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerleave : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointermove : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointermove : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerout : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerout : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerover : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerover : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerup : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerup : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method dispatchEvent : event t -> bool t meth
-  end
+  method dispatchEvent : event t -> bool t meth
+end
 
-and popStateEvent =
-  object
-    inherit event
+and popStateEvent = object
+  inherit event
 
-    method state : Js.Unsafe.any readonly_prop
-  end
+  method state : Js.Unsafe.any readonly_prop
+end
 
-and pointerEvent =
-  object
-    inherit mouseEvent
+and pointerEvent = object
+  inherit mouseEvent
 
-    method pointerId : int Js.readonly_prop
+  method pointerId : int Js.readonly_prop
 
-    method width : number t Js.readonly_prop
+  method width : number t Js.readonly_prop
 
-    method height : number t Js.readonly_prop
+  method height : number t Js.readonly_prop
 
-    method pressure : number t Js.readonly_prop
+  method pressure : number t Js.readonly_prop
 
-    method tangentialPressure : number t Js.readonly_prop
+  method tangentialPressure : number t Js.readonly_prop
 
-    method tiltX : int Js.readonly_prop
+  method tiltX : int Js.readonly_prop
 
-    method tiltY : int Js.readonly_prop
+  method tiltY : int Js.readonly_prop
 
-    method twist : int Js.readonly_prop
+  method twist : int Js.readonly_prop
 
-    method pointerType : Js.js_string Js.t Js.readonly_prop
+  method pointerType : Js.js_string Js.t Js.readonly_prop
 
-    method isPrimary : bool Js.t Js.readonly_prop
-  end
+  method isPrimary : bool Js.t Js.readonly_prop
+end
 
-and storageEvent =
-  object
-    inherit event
+and storageEvent = object
+  inherit event
 
-    method key : js_string t opt readonly_prop
+  method key : js_string t opt readonly_prop
 
-    method oldValue : js_string t opt readonly_prop
+  method oldValue : js_string t opt readonly_prop
 
-    method newValue : js_string t opt readonly_prop
+  method newValue : js_string t opt readonly_prop
 
-    method url : js_string t readonly_prop
+  method url : js_string t readonly_prop
 
-    method storageArea : storage t opt readonly_prop
-  end
+  method storageArea : storage t opt readonly_prop
+end
 
-and storage =
-  object
-    method length : int readonly_prop
+and storage = object
+  method length : int readonly_prop
 
-    method key : int -> js_string t opt meth
+  method key : int -> js_string t opt meth
 
-    method getItem : js_string t -> js_string t opt meth
+  method getItem : js_string t -> js_string t opt meth
 
-    method setItem : js_string t -> js_string t -> unit meth
+  method setItem : js_string t -> js_string t -> unit meth
 
-    method removeItem : js_string t -> unit meth
+  method removeItem : js_string t -> unit meth
 
-    method clear : unit meth
-  end
+  method clear : unit meth
+end
 
-and hashChangeEvent =
-  object
-    inherit event
+and hashChangeEvent = object
+  inherit event
 
-    method oldURL : js_string t readonly_prop
+  method oldURL : js_string t readonly_prop
 
-    method newURL : js_string t readonly_prop
-  end
+  method newURL : js_string t readonly_prop
+end
 
-and animationEvent =
-  object
-    inherit event
+and animationEvent = object
+  inherit event
 
-    method animationName : js_string t readonly_prop
+  method animationName : js_string t readonly_prop
 
-    method elapsedTime : number t readonly_prop
+  method elapsedTime : number t readonly_prop
 
-    method pseudoElement : js_string t readonly_prop
-  end
+  method pseudoElement : js_string t readonly_prop
+end
 
-and transitionEvent =
-  object
-    inherit event
+and transitionEvent = object
+  inherit event
 
-    method propertyName : js_string t readonly_prop
+  method propertyName : js_string t readonly_prop
 
-    method elapsedTime : number t readonly_prop
+  method elapsedTime : number t readonly_prop
 
-    method pseudoElement : js_string t readonly_prop
-  end
+  method pseudoElement : js_string t readonly_prop
+end
 
-and mediaEvent =
-  object
-    inherit event
-  end
+and mediaEvent = object
+  inherit event
+end
 
-and messageEvent =
-  object
-    inherit event
+and messageEvent = object
+  inherit event
 
-    method data : Unsafe.any opt readonly_prop
+  method data : Unsafe.any opt readonly_prop
 
-    method source : Unsafe.any opt readonly_prop
-  end
+  method source : Unsafe.any opt readonly_prop
+end
 
-and nodeSelector =
-  object
-    method querySelector : js_string t -> element t opt meth
+and nodeSelector = object
+  method querySelector : js_string t -> element t opt meth
 
-    method querySelectorAll : js_string t -> element Dom.nodeList t meth
-  end
+  method querySelectorAll : js_string t -> element Dom.nodeList t meth
+end
 
-and tokenList =
-  object
-    method length : int readonly_prop
+and tokenList = object
+  method length : int readonly_prop
 
-    method item : int -> js_string t optdef meth
+  method item : int -> js_string t optdef meth
 
-    method contains : js_string t -> bool t meth
+  method contains : js_string t -> bool t meth
 
-    method add : js_string t -> unit meth
+  method add : js_string t -> unit meth
 
-    method remove : js_string t -> unit meth
+  method remove : js_string t -> unit meth
 
-    method toggle : js_string t -> bool t meth
+  method toggle : js_string t -> bool t meth
 
-    method stringifier : js_string t prop
-  end
+  method stringifier : js_string t prop
+end
 
-and element =
-  object
-    inherit Dom.element
+and element = object
+  inherit Dom.element
 
-    inherit nodeSelector
+  inherit nodeSelector
 
-    method id : js_string t prop
+  method id : js_string t prop
 
-    method title : js_string t prop
+  method title : js_string t prop
 
-    method lang : js_string t prop
+  method lang : js_string t prop
 
-    method dir : js_string t prop
+  method dir : js_string t prop
 
-    method className : js_string t prop
+  method className : js_string t prop
 
-    method classList : tokenList t readonly_prop
+  method classList : tokenList t readonly_prop
 
-    method closest : js_string t -> element t opt meth
+  method closest : js_string t -> element t opt meth
 
-    method style : cssStyleDeclaration t prop
+  method style : cssStyleDeclaration t prop
 
-    method innerHTML : js_string t prop
+  method innerHTML : js_string t prop
 
-    method outerHTML : js_string t prop
+  method outerHTML : js_string t prop
 
-    method textContent : js_string t opt prop
+  method textContent : js_string t opt prop
 
-    method innerText : js_string t prop
+  method innerText : js_string t prop
 
-    method clientLeft : int readonly_prop
+  method clientLeft : int readonly_prop
 
-    method clientTop : int readonly_prop
+  method clientTop : int readonly_prop
 
-    method clientWidth : int readonly_prop
+  method clientWidth : int readonly_prop
 
-    method clientHeight : int readonly_prop
+  method clientHeight : int readonly_prop
 
-    method offsetLeft : int readonly_prop
+  method offsetLeft : int readonly_prop
 
-    method offsetTop : int readonly_prop
+  method offsetTop : int readonly_prop
 
-    method offsetParent : element t opt readonly_prop
+  method offsetParent : element t opt readonly_prop
 
-    method offsetWidth : int readonly_prop
+  method offsetWidth : int readonly_prop
 
-    method offsetHeight : int readonly_prop
+  method offsetHeight : int readonly_prop
 
-    method scrollLeft : int prop
+  method scrollLeft : int prop
 
-    method scrollTop : int prop
+  method scrollTop : int prop
 
-    method scrollWidth : int prop
+  method scrollWidth : int prop
 
-    method scrollHeight : int prop
+  method scrollHeight : int prop
 
-    method getClientRects : clientRectList t meth
+  method getClientRects : clientRectList t meth
 
-    method getBoundingClientRect : clientRect t meth
+  method getBoundingClientRect : clientRect t meth
 
-    method scrollIntoView : bool t -> unit meth
+  method scrollIntoView : bool t -> unit meth
 
-    method click : unit meth
+  method click : unit meth
 
-    method focus : unit meth
+  method focus : unit meth
 
-    method blur : unit meth
+  method blur : unit meth
 
-    inherit eventTarget
-  end
+  inherit eventTarget
+end
 
-and clientRect =
-  object
-    method top : number t readonly_prop
+and clientRect = object
+  method top : number t readonly_prop
 
-    method right : number t readonly_prop
+  method right : number t readonly_prop
 
-    method bottom : number t readonly_prop
+  method bottom : number t readonly_prop
 
-    method left : number t readonly_prop
+  method left : number t readonly_prop
 
-    method width : number t optdef readonly_prop
+  method width : number t optdef readonly_prop
 
-    method height : number t optdef readonly_prop
-  end
+  method height : number t optdef readonly_prop
+end
 
-and clientRectList =
-  object
-    method length : int readonly_prop
+and clientRectList = object
+  method length : int readonly_prop
 
-    method item : int -> clientRect t opt meth
-  end
+  method item : int -> clientRect t opt meth
+end
 
 let no_handler : ('a, 'b) event_listener = Dom.no_handler
 
@@ -999,338 +968,321 @@ let removeEventListener = Dom.removeEventListener
 
 let createCustomEvent = Dom.createCustomEvent
 
-class type ['node] collection =
-  object
-    method length : int readonly_prop
+class type ['node] collection = object
+  method length : int readonly_prop
 
-    method item : int -> 'node t opt meth
+  method item : int -> 'node t opt meth
 
-    method namedItem : js_string t -> 'node t opt meth
-  end
+  method namedItem : js_string t -> 'node t opt meth
+end
 
 class type htmlElement = element
 
-class type headElement =
-  object
-    inherit element
+class type headElement = object
+  inherit element
 
-    method profile : js_string t prop
-  end
+  method profile : js_string t prop
+end
 
-class type linkElement =
-  object
-    inherit element
+class type linkElement = object
+  inherit element
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method charset : js_string t prop
+  method charset : js_string t prop
 
-    method crossorigin : js_string t prop
+  method crossorigin : js_string t prop
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method hreflang : js_string t prop
+  method hreflang : js_string t prop
 
-    method media : js_string t prop
+  method media : js_string t prop
 
-    method rel : js_string t prop
+  method rel : js_string t prop
 
-    method rev : js_string t prop
+  method rev : js_string t prop
 
-    method target : js_string t prop
+  method target : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
-class type titleElement =
-  object
-    inherit element
+class type titleElement = object
+  inherit element
 
-    method text : js_string t prop
-  end
+  method text : js_string t prop
+end
 
-class type metaElement =
-  object
-    inherit element
+class type metaElement = object
+  inherit element
 
-    method content : js_string t prop
+  method content : js_string t prop
 
-    method httpEquiv : js_string t prop
+  method httpEquiv : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method scheme : js_string t prop
-  end
+  method scheme : js_string t prop
+end
 
-class type baseElement =
-  object
-    inherit element
+class type baseElement = object
+  inherit element
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method target : js_string t prop
-  end
+  method target : js_string t prop
+end
 
-class type styleElement =
-  object
-    inherit element
+class type styleElement = object
+  inherit element
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method media : js_string t prop
+  method media : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
 class type bodyElement = element
 
-class type formElement =
-  object
-    inherit element
+class type formElement = object
+  inherit element
 
-    method elements : element collection t readonly_prop
+  method elements : element collection t readonly_prop
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method acceptCharset : js_string t prop
+  method acceptCharset : js_string t prop
 
-    method action : js_string t prop
+  method action : js_string t prop
 
-    method enctype : js_string t prop
+  method enctype : js_string t prop
 
-    method _method : js_string t prop
+  method _method : js_string t prop
 
-    method target : js_string t prop
+  method target : js_string t prop
 
-    method submit : unit meth
+  method submit : unit meth
 
-    method reset : unit meth
+  method reset : unit meth
 
-    method onsubmit : ('self t, submitEvent t) event_listener writeonly_prop
-  end
+  method onsubmit : ('self t, submitEvent t) event_listener writeonly_prop
+end
 
-class type optGroupElement =
-  object
-    inherit element
+class type optGroupElement = object
+  inherit element
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method label : js_string t prop
-  end
+  method label : js_string t prop
+end
 
-class type optionElement =
-  object
-    inherit optGroupElement
+class type optionElement = object
+  inherit optGroupElement
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method defaultSelected : bool t prop
+  method defaultSelected : bool t prop
 
-    method text : js_string t readonly_prop
+  method text : js_string t readonly_prop
 
-    method index : int readonly_prop
+  method index : int readonly_prop
 
-    method selected : bool t prop
+  method selected : bool t prop
 
-    method value : js_string t prop
-  end
+  method value : js_string t prop
+end
 
-class type selectElement =
-  object ('self)
-    inherit element
+class type selectElement = object ('self)
+  inherit element
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    method selectedIndex : int prop
+  method selectedIndex : int prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method length : int prop
+  method length : int prop
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method options : optionElement collection t readonly_prop
+  method options : optionElement collection t readonly_prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method multiple : bool t prop
+  method multiple : bool t prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method size : int prop
+  method size : int prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method add : #optGroupElement t -> #optGroupElement t opt -> unit meth
+  method add : #optGroupElement t -> #optGroupElement t opt -> unit meth
 
-    method remove : int -> unit meth
+  method remove : int -> unit meth
 
-    method required : bool t writeonly_prop
+  method required : bool t writeonly_prop
 
-    method onchange : ('self t, event t) event_listener prop
+  method onchange : ('self t, event t) event_listener prop
 
-    method oninput : ('self t, event t) event_listener prop
-  end
+  method oninput : ('self t, event t) event_listener prop
+end
 
-class type inputElement =
-  object ('self)
-    inherit element
+class type inputElement = object ('self)
+  inherit element
 
-    method defaultValue : js_string t prop
+  method defaultValue : js_string t prop
 
-    method defaultChecked : js_string t prop
+  method defaultChecked : js_string t prop
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accept : js_string t prop
+  method accept : js_string t prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method alt : js_string t prop
+  method alt : js_string t prop
 
-    method checked : bool t prop
+  method checked : bool t prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method maxLength : int prop
+  method maxLength : int prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method readOnly : bool t prop
+  method readOnly : bool t prop
 
-    method required : bool t writeonly_prop
+  method required : bool t writeonly_prop
 
-    method size : int prop
+  method size : int prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    method useMap : js_string t prop
+  method useMap : js_string t prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method select : unit meth
+  method select : unit meth
 
-    method files : File.fileList t optdef readonly_prop
+  method files : File.fileList t optdef readonly_prop
 
-    method placeholder : js_string t writeonly_prop
+  method placeholder : js_string t writeonly_prop
 
-    method selectionDirection : js_string t prop
+  method selectionDirection : js_string t prop
 
-    method selectionStart : int prop
+  method selectionStart : int prop
 
-    method selectionEnd : int prop
+  method selectionEnd : int prop
 
-    method onselect : ('self t, event t) event_listener prop
+  method onselect : ('self t, event t) event_listener prop
 
-    method onchange : ('self t, event t) event_listener prop
+  method onchange : ('self t, event t) event_listener prop
 
-    method oninput : ('self t, event t) event_listener prop
+  method oninput : ('self t, event t) event_listener prop
 
-    method onblur : ('self t, focusEvent t) event_listener prop
+  method onblur : ('self t, focusEvent t) event_listener prop
 
-    method onfocus : ('self t, focusEvent t) event_listener prop
-  end
+  method onfocus : ('self t, focusEvent t) event_listener prop
+end
 
-class type textAreaElement =
-  object ('self)
-    inherit element
+class type textAreaElement = object ('self)
+  inherit element
 
-    method defaultValue : js_string t prop
+  method defaultValue : js_string t prop
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method cols : int prop
+  method cols : int prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method readOnly : bool t prop
+  method readOnly : bool t prop
 
-    method rows : int prop
+  method rows : int prop
 
-    method selectionDirection : js_string t prop
+  method selectionDirection : js_string t prop
 
-    method selectionEnd : int prop
+  method selectionEnd : int prop
 
-    method selectionStart : int prop
+  method selectionStart : int prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method select : unit meth
+  method select : unit meth
 
-    method required : bool t writeonly_prop
+  method required : bool t writeonly_prop
 
-    method placeholder : js_string t writeonly_prop
+  method placeholder : js_string t writeonly_prop
 
-    method onselect : ('self t, event t) event_listener prop
+  method onselect : ('self t, event t) event_listener prop
 
-    method onchange : ('self t, event t) event_listener prop
+  method onchange : ('self t, event t) event_listener prop
 
-    method oninput : ('self t, event t) event_listener prop
+  method oninput : ('self t, event t) event_listener prop
 
-    method onblur : ('self t, focusEvent t) event_listener prop
+  method onblur : ('self t, focusEvent t) event_listener prop
 
-    method onfocus : ('self t, focusEvent t) event_listener prop
-  end
+  method onfocus : ('self t, focusEvent t) event_listener prop
+end
 
-class type buttonElement =
-  object
-    inherit element
+class type buttonElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    method value : js_string t prop
-  end
+  method value : js_string t prop
+end
 
-class type labelElement =
-  object
-    inherit element
+class type labelElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method htmlFor : js_string t prop
-  end
+  method htmlFor : js_string t prop
+end
 
-class type fieldSetElement =
-  object
-    inherit element
+class type fieldSetElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
-  end
+  method form : formElement t opt readonly_prop
+end
 
-class type legendElement =
-  object
-    inherit element
+class type legendElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
-  end
+  method accessKey : js_string t prop
+end
 
 class type uListElement = element
 
@@ -1346,12 +1298,11 @@ class type paragraphElement = element
 
 class type headingElement = element
 
-class type quoteElement =
-  object
-    inherit element
+class type quoteElement = object
+  inherit element
 
-    method cite : js_string t prop
-  end
+  method cite : js_string t prop
+end
 
 class type preElement = element
 
@@ -1359,324 +1310,309 @@ class type brElement = element
 
 class type hrElement = element
 
-class type modElement =
-  object
-    inherit element
+class type modElement = object
+  inherit element
 
-    method cite : js_string t prop
+  method cite : js_string t prop
 
-    method dateTime : js_string t prop
-  end
+  method dateTime : js_string t prop
+end
 
-class type anchorElement =
-  object
-    inherit element
+class type anchorElement = object
+  inherit element
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method charset : js_string t prop
+  method charset : js_string t prop
 
-    method coords : js_string t prop
+  method coords : js_string t prop
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method hreflang : js_string t prop
+  method hreflang : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method rel : js_string t prop
+  method rel : js_string t prop
 
-    method rev : js_string t prop
+  method rev : js_string t prop
 
-    method shape : js_string t prop
+  method shape : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method target : js_string t prop
+  method target : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
-class type imageElement =
-  object ('self)
-    inherit element
+class type imageElement = object ('self)
+  inherit element
 
-    method alt : js_string t prop
+  method alt : js_string t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method useMap : js_string t prop
+  method useMap : js_string t prop
 
-    method isMap : bool t prop
+  method isMap : bool t prop
 
-    method width : int prop
+  method width : int prop
 
-    method height : int prop
+  method height : int prop
 
-    method naturalWidth : int optdef readonly_prop
+  method naturalWidth : int optdef readonly_prop
 
-    method naturalHeight : int optdef readonly_prop
+  method naturalHeight : int optdef readonly_prop
 
-    method complete : bool t prop
+  method complete : bool t prop
 
-    method onload : ('self t, event t) event_listener prop
+  method onload : ('self t, event t) event_listener prop
 
-    method onerror : ('self t, event t) event_listener prop
+  method onerror : ('self t, event t) event_listener prop
 
-    method onabort : ('self t, event t) event_listener prop
-  end
+  method onabort : ('self t, event t) event_listener prop
+end
 
-class type objectElement =
-  object
-    inherit element
+class type objectElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method code : js_string t prop
+  method code : js_string t prop
 
-    method archive : js_string t prop
+  method archive : js_string t prop
 
-    method codeBase : js_string t prop
+  method codeBase : js_string t prop
 
-    method codeType : js_string t prop
+  method codeType : js_string t prop
 
-    method data : js_string t prop
+  method data : js_string t prop
 
-    method declare : bool t prop
+  method declare : bool t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method standby : js_string t prop
+  method standby : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method _type : js_string t prop
+  method _type : js_string t prop
 
-    method useMap : js_string t prop
+  method useMap : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method document : Dom.element Dom.document t opt readonly_prop
-  end
+  method document : Dom.element Dom.document t opt readonly_prop
+end
 
-class type paramElement =
-  object
-    inherit element
+class type paramElement = object
+  inherit element
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method _type : js_string t prop
+  method _type : js_string t prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method valueType : js_string t prop
-  end
+  method valueType : js_string t prop
+end
 
-class type areaElement =
-  object
-    inherit element
+class type areaElement = object
+  inherit element
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method alt : js_string t prop
+  method alt : js_string t prop
 
-    method coords : js_string t prop
+  method coords : js_string t prop
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method noHref : bool t prop
+  method noHref : bool t prop
 
-    method shape : js_string t prop
+  method shape : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method target : js_string t prop
-  end
+  method target : js_string t prop
+end
 
-class type mapElement =
-  object
-    inherit element
+class type mapElement = object
+  inherit element
 
-    method areas : areaElement collection t readonly_prop
+  method areas : areaElement collection t readonly_prop
 
-    method name : js_string t prop
-  end
+  method name : js_string t prop
+end
 
-class type scriptElement =
-  object
-    inherit element
+class type scriptElement = object
+  inherit element
 
-    method text : js_string t prop
+  method text : js_string t prop
 
-    method charset : js_string t prop
+  method charset : js_string t prop
 
-    method defer : bool t prop
+  method defer : bool t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method _type : js_string t prop
+  method _type : js_string t prop
 
-    method async : bool t prop
-  end
+  method async : bool t prop
+end
 
-class type embedElement =
-  object
-    inherit element
+class type embedElement = object
+  inherit element
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
-class type tableCellElement =
-  object
-    inherit element
+class type tableCellElement = object
+  inherit element
 
-    method cellIndex : int readonly_prop
+  method cellIndex : int readonly_prop
 
-    method abbr : js_string t prop
+  method abbr : js_string t prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method axis : js_string t prop
+  method axis : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method colSpan : int prop
+  method colSpan : int prop
 
-    method headers : js_string t prop
+  method headers : js_string t prop
 
-    method rowSpan : int prop
+  method rowSpan : int prop
 
-    method scope : js_string t prop
+  method scope : js_string t prop
 
-    method vAlign : js_string t prop
-  end
+  method vAlign : js_string t prop
+end
 
-class type tableRowElement =
-  object
-    inherit element
+class type tableRowElement = object
+  inherit element
 
-    method rowIndex : int readonly_prop
+  method rowIndex : int readonly_prop
 
-    method sectionRowIndex : int readonly_prop
+  method sectionRowIndex : int readonly_prop
 
-    method cells : tableCellElement collection t readonly_prop
+  method cells : tableCellElement collection t readonly_prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method vAlign : js_string t prop
+  method vAlign : js_string t prop
 
-    method insertCell : int -> tableCellElement t meth
+  method insertCell : int -> tableCellElement t meth
 
-    method deleteCell : int -> unit meth
-  end
+  method deleteCell : int -> unit meth
+end
 
-class type tableColElement =
-  object
-    inherit element
+class type tableColElement = object
+  inherit element
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method span : int prop
+  method span : int prop
 
-    method vAlign : js_string t prop
+  method vAlign : js_string t prop
 
-    method width : js_string t prop
-  end
+  method width : js_string t prop
+end
 
-class type tableSectionElement =
-  object
-    inherit element
+class type tableSectionElement = object
+  inherit element
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method vAlign : js_string t prop
+  method vAlign : js_string t prop
 
-    method rows : tableRowElement collection t readonly_prop
+  method rows : tableRowElement collection t readonly_prop
 
-    method insertRow : int -> tableRowElement t meth
+  method insertRow : int -> tableRowElement t meth
 
-    method deleteRow : int -> unit meth
-  end
+  method deleteRow : int -> unit meth
+end
 
 class type tableCaptionElement = element
 
-class type tableElement =
-  object
-    inherit element
+class type tableElement = object
+  inherit element
 
-    method caption : tableCaptionElement t prop
+  method caption : tableCaptionElement t prop
 
-    method tHead : tableSectionElement t prop
+  method tHead : tableSectionElement t prop
 
-    method tFoot : tableSectionElement t prop
+  method tFoot : tableSectionElement t prop
 
-    method rows : tableRowElement collection t readonly_prop
+  method rows : tableRowElement collection t readonly_prop
 
-    method tBodies : tableSectionElement collection t readonly_prop
+  method tBodies : tableSectionElement collection t readonly_prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method border : js_string t prop
+  method border : js_string t prop
 
-    method cellPadding : js_string t prop
+  method cellPadding : js_string t prop
 
-    method cellSpacing : js_string t prop
+  method cellSpacing : js_string t prop
 
-    method frame : js_string t prop
+  method frame : js_string t prop
 
-    method rules : js_string t prop
+  method rules : js_string t prop
 
-    method summary : js_string t prop
+  method summary : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method createTHead : tableSectionElement t meth
+  method createTHead : tableSectionElement t meth
 
-    method deleteTHead : unit meth
+  method deleteTHead : unit meth
 
-    method createTFoot : tableSectionElement t meth
+  method createTFoot : tableSectionElement t meth
 
-    method deleteTFoot : unit meth
+  method deleteTFoot : unit meth
 
-    method createCaption : tableCaptionElement t meth
+  method createCaption : tableCaptionElement t meth
 
-    method deleteCaption : unit meth
+  method deleteCaption : unit meth
 
-    method insertRow : int -> tableRowElement t meth
+  method insertRow : int -> tableRowElement t meth
 
-    method deleteRow : int -> unit meth
-  end
+  method deleteRow : int -> unit meth
+end
 
-class type timeRanges =
-  object
-    method length : int readonly_prop
+class type timeRanges = object
+  method length : int readonly_prop
 
-    method start : int -> number t meth
+  method start : int -> number t meth
 
-    method end_ : int -> number t meth
-  end
+  method end_ : int -> number t meth
+end
 
 type networkState =
   | NETWORK_EMPTY
@@ -1693,108 +1629,105 @@ type readyState =
 
 (* http://www.w3schools.com/tags/ref_av_dom.asp *)
 (* only features supported by all browser. (IE9+) *)
-class type mediaElement =
-  object
-    inherit element
+class type mediaElement = object
+  inherit element
 
-    method canPlayType : js_string t -> js_string t meth
+  method canPlayType : js_string t -> js_string t meth
 
-    method load : unit meth
+  method load : unit meth
 
-    method play : unit meth
+  method play : unit meth
 
-    method pause : unit meth
+  method pause : unit meth
 
-    method autoplay : bool t prop
+  method autoplay : bool t prop
 
-    method buffered : timeRanges t readonly_prop
+  method buffered : timeRanges t readonly_prop
 
-    method controls : bool t prop
+  method controls : bool t prop
 
-    method currentSrc : js_string t readonly_prop
+  method currentSrc : js_string t readonly_prop
 
-    method currentTime : number t prop
+  method currentTime : number t prop
 
-    method duration : number t readonly_prop
+  method duration : number t readonly_prop
 
-    method ended : bool t readonly_prop
+  method ended : bool t readonly_prop
 
-    method loop : bool t prop
+  method loop : bool t prop
 
-    method mediagroup : js_string t prop
+  method mediagroup : js_string t prop
 
-    method muted : bool t prop
+  method muted : bool t prop
 
-    method networkState_int : int readonly_prop
+  method networkState_int : int readonly_prop
 
-    method networkState : networkState readonly_prop
+  method networkState : networkState readonly_prop
 
-    method paused : bool t readonly_prop
+  method paused : bool t readonly_prop
 
-    method playbackRate : number t prop
+  method playbackRate : number t prop
 
-    method played : timeRanges t readonly_prop
+  method played : timeRanges t readonly_prop
 
-    method preload : js_string t prop
+  method preload : js_string t prop
 
-    method readyState_int : int readonly_prop
+  method readyState_int : int readonly_prop
 
-    method readyState : readyState readonly_prop
+  method readyState : readyState readonly_prop
 
-    method seekable : timeRanges t readonly_prop
+  method seekable : timeRanges t readonly_prop
 
-    method seeking : bool t readonly_prop
+  method seeking : bool t readonly_prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method volume : number t prop
+  method volume : number t prop
 
-    method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
+  method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method oncanplaythrough : ('self t, mediaEvent t) event_listener writeonly_prop
+  method oncanplaythrough : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method ondurationchange : ('self t, mediaEvent t) event_listener writeonly_prop
+  method ondurationchange : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onemptied : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onemptied : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onended : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onended : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onloadeddata : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onloadeddata : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onloadedmetadata : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onloadedmetadata : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onloadstart : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onloadstart : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onpause : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onpause : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onplay : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onplaying : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onplaying : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onratechange : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onratechange : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onseeked : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onseeked : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onseeking : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onseeking : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onstalled : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onstalled : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onsuspend : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onsuspend : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onvolumechange : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onvolumechange : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onwaiting : ('self t, mediaEvent t) event_listener writeonly_prop
-  end
+  method onwaiting : ('self t, mediaEvent t) event_listener writeonly_prop
+end
 
-class type audioElement =
-  object
-    inherit mediaElement
-  end
+class type audioElement = object
+  inherit mediaElement
+end
 
-class type videoElement =
-  object
-    inherit mediaElement
-  end
+class type videoElement = object
+  inherit mediaElement
+end
 
 type context = js_string t
 
@@ -1802,384 +1735,373 @@ let _2d_ = Js.string "2d"
 
 type canvasPattern
 
-class type canvasElement =
-  object
-    inherit element
+class type canvasElement = object
+  inherit element
 
-    method width : int prop
+  method width : int prop
 
-    method height : int prop
+  method height : int prop
 
-    method toDataURL : js_string t meth
+  method toDataURL : js_string t meth
 
-    method toDataURL_type : js_string t -> js_string t meth
+  method toDataURL_type : js_string t -> js_string t meth
 
-    method toDataURL_type_compression : js_string t -> number t -> js_string t meth
+  method toDataURL_type_compression : js_string t -> number t -> js_string t meth
 
-    method getContext : js_string t -> canvasRenderingContext2D t meth
-  end
+  method getContext : js_string t -> canvasRenderingContext2D t meth
+end
 
-and canvasRenderingContext2D =
-  object
-    method canvas : canvasElement t readonly_prop
+and canvasRenderingContext2D = object
+  method canvas : canvasElement t readonly_prop
 
-    method save : unit meth
+  method save : unit meth
 
-    method restore : unit meth
+  method restore : unit meth
 
-    method scale : number t -> number t -> unit meth
+  method scale : number t -> number t -> unit meth
 
-    method rotate : number t -> unit meth
+  method rotate : number t -> unit meth
 
-    method translate : number t -> number t -> unit meth
+  method translate : number t -> number t -> unit meth
 
-    method transform :
-      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+  method transform :
+    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method setTransform :
-      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+  method setTransform :
+    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method globalAlpha : number t prop
+  method globalAlpha : number t prop
 
-    method globalCompositeOperation : js_string t prop
+  method globalCompositeOperation : js_string t prop
 
-    method strokeStyle : js_string t writeonly_prop
+  method strokeStyle : js_string t writeonly_prop
 
-    method strokeStyle_gradient : canvasGradient t writeonly_prop
+  method strokeStyle_gradient : canvasGradient t writeonly_prop
 
-    method strokeStyle_pattern : canvasPattern t writeonly_prop
+  method strokeStyle_pattern : canvasPattern t writeonly_prop
 
-    method fillStyle : js_string t writeonly_prop
+  method fillStyle : js_string t writeonly_prop
 
-    method fillStyle_gradient : canvasGradient t writeonly_prop
+  method fillStyle_gradient : canvasGradient t writeonly_prop
 
-    method fillStyle_pattern : canvasPattern t writeonly_prop
+  method fillStyle_pattern : canvasPattern t writeonly_prop
 
-    method createLinearGradient :
-      number t -> number t -> number t -> number t -> canvasGradient t meth
+  method createLinearGradient :
+    number t -> number t -> number t -> number t -> canvasGradient t meth
 
-    method createRadialGradient :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> canvasGradient t meth
+  method createRadialGradient :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> canvasGradient t meth
 
-    method createPattern : imageElement t -> js_string t -> canvasPattern t meth
+  method createPattern : imageElement t -> js_string t -> canvasPattern t meth
 
-    method createPattern_fromCanvas :
-      canvasElement t -> js_string t -> canvasPattern t meth
+  method createPattern_fromCanvas : canvasElement t -> js_string t -> canvasPattern t meth
 
-    method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
+  method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-    method lineWidth : number t prop
+  method lineWidth : number t prop
 
-    method lineCap : js_string t prop
+  method lineCap : js_string t prop
 
-    method lineJoin : js_string t prop
+  method lineJoin : js_string t prop
 
-    method miterLimit : number t prop
+  method miterLimit : number t prop
 
-    method shadowOffsetX : number t prop
+  method shadowOffsetX : number t prop
 
-    method shadowOffsetY : number t prop
+  method shadowOffsetY : number t prop
 
-    method shadowBlur : number t prop
+  method shadowBlur : number t prop
 
-    method shadowColor : js_string t prop
+  method shadowColor : js_string t prop
 
-    method clearRect : number t -> number t -> number t -> number t -> unit meth
+  method clearRect : number t -> number t -> number t -> number t -> unit meth
 
-    method fillRect : number t -> number t -> number t -> number t -> unit meth
+  method fillRect : number t -> number t -> number t -> number t -> unit meth
 
-    method strokeRect : number t -> number t -> number t -> number t -> unit meth
+  method strokeRect : number t -> number t -> number t -> number t -> unit meth
 
-    method beginPath : unit meth
+  method beginPath : unit meth
 
-    method closePath : unit meth
+  method closePath : unit meth
 
-    method moveTo : number t -> number t -> unit meth
+  method moveTo : number t -> number t -> unit meth
 
-    method lineTo : number t -> number t -> unit meth
+  method lineTo : number t -> number t -> unit meth
 
-    method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
+  method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
 
-    method bezierCurveTo :
-      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+  method bezierCurveTo :
+    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
+  method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method rect : number t -> number t -> number t -> number t -> unit meth
+  method rect : number t -> number t -> number t -> number t -> unit meth
 
-    method arc :
-      number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
+  method arc :
+    number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
 
-    method fill : unit meth
+  method fill : unit meth
 
-    method stroke : unit meth
+  method stroke : unit meth
 
-    method clip : unit meth
+  method clip : unit meth
 
-    method isPointInPath : number t -> number t -> bool t meth
+  method isPointInPath : number t -> number t -> bool t meth
 
-    method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
+  method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
 
-    method font : js_string t prop
+  method font : js_string t prop
 
-    method textAlign : js_string t prop
+  method textAlign : js_string t prop
 
-    method textBaseline : js_string t prop
+  method textBaseline : js_string t prop
 
-    method fillText : js_string t -> number t -> number t -> unit meth
+  method fillText : js_string t -> number t -> number t -> unit meth
 
-    method fillText_withWidth :
-      js_string t -> number t -> number t -> number t -> unit meth
+  method fillText_withWidth : js_string t -> number t -> number t -> number t -> unit meth
 
-    method strokeText : js_string t -> number t -> number t -> unit meth
+  method strokeText : js_string t -> number t -> number t -> unit meth
 
-    method strokeText_withWidth :
-      js_string t -> number t -> number t -> number t -> unit meth
+  method strokeText_withWidth :
+    js_string t -> number t -> number t -> number t -> unit meth
 
-    method measureText : js_string t -> textMetrics t meth
+  method measureText : js_string t -> textMetrics t meth
 
-    method drawImage : imageElement t -> number t -> number t -> unit meth
+  method drawImage : imageElement t -> number t -> number t -> unit meth
 
-    method drawImage_withSize :
-      imageElement t -> number t -> number t -> number t -> number t -> unit meth
+  method drawImage_withSize :
+    imageElement t -> number t -> number t -> number t -> number t -> unit meth
 
-    method drawImage_full :
-         imageElement t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method drawImage_full :
+       imageElement t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
+  method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
 
-    method drawImage_fromCanvasWithSize :
-      canvasElement t -> number t -> number t -> number t -> number t -> unit meth
+  method drawImage_fromCanvasWithSize :
+    canvasElement t -> number t -> number t -> number t -> number t -> unit meth
 
-    method drawImage_fullFromCanvas :
-         canvasElement t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method drawImage_fullFromCanvas :
+       canvasElement t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    method drawImage_fromVideoWithVideo :
-      videoElement t -> number t -> number t -> unit meth
+  method drawImage_fromVideoWithVideo :
+    videoElement t -> number t -> number t -> unit meth
 
-    method drawImage_fromVideoWithSize :
-      videoElement t -> number t -> number t -> number t -> number t -> unit meth
+  method drawImage_fromVideoWithSize :
+    videoElement t -> number t -> number t -> number t -> number t -> unit meth
 
-    method drawImage_fullFromVideo :
-         videoElement t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method drawImage_fullFromVideo :
+       videoElement t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    method createImageData : int -> int -> imageData t meth
+  method createImageData : int -> int -> imageData t meth
 
-    method getImageData : number t -> number t -> number t -> number t -> imageData t meth
+  method getImageData : number t -> number t -> number t -> number t -> imageData t meth
 
-    method putImageData : imageData t -> number t -> number t -> unit meth
-  end
+  method putImageData : imageData t -> number t -> number t -> unit meth
+end
 
-and canvasGradient =
-  object
-    method addColorStop : number t -> js_string t -> unit meth
-  end
+and canvasGradient = object
+  method addColorStop : number t -> js_string t -> unit meth
+end
 
-and textMetrics =
-  object
-    method width : number t readonly_prop
-  end
+and textMetrics = object
+  method width : number t readonly_prop
+end
 
-and imageData =
-  object
-    method width : int readonly_prop
+and imageData = object
+  method width : int readonly_prop
 
-    method height : int readonly_prop
+  method height : int readonly_prop
 
-    method data : canvasPixelArray t readonly_prop
-  end
+  method data : canvasPixelArray t readonly_prop
+end
 
-and canvasPixelArray =
-  object
-    method length : int readonly_prop
-  end
+and canvasPixelArray = object
+  method length : int readonly_prop
+end
 
 external pixel_get : canvasPixelArray t -> int -> int = "caml_js_get"
 
 external pixel_set : canvasPixelArray t -> int -> int -> unit = "caml_js_set"
 
-class type range =
-  object
-    method collapsed : bool t readonly_prop
+class type range = object
+  method collapsed : bool t readonly_prop
 
-    method startOffset : int readonly_prop
+  method startOffset : int readonly_prop
 
-    method endOffset : int readonly_prop
+  method endOffset : int readonly_prop
 
-    method startContainer : Dom.node t readonly_prop
+  method startContainer : Dom.node t readonly_prop
 
-    method endContainer : Dom.node t readonly_prop
+  method endContainer : Dom.node t readonly_prop
 
-    method setStart : Dom.node t -> int -> unit meth
+  method setStart : Dom.node t -> int -> unit meth
 
-    method setEnd : Dom.node t -> int -> unit meth
+  method setEnd : Dom.node t -> int -> unit meth
 
-    method setStartBefore : Dom.node t -> unit meth
+  method setStartBefore : Dom.node t -> unit meth
 
-    method setEndBefore : Dom.node t -> unit meth
+  method setEndBefore : Dom.node t -> unit meth
 
-    method setStartAfter : Dom.node t -> unit meth
+  method setStartAfter : Dom.node t -> unit meth
 
-    method setEndAfter : Dom.node t -> unit meth
+  method setEndAfter : Dom.node t -> unit meth
 
-    method selectNode : Dom.node t -> unit meth
+  method selectNode : Dom.node t -> unit meth
 
-    method selectNodeContents : Dom.node t -> unit meth
+  method selectNodeContents : Dom.node t -> unit meth
 
-    method collapse : bool t -> unit meth
+  method collapse : bool t -> unit meth
 
-    method cloneContents : Dom.documentFragment t meth
+  method cloneContents : Dom.documentFragment t meth
 
-    method extractContents : Dom.documentFragment t meth
+  method extractContents : Dom.documentFragment t meth
 
-    method deleteContents : unit meth
+  method deleteContents : unit meth
 
-    method insertNode : Dom.node t -> unit meth
+  method insertNode : Dom.node t -> unit meth
 
-    method surroundContents : Dom.node t -> unit meth
+  method surroundContents : Dom.node t -> unit meth
 
-    method cloneRange : range t meth
+  method cloneRange : range t meth
 
-    method toString : js_string t meth
-  end
+  method toString : js_string t meth
+end
 
 (** Information on current selection *)
-class type selection =
-  object
-    method anchorNode : Dom.node t readonly_prop
+class type selection = object
+  method anchorNode : Dom.node t readonly_prop
 
-    method anchorOffset : int readonly_prop
+  method anchorOffset : int readonly_prop
 
-    method focusNode : Dom.node t readonly_prop
+  method focusNode : Dom.node t readonly_prop
 
-    method focusOffset : int readonly_prop
+  method focusOffset : int readonly_prop
 
-    method isCollapsed : bool t readonly_prop
+  method isCollapsed : bool t readonly_prop
 
-    method rangeCount : int readonly_prop
+  method rangeCount : int readonly_prop
 
-    method getRangeAt : int -> range t meth
+  method getRangeAt : int -> range t meth
 
-    method collapse : bool t -> unit meth
+  method collapse : bool t -> unit meth
 
-    method extend : Dom.node t -> int -> unit meth
+  method extend : Dom.node t -> int -> unit meth
 
-    method modify : js_string t -> js_string t -> js_string t -> unit meth
+  method modify : js_string t -> js_string t -> js_string t -> unit meth
 
-    method collapseToStart : unit meth
+  method collapseToStart : unit meth
 
-    method collapseToEnd : unit meth
+  method collapseToEnd : unit meth
 
-    method selectAllChildren : Dom.node t -> unit meth
+  method selectAllChildren : Dom.node t -> unit meth
 
-    method addRange : range t -> unit meth
+  method addRange : range t -> unit meth
 
-    method removeRange : range t -> unit meth
+  method removeRange : range t -> unit meth
 
-    method removeAllRanges : unit meth
+  method removeAllRanges : unit meth
 
-    method deleteFromDocument : unit meth
+  method deleteFromDocument : unit meth
 
-    method containsNode : Dom.node t -> bool t -> bool t meth
+  method containsNode : Dom.node t -> bool t -> bool t meth
 
-    method toString : js_string t meth
-  end
+  method toString : js_string t meth
+end
 
-class type document =
-  object
-    inherit [element] Dom.document
+class type document = object
+  inherit [element] Dom.document
 
-    inherit nodeSelector
+  inherit nodeSelector
 
-    inherit eventTarget
+  inherit eventTarget
 
-    method title : js_string t prop
+  method title : js_string t prop
 
-    method referrer : js_string t readonly_prop
+  method referrer : js_string t readonly_prop
 
-    method domain : js_string t prop
+  method domain : js_string t prop
 
-    method _URL : js_string t readonly_prop
+  method _URL : js_string t readonly_prop
 
-    method head : headElement t prop
+  method head : headElement t prop
 
-    method body : bodyElement t prop
+  method body : bodyElement t prop
 
-    method documentElement : htmlElement t readonly_prop
+  method documentElement : htmlElement t readonly_prop
 
-    method images : imageElement collection t readonly_prop
+  method images : imageElement collection t readonly_prop
 
-    method applets : element collection t readonly_prop
+  method applets : element collection t readonly_prop
 
-    method links : element collection t readonly_prop
+  method links : element collection t readonly_prop
 
-    method forms : formElement collection t readonly_prop
+  method forms : formElement collection t readonly_prop
 
-    method anchors : element collection t readonly_prop
+  method anchors : element collection t readonly_prop
 
-    method cookie : js_string t prop
+  method cookie : js_string t prop
 
-    method designMode : js_string t prop
+  method designMode : js_string t prop
 
-    method open_ : unit meth
+  method open_ : unit meth
 
-    method close : unit meth
+  method close : unit meth
 
-    method write : js_string t -> unit meth
+  method write : js_string t -> unit meth
 
-    method execCommand : js_string t -> bool t -> js_string t opt -> unit meth
+  method execCommand : js_string t -> bool t -> js_string t opt -> unit meth
 
-    method createRange : range t meth
+  method createRange : range t meth
 
-    method readyState : js_string t readonly_prop
+  method readyState : js_string t readonly_prop
 
-    method getElementsByClassName : js_string t -> element Dom.nodeList t meth
+  method getElementsByClassName : js_string t -> element Dom.nodeList t meth
 
-    method getElementsByName : js_string t -> element Dom.nodeList t meth
+  method getElementsByName : js_string t -> element Dom.nodeList t meth
 
-    method activeElement : element t opt readonly_prop
+  method activeElement : element t opt readonly_prop
 
-    method hidden : bool t readonly_prop
+  method hidden : bool t readonly_prop
 
-    method onfullscreenchange : (document t, event t) event_listener writeonly_prop
+  method onfullscreenchange : (document t, event t) event_listener writeonly_prop
 
-    method onwebkitfullscreenchange : (document t, event t) event_listener writeonly_prop
+  method onwebkitfullscreenchange : (document t, event t) event_listener writeonly_prop
 
-    inherit eventTarget
-  end
+  inherit eventTarget
+end
 
 type interval_id
 
@@ -2187,32 +2109,31 @@ type timeout_id
 
 type animation_frame_request_id
 
-class type location =
-  object
-    method href : js_string t prop
+class type location = object
+  method href : js_string t prop
 
-    method protocol : js_string t prop
+  method protocol : js_string t prop
 
-    method host : js_string t prop
+  method host : js_string t prop
 
-    method hostname : js_string t prop
+  method hostname : js_string t prop
 
-    method origin : js_string t optdef readonly_prop
+  method origin : js_string t optdef readonly_prop
 
-    method port : js_string t prop
+  method port : js_string t prop
 
-    method pathname : js_string t prop
+  method pathname : js_string t prop
 
-    method search : js_string t prop
+  method search : js_string t prop
 
-    method hash : js_string t prop
+  method hash : js_string t prop
 
-    method assign : js_string t -> unit meth
+  method assign : js_string t -> unit meth
 
-    method replace : js_string t -> unit meth
+  method replace : js_string t -> unit meth
 
-    method reload : unit meth
-  end
+  method reload : unit meth
+end
 
 let location_origin (loc : location t) =
   Optdef.case
@@ -2228,209 +2149,203 @@ let location_origin (loc : location t) =
         if port##.length > 0 then origin##concat_2 (Js.string ":") loc##.port else origin)
     (fun o -> o)
 
-class type history =
-  object
-    method length : int readonly_prop
+class type history = object
+  method length : int readonly_prop
 
-    method state : Js.Unsafe.any readonly_prop
+  method state : Js.Unsafe.any readonly_prop
 
-    method go : int opt -> unit meth
+  method go : int opt -> unit meth
 
-    method back : unit meth
+  method back : unit meth
 
-    method forward : unit meth
+  method forward : unit meth
 
-    method pushState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
+  method pushState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
 
-    method replaceState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
-  end
+  method replaceState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
+end
 
 class type undoManager = object end
 
-class type navigator =
-  object
-    method appCodeName : js_string t readonly_prop
+class type navigator = object
+  method appCodeName : js_string t readonly_prop
 
-    method appName : js_string t readonly_prop
+  method appName : js_string t readonly_prop
 
-    method appVersion : js_string t readonly_prop
+  method appVersion : js_string t readonly_prop
 
-    method cookieEnabled : bool t readonly_prop
+  method cookieEnabled : bool t readonly_prop
 
-    method onLine : bool t readonly_prop
+  method onLine : bool t readonly_prop
 
-    method platform : js_string t readonly_prop
+  method platform : js_string t readonly_prop
 
-    method vendor : js_string t readonly_prop
+  method vendor : js_string t readonly_prop
 
-    method userAgent : js_string t readonly_prop
+  method userAgent : js_string t readonly_prop
 
-    method language : js_string t optdef readonly_prop
+  method language : js_string t optdef readonly_prop
 
-    method userLanguage : js_string t optdef readonly_prop
+  method userLanguage : js_string t optdef readonly_prop
 
-    method maxTouchPoints : int readonly_prop
-  end
+  method maxTouchPoints : int readonly_prop
+end
 
-class type screen =
-  object
-    method width : int readonly_prop
+class type screen = object
+  method width : int readonly_prop
 
-    method height : int readonly_prop
+  method height : int readonly_prop
 
-    method availWidth : int readonly_prop
+  method availWidth : int readonly_prop
 
-    method availHeight : int readonly_prop
-  end
+  method availHeight : int readonly_prop
+end
 
-class type applicationCache =
-  object
-    method status : int readonly_prop
+class type applicationCache = object
+  method status : int readonly_prop
 
-    method update : unit meth
+  method update : unit meth
 
-    method abort : unit meth
+  method abort : unit meth
 
-    method swapCache : unit meth
+  method swapCache : unit meth
 
-    method onchecking : (applicationCache t, event t) event_listener prop
+  method onchecking : (applicationCache t, event t) event_listener prop
 
-    method onerror : (applicationCache t, event t) event_listener prop
+  method onerror : (applicationCache t, event t) event_listener prop
 
-    method onnoupdate : (applicationCache t, event t) event_listener prop
+  method onnoupdate : (applicationCache t, event t) event_listener prop
 
-    method ondownloading : (applicationCache t, event t) event_listener prop
+  method ondownloading : (applicationCache t, event t) event_listener prop
 
-    method onprogress : (applicationCache t, event t) event_listener prop
+  method onprogress : (applicationCache t, event t) event_listener prop
 
-    method onupdateready : (applicationCache t, event t) event_listener prop
+  method onupdateready : (applicationCache t, event t) event_listener prop
 
-    method oncached : (applicationCache t, event t) event_listener prop
+  method oncached : (applicationCache t, event t) event_listener prop
 
-    method onobsolete : (applicationCache t, event t) event_listener prop
+  method onobsolete : (applicationCache t, event t) event_listener prop
 
-    inherit eventTarget
-  end
+  inherit eventTarget
+end
 
-class type _URL =
-  object
-    method createObjectURL : #File.blob t -> js_string t meth
+class type _URL = object
+  method createObjectURL : #File.blob t -> js_string t meth
 
-    method revokeObjectURL : js_string t -> unit meth
-  end
+  method revokeObjectURL : js_string t -> unit meth
+end
 
-class type window =
-  object
-    inherit eventTarget
+class type window = object
+  inherit eventTarget
 
-    method document : document t readonly_prop
+  method document : document t readonly_prop
 
-    method applicationCache : applicationCache t readonly_prop
+  method applicationCache : applicationCache t readonly_prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method location : location t readonly_prop
+  method location : location t readonly_prop
 
-    method history : history t readonly_prop
+  method history : history t readonly_prop
 
-    method undoManager : undoManager t readonly_prop
+  method undoManager : undoManager t readonly_prop
 
-    method navigator : navigator t readonly_prop
+  method navigator : navigator t readonly_prop
 
-    method getSelection : selection t meth
+  method getSelection : selection t meth
 
-    method close : unit meth
+  method close : unit meth
 
-    method closed : bool t readonly_prop
+  method closed : bool t readonly_prop
 
-    method stop : unit meth
+  method stop : unit meth
 
-    method focus : unit meth
+  method focus : unit meth
 
-    method blur : unit meth
+  method blur : unit meth
 
-    method scroll : int -> int -> unit meth
+  method scroll : int -> int -> unit meth
 
-    method scrollBy : int -> int -> unit meth
+  method scrollBy : int -> int -> unit meth
 
-    method sessionStorage : storage t optdef readonly_prop
+  method sessionStorage : storage t optdef readonly_prop
 
-    method localStorage : storage t optdef readonly_prop
+  method localStorage : storage t optdef readonly_prop
 
-    method top : window t readonly_prop
+  method top : window t readonly_prop
 
-    method parent : window t readonly_prop
+  method parent : window t readonly_prop
 
-    method frameElement : element t opt readonly_prop
+  method frameElement : element t opt readonly_prop
 
-    method open_ : js_string t -> js_string t -> js_string t opt -> window t opt meth
+  method open_ : js_string t -> js_string t -> js_string t opt -> window t opt meth
 
-    method alert : js_string t -> unit meth
+  method alert : js_string t -> unit meth
 
-    method confirm : js_string t -> bool t meth
+  method confirm : js_string t -> bool t meth
 
-    method prompt : js_string t -> js_string t -> js_string t opt meth
+  method prompt : js_string t -> js_string t -> js_string t opt meth
 
-    method print : unit meth
+  method print : unit meth
 
-    method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
+  method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
 
-    method clearInterval : interval_id -> unit meth
+  method clearInterval : interval_id -> unit meth
 
-    method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
+  method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
 
-    method clearTimeout : timeout_id -> unit meth
+  method clearTimeout : timeout_id -> unit meth
 
-    method requestAnimationFrame :
-      (number t -> unit) Js.callback -> animation_frame_request_id meth
+  method requestAnimationFrame :
+    (number t -> unit) Js.callback -> animation_frame_request_id meth
 
-    method cancelAnimationFrame : animation_frame_request_id -> unit meth
+  method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
-    method screen : screen t readonly_prop
+  method screen : screen t readonly_prop
 
-    method innerWidth : int readonly_prop
+  method innerWidth : int readonly_prop
 
-    method innerHeight : int readonly_prop
+  method innerHeight : int readonly_prop
 
-    method outerWidth : int readonly_prop
+  method outerWidth : int readonly_prop
 
-    method outerHeight : int readonly_prop
+  method outerHeight : int readonly_prop
 
-    method getComputedStyle : #element t -> cssStyleDeclaration t meth
+  method getComputedStyle : #element t -> cssStyleDeclaration t meth
 
-    method getComputedStyle_pseudoElt :
-      #element t -> js_string t -> cssStyleDeclaration t meth
+  method getComputedStyle_pseudoElt :
+    #element t -> js_string t -> cssStyleDeclaration t meth
 
-    method atob : js_string t -> js_string t meth
+  method atob : js_string t -> js_string t meth
 
-    method btoa : js_string t -> js_string t meth
+  method btoa : js_string t -> js_string t meth
 
-    method onload : (window t, event t) event_listener prop
+  method onload : (window t, event t) event_listener prop
 
-    method onunload : (window t, event t) event_listener prop
+  method onunload : (window t, event t) event_listener prop
 
-    method onbeforeunload : (window t, event t) event_listener prop
+  method onbeforeunload : (window t, event t) event_listener prop
 
-    method onblur : (window t, focusEvent t) event_listener prop
+  method onblur : (window t, focusEvent t) event_listener prop
 
-    method onfocus : (window t, focusEvent t) event_listener prop
+  method onfocus : (window t, focusEvent t) event_listener prop
 
-    method onresize : (window t, event t) event_listener prop
+  method onresize : (window t, event t) event_listener prop
 
-    method onorientationchange : (window t, event t) event_listener prop
+  method onorientationchange : (window t, event t) event_listener prop
 
-    method onpopstate : (window t, popStateEvent t) event_listener prop
+  method onpopstate : (window t, popStateEvent t) event_listener prop
 
-    method onhashchange : (window t, hashChangeEvent t) event_listener prop
+  method onhashchange : (window t, hashChangeEvent t) event_listener prop
 
-    method ononline : (window t, event t) event_listener writeonly_prop
+  method ononline : (window t, event t) event_listener writeonly_prop
 
-    method onoffline : (window t, event t) event_listener writeonly_prop
+  method onoffline : (window t, event t) event_listener writeonly_prop
 
-    method _URL : _URL t readonly_prop
+  method _URL : _URL t readonly_prop
 
-    method devicePixelRatio : number t readonly_prop
-  end
+  method devicePixelRatio : number t readonly_prop
+end
 
 let window : window t = Js.Unsafe.global
 
@@ -2460,64 +2375,61 @@ let getElementById_coerce id coerce =
 
 (****)
 
-class type frameSetElement =
-  object
-    inherit element
+class type frameSetElement = object
+  inherit element
 
-    method cols : js_string t prop
+  method cols : js_string t prop
 
-    method rows : js_string t prop
-  end
+  method rows : js_string t prop
+end
 
-class type frameElement =
-  object
-    inherit element
+class type frameElement = object
+  inherit element
 
-    method frameBorder : js_string t prop
+  method frameBorder : js_string t prop
 
-    method longDesc : js_string t prop
+  method longDesc : js_string t prop
 
-    method marginHeight : js_string t prop
+  method marginHeight : js_string t prop
 
-    method marginWidth : js_string t prop
+  method marginWidth : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method noResize : bool t prop
+  method noResize : bool t prop
 
-    method scrolling : js_string t prop
+  method scrolling : js_string t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method contentDocument : document t opt readonly_prop
-  end
+  method contentDocument : document t opt readonly_prop
+end
 
-class type iFrameElement =
-  object
-    inherit element
+class type iFrameElement = object
+  inherit element
 
-    method frameBorder : js_string t prop
+  method frameBorder : js_string t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method longDesc : js_string t prop
+  method longDesc : js_string t prop
 
-    method marginHeight : js_string t prop
+  method marginHeight : js_string t prop
 
-    method marginWidth : js_string t prop
+  method marginWidth : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method scrolling : js_string t prop
+  method scrolling : js_string t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method contentDocument : document t opt readonly_prop
+  method contentDocument : document t opt readonly_prop
 
-    method contentWindow : window t readonly_prop
-  end
+  method contentWindow : window t readonly_prop
+end
 
 (****)
 
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 23de2ca77c..96ae54c8f4 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -27,240 +27,239 @@ open Js
 
 (** {2 CSS style declaration} *)
 
-class type cssStyleDeclaration =
-  object
-    method setProperty :
-      js_string t -> js_string t -> js_string t optdef -> js_string t meth
+class type cssStyleDeclaration = object
+  method setProperty :
+    js_string t -> js_string t -> js_string t optdef -> js_string t meth
 
-    method getPropertyValue : js_string t -> js_string t meth
+  method getPropertyValue : js_string t -> js_string t meth
 
-    method getPropertyPriority : js_string t -> js_string t meth
+  method getPropertyPriority : js_string t -> js_string t meth
 
-    method removeProperty : js_string t -> js_string t meth
+  method removeProperty : js_string t -> js_string t meth
 
-    method animation : js_string t prop
+  method animation : js_string t prop
 
-    method animationDelay : js_string t prop
+  method animationDelay : js_string t prop
 
-    method animationDirection : js_string t prop
+  method animationDirection : js_string t prop
 
-    method animationDuration : js_string t prop
+  method animationDuration : js_string t prop
 
-    method animationFillMode : js_string t prop
+  method animationFillMode : js_string t prop
 
-    method animationIterationCount : js_string t prop
+  method animationIterationCount : js_string t prop
 
-    method animationName : js_string t prop
+  method animationName : js_string t prop
 
-    method animationPlayState : js_string t prop
+  method animationPlayState : js_string t prop
 
-    method animationTimingFunction : js_string t prop
+  method animationTimingFunction : js_string t prop
 
-    method background : js_string t prop
+  method background : js_string t prop
 
-    method backgroundAttachment : js_string t prop
+  method backgroundAttachment : js_string t prop
 
-    method backgroundColor : js_string t prop
+  method backgroundColor : js_string t prop
 
-    method backgroundImage : js_string t prop
+  method backgroundImage : js_string t prop
 
-    method backgroundPosition : js_string t prop
+  method backgroundPosition : js_string t prop
 
-    method backgroundRepeat : js_string t prop
+  method backgroundRepeat : js_string t prop
 
-    method border : js_string t prop
+  method border : js_string t prop
 
-    method borderBottom : js_string t prop
+  method borderBottom : js_string t prop
 
-    method borderBottomColor : js_string t prop
+  method borderBottomColor : js_string t prop
 
-    method borderBottomStyle : js_string t prop
+  method borderBottomStyle : js_string t prop
 
-    method borderBottomWidth : js_string t prop
+  method borderBottomWidth : js_string t prop
 
-    method borderCollapse : js_string t prop
+  method borderCollapse : js_string t prop
 
-    method borderColor : js_string t prop
+  method borderColor : js_string t prop
 
-    method borderLeft : js_string t prop
+  method borderLeft : js_string t prop
 
-    method borderLeftColor : js_string t prop
+  method borderLeftColor : js_string t prop
 
-    method borderLeftStyle : js_string t prop
+  method borderLeftStyle : js_string t prop
 
-    method borderLeftWidth : js_string t prop
+  method borderLeftWidth : js_string t prop
 
-    method borderRadius : js_string t prop
+  method borderRadius : js_string t prop
 
-    method borderRight : js_string t prop
+  method borderRight : js_string t prop
 
-    method borderRightColor : js_string t prop
+  method borderRightColor : js_string t prop
 
-    method borderRightStyle : js_string t prop
+  method borderRightStyle : js_string t prop
 
-    method borderRightWidth : js_string t prop
+  method borderRightWidth : js_string t prop
 
-    method borderSpacing : js_string t prop
+  method borderSpacing : js_string t prop
 
-    method borderStyle : js_string t prop
+  method borderStyle : js_string t prop
 
-    method borderTop : js_string t prop
+  method borderTop : js_string t prop
 
-    method borderTopColor : js_string t prop
+  method borderTopColor : js_string t prop
 
-    method borderTopStyle : js_string t prop
+  method borderTopStyle : js_string t prop
 
-    method borderTopWidth : js_string t prop
+  method borderTopWidth : js_string t prop
 
-    method borderWidth : js_string t prop
+  method borderWidth : js_string t prop
 
-    method bottom : js_string t prop
+  method bottom : js_string t prop
 
-    method captionSide : js_string t prop
+  method captionSide : js_string t prop
 
-    method clear : js_string t prop
+  method clear : js_string t prop
 
-    method clip : js_string t prop
+  method clip : js_string t prop
 
-    method color : js_string t prop
+  method color : js_string t prop
 
-    method content : js_string t prop
+  method content : js_string t prop
 
-    method counterIncrement : js_string t prop
+  method counterIncrement : js_string t prop
 
-    method counterReset : js_string t prop
+  method counterReset : js_string t prop
 
-    method cssFloat : js_string t prop
+  method cssFloat : js_string t prop
 
-    method cssText : js_string t prop
+  method cssText : js_string t prop
 
-    method cursor : js_string t prop
+  method cursor : js_string t prop
 
-    method direction : js_string t prop
+  method direction : js_string t prop
 
-    method display : js_string t prop
+  method display : js_string t prop
 
-    method emptyCells : js_string t prop
+  method emptyCells : js_string t prop
 
-    method fill : js_string t prop
+  method fill : js_string t prop
 
-    method font : js_string t prop
+  method font : js_string t prop
 
-    method fontFamily : js_string t prop
+  method fontFamily : js_string t prop
 
-    method fontSize : js_string t prop
+  method fontSize : js_string t prop
 
-    method fontStyle : js_string t prop
+  method fontStyle : js_string t prop
 
-    method fontVariant : js_string t prop
+  method fontVariant : js_string t prop
 
-    method fontWeight : js_string t prop
+  method fontWeight : js_string t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method left : js_string t prop
+  method left : js_string t prop
 
-    method letterSpacing : js_string t prop
+  method letterSpacing : js_string t prop
 
-    method lineHeight : js_string t prop
+  method lineHeight : js_string t prop
 
-    method listStyle : js_string t prop
+  method listStyle : js_string t prop
 
-    method listStyleImage : js_string t prop
+  method listStyleImage : js_string t prop
 
-    method listStylePosition : js_string t prop
+  method listStylePosition : js_string t prop
 
-    method listStyleType : js_string t prop
+  method listStyleType : js_string t prop
 
-    method margin : js_string t prop
+  method margin : js_string t prop
 
-    method marginBottom : js_string t prop
+  method marginBottom : js_string t prop
 
-    method marginLeft : js_string t prop
+  method marginLeft : js_string t prop
 
-    method marginRight : js_string t prop
+  method marginRight : js_string t prop
 
-    method marginTop : js_string t prop
+  method marginTop : js_string t prop
 
-    method maxHeight : js_string t prop
+  method maxHeight : js_string t prop
 
-    method maxWidth : js_string t prop
+  method maxWidth : js_string t prop
 
-    method minHeight : js_string t prop
+  method minHeight : js_string t prop
 
-    method minWidth : js_string t prop
+  method minWidth : js_string t prop
 
-    method opacity : js_string t optdef prop
+  method opacity : js_string t optdef prop
 
-    method outline : js_string t prop
+  method outline : js_string t prop
 
-    method outlineColor : js_string t prop
+  method outlineColor : js_string t prop
 
-    method outlineOffset : js_string t prop
+  method outlineOffset : js_string t prop
 
-    method outlineStyle : js_string t prop
+  method outlineStyle : js_string t prop
 
-    method outlineWidth : js_string t prop
+  method outlineWidth : js_string t prop
 
-    method overflow : js_string t prop
+  method overflow : js_string t prop
 
-    method overflowX : js_string t prop
+  method overflowX : js_string t prop
 
-    method overflowY : js_string t prop
+  method overflowY : js_string t prop
 
-    method padding : js_string t prop
+  method padding : js_string t prop
 
-    method paddingBottom : js_string t prop
+  method paddingBottom : js_string t prop
 
-    method paddingLeft : js_string t prop
+  method paddingLeft : js_string t prop
 
-    method paddingRight : js_string t prop
+  method paddingRight : js_string t prop
 
-    method paddingTop : js_string t prop
+  method paddingTop : js_string t prop
 
-    method pageBreakAfter : js_string t prop
+  method pageBreakAfter : js_string t prop
 
-    method pageBreakBefore : js_string t prop
+  method pageBreakBefore : js_string t prop
 
-    method pointerEvents : js_string t prop
+  method pointerEvents : js_string t prop
 
-    (* SVG-only on many browsers *)
-    method position : js_string t prop
+  (* SVG-only on many browsers *)
+  method position : js_string t prop
 
-    method right : js_string t prop
+  method right : js_string t prop
 
-    method stroke : js_string t prop
+  method stroke : js_string t prop
 
-    method strokeWidth : js_string t prop
+  method strokeWidth : js_string t prop
 
-    method tableLayout : js_string t prop
+  method tableLayout : js_string t prop
 
-    method textAlign : js_string t prop
+  method textAlign : js_string t prop
 
-    method textAnchor : js_string t prop
+  method textAnchor : js_string t prop
 
-    method textDecoration : js_string t prop
+  method textDecoration : js_string t prop
 
-    method textIndent : js_string t prop
+  method textIndent : js_string t prop
 
-    method textTransform : js_string t prop
+  method textTransform : js_string t prop
 
-    method top : js_string t prop
+  method top : js_string t prop
 
-    method transform : js_string t prop
+  method transform : js_string t prop
 
-    method verticalAlign : js_string t prop
+  method verticalAlign : js_string t prop
 
-    method visibility : js_string t prop
+  method visibility : js_string t prop
 
-    method whiteSpace : js_string t prop
+  method whiteSpace : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method wordSpacing : js_string t prop
+  method wordSpacing : js_string t prop
 
-    method zIndex : js_string t prop
-  end
+  method zIndex : js_string t prop
+end
 
 (** {2 Events} *)
 
@@ -280,879 +279,832 @@ type delta_mode =
   | Delta_line
   | Delta_page
 
-class type event =
-  object
-    inherit [element] Dom.event
-  end
+class type event = object
+  inherit [element] Dom.event
+end
 
-and ['a] customEvent =
-  object
-    inherit [element, 'a] Dom.customEvent
-  end
+and ['a] customEvent = object
+  inherit [element, 'a] Dom.customEvent
+end
 
-and focusEvent =
-  object
-    inherit event
+and focusEvent = object
+  inherit event
 
-    method relatedTarget : element t opt optdef readonly_prop
-  end
+  method relatedTarget : element t opt optdef readonly_prop
+end
 
-and mouseEvent =
-  object
-    inherit event
+and mouseEvent = object
+  inherit event
 
-    method relatedTarget : element t opt optdef readonly_prop
+  method relatedTarget : element t opt optdef readonly_prop
 
-    (* Relative to viewport *)
-    method clientX : int readonly_prop
+  (* Relative to viewport *)
+  method clientX : int readonly_prop
 
-    method clientY : int readonly_prop
+  method clientY : int readonly_prop
 
-    (* Relative to the edge of the screen *)
-    method screenX : int readonly_prop
+  (* Relative to the edge of the screen *)
+  method screenX : int readonly_prop
 
-    method screenY : int readonly_prop
+  method screenY : int readonly_prop
 
-    method offsetX : int readonly_prop
+  method offsetX : int readonly_prop
 
-    method offsetY : int readonly_prop
+  method offsetY : int readonly_prop
 
-    method ctrlKey : bool t readonly_prop
+  method ctrlKey : bool t readonly_prop
 
-    method shiftKey : bool t readonly_prop
+  method shiftKey : bool t readonly_prop
 
-    method altKey : bool t readonly_prop
+  method altKey : bool t readonly_prop
 
-    method metaKey : bool t readonly_prop
+  method metaKey : bool t readonly_prop
 
-    method which : mouse_button optdef readonly_prop
+  method which : mouse_button optdef readonly_prop
 
-    (* Legacy methods *)
-    method button : int readonly_prop
+  (* Legacy methods *)
+  method button : int readonly_prop
 
-    method fromElement : element t opt optdef readonly_prop
+  method fromElement : element t opt optdef readonly_prop
 
-    method toElement : element t opt optdef readonly_prop
+  method toElement : element t opt optdef readonly_prop
 
-    method pageX : int optdef readonly_prop
+  method pageX : int optdef readonly_prop
 
-    method pageY : int optdef readonly_prop
-  end
+  method pageY : int optdef readonly_prop
+end
 
-and keyboardEvent =
-  object
-    inherit event
+and keyboardEvent = object
+  inherit event
 
-    method altKey : bool t readonly_prop
+  method altKey : bool t readonly_prop
 
-    method shiftKey : bool t readonly_prop
+  method shiftKey : bool t readonly_prop
 
-    method ctrlKey : bool t readonly_prop
+  method ctrlKey : bool t readonly_prop
 
-    method metaKey : bool t readonly_prop
+  method metaKey : bool t readonly_prop
 
-    method location : int readonly_prop
+  method location : int readonly_prop
 
-    (* Standardized but not fully supported properties *)
-    method key : js_string t optdef readonly_prop
+  (* Standardized but not fully supported properties *)
+  method key : js_string t optdef readonly_prop
 
-    method code : js_string t optdef readonly_prop
+  method code : js_string t optdef readonly_prop
 
-    (* Deprecated properties *)
-    method which : int optdef readonly_prop
+  (* Deprecated properties *)
+  method which : int optdef readonly_prop
 
-    method charCode : int optdef readonly_prop
+  method charCode : int optdef readonly_prop
 
-    method keyCode : int readonly_prop
+  method keyCode : int readonly_prop
 
-    method getModifierState : js_string t -> bool t meth
+  method getModifierState : js_string t -> bool t meth
 
-    method keyIdentifier : js_string t optdef readonly_prop
-  end
+  method keyIdentifier : js_string t optdef readonly_prop
+end
 
-and mousewheelEvent =
-  object
-    (* All modern browsers *)
-    inherit mouseEvent
+and mousewheelEvent = object
+  (* All modern browsers *)
+  inherit mouseEvent
 
-    method wheelDelta : int readonly_prop
+  method wheelDelta : int readonly_prop
 
-    method wheelDeltaX : int optdef readonly_prop
+  method wheelDeltaX : int optdef readonly_prop
 
-    method wheelDeltaY : int optdef readonly_prop
+  method wheelDeltaY : int optdef readonly_prop
 
-    method deltaX : number t readonly_prop
+  method deltaX : number t readonly_prop
 
-    method deltaY : number t readonly_prop
+  method deltaY : number t readonly_prop
 
-    method deltaZ : number t readonly_prop
+  method deltaZ : number t readonly_prop
 
-    method deltaMode : delta_mode readonly_prop
-  end
+  method deltaMode : delta_mode readonly_prop
+end
 
-and mouseScrollEvent =
-  object
-    (* Firefox *)
-    inherit mouseEvent
+and mouseScrollEvent = object
+  (* Firefox *)
+  inherit mouseEvent
 
-    method detail : int readonly_prop
+  method detail : int readonly_prop
 
-    method axis : int optdef readonly_prop
+  method axis : int optdef readonly_prop
 
-    method _HORIZONTAL_AXIS : int optdef readonly_prop
+  method _HORIZONTAL_AXIS : int optdef readonly_prop
 
-    method _VERTICAL_AXIS : int optdef readonly_prop
-  end
+  method _VERTICAL_AXIS : int optdef readonly_prop
+end
 
-and touchEvent =
-  object
-    inherit event
+and touchEvent = object
+  inherit event
 
-    method touches : touchList t readonly_prop
+  method touches : touchList t readonly_prop
 
-    method targetTouches : touchList t readonly_prop
+  method targetTouches : touchList t readonly_prop
 
-    method changedTouches : touchList t readonly_prop
+  method changedTouches : touchList t readonly_prop
 
-    method ctrlKey : bool t readonly_prop
+  method ctrlKey : bool t readonly_prop
 
-    method shiftKey : bool t readonly_prop
+  method shiftKey : bool t readonly_prop
 
-    method altKey : bool t readonly_prop
+  method altKey : bool t readonly_prop
 
-    method metaKey : bool t readonly_prop
+  method metaKey : bool t readonly_prop
 
-    method relatedTarget : element t opt optdef readonly_prop
-  end
+  method relatedTarget : element t opt optdef readonly_prop
+end
 
-and touchList =
-  object
-    method length : int readonly_prop
+and touchList = object
+  method length : int readonly_prop
 
-    method item : int -> touch t optdef meth
-  end
+  method item : int -> touch t optdef meth
+end
 
-and touch =
-  object
-    method identifier : int readonly_prop
+and touch = object
+  method identifier : int readonly_prop
 
-    method target : element t optdef readonly_prop
+  method target : element t optdef readonly_prop
 
-    method screenX : int readonly_prop
+  method screenX : int readonly_prop
 
-    method screenY : int readonly_prop
+  method screenY : int readonly_prop
 
-    method clientX : int readonly_prop
+  method clientX : int readonly_prop
 
-    method clientY : int readonly_prop
+  method clientY : int readonly_prop
 
-    method pageX : int readonly_prop
+  method pageX : int readonly_prop
 
-    method pageY : int readonly_prop
-  end
+  method pageY : int readonly_prop
+end
 
-and submitEvent =
-  object
-    inherit event
+and submitEvent = object
+  inherit event
 
-    method submitter : element t optdef readonly_prop
-  end
+  method submitter : element t optdef readonly_prop
+end
 
-and dragEvent =
-  object
-    inherit mouseEvent
+and dragEvent = object
+  inherit mouseEvent
 
-    method dataTransfer : dataTransfer t readonly_prop
-  end
+  method dataTransfer : dataTransfer t readonly_prop
+end
 
-and clipboardEvent =
-  object
-    inherit event
+and clipboardEvent = object
+  inherit event
 
-    method clipboardData : dataTransfer t readonly_prop
-  end
+  method clipboardData : dataTransfer t readonly_prop
+end
 
-and dataTransfer =
-  object
-    method dropEffect : js_string t prop
+and dataTransfer = object
+  method dropEffect : js_string t prop
 
-    method effectAllowed : js_string t prop
+  method effectAllowed : js_string t prop
 
-    method files : File.fileList t readonly_prop
+  method files : File.fileList t readonly_prop
 
-    method types : js_string t js_array t readonly_prop
+  method types : js_string t js_array t readonly_prop
 
-    method addElement : element t -> unit meth
+  method addElement : element t -> unit meth
 
-    method clearData : js_string t -> unit meth
+  method clearData : js_string t -> unit meth
 
-    method clearData_all : unit meth
+  method clearData_all : unit meth
 
-    method getData : js_string t -> js_string t meth
+  method getData : js_string t -> js_string t meth
 
-    method setData : js_string t -> js_string t -> unit meth
+  method setData : js_string t -> js_string t -> unit meth
 
-    method setDragImage : element t -> int -> int -> unit meth
-  end
+  method setDragImage : element t -> int -> int -> unit meth
+end
 
 (** Common properties of event target objects: [onclick],
     [onkeypress], ... *)
-and eventTarget =
-  object ('self)
-    method onclick : ('self t, mouseEvent t) event_listener writeonly_prop
+and eventTarget = object ('self)
+  method onclick : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method ondblclick : ('self t, mouseEvent t) event_listener writeonly_prop
+  method ondblclick : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmousedown : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmousedown : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmouseup : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmouseup : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmouseover : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmouseover : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmousemove : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmousemove : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onmouseout : ('self t, mouseEvent t) event_listener writeonly_prop
+  method onmouseout : ('self t, mouseEvent t) event_listener writeonly_prop
 
-    method onkeypress : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onkeypress : ('self t, keyboardEvent t) event_listener writeonly_prop
 
-    method onkeydown : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onkeydown : ('self t, keyboardEvent t) event_listener writeonly_prop
 
-    method onkeyup : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onkeyup : ('self t, keyboardEvent t) event_listener writeonly_prop
 
-    method onscroll : ('self t, event t) event_listener writeonly_prop
+  method onscroll : ('self t, event t) event_listener writeonly_prop
 
-    method onwheel : ('self t, mousewheelEvent t) event_listener writeonly_prop
+  method onwheel : ('self t, mousewheelEvent t) event_listener writeonly_prop
 
-    method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragenter : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragenter : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragover : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragover : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondragleave : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondragleave : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondrag : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondrag : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method ondrop : ('self t, dragEvent t) event_listener writeonly_prop
+  method ondrop : ('self t, dragEvent t) event_listener writeonly_prop
 
-    method onanimationstart : ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationstart : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method onanimationend : ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationend : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method onanimationiteration :
-      ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationiteration : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method onanimationcancel : ('self t, animationEvent t) event_listener writeonly_prop
+  method onanimationcancel : ('self t, animationEvent t) event_listener writeonly_prop
 
-    method ontransitionrun : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitionrun : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ontransitionstart : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitionstart : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ontransitionend : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitionend : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ontransitioncancel : ('self t, transitionEvent t) event_listener writeonly_prop
+  method ontransitioncancel : ('self t, transitionEvent t) event_listener writeonly_prop
 
-    method ongotpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
+  method ongotpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onlostpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onlostpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerenter : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerenter : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointercancel : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointercancel : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerdown : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerdown : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerleave : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerleave : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointermove : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointermove : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerout : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerout : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerover : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerover : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method onpointerup : ('self t, pointerEvent t) event_listener writeonly_prop
+  method onpointerup : ('self t, pointerEvent t) event_listener writeonly_prop
 
-    method dispatchEvent : event t -> bool t meth
-  end
+  method dispatchEvent : event t -> bool t meth
+end
 
-and popStateEvent =
-  object
-    inherit event
+and popStateEvent = object
+  inherit event
 
-    method state : Js.Unsafe.any readonly_prop
-  end
+  method state : Js.Unsafe.any readonly_prop
+end
 
-and pointerEvent =
-  object
-    inherit mouseEvent
+and pointerEvent = object
+  inherit mouseEvent
 
-    method pointerId : int Js.readonly_prop
+  method pointerId : int Js.readonly_prop
 
-    method width : number t Js.readonly_prop
+  method width : number t Js.readonly_prop
 
-    method height : number t Js.readonly_prop
+  method height : number t Js.readonly_prop
 
-    method pressure : number t Js.readonly_prop
+  method pressure : number t Js.readonly_prop
 
-    method tangentialPressure : number t Js.readonly_prop
+  method tangentialPressure : number t Js.readonly_prop
 
-    method tiltX : int Js.readonly_prop
+  method tiltX : int Js.readonly_prop
 
-    method tiltY : int Js.readonly_prop
+  method tiltY : int Js.readonly_prop
 
-    method twist : int Js.readonly_prop
+  method twist : int Js.readonly_prop
 
-    method pointerType : Js.js_string Js.t Js.readonly_prop
+  method pointerType : Js.js_string Js.t Js.readonly_prop
 
-    method isPrimary : bool Js.t Js.readonly_prop
-  end
+  method isPrimary : bool Js.t Js.readonly_prop
+end
 
-and storageEvent =
-  object
-    inherit event
+and storageEvent = object
+  inherit event
 
-    method key : js_string t opt readonly_prop
+  method key : js_string t opt readonly_prop
 
-    method oldValue : js_string t opt readonly_prop
+  method oldValue : js_string t opt readonly_prop
 
-    method newValue : js_string t opt readonly_prop
+  method newValue : js_string t opt readonly_prop
 
-    method url : js_string t readonly_prop
+  method url : js_string t readonly_prop
 
-    method storageArea : storage t opt readonly_prop
-  end
+  method storageArea : storage t opt readonly_prop
+end
 
 (** Storage *)
-and storage =
-  object
-    method length : int readonly_prop
+and storage = object
+  method length : int readonly_prop
 
-    method key : int -> js_string t opt meth
+  method key : int -> js_string t opt meth
 
-    method getItem : js_string t -> js_string t opt meth
+  method getItem : js_string t -> js_string t opt meth
 
-    method setItem : js_string t -> js_string t -> unit meth
+  method setItem : js_string t -> js_string t -> unit meth
 
-    method removeItem : js_string t -> unit meth
+  method removeItem : js_string t -> unit meth
 
-    method clear : unit meth
-  end
+  method clear : unit meth
+end
 
-and hashChangeEvent =
-  object
-    inherit event
+and hashChangeEvent = object
+  inherit event
 
-    method oldURL : js_string t readonly_prop
+  method oldURL : js_string t readonly_prop
 
-    method newURL : js_string t readonly_prop
-  end
+  method newURL : js_string t readonly_prop
+end
 
-and animationEvent =
-  object
-    inherit event
+and animationEvent = object
+  inherit event
 
-    method animationName : js_string t readonly_prop
+  method animationName : js_string t readonly_prop
 
-    method elapsedTime : number t readonly_prop
+  method elapsedTime : number t readonly_prop
 
-    method pseudoElement : js_string t readonly_prop
-  end
+  method pseudoElement : js_string t readonly_prop
+end
 
-and transitionEvent =
-  object
-    inherit event
+and transitionEvent = object
+  inherit event
 
-    method propertyName : js_string t readonly_prop
+  method propertyName : js_string t readonly_prop
 
-    method elapsedTime : number t readonly_prop
+  method elapsedTime : number t readonly_prop
 
-    method pseudoElement : js_string t readonly_prop
-  end
+  method pseudoElement : js_string t readonly_prop
+end
 
-and mediaEvent =
-  object
-    inherit event
-  end
+and mediaEvent = object
+  inherit event
+end
 
-and messageEvent =
-  object
-    inherit event
+and messageEvent = object
+  inherit event
 
-    method data : Unsafe.any opt readonly_prop
+  method data : Unsafe.any opt readonly_prop
 
-    method source : Unsafe.any opt readonly_prop
-  end
+  method source : Unsafe.any opt readonly_prop
+end
 
 (** {2 HTML elements} *)
 
-and nodeSelector =
-  object
-    method querySelector : js_string t -> element t opt meth
+and nodeSelector = object
+  method querySelector : js_string t -> element t opt meth
 
-    method querySelectorAll : js_string t -> element Dom.nodeList t meth
-  end
+  method querySelectorAll : js_string t -> element Dom.nodeList t meth
+end
 
-and tokenList =
-  object
-    method length : int readonly_prop
+and tokenList = object
+  method length : int readonly_prop
 
-    method item : int -> js_string t optdef meth
+  method item : int -> js_string t optdef meth
 
-    method contains : js_string t -> bool t meth
+  method contains : js_string t -> bool t meth
 
-    method add : js_string t -> unit meth
+  method add : js_string t -> unit meth
 
-    method remove : js_string t -> unit meth
+  method remove : js_string t -> unit meth
 
-    method toggle : js_string t -> bool t meth
+  method toggle : js_string t -> bool t meth
 
-    method stringifier : js_string t prop
-  end
+  method stringifier : js_string t prop
+end
 
 (** Properties common to all HTML elements *)
-and element =
-  object
-    inherit Dom.element
+and element = object
+  inherit Dom.element
 
-    inherit nodeSelector
+  inherit nodeSelector
 
-    method id : js_string t prop
+  method id : js_string t prop
 
-    method title : js_string t prop
+  method title : js_string t prop
 
-    method lang : js_string t prop
+  method lang : js_string t prop
 
-    method dir : js_string t prop
+  method dir : js_string t prop
 
-    method className : js_string t prop
+  method className : js_string t prop
 
-    method classList : tokenList t readonly_prop
+  method classList : tokenList t readonly_prop
 
-    method closest : js_string t -> element t opt meth
+  method closest : js_string t -> element t opt meth
 
-    method style : cssStyleDeclaration t prop
+  method style : cssStyleDeclaration t prop
 
-    method innerHTML : js_string t prop
+  method innerHTML : js_string t prop
 
-    method outerHTML : js_string t prop
+  method outerHTML : js_string t prop
 
-    method textContent : js_string t opt prop
+  method textContent : js_string t opt prop
 
-    method innerText : js_string t prop
+  method innerText : js_string t prop
 
-    method clientLeft : int readonly_prop
+  method clientLeft : int readonly_prop
 
-    method clientTop : int readonly_prop
+  method clientTop : int readonly_prop
 
-    method clientWidth : int readonly_prop
+  method clientWidth : int readonly_prop
 
-    method clientHeight : int readonly_prop
+  method clientHeight : int readonly_prop
 
-    method offsetLeft : int readonly_prop
+  method offsetLeft : int readonly_prop
 
-    method offsetTop : int readonly_prop
+  method offsetTop : int readonly_prop
 
-    (* Incorrect in IE until IE7 included *)
-    method offsetParent : element t opt readonly_prop
+  (* Incorrect in IE until IE7 included *)
+  method offsetParent : element t opt readonly_prop
 
-    method offsetWidth : int readonly_prop
+  method offsetWidth : int readonly_prop
 
-    method offsetHeight : int readonly_prop
+  method offsetHeight : int readonly_prop
 
-    method scrollLeft : int prop
+  method scrollLeft : int prop
 
-    method scrollTop : int prop
+  method scrollTop : int prop
 
-    method scrollWidth : int prop
+  method scrollWidth : int prop
 
-    method scrollHeight : int prop
+  method scrollHeight : int prop
 
-    method getClientRects : clientRectList t meth
+  method getClientRects : clientRectList t meth
 
-    method getBoundingClientRect : clientRect t meth
+  method getBoundingClientRect : clientRect t meth
 
-    method scrollIntoView : bool t -> unit meth
+  method scrollIntoView : bool t -> unit meth
 
-    method click : unit meth
+  method click : unit meth
 
-    method focus : unit meth
+  method focus : unit meth
 
-    method blur : unit meth
+  method blur : unit meth
 
-    inherit eventTarget
-  end
+  inherit eventTarget
+end
 
 (** Rectangular box (used for element bounding boxes) *)
-and clientRect =
-  object
-    method top : number t readonly_prop
+and clientRect = object
+  method top : number t readonly_prop
 
-    method right : number t readonly_prop
+  method right : number t readonly_prop
 
-    method bottom : number t readonly_prop
+  method bottom : number t readonly_prop
 
-    method left : number t readonly_prop
+  method left : number t readonly_prop
 
-    method width : number t optdef readonly_prop
+  method width : number t optdef readonly_prop
 
-    method height : number t optdef readonly_prop
-  end
+  method height : number t optdef readonly_prop
+end
 
-and clientRectList =
-  object
-    method length : int readonly_prop
+and clientRectList = object
+  method length : int readonly_prop
 
-    method item : int -> clientRect t opt meth
-  end
+  method item : int -> clientRect t opt meth
+end
 
 (** Collection of HTML elements *)
-class type ['node] collection =
-  object
-    method length : int readonly_prop
+class type ['node] collection = object
+  method length : int readonly_prop
 
-    method item : int -> 'node t opt meth
+  method item : int -> 'node t opt meth
 
-    method namedItem : js_string t -> 'node t opt meth
-  end
+  method namedItem : js_string t -> 'node t opt meth
+end
 
 class type htmlElement = element
 
-class type headElement =
-  object
-    inherit element
+class type headElement = object
+  inherit element
 
-    method profile : js_string t prop
-  end
+  method profile : js_string t prop
+end
 
-class type linkElement =
-  object
-    inherit element
+class type linkElement = object
+  inherit element
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method charset : js_string t prop
+  method charset : js_string t prop
 
-    method crossorigin : js_string t prop
+  method crossorigin : js_string t prop
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method hreflang : js_string t prop
+  method hreflang : js_string t prop
 
-    method media : js_string t prop
+  method media : js_string t prop
 
-    method rel : js_string t prop
+  method rel : js_string t prop
 
-    method rev : js_string t prop
+  method rev : js_string t prop
 
-    method target : js_string t prop
+  method target : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
-class type titleElement =
-  object
-    inherit element
+class type titleElement = object
+  inherit element
 
-    method text : js_string t prop
-  end
+  method text : js_string t prop
+end
 
-class type metaElement =
-  object
-    inherit element
+class type metaElement = object
+  inherit element
 
-    method content : js_string t prop
+  method content : js_string t prop
 
-    method httpEquiv : js_string t prop
+  method httpEquiv : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method scheme : js_string t prop
-  end
+  method scheme : js_string t prop
+end
 
-class type baseElement =
-  object
-    inherit element
+class type baseElement = object
+  inherit element
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method target : js_string t prop
-  end
+  method target : js_string t prop
+end
 
-class type styleElement =
-  object
-    inherit element
+class type styleElement = object
+  inherit element
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method media : js_string t prop
+  method media : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
 class type bodyElement = element
 
-class type formElement =
-  object
-    inherit element
+class type formElement = object
+  inherit element
 
-    method elements : element collection t readonly_prop
+  method elements : element collection t readonly_prop
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method acceptCharset : js_string t prop
+  method acceptCharset : js_string t prop
 
-    method action : js_string t prop
+  method action : js_string t prop
 
-    method enctype : js_string t prop
+  method enctype : js_string t prop
 
-    method _method : js_string t prop
+  method _method : js_string t prop
 
-    method target : js_string t prop
+  method target : js_string t prop
 
-    method submit : unit meth
+  method submit : unit meth
 
-    method reset : unit meth
+  method reset : unit meth
 
-    method onsubmit : ('self t, submitEvent t) event_listener writeonly_prop
-  end
+  method onsubmit : ('self t, submitEvent t) event_listener writeonly_prop
+end
 
-class type optGroupElement =
-  object
-    inherit element
+class type optGroupElement = object
+  inherit element
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method label : js_string t prop
-  end
+  method label : js_string t prop
+end
 
-class type optionElement =
-  object
-    inherit optGroupElement
+class type optionElement = object
+  inherit optGroupElement
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method defaultSelected : bool t prop
+  method defaultSelected : bool t prop
 
-    method text : js_string t readonly_prop
+  method text : js_string t readonly_prop
 
-    method index : int readonly_prop
+  method index : int readonly_prop
 
-    method selected : bool t prop
+  method selected : bool t prop
 
-    method value : js_string t prop
-  end
+  method value : js_string t prop
+end
 
-class type selectElement =
-  object ('self)
-    inherit element
+class type selectElement = object ('self)
+  inherit element
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method selectedIndex : int prop
+  (* Cannot be changed under IE *)
+  method selectedIndex : int prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method length : int prop
+  method length : int prop
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method options : optionElement collection t readonly_prop
+  method options : optionElement collection t readonly_prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method multiple : bool t prop
+  method multiple : bool t prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method size : int prop
+  (* Cannot be changed under IE *)
+  method size : int prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method add : #optGroupElement t -> #optGroupElement t opt -> unit meth
+  method add : #optGroupElement t -> #optGroupElement t opt -> unit meth
 
-    method remove : int -> unit meth
+  method remove : int -> unit meth
 
-    method required : bool t writeonly_prop
+  method required : bool t writeonly_prop
 
-    (* Not supported by IE 9/Safari *)
-    method onchange : ('self t, event t) event_listener prop
+  (* Not supported by IE 9/Safari *)
+  method onchange : ('self t, event t) event_listener prop
 
-    method oninput : ('self t, event t) event_listener prop
-  end
+  method oninput : ('self t, event t) event_listener prop
+end
 
-class type inputElement =
-  object ('self)
-    inherit element
+class type inputElement = object ('self)
+  inherit element
 
-    method defaultValue : js_string t prop
+  method defaultValue : js_string t prop
 
-    method defaultChecked : js_string t prop
+  method defaultChecked : js_string t prop
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accept : js_string t prop
+  method accept : js_string t prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method alt : js_string t prop
+  method alt : js_string t prop
 
-    method checked : bool t prop
+  method checked : bool t prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method maxLength : int prop
+  method maxLength : int prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method readOnly : bool t prop
+  (* Cannot be changed under IE *)
+  method readOnly : bool t prop
 
-    method required : bool t writeonly_prop
+  method required : bool t writeonly_prop
 
-    (* Not supported by IE 9/Safari *)
-    method size : int prop
+  (* Not supported by IE 9/Safari *)
+  method size : int prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method useMap : js_string t prop
+  (* Cannot be changed under IE *)
+  method useMap : js_string t prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method select : unit meth
+  method select : unit meth
 
-    method files : File.fileList t optdef readonly_prop
+  method files : File.fileList t optdef readonly_prop
 
-    method placeholder : js_string t writeonly_prop
+  method placeholder : js_string t writeonly_prop
 
-    (* Not supported by IE 9 *)
-    method selectionDirection : js_string t prop
+  (* Not supported by IE 9 *)
+  method selectionDirection : js_string t prop
 
-    method selectionStart : int prop
+  method selectionStart : int prop
 
-    method selectionEnd : int prop
+  method selectionEnd : int prop
 
-    method onselect : ('self t, event t) event_listener prop
+  method onselect : ('self t, event t) event_listener prop
 
-    method onchange : ('self t, event t) event_listener prop
+  method onchange : ('self t, event t) event_listener prop
 
-    method oninput : ('self t, event t) event_listener prop
+  method oninput : ('self t, event t) event_listener prop
 
-    method onblur : ('self t, focusEvent t) event_listener prop
+  method onblur : ('self t, focusEvent t) event_listener prop
 
-    method onfocus : ('self t, focusEvent t) event_listener prop
-  end
+  method onfocus : ('self t, focusEvent t) event_listener prop
+end
 
-class type textAreaElement =
-  object ('self)
-    inherit element
+class type textAreaElement = object ('self)
+  inherit element
 
-    method defaultValue : js_string t prop
+  method defaultValue : js_string t prop
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method cols : int prop
+  method cols : int prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method readOnly : bool t prop
+  (* Cannot be changed under IE *)
+  method readOnly : bool t prop
 
-    method rows : int prop
+  method rows : int prop
 
-    method selectionDirection : js_string t prop
+  method selectionDirection : js_string t prop
 
-    method selectionEnd : int prop
+  method selectionEnd : int prop
 
-    method selectionStart : int prop
+  method selectionStart : int prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method value : js_string t prop
+  (* Cannot be changed under IE *)
+  method value : js_string t prop
 
-    method select : unit meth
+  method select : unit meth
 
-    method required : bool t writeonly_prop
+  method required : bool t writeonly_prop
 
-    (* Not supported by IE 9/Safari *)
-    method placeholder : js_string t writeonly_prop
+  (* Not supported by IE 9/Safari *)
+  method placeholder : js_string t writeonly_prop
 
-    (* Not supported by IE 9 *)
-    method onselect : ('self t, event t) event_listener prop
+  (* Not supported by IE 9 *)
+  method onselect : ('self t, event t) event_listener prop
 
-    method onchange : ('self t, event t) event_listener prop
+  method onchange : ('self t, event t) event_listener prop
 
-    method oninput : ('self t, event t) event_listener prop
+  method oninput : ('self t, event t) event_listener prop
 
-    method onblur : ('self t, focusEvent t) event_listener prop
+  method onblur : ('self t, focusEvent t) event_listener prop
 
-    method onfocus : ('self t, focusEvent t) event_listener prop
-  end
+  method onfocus : ('self t, focusEvent t) event_listener prop
+end
 
-class type buttonElement =
-  object
-    inherit element
+class type buttonElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method disabled : bool t prop
+  method disabled : bool t prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method tabIndex : int prop
+  (* Cannot be changed under IE *)
+  method tabIndex : int prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    (* Cannot be changed under IE *)
-    method value : js_string t prop
-  end
+  (* Cannot be changed under IE *)
+  method value : js_string t prop
+end
 
-class type labelElement =
-  object
-    inherit element
+class type labelElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method htmlFor : js_string t prop
-  end
+  method htmlFor : js_string t prop
+end
 
-class type fieldSetElement =
-  object
-    inherit element
+class type fieldSetElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
-  end
+  method form : formElement t opt readonly_prop
+end
 
-class type legendElement =
-  object
-    inherit element
+class type legendElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method accessKey : js_string t prop
-  end
+  method accessKey : js_string t prop
+end
 
 class type uListElement = element
 
@@ -1168,12 +1120,11 @@ class type paragraphElement = element
 
 class type headingElement = element
 
-class type quoteElement =
-  object
-    inherit element
+class type quoteElement = object
+  inherit element
 
-    method cite : js_string t prop
-  end
+  method cite : js_string t prop
+end
 
 class type preElement = element
 
@@ -1181,325 +1132,310 @@ class type brElement = element
 
 class type hrElement = element
 
-class type modElement =
-  object
-    inherit element
+class type modElement = object
+  inherit element
 
-    method cite : js_string t prop
+  method cite : js_string t prop
 
-    method dateTime : js_string t prop
-  end
+  method dateTime : js_string t prop
+end
 
-class type anchorElement =
-  object
-    inherit element
+class type anchorElement = object
+  inherit element
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method charset : js_string t prop
+  method charset : js_string t prop
 
-    method coords : js_string t prop
+  method coords : js_string t prop
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method hreflang : js_string t prop
+  method hreflang : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method rel : js_string t prop
+  method rel : js_string t prop
 
-    method rev : js_string t prop
+  method rev : js_string t prop
 
-    method shape : js_string t prop
+  method shape : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method target : js_string t prop
+  method target : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
-class type imageElement =
-  object ('self)
-    inherit element
+class type imageElement = object ('self)
+  inherit element
 
-    method alt : js_string t prop
+  method alt : js_string t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method useMap : js_string t prop
+  method useMap : js_string t prop
 
-    method isMap : bool t prop
+  method isMap : bool t prop
 
-    method width : int prop
+  method width : int prop
 
-    method height : int prop
+  method height : int prop
 
-    (* Properties naturalWidth/Height not available in all browsers. *)
-    method naturalWidth : int optdef readonly_prop
+  (* Properties naturalWidth/Height not available in all browsers. *)
+  method naturalWidth : int optdef readonly_prop
 
-    method naturalHeight : int optdef readonly_prop
+  method naturalHeight : int optdef readonly_prop
 
-    method complete : bool t prop
+  method complete : bool t prop
 
-    method onload : ('self t, event t) event_listener prop
+  method onload : ('self t, event t) event_listener prop
 
-    method onerror : ('self t, event t) event_listener prop
+  method onerror : ('self t, event t) event_listener prop
 
-    method onabort : ('self t, event t) event_listener prop
-  end
+  method onabort : ('self t, event t) event_listener prop
+end
 
-class type objectElement =
-  object
-    inherit element
+class type objectElement = object
+  inherit element
 
-    method form : formElement t opt readonly_prop
+  method form : formElement t opt readonly_prop
 
-    method code : js_string t prop
+  method code : js_string t prop
 
-    method archive : js_string t prop
+  method archive : js_string t prop
 
-    method codeBase : js_string t prop
+  method codeBase : js_string t prop
 
-    method codeType : js_string t prop
+  method codeType : js_string t prop
 
-    method data : js_string t prop
+  method data : js_string t prop
 
-    method declare : bool t prop
+  method declare : bool t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method standby : js_string t prop
+  method standby : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method _type : js_string t prop
+  method _type : js_string t prop
 
-    method useMap : js_string t prop
+  method useMap : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method document : Dom.element Dom.document t opt readonly_prop
-  end
+  method document : Dom.element Dom.document t opt readonly_prop
+end
 
-class type paramElement =
-  object
-    inherit element
+class type paramElement = object
+  inherit element
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method _type : js_string t prop
+  method _type : js_string t prop
 
-    method value : js_string t prop
+  method value : js_string t prop
 
-    method valueType : js_string t prop
-  end
+  method valueType : js_string t prop
+end
 
-class type areaElement =
-  object
-    inherit element
+class type areaElement = object
+  inherit element
 
-    method accessKey : js_string t prop
+  method accessKey : js_string t prop
 
-    method alt : js_string t prop
+  method alt : js_string t prop
 
-    method coords : js_string t prop
+  method coords : js_string t prop
 
-    method href : js_string t prop
+  method href : js_string t prop
 
-    method noHref : bool t prop
+  method noHref : bool t prop
 
-    method shape : js_string t prop
+  method shape : js_string t prop
 
-    method tabIndex : int prop
+  method tabIndex : int prop
 
-    method target : js_string t prop
-  end
+  method target : js_string t prop
+end
 
-class type mapElement =
-  object
-    inherit element
+class type mapElement = object
+  inherit element
 
-    method areas : areaElement collection t readonly_prop
+  method areas : areaElement collection t readonly_prop
 
-    method name : js_string t prop
-  end
+  method name : js_string t prop
+end
 
-class type scriptElement =
-  object
-    inherit element
+class type scriptElement = object
+  inherit element
 
-    method text : js_string t prop
+  method text : js_string t prop
 
-    method charset : js_string t prop
+  method charset : js_string t prop
 
-    method defer : bool t prop
+  method defer : bool t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method _type : js_string t prop
+  method _type : js_string t prop
 
-    method async : bool t prop
-  end
+  method async : bool t prop
+end
 
-class type embedElement =
-  object
-    inherit element
+class type embedElement = object
+  inherit element
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method _type : js_string t prop
-  end
+  method _type : js_string t prop
+end
 
-class type tableCellElement =
-  object
-    inherit element
+class type tableCellElement = object
+  inherit element
 
-    method cellIndex : int readonly_prop
+  method cellIndex : int readonly_prop
 
-    method abbr : js_string t prop
+  method abbr : js_string t prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method axis : js_string t prop
+  method axis : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method colSpan : int prop
+  method colSpan : int prop
 
-    method headers : js_string t prop
+  method headers : js_string t prop
 
-    method rowSpan : int prop
+  method rowSpan : int prop
 
-    method scope : js_string t prop
+  method scope : js_string t prop
 
-    method vAlign : js_string t prop
-  end
+  method vAlign : js_string t prop
+end
 
-class type tableRowElement =
-  object
-    inherit element
+class type tableRowElement = object
+  inherit element
 
-    method rowIndex : int readonly_prop
+  method rowIndex : int readonly_prop
 
-    method sectionRowIndex : int readonly_prop
+  method sectionRowIndex : int readonly_prop
 
-    method cells : tableCellElement collection t readonly_prop
+  method cells : tableCellElement collection t readonly_prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method vAlign : js_string t prop
+  method vAlign : js_string t prop
 
-    method insertCell : int -> tableCellElement t meth
+  method insertCell : int -> tableCellElement t meth
 
-    method deleteCell : int -> unit meth
-  end
+  method deleteCell : int -> unit meth
+end
 
-class type tableColElement =
-  object
-    inherit element
+class type tableColElement = object
+  inherit element
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method span : int prop
+  method span : int prop
 
-    method vAlign : js_string t prop
+  method vAlign : js_string t prop
 
-    method width : js_string t prop
-  end
+  method width : js_string t prop
+end
 
-class type tableSectionElement =
-  object
-    inherit element
+class type tableSectionElement = object
+  inherit element
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method ch : js_string t prop
+  method ch : js_string t prop
 
-    method chOff : js_string t prop
+  method chOff : js_string t prop
 
-    method vAlign : js_string t prop
+  method vAlign : js_string t prop
 
-    method rows : tableRowElement collection t readonly_prop
+  method rows : tableRowElement collection t readonly_prop
 
-    method insertRow : int -> tableRowElement t meth
+  method insertRow : int -> tableRowElement t meth
 
-    method deleteRow : int -> unit meth
-  end
+  method deleteRow : int -> unit meth
+end
 
 class type tableCaptionElement = element
 
-class type tableElement =
-  object
-    inherit element
+class type tableElement = object
+  inherit element
 
-    method caption : tableCaptionElement t prop
+  method caption : tableCaptionElement t prop
 
-    method tHead : tableSectionElement t prop
+  method tHead : tableSectionElement t prop
 
-    method tFoot : tableSectionElement t prop
+  method tFoot : tableSectionElement t prop
 
-    method rows : tableRowElement collection t readonly_prop
+  method rows : tableRowElement collection t readonly_prop
 
-    method tBodies : tableSectionElement collection t readonly_prop
+  method tBodies : tableSectionElement collection t readonly_prop
 
-    method align : js_string t prop
+  method align : js_string t prop
 
-    method border : js_string t prop
+  method border : js_string t prop
 
-    method cellPadding : js_string t prop
+  method cellPadding : js_string t prop
 
-    method cellSpacing : js_string t prop
+  method cellSpacing : js_string t prop
 
-    method frame : js_string t prop
+  method frame : js_string t prop
 
-    method rules : js_string t prop
+  method rules : js_string t prop
 
-    method summary : js_string t prop
+  method summary : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method createTHead : tableSectionElement t meth
+  method createTHead : tableSectionElement t meth
 
-    method deleteTHead : unit meth
+  method deleteTHead : unit meth
 
-    method createTFoot : tableSectionElement t meth
+  method createTFoot : tableSectionElement t meth
 
-    method deleteTFoot : unit meth
+  method deleteTFoot : unit meth
 
-    method createCaption : tableCaptionElement t meth
+  method createCaption : tableCaptionElement t meth
 
-    method deleteCaption : unit meth
+  method deleteCaption : unit meth
 
-    method insertRow : int -> tableRowElement t meth
+  method insertRow : int -> tableRowElement t meth
 
-    method deleteRow : int -> unit meth
-  end
+  method deleteRow : int -> unit meth
+end
 
-class type timeRanges =
-  object
-    method length : int readonly_prop
+class type timeRanges = object
+  method length : int readonly_prop
 
-    method start : int -> number t meth
+  method start : int -> number t meth
 
-    method end_ : int -> number t meth
-  end
+  method end_ : int -> number t meth
+end
 
 type networkState =
   | NETWORK_EMPTY
@@ -1514,108 +1450,105 @@ type readyState =
   | HAVE_FUTURE_DATA
   | HAVE_ENOUGH_DATA
 
-class type mediaElement =
-  object
-    inherit element
+class type mediaElement = object
+  inherit element
 
-    method canPlayType : js_string t -> js_string t meth
+  method canPlayType : js_string t -> js_string t meth
 
-    method load : unit meth
+  method load : unit meth
 
-    method play : unit meth
+  method play : unit meth
 
-    method pause : unit meth
+  method pause : unit meth
 
-    method autoplay : bool t prop
+  method autoplay : bool t prop
 
-    method buffered : timeRanges t readonly_prop
+  method buffered : timeRanges t readonly_prop
 
-    method controls : bool t prop
+  method controls : bool t prop
 
-    method currentSrc : js_string t readonly_prop
+  method currentSrc : js_string t readonly_prop
 
-    method currentTime : number t prop
+  method currentTime : number t prop
 
-    method duration : number t readonly_prop
+  method duration : number t readonly_prop
 
-    method ended : bool t readonly_prop
+  method ended : bool t readonly_prop
 
-    method loop : bool t prop
+  method loop : bool t prop
 
-    method mediagroup : js_string t prop
+  method mediagroup : js_string t prop
 
-    method muted : bool t prop
+  method muted : bool t prop
 
-    method networkState_int : int readonly_prop
+  method networkState_int : int readonly_prop
 
-    method networkState : networkState readonly_prop
+  method networkState : networkState readonly_prop
 
-    method paused : bool t readonly_prop
+  method paused : bool t readonly_prop
 
-    method playbackRate : number t prop
+  method playbackRate : number t prop
 
-    method played : timeRanges t readonly_prop
+  method played : timeRanges t readonly_prop
 
-    method preload : js_string t prop
+  method preload : js_string t prop
 
-    method readyState_int : int readonly_prop
+  method readyState_int : int readonly_prop
 
-    method readyState : readyState readonly_prop
+  method readyState : readyState readonly_prop
 
-    method seekable : timeRanges t readonly_prop
+  method seekable : timeRanges t readonly_prop
 
-    method seeking : bool t readonly_prop
+  method seeking : bool t readonly_prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method volume : number t prop
+  method volume : number t prop
 
-    method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
+  method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method oncanplaythrough : ('self t, mediaEvent t) event_listener writeonly_prop
+  method oncanplaythrough : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method ondurationchange : ('self t, mediaEvent t) event_listener writeonly_prop
+  method ondurationchange : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onemptied : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onemptied : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onended : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onended : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onloadeddata : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onloadeddata : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onloadedmetadata : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onloadedmetadata : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onloadstart : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onloadstart : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onpause : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onpause : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onplay : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onplaying : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onplaying : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onratechange : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onratechange : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onseeked : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onseeked : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onseeking : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onseeking : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onstalled : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onstalled : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onsuspend : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onsuspend : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onvolumechange : ('self t, mediaEvent t) event_listener writeonly_prop
+  method onvolumechange : ('self t, mediaEvent t) event_listener writeonly_prop
 
-    method onwaiting : ('self t, mediaEvent t) event_listener writeonly_prop
-  end
+  method onwaiting : ('self t, mediaEvent t) event_listener writeonly_prop
+end
 
-class type audioElement =
-  object
-    inherit mediaElement
-  end
+class type audioElement = object
+  inherit mediaElement
+end
 
-class type videoElement =
-  object
-    inherit mediaElement
-  end
+class type videoElement = object
+  inherit mediaElement
+end
 
 (** {2 Canvas object} *)
 
@@ -1625,387 +1558,377 @@ val _2d_ : context
 
 type canvasPattern
 
-class type canvasElement =
-  object
-    inherit element
+class type canvasElement = object
+  inherit element
 
-    method width : int prop
+  method width : int prop
 
-    method height : int prop
+  method height : int prop
 
-    method toDataURL : js_string t meth
+  method toDataURL : js_string t meth
 
-    method toDataURL_type : js_string t -> js_string t meth
+  method toDataURL_type : js_string t -> js_string t meth
 
-    method toDataURL_type_compression : js_string t -> number t -> js_string t meth
+  method toDataURL_type_compression : js_string t -> number t -> js_string t meth
 
-    method getContext : context -> canvasRenderingContext2D t meth
-  end
+  method getContext : context -> canvasRenderingContext2D t meth
+end
 
-and canvasRenderingContext2D =
-  object
-    method canvas : canvasElement t readonly_prop
+and canvasRenderingContext2D = object
+  method canvas : canvasElement t readonly_prop
 
-    method save : unit meth
+  method save : unit meth
 
-    method restore : unit meth
+  method restore : unit meth
 
-    method scale : number t -> number t -> unit meth
+  method scale : number t -> number t -> unit meth
 
-    method rotate : number t -> unit meth
+  method rotate : number t -> unit meth
 
-    method translate : number t -> number t -> unit meth
+  method translate : number t -> number t -> unit meth
 
-    method transform :
-      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+  method transform :
+    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method setTransform :
-      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+  method setTransform :
+    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method globalAlpha : number t prop
+  method globalAlpha : number t prop
 
-    method globalCompositeOperation : js_string t prop
+  method globalCompositeOperation : js_string t prop
 
-    method strokeStyle : js_string t writeonly_prop
+  method strokeStyle : js_string t writeonly_prop
 
-    method strokeStyle_gradient : canvasGradient t writeonly_prop
+  method strokeStyle_gradient : canvasGradient t writeonly_prop
 
-    method strokeStyle_pattern : canvasPattern t writeonly_prop
+  method strokeStyle_pattern : canvasPattern t writeonly_prop
 
-    method fillStyle : js_string t writeonly_prop
+  method fillStyle : js_string t writeonly_prop
 
-    method fillStyle_gradient : canvasGradient t writeonly_prop
+  method fillStyle_gradient : canvasGradient t writeonly_prop
 
-    method fillStyle_pattern : canvasPattern t writeonly_prop
+  method fillStyle_pattern : canvasPattern t writeonly_prop
 
-    method createLinearGradient :
-      number t -> number t -> number t -> number t -> canvasGradient t meth
+  method createLinearGradient :
+    number t -> number t -> number t -> number t -> canvasGradient t meth
 
-    method createRadialGradient :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> canvasGradient t meth
+  method createRadialGradient :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> canvasGradient t meth
 
-    method createPattern : imageElement t -> js_string t -> canvasPattern t meth
+  method createPattern : imageElement t -> js_string t -> canvasPattern t meth
 
-    method createPattern_fromCanvas :
-      canvasElement t -> js_string t -> canvasPattern t meth
+  method createPattern_fromCanvas : canvasElement t -> js_string t -> canvasPattern t meth
 
-    method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
+  method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-    method lineWidth : number t prop
+  method lineWidth : number t prop
 
-    method lineCap : js_string t prop
+  method lineCap : js_string t prop
 
-    method lineJoin : js_string t prop
+  method lineJoin : js_string t prop
 
-    method miterLimit : number t prop
+  method miterLimit : number t prop
 
-    method shadowOffsetX : number t prop
+  method shadowOffsetX : number t prop
 
-    method shadowOffsetY : number t prop
+  method shadowOffsetY : number t prop
 
-    method shadowBlur : number t prop
+  method shadowBlur : number t prop
 
-    method shadowColor : js_string t prop
+  method shadowColor : js_string t prop
 
-    method clearRect : number t -> number t -> number t -> number t -> unit meth
+  method clearRect : number t -> number t -> number t -> number t -> unit meth
 
-    method fillRect : number t -> number t -> number t -> number t -> unit meth
+  method fillRect : number t -> number t -> number t -> number t -> unit meth
 
-    method strokeRect : number t -> number t -> number t -> number t -> unit meth
+  method strokeRect : number t -> number t -> number t -> number t -> unit meth
 
-    method beginPath : unit meth
+  method beginPath : unit meth
 
-    method closePath : unit meth
+  method closePath : unit meth
 
-    method moveTo : number t -> number t -> unit meth
+  method moveTo : number t -> number t -> unit meth
 
-    method lineTo : number t -> number t -> unit meth
+  method lineTo : number t -> number t -> unit meth
 
-    method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
+  method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
 
-    method bezierCurveTo :
-      number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+  method bezierCurveTo :
+    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
+  method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
 
-    method rect : number t -> number t -> number t -> number t -> unit meth
+  method rect : number t -> number t -> number t -> number t -> unit meth
 
-    method arc :
-      number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
+  method arc :
+    number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
 
-    method fill : unit meth
+  method fill : unit meth
 
-    method stroke : unit meth
+  method stroke : unit meth
 
-    method clip : unit meth
+  method clip : unit meth
 
-    method isPointInPath : number t -> number t -> bool t meth
+  method isPointInPath : number t -> number t -> bool t meth
 
-    method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
+  method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
 
-    method font : js_string t prop
+  method font : js_string t prop
 
-    method textAlign : js_string t prop
+  method textAlign : js_string t prop
 
-    method textBaseline : js_string t prop
+  method textBaseline : js_string t prop
 
-    method fillText : js_string t -> number t -> number t -> unit meth
+  method fillText : js_string t -> number t -> number t -> unit meth
 
-    method fillText_withWidth : js_string t -> number t -> number t -> number t -> unit meth
+  method fillText_withWidth : js_string t -> number t -> number t -> number t -> unit meth
 
-    method strokeText : js_string t -> number t -> number t -> unit meth
+  method strokeText : js_string t -> number t -> number t -> unit meth
 
-    method strokeText_withWidth :
-      js_string t -> number t -> number t -> number t -> unit meth
+  method strokeText_withWidth :
+    js_string t -> number t -> number t -> number t -> unit meth
 
-    method measureText : js_string t -> textMetrics t meth
+  method measureText : js_string t -> textMetrics t meth
 
-    method drawImage : imageElement t -> number t -> number t -> unit meth
+  method drawImage : imageElement t -> number t -> number t -> unit meth
 
-    method drawImage_withSize :
-      imageElement t -> number t -> number t -> number t -> number t -> unit meth
+  method drawImage_withSize :
+    imageElement t -> number t -> number t -> number t -> number t -> unit meth
 
-    method drawImage_full :
-         imageElement t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method drawImage_full :
+       imageElement t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
+  method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
 
-    method drawImage_fromCanvasWithSize :
-      canvasElement t -> number t -> number t -> number t -> number t -> unit meth
+  method drawImage_fromCanvasWithSize :
+    canvasElement t -> number t -> number t -> number t -> number t -> unit meth
 
-    method drawImage_fullFromCanvas :
-         canvasElement t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method drawImage_fullFromCanvas :
+       canvasElement t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    method drawImage_fromVideoWithVideo :
-      videoElement t -> number t -> number t -> unit meth
+  method drawImage_fromVideoWithVideo :
+    videoElement t -> number t -> number t -> unit meth
 
-    method drawImage_fromVideoWithSize :
-      videoElement t -> number t -> number t -> number t -> number t -> unit meth
+  method drawImage_fromVideoWithSize :
+    videoElement t -> number t -> number t -> number t -> number t -> unit meth
 
-    method drawImage_fullFromVideo :
-         videoElement t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method drawImage_fullFromVideo :
+       videoElement t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    (* Method createImageData not available in Opera *)
-    method createImageData : int -> int -> imageData t meth
+  (* Method createImageData not available in Opera *)
+  method createImageData : int -> int -> imageData t meth
 
-    method getImageData : number t -> number t -> number t -> number t -> imageData t meth
+  method getImageData : number t -> number t -> number t -> number t -> imageData t meth
 
-    method putImageData : imageData t -> number t -> number t -> unit meth
-  end
+  method putImageData : imageData t -> number t -> number t -> unit meth
+end
 
-and canvasGradient =
-  object
-    method addColorStop : number t -> js_string t -> unit meth
-  end
+and canvasGradient = object
+  method addColorStop : number t -> js_string t -> unit meth
+end
 
-and textMetrics =
-  object
-    method width : number t readonly_prop
-  end
+and textMetrics = object
+  method width : number t readonly_prop
+end
 
-and imageData =
-  object
-    method width : int readonly_prop
+and imageData = object
+  method width : int readonly_prop
 
-    method height : int readonly_prop
+  method height : int readonly_prop
 
-    method data : canvasPixelArray t readonly_prop
-  end
+  method data : canvasPixelArray t readonly_prop
+end
 
-and canvasPixelArray =
-  object
-    method length : int readonly_prop
-  end
+and canvasPixelArray = object
+  method length : int readonly_prop
+end
 
 external pixel_get : canvasPixelArray t -> int -> int = "caml_js_get"
 
 external pixel_set : canvasPixelArray t -> int -> int -> unit = "caml_js_set"
 
 (** Object representing a range **)
-class type range =
-  object
-    method collapsed : bool t readonly_prop
+class type range = object
+  method collapsed : bool t readonly_prop
 
-    method startOffset : int readonly_prop
+  method startOffset : int readonly_prop
 
-    method endOffset : int readonly_prop
+  method endOffset : int readonly_prop
 
-    method startContainer : Dom.node t readonly_prop
+  method startContainer : Dom.node t readonly_prop
 
-    method endContainer : Dom.node t readonly_prop
+  method endContainer : Dom.node t readonly_prop
 
-    method setStart : Dom.node t -> int -> unit meth
+  method setStart : Dom.node t -> int -> unit meth
 
-    method setEnd : Dom.node t -> int -> unit meth
+  method setEnd : Dom.node t -> int -> unit meth
 
-    method setStartBefore : Dom.node t -> unit meth
+  method setStartBefore : Dom.node t -> unit meth
 
-    method setEndBefore : Dom.node t -> unit meth
+  method setEndBefore : Dom.node t -> unit meth
 
-    method setStartAfter : Dom.node t -> unit meth
+  method setStartAfter : Dom.node t -> unit meth
 
-    method setEndAfter : Dom.node t -> unit meth
+  method setEndAfter : Dom.node t -> unit meth
 
-    method selectNode : Dom.node t -> unit meth
+  method selectNode : Dom.node t -> unit meth
 
-    method selectNodeContents : Dom.node t -> unit meth
+  method selectNodeContents : Dom.node t -> unit meth
 
-    method collapse : bool t -> unit meth
+  method collapse : bool t -> unit meth
 
-    method cloneContents : Dom.documentFragment t meth
+  method cloneContents : Dom.documentFragment t meth
 
-    method extractContents : Dom.documentFragment t meth
+  method extractContents : Dom.documentFragment t meth
 
-    method deleteContents : unit meth
+  method deleteContents : unit meth
 
-    method insertNode : Dom.node t -> unit meth
+  method insertNode : Dom.node t -> unit meth
 
-    method surroundContents : Dom.node t -> unit meth
+  method surroundContents : Dom.node t -> unit meth
 
-    method cloneRange : range t meth
+  method cloneRange : range t meth
 
-    method toString : js_string t meth
-  end
+  method toString : js_string t meth
+end
 
 (** Information on current selection *)
-class type selection =
-  object
-    method anchorNode : Dom.node t readonly_prop
+class type selection = object
+  method anchorNode : Dom.node t readonly_prop
 
-    method anchorOffset : int readonly_prop
+  method anchorOffset : int readonly_prop
 
-    method focusNode : Dom.node t readonly_prop
+  method focusNode : Dom.node t readonly_prop
 
-    method focusOffset : int readonly_prop
+  method focusOffset : int readonly_prop
 
-    method isCollapsed : bool t readonly_prop
+  method isCollapsed : bool t readonly_prop
 
-    method rangeCount : int readonly_prop
+  method rangeCount : int readonly_prop
 
-    method getRangeAt : int -> range t meth
+  method getRangeAt : int -> range t meth
 
-    method collapse : bool t -> unit meth
+  method collapse : bool t -> unit meth
 
-    method extend : Dom.node t -> int -> unit meth
+  method extend : Dom.node t -> int -> unit meth
 
-    method modify : js_string t -> js_string t -> js_string t -> unit meth
+  method modify : js_string t -> js_string t -> js_string t -> unit meth
 
-    method collapseToStart : unit meth
+  method collapseToStart : unit meth
 
-    method collapseToEnd : unit meth
+  method collapseToEnd : unit meth
 
-    method selectAllChildren : Dom.node t -> unit meth
+  method selectAllChildren : Dom.node t -> unit meth
 
-    method addRange : range t -> unit meth
+  method addRange : range t -> unit meth
 
-    method removeRange : range t -> unit meth
+  method removeRange : range t -> unit meth
 
-    method removeAllRanges : unit meth
+  method removeAllRanges : unit meth
 
-    method deleteFromDocument : unit meth
+  method deleteFromDocument : unit meth
 
-    method containsNode : Dom.node t -> bool t -> bool t meth
+  method containsNode : Dom.node t -> bool t -> bool t meth
 
-    method toString : js_string t meth
-  end
+  method toString : js_string t meth
+end
 
 (** {2 Document objects} *)
 
-class type document =
-  object
-    inherit [element] Dom.document
+class type document = object
+  inherit [element] Dom.document
 
-    inherit nodeSelector
+  inherit nodeSelector
 
-    inherit eventTarget
+  inherit eventTarget
 
-    method title : js_string t prop
+  method title : js_string t prop
 
-    method referrer : js_string t readonly_prop
+  method referrer : js_string t readonly_prop
 
-    method domain : js_string t prop
+  method domain : js_string t prop
 
-    method _URL : js_string t readonly_prop
+  method _URL : js_string t readonly_prop
 
-    method head : headElement t prop
+  method head : headElement t prop
 
-    method body : bodyElement t prop
+  method body : bodyElement t prop
 
-    method documentElement : htmlElement t readonly_prop
+  method documentElement : htmlElement t readonly_prop
 
-    method images : imageElement collection t readonly_prop
+  method images : imageElement collection t readonly_prop
 
-    method applets : element collection t readonly_prop
+  method applets : element collection t readonly_prop
 
-    method links : element collection t readonly_prop
+  method links : element collection t readonly_prop
 
-    method forms : formElement collection t readonly_prop
+  method forms : formElement collection t readonly_prop
 
-    method anchors : element collection t readonly_prop
+  method anchors : element collection t readonly_prop
 
-    method cookie : js_string t prop
+  method cookie : js_string t prop
 
-    method designMode : js_string t prop
+  method designMode : js_string t prop
 
-    method open_ : unit meth
+  method open_ : unit meth
 
-    method close : unit meth
+  method close : unit meth
 
-    method write : js_string t -> unit meth
+  method write : js_string t -> unit meth
 
-    method execCommand : js_string t -> bool t -> js_string t opt -> unit meth
+  method execCommand : js_string t -> bool t -> js_string t opt -> unit meth
 
-    method createRange : range t meth
+  method createRange : range t meth
 
-    method readyState : js_string t readonly_prop
+  method readyState : js_string t readonly_prop
 
-    method getElementsByClassName : js_string t -> element Dom.nodeList t meth
+  method getElementsByClassName : js_string t -> element Dom.nodeList t meth
 
-    method getElementsByName : js_string t -> element Dom.nodeList t meth
+  method getElementsByName : js_string t -> element Dom.nodeList t meth
 
-    method activeElement : element t opt readonly_prop
+  method activeElement : element t opt readonly_prop
 
-    method hidden : bool t readonly_prop
+  method hidden : bool t readonly_prop
 
-    method onfullscreenchange : (document t, event t) event_listener writeonly_prop
+  method onfullscreenchange : (document t, event t) event_listener writeonly_prop
 
-    method onwebkitfullscreenchange : (document t, event t) event_listener writeonly_prop
+  method onwebkitfullscreenchange : (document t, event t) event_listener writeonly_prop
 
-    inherit eventTarget
-  end
+  inherit eventTarget
+end
 
 val document : document t
 (** The current document *)
@@ -2038,121 +1961,116 @@ val getElementById : string -> element Js.t
 (** {2 Window objects} *)
 
 (** Location information *)
-class type location =
-  object
-    method href : js_string t prop
+class type location = object
+  method href : js_string t prop
 
-    method protocol : js_string t prop
+  method protocol : js_string t prop
 
-    method host : js_string t prop
+  method host : js_string t prop
 
-    method hostname : js_string t prop
+  method hostname : js_string t prop
 
-    method origin : js_string t optdef readonly_prop
+  method origin : js_string t optdef readonly_prop
 
-    method port : js_string t prop
+  method port : js_string t prop
 
-    method pathname : js_string t prop
+  method pathname : js_string t prop
 
-    method search : js_string t prop
+  method search : js_string t prop
 
-    method hash : js_string t prop
+  method hash : js_string t prop
 
-    method assign : js_string t -> unit meth
+  method assign : js_string t -> unit meth
 
-    method replace : js_string t -> unit meth
+  method replace : js_string t -> unit meth
 
-    method reload : unit meth
-  end
+  method reload : unit meth
+end
 
 val location_origin : location t -> js_string t
 
 (** Browser history information *)
-class type history =
-  object
-    method length : int readonly_prop
+class type history = object
+  method length : int readonly_prop
 
-    method state : Js.Unsafe.any readonly_prop
+  method state : Js.Unsafe.any readonly_prop
 
-    method go : int opt -> unit meth
+  method go : int opt -> unit meth
 
-    method back : unit meth
+  method back : unit meth
 
-    method forward : unit meth
+  method forward : unit meth
 
-    method pushState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
+  method pushState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
 
-    method replaceState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
-  end
+  method replaceState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
+end
 
 class type undoManager = object end
 (** Undo manager *)
 
 (** Navigator information *)
-class type navigator =
-  object
-    method appCodeName : js_string t readonly_prop
+class type navigator = object
+  method appCodeName : js_string t readonly_prop
 
-    method appName : js_string t readonly_prop
+  method appName : js_string t readonly_prop
 
-    method appVersion : js_string t readonly_prop
+  method appVersion : js_string t readonly_prop
 
-    method cookieEnabled : bool t readonly_prop
+  method cookieEnabled : bool t readonly_prop
 
-    method onLine : bool t readonly_prop
+  method onLine : bool t readonly_prop
 
-    method platform : js_string t readonly_prop
+  method platform : js_string t readonly_prop
 
-    method vendor : js_string t readonly_prop
+  method vendor : js_string t readonly_prop
 
-    method userAgent : js_string t readonly_prop
+  method userAgent : js_string t readonly_prop
 
-    method language : js_string t optdef readonly_prop
+  method language : js_string t optdef readonly_prop
 
-    method userLanguage : js_string t optdef readonly_prop
+  method userLanguage : js_string t optdef readonly_prop
 
-    method maxTouchPoints : int readonly_prop
-  end
+  method maxTouchPoints : int readonly_prop
+end
 
-class type screen =
-  object
-    method width : int readonly_prop
+class type screen = object
+  method width : int readonly_prop
 
-    method height : int readonly_prop
+  method height : int readonly_prop
 
-    method availWidth : int readonly_prop
+  method availWidth : int readonly_prop
 
-    method availHeight : int readonly_prop
-  end
+  method availHeight : int readonly_prop
+end
 
-class type applicationCache =
-  object
-    method status : int readonly_prop
+class type applicationCache = object
+  method status : int readonly_prop
 
-    method update : unit meth
+  method update : unit meth
 
-    method abort : unit meth
+  method abort : unit meth
 
-    method swapCache : unit meth
+  method swapCache : unit meth
 
-    method onchecking : (applicationCache t, event t) event_listener prop
+  method onchecking : (applicationCache t, event t) event_listener prop
 
-    method onerror : (applicationCache t, event t) event_listener prop
+  method onerror : (applicationCache t, event t) event_listener prop
 
-    method onnoupdate : (applicationCache t, event t) event_listener prop
+  method onnoupdate : (applicationCache t, event t) event_listener prop
 
-    method ondownloading : (applicationCache t, event t) event_listener prop
+  method ondownloading : (applicationCache t, event t) event_listener prop
 
-    method onprogress : (applicationCache t, event t) event_listener prop
+  method onprogress : (applicationCache t, event t) event_listener prop
 
-    method onupdateready : (applicationCache t, event t) event_listener prop
+  method onupdateready : (applicationCache t, event t) event_listener prop
 
-    method oncached : (applicationCache t, event t) event_listener prop
+  method oncached : (applicationCache t, event t) event_listener prop
 
-    method onobsolete : (applicationCache t, event t) event_listener prop
+  method onobsolete : (applicationCache t, event t) event_listener prop
 
-    inherit eventTarget
-  end
+  inherit eventTarget
+end
 
 type interval_id
 
@@ -2160,190 +2078,185 @@ type timeout_id
 
 type animation_frame_request_id
 
-class type _URL =
-  object
-    method createObjectURL : #File.blob t -> js_string t meth
+class type _URL = object
+  method createObjectURL : #File.blob t -> js_string t meth
 
-    method revokeObjectURL : js_string t -> unit meth
-  end
+  method revokeObjectURL : js_string t -> unit meth
+end
 
 (** Specification of window objects *)
-class type window =
-  object
-    inherit eventTarget
+class type window = object
+  inherit eventTarget
 
-    method document : document t readonly_prop
+  method document : document t readonly_prop
 
-    method applicationCache : applicationCache t readonly_prop
+  method applicationCache : applicationCache t readonly_prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method location : location t readonly_prop
+  method location : location t readonly_prop
 
-    method history : history t readonly_prop
+  method history : history t readonly_prop
 
-    method undoManager : undoManager t readonly_prop
+  method undoManager : undoManager t readonly_prop
 
-    method navigator : navigator t readonly_prop
+  method navigator : navigator t readonly_prop
 
-    method getSelection : selection t meth
+  method getSelection : selection t meth
 
-    method close : unit meth
+  method close : unit meth
 
-    method closed : bool t readonly_prop
+  method closed : bool t readonly_prop
 
-    method stop : unit meth
+  method stop : unit meth
 
-    method focus : unit meth
+  method focus : unit meth
 
-    method blur : unit meth
+  method blur : unit meth
 
-    method scroll : int -> int -> unit meth
+  method scroll : int -> int -> unit meth
 
-    method scrollBy : int -> int -> unit meth
+  method scrollBy : int -> int -> unit meth
 
-    method sessionStorage : storage t optdef readonly_prop
+  method sessionStorage : storage t optdef readonly_prop
 
-    method localStorage : storage t optdef readonly_prop
+  method localStorage : storage t optdef readonly_prop
 
-    method top : window t readonly_prop
+  method top : window t readonly_prop
 
-    method parent : window t readonly_prop
+  method parent : window t readonly_prop
 
-    method frameElement : element t opt readonly_prop
+  method frameElement : element t opt readonly_prop
 
-    method open_ : js_string t -> js_string t -> js_string t opt -> window t opt meth
+  method open_ : js_string t -> js_string t -> js_string t opt -> window t opt meth
 
-    method alert : js_string t -> unit meth
+  method alert : js_string t -> unit meth
 
-    method confirm : js_string t -> bool t meth
+  method confirm : js_string t -> bool t meth
 
-    method prompt : js_string t -> js_string t -> js_string t opt meth
+  method prompt : js_string t -> js_string t -> js_string t opt meth
 
-    method print : unit meth
+  method print : unit meth
 
-    method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
+  method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
 
-    method clearInterval : interval_id -> unit meth
+  method clearInterval : interval_id -> unit meth
 
-    method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
+  method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
 
-    method clearTimeout : timeout_id -> unit meth
+  method clearTimeout : timeout_id -> unit meth
 
-    method requestAnimationFrame :
-      (number t -> unit) Js.callback -> animation_frame_request_id meth
+  method requestAnimationFrame :
+    (number t -> unit) Js.callback -> animation_frame_request_id meth
 
-    method cancelAnimationFrame : animation_frame_request_id -> unit meth
+  method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
-    method screen : screen t readonly_prop
+  method screen : screen t readonly_prop
 
-    method innerWidth : int readonly_prop
+  method innerWidth : int readonly_prop
 
-    method innerHeight : int readonly_prop
+  method innerHeight : int readonly_prop
 
-    method outerWidth : int readonly_prop
+  method outerWidth : int readonly_prop
 
-    method outerHeight : int readonly_prop
+  method outerHeight : int readonly_prop
 
-    method getComputedStyle : #element t -> cssStyleDeclaration t meth
+  method getComputedStyle : #element t -> cssStyleDeclaration t meth
 
-    method getComputedStyle_pseudoElt :
-      #element t -> js_string t -> cssStyleDeclaration t meth
+  method getComputedStyle_pseudoElt :
+    #element t -> js_string t -> cssStyleDeclaration t meth
 
-    method atob : js_string t -> js_string t meth
+  method atob : js_string t -> js_string t meth
 
-    method btoa : js_string t -> js_string t meth
+  method btoa : js_string t -> js_string t meth
 
-    method onload : (window t, event t) event_listener prop
+  method onload : (window t, event t) event_listener prop
 
-    method onunload : (window t, event t) event_listener prop
+  method onunload : (window t, event t) event_listener prop
 
-    method onbeforeunload : (window t, event t) event_listener prop
+  method onbeforeunload : (window t, event t) event_listener prop
 
-    method onblur : (window t, focusEvent t) event_listener prop
+  method onblur : (window t, focusEvent t) event_listener prop
 
-    method onfocus : (window t, focusEvent t) event_listener prop
+  method onfocus : (window t, focusEvent t) event_listener prop
 
-    method onresize : (window t, event t) event_listener prop
+  method onresize : (window t, event t) event_listener prop
 
-    method onorientationchange : (window t, event t) event_listener prop
+  method onorientationchange : (window t, event t) event_listener prop
 
-    method onpopstate : (window t, popStateEvent t) event_listener prop
+  method onpopstate : (window t, popStateEvent t) event_listener prop
 
-    method onhashchange : (window t, hashChangeEvent t) event_listener prop
+  method onhashchange : (window t, hashChangeEvent t) event_listener prop
 
-    method ononline : (window t, event t) event_listener writeonly_prop
+  method ononline : (window t, event t) event_listener writeonly_prop
 
-    method onoffline : (window t, event t) event_listener writeonly_prop
+  method onoffline : (window t, event t) event_listener writeonly_prop
 
-    method _URL : _URL t readonly_prop
+  method _URL : _URL t readonly_prop
 
-    method devicePixelRatio : number t readonly_prop
-  end
+  method devicePixelRatio : number t readonly_prop
+end
 
 val window : window t
 (** The current window *)
 
 (* {2 Frames } *)
 
-class type frameSetElement =
-  object
-    inherit element
+class type frameSetElement = object
+  inherit element
 
-    method cols : js_string t prop
+  method cols : js_string t prop
 
-    method rows : js_string t prop
-  end
+  method rows : js_string t prop
+end
 
-class type frameElement =
-  object
-    inherit element
+class type frameElement = object
+  inherit element
 
-    method frameBorder : js_string t prop
+  method frameBorder : js_string t prop
 
-    method longDesc : js_string t prop
+  method longDesc : js_string t prop
 
-    method marginHeight : js_string t prop
+  method marginHeight : js_string t prop
 
-    method marginWidth : js_string t prop
+  method marginWidth : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method noResize : bool t prop
+  method noResize : bool t prop
 
-    method scrolling : js_string t prop
+  method scrolling : js_string t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method contentDocument : document t opt readonly_prop
-  end
+  method contentDocument : document t opt readonly_prop
+end
 
-class type iFrameElement =
-  object
-    inherit element
+class type iFrameElement = object
+  inherit element
 
-    method frameBorder : js_string t prop
+  method frameBorder : js_string t prop
 
-    method height : js_string t prop
+  method height : js_string t prop
 
-    method width : js_string t prop
+  method width : js_string t prop
 
-    method longDesc : js_string t prop
+  method longDesc : js_string t prop
 
-    method marginHeight : js_string t prop
+  method marginHeight : js_string t prop
 
-    method marginWidth : js_string t prop
+  method marginWidth : js_string t prop
 
-    method name : js_string t prop
+  method name : js_string t prop
 
-    method scrolling : js_string t prop
+  method scrolling : js_string t prop
 
-    method src : js_string t prop
+  method src : js_string t prop
 
-    method contentDocument : document t opt readonly_prop
+  method contentDocument : document t opt readonly_prop
 
-    method contentWindow : window t readonly_prop
-  end
+  method contentWindow : window t readonly_prop
+end
 
 (****)
 
@@ -3220,7 +3133,7 @@ val js_array_of_collection : #element collection Js.t -> #element Js.t Js.js_arr
 (** {2 Deprecated function.} *)
 
 val _requestAnimationFrame : (unit -> unit) Js.callback -> unit
-  [@@ocaml.deprecated "[since 2.6] Use [Dom_html.window##requestAnimationFrame] instead."]
+[@@ocaml.deprecated "[since 2.6] Use [Dom_html.window##requestAnimationFrame] instead."]
 (** Call the appropriate [requestAnimationFrame] method variant
       (depending on the navigator), or sleep for a short amount
       of time when there no such method is provided. We currently
diff --git a/lib/js_of_ocaml/dom_svg.ml b/lib/js_of_ocaml/dom_svg.ml
index 794c4e99ea..0ce7b97665 100644
--- a/lib/js_of_ocaml/dom_svg.ml
+++ b/lib/js_of_ocaml/dom_svg.ml
@@ -31,12 +31,11 @@ type error_code =
   | INVALID_VALUE_ERR
   | MATRIX_NOT_INVERTABLE
 
-class type svg_error =
-  object
-    inherit Js.error
+class type svg_error = object
+  inherit Js.error
 
-    method code : error_code t readonly_prop
-  end
+  method code : error_code t readonly_prop
+end
 
 exception SVGError of svg_error
 
@@ -163,47 +162,44 @@ type suspendHandleID
 
 (****)
 
-class type ['a] animated =
-  object
-    method baseVal : 'a prop
+class type ['a] animated = object
+  method baseVal : 'a prop
 
-    method animVal : 'a prop
-  end
+  method animVal : 'a prop
+end
 
-class type ['a] list =
-  object
-    method numberOfItems : int readonly_prop
+class type ['a] list = object
+  method numberOfItems : int readonly_prop
 
-    method clear : unit meth
+  method clear : unit meth
 
-    method initialize : 'a -> 'a meth
+  method initialize : 'a -> 'a meth
 
-    method getItem : int -> 'a meth
+  method getItem : int -> 'a meth
 
-    method insertItemBefore : 'a -> int -> 'a meth
+  method insertItemBefore : 'a -> int -> 'a meth
 
-    method replaceItem : 'a -> int -> 'a meth
+  method replaceItem : 'a -> int -> 'a meth
 
-    method removeItem : int -> 'a meth
+  method removeItem : int -> 'a meth
 
-    method appendItem : 'a -> 'a meth
-  end
+  method appendItem : 'a -> 'a meth
+end
 
 (****)
 
 (* interface SVGElement *)
-class type element =
-  object
-    inherit Dom.element
+class type element = object
+  inherit Dom.element
 
-    method id : js_string t prop
+  method id : js_string t prop
 
-    method xmlbase : js_string t prop
+  method xmlbase : js_string t prop
 
-    method ownerSVGElement : svgElement t readonly_prop
+  method ownerSVGElement : svgElement t readonly_prop
 
-    method viewportElement : element t readonly_prop
-  end
+  method viewportElement : element t readonly_prop
+end
 
 (* interface SVGAnimatedString *)
 and animatedString = [js_string t] animated
@@ -230,20 +226,19 @@ and numberList = [number t] list
 and animatedNumberList = [numberList t] animated
 
 (* interface SVGLength *)
-and length =
-  object
-    method unitType : lengthUnitType readonly_prop
+and length = object
+  method unitType : lengthUnitType readonly_prop
 
-    method value : number t prop
+  method value : number t prop
 
-    method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number t prop
 
-    method valueAsString : js_string t prop
+  method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
 
-    method convertToSpecifiedUnits : lengthUnitType -> unit meth
-  end
+  method convertToSpecifiedUnits : lengthUnitType -> unit meth
+end
 
 (* interface SVGAnimatedLength *)
 and animatedLength = [length t] animated
@@ -255,20 +250,19 @@ and lengthList = [length t] list
 and animatedLengthList = [lengthList t] animated
 
 (* interface SVGAngle *)
-and angle =
-  object
-    method unitType : angleUnitType readonly_prop
+and angle = object
+  method unitType : angleUnitType readonly_prop
 
-    method value : number t prop
+  method value : number t prop
 
-    method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number t prop
 
-    method valueAsString : js_string t prop
+  method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
 
-    method convertToSpecifiedUnits : angleUnitType -> unit meth
-  end
+  method convertToSpecifiedUnits : angleUnitType -> unit meth
+end
 
 (* interface SVGAnimatedAngle *)
 and animatedAngle = [angle t] animated
@@ -277,1035 +271,979 @@ and animatedAngle = [angle t] animated
 and rgbColor = object end
 
 (* interface SVGColor *)
-and color =
-  object
-    (* XXX inherit cssValue *)
-    method colorType : colorType readonly_prop
+and color = object
+  (* XXX inherit cssValue *)
+  method colorType : colorType readonly_prop
 
-    method rgbColor : rgbColor t readonly_prop
+  method rgbColor : rgbColor t readonly_prop
 
-    method iccColor : iccColor t readonly_prop
+  method iccColor : iccColor t readonly_prop
 
-    method setRGBColor : js_string t -> unit meth
+  method setRGBColor : js_string t -> unit meth
 
-    method setRGBColorICCColor : js_string t -> js_string t -> unit meth
+  method setRGBColorICCColor : js_string t -> js_string t -> unit meth
 
-    method setColor : colorType -> js_string t -> js_string t -> unit meth
-  end
+  method setColor : colorType -> js_string t -> js_string t -> unit meth
+end
 
 (* interface SVGICCColor *)
-and iccColor =
-  object
-    method colorProfile : js_string t prop
+and iccColor = object
+  method colorProfile : js_string t prop
 
-    method colors : numberList t readonly_prop
-  end
+  method colors : numberList t readonly_prop
+end
 
 (* interface SVGRect *)
-and rect =
-  object
-    method x : number t prop
+and rect = object
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method width : number t prop
+  method width : number t prop
 
-    method height : number t prop
-  end
+  method height : number t prop
+end
 
 (* interface SVGAnimatedRect *)
 and animatedRect = [rect t] animated
 
 (* interface SVGStylable *)
-and stylable =
-  object
-    method className : animatedString t readonly_prop
+and stylable = object
+  method className : animatedString t readonly_prop
 
-    method style : Dom_html.cssStyleDeclaration t readonly_prop
-    (*   CSSValue getPresentationAttribute(in DOMString name); *)
-  end
+  method style : Dom_html.cssStyleDeclaration t readonly_prop
+  (*   CSSValue getPresentationAttribute(in DOMString name); *)
+end
 
 (* interface SVGLocatable *)
-and locatable =
-  object
-    method nearestViewportElement : element t readonly_prop
+and locatable = object
+  method nearestViewportElement : element t readonly_prop
 
-    method farthestViewportElement : element t readonly_prop
+  method farthestViewportElement : element t readonly_prop
 
-    method getBBox : rect t meth
+  method getBBox : rect t meth
 
-    method getCTM : matrix t meth
+  method getCTM : matrix t meth
 
-    method getScreenCTM : matrix t meth
+  method getScreenCTM : matrix t meth
 
-    method getTransformToElement : element t -> matrix t meth
-  end
+  method getTransformToElement : element t -> matrix t meth
+end
 
 (* interface SVGTransformable *)
-and transformable =
-  object
-    inherit locatable
+and transformable = object
+  inherit locatable
 
-    method transform : animatedTransformList t readonly_prop
-  end
+  method transform : animatedTransformList t readonly_prop
+end
 
 (* interface SVGTests *)
-and tests =
-  object
-    method requiredFeatures : stringList t readonly_prop
+and tests = object
+  method requiredFeatures : stringList t readonly_prop
 
-    method requiredExtensions : stringList t readonly_prop
+  method requiredExtensions : stringList t readonly_prop
 
-    method systemLanguage : stringList t readonly_prop
+  method systemLanguage : stringList t readonly_prop
 
-    method hasExtension : js_string t -> bool t meth
-  end
+  method hasExtension : js_string t -> bool t meth
+end
 
 (* interface SVGLangSpace *)
-and langSpace =
-  object
-    method xmllang : js_string t prop
+and langSpace = object
+  method xmllang : js_string t prop
 
-    method xmlspace : js_string t prop
-  end
+  method xmlspace : js_string t prop
+end
 
 (* interface SVGExternalResourcesRequired *)
-and externalResourcesRequired =
-  object
-    method externalResourcesRequired : animatedBoolean t readonly_prop
-  end
+and externalResourcesRequired = object
+  method externalResourcesRequired : animatedBoolean t readonly_prop
+end
 
 (* interface SVGFitToViewBox *)
-and fitToViewBox =
-  object
-    method viewBox : animatedRect t readonly_prop
+and fitToViewBox = object
+  method viewBox : animatedRect t readonly_prop
 
-    method preserveAspectRatio : animatedPreserveAspectRatio t readonly_prop
-  end
+  method preserveAspectRatio : animatedPreserveAspectRatio t readonly_prop
+end
 
 (* interface SVGZoomAndPan *)
-and zoomAndPan =
-  object
-    method zoomAndPan : zoomAndPanType prop
-  end
+and zoomAndPan = object
+  method zoomAndPan : zoomAndPanType prop
+end
 
 (* interface SVGViewSpec *)
-and viewSpec =
-  object
-    inherit zoomAndPan
+and viewSpec = object
+  inherit zoomAndPan
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    method transform : transformList t readonly_prop
+  method transform : transformList t readonly_prop
 
-    method viewTarget : element t readonly_prop
+  method viewTarget : element t readonly_prop
 
-    method viewBoxString : js_string t readonly_prop
+  method viewBoxString : js_string t readonly_prop
 
-    method preserveAspectRatioString : js_string t readonly_prop
+  method preserveAspectRatioString : js_string t readonly_prop
 
-    method transformString : js_string t readonly_prop
+  method transformString : js_string t readonly_prop
 
-    method viewTargetString : js_string t readonly_prop
-  end
+  method viewTargetString : js_string t readonly_prop
+end
 
 (* interface SVGURIReference *)
-and uriReference =
-  object
-    method href : animatedString t readonly_prop
-  end
+and uriReference = object
+  method href : animatedString t readonly_prop
+end
 
 (* interface SVGCSSRule : CSSRule *)
 (*   const unsigned short COLOR_PROFILE_RULE = 7; *)
 (* }; *)
 
 (* interface SVGDocument *)
-and document =
-  object
-    inherit [element] Dom.document
+and document = object
+  inherit [element] Dom.document
 
-    (*XXX inherit documentEvent *)
-    method title : js_string t prop
+  (*XXX inherit documentEvent *)
+  method title : js_string t prop
 
-    method referrer : js_string t readonly_prop
+  method referrer : js_string t readonly_prop
 
-    method domain : js_string t prop
+  method domain : js_string t prop
 
-    method _URL : js_string t readonly_prop
+  method _URL : js_string t readonly_prop
 
-    method rootElement : svgElement t opt readonly_prop
-    (* rootElement will be null or undefined in an html context *)
-  end
+  method rootElement : svgElement t opt readonly_prop
+  (* rootElement will be null or undefined in an html context *)
+end
 
 (* interface SVGSVGElement *)
-and svgElement =
-  object
-    inherit element
+and svgElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit locatable
+  inherit locatable
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    inherit zoomAndPan
+  inherit zoomAndPan
 
-    (*XXX inherit documentevent, viewcss, documentcss *)
-    method x : animatedLength t readonly_prop
+  (*XXX inherit documentevent, viewcss, documentcss *)
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method contentScriptType : js_string t prop
+  method contentScriptType : js_string t prop
 
-    method contentStyleType : js_string t prop
+  method contentStyleType : js_string t prop
 
-    method viewport : rect t readonly_prop
+  method viewport : rect t readonly_prop
 
-    method pixelUnitToMillimeterX : number t readonly_prop
+  method pixelUnitToMillimeterX : number t readonly_prop
 
-    method pixelUnitToMillimeterY : number t readonly_prop
+  method pixelUnitToMillimeterY : number t readonly_prop
 
-    method screenPixelUnitToMillimeterX : number t readonly_prop
+  method screenPixelUnitToMillimeterX : number t readonly_prop
 
-    method screenPixelUnitToMillimeterY : number t readonly_prop
+  method screenPixelUnitToMillimeterY : number t readonly_prop
 
-    method useCurrentView : bool t readonly_prop
+  method useCurrentView : bool t readonly_prop
 
-    method currentView : viewSpec t readonly_prop
+  method currentView : viewSpec t readonly_prop
 
-    method currentScale : number t prop
+  method currentScale : number t prop
 
-    method currentTranslate : point t readonly_prop
+  method currentTranslate : point t readonly_prop
 
-    method suspendRedraw : int -> suspendHandleID meth
+  method suspendRedraw : int -> suspendHandleID meth
 
-    method unsuspendRedraw : suspendHandleID -> unit meth
+  method unsuspendRedraw : suspendHandleID -> unit meth
 
-    method unsuspendRedrawAll : unit meth
+  method unsuspendRedrawAll : unit meth
 
-    method forceRedraw : unit meth
+  method forceRedraw : unit meth
 
-    method pauseAnimations : unit meth
+  method pauseAnimations : unit meth
 
-    method unpauseAnimations : unit meth
+  method unpauseAnimations : unit meth
 
-    method animationsPaused : bool t meth
+  method animationsPaused : bool t meth
 
-    method getCurrentTime : number t meth
+  method getCurrentTime : number t meth
 
-    method setCurrentTime : int -> unit meth
+  method setCurrentTime : int -> unit meth
 
-    method getIntersectionList : rect t -> element t -> element Dom.nodeList t meth
+  method getIntersectionList : rect t -> element t -> element Dom.nodeList t meth
 
-    method getEnclosureList : rect t -> element t -> element Dom.nodeList t meth
+  method getEnclosureList : rect t -> element t -> element Dom.nodeList t meth
 
-    method checkIntersection : element t -> rect t -> bool t
+  method checkIntersection : element t -> rect t -> bool t
 
-    method checkEnclosure : element t -> rect t -> bool t
+  method checkEnclosure : element t -> rect t -> bool t
 
-    method deselectAll : unit meth
+  method deselectAll : unit meth
 
-    method createSVGNumber : number t meth
+  method createSVGNumber : number t meth
 
-    method createSVGLength : length t meth
+  method createSVGLength : length t meth
 
-    method createSVGAngle : angle t meth
+  method createSVGAngle : angle t meth
 
-    method createSVGPoint : point t meth
+  method createSVGPoint : point t meth
 
-    method createSVGMatrix : matrix t meth
+  method createSVGMatrix : matrix t meth
 
-    method createSVGRect : rect t meth
+  method createSVGRect : rect t meth
 
-    method createSVGTransform : transform t meth
+  method createSVGTransform : transform t meth
 
-    method createSVGTransformFromMatrix : matrix t -> transform t meth
+  method createSVGTransformFromMatrix : matrix t -> transform t meth
 
-    method getElementById : js_string t -> Dom.element t meth
-  end
+  method getElementById : js_string t -> Dom.element t meth
+end
 
 (* interface SVGGElement *)
-and gElement =
-  object
-    inherit element
+and gElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit Dom_html.eventTarget
-  end
+  inherit Dom_html.eventTarget
+end
 
 (* interface SVGDefsElement *)
-and defsElement =
-  object
-    inherit element
+and defsElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
-    (* XXXXXXX ? inherit Dom_html.eventTarget *)
-  end
+  inherit transformable
+  (* XXXXXXX ? inherit Dom_html.eventTarget *)
+end
 
 (* interface SVGDescElement *)
-and descElement =
-  object
-    inherit element
+and descElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit stylable
-    (* XXXXXXX ? inherit Dom_html.eventTarget *)
-  end
+  inherit stylable
+  (* XXXXXXX ? inherit Dom_html.eventTarget *)
+end
 
 (* interface SVGTitleElement *)
-and titleElement =
-  object
-    inherit element
+and titleElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGSymbolElement *)
-and symbolElement =
-  object
-    inherit element
+and symbolElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    inherit Dom_html.eventTarget
-  end
+  inherit Dom_html.eventTarget
+end
 
 (* interface SVGUseElement *)
-and useElement =
-  object
-    inherit element
+and useElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method instanceRoot : elementInstance t readonly_prop
+  method instanceRoot : elementInstance t readonly_prop
 
-    method animatedInstanceRoot : elementInstance t readonly_prop
-  end
+  method animatedInstanceRoot : elementInstance t readonly_prop
+end
 
-and elementInstance =
-  object
-    inherit Dom_html.eventTarget
+and elementInstance = object
+  inherit Dom_html.eventTarget
 
-    method correspondingElement : element t readonly_prop
+  method correspondingElement : element t readonly_prop
 
-    method correspondingUseElement : useElement t readonly_prop
+  method correspondingUseElement : useElement t readonly_prop
 
-    method parentNode : elementInstance t readonly_prop
+  method parentNode : elementInstance t readonly_prop
 
-    method childNodes : elementInstanceList t readonly_prop
+  method childNodes : elementInstanceList t readonly_prop
 
-    method firstChild : elementInstance t readonly_prop
+  method firstChild : elementInstance t readonly_prop
 
-    method lastChild : elementInstance t readonly_prop
+  method lastChild : elementInstance t readonly_prop
 
-    method previousSibling : elementInstance t readonly_prop
+  method previousSibling : elementInstance t readonly_prop
 
-    method nextSibling : elementInstance t readonly_prop
-  end
+  method nextSibling : elementInstance t readonly_prop
+end
 
 (* interface SVGElementInstanceList *)
-and elementInstanceList =
-  object
-    method length : int readonly_prop
+and elementInstanceList = object
+  method length : int readonly_prop
 
-    method item : int -> elementInstance t
-  end
+  method item : int -> elementInstance t
+end
 
 (* interface SVGImageElement *)
-and imageElement =
-  object
-    inherit element
+and imageElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-    (* readonly attribute SVGAnimatedPreserveAspectRatio preserveAspectRatio *)
-  end
+  method height : animatedLength t readonly_prop
+  (* readonly attribute SVGAnimatedPreserveAspectRatio preserveAspectRatio *)
+end
 
-and switchElement =
-  object
-    inherit element
+and switchElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
-  end
+  inherit transformable
+end
 
 (* XXX deprecated => interface GetSVGDocument => SVGDocument getSVGDocument() *)
 
 (* interface SVGStyleElement *)
-and styleElement =
-  object
-    inherit element
+and styleElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    method type_ : js_string t prop
+  method type_ : js_string t prop
 
-    method media : js_string t prop
+  method media : js_string t prop
 
-    method title : js_string t prop
-  end
+  method title : js_string t prop
+end
 
 (* interface SVGPoint *)
-and point =
-  object
-    method x : number t readonly_prop
+and point = object
+  method x : number t readonly_prop
 
-    method y : number t readonly_prop
+  method y : number t readonly_prop
 
-    method matrixTransform : matrix t -> point t meth
-  end
+  method matrixTransform : matrix t -> point t meth
+end
 
 (* interface SVGPointList *)
 and pointList = [point t] list
 
 (* interface SVGMatrix *)
-and matrix =
-  object
-    method a : number t readonly_prop
+and matrix = object
+  method a : number t readonly_prop
 
-    method b : number t readonly_prop
+  method b : number t readonly_prop
 
-    method c : number t readonly_prop
+  method c : number t readonly_prop
 
-    method d : number t readonly_prop
+  method d : number t readonly_prop
 
-    method e : number t readonly_prop
+  method e : number t readonly_prop
 
-    method f : number t readonly_prop
+  method f : number t readonly_prop
 
-    method multiply : matrix t -> matrix t meth
+  method multiply : matrix t -> matrix t meth
 
-    method inverse : matrix t meth
+  method inverse : matrix t meth
 
-    method translate : number t -> number t -> matrix t meth
+  method translate : number t -> number t -> matrix t meth
 
-    method scale : number t -> matrix t meth
+  method scale : number t -> matrix t meth
 
-    method scaleNonUniform : number t -> number t -> matrix t meth
+  method scaleNonUniform : number t -> number t -> matrix t meth
 
-    method rotate : number t -> matrix t meth
+  method rotate : number t -> matrix t meth
 
-    method rotateFromVector : number t -> number t -> matrix t meth
+  method rotateFromVector : number t -> number t -> matrix t meth
 
-    method flipX : matrix t meth
+  method flipX : matrix t meth
 
-    method flipY : matrix t meth
+  method flipY : matrix t meth
 
-    method skewX : number t -> matrix t meth
+  method skewX : number t -> matrix t meth
 
-    method skewY : number t -> matrix t meth
-  end
+  method skewY : number t -> matrix t meth
+end
 
 (* interface SVGTransform *)
-and transform =
-  object
-    method _type : transformType readonly_prop
+and transform = object
+  method _type : transformType readonly_prop
 
-    method matrix : matrix t readonly_prop
+  method matrix : matrix t readonly_prop
 
-    method angle : number t readonly_prop
+  method angle : number t readonly_prop
 
-    method setMatrix : matrix t -> unit meth
+  method setMatrix : matrix t -> unit meth
 
-    method setTranslate : number t -> number t -> unit meth
+  method setTranslate : number t -> number t -> unit meth
 
-    method setScale : number t -> number t -> unit meth
+  method setScale : number t -> number t -> unit meth
 
-    method setRotate : number t -> number t -> number t -> unit meth
+  method setRotate : number t -> number t -> number t -> unit meth
 
-    method setSkewX : number t -> unit meth
+  method setSkewX : number t -> unit meth
 
-    method setSkewY : number t -> unit meth
-  end
+  method setSkewY : number t -> unit meth
+end
 
 (* interface SVGTransformList *)
-and transformList =
-  object
-    inherit [transform t] list
+and transformList = object
+  inherit [transform t] list
 
-    method createSVGTransformFromMatrix : matrix -> transform t meth
+  method createSVGTransformFromMatrix : matrix -> transform t meth
 
-    method consolidate : transform t meth
-  end
+  method consolidate : transform t meth
+end
 
 (* interface SVGAnimatedTransformList *)
 and animatedTransformList = [transformList t] animated
 
 (* interface SVGPreserveAspectRatio *)
-and preserveAspectRatio =
-  object
-    method align : alignmentType readonly_prop
+and preserveAspectRatio = object
+  method align : alignmentType readonly_prop
 
-    method meetOrSlice : meetOrSliceType readonly_prop
-  end
+  method meetOrSlice : meetOrSliceType readonly_prop
+end
 
 (* interface SVGAnimatedPreserveAspectRatio *)
 and animatedPreserveAspectRatio = [preserveAspectRatio t] animated
 
 (* interface SVGPathSeg *)
-and pathSeg =
-  object
-    method pathSegType : pathSegmentType readonly_prop
+and pathSeg = object
+  method pathSegType : pathSegmentType readonly_prop
 
-    method pathSegTypeAsLetter : js_string t readonly_prop
-  end
+  method pathSegTypeAsLetter : js_string t readonly_prop
+end
 
 (* interface SVGPathSegClosePath *)
 and pathSegClosePath = pathSeg
 
 (* interface SVGPathSegMovetoAbs *)
 (* interface SVGPathSegMovetoRel *)
-and pathSegMoveto =
-  object
-    inherit pathSeg
+and pathSegMoveto = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
-  end
+  method y : number t prop
+end
 
 (* interface SVGPathSegLinetoAbs *)
 (* interface SVGPathSegLinetoRel *)
-and pathSegLineto =
-  object
-    inherit pathSeg
+and pathSegLineto = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
-  end
+  method y : number t prop
+end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
 (* interface SVGPathSegCurvetoCubicRel *)
-and pathSegCurvetoCubic =
-  object
-    inherit pathSeg
+and pathSegCurvetoCubic = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method x1 : number t prop
+  method x1 : number t prop
 
-    method y1 : number t prop
+  method y1 : number t prop
 
-    method x2 : number t prop
+  method x2 : number t prop
 
-    method y2 : number t prop
-  end
+  method y2 : number t prop
+end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
 (* interface SVGPathSegCurvetoQuadraticRel *)
-and pathSegCurvetoQuadratic =
-  object
-    inherit pathSeg
+and pathSegCurvetoQuadratic = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method x1 : number t prop
+  method x1 : number t prop
 
-    method y1 : number t prop
-  end
+  method y1 : number t prop
+end
 
 (* interface SVGPathSegArcAbs *)
 (* interface SVGPathSegArcRel*)
-and pathSegArc =
-  object
-    inherit pathSeg
+and pathSegArc = object
+  inherit pathSeg
 
-    method y : number t prop
+  method y : number t prop
 
-    method r1 : number t prop
+  method r1 : number t prop
 
-    method r2 : number t prop
+  method r2 : number t prop
 
-    method angle : number t prop
+  method angle : number t prop
 
-    method largeArcFlag : bool t prop
+  method largeArcFlag : bool t prop
 
-    method sweepFlag : bool t prop
-  end
+  method sweepFlag : bool t prop
+end
 
 (* interface SVGPathSegLinetoHorizontalAbs *)
 (* interface SVGPathSegLinetoHorizontalRel *)
-and pathSegLinetoHorizontal =
-  object
-    inherit pathSeg
+and pathSegLinetoHorizontal = object
+  inherit pathSeg
 
-    method x : number t
-  end
+  method x : number t
+end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
 (* interface SVGPathSegLinetoVerticalRel *)
-and pathSegLinetoVertical =
-  object
-    inherit pathSeg
+and pathSegLinetoVertical = object
+  inherit pathSeg
 
-    method y : number t
-  end
+  method y : number t
+end
 
-and pathSegCurvetoCubicSmooth =
-  object
-    inherit pathSeg
+and pathSegCurvetoCubicSmooth = object
+  inherit pathSeg
 
-    method x : number t
+  method x : number t
 
-    method y : number t
+  method y : number t
 
-    method x2 : number t
+  method x2 : number t
 
-    method y2 : number t
-  end
+  method y2 : number t
+end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
 (* interface SVGPathSegCurvetoQuadraticSmoothRel  *)
-and pathSegCurvetoQuadraticSmooth =
-  object
-    inherit pathSeg
+and pathSegCurvetoQuadraticSmooth = object
+  inherit pathSeg
 
-    method x : number t
+  method x : number t
 
-    method y : number t
-  end
+  method y : number t
+end
 
 and pathSegList = [pathSeg t] list
 
 (* interface SVGAnimatedPathData *)
-and animatedPathData =
-  object
-    method pathSegList : pathSegList t prop
+and animatedPathData = object
+  method pathSegList : pathSegList t prop
 
-    method normalizedPathSegList : pathSegList t prop
+  method normalizedPathSegList : pathSegList t prop
 
-    method animatedPathSegList : pathSegList t prop
+  method animatedPathSegList : pathSegList t prop
 
-    method animatedNormalizedPathSegList : pathSegList t prop
-  end
+  method animatedNormalizedPathSegList : pathSegList t prop
+end
 
 (* interface SVGPathElement *)
-and pathElement =
-  object
-    inherit element
+and pathElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit animatedPathData
+  inherit animatedPathData
 
-    method pathLength : animatedNumber t readonly_prop
+  method pathLength : animatedNumber t readonly_prop
 
-    method getTotalLength : number t meth
+  method getTotalLength : number t meth
 
-    method getPointAtLength : number t -> point t meth
+  method getPointAtLength : number t -> point t meth
 
-    method getPathSegAtLength : number t -> int
+  method getPathSegAtLength : number t -> int
 
-    method createSVGPathSegClosePath : pathSegClosePath meth
+  method createSVGPathSegClosePath : pathSegClosePath meth
 
-    method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
 
-    method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
 
-    method createSVGPathSegCurvetoCubicAbs :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> pathSegCurvetoCubic meth
+  method createSVGPathSegCurvetoCubicAbs :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> pathSegCurvetoCubic meth
 
-    method createSVGPathSegCurvetoCubicRel :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> pathSegCurvetoCubic meth
+  method createSVGPathSegCurvetoCubicRel :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> pathSegCurvetoCubic meth
 
-    method createSVGPathSegCurvetoQuadraticAbs :
-      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+  method createSVGPathSegCurvetoQuadraticAbs :
+    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
-    method createSVGPathSegCurvetoQuadraticRel :
-      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+  method createSVGPathSegCurvetoQuadraticRel :
+    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
-    method createSVGPathSegArcAbs :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> bool t
-      -> bool t
-      -> pathSegArc meth
+  method createSVGPathSegArcAbs :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> bool t
+    -> bool t
+    -> pathSegArc meth
 
-    method createSVGPathSegArcRel :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> bool t
-      -> bool t
-      -> pathSegArc meth
+  method createSVGPathSegArcRel :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> bool t
+    -> bool t
+    -> pathSegArc meth
 
-    method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegCurvetoCubicSmoothAbs :
-      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+  method createSVGPathSegCurvetoCubicSmoothAbs :
+    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
-    method createSVGPathSegCurvetoCubicSmoothRel :
-      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+  method createSVGPathSegCurvetoCubicSmoothRel :
+    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
-    method createSVGPathSegCurvetoQuadraticSmoothAbs :
-      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+  method createSVGPathSegCurvetoQuadraticSmoothAbs :
+    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
 
-    method createSVGPathSegCurvetoQuadraticSmoothRel :
-      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
-  end
+  method createSVGPathSegCurvetoQuadraticSmoothRel :
+    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+end
 
 (* interface SVGRectElement *)
-and rectElement =
-  object
-    inherit element
+and rectElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method rx : animatedLength t readonly_prop
+  method rx : animatedLength t readonly_prop
 
-    method ry : animatedLength t readonly_prop
-  end
+  method ry : animatedLength t readonly_prop
+end
 
 (* interface SVGCircleElement *)
-and circleElement =
-  object
-    inherit element
+and circleElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method cx : animatedLength t readonly_prop
+  method cx : animatedLength t readonly_prop
 
-    method cy : animatedLength t readonly_prop
+  method cy : animatedLength t readonly_prop
 
-    method r : animatedLength t readonly_prop
-  end
+  method r : animatedLength t readonly_prop
+end
 
 (* interface SVGEllipseElement *)
-and ellipseElement =
-  object
-    inherit element
+and ellipseElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method cx : animatedLength t readonly_prop
+  method cx : animatedLength t readonly_prop
 
-    method cy : animatedLength t readonly_prop
+  method cy : animatedLength t readonly_prop
 
-    method rx : animatedLength t readonly_prop
+  method rx : animatedLength t readonly_prop
 
-    method ry : animatedLength t readonly_prop
-  end
+  method ry : animatedLength t readonly_prop
+end
 
 (* interface SVGLineElement *)
-class type lineElement =
-  object
-    inherit element
+class type lineElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit Dom_html.eventTarget
+  inherit Dom_html.eventTarget
 
-    method x1 : animatedLength t readonly_prop
+  method x1 : animatedLength t readonly_prop
 
-    method y1 : animatedLength t readonly_prop
+  method y1 : animatedLength t readonly_prop
 
-    method x2 : animatedLength t readonly_prop
+  method x2 : animatedLength t readonly_prop
 
-    method y2 : animatedLength t readonly_prop
-  end
+  method y2 : animatedLength t readonly_prop
+end
 
 (* interface SVGAnimatedPoints *)
-and animatedPoints =
-  object
-    method points : pointList t readonly_prop
+and animatedPoints = object
+  method points : pointList t readonly_prop
 
-    method animatedpoints : pointList t readonly_prop
-  end
+  method animatedpoints : pointList t readonly_prop
+end
 
 (* interface SVGPolylineElement *)
-and polyLineElement =
-  object
-    inherit element
+and polyLineElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit animatedPoints
-  end
+  inherit animatedPoints
+end
 
 (* interface SVGPolygonElement *)
-and polygonElement =
-  object
-    inherit element
+and polygonElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit animatedPoints
-  end
+  inherit animatedPoints
+end
 
 (* interface SVGTextContentElement *)
-and textContentElement =
-  object
-    inherit element
+and textContentElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit Dom_html.eventTarget
+  inherit Dom_html.eventTarget
 
-    method textLength : animatedLength t readonly_prop
+  method textLength : animatedLength t readonly_prop
 
-    method lengthAdjust : lengthAdjust animated t readonly_prop
+  method lengthAdjust : lengthAdjust animated t readonly_prop
 
-    method getNumberOfChars : int meth
+  method getNumberOfChars : int meth
 
-    method getComputedTextLength : number t meth
+  method getComputedTextLength : number t meth
 
-    method getSubStringLength : int -> int -> number t meth
+  method getSubStringLength : int -> int -> number t meth
 
-    method getStartPositionOfChar : int -> point t meth
+  method getStartPositionOfChar : int -> point t meth
 
-    method getEndPositionOfChar : int -> point t meth
+  method getEndPositionOfChar : int -> point t meth
 
-    method getExtentOfChar : int -> rect t meth
+  method getExtentOfChar : int -> rect t meth
 
-    method getRotationOfChar : int -> number t meth
+  method getRotationOfChar : int -> number t meth
 
-    method getCharNumAtPosition : point -> int meth
+  method getCharNumAtPosition : point -> int meth
 
-    method selectSubString : int -> int -> unit meth
-  end
+  method selectSubString : int -> int -> unit meth
+end
 
 (* interface SVGTextPositioningElement *)
-and textPositioningElement =
-  object
-    inherit textContentElement
+and textPositioningElement = object
+  inherit textContentElement
 
-    method x : animatedLengthList t readonly_prop
+  method x : animatedLengthList t readonly_prop
 
-    method y : animatedLengthList t readonly_prop
+  method y : animatedLengthList t readonly_prop
 
-    method dx : animatedLengthList t readonly_prop
+  method dx : animatedLengthList t readonly_prop
 
-    method dy : animatedLengthList t readonly_prop
+  method dy : animatedLengthList t readonly_prop
 
-    method rotate : animatedNumberList t readonly_prop
-  end
+  method rotate : animatedNumberList t readonly_prop
+end
 
 (* interface SVGTextElement *)
-and textElement =
-  object
-    inherit textPositioningElement
+and textElement = object
+  inherit textPositioningElement
 
-    inherit transformable
-  end
+  inherit transformable
+end
 
 and tspanElement = textPositioningElement
 
-and trefElement =
-  object
-    inherit textPositioningElement
+and trefElement = object
+  inherit textPositioningElement
 
-    inherit uriReference
-  end
+  inherit uriReference
+end
 
 (* interface SVGTextPathElement *)
 and textPathElementMethod = [textPathMethodType] animated
 
 and textPathElementSpacing = [textPathSpacingType] animated
 
-and textPathElement =
-  object
-    inherit textContentElement
+and textPathElement = object
+  inherit textContentElement
 
-    inherit uriReference
+  inherit uriReference
 
-    method startOffset : animatedLength t readonly_prop
+  method startOffset : animatedLength t readonly_prop
 
-    method method_ : textPathElementMethod readonly_prop
+  method method_ : textPathElementMethod readonly_prop
 
-    method spacing : textPathElementSpacing readonly_prop
-  end
+  method spacing : textPathElementSpacing readonly_prop
+end
 
 (* interface SVGAltGlyphElement *)
-and altGlyphElement =
-  object
-    inherit textPositioningElement
+and altGlyphElement = object
+  inherit textPositioningElement
 
-    inherit uriReference
+  inherit uriReference
 
-    method glyphRef : js_string t prop
+  method glyphRef : js_string t prop
 
-    method format : js_string t prop
-  end
+  method format : js_string t prop
+end
 
 (* interface SVGAltGlyphDefElement *)
 and altGlyphDefElement = element
@@ -1314,26 +1252,25 @@ and altGlyphDefElement = element
 and altGlyphItemElement = element
 
 (* interface SVGGlyphRefElement *)
-and glyphRefElement =
-  object
-    inherit element
+and glyphRefElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit stylable
+  inherit stylable
 
-    method glyphRef : js_string t prop
+  method glyphRef : js_string t prop
 
-    method format : js_string t prop
+  method format : js_string t prop
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method dx : number t prop
+  method dx : number t prop
 
-    method dy : number t prop
-  end
+  method dy : number t prop
+end
 
 (* interface SVGPaint : SVGColor { *)
 
@@ -1402,160 +1339,152 @@ and glyphRefElement =
 (* interface SVGGradientElement *)
 and animatedSpreadMethod = [spreadMethodType] animated
 
-and gradientElement =
-  object
-    inherit element
+and gradientElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit stylable
+  inherit stylable
 
-    (*   readonly attribute SVGAnimatedEnumeration gradientUnits; *)
-    method gradientTransform : animatedTransformList t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration gradientUnits; *)
+  method gradientTransform : animatedTransformList t readonly_prop
 
-    method spreadMethod : animatedSpreadMethod t readonly_prop
-  end
+  method spreadMethod : animatedSpreadMethod t readonly_prop
+end
 
 (* interface SVGLinearGradientElement *)
-and linearGradientElement =
-  object
-    inherit gradientElement
+and linearGradientElement = object
+  inherit gradientElement
 
-    method x1 : animatedLength t readonly_prop
+  method x1 : animatedLength t readonly_prop
 
-    method y1 : animatedLength t readonly_prop
+  method y1 : animatedLength t readonly_prop
 
-    method x2 : animatedLength t readonly_prop
+  method x2 : animatedLength t readonly_prop
 
-    method y2 : animatedLength t readonly_prop
-  end
+  method y2 : animatedLength t readonly_prop
+end
 
 (* interface SVGRadialGradientElement *)
-and radialGradientElement =
-  object
-    inherit gradientElement
+and radialGradientElement = object
+  inherit gradientElement
 
-    method cx : animatedLength t readonly_prop
+  method cx : animatedLength t readonly_prop
 
-    method cy : animatedLength t readonly_prop
+  method cy : animatedLength t readonly_prop
 
-    method r : animatedLength t readonly_prop
+  method r : animatedLength t readonly_prop
 
-    method fx : animatedLength t readonly_prop
+  method fx : animatedLength t readonly_prop
 
-    method fy : animatedLength t readonly_prop
-  end
+  method fy : animatedLength t readonly_prop
+end
 
 (* interface SVGStopElement *)
-and stopElement =
-  object
-    inherit element
+and stopElement = object
+  inherit element
 
-    inherit stylable
+  inherit stylable
 
-    method offset : animatedNumber t readonly_prop
-  end
+  method offset : animatedNumber t readonly_prop
+end
 
 (* interface SVGPatternElement *)
-and patternElement =
-  object
-    inherit element
+and patternElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    (*   readonly attribute SVGAnimatedEnumeration patternUnits; *)
-    (*   readonly attribute SVGAnimatedEnumeration patternContentUnits; *)
-    method patternTransform : animatedTransformList t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration patternUnits; *)
+  (*   readonly attribute SVGAnimatedEnumeration patternContentUnits; *)
+  method patternTransform : animatedTransformList t readonly_prop
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-  end
+  method height : animatedLength t readonly_prop
+end
 
 (* interface SVGClipPathElement *)
-and clipPathElement =
-  object
-    inherit element
+and clipPathElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
-    (*   readonly attribute SVGAnimatedEnumeration clipPathUnits; *)
-  end
+  inherit transformable
+  (*   readonly attribute SVGAnimatedEnumeration clipPathUnits; *)
+end
 
 (* interface SVGMaskElement *)
-and maskElement =
-  object
-    inherit element
+and maskElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    (*   readonly attribute SVGAnimatedEnumeration maskUnits; *)
-    (*   readonly attribute SVGAnimatedEnumeration maskContentUnits; *)
-    method x : animatedLength t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration maskUnits; *)
+  (*   readonly attribute SVGAnimatedEnumeration maskContentUnits; *)
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-  end
+  method height : animatedLength t readonly_prop
+end
 
 (* interface SVGFilterElement *)
-and filterElement =
-  object
-    inherit element
+and filterElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    (*   readonly attribute SVGAnimatedEnumeration filterUnits; *)
-    (*   readonly attribute SVGAnimatedEnumeration primitiveUnits; *)
-    method x : animatedLength t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration filterUnits; *)
+  (*   readonly attribute SVGAnimatedEnumeration primitiveUnits; *)
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method filterResX : animatedInteger t readonly_prop
+  method filterResX : animatedInteger t readonly_prop
 
-    method filterResY : animatedInteger t readonly_prop
+  method filterResY : animatedInteger t readonly_prop
 
-    method setFilterRes : int -> int -> unit meth
-  end
+  method setFilterRes : int -> int -> unit meth
+end
 
 (* interface SVGFilterPrimitiveStandardAttributes : SVGStylable { *)
 (*   readonly attribute SVGAnimatedLength x; *)
@@ -1812,66 +1741,62 @@ and filterElement =
 (* }; *)
 
 (* interface SVGCursorElement *)
-and cursorElement =
-  object
-    inherit element
+and cursorElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
-  end
+  method y : animatedLength t readonly_prop
+end
 
 (* interface SVGAElement *)
-and aElement =
-  object
-    inherit element
+and aElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method target : animatedString t readonly_prop
-  end
+  method target : animatedString t readonly_prop
+end
 
 (* interface SVGViewElement *)
-and viewElement =
-  object
-    inherit element
+and viewElement = object
+  inherit element
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    inherit zoomAndPan
+  inherit zoomAndPan
 
-    method viewTarget : stringList t readonly_prop
-  end
+  method viewTarget : stringList t readonly_prop
+end
 
 (* interface SVGScriptElement *)
-and scriptElement =
-  object
-    inherit element
+and scriptElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    method type_ : js_string t prop
-  end
+  method type_ : js_string t prop
+end
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
@@ -1882,31 +1807,29 @@ and scriptElement =
 (* }; *)
 
 (* interface SVGAnimationElement *)
-and animationElement =
-  object
-    inherit element
+and animationElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    (* inherit elementTimeControl *)
-    method targetElement : element t readonly_prop
+  (* inherit elementTimeControl *)
+  method targetElement : element t readonly_prop
 
-    method getStartTime : number t meth
+  method getStartTime : number t meth
 
-    method getCurrentTime : number t meth
+  method getCurrentTime : number t meth
 
-    method getSimpleDuration : number t meth
-  end
+  method getSimpleDuration : number t meth
+end
 
 (* interface SVGAnimateElement *)
-and animateElement =
-  object
-    inherit animationElement
+and animateElement = object
+  inherit animationElement
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGSetElement *)
 and setElement = animationElement
@@ -1915,42 +1838,38 @@ and setElement = animationElement
 and animateMotionElement = animationElement
 
 (* interface SVGMPathElement *)
-and mPathElement =
-  object
-    inherit element
+and mPathElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit externalResourcesRequired
-  end
+  inherit externalResourcesRequired
+end
 
 (* interface SVGAnimateColorElement *)
-and animateColorElement =
-  object
-    inherit animationElement
+and animateColorElement = object
+  inherit animationElement
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGAnimateTransformElement *)
 and animateTransformElement = animationElement
 
 (* interface SVGFontElement *)
-and fontElement =
-  object
-    inherit element
+and fontElement = object
+  inherit element
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGGlyphElement *)
 (* interface SVGMissingGlyphElement*)
-and glyphElement =
-  object
-    inherit element
+and glyphElement = object
+  inherit element
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGHKernElement : SVGElement *)
 (* interface SVGVKernElement : SVGElement *)
@@ -1974,28 +1893,27 @@ class type fontFaceNameElement = element
 class type metadataElement = element
 
 (* interface SVGForeignObjectElement *)
-class type foreignObjectElement =
-  object
-    inherit element
+class type foreignObjectElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-  end
+  method height : animatedLength t readonly_prop
+end
 
 let createElement (doc : document t) name = doc##createElementNS xmlns (Js.string name)
 
diff --git a/lib/js_of_ocaml/dom_svg.mli b/lib/js_of_ocaml/dom_svg.mli
index 24ce259f2b..105edba0b8 100644
--- a/lib/js_of_ocaml/dom_svg.mli
+++ b/lib/js_of_ocaml/dom_svg.mli
@@ -33,12 +33,11 @@ type error_code =
   | INVALID_VALUE_ERR
   | MATRIX_NOT_INVERTABLE
 
-class type svg_error =
-  object
-    inherit Js.error
+class type svg_error = object
+  inherit Js.error
 
-    method code : error_code t readonly_prop
-  end
+  method code : error_code t readonly_prop
+end
 
 exception SVGError of svg_error
 
@@ -165,48 +164,45 @@ type suspendHandleID
 
 (****)
 
-class type ['a] animated =
-  object
-    method baseVal : 'a prop
+class type ['a] animated = object
+  method baseVal : 'a prop
 
-    method animVal : 'a prop
-  end
+  method animVal : 'a prop
+end
 
-class type ['a] list =
-  object
-    method numberOfItems : int readonly_prop
+class type ['a] list = object
+  method numberOfItems : int readonly_prop
 
-    method clear : unit meth
+  method clear : unit meth
 
-    method initialize : 'a -> 'a meth
+  method initialize : 'a -> 'a meth
 
-    method getItem : int -> 'a meth
+  method getItem : int -> 'a meth
 
-    method insertItemBefore : 'a -> int -> 'a meth
+  method insertItemBefore : 'a -> int -> 'a meth
 
-    method replaceItem : 'a -> int -> 'a meth
+  method replaceItem : 'a -> int -> 'a meth
 
-    method removeItem : int -> 'a meth
+  method removeItem : int -> 'a meth
 
-    method appendItem : 'a -> 'a meth
-  end
+  method appendItem : 'a -> 'a meth
+end
 
 (****)
 (** {2 Elements } *)
 
 (* interface SVGElement *)
-class type element =
-  object
-    inherit Dom.element
+class type element = object
+  inherit Dom.element
 
-    method id : js_string t prop
+  method id : js_string t prop
 
-    method xmlbase : js_string t prop
+  method xmlbase : js_string t prop
 
-    method ownerSVGElement : svgElement t readonly_prop
+  method ownerSVGElement : svgElement t readonly_prop
 
-    method viewportElement : element t readonly_prop
-  end
+  method viewportElement : element t readonly_prop
+end
 
 (* interface SVGAnimatedString *)
 and animatedString = [js_string t] animated
@@ -233,20 +229,19 @@ and numberList = [number t] list
 and animatedNumberList = [numberList t] animated
 
 (* interface SVGLength *)
-and length =
-  object
-    method unitType : lengthUnitType readonly_prop
+and length = object
+  method unitType : lengthUnitType readonly_prop
 
-    method value : number t prop
+  method value : number t prop
 
-    method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number t prop
 
-    method valueAsString : js_string t prop
+  method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
 
-    method convertToSpecifiedUnits : lengthUnitType -> unit meth
-  end
+  method convertToSpecifiedUnits : lengthUnitType -> unit meth
+end
 
 (* interface SVGAnimatedLength *)
 and animatedLength = [length t] animated
@@ -258,20 +253,19 @@ and lengthList = [length t] list
 and animatedLengthList = [lengthList t] animated
 
 (* interface SVGAngle *)
-and angle =
-  object
-    method unitType : angleUnitType readonly_prop
+and angle = object
+  method unitType : angleUnitType readonly_prop
 
-    method value : number t prop
+  method value : number t prop
 
-    method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number t prop
 
-    method valueAsString : js_string t prop
+  method valueAsString : js_string t prop
 
-    method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
 
-    method convertToSpecifiedUnits : angleUnitType -> unit meth
-  end
+  method convertToSpecifiedUnits : angleUnitType -> unit meth
+end
 
 (* interface SVGAnimatedAngle *)
 and animatedAngle = [angle t] animated
@@ -280,1034 +274,978 @@ and animatedAngle = [angle t] animated
 and rgbColor = object end
 
 (* interface SVGColor *)
-and color =
-  object
-    (* XXX inherit cssValue *)
-    method colorType : colorType readonly_prop
+and color = object
+  (* XXX inherit cssValue *)
+  method colorType : colorType readonly_prop
 
-    method rgbColor : rgbColor t readonly_prop
+  method rgbColor : rgbColor t readonly_prop
 
-    method iccColor : iccColor t readonly_prop
+  method iccColor : iccColor t readonly_prop
 
-    method setRGBColor : js_string t -> unit meth
+  method setRGBColor : js_string t -> unit meth
 
-    method setRGBColorICCColor : js_string t -> js_string t -> unit meth
+  method setRGBColorICCColor : js_string t -> js_string t -> unit meth
 
-    method setColor : colorType -> js_string t -> js_string t -> unit meth
-  end
+  method setColor : colorType -> js_string t -> js_string t -> unit meth
+end
 
 (* interface SVGICCColor *)
-and iccColor =
-  object
-    method colorProfile : js_string t prop
+and iccColor = object
+  method colorProfile : js_string t prop
 
-    method colors : numberList t readonly_prop
-  end
+  method colors : numberList t readonly_prop
+end
 
 (* interface SVGRect *)
-and rect =
-  object
-    method x : number t prop
+and rect = object
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method width : number t prop
+  method width : number t prop
 
-    method height : number t prop
-  end
+  method height : number t prop
+end
 
 (* interface SVGAnimatedRect *)
 and animatedRect = [rect t] animated
 
 (* interface SVGStylable *)
-and stylable =
-  object
-    method className : animatedString t readonly_prop
+and stylable = object
+  method className : animatedString t readonly_prop
 
-    method style : Dom_html.cssStyleDeclaration t readonly_prop
-    (*   CSSValue getPresentationAttribute(in DOMString name); *)
-  end
+  method style : Dom_html.cssStyleDeclaration t readonly_prop
+  (*   CSSValue getPresentationAttribute(in DOMString name); *)
+end
 
 (* interface SVGLocatable *)
-and locatable =
-  object
-    method nearestViewportElement : element t readonly_prop
+and locatable = object
+  method nearestViewportElement : element t readonly_prop
 
-    method farthestViewportElement : element t readonly_prop
+  method farthestViewportElement : element t readonly_prop
 
-    method getBBox : rect t meth
+  method getBBox : rect t meth
 
-    method getCTM : matrix t meth
+  method getCTM : matrix t meth
 
-    method getScreenCTM : matrix t meth
+  method getScreenCTM : matrix t meth
 
-    method getTransformToElement : element t -> matrix t meth
-  end
+  method getTransformToElement : element t -> matrix t meth
+end
 
 (* interface SVGTransformable *)
-and transformable =
-  object
-    inherit locatable
+and transformable = object
+  inherit locatable
 
-    method transform : animatedTransformList t readonly_prop
-  end
+  method transform : animatedTransformList t readonly_prop
+end
 
 (* interface SVGTests *)
-and tests =
-  object
-    method requiredFeatures : stringList t readonly_prop
+and tests = object
+  method requiredFeatures : stringList t readonly_prop
 
-    method requiredExtensions : stringList t readonly_prop
+  method requiredExtensions : stringList t readonly_prop
 
-    method systemLanguage : stringList t readonly_prop
+  method systemLanguage : stringList t readonly_prop
 
-    method hasExtension : js_string t -> bool t meth
-  end
+  method hasExtension : js_string t -> bool t meth
+end
 
 (* interface SVGLangSpace *)
-and langSpace =
-  object
-    method xmllang : js_string t prop
+and langSpace = object
+  method xmllang : js_string t prop
 
-    method xmlspace : js_string t prop
-  end
+  method xmlspace : js_string t prop
+end
 
 (* interface SVGExternalResourcesRequired *)
-and externalResourcesRequired =
-  object
-    method externalResourcesRequired : animatedBoolean t readonly_prop
-  end
+and externalResourcesRequired = object
+  method externalResourcesRequired : animatedBoolean t readonly_prop
+end
 
 (* interface SVGFitToViewBox *)
-and fitToViewBox =
-  object
-    method viewBox : animatedRect t readonly_prop
+and fitToViewBox = object
+  method viewBox : animatedRect t readonly_prop
 
-    method preserveAspectRatio : animatedPreserveAspectRatio t readonly_prop
-  end
+  method preserveAspectRatio : animatedPreserveAspectRatio t readonly_prop
+end
 
 (* interface SVGZoomAndPan *)
-and zoomAndPan =
-  object
-    method zoomAndPan : zoomAndPanType prop
-  end
+and zoomAndPan = object
+  method zoomAndPan : zoomAndPanType prop
+end
 
 (* interface SVGViewSpec *)
-and viewSpec =
-  object
-    inherit zoomAndPan
+and viewSpec = object
+  inherit zoomAndPan
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    method transform : transformList t readonly_prop
+  method transform : transformList t readonly_prop
 
-    method viewTarget : element t readonly_prop
+  method viewTarget : element t readonly_prop
 
-    method viewBoxString : js_string t readonly_prop
+  method viewBoxString : js_string t readonly_prop
 
-    method preserveAspectRatioString : js_string t readonly_prop
+  method preserveAspectRatioString : js_string t readonly_prop
 
-    method transformString : js_string t readonly_prop
+  method transformString : js_string t readonly_prop
 
-    method viewTargetString : js_string t readonly_prop
-  end
+  method viewTargetString : js_string t readonly_prop
+end
 
 (* interface SVGURIReference *)
-and uriReference =
-  object
-    method href : animatedString t readonly_prop
-  end
+and uriReference = object
+  method href : animatedString t readonly_prop
+end
 
 (* interface SVGCSSRule : CSSRule *)
 (*   const unsigned short COLOR_PROFILE_RULE = 7; *)
 (* }; *)
 
 (* interface SVGDocument *)
-and document =
-  object
-    inherit [element] Dom.document
+and document = object
+  inherit [element] Dom.document
 
-    (*XXX inherit documentEvent *)
-    method title : js_string t prop
+  (*XXX inherit documentEvent *)
+  method title : js_string t prop
 
-    method referrer : js_string t readonly_prop
+  method referrer : js_string t readonly_prop
 
-    method domain : js_string t prop
+  method domain : js_string t prop
 
-    method _URL : js_string t readonly_prop
+  method _URL : js_string t readonly_prop
 
-    method rootElement : svgElement t opt readonly_prop
-  end
+  method rootElement : svgElement t opt readonly_prop
+end
 
 (* interface SVGSVGElement *)
-and svgElement =
-  object
-    inherit element
+and svgElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit locatable
+  inherit locatable
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    inherit zoomAndPan
+  inherit zoomAndPan
 
-    (*XXX inherit documentevent, viewcss, documentcss *)
-    method x : animatedLength t readonly_prop
+  (*XXX inherit documentevent, viewcss, documentcss *)
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method contentScriptType : js_string t prop
+  method contentScriptType : js_string t prop
 
-    method contentStyleType : js_string t prop
+  method contentStyleType : js_string t prop
 
-    method viewport : rect t readonly_prop
+  method viewport : rect t readonly_prop
 
-    method pixelUnitToMillimeterX : number t readonly_prop
+  method pixelUnitToMillimeterX : number t readonly_prop
 
-    method pixelUnitToMillimeterY : number t readonly_prop
+  method pixelUnitToMillimeterY : number t readonly_prop
 
-    method screenPixelUnitToMillimeterX : number t readonly_prop
+  method screenPixelUnitToMillimeterX : number t readonly_prop
 
-    method screenPixelUnitToMillimeterY : number t readonly_prop
+  method screenPixelUnitToMillimeterY : number t readonly_prop
 
-    method useCurrentView : bool t readonly_prop
+  method useCurrentView : bool t readonly_prop
 
-    method currentView : viewSpec t readonly_prop
+  method currentView : viewSpec t readonly_prop
 
-    method currentScale : number t prop
+  method currentScale : number t prop
 
-    method currentTranslate : point t readonly_prop
+  method currentTranslate : point t readonly_prop
 
-    method suspendRedraw : int -> suspendHandleID meth
+  method suspendRedraw : int -> suspendHandleID meth
 
-    method unsuspendRedraw : suspendHandleID -> unit meth
+  method unsuspendRedraw : suspendHandleID -> unit meth
 
-    method unsuspendRedrawAll : unit meth
+  method unsuspendRedrawAll : unit meth
 
-    method forceRedraw : unit meth
+  method forceRedraw : unit meth
 
-    method pauseAnimations : unit meth
+  method pauseAnimations : unit meth
 
-    method unpauseAnimations : unit meth
+  method unpauseAnimations : unit meth
 
-    method animationsPaused : bool t meth
+  method animationsPaused : bool t meth
 
-    method getCurrentTime : number t meth
+  method getCurrentTime : number t meth
 
-    method setCurrentTime : int -> unit meth
+  method setCurrentTime : int -> unit meth
 
-    method getIntersectionList : rect t -> element t -> element Dom.nodeList t meth
+  method getIntersectionList : rect t -> element t -> element Dom.nodeList t meth
 
-    method getEnclosureList : rect t -> element t -> element Dom.nodeList t meth
+  method getEnclosureList : rect t -> element t -> element Dom.nodeList t meth
 
-    method checkIntersection : element t -> rect t -> bool t
+  method checkIntersection : element t -> rect t -> bool t
 
-    method checkEnclosure : element t -> rect t -> bool t
+  method checkEnclosure : element t -> rect t -> bool t
 
-    method deselectAll : unit meth
+  method deselectAll : unit meth
 
-    method createSVGNumber : number t meth
+  method createSVGNumber : number t meth
 
-    method createSVGLength : length t meth
+  method createSVGLength : length t meth
 
-    method createSVGAngle : angle t meth
+  method createSVGAngle : angle t meth
 
-    method createSVGPoint : point t meth
+  method createSVGPoint : point t meth
 
-    method createSVGMatrix : matrix t meth
+  method createSVGMatrix : matrix t meth
 
-    method createSVGRect : rect t meth
+  method createSVGRect : rect t meth
 
-    method createSVGTransform : transform t meth
+  method createSVGTransform : transform t meth
 
-    method createSVGTransformFromMatrix : matrix t -> transform t meth
+  method createSVGTransformFromMatrix : matrix t -> transform t meth
 
-    method getElementById : js_string t -> Dom.element t meth
-  end
+  method getElementById : js_string t -> Dom.element t meth
+end
 
 (* interface SVGGElement *)
-and gElement =
-  object
-    inherit element
+and gElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit Dom_html.eventTarget
-  end
+  inherit Dom_html.eventTarget
+end
 
 (* interface SVGDefsElement *)
-and defsElement =
-  object
-    inherit element
+and defsElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
-    (* XXXXXXX ? inherit Dom_html.eventTarget *)
-  end
+  inherit transformable
+  (* XXXXXXX ? inherit Dom_html.eventTarget *)
+end
 
 (* interface SVGDescElement *)
-and descElement =
-  object
-    inherit element
+and descElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit stylable
-    (* XXXXXXX ? inherit Dom_html.eventTarget *)
-  end
+  inherit stylable
+  (* XXXXXXX ? inherit Dom_html.eventTarget *)
+end
 
 (* interface SVGTitleElement *)
-and titleElement =
-  object
-    inherit element
+and titleElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGSymbolElement *)
-and symbolElement =
-  object
-    inherit element
+and symbolElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    inherit Dom_html.eventTarget
-  end
+  inherit Dom_html.eventTarget
+end
 
 (* interface SVGUseElement *)
-and useElement =
-  object
-    inherit element
+and useElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method instanceRoot : elementInstance t readonly_prop
+  method instanceRoot : elementInstance t readonly_prop
 
-    method animatedInstanceRoot : elementInstance t readonly_prop
-  end
+  method animatedInstanceRoot : elementInstance t readonly_prop
+end
 
-and elementInstance =
-  object
-    inherit Dom_html.eventTarget
+and elementInstance = object
+  inherit Dom_html.eventTarget
 
-    method correspondingElement : element t readonly_prop
+  method correspondingElement : element t readonly_prop
 
-    method correspondingUseElement : useElement t readonly_prop
+  method correspondingUseElement : useElement t readonly_prop
 
-    method parentNode : elementInstance t readonly_prop
+  method parentNode : elementInstance t readonly_prop
 
-    method childNodes : elementInstanceList t readonly_prop
+  method childNodes : elementInstanceList t readonly_prop
 
-    method firstChild : elementInstance t readonly_prop
+  method firstChild : elementInstance t readonly_prop
 
-    method lastChild : elementInstance t readonly_prop
+  method lastChild : elementInstance t readonly_prop
 
-    method previousSibling : elementInstance t readonly_prop
+  method previousSibling : elementInstance t readonly_prop
 
-    method nextSibling : elementInstance t readonly_prop
-  end
+  method nextSibling : elementInstance t readonly_prop
+end
 
 (* interface SVGElementInstanceList *)
-and elementInstanceList =
-  object
-    method length : int readonly_prop
+and elementInstanceList = object
+  method length : int readonly_prop
 
-    method item : int -> elementInstance t
-  end
+  method item : int -> elementInstance t
+end
 
 (* interface SVGImageElement *)
-and imageElement =
-  object
-    inherit element
+and imageElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-    (* readonly attribute SVGAnimatedPreserveAspectRatio preserveAspectRatio *)
-  end
+  method height : animatedLength t readonly_prop
+  (* readonly attribute SVGAnimatedPreserveAspectRatio preserveAspectRatio *)
+end
 
-and switchElement =
-  object
-    inherit element
+and switchElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
-  end
+  inherit transformable
+end
 
 (* XXX deprecated => interface GetSVGDocument => SVGDocument getSVGDocument() *)
 
 (* interface SVGStyleElement *)
-and styleElement =
-  object
-    inherit element
+and styleElement = object
+  inherit element
 
-    inherit langSpace
+  inherit langSpace
 
-    method type_ : js_string t prop
+  method type_ : js_string t prop
 
-    method media : js_string t prop
+  method media : js_string t prop
 
-    method title : js_string t prop
-  end
+  method title : js_string t prop
+end
 
 (* interface SVGPoint *)
-and point =
-  object
-    method x : number t readonly_prop
+and point = object
+  method x : number t readonly_prop
 
-    method y : number t readonly_prop
+  method y : number t readonly_prop
 
-    method matrixTransform : matrix t -> point t meth
-  end
+  method matrixTransform : matrix t -> point t meth
+end
 
 (* interface SVGPointList *)
 and pointList = [point t] list
 
 (* interface SVGMatrix *)
-and matrix =
-  object
-    method a : number t readonly_prop
+and matrix = object
+  method a : number t readonly_prop
 
-    method b : number t readonly_prop
+  method b : number t readonly_prop
 
-    method c : number t readonly_prop
+  method c : number t readonly_prop
 
-    method d : number t readonly_prop
+  method d : number t readonly_prop
 
-    method e : number t readonly_prop
+  method e : number t readonly_prop
 
-    method f : number t readonly_prop
+  method f : number t readonly_prop
 
-    method multiply : matrix t -> matrix t meth
+  method multiply : matrix t -> matrix t meth
 
-    method inverse : matrix t meth
+  method inverse : matrix t meth
 
-    method translate : number t -> number t -> matrix t meth
+  method translate : number t -> number t -> matrix t meth
 
-    method scale : number t -> matrix t meth
+  method scale : number t -> matrix t meth
 
-    method scaleNonUniform : number t -> number t -> matrix t meth
+  method scaleNonUniform : number t -> number t -> matrix t meth
 
-    method rotate : number t -> matrix t meth
+  method rotate : number t -> matrix t meth
 
-    method rotateFromVector : number t -> number t -> matrix t meth
+  method rotateFromVector : number t -> number t -> matrix t meth
 
-    method flipX : matrix t meth
+  method flipX : matrix t meth
 
-    method flipY : matrix t meth
+  method flipY : matrix t meth
 
-    method skewX : number t -> matrix t meth
+  method skewX : number t -> matrix t meth
 
-    method skewY : number t -> matrix t meth
-  end
+  method skewY : number t -> matrix t meth
+end
 
 (* interface SVGTransform *)
-and transform =
-  object
-    method _type : transformType readonly_prop
+and transform = object
+  method _type : transformType readonly_prop
 
-    method matrix : matrix t readonly_prop
+  method matrix : matrix t readonly_prop
 
-    method angle : number t readonly_prop
+  method angle : number t readonly_prop
 
-    method setMatrix : matrix t -> unit meth
+  method setMatrix : matrix t -> unit meth
 
-    method setTranslate : number t -> number t -> unit meth
+  method setTranslate : number t -> number t -> unit meth
 
-    method setScale : number t -> number t -> unit meth
+  method setScale : number t -> number t -> unit meth
 
-    method setRotate : number t -> number t -> number t -> unit meth
+  method setRotate : number t -> number t -> number t -> unit meth
 
-    method setSkewX : number t -> unit meth
+  method setSkewX : number t -> unit meth
 
-    method setSkewY : number t -> unit meth
-  end
+  method setSkewY : number t -> unit meth
+end
 
 (* interface SVGTransformList *)
-and transformList =
-  object
-    inherit [transform t] list
+and transformList = object
+  inherit [transform t] list
 
-    method createSVGTransformFromMatrix : matrix -> transform t meth
+  method createSVGTransformFromMatrix : matrix -> transform t meth
 
-    method consolidate : transform t meth
-  end
+  method consolidate : transform t meth
+end
 
 (* interface SVGAnimatedTransformList *)
 and animatedTransformList = [transformList t] animated
 
 (* interface SVGPreserveAspectRatio *)
-and preserveAspectRatio =
-  object
-    method align : alignmentType readonly_prop
+and preserveAspectRatio = object
+  method align : alignmentType readonly_prop
 
-    method meetOrSlice : meetOrSliceType readonly_prop
-  end
+  method meetOrSlice : meetOrSliceType readonly_prop
+end
 
 (* interface SVGAnimatedPreserveAspectRatio *)
 and animatedPreserveAspectRatio = [preserveAspectRatio t] animated
 
 (* interface SVGPathSeg *)
-and pathSeg =
-  object
-    method pathSegType : pathSegmentType readonly_prop
+and pathSeg = object
+  method pathSegType : pathSegmentType readonly_prop
 
-    method pathSegTypeAsLetter : js_string t readonly_prop
-  end
+  method pathSegTypeAsLetter : js_string t readonly_prop
+end
 
 (* interface SVGPathSegClosePath *)
 and pathSegClosePath = pathSeg
 
 (* interface SVGPathSegMovetoAbs *)
 (* interface SVGPathSegMovetoRel *)
-and pathSegMoveto =
-  object
-    inherit pathSeg
+and pathSegMoveto = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
-  end
+  method y : number t prop
+end
 
 (* interface SVGPathSegLinetoAbs *)
 (* interface SVGPathSegLinetoRel *)
-and pathSegLineto =
-  object
-    inherit pathSeg
+and pathSegLineto = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
-  end
+  method y : number t prop
+end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
 (* interface SVGPathSegCurvetoCubicRel *)
-and pathSegCurvetoCubic =
-  object
-    inherit pathSeg
+and pathSegCurvetoCubic = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method x1 : number t prop
+  method x1 : number t prop
 
-    method y1 : number t prop
+  method y1 : number t prop
 
-    method x2 : number t prop
+  method x2 : number t prop
 
-    method y2 : number t prop
-  end
+  method y2 : number t prop
+end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
 (* interface SVGPathSegCurvetoQuadraticRel *)
-and pathSegCurvetoQuadratic =
-  object
-    inherit pathSeg
+and pathSegCurvetoQuadratic = object
+  inherit pathSeg
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method x1 : number t prop
+  method x1 : number t prop
 
-    method y1 : number t prop
-  end
+  method y1 : number t prop
+end
 
 (* interface SVGPathSegArcAbs *)
 (* interface SVGPathSegArcRel*)
-and pathSegArc =
-  object
-    inherit pathSeg
+and pathSegArc = object
+  inherit pathSeg
 
-    method y : number t prop
+  method y : number t prop
 
-    method r1 : number t prop
+  method r1 : number t prop
 
-    method r2 : number t prop
+  method r2 : number t prop
 
-    method angle : number t prop
+  method angle : number t prop
 
-    method largeArcFlag : bool t prop
+  method largeArcFlag : bool t prop
 
-    method sweepFlag : bool t prop
-  end
+  method sweepFlag : bool t prop
+end
 
 (* interface SVGPathSegLinetoHorizontalAbs *)
 (* interface SVGPathSegLinetoHorizontalRel *)
-and pathSegLinetoHorizontal =
-  object
-    inherit pathSeg
+and pathSegLinetoHorizontal = object
+  inherit pathSeg
 
-    method x : number t
-  end
+  method x : number t
+end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
 (* interface SVGPathSegLinetoVerticalRel *)
-and pathSegLinetoVertical =
-  object
-    inherit pathSeg
+and pathSegLinetoVertical = object
+  inherit pathSeg
 
-    method y : number t
-  end
+  method y : number t
+end
 
-and pathSegCurvetoCubicSmooth =
-  object
-    inherit pathSeg
+and pathSegCurvetoCubicSmooth = object
+  inherit pathSeg
 
-    method x : number t
+  method x : number t
 
-    method y : number t
+  method y : number t
 
-    method x2 : number t
+  method x2 : number t
 
-    method y2 : number t
-  end
+  method y2 : number t
+end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
 (* interface SVGPathSegCurvetoQuadraticSmoothRel  *)
-and pathSegCurvetoQuadraticSmooth =
-  object
-    inherit pathSeg
+and pathSegCurvetoQuadraticSmooth = object
+  inherit pathSeg
 
-    method x : number t
+  method x : number t
 
-    method y : number t
-  end
+  method y : number t
+end
 
 and pathSegList = [pathSeg t] list
 
 (* interface SVGAnimatedPathData *)
-and animatedPathData =
-  object
-    method pathSegList : pathSegList t prop
+and animatedPathData = object
+  method pathSegList : pathSegList t prop
 
-    method normalizedPathSegList : pathSegList t prop
+  method normalizedPathSegList : pathSegList t prop
 
-    method animatedPathSegList : pathSegList t prop
+  method animatedPathSegList : pathSegList t prop
 
-    method animatedNormalizedPathSegList : pathSegList t prop
-  end
+  method animatedNormalizedPathSegList : pathSegList t prop
+end
 
 (* interface SVGPathElement *)
-and pathElement =
-  object
-    inherit element
+and pathElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit animatedPathData
+  inherit animatedPathData
 
-    method pathLength : animatedNumber t readonly_prop
+  method pathLength : animatedNumber t readonly_prop
 
-    method getTotalLength : number t meth
+  method getTotalLength : number t meth
 
-    method getPointAtLength : number t -> point t meth
+  method getPointAtLength : number t -> point t meth
 
-    method getPathSegAtLength : number t -> int
+  method getPathSegAtLength : number t -> int
 
-    method createSVGPathSegClosePath : pathSegClosePath meth
+  method createSVGPathSegClosePath : pathSegClosePath meth
 
-    method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
 
-    method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
 
-    method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
 
-    method createSVGPathSegCurvetoCubicAbs :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> pathSegCurvetoCubic meth
+  method createSVGPathSegCurvetoCubicAbs :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> pathSegCurvetoCubic meth
 
-    method createSVGPathSegCurvetoCubicRel :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> pathSegCurvetoCubic meth
+  method createSVGPathSegCurvetoCubicRel :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> pathSegCurvetoCubic meth
 
-    method createSVGPathSegCurvetoQuadraticAbs :
-      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+  method createSVGPathSegCurvetoQuadraticAbs :
+    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
-    method createSVGPathSegCurvetoQuadraticRel :
-      number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+  method createSVGPathSegCurvetoQuadraticRel :
+    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
 
-    method createSVGPathSegArcAbs :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> bool t
-      -> bool t
-      -> pathSegArc meth
+  method createSVGPathSegArcAbs :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> bool t
+    -> bool t
+    -> pathSegArc meth
 
-    method createSVGPathSegArcRel :
-         number t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> bool t
-      -> bool t
-      -> pathSegArc meth
+  method createSVGPathSegArcRel :
+       number t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> bool t
+    -> bool t
+    -> pathSegArc meth
 
-    method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
 
-    method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
 
-    method createSVGPathSegCurvetoCubicSmoothAbs :
-      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+  method createSVGPathSegCurvetoCubicSmoothAbs :
+    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
-    method createSVGPathSegCurvetoCubicSmoothRel :
-      number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+  method createSVGPathSegCurvetoCubicSmoothRel :
+    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
 
-    method createSVGPathSegCurvetoQuadraticSmoothAbs :
-      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+  method createSVGPathSegCurvetoQuadraticSmoothAbs :
+    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
 
-    method createSVGPathSegCurvetoQuadraticSmoothRel :
-      number t -> number t -> pathSegCurvetoQuadraticSmooth meth
-  end
+  method createSVGPathSegCurvetoQuadraticSmoothRel :
+    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+end
 
 (* interface SVGRectElement *)
-and rectElement =
-  object
-    inherit element
+and rectElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method rx : animatedLength t readonly_prop
+  method rx : animatedLength t readonly_prop
 
-    method ry : animatedLength t readonly_prop
-  end
+  method ry : animatedLength t readonly_prop
+end
 
 (* interface SVGCircleElement *)
-and circleElement =
-  object
-    inherit element
+and circleElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method cx : animatedLength t readonly_prop
+  method cx : animatedLength t readonly_prop
 
-    method cy : animatedLength t readonly_prop
+  method cy : animatedLength t readonly_prop
 
-    method r : animatedLength t readonly_prop
-  end
+  method r : animatedLength t readonly_prop
+end
 
 (* interface SVGEllipseElement *)
-and ellipseElement =
-  object
-    inherit element
+and ellipseElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method cx : animatedLength t readonly_prop
+  method cx : animatedLength t readonly_prop
 
-    method cy : animatedLength t readonly_prop
+  method cy : animatedLength t readonly_prop
 
-    method rx : animatedLength t readonly_prop
+  method rx : animatedLength t readonly_prop
 
-    method ry : animatedLength t readonly_prop
-  end
+  method ry : animatedLength t readonly_prop
+end
 
 (* interface SVGLineElement *)
-class type lineElement =
-  object
-    inherit element
+class type lineElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit Dom_html.eventTarget
+  inherit Dom_html.eventTarget
 
-    method x1 : animatedLength t readonly_prop
+  method x1 : animatedLength t readonly_prop
 
-    method y1 : animatedLength t readonly_prop
+  method y1 : animatedLength t readonly_prop
 
-    method x2 : animatedLength t readonly_prop
+  method x2 : animatedLength t readonly_prop
 
-    method y2 : animatedLength t readonly_prop
-  end
+  method y2 : animatedLength t readonly_prop
+end
 
 (* interface SVGAnimatedPoints *)
-and animatedPoints =
-  object
-    method points : pointList t readonly_prop
+and animatedPoints = object
+  method points : pointList t readonly_prop
 
-    method animatedpoints : pointList t readonly_prop
-  end
+  method animatedpoints : pointList t readonly_prop
+end
 
 (* interface SVGPolylineElement *)
-and polyLineElement =
-  object
-    inherit element
+and polyLineElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit animatedPoints
-  end
+  inherit animatedPoints
+end
 
 (* interface SVGPolygonElement *)
-and polygonElement =
-  object
-    inherit element
+and polygonElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    inherit animatedPoints
-  end
+  inherit animatedPoints
+end
 
 (* interface SVGTextContentElement *)
-and textContentElement =
-  object
-    inherit element
+and textContentElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit Dom_html.eventTarget
+  inherit Dom_html.eventTarget
 
-    method textLength : animatedLength t readonly_prop
+  method textLength : animatedLength t readonly_prop
 
-    method lengthAdjust : lengthAdjust animated t readonly_prop
+  method lengthAdjust : lengthAdjust animated t readonly_prop
 
-    method getNumberOfChars : int meth
+  method getNumberOfChars : int meth
 
-    method getComputedTextLength : number t meth
+  method getComputedTextLength : number t meth
 
-    method getSubStringLength : int -> int -> number t meth
+  method getSubStringLength : int -> int -> number t meth
 
-    method getStartPositionOfChar : int -> point t meth
+  method getStartPositionOfChar : int -> point t meth
 
-    method getEndPositionOfChar : int -> point t meth
+  method getEndPositionOfChar : int -> point t meth
 
-    method getExtentOfChar : int -> rect t meth
+  method getExtentOfChar : int -> rect t meth
 
-    method getRotationOfChar : int -> number t meth
+  method getRotationOfChar : int -> number t meth
 
-    method getCharNumAtPosition : point -> int meth
+  method getCharNumAtPosition : point -> int meth
 
-    method selectSubString : int -> int -> unit meth
-  end
+  method selectSubString : int -> int -> unit meth
+end
 
 (* interface SVGTextPositioningElement *)
-and textPositioningElement =
-  object
-    inherit textContentElement
+and textPositioningElement = object
+  inherit textContentElement
 
-    method x : animatedLengthList t readonly_prop
+  method x : animatedLengthList t readonly_prop
 
-    method y : animatedLengthList t readonly_prop
+  method y : animatedLengthList t readonly_prop
 
-    method dx : animatedLengthList t readonly_prop
+  method dx : animatedLengthList t readonly_prop
 
-    method dy : animatedLengthList t readonly_prop
+  method dy : animatedLengthList t readonly_prop
 
-    method rotate : animatedNumberList t readonly_prop
-  end
+  method rotate : animatedNumberList t readonly_prop
+end
 
 (* interface SVGTextElement *)
-and textElement =
-  object
-    inherit textPositioningElement
+and textElement = object
+  inherit textPositioningElement
 
-    inherit transformable
-  end
+  inherit transformable
+end
 
 and tspanElement = textPositioningElement
 
-and trefElement =
-  object
-    inherit textPositioningElement
+and trefElement = object
+  inherit textPositioningElement
 
-    inherit uriReference
-  end
+  inherit uriReference
+end
 
 (* interface SVGTextPathElement *)
 and textPathElementMethod = [textPathMethodType] animated
 
 and textPathElementSpacing = [textPathSpacingType] animated
 
-and textPathElement =
-  object
-    inherit textContentElement
+and textPathElement = object
+  inherit textContentElement
 
-    inherit uriReference
+  inherit uriReference
 
-    method startOffset : animatedLength t readonly_prop
+  method startOffset : animatedLength t readonly_prop
 
-    method method_ : textPathElementMethod readonly_prop
+  method method_ : textPathElementMethod readonly_prop
 
-    method spacing : textPathElementSpacing readonly_prop
-  end
+  method spacing : textPathElementSpacing readonly_prop
+end
 
 (* interface SVGAltGlyphElement *)
-and altGlyphElement =
-  object
-    inherit textPositioningElement
+and altGlyphElement = object
+  inherit textPositioningElement
 
-    inherit uriReference
+  inherit uriReference
 
-    method glyphRef : js_string t prop
+  method glyphRef : js_string t prop
 
-    method format : js_string t prop
-  end
+  method format : js_string t prop
+end
 
 (* interface SVGAltGlyphDefElement *)
 and altGlyphDefElement = element
@@ -1316,26 +1254,25 @@ and altGlyphDefElement = element
 and altGlyphItemElement = element
 
 (* interface SVGGlyphRefElement *)
-and glyphRefElement =
-  object
-    inherit element
+and glyphRefElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit stylable
+  inherit stylable
 
-    method glyphRef : js_string t prop
+  method glyphRef : js_string t prop
 
-    method format : js_string t prop
+  method format : js_string t prop
 
-    method x : number t prop
+  method x : number t prop
 
-    method y : number t prop
+  method y : number t prop
 
-    method dx : number t prop
+  method dx : number t prop
 
-    method dy : number t prop
-  end
+  method dy : number t prop
+end
 
 (* interface SVGPaint : SVGColor { *)
 
@@ -1404,160 +1341,152 @@ and glyphRefElement =
 (* interface SVGGradientElement *)
 and animatedSpreadMethod = [spreadMethodType] animated
 
-and gradientElement =
-  object
-    inherit element
+and gradientElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit stylable
+  inherit stylable
 
-    (*   readonly attribute SVGAnimatedEnumeration gradientUnits; *)
-    method gradientTransform : animatedTransformList t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration gradientUnits; *)
+  method gradientTransform : animatedTransformList t readonly_prop
 
-    method spreadMethod : animatedSpreadMethod t readonly_prop
-  end
+  method spreadMethod : animatedSpreadMethod t readonly_prop
+end
 
 (* interface SVGLinearGradientElement *)
-and linearGradientElement =
-  object
-    inherit gradientElement
+and linearGradientElement = object
+  inherit gradientElement
 
-    method x1 : animatedLength t readonly_prop
+  method x1 : animatedLength t readonly_prop
 
-    method y1 : animatedLength t readonly_prop
+  method y1 : animatedLength t readonly_prop
 
-    method x2 : animatedLength t readonly_prop
+  method x2 : animatedLength t readonly_prop
 
-    method y2 : animatedLength t readonly_prop
-  end
+  method y2 : animatedLength t readonly_prop
+end
 
 (* interface SVGRadialGradientElement *)
-and radialGradientElement =
-  object
-    inherit gradientElement
+and radialGradientElement = object
+  inherit gradientElement
 
-    method cx : animatedLength t readonly_prop
+  method cx : animatedLength t readonly_prop
 
-    method cy : animatedLength t readonly_prop
+  method cy : animatedLength t readonly_prop
 
-    method r : animatedLength t readonly_prop
+  method r : animatedLength t readonly_prop
 
-    method fx : animatedLength t readonly_prop
+  method fx : animatedLength t readonly_prop
 
-    method fy : animatedLength t readonly_prop
-  end
+  method fy : animatedLength t readonly_prop
+end
 
 (* interface SVGStopElement *)
-and stopElement =
-  object
-    inherit element
+and stopElement = object
+  inherit element
 
-    inherit stylable
+  inherit stylable
 
-    method offset : animatedNumber t readonly_prop
-  end
+  method offset : animatedNumber t readonly_prop
+end
 
 (* interface SVGPatternElement *)
-and patternElement =
-  object
-    inherit element
+and patternElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    (*   readonly attribute SVGAnimatedEnumeration patternUnits; *)
-    (*   readonly attribute SVGAnimatedEnumeration patternContentUnits; *)
-    method patternTransform : animatedTransformList t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration patternUnits; *)
+  (*   readonly attribute SVGAnimatedEnumeration patternContentUnits; *)
+  method patternTransform : animatedTransformList t readonly_prop
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-  end
+  method height : animatedLength t readonly_prop
+end
 
 (* interface SVGClipPathElement *)
-and clipPathElement =
-  object
-    inherit element
+and clipPathElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
-    (*   readonly attribute SVGAnimatedEnumeration clipPathUnits; *)
-  end
+  inherit transformable
+  (*   readonly attribute SVGAnimatedEnumeration clipPathUnits; *)
+end
 
 (* interface SVGMaskElement *)
-and maskElement =
-  object
-    inherit element
+and maskElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    (*   readonly attribute SVGAnimatedEnumeration maskUnits; *)
-    (*   readonly attribute SVGAnimatedEnumeration maskContentUnits; *)
-    method x : animatedLength t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration maskUnits; *)
+  (*   readonly attribute SVGAnimatedEnumeration maskContentUnits; *)
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-  end
+  method height : animatedLength t readonly_prop
+end
 
 (* interface SVGFilterElement *)
-and filterElement =
-  object
-    inherit element
+and filterElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    (*   readonly attribute SVGAnimatedEnumeration filterUnits; *)
-    (*   readonly attribute SVGAnimatedEnumeration primitiveUnits; *)
-    method x : animatedLength t readonly_prop
+  (*   readonly attribute SVGAnimatedEnumeration filterUnits; *)
+  (*   readonly attribute SVGAnimatedEnumeration primitiveUnits; *)
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
+  method height : animatedLength t readonly_prop
 
-    method filterResX : animatedInteger t readonly_prop
+  method filterResX : animatedInteger t readonly_prop
 
-    method filterResY : animatedInteger t readonly_prop
+  method filterResY : animatedInteger t readonly_prop
 
-    method setFilterRes : int -> int -> unit meth
-  end
+  method setFilterRes : int -> int -> unit meth
+end
 
 (* interface SVGFilterPrimitiveStandardAttributes : SVGStylable { *)
 (*   readonly attribute SVGAnimatedLength x; *)
@@ -1814,66 +1743,62 @@ and filterElement =
 (* }; *)
 
 (* interface SVGCursorElement *)
-and cursorElement =
-  object
-    inherit element
+and cursorElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
-  end
+  method y : animatedLength t readonly_prop
+end
 
 (* interface SVGAElement *)
-and aElement =
-  object
-    inherit element
+and aElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method target : animatedString t readonly_prop
-  end
+  method target : animatedString t readonly_prop
+end
 
 (* interface SVGViewElement *)
-and viewElement =
-  object
-    inherit element
+and viewElement = object
+  inherit element
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit fitToViewBox
+  inherit fitToViewBox
 
-    inherit zoomAndPan
+  inherit zoomAndPan
 
-    method viewTarget : stringList t readonly_prop
-  end
+  method viewTarget : stringList t readonly_prop
+end
 
 (* interface SVGScriptElement *)
-and scriptElement =
-  object
-    inherit element
+and scriptElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    method type_ : js_string t prop
-  end
+  method type_ : js_string t prop
+end
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
@@ -1884,31 +1809,29 @@ and scriptElement =
 (* }; *)
 
 (* interface SVGAnimationElement *)
-and animationElement =
-  object
-    inherit element
+and animationElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    (* inherit elementTimeControl *)
-    method targetElement : element t readonly_prop
+  (* inherit elementTimeControl *)
+  method targetElement : element t readonly_prop
 
-    method getStartTime : number t meth
+  method getStartTime : number t meth
 
-    method getCurrentTime : number t meth
+  method getCurrentTime : number t meth
 
-    method getSimpleDuration : number t meth
-  end
+  method getSimpleDuration : number t meth
+end
 
 (* interface SVGAnimateElement *)
-and animateElement =
-  object
-    inherit animationElement
+and animateElement = object
+  inherit animationElement
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGSetElement *)
 and setElement = animationElement
@@ -1917,42 +1840,38 @@ and setElement = animationElement
 and animateMotionElement = animationElement
 
 (* interface SVGMPathElement *)
-and mPathElement =
-  object
-    inherit element
+and mPathElement = object
+  inherit element
 
-    inherit uriReference
+  inherit uriReference
 
-    inherit externalResourcesRequired
-  end
+  inherit externalResourcesRequired
+end
 
 (* interface SVGAnimateColorElement *)
-and animateColorElement =
-  object
-    inherit animationElement
+and animateColorElement = object
+  inherit animationElement
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGAnimateTransformElement *)
 and animateTransformElement = animationElement
 
 (* interface SVGFontElement *)
-and fontElement =
-  object
-    inherit element
+and fontElement = object
+  inherit element
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGGlyphElement *)
 (* interface SVGMissingGlyphElement*)
-and glyphElement =
-  object
-    inherit element
+and glyphElement = object
+  inherit element
 
-    inherit stylable
-  end
+  inherit stylable
+end
 
 (* interface SVGHKernElement : SVGElement *)
 (* interface SVGVKernElement : SVGElement *)
@@ -1976,28 +1895,27 @@ class type fontFaceNameElement = element
 class type metadataElement = element
 
 (* interface SVGForeignObjectElement *)
-class type foreignObjectElement =
-  object
-    inherit element
+class type foreignObjectElement = object
+  inherit element
 
-    inherit tests
+  inherit tests
 
-    inherit langSpace
+  inherit langSpace
 
-    inherit externalResourcesRequired
+  inherit externalResourcesRequired
 
-    inherit stylable
+  inherit stylable
 
-    inherit transformable
+  inherit transformable
 
-    method x : animatedLength t readonly_prop
+  method x : animatedLength t readonly_prop
 
-    method y : animatedLength t readonly_prop
+  method y : animatedLength t readonly_prop
 
-    method width : animatedLength t readonly_prop
+  method width : animatedLength t readonly_prop
 
-    method height : animatedLength t readonly_prop
-  end
+  method height : animatedLength t readonly_prop
+end
 
 (** {2 Helper functions for creating Svg elements} *)
 
diff --git a/lib/js_of_ocaml/eventSource.ml b/lib/js_of_ocaml/eventSource.ml
index 302f4d19e6..d6f8d4fc9f 100644
--- a/lib/js_of_ocaml/eventSource.ml
+++ b/lib/js_of_ocaml/eventSource.ml
@@ -27,39 +27,36 @@ type state =
   | OPEN
   | CLOSED
 
-class type ['a] messageEvent =
-  object
-    inherit ['a] Dom.event
+class type ['a] messageEvent = object
+  inherit ['a] Dom.event
 
-    method data : js_string t readonly_prop
+  method data : js_string t readonly_prop
 
-    method origin : js_string t readonly_prop
+  method origin : js_string t readonly_prop
 
-    method lastEventId : js_string t readonly_prop
-    (* method source : unit *)
-  end
+  method lastEventId : js_string t readonly_prop
+  (* method source : unit *)
+end
 
-class type eventSource =
-  object ('self)
-    method url : string t readonly_prop
+class type eventSource = object ('self)
+  method url : string t readonly_prop
 
-    method withCredentials : bool t readonly_prop
+  method withCredentials : bool t readonly_prop
 
-    method readyState : state readonly_prop
+  method readyState : state readonly_prop
 
-    method close : unit meth
+  method close : unit meth
 
-    method onopen : ('self t, 'self messageEvent t) event_listener writeonly_prop
+  method onopen : ('self t, 'self messageEvent t) event_listener writeonly_prop
 
-    method onmessage : ('self t, 'self messageEvent t) event_listener writeonly_prop
+  method onmessage : ('self t, 'self messageEvent t) event_listener writeonly_prop
 
-    method onerror : ('self t, 'self messageEvent t) event_listener writeonly_prop
-  end
+  method onerror : ('self t, 'self messageEvent t) event_listener writeonly_prop
+end
 
-class type options =
-  object
-    method withCredentials : bool t writeonly_prop
-  end
+class type options = object
+  method withCredentials : bool t writeonly_prop
+end
 
 let withCredentials b : options t =
   let init = Js.Unsafe.obj [||] in
diff --git a/lib/js_of_ocaml/eventSource.mli b/lib/js_of_ocaml/eventSource.mli
index cf8d51bcc2..6ffdeda4f9 100644
--- a/lib/js_of_ocaml/eventSource.mli
+++ b/lib/js_of_ocaml/eventSource.mli
@@ -27,39 +27,36 @@ type state =
   | OPEN
   | CLOSED
 
-class type ['a] messageEvent =
-  object
-    inherit ['a] Dom.event
+class type ['a] messageEvent = object
+  inherit ['a] Dom.event
 
-    method data : js_string t readonly_prop
+  method data : js_string t readonly_prop
 
-    method origin : js_string t readonly_prop
+  method origin : js_string t readonly_prop
 
-    method lastEventId : js_string t readonly_prop
-    (* method source : unit *)
-  end
+  method lastEventId : js_string t readonly_prop
+  (* method source : unit *)
+end
 
-class type eventSource =
-  object ('self)
-    method url : string t readonly_prop
+class type eventSource = object ('self)
+  method url : string t readonly_prop
 
-    method withCredentials : bool t readonly_prop
+  method withCredentials : bool t readonly_prop
 
-    method readyState : state readonly_prop
+  method readyState : state readonly_prop
 
-    method close : unit meth
+  method close : unit meth
 
-    method onopen : ('self t, 'self messageEvent t) event_listener writeonly_prop
+  method onopen : ('self t, 'self messageEvent t) event_listener writeonly_prop
 
-    method onmessage : ('self t, 'self messageEvent t) event_listener writeonly_prop
+  method onmessage : ('self t, 'self messageEvent t) event_listener writeonly_prop
 
-    method onerror : ('self t, 'self messageEvent t) event_listener writeonly_prop
-  end
+  method onerror : ('self t, 'self messageEvent t) event_listener writeonly_prop
+end
 
-class type options =
-  object
-    method withCredentials : bool t writeonly_prop
-  end
+class type options = object
+  method withCredentials : bool t writeonly_prop
+end
 
 val withCredentials : bool -> options t
 
diff --git a/lib/js_of_ocaml/file.ml b/lib/js_of_ocaml/file.ml
index 431ce9134d..732776bfc1 100644
--- a/lib/js_of_ocaml/file.ml
+++ b/lib/js_of_ocaml/file.ml
@@ -22,16 +22,15 @@ open Js
 open Dom
 open! Import
 
-class type blob =
-  object
-    method size : int readonly_prop
+class type blob = object
+  method size : int readonly_prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    method slice : int -> int -> blob t meth
+  method slice : int -> int -> blob t meth
 
-    method slice_withContentType : int -> int -> js_string t -> blob t meth
-  end
+  method slice_withContentType : int -> int -> js_string t -> blob t meth
+end
 
 let blob_constr = Unsafe.global##._Blob
 
@@ -84,22 +83,20 @@ let blob_from_any ?contentType ?endings l =
   in
   blob_raw ?contentType ?endings (Array.of_list l)
 
-class type file =
-  object
-    inherit blob
+class type file = object
+  inherit blob
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method lastModifiedDate : js_string t readonly_prop
-  end
+  method lastModifiedDate : js_string t readonly_prop
+end
 
 (* in firefox 3.0-3.5 file.name is not available, we use the nonstandard fileName instead *)
-class type file_name_only =
-  object
-    method name : js_string t optdef readonly_prop
+class type file_name_only = object
+  method name : js_string t optdef readonly_prop
 
-    method fileName : js_string t optdef readonly_prop
-  end
+  method fileName : js_string t optdef readonly_prop
+end
 
 let filename file =
   let file : file_name_only t = Js.Unsafe.coerce file in
@@ -136,69 +133,64 @@ module CoerceTo = struct
     else Js.null
 end
 
-class type fileList =
-  object
-    inherit [file] Dom.nodeList
-  end
+class type fileList = object
+  inherit [file] Dom.nodeList
+end
 
-class type fileError =
-  object
-    method code : int readonly_prop
-  end
+class type fileError = object
+  method code : int readonly_prop
+end
 
-class type ['a] progressEvent =
-  object
-    inherit ['a] event
+class type ['a] progressEvent = object
+  inherit ['a] event
 
-    method lengthComputable : bool t readonly_prop
+  method lengthComputable : bool t readonly_prop
 
-    method loaded : int readonly_prop
+  method loaded : int readonly_prop
 
-    method total : int readonly_prop
-  end
+  method total : int readonly_prop
+end
 
-class type progressEventTarget =
-  object ('self)
-    method onloadstart : ('self t, 'self progressEvent t) event_listener writeonly_prop
+class type progressEventTarget = object ('self)
+  method onloadstart : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onprogress : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onprogress : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onload : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onload : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onabort : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onabort : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onerror : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onerror : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onloadend : ('self t, 'self progressEvent t) event_listener writeonly_prop
-  end
+  method onloadend : ('self t, 'self progressEvent t) event_listener writeonly_prop
+end
 
 type readyState =
   | EMPTY
   | LOADING
   | DONE
 
-class type fileReader =
-  object ('self)
-    method readAsArrayBuffer : #blob t -> unit meth
+class type fileReader = object ('self)
+  method readAsArrayBuffer : #blob t -> unit meth
 
-    method readAsBinaryString : #blob t -> unit meth
+  method readAsBinaryString : #blob t -> unit meth
 
-    method readAsText : #blob t -> unit meth
+  method readAsText : #blob t -> unit meth
 
-    method readAsText_withEncoding : #blob t -> js_string t -> unit meth
+  method readAsText_withEncoding : #blob t -> js_string t -> unit meth
 
-    method readAsDataURL : #blob t -> unit meth
+  method readAsDataURL : #blob t -> unit meth
 
-    method abort : unit meth
+  method abort : unit meth
 
-    method readyState : readyState readonly_prop
+  method readyState : readyState readonly_prop
 
-    method result : file_any readonly_prop
+  method result : file_any readonly_prop
 
-    method error : fileError t readonly_prop
+  method error : fileError t readonly_prop
 
-    inherit progressEventTarget
-  end
+  inherit progressEventTarget
+end
 
 module ReaderEvent = struct
   type typ = fileReader progressEvent t Dom.Event.typ
diff --git a/lib/js_of_ocaml/file.mli b/lib/js_of_ocaml/file.mli
index d922521b1d..4f65c8afbd 100644
--- a/lib/js_of_ocaml/file.mli
+++ b/lib/js_of_ocaml/file.mli
@@ -23,16 +23,15 @@
 open Js
 open Dom
 
-class type blob =
-  object
-    method size : int readonly_prop
+class type blob = object
+  method size : int readonly_prop
 
-    method _type : js_string t readonly_prop
+  method _type : js_string t readonly_prop
 
-    method slice : int -> int -> blob t meth
+  method slice : int -> int -> blob t meth
 
-    method slice_withContentType : int -> int -> js_string t -> blob t meth
-  end
+  method slice_withContentType : int -> int -> js_string t -> blob t meth
+end
 
 type 'a make_blob =
   ?contentType:string -> ?endings:[ `Transparent | `Native ] -> 'a -> blob t
@@ -49,14 +48,13 @@ val blob_from_any :
   list
   make_blob
 
-class type file =
-  object
-    inherit blob
+class type file = object
+  inherit blob
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method lastModifiedDate : js_string t readonly_prop
-  end
+  method lastModifiedDate : js_string t readonly_prop
+end
 
 type file_any
 
@@ -72,82 +70,77 @@ module CoerceTo : sig
   val arrayBuffer : file_any -> Typed_array.arrayBuffer t Opt.t
 end
 
-class type fileList =
-  object
-    inherit [file] Dom.nodeList
-  end
+class type fileList = object
+  inherit [file] Dom.nodeList
+end
 
-class type fileError =
-  object
-    method code : int readonly_prop
-  end
+class type fileError = object
+  method code : int readonly_prop
+end
 
 (* {2 Events} *)
-class type ['a] progressEvent =
-  object
-    inherit ['a] event
+class type ['a] progressEvent = object
+  inherit ['a] event
 
-    method lengthComputable : bool t readonly_prop
+  method lengthComputable : bool t readonly_prop
 
-    method loaded : int readonly_prop
+  method loaded : int readonly_prop
 
-    method total : int readonly_prop
-  end
+  method total : int readonly_prop
+end
 
-class type progressEventTarget =
-  object ('self)
-    method onloadstart : ('self t, 'self progressEvent t) event_listener writeonly_prop
+class type progressEventTarget = object ('self)
+  method onloadstart : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onprogress : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onprogress : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onload : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onload : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onabort : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onabort : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onerror : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onerror : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onloadend : ('self t, 'self progressEvent t) event_listener writeonly_prop
-  end
+  method onloadend : ('self t, 'self progressEvent t) event_listener writeonly_prop
+end
 
 type readyState =
   | EMPTY
   | LOADING
   | DONE
 
-class type fileReader =
-  object ('self)
-    method readAsArrayBuffer : #blob t -> unit meth
+class type fileReader = object ('self)
+  method readAsArrayBuffer : #blob t -> unit meth
 
-    method readAsBinaryString : #blob t -> unit meth
+  method readAsBinaryString : #blob t -> unit meth
 
-    method readAsText : #blob t -> unit meth
+  method readAsText : #blob t -> unit meth
 
-    method readAsText_withEncoding : #blob t -> js_string t -> unit meth
+  method readAsText_withEncoding : #blob t -> js_string t -> unit meth
 
-    method readAsDataURL : #blob t -> unit meth
+  method readAsDataURL : #blob t -> unit meth
 
-    method abort : unit meth
+  method abort : unit meth
 
-    method readyState : readyState readonly_prop
+  method readyState : readyState readonly_prop
 
-    method result : file_any readonly_prop
+  method result : file_any readonly_prop
 
-    method error : fileError t readonly_prop
+  method error : fileError t readonly_prop
 
-    method onloadstart : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onloadstart : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onprogress : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onprogress : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onload : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onload : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onabort : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onabort : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onerror : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onerror : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    method onloadend : ('self t, 'self progressEvent t) event_listener writeonly_prop
+  method onloadend : ('self t, 'self progressEvent t) event_listener writeonly_prop
 
-    inherit progressEventTarget
-  end
+  inherit progressEventTarget
+end
 
 module ReaderEvent : sig
   type typ = fileReader progressEvent t Dom.Event.typ
diff --git a/lib/js_of_ocaml/firebug.ml b/lib/js_of_ocaml/firebug.ml
index c136e46b84..2a712d334c 100644
--- a/lib/js_of_ocaml/firebug.ml
+++ b/lib/js_of_ocaml/firebug.ml
@@ -21,108 +21,107 @@
 open Js
 open! Import
 
-class type console =
-  object
-    method log : _ -> unit meth
+class type console = object
+  method log : _ -> unit meth
 
-    method log_2 : _ -> _ -> unit meth
+  method log_2 : _ -> _ -> unit meth
 
-    method log_3 : _ -> _ -> _ -> unit meth
+  method log_3 : _ -> _ -> _ -> unit meth
 
-    method log_4 : _ -> _ -> _ -> _ -> unit meth
+  method log_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method log_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method log_6 : _ -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_6 : _ -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method log_7 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_7 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method log_8 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_8 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method debug : _ -> unit meth
+  method debug : _ -> unit meth
 
-    method debug_2 : _ -> _ -> unit meth
+  method debug_2 : _ -> _ -> unit meth
 
-    method debug_3 : _ -> _ -> _ -> unit meth
+  method debug_3 : _ -> _ -> _ -> unit meth
 
-    method debug_4 : _ -> _ -> _ -> _ -> unit meth
+  method debug_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method debug_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method debug_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method info : _ -> unit meth
+  method info : _ -> unit meth
 
-    method info_2 : _ -> _ -> unit meth
+  method info_2 : _ -> _ -> unit meth
 
-    method info_3 : _ -> _ -> _ -> unit meth
+  method info_3 : _ -> _ -> _ -> unit meth
 
-    method info_4 : _ -> _ -> _ -> _ -> unit meth
+  method info_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method info_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method info_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method warn : _ -> unit meth
+  method warn : _ -> unit meth
 
-    method warn_2 : _ -> _ -> unit meth
+  method warn_2 : _ -> _ -> unit meth
 
-    method warn_3 : _ -> _ -> _ -> unit meth
+  method warn_3 : _ -> _ -> _ -> unit meth
 
-    method warn_4 : _ -> _ -> _ -> _ -> unit meth
+  method warn_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method warn_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method warn_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method error : _ -> unit meth
+  method error : _ -> unit meth
 
-    method error_2 : _ -> _ -> unit meth
+  method error_2 : _ -> _ -> unit meth
 
-    method error_3 : _ -> _ -> _ -> unit meth
+  method error_3 : _ -> _ -> _ -> unit meth
 
-    method error_4 : _ -> _ -> _ -> _ -> unit meth
+  method error_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method error_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method error_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method assert_ : bool t -> unit meth
+  method assert_ : bool t -> unit meth
 
-    method assert_1 : bool t -> _ -> unit meth
+  method assert_1 : bool t -> _ -> unit meth
 
-    method assert_2 : bool t -> _ -> _ -> unit meth
+  method assert_2 : bool t -> _ -> _ -> unit meth
 
-    method assert_3 : bool t -> _ -> _ -> _ -> unit meth
+  method assert_3 : bool t -> _ -> _ -> _ -> unit meth
 
-    method assert_4 : bool t -> _ -> _ -> _ -> _ -> unit meth
+  method assert_4 : bool t -> _ -> _ -> _ -> _ -> unit meth
 
-    method assert_5 : bool t -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method assert_5 : bool t -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method dir : _ -> unit meth
+  method dir : _ -> unit meth
 
-    method dirxml : Dom.node t -> unit meth
+  method dirxml : Dom.node t -> unit meth
 
-    method trace : unit meth
+  method trace : unit meth
 
-    method group : _ -> unit meth
+  method group : _ -> unit meth
 
-    method group_2 : _ -> _ -> unit meth
+  method group_2 : _ -> _ -> unit meth
 
-    method group_3 : _ -> _ -> _ -> unit meth
+  method group_3 : _ -> _ -> _ -> unit meth
 
-    method group_4 : _ -> _ -> _ -> _ -> unit meth
+  method group_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method group_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method group_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method groupCollapsed : _ -> unit meth
+  method groupCollapsed : _ -> unit meth
 
-    method groupCollapsed_2 : _ -> _ -> unit meth
+  method groupCollapsed_2 : _ -> _ -> unit meth
 
-    method groupCollapsed_3 : _ -> _ -> _ -> unit meth
+  method groupCollapsed_3 : _ -> _ -> _ -> unit meth
 
-    method groupCollapsed_4 : _ -> _ -> _ -> _ -> unit meth
+  method groupCollapsed_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method groupCollapsed_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method groupCollapsed_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method groupEnd : unit meth
+  method groupEnd : unit meth
 
-    method time : js_string t -> unit meth
+  method time : js_string t -> unit meth
 
-    method timeEnd : js_string t -> unit meth
-  end
+  method timeEnd : js_string t -> unit meth
+end
 
 external get_console : unit -> console t = "caml_js_get_console"
 
diff --git a/lib/js_of_ocaml/firebug.mli b/lib/js_of_ocaml/firebug.mli
index fd96e1076c..fdf94f9f9f 100644
--- a/lib/js_of_ocaml/firebug.mli
+++ b/lib/js_of_ocaml/firebug.mli
@@ -25,107 +25,106 @@ The Firebug console API
 
 open Js
 
-class type console =
-  object
-    method log : _ -> unit meth
+class type console = object
+  method log : _ -> unit meth
 
-    method log_2 : _ -> _ -> unit meth
+  method log_2 : _ -> _ -> unit meth
 
-    method log_3 : _ -> _ -> _ -> unit meth
+  method log_3 : _ -> _ -> _ -> unit meth
 
-    method log_4 : _ -> _ -> _ -> _ -> unit meth
+  method log_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method log_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method log_6 : _ -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_6 : _ -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method log_7 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_7 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method log_8 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method log_8 : _ -> _ -> _ -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method debug : _ -> unit meth
+  method debug : _ -> unit meth
 
-    method debug_2 : _ -> _ -> unit meth
+  method debug_2 : _ -> _ -> unit meth
 
-    method debug_3 : _ -> _ -> _ -> unit meth
+  method debug_3 : _ -> _ -> _ -> unit meth
 
-    method debug_4 : _ -> _ -> _ -> _ -> unit meth
+  method debug_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method debug_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method debug_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method info : _ -> unit meth
+  method info : _ -> unit meth
 
-    method info_2 : _ -> _ -> unit meth
+  method info_2 : _ -> _ -> unit meth
 
-    method info_3 : _ -> _ -> _ -> unit meth
+  method info_3 : _ -> _ -> _ -> unit meth
 
-    method info_4 : _ -> _ -> _ -> _ -> unit meth
+  method info_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method info_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method info_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method warn : _ -> unit meth
+  method warn : _ -> unit meth
 
-    method warn_2 : _ -> _ -> unit meth
+  method warn_2 : _ -> _ -> unit meth
 
-    method warn_3 : _ -> _ -> _ -> unit meth
+  method warn_3 : _ -> _ -> _ -> unit meth
 
-    method warn_4 : _ -> _ -> _ -> _ -> unit meth
+  method warn_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method warn_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method warn_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method error : _ -> unit meth
+  method error : _ -> unit meth
 
-    method error_2 : _ -> _ -> unit meth
+  method error_2 : _ -> _ -> unit meth
 
-    method error_3 : _ -> _ -> _ -> unit meth
+  method error_3 : _ -> _ -> _ -> unit meth
 
-    method error_4 : _ -> _ -> _ -> _ -> unit meth
+  method error_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method error_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method error_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method assert_ : bool t -> unit meth
+  method assert_ : bool t -> unit meth
 
-    method assert_1 : bool t -> _ -> unit meth
+  method assert_1 : bool t -> _ -> unit meth
 
-    method assert_2 : bool t -> _ -> _ -> unit meth
+  method assert_2 : bool t -> _ -> _ -> unit meth
 
-    method assert_3 : bool t -> _ -> _ -> _ -> unit meth
+  method assert_3 : bool t -> _ -> _ -> _ -> unit meth
 
-    method assert_4 : bool t -> _ -> _ -> _ -> _ -> unit meth
+  method assert_4 : bool t -> _ -> _ -> _ -> _ -> unit meth
 
-    method assert_5 : bool t -> _ -> _ -> _ -> _ -> _ -> unit meth
+  method assert_5 : bool t -> _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method dir : _ -> unit meth
+  method dir : _ -> unit meth
 
-    method dirxml : Dom.node t -> unit meth
+  method dirxml : Dom.node t -> unit meth
 
-    method trace : unit meth
+  method trace : unit meth
 
-    method group : _ -> unit meth
+  method group : _ -> unit meth
 
-    method group_2 : _ -> _ -> unit meth
+  method group_2 : _ -> _ -> unit meth
 
-    method group_3 : _ -> _ -> _ -> unit meth
+  method group_3 : _ -> _ -> _ -> unit meth
 
-    method group_4 : _ -> _ -> _ -> _ -> unit meth
+  method group_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method group_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method group_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method groupCollapsed : _ -> unit meth
+  method groupCollapsed : _ -> unit meth
 
-    method groupCollapsed_2 : _ -> _ -> unit meth
+  method groupCollapsed_2 : _ -> _ -> unit meth
 
-    method groupCollapsed_3 : _ -> _ -> _ -> unit meth
+  method groupCollapsed_3 : _ -> _ -> _ -> unit meth
 
-    method groupCollapsed_4 : _ -> _ -> _ -> _ -> unit meth
+  method groupCollapsed_4 : _ -> _ -> _ -> _ -> unit meth
 
-    method groupCollapsed_5 : _ -> _ -> _ -> _ -> _ -> unit meth
+  method groupCollapsed_5 : _ -> _ -> _ -> _ -> _ -> unit meth
 
-    method groupEnd : unit meth
+  method groupEnd : unit meth
 
-    method time : js_string t -> unit meth
+  method time : js_string t -> unit meth
 
-    method timeEnd : js_string t -> unit meth
-  end
+  method timeEnd : js_string t -> unit meth
+end
 
 val console : console t
diff --git a/lib/js_of_ocaml/form.ml b/lib/js_of_ocaml/form.ml
index e6f676711f..0b7b3fa217 100644
--- a/lib/js_of_ocaml/form.ml
+++ b/lib/js_of_ocaml/form.ml
@@ -22,12 +22,11 @@ open Js
 open Dom_html
 open! Import
 
-class type formData =
-  object
-    method append : js_string t -> js_string t -> unit meth
+class type formData = object
+  method append : js_string t -> js_string t -> unit meth
 
-    method append_blob : js_string t -> File.blob t -> unit meth
-  end
+  method append_blob : js_string t -> File.blob t -> unit meth
+end
 
 let formData : formData t constr = Js.Unsafe.global##._FormData
 
@@ -50,14 +49,13 @@ let rec filter_map f = function
       | None -> filter_map f q
       | Some v' -> v' :: filter_map f q)
 
-class type submittableElement =
-  object
-    method disabled : bool t prop
+class type submittableElement = object
+  method disabled : bool t prop
 
-    method name : js_string t readonly_prop
+  method name : js_string t readonly_prop
 
-    method value : js_string t prop
-  end
+  method value : js_string t prop
+end
 
 let have_content (elt : submittableElement t) =
   elt##.name##.length > 0 && not (Js.to_bool elt##.disabled)
@@ -87,14 +85,13 @@ let get_select_val (elt : selectElement t) =
     else [ name, `String elt##.value ]
   else []
 
-class type file_input =
-  object
-    inherit inputElement
+class type file_input = object
+  inherit inputElement
 
-    method files : File.fileList t optdef readonly_prop
+  method files : File.fileList t optdef readonly_prop
 
-    method multiple : bool optdef readonly_prop
-  end
+  method multiple : bool optdef readonly_prop
+end
 
 let get_input_val ?(get = false) (elt : inputElement t) =
   if have_content (elt :> submittableElement t)
diff --git a/lib/js_of_ocaml/form.mli b/lib/js_of_ocaml/form.mli
index fddb1dd2c6..60247cc423 100644
--- a/lib/js_of_ocaml/form.mli
+++ b/lib/js_of_ocaml/form.mli
@@ -21,12 +21,11 @@
 open Js
 (** This module provides functions to manipulate forms. *)
 
-class type formData =
-  object
-    method append : js_string t -> js_string t -> unit meth
+class type formData = object
+  method append : js_string t -> js_string t -> unit meth
 
-    method append_blob : js_string t -> File.blob t -> unit meth
-  end
+  method append_blob : js_string t -> File.blob t -> unit meth
+end
 
 val formData : formData t constr
 
diff --git a/lib/js_of_ocaml/geolocation.ml b/lib/js_of_ocaml/geolocation.ml
index 5a4980c6e8..6e0d185ea1 100644
--- a/lib/js_of_ocaml/geolocation.ml
+++ b/lib/js_of_ocaml/geolocation.ml
@@ -22,68 +22,63 @@ type positionErrorCode
 
 type watchId
 
-class type coordinates =
-  object
-    method latitude : Js.number Js.t Js.readonly_prop
+class type coordinates = object
+  method latitude : Js.number Js.t Js.readonly_prop
 
-    method longitude : Js.number Js.t Js.readonly_prop
+  method longitude : Js.number Js.t Js.readonly_prop
 
-    method altitude : Js.number Js.t Js.opt Js.readonly_prop
+  method altitude : Js.number Js.t Js.opt Js.readonly_prop
 
-    method accuracy : Js.number Js.t Js.readonly_prop
+  method accuracy : Js.number Js.t Js.readonly_prop
 
-    method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
+  method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
 
-    method heading : Js.number Js.t Js.opt Js.readonly_prop
+  method heading : Js.number Js.t Js.opt Js.readonly_prop
 
-    method speed : Js.number Js.t Js.opt Js.readonly_prop
-  end
+  method speed : Js.number Js.t Js.opt Js.readonly_prop
+end
 
-class type position =
-  object
-    method coords : coordinates Js.t Js.readonly_prop
+class type position = object
+  method coords : coordinates Js.t Js.readonly_prop
 
-    method timestamp : Js.date Js.readonly_prop
-  end
+  method timestamp : Js.date Js.readonly_prop
+end
 
-class type positionOptions =
-  object
-    method enableHighAccuracy : bool Js.writeonly_prop
+class type positionOptions = object
+  method enableHighAccuracy : bool Js.writeonly_prop
 
-    method timeout : int Js.writeonly_prop
+  method timeout : int Js.writeonly_prop
 
-    method maximumAge : int Js.writeonly_prop
-  end
+  method maximumAge : int Js.writeonly_prop
+end
 
-class type positionError =
-  object
-    method _PERMISSION_DENIED_ : positionErrorCode Js.readonly_prop
+class type positionError = object
+  method _PERMISSION_DENIED_ : positionErrorCode Js.readonly_prop
 
-    method _POSITION_UNAVAILABLE_ : positionErrorCode Js.readonly_prop
+  method _POSITION_UNAVAILABLE_ : positionErrorCode Js.readonly_prop
 
-    method _TIMEOUT : positionErrorCode Js.readonly_prop
+  method _TIMEOUT : positionErrorCode Js.readonly_prop
 
-    method code : positionErrorCode Js.readonly_prop
+  method code : positionErrorCode Js.readonly_prop
 
-    method message : Js.js_string Js.t Js.readonly_prop
-  end
+  method message : Js.js_string Js.t Js.readonly_prop
+end
 
-class type geolocation =
-  object
-    method getCurrentPosition :
-         (position Js.t -> unit) Js.callback
-      -> (positionError Js.t -> unit) Js.callback
-      -> positionOptions Js.t
-      -> unit Js.meth
+class type geolocation = object
+  method getCurrentPosition :
+       (position Js.t -> unit) Js.callback
+    -> (positionError Js.t -> unit) Js.callback
+    -> positionOptions Js.t
+    -> unit Js.meth
 
-    method watchPosition :
-         (position Js.t -> unit) Js.callback
-      -> (positionError Js.t -> unit) Js.callback
-      -> positionOptions Js.t
-      -> watchId Js.meth
+  method watchPosition :
+       (position Js.t -> unit) Js.callback
+    -> (positionError Js.t -> unit) Js.callback
+    -> positionOptions Js.t
+    -> watchId Js.meth
 
-    method clearWatch : watchId -> unit Js.meth
-  end
+  method clearWatch : watchId -> unit Js.meth
+end
 
 let empty_position_options () = Js.Unsafe.obj [||]
 
diff --git a/lib/js_of_ocaml/geolocation.mli b/lib/js_of_ocaml/geolocation.mli
index 967f40f562..9e2561778d 100644
--- a/lib/js_of_ocaml/geolocation.mli
+++ b/lib/js_of_ocaml/geolocation.mli
@@ -44,68 +44,63 @@ type positionErrorCode
 
 type watchId
 
-class type coordinates =
-  object
-    method latitude : Js.number Js.t Js.readonly_prop
+class type coordinates = object
+  method latitude : Js.number Js.t Js.readonly_prop
 
-    method longitude : Js.number Js.t Js.readonly_prop
+  method longitude : Js.number Js.t Js.readonly_prop
 
-    method altitude : Js.number Js.t Js.opt Js.readonly_prop
+  method altitude : Js.number Js.t Js.opt Js.readonly_prop
 
-    method accuracy : Js.number Js.t Js.readonly_prop
+  method accuracy : Js.number Js.t Js.readonly_prop
 
-    method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
+  method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
 
-    method heading : Js.number Js.t Js.opt Js.readonly_prop
+  method heading : Js.number Js.t Js.opt Js.readonly_prop
 
-    method speed : Js.number Js.t Js.opt Js.readonly_prop
-  end
+  method speed : Js.number Js.t Js.opt Js.readonly_prop
+end
 
-class type position =
-  object
-    method coords : coordinates Js.t Js.readonly_prop
+class type position = object
+  method coords : coordinates Js.t Js.readonly_prop
 
-    method timestamp : Js.date Js.readonly_prop
-  end
+  method timestamp : Js.date Js.readonly_prop
+end
 
-class type positionOptions =
-  object
-    method enableHighAccuracy : bool Js.writeonly_prop
+class type positionOptions = object
+  method enableHighAccuracy : bool Js.writeonly_prop
 
-    method timeout : int Js.writeonly_prop
+  method timeout : int Js.writeonly_prop
 
-    method maximumAge : int Js.writeonly_prop
-  end
+  method maximumAge : int Js.writeonly_prop
+end
 
-class type positionError =
-  object
-    method _PERMISSION_DENIED_ : positionErrorCode Js.readonly_prop
+class type positionError = object
+  method _PERMISSION_DENIED_ : positionErrorCode Js.readonly_prop
 
-    method _POSITION_UNAVAILABLE_ : positionErrorCode Js.readonly_prop
+  method _POSITION_UNAVAILABLE_ : positionErrorCode Js.readonly_prop
 
-    method _TIMEOUT : positionErrorCode Js.readonly_prop
+  method _TIMEOUT : positionErrorCode Js.readonly_prop
 
-    method code : positionErrorCode Js.readonly_prop
+  method code : positionErrorCode Js.readonly_prop
 
-    method message : Js.js_string Js.t Js.readonly_prop
-  end
+  method message : Js.js_string Js.t Js.readonly_prop
+end
 
-class type geolocation =
-  object
-    method getCurrentPosition :
-         (position Js.t -> unit) Js.callback
-      -> (positionError Js.t -> unit) Js.callback
-      -> positionOptions Js.t
-      -> unit Js.meth
+class type geolocation = object
+  method getCurrentPosition :
+       (position Js.t -> unit) Js.callback
+    -> (positionError Js.t -> unit) Js.callback
+    -> positionOptions Js.t
+    -> unit Js.meth
 
-    method watchPosition :
-         (position Js.t -> unit) Js.callback
-      -> (positionError Js.t -> unit) Js.callback
-      -> positionOptions Js.t
-      -> watchId Js.meth
+  method watchPosition :
+       (position Js.t -> unit) Js.callback
+    -> (positionError Js.t -> unit) Js.callback
+    -> positionOptions Js.t
+    -> watchId Js.meth
 
-    method clearWatch : watchId -> unit Js.meth
-  end
+  method clearWatch : watchId -> unit Js.meth
+end
 
 val empty_position_options : unit -> positionOptions Js.t
 
diff --git a/lib/js_of_ocaml/intersectionObserver.ml b/lib/js_of_ocaml/intersectionObserver.ml
index 1202b54598..d802652561 100644
--- a/lib/js_of_ocaml/intersectionObserver.ml
+++ b/lib/js_of_ocaml/intersectionObserver.ml
@@ -1,45 +1,42 @@
-class type intersectionObserverEntry =
-  object
-    method target : Dom.node Js.t Js.readonly_prop
+class type intersectionObserverEntry = object
+  method target : Dom.node Js.t Js.readonly_prop
 
-    method boundingClientRect : Dom_html.clientRect Js.t Js.readonly_prop
+  method boundingClientRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method rootBounds : Dom_html.clientRect Js.t Js.opt Js.readonly_prop
+  method rootBounds : Dom_html.clientRect Js.t Js.opt Js.readonly_prop
 
-    method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
+  method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method intersectionRatio : Js.number Js.t Js.readonly_prop
+  method intersectionRatio : Js.number Js.t Js.readonly_prop
 
-    method isIntersecting : bool Js.t Js.readonly_prop
+  method isIntersecting : bool Js.t Js.readonly_prop
 
-    method time : Js.number Js.t Js.readonly_prop
-  end
+  method time : Js.number Js.t Js.readonly_prop
+end
 
-class type intersectionObserverOptions =
-  object
-    method root : Dom.node Js.t Js.writeonly_prop
+class type intersectionObserverOptions = object
+  method root : Dom.node Js.t Js.writeonly_prop
 
-    method rootMargin : Js.js_string Js.t Js.writeonly_prop
+  method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-    method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
-  end
+  method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
+end
 
-class type intersectionObserver =
-  object
-    method root : Dom.node Js.t Js.opt Js.readonly_prop
+class type intersectionObserver = object
+  method root : Dom.node Js.t Js.opt Js.readonly_prop
 
-    method rootMargin : Js.js_string Js.t Js.readonly_prop
+  method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-    method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
+  method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
 
-    method observe : #Dom.node Js.t -> unit Js.meth
+  method observe : #Dom.node Js.t -> unit Js.meth
 
-    method unobserve : #Dom.node Js.t -> unit Js.meth
+  method unobserve : #Dom.node Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
+  method disconnect : unit Js.meth
 
-    method takeRecords : intersectionObserverEntry Js.t Js.js_array Js.meth
-  end
+  method takeRecords : intersectionObserverEntry Js.t Js.js_array Js.meth
+end
 
 let empty_intersection_observer_options () : intersectionObserverOptions Js.t =
   Js.Unsafe.obj [||]
diff --git a/lib/js_of_ocaml/intersectionObserver.mli b/lib/js_of_ocaml/intersectionObserver.mli
index 0c9f5a026b..3a056608d4 100644
--- a/lib/js_of_ocaml/intersectionObserver.mli
+++ b/lib/js_of_ocaml/intersectionObserver.mli
@@ -4,48 +4,45 @@
 
     https://developer.mozilla.org/en-US/docs/Web/API/Intersection_Observer_API *)
 
-class type intersectionObserverEntry =
-  object
-    method target : Dom.node Js.t Js.readonly_prop
+class type intersectionObserverEntry = object
+  method target : Dom.node Js.t Js.readonly_prop
 
-    method boundingClientRect : Dom_html.clientRect Js.t Js.readonly_prop
+  method boundingClientRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method rootBounds : Dom_html.clientRect Js.t Js.opt Js.readonly_prop
+  method rootBounds : Dom_html.clientRect Js.t Js.opt Js.readonly_prop
 
-    method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
+  method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method intersectionRatio : Js.number Js.t Js.readonly_prop
+  method intersectionRatio : Js.number Js.t Js.readonly_prop
 
-    method isIntersecting : bool Js.t Js.readonly_prop
+  method isIntersecting : bool Js.t Js.readonly_prop
 
-    method time : Js.number Js.t Js.readonly_prop
-  end
+  method time : Js.number Js.t Js.readonly_prop
+end
 
-class type intersectionObserverOptions =
-  object
-    method root : Dom.node Js.t Js.writeonly_prop
+class type intersectionObserverOptions = object
+  method root : Dom.node Js.t Js.writeonly_prop
 
-    method rootMargin : Js.js_string Js.t Js.writeonly_prop
+  method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-    method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
-  end
+  method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
+end
 
-class type intersectionObserver =
-  object
-    method root : Dom.node Js.t Js.opt Js.readonly_prop
+class type intersectionObserver = object
+  method root : Dom.node Js.t Js.opt Js.readonly_prop
 
-    method rootMargin : Js.js_string Js.t Js.readonly_prop
+  method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-    method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
+  method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
 
-    method observe : #Dom.node Js.t -> unit Js.meth
+  method observe : #Dom.node Js.t -> unit Js.meth
 
-    method unobserve : #Dom.node Js.t -> unit Js.meth
+  method unobserve : #Dom.node Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
+  method disconnect : unit Js.meth
 
-    method takeRecords : intersectionObserverEntry Js.t Js.js_array Js.meth
-  end
+  method takeRecords : intersectionObserverEntry Js.t Js.js_array Js.meth
+end
 
 val empty_intersection_observer_options : unit -> intersectionObserverOptions Js.t
 
diff --git a/lib/js_of_ocaml/intl.ml b/lib/js_of_ocaml/intl.ml
index 4a9c8a1741..6a71b5d2cb 100644
--- a/lib/js_of_ocaml/intl.ml
+++ b/lib/js_of_ocaml/intl.ml
@@ -19,76 +19,70 @@
 open! Import
 
 module type Shared = sig
-  class type object_options =
-    object
-      method localeMatcher : Js.js_string Js.t Js.prop
-    end
+  class type object_options = object
+    method localeMatcher : Js.js_string Js.t Js.prop
+  end
 
   val object_options : unit -> object_options Js.t
 
-  class type _object =
-    object
-      method supportedLocalesOf :
-           Js.js_string Js.t Js.js_array Js.t
-        -> object_options Js.t Js.optdef
-        -> Js.js_string Js.t Js.js_array Js.t Js.meth
-    end
+  class type _object = object
+    method supportedLocalesOf :
+         Js.js_string Js.t Js.js_array Js.t
+      -> object_options Js.t Js.optdef
+      -> Js.js_string Js.t Js.js_array Js.t Js.meth
+  end
 end
 
 module Shared : Shared = struct
-  class type object_options =
-    object
-      method localeMatcher : Js.js_string Js.t Js.prop
-    end
+  class type object_options = object
+    method localeMatcher : Js.js_string Js.t Js.prop
+  end
 
   let object_options () =
     object%js
       val mutable localeMatcher = Js.string "best fit"
     end
 
-  class type _object =
-    object
-      method supportedLocalesOf :
-           Js.js_string Js.t Js.js_array Js.t
-        -> object_options Js.t Js.optdef
-        -> Js.js_string Js.t Js.js_array Js.t Js.meth
-    end
+  class type _object = object
+    method supportedLocalesOf :
+         Js.js_string Js.t Js.js_array Js.t
+      -> object_options Js.t Js.optdef
+      -> Js.js_string Js.t Js.js_array Js.t Js.meth
+  end
 end
 
 module Collator = struct
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method usage : Js.js_string Js.t Js.readonly_prop
+    method usage : Js.js_string Js.t Js.readonly_prop
 
-      method sensitivity : Js.js_string Js.t Js.readonly_prop
+    method sensitivity : Js.js_string Js.t Js.readonly_prop
 
-      method ignorePunctuation : bool Js.t Js.readonly_prop
+    method ignorePunctuation : bool Js.t Js.readonly_prop
 
-      method collation : Js.js_string Js.t Js.readonly_prop
+    method collation : Js.js_string Js.t Js.readonly_prop
 
-      method numeric : bool Js.t Js.readonly_prop
+    method numeric : bool Js.t Js.readonly_prop
 
-      method caseFirst : Js.js_string Js.t Js.readonly_prop
-    end
+    method caseFirst : Js.js_string Js.t Js.readonly_prop
+  end
 
-  class type options =
-    object
-      method localeMatcher : Js.js_string Js.t Js.prop
+  class type options = object
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method usage : Js.js_string Js.t Js.prop
+    method usage : Js.js_string Js.t Js.prop
 
-      method sensitivity : Js.js_string Js.t Js.prop
+    method sensitivity : Js.js_string Js.t Js.prop
 
-      method ignorePunctuation : bool Js.t Js.prop
+    method ignorePunctuation : bool Js.t Js.prop
 
-      method numeric : bool Js.t Js.prop
+    method numeric : bool Js.t Js.prop
 
-      method caseFirst : Js.js_string Js.t Js.prop
-    end
+    method caseFirst : Js.js_string Js.t Js.prop
+  end
 
   let options () =
     object%js
@@ -105,90 +99,87 @@ module Collator = struct
       val mutable caseFirst = Js.string "false"
     end
 
-  class type t =
-    object
-      method compare : (Js.js_string Js.t -> Js.js_string Js.t -> int) Js.readonly_prop
+  class type t = object
+    method compare : (Js.js_string Js.t -> Js.js_string Js.t -> int) Js.readonly_prop
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
 module DateTimeFormat = struct
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method calendar : Js.js_string Js.t Js.readonly_prop
+    method calendar : Js.js_string Js.t Js.readonly_prop
 
-      method numberingSystem : Js.js_string Js.t Js.readonly_prop
+    method numberingSystem : Js.js_string Js.t Js.readonly_prop
 
-      method timeZone : Js.js_string Js.t Js.readonly_prop
+    method timeZone : Js.js_string Js.t Js.readonly_prop
 
-      method hour12 : bool Js.t Js.readonly_prop
+    method hour12 : bool Js.t Js.readonly_prop
 
-      method weekday : Js.js_string Js.t Js.optdef_prop
+    method weekday : Js.js_string Js.t Js.optdef_prop
 
-      method era : Js.js_string Js.t Js.optdef_prop
+    method era : Js.js_string Js.t Js.optdef_prop
 
-      method year : Js.js_string Js.t Js.optdef_prop
+    method year : Js.js_string Js.t Js.optdef_prop
 
-      method month : Js.js_string Js.t Js.optdef_prop
+    method month : Js.js_string Js.t Js.optdef_prop
 
-      method day : Js.js_string Js.t Js.optdef_prop
+    method day : Js.js_string Js.t Js.optdef_prop
 
-      method hour : Js.js_string Js.t Js.optdef_prop
+    method hour : Js.js_string Js.t Js.optdef_prop
 
-      method minute : Js.js_string Js.t Js.optdef_prop
+    method minute : Js.js_string Js.t Js.optdef_prop
 
-      method second : Js.js_string Js.t Js.optdef_prop
+    method second : Js.js_string Js.t Js.optdef_prop
 
-      method timeZoneName : Js.js_string Js.t Js.optdef_prop
-    end
+    method timeZoneName : Js.js_string Js.t Js.optdef_prop
+  end
 
-  class type options =
-    object
-      method dateStyle : Js.js_string Js.t Js.optdef Js.prop
+  class type options = object
+    method dateStyle : Js.js_string Js.t Js.optdef Js.prop
 
-      method timeStyle : Js.js_string Js.t Js.optdef Js.prop
+    method timeStyle : Js.js_string Js.t Js.optdef Js.prop
 
-      method calendar : Js.js_string Js.t Js.optdef Js.prop
+    method calendar : Js.js_string Js.t Js.optdef Js.prop
 
-      method dayPeriod : Js.js_string Js.t Js.optdef Js.prop
+    method dayPeriod : Js.js_string Js.t Js.optdef Js.prop
 
-      method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
+    method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
 
-      method localeMatcher : Js.js_string Js.t Js.prop
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method timeZone : Js.js_string Js.t Js.optdef Js.prop
+    method timeZone : Js.js_string Js.t Js.optdef Js.prop
 
-      method hour12 : bool Js.t Js.optdef Js.prop
+    method hour12 : bool Js.t Js.optdef Js.prop
 
-      method hourCycle : Js.js_string Js.t Js.optdef Js.prop
+    method hourCycle : Js.js_string Js.t Js.optdef Js.prop
 
-      method formatMatcher : Js.js_string Js.t Js.prop
+    method formatMatcher : Js.js_string Js.t Js.prop
 
-      method weekday : Js.js_string Js.t Js.optdef Js.prop
+    method weekday : Js.js_string Js.t Js.optdef Js.prop
 
-      method era : Js.js_string Js.t Js.optdef Js.prop
+    method era : Js.js_string Js.t Js.optdef Js.prop
 
-      method year : Js.js_string Js.t Js.optdef Js.prop
+    method year : Js.js_string Js.t Js.optdef Js.prop
 
-      method month : Js.js_string Js.t Js.optdef Js.prop
+    method month : Js.js_string Js.t Js.optdef Js.prop
 
-      method day : Js.js_string Js.t Js.optdef Js.prop
+    method day : Js.js_string Js.t Js.optdef Js.prop
 
-      method hour : Js.js_string Js.t Js.optdef Js.prop
+    method hour : Js.js_string Js.t Js.optdef Js.prop
 
-      method minute : Js.js_string Js.t Js.optdef Js.prop
+    method minute : Js.js_string Js.t Js.optdef Js.prop
 
-      method second : Js.js_string Js.t Js.optdef Js.prop
+    method second : Js.js_string Js.t Js.optdef Js.prop
 
-      method fractionalSecondDigits : int Js.optdef Js.prop
+    method fractionalSecondDigits : int Js.optdef Js.prop
 
-      method timeZoneName : Js.js_string Js.t Js.optdef Js.prop
-    end
+    method timeZoneName : Js.js_string Js.t Js.optdef Js.prop
+  end
 
   let options () : options Js.t =
     object%js
@@ -233,96 +224,92 @@ module DateTimeFormat = struct
       val mutable timeZoneName = Js.undefined
     end
 
-  class type format_part =
-    object
-      method _type : Js.js_string Js.t Js.readonly_prop
+  class type format_part = object
+    method _type : Js.js_string Js.t Js.readonly_prop
 
-      method _value : Js.js_string Js.t Js.readonly_prop
-    end
+    method _value : Js.js_string Js.t Js.readonly_prop
+  end
 
-  class type t =
-    object
-      method format : (Js.date Js.t -> Js.js_string Js.t) Js.readonly_prop
+  class type t = object
+    method format : (Js.date Js.t -> Js.js_string Js.t) Js.readonly_prop
 
-      method formatToParts :
-        Js.date Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
+    method formatToParts :
+      Js.date Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
 module NumberFormat = struct
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method numberingSystem : Js.js_string Js.t Js.readonly_prop
+    method numberingSystem : Js.js_string Js.t Js.readonly_prop
 
-      method style : Js.js_string Js.t Js.readonly_prop
+    method style : Js.js_string Js.t Js.readonly_prop
 
-      method currency : Js.js_string Js.t Js.optdef_prop
+    method currency : Js.js_string Js.t Js.optdef_prop
 
-      method currencyDisplay : Js.js_string Js.t Js.optdef_prop
+    method currencyDisplay : Js.js_string Js.t Js.optdef_prop
 
-      method useGrouping : bool Js.t Js.readonly_prop
+    method useGrouping : bool Js.t Js.readonly_prop
 
-      method minimumIntegerDigits : int Js.optdef_prop
+    method minimumIntegerDigits : int Js.optdef_prop
 
-      method minimumFractionDigits : int Js.optdef_prop
+    method minimumFractionDigits : int Js.optdef_prop
 
-      method maximumFractionDigits : int Js.optdef_prop
+    method maximumFractionDigits : int Js.optdef_prop
 
-      method minimumSignificantDigits : int Js.optdef_prop
+    method minimumSignificantDigits : int Js.optdef_prop
 
-      method maximumSignificantDigits : int Js.optdef_prop
-    end
+    method maximumSignificantDigits : int Js.optdef_prop
+  end
 
-  class type options =
-    object
-      method compactDisplay : Js.js_string Js.t Js.optdef Js.prop
+  class type options = object
+    method compactDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method currency : Js.js_string Js.t Js.optdef Js.prop
+    method currency : Js.js_string Js.t Js.optdef Js.prop
 
-      method currencyDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method currencyDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method currencySign : Js.js_string Js.t Js.optdef Js.prop
+    method currencySign : Js.js_string Js.t Js.optdef Js.prop
 
-      method localeMatcher : Js.js_string Js.t Js.prop
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method notation : Js.js_string Js.t Js.optdef Js.prop
+    method notation : Js.js_string Js.t Js.optdef Js.prop
 
-      method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
+    method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
 
-      method signDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method signDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method style : Js.js_string Js.t Js.prop
+    method style : Js.js_string Js.t Js.prop
 
-      method unit : Js.js_string Js.t Js.optdef Js.prop
+    method unit : Js.js_string Js.t Js.optdef Js.prop
 
-      method unitDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method unitDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method useGrouping : bool Js.t Js.prop
+    method useGrouping : bool Js.t Js.prop
 
-      method roundingMode : Js.js_string Js.t Js.optdef Js.prop
+    method roundingMode : Js.js_string Js.t Js.optdef Js.prop
 
-      method roundingPriority : Js.js_string Js.t Js.optdef Js.prop
+    method roundingPriority : Js.js_string Js.t Js.optdef Js.prop
 
-      method roundingIncrement : Js.js_string Js.t Js.optdef Js.prop
+    method roundingIncrement : Js.js_string Js.t Js.optdef Js.prop
 
-      method trailingZeroDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method trailingZeroDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method minimumIntegerDigits : int Js.optdef Js.prop
+    method minimumIntegerDigits : int Js.optdef Js.prop
 
-      method minimumFractionDigits : int Js.optdef Js.prop
+    method minimumFractionDigits : int Js.optdef Js.prop
 
-      method maximumFractionDigits : int Js.optdef Js.prop
+    method maximumFractionDigits : int Js.optdef Js.prop
 
-      method minimumSignificantDigits : int Js.optdef Js.prop
+    method minimumSignificantDigits : int Js.optdef Js.prop
 
-      method maximumSignificantDigits : int Js.optdef Js.prop
-    end
+    method maximumSignificantDigits : int Js.optdef Js.prop
+  end
 
   let options () : options Js.t =
     object%js
@@ -369,52 +356,48 @@ module NumberFormat = struct
       val mutable maximumSignificantDigits = Js.undefined
     end
 
-  class type format_part =
-    object
-      method _type : Js.js_string Js.t Js.readonly_prop
+  class type format_part = object
+    method _type : Js.js_string Js.t Js.readonly_prop
 
-      method _value : Js.js_string Js.t Js.readonly_prop
-    end
+    method _value : Js.js_string Js.t Js.readonly_prop
+  end
 
-  class type t =
-    object
-      method format : (Js.number Js.t -> Js.js_string Js.t) Js.readonly_prop
+  class type t = object
+    method format : (Js.number Js.t -> Js.js_string Js.t) Js.readonly_prop
 
-      method formatToParts :
-        Js.number Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
+    method formatToParts :
+      Js.number Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
 module PluralRules = struct
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method pluralCategories : Js.js_string Js.t Js.js_array Js.t Js.readonly_prop
+    method pluralCategories : Js.js_string Js.t Js.js_array Js.t Js.readonly_prop
 
-      method _type : Js.js_string Js.t Js.readonly_prop
+    method _type : Js.js_string Js.t Js.readonly_prop
 
-      method minimumIntegerDigits : int Js.optdef_prop
+    method minimumIntegerDigits : int Js.optdef_prop
 
-      method minimumFractionDigits : int Js.optdef_prop
+    method minimumFractionDigits : int Js.optdef_prop
 
-      method maximumFractionDigits : int Js.optdef_prop
+    method maximumFractionDigits : int Js.optdef_prop
 
-      method minimumSignificantDigits : int Js.optdef_prop
+    method minimumSignificantDigits : int Js.optdef_prop
 
-      method maximumSignificantDigits : int Js.optdef_prop
-    end
+    method maximumSignificantDigits : int Js.optdef_prop
+  end
 
-  class type options =
-    object
-      method localeMatcher : Js.js_string Js.t Js.prop
+  class type options = object
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method _type : Js.js_string Js.t Js.prop
-    end
+    method _type : Js.js_string Js.t Js.prop
+  end
 
   let options () : options Js.t =
     object%js
@@ -423,27 +406,25 @@ module PluralRules = struct
       val mutable _type = Js.string "cardinal"
     end
 
-  class type t =
-    object
-      method select : Js.number Js.t -> Js.js_string Js.t Js.meth
+  class type t = object
+    method select : Js.number Js.t -> Js.js_string Js.t Js.meth
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
-class type intl =
-  object
-    method _Collator : Collator._object Js.t Js.readonly_prop
+class type intl = object
+  method _Collator : Collator._object Js.t Js.readonly_prop
 
-    method _DateTimeFormat : DateTimeFormat._object Js.t Js.readonly_prop
+  method _DateTimeFormat : DateTimeFormat._object Js.t Js.readonly_prop
 
-    method _NumberFormat : NumberFormat._object Js.t Js.readonly_prop
+  method _NumberFormat : NumberFormat._object Js.t Js.readonly_prop
 
-    method _PluralRules : PluralRules._object Js.t Js.readonly_prop
+  method _PluralRules : PluralRules._object Js.t Js.readonly_prop
 
-    method getCanonicalLocales :
-      Js.js_string Js.t Js.js_array Js.t -> Js.js_string Js.t Js.js_array Js.t Js.meth
-  end
+  method getCanonicalLocales :
+    Js.js_string Js.t Js.js_array Js.t -> Js.js_string Js.t Js.js_array Js.t Js.meth
+end
 
 let intl = Js.Unsafe.global##._Intl
 
diff --git a/lib/js_of_ocaml/intl.mli b/lib/js_of_ocaml/intl.mli
index 283ad5b785..c5a064fccf 100644
--- a/lib/js_of_ocaml/intl.mli
+++ b/lib/js_of_ocaml/intl.mli
@@ -420,309 +420,292 @@ if (Intl.is_supported()) then (
     @see <https://www.ecma-international.org/ecma-402/1.0/> for the ECMAScript specification. *)
 
 module type Shared = sig
-  class type object_options =
-    object
-      method localeMatcher : Js.js_string Js.t Js.prop
-    end
+  class type object_options = object
+    method localeMatcher : Js.js_string Js.t Js.prop
+  end
 
   val object_options : unit -> object_options Js.t
 
-  class type _object =
-    object
-      method supportedLocalesOf :
-           Js.js_string Js.t Js.js_array Js.t
-        -> object_options Js.t Js.optdef
-        -> Js.js_string Js.t Js.js_array Js.t Js.meth
-    end
+  class type _object = object
+    method supportedLocalesOf :
+         Js.js_string Js.t Js.js_array Js.t
+      -> object_options Js.t Js.optdef
+      -> Js.js_string Js.t Js.js_array Js.t Js.meth
+  end
 end
 
 module Collator : sig
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method usage : Js.js_string Js.t Js.readonly_prop
+    method usage : Js.js_string Js.t Js.readonly_prop
 
-      method sensitivity : Js.js_string Js.t Js.readonly_prop
+    method sensitivity : Js.js_string Js.t Js.readonly_prop
 
-      method ignorePunctuation : bool Js.t Js.readonly_prop
+    method ignorePunctuation : bool Js.t Js.readonly_prop
 
-      method collation : Js.js_string Js.t Js.readonly_prop
+    method collation : Js.js_string Js.t Js.readonly_prop
 
-      method numeric : bool Js.t Js.readonly_prop
+    method numeric : bool Js.t Js.readonly_prop
 
-      method caseFirst : Js.js_string Js.t Js.readonly_prop
-    end
+    method caseFirst : Js.js_string Js.t Js.readonly_prop
+  end
 
-  class type options =
-    object
-      method localeMatcher : Js.js_string Js.t Js.prop
+  class type options = object
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method usage : Js.js_string Js.t Js.prop
+    method usage : Js.js_string Js.t Js.prop
 
-      method sensitivity : Js.js_string Js.t Js.prop
+    method sensitivity : Js.js_string Js.t Js.prop
 
-      method ignorePunctuation : bool Js.t Js.prop
+    method ignorePunctuation : bool Js.t Js.prop
 
-      method numeric : bool Js.t Js.prop
+    method numeric : bool Js.t Js.prop
 
-      method caseFirst : Js.js_string Js.t Js.prop
-    end
+    method caseFirst : Js.js_string Js.t Js.prop
+  end
 
   val options : unit -> options Js.t
 
-  class type t =
-    object
-      method compare : (Js.js_string Js.t -> Js.js_string Js.t -> int) Js.readonly_prop
+  class type t = object
+    method compare : (Js.js_string Js.t -> Js.js_string Js.t -> int) Js.readonly_prop
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
 module DateTimeFormat : sig
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method calendar : Js.js_string Js.t Js.readonly_prop
+    method calendar : Js.js_string Js.t Js.readonly_prop
 
-      method numberingSystem : Js.js_string Js.t Js.readonly_prop
+    method numberingSystem : Js.js_string Js.t Js.readonly_prop
 
-      method timeZone : Js.js_string Js.t Js.readonly_prop
+    method timeZone : Js.js_string Js.t Js.readonly_prop
 
-      method hour12 : bool Js.t Js.readonly_prop
+    method hour12 : bool Js.t Js.readonly_prop
 
-      method weekday : Js.js_string Js.t Js.optdef_prop
+    method weekday : Js.js_string Js.t Js.optdef_prop
 
-      method era : Js.js_string Js.t Js.optdef_prop
+    method era : Js.js_string Js.t Js.optdef_prop
 
-      method year : Js.js_string Js.t Js.optdef_prop
+    method year : Js.js_string Js.t Js.optdef_prop
 
-      method month : Js.js_string Js.t Js.optdef_prop
+    method month : Js.js_string Js.t Js.optdef_prop
 
-      method day : Js.js_string Js.t Js.optdef_prop
+    method day : Js.js_string Js.t Js.optdef_prop
 
-      method hour : Js.js_string Js.t Js.optdef_prop
+    method hour : Js.js_string Js.t Js.optdef_prop
 
-      method minute : Js.js_string Js.t Js.optdef_prop
+    method minute : Js.js_string Js.t Js.optdef_prop
 
-      method second : Js.js_string Js.t Js.optdef_prop
+    method second : Js.js_string Js.t Js.optdef_prop
 
-      method timeZoneName : Js.js_string Js.t Js.optdef_prop
-    end
+    method timeZoneName : Js.js_string Js.t Js.optdef_prop
+  end
 
-  class type options =
-    object
-      method dateStyle : Js.js_string Js.t Js.optdef Js.prop
+  class type options = object
+    method dateStyle : Js.js_string Js.t Js.optdef Js.prop
 
-      method timeStyle : Js.js_string Js.t Js.optdef Js.prop
+    method timeStyle : Js.js_string Js.t Js.optdef Js.prop
 
-      method calendar : Js.js_string Js.t Js.optdef Js.prop
+    method calendar : Js.js_string Js.t Js.optdef Js.prop
 
-      method dayPeriod : Js.js_string Js.t Js.optdef Js.prop
+    method dayPeriod : Js.js_string Js.t Js.optdef Js.prop
 
-      method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
+    method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
 
-      method localeMatcher : Js.js_string Js.t Js.prop
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method timeZone : Js.js_string Js.t Js.optdef Js.prop
+    method timeZone : Js.js_string Js.t Js.optdef Js.prop
 
-      method hour12 : bool Js.t Js.optdef Js.prop
+    method hour12 : bool Js.t Js.optdef Js.prop
 
-      method hourCycle : Js.js_string Js.t Js.optdef Js.prop
+    method hourCycle : Js.js_string Js.t Js.optdef Js.prop
 
-      method formatMatcher : Js.js_string Js.t Js.prop
+    method formatMatcher : Js.js_string Js.t Js.prop
 
-      method weekday : Js.js_string Js.t Js.optdef Js.prop
+    method weekday : Js.js_string Js.t Js.optdef Js.prop
 
-      method era : Js.js_string Js.t Js.optdef Js.prop
+    method era : Js.js_string Js.t Js.optdef Js.prop
 
-      method year : Js.js_string Js.t Js.optdef Js.prop
+    method year : Js.js_string Js.t Js.optdef Js.prop
 
-      method month : Js.js_string Js.t Js.optdef Js.prop
+    method month : Js.js_string Js.t Js.optdef Js.prop
 
-      method day : Js.js_string Js.t Js.optdef Js.prop
+    method day : Js.js_string Js.t Js.optdef Js.prop
 
-      method hour : Js.js_string Js.t Js.optdef Js.prop
+    method hour : Js.js_string Js.t Js.optdef Js.prop
 
-      method minute : Js.js_string Js.t Js.optdef Js.prop
+    method minute : Js.js_string Js.t Js.optdef Js.prop
 
-      method second : Js.js_string Js.t Js.optdef Js.prop
+    method second : Js.js_string Js.t Js.optdef Js.prop
 
-      method fractionalSecondDigits : int Js.optdef Js.prop
+    method fractionalSecondDigits : int Js.optdef Js.prop
 
-      method timeZoneName : Js.js_string Js.t Js.optdef Js.prop
-    end
+    method timeZoneName : Js.js_string Js.t Js.optdef Js.prop
+  end
 
   val options : unit -> options Js.t
 
-  class type format_part =
-    object
-      method _type : Js.js_string Js.t Js.readonly_prop
+  class type format_part = object
+    method _type : Js.js_string Js.t Js.readonly_prop
 
-      method _value : Js.js_string Js.t Js.readonly_prop
-    end
+    method _value : Js.js_string Js.t Js.readonly_prop
+  end
 
-  class type t =
-    object
-      method format : (Js.date Js.t -> Js.js_string Js.t) Js.readonly_prop
+  class type t = object
+    method format : (Js.date Js.t -> Js.js_string Js.t) Js.readonly_prop
 
-      method formatToParts :
-        Js.date Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
+    method formatToParts :
+      Js.date Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
 module NumberFormat : sig
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method numberingSystem : Js.js_string Js.t Js.readonly_prop
+    method numberingSystem : Js.js_string Js.t Js.readonly_prop
 
-      method style : Js.js_string Js.t Js.readonly_prop
+    method style : Js.js_string Js.t Js.readonly_prop
 
-      method currency : Js.js_string Js.t Js.optdef_prop
+    method currency : Js.js_string Js.t Js.optdef_prop
 
-      method currencyDisplay : Js.js_string Js.t Js.optdef_prop
+    method currencyDisplay : Js.js_string Js.t Js.optdef_prop
 
-      method useGrouping : bool Js.t Js.readonly_prop
+    method useGrouping : bool Js.t Js.readonly_prop
 
-      method minimumIntegerDigits : int Js.optdef_prop
+    method minimumIntegerDigits : int Js.optdef_prop
 
-      method minimumFractionDigits : int Js.optdef_prop
+    method minimumFractionDigits : int Js.optdef_prop
 
-      method maximumFractionDigits : int Js.optdef_prop
+    method maximumFractionDigits : int Js.optdef_prop
 
-      method minimumSignificantDigits : int Js.optdef_prop
+    method minimumSignificantDigits : int Js.optdef_prop
 
-      method maximumSignificantDigits : int Js.optdef_prop
-    end
+    method maximumSignificantDigits : int Js.optdef_prop
+  end
 
-  class type options =
-    object
-      method compactDisplay : Js.js_string Js.t Js.optdef Js.prop
+  class type options = object
+    method compactDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method currency : Js.js_string Js.t Js.optdef Js.prop
+    method currency : Js.js_string Js.t Js.optdef Js.prop
 
-      method currencyDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method currencyDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method currencySign : Js.js_string Js.t Js.optdef Js.prop
+    method currencySign : Js.js_string Js.t Js.optdef Js.prop
 
-      method localeMatcher : Js.js_string Js.t Js.prop
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method notation : Js.js_string Js.t Js.optdef Js.prop
+    method notation : Js.js_string Js.t Js.optdef Js.prop
 
-      method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
+    method numberingSystem : Js.js_string Js.t Js.optdef Js.prop
 
-      method signDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method signDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method style : Js.js_string Js.t Js.prop
+    method style : Js.js_string Js.t Js.prop
 
-      method unit : Js.js_string Js.t Js.optdef Js.prop
+    method unit : Js.js_string Js.t Js.optdef Js.prop
 
-      method unitDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method unitDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method useGrouping : bool Js.t Js.prop
+    method useGrouping : bool Js.t Js.prop
 
-      method roundingMode : Js.js_string Js.t Js.optdef Js.prop
+    method roundingMode : Js.js_string Js.t Js.optdef Js.prop
 
-      method roundingPriority : Js.js_string Js.t Js.optdef Js.prop
+    method roundingPriority : Js.js_string Js.t Js.optdef Js.prop
 
-      method roundingIncrement : Js.js_string Js.t Js.optdef Js.prop
+    method roundingIncrement : Js.js_string Js.t Js.optdef Js.prop
 
-      method trailingZeroDisplay : Js.js_string Js.t Js.optdef Js.prop
+    method trailingZeroDisplay : Js.js_string Js.t Js.optdef Js.prop
 
-      method minimumIntegerDigits : int Js.optdef Js.prop
+    method minimumIntegerDigits : int Js.optdef Js.prop
 
-      method minimumFractionDigits : int Js.optdef Js.prop
+    method minimumFractionDigits : int Js.optdef Js.prop
 
-      method maximumFractionDigits : int Js.optdef Js.prop
+    method maximumFractionDigits : int Js.optdef Js.prop
 
-      method minimumSignificantDigits : int Js.optdef Js.prop
+    method minimumSignificantDigits : int Js.optdef Js.prop
 
-      method maximumSignificantDigits : int Js.optdef Js.prop
-    end
+    method maximumSignificantDigits : int Js.optdef Js.prop
+  end
 
   val options : unit -> options Js.t
 
-  class type format_part =
-    object
-      method _type : Js.js_string Js.t Js.readonly_prop
+  class type format_part = object
+    method _type : Js.js_string Js.t Js.readonly_prop
 
-      method _value : Js.js_string Js.t Js.readonly_prop
-    end
+    method _value : Js.js_string Js.t Js.readonly_prop
+  end
 
-  class type t =
-    object
-      method format : (Js.number Js.t -> Js.js_string Js.t) Js.readonly_prop
+  class type t = object
+    method format : (Js.number Js.t -> Js.js_string Js.t) Js.readonly_prop
 
-      method formatToParts :
-        Js.number Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
+    method formatToParts :
+      Js.number Js.t Js.optdef -> format_part Js.t Js.js_array Js.t Js.meth
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
 module PluralRules : sig
   include Shared
 
-  class type resolved_options =
-    object
-      method locale : Js.js_string Js.t Js.readonly_prop
+  class type resolved_options = object
+    method locale : Js.js_string Js.t Js.readonly_prop
 
-      method pluralCategories : Js.js_string Js.t Js.js_array Js.t Js.readonly_prop
+    method pluralCategories : Js.js_string Js.t Js.js_array Js.t Js.readonly_prop
 
-      method _type : Js.js_string Js.t Js.readonly_prop
+    method _type : Js.js_string Js.t Js.readonly_prop
 
-      method minimumIntegerDigits : int Js.optdef_prop
+    method minimumIntegerDigits : int Js.optdef_prop
 
-      method minimumFractionDigits : int Js.optdef_prop
+    method minimumFractionDigits : int Js.optdef_prop
 
-      method maximumFractionDigits : int Js.optdef_prop
+    method maximumFractionDigits : int Js.optdef_prop
 
-      method minimumSignificantDigits : int Js.optdef_prop
+    method minimumSignificantDigits : int Js.optdef_prop
 
-      method maximumSignificantDigits : int Js.optdef_prop
-    end
+    method maximumSignificantDigits : int Js.optdef_prop
+  end
 
-  class type options =
-    object
-      method localeMatcher : Js.js_string Js.t Js.prop
+  class type options = object
+    method localeMatcher : Js.js_string Js.t Js.prop
 
-      method _type : Js.js_string Js.t Js.prop
-    end
+    method _type : Js.js_string Js.t Js.prop
+  end
 
   val options : unit -> options Js.t
 
-  class type t =
-    object
-      method select : Js.number Js.t -> Js.js_string Js.t Js.meth
+  class type t = object
+    method select : Js.number Js.t -> Js.js_string Js.t Js.meth
 
-      method resolvedOptions : unit -> resolved_options Js.t Js.meth
-    end
+    method resolvedOptions : unit -> resolved_options Js.t Js.meth
+  end
 end
 
-class type intl =
-  object
-    method _Collator : Collator._object Js.t Js.readonly_prop
+class type intl = object
+  method _Collator : Collator._object Js.t Js.readonly_prop
 
-    method _DateTimeFormat : DateTimeFormat._object Js.t Js.readonly_prop
+  method _DateTimeFormat : DateTimeFormat._object Js.t Js.readonly_prop
 
-    method _NumberFormat : NumberFormat._object Js.t Js.readonly_prop
+  method _NumberFormat : NumberFormat._object Js.t Js.readonly_prop
 
-    method _PluralRules : PluralRules._object Js.t Js.readonly_prop
+  method _PluralRules : PluralRules._object Js.t Js.readonly_prop
 
-    method getCanonicalLocales :
-      Js.js_string Js.t Js.js_array Js.t -> Js.js_string Js.t Js.js_array Js.t Js.meth
-  end
+  method getCanonicalLocales :
+    Js.js_string Js.t Js.js_array Js.t -> Js.js_string Js.t Js.js_array Js.t Js.meth
+end
 
 val intl : intl Js.t
 
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index 032c1c0cd8..a8e432c120 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -244,112 +244,109 @@ module Js = struct
 
   type string_array
 
-  class type number =
-    object
-      method toString : js_string t meth
+  class type number = object
+    method toString : js_string t meth
 
-      method toString_radix : int -> js_string t meth
+    method toString_radix : int -> js_string t meth
 
-      method toLocaleString : js_string t meth
+    method toLocaleString : js_string t meth
 
-      method toFixed : int -> js_string t meth
+    method toFixed : int -> js_string t meth
 
-      method toExponential : js_string t meth
+    method toExponential : js_string t meth
 
-      method toExponential_digits : int -> js_string t meth
+    method toExponential_digits : int -> js_string t meth
 
-      method toPrecision : int -> js_string t meth
-    end
+    method toPrecision : int -> js_string t meth
+  end
 
-  and js_string =
-    object
-      method toString : js_string t meth
+  and js_string = object
+    method toString : js_string t meth
 
-      method valueOf : js_string t meth
+    method valueOf : js_string t meth
 
-      method charAt : int -> js_string t meth
+    method charAt : int -> js_string t meth
 
-      method charCodeAt : int -> number t meth
+    method charCodeAt : int -> number t meth
 
-      (* This may return NaN... *)
-      method concat : js_string t -> js_string t meth
+    (* This may return NaN... *)
+    method concat : js_string t -> js_string t meth
 
-      method concat_2 : js_string t -> js_string t -> js_string t meth
+    method concat_2 : js_string t -> js_string t -> js_string t meth
 
-      method concat_3 : js_string t -> js_string t -> js_string t -> js_string t meth
+    method concat_3 : js_string t -> js_string t -> js_string t -> js_string t meth
 
-      method concat_4 :
-        js_string t -> js_string t -> js_string t -> js_string t -> js_string t meth
+    method concat_4 :
+      js_string t -> js_string t -> js_string t -> js_string t -> js_string t meth
 
-      method indexOf : js_string t -> int meth
+    method indexOf : js_string t -> int meth
 
-      method indexOf_from : js_string t -> int -> int meth
+    method indexOf_from : js_string t -> int -> int meth
 
-      method lastIndexOf : js_string t -> int meth
+    method lastIndexOf : js_string t -> int meth
 
-      method lastIndexOf_from : js_string t -> int -> int meth
+    method lastIndexOf_from : js_string t -> int -> int meth
 
-      method localeCompare : js_string t -> number t meth
+    method localeCompare : js_string t -> number t meth
 
-      method _match : regExp t -> match_result_handle t opt meth
+    method _match : regExp t -> match_result_handle t opt meth
 
-      method normalize : js_string t meth
+    method normalize : js_string t meth
 
-      method normalize_form : normalization t -> js_string t meth
+    method normalize_form : normalization t -> js_string t meth
 
-      method replace : regExp t -> js_string t -> js_string t meth
+    method replace : regExp t -> js_string t -> js_string t meth
 
-      method replace_string : js_string t -> js_string t -> js_string t meth
+    method replace_string : js_string t -> js_string t -> js_string t meth
 
-      method search : regExp t -> int meth
+    method search : regExp t -> int meth
 
-      method slice : int -> int -> js_string t meth
+    method slice : int -> int -> js_string t meth
 
-      method slice_end : int -> js_string t meth
+    method slice_end : int -> js_string t meth
 
-      method split : js_string t -> string_array t meth
+    method split : js_string t -> string_array t meth
 
-      method split_limited : js_string t -> int -> string_array t meth
+    method split_limited : js_string t -> int -> string_array t meth
 
-      method split_regExp : regExp t -> string_array t meth
+    method split_regExp : regExp t -> string_array t meth
 
-      method split_regExpLimited : regExp t -> int -> string_array t meth
+    method split_regExpLimited : regExp t -> int -> string_array t meth
 
-      method substring : int -> int -> js_string t meth
+    method substring : int -> int -> js_string t meth
 
-      method substring_toEnd : int -> js_string t meth
+    method substring_toEnd : int -> js_string t meth
 
-      method toLowerCase : js_string t meth
+    method toLowerCase : js_string t meth
 
-      method toLocaleLowerCase : js_string t meth
+    method toLocaleLowerCase : js_string t meth
 
-      method toUpperCase : js_string t meth
+    method toUpperCase : js_string t meth
 
-      method toLocaleUpperCase : js_string t meth
+    method toLocaleUpperCase : js_string t meth
 
-      method trim : js_string t meth
+    method trim : js_string t meth
 
-      method length : int readonly_prop
-    end
+    method length : int readonly_prop
+  end
 
-  and regExp =
-    object
-      method exec : js_string t -> match_result_handle t opt meth
+  and regExp = object
+    method exec : js_string t -> match_result_handle t opt meth
 
-      method test : js_string t -> bool t meth
+    method test : js_string t -> bool t meth
 
-      method toString : js_string t meth
+    method toString : js_string t meth
 
-      method source : js_string t readonly_prop
+    method source : js_string t readonly_prop
 
-      method global : bool t readonly_prop
+    method global : bool t readonly_prop
 
-      method ignoreCase : bool t readonly_prop
+    method ignoreCase : bool t readonly_prop
 
-      method multiline : bool t readonly_prop
+    method multiline : bool t readonly_prop
 
-      method lastIndex : int prop
-    end
+    method lastIndex : int prop
+  end
 
   and normalization = js_string
 
@@ -370,10 +367,9 @@ end
 
 include Js
 
-class type string_constr =
-  object
-    method fromCharCode : int -> js_string t meth
-  end
+class type string_constr = object
+  method fromCharCode : int -> js_string t meth
+end
 
 let string_constr = Unsafe.global##._String
 
@@ -383,78 +379,76 @@ let regExp_copy = regExp
 
 let regExp_withFlags = regExp
 
-class type ['a] js_array =
-  object
-    method toString : js_string t meth
+class type ['a] js_array = object
+  method toString : js_string t meth
 
-    method toLocaleString : js_string t meth
+  method toLocaleString : js_string t meth
 
-    method concat : 'a js_array t -> 'a js_array t meth
+  method concat : 'a js_array t -> 'a js_array t meth
 
-    method join : js_string t -> js_string t meth
+  method join : js_string t -> js_string t meth
 
-    method pop : 'a optdef meth
+  method pop : 'a optdef meth
 
-    method push : 'a -> int meth
+  method push : 'a -> int meth
 
-    method push_2 : 'a -> 'a -> int meth
+  method push_2 : 'a -> 'a -> int meth
 
-    method push_3 : 'a -> 'a -> 'a -> int meth
+  method push_3 : 'a -> 'a -> 'a -> int meth
 
-    method push_4 : 'a -> 'a -> 'a -> 'a -> int meth
+  method push_4 : 'a -> 'a -> 'a -> 'a -> int meth
 
-    method reverse : 'a js_array t meth
+  method reverse : 'a js_array t meth
 
-    method shift : 'a optdef meth
+  method shift : 'a optdef meth
 
-    method slice : int -> int -> 'a js_array t meth
+  method slice : int -> int -> 'a js_array t meth
 
-    method slice_end : int -> 'a js_array t meth
+  method slice_end : int -> 'a js_array t meth
 
-    method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
+  method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
 
-    method sort_asStrings : 'a js_array t meth
+  method sort_asStrings : 'a js_array t meth
 
-    method splice : int -> int -> 'a js_array t meth
+  method splice : int -> int -> 'a js_array t meth
 
-    method splice_1 : int -> int -> 'a -> 'a js_array t meth
+  method splice_1 : int -> int -> 'a -> 'a js_array t meth
 
-    method splice_2 : int -> int -> 'a -> 'a -> 'a js_array t meth
+  method splice_2 : int -> int -> 'a -> 'a -> 'a js_array t meth
 
-    method splice_3 : int -> int -> 'a -> 'a -> 'a -> 'a js_array t meth
+  method splice_3 : int -> int -> 'a -> 'a -> 'a -> 'a js_array t meth
 
-    method splice_4 : int -> int -> 'a -> 'a -> 'a -> 'a -> 'a js_array t meth
+  method splice_4 : int -> int -> 'a -> 'a -> 'a -> 'a -> 'a js_array t meth
 
-    method unshift : 'a -> int meth
+  method unshift : 'a -> int meth
 
-    method unshift_2 : 'a -> 'a -> int meth
+  method unshift_2 : 'a -> 'a -> int meth
 
-    method unshift_3 : 'a -> 'a -> 'a -> int meth
+  method unshift_3 : 'a -> 'a -> 'a -> int meth
 
-    method unshift_4 : 'a -> 'a -> 'a -> 'a -> int meth
+  method unshift_4 : 'a -> 'a -> 'a -> 'a -> int meth
 
-    method some : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
+  method some : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
 
-    method every : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
+  method every : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
 
-    method forEach : ('a -> int -> 'a js_array t -> unit) callback -> unit meth
+  method forEach : ('a -> int -> 'a js_array t -> unit) callback -> unit meth
 
-    method map : ('a -> int -> 'a js_array t -> 'b) callback -> 'b js_array t meth
+  method map : ('a -> int -> 'a js_array t -> 'b) callback -> 'b js_array t meth
 
-    method filter : ('a -> int -> 'a js_array t -> bool t) callback -> 'a js_array t meth
+  method filter : ('a -> int -> 'a js_array t -> bool t) callback -> 'a js_array t meth
 
-    method reduce_init :
-      ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
+  method reduce_init : ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
 
-    method reduce : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
+  method reduce : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
 
-    method reduceRight_init :
-      ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
+  method reduceRight_init :
+    ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
 
-    method reduceRight : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
+  method reduceRight : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
 
-    method length : int prop
-  end
+  method length : int prop
+end
 
 let object_constructor = Unsafe.global##._Object
 
@@ -478,14 +472,13 @@ let array_map f a = array_map_poly a (wrap_callback (fun x _idx _ -> f x))
 
 let array_mapi f a = array_map_poly a (wrap_callback (fun x idx _ -> f idx x))
 
-class type match_result =
-  object
-    inherit [js_string t] js_array
+class type match_result = object
+  inherit [js_string t] js_array
 
-    method index : int readonly_prop
+  method index : int readonly_prop
 
-    method input : js_string t readonly_prop
-  end
+  method input : js_string t readonly_prop
+end
 
 let str_array : string_array t -> js_string t js_array t = Unsafe.coerce
 
@@ -495,117 +488,115 @@ external number_of_float : float -> number t = "caml_js_from_float"
 
 external float_of_number : number t -> float = "caml_js_to_float"
 
-class type date =
-  object
-    method toString : js_string t meth
+class type date = object
+  method toString : js_string t meth
 
-    method toDateString : js_string t meth
+  method toDateString : js_string t meth
 
-    method toTimeString : js_string t meth
+  method toTimeString : js_string t meth
 
-    method toLocaleString : js_string t meth
+  method toLocaleString : js_string t meth
 
-    method toLocaleDateString : js_string t meth
+  method toLocaleDateString : js_string t meth
 
-    method toLocaleTimeString : js_string t meth
+  method toLocaleTimeString : js_string t meth
 
-    method valueOf : number t meth
+  method valueOf : number t meth
 
-    method getTime : number t meth
+  method getTime : number t meth
 
-    method getFullYear : int meth
+  method getFullYear : int meth
 
-    method getUTCFullYear : int meth
+  method getUTCFullYear : int meth
 
-    method getMonth : int meth
+  method getMonth : int meth
 
-    method getUTCMonth : int meth
+  method getUTCMonth : int meth
 
-    method getDate : int meth
+  method getDate : int meth
 
-    method getUTCDate : int meth
+  method getUTCDate : int meth
 
-    method getDay : int meth
+  method getDay : int meth
 
-    method getUTCDay : int meth
+  method getUTCDay : int meth
 
-    method getHours : int meth
+  method getHours : int meth
 
-    method getUTCHours : int meth
+  method getUTCHours : int meth
 
-    method getMinutes : int meth
+  method getMinutes : int meth
 
-    method getUTCMinutes : int meth
+  method getUTCMinutes : int meth
 
-    method getSeconds : int meth
+  method getSeconds : int meth
 
-    method getUTCSeconds : int meth
+  method getUTCSeconds : int meth
 
-    method getMilliseconds : int meth
+  method getMilliseconds : int meth
 
-    method getUTCMilliseconds : int meth
+  method getUTCMilliseconds : int meth
 
-    method getTimezoneOffset : int meth
+  method getTimezoneOffset : int meth
 
-    method setTime : number t -> number t meth
+  method setTime : number t -> number t meth
 
-    method setFullYear : int -> number t meth
+  method setFullYear : int -> number t meth
 
-    method setUTCFullYear : int -> number t meth
+  method setUTCFullYear : int -> number t meth
 
-    method setMonth : int -> number t meth
+  method setMonth : int -> number t meth
 
-    method setUTCMonth : int -> number t meth
+  method setUTCMonth : int -> number t meth
 
-    method setDate : int -> number t meth
+  method setDate : int -> number t meth
 
-    method setUTCDate : int -> number t meth
+  method setUTCDate : int -> number t meth
 
-    method setDay : int -> number t meth
+  method setDay : int -> number t meth
 
-    method setUTCDay : int -> number t meth
+  method setUTCDay : int -> number t meth
 
-    method setHours : int -> number t meth
+  method setHours : int -> number t meth
 
-    method setUTCHours : int -> number t meth
+  method setUTCHours : int -> number t meth
 
-    method setMinutes : int -> number t meth
+  method setMinutes : int -> number t meth
 
-    method setUTCMinutes : int -> number t meth
+  method setUTCMinutes : int -> number t meth
 
-    method setSeconds : int -> number t meth
+  method setSeconds : int -> number t meth
 
-    method setUTCSeconds : int -> number t meth
+  method setUTCSeconds : int -> number t meth
 
-    method setMilliseconds : int -> number t meth
+  method setMilliseconds : int -> number t meth
 
-    method setUTCMilliseconds : int -> number t meth
+  method setUTCMilliseconds : int -> number t meth
 
-    method toUTCString : js_string t meth
+  method toUTCString : js_string t meth
 
-    method toISOString : js_string t meth
+  method toISOString : js_string t meth
 
-    method toJSON : 'a -> js_string t meth
-  end
+  method toJSON : 'a -> js_string t meth
+end
 
-class type date_constr =
-  object
-    method parse : js_string t -> number t meth
+class type date_constr = object
+  method parse : js_string t -> number t meth
 
-    method _UTC_month : int -> int -> number t meth
+  method _UTC_month : int -> int -> number t meth
 
-    method _UTC_day : int -> int -> number t meth
+  method _UTC_day : int -> int -> number t meth
 
-    method _UTC_hour : int -> int -> int -> int -> number t meth
+  method _UTC_hour : int -> int -> int -> int -> number t meth
 
-    method _UTC_min : int -> int -> int -> int -> int -> number t meth
+  method _UTC_min : int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
 
-    method now : number t meth
-  end
+  method now : number t meth
+end
 
 let date_constr = Unsafe.global##._Date
 
@@ -628,81 +619,79 @@ let date_sec : (int -> int -> int -> int -> int -> int -> date t) constr = date_
 let date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr =
   date_constr
 
-class type math =
-  object
-    method _E : number t readonly_prop
+class type math = object
+  method _E : number t readonly_prop
 
-    method _LN2 : number t readonly_prop
+  method _LN2 : number t readonly_prop
 
-    method _LN10 : number t readonly_prop
+  method _LN10 : number t readonly_prop
 
-    method _LOG2E : number t readonly_prop
+  method _LOG2E : number t readonly_prop
 
-    method _LOG10E : number t readonly_prop
+  method _LOG10E : number t readonly_prop
 
-    method _PI : number t readonly_prop
+  method _PI : number t readonly_prop
 
-    method _SQRT1_2_ : number t readonly_prop
+  method _SQRT1_2_ : number t readonly_prop
 
-    method _SQRT2 : number t readonly_prop
+  method _SQRT2 : number t readonly_prop
 
-    method abs : number t -> number t meth
+  method abs : number t -> number t meth
 
-    method acos : number t -> number t meth
+  method acos : number t -> number t meth
 
-    method asin : number t -> number t meth
+  method asin : number t -> number t meth
 
-    method atan : number t -> number t meth
+  method atan : number t -> number t meth
 
-    method atan2 : number t -> number t -> number t meth
+  method atan2 : number t -> number t -> number t meth
 
-    method ceil : number t -> number t meth
+  method ceil : number t -> number t meth
 
-    method cos : number t -> number t meth
+  method cos : number t -> number t meth
 
-    method exp : number t -> number t meth
+  method exp : number t -> number t meth
 
-    method floor : number t -> number t meth
+  method floor : number t -> number t meth
 
-    method log : number t -> number t meth
+  method log : number t -> number t meth
 
-    method max : number t -> number t -> number t meth
+  method max : number t -> number t -> number t meth
 
-    method max_3 : number t -> number t -> number t -> number t meth
+  method max_3 : number t -> number t -> number t -> number t meth
 
-    method max_4 : number t -> number t -> number t -> number t -> number t meth
+  method max_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method min : number t -> number t -> number t meth
+  method min : number t -> number t -> number t meth
 
-    method min_3 : number t -> number t -> number t -> number t meth
+  method min_3 : number t -> number t -> number t -> number t meth
 
-    method min_4 : number t -> number t -> number t -> number t -> number t meth
+  method min_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method pow : number t -> number t -> number t meth
+  method pow : number t -> number t -> number t meth
 
-    method random : number t meth
+  method random : number t meth
 
-    method round : number t -> number t meth
+  method round : number t -> number t meth
 
-    method sin : number t -> number t meth
+  method sin : number t -> number t meth
 
-    method sqrt : number t -> number t meth
+  method sqrt : number t -> number t meth
 
-    method tan : number t -> number t meth
-  end
+  method tan : number t -> number t meth
+end
 
 let math = Unsafe.global##._Math
 
-class type error =
-  object
-    method name : js_string t prop
+class type error = object
+  method name : js_string t prop
 
-    method message : js_string t prop
+  method message : js_string t prop
 
-    method stack : js_string t optdef prop
+  method stack : js_string t optdef prop
 
-    method toString : js_string t meth
-  end
+  method toString : js_string t meth
+end
 
 let error_constr = Unsafe.global##._Error
 
@@ -754,12 +743,11 @@ let exn_with_js_backtrace = Js_error.attach_js_backtrace
 
 external js_error_of_exn : exn -> error t opt = "caml_js_error_of_exception"
 
-class type json =
-  object
-    method parse : js_string t -> 'a meth
+class type json = object
+  method parse : js_string t -> 'a meth
 
-    method stringify : 'a -> js_string t meth
-  end
+  method stringify : 'a -> js_string t meth
+end
 
 let _JSON : json t = Unsafe.global##._JSON
 
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index 3626cf281f..17d887827d 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -218,121 +218,117 @@ val nfkc : normalization t
 (** Compatibility Decomposition, followed by Canonical Composition *)
 
 (** Specification of Javascript number objects. *)
-class type number =
-  object
-    method toString : js_string t meth
+class type number = object
+  method toString : js_string t meth
 
-    method toString_radix : int -> js_string t meth
+  method toString_radix : int -> js_string t meth
 
-    method toLocaleString : js_string t meth
+  method toLocaleString : js_string t meth
 
-    method toFixed : int -> js_string t meth
+  method toFixed : int -> js_string t meth
 
-    method toExponential : js_string t meth
+  method toExponential : js_string t meth
 
-    method toExponential_digits : int -> js_string t meth
+  method toExponential_digits : int -> js_string t meth
 
-    method toPrecision : int -> js_string t meth
-  end
+  method toPrecision : int -> js_string t meth
+end
 
 (** Specification of Javascript string objects. *)
-and js_string =
-  object
-    method toString : js_string t meth
+and js_string = object
+  method toString : js_string t meth
 
-    method valueOf : js_string t meth
+  method valueOf : js_string t meth
 
-    method charAt : int -> js_string t meth
+  method charAt : int -> js_string t meth
 
-    method charCodeAt : int -> number t meth
+  method charCodeAt : int -> number t meth
 
-    (* This may return NaN... *)
-    method concat : js_string t -> js_string t meth
+  (* This may return NaN... *)
+  method concat : js_string t -> js_string t meth
 
-    method concat_2 : js_string t -> js_string t -> js_string t meth
+  method concat_2 : js_string t -> js_string t -> js_string t meth
 
-    method concat_3 : js_string t -> js_string t -> js_string t -> js_string t meth
+  method concat_3 : js_string t -> js_string t -> js_string t -> js_string t meth
 
-    method concat_4 :
-      js_string t -> js_string t -> js_string t -> js_string t -> js_string t meth
+  method concat_4 :
+    js_string t -> js_string t -> js_string t -> js_string t -> js_string t meth
 
-    method indexOf : js_string t -> int meth
+  method indexOf : js_string t -> int meth
 
-    method indexOf_from : js_string t -> int -> int meth
+  method indexOf_from : js_string t -> int -> int meth
 
-    method lastIndexOf : js_string t -> int meth
+  method lastIndexOf : js_string t -> int meth
 
-    method lastIndexOf_from : js_string t -> int -> int meth
+  method lastIndexOf_from : js_string t -> int -> int meth
 
-    method localeCompare : js_string t -> number t meth
+  method localeCompare : js_string t -> number t meth
 
-    method _match : regExp t -> match_result_handle t opt meth
+  method _match : regExp t -> match_result_handle t opt meth
 
-    method normalize : js_string t meth
+  method normalize : js_string t meth
 
-    method normalize_form : normalization t -> js_string t meth
+  method normalize_form : normalization t -> js_string t meth
 
-    method replace : regExp t -> js_string t -> js_string t meth
+  method replace : regExp t -> js_string t -> js_string t meth
 
-    (* FIX: version of replace taking a function... *)
-    method replace_string : js_string t -> js_string t -> js_string t meth
+  (* FIX: version of replace taking a function... *)
+  method replace_string : js_string t -> js_string t -> js_string t meth
 
-    method search : regExp t -> int meth
+  method search : regExp t -> int meth
 
-    method slice : int -> int -> js_string t meth
+  method slice : int -> int -> js_string t meth
 
-    method slice_end : int -> js_string t meth
+  method slice_end : int -> js_string t meth
 
-    method split : js_string t -> string_array t meth
+  method split : js_string t -> string_array t meth
 
-    method split_limited : js_string t -> int -> string_array t meth
+  method split_limited : js_string t -> int -> string_array t meth
 
-    method split_regExp : regExp t -> string_array t meth
+  method split_regExp : regExp t -> string_array t meth
 
-    method split_regExpLimited : regExp t -> int -> string_array t meth
+  method split_regExpLimited : regExp t -> int -> string_array t meth
 
-    method substring : int -> int -> js_string t meth
+  method substring : int -> int -> js_string t meth
 
-    method substring_toEnd : int -> js_string t meth
+  method substring_toEnd : int -> js_string t meth
 
-    method toLowerCase : js_string t meth
+  method toLowerCase : js_string t meth
 
-    method toLocaleLowerCase : js_string t meth
+  method toLocaleLowerCase : js_string t meth
 
-    method toUpperCase : js_string t meth
+  method toUpperCase : js_string t meth
 
-    method toLocaleUpperCase : js_string t meth
+  method toLocaleUpperCase : js_string t meth
 
-    method trim : js_string t meth
+  method trim : js_string t meth
 
-    method length : int readonly_prop
-  end
+  method length : int readonly_prop
+end
 
 (** Specification of Javascript regular expression objects. *)
-and regExp =
-  object
-    method exec : js_string t -> match_result_handle t opt meth
+and regExp = object
+  method exec : js_string t -> match_result_handle t opt meth
 
-    method test : js_string t -> bool t meth
+  method test : js_string t -> bool t meth
 
-    method toString : js_string t meth
+  method toString : js_string t meth
 
-    method source : js_string t readonly_prop
+  method source : js_string t readonly_prop
 
-    method global : bool t readonly_prop
+  method global : bool t readonly_prop
 
-    method ignoreCase : bool t readonly_prop
+  method ignoreCase : bool t readonly_prop
 
-    method multiline : bool t readonly_prop
+  method multiline : bool t readonly_prop
 
-    method lastIndex : int prop
-  end
+  method lastIndex : int prop
+end
 
 (** Specification of the string constructor, considered as an object. *)
-class type string_constr =
-  object
-    method fromCharCode : int -> js_string t meth
-  end
+class type string_constr = object
+  method fromCharCode : int -> js_string t meth
+end
 
 val string_constr : string_constr t
 (** The string constructor, as an object. *)
@@ -352,78 +348,76 @@ val regExp_copy : (regExp t -> regExp t) constr
 
 (** Specification of Javascript regular arrays.
     Use [Js.array_get] and [Js.array_set] to access and set array elements. *)
-class type ['a] js_array =
-  object
-    method toString : js_string t meth
+class type ['a] js_array = object
+  method toString : js_string t meth
 
-    method toLocaleString : js_string t meth
+  method toLocaleString : js_string t meth
 
-    method concat : 'a js_array t -> 'a js_array t meth
+  method concat : 'a js_array t -> 'a js_array t meth
 
-    method join : js_string t -> js_string t meth
+  method join : js_string t -> js_string t meth
 
-    method pop : 'a optdef meth
+  method pop : 'a optdef meth
 
-    method push : 'a -> int meth
+  method push : 'a -> int meth
 
-    method push_2 : 'a -> 'a -> int meth
+  method push_2 : 'a -> 'a -> int meth
 
-    method push_3 : 'a -> 'a -> 'a -> int meth
+  method push_3 : 'a -> 'a -> 'a -> int meth
 
-    method push_4 : 'a -> 'a -> 'a -> 'a -> int meth
+  method push_4 : 'a -> 'a -> 'a -> 'a -> int meth
 
-    method reverse : 'a js_array t meth
+  method reverse : 'a js_array t meth
 
-    method shift : 'a optdef meth
+  method shift : 'a optdef meth
 
-    method slice : int -> int -> 'a js_array t meth
+  method slice : int -> int -> 'a js_array t meth
 
-    method slice_end : int -> 'a js_array t meth
+  method slice_end : int -> 'a js_array t meth
 
-    method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
+  method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
 
-    method sort_asStrings : 'a js_array t meth
+  method sort_asStrings : 'a js_array t meth
 
-    method splice : int -> int -> 'a js_array t meth
+  method splice : int -> int -> 'a js_array t meth
 
-    method splice_1 : int -> int -> 'a -> 'a js_array t meth
+  method splice_1 : int -> int -> 'a -> 'a js_array t meth
 
-    method splice_2 : int -> int -> 'a -> 'a -> 'a js_array t meth
+  method splice_2 : int -> int -> 'a -> 'a -> 'a js_array t meth
 
-    method splice_3 : int -> int -> 'a -> 'a -> 'a -> 'a js_array t meth
+  method splice_3 : int -> int -> 'a -> 'a -> 'a -> 'a js_array t meth
 
-    method splice_4 : int -> int -> 'a -> 'a -> 'a -> 'a -> 'a js_array t meth
+  method splice_4 : int -> int -> 'a -> 'a -> 'a -> 'a -> 'a js_array t meth
 
-    method unshift : 'a -> int meth
+  method unshift : 'a -> int meth
 
-    method unshift_2 : 'a -> 'a -> int meth
+  method unshift_2 : 'a -> 'a -> int meth
 
-    method unshift_3 : 'a -> 'a -> 'a -> int meth
+  method unshift_3 : 'a -> 'a -> 'a -> int meth
 
-    method unshift_4 : 'a -> 'a -> 'a -> 'a -> int meth
+  method unshift_4 : 'a -> 'a -> 'a -> 'a -> int meth
 
-    method some : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
+  method some : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
 
-    method every : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
+  method every : ('a -> int -> 'a js_array t -> bool t) callback -> bool t meth
 
-    method forEach : ('a -> int -> 'a js_array t -> unit) callback -> unit meth
+  method forEach : ('a -> int -> 'a js_array t -> unit) callback -> unit meth
 
-    method map : ('a -> int -> 'a js_array t -> 'b) callback -> 'b js_array t meth
+  method map : ('a -> int -> 'a js_array t -> 'b) callback -> 'b js_array t meth
 
-    method filter : ('a -> int -> 'a js_array t -> bool t) callback -> 'a js_array t meth
+  method filter : ('a -> int -> 'a js_array t -> bool t) callback -> 'a js_array t meth
 
-    method reduce_init :
-      ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
+  method reduce_init : ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
 
-    method reduce : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
+  method reduce : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
 
-    method reduceRight_init :
-      ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
+  method reduceRight_init :
+    ('b -> 'a -> int -> 'a js_array t -> 'b) callback -> 'b -> 'b meth
 
-    method reduceRight : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
+  method reduceRight : ('a -> 'a -> int -> 'a js_array t -> 'a) callback -> 'a meth
 
-    method length : int prop
-  end
+  method length : int prop
+end
 
 val object_keys : 'a t -> js_string t js_array t
 (** Returns jsarray containing keys of the object as Object.keys does. *)
@@ -452,14 +446,13 @@ val array_mapi : (int -> 'a -> 'b) -> 'a #js_array t -> 'b #js_array t
 (** Array mapi: [array_mapi f a] is [a##map(wrap_callback (fun elt idx arr -> f idx elt))]. *)
 
 (** Specification of match result objects *)
-class type match_result =
-  object
-    inherit [js_string t] js_array
+class type match_result = object
+  inherit [js_string t] js_array
 
-    method index : int readonly_prop
+  method index : int readonly_prop
 
-    method input : js_string t readonly_prop
-  end
+  method input : js_string t readonly_prop
+end
 
 val str_array : string_array t -> js_string t js_array t
 (** Convert an opaque [string_array t] object into an array of
@@ -472,98 +465,97 @@ val match_result : match_result_handle t -> match_result t
       and array type definitions.) *)
 
 (** Specification of Javascript date objects. *)
-class type date =
-  object
-    method toString : js_string t meth
+class type date = object
+  method toString : js_string t meth
 
-    method toDateString : js_string t meth
+  method toDateString : js_string t meth
 
-    method toTimeString : js_string t meth
+  method toTimeString : js_string t meth
 
-    method toLocaleString : js_string t meth
+  method toLocaleString : js_string t meth
 
-    method toLocaleDateString : js_string t meth
+  method toLocaleDateString : js_string t meth
 
-    method toLocaleTimeString : js_string t meth
+  method toLocaleTimeString : js_string t meth
 
-    method valueOf : number t meth
+  method valueOf : number t meth
 
-    method getTime : number t meth
+  method getTime : number t meth
 
-    method getFullYear : int meth
+  method getFullYear : int meth
 
-    method getUTCFullYear : int meth
+  method getUTCFullYear : int meth
 
-    method getMonth : int meth
+  method getMonth : int meth
 
-    method getUTCMonth : int meth
+  method getUTCMonth : int meth
 
-    method getDate : int meth
+  method getDate : int meth
 
-    method getUTCDate : int meth
+  method getUTCDate : int meth
 
-    method getDay : int meth
+  method getDay : int meth
 
-    method getUTCDay : int meth
+  method getUTCDay : int meth
 
-    method getHours : int meth
+  method getHours : int meth
 
-    method getUTCHours : int meth
+  method getUTCHours : int meth
 
-    method getMinutes : int meth
+  method getMinutes : int meth
 
-    method getUTCMinutes : int meth
+  method getUTCMinutes : int meth
 
-    method getSeconds : int meth
+  method getSeconds : int meth
 
-    method getUTCSeconds : int meth
+  method getUTCSeconds : int meth
 
-    method getMilliseconds : int meth
+  method getMilliseconds : int meth
 
-    method getUTCMilliseconds : int meth
+  method getUTCMilliseconds : int meth
 
-    method getTimezoneOffset : int meth
+  method getTimezoneOffset : int meth
 
-    method setTime : number t -> number t meth
+  method setTime : number t -> number t meth
 
-    method setFullYear : int -> number t meth
+  method setFullYear : int -> number t meth
 
-    method setUTCFullYear : int -> number t meth
+  method setUTCFullYear : int -> number t meth
 
-    method setMonth : int -> number t meth
+  method setMonth : int -> number t meth
 
-    method setUTCMonth : int -> number t meth
+  method setUTCMonth : int -> number t meth
 
-    method setDate : int -> number t meth
+  method setDate : int -> number t meth
 
-    method setUTCDate : int -> number t meth
+  method setUTCDate : int -> number t meth
 
-    method setDay : int -> number t meth
+  method setDay : int -> number t meth
 
-    method setUTCDay : int -> number t meth
+  method setUTCDay : int -> number t meth
 
-    method setHours : int -> number t meth
+  method setHours : int -> number t meth
 
-    method setUTCHours : int -> number t meth
+  method setUTCHours : int -> number t meth
 
-    method setMinutes : int -> number t meth
+  method setMinutes : int -> number t meth
 
-    method setUTCMinutes : int -> number t meth
+  method setUTCMinutes : int -> number t meth
 
-    method setSeconds : int -> number t meth
+  method setSeconds : int -> number t meth
 
-    method setUTCSeconds : int -> number t meth
+  method setUTCSeconds : int -> number t meth
 
-    method setMilliseconds : int -> number t meth
+  method setMilliseconds : int -> number t meth
 
-    method setUTCMilliseconds : int -> number t meth
+  method setUTCMilliseconds : int -> number t meth
 
-    method toUTCString : js_string t meth
+  method toUTCString : js_string t meth
 
-    method toISOString : js_string t meth
+  method toISOString : js_string t meth
 
-    method toJSON : 'a -> js_string t meth
-  end
+  method toJSON : 'a -> js_string t meth
+end
 
 val date_now : date t constr
 (** Constructor of [Date] objects: [new%js date_now] returns a
@@ -602,106 +594,103 @@ val date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr
       to millisecond [ms]. *)
 
 (** Specification of the date constructor, considered as an object. *)
-class type date_constr =
-  object
-    method parse : js_string t -> number t meth
+class type date_constr = object
+  method parse : js_string t -> number t meth
 
-    method _UTC_month : int -> int -> number t meth
+  method _UTC_month : int -> int -> number t meth
 
-    method _UTC_day : int -> int -> number t meth
+  method _UTC_day : int -> int -> number t meth
 
-    method _UTC_hour : int -> int -> int -> int -> number t meth
+  method _UTC_hour : int -> int -> int -> int -> number t meth
 
-    method _UTC_min : int -> int -> int -> int -> int -> number t meth
+  method _UTC_min : int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
 
-    method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
 
-    method now : number t meth
-  end
+  method now : number t meth
+end
 
 val date : date_constr t
 (** The date constructor, as an object. *)
 
 (** Specification of Javascript math object. *)
-class type math =
-  object
-    method _E : number t readonly_prop
+class type math = object
+  method _E : number t readonly_prop
 
-    method _LN2 : number t readonly_prop
+  method _LN2 : number t readonly_prop
 
-    method _LN10 : number t readonly_prop
+  method _LN10 : number t readonly_prop
 
-    method _LOG2E : number t readonly_prop
+  method _LOG2E : number t readonly_prop
 
-    method _LOG10E : number t readonly_prop
+  method _LOG10E : number t readonly_prop
 
-    method _PI : number t readonly_prop
+  method _PI : number t readonly_prop
 
-    method _SQRT1_2_ : number t readonly_prop
+  method _SQRT1_2_ : number t readonly_prop
 
-    method _SQRT2 : number t readonly_prop
+  method _SQRT2 : number t readonly_prop
 
-    method abs : number t -> number t meth
+  method abs : number t -> number t meth
 
-    method acos : number t -> number t meth
+  method acos : number t -> number t meth
 
-    method asin : number t -> number t meth
+  method asin : number t -> number t meth
 
-    method atan : number t -> number t meth
+  method atan : number t -> number t meth
 
-    method atan2 : number t -> number t -> number t meth
+  method atan2 : number t -> number t -> number t meth
 
-    method ceil : number t -> number t meth
+  method ceil : number t -> number t meth
 
-    method cos : number t -> number t meth
+  method cos : number t -> number t meth
 
-    method exp : number t -> number t meth
+  method exp : number t -> number t meth
 
-    method floor : number t -> number t meth
+  method floor : number t -> number t meth
 
-    method log : number t -> number t meth
+  method log : number t -> number t meth
 
-    method max : number t -> number t -> number t meth
+  method max : number t -> number t -> number t meth
 
-    method max_3 : number t -> number t -> number t -> number t meth
+  method max_3 : number t -> number t -> number t -> number t meth
 
-    method max_4 : number t -> number t -> number t -> number t -> number t meth
+  method max_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method min : number t -> number t -> number t meth
+  method min : number t -> number t -> number t meth
 
-    method min_3 : number t -> number t -> number t -> number t meth
+  method min_3 : number t -> number t -> number t -> number t meth
 
-    method min_4 : number t -> number t -> number t -> number t -> number t meth
+  method min_4 : number t -> number t -> number t -> number t -> number t meth
 
-    method pow : number t -> number t -> number t meth
+  method pow : number t -> number t -> number t meth
 
-    method random : number t meth
+  method random : number t meth
 
-    method round : number t -> number t meth
+  method round : number t -> number t meth
 
-    method sin : number t -> number t meth
+  method sin : number t -> number t meth
 
-    method sqrt : number t -> number t meth
+  method sqrt : number t -> number t meth
 
-    method tan : number t -> number t meth
-  end
+  method tan : number t -> number t meth
+end
 
 val math : math t
 (** The Math object *)
 
 (** Specification of Javascript error object. *)
-class type error =
-  object
-    method name : js_string t prop
+class type error = object
+  method name : js_string t prop
 
-    method message : js_string t prop
+  method message : js_string t prop
 
-    method stack : js_string t optdef prop
+  method stack : js_string t optdef prop
 
-    method toString : js_string t meth
-  end
+  method toString : js_string t meth
+end
 
 val error_constr : (js_string t -> error t) constr
 (** Constructor of [Error] objects:
@@ -747,12 +736,11 @@ module Js_error : sig
 end
 
 (** Specification of Javascript JSON object. *)
-class type json =
-  object
-    method parse : js_string t -> 'a meth
+class type json = object
+  method parse : js_string t -> 'a meth
 
-    method stringify : 'a -> js_string t meth
-  end
+  method stringify : 'a -> js_string t meth
+end
 
 val _JSON : json t
 (** JSON object *)
@@ -1023,7 +1011,7 @@ module Unsafe : sig
   (** {3 Deprecated functions.} *)
 
   external variable : string -> 'a = "caml_js_var"
-    [@@ocaml.deprecated "[since 2.6] use Js.Unsafe.pure_js_expr instead"]
+  [@@ocaml.deprecated "[since 2.6] use Js.Unsafe.pure_js_expr instead"]
   (** Access a Javascript variable.  [variable "foo"] will
         return the current value of variable [foo]. *)
 end
@@ -1031,13 +1019,13 @@ end
 (** {2 Deprecated functions and types.} *)
 
 val string_of_error : error t -> string
-  [@@ocaml.deprecated "[since 4.0] Use [Js_error.to_string] instead."]
+[@@ocaml.deprecated "[since 4.0] Use [Js_error.to_string] instead."]
 
 val raise_js_error : error t -> 'a
-  [@@ocaml.deprecated "[since 4.0] Use [Js_error.raise_] instead."]
+[@@ocaml.deprecated "[since 4.0] Use [Js_error.raise_] instead."]
 
 val exn_with_js_backtrace : exn -> force:bool -> exn
-  [@@ocaml.deprecated "[since 4.0] Use [Js_error.raise_] instead."]
+[@@ocaml.deprecated "[since 4.0] Use [Js_error.raise_] instead."]
 (** Attach a JavasScript error to an OCaml exception.  if [force = false] and a
     JavasScript error is already attached, it will do nothing. This function is useful to
     store and retrieve information about JavaScript stack traces.
@@ -1047,7 +1035,7 @@ val exn_with_js_backtrace : exn -> force:bool -> exn
 *)
 
 val js_error_of_exn : exn -> error t opt
-  [@@ocaml.deprecated "[since 4.0] Use [Js_error.of_exn] instead."]
+[@@ocaml.deprecated "[since 4.0] Use [Js_error.of_exn] instead."]
 (** Extract a JavaScript error attached to an OCaml exception, if any.  This is useful to
     inspect an eventual stack strace, especially when sourcemap is enabled. *)
 
diff --git a/lib/js_of_ocaml/json.ml b/lib/js_of_ocaml/json.ml
index a99b3a521a..7ee702ed95 100644
--- a/lib/js_of_ocaml/json.ml
+++ b/lib/js_of_ocaml/json.ml
@@ -106,18 +106,17 @@ let to_json v =
 
 (****)
 
-class type json =
-  object
-    method parse : 'a. js_string t -> 'a meth
+class type json = object
+  method parse : 'a. js_string t -> 'a meth
 
-    method parse_ :
-      'a 'b 'c 'd. js_string t -> ('b t, js_string t -> 'c -> 'd) meth_callback -> 'a meth
+  method parse_ :
+    'a 'b 'c 'd. js_string t -> ('b t, js_string t -> 'c -> 'd) meth_callback -> 'a meth
 
-    method stringify : 'a. 'a -> js_string t meth
+  method stringify : 'a. 'a -> js_string t meth
 
-    method stringify_ :
-      'a 'b 'c 'd. 'a -> ('b, js_string t -> 'c -> 'd) meth_callback -> js_string t meth
-  end
+  method stringify_ :
+    'a 'b 'c 'd. 'a -> ('b, js_string t -> 'c -> 'd) meth_callback -> js_string t meth
+end
 
 let json : json Js.t = Unsafe.global##._JSON
 
@@ -143,10 +142,9 @@ let unsafe_input s =
   | Other "wasm_of_ocaml" -> failwith "Json.unsafe_input: not implemented"
   | _ -> json##parse_ s input_reviver
 
-class type obj =
-  object
-    method constructor : 'a. 'a constr Js.readonly_prop
-  end
+class type obj = object
+  method constructor : 'a. 'a constr Js.readonly_prop
+end
 
 let mlInt64_constr =
   Js.Unsafe.pure_expr
diff --git a/lib/js_of_ocaml/mutationObserver.ml b/lib/js_of_ocaml/mutationObserver.ml
index 125c3d3086..3781b06efc 100644
--- a/lib/js_of_ocaml/mutationObserver.ml
+++ b/lib/js_of_ocaml/mutationObserver.ml
@@ -18,52 +18,49 @@
  *)
 open! Import
 
-class type mutationObserverInit =
-  object
-    method childList : bool Js.writeonly_prop
+class type mutationObserverInit = object
+  method childList : bool Js.writeonly_prop
 
-    method attributes : bool Js.writeonly_prop
+  method attributes : bool Js.writeonly_prop
 
-    method characterData : bool Js.writeonly_prop
+  method characterData : bool Js.writeonly_prop
 
-    method subtree : bool Js.writeonly_prop
+  method subtree : bool Js.writeonly_prop
 
-    method attributeOldValue : bool Js.writeonly_prop
+  method attributeOldValue : bool Js.writeonly_prop
 
-    method characterDataOldValue : bool Js.writeonly_prop
+  method characterDataOldValue : bool Js.writeonly_prop
 
-    method attributeFilter : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
-  end
+  method attributeFilter : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
+end
 
-class type mutationRecord =
-  object
-    method _type : Js.js_string Js.t Js.readonly_prop
+class type mutationRecord = object
+  method _type : Js.js_string Js.t Js.readonly_prop
 
-    method target : Dom.node Js.t Js.readonly_prop
+  method target : Dom.node Js.t Js.readonly_prop
 
-    method addedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
+  method addedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
 
-    method removedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
+  method removedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
 
-    method previousSibling : Dom.node Js.t Js.opt Js.readonly_prop
+  method previousSibling : Dom.node Js.t Js.opt Js.readonly_prop
 
-    method nextSibling : Dom.node Js.t Js.opt Js.readonly_prop
+  method nextSibling : Dom.node Js.t Js.opt Js.readonly_prop
 
-    method attributeName : Js.js_string Js.t Js.opt Js.readonly_prop
+  method attributeName : Js.js_string Js.t Js.opt Js.readonly_prop
 
-    method attributeNamespace : Js.js_string Js.t Js.opt Js.readonly_prop
+  method attributeNamespace : Js.js_string Js.t Js.opt Js.readonly_prop
 
-    method oldValue : Js.js_string Js.t Js.opt Js.readonly_prop
-  end
+  method oldValue : Js.js_string Js.t Js.opt Js.readonly_prop
+end
 
-class type mutationObserver =
-  object
-    method observe : #Dom.node Js.t -> mutationObserverInit Js.t -> unit Js.meth
+class type mutationObserver = object
+  method observe : #Dom.node Js.t -> mutationObserverInit Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
+  method disconnect : unit Js.meth
 
-    method takeRecords : mutationRecord Js.t Js.js_array Js.t Js.meth
-  end
+  method takeRecords : mutationRecord Js.t Js.js_array Js.t Js.meth
+end
 
 let empty_mutation_observer_init () : mutationObserverInit Js.t = Js.Unsafe.obj [||]
 
diff --git a/lib/js_of_ocaml/mutationObserver.mli b/lib/js_of_ocaml/mutationObserver.mli
index 0bd3377136..edc9b4ac6e 100644
--- a/lib/js_of_ocaml/mutationObserver.mli
+++ b/lib/js_of_ocaml/mutationObserver.mli
@@ -40,52 +40,49 @@
   @see <https://developer.mozilla.org/en-US/docs/Web/API/MutationObserver> for API documentation.
   @see <https://dom.spec.whatwg.org/#mutation-observers> for the Web Hypertext Application Technology Working Group (WHATWG) spec. *)
 
-class type mutationObserverInit =
-  object
-    method childList : bool Js.writeonly_prop
+class type mutationObserverInit = object
+  method childList : bool Js.writeonly_prop
 
-    method attributes : bool Js.writeonly_prop
+  method attributes : bool Js.writeonly_prop
 
-    method characterData : bool Js.writeonly_prop
+  method characterData : bool Js.writeonly_prop
 
-    method subtree : bool Js.writeonly_prop
+  method subtree : bool Js.writeonly_prop
 
-    method attributeOldValue : bool Js.writeonly_prop
+  method attributeOldValue : bool Js.writeonly_prop
 
-    method characterDataOldValue : bool Js.writeonly_prop
+  method characterDataOldValue : bool Js.writeonly_prop
 
-    method attributeFilter : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
-  end
+  method attributeFilter : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
+end
 
-class type mutationRecord =
-  object
-    method _type : Js.js_string Js.t Js.readonly_prop
+class type mutationRecord = object
+  method _type : Js.js_string Js.t Js.readonly_prop
 
-    method target : Dom.node Js.t Js.readonly_prop
+  method target : Dom.node Js.t Js.readonly_prop
 
-    method addedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
+  method addedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
 
-    method removedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
+  method removedNodes : Dom.node Dom.nodeList Js.t Js.readonly_prop
 
-    method previousSibling : Dom.node Js.t Js.opt Js.readonly_prop
+  method previousSibling : Dom.node Js.t Js.opt Js.readonly_prop
 
-    method nextSibling : Dom.node Js.t Js.opt Js.readonly_prop
+  method nextSibling : Dom.node Js.t Js.opt Js.readonly_prop
 
-    method attributeName : Js.js_string Js.t Js.opt Js.readonly_prop
+  method attributeName : Js.js_string Js.t Js.opt Js.readonly_prop
 
-    method attributeNamespace : Js.js_string Js.t Js.opt Js.readonly_prop
+  method attributeNamespace : Js.js_string Js.t Js.opt Js.readonly_prop
 
-    method oldValue : Js.js_string Js.t Js.opt Js.readonly_prop
-  end
+  method oldValue : Js.js_string Js.t Js.opt Js.readonly_prop
+end
 
-class type mutationObserver =
-  object
-    method observe : #Dom.node Js.t -> mutationObserverInit Js.t -> unit Js.meth
+class type mutationObserver = object
+  method observe : #Dom.node Js.t -> mutationObserverInit Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
+  method disconnect : unit Js.meth
 
-    method takeRecords : mutationRecord Js.t Js.js_array Js.t Js.meth
-  end
+  method takeRecords : mutationRecord Js.t Js.js_array Js.t Js.meth
+end
 
 val empty_mutation_observer_init : unit -> mutationObserverInit Js.t
 
diff --git a/lib/js_of_ocaml/performanceObserver.ml b/lib/js_of_ocaml/performanceObserver.ml
index 57cea8cef6..a0fd42fdfb 100644
--- a/lib/js_of_ocaml/performanceObserver.ml
+++ b/lib/js_of_ocaml/performanceObserver.ml
@@ -19,35 +19,31 @@
 
 open! Import
 
-class type performanceObserverInit =
-  object
-    method entryTypes : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
-  end
+class type performanceObserverInit = object
+  method entryTypes : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
+end
 
-class type performanceEntry =
-  object
-    method name : Js.js_string Js.t Js.readonly_prop
+class type performanceEntry = object
+  method name : Js.js_string Js.t Js.readonly_prop
 
-    method entryType : Js.js_string Js.t Js.readonly_prop
+  method entryType : Js.js_string Js.t Js.readonly_prop
 
-    method startTime : Js.number Js.t Js.readonly_prop
+  method startTime : Js.number Js.t Js.readonly_prop
 
-    method duration : Js.number Js.t Js.readonly_prop
-  end
+  method duration : Js.number Js.t Js.readonly_prop
+end
 
-class type performanceObserverEntryList =
-  object
-    method getEntries : performanceEntry Js.t Js.js_array Js.t Js.meth
-  end
+class type performanceObserverEntryList = object
+  method getEntries : performanceEntry Js.t Js.js_array Js.t Js.meth
+end
 
-class type performanceObserver =
-  object
-    method observe : performanceObserverInit Js.t -> unit Js.meth
+class type performanceObserver = object
+  method observe : performanceObserverInit Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
+  method disconnect : unit Js.meth
 
-    method takeRecords : performanceEntry Js.t Js.js_array Js.t Js.meth
-  end
+  method takeRecords : performanceEntry Js.t Js.js_array Js.t Js.meth
+end
 
 let performanceObserver = Js.Unsafe.global##._PerformanceObserver
 
diff --git a/lib/js_of_ocaml/performanceObserver.mli b/lib/js_of_ocaml/performanceObserver.mli
index 0c2950df7c..4ec3116e46 100644
--- a/lib/js_of_ocaml/performanceObserver.mli
+++ b/lib/js_of_ocaml/performanceObserver.mli
@@ -35,35 +35,31 @@
    @see <https://developer.mozilla.org/en-US/docs/Web/API/PerformanceObserver> for API documentation.
 *)
 
-class type performanceObserverInit =
-  object
-    method entryTypes : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
-  end
+class type performanceObserverInit = object
+  method entryTypes : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
+end
 
-class type performanceEntry =
-  object
-    method name : Js.js_string Js.t Js.readonly_prop
+class type performanceEntry = object
+  method name : Js.js_string Js.t Js.readonly_prop
 
-    method entryType : Js.js_string Js.t Js.readonly_prop
+  method entryType : Js.js_string Js.t Js.readonly_prop
 
-    method startTime : Js.number Js.t Js.readonly_prop
+  method startTime : Js.number Js.t Js.readonly_prop
 
-    method duration : Js.number Js.t Js.readonly_prop
-  end
+  method duration : Js.number Js.t Js.readonly_prop
+end
 
-class type performanceObserverEntryList =
-  object
-    method getEntries : performanceEntry Js.t Js.js_array Js.t Js.meth
-  end
+class type performanceObserverEntryList = object
+  method getEntries : performanceEntry Js.t Js.js_array Js.t Js.meth
+end
 
-class type performanceObserver =
-  object
-    method observe : performanceObserverInit Js.t -> unit Js.meth
+class type performanceObserver = object
+  method observe : performanceObserverInit Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
+  method disconnect : unit Js.meth
 
-    method takeRecords : performanceEntry Js.t Js.js_array Js.t Js.meth
-  end
+  method takeRecords : performanceEntry Js.t Js.js_array Js.t Js.meth
+end
 
 val performanceObserver :
   (   (performanceObserverEntryList Js.t -> performanceObserver Js.t -> unit) Js.callback
diff --git a/lib/js_of_ocaml/resizeObserver.ml b/lib/js_of_ocaml/resizeObserver.ml
index 2040977d4a..eb4501974a 100644
--- a/lib/js_of_ocaml/resizeObserver.ml
+++ b/lib/js_of_ocaml/resizeObserver.ml
@@ -18,40 +18,36 @@
  *)
 open! Import
 
-class type resizeObserverSize =
-  object
-    method inlineSize : Js.number Js.t Js.readonly_prop
+class type resizeObserverSize = object
+  method inlineSize : Js.number Js.t Js.readonly_prop
 
-    method blockSize : Js.number Js.t Js.readonly_prop
-  end
+  method blockSize : Js.number Js.t Js.readonly_prop
+end
 
-class type resizeObserverEntry =
-  object
-    method target : Dom.node Js.t Js.readonly_prop
+class type resizeObserverEntry = object
+  method target : Dom.node Js.t Js.readonly_prop
 
-    method contentRect : Dom_html.clientRect Js.t Js.readonly_prop
+  method contentRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method borderBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
+  method borderBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
 
-    method contentBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
-  end
+  method contentBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
+end
 
-class type resizeObserverOptions =
-  object
-    method box : Js.js_string Js.t Js.writeonly_prop
-  end
+class type resizeObserverOptions = object
+  method box : Js.js_string Js.t Js.writeonly_prop
+end
 
-class type resizeObserver =
-  object
-    method observe : #Dom.node Js.t -> unit Js.meth
+class type resizeObserver = object
+  method observe : #Dom.node Js.t -> unit Js.meth
 
-    method observe_withOptions :
-      #Dom.node Js.t -> resizeObserverOptions Js.t -> unit Js.meth
+  method observe_withOptions :
+    #Dom.node Js.t -> resizeObserverOptions Js.t -> unit Js.meth
 
-    method unobserve : #Dom.node Js.t -> unit Js.meth
+  method unobserve : #Dom.node Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
-  end
+  method disconnect : unit Js.meth
+end
 
 let empty_resize_observer_options () : resizeObserverOptions Js.t = Js.Unsafe.obj [||]
 
diff --git a/lib/js_of_ocaml/resizeObserver.mli b/lib/js_of_ocaml/resizeObserver.mli
index 3b31d29f84..e1e0f7a245 100644
--- a/lib/js_of_ocaml/resizeObserver.mli
+++ b/lib/js_of_ocaml/resizeObserver.mli
@@ -41,40 +41,36 @@
     @see <https://drafts.csswg.org/resize-observer> for W3C draft spec
 *)
 
-class type resizeObserverSize =
-  object
-    method inlineSize : Js.number Js.t Js.readonly_prop
+class type resizeObserverSize = object
+  method inlineSize : Js.number Js.t Js.readonly_prop
 
-    method blockSize : Js.number Js.t Js.readonly_prop
-  end
+  method blockSize : Js.number Js.t Js.readonly_prop
+end
 
-class type resizeObserverEntry =
-  object
-    method target : Dom.node Js.t Js.readonly_prop
+class type resizeObserverEntry = object
+  method target : Dom.node Js.t Js.readonly_prop
 
-    method contentRect : Dom_html.clientRect Js.t Js.readonly_prop
+  method contentRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-    method borderBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
+  method borderBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
 
-    method contentBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
-  end
+  method contentBoxSize : resizeObserverSize Js.t Js.js_array Js.t Js.readonly_prop
+end
 
-class type resizeObserverOptions =
-  object
-    method box : Js.js_string Js.t Js.writeonly_prop
-  end
+class type resizeObserverOptions = object
+  method box : Js.js_string Js.t Js.writeonly_prop
+end
 
-class type resizeObserver =
-  object
-    method observe : #Dom.node Js.t -> unit Js.meth
+class type resizeObserver = object
+  method observe : #Dom.node Js.t -> unit Js.meth
 
-    method observe_withOptions :
-      #Dom.node Js.t -> resizeObserverOptions Js.t -> unit Js.meth
+  method observe_withOptions :
+    #Dom.node Js.t -> resizeObserverOptions Js.t -> unit Js.meth
 
-    method unobserve : #Dom.node Js.t -> unit Js.meth
+  method unobserve : #Dom.node Js.t -> unit Js.meth
 
-    method disconnect : unit Js.meth
-  end
+  method disconnect : unit Js.meth
+end
 
 val empty_resize_observer_options : unit -> resizeObserverOptions Js.t
 
diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index 02199ce90c..4b52cda8a9 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -24,50 +24,47 @@ type int32 = Js.number Js.t
 
 type uint32 = Js.number Js.t
 
-class type arrayBuffer =
-  object
-    method byteLength : int readonly_prop
+class type arrayBuffer = object
+  method byteLength : int readonly_prop
 
-    method slice : int -> int -> arrayBuffer t meth
+  method slice : int -> int -> arrayBuffer t meth
 
-    method slice_toEnd : int -> arrayBuffer t meth
-  end
+  method slice_toEnd : int -> arrayBuffer t meth
+end
 
 let arrayBuffer : (int -> arrayBuffer t) constr = Js.Unsafe.global##._ArrayBuffer
 
-class type arrayBufferView =
-  object
-    method buffer : arrayBuffer t readonly_prop
+class type arrayBufferView = object
+  method buffer : arrayBuffer t readonly_prop
 
-    method byteOffset : int readonly_prop
+  method byteOffset : int readonly_prop
 
-    method byteLength : int readonly_prop
-  end
+  method byteLength : int readonly_prop
+end
 
-class type ['a, 'b, 'c] typedArray =
-  object
-    inherit arrayBufferView
+class type ['a, 'b, 'c] typedArray = object
+  inherit arrayBufferView
 
-    method _BYTES_PER_ELEMENT : int readonly_prop
+  method _BYTES_PER_ELEMENT : int readonly_prop
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method set_fromArray : 'a js_array t -> int -> unit meth
+  method set_fromArray : 'a js_array t -> int -> unit meth
 
-    method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth
+  method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth
 
-    method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth
+  method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth
+  method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice : int -> int -> ('a, 'b, 'c) typedArray t meth
+  method slice : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth
+  method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-    (* This fake method is needed for typing purposes.
-       Without it, ['b] would not be constrained. *)
-    method _content_type_ : ('b * 'c) optdef readonly_prop
-  end
+  (* This fake method is needed for typing purposes.
+     Without it, ['b] would not be constrained. *)
+  method _content_type_ : ('b * 'c) optdef readonly_prop
+end
 
 type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray
 
@@ -197,66 +194,65 @@ let get : ('a, _, _) typedArray t -> int -> 'a optdef = fun a i -> Js.Unsafe.get
 
 let unsafe_get : ('a, _, _) typedArray t -> int -> 'a = fun a i -> Js.Unsafe.get a i
 
-class type dataView =
-  object
-    inherit arrayBufferView
+class type dataView = object
+  inherit arrayBufferView
 
-    method getInt8 : int -> int meth
+  method getInt8 : int -> int meth
 
-    method getUint8 : int -> int meth
+  method getUint8 : int -> int meth
 
-    method getInt16 : int -> int meth
+  method getInt16 : int -> int meth
 
-    method getInt16_ : int -> bool t -> int meth
+  method getInt16_ : int -> bool t -> int meth
 
-    method getUint16 : int -> int meth
+  method getUint16 : int -> int meth
 
-    method getUint16_ : int -> bool t -> int meth
+  method getUint16_ : int -> bool t -> int meth
 
-    method getInt32 : int -> int32 meth
+  method getInt32 : int -> int32 meth
 
-    method getInt32_ : int -> bool t -> int32 meth
+  method getInt32_ : int -> bool t -> int32 meth
 
-    method getUint32 : int -> uint32 meth
+  method getUint32 : int -> uint32 meth
 
-    method getUint32_ : int -> bool t -> uint32 meth
+  method getUint32_ : int -> bool t -> uint32 meth
 
-    method getFloat32 : int -> Js.number Js.t meth
+  method getFloat32 : int -> Js.number Js.t meth
 
-    method getFloat32_ : int -> bool t -> Js.number Js.t meth
+  method getFloat32_ : int -> bool t -> Js.number Js.t meth
 
-    method getFloat64 : int -> Js.number Js.t meth
+  method getFloat64 : int -> Js.number Js.t meth
 
-    method getFloat64_ : int -> bool t -> Js.number Js.t meth
+  method getFloat64_ : int -> bool t -> Js.number Js.t meth
 
-    method setInt8 : int -> int -> unit meth
+  method setInt8 : int -> int -> unit meth
 
-    method setUint8 : int -> int -> unit meth
+  method setUint8 : int -> int -> unit meth
 
-    method setInt16 : int -> int -> unit meth
+  method setInt16 : int -> int -> unit meth
 
-    method setInt16_ : int -> int -> bool t -> unit meth
+  method setInt16_ : int -> int -> bool t -> unit meth
 
-    method setUint16 : int -> int -> unit meth
+  method setUint16 : int -> int -> unit meth
 
-    method setUint16_ : int -> int -> bool t -> unit meth
+  method setUint16_ : int -> int -> bool t -> unit meth
 
-    method setInt32 : int -> int32 -> unit meth
+  method setInt32 : int -> int32 -> unit meth
 
-    method setInt32_ : int -> int32 -> bool t -> unit meth
+  method setInt32_ : int -> int32 -> bool t -> unit meth
 
-    method setUint32 : int -> uint32 -> unit meth
+  method setUint32 : int -> uint32 -> unit meth
 
-    method setUint32_ : int -> uint32 -> bool t -> unit meth
+  method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-    method setFloat32 : int -> Js.number Js.t -> unit meth
+  method setFloat32 : int -> Js.number Js.t -> unit meth
 
-    method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
+  method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
 
-    method setFloat64 : int -> Js.number Js.t -> unit meth
+  method setFloat64 : int -> Js.number Js.t -> unit meth
 
-    method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
-  end
+  method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
+end
 
 let dataView = Js.Unsafe.global##._DataView
 
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index 6ea4b30e02..4cedaba0ef 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -26,50 +26,47 @@ type int32 = Js.number Js.t
 
 type uint32 = Js.number Js.t
 
-class type arrayBuffer =
-  object
-    method byteLength : int readonly_prop
+class type arrayBuffer = object
+  method byteLength : int readonly_prop
 
-    method slice : int -> int -> arrayBuffer t meth
+  method slice : int -> int -> arrayBuffer t meth
 
-    method slice_toEnd : int -> arrayBuffer t meth
-  end
+  method slice_toEnd : int -> arrayBuffer t meth
+end
 
 val arrayBuffer : (int -> arrayBuffer t) constr
 
-class type arrayBufferView =
-  object
-    method buffer : arrayBuffer t readonly_prop
+class type arrayBufferView = object
+  method buffer : arrayBuffer t readonly_prop
 
-    method byteOffset : int readonly_prop
+  method byteOffset : int readonly_prop
 
-    method byteLength : int readonly_prop
-  end
+  method byteLength : int readonly_prop
+end
 
-class type ['a, 'b, 'c] typedArray =
-  object
-    inherit arrayBufferView
+class type ['a, 'b, 'c] typedArray = object
+  inherit arrayBufferView
 
-    method _BYTES_PER_ELEMENT : int readonly_prop
+  method _BYTES_PER_ELEMENT : int readonly_prop
 
-    method length : int readonly_prop
+  method length : int readonly_prop
 
-    method set_fromArray : 'a js_array t -> int -> unit meth
+  method set_fromArray : 'a js_array t -> int -> unit meth
 
-    method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth
+  method set_fromTypedArray : ('a, 'b, 'c) typedArray t -> int -> unit meth
 
-    method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth
+  method subarray : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth
+  method subarray_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice : int -> int -> ('a, 'b, 'c) typedArray t meth
+  method slice : int -> int -> ('a, 'b, 'c) typedArray t meth
 
-    method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth
+  method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-    (* This fake method is needed for typing purposes.
-       Without it, ['b] would not be constrained. *)
-    method _content_type_ : ('b * 'c) optdef readonly_prop
-  end
+  (* This fake method is needed for typing purposes.
+     Without it, ['b] would not be constrained. *)
+  method _content_type_ : ('b * 'c) optdef readonly_prop
+end
 
 type int8Array = (int, int, Bigarray.int8_signed_elt) typedArray
 
@@ -195,66 +192,65 @@ val get : ('a, _, _) typedArray t -> int -> 'a optdef
 
 val unsafe_get : ('a, _, _) typedArray t -> int -> 'a
 
-class type dataView =
-  object
-    inherit arrayBufferView
+class type dataView = object
+  inherit arrayBufferView
 
-    method getInt8 : int -> int meth
+  method getInt8 : int -> int meth
 
-    method getUint8 : int -> int meth
+  method getUint8 : int -> int meth
 
-    method getInt16 : int -> int meth
+  method getInt16 : int -> int meth
 
-    method getInt16_ : int -> bool t -> int meth
+  method getInt16_ : int -> bool t -> int meth
 
-    method getUint16 : int -> int meth
+  method getUint16 : int -> int meth
 
-    method getUint16_ : int -> bool t -> int meth
+  method getUint16_ : int -> bool t -> int meth
 
-    method getInt32 : int -> int32 meth
+  method getInt32 : int -> int32 meth
 
-    method getInt32_ : int -> bool t -> int32 meth
+  method getInt32_ : int -> bool t -> int32 meth
 
-    method getUint32 : int -> uint32 meth
+  method getUint32 : int -> uint32 meth
 
-    method getUint32_ : int -> bool t -> uint32 meth
+  method getUint32_ : int -> bool t -> uint32 meth
 
-    method getFloat32 : int -> Js.number Js.t meth
+  method getFloat32 : int -> Js.number Js.t meth
 
-    method getFloat32_ : int -> bool t -> Js.number Js.t meth
+  method getFloat32_ : int -> bool t -> Js.number Js.t meth
 
-    method getFloat64 : int -> Js.number Js.t meth
+  method getFloat64 : int -> Js.number Js.t meth
 
-    method getFloat64_ : int -> bool t -> Js.number Js.t meth
+  method getFloat64_ : int -> bool t -> Js.number Js.t meth
 
-    method setInt8 : int -> int -> unit meth
+  method setInt8 : int -> int -> unit meth
 
-    method setUint8 : int -> int -> unit meth
+  method setUint8 : int -> int -> unit meth
 
-    method setInt16 : int -> int -> unit meth
+  method setInt16 : int -> int -> unit meth
 
-    method setInt16_ : int -> int -> bool t -> unit meth
+  method setInt16_ : int -> int -> bool t -> unit meth
 
-    method setUint16 : int -> int -> unit meth
+  method setUint16 : int -> int -> unit meth
 
-    method setUint16_ : int -> int -> bool t -> unit meth
+  method setUint16_ : int -> int -> bool t -> unit meth
 
-    method setInt32 : int -> int32 -> unit meth
+  method setInt32 : int -> int32 -> unit meth
 
-    method setInt32_ : int -> int32 -> bool t -> unit meth
+  method setInt32_ : int -> int32 -> bool t -> unit meth
 
-    method setUint32 : int -> uint32 -> unit meth
+  method setUint32 : int -> uint32 -> unit meth
 
-    method setUint32_ : int -> uint32 -> bool t -> unit meth
+  method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-    method setFloat32 : int -> Js.number Js.t -> unit meth
+  method setFloat32 : int -> Js.number Js.t -> unit meth
 
-    method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
+  method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
 
-    method setFloat64 : int -> Js.number Js.t -> unit meth
+  method setFloat64 : int -> Js.number Js.t -> unit meth
 
-    method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
-  end
+  method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
+end
 
 val dataView : (arrayBuffer t -> dataView t) constr
 
diff --git a/lib/js_of_ocaml/webGL.ml b/lib/js_of_ocaml/webGL.ml
index 22a19774b3..b54a7110b8 100644
--- a/lib/js_of_ocaml/webGL.ml
+++ b/lib/js_of_ocaml/webGL.ml
@@ -120,24 +120,23 @@ type shaderPrecisionType
 type objectType
 
 (** 5.2 WebGLContextAttributes *)
-class type contextAttributes =
-  object
-    method alpha : bool t prop
+class type contextAttributes = object
+  method alpha : bool t prop
 
-    method depth : bool t prop
+  method depth : bool t prop
 
-    method stencil : bool t prop
+  method stencil : bool t prop
 
-    method antialias : bool t prop
+  method antialias : bool t prop
 
-    method premultipliedAlpha : bool t prop
+  method premultipliedAlpha : bool t prop
 
-    method preserveDrawingBuffer : bool t prop
+  method preserveDrawingBuffer : bool t prop
 
-    method preferLowPowerToHighPerformance : bool t prop
+  method preferLowPowerToHighPerformance : bool t prop
 
-    method failIfMajorPerformanceCaveat : bool t prop
-  end
+  method failIfMajorPerformanceCaveat : bool t prop
+end
 
 let defaultContextAttributes =
   Js.Unsafe.(
@@ -166,1198 +165,1189 @@ type texture
 
 type 'a uniformLocation
 
-class type activeInfo =
-  object
-    method size : int readonly_prop
-
-    method _type : uniformType readonly_prop
+class type activeInfo = object
+  method size : int readonly_prop
 
-    method name : js_string t readonly_prop
-  end
+  method _type : uniformType readonly_prop
 
-class type shaderPrecisionFormat =
-  object
-    method rangeMin : int readonly_prop
+  method name : js_string t readonly_prop
+end
 
-    method rangeMax : int readonly_prop
+class type shaderPrecisionFormat = object
+  method rangeMin : int readonly_prop
 
-    method precision : int readonly_prop
-  end
+  method rangeMax : int readonly_prop
 
-class type renderingContext =
-  object
+  method precision : int readonly_prop
+end
 
-    (** 5.13.1 Attributes *)
+class type renderingContext = object
+  (** 5.13.1 Attributes *)
 
-    method canvas : Dom_html.canvasElement t readonly_prop
+  method canvas : Dom_html.canvasElement t readonly_prop
 
-    method drawingBufferWidth : sizei readonly_prop
+  method drawingBufferWidth : sizei readonly_prop
 
-    method drawingBufferHeight : sizei readonly_prop
+  method drawingBufferHeight : sizei readonly_prop
 
-    (** 5.13.2 Getting information about the context *)
+  (** 5.13.2 Getting information about the context *)
 
-    method getContextAttributes : contextAttributes t meth
+  method getContextAttributes : contextAttributes t meth
 
-    (** 5.13.3 Setting and getting state *)
+  (** 5.13.3 Setting and getting state *)
 
-    method activeTexture : textureUnit -> unit meth
+  method activeTexture : textureUnit -> unit meth
 
-    method blendColor : clampf -> clampf -> clampf -> clampf -> unit meth
+  method blendColor : clampf -> clampf -> clampf -> clampf -> unit meth
 
-    method blendEquation : blendMode -> unit meth
+  method blendEquation : blendMode -> unit meth
 
-    method blendEquationSeparate : blendMode -> blendMode -> unit meth
+  method blendEquationSeparate : blendMode -> blendMode -> unit meth
 
-    method blendFunc : blendingFactor -> blendingFactor -> unit meth
+  method blendFunc : blendingFactor -> blendingFactor -> unit meth
 
-    method blendFuncSeparate :
-      blendingFactor -> blendingFactor -> blendingFactor -> blendingFactor -> unit meth
+  method blendFuncSeparate :
+    blendingFactor -> blendingFactor -> blendingFactor -> blendingFactor -> unit meth
 
-    method clearColor : clampf -> clampf -> clampf -> clampf -> unit meth
+  method clearColor : clampf -> clampf -> clampf -> clampf -> unit meth
 
-    method clearDepth : clampf -> unit meth
+  method clearDepth : clampf -> unit meth
 
-    method clearStencil : int -> unit meth
+  method clearStencil : int -> unit meth
 
-    method colorMask : bool t -> bool t -> bool t -> bool t -> unit meth
+  method colorMask : bool t -> bool t -> bool t -> bool t -> unit meth
 
-    method cullFace : cullFaceMode -> unit meth
+  method cullFace : cullFaceMode -> unit meth
 
-    method depthFunc : depthFunction -> unit meth
+  method depthFunc : depthFunction -> unit meth
 
-    method depthMask : bool t -> unit meth
+  method depthMask : bool t -> unit meth
 
-    method depthRange : clampf -> clampf -> unit meth
+  method depthRange : clampf -> clampf -> unit meth
 
-    method disable : enableCap -> unit meth
+  method disable : enableCap -> unit meth
 
-    method enable : enableCap -> unit meth
+  method enable : enableCap -> unit meth
 
-    method frontFace : frontFaceDir -> unit meth
+  method frontFace : frontFaceDir -> unit meth
 
-    method getParameter : 'a. 'a parameter -> 'a meth
+  method getParameter : 'a. 'a parameter -> 'a meth
 
-    method getError : errorCode meth
+  method getError : errorCode meth
 
-    method hint : hintTarget -> hintMode -> unit meth
+  method hint : hintTarget -> hintMode -> unit meth
 
-    method isEnabled : enableCap -> bool t meth
+  method isEnabled : enableCap -> bool t meth
 
-    method lineWidth : number t -> unit meth
+  method lineWidth : number t -> unit meth
 
-    method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
+  method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-    method polygonOffset : number t -> number t -> unit meth
+  method polygonOffset : number t -> number t -> unit meth
 
-    method sampleCoverage : clampf -> bool t -> unit meth
+  method sampleCoverage : clampf -> bool t -> unit meth
 
-    method stencilFunc : depthFunction -> int -> uint -> unit meth
+  method stencilFunc : depthFunction -> int -> uint -> unit meth
 
-    method stencilFuncSeparate : cullFaceMode -> depthFunction -> int -> uint -> unit meth
+  method stencilFuncSeparate : cullFaceMode -> depthFunction -> int -> uint -> unit meth
 
-    method stencilMask : uint -> unit meth
+  method stencilMask : uint -> unit meth
 
-    method stencilMaskSeparate : cullFaceMode -> uint -> unit meth
+  method stencilMaskSeparate : cullFaceMode -> uint -> unit meth
 
-    method stencilOp : stencilOp -> stencilOp -> stencilOp -> unit meth
+  method stencilOp : stencilOp -> stencilOp -> stencilOp -> unit meth
 
-    method stencilOpSeparate :
-      cullFaceMode -> stencilOp -> stencilOp -> stencilOp -> unit meth
+  method stencilOpSeparate :
+    cullFaceMode -> stencilOp -> stencilOp -> stencilOp -> unit meth
 
-    (** 5.13.4 Viewing and clipping *)
+  (** 5.13.4 Viewing and clipping *)
 
-    method scissor : int -> int -> sizei -> sizei -> unit meth
+  method scissor : int -> int -> sizei -> sizei -> unit meth
 
-    method viewport : int -> int -> sizei -> sizei -> unit meth
+  method viewport : int -> int -> sizei -> sizei -> unit meth
 
-    (** 5.13.5 Buffer objects *)
+  (** 5.13.5 Buffer objects *)
 
-    method bindBuffer : bufferTarget -> buffer t -> unit meth
+  method bindBuffer : bufferTarget -> buffer t -> unit meth
 
-    method bindBuffer_ : bufferTarget -> buffer t opt -> unit meth
+  method bindBuffer_ : bufferTarget -> buffer t opt -> unit meth
 
-    method bufferData_create : bufferTarget -> sizeiptr -> bufferUsage -> unit meth
+  method bufferData_create : bufferTarget -> sizeiptr -> bufferUsage -> unit meth
 
-    method bufferData :
-      bufferTarget -> #Typed_array.arrayBufferView t -> bufferUsage -> unit meth
+  method bufferData :
+    bufferTarget -> #Typed_array.arrayBufferView t -> bufferUsage -> unit meth
 
-    method bufferData_raw :
-      bufferTarget -> Typed_array.arrayBuffer t -> bufferUsage -> unit meth
+  method bufferData_raw :
+    bufferTarget -> Typed_array.arrayBuffer t -> bufferUsage -> unit meth
 
-    method bufferSubData :
-      bufferTarget -> intptr -> #Typed_array.arrayBufferView t -> unit meth
+  method bufferSubData :
+    bufferTarget -> intptr -> #Typed_array.arrayBufferView t -> unit meth
 
-    method bufferSubData_raw :
-      bufferTarget -> intptr -> Typed_array.arrayBuffer t -> unit meth
+  method bufferSubData_raw :
+    bufferTarget -> intptr -> Typed_array.arrayBuffer t -> unit meth
 
-    method createBuffer : buffer t meth
+  method createBuffer : buffer t meth
 
-    method deleteBuffer : buffer t -> unit meth
+  method deleteBuffer : buffer t -> unit meth
 
-    method getBufferParameter : 'a. bufferTarget -> 'a bufferParameter -> 'a meth
+  method getBufferParameter : 'a. bufferTarget -> 'a bufferParameter -> 'a meth
 
-    method isBuffer : buffer t -> bool t meth
+  method isBuffer : buffer t -> bool t meth
 
-    (** 5.13.6 Framebuffer objects *)
+  (** 5.13.6 Framebuffer objects *)
 
-    method bindFramebuffer : fbTarget -> framebuffer t -> unit meth
+  method bindFramebuffer : fbTarget -> framebuffer t -> unit meth
 
-    method bindFramebuffer_ : fbTarget -> framebuffer t opt -> unit meth
+  method bindFramebuffer_ : fbTarget -> framebuffer t opt -> unit meth
 
-    method checkFramebufferStatus : fbTarget -> framebufferStatus meth
+  method checkFramebufferStatus : fbTarget -> framebufferStatus meth
 
-    method createFramebuffer : framebuffer t meth
+  method createFramebuffer : framebuffer t meth
 
-    method deleteFramebuffer : framebuffer t -> unit meth
+  method deleteFramebuffer : framebuffer t -> unit meth
 
-    method framebufferRenderbuffer :
-      fbTarget -> attachmentPoint -> rbTarget -> renderbuffer t -> unit meth
+  method framebufferRenderbuffer :
+    fbTarget -> attachmentPoint -> rbTarget -> renderbuffer t -> unit meth
 
-    method framebufferTexture2D :
-      fbTarget -> attachmentPoint -> texTarget -> texture t -> int -> unit meth
+  method framebufferTexture2D :
+    fbTarget -> attachmentPoint -> texTarget -> texture t -> int -> unit meth
 
-    method getFramebufferAttachmentParameter :
-      'a. fbTarget -> attachmentPoint -> 'a attachParam -> 'a meth
+  method getFramebufferAttachmentParameter :
+    'a. fbTarget -> attachmentPoint -> 'a attachParam -> 'a meth
 
-    method isFramebuffer : framebuffer t -> bool t meth
+  method isFramebuffer : framebuffer t -> bool t meth
 
-    (** 5.13.7 Renderbuffer objects *)
+  (** 5.13.7 Renderbuffer objects *)
 
-    method bindRenderbuffer : rbTarget -> renderbuffer t -> unit meth
+  method bindRenderbuffer : rbTarget -> renderbuffer t -> unit meth
 
-    method bindRenderbuffer_ : rbTarget -> renderbuffer t opt -> unit meth
+  method bindRenderbuffer_ : rbTarget -> renderbuffer t opt -> unit meth
 
-    method createRenderbuffer : renderbuffer t meth
+  method createRenderbuffer : renderbuffer t meth
 
-    method deleteRenderbuffer : renderbuffer t -> unit meth
+  method deleteRenderbuffer : renderbuffer t -> unit meth
 
-    method getRenderbufferParameter : 'a. rbTarget -> 'a renderbufferParam -> 'a meth
+  method getRenderbufferParameter : 'a. rbTarget -> 'a renderbufferParam -> 'a meth
 
-    method isRenderbuffer : renderbuffer t -> bool t meth
+  method isRenderbuffer : renderbuffer t -> bool t meth
 
-    method renderbufferStorage : rbTarget -> format -> sizei -> sizei -> unit meth
+  method renderbufferStorage : rbTarget -> format -> sizei -> sizei -> unit meth
 
-    (** 5.13.8 Texture objects *)
+  (** 5.13.8 Texture objects *)
 
-    method bindTexture : texTarget -> texture t -> unit meth
+  method bindTexture : texTarget -> texture t -> unit meth
 
-    method bindTexture_ : texTarget -> texture t opt -> unit meth
+  method bindTexture_ : texTarget -> texture t opt -> unit meth
 
-    method compressedTexImage2D :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> sizei
-      -> sizei
-      -> int
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
+  method compressedTexImage2D :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> sizei
+    -> sizei
+    -> int
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
 
-    method compressedTexSubImage2D :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> sizei
-      -> sizei
-      -> pixelFormat
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
+  method compressedTexSubImage2D :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> sizei
+    -> sizei
+    -> pixelFormat
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
 
-    method copyTexImage2D :
-      texTarget -> int -> pixelFormat -> int -> int -> sizei -> sizei -> int -> unit meth
+  method copyTexImage2D :
+    texTarget -> int -> pixelFormat -> int -> int -> sizei -> sizei -> int -> unit meth
 
-    method copyTexSubImage2D :
-      texTarget -> int -> int -> int -> int -> int -> sizei -> sizei -> unit meth
+  method copyTexSubImage2D :
+    texTarget -> int -> int -> int -> int -> int -> sizei -> sizei -> unit meth
 
-    method createTexture : texture t meth
+  method createTexture : texture t meth
 
-    method deleteTexture : texture t -> unit meth
+  method deleteTexture : texture t -> unit meth
 
-    method generateMipmap : texTarget -> unit meth
-
-    method getTexParameter : texTarget -> 'a texParam -> 'a meth
-
-    method isTexture : texture t -> bool t meth
-
-    method texImage2D_new :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> sizei
-      -> sizei
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> void opt
-      -> unit meth
-
-    method texImage2D_fromView :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> sizei
-      -> sizei
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
-
-    method texImage2D_fromImageData :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageData t
-      -> unit meth
-
-    method texImage2D_fromImage :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageElement t
-      -> unit meth
-
-    method texImage2D_fromCanvas :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.canvasElement t
-      -> unit meth
-
-    method texImage2D_fromVideo :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.videoElement t
-      -> unit meth
-
-    (* {[
-        method texParameterf : texTarget -> texParam -> number t -> unit meth
-       ]}
-    *)
-    method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
-
-    method texSubImage2D_fromView :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> sizei
-      -> sizei
-      -> pixelFormat
-      -> pixelType
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
-
-    method texSubImage2D_fromImageData :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageData t
-      -> unit meth
+  method generateMipmap : texTarget -> unit meth
+
+  method getTexParameter : texTarget -> 'a texParam -> 'a meth
+
+  method isTexture : texture t -> bool t meth
+
+  method texImage2D_new :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> sizei
+    -> sizei
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> void opt
+    -> unit meth
+
+  method texImage2D_fromView :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> sizei
+    -> sizei
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
+
+  method texImage2D_fromImageData :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageData t
+    -> unit meth
+
+  method texImage2D_fromImage :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageElement t
+    -> unit meth
+
+  method texImage2D_fromCanvas :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.canvasElement t
+    -> unit meth
+
+  method texImage2D_fromVideo :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.videoElement t
+    -> unit meth
+
+  (* {[
+      method texParameterf : texTarget -> texParam -> number t -> unit meth
+     ]}
+  *)
+  method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
+
+  method texSubImage2D_fromView :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> sizei
+    -> sizei
+    -> pixelFormat
+    -> pixelType
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
+
+  method texSubImage2D_fromImageData :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageData t
+    -> unit meth
 
-    method texSubImage2D_fromImage :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageElement t
-      -> unit meth
+  method texSubImage2D_fromImage :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageElement t
+    -> unit meth
 
-    method texSubImage2D_fromCanvas :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.canvasElement t
-      -> unit meth
+  method texSubImage2D_fromCanvas :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.canvasElement t
+    -> unit meth
 
-    method texSubImage2D_fromVideo :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.videoElement t
-      -> unit meth
+  method texSubImage2D_fromVideo :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.videoElement t
+    -> unit meth
 
-    (** 5.13.9 Programs and Shaders *)
+  (** 5.13.9 Programs and Shaders *)
 
-    method attachShader : program t -> shader t -> unit meth
+  method attachShader : program t -> shader t -> unit meth
 
-    method bindAttribLocation : program t -> uint -> js_string t -> unit meth
+  method bindAttribLocation : program t -> uint -> js_string t -> unit meth
 
-    method compileShader : shader t -> unit meth
+  method compileShader : shader t -> unit meth
 
-    method createProgram : program t meth
+  method createProgram : program t meth
 
-    method createShader : shaderType -> shader t meth
+  method createShader : shaderType -> shader t meth
 
-    method deleteProgram : program t -> unit meth
+  method deleteProgram : program t -> unit meth
 
-    method deleteShader : shader t -> unit meth
+  method deleteShader : shader t -> unit meth
 
-    method detachShader : program t -> shader t -> unit meth
+  method detachShader : program t -> shader t -> unit meth
 
-    method getAttachedShaders : program t -> shader t js_array t meth
+  method getAttachedShaders : program t -> shader t js_array t meth
 
-    method getProgramParameter : 'a. program t -> 'a programParam -> 'a meth
+  method getProgramParameter : 'a. program t -> 'a programParam -> 'a meth
 
-    method getProgramInfoLog : program t -> js_string t meth
+  method getProgramInfoLog : program t -> js_string t meth
 
-    method getShaderParameter : 'a. shader t -> 'a shaderParam -> 'a meth
+  method getShaderParameter : 'a. shader t -> 'a shaderParam -> 'a meth
 
-    method getShaderPrecisionFormat :
-      shaderType -> shaderPrecisionType -> shaderPrecisionFormat t meth
+  method getShaderPrecisionFormat :
+    shaderType -> shaderPrecisionType -> shaderPrecisionFormat t meth
 
-    method getShaderInfoLog : shader t -> js_string t meth
+  method getShaderInfoLog : shader t -> js_string t meth
 
-    method getShaderSource : shader t -> js_string t meth
+  method getShaderSource : shader t -> js_string t meth
 
-    method isProgram : program t -> bool t meth
+  method isProgram : program t -> bool t meth
 
-    method isShader : shader t -> bool t meth
+  method isShader : shader t -> bool t meth
 
-    method linkProgram : program t -> unit meth
+  method linkProgram : program t -> unit meth
 
-    method shaderSource : shader t -> js_string t -> unit meth
+  method shaderSource : shader t -> js_string t -> unit meth
 
-    method useProgram : program t -> unit meth
+  method useProgram : program t -> unit meth
 
-    method validateProgram : program t -> unit meth
+  method validateProgram : program t -> unit meth
 
-    (** 5.13.10 Uniforms and attributes *)
+  (** 5.13.10 Uniforms and attributes *)
 
-    method disableVertexAttribArray : uint -> unit meth
+  method disableVertexAttribArray : uint -> unit meth
 
-    method enableVertexAttribArray : uint -> unit meth
+  method enableVertexAttribArray : uint -> unit meth
 
-    method getActiveAttrib : program t -> uint -> activeInfo t meth
+  method getActiveAttrib : program t -> uint -> activeInfo t meth
 
-    method getActiveUniform : program t -> uint -> activeInfo t meth
+  method getActiveUniform : program t -> uint -> activeInfo t meth
 
-    method getAttribLocation : program t -> js_string t -> int meth
+  method getAttribLocation : program t -> js_string t -> int meth
 
-    method getUniform : 'a 'b. program t -> 'a uniformLocation t -> 'b meth
+  method getUniform : 'a 'b. program t -> 'a uniformLocation t -> 'b meth
 
-    method getUniformLocation : 'a. program t -> js_string t -> 'a uniformLocation t meth
+  method getUniformLocation : 'a. program t -> js_string t -> 'a uniformLocation t meth
 
-    method getVertexAttrib : 'a. uint -> 'a vertexAttribParam -> 'a meth
+  method getVertexAttrib : 'a. uint -> 'a vertexAttribParam -> 'a meth
 
-    method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
+  method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-    method uniform1f : number t uniformLocation t -> number t -> unit meth
+  method uniform1f : number t uniformLocation t -> number t -> unit meth
 
-    method uniform1fv_typed :
-      number t uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform1fv_typed :
+    number t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
+  method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform1i : int uniformLocation t -> int -> unit meth
+  method uniform1i : int uniformLocation t -> int -> unit meth
 
-    method uniform1iv_typed :
-      int uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform1iv_typed : int uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
+  method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
+  method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
 
-    method uniform2fv_typed :
-      [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform2fv_typed :
+    [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
+  method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
-    method uniform2iv : [ `ivec2 ] uniformLocation t -> int js_array t -> unit meth
+  method uniform2iv : [ `ivec2 ] uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2iv_typed :
-      [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform2iv_typed :
+    [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform3f :
-      [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
+  method uniform3f :
+    [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
 
-    method uniform3fv_typed :
-      [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform3fv_typed :
+    [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
+  method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
-    method uniform3iv : [ `ivec3 ] uniformLocation t -> int js_array t -> unit meth
+  method uniform3iv : [ `ivec3 ] uniformLocation t -> int js_array t -> unit meth
 
-    method uniform3iv_typed :
-      [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform3iv_typed :
+    [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform4f :
-         [ `vec4 ] uniformLocation t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method uniform4f :
+       [ `vec4 ] uniformLocation t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    method uniform4fv_typed :
-      [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform4fv_typed :
+    [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform4i :
-      [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
+  method uniform4i : [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
 
-    method uniform4iv : [ `ivec4 ] uniformLocation t -> int js_array t -> unit meth
+  method uniform4iv : [ `ivec4 ] uniformLocation t -> int js_array t -> unit meth
 
-    method uniform4iv_typed :
-      [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform4iv_typed :
+    [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniformMatrix2fv :
-      [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+  method uniformMatrix2fv :
+    [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
-    method uniformMatrix2fv_typed :
-      [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
+  method uniformMatrix2fv_typed :
+    [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method uniformMatrix3fv :
-      [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+  method uniformMatrix3fv :
+    [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
-    method uniformMatrix3fv_typed :
-      [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
+  method uniformMatrix3fv_typed :
+    [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method uniformMatrix4fv :
-      [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+  method uniformMatrix4fv :
+    [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
-    method uniformMatrix4fv_typed :
-      [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
+  method uniformMatrix4fv_typed :
+    [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib1f : uint -> number t -> unit meth
+  method vertexAttrib1f : uint -> number t -> unit meth
 
-    method vertexAttrib1fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib1fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib2f : uint -> number t -> number t -> unit meth
+  method vertexAttrib2f : uint -> number t -> number t -> unit meth
 
-    method vertexAttrib2fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib2fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
+  method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib3fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib3fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib4f :
-      uint -> number t -> number t -> number t -> number t -> unit meth
+  method vertexAttrib4f :
+    uint -> number t -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib4fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib4fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttribPointer :
-      uint -> int -> dataType -> bool t -> sizei -> intptr -> unit meth
+  method vertexAttribPointer :
+    uint -> int -> dataType -> bool t -> sizei -> intptr -> unit meth
 
-    (** 5.13.11 Writing to the drawing buffer *)
+  (** 5.13.11 Writing to the drawing buffer *)
 
-    method clear : clearBufferMask -> unit meth
+  method clear : clearBufferMask -> unit meth
 
-    method drawArrays : beginMode -> int -> sizei -> unit meth
+  method drawArrays : beginMode -> int -> sizei -> unit meth
 
-    method drawElements : beginMode -> sizei -> dataType -> intptr -> unit meth
+  method drawElements : beginMode -> sizei -> dataType -> intptr -> unit meth
 
-    method finish : unit meth
+  method finish : unit meth
 
-    method flush : unit meth
+  method flush : unit meth
 
-    (** 5.13.12 Reading back pixels *)
+  (** 5.13.12 Reading back pixels *)
 
-    method readPixels :
-         int
-      -> int
-      -> sizei
-      -> sizei
-      -> pixelFormat
-      -> pixelType
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
+  method readPixels :
+       int
+    -> int
+    -> sizei
+    -> sizei
+    -> pixelFormat
+    -> pixelType
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
 
-    (** 5.13.13 Detecting context lost events *)
+  (** 5.13.13 Detecting context lost events *)
 
-    method isContextLost : bool t meth
+  method isContextLost : bool t meth
 
-    (** 5.13.14 Detecting and enabling extensions *)
+  (** 5.13.14 Detecting and enabling extensions *)
 
-    method getSupportedExtensions : js_string t js_array t meth
+  method getSupportedExtensions : js_string t js_array t meth
 
-    method getExtension : 'a. js_string t -> 'a t opt meth
+  method getExtension : 'a. js_string t -> 'a t opt meth
 
-    (* Untyped! *)
-    (** Constants *)
+  (* Untyped! *)
+  (** Constants *)
 
-    method _DEPTH_BUFFER_BIT_ : clearBufferMask readonly_prop
+  method _DEPTH_BUFFER_BIT_ : clearBufferMask readonly_prop
 
-    method _STENCIL_BUFFER_BIT_ : clearBufferMask readonly_prop
+  method _STENCIL_BUFFER_BIT_ : clearBufferMask readonly_prop
 
-    method _COLOR_BUFFER_BIT_ : clearBufferMask readonly_prop
+  method _COLOR_BUFFER_BIT_ : clearBufferMask readonly_prop
 
-    method _POINTS : beginMode readonly_prop
+  method _POINTS : beginMode readonly_prop
 
-    method _LINES : beginMode readonly_prop
+  method _LINES : beginMode readonly_prop
 
-    method _LINE_LOOP_ : beginMode readonly_prop
+  method _LINE_LOOP_ : beginMode readonly_prop
 
-    method _LINE_STRIP_ : beginMode readonly_prop
+  method _LINE_STRIP_ : beginMode readonly_prop
 
-    method _TRIANGLES : beginMode readonly_prop
+  method _TRIANGLES : beginMode readonly_prop
 
-    method _TRIANGLE_STRIP_ : beginMode readonly_prop
+  method _TRIANGLE_STRIP_ : beginMode readonly_prop
 
-    method _TRIANGLE_FAN_ : beginMode readonly_prop
+  method _TRIANGLE_FAN_ : beginMode readonly_prop
 
-    method _ZERO : blendingFactor readonly_prop
+  method _ZERO : blendingFactor readonly_prop
 
-    method _ONE : blendingFactor readonly_prop
+  method _ONE : blendingFactor readonly_prop
 
-    method _SRC_COLOR_ : blendingFactor readonly_prop
+  method _SRC_COLOR_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_SRC_COLOR_ : blendingFactor readonly_prop
+  method _ONE_MINUS_SRC_COLOR_ : blendingFactor readonly_prop
 
-    method _SRC_ALPHA_ : blendingFactor readonly_prop
+  method _SRC_ALPHA_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_SRC_ALPHA_ : blendingFactor readonly_prop
+  method _ONE_MINUS_SRC_ALPHA_ : blendingFactor readonly_prop
 
-    method _DST_ALPHA_ : blendingFactor readonly_prop
+  method _DST_ALPHA_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_DST_ALPHA_ : blendingFactor readonly_prop
+  method _ONE_MINUS_DST_ALPHA_ : blendingFactor readonly_prop
 
-    method _DST_COLOR_ : blendingFactor readonly_prop
+  method _DST_COLOR_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_DST_COLOR_ : blendingFactor readonly_prop
+  method _ONE_MINUS_DST_COLOR_ : blendingFactor readonly_prop
 
-    method _SRC_ALPHA_SATURATE_ : blendingFactor readonly_prop
+  method _SRC_ALPHA_SATURATE_ : blendingFactor readonly_prop
 
-    method _FUNC_ADD_ : blendMode readonly_prop
+  method _FUNC_ADD_ : blendMode readonly_prop
 
-    method _FUNC_SUBTRACT_ : blendMode readonly_prop
+  method _FUNC_SUBTRACT_ : blendMode readonly_prop
 
-    method _FUNC_REVERSE_SUBTRACT_ : blendMode readonly_prop
+  method _FUNC_REVERSE_SUBTRACT_ : blendMode readonly_prop
 
-    method _CONSTANT_COLOR_ : blendMode readonly_prop
+  method _CONSTANT_COLOR_ : blendMode readonly_prop
 
-    method _ONE_MINUS_CONSTANT_COLOR_ : blendMode readonly_prop
+  method _ONE_MINUS_CONSTANT_COLOR_ : blendMode readonly_prop
 
-    method _CONSTANT_ALPHA_ : blendMode readonly_prop
+  method _CONSTANT_ALPHA_ : blendMode readonly_prop
 
-    method _ONE_MINUS_CONSTANT_ALPHA_ : blendMode readonly_prop
+  method _ONE_MINUS_CONSTANT_ALPHA_ : blendMode readonly_prop
 
-    method _ARRAY_BUFFER_ : bufferTarget readonly_prop
+  method _ARRAY_BUFFER_ : bufferTarget readonly_prop
 
-    method _ELEMENT_ARRAY_BUFFER_ : bufferTarget readonly_prop
+  method _ELEMENT_ARRAY_BUFFER_ : bufferTarget readonly_prop
 
-    method _STREAM_DRAW_ : bufferUsage readonly_prop
+  method _STREAM_DRAW_ : bufferUsage readonly_prop
 
-    method _STATIC_DRAW_ : bufferUsage readonly_prop
+  method _STATIC_DRAW_ : bufferUsage readonly_prop
 
-    method _DYNAMIC_DRAW_ : bufferUsage readonly_prop
+  method _DYNAMIC_DRAW_ : bufferUsage readonly_prop
 
-    method _FRONT : cullFaceMode readonly_prop
+  method _FRONT : cullFaceMode readonly_prop
 
-    method _BACK : cullFaceMode readonly_prop
+  method _BACK : cullFaceMode readonly_prop
 
-    method _FRONT_AND_BACK_ : cullFaceMode readonly_prop
+  method _FRONT_AND_BACK_ : cullFaceMode readonly_prop
 
-    method _CULL_FACE_ : enableCap readonly_prop
+  method _CULL_FACE_ : enableCap readonly_prop
 
-    method _BLEND : enableCap readonly_prop
+  method _BLEND : enableCap readonly_prop
 
-    method _DITHER : enableCap readonly_prop
+  method _DITHER : enableCap readonly_prop
 
-    method _STENCIL_TEST_ : enableCap readonly_prop
+  method _STENCIL_TEST_ : enableCap readonly_prop
 
-    method _DEPTH_TEST_ : enableCap readonly_prop
+  method _DEPTH_TEST_ : enableCap readonly_prop
 
-    method _SCISSOR_TEST_ : enableCap readonly_prop
+  method _SCISSOR_TEST_ : enableCap readonly_prop
 
-    method _POLYGON_OFFSET_FILL_ : enableCap readonly_prop
+  method _POLYGON_OFFSET_FILL_ : enableCap readonly_prop
 
-    method _SAMPLE_ALPHA_TO_COVERAGE_ : enableCap readonly_prop
+  method _SAMPLE_ALPHA_TO_COVERAGE_ : enableCap readonly_prop
 
-    method _SAMPLE_COVERAGE_ : enableCap readonly_prop
+  method _SAMPLE_COVERAGE_ : enableCap readonly_prop
 
-    method _NO_ERROR_ : errorCode readonly_prop
+  method _NO_ERROR_ : errorCode readonly_prop
 
-    method _INVALID_ENUM_ : errorCode readonly_prop
+  method _INVALID_ENUM_ : errorCode readonly_prop
 
-    method _INVALID_VALUE_ : errorCode readonly_prop
+  method _INVALID_VALUE_ : errorCode readonly_prop
 
-    method _INVALID_OPERATION_ : errorCode readonly_prop
+  method _INVALID_OPERATION_ : errorCode readonly_prop
 
-    method _OUT_OF_MEMORY_ : errorCode readonly_prop
+  method _OUT_OF_MEMORY_ : errorCode readonly_prop
 
-    method _CONTEXT_LOST_WEBGL_ : errorCode readonly_prop
+  method _CONTEXT_LOST_WEBGL_ : errorCode readonly_prop
 
-    method _INVALID_FRAMEBUFFER_OPERATION_ : errorCode readonly_prop
+  method _INVALID_FRAMEBUFFER_OPERATION_ : errorCode readonly_prop
 
-    method _CW : frontFaceDir readonly_prop
+  method _CW : frontFaceDir readonly_prop
 
-    method _CCW : frontFaceDir readonly_prop
+  method _CCW : frontFaceDir readonly_prop
 
-    method _DONT_CARE_ : hintMode readonly_prop
+  method _DONT_CARE_ : hintMode readonly_prop
 
-    method _FASTEST : hintMode readonly_prop
+  method _FASTEST : hintMode readonly_prop
 
-    method _NICEST : hintMode readonly_prop
+  method _NICEST : hintMode readonly_prop
 
-    method _GENERATE_MIPMAP_HINT_ : hintTarget readonly_prop
+  method _GENERATE_MIPMAP_HINT_ : hintTarget readonly_prop
 
-    method _BLEND_EQUATION_ : blendMode parameter readonly_prop
+  method _BLEND_EQUATION_ : blendMode parameter readonly_prop
 
-    method _BLEND_EQUATION_RGB_ : blendMode parameter readonly_prop
+  method _BLEND_EQUATION_RGB_ : blendMode parameter readonly_prop
 
-    method _BLEND_EQUATION_ALPHA_ : blendMode parameter readonly_prop
+  method _BLEND_EQUATION_ALPHA_ : blendMode parameter readonly_prop
 
-    method _BLEND_DST_RGB_ : blendingFactor parameter readonly_prop
+  method _BLEND_DST_RGB_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_SRC_RGB_ : blendingFactor parameter readonly_prop
+  method _BLEND_SRC_RGB_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_DST_ALPHA_ : blendingFactor parameter readonly_prop
+  method _BLEND_DST_ALPHA_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_SRC_ALPHA_ : blendingFactor parameter readonly_prop
+  method _BLEND_SRC_ALPHA_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_COLOR_ : Typed_array.float32Array t parameter readonly_prop
+  method _BLEND_COLOR_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
+  method _ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
 
-    method _ELEMENT_ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
+  method _ELEMENT_ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
 
-    method _CULL_FACE_PARAM : bool t parameter readonly_prop
+  method _CULL_FACE_PARAM : bool t parameter readonly_prop
 
-    method _BLEND_PARAM : bool t parameter readonly_prop
+  method _BLEND_PARAM : bool t parameter readonly_prop
 
-    method _DITHER_PARAM : bool t parameter readonly_prop
+  method _DITHER_PARAM : bool t parameter readonly_prop
 
-    method _STENCIL_TEST_PARAM : bool t parameter readonly_prop
+  method _STENCIL_TEST_PARAM : bool t parameter readonly_prop
 
-    method _DEPTH_TEST_PARAM : bool t parameter readonly_prop
+  method _DEPTH_TEST_PARAM : bool t parameter readonly_prop
 
-    method _SCISSOR_TEST_PARAM : bool t parameter readonly_prop
+  method _SCISSOR_TEST_PARAM : bool t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
+  method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-    method _LINE_WIDTH_ : number t parameter readonly_prop
+  method _LINE_WIDTH_ : number t parameter readonly_prop
 
-    method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
+  method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _ALIASED_LINE_WIDTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
+  method _ALIASED_LINE_WIDTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _CULL_FACE_MODE_ : cullFaceMode parameter readonly_prop
+  method _CULL_FACE_MODE_ : cullFaceMode parameter readonly_prop
 
-    method _FRONT_FACE_ : frontFaceDir parameter readonly_prop
+  method _FRONT_FACE_ : frontFaceDir parameter readonly_prop
 
-    method _DEPTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
+  method _DEPTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
+  method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-    method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
+  method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
 
-    method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
+  method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
-    method _STENCIL_CLEAR_VALUE_ : int parameter readonly_prop
+  method _STENCIL_CLEAR_VALUE_ : int parameter readonly_prop
 
-    method _STENCIL_FUNC_ : int parameter readonly_prop
+  method _STENCIL_FUNC_ : int parameter readonly_prop
 
-    method _STENCIL_FAIL_ : int parameter readonly_prop
+  method _STENCIL_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_PASS_DEPTH_FAIL_ : int parameter readonly_prop
+  method _STENCIL_PASS_DEPTH_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_PASS_DEPTH_PASS_ : int parameter readonly_prop
+  method _STENCIL_PASS_DEPTH_PASS_ : int parameter readonly_prop
 
-    method _STENCIL_REF_ : int parameter readonly_prop
+  method _STENCIL_REF_ : int parameter readonly_prop
 
-    method _STENCIL_VALUE_MASK_ : int parameter readonly_prop
+  method _STENCIL_VALUE_MASK_ : int parameter readonly_prop
 
-    method _STENCIL_WRITEMASK_ : int parameter readonly_prop
+  method _STENCIL_WRITEMASK_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_FUNC_ : int parameter readonly_prop
+  method _STENCIL_BACK_FUNC_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_FAIL_ : int parameter readonly_prop
+  method _STENCIL_BACK_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_PASS_DEPTH_FAIL_ : int parameter readonly_prop
+  method _STENCIL_BACK_PASS_DEPTH_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_PASS_DEPTH_PASS_ : int parameter readonly_prop
+  method _STENCIL_BACK_PASS_DEPTH_PASS_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_REF_ : int parameter readonly_prop
+  method _STENCIL_BACK_REF_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_VALUE_MASK_ : int parameter readonly_prop
+  method _STENCIL_BACK_VALUE_MASK_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_WRITEMASK_ : int parameter readonly_prop
+  method _STENCIL_BACK_WRITEMASK_ : int parameter readonly_prop
 
-    method _VIEWPORT : Typed_array.int32Array t parameter readonly_prop
+  method _VIEWPORT : Typed_array.int32Array t parameter readonly_prop
 
-    method _SCISSOR_BOX_ : Typed_array.int32Array t parameter readonly_prop
+  method _SCISSOR_BOX_ : Typed_array.int32Array t parameter readonly_prop
 
-    method _COLOR_CLEAR_VALUE_ : Typed_array.float32Array t parameter readonly_prop
+  method _COLOR_CLEAR_VALUE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _COLOR_WRITEMASK_ : bool t js_array t parameter readonly_prop
+  method _COLOR_WRITEMASK_ : bool t js_array t parameter readonly_prop
 
-    method _UNPACK_ALIGNMENT_PARAM : int parameter readonly_prop
+  method _UNPACK_ALIGNMENT_PARAM : int parameter readonly_prop
 
-    method _PACK_ALIGNMENT_ : int parameter readonly_prop
+  method _PACK_ALIGNMENT_ : int parameter readonly_prop
 
-    method _MAX_TEXTURE_SIZE_ : int parameter readonly_prop
+  method _MAX_TEXTURE_SIZE_ : int parameter readonly_prop
 
-    method _MAX_VIEWPORT_DIMS_ : Typed_array.int32Array t parameter readonly_prop
+  method _MAX_VIEWPORT_DIMS_ : Typed_array.int32Array t parameter readonly_prop
 
-    method _SUBPIXEL_BITS_ : int parameter readonly_prop
+  method _SUBPIXEL_BITS_ : int parameter readonly_prop
 
-    method _RED_BITS_ : int parameter readonly_prop
+  method _RED_BITS_ : int parameter readonly_prop
 
-    method _GREEN_BITS_ : int parameter readonly_prop
+  method _GREEN_BITS_ : int parameter readonly_prop
 
-    method _BLUE_BITS_ : int parameter readonly_prop
+  method _BLUE_BITS_ : int parameter readonly_prop
 
-    method _ALPHA_BITS_ : int parameter readonly_prop
+  method _ALPHA_BITS_ : int parameter readonly_prop
 
-    method _DEPTH_BITS_ : int parameter readonly_prop
+  method _DEPTH_BITS_ : int parameter readonly_prop
 
-    method _STENCIL_BITS_ : int parameter readonly_prop
+  method _STENCIL_BITS_ : int parameter readonly_prop
 
-    method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
 
-    method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
+  method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
-    method _TEXTURE_BINDING_CUBE_MAP_ : texture t opt parameter readonly_prop
+  method _TEXTURE_BINDING_CUBE_MAP_ : texture t opt parameter readonly_prop
 
-    method _SAMPLE_BUFFERS_ : int parameter readonly_prop
+  method _SAMPLE_BUFFERS_ : int parameter readonly_prop
 
-    method _SAMPLES_ : int parameter readonly_prop
+  method _SAMPLES_ : int parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
+  method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
+  method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
-    method _NUM_COMPRESSED_TEXTURE_FORMATS_ : int parameter readonly_prop
+  method _NUM_COMPRESSED_TEXTURE_FORMATS_ : int parameter readonly_prop
 
-    method _COMPRESSED_TEXTURE_FORMATS_ :
-      Typed_array.uint32Array t parameter readonly_prop
+  method _COMPRESSED_TEXTURE_FORMATS_ : Typed_array.uint32Array t parameter readonly_prop
 
-    method _GENERATE_MIPMAP_HINT_PARAM_ : hintMode parameter readonly_prop
+  method _GENERATE_MIPMAP_HINT_PARAM_ : hintMode parameter readonly_prop
 
-    method _BUFFER_SIZE_ : int bufferParameter readonly_prop
+  method _BUFFER_SIZE_ : int bufferParameter readonly_prop
 
-    method _BUFFER_USAGE_ : bufferUsage bufferParameter readonly_prop
+  method _BUFFER_USAGE_ : bufferUsage bufferParameter readonly_prop
 
-    method _BYTE : dataType readonly_prop
+  method _BYTE : dataType readonly_prop
 
-    method _UNSIGNED_BYTE_DT : dataType readonly_prop
+  method _UNSIGNED_BYTE_DT : dataType readonly_prop
 
-    method _SHORT : dataType readonly_prop
+  method _SHORT : dataType readonly_prop
 
-    method _UNSIGNED_SHORT_ : dataType readonly_prop
+  method _UNSIGNED_SHORT_ : dataType readonly_prop
 
-    method _INT : dataType readonly_prop
+  method _INT : dataType readonly_prop
 
-    method _UNSIGNED_INT_ : dataType readonly_prop
+  method _UNSIGNED_INT_ : dataType readonly_prop
 
-    method _FLOAT : dataType readonly_prop
+  method _FLOAT : dataType readonly_prop
 
-    method _UNSIGNED_BYTE_ : pixelType readonly_prop
+  method _UNSIGNED_BYTE_ : pixelType readonly_prop
 
-    method _UNSIGNED_SHORT_4_4_4_4_ : pixelType readonly_prop
+  method _UNSIGNED_SHORT_4_4_4_4_ : pixelType readonly_prop
 
-    method _UNSIGNED_SHORT_5_5_5_1_ : pixelType readonly_prop
+  method _UNSIGNED_SHORT_5_5_5_1_ : pixelType readonly_prop
 
-    method _UNSIGNED_SHORT_5_6_5_ : pixelType readonly_prop
+  method _UNSIGNED_SHORT_5_6_5_ : pixelType readonly_prop
 
-    method _ALPHA : pixelFormat readonly_prop
+  method _ALPHA : pixelFormat readonly_prop
 
-    method _RGB : pixelFormat readonly_prop
+  method _RGB : pixelFormat readonly_prop
 
-    method _RGBA : pixelFormat readonly_prop
+  method _RGBA : pixelFormat readonly_prop
 
-    method _LUMINANCE : pixelFormat readonly_prop
+  method _LUMINANCE : pixelFormat readonly_prop
 
-    method _LUMINANCE_ALPHA_ : pixelFormat readonly_prop
+  method _LUMINANCE_ALPHA_ : pixelFormat readonly_prop
 
-    method _STENCIL_INDEX_ : pixelFormat readonly_prop
+  method _STENCIL_INDEX_ : pixelFormat readonly_prop
 
-    method _DEPTH_STENCIL_ : pixelFormat readonly_prop
+  method _DEPTH_STENCIL_ : pixelFormat readonly_prop
 
-    method _DEPTH_COMPONENT_ : pixelFormat readonly_prop
+  method _DEPTH_COMPONENT_ : pixelFormat readonly_prop
 
-    method _FRAGMENT_SHADER_ : shaderType readonly_prop
+  method _FRAGMENT_SHADER_ : shaderType readonly_prop
 
-    method _VERTEX_SHADER_ : shaderType readonly_prop
+  method _VERTEX_SHADER_ : shaderType readonly_prop
 
-    method _MAX_VERTEX_ATTRIBS_ : int parameter readonly_prop
+  method _MAX_VERTEX_ATTRIBS_ : int parameter readonly_prop
 
-    method _MAX_VERTEX_UNIFORM_VECTORS_ : int parameter readonly_prop
+  method _MAX_VERTEX_UNIFORM_VECTORS_ : int parameter readonly_prop
 
-    method _MAX_VARYING_VECTORS_ : int parameter readonly_prop
+  method _MAX_VARYING_VECTORS_ : int parameter readonly_prop
 
-    method _MAX_COMBINED_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
+  method _MAX_COMBINED_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
 
-    method _MAX_VERTEX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
+  method _MAX_VERTEX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
 
-    method _MAX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
+  method _MAX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
 
-    method _MAX_FRAGMENT_UNIFORM_VECTORS_ : int parameter readonly_prop
+  method _MAX_FRAGMENT_UNIFORM_VECTORS_ : int parameter readonly_prop
 
-    method _SHADER_TYPE_ : shaderType shaderParam readonly_prop
+  method _SHADER_TYPE_ : shaderType shaderParam readonly_prop
 
-    method _DELETE_STATUS_ : bool t shaderParam readonly_prop
+  method _DELETE_STATUS_ : bool t shaderParam readonly_prop
 
-    method _COMPILE_STATUS_ : bool t shaderParam readonly_prop
+  method _COMPILE_STATUS_ : bool t shaderParam readonly_prop
 
-    method _DELETE_STATUS_PROG : bool t programParam readonly_prop
+  method _DELETE_STATUS_PROG : bool t programParam readonly_prop
 
-    method _LINK_STATUS_ : bool t programParam readonly_prop
+  method _LINK_STATUS_ : bool t programParam readonly_prop
 
-    method _VALIDATE_STATUS_ : bool t programParam readonly_prop
+  method _VALIDATE_STATUS_ : bool t programParam readonly_prop
 
-    method _ATTACHED_SHADERS_ : int programParam readonly_prop
+  method _ATTACHED_SHADERS_ : int programParam readonly_prop
 
-    method _ACTIVE_UNIFORMS_ : int programParam readonly_prop
+  method _ACTIVE_UNIFORMS_ : int programParam readonly_prop
 
-    method _ACTIVE_ATTRIBUTES_ : int programParam readonly_prop
+  method _ACTIVE_ATTRIBUTES_ : int programParam readonly_prop
 
-    method _SHADING_LANGUAGE_VERSION_ : js_string t parameter readonly_prop
+  method _SHADING_LANGUAGE_VERSION_ : js_string t parameter readonly_prop
 
-    method _CURRENT_PROGRAM_ : program t opt parameter readonly_prop
+  method _CURRENT_PROGRAM_ : program t opt parameter readonly_prop
 
-    method _VENDOR : js_string t parameter readonly_prop
+  method _VENDOR : js_string t parameter readonly_prop
 
-    method _RENDERER : js_string t parameter readonly_prop
+  method _RENDERER : js_string t parameter readonly_prop
 
-    method _VERSION : js_string t parameter readonly_prop
+  method _VERSION : js_string t parameter readonly_prop
 
-    method _MAX_CUBE_MAP_TEXTURE_SIZE_ : int parameter readonly_prop
+  method _MAX_CUBE_MAP_TEXTURE_SIZE_ : int parameter readonly_prop
 
-    method _ACTIVE_TEXTURE_ : int parameter readonly_prop
+  method _ACTIVE_TEXTURE_ : int parameter readonly_prop
 
-    method _FRAMEBUFFER_BINDING_ : framebuffer t opt parameter readonly_prop
+  method _FRAMEBUFFER_BINDING_ : framebuffer t opt parameter readonly_prop
 
-    method _RENDERBUFFER_BINDING_ : renderbuffer t opt parameter readonly_prop
+  method _RENDERBUFFER_BINDING_ : renderbuffer t opt parameter readonly_prop
 
-    method _MAX_RENDERBUFFER_SIZE : int parameter readonly_prop
+  method _MAX_RENDERBUFFER_SIZE : int parameter readonly_prop
 
-    method _NEVER : depthFunction readonly_prop
+  method _NEVER : depthFunction readonly_prop
 
-    method _LESS : depthFunction readonly_prop
+  method _LESS : depthFunction readonly_prop
 
-    method _EQUAL : depthFunction readonly_prop
+  method _EQUAL : depthFunction readonly_prop
 
-    method _LEQUAL : depthFunction readonly_prop
+  method _LEQUAL : depthFunction readonly_prop
 
-    method _GREATER : depthFunction readonly_prop
+  method _GREATER : depthFunction readonly_prop
 
-    method _NOTEQUAL : depthFunction readonly_prop
+  method _NOTEQUAL : depthFunction readonly_prop
 
-    method _GEQUAL : depthFunction readonly_prop
+  method _GEQUAL : depthFunction readonly_prop
 
-    method _ALWAYS : depthFunction readonly_prop
+  method _ALWAYS : depthFunction readonly_prop
 
-    method _KEEP : stencilOp readonly_prop
+  method _KEEP : stencilOp readonly_prop
 
-    method _REPLACE : stencilOp readonly_prop
+  method _REPLACE : stencilOp readonly_prop
 
-    method _INCR : stencilOp readonly_prop
+  method _INCR : stencilOp readonly_prop
 
-    method _DECR : stencilOp readonly_prop
+  method _DECR : stencilOp readonly_prop
 
-    method _INVERT : stencilOp readonly_prop
+  method _INVERT : stencilOp readonly_prop
 
-    method _INCR_WRAP_ : stencilOp readonly_prop
+  method _INCR_WRAP_ : stencilOp readonly_prop
 
-    method _DECR_WRAP_ : stencilOp readonly_prop
+  method _DECR_WRAP_ : stencilOp readonly_prop
 
-    method _ZERO_ : stencilOp readonly_prop
+  method _ZERO_ : stencilOp readonly_prop
 
-    method _NEAREST : texFilter readonly_prop
+  method _NEAREST : texFilter readonly_prop
 
-    method _LINEAR : texFilter readonly_prop
+  method _LINEAR : texFilter readonly_prop
 
-    method _NEAREST_MIPMAP_NEAREST_ : texFilter readonly_prop
+  method _NEAREST_MIPMAP_NEAREST_ : texFilter readonly_prop
 
-    method _LINEAR_MIPMAP_NEAREST_ : texFilter readonly_prop
+  method _LINEAR_MIPMAP_NEAREST_ : texFilter readonly_prop
 
-    method _NEAREST_MIPMAP_LINEAR_ : texFilter readonly_prop
+  method _NEAREST_MIPMAP_LINEAR_ : texFilter readonly_prop
 
-    method _LINEAR_MIPMAP_LINEAR_ : texFilter readonly_prop
+  method _LINEAR_MIPMAP_LINEAR_ : texFilter readonly_prop
 
-    method _TEXTURE_MAG_FILTER_ : texFilter texParam readonly_prop
+  method _TEXTURE_MAG_FILTER_ : texFilter texParam readonly_prop
 
-    method _TEXTURE_MIN_FILTER_ : texFilter texParam readonly_prop
+  method _TEXTURE_MIN_FILTER_ : texFilter texParam readonly_prop
 
-    method _TEXTURE_WRAP_S_ : wrapMode texParam readonly_prop
+  method _TEXTURE_WRAP_S_ : wrapMode texParam readonly_prop
 
-    method _TEXTURE_WRAP_T_ : wrapMode texParam readonly_prop
+  method _TEXTURE_WRAP_T_ : wrapMode texParam readonly_prop
 
-    method _NONE_OT : objectType readonly_prop
+  method _NONE_OT : objectType readonly_prop
 
-    method _TEXTURE_OT : objectType readonly_prop
+  method _TEXTURE_OT : objectType readonly_prop
 
-    method _RENDERBUFFER_OT : objectType readonly_prop
+  method _RENDERBUFFER_OT : objectType readonly_prop
 
-    method _TEXTURE_2D_ : texTarget readonly_prop
+  method _TEXTURE_2D_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_POSITIVE_X_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_POSITIVE_X_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_NEGATIVE_X_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_NEGATIVE_X_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_POSITIVE_Y_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_POSITIVE_Y_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_NEGATIVE_Y_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_NEGATIVE_Y_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_POSITIVE_Z_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_POSITIVE_Z_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_NEGATIVE_Z_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_NEGATIVE_Z_ : texTarget readonly_prop
 
-    method _TEXTURE0 : textureUnit readonly_prop
+  method _TEXTURE0 : textureUnit readonly_prop
 
-    method _TEXTURE1 : textureUnit readonly_prop
+  method _TEXTURE1 : textureUnit readonly_prop
 
-    method _TEXTURE2 : textureUnit readonly_prop
+  method _TEXTURE2 : textureUnit readonly_prop
 
-    method _TEXTURE3 : textureUnit readonly_prop
+  method _TEXTURE3 : textureUnit readonly_prop
 
-    method _TEXTURE4 : textureUnit readonly_prop
+  method _TEXTURE4 : textureUnit readonly_prop
 
-    method _TEXTURE5 : textureUnit readonly_prop
+  method _TEXTURE5 : textureUnit readonly_prop
 
-    method _TEXTURE6 : textureUnit readonly_prop
+  method _TEXTURE6 : textureUnit readonly_prop
 
-    method _TEXTURE7 : textureUnit readonly_prop
+  method _TEXTURE7 : textureUnit readonly_prop
 
-    method _TEXTURE8 : textureUnit readonly_prop
+  method _TEXTURE8 : textureUnit readonly_prop
 
-    method _TEXTURE9 : textureUnit readonly_prop
+  method _TEXTURE9 : textureUnit readonly_prop
 
-    method _TEXTURE10 : textureUnit readonly_prop
+  method _TEXTURE10 : textureUnit readonly_prop
 
-    method _TEXTURE11 : textureUnit readonly_prop
+  method _TEXTURE11 : textureUnit readonly_prop
 
-    method _TEXTURE12 : textureUnit readonly_prop
+  method _TEXTURE12 : textureUnit readonly_prop
 
-    method _TEXTURE13 : textureUnit readonly_prop
+  method _TEXTURE13 : textureUnit readonly_prop
 
-    method _TEXTURE14 : textureUnit readonly_prop
+  method _TEXTURE14 : textureUnit readonly_prop
 
-    method _TEXTURE15 : textureUnit readonly_prop
+  method _TEXTURE15 : textureUnit readonly_prop
 
-    method _TEXTURE16 : textureUnit readonly_prop
+  method _TEXTURE16 : textureUnit readonly_prop
 
-    method _TEXTURE17 : textureUnit readonly_prop
+  method _TEXTURE17 : textureUnit readonly_prop
 
-    method _TEXTURE18 : textureUnit readonly_prop
+  method _TEXTURE18 : textureUnit readonly_prop
 
-    method _TEXTURE19 : textureUnit readonly_prop
+  method _TEXTURE19 : textureUnit readonly_prop
 
-    method _TEXTURE20 : textureUnit readonly_prop
+  method _TEXTURE20 : textureUnit readonly_prop
 
-    method _TEXTURE21 : textureUnit readonly_prop
+  method _TEXTURE21 : textureUnit readonly_prop
 
-    method _TEXTURE22 : textureUnit readonly_prop
+  method _TEXTURE22 : textureUnit readonly_prop
 
-    method _TEXTURE23 : textureUnit readonly_prop
+  method _TEXTURE23 : textureUnit readonly_prop
 
-    method _TEXTURE24 : textureUnit readonly_prop
+  method _TEXTURE24 : textureUnit readonly_prop
 
-    method _TEXTURE25 : textureUnit readonly_prop
+  method _TEXTURE25 : textureUnit readonly_prop
 
-    method _TEXTURE26 : textureUnit readonly_prop
+  method _TEXTURE26 : textureUnit readonly_prop
 
-    method _TEXTURE27 : textureUnit readonly_prop
+  method _TEXTURE27 : textureUnit readonly_prop
 
-    method _TEXTURE28 : textureUnit readonly_prop
+  method _TEXTURE28 : textureUnit readonly_prop
 
-    method _TEXTURE29 : textureUnit readonly_prop
+  method _TEXTURE29 : textureUnit readonly_prop
 
-    method _TEXTURE30 : textureUnit readonly_prop
+  method _TEXTURE30 : textureUnit readonly_prop
 
-    method _TEXTURE31 : textureUnit readonly_prop
+  method _TEXTURE31 : textureUnit readonly_prop
 
-    method _REPEAT : wrapMode readonly_prop
+  method _REPEAT : wrapMode readonly_prop
 
-    method _CLAMP_TO_EDGE_ : wrapMode readonly_prop
+  method _CLAMP_TO_EDGE_ : wrapMode readonly_prop
 
-    method _MIRRORED_REPEAT_ : wrapMode readonly_prop
+  method _MIRRORED_REPEAT_ : wrapMode readonly_prop
 
-    method _FLOAT_ : uniformType readonly_prop
+  method _FLOAT_ : uniformType readonly_prop
 
-    method _FLOAT_VEC2_ : uniformType readonly_prop
+  method _FLOAT_VEC2_ : uniformType readonly_prop
 
-    method _FLOAT_VEC3_ : uniformType readonly_prop
+  method _FLOAT_VEC3_ : uniformType readonly_prop
 
-    method _FLOAT_VEC4_ : uniformType readonly_prop
+  method _FLOAT_VEC4_ : uniformType readonly_prop
 
-    method _INT_ : uniformType readonly_prop
+  method _INT_ : uniformType readonly_prop
 
-    method _INT_VEC2_ : uniformType readonly_prop
+  method _INT_VEC2_ : uniformType readonly_prop
 
-    method _INT_VEC3_ : uniformType readonly_prop
+  method _INT_VEC3_ : uniformType readonly_prop
 
-    method _INT_VEC4_ : uniformType readonly_prop
+  method _INT_VEC4_ : uniformType readonly_prop
 
-    method _BOOL_ : uniformType readonly_prop
+  method _BOOL_ : uniformType readonly_prop
 
-    method _BOOL_VEC2_ : uniformType readonly_prop
+  method _BOOL_VEC2_ : uniformType readonly_prop
 
-    method _BOOL_VEC3_ : uniformType readonly_prop
+  method _BOOL_VEC3_ : uniformType readonly_prop
 
-    method _BOOL_VEC4_ : uniformType readonly_prop
+  method _BOOL_VEC4_ : uniformType readonly_prop
 
-    method _FLOAT_MAT2_ : uniformType readonly_prop
+  method _FLOAT_MAT2_ : uniformType readonly_prop
 
-    method _FLOAT_MAT3_ : uniformType readonly_prop
+  method _FLOAT_MAT3_ : uniformType readonly_prop
 
-    method _FLOAT_MAT4_ : uniformType readonly_prop
+  method _FLOAT_MAT4_ : uniformType readonly_prop
 
-    method _SAMPLER_2D_ : uniformType readonly_prop
+  method _SAMPLER_2D_ : uniformType readonly_prop
 
-    method _SAMPLER_CUBE_ : uniformType readonly_prop
+  method _SAMPLER_CUBE_ : uniformType readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_ENABLED_ : bool t vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_ENABLED_ : bool t vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_SIZE_ : int vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_SIZE_ : int vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_STRIDE_ : int vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_STRIDE_ : int vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_TYPE_ : int vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_TYPE_ : int vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_NORMALIZED_ : bool t vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_NORMALIZED_ : bool t vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_POINTER_ : vertexAttribPointerParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_POINTER_ : vertexAttribPointerParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ :
-      buffer t opt vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ :
+    buffer t opt vertexAttribParam readonly_prop
 
-    method _CURRENT_VERTEX_ATTRIB_ :
-      Typed_array.float32Array t vertexAttribParam readonly_prop
+  method _CURRENT_VERTEX_ATTRIB_ :
+    Typed_array.float32Array t vertexAttribParam readonly_prop
 
-    method _LOW_FLOAT_ : shaderPrecisionType readonly_prop
+  method _LOW_FLOAT_ : shaderPrecisionType readonly_prop
 
-    method _MEDIUM_FLOAT_ : shaderPrecisionType readonly_prop
+  method _MEDIUM_FLOAT_ : shaderPrecisionType readonly_prop
 
-    method _HIGH_FLOAT_ : shaderPrecisionType readonly_prop
+  method _HIGH_FLOAT_ : shaderPrecisionType readonly_prop
 
-    method _LOW_INT_ : shaderPrecisionType readonly_prop
+  method _LOW_INT_ : shaderPrecisionType readonly_prop
 
-    method _MEDIUM_INT_ : shaderPrecisionType readonly_prop
+  method _MEDIUM_INT_ : shaderPrecisionType readonly_prop
 
-    method _HIGH_INT_ : shaderPrecisionType readonly_prop
+  method _HIGH_INT_ : shaderPrecisionType readonly_prop
 
-    method _FRAMEBUFFER : fbTarget readonly_prop
+  method _FRAMEBUFFER : fbTarget readonly_prop
 
-    method _RENDERBUFFER : rbTarget readonly_prop
+  method _RENDERBUFFER : rbTarget readonly_prop
 
-    method _RGBA4 : format readonly_prop
+  method _RGBA4 : format readonly_prop
 
-    method _RGB5_A1_ : format readonly_prop
+  method _RGB5_A1_ : format readonly_prop
 
-    method _RGB565 : format readonly_prop
+  method _RGB565 : format readonly_prop
 
-    method _DEPTH_COMPONENT16_ : format readonly_prop
+  method _DEPTH_COMPONENT16_ : format readonly_prop
 
-    method _STENCIL_INDEX8_ : format readonly_prop
+  method _STENCIL_INDEX8_ : format readonly_prop
 
-    method _RENDERBUFFER_WIDTH_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_WIDTH_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_HEIGHT_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_HEIGHT_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_INTERNAL_FORMAT_ : format renderbufferParam readonly_prop
+  method _RENDERBUFFER_INTERNAL_FORMAT_ : format renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_RED_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_RED_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_GREEN_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_GREEN_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_BLUE_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_BLUE_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_ALPHA_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_ALPHA_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_DEPTH_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_DEPTH_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_STENCIL_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_STENCIL_SIZE_ : int renderbufferParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_ : objectType attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_ : objectType attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_RENDERBUFFER :
-      renderbuffer t attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_RENDERBUFFER :
+    renderbuffer t attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_TEXTURE :
-      texture t attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_TEXTURE : texture t attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_ : int attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_ : int attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_ : int attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_ : int attachParam readonly_prop
 
-    method _COLOR_ATTACHMENT0_ : attachmentPoint readonly_prop
+  method _COLOR_ATTACHMENT0_ : attachmentPoint readonly_prop
 
-    method _DEPTH_ATTACHMENT_ : attachmentPoint readonly_prop
+  method _DEPTH_ATTACHMENT_ : attachmentPoint readonly_prop
 
-    method _STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
+  method _STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
 
-    method _DEPTH_STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
+  method _DEPTH_STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
 
-    method _FRAMEBUFFER_COMPLETE_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_COMPLETE_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_INCOMPLETE_ATTACHMENT_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_INCOMPLETE_ATTACHMENT_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_INCOMPLETE_DIMENSIONS_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_INCOMPLETE_DIMENSIONS_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_UNSUPPORTED_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_UNSUPPORTED_ : framebufferStatus readonly_prop
 
-    method _UNPACK_FLIP_Y_WEBGL_PARAM : bool t parameter readonly_prop
+  method _UNPACK_FLIP_Y_WEBGL_PARAM : bool t parameter readonly_prop
 
-    method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_PARAM : bool t parameter readonly_prop
+  method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_PARAM : bool t parameter readonly_prop
 
-    method _UNPACK_COLORSPACE_CONVERSION_WEBGL_PARAM :
-      colorspaceConversion parameter readonly_prop
+  method _UNPACK_COLORSPACE_CONVERSION_WEBGL_PARAM :
+    colorspaceConversion parameter readonly_prop
 
-    method _NONE : colorspaceConversion readonly_prop
+  method _NONE : colorspaceConversion readonly_prop
 
-    method _BROWSER_DEFAULT_WEBGL_ : colorspaceConversion readonly_prop
+  method _BROWSER_DEFAULT_WEBGL_ : colorspaceConversion readonly_prop
 
-    method _UNPACK_ALIGNMENT_ : int pixelStoreParam readonly_prop
+  method _UNPACK_ALIGNMENT_ : int pixelStoreParam readonly_prop
 
-    method _UNPACK_FLIP_Y_WEBGL_ : bool t pixelStoreParam readonly_prop
+  method _UNPACK_FLIP_Y_WEBGL_ : bool t pixelStoreParam readonly_prop
 
-    method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_ : bool t pixelStoreParam readonly_prop
+  method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_ : bool t pixelStoreParam readonly_prop
 
-    method _UNPACK_COLORSPACE_CONVERSION_WEBGL_ : int pixelStoreParam readonly_prop
-  end
+  method _UNPACK_COLORSPACE_CONVERSION_WEBGL_ : int pixelStoreParam readonly_prop
+end
 
 (** 5.14 WebGLContextEvent *)
 
-class type contextEvent =
-  object
-    inherit Dom_html.event
+class type contextEvent = object
+  inherit Dom_html.event
 
-    method statusMessage : js_string t readonly_prop
-  end
+  method statusMessage : js_string t readonly_prop
+end
 
 module Event = struct
   let webglcontextlost = Dom_html.Event.make "webglcontextlost"
@@ -1369,12 +1359,11 @@ end
 
 (****)
 
-class type canvasElement =
-  object
-    method getContext : js_string t -> renderingContext t opt meth
+class type canvasElement = object
+  method getContext : js_string t -> renderingContext t opt meth
 
-    method getContext_ : js_string t -> contextAttributes t -> renderingContext t opt meth
-  end
+  method getContext_ : js_string t -> contextAttributes t -> renderingContext t opt meth
+end
 
 let getContext (c : Dom_html.canvasElement t) =
   let c : canvasElement t = Js.Unsafe.coerce c in
diff --git a/lib/js_of_ocaml/webGL.mli b/lib/js_of_ocaml/webGL.mli
index b2671fdec4..58b8174c9d 100644
--- a/lib/js_of_ocaml/webGL.mli
+++ b/lib/js_of_ocaml/webGL.mli
@@ -121,24 +121,23 @@ type shaderPrecisionType
 type objectType
 
 (** 5.2 WebGLContextAttributes *)
-class type contextAttributes =
-  object
-    method alpha : bool t prop
+class type contextAttributes = object
+  method alpha : bool t prop
 
-    method depth : bool t prop
+  method depth : bool t prop
 
-    method stencil : bool t prop
+  method stencil : bool t prop
 
-    method antialias : bool t prop
+  method antialias : bool t prop
 
-    method premultipliedAlpha : bool t prop
+  method premultipliedAlpha : bool t prop
 
-    method preserveDrawingBuffer : bool t prop
+  method preserveDrawingBuffer : bool t prop
 
-    method preferLowPowerToHighPerformance : bool t prop
+  method preferLowPowerToHighPerformance : bool t prop
 
-    method failIfMajorPerformanceCaveat : bool t prop
-  end
+  method failIfMajorPerformanceCaveat : bool t prop
+end
 
 val defaultContextAttributes : contextAttributes t
 
@@ -156,1198 +155,1189 @@ type texture
 
 type 'a uniformLocation
 
-class type activeInfo =
-  object
-    method size : int readonly_prop
-
-    method _type : uniformType readonly_prop
+class type activeInfo = object
+  method size : int readonly_prop
 
-    method name : js_string t readonly_prop
-  end
+  method _type : uniformType readonly_prop
 
-class type shaderPrecisionFormat =
-  object
-    method rangeMin : int readonly_prop
+  method name : js_string t readonly_prop
+end
 
-    method rangeMax : int readonly_prop
+class type shaderPrecisionFormat = object
+  method rangeMin : int readonly_prop
 
-    method precision : int readonly_prop
-  end
+  method rangeMax : int readonly_prop
 
-class type renderingContext =
-  object
+  method precision : int readonly_prop
+end
 
-    (** 5.13.1 Attributes *)
+class type renderingContext = object
+  (** 5.13.1 Attributes *)
 
-    method canvas : Dom_html.canvasElement t readonly_prop
+  method canvas : Dom_html.canvasElement t readonly_prop
 
-    method drawingBufferWidth : sizei readonly_prop
+  method drawingBufferWidth : sizei readonly_prop
 
-    method drawingBufferHeight : sizei readonly_prop
+  method drawingBufferHeight : sizei readonly_prop
 
-    (** 5.13.2 Getting information about the context *)
+  (** 5.13.2 Getting information about the context *)
 
-    method getContextAttributes : contextAttributes t meth
+  method getContextAttributes : contextAttributes t meth
 
-    (** 5.13.3 Setting and getting state *)
+  (** 5.13.3 Setting and getting state *)
 
-    method activeTexture : textureUnit -> unit meth
+  method activeTexture : textureUnit -> unit meth
 
-    method blendColor : clampf -> clampf -> clampf -> clampf -> unit meth
+  method blendColor : clampf -> clampf -> clampf -> clampf -> unit meth
 
-    method blendEquation : blendMode -> unit meth
+  method blendEquation : blendMode -> unit meth
 
-    method blendEquationSeparate : blendMode -> blendMode -> unit meth
+  method blendEquationSeparate : blendMode -> blendMode -> unit meth
 
-    method blendFunc : blendingFactor -> blendingFactor -> unit meth
+  method blendFunc : blendingFactor -> blendingFactor -> unit meth
 
-    method blendFuncSeparate :
-      blendingFactor -> blendingFactor -> blendingFactor -> blendingFactor -> unit meth
+  method blendFuncSeparate :
+    blendingFactor -> blendingFactor -> blendingFactor -> blendingFactor -> unit meth
 
-    method clearColor : clampf -> clampf -> clampf -> clampf -> unit meth
+  method clearColor : clampf -> clampf -> clampf -> clampf -> unit meth
 
-    method clearDepth : clampf -> unit meth
+  method clearDepth : clampf -> unit meth
 
-    method clearStencil : int -> unit meth
+  method clearStencil : int -> unit meth
 
-    method colorMask : bool t -> bool t -> bool t -> bool t -> unit meth
+  method colorMask : bool t -> bool t -> bool t -> bool t -> unit meth
 
-    method cullFace : cullFaceMode -> unit meth
+  method cullFace : cullFaceMode -> unit meth
 
-    method depthFunc : depthFunction -> unit meth
+  method depthFunc : depthFunction -> unit meth
 
-    method depthMask : bool t -> unit meth
+  method depthMask : bool t -> unit meth
 
-    method depthRange : clampf -> clampf -> unit meth
+  method depthRange : clampf -> clampf -> unit meth
 
-    method disable : enableCap -> unit meth
+  method disable : enableCap -> unit meth
 
-    method enable : enableCap -> unit meth
+  method enable : enableCap -> unit meth
 
-    method frontFace : frontFaceDir -> unit meth
+  method frontFace : frontFaceDir -> unit meth
 
-    method getParameter : 'a. 'a parameter -> 'a meth
+  method getParameter : 'a. 'a parameter -> 'a meth
 
-    method getError : errorCode meth
+  method getError : errorCode meth
 
-    method hint : hintTarget -> hintMode -> unit meth
+  method hint : hintTarget -> hintMode -> unit meth
 
-    method isEnabled : enableCap -> bool t meth
+  method isEnabled : enableCap -> bool t meth
 
-    method lineWidth : number t -> unit meth
+  method lineWidth : number t -> unit meth
 
-    method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
+  method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-    method polygonOffset : number t -> number t -> unit meth
+  method polygonOffset : number t -> number t -> unit meth
 
-    method sampleCoverage : clampf -> bool t -> unit meth
+  method sampleCoverage : clampf -> bool t -> unit meth
 
-    method stencilFunc : depthFunction -> int -> uint -> unit meth
+  method stencilFunc : depthFunction -> int -> uint -> unit meth
 
-    method stencilFuncSeparate : cullFaceMode -> depthFunction -> int -> uint -> unit meth
+  method stencilFuncSeparate : cullFaceMode -> depthFunction -> int -> uint -> unit meth
 
-    method stencilMask : uint -> unit meth
+  method stencilMask : uint -> unit meth
 
-    method stencilMaskSeparate : cullFaceMode -> uint -> unit meth
+  method stencilMaskSeparate : cullFaceMode -> uint -> unit meth
 
-    method stencilOp : stencilOp -> stencilOp -> stencilOp -> unit meth
+  method stencilOp : stencilOp -> stencilOp -> stencilOp -> unit meth
 
-    method stencilOpSeparate :
-      cullFaceMode -> stencilOp -> stencilOp -> stencilOp -> unit meth
+  method stencilOpSeparate :
+    cullFaceMode -> stencilOp -> stencilOp -> stencilOp -> unit meth
 
-    (** 5.13.4 Viewing and clipping *)
+  (** 5.13.4 Viewing and clipping *)
 
-    method scissor : int -> int -> sizei -> sizei -> unit meth
+  method scissor : int -> int -> sizei -> sizei -> unit meth
 
-    method viewport : int -> int -> sizei -> sizei -> unit meth
+  method viewport : int -> int -> sizei -> sizei -> unit meth
 
-    (** 5.13.5 Buffer objects *)
+  (** 5.13.5 Buffer objects *)
 
-    method bindBuffer : bufferTarget -> buffer t -> unit meth
+  method bindBuffer : bufferTarget -> buffer t -> unit meth
 
-    method bindBuffer_ : bufferTarget -> buffer t opt -> unit meth
+  method bindBuffer_ : bufferTarget -> buffer t opt -> unit meth
 
-    method bufferData_create : bufferTarget -> sizeiptr -> bufferUsage -> unit meth
+  method bufferData_create : bufferTarget -> sizeiptr -> bufferUsage -> unit meth
 
-    method bufferData :
-      bufferTarget -> #Typed_array.arrayBufferView t -> bufferUsage -> unit meth
+  method bufferData :
+    bufferTarget -> #Typed_array.arrayBufferView t -> bufferUsage -> unit meth
 
-    method bufferData_raw :
-      bufferTarget -> Typed_array.arrayBuffer t -> bufferUsage -> unit meth
+  method bufferData_raw :
+    bufferTarget -> Typed_array.arrayBuffer t -> bufferUsage -> unit meth
 
-    method bufferSubData :
-      bufferTarget -> intptr -> #Typed_array.arrayBufferView t -> unit meth
+  method bufferSubData :
+    bufferTarget -> intptr -> #Typed_array.arrayBufferView t -> unit meth
 
-    method bufferSubData_raw :
-      bufferTarget -> intptr -> Typed_array.arrayBuffer t -> unit meth
+  method bufferSubData_raw :
+    bufferTarget -> intptr -> Typed_array.arrayBuffer t -> unit meth
 
-    method createBuffer : buffer t meth
+  method createBuffer : buffer t meth
 
-    method deleteBuffer : buffer t -> unit meth
+  method deleteBuffer : buffer t -> unit meth
 
-    method getBufferParameter : 'a. bufferTarget -> 'a bufferParameter -> 'a meth
+  method getBufferParameter : 'a. bufferTarget -> 'a bufferParameter -> 'a meth
 
-    method isBuffer : buffer t -> bool t meth
+  method isBuffer : buffer t -> bool t meth
 
-    (** 5.13.6 Framebuffer objects *)
+  (** 5.13.6 Framebuffer objects *)
 
-    method bindFramebuffer : fbTarget -> framebuffer t -> unit meth
+  method bindFramebuffer : fbTarget -> framebuffer t -> unit meth
 
-    method bindFramebuffer_ : fbTarget -> framebuffer t opt -> unit meth
+  method bindFramebuffer_ : fbTarget -> framebuffer t opt -> unit meth
 
-    method checkFramebufferStatus : fbTarget -> framebufferStatus meth
+  method checkFramebufferStatus : fbTarget -> framebufferStatus meth
 
-    method createFramebuffer : framebuffer t meth
+  method createFramebuffer : framebuffer t meth
 
-    method deleteFramebuffer : framebuffer t -> unit meth
+  method deleteFramebuffer : framebuffer t -> unit meth
 
-    method framebufferRenderbuffer :
-      fbTarget -> attachmentPoint -> rbTarget -> renderbuffer t -> unit meth
+  method framebufferRenderbuffer :
+    fbTarget -> attachmentPoint -> rbTarget -> renderbuffer t -> unit meth
 
-    method framebufferTexture2D :
-      fbTarget -> attachmentPoint -> texTarget -> texture t -> int -> unit meth
+  method framebufferTexture2D :
+    fbTarget -> attachmentPoint -> texTarget -> texture t -> int -> unit meth
 
-    method getFramebufferAttachmentParameter :
-      'a. fbTarget -> attachmentPoint -> 'a attachParam -> 'a meth
+  method getFramebufferAttachmentParameter :
+    'a. fbTarget -> attachmentPoint -> 'a attachParam -> 'a meth
 
-    method isFramebuffer : framebuffer t -> bool t meth
+  method isFramebuffer : framebuffer t -> bool t meth
 
-    (** 5.13.7 Renderbuffer objects *)
+  (** 5.13.7 Renderbuffer objects *)
 
-    method bindRenderbuffer : rbTarget -> renderbuffer t -> unit meth
+  method bindRenderbuffer : rbTarget -> renderbuffer t -> unit meth
 
-    method bindRenderbuffer_ : rbTarget -> renderbuffer t opt -> unit meth
+  method bindRenderbuffer_ : rbTarget -> renderbuffer t opt -> unit meth
 
-    method createRenderbuffer : renderbuffer t meth
+  method createRenderbuffer : renderbuffer t meth
 
-    method deleteRenderbuffer : renderbuffer t -> unit meth
+  method deleteRenderbuffer : renderbuffer t -> unit meth
 
-    method getRenderbufferParameter : 'a. rbTarget -> 'a renderbufferParam -> 'a meth
+  method getRenderbufferParameter : 'a. rbTarget -> 'a renderbufferParam -> 'a meth
 
-    method isRenderbuffer : renderbuffer t -> bool t meth
+  method isRenderbuffer : renderbuffer t -> bool t meth
 
-    method renderbufferStorage : rbTarget -> format -> sizei -> sizei -> unit meth
+  method renderbufferStorage : rbTarget -> format -> sizei -> sizei -> unit meth
 
-    (** 5.13.8 Texture objects *)
+  (** 5.13.8 Texture objects *)
 
-    method bindTexture : texTarget -> texture t -> unit meth
+  method bindTexture : texTarget -> texture t -> unit meth
 
-    method bindTexture_ : texTarget -> texture t opt -> unit meth
+  method bindTexture_ : texTarget -> texture t opt -> unit meth
 
-    method compressedTexImage2D :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> sizei
-      -> sizei
-      -> int
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
+  method compressedTexImage2D :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> sizei
+    -> sizei
+    -> int
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
 
-    method compressedTexSubImage2D :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> sizei
-      -> sizei
-      -> pixelFormat
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
+  method compressedTexSubImage2D :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> sizei
+    -> sizei
+    -> pixelFormat
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
 
-    method copyTexImage2D :
-      texTarget -> int -> pixelFormat -> int -> int -> sizei -> sizei -> int -> unit meth
+  method copyTexImage2D :
+    texTarget -> int -> pixelFormat -> int -> int -> sizei -> sizei -> int -> unit meth
 
-    method copyTexSubImage2D :
-      texTarget -> int -> int -> int -> int -> int -> sizei -> sizei -> unit meth
+  method copyTexSubImage2D :
+    texTarget -> int -> int -> int -> int -> int -> sizei -> sizei -> unit meth
 
-    method createTexture : texture t meth
+  method createTexture : texture t meth
 
-    method deleteTexture : texture t -> unit meth
+  method deleteTexture : texture t -> unit meth
 
-    method generateMipmap : texTarget -> unit meth
-
-    method getTexParameter : texTarget -> 'a texParam -> 'a meth
-
-    method isTexture : texture t -> bool t meth
-
-    method texImage2D_new :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> sizei
-      -> sizei
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> void opt
-      -> unit meth
-
-    method texImage2D_fromView :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> sizei
-      -> sizei
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
-
-    method texImage2D_fromImageData :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageData t
-      -> unit meth
-
-    method texImage2D_fromImage :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageElement t
-      -> unit meth
-
-    method texImage2D_fromCanvas :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.canvasElement t
-      -> unit meth
-
-    method texImage2D_fromVideo :
-         texTarget
-      -> int
-      -> pixelFormat
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.videoElement t
-      -> unit meth
-
-    (* {[
-         method texParameterf : texTarget -> texParam -> number t -> unit meth
-       ]}
-    *)
-    method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
-
-    method texSubImage2D_fromView :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> sizei
-      -> sizei
-      -> pixelFormat
-      -> pixelType
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
-
-    method texSubImage2D_fromImageData :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageData t
-      -> unit meth
+  method generateMipmap : texTarget -> unit meth
+
+  method getTexParameter : texTarget -> 'a texParam -> 'a meth
+
+  method isTexture : texture t -> bool t meth
+
+  method texImage2D_new :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> sizei
+    -> sizei
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> void opt
+    -> unit meth
+
+  method texImage2D_fromView :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> sizei
+    -> sizei
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
+
+  method texImage2D_fromImageData :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageData t
+    -> unit meth
+
+  method texImage2D_fromImage :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageElement t
+    -> unit meth
+
+  method texImage2D_fromCanvas :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.canvasElement t
+    -> unit meth
+
+  method texImage2D_fromVideo :
+       texTarget
+    -> int
+    -> pixelFormat
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.videoElement t
+    -> unit meth
+
+  (* {[
+       method texParameterf : texTarget -> texParam -> number t -> unit meth
+     ]}
+  *)
+  method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
+
+  method texSubImage2D_fromView :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> sizei
+    -> sizei
+    -> pixelFormat
+    -> pixelType
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
+
+  method texSubImage2D_fromImageData :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageData t
+    -> unit meth
 
-    method texSubImage2D_fromImage :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.imageElement t
-      -> unit meth
+  method texSubImage2D_fromImage :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.imageElement t
+    -> unit meth
 
-    method texSubImage2D_fromCanvas :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.canvasElement t
-      -> unit meth
+  method texSubImage2D_fromCanvas :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.canvasElement t
+    -> unit meth
 
-    method texSubImage2D_fromVideo :
-         texTarget
-      -> int
-      -> int
-      -> int
-      -> pixelFormat
-      -> pixelType
-      -> Dom_html.videoElement t
-      -> unit meth
+  method texSubImage2D_fromVideo :
+       texTarget
+    -> int
+    -> int
+    -> int
+    -> pixelFormat
+    -> pixelType
+    -> Dom_html.videoElement t
+    -> unit meth
 
-    (** 5.13.9 Programs and Shaders *)
+  (** 5.13.9 Programs and Shaders *)
 
-    method attachShader : program t -> shader t -> unit meth
+  method attachShader : program t -> shader t -> unit meth
 
-    method bindAttribLocation : program t -> uint -> js_string t -> unit meth
+  method bindAttribLocation : program t -> uint -> js_string t -> unit meth
 
-    method compileShader : shader t -> unit meth
+  method compileShader : shader t -> unit meth
 
-    method createProgram : program t meth
+  method createProgram : program t meth
 
-    method createShader : shaderType -> shader t meth
+  method createShader : shaderType -> shader t meth
 
-    method deleteProgram : program t -> unit meth
+  method deleteProgram : program t -> unit meth
 
-    method deleteShader : shader t -> unit meth
+  method deleteShader : shader t -> unit meth
 
-    method detachShader : program t -> shader t -> unit meth
+  method detachShader : program t -> shader t -> unit meth
 
-    method getAttachedShaders : program t -> shader t js_array t meth
+  method getAttachedShaders : program t -> shader t js_array t meth
 
-    method getProgramParameter : 'a. program t -> 'a programParam -> 'a meth
+  method getProgramParameter : 'a. program t -> 'a programParam -> 'a meth
 
-    method getProgramInfoLog : program t -> js_string t meth
+  method getProgramInfoLog : program t -> js_string t meth
 
-    method getShaderParameter : 'a. shader t -> 'a shaderParam -> 'a meth
+  method getShaderParameter : 'a. shader t -> 'a shaderParam -> 'a meth
 
-    method getShaderPrecisionFormat :
-      shaderType -> shaderPrecisionType -> shaderPrecisionFormat t meth
+  method getShaderPrecisionFormat :
+    shaderType -> shaderPrecisionType -> shaderPrecisionFormat t meth
 
-    method getShaderInfoLog : shader t -> js_string t meth
+  method getShaderInfoLog : shader t -> js_string t meth
 
-    method getShaderSource : shader t -> js_string t meth
+  method getShaderSource : shader t -> js_string t meth
 
-    method isProgram : program t -> bool t meth
+  method isProgram : program t -> bool t meth
 
-    method isShader : shader t -> bool t meth
+  method isShader : shader t -> bool t meth
 
-    method linkProgram : program t -> unit meth
+  method linkProgram : program t -> unit meth
 
-    method shaderSource : shader t -> js_string t -> unit meth
+  method shaderSource : shader t -> js_string t -> unit meth
 
-    method useProgram : program t -> unit meth
+  method useProgram : program t -> unit meth
 
-    method validateProgram : program t -> unit meth
+  method validateProgram : program t -> unit meth
 
-    (** 5.13.10 Uniforms and attributes *)
+  (** 5.13.10 Uniforms and attributes *)
 
-    method disableVertexAttribArray : uint -> unit meth
+  method disableVertexAttribArray : uint -> unit meth
 
-    method enableVertexAttribArray : uint -> unit meth
+  method enableVertexAttribArray : uint -> unit meth
 
-    method getActiveAttrib : program t -> uint -> activeInfo t meth
+  method getActiveAttrib : program t -> uint -> activeInfo t meth
 
-    method getActiveUniform : program t -> uint -> activeInfo t meth
+  method getActiveUniform : program t -> uint -> activeInfo t meth
 
-    method getAttribLocation : program t -> js_string t -> int meth
+  method getAttribLocation : program t -> js_string t -> int meth
 
-    method getUniform : 'a 'b. program t -> 'a uniformLocation t -> 'b meth
+  method getUniform : 'a 'b. program t -> 'a uniformLocation t -> 'b meth
 
-    method getUniformLocation : 'a. program t -> js_string t -> 'a uniformLocation t meth
+  method getUniformLocation : 'a. program t -> js_string t -> 'a uniformLocation t meth
 
-    method getVertexAttrib : 'a. uint -> 'a vertexAttribParam -> 'a meth
+  method getVertexAttrib : 'a. uint -> 'a vertexAttribParam -> 'a meth
 
-    method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
+  method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-    method uniform1f : number t uniformLocation t -> number t -> unit meth
+  method uniform1f : number t uniformLocation t -> number t -> unit meth
 
-    method uniform1fv_typed :
-      number t uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform1fv_typed :
+    number t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
+  method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform1i : int uniformLocation t -> int -> unit meth
+  method uniform1i : int uniformLocation t -> int -> unit meth
 
-    method uniform1iv_typed :
-      int uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform1iv_typed : int uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
+  method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
+  method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
 
-    method uniform2fv_typed :
-      [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform2fv_typed :
+    [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
+  method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
-    method uniform2iv : [ `ivec2 ] uniformLocation t -> int js_array t -> unit meth
+  method uniform2iv : [ `ivec2 ] uniformLocation t -> int js_array t -> unit meth
 
-    method uniform2iv_typed :
-      [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform2iv_typed :
+    [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform3f :
-      [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
+  method uniform3f :
+    [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
 
-    method uniform3fv_typed :
-      [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform3fv_typed :
+    [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
+  method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
-    method uniform3iv : [ `ivec3 ] uniformLocation t -> int js_array t -> unit meth
+  method uniform3iv : [ `ivec3 ] uniformLocation t -> int js_array t -> unit meth
 
-    method uniform3iv_typed :
-      [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform3iv_typed :
+    [ `ivec3 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniform4f :
-         [ `vec4 ] uniformLocation t
-      -> number t
-      -> number t
-      -> number t
-      -> number t
-      -> unit meth
+  method uniform4f :
+       [ `vec4 ] uniformLocation t
+    -> number t
+    -> number t
+    -> number t
+    -> number t
+    -> unit meth
 
-    method uniform4fv_typed :
-      [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
+  method uniform4fv_typed :
+    [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-    method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
 
-    method uniform4i :
-      [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
+  method uniform4i : [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
 
-    method uniform4iv : [ `ivec4 ] uniformLocation t -> int js_array t -> unit meth
+  method uniform4iv : [ `ivec4 ] uniformLocation t -> int js_array t -> unit meth
 
-    method uniform4iv_typed :
-      [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
+  method uniform4iv_typed :
+    [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
-    method uniformMatrix2fv :
-      [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+  method uniformMatrix2fv :
+    [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
-    method uniformMatrix2fv_typed :
-      [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
+  method uniformMatrix2fv_typed :
+    [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method uniformMatrix3fv :
-      [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+  method uniformMatrix3fv :
+    [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
-    method uniformMatrix3fv_typed :
-      [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
+  method uniformMatrix3fv_typed :
+    [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method uniformMatrix4fv :
-      [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+  method uniformMatrix4fv :
+    [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
 
-    method uniformMatrix4fv_typed :
-      [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
+  method uniformMatrix4fv_typed :
+    [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib1f : uint -> number t -> unit meth
+  method vertexAttrib1f : uint -> number t -> unit meth
 
-    method vertexAttrib1fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib1fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib2f : uint -> number t -> number t -> unit meth
+  method vertexAttrib2f : uint -> number t -> number t -> unit meth
 
-    method vertexAttrib2fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib2fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
+  method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib3fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib3fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttrib4f :
-      uint -> number t -> number t -> number t -> number t -> unit meth
+  method vertexAttrib4f :
+    uint -> number t -> number t -> number t -> number t -> unit meth
 
-    method vertexAttrib4fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib4fv : uint -> number t js_array t -> unit meth
 
-    method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
+  method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-    method vertexAttribPointer :
-      uint -> int -> dataType -> bool t -> sizei -> intptr -> unit meth
+  method vertexAttribPointer :
+    uint -> int -> dataType -> bool t -> sizei -> intptr -> unit meth
 
-    (** 5.13.11 Writing to the drawing buffer *)
+  (** 5.13.11 Writing to the drawing buffer *)
 
-    method clear : clearBufferMask -> unit meth
+  method clear : clearBufferMask -> unit meth
 
-    method drawArrays : beginMode -> int -> sizei -> unit meth
+  method drawArrays : beginMode -> int -> sizei -> unit meth
 
-    method drawElements : beginMode -> sizei -> dataType -> intptr -> unit meth
+  method drawElements : beginMode -> sizei -> dataType -> intptr -> unit meth
 
-    method finish : unit meth
+  method finish : unit meth
 
-    method flush : unit meth
+  method flush : unit meth
 
-    (** 5.13.12 Reading back pixels *)
+  (** 5.13.12 Reading back pixels *)
 
-    method readPixels :
-         int
-      -> int
-      -> sizei
-      -> sizei
-      -> pixelFormat
-      -> pixelType
-      -> #Typed_array.arrayBufferView t
-      -> unit meth
+  method readPixels :
+       int
+    -> int
+    -> sizei
+    -> sizei
+    -> pixelFormat
+    -> pixelType
+    -> #Typed_array.arrayBufferView t
+    -> unit meth
 
-    (** 5.13.13 Detecting context lost events *)
+  (** 5.13.13 Detecting context lost events *)
 
-    method isContextLost : bool t meth
+  method isContextLost : bool t meth
 
-    (** 5.13.14 Detecting and enabling extensions *)
+  (** 5.13.14 Detecting and enabling extensions *)
 
-    method getSupportedExtensions : js_string t js_array t meth
+  method getSupportedExtensions : js_string t js_array t meth
 
-    method getExtension : 'a. js_string t -> 'a t opt meth
+  method getExtension : 'a. js_string t -> 'a t opt meth
 
-    (* Untyped! *)
-    (** Constants *)
+  (* Untyped! *)
+  (** Constants *)
 
-    method _DEPTH_BUFFER_BIT_ : clearBufferMask readonly_prop
+  method _DEPTH_BUFFER_BIT_ : clearBufferMask readonly_prop
 
-    method _STENCIL_BUFFER_BIT_ : clearBufferMask readonly_prop
+  method _STENCIL_BUFFER_BIT_ : clearBufferMask readonly_prop
 
-    method _COLOR_BUFFER_BIT_ : clearBufferMask readonly_prop
+  method _COLOR_BUFFER_BIT_ : clearBufferMask readonly_prop
 
-    method _POINTS : beginMode readonly_prop
+  method _POINTS : beginMode readonly_prop
 
-    method _LINES : beginMode readonly_prop
+  method _LINES : beginMode readonly_prop
 
-    method _LINE_LOOP_ : beginMode readonly_prop
+  method _LINE_LOOP_ : beginMode readonly_prop
 
-    method _LINE_STRIP_ : beginMode readonly_prop
+  method _LINE_STRIP_ : beginMode readonly_prop
 
-    method _TRIANGLES : beginMode readonly_prop
+  method _TRIANGLES : beginMode readonly_prop
 
-    method _TRIANGLE_STRIP_ : beginMode readonly_prop
+  method _TRIANGLE_STRIP_ : beginMode readonly_prop
 
-    method _TRIANGLE_FAN_ : beginMode readonly_prop
+  method _TRIANGLE_FAN_ : beginMode readonly_prop
 
-    method _ZERO : blendingFactor readonly_prop
+  method _ZERO : blendingFactor readonly_prop
 
-    method _ONE : blendingFactor readonly_prop
+  method _ONE : blendingFactor readonly_prop
 
-    method _SRC_COLOR_ : blendingFactor readonly_prop
+  method _SRC_COLOR_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_SRC_COLOR_ : blendingFactor readonly_prop
+  method _ONE_MINUS_SRC_COLOR_ : blendingFactor readonly_prop
 
-    method _SRC_ALPHA_ : blendingFactor readonly_prop
+  method _SRC_ALPHA_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_SRC_ALPHA_ : blendingFactor readonly_prop
+  method _ONE_MINUS_SRC_ALPHA_ : blendingFactor readonly_prop
 
-    method _DST_ALPHA_ : blendingFactor readonly_prop
+  method _DST_ALPHA_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_DST_ALPHA_ : blendingFactor readonly_prop
+  method _ONE_MINUS_DST_ALPHA_ : blendingFactor readonly_prop
 
-    method _DST_COLOR_ : blendingFactor readonly_prop
+  method _DST_COLOR_ : blendingFactor readonly_prop
 
-    method _ONE_MINUS_DST_COLOR_ : blendingFactor readonly_prop
+  method _ONE_MINUS_DST_COLOR_ : blendingFactor readonly_prop
 
-    method _SRC_ALPHA_SATURATE_ : blendingFactor readonly_prop
+  method _SRC_ALPHA_SATURATE_ : blendingFactor readonly_prop
 
-    method _FUNC_ADD_ : blendMode readonly_prop
+  method _FUNC_ADD_ : blendMode readonly_prop
 
-    method _FUNC_SUBTRACT_ : blendMode readonly_prop
+  method _FUNC_SUBTRACT_ : blendMode readonly_prop
 
-    method _FUNC_REVERSE_SUBTRACT_ : blendMode readonly_prop
+  method _FUNC_REVERSE_SUBTRACT_ : blendMode readonly_prop
 
-    method _CONSTANT_COLOR_ : blendMode readonly_prop
+  method _CONSTANT_COLOR_ : blendMode readonly_prop
 
-    method _ONE_MINUS_CONSTANT_COLOR_ : blendMode readonly_prop
+  method _ONE_MINUS_CONSTANT_COLOR_ : blendMode readonly_prop
 
-    method _CONSTANT_ALPHA_ : blendMode readonly_prop
+  method _CONSTANT_ALPHA_ : blendMode readonly_prop
 
-    method _ONE_MINUS_CONSTANT_ALPHA_ : blendMode readonly_prop
+  method _ONE_MINUS_CONSTANT_ALPHA_ : blendMode readonly_prop
 
-    method _ARRAY_BUFFER_ : bufferTarget readonly_prop
+  method _ARRAY_BUFFER_ : bufferTarget readonly_prop
 
-    method _ELEMENT_ARRAY_BUFFER_ : bufferTarget readonly_prop
+  method _ELEMENT_ARRAY_BUFFER_ : bufferTarget readonly_prop
 
-    method _STREAM_DRAW_ : bufferUsage readonly_prop
+  method _STREAM_DRAW_ : bufferUsage readonly_prop
 
-    method _STATIC_DRAW_ : bufferUsage readonly_prop
+  method _STATIC_DRAW_ : bufferUsage readonly_prop
 
-    method _DYNAMIC_DRAW_ : bufferUsage readonly_prop
+  method _DYNAMIC_DRAW_ : bufferUsage readonly_prop
 
-    method _FRONT : cullFaceMode readonly_prop
+  method _FRONT : cullFaceMode readonly_prop
 
-    method _BACK : cullFaceMode readonly_prop
+  method _BACK : cullFaceMode readonly_prop
 
-    method _FRONT_AND_BACK_ : cullFaceMode readonly_prop
+  method _FRONT_AND_BACK_ : cullFaceMode readonly_prop
 
-    method _CULL_FACE_ : enableCap readonly_prop
+  method _CULL_FACE_ : enableCap readonly_prop
 
-    method _BLEND : enableCap readonly_prop
+  method _BLEND : enableCap readonly_prop
 
-    method _DITHER : enableCap readonly_prop
+  method _DITHER : enableCap readonly_prop
 
-    method _STENCIL_TEST_ : enableCap readonly_prop
+  method _STENCIL_TEST_ : enableCap readonly_prop
 
-    method _DEPTH_TEST_ : enableCap readonly_prop
+  method _DEPTH_TEST_ : enableCap readonly_prop
 
-    method _SCISSOR_TEST_ : enableCap readonly_prop
+  method _SCISSOR_TEST_ : enableCap readonly_prop
 
-    method _POLYGON_OFFSET_FILL_ : enableCap readonly_prop
+  method _POLYGON_OFFSET_FILL_ : enableCap readonly_prop
 
-    method _SAMPLE_ALPHA_TO_COVERAGE_ : enableCap readonly_prop
+  method _SAMPLE_ALPHA_TO_COVERAGE_ : enableCap readonly_prop
 
-    method _SAMPLE_COVERAGE_ : enableCap readonly_prop
+  method _SAMPLE_COVERAGE_ : enableCap readonly_prop
 
-    method _NO_ERROR_ : errorCode readonly_prop
+  method _NO_ERROR_ : errorCode readonly_prop
 
-    method _INVALID_ENUM_ : errorCode readonly_prop
+  method _INVALID_ENUM_ : errorCode readonly_prop
 
-    method _INVALID_VALUE_ : errorCode readonly_prop
+  method _INVALID_VALUE_ : errorCode readonly_prop
 
-    method _INVALID_OPERATION_ : errorCode readonly_prop
+  method _INVALID_OPERATION_ : errorCode readonly_prop
 
-    method _OUT_OF_MEMORY_ : errorCode readonly_prop
+  method _OUT_OF_MEMORY_ : errorCode readonly_prop
 
-    method _CONTEXT_LOST_WEBGL_ : errorCode readonly_prop
+  method _CONTEXT_LOST_WEBGL_ : errorCode readonly_prop
 
-    method _INVALID_FRAMEBUFFER_OPERATION_ : errorCode readonly_prop
+  method _INVALID_FRAMEBUFFER_OPERATION_ : errorCode readonly_prop
 
-    method _CW : frontFaceDir readonly_prop
+  method _CW : frontFaceDir readonly_prop
 
-    method _CCW : frontFaceDir readonly_prop
+  method _CCW : frontFaceDir readonly_prop
 
-    method _DONT_CARE_ : hintMode readonly_prop
+  method _DONT_CARE_ : hintMode readonly_prop
 
-    method _FASTEST : hintMode readonly_prop
+  method _FASTEST : hintMode readonly_prop
 
-    method _NICEST : hintMode readonly_prop
+  method _NICEST : hintMode readonly_prop
 
-    method _GENERATE_MIPMAP_HINT_ : hintTarget readonly_prop
+  method _GENERATE_MIPMAP_HINT_ : hintTarget readonly_prop
 
-    method _BLEND_EQUATION_ : blendMode parameter readonly_prop
+  method _BLEND_EQUATION_ : blendMode parameter readonly_prop
 
-    method _BLEND_EQUATION_RGB_ : blendMode parameter readonly_prop
+  method _BLEND_EQUATION_RGB_ : blendMode parameter readonly_prop
 
-    method _BLEND_EQUATION_ALPHA_ : blendMode parameter readonly_prop
+  method _BLEND_EQUATION_ALPHA_ : blendMode parameter readonly_prop
 
-    method _BLEND_DST_RGB_ : blendingFactor parameter readonly_prop
+  method _BLEND_DST_RGB_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_SRC_RGB_ : blendingFactor parameter readonly_prop
+  method _BLEND_SRC_RGB_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_DST_ALPHA_ : blendingFactor parameter readonly_prop
+  method _BLEND_DST_ALPHA_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_SRC_ALPHA_ : blendingFactor parameter readonly_prop
+  method _BLEND_SRC_ALPHA_ : blendingFactor parameter readonly_prop
 
-    method _BLEND_COLOR_ : Typed_array.float32Array t parameter readonly_prop
+  method _BLEND_COLOR_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
+  method _ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
 
-    method _ELEMENT_ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
+  method _ELEMENT_ARRAY_BUFFER_BINDING_ : buffer t opt parameter readonly_prop
 
-    method _CULL_FACE_PARAM : bool t parameter readonly_prop
+  method _CULL_FACE_PARAM : bool t parameter readonly_prop
 
-    method _BLEND_PARAM : bool t parameter readonly_prop
+  method _BLEND_PARAM : bool t parameter readonly_prop
 
-    method _DITHER_PARAM : bool t parameter readonly_prop
+  method _DITHER_PARAM : bool t parameter readonly_prop
 
-    method _STENCIL_TEST_PARAM : bool t parameter readonly_prop
+  method _STENCIL_TEST_PARAM : bool t parameter readonly_prop
 
-    method _DEPTH_TEST_PARAM : bool t parameter readonly_prop
+  method _DEPTH_TEST_PARAM : bool t parameter readonly_prop
 
-    method _SCISSOR_TEST_PARAM : bool t parameter readonly_prop
+  method _SCISSOR_TEST_PARAM : bool t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
+  method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-    method _LINE_WIDTH_ : number t parameter readonly_prop
+  method _LINE_WIDTH_ : number t parameter readonly_prop
 
-    method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
+  method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _ALIASED_LINE_WIDTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
+  method _ALIASED_LINE_WIDTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _CULL_FACE_MODE_ : cullFaceMode parameter readonly_prop
+  method _CULL_FACE_MODE_ : cullFaceMode parameter readonly_prop
 
-    method _FRONT_FACE_ : frontFaceDir parameter readonly_prop
+  method _FRONT_FACE_ : frontFaceDir parameter readonly_prop
 
-    method _DEPTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
+  method _DEPTH_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
+  method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-    method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
+  method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
 
-    method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
+  method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
-    method _STENCIL_CLEAR_VALUE_ : int parameter readonly_prop
+  method _STENCIL_CLEAR_VALUE_ : int parameter readonly_prop
 
-    method _STENCIL_FUNC_ : int parameter readonly_prop
+  method _STENCIL_FUNC_ : int parameter readonly_prop
 
-    method _STENCIL_FAIL_ : int parameter readonly_prop
+  method _STENCIL_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_PASS_DEPTH_FAIL_ : int parameter readonly_prop
+  method _STENCIL_PASS_DEPTH_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_PASS_DEPTH_PASS_ : int parameter readonly_prop
+  method _STENCIL_PASS_DEPTH_PASS_ : int parameter readonly_prop
 
-    method _STENCIL_REF_ : int parameter readonly_prop
+  method _STENCIL_REF_ : int parameter readonly_prop
 
-    method _STENCIL_VALUE_MASK_ : int parameter readonly_prop
+  method _STENCIL_VALUE_MASK_ : int parameter readonly_prop
 
-    method _STENCIL_WRITEMASK_ : int parameter readonly_prop
+  method _STENCIL_WRITEMASK_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_FUNC_ : int parameter readonly_prop
+  method _STENCIL_BACK_FUNC_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_FAIL_ : int parameter readonly_prop
+  method _STENCIL_BACK_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_PASS_DEPTH_FAIL_ : int parameter readonly_prop
+  method _STENCIL_BACK_PASS_DEPTH_FAIL_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_PASS_DEPTH_PASS_ : int parameter readonly_prop
+  method _STENCIL_BACK_PASS_DEPTH_PASS_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_REF_ : int parameter readonly_prop
+  method _STENCIL_BACK_REF_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_VALUE_MASK_ : int parameter readonly_prop
+  method _STENCIL_BACK_VALUE_MASK_ : int parameter readonly_prop
 
-    method _STENCIL_BACK_WRITEMASK_ : int parameter readonly_prop
+  method _STENCIL_BACK_WRITEMASK_ : int parameter readonly_prop
 
-    method _VIEWPORT : Typed_array.int32Array t parameter readonly_prop
+  method _VIEWPORT : Typed_array.int32Array t parameter readonly_prop
 
-    method _SCISSOR_BOX_ : Typed_array.int32Array t parameter readonly_prop
+  method _SCISSOR_BOX_ : Typed_array.int32Array t parameter readonly_prop
 
-    method _COLOR_CLEAR_VALUE_ : Typed_array.float32Array t parameter readonly_prop
+  method _COLOR_CLEAR_VALUE_ : Typed_array.float32Array t parameter readonly_prop
 
-    method _COLOR_WRITEMASK_ : bool t js_array t parameter readonly_prop
+  method _COLOR_WRITEMASK_ : bool t js_array t parameter readonly_prop
 
-    method _UNPACK_ALIGNMENT_PARAM : int parameter readonly_prop
+  method _UNPACK_ALIGNMENT_PARAM : int parameter readonly_prop
 
-    method _PACK_ALIGNMENT_ : int parameter readonly_prop
+  method _PACK_ALIGNMENT_ : int parameter readonly_prop
 
-    method _MAX_TEXTURE_SIZE_ : int parameter readonly_prop
+  method _MAX_TEXTURE_SIZE_ : int parameter readonly_prop
 
-    method _MAX_VIEWPORT_DIMS_ : Typed_array.int32Array t parameter readonly_prop
+  method _MAX_VIEWPORT_DIMS_ : Typed_array.int32Array t parameter readonly_prop
 
-    method _SUBPIXEL_BITS_ : int parameter readonly_prop
+  method _SUBPIXEL_BITS_ : int parameter readonly_prop
 
-    method _RED_BITS_ : int parameter readonly_prop
+  method _RED_BITS_ : int parameter readonly_prop
 
-    method _GREEN_BITS_ : int parameter readonly_prop
+  method _GREEN_BITS_ : int parameter readonly_prop
 
-    method _BLUE_BITS_ : int parameter readonly_prop
+  method _BLUE_BITS_ : int parameter readonly_prop
 
-    method _ALPHA_BITS_ : int parameter readonly_prop
+  method _ALPHA_BITS_ : int parameter readonly_prop
 
-    method _DEPTH_BITS_ : int parameter readonly_prop
+  method _DEPTH_BITS_ : int parameter readonly_prop
 
-    method _STENCIL_BITS_ : int parameter readonly_prop
+  method _STENCIL_BITS_ : int parameter readonly_prop
 
-    method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
 
-    method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
 
-    method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
+  method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
-    method _TEXTURE_BINDING_CUBE_MAP_ : texture t opt parameter readonly_prop
+  method _TEXTURE_BINDING_CUBE_MAP_ : texture t opt parameter readonly_prop
 
-    method _SAMPLE_BUFFERS_ : int parameter readonly_prop
+  method _SAMPLE_BUFFERS_ : int parameter readonly_prop
 
-    method _SAMPLES_ : int parameter readonly_prop
+  method _SAMPLES_ : int parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
+  method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
 
-    method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
+  method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
-    method _NUM_COMPRESSED_TEXTURE_FORMATS_ : int parameter readonly_prop
+  method _NUM_COMPRESSED_TEXTURE_FORMATS_ : int parameter readonly_prop
 
-    method _COMPRESSED_TEXTURE_FORMATS_ :
-      Typed_array.uint32Array t parameter readonly_prop
+  method _COMPRESSED_TEXTURE_FORMATS_ : Typed_array.uint32Array t parameter readonly_prop
 
-    method _GENERATE_MIPMAP_HINT_PARAM_ : hintMode parameter readonly_prop
+  method _GENERATE_MIPMAP_HINT_PARAM_ : hintMode parameter readonly_prop
 
-    method _BUFFER_SIZE_ : int bufferParameter readonly_prop
+  method _BUFFER_SIZE_ : int bufferParameter readonly_prop
 
-    method _BUFFER_USAGE_ : bufferUsage bufferParameter readonly_prop
+  method _BUFFER_USAGE_ : bufferUsage bufferParameter readonly_prop
 
-    method _BYTE : dataType readonly_prop
+  method _BYTE : dataType readonly_prop
 
-    method _UNSIGNED_BYTE_DT : dataType readonly_prop
+  method _UNSIGNED_BYTE_DT : dataType readonly_prop
 
-    method _SHORT : dataType readonly_prop
+  method _SHORT : dataType readonly_prop
 
-    method _UNSIGNED_SHORT_ : dataType readonly_prop
+  method _UNSIGNED_SHORT_ : dataType readonly_prop
 
-    method _INT : dataType readonly_prop
+  method _INT : dataType readonly_prop
 
-    method _UNSIGNED_INT_ : dataType readonly_prop
+  method _UNSIGNED_INT_ : dataType readonly_prop
 
-    method _FLOAT : dataType readonly_prop
+  method _FLOAT : dataType readonly_prop
 
-    method _UNSIGNED_BYTE_ : pixelType readonly_prop
+  method _UNSIGNED_BYTE_ : pixelType readonly_prop
 
-    method _UNSIGNED_SHORT_4_4_4_4_ : pixelType readonly_prop
+  method _UNSIGNED_SHORT_4_4_4_4_ : pixelType readonly_prop
 
-    method _UNSIGNED_SHORT_5_5_5_1_ : pixelType readonly_prop
+  method _UNSIGNED_SHORT_5_5_5_1_ : pixelType readonly_prop
 
-    method _UNSIGNED_SHORT_5_6_5_ : pixelType readonly_prop
+  method _UNSIGNED_SHORT_5_6_5_ : pixelType readonly_prop
 
-    method _ALPHA : pixelFormat readonly_prop
+  method _ALPHA : pixelFormat readonly_prop
 
-    method _RGB : pixelFormat readonly_prop
+  method _RGB : pixelFormat readonly_prop
 
-    method _RGBA : pixelFormat readonly_prop
+  method _RGBA : pixelFormat readonly_prop
 
-    method _LUMINANCE : pixelFormat readonly_prop
+  method _LUMINANCE : pixelFormat readonly_prop
 
-    method _LUMINANCE_ALPHA_ : pixelFormat readonly_prop
+  method _LUMINANCE_ALPHA_ : pixelFormat readonly_prop
 
-    method _STENCIL_INDEX_ : pixelFormat readonly_prop
+  method _STENCIL_INDEX_ : pixelFormat readonly_prop
 
-    method _DEPTH_STENCIL_ : pixelFormat readonly_prop
+  method _DEPTH_STENCIL_ : pixelFormat readonly_prop
 
-    method _DEPTH_COMPONENT_ : pixelFormat readonly_prop
+  method _DEPTH_COMPONENT_ : pixelFormat readonly_prop
 
-    method _FRAGMENT_SHADER_ : shaderType readonly_prop
+  method _FRAGMENT_SHADER_ : shaderType readonly_prop
 
-    method _VERTEX_SHADER_ : shaderType readonly_prop
+  method _VERTEX_SHADER_ : shaderType readonly_prop
 
-    method _MAX_VERTEX_ATTRIBS_ : int parameter readonly_prop
+  method _MAX_VERTEX_ATTRIBS_ : int parameter readonly_prop
 
-    method _MAX_VERTEX_UNIFORM_VECTORS_ : int parameter readonly_prop
+  method _MAX_VERTEX_UNIFORM_VECTORS_ : int parameter readonly_prop
 
-    method _MAX_VARYING_VECTORS_ : int parameter readonly_prop
+  method _MAX_VARYING_VECTORS_ : int parameter readonly_prop
 
-    method _MAX_COMBINED_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
+  method _MAX_COMBINED_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
 
-    method _MAX_VERTEX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
+  method _MAX_VERTEX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
 
-    method _MAX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
+  method _MAX_TEXTURE_IMAGE_UNITS_ : int parameter readonly_prop
 
-    method _MAX_FRAGMENT_UNIFORM_VECTORS_ : int parameter readonly_prop
+  method _MAX_FRAGMENT_UNIFORM_VECTORS_ : int parameter readonly_prop
 
-    method _SHADER_TYPE_ : shaderType shaderParam readonly_prop
+  method _SHADER_TYPE_ : shaderType shaderParam readonly_prop
 
-    method _DELETE_STATUS_ : bool t shaderParam readonly_prop
+  method _DELETE_STATUS_ : bool t shaderParam readonly_prop
 
-    method _COMPILE_STATUS_ : bool t shaderParam readonly_prop
+  method _COMPILE_STATUS_ : bool t shaderParam readonly_prop
 
-    method _DELETE_STATUS_PROG : bool t programParam readonly_prop
+  method _DELETE_STATUS_PROG : bool t programParam readonly_prop
 
-    method _LINK_STATUS_ : bool t programParam readonly_prop
+  method _LINK_STATUS_ : bool t programParam readonly_prop
 
-    method _VALIDATE_STATUS_ : bool t programParam readonly_prop
+  method _VALIDATE_STATUS_ : bool t programParam readonly_prop
 
-    method _ATTACHED_SHADERS_ : int programParam readonly_prop
+  method _ATTACHED_SHADERS_ : int programParam readonly_prop
 
-    method _ACTIVE_UNIFORMS_ : int programParam readonly_prop
+  method _ACTIVE_UNIFORMS_ : int programParam readonly_prop
 
-    method _ACTIVE_ATTRIBUTES_ : int programParam readonly_prop
+  method _ACTIVE_ATTRIBUTES_ : int programParam readonly_prop
 
-    method _SHADING_LANGUAGE_VERSION_ : js_string t parameter readonly_prop
+  method _SHADING_LANGUAGE_VERSION_ : js_string t parameter readonly_prop
 
-    method _CURRENT_PROGRAM_ : program t opt parameter readonly_prop
+  method _CURRENT_PROGRAM_ : program t opt parameter readonly_prop
 
-    method _VENDOR : js_string t parameter readonly_prop
+  method _VENDOR : js_string t parameter readonly_prop
 
-    method _RENDERER : js_string t parameter readonly_prop
+  method _RENDERER : js_string t parameter readonly_prop
 
-    method _VERSION : js_string t parameter readonly_prop
+  method _VERSION : js_string t parameter readonly_prop
 
-    method _MAX_CUBE_MAP_TEXTURE_SIZE_ : int parameter readonly_prop
+  method _MAX_CUBE_MAP_TEXTURE_SIZE_ : int parameter readonly_prop
 
-    method _ACTIVE_TEXTURE_ : textureUnit parameter readonly_prop
+  method _ACTIVE_TEXTURE_ : textureUnit parameter readonly_prop
 
-    method _FRAMEBUFFER_BINDING_ : framebuffer t opt parameter readonly_prop
+  method _FRAMEBUFFER_BINDING_ : framebuffer t opt parameter readonly_prop
 
-    method _RENDERBUFFER_BINDING_ : renderbuffer t opt parameter readonly_prop
+  method _RENDERBUFFER_BINDING_ : renderbuffer t opt parameter readonly_prop
 
-    method _MAX_RENDERBUFFER_SIZE : int parameter readonly_prop
+  method _MAX_RENDERBUFFER_SIZE : int parameter readonly_prop
 
-    method _NEVER : depthFunction readonly_prop
+  method _NEVER : depthFunction readonly_prop
 
-    method _LESS : depthFunction readonly_prop
+  method _LESS : depthFunction readonly_prop
 
-    method _EQUAL : depthFunction readonly_prop
+  method _EQUAL : depthFunction readonly_prop
 
-    method _LEQUAL : depthFunction readonly_prop
+  method _LEQUAL : depthFunction readonly_prop
 
-    method _GREATER : depthFunction readonly_prop
+  method _GREATER : depthFunction readonly_prop
 
-    method _NOTEQUAL : depthFunction readonly_prop
+  method _NOTEQUAL : depthFunction readonly_prop
 
-    method _GEQUAL : depthFunction readonly_prop
+  method _GEQUAL : depthFunction readonly_prop
 
-    method _ALWAYS : depthFunction readonly_prop
+  method _ALWAYS : depthFunction readonly_prop
 
-    method _KEEP : stencilOp readonly_prop
+  method _KEEP : stencilOp readonly_prop
 
-    method _REPLACE : stencilOp readonly_prop
+  method _REPLACE : stencilOp readonly_prop
 
-    method _INCR : stencilOp readonly_prop
+  method _INCR : stencilOp readonly_prop
 
-    method _DECR : stencilOp readonly_prop
+  method _DECR : stencilOp readonly_prop
 
-    method _INVERT : stencilOp readonly_prop
+  method _INVERT : stencilOp readonly_prop
 
-    method _INCR_WRAP_ : stencilOp readonly_prop
+  method _INCR_WRAP_ : stencilOp readonly_prop
 
-    method _DECR_WRAP_ : stencilOp readonly_prop
+  method _DECR_WRAP_ : stencilOp readonly_prop
 
-    method _ZERO_ : stencilOp readonly_prop
+  method _ZERO_ : stencilOp readonly_prop
 
-    method _NEAREST : texFilter readonly_prop
+  method _NEAREST : texFilter readonly_prop
 
-    method _LINEAR : texFilter readonly_prop
+  method _LINEAR : texFilter readonly_prop
 
-    method _NEAREST_MIPMAP_NEAREST_ : texFilter readonly_prop
+  method _NEAREST_MIPMAP_NEAREST_ : texFilter readonly_prop
 
-    method _LINEAR_MIPMAP_NEAREST_ : texFilter readonly_prop
+  method _LINEAR_MIPMAP_NEAREST_ : texFilter readonly_prop
 
-    method _NEAREST_MIPMAP_LINEAR_ : texFilter readonly_prop
+  method _NEAREST_MIPMAP_LINEAR_ : texFilter readonly_prop
 
-    method _LINEAR_MIPMAP_LINEAR_ : texFilter readonly_prop
+  method _LINEAR_MIPMAP_LINEAR_ : texFilter readonly_prop
 
-    method _TEXTURE_MAG_FILTER_ : texFilter texParam readonly_prop
+  method _TEXTURE_MAG_FILTER_ : texFilter texParam readonly_prop
 
-    method _TEXTURE_MIN_FILTER_ : texFilter texParam readonly_prop
+  method _TEXTURE_MIN_FILTER_ : texFilter texParam readonly_prop
 
-    method _TEXTURE_WRAP_S_ : wrapMode texParam readonly_prop
+  method _TEXTURE_WRAP_S_ : wrapMode texParam readonly_prop
 
-    method _TEXTURE_WRAP_T_ : wrapMode texParam readonly_prop
+  method _TEXTURE_WRAP_T_ : wrapMode texParam readonly_prop
 
-    method _NONE_OT : objectType readonly_prop
+  method _NONE_OT : objectType readonly_prop
 
-    method _TEXTURE_OT : objectType readonly_prop
+  method _TEXTURE_OT : objectType readonly_prop
 
-    method _RENDERBUFFER_OT : objectType readonly_prop
+  method _RENDERBUFFER_OT : objectType readonly_prop
 
-    method _TEXTURE_2D_ : texTarget readonly_prop
+  method _TEXTURE_2D_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_POSITIVE_X_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_POSITIVE_X_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_NEGATIVE_X_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_NEGATIVE_X_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_POSITIVE_Y_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_POSITIVE_Y_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_NEGATIVE_Y_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_NEGATIVE_Y_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_POSITIVE_Z_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_POSITIVE_Z_ : texTarget readonly_prop
 
-    method _TEXTURE_CUBE_MAP_NEGATIVE_Z_ : texTarget readonly_prop
+  method _TEXTURE_CUBE_MAP_NEGATIVE_Z_ : texTarget readonly_prop
 
-    method _TEXTURE0 : textureUnit readonly_prop
+  method _TEXTURE0 : textureUnit readonly_prop
 
-    method _TEXTURE1 : textureUnit readonly_prop
+  method _TEXTURE1 : textureUnit readonly_prop
 
-    method _TEXTURE2 : textureUnit readonly_prop
+  method _TEXTURE2 : textureUnit readonly_prop
 
-    method _TEXTURE3 : textureUnit readonly_prop
+  method _TEXTURE3 : textureUnit readonly_prop
 
-    method _TEXTURE4 : textureUnit readonly_prop
+  method _TEXTURE4 : textureUnit readonly_prop
 
-    method _TEXTURE5 : textureUnit readonly_prop
+  method _TEXTURE5 : textureUnit readonly_prop
 
-    method _TEXTURE6 : textureUnit readonly_prop
+  method _TEXTURE6 : textureUnit readonly_prop
 
-    method _TEXTURE7 : textureUnit readonly_prop
+  method _TEXTURE7 : textureUnit readonly_prop
 
-    method _TEXTURE8 : textureUnit readonly_prop
+  method _TEXTURE8 : textureUnit readonly_prop
 
-    method _TEXTURE9 : textureUnit readonly_prop
+  method _TEXTURE9 : textureUnit readonly_prop
 
-    method _TEXTURE10 : textureUnit readonly_prop
+  method _TEXTURE10 : textureUnit readonly_prop
 
-    method _TEXTURE11 : textureUnit readonly_prop
+  method _TEXTURE11 : textureUnit readonly_prop
 
-    method _TEXTURE12 : textureUnit readonly_prop
+  method _TEXTURE12 : textureUnit readonly_prop
 
-    method _TEXTURE13 : textureUnit readonly_prop
+  method _TEXTURE13 : textureUnit readonly_prop
 
-    method _TEXTURE14 : textureUnit readonly_prop
+  method _TEXTURE14 : textureUnit readonly_prop
 
-    method _TEXTURE15 : textureUnit readonly_prop
+  method _TEXTURE15 : textureUnit readonly_prop
 
-    method _TEXTURE16 : textureUnit readonly_prop
+  method _TEXTURE16 : textureUnit readonly_prop
 
-    method _TEXTURE17 : textureUnit readonly_prop
+  method _TEXTURE17 : textureUnit readonly_prop
 
-    method _TEXTURE18 : textureUnit readonly_prop
+  method _TEXTURE18 : textureUnit readonly_prop
 
-    method _TEXTURE19 : textureUnit readonly_prop
+  method _TEXTURE19 : textureUnit readonly_prop
 
-    method _TEXTURE20 : textureUnit readonly_prop
+  method _TEXTURE20 : textureUnit readonly_prop
 
-    method _TEXTURE21 : textureUnit readonly_prop
+  method _TEXTURE21 : textureUnit readonly_prop
 
-    method _TEXTURE22 : textureUnit readonly_prop
+  method _TEXTURE22 : textureUnit readonly_prop
 
-    method _TEXTURE23 : textureUnit readonly_prop
+  method _TEXTURE23 : textureUnit readonly_prop
 
-    method _TEXTURE24 : textureUnit readonly_prop
+  method _TEXTURE24 : textureUnit readonly_prop
 
-    method _TEXTURE25 : textureUnit readonly_prop
+  method _TEXTURE25 : textureUnit readonly_prop
 
-    method _TEXTURE26 : textureUnit readonly_prop
+  method _TEXTURE26 : textureUnit readonly_prop
 
-    method _TEXTURE27 : textureUnit readonly_prop
+  method _TEXTURE27 : textureUnit readonly_prop
 
-    method _TEXTURE28 : textureUnit readonly_prop
+  method _TEXTURE28 : textureUnit readonly_prop
 
-    method _TEXTURE29 : textureUnit readonly_prop
+  method _TEXTURE29 : textureUnit readonly_prop
 
-    method _TEXTURE30 : textureUnit readonly_prop
+  method _TEXTURE30 : textureUnit readonly_prop
 
-    method _TEXTURE31 : textureUnit readonly_prop
+  method _TEXTURE31 : textureUnit readonly_prop
 
-    method _REPEAT : wrapMode readonly_prop
+  method _REPEAT : wrapMode readonly_prop
 
-    method _CLAMP_TO_EDGE_ : wrapMode readonly_prop
+  method _CLAMP_TO_EDGE_ : wrapMode readonly_prop
 
-    method _MIRRORED_REPEAT_ : wrapMode readonly_prop
+  method _MIRRORED_REPEAT_ : wrapMode readonly_prop
 
-    method _FLOAT_ : uniformType readonly_prop
+  method _FLOAT_ : uniformType readonly_prop
 
-    method _FLOAT_VEC2_ : uniformType readonly_prop
+  method _FLOAT_VEC2_ : uniformType readonly_prop
 
-    method _FLOAT_VEC3_ : uniformType readonly_prop
+  method _FLOAT_VEC3_ : uniformType readonly_prop
 
-    method _FLOAT_VEC4_ : uniformType readonly_prop
+  method _FLOAT_VEC4_ : uniformType readonly_prop
 
-    method _INT_ : uniformType readonly_prop
+  method _INT_ : uniformType readonly_prop
 
-    method _INT_VEC2_ : uniformType readonly_prop
+  method _INT_VEC2_ : uniformType readonly_prop
 
-    method _INT_VEC3_ : uniformType readonly_prop
+  method _INT_VEC3_ : uniformType readonly_prop
 
-    method _INT_VEC4_ : uniformType readonly_prop
+  method _INT_VEC4_ : uniformType readonly_prop
 
-    method _BOOL_ : uniformType readonly_prop
+  method _BOOL_ : uniformType readonly_prop
 
-    method _BOOL_VEC2_ : uniformType readonly_prop
+  method _BOOL_VEC2_ : uniformType readonly_prop
 
-    method _BOOL_VEC3_ : uniformType readonly_prop
+  method _BOOL_VEC3_ : uniformType readonly_prop
 
-    method _BOOL_VEC4_ : uniformType readonly_prop
+  method _BOOL_VEC4_ : uniformType readonly_prop
 
-    method _FLOAT_MAT2_ : uniformType readonly_prop
+  method _FLOAT_MAT2_ : uniformType readonly_prop
 
-    method _FLOAT_MAT3_ : uniformType readonly_prop
+  method _FLOAT_MAT3_ : uniformType readonly_prop
 
-    method _FLOAT_MAT4_ : uniformType readonly_prop
+  method _FLOAT_MAT4_ : uniformType readonly_prop
 
-    method _SAMPLER_2D_ : uniformType readonly_prop
+  method _SAMPLER_2D_ : uniformType readonly_prop
 
-    method _SAMPLER_CUBE_ : uniformType readonly_prop
+  method _SAMPLER_CUBE_ : uniformType readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_ENABLED_ : bool t vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_ENABLED_ : bool t vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_SIZE_ : int vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_SIZE_ : int vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_STRIDE_ : int vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_STRIDE_ : int vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_TYPE_ : int vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_TYPE_ : int vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_NORMALIZED_ : bool t vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_NORMALIZED_ : bool t vertexAttribParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_POINTER_ : vertexAttribPointerParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_POINTER_ : vertexAttribPointerParam readonly_prop
 
-    method _VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ :
-      buffer t opt vertexAttribParam readonly_prop
+  method _VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ :
+    buffer t opt vertexAttribParam readonly_prop
 
-    method _CURRENT_VERTEX_ATTRIB_ :
-      Typed_array.float32Array t vertexAttribParam readonly_prop
+  method _CURRENT_VERTEX_ATTRIB_ :
+    Typed_array.float32Array t vertexAttribParam readonly_prop
 
-    method _LOW_FLOAT_ : shaderPrecisionType readonly_prop
+  method _LOW_FLOAT_ : shaderPrecisionType readonly_prop
 
-    method _MEDIUM_FLOAT_ : shaderPrecisionType readonly_prop
+  method _MEDIUM_FLOAT_ : shaderPrecisionType readonly_prop
 
-    method _HIGH_FLOAT_ : shaderPrecisionType readonly_prop
+  method _HIGH_FLOAT_ : shaderPrecisionType readonly_prop
 
-    method _LOW_INT_ : shaderPrecisionType readonly_prop
+  method _LOW_INT_ : shaderPrecisionType readonly_prop
 
-    method _MEDIUM_INT_ : shaderPrecisionType readonly_prop
+  method _MEDIUM_INT_ : shaderPrecisionType readonly_prop
 
-    method _HIGH_INT_ : shaderPrecisionType readonly_prop
+  method _HIGH_INT_ : shaderPrecisionType readonly_prop
 
-    method _FRAMEBUFFER : fbTarget readonly_prop
+  method _FRAMEBUFFER : fbTarget readonly_prop
 
-    method _RENDERBUFFER : rbTarget readonly_prop
+  method _RENDERBUFFER : rbTarget readonly_prop
 
-    method _RGBA4 : format readonly_prop
+  method _RGBA4 : format readonly_prop
 
-    method _RGB5_A1_ : format readonly_prop
+  method _RGB5_A1_ : format readonly_prop
 
-    method _RGB565 : format readonly_prop
+  method _RGB565 : format readonly_prop
 
-    method _DEPTH_COMPONENT16_ : format readonly_prop
+  method _DEPTH_COMPONENT16_ : format readonly_prop
 
-    method _STENCIL_INDEX8_ : format readonly_prop
+  method _STENCIL_INDEX8_ : format readonly_prop
 
-    method _RENDERBUFFER_WIDTH_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_WIDTH_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_HEIGHT_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_HEIGHT_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_INTERNAL_FORMAT_ : format renderbufferParam readonly_prop
+  method _RENDERBUFFER_INTERNAL_FORMAT_ : format renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_RED_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_RED_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_GREEN_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_GREEN_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_BLUE_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_BLUE_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_ALPHA_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_ALPHA_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_DEPTH_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_DEPTH_SIZE_ : int renderbufferParam readonly_prop
 
-    method _RENDERBUFFER_STENCIL_SIZE_ : int renderbufferParam readonly_prop
+  method _RENDERBUFFER_STENCIL_SIZE_ : int renderbufferParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_ : objectType attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_ : objectType attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_RENDERBUFFER :
-      renderbuffer t attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_RENDERBUFFER :
+    renderbuffer t attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_TEXTURE :
-      texture t attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_TEXTURE : texture t attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_ : int attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_ : int attachParam readonly_prop
 
-    method _FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_ : int attachParam readonly_prop
+  method _FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_ : int attachParam readonly_prop
 
-    method _COLOR_ATTACHMENT0_ : attachmentPoint readonly_prop
+  method _COLOR_ATTACHMENT0_ : attachmentPoint readonly_prop
 
-    method _DEPTH_ATTACHMENT_ : attachmentPoint readonly_prop
+  method _DEPTH_ATTACHMENT_ : attachmentPoint readonly_prop
 
-    method _STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
+  method _STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
 
-    method _DEPTH_STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
+  method _DEPTH_STENCIL_ATTACHMENT_ : attachmentPoint readonly_prop
 
-    method _FRAMEBUFFER_COMPLETE_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_COMPLETE_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_INCOMPLETE_ATTACHMENT_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_INCOMPLETE_ATTACHMENT_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_INCOMPLETE_DIMENSIONS_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_INCOMPLETE_DIMENSIONS_ : framebufferStatus readonly_prop
 
-    method _FRAMEBUFFER_UNSUPPORTED_ : framebufferStatus readonly_prop
+  method _FRAMEBUFFER_UNSUPPORTED_ : framebufferStatus readonly_prop
 
-    method _UNPACK_FLIP_Y_WEBGL_PARAM : bool t parameter readonly_prop
+  method _UNPACK_FLIP_Y_WEBGL_PARAM : bool t parameter readonly_prop
 
-    method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_PARAM : bool t parameter readonly_prop
+  method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_PARAM : bool t parameter readonly_prop
 
-    method _UNPACK_COLORSPACE_CONVERSION_WEBGL_PARAM :
-      colorspaceConversion parameter readonly_prop
+  method _UNPACK_COLORSPACE_CONVERSION_WEBGL_PARAM :
+    colorspaceConversion parameter readonly_prop
 
-    method _NONE : colorspaceConversion readonly_prop
+  method _NONE : colorspaceConversion readonly_prop
 
-    method _BROWSER_DEFAULT_WEBGL_ : colorspaceConversion readonly_prop
+  method _BROWSER_DEFAULT_WEBGL_ : colorspaceConversion readonly_prop
 
-    method _UNPACK_ALIGNMENT_ : int pixelStoreParam readonly_prop
+  method _UNPACK_ALIGNMENT_ : int pixelStoreParam readonly_prop
 
-    method _UNPACK_FLIP_Y_WEBGL_ : bool t pixelStoreParam readonly_prop
+  method _UNPACK_FLIP_Y_WEBGL_ : bool t pixelStoreParam readonly_prop
 
-    method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_ : bool t pixelStoreParam readonly_prop
+  method _UNPACK_PREMULTIPLY_ALPHA_WEBGL_ : bool t pixelStoreParam readonly_prop
 
-    method _UNPACK_COLORSPACE_CONVERSION_WEBGL_ : int pixelStoreParam readonly_prop
-  end
+  method _UNPACK_COLORSPACE_CONVERSION_WEBGL_ : int pixelStoreParam readonly_prop
+end
 
 (** 5.14 WebGLContextEvent *)
 
-class type contextEvent =
-  object
-    inherit Dom_html.event
+class type contextEvent = object
+  inherit Dom_html.event
 
-    method statusMessage : js_string t readonly_prop
-  end
+  method statusMessage : js_string t readonly_prop
+end
 
 module Event : sig
   val webglcontextlost : contextEvent t Dom_html.Event.typ
diff --git a/lib/js_of_ocaml/webSockets.ml b/lib/js_of_ocaml/webSockets.ml
index c878df9cce..390e3edb86 100644
--- a/lib/js_of_ocaml/webSockets.ml
+++ b/lib/js_of_ocaml/webSockets.ml
@@ -26,68 +26,63 @@ type readyState =
   | CLOSING
   | CLOSED
 
-class type ['a] closeEvent =
-  object
-    inherit ['a] Dom.event
+class type ['a] closeEvent = object
+  inherit ['a] Dom.event
 
-    method code : int Js.readonly_prop
+  method code : int Js.readonly_prop
 
-    method reason : Js.js_string Js.t Js.readonly_prop
+  method reason : Js.js_string Js.t Js.readonly_prop
 
-    method wasClean : bool Js.t Js.readonly_prop
-  end
+  method wasClean : bool Js.t Js.readonly_prop
+end
 
-class type ['a] messageEvent =
-  object
-    inherit ['a] Dom.event
+class type ['a] messageEvent = object
+  inherit ['a] Dom.event
 
-    method data : Js.js_string Js.t Js.readonly_prop
+  method data : Js.js_string Js.t Js.readonly_prop
 
-    method data_buffer : Typed_array.arrayBuffer Js.t Js.readonly_prop
+  method data_buffer : Typed_array.arrayBuffer Js.t Js.readonly_prop
 
-    method data_blob : File.blob Js.t Js.readonly_prop
-  end
+  method data_blob : File.blob Js.t Js.readonly_prop
+end
 
-class type webSocket =
-  object ('self)
-    inherit Dom_html.eventTarget
+class type webSocket = object ('self)
+  inherit Dom_html.eventTarget
 
-    method url : Js.js_string Js.t Js.readonly_prop
+  method url : Js.js_string Js.t Js.readonly_prop
 
-    method readyState : readyState Js.readonly_prop
+  method readyState : readyState Js.readonly_prop
 
-    method bufferedAmount : int Js.readonly_prop
+  method bufferedAmount : int Js.readonly_prop
 
-    method onopen :
-      ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
+  method onopen : ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
 
-    method onclose :
-      ('self Js.t, 'self closeEvent Js.t) Dom.event_listener Js.writeonly_prop
+  method onclose :
+    ('self Js.t, 'self closeEvent Js.t) Dom.event_listener Js.writeonly_prop
 
-    method onerror :
-      ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
+  method onerror : ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
 
-    method extensions : Js.js_string Js.t Js.readonly_prop
+  method extensions : Js.js_string Js.t Js.readonly_prop
 
-    method protocol : Js.js_string Js.t Js.readonly_prop
+  method protocol : Js.js_string Js.t Js.readonly_prop
 
-    method close : unit Js.meth
+  method close : unit Js.meth
 
-    method close_withCode : int -> unit Js.meth
+  method close_withCode : int -> unit Js.meth
 
-    method close_withCodeAndReason : int -> Js.js_string Js.t -> unit Js.meth
+  method close_withCodeAndReason : int -> Js.js_string Js.t -> unit Js.meth
 
-    method onmessage :
-      ('self Js.t, 'self messageEvent Js.t) Dom.event_listener Js.writeonly_prop
+  method onmessage :
+    ('self Js.t, 'self messageEvent Js.t) Dom.event_listener Js.writeonly_prop
 
-    method binaryType : Js.js_string Js.t Js.prop
+  method binaryType : Js.js_string Js.t Js.prop
 
-    method send : Js.js_string Js.t -> unit Js.meth
+  method send : Js.js_string Js.t -> unit Js.meth
 
-    method send_buffer : Typed_array.arrayBuffer Js.t -> unit Js.meth
+  method send_buffer : Typed_array.arrayBuffer Js.t -> unit Js.meth
 
-    method send_blob : File.blob Js.t -> unit Js.meth
-  end
+  method send_blob : File.blob Js.t -> unit Js.meth
+end
 
 let webSocket = Js.Unsafe.global##._WebSocket
 
diff --git a/lib/js_of_ocaml/webSockets.mli b/lib/js_of_ocaml/webSockets.mli
index 35e850e802..89157ddfac 100644
--- a/lib/js_of_ocaml/webSockets.mli
+++ b/lib/js_of_ocaml/webSockets.mli
@@ -26,68 +26,63 @@ type readyState =
   | CLOSING
   | CLOSED
 
-class type ['a] closeEvent =
-  object
-    inherit ['a] Dom.event
+class type ['a] closeEvent = object
+  inherit ['a] Dom.event
 
-    method code : int Js.readonly_prop
+  method code : int Js.readonly_prop
 
-    method reason : Js.js_string Js.t Js.readonly_prop
+  method reason : Js.js_string Js.t Js.readonly_prop
 
-    method wasClean : bool Js.t Js.readonly_prop
-  end
+  method wasClean : bool Js.t Js.readonly_prop
+end
 
-class type ['a] messageEvent =
-  object
-    inherit ['a] Dom.event
+class type ['a] messageEvent = object
+  inherit ['a] Dom.event
 
-    method data : Js.js_string Js.t Js.readonly_prop
+  method data : Js.js_string Js.t Js.readonly_prop
 
-    method data_buffer : Typed_array.arrayBuffer Js.t Js.readonly_prop
+  method data_buffer : Typed_array.arrayBuffer Js.t Js.readonly_prop
 
-    method data_blob : File.blob Js.t Js.readonly_prop
-  end
+  method data_blob : File.blob Js.t Js.readonly_prop
+end
 
-class type webSocket =
-  object ('self)
-    inherit Dom_html.eventTarget
+class type webSocket = object ('self)
+  inherit Dom_html.eventTarget
 
-    method url : Js.js_string Js.t Js.readonly_prop
+  method url : Js.js_string Js.t Js.readonly_prop
 
-    method readyState : readyState Js.readonly_prop
+  method readyState : readyState Js.readonly_prop
 
-    method bufferedAmount : int Js.readonly_prop
+  method bufferedAmount : int Js.readonly_prop
 
-    method onopen :
-      ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
+  method onopen : ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
 
-    method onclose :
-      ('self Js.t, 'self closeEvent Js.t) Dom.event_listener Js.writeonly_prop
+  method onclose :
+    ('self Js.t, 'self closeEvent Js.t) Dom.event_listener Js.writeonly_prop
 
-    method onerror :
-      ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
+  method onerror : ('self Js.t, 'self Dom.event Js.t) Dom.event_listener Js.writeonly_prop
 
-    method extensions : Js.js_string Js.t Js.readonly_prop
+  method extensions : Js.js_string Js.t Js.readonly_prop
 
-    method protocol : Js.js_string Js.t Js.readonly_prop
+  method protocol : Js.js_string Js.t Js.readonly_prop
 
-    method close : unit Js.meth
+  method close : unit Js.meth
 
-    method close_withCode : int -> unit Js.meth
+  method close_withCode : int -> unit Js.meth
 
-    method close_withCodeAndReason : int -> Js.js_string Js.t -> unit Js.meth
+  method close_withCodeAndReason : int -> Js.js_string Js.t -> unit Js.meth
 
-    method onmessage :
-      ('self Js.t, 'self messageEvent Js.t) Dom.event_listener Js.writeonly_prop
+  method onmessage :
+    ('self Js.t, 'self messageEvent Js.t) Dom.event_listener Js.writeonly_prop
 
-    method binaryType : Js.js_string Js.t Js.prop
+  method binaryType : Js.js_string Js.t Js.prop
 
-    method send : Js.js_string Js.t -> unit Js.meth
+  method send : Js.js_string Js.t -> unit Js.meth
 
-    method send_buffer : Typed_array.arrayBuffer Js.t -> unit Js.meth
+  method send_buffer : Typed_array.arrayBuffer Js.t -> unit Js.meth
 
-    method send_blob : File.blob Js.t -> unit Js.meth
-  end
+  method send_blob : File.blob Js.t -> unit Js.meth
+end
 
 val webSocket : (Js.js_string Js.t -> webSocket Js.t) Js.constr
 
diff --git a/lib/js_of_ocaml/worker.ml b/lib/js_of_ocaml/worker.ml
index f163f9aa68..1f573d663b 100644
--- a/lib/js_of_ocaml/worker.ml
+++ b/lib/js_of_ocaml/worker.ml
@@ -21,40 +21,37 @@ open Js
 open Dom_html
 open! Import
 
-class type ['a, 'b] worker =
-  object ('self)
-    inherit eventTarget
+class type ['a, 'b] worker = object ('self)
+  inherit eventTarget
 
-    method onerror : ('self t, errorEvent t) event_listener writeonly_prop
+  method onerror : ('self t, errorEvent t) event_listener writeonly_prop
 
-    method onmessage : ('self t, 'b messageEvent t) event_listener writeonly_prop
+  method onmessage : ('self t, 'b messageEvent t) event_listener writeonly_prop
 
-    method postMessage : 'a -> unit meth
+  method postMessage : 'a -> unit meth
 
-    method terminate : unit meth
-  end
+  method terminate : unit meth
+end
 
-and errorEvent =
-  object
-    inherit event
+and errorEvent = object
+  inherit event
 
-    method message : js_string t readonly_prop
+  method message : js_string t readonly_prop
 
-    method filename : js_string t readonly_prop
+  method filename : js_string t readonly_prop
 
-    method lineno : int readonly_prop
+  method lineno : int readonly_prop
 
-    method colno : int readonly_prop
+  method colno : int readonly_prop
 
-    method error : Unsafe.any readonly_prop
-  end
+  method error : Unsafe.any readonly_prop
+end
 
-and ['a] messageEvent =
-  object
-    inherit event
+and ['a] messageEvent = object
+  inherit event
 
-    method data : 'a readonly_prop
-  end
+  method data : 'a readonly_prop
+end
 
 let worker = Unsafe.global##._Worker
 
diff --git a/lib/js_of_ocaml/worker.mli b/lib/js_of_ocaml/worker.mli
index 4634e22762..783b778adf 100644
--- a/lib/js_of_ocaml/worker.mli
+++ b/lib/js_of_ocaml/worker.mli
@@ -29,40 +29,37 @@
 open Js
 open Dom_html
 
-class type ['a, 'b] worker =
-  object ('self)
-    inherit eventTarget
+class type ['a, 'b] worker = object ('self)
+  inherit eventTarget
 
-    method onerror : ('self t, errorEvent t) event_listener writeonly_prop
+  method onerror : ('self t, errorEvent t) event_listener writeonly_prop
 
-    method onmessage : ('self t, 'b messageEvent t) event_listener writeonly_prop
+  method onmessage : ('self t, 'b messageEvent t) event_listener writeonly_prop
 
-    method postMessage : 'a -> unit meth
+  method postMessage : 'a -> unit meth
 
-    method terminate : unit meth
-  end
+  method terminate : unit meth
+end
 
-and errorEvent =
-  object
-    inherit event
+and errorEvent = object
+  inherit event
 
-    method message : js_string t readonly_prop
+  method message : js_string t readonly_prop
 
-    method filename : js_string t readonly_prop
+  method filename : js_string t readonly_prop
 
-    method lineno : int readonly_prop
+  method lineno : int readonly_prop
 
-    method colno : int readonly_prop
+  method colno : int readonly_prop
 
-    method error : Unsafe.any readonly_prop
-  end
+  method error : Unsafe.any readonly_prop
+end
 
-and ['a] messageEvent =
-  object
-    inherit event
+and ['a] messageEvent = object
+  inherit event
 
-    method data : 'a readonly_prop
-  end
+  method data : 'a readonly_prop
+end
 
 val create : string -> ('a, 'b) worker t
 
diff --git a/lib/js_of_ocaml/xmlHttpRequest.ml b/lib/js_of_ocaml/xmlHttpRequest.ml
index 6cb3d16217..e407ad4e3c 100644
--- a/lib/js_of_ocaml/xmlHttpRequest.ml
+++ b/lib/js_of_ocaml/xmlHttpRequest.ml
@@ -36,66 +36,64 @@ type _ response =
   | Text : js_string t response
   | Default : string response
 
-class type xmlHttpRequest =
-  object ('self)
-    method onreadystatechange : (unit -> unit) Js.callback Js.writeonly_prop
+class type xmlHttpRequest = object ('self)
+  method onreadystatechange : (unit -> unit) Js.callback Js.writeonly_prop
 
-    method readyState : readyState readonly_prop
+  method readyState : readyState readonly_prop
 
-    method _open : js_string t -> js_string t -> bool t -> unit meth
+  method _open : js_string t -> js_string t -> bool t -> unit meth
 
-    method _open_full :
-         js_string t
-      -> js_string t
-      -> bool t
-      -> js_string t opt
-      -> js_string t opt
-      -> unit meth
+  method _open_full :
+       js_string t
+    -> js_string t
+    -> bool t
+    -> js_string t opt
+    -> js_string t opt
+    -> unit meth
 
-    method setRequestHeader : js_string t -> js_string t -> unit meth
+  method setRequestHeader : js_string t -> js_string t -> unit meth
 
-    method overrideMimeType : js_string t -> unit meth
+  method overrideMimeType : js_string t -> unit meth
 
-    method send : js_string t opt -> unit meth
+  method send : js_string t opt -> unit meth
 
-    method send_blob : #File.blob t -> unit meth
+  method send_blob : #File.blob t -> unit meth
 
-    method send_document : Dom.element Dom.document t -> unit meth
+  method send_document : Dom.element Dom.document t -> unit meth
 
-    method send_formData : Form.formData t -> unit meth
+  method send_formData : Form.formData t -> unit meth
 
-    method abort : unit meth
+  method abort : unit meth
 
-    method status : int readonly_prop
+  method status : int readonly_prop
 
-    method statusText : js_string t readonly_prop
+  method statusText : js_string t readonly_prop
 
-    method getResponseHeader : js_string t -> js_string t opt meth
+  method getResponseHeader : js_string t -> js_string t opt meth
 
-    method getAllResponseHeaders : js_string t meth
+  method getAllResponseHeaders : js_string t meth
 
-    method response : File.file_any readonly_prop
+  method response : File.file_any readonly_prop
 
-    method responseText : js_string t opt readonly_prop
+  method responseText : js_string t opt readonly_prop
 
-    method responseXML : Dom.element Dom.document t opt readonly_prop
+  method responseXML : Dom.element Dom.document t opt readonly_prop
 
-    method responseType : js_string t prop
+  method responseType : js_string t prop
 
-    method withCredentials : bool t writeonly_prop
+  method withCredentials : bool t writeonly_prop
 
-    inherit File.progressEventTarget
+  inherit File.progressEventTarget
 
-    method ontimeout :
-      ('self t, 'self File.progressEvent t) Dom.event_listener writeonly_prop
+  method ontimeout :
+    ('self t, 'self File.progressEvent t) Dom.event_listener writeonly_prop
 
-    method upload : xmlHttpRequestUpload t optdef readonly_prop
-  end
+  method upload : xmlHttpRequestUpload t optdef readonly_prop
+end
 
-and xmlHttpRequestUpload =
-  object ('self)
-    inherit File.progressEventTarget
-  end
+and xmlHttpRequestUpload = object ('self)
+  inherit File.progressEventTarget
+end
 
 module Event = struct
   type typ = xmlHttpRequest File.progressEvent t Dom.Event.typ
diff --git a/lib/js_of_ocaml/xmlHttpRequest.mli b/lib/js_of_ocaml/xmlHttpRequest.mli
index 7db270235a..7fbc739fc5 100644
--- a/lib/js_of_ocaml/xmlHttpRequest.mli
+++ b/lib/js_of_ocaml/xmlHttpRequest.mli
@@ -37,66 +37,64 @@ type _ response =
   | Text : js_string t response
   | Default : string response
 
-class type xmlHttpRequest =
-  object ('self)
-    method onreadystatechange : (unit -> unit) Js.callback Js.writeonly_prop
+class type xmlHttpRequest = object ('self)
+  method onreadystatechange : (unit -> unit) Js.callback Js.writeonly_prop
 
-    method readyState : readyState readonly_prop
+  method readyState : readyState readonly_prop
 
-    method _open : js_string t -> js_string t -> bool t -> unit meth
+  method _open : js_string t -> js_string t -> bool t -> unit meth
 
-    method _open_full :
-         js_string t
-      -> js_string t
-      -> bool t
-      -> js_string t opt
-      -> js_string t opt
-      -> unit meth
+  method _open_full :
+       js_string t
+    -> js_string t
+    -> bool t
+    -> js_string t opt
+    -> js_string t opt
+    -> unit meth
 
-    method setRequestHeader : js_string t -> js_string t -> unit meth
+  method setRequestHeader : js_string t -> js_string t -> unit meth
 
-    method overrideMimeType : js_string t -> unit meth
+  method overrideMimeType : js_string t -> unit meth
 
-    method send : js_string t opt -> unit meth
+  method send : js_string t opt -> unit meth
 
-    method send_blob : #File.blob t -> unit meth
+  method send_blob : #File.blob t -> unit meth
 
-    method send_document : Dom.element Dom.document t -> unit meth
+  method send_document : Dom.element Dom.document t -> unit meth
 
-    method send_formData : Form.formData t -> unit meth
+  method send_formData : Form.formData t -> unit meth
 
-    method abort : unit meth
+  method abort : unit meth
 
-    method status : int readonly_prop
+  method status : int readonly_prop
 
-    method statusText : js_string t readonly_prop
+  method statusText : js_string t readonly_prop
 
-    method getResponseHeader : js_string t -> js_string t opt meth
+  method getResponseHeader : js_string t -> js_string t opt meth
 
-    method getAllResponseHeaders : js_string t meth
+  method getAllResponseHeaders : js_string t meth
 
-    method response : File.file_any readonly_prop
+  method response : File.file_any readonly_prop
 
-    method responseText : js_string t opt readonly_prop
+  method responseText : js_string t opt readonly_prop
 
-    method responseXML : Dom.element Dom.document t opt readonly_prop
+  method responseXML : Dom.element Dom.document t opt readonly_prop
 
-    method responseType : js_string t prop
+  method responseType : js_string t prop
 
-    method withCredentials : bool t writeonly_prop
+  method withCredentials : bool t writeonly_prop
 
-    inherit File.progressEventTarget
+  inherit File.progressEventTarget
 
-    method ontimeout :
-      ('self t, 'self File.progressEvent t) Dom.event_listener writeonly_prop
+  method ontimeout :
+    ('self t, 'self File.progressEvent t) Dom.event_listener writeonly_prop
 
-    method upload : xmlHttpRequestUpload t optdef readonly_prop
-  end
+  method upload : xmlHttpRequestUpload t optdef readonly_prop
+end
 
-and xmlHttpRequestUpload =
-  object ('self)
-    inherit File.progressEventTarget
-  end
+and xmlHttpRequestUpload = object ('self)
+  inherit File.progressEventTarget
+end
 
 val create : unit -> xmlHttpRequest t
 
diff --git a/lib/lwt/graphics/graphics_js.ml b/lib/lwt/graphics/graphics_js.ml
index bc7d8f2161..588a329300 100644
--- a/lib/lwt/graphics/graphics_js.ml
+++ b/lib/lwt/graphics/graphics_js.ml
@@ -22,10 +22,9 @@ open Js_of_ocaml_lwt
 open! Import
 include Graphics
 
-class type context_ =
-  object
-    method canvas : Dom_html.canvasElement Js.t Js.readonly_prop
-  end
+class type context_ = object
+  method canvas : Dom_html.canvasElement Js.t Js.readonly_prop
+end
 
 type context = context_ Js.t
 
diff --git a/lib/tyxml/tyxml_js.ml b/lib/tyxml/tyxml_js.ml
index b3ebc80a1f..8989795abd 100644
--- a/lib/tyxml/tyxml_js.ml
+++ b/lib/tyxml/tyxml_js.ml
@@ -32,12 +32,11 @@ module type XML =
      and type keyboard_event_handler = Dom_html.keyboardEvent Js.t -> bool
      and type elt = Dom.node Js.t
 
-class type ['a, 'b] weakMap =
-  object
-    method set : 'a -> 'b -> unit Js.meth
+class type ['a, 'b] weakMap = object
+  method set : 'a -> 'b -> unit Js.meth
 
-    method get : 'a -> 'b Js.Optdef.t Js.meth
-  end
+  method get : 'a -> 'b Js.Optdef.t Js.meth
+end
 
 let retain =
   let map : (Dom.node Js.t, Obj.t Js.js_array Js.t) weakMap Js.t =
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index b1c4c7745a..c06d2915c3 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -4,16 +4,51 @@
  (files runtime.wasm runtime.js))
 
 (rule
-   (target runtime.wasm)
-   (deps args (glob_files *.wat))
-   (action
-      (progn
-         (system "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
-         (system "wasm-merge --version | grep -q 'version 117' || (echo 'Error: Binaryen version 117 is currently required'; false)")
-         (pipe-stdout
-            (run wasm-merge -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory %{read-lines:args} -o -)
-            (run wasm-opt -g --enable-gc --enable-exception-handling --enable-reference-types --enable-tail-call --enable-strings --enable-multivalue --enable-bulk-memory - -O3 -o %{target})))))
+ (target runtime.wasm)
+ (deps
+  args
+  (glob_files *.wat))
+ (action
+  (progn
+   (system
+    "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
+   (system
+    "wasm-merge --version | grep -q 'version 117' || (echo 'Error: Binaryen version 117 is currently required'; false)")
+   (pipe-stdout
+    (run
+     wasm-merge
+     -g
+     --enable-gc
+     --enable-exception-handling
+     --enable-reference-types
+     --enable-tail-call
+     --enable-strings
+     --enable-multivalue
+     --enable-bulk-memory
+     %{read-lines:args}
+     -o
+     -)
+    (run
+     wasm-opt
+     -g
+     --enable-gc
+     --enable-exception-handling
+     --enable-reference-types
+     --enable-tail-call
+     --enable-strings
+     --enable-multivalue
+     --enable-bulk-memory
+     -
+     -O3
+     -o
+     %{target})))))
 
-(rule (target args)
-   (deps args.ml (glob_files *.wat))
-   (action (with-stdout-to %{target}  (run ocaml %{deps}))))
+(rule
+ (target args)
+ (deps
+  args.ml
+  (glob_files *.wat))
+ (action
+  (with-stdout-to
+   %{target}
+   (run ocaml %{deps}))))
diff --git a/toplevel/examples/eval/dune b/toplevel/examples/eval/dune
index f261b2cf64..43a376a6d1 100644
--- a/toplevel/examples/eval/dune
+++ b/toplevel/examples/eval/dune
@@ -1,6 +1,9 @@
 (executables
  (names eval)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (libraries js_of_ocaml-compiler js_of_ocaml-toplevel)
  (link_flags
   (:standard -linkall))
@@ -10,14 +13,20 @@
 
 (rule
  (targets export.txt)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps eval.bc)
  (action
   (run jsoo_listunits -o %{targets} stdlib)))
 
 (rule
  (targets eval.js)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (run
    %{bin:js_of_ocaml}
@@ -31,5 +40,8 @@
 
 (alias
  (name default)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps eval.js index.html))
diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune
index 50ef34ece4..775b7b0c2f 100644
--- a/toplevel/examples/lwt_toplevel/dune
+++ b/toplevel/examples/lwt_toplevel/dune
@@ -1,6 +1,9 @@
 (executables
  (names toplevel)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (libraries
   js_of_ocaml-compiler
   js_of_ocaml-tyxml
@@ -122,7 +125,10 @@
 
 (rule
  (targets toplevel.js)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (run
    %{bin:js_of_ocaml}
@@ -149,5 +155,8 @@
 
 (alias
  (name default)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps toplevel.js toplevel.bc.js index.html))
diff --git a/toplevel/lib/jsooTop.ml b/toplevel/lib/jsooTop.ml
index 6bfa0d3639..dea1c1a164 100644
--- a/toplevel/lib/jsooTop.ml
+++ b/toplevel/lib/jsooTop.ml
@@ -78,10 +78,10 @@ let use ffp content =
   with e ->
     Sys.remove fname;
     raise e
-  [@@if ocaml_version < (4, 14, 0)]
+[@@if ocaml_version < (4, 14, 0)]
 
 let use ffp content = Toploop.use_silently ffp (String content)
-  [@@if ocaml_version >= (4, 14, 0)]
+[@@if ocaml_version >= (4, 14, 0)]
 
 let execute printval ?pp_code ?highlight_location pp_answer s =
   let lb = Lexing.from_function (refill_lexbuf s (ref 0) pp_code) in
diff --git a/toplevel/test/dune b/toplevel/test/dune
index 54cfd5c5d4..4acf6aa48b 100644
--- a/toplevel/test/dune
+++ b/toplevel/test/dune
@@ -36,7 +36,10 @@
 
 (rule
  (alias runtest)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (deps test_toplevel.reference test_toplevel.referencejs)
  (action
   (diff test_toplevel.reference test_toplevel.referencejs)))

From 28322043c848780a1a92ecb0a3f34e60db41db1e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 27 Jun 2024 18:02:48 +0200
Subject: [PATCH 257/481] Fix comparison function

The stack containing what remains to be compared was not resized
---
 runtime/wasm/compare.wat | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index 55f18a66b5..f81a30745f 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -115,10 +115,10 @@
             (local.set $stack'
                (struct.new $compare_stack (local.get $i)
                   (array.new $block_array
-                     (global.get $dummy_block) (i32.const 8))
+                     (global.get $dummy_block) (local.get $len'))
                   (array.new $block_array
-                     (global.get $dummy_block) (i32.const 8))
-                  (array.new $int_array (i32.const 0) (i32.const 8))))
+                     (global.get $dummy_block) (local.get $len'))
+                  (array.new $int_array (i32.const 0) (local.get $len'))))
             (array.copy $block_array $block_array
                (struct.get $compare_stack 1 (local.get $stack')) (i32.const 0)
                (struct.get $compare_stack 1 (local.get $stack)) (i32.const 0)

From df5ccda854b21f11c5b7f6aed15ffd59b06182d3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 27 Jun 2024 18:06:48 +0200
Subject: [PATCH 258/481] Comparisation function: add regression test

---
 compiler/tests-wasm_of_ocaml/dune    | 12 +++++++++++-
 compiler/tests-wasm_of_ocaml/gh46.ml |  7 +++++++
 2 files changed, 18 insertions(+), 1 deletion(-)
 create mode 100644 compiler/tests-wasm_of_ocaml/gh46.ml

diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune
index c3ad4d7d11..3d99da815c 100644
--- a/compiler/tests-wasm_of_ocaml/dune
+++ b/compiler/tests-wasm_of_ocaml/dune
@@ -1,5 +1,5 @@
 (executables
- (names gh38)
+ (names gh38 gh46)
  (modes js)
  (js_of_ocaml
   (flags :standard --disable optcall)))
@@ -13,3 +13,13 @@
   (with-outputs-to
    %{target}
    (run node %{dep:gh38.bc.js}))))
+
+(rule
+ (target gh46.actual)
+ (enabled_if
+  (= %{profile} wasm))
+ (alias runtest)
+ (action
+  (with-outputs-to
+   %{target}
+   (run node %{dep:gh46.bc.js}))))
diff --git a/compiler/tests-wasm_of_ocaml/gh46.ml b/compiler/tests-wasm_of_ocaml/gh46.ml
new file mode 100644
index 0000000000..4fcf866402
--- /dev/null
+++ b/compiler/tests-wasm_of_ocaml/gh46.ml
@@ -0,0 +1,7 @@
+type lst =
+  | Cons of lst * int
+  | Nil
+
+let rec make n = if n = 0 then Nil else Cons (make (n - 1), n)
+
+let () = assert (make 10 = make 10)

From e641fbeb258ad5219faff6213ba4252812f856cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 2 Jul 2024 13:47:11 +0200
Subject: [PATCH 259/481] Rename wasm_of_ocaml's github build workflow

---
 .github/workflows/{build.yml => build-wasm_of_ocaml.yml} | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)
 rename .github/workflows/{build.yml => build-wasm_of_ocaml.yml} (99%)

diff --git a/.github/workflows/build.yml b/.github/workflows/build-wasm_of_ocaml.yml
similarity index 99%
rename from .github/workflows/build.yml
rename to .github/workflows/build-wasm_of_ocaml.yml
index e4351ea629..a2138d7ba9 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -1,4 +1,4 @@
-name: build
+name: Build wasm_of_ocaml
 
 on:
   pull_request:

From 79a72c2a8c7797738ab653ce437a14700a18865b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 2 Jul 2024 16:49:38 +0200
Subject: [PATCH 260/481] Fix marshaling of native integers

---
 runtime/wasm/int32.wat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index ca17127a0a..eb4dad94eb 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -140,7 +140,7 @@
       (call $caml_serialize_int_1 (local.get $s) (i32.const 1))
       (call $caml_serialize_int_4 (local.get $s)
          (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v))))
-      (tuple.make 2 (i32.const 4) (i32.const 4)))
+      (tuple.make 2 (i32.const 4) (i32.const 8)))
 
    (data $integer_too_large "input_value: native integer value too large")
 

From 614cc25afba8e5920a3633bc1032f0a5df97de12 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 2 Jul 2024 16:11:38 +0200
Subject: [PATCH 261/481] Runtime: rename caml_string_cat into
 caml_string_concat

---
 runtime/wasm/marshal.wat | 12 ++++++------
 runtime/wasm/stdlib.wat  |  8 ++++----
 runtime/wasm/string.wat  |  2 +-
 3 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 0c46b4fe4f..7494992391 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -4,8 +4,8 @@
       (func $caml_invalid_argument (param (ref eq))))
    (import "fail" "caml_raise_end_of_file" (func $caml_raise_end_of_file))
    (import "obj" "double_array_tag" (global $double_array_tag i32))
-   (import "string" "caml_string_cat"
-      (func $caml_string_cat
+   (import "string" "caml_string_concat"
+      (func $caml_string_concat
          (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "obj" "caml_is_closure"
       (func $caml_is_closure (param (ref eq)) (result i32)))
@@ -643,21 +643,21 @@
 
    (func $too_large (param $prim (ref $string))
       (call $caml_failwith
-         (call $caml_string_cat (local.get $prim)
+         (call $caml_string_concat (local.get $prim)
             (array.new_data $string $too_large (i32.const 0) (i32.const 55)))))
 
    (data $bad_object ": bad object")
 
    (func $bad_object (param $prim (ref $string))
       (call $caml_failwith
-         (call $caml_string_cat (local.get $prim)
+         (call $caml_string_concat (local.get $prim)
             (array.new_data $string $bad_object (i32.const 0) (i32.const 12)))))
 
    (data $bad_length ": bad length")
 
    (func $bad_length (param $prim (ref $string))
       (call $caml_failwith
-         (call $caml_string_cat (local.get $prim)
+         (call $caml_string_concat (local.get $prim)
             (array.new_data $string $bad_length (i32.const 0) (i32.const 12)))))
 
    (type $marshal_header
@@ -1073,7 +1073,7 @@
                         (local.get $fixed_length))))
                 (then
                    (call $caml_failwith
-                      (call $caml_string_cat
+                      (call $caml_string_concat
                          (array.new_data $string $incorrect_sizes
                             (i32.const 0) (i32.const 49))
                          (struct.get $custom_operations $id
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index d91c2a744e..1f51b95ed3 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -18,8 +18,8 @@
       (func $caml_callback_2
          (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "bindings" "write" (func $write (param i32) (param anyref)))
-   (import "string" "caml_string_cat"
-      (func $caml_string_cat
+   (import "string" "caml_string_concat"
+      (func $caml_string_concat
          (param (ref eq)) (param (ref eq)) (result (ref eq))))
    (import "printexc" "caml_format_exception"
       (func $caml_format_exception (param (ref eq)) (result (ref eq))))
@@ -202,10 +202,10 @@
                (call $write (i32.const 2)
                   (call $unwrap
                      (call $caml_jsstring_of_string
-                        (call $caml_string_cat
+                        (call $caml_string_concat
                            (array.new_data $string $fatal_error
                               (i32.const 0) (i32.const 23))
-                           (call $caml_string_cat
+                           (call $caml_string_concat
                               (call $caml_format_exception (local.get $exn))
                               (array.new_fixed $string 1
                                  (i32.const 10)))))))) ;; `\n`
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index b59309911c..7ea971844d 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -315,7 +315,7 @@
          (i32.wrap_i64 (i64.shr_u (local.get $v) (i64.const 56))))
       (ref.i31 (i32.const 0)))
 
-   (func (export "caml_string_cat")
+   (func (export "caml_string_concat")
       (param $vs1 (ref eq)) (param $vs2 (ref eq)) (result (ref eq))
       (local $s1 (ref $string)) (local $s2 (ref $string))
       (local $s (ref $string))

From a759bbbae2dfd77de77d12362140c14521f72432 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 2 Jul 2024 23:39:49 +0200
Subject: [PATCH 262/481] Test improvements

Revert test_fun_call and test_poly_compare and don't run them in Wasm.
Add additional tests test_fun_call2 and test_poly_equal that make sense
in Wasm.
---
 lib/tests/dune.inc             |  24 +-
 lib/tests/gen-rules/gen.ml     |  12 +-
 lib/tests/test_fun_call.ml     |  37 ++-
 lib/tests/test_fun_call_2.ml   | 420 +++++++++++++++++++++++++++++++++
 lib/tests/test_poly_compare.ml |  39 ++-
 lib/tests/test_poly_equal.ml   |  66 ++++++
 6 files changed, 559 insertions(+), 39 deletions(-)
 create mode 100644 lib/tests/test_fun_call_2.ml
 create mode 100644 lib/tests/test_poly_equal.ml

diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc
index e219fc10e7..b16a266b6d 100644
--- a/lib/tests/dune.inc
+++ b/lib/tests/dune.inc
@@ -32,13 +32,23 @@
 (library
  ;; lib/tests/test_fun_call.ml
  (name test_fun_call_75)
- (enabled_if (<> %{profile} using-effects))
+ (enabled_if (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_fun_call)
  (libraries js_of_ocaml unix)
  (inline_tests (modes js))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
+(library
+ ;; lib/tests/test_fun_call_2.ml
+ (name test_fun_call_2_75)
+ (enabled_if true)
+ (modules test_fun_call_2)
+ (libraries js_of_ocaml unix)
+ (inline_tests (modes js))
+ (preprocess
+  (pps ppx_js_internal ppx_expect)))
+
 (library
  ;; lib/tests/test_json.ml
  (name test_json_75)
@@ -62,13 +72,23 @@
 (library
  ;; lib/tests/test_poly_compare.ml
  (name test_poly_compare_75)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_poly_compare)
  (libraries js_of_ocaml unix)
  (inline_tests (modes js))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
+(library
+ ;; lib/tests/test_poly_equal.ml
+ (name test_poly_equal_75)
+ (enabled_if true)
+ (modules test_poly_equal)
+ (libraries js_of_ocaml unix)
+ (inline_tests (modes js))
+ (preprocess
+  (pps ppx_js_internal ppx_expect)))
+
 (library
  ;; lib/tests/test_regexp.ml
  (name test_regexp_75)
diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml
index cc42105ce8..eda5eea71a 100644
--- a/lib/tests/gen-rules/gen.ml
+++ b/lib/tests/gen-rules/gen.ml
@@ -47,14 +47,14 @@ let prefix : string =
 
 type enabled_if =
   | GE5
-  | No_effects
   | Not_wasm
+  | No_effects_not_wasm
   | Any
 
 let enabled_if = function
   | "test_sys" -> GE5
-  | "test_fun_call" -> No_effects
-  | "test_json" -> Not_wasm
+  | "test_fun_call" -> No_effects_not_wasm
+  | "test_json" | "test_poly_compare" -> Not_wasm
   | _ -> Any
 
 let () =
@@ -85,6 +85,8 @@ let () =
                (* ZZZ /static not yet implemented *)
                "(and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} \
                 wasm-effects))"
-           | No_effects -> "(<> %{profile} using-effects)"
-           | Not_wasm -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))")
+           | Not_wasm -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))"
+           | No_effects_not_wasm ->
+               "(and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} \
+                wasm-effects))")
            basename)
diff --git a/lib/tests/test_fun_call.ml b/lib/tests/test_fun_call.ml
index f36b0b871b..888246dd20 100644
--- a/lib/tests/test_fun_call.ml
+++ b/lib/tests/test_fun_call.ml
@@ -29,8 +29,9 @@ let s x =
       return "undefined"
     if(typeof x === "function")
       return "function#" + x.length + "#" + x.l
-    if (x.toString) return x.toString();
-    return "other"
+    if(x.toString() == "[object Arguments]")
+      return "(Arguments: " + Array.prototype.slice.call(x).toString() + ")";
+    return x.toString()
 })
 |}
   in
@@ -146,7 +147,7 @@ let%expect_test "wrap_callback_strict" =
     (Js.Unsafe.callback_with_arity 2 cb3)
     {| (function(f){ return f(1,2,3) }) |};
   [%expect {|
-    Result: other |}];
+    Result: function#1#1 |}];
   call_and_log
     (Js.Unsafe.callback_with_arity 2 cb3)
     ~cont:(fun g -> g 4)
@@ -163,7 +164,7 @@ let%expect_test "wrap_callback_strict" =
     Result: 0 |}];
   call_and_log (Js.Unsafe.callback_with_arity 2 cb3) {| (function(f){ return f(1,2) }) |};
   [%expect {|
-    Result: other |}]
+    Result: function#1#1 |}]
 
 let%expect_test "wrap_callback_strict" =
   call_and_log
@@ -290,7 +291,7 @@ let%expect_test "wrap_meth_callback_strict" =
     (Js.Unsafe.meth_callback_with_arity 2 cb4)
     {| (function(f){ return f.apply("this",[1,2,3]) }) |};
   [%expect {|
-    Result: other |}];
+    Result: function#1#1 |}];
   call_and_log
     (Js.Unsafe.meth_callback_with_arity 2 cb4)
     ~cont:(fun g -> g 4)
@@ -308,7 +309,7 @@ let%expect_test "wrap_meth_callback_strict" =
   call_and_log
     (Js.Unsafe.meth_callback_with_arity 2 cb4)
     {| (function(f){ return f.apply("this",[1,2]) }) |};
-  [%expect {| Result: other |}]
+  [%expect {| Result: function#1#1 |}]
 
 let%expect_test "wrap_meth_callback_strict" =
   call_and_log
@@ -353,15 +354,13 @@ let%expect_test "partial application, extra arguments set to undefined" =
 let%expect_test _ =
   call_and_log cb3 ~cont:(fun g -> g 1) {| (function(f){ return f }) |};
   [%expect {|
-    Result: other |}]
+    Result: function#2#2 |}]
 
-(*
 let%expect_test _ =
   call_and_log cb3 ~cont:(fun g -> g 1 2 3 4) {| (function(f){ return f }) |};
   [%expect {|
     got 1, 2, 3, done
     Result: 0 |}]
-*)
 
 let%expect_test _ =
   let f cb =
@@ -370,17 +369,15 @@ let%expect_test _ =
     | _ -> Printf.printf "Error: unknown"
   in
   f cb5;
-  [%expect {| Result: other |}];
+  [%expect {| Result: function#1#1 |}];
   f cb4;
   [%expect {|
     got 1, 1, 2, 3, done
     Result: 0 |}];
-  ()
-(* f cb3;
-   [%expect {|
-     got 1, 1, 2, done
-     Result: 0 |}]
-*)
+  f cb3;
+  [%expect {|
+    got 1, 1, 2, done
+    Result: 0 |}]
 
 let%expect_test _ =
   let f cb =
@@ -388,7 +385,6 @@ let%expect_test _ =
     | Invalid_argument s | Failure s -> Printf.printf "Error: %s" s
     | _ -> Printf.printf "Error: unknown"
   in
-  (*
   f (Obj.magic cb1);
   [%expect {|
     got 1, done
@@ -397,21 +393,20 @@ let%expect_test _ =
   [%expect {|
     got 1, 2, done
     Result: 0 |}];
-*)
   f (Obj.magic cb3);
   [%expect {|
     got 1, 2, 3, done
     Result: 0 |}];
   f (Obj.magic cb4);
   [%expect {|
-    Result: other |}];
+    Result: function#1#1 |}];
   f (Obj.magic cb5);
   [%expect {|
-    Result: other |}]
+    Result: function#2#2 |}]
 
 let%expect_test _ =
   let open Js_of_ocaml in
-  let f = Js.wrap_callback (fun s -> print_endline (Js.to_string s)) in
+  let f = Js.wrap_callback (fun s -> print_endline s) in
   Js.export "f" f;
   let () =
     Js.Unsafe.fun_call
diff --git a/lib/tests/test_fun_call_2.ml b/lib/tests/test_fun_call_2.ml
new file mode 100644
index 0000000000..1a8dd0071e
--- /dev/null
+++ b/lib/tests/test_fun_call_2.ml
@@ -0,0 +1,420 @@
+(* Js_of_ocaml tests
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2020 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+open Js_of_ocaml
+
+let s x =
+  let to_string =
+    Js.Unsafe.eval_string
+      {|
+(function(x){
+    if(x === null)
+      return "null"
+    if(x === undefined)
+      return "undefined"
+    if (!(typeof x == 'function') && x.toString) return x.toString();
+    return "other"
+})
+|}
+  in
+  Js.to_string (Js.Unsafe.fun_call to_string [| Js.Unsafe.inject x |])
+
+let call_and_log f ?(cont = (Obj.magic Fun.id : _ -> _)) str =
+  let call = Js.Unsafe.eval_string str in
+  let r = Js.Unsafe.fun_call call [| Js.Unsafe.inject f |] in
+  Printf.printf "Result: %s" (s (cont r))
+
+let cb1 a = Printf.printf "got %s, done\n" (s a)
+
+let cb2 a b = Printf.printf "got %s, %s, done\n" (s a) (s b)
+
+let cb3 a b c = Printf.printf "got %s, %s, %s, done\n" (s a) (s b) (s c)
+
+let cb4 a b c d = Printf.printf "got %s, %s, %s, %s, done\n" (s a) (s b) (s c) (s d)
+
+let cb5 a b c d e =
+  Printf.printf "got %s, %s, %s, %s, %s, done\n" (s a) (s b) (s c) (s d) (s e)
+
+(* Wrap callback *)
+
+let%expect_test "over application, extra arguments are dropped" =
+  call_and_log (Js.wrap_callback cb3) {| (function(f){ return f(1,2,3,4) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "over application, extra arguments are dropped" =
+  call_and_log (Js.wrap_callback cb3) {| (function(f){ return f(1,2)(3,4) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "partial application 1 + 2" =
+  call_and_log (Js.wrap_callback cb3) {| (function(f){ return f(1)(2,3) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "partial application 2 + 1" =
+  call_and_log (Js.wrap_callback cb3) {| (function(f){ return f(1,2)(3) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "partial application, callback is called when all arguments are available"
+    =
+  call_and_log (Js.wrap_callback cb5) {| (function(f){ return f(1)(2)(3)(4)(5) }) |};
+  [%expect {|
+    got 1, 2, 3, 4, 5, done
+    Result: 0 |}]
+
+let%expect_test "partial application, 0 argument call is treated like 1 argument \
+                 (undefined)" =
+  call_and_log (Js.wrap_callback cb5) {| (function(f){ return f(1)()(3)()(5) }) |};
+  [%expect {|
+    got 1, undefined, 3, undefined, 5, done
+    Result: 0 |}]
+
+let%expect_test _ =
+  let plus = Js.wrap_callback (fun a b -> a + b) in
+  call_and_log plus {| (function(f){ return f(1) }) |};
+  [%expect {| Result: other |}];
+  call_and_log plus {| (function(f){ return f(1)(2) }) |};
+  [%expect {| Result: 3 |}];
+  call_and_log plus {| (function(f){ return f(1,2) }) |};
+  [%expect {| Result: 3 |}];
+  call_and_log plus {| (function(f){ return f(1,2,3) }) |};
+  [%expect {| Result: 3 |}]
+
+(* Wrap callback with argument *)
+
+let%expect_test "wrap_callback_arguments" =
+  call_and_log
+    (Js.Unsafe.callback_with_arguments (Obj.magic cb1))
+    {| (function(f){ return f(1,2,3,4,5) }) |};
+  [%expect {|
+    got 1,2,3,4,5, done
+    Result: 0 |}]
+
+let%expect_test "wrap_callback_arguments" =
+  call_and_log
+    (Js.Unsafe.callback_with_arguments (Obj.magic cb1))
+    {| (function(f){ return f() }) |};
+  [%expect {|
+    got , done
+    Result: 0 |}]
+
+(* Wrap with arity *)
+
+let%expect_test "wrap_callback_strict" =
+  call_and_log
+    (Js.Unsafe.callback_with_arity 3 cb3)
+    {| (function(f){ return f(1,2,3) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.callback_with_arity 3 cb3)
+    {| (function(f){ return f(1,2,3,4) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log (Js.Unsafe.callback_with_arity 3 cb3) {| (function(f){ return f(1,2) }) |};
+  [%expect {|
+    got 1, 2, undefined, done
+    Result: 0 |}]
+
+let%expect_test "wrap_callback_strict" =
+  call_and_log
+    (Js.Unsafe.callback_with_arity 2 cb3)
+    {| (function(f){ return f(1,2,3) }) |};
+  [%expect {|
+    Result: other |}];
+  call_and_log
+    (Js.Unsafe.callback_with_arity 2 cb3)
+    ~cont:(fun g -> g 4)
+    {| (function(f){ return f(1,2,3) }) |};
+  [%expect {|
+    got 1, 2, 4, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.callback_with_arity 2 cb3)
+    ~cont:(fun g -> g 3)
+    {| (function(f){ return f(1,2) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log (Js.Unsafe.callback_with_arity 2 cb3) {| (function(f){ return f(1,2) }) |};
+  [%expect {|
+    Result: other |}]
+
+let%expect_test "wrap_callback_strict" =
+  call_and_log
+    (Js.Unsafe.callback_with_arity 4 cb3)
+    {| (function(f){ return f(1,2,3) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.callback_with_arity 4 cb3)
+    {| (function(f){ return f(1,2,3,4) }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log (Js.Unsafe.callback_with_arity 4 cb3) {| (function(f){ return f(1,2) }) |};
+  [%expect {|
+    got 1, 2, undefined, done
+    Result: 0 |}]
+
+(* Wrap meth callback *)
+
+let%expect_test "over application, extra arguments are dropped" =
+  call_and_log
+    (Js.wrap_meth_callback cb4)
+    {| (function(f){ return f.apply("this",[1,2,3,4]) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "over application, extra arguments are dropped" =
+  call_and_log
+    (Js.wrap_meth_callback cb4)
+    {| (function(f){ return f.apply("this",[1,2])(3,4) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "partial application 1 + 2" =
+  call_and_log
+    (Js.wrap_meth_callback cb4)
+    {| (function(f){ return f.apply("this", [1])(2,3) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "partial application 2 + 1" =
+  call_and_log
+    (Js.wrap_meth_callback cb4)
+    {| (function(f){ return f.apply("this",[1,2])(3) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "partial application, callback is called when all arguments are available"
+    =
+  call_and_log
+    (Js.wrap_meth_callback cb5)
+    {| (function(f){ return f.apply("this",[])(1)(2)(3)(4) }) |};
+  [%expect {|
+    got this, 1, 2, 3, 4, done
+    Result: 0 |}]
+
+let%expect_test "partial application, 0 argument call is treated 1 argument (undefined)" =
+  call_and_log
+    (Js.wrap_meth_callback cb5)
+    {| (function(f){ return f.apply("this",[])(1)()(3)() }) |};
+  [%expect {|
+    got this, 1, undefined, 3, undefined, done
+    Result: 0 |}]
+
+let%expect_test _ =
+  let plus = Js.wrap_meth_callback (fun _ a b -> a + b) in
+  call_and_log plus {| (function(f){ return f(1) }) |};
+  [%expect {| Result: other |}];
+  call_and_log plus {| (function(f){ return f(1)(2) }) |};
+  [%expect {| Result: 3 |}];
+  call_and_log plus {| (function(f){ return f(1,2) }) |};
+  [%expect {| Result: 3 |}];
+  call_and_log plus {| (function(f){ return f(1,2,3) }) |};
+  [%expect {| Result: 3 |}]
+
+(* Wrap callback with argument *)
+
+let%expect_test "wrap_meth_callback_arguments" =
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arguments (Obj.magic cb2))
+    {| (function(f){ return f.apply("this",[1,2,3,4,5]) }) |};
+  [%expect {|
+    got this, 1,2,3,4,5, done
+    Result: 0 |}]
+
+let%expect_test "wrap_meth_callback_arguments" =
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arguments (Obj.magic cb2))
+    {| (function(f){ return f.apply("this", []) }) |};
+  [%expect {|
+    got this, , done
+    Result: 0 |}]
+
+(* Wrap with arity *)
+
+let%expect_test "wrap_meth_callback_strict" =
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 3 cb4)
+    {| (function(f){ return f.apply("this",[1,2,3]) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 3 cb4)
+    {| (function(f){ return f.apply("this",[1,2,3,4]) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 3 cb4)
+    {| (function(f){ return f.apply("this",[1,2]) }) |};
+  [%expect {|
+    got this, 1, 2, undefined, done
+    Result: 0 |}]
+
+let%expect_test "wrap_meth_callback_strict" =
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 2 cb4)
+    {| (function(f){ return f.apply("this",[1,2,3]) }) |};
+  [%expect {|
+    Result: other |}];
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 2 cb4)
+    ~cont:(fun g -> g 4)
+    {| (function(f){ return f.apply("this",[1,2,3]) }) |};
+  [%expect {|
+    got this, 1, 2, 4, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 2 cb4)
+    ~cont:(fun g -> g 3)
+    {| (function(f){ return f.apply("this",[1,2]) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 2 cb4)
+    {| (function(f){ return f.apply("this",[1,2]) }) |};
+  [%expect {| Result: other |}]
+
+let%expect_test "wrap_meth_callback_strict" =
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 4 cb4)
+    {| (function(f){ return f.apply("this",[1,2,3]) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 4 cb4)
+    {| (function(f){ return f.apply("this",[1,2,3,4]) }) |};
+  (* Should not return a function *)
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}];
+  call_and_log
+    (Js.Unsafe.meth_callback_with_arity 4 cb4)
+    {| (function(f){ return f.apply("this",[1,2]) }) |};
+  [%expect {|
+    got this, 1, 2, undefined, done
+    Result: 0 |}]
+
+(* Wrap meth callback unsafe *)
+let%expect_test "over application, extra arguments are dropped" =
+  call_and_log
+    (Js.Unsafe.meth_callback cb4)
+    {| (function(f){ return f.apply("this",[1,2,3,4]) }) |};
+  [%expect {|
+    got this, 1, 2, 3, done
+    Result: 0 |}]
+
+let%expect_test "partial application, extra arguments set to undefined" =
+  call_and_log
+    (Js.Unsafe.meth_callback cb4)
+    {| (function(f){ return f.apply("this",[1,2]) }) |};
+  [%expect {|
+    got this, 1, 2, undefined, done
+    Result: 0 |}]
+
+(* caml_call_gen *)
+
+let%expect_test _ =
+  call_and_log cb3 ~cont:(fun g -> g 1) {| (function(f){ return f }) |};
+  [%expect {|
+    Result: other |}]
+
+(*
+let%expect_test _ =
+  call_and_log cb3 ~cont:(fun g -> g 1 2 3 4) {| (function(f){ return f }) |};
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}]
+*)
+
+let%expect_test _ =
+  let f cb =
+    try call_and_log (cb 1) ~cont:(fun g -> g 1 2 3) {| (function(f){ return f }) |} with
+    | Invalid_argument s | Failure s -> Printf.printf "Error: %s" s
+    | _ -> Printf.printf "Error: unknown"
+  in
+  f cb5;
+  [%expect {| Result: other |}];
+  f cb4;
+  [%expect {|
+    got 1, 1, 2, 3, done
+    Result: 0 |}];
+  ()
+(* f cb3;
+   [%expect {|
+     got 1, 1, 2, done
+     Result: 0 |}]
+*)
+
+let%expect_test _ =
+  let f cb =
+    try call_and_log (cb 1 2 3) {| (function(f){ return f }) |} with
+    | Invalid_argument s | Failure s -> Printf.printf "Error: %s" s
+    | _ -> Printf.printf "Error: unknown"
+  in
+  (*
+  f (Obj.magic cb1);
+  [%expect {|
+    got 1, done
+    Result: 0 |}];
+  f (Obj.magic cb2);
+  [%expect {|
+    got 1, 2, done
+    Result: 0 |}];
+*)
+  f (Obj.magic cb3);
+  [%expect {|
+    got 1, 2, 3, done
+    Result: 0 |}];
+  f (Obj.magic cb4);
+  [%expect {|
+    Result: other |}];
+  f (Obj.magic cb5);
+  [%expect {|
+    Result: other |}]
+
+let%expect_test _ =
+  let open Js_of_ocaml in
+  let f = Js.wrap_callback (fun s -> print_endline (Js.to_string s)) in
+  Js.export "f" f;
+  let () =
+    Js.Unsafe.fun_call
+      (Js.Unsafe.pure_js_expr "jsoo_exports")##.f
+      [| Js.Unsafe.coerce (Js.string "hello") |]
+  in
+  ();
+  [%expect {| hello |}]
diff --git a/lib/tests/test_poly_compare.ml b/lib/tests/test_poly_compare.ml
index b9799cc8db..62c47b46b8 100644
--- a/lib/tests/test_poly_compare.ml
+++ b/lib/tests/test_poly_compare.ml
@@ -25,7 +25,6 @@ let%expect_test "poly equal" =
   assert (List.mem obj1 [ obj2; obj1 ]);
   assert (not (List.mem obj1 [ obj2 ]));
   ()
-[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
 
 let%expect_test "poly equal neg" =
   let obj1 = Js.Unsafe.obj [||] in
@@ -50,8 +49,7 @@ let%expect_test "poly compare" =
       then print_endline "preserve"
       else print_endline "not preserve"
   | _ -> assert false);
-  [%expect.unreachable]
-[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
+  [%expect {| not preserve |}]
 
 type pack = Pack : 'a -> pack
 
@@ -65,7 +63,6 @@ let%expect_test "number comparison" =
   assert (
     Pack (Js.Unsafe.js_expr "new Number(2.1)")
     = Pack (Js.Unsafe.js_expr "new Number(2.1)"))
-[@@expect.uncaught_exn {| "Assert_failure lib/tests/test_poly_compare.ml:59:2" |}]
 
 let js_string_enabled = Js.typeof (Obj.magic "") == Js.string "string"
 
@@ -82,7 +79,6 @@ let%expect_test "string comparison" =
   assert (
     Pack (Js.Unsafe.js_expr "new String('abcd')")
     = Pack (Js.Unsafe.js_expr "new String('abcd')"))
-[@@expect.uncaught_exn {| "Assert_failure lib/tests/test_poly_compare.ml:82:2" |}]
 
 let%expect_test "symbol comparison" =
   let s1 = Pack (Js.Unsafe.js_expr "Symbol('2')") in
@@ -92,7 +88,6 @@ let%expect_test "symbol comparison" =
   assert (compare s1 s1 = 0);
   assert (compare s1 s2 = 1);
   assert (compare s2 s1 = 1)
-[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
 
 let%expect_test "object comparison" =
   let s1 = Pack (Js.Unsafe.js_expr "{}") in
@@ -102,7 +97,6 @@ let%expect_test "object comparison" =
   assert (compare s1 s1 = 0);
   assert (compare s1 s2 = 1);
   assert (compare s2 s1 = 1)
-[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
 
 let%expect_test "poly compare" =
   let l =
@@ -120,13 +114,36 @@ let%expect_test "poly compare" =
   let l' = List.sort (fun (_, a) (_, b) -> compare a b) l in
   List.iter (fun (i, _) -> Printf.printf "%d\n" i) l';
   print_endline "";
-  [%expect.unreachable];
+  [%expect {|
+    1
+    3
+    2
+    0
+    6
+    7
+    5
+    4 |}];
   let l' = List.sort (fun (_, a) (_, b) -> compare a b) (List.rev l) in
   let l'' = List.sort (fun (_, a) (_, b) -> compare a b) (List.rev l') in
   List.iter (fun (i, _) -> Printf.printf "%d\n" i) l';
   print_endline "";
-  [%expect.unreachable];
+  [%expect {|
+    3
+    1
+    2
+    0
+    4
+    5
+    7
+    6 |}];
   List.iter (fun (i, _) -> Printf.printf "%d\n" i) l'';
   print_endline "";
-  [%expect.unreachable]
-[@@expect.uncaught_exn {| (Invalid_argument "compare: abstract value") |}]
+  [%expect {|
+    1
+    3
+    2
+    0
+    4
+    5
+    6
+    7 |}]
diff --git a/lib/tests/test_poly_equal.ml b/lib/tests/test_poly_equal.ml
new file mode 100644
index 0000000000..0f6cf095ea
--- /dev/null
+++ b/lib/tests/test_poly_equal.ml
@@ -0,0 +1,66 @@
+(* Js_of_ocaml tests
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2019 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any 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.
+ *)
+open Js_of_ocaml
+
+let%expect_test "poly equal" =
+  let obj1 = Js.Unsafe.obj [||] in
+  let obj2 = Js.Unsafe.obj [||] in
+  assert (obj1 = obj2);
+  assert (not (obj1 = obj2));
+  ()
+[@@expect.uncaught_exn {| "Assert_failure lib/tests/test_poly_equal.ml:24:2" |}]
+
+let%expect_test "poly equal neg" =
+  let obj1 = Js.Unsafe.obj [||] in
+  let obj2 = Js.Unsafe.obj [||] in
+  assert (obj1 <> obj2);
+  assert (not (obj1 <> obj1));
+  ()
+
+type pack = Pack : 'a -> pack
+
+let%expect_test "number comparison" =
+  assert (Pack 2 = Pack 2);
+  assert (Pack 2 <> Pack 2.1);
+  assert (Pack (Js.float 2.1) = Pack (Js.float 2.1));
+  assert (Pack (Js.Unsafe.js_expr "Number(2.1)") <> Pack 2.);
+  assert (Pack (Js.Unsafe.js_expr "new Number(2.1)") <> Pack 2.);
+  assert (Pack (Js.Unsafe.js_expr "Number(2.1)") = Pack (Js.Unsafe.js_expr "Number(2.1)"))
+
+let%expect_test "string comparison" =
+  assert (Pack (Js.Unsafe.js_expr "String(2)") = Pack (Js.string "2"));
+  assert (Pack (Js.Unsafe.js_expr "String('abc')") = Pack (Js.string "abc"));
+  assert (Pack (Js.Unsafe.js_expr "new String('abcሴ')") = Pack (Js.string "abcሴ"));
+  assert (Pack (Js.Unsafe.js_expr "String(1)") <> Pack (Js.string "2"));
+  assert (Pack (Js.Unsafe.js_expr "String('abcd')") <> Pack (Js.string "abc"));
+  assert (Pack (Js.Unsafe.js_expr "new String('abcd')") <> Pack (Js.string "abc"));
+  assert (
+    Pack (Js.Unsafe.js_expr "String('abcd')") = Pack (Js.Unsafe.js_expr "String('abcd')"))
+
+let%expect_test "symbol comparison" =
+  let s1 = Pack (Js.Unsafe.js_expr "Symbol('2')") in
+  let s2 = Pack (Js.Unsafe.js_expr "Symbol('2')") in
+  assert (s1 <> s2);
+  assert (s1 = s1)
+
+let%expect_test "object comparison" =
+  let s1 = Pack (Js.Unsafe.js_expr "{}") in
+  let s2 = Pack (Js.Unsafe.js_expr "{}") in
+  assert (s1 <> s2);
+  assert (s1 = s1)

From fc761ced599fd1de1bf190441b364b91b601c801 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 4 Jul 2024 16:46:45 +0200
Subject: [PATCH 263/481] Add copyright headers

---
 compiler/bin-wasm_of_ocaml/build_runtime.ml    |  3 +--
 compiler/bin-wasm_of_ocaml/build_runtime.mli   |  3 +--
 compiler/bin-wasm_of_ocaml/cmd_arg.ml          |  3 +--
 compiler/bin-wasm_of_ocaml/cmd_arg.mli         |  3 +--
 compiler/bin-wasm_of_ocaml/compile.ml          |  2 +-
 compiler/bin-wasm_of_ocaml/compile.mli         |  2 +-
 .../bin-wasm_of_ocaml/findlib_support.empty.ml |  3 +--
 compiler/bin-wasm_of_ocaml/info.ml             |  3 +--
 compiler/bin-wasm_of_ocaml/info.mli            |  3 +--
 compiler/bin-wasm_of_ocaml/link.ml             |  3 +--
 compiler/bin-wasm_of_ocaml/link.mli            |  3 +--
 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml    |  4 +---
 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli   |  3 +--
 compiler/lib/wasm/wa_asm_output.ml             | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_asm_output.mli            | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_ast.ml                    | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_binaryen.ml               | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_binaryen.mli              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_closure_conversion.ml     | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_closure_conversion.mli    | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_code_generation.ml        | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_code_generation.mli       | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_core_target.ml            | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_core_target.mli           | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_curry.ml                  | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_curry.mli                 | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_gc_target.ml              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_gc_target.mli             | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_generate.ml               | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_generate.mli              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_globalize.ml              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_globalize.mli             | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_initialize_locals.ml      | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_initialize_locals.mli     | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_link.ml                   |  3 +--
 compiler/lib/wasm/wa_link.mli                  |  3 +--
 compiler/lib/wasm/wa_liveness.ml               | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_liveness.mli              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_spilling.ml               | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_spilling.mli              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_structure.ml              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_structure.mli             | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_tail_call.ml              | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_tail_call.mli             | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_target_sig.ml             | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_wat_output.ml             | 18 ++++++++++++++++++
 compiler/lib/wasm/wa_wat_output.mli            | 18 ++++++++++++++++++
 compiler/lib/wasm/zip.ml                       | 18 ++++++++++++++++++
 compiler/lib/wasm/zip.mli                      | 18 ++++++++++++++++++
 runtime/wasm/array.wat                         | 17 +++++++++++++++++
 runtime/wasm/backtrace.wat                     | 17 +++++++++++++++++
 runtime/wasm/bigarray.wat                      | 17 +++++++++++++++++
 runtime/wasm/bigstring.wat                     | 17 +++++++++++++++++
 runtime/wasm/compare.wat                       | 17 +++++++++++++++++
 runtime/wasm/custom.wat                        | 17 +++++++++++++++++
 runtime/wasm/domain.wat                        | 17 +++++++++++++++++
 runtime/wasm/dynlink.wat                       | 17 +++++++++++++++++
 runtime/wasm/effect.wat                        | 17 +++++++++++++++++
 runtime/wasm/fail.wat                          | 17 +++++++++++++++++
 runtime/wasm/float.wat                         | 17 +++++++++++++++++
 runtime/wasm/fs.wat                            | 17 +++++++++++++++++
 runtime/wasm/gc.wat                            | 17 +++++++++++++++++
 runtime/wasm/hash.wat                          | 17 +++++++++++++++++
 runtime/wasm/int32.wat                         | 17 +++++++++++++++++
 runtime/wasm/int64.wat                         | 17 +++++++++++++++++
 runtime/wasm/ints.wat                          | 17 +++++++++++++++++
 runtime/wasm/io.wat                            | 17 +++++++++++++++++
 runtime/wasm/jslib.wat                         | 17 +++++++++++++++++
 runtime/wasm/jslib_js_of_ocaml.wat             | 17 +++++++++++++++++
 runtime/wasm/jsstring.wat                      | 17 +++++++++++++++++
 runtime/wasm/lexing.wat                        | 17 +++++++++++++++++
 runtime/wasm/marshal.wat                       | 17 +++++++++++++++++
 runtime/wasm/md5.wat                           | 17 +++++++++++++++++
 runtime/wasm/nat.wat                           | 17 +++++++++++++++++
 runtime/wasm/obj.wat                           | 17 +++++++++++++++++
 runtime/wasm/parsing.wat                       | 17 +++++++++++++++++
 runtime/wasm/printexc.wat                      | 17 +++++++++++++++++
 runtime/wasm/prng.wat                          | 17 +++++++++++++++++
 runtime/wasm/runtime.js                        | 17 +++++++++++++++++
 runtime/wasm/stdlib.wat                        | 17 +++++++++++++++++
 runtime/wasm/str.wat                           | 17 +++++++++++++++++
 runtime/wasm/string.wat                        | 17 +++++++++++++++++
 runtime/wasm/sync.wat                          | 17 +++++++++++++++++
 runtime/wasm/sys.wat                           | 17 +++++++++++++++++
 runtime/wasm/toplevel.wat                      | 17 +++++++++++++++++
 runtime/wasm/unix.wat                          | 17 +++++++++++++++++
 runtime/wasm/weak.wat                          | 17 +++++++++++++++++
 87 files changed, 1273 insertions(+), 29 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/build_runtime.ml b/compiler/bin-wasm_of_ocaml/build_runtime.ml
index b0dbc4fb1a..774a8ba53d 100644
--- a/compiler/bin-wasm_of_ocaml/build_runtime.ml
+++ b/compiler/bin-wasm_of_ocaml/build_runtime.ml
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/build_runtime.mli b/compiler/bin-wasm_of_ocaml/build_runtime.mli
index 969933f7a7..952975461c 100644
--- a/compiler/bin-wasm_of_ocaml/build_runtime.mli
+++ b/compiler/bin-wasm_of_ocaml/build_runtime.mli
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index b1b414f594..59bd343d43 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2014 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
index 0bacf92e10..74d38c76fc 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.mli
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.mli
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2014 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index b91be415cf..cfcf3ee947 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -1,4 +1,4 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
  *
  * This program is free software; you can redistribute it and/or modify
diff --git a/compiler/bin-wasm_of_ocaml/compile.mli b/compiler/bin-wasm_of_ocaml/compile.mli
index 56b262fd23..a2a0703faf 100644
--- a/compiler/bin-wasm_of_ocaml/compile.mli
+++ b/compiler/bin-wasm_of_ocaml/compile.mli
@@ -1,4 +1,4 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
  *
  * This program is free software; you can redistribute it and/or modify
diff --git a/compiler/bin-wasm_of_ocaml/findlib_support.empty.ml b/compiler/bin-wasm_of_ocaml/findlib_support.empty.ml
index a96ea76350..cc6700682b 100644
--- a/compiler/bin-wasm_of_ocaml/findlib_support.empty.ml
+++ b/compiler/bin-wasm_of_ocaml/findlib_support.empty.ml
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/info.ml b/compiler/bin-wasm_of_ocaml/info.ml
index 0fc46359f7..33cd21e5bc 100644
--- a/compiler/bin-wasm_of_ocaml/info.ml
+++ b/compiler/bin-wasm_of_ocaml/info.ml
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/info.mli b/compiler/bin-wasm_of_ocaml/info.mli
index cab49a83d2..c97f81629f 100644
--- a/compiler/bin-wasm_of_ocaml/info.mli
+++ b/compiler/bin-wasm_of_ocaml/info.mli
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/link.ml b/compiler/bin-wasm_of_ocaml/link.ml
index 7fa8011249..db36e305d4 100644
--- a/compiler/bin-wasm_of_ocaml/link.ml
+++ b/compiler/bin-wasm_of_ocaml/link.ml
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/link.mli b/compiler/bin-wasm_of_ocaml/link.mli
index 969933f7a7..952975461c 100644
--- a/compiler/bin-wasm_of_ocaml/link.mli
+++ b/compiler/bin-wasm_of_ocaml/link.mli
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
index 1ea4787d2d..1c4ceec3fb 100644
--- a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
+++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
@@ -1,7 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wams_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2010 Jérôme Vouillon
- * Laboratoire PPS - CNRS Université Paris Diderot
  *
  * 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
diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli
index a96ea76350..cc6700682b 100644
--- a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli
+++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.mli
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2020 Hugo Heuzard
  *
  * 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
diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 86114426e6..86d705066a 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 
 module PP : sig
diff --git a/compiler/lib/wasm/wa_asm_output.mli b/compiler/lib/wasm/wa_asm_output.mli
index 59f2b93d9a..3a2fc50a10 100644
--- a/compiler/lib/wasm/wa_asm_output.mli
+++ b/compiler/lib/wasm/wa_asm_output.mli
@@ -1 +1,19 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val f : out_channel -> Wa_ast.module_field list -> unit
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 093238f2f2..8aded1dd6e 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type var = Code.Var.t
 
 type symbol =
diff --git a/compiler/lib/wasm/wa_binaryen.ml b/compiler/lib/wasm/wa_binaryen.ml
index 15d32dccd0..551c3a11bc 100644
--- a/compiler/lib/wasm/wa_binaryen.ml
+++ b/compiler/lib/wasm/wa_binaryen.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open Stdlib
 
 let debug = Debug.find "binaryen"
diff --git a/compiler/lib/wasm/wa_binaryen.mli b/compiler/lib/wasm/wa_binaryen.mli
index e08899a3bf..473d2cbcfc 100644
--- a/compiler/lib/wasm/wa_binaryen.mli
+++ b/compiler/lib/wasm/wa_binaryen.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val link :
      runtime_files:string list
   -> input_files:string list
diff --git a/compiler/lib/wasm/wa_closure_conversion.ml b/compiler/lib/wasm/wa_closure_conversion.ml
index 7ba591e928..38bb7fc9b3 100644
--- a/compiler/lib/wasm/wa_closure_conversion.ml
+++ b/compiler/lib/wasm/wa_closure_conversion.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 open Code
 
diff --git a/compiler/lib/wasm/wa_closure_conversion.mli b/compiler/lib/wasm/wa_closure_conversion.mli
index 3e97d0eff5..41a5e0642c 100644
--- a/compiler/lib/wasm/wa_closure_conversion.mli
+++ b/compiler/lib/wasm/wa_closure_conversion.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type closure =
   { functions : (Code.Var.t * int) list
   ; free_variables : Code.Var.t list
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index e6aa0b3e22..293de76d0b 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 open Code
 module W = Wa_ast
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 848e5ea60b..d83649c819 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open Stdlib
 
 type constant_global
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 0db0786ae4..762a1d979d 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 module W = Wa_ast
 open Wa_code_generation
diff --git a/compiler/lib/wasm/wa_core_target.mli b/compiler/lib/wasm/wa_core_target.mli
index 97ae000338..e44faa1a1f 100644
--- a/compiler/lib/wasm/wa_core_target.mli
+++ b/compiler/lib/wasm/wa_core_target.mli
@@ -1 +1,19 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 include Wa_target_sig.S
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index b86948ad0d..f3640b3b49 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 open Code
 module W = Wa_ast
diff --git a/compiler/lib/wasm/wa_curry.mli b/compiler/lib/wasm/wa_curry.mli
index c76a44afdb..35fa39b1d3 100644
--- a/compiler/lib/wasm/wa_curry.mli
+++ b/compiler/lib/wasm/wa_curry.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 module Make (_ : Wa_target_sig.S) : sig
   val f : context:Wa_code_generation.context -> unit
 end
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index d2a3da1f5d..156f9f5461 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 module W = Wa_ast
 open Wa_code_generation
diff --git a/compiler/lib/wasm/wa_gc_target.mli b/compiler/lib/wasm/wa_gc_target.mli
index 97ae000338..e44faa1a1f 100644
--- a/compiler/lib/wasm/wa_gc_target.mli
+++ b/compiler/lib/wasm/wa_gc_target.mli
@@ -1 +1,19 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 include Wa_target_sig.S
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index c860a82261..6eb088ad7b 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 open Code
 module W = Wa_ast
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index 0ff7c7d782..83f49d6627 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val init : unit -> unit
 
 val start : unit -> Wa_code_generation.context
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib/wasm/wa_globalize.ml
index 6bac837663..8f78ef4208 100644
--- a/compiler/lib/wasm/wa_globalize.ml
+++ b/compiler/lib/wasm/wa_globalize.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 (*
 
 Store some toplevel values into globals. Any variable which is used a
diff --git a/compiler/lib/wasm/wa_globalize.mli b/compiler/lib/wasm/wa_globalize.mli
index 53616b683e..9819b18f4e 100644
--- a/compiler/lib/wasm/wa_globalize.mli
+++ b/compiler/lib/wasm/wa_globalize.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val f :
      Code.program
   -> Wa_structure.control_flow_graph
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
index b638f1aa1d..50c99ae309 100644
--- a/compiler/lib/wasm/wa_initialize_locals.ml
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open Stdlib
 
 type ctx =
diff --git a/compiler/lib/wasm/wa_initialize_locals.mli b/compiler/lib/wasm/wa_initialize_locals.mli
index d3a89de191..3d464e4dfc 100644
--- a/compiler/lib/wasm/wa_initialize_locals.mli
+++ b/compiler/lib/wasm/wa_initialize_locals.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val f :
      param_names:Wa_ast.var list
   -> locals:(Wa_ast.var * Wa_ast.value_type) list
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 7b4b1c9dbe..ab568b2941 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2017 Hugo Heuzard
  *
  * 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
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index 3601efcc83..a54bc14903 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -1,6 +1,5 @@
-(* Js_of_ocaml compiler
+(* Wasm_of_ocaml compiler
  * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2017 Hugo Heuzard
  *
  * 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
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
index ab54e955d4..7842664242 100644
--- a/compiler/lib/wasm/wa_liveness.ml
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 (*
 ZZZ If live in exception handler, live any place we may raise in the body
 *)
diff --git a/compiler/lib/wasm/wa_liveness.mli b/compiler/lib/wasm/wa_liveness.mli
index 6e4b5ed946..e6f7e3d2f2 100644
--- a/compiler/lib/wasm/wa_liveness.mli
+++ b/compiler/lib/wasm/wa_liveness.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type block_info =
   { initially_live : Code.Var.Set.t (* Live at start of block *)
   ; live_before_branch : Code.Var.Set.t
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
index bb7a95c5fa..441d23326d 100644
--- a/compiler/lib/wasm/wa_spilling.ml
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 (*
 We add spilling points at the end of each block and before each
 possible GC: function calls and allocations. Local variables are
diff --git a/compiler/lib/wasm/wa_spilling.mli b/compiler/lib/wasm/wa_spilling.mli
index 65cee35222..5c4ac9db86 100644
--- a/compiler/lib/wasm/wa_spilling.mli
+++ b/compiler/lib/wasm/wa_spilling.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 (*
 type stack = Code.Var.t option list
 
diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
index ae64646cac..80ea1e567a 100644
--- a/compiler/lib/wasm/wa_structure.ml
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open Stdlib
 open Code
 
diff --git a/compiler/lib/wasm/wa_structure.mli b/compiler/lib/wasm/wa_structure.mli
index 0f0a0de7c0..53be40e9da 100644
--- a/compiler/lib/wasm/wa_structure.mli
+++ b/compiler/lib/wasm/wa_structure.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type graph
 
 val get_edges : graph -> Code.Addr.t -> Code.Addr.Set.t
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index a05d53ac78..b0c1a40c82 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 
 let rec get_return ~tail i =
diff --git a/compiler/lib/wasm/wa_tail_call.mli b/compiler/lib/wasm/wa_tail_call.mli
index 2c65525ff5..61143cb283 100644
--- a/compiler/lib/wasm/wa_tail_call.mli
+++ b/compiler/lib/wasm/wa_tail_call.mli
@@ -1 +1,19 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val f : Wa_ast.instruction list -> Wa_ast.instruction list
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 8dabb7df31..e5f221e881 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 module type S = sig
   type expression = Wa_code_generation.expression
 
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 39667eaeba..d63e733a00 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 open Wa_ast
 
diff --git a/compiler/lib/wasm/wa_wat_output.mli b/compiler/lib/wasm/wa_wat_output.mli
index 537798744e..b589af12b2 100644
--- a/compiler/lib/wasm/wa_wat_output.mli
+++ b/compiler/lib/wasm/wa_wat_output.mli
@@ -1 +1,19 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val f : debug:Parse_bytecode.Debug.t -> out_channel -> Wa_ast.module_field list -> unit
diff --git a/compiler/lib/wasm/zip.ml b/compiler/lib/wasm/zip.ml
index 0479f96ba7..916ca7ef3b 100644
--- a/compiler/lib/wasm/zip.ml
+++ b/compiler/lib/wasm/zip.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 let stdlib_close_out = close_out
 
 open Stdlib
diff --git a/compiler/lib/wasm/zip.mli b/compiler/lib/wasm/zip.mli
index bf65cc5390..111bb42a4f 100644
--- a/compiler/lib/wasm/zip.mli
+++ b/compiler/lib/wasm/zip.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type output
 
 val open_out : string -> output
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index 311a2cb9b5..b33396f5b4 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat
index 33a2c962b7..ea4d0e46aa 100644
--- a/runtime/wasm/backtrace.wat
+++ b/runtime/wasm/backtrace.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index a8c1683704..0baf91f922 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "bindings" "ta_create"
       (func $ta_create (param i32) (param i32) (result (ref extern))))
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 549a9fb742..0d6a5f87f0 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat
index f81a30745f..affa2a2765 100644
--- a/runtime/wasm/compare.wat
+++ b/runtime/wasm/compare.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "bindings" "equals"
       (func $equals (param anyref) (param anyref) (result i32)))
diff --git a/runtime/wasm/custom.wat b/runtime/wasm/custom.wat
index 808e055048..4d48e9e075 100644
--- a/runtime/wasm/custom.wat
+++ b/runtime/wasm/custom.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "int32" "int32_ops" (global $int32_ops (ref $custom_operations)))
    (import "int32" "nativeint_ops"
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index 80b31ca773..169f9d9aba 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (type $block (array (mut (ref eq))))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
diff --git a/runtime/wasm/dynlink.wat b/runtime/wasm/dynlink.wat
index fca3f1bec4..45c68b3314 100644
--- a/runtime/wasm/dynlink.wat
+++ b/runtime/wasm/dynlink.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "log_str" (func $log_str (param (ref $string))))
 
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 0e3470e817..cbc35f3826 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_raise_constant"
       (func $caml_raise_constant (param (ref eq))))
diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat
index 0dc30649bb..e3dc000d55 100644
--- a/runtime/wasm/fail.wat
+++ b/runtime/wasm/fail.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "stdlib" "caml_global_data"
       (global $caml_global_data (mut (ref $block))))
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index ab1d6e2957..04e7e3bb5e 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "bindings" "format_float"
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index d1653ea7f7..cb0c50bde5 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "bindings" "getcwd" (func $getcwd (result anyref)))
diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat
index f8452f92bc..01d873cc10 100644
--- a/runtime/wasm/gc.wat
+++ b/runtime/wasm/gc.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (type $float (struct (field f64)))
    (type $block (array (mut (ref eq))))
diff --git a/runtime/wasm/hash.wat b/runtime/wasm/hash.wat
index 7aa9965b30..543df44919 100644
--- a/runtime/wasm/hash.wat
+++ b/runtime/wasm/hash.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "obj" "object_tag" (global $object_tag i32))
    (import "obj" "forward_tag" (global $forward_tag i32))
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index eb4dad94eb..6a56cbb312 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "ints" "parse_int"
       (func $parse_int
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 2d4b632c28..102b7d176b 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "ints" "parse_sign_and_base"
diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat
index 2ba2c5592a..1744e733f7 100644
--- a/runtime/wasm/ints.wat
+++ b/runtime/wasm/ints.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "fail" "caml_invalid_argument"
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 1115bf2323..01fd089fc2 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "fail" "caml_raise_end_of_file" (func $caml_raise_end_of_file))
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 8cdb041d11..187db76777 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "bindings" "log" (func $log_js (param anyref)))
    (import "bindings" "identity" (func $to_float (param anyref) (result f64)))
diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat
index a77ecb2f6a..7c3b161c77 100644
--- a/runtime/wasm/jslib_js_of_ocaml.wat
+++ b/runtime/wasm/jslib_js_of_ocaml.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
index 758f0ae084..9e4efd01fa 100644
--- a/runtime/wasm/jsstring.wat
+++ b/runtime/wasm/jsstring.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "wasm:js-string" "compare"
       (func $compare_strings (param externref externref) (result i32)))
diff --git a/runtime/wasm/lexing.wat b/runtime/wasm/lexing.wat
index 03e2c37891..eb9b94b1ad 100644
--- a/runtime/wasm/lexing.wat
+++ b/runtime/wasm/lexing.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
 
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 7494992391..491d843854 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "fail" "caml_invalid_argument"
diff --git a/runtime/wasm/md5.wat b/runtime/wasm/md5.wat
index e3ec9a54e1..76bb4a389c 100644
--- a/runtime/wasm/md5.wat
+++ b/runtime/wasm/md5.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "io" "caml_getblock"
       (func $caml_getblock
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index 9cdffaab6d..30eae1d8f2 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "custom" "caml_register_custom_operations"
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 402028e983..8c08e38124 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "custom" "caml_is_custom"
diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat
index d9b458e5c4..f0fe757a8b 100644
--- a/runtime/wasm/parsing.wat
+++ b/runtime/wasm/parsing.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "caml_string_of_jsstring"
diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat
index 915a2d031f..84b616829d 100644
--- a/runtime/wasm/printexc.wat
+++ b/runtime/wasm/printexc.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
    (import "jslib" "caml_jsstring_of_string"
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index d0984ad795..082a7b1bf3 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "int64" "caml_copy_int64"
       (func $caml_copy_int64 (param i64) (result (ref eq))))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index cfdb0ca6f5..ad25d118c9 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -1,3 +1,20 @@
+// Wasm_of_ocaml runtime support
+// http://www.ocsigen.org/js_of_ocaml/
+//
+// 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, with linking exception;
+// either version 2.1 of the License, or (at your option) any 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.
+
 ((js) => async (args) => {
     "use strict";
     let {link, src, generated} = args;
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index 1f51b95ed3..add57ec6d8 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "hash" "caml_string_hash"
       (func $caml_string_hash
diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat
index 10d8ccdccb..4fa9409ee7 100644
--- a/runtime/wasm/str.wat
+++ b/runtime/wasm/str.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param (ref eq))))
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 7ea971844d..1f41937bd5 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_bound_error" (func $caml_bound_error))
    (import "fail" "caml_invalid_argument"
diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat
index 056c4a4bfc..cd14209dd1 100644
--- a/runtime/wasm/sync.wat
+++ b/runtime/wasm/sync.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
    (import "custom" "custom_compare_id"
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 8fba4c08ad..167c182600 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "bindings" "ta_length"
       (func $ta_length (param (ref extern)) (result i32)))
diff --git a/runtime/wasm/toplevel.wat b/runtime/wasm/toplevel.wat
index d103fd5c34..c187ff9eb0 100644
--- a/runtime/wasm/toplevel.wat
+++ b/runtime/wasm/toplevel.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (func (export "caml_terminfo_rows")
       (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat
index bf47dfcde4..797a3b3f3f 100644
--- a/runtime/wasm/unix.wat
+++ b/runtime/wasm/unix.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "bindings" "gettimeofday" (func $gettimeofday (result f64)))
    (import "bindings" "gmtime" (func $gmtime (param f64) (result (ref eq))))
diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat
index c1b60acafe..5b54df26e0 100644
--- a/runtime/wasm/weak.wat
+++ b/runtime/wasm/weak.wat
@@ -1,3 +1,20 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
 (module
    (import "obj" "abstract_tag" (global $abstract_tag i32))
    (import "obj" "caml_obj_dup"

From 0f7baaa5ba33dca3f9e5d02d827d3d037315a7f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 6 Jul 2024 11:52:21 +0200
Subject: [PATCH 264/481] Runtime: systematically use array.get_u rather
 array.get for strings

This does not make any difference with binaryen which conflated both,
but the spec mandates the former.
---
 runtime/wasm/bigstring.wat | 2 +-
 runtime/wasm/float.wat     | 2 +-
 runtime/wasm/parsing.wat   | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 549a9fb742..4f83f7b769 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -158,7 +158,7 @@
                   (call $ta_get_ui8 (local.get $d1)
                      (i32.add (local.get $pos1) (local.get $i))))
                (local.set $c2
-                  (array.get $string (local.get $s2)
+                  (array.get_u $string (local.get $s2)
                      (i32.add (local.get $pos2) (local.get $i))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br_if $loop (i32.eq (local.get $c1) (local.get $c2)))
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index ab1d6e2957..f143402e7f 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -509,7 +509,7 @@
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
                (if (i32.eq (i32.const 32) ;; ' '
-                           (array.get $string (local.get $s) (local.get $i)))
+                           (array.get_u $string (local.get $s) (local.get $i)))
                   (then
                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
                      (br $skip_spaces))))))
diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat
index d9b458e5c4..fbd4706d3a 100644
--- a/runtime/wasm/parsing.wat
+++ b/runtime/wasm/parsing.wat
@@ -92,7 +92,7 @@
       (local $i i32)
       (local.set $i (local.get $p))
       (loop $loop
-         (if (i32.ne (array.get $string (local.get $s) (local.get $i))
+         (if (i32.ne (array.get_u $string (local.get $s) (local.get $i))
                (i32.const 0))
             (then
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
@@ -106,7 +106,7 @@
       (local $name (ref $string))
       (local.set $names (ref.cast (ref $string) (local.get $vnames)))
       (loop $loop
-         (if (i32.eqz (array.get $string (local.get $names) (local.get $i)))
+         (if (i32.eqz (array.get_u $string (local.get $names) (local.get $i)))
             (then
                (return
                   (array.new_data $string $unknown_token

From 8b6a2163b713909fd1a48c670b54b6bf09be93f6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 6 Jul 2024 11:55:16 +0200
Subject: [PATCH 265/481] Add a warning when generating source maps if there is
 no debugging information

---
 compiler/bin-wasm_of_ocaml/compile.ml | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index b91be415cf..186730c8c1 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -262,7 +262,20 @@ let run
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
   let need_debug = enable_source_maps || Config.Flag.debuginfo () in
+  let check_debug (one : Parse_bytecode.one) =
+    if (not runtime_only)
+       && enable_source_maps
+       && Parse_bytecode.Debug.is_empty one.debug
+       && not (Code.is_empty one.code)
+    then
+      warn
+        "Warning: '--source-map' is enabled but the bytecode program was compiled with \
+         no debugging information.\n\
+         Warning: Consider passing '-g' option to ocamlc.\n\
+         %!"
+  in
   let output (one : Parse_bytecode.one) ~unit_name ch =
+    check_debug one;
     let code = one.code in
     let standalone = Option.is_none unit_name in
     let live_vars, in_cps, p, debug =

From 83b7c68ed720ab790ecf3aa7a674e67d6f10a3e2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 6 Jul 2024 14:01:05 +0200
Subject: [PATCH 266/481] Reduce constant string threshold

dune-build-info use a 64-byte placeholder. This ensures that such
strings are encoded as a sequence of bytes in the wasm module.
---
 compiler/lib/wasm/wa_gc_target.ml | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index d2a3da1f5d..fcb1930ef3 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -890,7 +890,9 @@ module Memory = struct
 end
 
 module Constant = struct
-  let string_length_threshold = 100
+  (* dune-build-info use a 64-byte placeholder. This ensures that such
+     strings are encoded as a sequence of bytes in the wasm module. *)
+  let string_length_threshold = 64
 
   let store_in_global ?(name = "const") c =
     let name = Code.Var.fresh_n name in
@@ -991,7 +993,7 @@ module Constant = struct
         return (Const_named ("str_" ^ s), W.StructNew (ty, [ GlobalGet (V x) ]))
     | String s ->
         let* ty = Type.string_type in
-        if String.length s > string_length_threshold
+        if String.length s >= string_length_threshold
         then
           let name = Code.Var.fresh_n "string" in
           let* () = register_data_segment name ~active:false [ DataBytes s ] in

From d5e9b955a67829de35d1f03180c0be524ac091f6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 16 Jul 2024 14:29:49 +0200
Subject: [PATCH 267/481] Switch to Binaryen 118

---
 .github/workflows/build-wasm_of_ocaml.yml | 8 ++++----
 README.md                                 | 4 ++--
 runtime/wasm/dune                         | 2 +-
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index a2138d7ba9..81fd5c5854 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -31,14 +31,14 @@ jobs:
       - name: Install node
         uses: actions/setup-node@v4
         with:
-          node-version: v22.0.0-v8-canary2024030314ed92e804
+          node-version: 22
 
       - name: Restore cached binaryen
         id: cache-binaryen
         uses: actions/cache/restore@v4
         with:
           path: binaryen
-          key: ${{ runner.os }}-binaryen-version_117
+          key: ${{ runner.os }}-binaryen-version_118
 
       - name: Checkout binaryen
         if: steps.cache-binaryen.outputs.cache-hit != 'true'
@@ -47,7 +47,7 @@ jobs:
           repository: WebAssembly/binaryen
           path: binaryen
           submodules: true
-          ref: version_117
+          ref: version_118
 
       - name: Install ninja
         if: steps.cache-binaryen.outputs.cache-hit != 'true'
@@ -65,7 +65,7 @@ jobs:
         uses: actions/cache/save@v4
         with:
           path: binaryen
-          key: ${{ runner.os }}-binaryen-version_117
+          key: ${{ runner.os }}-binaryen-version_118
 
       - name: Set binaryen's path
         run: |
diff --git a/README.md b/README.md
index bd18d1a83a..0bacdc5e9d 100644
--- a/README.md
+++ b/README.md
@@ -4,11 +4,11 @@ Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssem
 
 ## Requirements
 
-Wasm_of_ocaml relies on the Binaryen toolchain; currently, only [version 117](https://github.com/WebAssembly/binaryen/releases/tag/version_117) is supported. Binaryen commands must be in the PATH for wasm_of_ocaml to function.
+Wasm_of_ocaml relies on the Binaryen toolchain; currently, only versions [118](https://github.com/WebAssembly/binaryen/releases/tag/version_118) or greater are supported. Binaryen commands must be in the PATH for wasm_of_ocaml to function.
 
 ## Supported engines
 
-The generated code works with Chrome 11.9, [node V8 canary](https://nodejs.org/download/v8-canary/v21.0.0-v8-canary20230927fa59f85d60/) and [Firefox 122](https://www.mozilla.org/en-US/firefox/new/).
+The generated code works with Chrome 11.9, Node.js 22 and Firefox 122 (or more recent versions of these applications).
 
 In particular, the output code requires the following [Wasm extensions](https://webassembly.org/roadmap/) to run:
 - [the GC extension](https://github.com/WebAssembly/gc), including functional references and 31-bit integers
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index c06d2915c3..bbba4609e6 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -13,7 +13,7 @@
    (system
     "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
    (system
-    "wasm-merge --version | grep -q 'version 117' || (echo 'Error: Binaryen version 117 is currently required'; false)")
+    "wasm-merge --version | grep -q 'version \\(11[789]\\|1[2-9][0-9]\\)' || (echo 'Error: Binaryen version 117 or greater is currently required'; false)")
    (pipe-stdout
     (run
      wasm-merge

From 074be74c2cae16db2874d29d6527d7fe57786db0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 17 Jul 2024 18:10:28 +0200
Subject: [PATCH 268/481] Runtime: rename deprecated instruction i31.new

---
 runtime/wasm/float.wat | 2 +-
 runtime/wasm/nat.wat   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index f01de24048..4705b04c98 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -658,7 +658,7 @@
          (return (struct.new $float (local.get $f))))
       (call $caml_failwith
          (array.new_data $string $float_of_string (i32.const 0) (i32.const 15)))
-      (return (i31.new (i32.const 0))))
+      (return (ref.i31 (i32.const 0))))
 
    (func (export "caml_nextafter_float")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index 30eae1d8f2..71719a9d62 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -382,7 +382,7 @@
          (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
          (local.set $ofs1 (i32.add (local.get $ofs1) (i32.const 1)))
          (if (local.get $len1) (then (br $loop))))
-      (i31.new (i32.const 1)))
+      (ref.i31 (i32.const 1)))
 
    (data $mult_nat "mult_nat")
 

From da3a0b23fec6fbaa556311721da424b99382b0f7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 17 Apr 2024 15:37:28 +0200
Subject: [PATCH 269/481] Revert "Hack to make binaryen eliminate redundant
 casts"

This reverts commit 25315fb4d3231ecd0fdc07c57adec59f3e697dc3.

No longer useful with https://github.com/WebAssembly/binaryen/pull/6507
---
 compiler/lib/wasm/wa_gc_target.ml | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 8eea84e090..67bb57cdac 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -616,13 +616,7 @@ end
 module Memory = struct
   let wasm_cast ty e =
     let* e = e in
-    match e with
-    | W.LocalGet x ->
-        return
-          (W.RefCast
-             ( { nullable = false; typ = Type ty }
-             , W.LocalTee (x, W.RefCast ({ nullable = false; typ = Type ty }, e)) ))
-    | _ -> return (W.RefCast ({ nullable = false; typ = Type ty }, e))
+    return (W.RefCast ({ nullable = false; typ = Type ty }, e))
 
   let wasm_struct_get ty e i =
     let* e = e in

From 1f38221077ef061156cd483eaa726bb3036c79b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 19 Jul 2024 13:46:47 +0200
Subject: [PATCH 270/481] Wa_link: clean-up

---
 compiler/lib/wasm/wa_link.ml | 260 +++++++++++++++++------------------
 1 file changed, 128 insertions(+), 132 deletions(-)

diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index ab568b2941..0c4efbc9ce 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -586,143 +586,139 @@ let load_information files =
                file, (build_info, unit_data)) )
 
 let link ~output_file ~linkall ~enable_source_maps ~files =
-  let rec loop n =
-    if times () then Format.eprintf "linking@.";
-    let t = Timer.make () in
-    let predefined_exceptions, files = load_information files in
-    (match files with
-    | [] -> assert false
-    | (file, (bi, _)) :: r ->
-        (match Build_info.kind bi with
-        | `Runtime -> ()
-        | _ ->
-            failwith
-              "The first input file should be a runtime built using 'wasm_of_ocaml \
-               build-runtime'.");
-        Build_info.configure bi;
-        ignore
-          (List.fold_left
-             ~init:bi
-             ~f:(fun bi (file', (bi', _)) ->
-               (match Build_info.kind bi' with
-               | `Runtime ->
-                   failwith "The runtime file should be listed first on the command line."
-               | _ -> ());
-               Build_info.merge file bi file' bi')
-             r));
-    if times () then Format.eprintf "    reading information: %a@." Timer.print t;
-    let t1 = Timer.make () in
-    let missing, to_link =
-      List.fold_right
+  if times () then Format.eprintf "linking@.";
+  let t = Timer.make () in
+  let predefined_exceptions, files = load_information files in
+  (match files with
+  | [] -> assert false
+  | (file, (bi, _)) :: r ->
+      (match Build_info.kind bi with
+      | `Runtime -> ()
+      | _ ->
+          failwith
+            "The first input file should be a runtime built using 'wasm_of_ocaml \
+             build-runtime'.");
+      Build_info.configure bi;
+      ignore
+        (List.fold_left
+           ~init:bi
+           ~f:(fun bi (file', (bi', _)) ->
+             (match Build_info.kind bi' with
+             | `Runtime ->
+                 failwith "The runtime file should be listed first on the command line."
+             | _ -> ());
+             Build_info.merge file bi file' bi')
+           r));
+  if times () then Format.eprintf "    reading information: %a@." Timer.print t;
+  let t1 = Timer.make () in
+  let missing, to_link =
+    List.fold_right
+      files
+      ~init:(StringSet.empty, [])
+      ~f:(fun (_file, (build_info, units)) acc ->
+        let cmo_file =
+          match Build_info.kind build_info with
+          | `Cmo -> true
+          | `Cma | `Exe | `Runtime | `Unknown -> false
+        in
+        List.fold_right units ~init:acc ~f:(fun { unit_info; _ } (requires, to_link) ->
+            if (not (Config.Flag.auto_link ()))
+               || cmo_file
+               || linkall
+               || unit_info.force_link
+               || not (StringSet.is_empty (StringSet.inter requires unit_info.provides))
+            then
+              ( StringSet.diff
+                  (StringSet.union unit_info.requires requires)
+                  unit_info.provides
+              , StringSet.elements unit_info.provides @ to_link )
+            else requires, to_link))
+  in
+  let set_to_link = StringSet.of_list to_link in
+  let files =
+    if linkall
+    then files
+    else
+      List.filter
+        ~f:(fun (_file, (build_info, units)) ->
+          (match Build_info.kind build_info with
+          | `Cma | `Exe | `Unknown -> false
+          | `Cmo | `Runtime -> true)
+          || List.exists
+               ~f:(fun { unit_info; _ } ->
+                 StringSet.exists
+                   (fun nm -> StringSet.mem nm set_to_link)
+                   unit_info.provides)
+               units)
         files
-        ~init:(StringSet.empty, [])
-        ~f:(fun (_file, (build_info, units)) acc ->
-          let cmo_file =
-            match Build_info.kind build_info with
-            | `Cmo -> true
-            | `Cma | `Exe | `Runtime | `Unknown -> false
-          in
-          List.fold_right units ~init:acc ~f:(fun { unit_info; _ } (requires, to_link) ->
-              if (not (Config.Flag.auto_link ()))
-                 || cmo_file
-                 || linkall
-                 || unit_info.force_link
-                 || not (StringSet.is_empty (StringSet.inter requires unit_info.provides))
-              then
-                ( StringSet.diff
-                    (StringSet.union unit_info.requires requires)
-                    unit_info.provides
-                , StringSet.elements unit_info.provides @ to_link )
-              else requires, to_link))
-    in
-    let set_to_link = StringSet.of_list to_link in
-    let files =
-      if linkall
-      then files
-      else
-        List.filter
-          ~f:(fun (_file, (build_info, units)) ->
-            (match Build_info.kind build_info with
-            | `Cma | `Exe | `Unknown -> false
-            | `Cmo | `Runtime -> true)
-            || List.exists
-                 ~f:(fun { unit_info; _ } ->
-                   StringSet.exists
-                     (fun nm -> StringSet.mem nm set_to_link)
-                     unit_info.provides)
-                 units)
-          files
-    in
-    let missing = StringSet.diff missing predefined_exceptions in
-    if not (StringSet.is_empty missing)
-    then
-      failwith
-        (Printf.sprintf
-           "Could not find compilation unit for %s"
-           (String.concat ~sep:", " (StringSet.elements missing)));
-    if times () then Format.eprintf "    finding what to link: %a@." Timer.print t1;
-    if times () then Format.eprintf "  scan: %a@." Timer.print t;
-    let t = Timer.make () in
-    let interfaces, wasm_file, link_spec =
-      let dir = Filename.chop_extension output_file ^ ".assets" in
-      Fs.gen_file dir
-      @@ fun tmp_dir ->
-      Sys.mkdir tmp_dir 0o777;
-      let start_module =
-        "start-"
-        ^ String.sub
-            (Digest.to_hex (Digest.string (String.concat ~sep:"/" to_link)))
-            ~pos:0
-            ~len:8
-      in
-      generate_start_function
-        ~to_link
-        ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm"));
-      let module_names, interfaces =
-        link_to_directory ~set_to_link ~files ~enable_source_maps ~dir:tmp_dir
-      in
-      ( interfaces
-      , dir
-      , let to_link = compute_dependencies ~set_to_link ~files in
-        List.combine module_names (None :: None :: to_link) @ [ start_module, None ] )
-    in
-    let missing_primitives = compute_missing_primitives interfaces in
-    if times () then Format.eprintf "    copy wasm files: %a@." Timer.print t;
-    let t1 = Timer.make () in
-    let js_runtime =
-      match files with
-      | (file, _) :: _ ->
-          Zip.with_open_in file (fun z -> Zip.read_entry z ~name:"runtime.js")
-      | _ -> assert false
+  in
+  let missing = StringSet.diff missing predefined_exceptions in
+  if not (StringSet.is_empty missing)
+  then
+    failwith
+      (Printf.sprintf
+         "Could not find compilation unit for %s"
+         (String.concat ~sep:", " (StringSet.elements missing)));
+  if times () then Format.eprintf "    finding what to link: %a@." Timer.print t1;
+  if times () then Format.eprintf "  scan: %a@." Timer.print t;
+  let t = Timer.make () in
+  let interfaces, wasm_file, link_spec =
+    let dir = Filename.chop_extension output_file ^ ".assets" in
+    Fs.gen_file dir
+    @@ fun tmp_dir ->
+    Sys.mkdir tmp_dir 0o777;
+    let start_module =
+      "start-"
+      ^ String.sub
+          (Digest.to_hex (Digest.string (String.concat ~sep:"/" to_link)))
+          ~pos:0
+          ~len:8
     in
-    let generated_js =
-      List.concat
-      @@ List.map files ~f:(fun (_, (_, units)) ->
-             List.map units ~f:(fun { unit_info; strings; fragments } ->
-                 Some (StringSet.choose unit_info.provides), (strings, fragments)))
+    generate_start_function
+      ~to_link
+      ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm"));
+    let module_names, interfaces =
+      link_to_directory ~set_to_link ~files ~enable_source_maps ~dir:tmp_dir
     in
-    let runtime_args =
-      let js =
-        build_runtime_arguments
-          ~link_spec
-          ~separate_compilation:true
-          ~missing_primitives
-          ~wasm_file
-          ~generated_js
-          ()
-      in
-      output_js [ Javascript.Expression_statement js, Javascript.N ]
+    ( interfaces
+    , dir
+    , let to_link = compute_dependencies ~set_to_link ~files in
+      List.combine module_names (None :: None :: to_link) @ [ start_module, None ] )
+  in
+  let missing_primitives = compute_missing_primitives interfaces in
+  if times () then Format.eprintf "    copy wasm files: %a@." Timer.print t;
+  let t1 = Timer.make () in
+  let js_runtime =
+    match files with
+    | (file, _) :: _ ->
+        Zip.with_open_in file (fun z -> Zip.read_entry z ~name:"runtime.js")
+    | _ -> assert false
+  in
+  let generated_js =
+    List.concat
+    @@ List.map files ~f:(fun (_, (_, units)) ->
+           List.map units ~f:(fun { unit_info; strings; fragments } ->
+               Some (StringSet.choose unit_info.provides), (strings, fragments)))
+  in
+  let runtime_args =
+    let js =
+      build_runtime_arguments
+        ~link_spec
+        ~separate_compilation:true
+        ~missing_primitives
+        ~wasm_file
+        ~generated_js
+        ()
     in
-    Fs.gen_file output_file
-    @@ fun tmp_output_file ->
-    Fs.write_file
-      ~name:tmp_output_file
-      ~contents:(trim_semi js_runtime ^ "\n" ^ runtime_args);
-    if times () then Format.eprintf "    build JS runtime: %a@." Timer.print t1;
-    if times () then Format.eprintf "  emit: %a@." Timer.print t;
-    if n > 0 then loop (n - 1)
+    output_js [ Javascript.Expression_statement js, Javascript.N ]
   in
-  loop 0
+  Fs.gen_file output_file
+  @@ fun tmp_output_file ->
+  Fs.write_file
+    ~name:tmp_output_file
+    ~contents:(trim_semi js_runtime ^ "\n" ^ runtime_args);
+  if times () then Format.eprintf "    build JS runtime: %a@." Timer.print t1;
+  if times () then Format.eprintf "  emit: %a@." Timer.print t
 
 let link ~output_file ~linkall ~enable_source_maps ~files =
   try link ~output_file ~linkall ~enable_source_maps ~files

From 3ef1effa8a1e2b661733ec8c2a63f0c2e52332b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 16 Jul 2024 14:29:49 +0200
Subject: [PATCH 271/481] Enforce Binaryen 118 or greater

---
 runtime/wasm/dune | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index bbba4609e6..2923b1ac9f 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -13,7 +13,7 @@
    (system
     "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
    (system
-    "wasm-merge --version | grep -q 'version \\(11[789]\\|1[2-9][0-9]\\)' || (echo 'Error: Binaryen version 117 or greater is currently required'; false)")
+    "wasm-merge --version | grep -q 'version \\(11[89]\\|1[2-9][0-9]\\)' || (echo 'Error: Binaryen version 118 or greater is currently required'; false)")
    (pipe-stdout
     (run
      wasm-merge

From 7cc2831279778610abf33def954a690aed291a3c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 16 Jul 2024 14:35:32 +0200
Subject: [PATCH 272/481] Rename conversion instructions
 extern.{in,ex}ternalize

---
 runtime/wasm/bigarray.wat |  6 +++---
 runtime/wasm/jslib.wat    | 16 ++++++++--------
 runtime/wasm/jsstring.wat | 10 +++++-----
 runtime/wasm/sys.wat      |  2 +-
 4 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 0baf91f922..bcffa35710 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -752,7 +752,7 @@
       (local $len i32)
       (local.set $data
          (call $ta_normalize
-            (ref.as_non_null (extern.externalize (call $unwrap (local.get 0))))))
+            (ref.as_non_null (extern.convert_any (call $unwrap (local.get 0))))))
       (local.set $kind (call $ta_kind (local.get $data)))
       (if (i32.lt_s (local.get $kind) (i32.const 0))
          (then
@@ -777,7 +777,7 @@
 
    (func (export "caml_ba_to_typed_array") (param (ref eq)) (result (ref eq))
       (call $wrap
-         (extern.internalize
+         (any.convert_extern
             (struct.get $bigarray $ba_data
                (ref.cast (ref $bigarray) (local.get 0))))))
 
@@ -2102,7 +2102,7 @@
       (local $a (ref extern)) (local $len i32) (local $i i32)
       (local $s (ref $string))
       (local.set $a
-         (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
+         (ref.as_non_null (extern.convert_any (call $unwrap (local.get 0)))))
       (local.set $len (call $ta_length (local.get $a)))
       (local.set $s (array.new $string (i32.const 0) (local.get $len)))
       (loop $loop
diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
index 187db76777..b4468e8dea 100644
--- a/runtime/wasm/jslib.wat
+++ b/runtime/wasm/jslib.wat
@@ -199,7 +199,7 @@
             (local.set 1 (call $caml_jsbytes_of_string (local.get 1)))))
       (return_call $wrap
          (call $get
-            (ref.as_non_null (extern.externalize (call $unwrap (local.get 0))))
+            (ref.as_non_null (extern.convert_any (call $unwrap (local.get 0))))
             (call $unwrap (local.get 1)))))
 
    (func (export "caml_js_set")
@@ -291,7 +291,7 @@
                                       (i32.add (local.get $i) (i32.const 1)))))
                   (local.set $i (i32.add (local.get $i) (i32.const 1)))
                   (br $loop))))
-         (return (struct.new $js (extern.internalize (local.get $a'))))))
+         (return (struct.new $js (any.convert_extern (local.get $a'))))))
      (local.set $fa (ref.cast (ref $float_array) (local.get $va)))
      (local.set $l (array.len (local.get $fa)))
      (local.set $a' (call $new_array (local.get $l)))
@@ -304,7 +304,7 @@
                     (array.get $float_array (local.get $fa) (local.get $i))))
               (local.set $i (i32.add (local.get $i) (i32.const 1)))
               (br $loop))))
-     (struct.new $js (extern.internalize (local.get $a'))))
+     (struct.new $js (any.convert_extern (local.get $a'))))
 
    (func (export "caml_js_to_array")
       (param (ref eq)) (result (ref eq))
@@ -313,7 +313,7 @@
       (local $fa (ref $float_array))
       (local $i i32) (local $l i32)
       (local.set $a
-         (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
+         (ref.as_non_null (extern.convert_any (call $unwrap (local.get 0)))))
       (local.set $l (call $array_length (local.get $a)))
       (if (local.get $l)
          (then
@@ -591,7 +591,7 @@
             (local.set $l (array.get $block (local.get $b) (i32.const 2)))
             (local.set $i (i32.add (local.get $i) (i32.const 1)))
             (br $loop))))
-      (struct.new $js (extern.internalize (local.get $a))))
+      (struct.new $js (any.convert_extern (local.get $a))))
 
    (func (export "caml_list_of_js_array")
       (param (ref eq)) (result (ref eq))
@@ -600,7 +600,7 @@
       (local $len i32)
       (local $a (ref extern))
       (local.set $a
-         (ref.as_non_null (extern.externalize (call $unwrap (local.get 0)))))
+         (ref.as_non_null (extern.convert_any (call $unwrap (local.get 0)))))
       (local.set $len (call $array_length (local.get $a)))
       (local.set $i (i32.const 0))
       (local.set $l (ref.i31 (i32.const 0)))
@@ -625,7 +625,7 @@
 
    (func (export "caml_wrap_exception") (param externref) (result (ref eq))
       (local $exn anyref)
-      (local.set $exn (extern.internalize (local.get 0)))
+      (local.set $exn (any.convert_extern (local.get 0)))
       ;; ZZZ special case for stack overflows?
       (block $undef
          (return
@@ -643,7 +643,7 @@
                      (call $caml_jsstring_of_string
                         (array.new_data $string $toString
                            (i32.const 0) (i32.const 8))))
-                  (extern.internalize (call $new_array (i32.const 0))))))))
+                  (any.convert_extern (call $new_array (i32.const 0))))))))
 
    (func (export "caml_js_error_option_of_exception")
       (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
index 9e4efd01fa..d84df649cb 100644
--- a/runtime/wasm/jsstring.wat
+++ b/runtime/wasm/jsstring.wat
@@ -63,11 +63,11 @@
    (func (export "jsstring_compare")
       (param $s anyref) (param $s' anyref) (result i32)
       (return_call $compare_strings
-         (extern.externalize (local.get $s))
-         (extern.externalize (local.get $s'))))
+         (extern.convert_any (local.get $s))
+         (extern.convert_any (local.get $s'))))
 
    (func (export "jsstring_test") (param $s anyref) (result i32)
-      (return_call $is_string (extern.externalize (local.get $s))))
+      (return_call $is_string (extern.convert_any (local.get $s))))
 
    (export "jsstring_hash" (func $hash_string))
 
@@ -78,7 +78,7 @@
       (if (global.get $builtins_available)
          (then
             (return
-               (extern.internalize
+               (any.convert_extern
                   (call $decodeStringFromUTF8Array (local.get $s)
                      (local.get $pos)
                      (i32.add (local.get $pos) (local.get $len)))))))
@@ -93,7 +93,7 @@
       (if (global.get $builtins_available)
          (then
             (return_call $encodeStringToUTF8Array
-               (extern.externalize (local.get $s)))))
+               (extern.convert_any (local.get $s)))))
       (return_call $string_of_jsstring_fallback (local.get $s)))
 
    ;; Fallback implementation of string conversion functions
diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat
index 167c182600..b397c89a82 100644
--- a/runtime/wasm/sys.wat
+++ b/runtime/wasm/sys.wat
@@ -192,7 +192,7 @@
       (call $caml_raise_sys_error
          (call $caml_string_of_jsstring
             (call $caml_js_meth_call
-               (call $wrap (extern.internalize (local.get $exn)))
+               (call $wrap (any.convert_extern (local.get $exn)))
                (array.new_data $string $toString (i32.const 0) (i32.const 8))
                (array.new_fixed $block 1 (ref.i31 (i32.const 0)))))))
 )

From b9a93a34fbcf47803f228e3bd4cc046d7d900086 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 16 Jul 2024 14:38:11 +0200
Subject: [PATCH 273/481] Wasm compiler: remove unused operators
 Extern{In,Ex}ternalize

---
 compiler/lib/wasm/wa_asm_output.ml        | 4 +---
 compiler/lib/wasm/wa_ast.ml               | 2 --
 compiler/lib/wasm/wa_code_generation.ml   | 2 --
 compiler/lib/wasm/wa_gc_target.ml         | 4 +---
 compiler/lib/wasm/wa_initialize_locals.ml | 4 +---
 compiler/lib/wasm/wa_wat_output.ml        | 2 --
 6 files changed, 3 insertions(+), 15 deletions(-)

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
index 86d705066a..3726fd8ba7 100644
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ b/compiler/lib/wasm/wa_asm_output.ml
@@ -343,9 +343,7 @@ module Output () = struct
     | RefEq _
     | RefNull _
     | Br_on_cast _
-    | Br_on_cast_fail _
-    | ExternExternalize _
-    | ExternInternalize _ -> assert false (* Not supported *)
+    | Br_on_cast_fail _ -> assert false (* Not supported *)
 
   and instruction m i =
     match i with
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 8aded1dd6e..6de691b26a 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -171,8 +171,6 @@ type expression =
   | RefTest of ref_type * expression
   | RefEq of expression * expression
   | RefNull of heap_type
-  | ExternInternalize of expression
-  | ExternExternalize of expression
   | Br_on_cast of int * ref_type * ref_type * expression
   | Br_on_cast_fail of int * ref_type * ref_type * expression
   | IfExpr of value_type * expression * expression * expression
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 293de76d0b..f84d5acea9 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -456,8 +456,6 @@ let rec is_smi e =
   | StructGet _
   | RefCast _
   | RefNull _
-  | ExternInternalize _
-  | ExternExternalize _
   | Br_on_cast _
   | Br_on_cast_fail _ -> false
   | BinOp ((F32 _ | F64 _), _, _) | RefTest _ | RefEq _ -> true
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 67bb57cdac..32f70fcb63 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -515,9 +515,7 @@ module Value = struct
     | ArrayLen e'
     | StructGet (_, _, _, e')
     | RefCast (_, e')
-    | RefTest (_, e')
-    | ExternInternalize e'
-    | ExternExternalize e' -> effect_free e'
+    | RefTest (_, e') -> effect_free e'
     | BinOp (_, e1, e2)
     | ArrayNew (_, e1, e2)
     | ArrayNewData (_, _, e1, e2)
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
index 50c99ae309..3d7ea6a819 100644
--- a/compiler/lib/wasm/wa_initialize_locals.ml
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -49,9 +49,7 @@ let rec scan_expression ctx e =
   | RefCast (_, e')
   | RefTest (_, e')
   | Br_on_cast (_, _, _, e')
-  | Br_on_cast_fail (_, _, _, e')
-  | ExternInternalize e'
-  | ExternExternalize e' -> scan_expression ctx e'
+  | Br_on_cast_fail (_, _, _, e') -> scan_expression ctx e'
   | BinOp (_, e', e'')
   | ArrayNew (_, e', e'')
   | ArrayNewData (_, _, e', e'')
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index d63e733a00..3e72493bea 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -469,8 +469,6 @@ let expression_or_instructions ctx st in_function =
             :: ref_type st ty'
             :: expression e)
         ]
-    | ExternInternalize e -> [ List (Atom "extern.internalize" :: expression e) ]
-    | ExternExternalize e -> [ List (Atom "extern.externalize" :: expression e) ]
     | IfExpr (ty, cond, ift, iff) ->
         [ List
             ((Atom "if" :: block_type st { params = []; result = [ ty ] })

From 156945d6a53eeb36d8899ad6dc3d9276767d9433 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 7 Jun 2024 14:59:22 +0200
Subject: [PATCH 274/481] Add type Js.number_t

---
 lib/js_of_ocaml/dom_html.ml              | 188 +++++++++---------
 lib/js_of_ocaml/dom_html.mli             | 188 +++++++++---------
 lib/js_of_ocaml/dom_svg.ml               | 232 +++++++++++------------
 lib/js_of_ocaml/dom_svg.mli              | 232 +++++++++++------------
 lib/js_of_ocaml/file.ml                  |   2 +-
 lib/js_of_ocaml/geolocation.ml           |  14 +-
 lib/js_of_ocaml/geolocation.mli          |  14 +-
 lib/js_of_ocaml/intersectionObserver.ml  |   8 +-
 lib/js_of_ocaml/intersectionObserver.mli |   8 +-
 lib/js_of_ocaml/intl.mli                 |   3 +-
 lib/js_of_ocaml/js.ml                    | 170 +++++++++--------
 lib/js_of_ocaml/js.mli                   | 143 +++++++-------
 lib/js_of_ocaml/performanceObserver.ml   |   4 +-
 lib/js_of_ocaml/performanceObserver.mli  |   4 +-
 lib/js_of_ocaml/resizeObserver.ml        |   4 +-
 lib/js_of_ocaml/resizeObserver.mli       |   4 +-
 lib/js_of_ocaml/webGL.ml                 |  64 +++----
 lib/js_of_ocaml/webGL.mli                |  64 +++----
 lib/lwt/lwt_js_events.ml                 |   2 +-
 19 files changed, 678 insertions(+), 670 deletions(-)

diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index 38ed36d2e7..df2e90c58e 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -368,11 +368,11 @@ and mousewheelEvent = object
 
   method wheelDeltaY : int optdef readonly_prop
 
-  method deltaX : number t readonly_prop
+  method deltaX : number_t readonly_prop
 
-  method deltaY : number t readonly_prop
+  method deltaY : number_t readonly_prop
 
-  method deltaZ : number t readonly_prop
+  method deltaZ : number_t readonly_prop
 
   method deltaMode : delta_mode readonly_prop
 end
@@ -563,13 +563,13 @@ and pointerEvent = object
 
   method pointerId : int Js.readonly_prop
 
-  method width : number t Js.readonly_prop
+  method width : number_t Js.readonly_prop
 
-  method height : number t Js.readonly_prop
+  method height : number_t Js.readonly_prop
 
-  method pressure : number t Js.readonly_prop
+  method pressure : number_t Js.readonly_prop
 
-  method tangentialPressure : number t Js.readonly_prop
+  method tangentialPressure : number_t Js.readonly_prop
 
   method tiltX : int Js.readonly_prop
 
@@ -623,7 +623,7 @@ and animationEvent = object
 
   method animationName : js_string t readonly_prop
 
-  method elapsedTime : number t readonly_prop
+  method elapsedTime : number_t readonly_prop
 
   method pseudoElement : js_string t readonly_prop
 end
@@ -633,7 +633,7 @@ and transitionEvent = object
 
   method propertyName : js_string t readonly_prop
 
-  method elapsedTime : number t readonly_prop
+  method elapsedTime : number_t readonly_prop
 
   method pseudoElement : js_string t readonly_prop
 end
@@ -743,17 +743,17 @@ and element = object
 end
 
 and clientRect = object
-  method top : number t readonly_prop
+  method top : number_t readonly_prop
 
-  method right : number t readonly_prop
+  method right : number_t readonly_prop
 
-  method bottom : number t readonly_prop
+  method bottom : number_t readonly_prop
 
-  method left : number t readonly_prop
+  method left : number_t readonly_prop
 
-  method width : number t optdef readonly_prop
+  method width : number_t optdef readonly_prop
 
-  method height : number t optdef readonly_prop
+  method height : number_t optdef readonly_prop
 end
 
 and clientRectList = object
@@ -1609,9 +1609,9 @@ end
 class type timeRanges = object
   method length : int readonly_prop
 
-  method start : int -> number t meth
+  method start : int -> number_t meth
 
-  method end_ : int -> number t meth
+  method end_ : int -> number_t meth
 end
 
 type networkState =
@@ -1648,9 +1648,9 @@ class type mediaElement = object
 
   method currentSrc : js_string t readonly_prop
 
-  method currentTime : number t prop
+  method currentTime : number_t prop
 
-  method duration : number t readonly_prop
+  method duration : number_t readonly_prop
 
   method ended : bool t readonly_prop
 
@@ -1666,7 +1666,7 @@ class type mediaElement = object
 
   method paused : bool t readonly_prop
 
-  method playbackRate : number t prop
+  method playbackRate : number_t prop
 
   method played : timeRanges t readonly_prop
 
@@ -1682,7 +1682,7 @@ class type mediaElement = object
 
   method src : js_string t prop
 
-  method volume : number t prop
+  method volume : number_t prop
 
   method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
@@ -1746,7 +1746,7 @@ class type canvasElement = object
 
   method toDataURL_type : js_string t -> js_string t meth
 
-  method toDataURL_type_compression : js_string t -> number t -> js_string t meth
+  method toDataURL_type_compression : js_string t -> number_t -> js_string t meth
 
   method getContext : js_string t -> canvasRenderingContext2D t meth
 end
@@ -1758,19 +1758,19 @@ and canvasRenderingContext2D = object
 
   method restore : unit meth
 
-  method scale : number t -> number t -> unit meth
+  method scale : number_t -> number_t -> unit meth
 
-  method rotate : number t -> unit meth
+  method rotate : number_t -> unit meth
 
-  method translate : number t -> number t -> unit meth
+  method translate : number_t -> number_t -> unit meth
 
   method transform :
-    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method setTransform :
-    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method globalAlpha : number t prop
+  method globalAlpha : number_t prop
 
   method globalCompositeOperation : js_string t prop
 
@@ -1787,15 +1787,15 @@ and canvasRenderingContext2D = object
   method fillStyle_pattern : canvasPattern t writeonly_prop
 
   method createLinearGradient :
-    number t -> number t -> number t -> number t -> canvasGradient t meth
+    number_t -> number_t -> number_t -> number_t -> canvasGradient t meth
 
   method createRadialGradient :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> canvasGradient t meth
 
   method createPattern : imageElement t -> js_string t -> canvasPattern t meth
@@ -1804,47 +1804,47 @@ and canvasRenderingContext2D = object
 
   method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-  method lineWidth : number t prop
+  method lineWidth : number_t prop
 
   method lineCap : js_string t prop
 
   method lineJoin : js_string t prop
 
-  method miterLimit : number t prop
+  method miterLimit : number_t prop
 
-  method shadowOffsetX : number t prop
+  method shadowOffsetX : number_t prop
 
-  method shadowOffsetY : number t prop
+  method shadowOffsetY : number_t prop
 
-  method shadowBlur : number t prop
+  method shadowBlur : number_t prop
 
   method shadowColor : js_string t prop
 
-  method clearRect : number t -> number t -> number t -> number t -> unit meth
+  method clearRect : number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method fillRect : number t -> number t -> number t -> number t -> unit meth
+  method fillRect : number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method strokeRect : number t -> number t -> number t -> number t -> unit meth
+  method strokeRect : number_t -> number_t -> number_t -> number_t -> unit meth
 
   method beginPath : unit meth
 
   method closePath : unit meth
 
-  method moveTo : number t -> number t -> unit meth
+  method moveTo : number_t -> number_t -> unit meth
 
-  method lineTo : number t -> number t -> unit meth
+  method lineTo : number_t -> number_t -> unit meth
 
-  method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
+  method quadraticCurveTo : number_t -> number_t -> number_t -> number_t -> unit meth
 
   method bezierCurveTo :
-    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
+  method arcTo : number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method rect : number t -> number t -> number t -> number t -> unit meth
+  method rect : number_t -> number_t -> number_t -> number_t -> unit meth
 
   method arc :
-    number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> bool t -> unit meth
 
   method fill : unit meth
 
@@ -1852,9 +1852,9 @@ and canvasRenderingContext2D = object
 
   method clip : unit meth
 
-  method isPointInPath : number t -> number t -> bool t meth
+  method isPointInPath : number_t -> number_t -> bool t meth
 
-  method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
+  method drawFocusRing : #element t -> number_t -> number_t -> bool t -> bool t meth
 
   method font : js_string t prop
 
@@ -1862,82 +1862,82 @@ and canvasRenderingContext2D = object
 
   method textBaseline : js_string t prop
 
-  method fillText : js_string t -> number t -> number t -> unit meth
+  method fillText : js_string t -> number_t -> number_t -> unit meth
 
-  method fillText_withWidth : js_string t -> number t -> number t -> number t -> unit meth
+  method fillText_withWidth : js_string t -> number_t -> number_t -> number_t -> unit meth
 
-  method strokeText : js_string t -> number t -> number t -> unit meth
+  method strokeText : js_string t -> number_t -> number_t -> unit meth
 
   method strokeText_withWidth :
-    js_string t -> number t -> number t -> number t -> unit meth
+    js_string t -> number_t -> number_t -> number_t -> unit meth
 
   method measureText : js_string t -> textMetrics t meth
 
-  method drawImage : imageElement t -> number t -> number t -> unit meth
+  method drawImage : imageElement t -> number_t -> number_t -> unit meth
 
   method drawImage_withSize :
-    imageElement t -> number t -> number t -> number t -> number t -> unit meth
+    imageElement t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method drawImage_full :
        imageElement t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
-  method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
+  method drawImage_fromCanvas : canvasElement t -> number_t -> number_t -> unit meth
 
   method drawImage_fromCanvasWithSize :
-    canvasElement t -> number t -> number t -> number t -> number t -> unit meth
+    canvasElement t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method drawImage_fullFromCanvas :
        canvasElement t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
   method drawImage_fromVideoWithVideo :
-    videoElement t -> number t -> number t -> unit meth
+    videoElement t -> number_t -> number_t -> unit meth
 
   method drawImage_fromVideoWithSize :
-    videoElement t -> number t -> number t -> number t -> number t -> unit meth
+    videoElement t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method drawImage_fullFromVideo :
        videoElement t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
   method createImageData : int -> int -> imageData t meth
 
-  method getImageData : number t -> number t -> number t -> number t -> imageData t meth
+  method getImageData : number_t -> number_t -> number_t -> number_t -> imageData t meth
 
-  method putImageData : imageData t -> number t -> number t -> unit meth
+  method putImageData : imageData t -> number_t -> number_t -> unit meth
 end
 
 and canvasGradient = object
-  method addColorStop : number t -> js_string t -> unit meth
+  method addColorStop : number_t -> js_string t -> unit meth
 end
 
 and textMetrics = object
-  method width : number t readonly_prop
+  method width : number_t readonly_prop
 end
 
 and imageData = object
@@ -2288,16 +2288,16 @@ class type window = object
 
   method print : unit meth
 
-  method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
+  method setInterval : (unit -> unit) Js.callback -> number_t -> interval_id meth
 
   method clearInterval : interval_id -> unit meth
 
-  method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
+  method setTimeout : (unit -> unit) Js.callback -> number_t -> timeout_id meth
 
   method clearTimeout : timeout_id -> unit meth
 
   method requestAnimationFrame :
-    (number t -> unit) Js.callback -> animation_frame_request_id meth
+    (number_t -> unit) Js.callback -> animation_frame_request_id meth
 
   method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
@@ -2344,7 +2344,7 @@ class type window = object
 
   method _URL : _URL t readonly_prop
 
-  method devicePixelRatio : number t readonly_prop
+  method devicePixelRatio : number_t readonly_prop
 end
 
 let window : window t = Js.Unsafe.global
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 96ae54c8f4..34a5fe8d06 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -374,11 +374,11 @@ and mousewheelEvent = object
 
   method wheelDeltaY : int optdef readonly_prop
 
-  method deltaX : number t readonly_prop
+  method deltaX : number_t readonly_prop
 
-  method deltaY : number t readonly_prop
+  method deltaY : number_t readonly_prop
 
-  method deltaZ : number t readonly_prop
+  method deltaZ : number_t readonly_prop
 
   method deltaMode : delta_mode readonly_prop
 end
@@ -571,13 +571,13 @@ and pointerEvent = object
 
   method pointerId : int Js.readonly_prop
 
-  method width : number t Js.readonly_prop
+  method width : number_t Js.readonly_prop
 
-  method height : number t Js.readonly_prop
+  method height : number_t Js.readonly_prop
 
-  method pressure : number t Js.readonly_prop
+  method pressure : number_t Js.readonly_prop
 
-  method tangentialPressure : number t Js.readonly_prop
+  method tangentialPressure : number_t Js.readonly_prop
 
   method tiltX : int Js.readonly_prop
 
@@ -632,7 +632,7 @@ and animationEvent = object
 
   method animationName : js_string t readonly_prop
 
-  method elapsedTime : number t readonly_prop
+  method elapsedTime : number_t readonly_prop
 
   method pseudoElement : js_string t readonly_prop
 end
@@ -642,7 +642,7 @@ and transitionEvent = object
 
   method propertyName : js_string t readonly_prop
 
-  method elapsedTime : number t readonly_prop
+  method elapsedTime : number_t readonly_prop
 
   method pseudoElement : js_string t readonly_prop
 end
@@ -757,17 +757,17 @@ end
 
 (** Rectangular box (used for element bounding boxes) *)
 and clientRect = object
-  method top : number t readonly_prop
+  method top : number_t readonly_prop
 
-  method right : number t readonly_prop
+  method right : number_t readonly_prop
 
-  method bottom : number t readonly_prop
+  method bottom : number_t readonly_prop
 
-  method left : number t readonly_prop
+  method left : number_t readonly_prop
 
-  method width : number t optdef readonly_prop
+  method width : number_t optdef readonly_prop
 
-  method height : number t optdef readonly_prop
+  method height : number_t optdef readonly_prop
 end
 
 and clientRectList = object
@@ -1432,9 +1432,9 @@ end
 class type timeRanges = object
   method length : int readonly_prop
 
-  method start : int -> number t meth
+  method start : int -> number_t meth
 
-  method end_ : int -> number t meth
+  method end_ : int -> number_t meth
 end
 
 type networkState =
@@ -1469,9 +1469,9 @@ class type mediaElement = object
 
   method currentSrc : js_string t readonly_prop
 
-  method currentTime : number t prop
+  method currentTime : number_t prop
 
-  method duration : number t readonly_prop
+  method duration : number_t readonly_prop
 
   method ended : bool t readonly_prop
 
@@ -1487,7 +1487,7 @@ class type mediaElement = object
 
   method paused : bool t readonly_prop
 
-  method playbackRate : number t prop
+  method playbackRate : number_t prop
 
   method played : timeRanges t readonly_prop
 
@@ -1503,7 +1503,7 @@ class type mediaElement = object
 
   method src : js_string t prop
 
-  method volume : number t prop
+  method volume : number_t prop
 
   method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop
 
@@ -1569,7 +1569,7 @@ class type canvasElement = object
 
   method toDataURL_type : js_string t -> js_string t meth
 
-  method toDataURL_type_compression : js_string t -> number t -> js_string t meth
+  method toDataURL_type_compression : js_string t -> number_t -> js_string t meth
 
   method getContext : context -> canvasRenderingContext2D t meth
 end
@@ -1581,19 +1581,19 @@ and canvasRenderingContext2D = object
 
   method restore : unit meth
 
-  method scale : number t -> number t -> unit meth
+  method scale : number_t -> number_t -> unit meth
 
-  method rotate : number t -> unit meth
+  method rotate : number_t -> unit meth
 
-  method translate : number t -> number t -> unit meth
+  method translate : number_t -> number_t -> unit meth
 
   method transform :
-    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method setTransform :
-    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method globalAlpha : number t prop
+  method globalAlpha : number_t prop
 
   method globalCompositeOperation : js_string t prop
 
@@ -1610,15 +1610,15 @@ and canvasRenderingContext2D = object
   method fillStyle_pattern : canvasPattern t writeonly_prop
 
   method createLinearGradient :
-    number t -> number t -> number t -> number t -> canvasGradient t meth
+    number_t -> number_t -> number_t -> number_t -> canvasGradient t meth
 
   method createRadialGradient :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> canvasGradient t meth
 
   method createPattern : imageElement t -> js_string t -> canvasPattern t meth
@@ -1627,47 +1627,47 @@ and canvasRenderingContext2D = object
 
   method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth
 
-  method lineWidth : number t prop
+  method lineWidth : number_t prop
 
   method lineCap : js_string t prop
 
   method lineJoin : js_string t prop
 
-  method miterLimit : number t prop
+  method miterLimit : number_t prop
 
-  method shadowOffsetX : number t prop
+  method shadowOffsetX : number_t prop
 
-  method shadowOffsetY : number t prop
+  method shadowOffsetY : number_t prop
 
-  method shadowBlur : number t prop
+  method shadowBlur : number_t prop
 
   method shadowColor : js_string t prop
 
-  method clearRect : number t -> number t -> number t -> number t -> unit meth
+  method clearRect : number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method fillRect : number t -> number t -> number t -> number t -> unit meth
+  method fillRect : number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method strokeRect : number t -> number t -> number t -> number t -> unit meth
+  method strokeRect : number_t -> number_t -> number_t -> number_t -> unit meth
 
   method beginPath : unit meth
 
   method closePath : unit meth
 
-  method moveTo : number t -> number t -> unit meth
+  method moveTo : number_t -> number_t -> unit meth
 
-  method lineTo : number t -> number t -> unit meth
+  method lineTo : number_t -> number_t -> unit meth
 
-  method quadraticCurveTo : number t -> number t -> number t -> number t -> unit meth
+  method quadraticCurveTo : number_t -> number_t -> number_t -> number_t -> unit meth
 
   method bezierCurveTo :
-    number t -> number t -> number t -> number t -> number t -> number t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method arcTo : number t -> number t -> number t -> number t -> number t -> unit meth
+  method arcTo : number_t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method rect : number t -> number t -> number t -> number t -> unit meth
+  method rect : number_t -> number_t -> number_t -> number_t -> unit meth
 
   method arc :
-    number t -> number t -> number t -> number t -> number t -> bool t -> unit meth
+    number_t -> number_t -> number_t -> number_t -> number_t -> bool t -> unit meth
 
   method fill : unit meth
 
@@ -1675,9 +1675,9 @@ and canvasRenderingContext2D = object
 
   method clip : unit meth
 
-  method isPointInPath : number t -> number t -> bool t meth
+  method isPointInPath : number_t -> number_t -> bool t meth
 
-  method drawFocusRing : #element t -> number t -> number t -> bool t -> bool t meth
+  method drawFocusRing : #element t -> number_t -> number_t -> bool t -> bool t meth
 
   method font : js_string t prop
 
@@ -1685,83 +1685,83 @@ and canvasRenderingContext2D = object
 
   method textBaseline : js_string t prop
 
-  method fillText : js_string t -> number t -> number t -> unit meth
+  method fillText : js_string t -> number_t -> number_t -> unit meth
 
-  method fillText_withWidth : js_string t -> number t -> number t -> number t -> unit meth
+  method fillText_withWidth : js_string t -> number_t -> number_t -> number_t -> unit meth
 
-  method strokeText : js_string t -> number t -> number t -> unit meth
+  method strokeText : js_string t -> number_t -> number_t -> unit meth
 
   method strokeText_withWidth :
-    js_string t -> number t -> number t -> number t -> unit meth
+    js_string t -> number_t -> number_t -> number_t -> unit meth
 
   method measureText : js_string t -> textMetrics t meth
 
-  method drawImage : imageElement t -> number t -> number t -> unit meth
+  method drawImage : imageElement t -> number_t -> number_t -> unit meth
 
   method drawImage_withSize :
-    imageElement t -> number t -> number t -> number t -> number t -> unit meth
+    imageElement t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method drawImage_full :
        imageElement t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
-  method drawImage_fromCanvas : canvasElement t -> number t -> number t -> unit meth
+  method drawImage_fromCanvas : canvasElement t -> number_t -> number_t -> unit meth
 
   method drawImage_fromCanvasWithSize :
-    canvasElement t -> number t -> number t -> number t -> number t -> unit meth
+    canvasElement t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method drawImage_fullFromCanvas :
        canvasElement t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
   method drawImage_fromVideoWithVideo :
-    videoElement t -> number t -> number t -> unit meth
+    videoElement t -> number_t -> number_t -> unit meth
 
   method drawImage_fromVideoWithSize :
-    videoElement t -> number t -> number t -> number t -> number t -> unit meth
+    videoElement t -> number_t -> number_t -> number_t -> number_t -> unit meth
 
   method drawImage_fullFromVideo :
        videoElement t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
   (* Method createImageData not available in Opera *)
   method createImageData : int -> int -> imageData t meth
 
-  method getImageData : number t -> number t -> number t -> number t -> imageData t meth
+  method getImageData : number_t -> number_t -> number_t -> number_t -> imageData t meth
 
-  method putImageData : imageData t -> number t -> number t -> unit meth
+  method putImageData : imageData t -> number_t -> number_t -> unit meth
 end
 
 and canvasGradient = object
-  method addColorStop : number t -> js_string t -> unit meth
+  method addColorStop : number_t -> js_string t -> unit meth
 end
 
 and textMetrics = object
-  method width : number t readonly_prop
+  method width : number_t readonly_prop
 end
 
 and imageData = object
@@ -2138,16 +2138,16 @@ class type window = object
 
   method print : unit meth
 
-  method setInterval : (unit -> unit) Js.callback -> number t -> interval_id meth
+  method setInterval : (unit -> unit) Js.callback -> number_t -> interval_id meth
 
   method clearInterval : interval_id -> unit meth
 
-  method setTimeout : (unit -> unit) Js.callback -> number t -> timeout_id meth
+  method setTimeout : (unit -> unit) Js.callback -> number_t -> timeout_id meth
 
   method clearTimeout : timeout_id -> unit meth
 
   method requestAnimationFrame :
-    (number t -> unit) Js.callback -> animation_frame_request_id meth
+    (number_t -> unit) Js.callback -> animation_frame_request_id meth
 
   method cancelAnimationFrame : animation_frame_request_id -> unit meth
 
@@ -2194,7 +2194,7 @@ class type window = object
 
   method _URL : _URL t readonly_prop
 
-  method devicePixelRatio : number t readonly_prop
+  method devicePixelRatio : number_t readonly_prop
 end
 
 val window : window t
diff --git a/lib/js_of_ocaml/dom_svg.ml b/lib/js_of_ocaml/dom_svg.ml
index 0ce7b97665..28d37600e5 100644
--- a/lib/js_of_ocaml/dom_svg.ml
+++ b/lib/js_of_ocaml/dom_svg.ml
@@ -217,7 +217,7 @@ and animatedEnumeration = [int (*short*)] animated
 and animatedInteger = [int] animated
 
 (* interface SVGAnimatedNumber *)
-and animatedNumber = [number t] animated
+and animatedNumber = [number_t] animated
 
 (* interface SVGNumberList *)
 and numberList = [number t] list
@@ -229,13 +229,13 @@ and animatedNumberList = [numberList t] animated
 and length = object
   method unitType : lengthUnitType readonly_prop
 
-  method value : number t prop
+  method value : number_t prop
 
-  method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number_t prop
 
   method valueAsString : js_string t prop
 
-  method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : lengthUnitType -> number_t -> unit meth
 
   method convertToSpecifiedUnits : lengthUnitType -> unit meth
 end
@@ -253,13 +253,13 @@ and animatedLengthList = [lengthList t] animated
 and angle = object
   method unitType : angleUnitType readonly_prop
 
-  method value : number t prop
+  method value : number_t prop
 
-  method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number_t prop
 
   method valueAsString : js_string t prop
 
-  method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : angleUnitType -> number_t -> unit meth
 
   method convertToSpecifiedUnits : angleUnitType -> unit meth
 end
@@ -295,13 +295,13 @@ end
 
 (* interface SVGRect *)
 and rect = object
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method width : number t prop
+  method width : number_t prop
 
-  method height : number t prop
+  method height : number_t prop
 end
 
 (* interface SVGAnimatedRect *)
@@ -450,19 +450,19 @@ and svgElement = object
 
   method viewport : rect t readonly_prop
 
-  method pixelUnitToMillimeterX : number t readonly_prop
+  method pixelUnitToMillimeterX : number_t readonly_prop
 
-  method pixelUnitToMillimeterY : number t readonly_prop
+  method pixelUnitToMillimeterY : number_t readonly_prop
 
-  method screenPixelUnitToMillimeterX : number t readonly_prop
+  method screenPixelUnitToMillimeterX : number_t readonly_prop
 
-  method screenPixelUnitToMillimeterY : number t readonly_prop
+  method screenPixelUnitToMillimeterY : number_t readonly_prop
 
   method useCurrentView : bool t readonly_prop
 
   method currentView : viewSpec t readonly_prop
 
-  method currentScale : number t prop
+  method currentScale : number_t prop
 
   method currentTranslate : point t readonly_prop
 
@@ -480,7 +480,7 @@ and svgElement = object
 
   method animationsPaused : bool t meth
 
-  method getCurrentTime : number t meth
+  method getCurrentTime : number_t meth
 
   method setCurrentTime : int -> unit meth
 
@@ -693,9 +693,9 @@ end
 
 (* interface SVGPoint *)
 and point = object
-  method x : number t readonly_prop
+  method x : number_t readonly_prop
 
-  method y : number t readonly_prop
+  method y : number_t readonly_prop
 
   method matrixTransform : matrix t -> point t meth
 end
@@ -705,39 +705,39 @@ and pointList = [point t] list
 
 (* interface SVGMatrix *)
 and matrix = object
-  method a : number t readonly_prop
+  method a : number_t readonly_prop
 
-  method b : number t readonly_prop
+  method b : number_t readonly_prop
 
-  method c : number t readonly_prop
+  method c : number_t readonly_prop
 
-  method d : number t readonly_prop
+  method d : number_t readonly_prop
 
-  method e : number t readonly_prop
+  method e : number_t readonly_prop
 
-  method f : number t readonly_prop
+  method f : number_t readonly_prop
 
   method multiply : matrix t -> matrix t meth
 
   method inverse : matrix t meth
 
-  method translate : number t -> number t -> matrix t meth
+  method translate : number_t -> number_t -> matrix t meth
 
-  method scale : number t -> matrix t meth
+  method scale : number_t -> matrix t meth
 
-  method scaleNonUniform : number t -> number t -> matrix t meth
+  method scaleNonUniform : number_t -> number_t -> matrix t meth
 
-  method rotate : number t -> matrix t meth
+  method rotate : number_t -> matrix t meth
 
-  method rotateFromVector : number t -> number t -> matrix t meth
+  method rotateFromVector : number_t -> number_t -> matrix t meth
 
   method flipX : matrix t meth
 
   method flipY : matrix t meth
 
-  method skewX : number t -> matrix t meth
+  method skewX : number_t -> matrix t meth
 
-  method skewY : number t -> matrix t meth
+  method skewY : number_t -> matrix t meth
 end
 
 (* interface SVGTransform *)
@@ -746,19 +746,19 @@ and transform = object
 
   method matrix : matrix t readonly_prop
 
-  method angle : number t readonly_prop
+  method angle : number_t readonly_prop
 
   method setMatrix : matrix t -> unit meth
 
-  method setTranslate : number t -> number t -> unit meth
+  method setTranslate : number_t -> number_t -> unit meth
 
-  method setScale : number t -> number t -> unit meth
+  method setScale : number_t -> number_t -> unit meth
 
-  method setRotate : number t -> number t -> number t -> unit meth
+  method setRotate : number_t -> number_t -> number_t -> unit meth
 
-  method setSkewX : number t -> unit meth
+  method setSkewX : number_t -> unit meth
 
-  method setSkewY : number t -> unit meth
+  method setSkewY : number_t -> unit meth
 end
 
 (* interface SVGTransformList *)
@@ -798,9 +798,9 @@ and pathSegClosePath = pathSeg
 and pathSegMoveto = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 end
 
 (* interface SVGPathSegLinetoAbs *)
@@ -808,9 +808,9 @@ end
 and pathSegLineto = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
@@ -818,17 +818,17 @@ end
 and pathSegCurvetoCubic = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method x1 : number t prop
+  method x1 : number_t prop
 
-  method y1 : number t prop
+  method y1 : number_t prop
 
-  method x2 : number t prop
+  method x2 : number_t prop
 
-  method y2 : number t prop
+  method y2 : number_t prop
 end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
@@ -836,13 +836,13 @@ end
 and pathSegCurvetoQuadratic = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method x1 : number t prop
+  method x1 : number_t prop
 
-  method y1 : number t prop
+  method y1 : number_t prop
 end
 
 (* interface SVGPathSegArcAbs *)
@@ -850,13 +850,13 @@ end
 and pathSegArc = object
   inherit pathSeg
 
-  method y : number t prop
+  method y : number_t prop
 
-  method r1 : number t prop
+  method r1 : number_t prop
 
-  method r2 : number t prop
+  method r2 : number_t prop
 
-  method angle : number t prop
+  method angle : number_t prop
 
   method largeArcFlag : bool t prop
 
@@ -868,7 +868,7 @@ end
 and pathSegLinetoHorizontal = object
   inherit pathSeg
 
-  method x : number t
+  method x : number_t
 end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
@@ -876,19 +876,19 @@ end
 and pathSegLinetoVertical = object
   inherit pathSeg
 
-  method y : number t
+  method y : number_t
 end
 
 and pathSegCurvetoCubicSmooth = object
   inherit pathSeg
 
-  method x : number t
+  method x : number_t
 
-  method y : number t
+  method y : number_t
 
-  method x2 : number t
+  method x2 : number_t
 
-  method y2 : number t
+  method y2 : number_t
 end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
@@ -896,9 +896,9 @@ end
 and pathSegCurvetoQuadraticSmooth = object
   inherit pathSeg
 
-  method x : number t
+  method x : number_t
 
-  method y : number t
+  method y : number_t
 end
 
 and pathSegList = [pathSeg t] list
@@ -932,85 +932,85 @@ and pathElement = object
 
   method pathLength : animatedNumber t readonly_prop
 
-  method getTotalLength : number t meth
+  method getTotalLength : number_t meth
 
-  method getPointAtLength : number t -> point t meth
+  method getPointAtLength : number_t -> point t meth
 
-  method getPathSegAtLength : number t -> int
+  method getPathSegAtLength : number_t -> int
 
   method createSVGPathSegClosePath : pathSegClosePath meth
 
-  method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoAbs : number_t -> number_t -> pathSegMoveto meth
 
-  method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoRel : number_t -> number_t -> pathSegMoveto meth
 
-  method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoAbs : number_t -> number_t -> pathSegLineto meth
 
-  method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoRel : number_t -> number_t -> pathSegLineto meth
 
   method createSVGPathSegCurvetoCubicAbs :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> pathSegCurvetoCubic meth
 
   method createSVGPathSegCurvetoCubicRel :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> pathSegCurvetoCubic meth
 
   method createSVGPathSegCurvetoQuadraticAbs :
-    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoQuadratic meth
 
   method createSVGPathSegCurvetoQuadraticRel :
-    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoQuadratic meth
 
   method createSVGPathSegArcAbs :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> bool t
     -> bool t
     -> pathSegArc meth
 
   method createSVGPathSegArcRel :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> bool t
     -> bool t
     -> pathSegArc meth
 
-  method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalAbs : number_t -> pathSegLinetoHorizontal meth
 
-  method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalRel : number_t -> pathSegLinetoHorizontal meth
 
-  method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalAbs : number_t -> pathSegLinetoVertical meth
 
-  method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalRel : number_t -> pathSegLinetoVertical meth
 
   method createSVGPathSegCurvetoCubicSmoothAbs :
-    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoCubicSmooth meth
 
   method createSVGPathSegCurvetoCubicSmoothRel :
-    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoCubicSmooth meth
 
   method createSVGPathSegCurvetoQuadraticSmoothAbs :
-    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+    number_t -> number_t -> pathSegCurvetoQuadraticSmooth meth
 
   method createSVGPathSegCurvetoQuadraticSmoothRel :
-    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+    number_t -> number_t -> pathSegCurvetoQuadraticSmooth meth
 end
 
 (* interface SVGRectElement *)
@@ -1170,9 +1170,9 @@ and textContentElement = object
 
   method getNumberOfChars : int meth
 
-  method getComputedTextLength : number t meth
+  method getComputedTextLength : number_t meth
 
-  method getSubStringLength : int -> int -> number t meth
+  method getSubStringLength : int -> int -> number_t meth
 
   method getStartPositionOfChar : int -> point t meth
 
@@ -1180,7 +1180,7 @@ and textContentElement = object
 
   method getExtentOfChar : int -> rect t meth
 
-  method getRotationOfChar : int -> number t meth
+  method getRotationOfChar : int -> number_t meth
 
   method getCharNumAtPosition : point -> int meth
 
@@ -1263,13 +1263,13 @@ and glyphRefElement = object
 
   method format : js_string t prop
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method dx : number t prop
+  method dx : number_t prop
 
-  method dy : number t prop
+  method dy : number_t prop
 end
 
 (* interface SVGPaint : SVGColor { *)
@@ -1664,7 +1664,7 @@ end
 (*   readonly attribute SVGAnimatedNumber stdDeviationX; *)
 (*   readonly attribute SVGAnimatedNumber stdDeviationY; *)
 
-(*   void setStdDeviation(in number t stdDeviationX, in number t stdDeviationY) raises(DOMException); *)
+(*   void setStdDeviation(in float stdDeviationX, in float stdDeviationY) raises(DOMException); *)
 (* }; *)
 
 (* interface SVGFEImageElement : SVGElement, *)
@@ -1800,9 +1800,9 @@ end
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
-(*   readonly attribute number t previousScale; *)
+(*   readonly attribute float previousScale; *)
 (*   readonly attribute SVGPoint previousTranslate; *)
-(*   readonly attribute number t newScale; *)
+(*   readonly attribute float newScale; *)
 (*   readonly attribute SVGPoint newTranslate; *)
 (* }; *)
 
@@ -1817,11 +1817,11 @@ and animationElement = object
   (* inherit elementTimeControl *)
   method targetElement : element t readonly_prop
 
-  method getStartTime : number t meth
+  method getStartTime : number_t meth
 
-  method getCurrentTime : number t meth
+  method getCurrentTime : number_t meth
 
-  method getSimpleDuration : number t meth
+  method getSimpleDuration : number_t meth
 end
 
 (* interface SVGAnimateElement *)
diff --git a/lib/js_of_ocaml/dom_svg.mli b/lib/js_of_ocaml/dom_svg.mli
index 105edba0b8..06343bc258 100644
--- a/lib/js_of_ocaml/dom_svg.mli
+++ b/lib/js_of_ocaml/dom_svg.mli
@@ -220,7 +220,7 @@ and animatedEnumeration = [int (*short*)] animated
 and animatedInteger = [int] animated
 
 (* interface SVGAnimatedNumber *)
-and animatedNumber = [number t] animated
+and animatedNumber = [number_t] animated
 
 (* interface SVGNumberList *)
 and numberList = [number t] list
@@ -232,13 +232,13 @@ and animatedNumberList = [numberList t] animated
 and length = object
   method unitType : lengthUnitType readonly_prop
 
-  method value : number t prop
+  method value : number_t prop
 
-  method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number_t prop
 
   method valueAsString : js_string t prop
 
-  method newValueSpecifiedUnits : lengthUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : lengthUnitType -> number_t -> unit meth
 
   method convertToSpecifiedUnits : lengthUnitType -> unit meth
 end
@@ -256,13 +256,13 @@ and animatedLengthList = [lengthList t] animated
 and angle = object
   method unitType : angleUnitType readonly_prop
 
-  method value : number t prop
+  method value : number_t prop
 
-  method valueInSpecifiedUnits : number t prop
+  method valueInSpecifiedUnits : number_t prop
 
   method valueAsString : js_string t prop
 
-  method newValueSpecifiedUnits : angleUnitType -> number t -> unit meth
+  method newValueSpecifiedUnits : angleUnitType -> number_t -> unit meth
 
   method convertToSpecifiedUnits : angleUnitType -> unit meth
 end
@@ -298,13 +298,13 @@ end
 
 (* interface SVGRect *)
 and rect = object
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method width : number t prop
+  method width : number_t prop
 
-  method height : number t prop
+  method height : number_t prop
 end
 
 (* interface SVGAnimatedRect *)
@@ -452,19 +452,19 @@ and svgElement = object
 
   method viewport : rect t readonly_prop
 
-  method pixelUnitToMillimeterX : number t readonly_prop
+  method pixelUnitToMillimeterX : number_t readonly_prop
 
-  method pixelUnitToMillimeterY : number t readonly_prop
+  method pixelUnitToMillimeterY : number_t readonly_prop
 
-  method screenPixelUnitToMillimeterX : number t readonly_prop
+  method screenPixelUnitToMillimeterX : number_t readonly_prop
 
-  method screenPixelUnitToMillimeterY : number t readonly_prop
+  method screenPixelUnitToMillimeterY : number_t readonly_prop
 
   method useCurrentView : bool t readonly_prop
 
   method currentView : viewSpec t readonly_prop
 
-  method currentScale : number t prop
+  method currentScale : number_t prop
 
   method currentTranslate : point t readonly_prop
 
@@ -482,7 +482,7 @@ and svgElement = object
 
   method animationsPaused : bool t meth
 
-  method getCurrentTime : number t meth
+  method getCurrentTime : number_t meth
 
   method setCurrentTime : int -> unit meth
 
@@ -695,9 +695,9 @@ end
 
 (* interface SVGPoint *)
 and point = object
-  method x : number t readonly_prop
+  method x : number_t readonly_prop
 
-  method y : number t readonly_prop
+  method y : number_t readonly_prop
 
   method matrixTransform : matrix t -> point t meth
 end
@@ -707,39 +707,39 @@ and pointList = [point t] list
 
 (* interface SVGMatrix *)
 and matrix = object
-  method a : number t readonly_prop
+  method a : number_t readonly_prop
 
-  method b : number t readonly_prop
+  method b : number_t readonly_prop
 
-  method c : number t readonly_prop
+  method c : number_t readonly_prop
 
-  method d : number t readonly_prop
+  method d : number_t readonly_prop
 
-  method e : number t readonly_prop
+  method e : number_t readonly_prop
 
-  method f : number t readonly_prop
+  method f : number_t readonly_prop
 
   method multiply : matrix t -> matrix t meth
 
   method inverse : matrix t meth
 
-  method translate : number t -> number t -> matrix t meth
+  method translate : number_t -> number_t -> matrix t meth
 
-  method scale : number t -> matrix t meth
+  method scale : number_t -> matrix t meth
 
-  method scaleNonUniform : number t -> number t -> matrix t meth
+  method scaleNonUniform : number_t -> number_t -> matrix t meth
 
-  method rotate : number t -> matrix t meth
+  method rotate : number_t -> matrix t meth
 
-  method rotateFromVector : number t -> number t -> matrix t meth
+  method rotateFromVector : number_t -> number_t -> matrix t meth
 
   method flipX : matrix t meth
 
   method flipY : matrix t meth
 
-  method skewX : number t -> matrix t meth
+  method skewX : number_t -> matrix t meth
 
-  method skewY : number t -> matrix t meth
+  method skewY : number_t -> matrix t meth
 end
 
 (* interface SVGTransform *)
@@ -748,19 +748,19 @@ and transform = object
 
   method matrix : matrix t readonly_prop
 
-  method angle : number t readonly_prop
+  method angle : number_t readonly_prop
 
   method setMatrix : matrix t -> unit meth
 
-  method setTranslate : number t -> number t -> unit meth
+  method setTranslate : number_t -> number_t -> unit meth
 
-  method setScale : number t -> number t -> unit meth
+  method setScale : number_t -> number_t -> unit meth
 
-  method setRotate : number t -> number t -> number t -> unit meth
+  method setRotate : number_t -> number_t -> number_t -> unit meth
 
-  method setSkewX : number t -> unit meth
+  method setSkewX : number_t -> unit meth
 
-  method setSkewY : number t -> unit meth
+  method setSkewY : number_t -> unit meth
 end
 
 (* interface SVGTransformList *)
@@ -800,9 +800,9 @@ and pathSegClosePath = pathSeg
 and pathSegMoveto = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 end
 
 (* interface SVGPathSegLinetoAbs *)
@@ -810,9 +810,9 @@ end
 and pathSegLineto = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 end
 
 (* interface SVGPathSegCurvetoCubicAbs *)
@@ -820,17 +820,17 @@ end
 and pathSegCurvetoCubic = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method x1 : number t prop
+  method x1 : number_t prop
 
-  method y1 : number t prop
+  method y1 : number_t prop
 
-  method x2 : number t prop
+  method x2 : number_t prop
 
-  method y2 : number t prop
+  method y2 : number_t prop
 end
 
 (* interface SVGPathSegCurvetoQuadraticAbs *)
@@ -838,13 +838,13 @@ end
 and pathSegCurvetoQuadratic = object
   inherit pathSeg
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method x1 : number t prop
+  method x1 : number_t prop
 
-  method y1 : number t prop
+  method y1 : number_t prop
 end
 
 (* interface SVGPathSegArcAbs *)
@@ -852,13 +852,13 @@ end
 and pathSegArc = object
   inherit pathSeg
 
-  method y : number t prop
+  method y : number_t prop
 
-  method r1 : number t prop
+  method r1 : number_t prop
 
-  method r2 : number t prop
+  method r2 : number_t prop
 
-  method angle : number t prop
+  method angle : number_t prop
 
   method largeArcFlag : bool t prop
 
@@ -870,7 +870,7 @@ end
 and pathSegLinetoHorizontal = object
   inherit pathSeg
 
-  method x : number t
+  method x : number_t
 end
 
 (* interface SVGPathSegLinetoVerticalAbs *)
@@ -878,19 +878,19 @@ end
 and pathSegLinetoVertical = object
   inherit pathSeg
 
-  method y : number t
+  method y : number_t
 end
 
 and pathSegCurvetoCubicSmooth = object
   inherit pathSeg
 
-  method x : number t
+  method x : number_t
 
-  method y : number t
+  method y : number_t
 
-  method x2 : number t
+  method x2 : number_t
 
-  method y2 : number t
+  method y2 : number_t
 end
 
 (* interface SVGPathSegCurvetoQuadraticSmoothAbs *)
@@ -898,9 +898,9 @@ end
 and pathSegCurvetoQuadraticSmooth = object
   inherit pathSeg
 
-  method x : number t
+  method x : number_t
 
-  method y : number t
+  method y : number_t
 end
 
 and pathSegList = [pathSeg t] list
@@ -934,85 +934,85 @@ and pathElement = object
 
   method pathLength : animatedNumber t readonly_prop
 
-  method getTotalLength : number t meth
+  method getTotalLength : number_t meth
 
-  method getPointAtLength : number t -> point t meth
+  method getPointAtLength : number_t -> point t meth
 
-  method getPathSegAtLength : number t -> int
+  method getPathSegAtLength : number_t -> int
 
   method createSVGPathSegClosePath : pathSegClosePath meth
 
-  method createSVGPathSegMovetoAbs : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoAbs : number_t -> number_t -> pathSegMoveto meth
 
-  method createSVGPathSegMovetoRel : number t -> number t -> pathSegMoveto meth
+  method createSVGPathSegMovetoRel : number_t -> number_t -> pathSegMoveto meth
 
-  method createSVGPathSegLinetoAbs : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoAbs : number_t -> number_t -> pathSegLineto meth
 
-  method createSVGPathSegLinetoRel : number t -> number t -> pathSegLineto meth
+  method createSVGPathSegLinetoRel : number_t -> number_t -> pathSegLineto meth
 
   method createSVGPathSegCurvetoCubicAbs :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> pathSegCurvetoCubic meth
 
   method createSVGPathSegCurvetoCubicRel :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> pathSegCurvetoCubic meth
 
   method createSVGPathSegCurvetoQuadraticAbs :
-    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoQuadratic meth
 
   method createSVGPathSegCurvetoQuadraticRel :
-    number t -> number t -> number t -> number t -> pathSegCurvetoQuadratic meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoQuadratic meth
 
   method createSVGPathSegArcAbs :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> bool t
     -> bool t
     -> pathSegArc meth
 
   method createSVGPathSegArcRel :
-       number t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> bool t
     -> bool t
     -> pathSegArc meth
 
-  method createSVGPathSegLinetoHorizontalAbs : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalAbs : number_t -> pathSegLinetoHorizontal meth
 
-  method createSVGPathSegLinetoHorizontalRel : number t -> pathSegLinetoHorizontal meth
+  method createSVGPathSegLinetoHorizontalRel : number_t -> pathSegLinetoHorizontal meth
 
-  method createSVGPathSegLinetoVerticalAbs : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalAbs : number_t -> pathSegLinetoVertical meth
 
-  method createSVGPathSegLinetoVerticalRel : number t -> pathSegLinetoVertical meth
+  method createSVGPathSegLinetoVerticalRel : number_t -> pathSegLinetoVertical meth
 
   method createSVGPathSegCurvetoCubicSmoothAbs :
-    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoCubicSmooth meth
 
   method createSVGPathSegCurvetoCubicSmoothRel :
-    number t -> number t -> number t -> number t -> pathSegCurvetoCubicSmooth meth
+    number_t -> number_t -> number_t -> number_t -> pathSegCurvetoCubicSmooth meth
 
   method createSVGPathSegCurvetoQuadraticSmoothAbs :
-    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+    number_t -> number_t -> pathSegCurvetoQuadraticSmooth meth
 
   method createSVGPathSegCurvetoQuadraticSmoothRel :
-    number t -> number t -> pathSegCurvetoQuadraticSmooth meth
+    number_t -> number_t -> pathSegCurvetoQuadraticSmooth meth
 end
 
 (* interface SVGRectElement *)
@@ -1172,9 +1172,9 @@ and textContentElement = object
 
   method getNumberOfChars : int meth
 
-  method getComputedTextLength : number t meth
+  method getComputedTextLength : number_t meth
 
-  method getSubStringLength : int -> int -> number t meth
+  method getSubStringLength : int -> int -> number_t meth
 
   method getStartPositionOfChar : int -> point t meth
 
@@ -1182,7 +1182,7 @@ and textContentElement = object
 
   method getExtentOfChar : int -> rect t meth
 
-  method getRotationOfChar : int -> number t meth
+  method getRotationOfChar : int -> number_t meth
 
   method getCharNumAtPosition : point -> int meth
 
@@ -1265,13 +1265,13 @@ and glyphRefElement = object
 
   method format : js_string t prop
 
-  method x : number t prop
+  method x : number_t prop
 
-  method y : number t prop
+  method y : number_t prop
 
-  method dx : number t prop
+  method dx : number_t prop
 
-  method dy : number t prop
+  method dy : number_t prop
 end
 
 (* interface SVGPaint : SVGColor { *)
@@ -1666,7 +1666,7 @@ end
 (*   readonly attribute SVGAnimatedNumber stdDeviationX; *)
 (*   readonly attribute SVGAnimatedNumber stdDeviationY; *)
 
-(*   void setStdDeviation(in number t stdDeviationX, in number t stdDeviationY) raises(DOMException); *)
+(*   void setStdDeviation(in float stdDeviationX, in float stdDeviationY) raises(DOMException); *)
 (* }; *)
 
 (* interface SVGFEImageElement : SVGElement, *)
@@ -1802,9 +1802,9 @@ end
 
 (* interface SVGZoomEvent : UIEvent *)
 (*   readonly attribute SVGRect zoomRectScreen; *)
-(*   readonly attribute number t previousScale; *)
+(*   readonly attribute float previousScale; *)
 (*   readonly attribute SVGPoint previousTranslate; *)
-(*   readonly attribute number t newScale; *)
+(*   readonly attribute float newScale; *)
 (*   readonly attribute SVGPoint newTranslate; *)
 (* }; *)
 
@@ -1819,11 +1819,11 @@ and animationElement = object
   (* inherit elementTimeControl *)
   method targetElement : element t readonly_prop
 
-  method getStartTime : number t meth
+  method getStartTime : number_t meth
 
-  method getCurrentTime : number t meth
+  method getCurrentTime : number_t meth
 
-  method getSimpleDuration : number t meth
+  method getSimpleDuration : number_t meth
 end
 
 (* interface SVGAnimateElement *)
diff --git a/lib/js_of_ocaml/file.ml b/lib/js_of_ocaml/file.ml
index 732776bfc1..12776afa0f 100644
--- a/lib/js_of_ocaml/file.ml
+++ b/lib/js_of_ocaml/file.ml
@@ -123,7 +123,7 @@ module CoerceTo = struct
     if instanceof e blob_constr then Js.some (Unsafe.coerce e : #blob t) else Js.null
 
   let string (e : file_any) =
-    if Js.equals (typeof e) (Js.string "string")
+    if Js.equals (typeof e) (string "string")
     then Js.some (Unsafe.coerce e : js_string t)
     else Js.null
 
diff --git a/lib/js_of_ocaml/geolocation.ml b/lib/js_of_ocaml/geolocation.ml
index 6e0d185ea1..56643aaa9d 100644
--- a/lib/js_of_ocaml/geolocation.ml
+++ b/lib/js_of_ocaml/geolocation.ml
@@ -23,19 +23,19 @@ type positionErrorCode
 type watchId
 
 class type coordinates = object
-  method latitude : Js.number Js.t Js.readonly_prop
+  method latitude : Js.number_t Js.readonly_prop
 
-  method longitude : Js.number Js.t Js.readonly_prop
+  method longitude : Js.number_t Js.readonly_prop
 
-  method altitude : Js.number Js.t Js.opt Js.readonly_prop
+  method altitude : Js.number_t Js.opt Js.readonly_prop
 
-  method accuracy : Js.number Js.t Js.readonly_prop
+  method accuracy : Js.number_t Js.readonly_prop
 
-  method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
+  method altitudeAccuracy : Js.number_t Js.opt Js.readonly_prop
 
-  method heading : Js.number Js.t Js.opt Js.readonly_prop
+  method heading : Js.number_t Js.opt Js.readonly_prop
 
-  method speed : Js.number Js.t Js.opt Js.readonly_prop
+  method speed : Js.number_t Js.opt Js.readonly_prop
 end
 
 class type position = object
diff --git a/lib/js_of_ocaml/geolocation.mli b/lib/js_of_ocaml/geolocation.mli
index 9e2561778d..3b562d3e25 100644
--- a/lib/js_of_ocaml/geolocation.mli
+++ b/lib/js_of_ocaml/geolocation.mli
@@ -45,19 +45,19 @@ type positionErrorCode
 type watchId
 
 class type coordinates = object
-  method latitude : Js.number Js.t Js.readonly_prop
+  method latitude : Js.number_t Js.readonly_prop
 
-  method longitude : Js.number Js.t Js.readonly_prop
+  method longitude : Js.number_t Js.readonly_prop
 
-  method altitude : Js.number Js.t Js.opt Js.readonly_prop
+  method altitude : Js.number_t Js.opt Js.readonly_prop
 
-  method accuracy : Js.number Js.t Js.readonly_prop
+  method accuracy : Js.number_t Js.readonly_prop
 
-  method altitudeAccuracy : Js.number Js.t Js.opt Js.readonly_prop
+  method altitudeAccuracy : Js.number_t Js.opt Js.readonly_prop
 
-  method heading : Js.number Js.t Js.opt Js.readonly_prop
+  method heading : Js.number_t Js.opt Js.readonly_prop
 
-  method speed : Js.number Js.t Js.opt Js.readonly_prop
+  method speed : Js.number_t Js.opt Js.readonly_prop
 end
 
 class type position = object
diff --git a/lib/js_of_ocaml/intersectionObserver.ml b/lib/js_of_ocaml/intersectionObserver.ml
index d802652561..3ef08d5c2d 100644
--- a/lib/js_of_ocaml/intersectionObserver.ml
+++ b/lib/js_of_ocaml/intersectionObserver.ml
@@ -7,11 +7,11 @@ class type intersectionObserverEntry = object
 
   method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-  method intersectionRatio : Js.number Js.t Js.readonly_prop
+  method intersectionRatio : Js.number_t Js.readonly_prop
 
   method isIntersecting : bool Js.t Js.readonly_prop
 
-  method time : Js.number Js.t Js.readonly_prop
+  method time : Js.number_t Js.readonly_prop
 end
 
 class type intersectionObserverOptions = object
@@ -19,7 +19,7 @@ class type intersectionObserverOptions = object
 
   method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-  method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
+  method threshold : Js.number_t Js.js_array Js.t Js.writeonly_prop
 end
 
 class type intersectionObserver = object
@@ -27,7 +27,7 @@ class type intersectionObserver = object
 
   method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-  method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
+  method thresholds : Js.number_t Js.js_array Js.t Js.readonly_prop
 
   method observe : #Dom.node Js.t -> unit Js.meth
 
diff --git a/lib/js_of_ocaml/intersectionObserver.mli b/lib/js_of_ocaml/intersectionObserver.mli
index 3a056608d4..6ec749e24c 100644
--- a/lib/js_of_ocaml/intersectionObserver.mli
+++ b/lib/js_of_ocaml/intersectionObserver.mli
@@ -13,11 +13,11 @@ class type intersectionObserverEntry = object
 
   method intersectionRect : Dom_html.clientRect Js.t Js.readonly_prop
 
-  method intersectionRatio : Js.number Js.t Js.readonly_prop
+  method intersectionRatio : Js.number_t Js.readonly_prop
 
   method isIntersecting : bool Js.t Js.readonly_prop
 
-  method time : Js.number Js.t Js.readonly_prop
+  method time : Js.number_t Js.readonly_prop
 end
 
 class type intersectionObserverOptions = object
@@ -25,7 +25,7 @@ class type intersectionObserverOptions = object
 
   method rootMargin : Js.js_string Js.t Js.writeonly_prop
 
-  method threshold : Js.number Js.t Js.js_array Js.t Js.writeonly_prop
+  method threshold : Js.number_t Js.js_array Js.t Js.writeonly_prop
 end
 
 class type intersectionObserver = object
@@ -33,7 +33,7 @@ class type intersectionObserver = object
 
   method rootMargin : Js.js_string Js.t Js.readonly_prop
 
-  method thresholds : Js.number Js.t Js.js_array Js.t Js.readonly_prop
+  method thresholds : Js.number_t Js.js_array Js.t Js.readonly_prop
 
   method observe : #Dom.node Js.t -> unit Js.meth
 
diff --git a/lib/js_of_ocaml/intl.mli b/lib/js_of_ocaml/intl.mli
index c5a064fccf..3cbf2ad281 100644
--- a/lib/js_of_ocaml/intl.mli
+++ b/lib/js_of_ocaml/intl.mli
@@ -95,7 +95,8 @@ if (Intl.is_supported()) then (
       (def (jas [| "de-u-co-phonebk" |])) undefined
     in
     let a = a##sort (wrap_callback
-                       (fun v1 v2 -> Js.float (float_of_int(collator##.compare v1 v2))))
+                       (fun v1 v2 ->
+                          Js.float (float_of_int(collator##.compare v1 v2))))
     in
     fc (a##join (string ", ")) ;
 
diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index a8e432c120..d432e83194 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -94,10 +94,6 @@ module Js = struct
 
   (****)
 
-  external equals : _ -> _ -> bool = "caml_js_equals"
-
-  external strict_equals : _ -> _ -> bool = "caml_js_strict_equals"
-
   type 'a opt = 'a
 
   type 'a optdef = 'a
@@ -147,6 +143,10 @@ module Js = struct
 
     let return = some
 
+    external equals : _ t -> _ t -> bool = "caml_js_equals"
+
+    external strict_equals : _ t -> _ t -> bool = "caml_js_strict_equals"
+
     let map x f = if equals x null then null else return (f x)
 
     let bind x f = if equals x null then null else f x
@@ -165,10 +165,6 @@ module Js = struct
       | Some x -> return x
 
     let to_option x = case x (fun () -> None) (fun x -> Some x)
-
-    external equals : 'a -> 'b -> bool = "caml_js_equals"
-
-    external strict_equals : 'a -> 'b -> bool = "caml_js_strict_equals"
   end
 
   module Optdef : OPT with type 'a t = 'a optdef = struct
@@ -178,6 +174,10 @@ module Js = struct
 
     let return = def
 
+    external equals : _ t -> _ t -> bool = "caml_js_equals"
+
+    external strict_equals : _ t -> _ t -> bool = "caml_js_strict_equals"
+
     let map x f = if strict_equals x undefined then undefined else return (f x)
 
     let bind x f = if strict_equals x undefined then undefined else f x
@@ -196,10 +196,6 @@ module Js = struct
       | Some x -> return x
 
     let to_option x = case x (fun () -> None) (fun x -> Some x)
-
-    external equals : 'a -> 'b -> bool = "caml_js_equals"
-
-    external strict_equals : 'a -> 'b -> bool = "caml_js_strict_equals"
   end
 
   (****)
@@ -236,6 +232,12 @@ module Js = struct
 
   (****)
 
+  external equals : _ t -> _ t -> bool = "caml_js_equals"
+
+  external strict_equals : _ t -> _ t -> bool = "caml_js_strict_equals"
+
+  (****)
+
   let _true = Unsafe.pure_js_expr "true"
 
   let _false = Unsafe.pure_js_expr "false"
@@ -350,6 +352,8 @@ module Js = struct
 
   and normalization = js_string
 
+  type number_t = number t
+
   (* string is used by ppx_js, it needs to come before any use of the
      new syntax in this file *)
   external string : string -> js_string t = "caml_jsstring_of_string"
@@ -406,7 +410,7 @@ class type ['a] js_array = object
 
   method slice_end : int -> 'a js_array t meth
 
-  method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
+  method sort : ('a -> 'a -> number_t) callback -> 'a js_array t meth
 
   method sort_asStrings : 'a js_array t meth
 
@@ -484,10 +488,6 @@ let str_array : string_array t -> js_string t js_array t = Unsafe.coerce
 
 let match_result : match_result_handle t -> match_result t = Unsafe.coerce
 
-external number_of_float : float -> number t = "caml_js_from_float"
-
-external float_of_number : number t -> float = "caml_js_to_float"
-
 class type date = object
   method toString : js_string t meth
 
@@ -501,9 +501,9 @@ class type date = object
 
   method toLocaleTimeString : js_string t meth
 
-  method valueOf : number t meth
+  method valueOf : number_t meth
 
-  method getTime : number t meth
+  method getTime : number_t meth
 
   method getFullYear : int meth
 
@@ -539,39 +539,39 @@ class type date = object
 
   method getTimezoneOffset : int meth
 
-  method setTime : number t -> number t meth
+  method setTime : number_t -> number_t meth
 
-  method setFullYear : int -> number t meth
+  method setFullYear : int -> number_t meth
 
-  method setUTCFullYear : int -> number t meth
+  method setUTCFullYear : int -> number_t meth
 
-  method setMonth : int -> number t meth
+  method setMonth : int -> number_t meth
 
-  method setUTCMonth : int -> number t meth
+  method setUTCMonth : int -> number_t meth
 
-  method setDate : int -> number t meth
+  method setDate : int -> number_t meth
 
-  method setUTCDate : int -> number t meth
+  method setUTCDate : int -> number_t meth
 
-  method setDay : int -> number t meth
+  method setDay : int -> number_t meth
 
-  method setUTCDay : int -> number t meth
+  method setUTCDay : int -> number_t meth
 
-  method setHours : int -> number t meth
+  method setHours : int -> number_t meth
 
-  method setUTCHours : int -> number t meth
+  method setUTCHours : int -> number_t meth
 
-  method setMinutes : int -> number t meth
+  method setMinutes : int -> number_t meth
 
-  method setUTCMinutes : int -> number t meth
+  method setUTCMinutes : int -> number_t meth
 
-  method setSeconds : int -> number t meth
+  method setSeconds : int -> number_t meth
 
-  method setUTCSeconds : int -> number t meth
+  method setUTCSeconds : int -> number_t meth
 
-  method setMilliseconds : int -> number t meth
+  method setMilliseconds : int -> number_t meth
 
-  method setUTCMilliseconds : int -> number t meth
+  method setUTCMilliseconds : int -> number_t meth
 
   method toUTCString : js_string t meth
 
@@ -581,21 +581,21 @@ class type date = object
 end
 
 class type date_constr = object
-  method parse : js_string t -> number t meth
+  method parse : js_string t -> number_t meth
 
-  method _UTC_month : int -> int -> number t meth
+  method _UTC_month : int -> int -> number_t meth
 
-  method _UTC_day : int -> int -> number t meth
+  method _UTC_day : int -> int -> number_t meth
 
-  method _UTC_hour : int -> int -> int -> int -> number t meth
+  method _UTC_hour : int -> int -> int -> int -> number_t meth
 
-  method _UTC_min : int -> int -> int -> int -> int -> number t meth
+  method _UTC_min : int -> int -> int -> int -> int -> number_t meth
 
-  method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_sec : int -> int -> int -> int -> int -> int -> number_t meth
 
-  method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number_t meth
 
-  method now : number t meth
+  method now : number_t meth
 end
 
 let date_constr = Unsafe.global##._Date
@@ -604,7 +604,7 @@ let date : date_constr t = date_constr
 
 let date_now : date t constr = date_constr
 
-let date_fromTimeValue : (number t -> date t) constr = date_constr
+let date_fromTimeValue : (number_t -> date t) constr = date_constr
 
 let date_month : (int -> int -> date t) constr = date_constr
 
@@ -620,65 +620,65 @@ let date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr =
   date_constr
 
 class type math = object
-  method _E : number t readonly_prop
+  method _E : number_t readonly_prop
 
-  method _LN2 : number t readonly_prop
+  method _LN2 : number_t readonly_prop
 
-  method _LN10 : number t readonly_prop
+  method _LN10 : number_t readonly_prop
 
-  method _LOG2E : number t readonly_prop
+  method _LOG2E : number_t readonly_prop
 
-  method _LOG10E : number t readonly_prop
+  method _LOG10E : number_t readonly_prop
 
-  method _PI : number t readonly_prop
+  method _PI : number_t readonly_prop
 
-  method _SQRT1_2_ : number t readonly_prop
+  method _SQRT1_2_ : number_t readonly_prop
 
-  method _SQRT2 : number t readonly_prop
+  method _SQRT2 : number_t readonly_prop
 
-  method abs : number t -> number t meth
+  method abs : number_t -> number_t meth
 
-  method acos : number t -> number t meth
+  method acos : number_t -> number_t meth
 
-  method asin : number t -> number t meth
+  method asin : number_t -> number_t meth
 
-  method atan : number t -> number t meth
+  method atan : number_t -> number_t meth
 
-  method atan2 : number t -> number t -> number t meth
+  method atan2 : number_t -> number_t -> number_t meth
 
-  method ceil : number t -> number t meth
+  method ceil : number_t -> number_t meth
 
-  method cos : number t -> number t meth
+  method cos : number_t -> number_t meth
 
-  method exp : number t -> number t meth
+  method exp : number_t -> number_t meth
 
-  method floor : number t -> number t meth
+  method floor : number_t -> number_t meth
 
-  method log : number t -> number t meth
+  method log : number_t -> number_t meth
 
-  method max : number t -> number t -> number t meth
+  method max : number_t -> number_t -> number_t meth
 
-  method max_3 : number t -> number t -> number t -> number t meth
+  method max_3 : number_t -> number_t -> number_t -> number_t meth
 
-  method max_4 : number t -> number t -> number t -> number t -> number t meth
+  method max_4 : number_t -> number_t -> number_t -> number_t -> number_t meth
 
-  method min : number t -> number t -> number t meth
+  method min : number_t -> number_t -> number_t meth
 
-  method min_3 : number t -> number t -> number t -> number t meth
+  method min_3 : number_t -> number_t -> number_t -> number_t meth
 
-  method min_4 : number t -> number t -> number t -> number t -> number t meth
+  method min_4 : number_t -> number_t -> number_t -> number_t -> number_t meth
 
-  method pow : number t -> number t -> number t meth
+  method pow : number_t -> number_t -> number_t meth
 
-  method random : number t meth
+  method random : number_t meth
 
-  method round : number t -> number t meth
+  method round : number_t -> number_t meth
 
-  method sin : number t -> number t meth
+  method sin : number_t -> number_t meth
 
-  method sqrt : number t -> number t meth
+  method sqrt : number_t -> number_t meth
 
-  method tan : number t -> number t meth
+  method tan : number_t -> number_t meth
 end
 
 let math = Unsafe.global##._Math
@@ -781,17 +781,21 @@ external bytestring : string -> js_string t = "caml_jsbytes_of_string"
 
 external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
 
-external float : float -> number t = "caml_js_from_float"
+external float : float -> number_t = "caml_js_from_float"
+
+external to_float : number_t -> float = "caml_js_to_float"
 
-external to_float : number t -> float = "caml_js_to_float"
+external number_of_float : float -> number t = "caml_js_from_float"
+
+external float_of_number : number t -> float = "caml_js_to_float"
 
-external int32 : int32 -> number t = "caml_js_from_int32"
+external int32 : int32 -> number_t = "caml_js_from_int32"
 
-external to_int32 : number t -> int32 = "caml_js_to_int32"
+external to_int32 : number_t -> int32 = "caml_js_to_int32"
 
-external nativeint : nativeint -> number t = "caml_js_from_nativeint"
+external nativeint : nativeint -> number_t = "caml_js_from_nativeint"
 
-external to_nativeint : number t -> nativeint = "caml_js_to_nativeint"
+external to_nativeint : number_t -> nativeint = "caml_js_to_nativeint"
 
 external typeof : _ t -> js_string t = "caml_js_typeof"
 
@@ -804,7 +808,7 @@ let parseInt (s : js_string t) : int =
   let s = Unsafe.fun_call Unsafe.global##.parseInt [| Unsafe.inject s |] in
   if isNaN s then failwith "parseInt" else s
 
-let parseFloat (s : js_string t) : number t =
+let parseFloat (s : js_string t) : number_t =
   let s = Unsafe.fun_call Unsafe.global##.parseFloat [| Unsafe.inject s |] in
   if isNaN s then failwith "parseFloat" else s
 
@@ -844,4 +848,4 @@ let export_all obj =
 
 (* DEPRECATED *)
 
-type float_prop = number t prop
+type float_prop = number_t prop
diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli
index 17d887827d..183692ddd5 100644
--- a/lib/js_of_ocaml/js.mli
+++ b/lib/js_of_ocaml/js.mli
@@ -325,6 +325,8 @@ and regExp = object
   method lastIndex : int prop
 end
 
+type number_t = number t
+
 (** Specification of the string constructor, considered as an object. *)
 class type string_constr = object
   method fromCharCode : int -> js_string t meth
@@ -375,7 +377,7 @@ class type ['a] js_array = object
 
   method slice_end : int -> 'a js_array t meth
 
-  method sort : ('a -> 'a -> number t) callback -> 'a js_array t meth
+  method sort : ('a -> 'a -> number_t) callback -> 'a js_array t meth
 
   method sort_asStrings : 'a js_array t meth
 
@@ -478,9 +480,9 @@ class type date = object
 
   method toLocaleTimeString : js_string t meth
 
-  method valueOf : number t meth
+  method valueOf : number_t meth
 
-  method getTime : number t meth
+  method getTime : number_t meth
 
   method getFullYear : int meth
 
@@ -516,39 +518,39 @@ class type date = object
 
   method getTimezoneOffset : int meth
 
-  method setTime : number t -> number t meth
+  method setTime : number_t -> number_t meth
 
-  method setFullYear : int -> number t meth
+  method setFullYear : int -> number_t meth
 
-  method setUTCFullYear : int -> number t meth
+  method setUTCFullYear : int -> number_t meth
 
-  method setMonth : int -> number t meth
+  method setMonth : int -> number_t meth
 
-  method setUTCMonth : int -> number t meth
+  method setUTCMonth : int -> number_t meth
 
-  method setDate : int -> number t meth
+  method setDate : int -> number_t meth
 
-  method setUTCDate : int -> number t meth
+  method setUTCDate : int -> number_t meth
 
-  method setDay : int -> number t meth
+  method setDay : int -> number_t meth
 
-  method setUTCDay : int -> number t meth
+  method setUTCDay : int -> number_t meth
 
-  method setHours : int -> number t meth
+  method setHours : int -> number_t meth
 
-  method setUTCHours : int -> number t meth
+  method setUTCHours : int -> number_t meth
 
-  method setMinutes : int -> number t meth
+  method setMinutes : int -> number_t meth
 
-  method setUTCMinutes : int -> number t meth
+  method setUTCMinutes : int -> number_t meth
 
-  method setSeconds : int -> number t meth
+  method setSeconds : int -> number_t meth
 
-  method setUTCSeconds : int -> number t meth
+  method setUTCSeconds : int -> number_t meth
 
-  method setMilliseconds : int -> number t meth
+  method setMilliseconds : int -> number_t meth
 
-  method setUTCMilliseconds : int -> number t meth
+  method setUTCMilliseconds : int -> number_t meth
 
   method toUTCString : js_string t meth
 
@@ -561,7 +563,7 @@ val date_now : date t constr
 (** Constructor of [Date] objects: [new%js date_now] returns a
       [Date] object initialized with the current date. *)
 
-val date_fromTimeValue : (number t -> date t) constr
+val date_fromTimeValue : (number_t -> date t) constr
 (** Constructor of [Date] objects: [new%js date_fromTimeValue t] returns a
       [Date] object initialized with the time value [t]. *)
 
@@ -595,21 +597,21 @@ val date_ms : (int -> int -> int -> int -> int -> int -> int -> date t) constr
 
 (** Specification of the date constructor, considered as an object. *)
 class type date_constr = object
-  method parse : js_string t -> number t meth
+  method parse : js_string t -> number_t meth
 
-  method _UTC_month : int -> int -> number t meth
+  method _UTC_month : int -> int -> number_t meth
 
-  method _UTC_day : int -> int -> number t meth
+  method _UTC_day : int -> int -> number_t meth
 
-  method _UTC_hour : int -> int -> int -> int -> number t meth
+  method _UTC_hour : int -> int -> int -> int -> number_t meth
 
-  method _UTC_min : int -> int -> int -> int -> int -> number t meth
+  method _UTC_min : int -> int -> int -> int -> int -> number_t meth
 
-  method _UTC_sec : int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_sec : int -> int -> int -> int -> int -> int -> number_t meth
 
-  method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number t meth
+  method _UTC_ms : int -> int -> int -> int -> int -> int -> int -> number_t meth
 
-  method now : number t meth
+  method now : number_t meth
 end
 
 val date : date_constr t
@@ -617,65 +619,65 @@ val date : date_constr t
 
 (** Specification of Javascript math object. *)
 class type math = object
-  method _E : number t readonly_prop
+  method _E : number_t readonly_prop
 
-  method _LN2 : number t readonly_prop
+  method _LN2 : number_t readonly_prop
 
-  method _LN10 : number t readonly_prop
+  method _LN10 : number_t readonly_prop
 
-  method _LOG2E : number t readonly_prop
+  method _LOG2E : number_t readonly_prop
 
-  method _LOG10E : number t readonly_prop
+  method _LOG10E : number_t readonly_prop
 
-  method _PI : number t readonly_prop
+  method _PI : number_t readonly_prop
 
-  method _SQRT1_2_ : number t readonly_prop
+  method _SQRT1_2_ : number_t readonly_prop
 
-  method _SQRT2 : number t readonly_prop
+  method _SQRT2 : number_t readonly_prop
 
-  method abs : number t -> number t meth
+  method abs : number_t -> number_t meth
 
-  method acos : number t -> number t meth
+  method acos : number_t -> number_t meth
 
-  method asin : number t -> number t meth
+  method asin : number_t -> number_t meth
 
-  method atan : number t -> number t meth
+  method atan : number_t -> number_t meth
 
-  method atan2 : number t -> number t -> number t meth
+  method atan2 : number_t -> number_t -> number_t meth
 
-  method ceil : number t -> number t meth
+  method ceil : number_t -> number_t meth
 
-  method cos : number t -> number t meth
+  method cos : number_t -> number_t meth
 
-  method exp : number t -> number t meth
+  method exp : number_t -> number_t meth
 
-  method floor : number t -> number t meth
+  method floor : number_t -> number_t meth
 
-  method log : number t -> number t meth
+  method log : number_t -> number_t meth
 
-  method max : number t -> number t -> number t meth
+  method max : number_t -> number_t -> number_t meth
 
-  method max_3 : number t -> number t -> number t -> number t meth
+  method max_3 : number_t -> number_t -> number_t -> number_t meth
 
-  method max_4 : number t -> number t -> number t -> number t -> number t meth
+  method max_4 : number_t -> number_t -> number_t -> number_t -> number_t meth
 
-  method min : number t -> number t -> number t meth
+  method min : number_t -> number_t -> number_t meth
 
-  method min_3 : number t -> number t -> number t -> number t meth
+  method min_3 : number_t -> number_t -> number_t -> number_t meth
 
-  method min_4 : number t -> number t -> number t -> number t -> number t meth
+  method min_4 : number_t -> number_t -> number_t -> number_t -> number_t meth
 
-  method pow : number t -> number t -> number t meth
+  method pow : number_t -> number_t -> number_t meth
 
-  method random : number t meth
+  method random : number_t meth
 
-  method round : number t -> number t meth
+  method round : number_t -> number_t meth
 
-  method sin : number t -> number t meth
+  method sin : number_t -> number_t meth
 
-  method sqrt : number t -> number t meth
+  method sqrt : number_t -> number_t meth
 
-  method tan : number t -> number t meth
+  method tan : number_t -> number_t meth
 end
 
 val math : math t
@@ -776,7 +778,7 @@ val isNaN : 'a -> bool
 
 val parseInt : js_string t -> int
 
-val parseFloat : js_string t -> number t
+val parseFloat : js_string t -> number_t
 
 (** {2 Conversion functions between Javascript and OCaml types} *)
 
@@ -809,10 +811,10 @@ external to_bytestring : js_string t -> string = "caml_string_of_jsbytes"
       Javascript string should only contain UTF-16 code points below
       255.) *)
 
-external float : float -> number t = "caml_js_from_float"
+external float : float -> number_t = "caml_js_from_float"
 (** Conversion of OCaml floats to Javascript numbers. *)
 
-external to_float : number t -> float = "caml_js_to_float"
+external to_float : number_t -> float = "caml_js_to_float"
 (** Conversion of Javascript numbers to OCaml floats. *)
 
 external number_of_float : float -> number t = "caml_js_from_float"
@@ -821,18 +823,19 @@ external number_of_float : float -> number t = "caml_js_from_float"
 external float_of_number : number t -> float = "caml_js_to_float"
 (** Conversion of Javascript number objects to OCaml floats. *)
 
-external int32 : int32 -> number t = "caml_js_from_int32"
+external int32 : int32 -> number_t = "caml_js_from_int32"
 (** Conversion of OCaml floats to Javascript numbers. *)
 
-external to_int32 : number t -> int32 = "caml_js_to_int32"
-(** Conversion of Javascript numbers to OCaml 32-bits. *)
+external to_int32 : number_t -> int32 = "caml_js_to_int32"
+(** Conversion of Javascript numbers to OCaml 32-bits. The given
+    floating-point number is truncated to an integer. *)
 
-external nativeint : nativeint -> number t = "caml_js_from_nativeint"
+external nativeint : nativeint -> number_t = "caml_js_from_nativeint"
 (** Conversion of OCaml 32-bits integers to Javascript numbers. *)
 
-external to_nativeint : number t -> nativeint = "caml_js_to_nativeint"
-
-(** Conversion of Javascript numbers to OCaml native integers. *)
+external to_nativeint : number_t -> nativeint = "caml_js_to_nativeint"
+(** Conversion of Javascript numbers to OCaml native integers. The
+    given floating-point number is truncated to an integer. *)
 
 (** {2 Convenience coercion functions} *)
 
@@ -1045,6 +1048,6 @@ exception Error of error t [@ocaml.deprecated "[since 4.0] Use [Js_error.Exn] in
     it will be serialized and wrapped into a [Failure] exception.
   *)
 
-type float_prop = number t prop [@@ocaml.deprecated "[since 2.0]."]
+type float_prop = number_t prop [@@ocaml.deprecated "[since 2.0]."]
 
 (** Type of float properties. *)
diff --git a/lib/js_of_ocaml/performanceObserver.ml b/lib/js_of_ocaml/performanceObserver.ml
index a0fd42fdfb..c98397b79b 100644
--- a/lib/js_of_ocaml/performanceObserver.ml
+++ b/lib/js_of_ocaml/performanceObserver.ml
@@ -28,9 +28,9 @@ class type performanceEntry = object
 
   method entryType : Js.js_string Js.t Js.readonly_prop
 
-  method startTime : Js.number Js.t Js.readonly_prop
+  method startTime : Js.number_t Js.readonly_prop
 
-  method duration : Js.number Js.t Js.readonly_prop
+  method duration : Js.number_t Js.readonly_prop
 end
 
 class type performanceObserverEntryList = object
diff --git a/lib/js_of_ocaml/performanceObserver.mli b/lib/js_of_ocaml/performanceObserver.mli
index 4ec3116e46..c0a073b8a2 100644
--- a/lib/js_of_ocaml/performanceObserver.mli
+++ b/lib/js_of_ocaml/performanceObserver.mli
@@ -44,9 +44,9 @@ class type performanceEntry = object
 
   method entryType : Js.js_string Js.t Js.readonly_prop
 
-  method startTime : Js.number Js.t Js.readonly_prop
+  method startTime : Js.number_t Js.readonly_prop
 
-  method duration : Js.number Js.t Js.readonly_prop
+  method duration : Js.number_t Js.readonly_prop
 end
 
 class type performanceObserverEntryList = object
diff --git a/lib/js_of_ocaml/resizeObserver.ml b/lib/js_of_ocaml/resizeObserver.ml
index eb4501974a..9b3552b05b 100644
--- a/lib/js_of_ocaml/resizeObserver.ml
+++ b/lib/js_of_ocaml/resizeObserver.ml
@@ -19,9 +19,9 @@
 open! Import
 
 class type resizeObserverSize = object
-  method inlineSize : Js.number Js.t Js.readonly_prop
+  method inlineSize : Js.number_t Js.readonly_prop
 
-  method blockSize : Js.number Js.t Js.readonly_prop
+  method blockSize : Js.number_t Js.readonly_prop
 end
 
 class type resizeObserverEntry = object
diff --git a/lib/js_of_ocaml/resizeObserver.mli b/lib/js_of_ocaml/resizeObserver.mli
index e1e0f7a245..df6874437e 100644
--- a/lib/js_of_ocaml/resizeObserver.mli
+++ b/lib/js_of_ocaml/resizeObserver.mli
@@ -42,9 +42,9 @@
 *)
 
 class type resizeObserverSize = object
-  method inlineSize : Js.number Js.t Js.readonly_prop
+  method inlineSize : Js.number_t Js.readonly_prop
 
-  method blockSize : Js.number Js.t Js.readonly_prop
+  method blockSize : Js.number_t Js.readonly_prop
 end
 
 class type resizeObserverEntry = object
diff --git a/lib/js_of_ocaml/webGL.ml b/lib/js_of_ocaml/webGL.ml
index b54a7110b8..bd3412c53f 100644
--- a/lib/js_of_ocaml/webGL.ml
+++ b/lib/js_of_ocaml/webGL.ml
@@ -31,7 +31,7 @@ type intptr = int
 
 type uint = int
 
-type clampf = number t
+type clampf = number_t
 
 type void
 
@@ -239,11 +239,11 @@ class type renderingContext = object
 
   method isEnabled : enableCap -> bool t meth
 
-  method lineWidth : number t -> unit meth
+  method lineWidth : number_t -> unit meth
 
   method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-  method polygonOffset : number t -> number t -> unit meth
+  method polygonOffset : number_t -> number_t -> unit meth
 
   method sampleCoverage : clampf -> bool t -> unit meth
 
@@ -437,7 +437,7 @@ class type renderingContext = object
     -> unit meth
 
   (* {[
-      method texParameterf : texTarget -> texParam -> number t -> unit meth
+      method texParameterf : texTarget -> texParam -> number_t -> unit meth
      ]}
   *)
   method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
@@ -559,12 +559,12 @@ class type renderingContext = object
 
   method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-  method uniform1f : number t uniformLocation t -> number t -> unit meth
+  method uniform1f : number_t uniformLocation t -> number_t -> unit meth
 
   method uniform1fv_typed :
-    number t uniformLocation t -> Typed_array.float32Array t -> unit meth
+    number_t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
+  method uniform1fv : number_t uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform1i : int uniformLocation t -> int -> unit meth
 
@@ -572,12 +572,12 @@ class type renderingContext = object
 
   method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-  method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
+  method uniform2f : [ `vec2 ] uniformLocation t -> number_t -> number_t -> unit meth
 
   method uniform2fv_typed :
     [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform2fv : [ `vec2 ] uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
@@ -587,12 +587,12 @@ class type renderingContext = object
     [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
   method uniform3f :
-    [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
+    [ `vec3 ] uniformLocation t -> number_t -> number_t -> number_t -> unit meth
 
   method uniform3fv_typed :
     [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform3fv : [ `vec3 ] uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
@@ -603,16 +603,16 @@ class type renderingContext = object
 
   method uniform4f :
        [ `vec4 ] uniformLocation t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
   method uniform4fv_typed :
     [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform4fv : [ `vec4 ] uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform4i : [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
 
@@ -622,45 +622,45 @@ class type renderingContext = object
     [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
   method uniformMatrix2fv :
-    [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+    [ `mat2 ] uniformLocation t -> bool t -> number_t js_array t -> unit meth
 
   method uniformMatrix2fv_typed :
     [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
   method uniformMatrix3fv :
-    [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+    [ `mat3 ] uniformLocation t -> bool t -> number_t js_array t -> unit meth
 
   method uniformMatrix3fv_typed :
     [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
   method uniformMatrix4fv :
-    [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+    [ `mat4 ] uniformLocation t -> bool t -> number_t js_array t -> unit meth
 
   method uniformMatrix4fv_typed :
     [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-  method vertexAttrib1f : uint -> number t -> unit meth
+  method vertexAttrib1f : uint -> number_t -> unit meth
 
-  method vertexAttrib1fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib1fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-  method vertexAttrib2f : uint -> number t -> number t -> unit meth
+  method vertexAttrib2f : uint -> number_t -> number_t -> unit meth
 
-  method vertexAttrib2fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib2fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-  method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
+  method vertexAttrib3f : uint -> number_t -> number_t -> number_t -> unit meth
 
-  method vertexAttrib3fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib3fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
   method vertexAttrib4f :
-    uint -> number t -> number t -> number t -> number t -> unit meth
+    uint -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method vertexAttrib4fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib4fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
@@ -854,7 +854,7 @@ class type renderingContext = object
 
   method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-  method _LINE_WIDTH_ : number t parameter readonly_prop
+  method _LINE_WIDTH_ : number_t parameter readonly_prop
 
   method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
@@ -868,7 +868,7 @@ class type renderingContext = object
 
   method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-  method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
+  method _DEPTH_CLEAR_VALUE_ : number_t parameter readonly_prop
 
   method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
@@ -932,9 +932,9 @@ class type renderingContext = object
 
   method _STENCIL_BITS_ : int parameter readonly_prop
 
-  method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_UNITS_ : number_t parameter readonly_prop
 
-  method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_FACTOR_ : number_t parameter readonly_prop
 
   method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
@@ -944,7 +944,7 @@ class type renderingContext = object
 
   method _SAMPLES_ : int parameter readonly_prop
 
-  method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
+  method _SAMPLE_COVERAGE_VALUE_ : number_t parameter readonly_prop
 
   method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
diff --git a/lib/js_of_ocaml/webGL.mli b/lib/js_of_ocaml/webGL.mli
index 58b8174c9d..5d84d6b713 100644
--- a/lib/js_of_ocaml/webGL.mli
+++ b/lib/js_of_ocaml/webGL.mli
@@ -32,7 +32,7 @@ type intptr = int
 
 type uint = int
 
-type clampf = number t
+type clampf = number_t
 
 type void
 
@@ -229,11 +229,11 @@ class type renderingContext = object
 
   method isEnabled : enableCap -> bool t meth
 
-  method lineWidth : number t -> unit meth
+  method lineWidth : number_t -> unit meth
 
   method pixelStorei : 'a. 'a pixelStoreParam -> 'a -> unit meth
 
-  method polygonOffset : number t -> number t -> unit meth
+  method polygonOffset : number_t -> number_t -> unit meth
 
   method sampleCoverage : clampf -> bool t -> unit meth
 
@@ -427,7 +427,7 @@ class type renderingContext = object
     -> unit meth
 
   (* {[
-       method texParameterf : texTarget -> texParam -> number t -> unit meth
+       method texParameterf : texTarget -> texParam -> number_t -> unit meth
      ]}
   *)
   method texParameteri : texTarget -> 'a texParam -> 'a -> unit meth
@@ -549,12 +549,12 @@ class type renderingContext = object
 
   method getVertexAttribOffset : uint -> vertexAttribPointerParam -> sizeiptr meth
 
-  method uniform1f : number t uniformLocation t -> number t -> unit meth
+  method uniform1f : number_t uniformLocation t -> number_t -> unit meth
 
   method uniform1fv_typed :
-    number t uniformLocation t -> Typed_array.float32Array t -> unit meth
+    number_t uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform1fv : number t uniformLocation t -> number t js_array t -> unit meth
+  method uniform1fv : number_t uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform1i : int uniformLocation t -> int -> unit meth
 
@@ -562,12 +562,12 @@ class type renderingContext = object
 
   method uniform1iv : int uniformLocation t -> int js_array t -> unit meth
 
-  method uniform2f : [ `vec2 ] uniformLocation t -> number t -> number t -> unit meth
+  method uniform2f : [ `vec2 ] uniformLocation t -> number_t -> number_t -> unit meth
 
   method uniform2fv_typed :
     [ `vec2 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform2fv : [ `vec2 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform2fv : [ `vec2 ] uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform2i : [ `ivec2 ] uniformLocation t -> int -> int -> unit meth
 
@@ -577,12 +577,12 @@ class type renderingContext = object
     [ `ivec2 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
   method uniform3f :
-    [ `vec3 ] uniformLocation t -> number t -> number t -> number t -> unit meth
+    [ `vec3 ] uniformLocation t -> number_t -> number_t -> number_t -> unit meth
 
   method uniform3fv_typed :
     [ `vec3 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform3fv : [ `vec3 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform3fv : [ `vec3 ] uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform3i : [ `ivec3 ] uniformLocation t -> int -> int -> int -> unit meth
 
@@ -593,16 +593,16 @@ class type renderingContext = object
 
   method uniform4f :
        [ `vec4 ] uniformLocation t
-    -> number t
-    -> number t
-    -> number t
-    -> number t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
     -> unit meth
 
   method uniform4fv_typed :
     [ `vec4 ] uniformLocation t -> Typed_array.float32Array t -> unit meth
 
-  method uniform4fv : [ `vec4 ] uniformLocation t -> number t js_array t -> unit meth
+  method uniform4fv : [ `vec4 ] uniformLocation t -> number_t js_array t -> unit meth
 
   method uniform4i : [ `ivec4 ] uniformLocation t -> int -> int -> int -> int -> unit meth
 
@@ -612,45 +612,45 @@ class type renderingContext = object
     [ `ivec4 ] uniformLocation t -> Typed_array.int32Array t -> unit meth
 
   method uniformMatrix2fv :
-    [ `mat2 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+    [ `mat2 ] uniformLocation t -> bool t -> number_t js_array t -> unit meth
 
   method uniformMatrix2fv_typed :
     [ `mat2 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
   method uniformMatrix3fv :
-    [ `mat3 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+    [ `mat3 ] uniformLocation t -> bool t -> number_t js_array t -> unit meth
 
   method uniformMatrix3fv_typed :
     [ `mat3 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
   method uniformMatrix4fv :
-    [ `mat4 ] uniformLocation t -> bool t -> number t js_array t -> unit meth
+    [ `mat4 ] uniformLocation t -> bool t -> number_t js_array t -> unit meth
 
   method uniformMatrix4fv_typed :
     [ `mat4 ] uniformLocation t -> bool t -> Typed_array.float32Array t -> unit meth
 
-  method vertexAttrib1f : uint -> number t -> unit meth
+  method vertexAttrib1f : uint -> number_t -> unit meth
 
-  method vertexAttrib1fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib1fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib1fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-  method vertexAttrib2f : uint -> number t -> number t -> unit meth
+  method vertexAttrib2f : uint -> number_t -> number_t -> unit meth
 
-  method vertexAttrib2fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib2fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib2fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
-  method vertexAttrib3f : uint -> number t -> number t -> number t -> unit meth
+  method vertexAttrib3f : uint -> number_t -> number_t -> number_t -> unit meth
 
-  method vertexAttrib3fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib3fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib3fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
   method vertexAttrib4f :
-    uint -> number t -> number t -> number t -> number t -> unit meth
+    uint -> number_t -> number_t -> number_t -> number_t -> unit meth
 
-  method vertexAttrib4fv : uint -> number t js_array t -> unit meth
+  method vertexAttrib4fv : uint -> number_t js_array t -> unit meth
 
   method vertexAttrib4fv_typed : uint -> Typed_array.float32Array t -> unit meth
 
@@ -844,7 +844,7 @@ class type renderingContext = object
 
   method _POLYGON_OFFSET_FILL_PARAM : bool t parameter readonly_prop
 
-  method _LINE_WIDTH_ : number t parameter readonly_prop
+  method _LINE_WIDTH_ : number_t parameter readonly_prop
 
   method _ALIASED_POINT_SIZE_RANGE_ : Typed_array.float32Array t parameter readonly_prop
 
@@ -858,7 +858,7 @@ class type renderingContext = object
 
   method _DEPTH_WRITEMASK_ : bool t parameter readonly_prop
 
-  method _DEPTH_CLEAR_VALUE_ : number t parameter readonly_prop
+  method _DEPTH_CLEAR_VALUE_ : number_t parameter readonly_prop
 
   method _DEPTH_FUNC_ : depthFunction parameter readonly_prop
 
@@ -922,9 +922,9 @@ class type renderingContext = object
 
   method _STENCIL_BITS_ : int parameter readonly_prop
 
-  method _POLYGON_OFFSET_UNITS_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_UNITS_ : number_t parameter readonly_prop
 
-  method _POLYGON_OFFSET_FACTOR_ : number t parameter readonly_prop
+  method _POLYGON_OFFSET_FACTOR_ : number_t parameter readonly_prop
 
   method _TEXTURE_BINDING_2D_ : texture t opt parameter readonly_prop
 
@@ -934,7 +934,7 @@ class type renderingContext = object
 
   method _SAMPLES_ : int parameter readonly_prop
 
-  method _SAMPLE_COVERAGE_VALUE_ : number t parameter readonly_prop
+  method _SAMPLE_COVERAGE_VALUE_ : number_t parameter readonly_prop
 
   method _SAMPLE_COVERAGE_INVERT_ : bool t parameter readonly_prop
 
diff --git a/lib/lwt/lwt_js_events.ml b/lib/lwt/lwt_js_events.ml
index 7ccbae9358..b582e0901b 100644
--- a/lib/lwt/lwt_js_events.ml
+++ b/lib/lwt/lwt_js_events.ml
@@ -610,7 +610,7 @@ let request_animation_frame () =
   let t, s = Lwt.wait () in
   let (_ : Dom_html.animation_frame_request_id) =
     Dom_html.window##requestAnimationFrame
-      (Js.wrap_callback (fun (_ : Js.number Js.t) -> Lwt.wakeup s ()))
+      (Js.wrap_callback (fun (_ : Js.number_t) -> Lwt.wakeup s ()))
   in
   t
 

From a9b5bea7842e9068dc36e93fef6e9c416276c7ff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 19 Jul 2024 18:03:34 +0200
Subject: [PATCH 275/481] Effects: make continuation format compatible with
 OCaml 5.2

---
 runtime/wasm/effect.wat | 75 ++++++++++++++++++++++++++---------------
 runtime/wasm/obj.wat    |  2 +-
 2 files changed, 49 insertions(+), 28 deletions(-)

diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index cbc35f3826..6d17704405 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -22,6 +22,7 @@
       (func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))))
    (import "obj" "caml_fresh_oo_id"
      (func $caml_fresh_oo_id (param (ref eq)) (result (ref eq))))
+   (import "obj" "cont_tag" (global $cont_tag i32))
    (import "stdlib" "caml_named_value"
       (func $caml_named_value (param (ref $string)) (result (ref null eq))))
    (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
@@ -123,8 +124,6 @@
             (field $suspender externref)
             (field $next (ref null $fiber)))))
 
-   (type $continuation (struct (mut eqref)))
-
    (data $effect_unhandled "Effect.Unhandled")
 
    (func $raise_unhandled
@@ -152,8 +151,9 @@
       (local.set $k'
          (call $push_stack
             (ref.cast (ref $fiber)
-               (struct.get $continuation 0
-                  (ref.cast (ref $continuation) (local.get $cont))))
+               (array.get $block
+                  (ref.cast (ref $block) (local.get $cont))
+                  (i32.const 1)))
             (ref.cast (ref $cont) (local.get $k))))
       (call_ref $cont_func
          (struct.new $pair
@@ -273,25 +273,30 @@
 
    (func $do_perform
       (param $k0 (ref $cont)) (param $vp (ref eq))
-      (local $eff (ref eq)) (local $cont (ref $continuation))
+      (local $eff (ref eq)) (local $cont (ref $block))
       (local $handler (ref eq))
       (local $k1 (ref $cont))
       (local $p (ref $pair))
+      (local $next_fiber (ref eq))
       (local.set $p (ref.cast (ref $pair) (local.get $vp)))
       (local.set $eff (struct.get $pair 0 (local.get $p)))
       (local.set $cont
-         (ref.cast (ref $continuation) (struct.get $pair 1 (local.get $p))))
+         (ref.cast (ref $block) (struct.get $pair 1 (local.get $p))))
       (local.set $handler
          (struct.get $handlers $effect
             (struct.get $fiber $handlers (global.get $stack))))
-      (struct.set $continuation 0
+      (local.set $next_fiber (array.get $block (local.get $cont) (i32.const 1)))
+      (array.set $block
          (local.get $cont)
+         (i32.const 1)
          (struct.new $fiber
              (struct.get $fiber $handlers (global.get $stack))
              (local.get $k0)
              (global.get $current_suspender)
-             (ref.cast (ref null $fiber)
-                (struct.get $continuation 0 (local.get $cont)))))
+             (if (result (ref null $fiber))
+                 (ref.test (ref $fiber) (local.get $next_fiber))
+                (then (ref.cast (ref $fiber) (local.get $next_fiber)))
+                (else (ref.null $fiber)))))
       (local.set $k1 (call $pop_fiber))
       (return_call_ref $cont_func
          (struct.new $pair
@@ -313,7 +318,8 @@
 
    (func (export "%perform") (param $eff (ref eq)) (result (ref eq))
       (return_call $reperform (local.get $eff)
-         (struct.new $continuation (ref.null $fiber))))
+         (array.new_fixed $block 3 (ref.i31 (global.get $cont_tag))
+           (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0)))))
 
    ;; Allocate a stack
 
@@ -367,14 +373,16 @@
 
    (func $caml_continuation_use_noexc (export "caml_continuation_use_noexc")
       (param (ref eq)) (result (ref eq))
-      (local $cont (ref $continuation))
+      (local $cont (ref $block))
       (local $stack (ref eq))
-      (block $used
-         (local.set $cont (ref.cast (ref $continuation) (local.get 0)))
+      (drop (block $used (result (ref eq))
+         (local.set $cont (ref.cast (ref $block) (local.get 0)))
          (local.set $stack
-            (br_on_null $used (struct.get $continuation 0 (local.get $cont))))
-         (struct.set $continuation 0 (local.get $cont) (ref.null eq))
-         (return (local.get $stack)))
+            (br_on_cast_fail $used (ref eq) (ref $generic_fiber)
+               (array.get $block (local.get $cont) (i32.const 1))))
+         (array.set $block (local.get $cont) (i32.const 1)
+            (ref.i31 (i32.const 0)))
+         (return (local.get $stack))))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_continuation_use_and_update_handler_noexc")
@@ -396,7 +404,15 @@
       (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
    (func (export "caml_is_continuation") (param (ref eq)) (result i32)
-      (ref.test (ref $continuation) (local.get 0)))
+      (drop (block $not_continuation (result (ref eq))
+         (return
+            (ref.eq
+               (array.get $block
+                  (br_on_cast_fail $not_continuation (ref eq) (ref $block)
+                     (local.get 0))
+                  (i32.const 0))
+               (ref.i31 (global.get $cont_tag))))))
+      (i32.const 0))
 
    (func (export "caml_initialize_effects") (param $s externref)
       (global.set $current_suspender (local.get $s)))
@@ -651,25 +667,31 @@
       (result (ref eq))
       (local $handlers (ref $handlers))
       (local $handler (ref eq)) (local $k1 (ref eq))
-      (local $cont (ref $continuation))
+      (local $cont (ref $block))
+      (local $next_fiber (ref eq))
       (local.set $cont
-         (block $reperform (result (ref $continuation))
+         (block $reperform (result (ref $block))
             (drop
-               (br_on_cast $reperform (ref eq) (ref $continuation)
+               (br_on_cast $reperform (ref eq) (ref $block)
                  (local.get $vcont)))
-            (struct.new $continuation (ref.null eq))))
+            (array.new_fixed $block 3 (ref.i31 (global.get $cont_tag))
+               (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0)))))
       (local.set $handlers
          (struct.get $cps_fiber $handlers
             (ref.as_non_null (global.get $cps_fiber_stack))))
       (local.set $handler
          (struct.get $handlers $effect (local.get $handlers)))
-      (struct.set $continuation 0 (local.get $cont)
+      (local.set $next_fiber
+         (array.get $block (local.get $cont) (i32.const 1)))
+      (array.set $block (local.get $cont) (i32.const 1)
          (struct.new $cps_fiber
             (local.get $handlers)
             (local.get $k0)
             (global.get $exn_stack)
-            (ref.cast (ref null $cps_fiber)
-               (struct.get $continuation 0 (local.get $cont)))))
+            (if (result (ref null $cps_fiber))
+                (ref.test (ref $cps_fiber) (local.get $next_fiber))
+               (then (ref.cast (ref $cps_fiber) (local.get $next_fiber)))
+               (else (ref.null $cps_fiber)))))
       (local.set $k1 (call $caml_pop_fiber))
       (return_call_ref $function_4
          (local.get $eff) (local.get $cont) (local.get $k1) (local.get $k1)
@@ -722,9 +744,8 @@
       (param (ref eq)) (param (ref eq)) (result (ref eq))
       (drop
          (call $caml_resume_stack
-            (ref.as_non_null
-               (struct.get $continuation 0
-                  (ref.cast (ref $continuation) (local.get $k))))
+            (array.get $block
+               (ref.cast (ref $block) (local.get $k)) (i32.const 1))
             (local.get $ms)))
       (call $raise_unhandled (local.get $eff) (ref.i31 (i32.const 0))))
 
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
index 8c08e38124..f0057eee2a 100644
--- a/runtime/wasm/obj.wat
+++ b/runtime/wasm/obj.wat
@@ -87,7 +87,7 @@
             (field (mut (ref null $cps_closure))))))
 
    (global $forcing_tag i32 (i32.const 244))
-   (global $cont_tag i32 (i32.const 245))
+   (global $cont_tag (export "cont_tag") i32 (i32.const 245))
    (global $lazy_tag (export "lazy_tag") i32 (i32.const 246))
    (global $closure_tag i32 (i32.const 247))
    (global $object_tag (export "object_tag") i32 (i32.const 248))

From c75d050969661f741012f5d4b7eaf09b360689d2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 31 Jul 2024 14:27:15 +0200
Subject: [PATCH 276/481] Fix implementation of caml_register_named_value

---
 runtime/stdlib.js       |  3 +--
 runtime/wasm/stdlib.wat | 49 ++++++++++++++++++++++++-----------------
 2 files changed, 30 insertions(+), 22 deletions(-)

diff --git a/runtime/stdlib.js b/runtime/stdlib.js
index 9b5a966830..acbd2e9979 100644
--- a/runtime/stdlib.js
+++ b/runtime/stdlib.js
@@ -131,8 +131,7 @@ var caml_named_values = {};
 //Provides: caml_register_named_value (const,mutable)
 //Requires: caml_named_values, caml_jsbytes_of_string
 function caml_register_named_value(nm,v) {
-  nm = caml_jsbytes_of_string(nm);
-  if (!caml_named_values.hasOwnProperty(nm)) caml_named_values[nm] = v;
+  caml_named_values[caml_jsbytes_of_string(nm)] = v;
   return 0;
 }
 
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index add57ec6d8..1fcf231cfc 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -51,7 +51,7 @@
    (type $assoc
       (struct
          (field (ref $string))
-         (field (ref eq))
+         (field (mut (ref eq)))
          (field (mut (ref null $assoc)))))
 
    (type $assoc_array (array (field (mut (ref null $assoc)))))
@@ -62,9 +62,9 @@
      (array.new $assoc_array (ref.null $assoc) (global.get $Named_value_size)))
 
    (func $find_named_value
-      (param $s (ref eq)) (param $l (ref null $assoc)) (result (ref null eq))
+      (param $s (ref eq)) (param $l (ref null $assoc)) (result (ref null $assoc))
       (local $a (ref $assoc))
-      (block $tail (result (ref null eq))
+      (block $tail (result (ref null $assoc))
          (loop $loop
             (local.set $a
                (br_on_cast_fail $tail (ref null eq) (ref $assoc) (local.get $l)))
@@ -74,21 +74,26 @@
                           (local.get $s)
                           (struct.get $assoc 0 (local.get $a)))))
                (then
-                  (return (struct.get $assoc 1 (local.get $a)))))
+                  (return (local.get $a))))
             (local.set $l (struct.get $assoc 2 (local.get $a)))
             (br $loop))))
 
    (func $caml_named_value (export "caml_named_value")
       (param $s (ref $string)) (result (ref null eq))
-      (return_call $find_named_value
-         (local.get $s)
-         (array.get $assoc_array (global.get $named_value_table)
-            (i32.rem_u
-               (i31.get_s
-                  (ref.cast (ref i31)
-                     (call $caml_string_hash
-                        (ref.i31 (i32.const 0)) (local.get $s))))
-               (global.get $Named_value_size)))))
+      (block $not_found
+         (return
+            (struct.get $assoc 1
+               (br_on_null $not_found
+                  (call $find_named_value
+                     (local.get $s)
+                     (array.get $assoc_array (global.get $named_value_table)
+                        (i32.rem_u
+                           (i31.get_s
+                              (ref.cast (ref i31)
+                                 (call $caml_string_hash
+                                    (ref.i31 (i32.const 0)) (local.get $s))))
+                           (global.get $Named_value_size))))))))
+      (return (ref.null eq)))
 
    (func (export "caml_register_named_value")
       (param (ref eq)) (param (ref eq)) (result (ref eq))
@@ -104,13 +109,17 @@
       (local.set $r
          (array.get $assoc_array
             (global.get $named_value_table) (local.get $h)))
-      (if (ref.is_null (call $find_named_value (local.get 0) (local.get $r)))
-         (then
-            (array.set $assoc_array
-               (global.get $named_value_table) (local.get $h)
-               (struct.new $assoc
-                  (ref.cast (ref $string) (local.get 0))
-                  (local.get 1) (local.get $r)))))
+      (block $not_found
+         (struct.set $assoc 1
+            (br_on_null $not_found
+               (call $find_named_value (local.get 0) (local.get $r)))
+            (local.get 1))
+         (return (ref.i31 (i32.const 0))))
+      (array.set $assoc_array
+         (global.get $named_value_table) (local.get $h)
+         (struct.new $assoc
+            (ref.cast (ref $string) (local.get 0))
+            (local.get 1) (local.get $r)))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_unregister_named_value")

From 6bf9b4b35debd1112091cee5fa562fef95b52786 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Thu, 18 Jul 2024 18:05:21 +0200
Subject: [PATCH 277/481] Add missing primitives

---
 runtime/wasm/bigarray.wat | 27 ++++++++++++++++++++++++++-
 runtime/wasm/domain.wat   |  9 +++++++++
 2 files changed, 35 insertions(+), 1 deletion(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 0baf91f922..57920939d1 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -2097,7 +2097,9 @@
          (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 56)))))
       (ref.i31 (i32.const 0)))
 
-   (func (export "caml_string_of_array") (param (ref eq)) (result (ref eq))
+   (export "caml_bytes_of_array" (func $caml_string_of_array))
+   (func $caml_string_of_array (export "caml_string_of_array")
+      (param (ref eq)) (result (ref eq))
       ;; used to convert a typed array to a string
       (local $a (ref extern)) (local $len i32) (local $i i32)
       (local $s (ref $string))
@@ -2114,6 +2116,29 @@
                (br $loop))))
       (local.get $s))
 
+   (export "caml_uint8_array_of_bytes" (func $caml_uint8_array_of_string))
+   (func $caml_uint8_array_of_string (export "caml_uint8_array_of_string")
+      (param (ref eq)) (result (ref eq))
+      ;; Convert a string to a typed array
+      (local $ta (ref extern)) (local $len i32) (local $i i32)
+      (local $s (ref $string))
+      (local.set $s (ref.cast (ref $string) (local.get 0)))
+      (local.set $len (array.len (local.get $s)))
+      (local.set $ta
+         (call $ta_create
+            (i32.const 3) ;; Uint8Array
+            (local.get $len)))
+      (loop $loop
+         (if (i32.lt_u (local.get $i) (local.get $len))
+            (then
+               (call $ta_set_ui8
+                  (local.get $ta)
+                  (local.get $i)
+                  (ref.i31 (array.get $string (local.get $s) (local.get $i))))
+               (local.set $i (i32.add (local.get $i) (i32.const 1)))
+               (br $loop))))
+      (call $wrap (extern.internalize (local.get $ta))))
+
    (func (export "caml_ba_get_kind") (param (ref eq)) (result i32)
       (struct.get $bigarray $ba_kind (ref.cast (ref $bigarray) (local.get 0))))
 
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index 169f9d9aba..2ba72bcf9c 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -69,6 +69,15 @@
       (global.set $caml_domain_dls (local.get $a))
       (ref.i31 (i32.const 0)))
 
+   (func (export "caml_domain_dls_compare_and_set") (param $old (ref eq)) (param $new (ref eq)) (result (ref eq))
+      (if (result (ref eq))
+         (ref.eq (global.get $caml_domain_dls) (local.get $old))
+         (then
+            (global.set $caml_domain_dls (local.get $new))
+            (ref.i31 (i32.const 1)))
+         (else
+            (ref.i31 (i32.const 0)))))
+
    (func (export "caml_domain_dls_get") (param (ref eq)) (result (ref eq))
       (global.get $caml_domain_dls))
 

From a87c5aeaa876206635b752577287c60c761e4981 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 23 Jul 2024 18:40:15 +0200
Subject: [PATCH 278/481] Add missing runtime_events primitives

---
 runtime/wasm/runtime_events.wat | 69 +++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100644 runtime/wasm/runtime_events.wat

diff --git a/runtime/wasm/runtime_events.wat b/runtime/wasm/runtime_events.wat
new file mode 100644
index 0000000000..ff77e5570d
--- /dev/null
+++ b/runtime/wasm/runtime_events.wat
@@ -0,0 +1,69 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
+(module
+
+   (type $block (array (mut (ref eq))))
+
+   (global $caml_custom_event_index (mut i32) (i32.const 0))
+
+   (func (export "caml_runtime_events_user_register")
+      (param $evname (ref eq)) (param $evtag (ref eq)) (param $evtype (ref eq))
+      (result (ref eq))
+      (global.set $caml_custom_event_index
+         (i32.add (global.get $caml_custom_event_index) (i32.const 1)))
+      (array.new_fixed $block 5
+         (ref.i31 (i32.const 0))
+         (ref.i31 (global.get $caml_custom_event_index))
+         (local.get $evname)
+         (local.get $evtag)
+         (local.get $evtype)))
+
+   (func (export "caml_runtime_events_user_write")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_runtime_events_user_resolve")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_runtime_events_start") (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_runtime_events_pause") (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_runtime_events_resume") (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_ml_runtime_events_are_active")
+      (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   ;; TODO: use Javascript function
+   ;;(func (export "caml_runtime_events_create_cursor")
+   ;;   (param (ref eq)) (result (ref eq))
+   ;;   (ref.i31 (i32.const 0)))
+
+   (func (export "caml_runtime_events_free_cursor")
+      (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_runtime_events_read_poll")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+)

From 3eac4d4f6bd155c53a26e43905b7c71b749dcb1f Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Thu, 1 Aug 2024 16:25:22 +0200
Subject: [PATCH 279/481] False-returning stub for caml_zstd_initialize

This stops a few tests from failing with Wasm
---
 runtime/wasm/zstd.wat | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)
 create mode 100644 runtime/wasm/zstd.wat

diff --git a/runtime/wasm/zstd.wat b/runtime/wasm/zstd.wat
new file mode 100644
index 0000000000..09aa888bad
--- /dev/null
+++ b/runtime/wasm/zstd.wat
@@ -0,0 +1,22 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
+(module
+
+   (func (export "caml_zstd_initialize") (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+)

From 89fce8572f2a30ed448fb35e38420bba7ac71c8e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 15 Sep 2023 11:03:34 +0200
Subject: [PATCH 280/481] Sync with Js_of_ocaml

---
 compiler/tests-jsoo/bin/dune                | 7 ++++++-
 compiler/tests-jsoo/bin/named_value_stubs.c | 5 +++++
 compiler/tests-jsoo/bin/runtime.js          | 7 +++++++
 runtime/stdlib.js                           | 8 --------
 runtime/wasm/stdlib.wat                     | 1 +
 5 files changed, 19 insertions(+), 9 deletions(-)
 create mode 100644 compiler/tests-jsoo/bin/named_value_stubs.c
 create mode 100644 compiler/tests-jsoo/bin/runtime.js

diff --git a/compiler/tests-jsoo/bin/dune b/compiler/tests-jsoo/bin/dune
index fb3f64d526..c92e954600 100644
--- a/compiler/tests-jsoo/bin/dune
+++ b/compiler/tests-jsoo/bin/dune
@@ -1,6 +1,11 @@
 (executables
  (names error1 error2 error3)
- (modes js)
+ (modes exe js)
+ (foreign_stubs
+  (language c)
+  (names named_value_stubs))
+ (js_of_ocaml
+  (javascript_files runtime.js))
  (libraries js_of_ocaml))
 
 (rule
diff --git a/compiler/tests-jsoo/bin/named_value_stubs.c b/compiler/tests-jsoo/bin/named_value_stubs.c
new file mode 100644
index 0000000000..42552ed320
--- /dev/null
+++ b/compiler/tests-jsoo/bin/named_value_stubs.c
@@ -0,0 +1,5 @@
+#include "caml/mlvalues.h"
+
+CAMLprim value caml_unregister_named_value(value nm) {
+   return Val_unit;
+}
diff --git a/compiler/tests-jsoo/bin/runtime.js b/compiler/tests-jsoo/bin/runtime.js
new file mode 100644
index 0000000000..2fedb275d9
--- /dev/null
+++ b/compiler/tests-jsoo/bin/runtime.js
@@ -0,0 +1,7 @@
+//Provides: caml_unregister_named_value (const)
+//Requires: caml_named_values, caml_jsbytes_of_string
+function caml_unregister_named_value(nm) {
+  nm = caml_jsbytes_of_string(nm);
+  delete caml_named_values[nm];
+  return 0;
+}
diff --git a/runtime/stdlib.js b/runtime/stdlib.js
index acbd2e9979..4029305135 100644
--- a/runtime/stdlib.js
+++ b/runtime/stdlib.js
@@ -135,14 +135,6 @@ function caml_register_named_value(nm,v) {
   return 0;
 }
 
-//Provides: caml_unregister_named_value (const)
-//Requires: caml_named_values, caml_jsbytes_of_string
-function caml_unregister_named_value(nm) {
-  nm = caml_jsbytes_of_string(nm);
-  delete caml_named_values[nm];
-  return 0;
-}
-
 //Provides: caml_named_value
 //Requires: caml_named_values
 function caml_named_value(nm) {
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index 1fcf231cfc..0d12af292a 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -122,6 +122,7 @@
             (local.get 1) (local.get $r)))
       (ref.i31 (i32.const 0)))
 
+   ;; Used only for testing (tests-jsoo/bin), but inconvenient to pull out
    (func (export "caml_unregister_named_value")
       (param $name (ref eq)) (result (ref eq))
       (local $h i32)

From 8a7f02133d2c0e62e54ddc33a156f26288f453bb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 24 Jul 2023 13:52:32 +0200
Subject: [PATCH 281/481] Lib: use number_t in Typed_array as well

---
 lib/js_of_ocaml/typed_array.ml  | 14 +++++++-------
 lib/js_of_ocaml/typed_array.mli | 18 +++++++++---------
 lib/tests/test_typed_array.ml   |  6 +++---
 3 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index 4b52cda8a9..057ebf1a21 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -20,9 +20,9 @@
 open! Import
 open Js
 
-type int32 = Js.number Js.t
+type int32 = number_t
 
-type uint32 = Js.number Js.t
+type uint32 = number_t
 
 class type arrayBuffer = object
   method byteLength : int readonly_prop
@@ -43,7 +43,7 @@ class type arrayBufferView = object
 end
 
 class type ['a, 'b, 'c] typedArray = object
-  inherit arrayBufferView
+    inherit arrayBufferView
 
   method _BYTES_PER_ELEMENT : int readonly_prop
 
@@ -78,9 +78,9 @@ type int32Array = (int32, Int32.t, Bigarray.int32_elt) typedArray
 
 type uint32Array = (uint32, Int32.t, Bigarray.int32_elt) typedArray
 
-type float32Array = (Js.number Js.t, float, Bigarray.float32_elt) typedArray
+type float32Array = (number_t, float, Bigarray.float32_elt) typedArray
 
-type float64Array = (Js.number Js.t, float, Bigarray.float64_elt) typedArray
+type float64Array = (number_t, float, Bigarray.float64_elt) typedArray
 
 type ('bigarray, 'typed_array, 'elt) type' =
   | Char : (int, char, Bigarray.int8_unsigned_elt) type'
@@ -90,8 +90,8 @@ type ('bigarray, 'typed_array, 'elt) type' =
   | Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) type'
   | Int32_signed : (int32, Int32.t, Bigarray.int32_elt) type'
   | Int32_unsigned : (uint32, Int32.t, Bigarray.int32_elt) type'
-  | Float32 : (Js.number Js.t, float, Bigarray.float32_elt) type'
-  | Float64 : (Js.number Js.t, float, Bigarray.float64_elt) type'
+  | Float32 : (number_t, float, Bigarray.float32_elt) type'
+  | Float64 : (number_t, float, Bigarray.float64_elt) type'
 
 external kind :
   ('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index 4cedaba0ef..a0c237d967 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -22,9 +22,9 @@
 
 open Js
 
-type int32 = Js.number Js.t
+type int32 = number_t
 
-type uint32 = Js.number Js.t
+type uint32 = number_t
 
 class type arrayBuffer = object
   method byteLength : int readonly_prop
@@ -45,7 +45,7 @@ class type arrayBufferView = object
 end
 
 class type ['a, 'b, 'c] typedArray = object
-  inherit arrayBufferView
+    inherit arrayBufferView
 
   method _BYTES_PER_ELEMENT : int readonly_prop
 
@@ -63,8 +63,8 @@ class type ['a, 'b, 'c] typedArray = object
 
   method slice_toEnd : int -> ('a, 'b, 'c) typedArray t meth
 
-  (* This fake method is needed for typing purposes.
-     Without it, ['b] would not be constrained. *)
+  (* This fake method is needed for typing purposes. Without it, ['b] would not
+     be constrained. *)
   method _content_type_ : ('b * 'c) optdef readonly_prop
 end
 
@@ -80,9 +80,9 @@ type int32Array = (int32, Int32.t, Bigarray.int32_elt) typedArray
 
 type uint32Array = (uint32, Int32.t, Bigarray.int32_elt) typedArray
 
-type float32Array = (Js.number Js.t, float, Bigarray.float32_elt) typedArray
+type float32Array = (number_t, float, Bigarray.float32_elt) typedArray
 
-type float64Array = (Js.number Js.t, float, Bigarray.float64_elt) typedArray
+type float64Array = (number_t, float, Bigarray.float64_elt) typedArray
 
 type ('bigarray, 'typed_array, 'elt) type' =
   | Char : (int, char, Bigarray.int8_unsigned_elt) type'
@@ -92,8 +92,8 @@ type ('bigarray, 'typed_array, 'elt) type' =
   | Int16_unsigned : (int, int, Bigarray.int16_unsigned_elt) type'
   | Int32_signed : (int32, Int32.t, Bigarray.int32_elt) type'
   | Int32_unsigned : (uint32, Int32.t, Bigarray.int32_elt) type'
-  | Float32 : (Js.number Js.t, float, Bigarray.float32_elt) type'
-  | Float64 : (Js.number Js.t, float, Bigarray.float64_elt) type'
+  | Float32 : (number_t, float, Bigarray.float32_elt) type'
+  | Float64 : (number_t, float, Bigarray.float64_elt) type'
 
 val kind : ('typed_array, 'bigarray, 'elt) typedArray t -> ('bigarray, 'elt) Bigarray.kind
 
diff --git a/lib/tests/test_typed_array.ml b/lib/tests/test_typed_array.ml
index 10846b3338..2993628739 100644
--- a/lib/tests/test_typed_array.ml
+++ b/lib/tests/test_typed_array.ml
@@ -30,9 +30,9 @@ module Setup = struct
     | Uint8 : (int, int, Bigarray.int8_unsigned_elt) t
     | Int16 : (int, int, Bigarray.int16_signed_elt) t
     | Uint16 : (int, int, Bigarray.int16_unsigned_elt) t
-    | Int32 : (Js.number Js.t, Int32.t, Bigarray.int32_elt) t
-    | Float32 : (Js.number Js.t, float, Bigarray.float32_elt) t
-    | Float64 : (Js.number Js.t, float, Bigarray.float64_elt) t
+    | Int32 : (Js.number_t, Int32.t, Bigarray.int32_elt) t
+    | Float32 : (Js.number_t, float, Bigarray.float32_elt) t
+    | Float64 : (Js.number_t, float, Bigarray.float64_elt) t
 end
 
 let kind_of_setup : type a b c. (a, b, c) Setup.t -> (b, c) kind = function

From 992cdf4ba531b3fb67ad1694524ffd79e7c3c8e6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 24 Jul 2023 13:52:32 +0200
Subject: [PATCH 282/481] Lib: use number_t in yet a few more places

---
 lib/js_of_ocaml/typed_array.ml  | 16 ++++++++--------
 lib/js_of_ocaml/typed_array.mli | 16 ++++++++--------
 2 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index 057ebf1a21..253837b16f 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -217,13 +217,13 @@ class type dataView = object
 
   method getUint32_ : int -> bool t -> uint32 meth
 
-  method getFloat32 : int -> Js.number Js.t meth
+  method getFloat32 : int -> number_t meth
 
-  method getFloat32_ : int -> bool t -> Js.number Js.t meth
+  method getFloat32_ : int -> bool t -> number_t meth
 
-  method getFloat64 : int -> Js.number Js.t meth
+  method getFloat64 : int -> number_t meth
 
-  method getFloat64_ : int -> bool t -> Js.number Js.t meth
+  method getFloat64_ : int -> bool t -> number_t meth
 
   method setInt8 : int -> int -> unit meth
 
@@ -245,13 +245,13 @@ class type dataView = object
 
   method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-  method setFloat32 : int -> Js.number Js.t -> unit meth
+  method setFloat32 : int -> number_t -> unit meth
 
-  method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
+  method setFloat32_ : int -> number_t -> bool t -> unit meth
 
-  method setFloat64 : int -> Js.number Js.t -> unit meth
+  method setFloat64 : int -> number_t -> unit meth
 
-  method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
+  method setFloat64_ : int -> number_t -> bool t -> unit meth
 end
 
 let dataView = Js.Unsafe.global##._DataView
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index a0c237d967..cea6fc32a5 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -215,13 +215,13 @@ class type dataView = object
 
   method getUint32_ : int -> bool t -> uint32 meth
 
-  method getFloat32 : int -> Js.number Js.t meth
+  method getFloat32 : int -> number_t meth
 
-  method getFloat32_ : int -> bool t -> Js.number Js.t meth
+  method getFloat32_ : int -> bool t -> number_t meth
 
-  method getFloat64 : int -> Js.number Js.t meth
+  method getFloat64 : int -> number_t meth
 
-  method getFloat64_ : int -> bool t -> Js.number Js.t meth
+  method getFloat64_ : int -> bool t -> number_t meth
 
   method setInt8 : int -> int -> unit meth
 
@@ -243,13 +243,13 @@ class type dataView = object
 
   method setUint32_ : int -> uint32 -> bool t -> unit meth
 
-  method setFloat32 : int -> Js.number Js.t -> unit meth
+  method setFloat32 : int -> number_t -> unit meth
 
-  method setFloat32_ : int -> Js.number Js.t -> bool t -> unit meth
+  method setFloat32_ : int -> number_t -> bool t -> unit meth
 
-  method setFloat64 : int -> Js.number Js.t -> unit meth
+  method setFloat64 : int -> number_t -> unit meth
 
-  method setFloat64_ : int -> Js.number Js.t -> bool t -> unit meth
+  method setFloat64_ : int -> number_t -> bool t -> unit meth
 end
 
 val dataView : (arrayBuffer t -> dataView t) constr

From 26b282086388c48c7c47bbcb0a9ef577e33ab318 Mon Sep 17 00:00:00 2001
From: TheNumbat <max@thenumb.at>
Date: Sun, 11 Aug 2024 13:12:15 -0400
Subject: [PATCH 283/481] fix bounds check

---
 runtime/wasm/bigarray.wat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 0baf91f922..3b9fc90019 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -1113,7 +1113,7 @@
              (i32.or
                 (i32.ge_u (local.get $j)
                    (array.get $int_array (local.get $dim) (i32.const 1)))
-                (i32.ge_u (local.get $j)
+                (i32.ge_u (local.get $k)
                    (array.get $int_array (local.get $dim) (i32.const 2)))))
          (then
             (call $caml_bound_error)))

From 09a8700e5eee2141ec3917c9e4add65a539d6a44 Mon Sep 17 00:00:00 2001
From: Erik Martin-Dorel <erik@martin-dorel.org>
Date: Fri, 28 Jul 2023 00:20:11 +0200
Subject: [PATCH 284/481] fix(url.ml): set_fragment need not any urlencode

---
 lib/js_of_ocaml/url.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/js_of_ocaml/url.ml b/lib/js_of_ocaml/url.ml
index 1be4dfe656..eb2312222e 100644
--- a/lib/js_of_ocaml/url.ml
+++ b/lib/js_of_ocaml/url.ml
@@ -322,7 +322,7 @@ module Current = struct
         let res = Js.match_result res in
         Js.to_string (Js.Unsafe.get res 1))
 
-  let set_fragment s = l##.hash := Js.bytestring (urlencode s)
+  let set_fragment s = l##.hash := Js.bytestring s
 
   let get () = url_of_js_string l##.href
 

From 1540ceb6bcbdcc45a4cc489b5ba4bd445e60eda5 Mon Sep 17 00:00:00 2001
From: Erik Martin-Dorel <erik@martin-dorel.org>
Date: Wed, 2 Aug 2023 15:39:32 +0200
Subject: [PATCH 285/481] fix(url.ml): Simplify get_fragment as well

and directly use l##.hash;

given Firefox' bug https://bugzilla.mozilla.org/show_bug.cgi?id=483304
is closed since 8+ years.
---
 lib/js_of_ocaml/url.ml | 16 ++++------------
 1 file changed, 4 insertions(+), 12 deletions(-)

diff --git a/lib/js_of_ocaml/url.ml b/lib/js_of_ocaml/url.ml
index eb2312222e..a9791f34ef 100644
--- a/lib/js_of_ocaml/url.ml
+++ b/lib/js_of_ocaml/url.ml
@@ -309,18 +309,10 @@ module Current = struct
        else l##.search)
 
   let get_fragment () =
-    (* location.hash doesn't have the same behavior depending on the browser
-       Firefox bug : https://bugzilla.mozilla.org/show_bug.cgi?id=483304 *)
-    (* let s = Js.to_bytestring (l##hash) in *)
-    (* if String.length s > 0 && s.[0] = '#' *)
-    (* then String.sub s 1 (String.length s - 1) *)
-    (* else s; *)
-    Js.Opt.case
-      (l##.href##_match (new%js Js.regExp (Js.string "#(.*)")))
-      (fun () -> "")
-      (fun res ->
-        let res = Js.match_result res in
-        Js.to_string (Js.Unsafe.get res 1))
+    let s = Js.to_bytestring l##.hash in
+    if String.length s > 0 && Char.equal s.[0] '#'
+    then String.sub s 1 (String.length s - 1)
+    else s
 
   let set_fragment s = l##.hash := Js.bytestring s
 

From 390f9d7d65635481c5bc18139989f57782279514 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 30 Aug 2024 17:44:32 +0200
Subject: [PATCH 286/481] Simplify the insertion of locations in wasm code

---
 compiler/lib/wasm/wa_code_generation.ml | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 293de76d0b..173287626d 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -291,15 +291,16 @@ let blk l st =
   List.rev st.instrs, { st with instrs }
 
 let with_location loc instrs st =
-  let current_instrs = st.instrs in
-  let (), st = instrs { st with instrs = [] } in
-  let[@tail_mod_cons] rec add_loc loc = function
-    | [] -> current_instrs
-    | W.Nop :: rem -> W.Nop :: add_loc loc rem
-    | Location _ :: _ as l -> l @ current_instrs (* Stop on the first location *)
-    | i :: rem -> W.Location (loc, i) :: add_loc loc rem
-  in
-  (), { st with instrs = add_loc loc st.instrs }
+  let (), st = instrs st in
+  ( ()
+  , { st with
+      instrs =
+        (match st.instrs with
+        | [] -> []
+        | Location _ :: _ when Poly.equal loc No -> st.instrs
+        | Location (_, i) :: rem -> Location (loc, i) :: rem
+        | i :: rem -> Location (loc, i) :: rem)
+    } )
 
 let cast ?(nullable = false) typ e =
   let* e = e in

From 6b08f132c3a153aa77a987d740339b3c23be7faf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 30 Aug 2024 17:45:29 +0200
Subject: [PATCH 287/481] Add possibly missing debug information at beginning
 of functions

---
 compiler/bin-wasm_of_ocaml/compile.ml |  6 ++++--
 compiler/lib/wasm/wa_generate.ml      | 28 ++++++++++++++++++++++-----
 compiler/lib/wasm/wa_generate.mli     |  1 +
 3 files changed, 28 insertions(+), 7 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index a76ec7df33..9eb2b282a8 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -148,7 +148,9 @@ let generate_prelude ~out_file =
     Driver.f ~target:Wasm (Parse_bytecode.Debug.create ~include_cmis:false false) code
   in
   let context = Wa_generate.start () in
-  let _ = Wa_generate.f ~context ~unit_name:(Some "prelude") ~live_vars ~in_cps p in
+  let _ =
+    Wa_generate.f ~context ~unit_name:(Some "prelude") ~live_vars ~in_cps ~debug p
+  in
   Wa_generate.output ch ~context ~debug;
   uinfo.provides
 
@@ -283,7 +285,7 @@ let run
     in
     let context = Wa_generate.start () in
     let toplevel_name, generated_js =
-      Wa_generate.f ~context ~unit_name ~live_vars ~in_cps p
+      Wa_generate.f ~context ~unit_name ~live_vars ~in_cps ~debug p
     in
     if standalone then Wa_generate.add_start_function ~context toplevel_name;
     Wa_generate.output ch ~context ~debug;
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 6eb088ad7b..fedb49d50f 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -37,6 +37,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     ; blocks : block Addr.Map.t
     ; closures : Wa_closure_conversion.closure Var.Map.t
     ; global_context : Wa_code_generation.context
+    ; debug : Parse_bytecode.Debug.t
     }
 
   let func_type n =
@@ -818,6 +819,20 @@ module Generate (Target : Wa_target_sig.S) = struct
       params
       ((pc, _) as cont)
       acc =
+    let ctx =
+      let loc = Before pc in
+      match Parse_bytecode.Debug.find_loc ctx.debug loc with
+      | Some _ ->
+          let block = Addr.Map.find pc ctx.blocks in
+          let block =
+            match block.body with
+            | (i, _) :: rem -> { block with body = (i, loc) :: rem }
+            | [] -> { block with branch = fst block.branch, loc }
+          in
+          let blocks = Addr.Map.add pc block ctx.blocks in
+          { ctx with blocks }
+      | None -> ctx
+    in
     let stack_info =
       Stack.generate_spilling_information
         p
@@ -1107,13 +1122,16 @@ module Generate (Target : Wa_target_sig.S) = struct
       ~in_cps (*
     ~should_export
     ~warn_on_unhandled_effect
-      _debug *) =
+*)
+      ~debug =
     global_context.unit_name <- unit_name;
     let p, closures = Wa_closure_conversion.f p in
     (*
   Code.Print.program (fun _ _ -> "") p;
 *)
-    let ctx = { live = live_vars; in_cps; blocks = p.blocks; closures; global_context } in
+    let ctx =
+      { live = live_vars; in_cps; blocks = p.blocks; closures; global_context; debug }
+    in
     let toplevel_name = Var.fresh_n "toplevel" in
     let functions =
       Code.fold_closures_outermost_first
@@ -1223,15 +1241,15 @@ let start () =
       | `Core -> Wa_core_target.Value.value
       | `GC -> Wa_gc_target.Value.value)
 
-let f ~context ~unit_name p ~live_vars ~in_cps =
+let f ~context ~unit_name p ~live_vars ~in_cps ~debug =
   let p = if Config.Flag.effects () then fix_switch_branches p else p in
   match target with
   | `Core ->
       let module G = Generate (Wa_core_target) in
-      G.f ~context ~unit_name ~live_vars ~in_cps p
+      G.f ~context ~unit_name ~live_vars ~in_cps ~debug p
   | `GC ->
       let module G = Generate (Wa_gc_target) in
-      G.f ~context ~unit_name ~live_vars ~in_cps p
+      G.f ~context ~unit_name ~live_vars ~in_cps ~debug p
 
 let add_start_function =
   match target with
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index 83f49d6627..d7e2e86627 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -26,6 +26,7 @@ val f :
   -> Code.program
   -> live_vars:int array
   -> in_cps:Effects.in_cps
+  -> debug:Parse_bytecode.Debug.t
   -> Wa_ast.var * (string list * (string * Javascript.expression) list)
 
 val add_start_function : context:Wa_code_generation.context -> Wa_ast.var -> unit

From 4d34679f5536aed3e85cc901d0497990f7a19978 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 30 Aug 2024 17:46:12 +0200
Subject: [PATCH 288/481] Reenable optimization prevented by the insertion of
 locations

---
 compiler/lib/wasm/wa_code_generation.ml | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 173287626d..5040b2fc33 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -470,6 +470,13 @@ let get_i31_value x st =
       let x = Var.fresh () in
       let x, st = add_var ~typ:I32 x st in
       Some x, { st with instrs = LocalSet (x', RefI31 (LocalTee (x, e))) :: rem }
+  | Location (loc, LocalSet (x', RefI31 e)) :: rem when Code.Var.equal x x' && is_smi e ->
+      let x = Var.fresh () in
+      let x, st = add_var ~typ:I32 x st in
+      ( Some x
+      , { st with
+          instrs = Location (loc, LocalSet (x', RefI31 (LocalTee (x, e)))) :: rem
+        } )
   | _ -> None, st
 
 let load x =

From b38e20d42aaba2cbc88c13425b1e038108918631 Mon Sep 17 00:00:00 2001
From: Fay Carsons <alisonbyrd94@protonmail.com>
Date: Thu, 18 Jan 2024 05:59:51 -0500
Subject: [PATCH 289/481] added 'ellipse' method to canvasRenderingContext2D
 (#1555)

* added 'ellipse' method to canvasRenderingContext2D
---------

Co-authored-by: Hugo Heuzard <hugo.heuzard@gmail.com>
---
 examples/hyperbolic/hypertree.ml | 46 +++++++-------------------------
 lib/js_of_ocaml/dom_html.ml      | 11 ++++++++
 lib/js_of_ocaml/dom_html.mli     | 11 ++++++++
 3 files changed, 32 insertions(+), 36 deletions(-)

diff --git a/examples/hyperbolic/hypertree.ml b/examples/hyperbolic/hypertree.ml
index 64bb28c4f5..f35b8aee4f 100644
--- a/examples/hyperbolic/hypertree.ml
+++ b/examples/hyperbolic/hypertree.ml
@@ -583,47 +583,21 @@ let from_screen canvas x y =
 
 let pi = 4. *. atan 1.
 
-let ellipse_arc c cx cy rx ry start fin clock_wise =
-  c##save;
-  c##translate (Js.float cx) (Js.float cy);
-  c##scale (Js.float rx) (Js.float ry);
-  c##arc
-    (Js.float 0.)
-    (Js.float 0.)
-    (Js.float 1.)
-    (Js.float start)
-    (Js.float fin)
-    clock_wise;
-  c##restore
-
 let arc c (rx, ry, dx, dy) z0 z1 z2 =
   let rd = norm (sub z1 z0) in
   let start = atan2 (z1.y -. z0.y) (z1.x -. z0.x) in
   let fin = atan2 (z2.y -. z0.y) (z2.x -. z0.x) in
   c##beginPath;
   let alpha = mod_float (fin -. start +. (2. *. pi)) (2. *. pi) in
-  (*
-Firebug.console##log_4(start, fin, alpha, (alpha > pi));
-*)
-  if rx = ry
-  then
-    c##arc
-      (Js.float ((z0.x *. rx) +. dx))
-      (Js.float ((z0.y *. rx) +. dy))
-      (Js.float (rd *. rx))
-      (Js.float start)
-      (Js.float fin)
-      (Js.bool (alpha > pi))
-  else
-    ellipse_arc
-      c
-      ((z0.x *. rx) +. dx)
-      ((z0.y *. ry) +. dy)
-      (rd *. rx)
-      (rd *. ry)
-      start
-      fin
-      (Js.bool (alpha > pi));
+  c##ellipse
+    ((z0.x *. rx) +. dx)
+    ((z0.y *. ry) +. dy)
+    (rd *. rx)
+    (rd *. ry)
+    0.
+    start
+    fin
+    (Js.bool (alpha > pi));
   c##stroke
 
 let line c (rx, ry, dx, dy) z1 z2 =
@@ -671,7 +645,7 @@ let draw canvas vertices edges nodes boxes =
     (Js.float (float canvas##.height));
   let padding = Js.to_float (opt_style style##.padding (Js.float 0.)) in
   c##beginPath;
-  ellipse_arc c dx dy (rx +. padding) (ry +. padding) 0. 7. Js._false;
+  c##ellipse dx dy (rx +. padding) (ry +. padding) 0. 0. 7. Js._false;
   Js.Optdef.iter style##.backgroundColor (fun color ->
       c##.fillStyle := color;
       c##fill);
diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index df2e90c58e..5895792cb6 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -1846,6 +1846,17 @@ and canvasRenderingContext2D = object
   method arc :
     number_t -> number_t -> number_t -> number_t -> number_t -> bool t -> unit meth
 
+  method ellipse :
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> bool t
+    -> unit meth
+
   method fill : unit meth
 
   method stroke : unit meth
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 34a5fe8d06..f79e12f888 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -1669,6 +1669,17 @@ and canvasRenderingContext2D = object
   method arc :
     number_t -> number_t -> number_t -> number_t -> number_t -> bool t -> unit meth
 
+  method ellipse :
+       number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> number_t
+    -> bool t
+    -> unit meth
+
   method fill : unit meth
 
   method stroke : unit meth

From e30e5405ba606c89bed6d19e359cfe20917954d0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 7 Jun 2024 16:18:04 +0200
Subject: [PATCH 290/481] Fix hyperbolic tree example

---
 examples/hyperbolic/hypertree.ml | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/examples/hyperbolic/hypertree.ml b/examples/hyperbolic/hypertree.ml
index f35b8aee4f..80ed2b63fc 100644
--- a/examples/hyperbolic/hypertree.ml
+++ b/examples/hyperbolic/hypertree.ml
@@ -590,13 +590,13 @@ let arc c (rx, ry, dx, dy) z0 z1 z2 =
   c##beginPath;
   let alpha = mod_float (fin -. start +. (2. *. pi)) (2. *. pi) in
   c##ellipse
-    ((z0.x *. rx) +. dx)
-    ((z0.y *. ry) +. dy)
-    (rd *. rx)
-    (rd *. ry)
-    0.
-    start
-    fin
+    (Js.float ((z0.x *. rx) +. dx))
+    (Js.float ((z0.y *. ry) +. dy))
+    (Js.float (rd *. rx))
+    (Js.float (rd *. ry))
+    (Js.float 0.)
+    (Js.float start)
+    (Js.float fin)
     (Js.bool (alpha > pi));
   c##stroke
 
@@ -645,7 +645,15 @@ let draw canvas vertices edges nodes boxes =
     (Js.float (float canvas##.height));
   let padding = Js.to_float (opt_style style##.padding (Js.float 0.)) in
   c##beginPath;
-  c##ellipse dx dy (rx +. padding) (ry +. padding) 0. 0. 7. Js._false;
+  c##ellipse
+    (Js.float dx)
+    (Js.float dy)
+    (Js.float (rx +. padding))
+    (Js.float (ry +. padding))
+    (Js.float 0.)
+    (Js.float 0.)
+    (Js.float 7.)
+    Js._false;
   Js.Optdef.iter style##.backgroundColor (fun color ->
       c##.fillStyle := color;
       c##fill);

From 5a0a1197c66b4fc602bd7e1d601fcd613f18a86e Mon Sep 17 00:00:00 2001
From: Julien Sagot <1826552+sagotch@users.noreply.github.com>
Date: Thu, 29 Feb 2024 16:13:25 +0100
Subject: [PATCH 291/481] Lib: Dialog element support (#1257)

* Support for dialogElement

* Added cancel and close events

---------

Co-authored-by: Hugo Heuzard <hugo.heuzard@gmail.com>
---
 dune-project                  |  2 +-
 js_of_ocaml-tyxml.opam        |  2 +-
 lib/js_of_ocaml/dom_html.ml   | 27 +++++++++++++++++++++++++++
 lib/js_of_ocaml/dom_html.mli  | 27 +++++++++++++++++++++++++++
 lib/tyxml/tyxml_cast.ml       |  4 ++++
 lib/tyxml/tyxml_cast_sigs.ml  |  4 ++++
 lib/tyxml/tyxml_cast_sigs.mli |  4 ++++
 7 files changed, 68 insertions(+), 2 deletions(-)

diff --git a/dune-project b/dune-project
index a8fa29678c..d436ec2af4 100644
--- a/dune-project
+++ b/dune-project
@@ -111,7 +111,7 @@
   (js_of_ocaml-ppx (= :version))
   (react (>= 1.2.1))
   (reactiveData (>= 0.2))
-  (tyxml (>= 4.3))
+  (tyxml (>= 4.6))
   (num :with-test)
   (ppx_expect (and (>= v0.14.2) :with-test))
   (ppxlib (and (>= 0.22.0) :with-test))
diff --git a/js_of_ocaml-tyxml.opam b/js_of_ocaml-tyxml.opam
index 34d89bb0e4..71390abd60 100644
--- a/js_of_ocaml-tyxml.opam
+++ b/js_of_ocaml-tyxml.opam
@@ -18,7 +18,7 @@ depends: [
   "js_of_ocaml-ppx" {= version}
   "react" {>= "1.2.1"}
   "reactiveData" {>= "0.2"}
-  "tyxml" {>= "4.3"}
+  "tyxml" {>= "4.6"}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}
   "ppxlib" {>= "0.22.0" & with-test}
diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index df2e90c58e..acdd556ef5 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -773,8 +773,12 @@ let invoke_handler = Dom.invoke_handler
 module Event = struct
   type 'a typ = 'a Dom.Event.typ
 
+  let cancel = Dom.Event.make "cancel"
+
   let click = Dom.Event.make "click"
 
+  let close = Dom.Event.make "close"
+
   let copy = Dom.Event.make "copy"
 
   let cut = Dom.Event.make "cut"
@@ -1292,6 +1296,26 @@ class type dListElement = element
 
 class type liElement = element
 
+class type dialogElement = object
+  inherit element
+
+  method close : unit meth
+
+  method close_returnValue : js_string t -> unit meth
+
+  method open_ : bool t prop
+
+  method returnValue : js_string t prop
+
+  method show : unit meth
+
+  method showModal : unit meth
+
+  method oncancel : ('self t, event t) event_listener prop
+
+  method onclose : ('self t, event t) event_listener prop
+end
+
 class type divElement = element
 
 class type paragraphElement = element
@@ -2527,6 +2551,8 @@ let createDl doc : dListElement t = unsafeCreateElement doc "dl"
 
 let createLi doc : liElement t = unsafeCreateElement doc "li"
 
+let createDialog doc : dialogElement t = unsafeCreateElement doc "dialog"
+
 let createDiv doc : divElement t = unsafeCreateElement doc "div"
 
 let createEmbed doc : embedElement t = unsafeCreateElement doc "embed"
@@ -3350,6 +3376,7 @@ type taggedElement =
   | Col of tableColElement t
   | Colgroup of tableColElement t
   | Del of modElement t
+  | Dialog of dialogElement t
   | Div of divElement t
   | Dl of dListElement t
   | Embed of embedElement t
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 34a5fe8d06..27da214f2d 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -1114,6 +1114,26 @@ class type dListElement = element
 
 class type liElement = element
 
+class type dialogElement = object
+  inherit element
+
+  method close : unit meth
+
+  method close_returnValue : js_string t -> unit meth
+
+  method open_ : bool t prop
+
+  method returnValue : js_string t prop
+
+  method show : unit meth
+
+  method showModal : unit meth
+
+  method oncancel : ('self t, event t) event_listener prop
+
+  method onclose : ('self t, event t) event_listener prop
+end
+
 class type divElement = element
 
 class type paragraphElement = element
@@ -2284,8 +2304,12 @@ val eventRelatedTarget : #mouseEvent t -> element t opt
 module Event : sig
   type 'a typ = 'a Dom.Event.typ
 
+  val cancel : event t typ
+
   val click : mouseEvent t typ
 
+  val close : event t typ
+
   val copy : clipboardEvent t typ
 
   val cut : clipboardEvent t typ
@@ -2760,6 +2784,8 @@ val createDl : document t -> dListElement t
 
 val createLi : document t -> liElement t
 
+val createDialog : document t -> dialogElement t
+
 val createDiv : document t -> divElement t
 
 val createEmbed : document t -> embedElement t
@@ -2906,6 +2932,7 @@ type taggedElement =
   | Col of tableColElement t
   | Colgroup of tableColElement t
   | Del of modElement t
+  | Dialog of dialogElement t
   | Div of divElement t
   | Dl of dListElement t
   | Embed of embedElement t
diff --git a/lib/tyxml/tyxml_cast.ml b/lib/tyxml/tyxml_cast.ml
index 79991501ad..53c21ffec2 100644
--- a/lib/tyxml/tyxml_cast.ml
+++ b/lib/tyxml/tyxml_cast.ml
@@ -79,6 +79,8 @@ end) : Tyxml_cast_sigs.TO with type 'a elt = 'a C.elt = struct
 
   let of_li elt = rebuild_node "of_li" elt
 
+  let of_dialog elt = rebuild_node "of_dialog" elt
+
   let of_div elt = rebuild_node "of_div" elt
 
   let of_p elt = rebuild_node "of_p" elt
@@ -309,6 +311,8 @@ end) : Tyxml_cast_sigs.OF with type 'a elt = 'a C.elt = struct
 
   let of_li elt = rebuild_node "of_li" elt
 
+  let of_dialog elt = rebuild_node "of_dialog" elt
+
   let of_div elt = rebuild_node "of_div" elt
 
   let of_paragraph elt = rebuild_node "of_paragraph" elt
diff --git a/lib/tyxml/tyxml_cast_sigs.ml b/lib/tyxml/tyxml_cast_sigs.ml
index 3b634527d5..08d8605ce3 100644
--- a/lib/tyxml/tyxml_cast_sigs.ml
+++ b/lib/tyxml/tyxml_cast_sigs.ml
@@ -71,6 +71,8 @@ module type OF = sig
 
   val of_li : Dom_html.liElement Js.t -> [> Html_types.li ] elt
 
+  val of_dialog : Dom_html.dialogElement Js.t -> [> Html_types.dialog ] elt
+
   val of_div : Dom_html.divElement Js.t -> [> Html_types.div ] elt
 
   val of_paragraph : Dom_html.paragraphElement Js.t -> [> Html_types.p ] elt
@@ -180,6 +182,8 @@ module type TO = sig
 
   val of_li : [< Html_types.li ] elt -> Dom_html.liElement Js.t
 
+  val of_dialog : [< Html_types.dialog ] elt -> Dom_html.dialogElement Js.t
+
   val of_div : [< Html_types.div ] elt -> Dom_html.divElement Js.t
 
   val of_p : [< Html_types.p ] elt -> Dom_html.paragraphElement Js.t
diff --git a/lib/tyxml/tyxml_cast_sigs.mli b/lib/tyxml/tyxml_cast_sigs.mli
index a9136c9112..42007a2ec5 100644
--- a/lib/tyxml/tyxml_cast_sigs.mli
+++ b/lib/tyxml/tyxml_cast_sigs.mli
@@ -70,6 +70,8 @@ module type OF = sig
 
   val of_li : Dom_html.liElement Js.t -> [> Html_types.li ] elt
 
+  val of_dialog : Dom_html.dialogElement Js.t -> [> Html_types.dialog ] elt
+
   val of_div : Dom_html.divElement Js.t -> [> Html_types.div ] elt
 
   val of_paragraph : Dom_html.paragraphElement Js.t -> [> Html_types.p ] elt
@@ -179,6 +181,8 @@ module type TO = sig
 
   val of_li : [< Html_types.li ] elt -> Dom_html.liElement Js.t
 
+  val of_dialog : [< Html_types.dialog ] elt -> Dom_html.dialogElement Js.t
+
   val of_div : [< Html_types.div ] elt -> Dom_html.divElement Js.t
 
   val of_p : [< Html_types.p ] elt -> Dom_html.paragraphElement Js.t

From 4ce9356772e9f91c26d7aefc363db98616d70930 Mon Sep 17 00:00:00 2001
From: Guillaume Petiot <guillaume@tarides.com>
Date: Fri, 1 Mar 2024 10:55:07 +0000
Subject: [PATCH 292/481] Lib: fix paragraph construction and coercion

---
 lib/js_of_ocaml/dom_html.ml  | 2 +-
 lib/js_of_ocaml/dom_html.mli | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index acdd556ef5..14cb2043c9 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -3407,7 +3407,7 @@ type taggedElement =
   | Ol of oListElement t
   | Optgroup of optGroupElement t
   | Option of optionElement t
-  | P of paramElement t
+  | P of paragraphElement t
   | Param of paramElement t
   | Pre of preElement t
   | Q of quoteElement t
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 27da214f2d..0caf77382a 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -2963,7 +2963,7 @@ type taggedElement =
   | Ol of oListElement t
   | Optgroup of optGroupElement t
   | Option of optionElement t
-  | P of paramElement t
+  | P of paragraphElement t
   | Param of paramElement t
   | Pre of preElement t
   | Q of quoteElement t
@@ -3095,7 +3095,7 @@ module CoerceTo : sig
 
   val option : #element t -> optionElement t opt
 
-  val p : #element t -> paramElement t opt
+  val p : #element t -> paragraphElement t opt
 
   val param : #element t -> paramElement t opt
 

From e3f7aa1ffc15e549d179f7a263f4d28b642998f0 Mon Sep 17 00:00:00 2001
From: John Jackson <37978984+johnridesabike@users.noreply.github.com>
Date: Fri, 3 May 2024 17:28:13 -0400
Subject: [PATCH 293/481] Lib: Add Typed_array.Bytes module (#1609)

---
 lib/js_of_ocaml/js_of_ocaml_stubs.c |  8 ++++++++
 lib/js_of_ocaml/typed_array.ml      | 10 ++++++++++
 lib/js_of_ocaml/typed_array.mli     | 17 +++++++++++++++++
 3 files changed, 35 insertions(+)

diff --git a/lib/js_of_ocaml/js_of_ocaml_stubs.c b/lib/js_of_ocaml/js_of_ocaml_stubs.c
index 4617e0720b..f1ed497ad1 100644
--- a/lib/js_of_ocaml/js_of_ocaml_stubs.c
+++ b/lib/js_of_ocaml/js_of_ocaml_stubs.c
@@ -1,5 +1,9 @@
 #include <stdlib.h>
 #include <stdio.h>
+void caml_bytes_of_array () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_bytes_of_array!\n");
+  exit(1);
+}
 void caml_custom_identifier () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_custom_identifier!\n");
   exit(1);
@@ -24,6 +28,10 @@ void caml_js_on_ie () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_js_on_ie!\n");
   exit(1);
 }
+void caml_uint8_array_of_bytes () {
+  fprintf(stderr, "Unimplemented Javascript primitive caml_uint8_array_of_bytes!\n");
+  exit(1);
+}
 void caml_xmlhttprequest_create () {
   fprintf(stderr, "Unimplemented Javascript primitive caml_xmlhttprequest_create!\n");
   exit(1);
diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index 253837b16f..e06f3b50bf 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -277,3 +277,13 @@ module String = struct
     let uint8 = new%js uint8Array_fromBuffer ab in
     of_uint8Array uint8
 end
+
+module Bytes = struct
+  external of_uint8Array : uint8Array Js.t -> bytes = "caml_bytes_of_array"
+
+  external to_uint8Array : bytes -> uint8Array Js.t = "caml_uint8_array_of_bytes"
+
+  let of_arrayBuffer ab =
+    let uint8 = new%js uint8Array_fromBuffer ab in
+    of_uint8Array uint8
+end
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index cea6fc32a5..33d5eca019 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -273,3 +273,20 @@ module String : sig
 
   val of_uint8Array : uint8Array Js.t -> string
 end
+
+module Bytes : sig
+  val of_uint8Array : uint8Array Js.t -> bytes
+  (** This efficiently converts a typed array to [bytes] because it will usually
+      not copy its input.
+
+      Modifying its input may also modify its output, and vice versa when
+      modifying its output. This is not a guarantee, however, since certain
+      [bytes] operations may require the runtime to make a copy. One should not
+      use this on input that is sensitive to modification. *)
+
+  val to_uint8Array : bytes -> uint8Array Js.t
+  (** See the words of caution for {!of_uint8Array}. *)
+
+  val of_arrayBuffer : arrayBuffer Js.t -> bytes
+  (** See the words of caution for {!of_uint8Array}. *)
+end

From de31b5a384c821a917925c98b655c211fa3b0497 Mon Sep 17 00:00:00 2001
From: Stephane Legrand <slegrand45@gmail.com>
Date: Sun, 3 Sep 2023 13:27:18 +0200
Subject: [PATCH 294/481] Add download attribute to anchor element

---
 lib/js_of_ocaml/dom_html.ml  | 2 ++
 lib/js_of_ocaml/dom_html.mli | 2 ++
 2 files changed, 4 insertions(+)

diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index 14cb2043c9..b366a3603b 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -1351,6 +1351,8 @@ class type anchorElement = object
 
   method coords : js_string t prop
 
+  method download : js_string t prop
+
   method href : js_string t prop
 
   method hreflang : js_string t prop
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 0caf77382a..57db485eae 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -1169,6 +1169,8 @@ class type anchorElement = object
 
   method coords : js_string t prop
 
+  method download : js_string t prop
+
   method href : js_string t prop
 
   method hreflang : js_string t prop

From 6dc669706290673b7a4f5ecdd3ae7f107f787092 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Fri, 1 Mar 2024 14:08:33 +0100
Subject: [PATCH 295/481] Compiler: dedicated type for "special" values 
 (#1573)

---
 compiler/lib/code.ml                 | 12 ++++++++++++
 compiler/lib/code.mli                |  5 +++++
 compiler/lib/deadcode.ml             |  1 +
 compiler/lib/eval.ml                 |  3 ++-
 compiler/lib/flow.ml                 |  9 +++++----
 compiler/lib/freevars.ml             |  1 +
 compiler/lib/generate.ml             | 14 ++++++--------
 compiler/lib/global_flow.ml          |  2 ++
 compiler/lib/inline.ml               |  5 ++---
 compiler/lib/parse_bytecode.ml       |  9 ++++-----
 compiler/lib/partial_cps_analysis.ml |  4 ++--
 compiler/lib/phisimpl.ml             |  2 +-
 compiler/lib/primitive.ml            |  5 ++++-
 compiler/lib/pure_fun.ml             |  1 +
 compiler/lib/specialize.ml           |  2 +-
 compiler/lib/subst.ml                |  1 +
 compiler/lib/wasm/wa_generate.ml     |  2 ++
 compiler/lib/wasm/wa_globalize.ml    |  2 +-
 compiler/lib/wasm/wa_liveness.ml     |  4 ++--
 compiler/lib/wasm/wa_spilling.ml     |  8 ++++----
 compiler/tests-dynlink/export        |  3 ++-
 21 files changed, 61 insertions(+), 34 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index efdbc4f52c..ddd4d7157f 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -334,6 +334,10 @@ type prim_arg =
   | Pv of Var.t
   | Pc of constant
 
+type special =
+  | Undefined
+  | Alias_prim of string
+
 type expr =
   | Apply of
       { f : Var.t
@@ -345,6 +349,7 @@ type expr =
   | Closure of Var.t list * cont
   | Constant of constant
   | Prim of prim * prim_arg list
+  | Special of special
 
 type instr =
   | Let of Var.t * expr
@@ -476,6 +481,11 @@ module Print = struct
     | Ult, [ x; y ] -> Format.fprintf f "%a <= %a" arg x arg y
     | _ -> assert false
 
+  let special f s =
+    match s with
+    | Undefined -> Format.fprintf f "undefined"
+    | Alias_prim s -> Format.fprintf f "alias %s" s
+
   let expr f e =
     match e with
     | Apply { f = g; args; exact } ->
@@ -492,6 +502,7 @@ module Print = struct
     | Closure (l, c) -> Format.fprintf f "fun(%a){%a}" var_list l cont c
     | Constant c -> Format.fprintf f "CONST{%a}" constant c
     | Prim (p, l) -> prim f p l
+    | Special s -> special f s
 
   let instr f (i, _loc) =
     match i with
@@ -756,6 +767,7 @@ let invariant { blocks; start; _ } =
           check_cont cont
       | Constant _ -> ()
       | Prim (_, _) -> ()
+      | Special _ -> ()
     in
     let check_instr (i, _loc) =
       match i with
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 13f036fd14..2f6125f83a 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -181,6 +181,10 @@ type prim_arg =
   | Pv of Var.t
   | Pc of constant
 
+type special =
+  | Undefined
+  | Alias_prim of string
+
 type expr =
   | Apply of
       { f : Var.t
@@ -192,6 +196,7 @@ type expr =
   | Closure of Var.t list * cont
   | Constant of constant
   | Prim of prim * prim_arg list
+  | Special of special
 
 type instr =
   | Let of Var.t * expr
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index 5468232a64..cd2a88736b 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -64,6 +64,7 @@ and mark_expr st e =
   | Block (_, a, _) -> Array.iter a ~f:(fun x -> mark_var st x)
   | Field (x, _) -> mark_var st x
   | Closure (_, (pc, _)) -> mark_reachable st pc
+  | Special _ -> ()
   | Prim (_, l) ->
       List.iter l ~f:(fun x ->
           match x with
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 6c1a264650..7370e5b4e3 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -367,7 +367,7 @@ let the_cond_of info x =
             | Float_array _
             | Int64 _ )) -> Non_zero
       | Expr (Block (_, _, _)) -> Non_zero
-      | Expr (Field _ | Closure _ | Prim _ | Apply _) -> Unknown
+      | Expr (Field _ | Closure _ | Prim _ | Apply _ | Special _) -> Unknown
       | Param | Phi _ -> Unknown)
     Unknown
     (fun u v ->
@@ -416,6 +416,7 @@ let rec do_not_raise pc visited blocks =
             match e with
             | Block (_, _, _) | Field (_, _) | Constant _ | Closure _ -> ()
             | Apply _ -> raise May_raise
+            | Special _ -> ()
             | Prim (Extern name, _) when Primitive.is_pure name -> ()
             | Prim (Extern _, _) -> raise May_raise
             | Prim (_, _) -> ()));
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index e6b5b600e9..7e719142fd 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -89,7 +89,7 @@ let cont_deps blocks vars deps defs (pc, args) =
 
 let expr_deps blocks vars deps defs x e =
   match e with
-  | Constant _ | Apply _ | Prim _ -> ()
+  | Constant _ | Apply _ | Prim _ | Special _ -> ()
   | Closure (l, cont) ->
       List.iter l ~f:(fun x -> add_param_def vars defs x);
       cont_deps blocks vars deps defs cont
@@ -137,7 +137,8 @@ let propagate1 deps defs st x =
   | Phi s -> var_set_lift (fun y -> Var.Tbl.get st y) s
   | Expr e -> (
       match e with
-      | Constant _ | Apply _ | Prim _ | Closure _ | Block _ -> Var.Set.singleton x
+      | Constant _ | Apply _ | Prim _ | Special _ | Closure _ | Block _ ->
+          Var.Set.singleton x
       | Field (y, n) ->
           var_set_lift
             (fun z ->
@@ -190,7 +191,7 @@ let rec block_escape st x =
 
 let expr_escape st _x e =
   match e with
-  | Constant _ | Closure _ | Block _ | Field _ -> ()
+  | Special _ | Constant _ | Closure _ | Block _ | Field _ -> ()
   | Apply { args; _ } -> List.iter args ~f:(fun x -> block_escape st x)
   | Prim (Array_get, [ Pv x; _ ]) -> block_escape st x
   | Prim ((Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) -> ()
@@ -266,7 +267,7 @@ let propagate2 ?(skip_param = false) defs known_origins possibly_mutable st x =
   | Phi s -> Var.Set.exists (fun y -> Var.Tbl.get st y) s
   | Expr e -> (
       match e with
-      | Constant _ | Closure _ | Apply _ | Prim _ | Block _ -> false
+      | Constant _ | Closure _ | Apply _ | Prim _ | Block _ | Special _ -> false
       | Field (y, n) ->
           Var.Tbl.get st y
           || Var.Set.exists
diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml
index f7e3daf3be..a635ee5086 100644
--- a/compiler/lib/freevars.ml
+++ b/compiler/lib/freevars.ml
@@ -36,6 +36,7 @@ let iter_expr_free_vars f e =
   | Block (_, a, _) -> Array.iter ~f a
   | Field (x, _) -> f x
   | Closure _ -> ()
+  | Special _ -> ()
   | Prim (_, l) ->
       List.iter l ~f:(fun x ->
           match x with
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index cafd0748af..baeb4ecd6e 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -165,7 +165,7 @@ module Share = struct
                   if (not exact) || cps
                   then add_apply { arity = List.length args; exact; cps } share
                   else share
-              | Let (_, Prim (Extern "%closure", [ Pc (String name) ])) ->
+              | Let (_, Special (Alias_prim name)) ->
                   let name = Primitive.resolve name in
                   let share =
                     if Primitive.exists name then add_prim name share else share
@@ -1261,6 +1261,11 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
   | Constant c ->
       let js, instrs = constant ~ctx c level in
       (js, const_p, queue), instrs
+  | Special (Alias_prim name) ->
+      let prim = Share.get_prim (runtime_fun ctx) name ctx.Ctx.share in
+      (prim, const_p, queue), []
+  | Special Undefined ->
+      (J.(EVar (ident (Utf8_string.of_string_exn "undefined"))), const_p, queue), []
   | Prim (Extern "debugger", _) ->
       let ins =
         if Config.Flag.debugger () then J.Debugger_statement else J.Empty_statement
@@ -1319,10 +1324,6 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
                 ~init:([], const_p, queue)
             in
             J.array args, prop, queue
-        | Extern "%closure", [ Pc (String name) ] ->
-            let prim = Share.get_prim (runtime_fun ctx) name ctx.Ctx.share in
-            prim, const_p, queue
-        | Extern "%closure", _ -> assert false
         | Extern "%caml_js_opt_call", f :: o :: l ->
             let (pf, cf), queue = access_queue' ~ctx queue f in
             let (po, co), queue = access_queue' ~ctx queue o in
@@ -1393,9 +1394,6 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
            | Extern "caml_js_delete", [ _; Pc (String _) ] -> assert false
            ]}
         *)
-        | Extern "%overrideMod", [ Pc (String m); Pc (String f) ] ->
-            runtime_fun ctx (Printf.sprintf "caml_%s_%s" m f), const_p, queue
-        | Extern "%overrideMod", _ -> assert false
         | Extern "%caml_js_opt_object", fields ->
             let rec build_fields queue l =
               match l with
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index 15b3837765..baeb0cd83d 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -153,6 +153,7 @@ let expr_deps blocks st x e =
   match e with
   | Constant _ | Prim ((Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) | Block _
     -> ()
+  | Special _ -> ()
   | Prim
       ( ( Extern
             ( "caml_check_bound"
@@ -462,6 +463,7 @@ let propagate st ~update approx x =
              block *)
           Domain.bot
       | Prim (Extern _, _) -> Domain.others
+      | Special _ -> Domain.others
       | Apply { f; args; _ } -> (
           match Var.Tbl.get approx f with
           | Values { known; others } ->
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 26c8ad397a..0b8fec6ef9 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -167,6 +167,7 @@ let simple blocks cont mapping =
                    })
           | Prim (prim, args) ->
               `Exp (Prim (prim, List.map args ~f:(map_prim_arg mapping)))
+          | Special _ -> `Exp exp
           | Block (tag, args, aon) ->
               `Exp (Block (tag, Array.map args ~f:(map_var mapping), aon))
           | Field (x, i) -> `Exp (Field (map_var mapping x, i))
@@ -252,9 +253,7 @@ let inline ~first_class_primitives live_vars closures pc (outer, blocks, free_pc
                 if Code.Var.compare y y' = 0
                    && Primitive.has_arity prim len
                    && args_equal l args
-                then
-                  ( (Let (x, Prim (Extern "%closure", [ Pc (String prim) ])), loc) :: rem
-                  , state )
+                then (Let (x, Special (Alias_prim prim)), loc) :: rem, state
                 else i :: rem, state
             | _ -> i :: rem, state)
         | _ -> i :: rem, state)
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 6646b2ba5b..9882493145 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -2507,9 +2507,6 @@ let override_global =
   match Ocaml_version.v with
   | `V4_13 | `V4_14 | `V5_00 | `V5_01 | `V5_02 -> []
   | `V4_08 | `V4_09 | `V4_10 | `V4_11 | `V4_12 ->
-      let jsmodule name func =
-        Prim (Extern "%overrideMod", [ Pc (String name); Pc (String func) ])
-      in
       [ ( "CamlinternalMod"
         , fun _orig instrs ->
             let x = Var.fresh_n "internalMod" in
@@ -2517,8 +2514,10 @@ let override_global =
             let update_mod = Var.fresh_n "update_mod" in
             ( x
             , (Let (x, Block (0, [| init_mod; update_mod |], NotArray)), noloc)
-              :: (Let (init_mod, jsmodule "CamlinternalMod" "init_mod"), noloc)
-              :: (Let (update_mod, jsmodule "CamlinternalMod" "update_mod"), noloc)
+              :: ( Let (init_mod, Special (Alias_prim "caml_CamlinternalMod_init_mod"))
+                 , noloc )
+              :: ( Let (update_mod, Special (Alias_prim "caml_CamlinternalMod_update_mod"))
+                 , noloc )
               :: instrs ) )
       ]
 
diff --git a/compiler/lib/partial_cps_analysis.ml b/compiler/lib/partial_cps_analysis.ml
index feb8189fb2..e2424fac1e 100644
--- a/compiler/lib/partial_cps_analysis.ml
+++ b/compiler/lib/partial_cps_analysis.ml
@@ -88,7 +88,7 @@ let block_deps ~info ~vars ~tail_deps ~deps ~blocks ~fun_name pc =
                  in CPS *)
               add_dep deps f x)
       | Let (x, Closure _) -> add_var vars x
-      | Let (_, (Prim _ | Block _ | Constant _ | Field _))
+      | Let (_, (Prim _ | Block _ | Constant _ | Field _ | Special _))
       | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> ())
 
 let program_deps ~info ~vars ~tail_deps ~deps p =
@@ -141,7 +141,7 @@ let cps_needed ~info ~in_mutual_recursion ~rev_deps st x =
   | Expr (Prim (Extern ("%perform" | "%reperform" | "%resume"), _)) ->
       (* Effects primitives are in CPS *)
       true
-  | Expr (Prim _ | Block _ | Constant _ | Field _) | Phi _ -> false
+  | Expr (Prim _ | Block _ | Constant _ | Field _ | Special _) | Phi _ -> false
 
 module SCC = Strongly_connected_components.Make (struct
   type t = Var.t
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index d4a481ef7a..7cc81c4764 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -50,7 +50,7 @@ let cont_deps blocks vars deps defs (pc, args) =
 
 let expr_deps blocks vars deps defs x e =
   match e with
-  | Constant _ | Apply _ | Prim _ -> ()
+  | Constant _ | Apply _ | Prim _ | Special _ -> ()
   | Closure (_, cont) -> cont_deps blocks vars deps defs cont
   | Block (_, a, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
   | Field (y, _) -> add_dep deps x y
diff --git a/compiler/lib/primitive.ml b/compiler/lib/primitive.ml
index 3a94dee698..9ccfd71df3 100644
--- a/compiler/lib/primitive.ml
+++ b/compiler/lib/primitive.ml
@@ -73,7 +73,10 @@ let arity nm = Hashtbl.find arities (resolve nm)
 
 let has_arity nm a = try Hashtbl.find arities (resolve nm) = a with Not_found -> false
 
-let is_pure nm = Poly.(kind nm <> `Mutator)
+let is_pure nm =
+  match nm with
+  | "%identity" | "%direct_int_div" | "%direct_int_mod" | "%direct_int_mul" -> true
+  | _ -> Poly.(kind nm <> `Mutator)
 
 let exists p = Hashtbl.mem kinds p
 
diff --git a/compiler/lib/pure_fun.ml b/compiler/lib/pure_fun.ml
index 714dbe7743..8e566fd135 100644
--- a/compiler/lib/pure_fun.ml
+++ b/compiler/lib/pure_fun.ml
@@ -25,6 +25,7 @@ open Code
 let pure_expr pure_funs e =
   match e with
   | Block _ | Field _ | Closure _ | Constant _ -> true
+  | Special (Alias_prim _ | Undefined) -> true
   | Apply { f; exact; _ } -> exact && Var.Set.mem f pure_funs
   | Prim (p, _l) -> (
       match p with
diff --git a/compiler/lib/specialize.ml b/compiler/lib/specialize.ml
index c1e1c620b2..1ab1f7174f 100644
--- a/compiler/lib/specialize.ml
+++ b/compiler/lib/specialize.ml
@@ -28,7 +28,7 @@ let function_arity info x =
       (fun x ->
         match info.info_defs.(Var.idx x) with
         | Expr (Closure (l, _)) -> Some (List.length l)
-        | Expr (Prim (Extern "%closure", [ Pc (String prim) ])) -> (
+        | Expr (Special (Alias_prim prim)) -> (
             try Some (Primitive.arity prim) with Not_found -> None)
         | Expr (Apply { f; args; _ }) -> (
             if List.mem f ~set:acc
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index d6a03a7a81..7e4d22b081 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -31,6 +31,7 @@ let expr s e =
   | Block (n, a, k) -> Block (n, Array.map a ~f:(fun x -> s x), k)
   | Field (x, n) -> Field (s x, n)
   | Closure (l, pc) -> Closure (l, subst_cont s pc)
+  | Special _ -> e
   | Prim (p, l) ->
       Prim
         ( p
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 6eb088ad7b..fb574316a2 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -165,6 +165,8 @@ module Generate (Target : Wa_target_sig.S) = struct
           ~cps:(Var.Set.mem x ctx.in_cps)
           x
     | Constant c -> Constant.translate c
+    | Special Undefined -> Constant.translate (Int (Regular, 0l))
+    | Special (Alias_prim _) -> assert false
     | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int (_, arity)) ])
       when Poly.(target = `GC) ->
         Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:(Int32.to_int arity)
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib/wasm/wa_globalize.ml
index 8f78ef4208..e27c078bda 100644
--- a/compiler/lib/wasm/wa_globalize.ml
+++ b/compiler/lib/wasm/wa_globalize.ml
@@ -80,7 +80,7 @@ let traverse_expression x e st =
         ~f:(fun st x -> use x st)
         ~init:st
         (Code.Var.Map.find x st.closures).Wa_closure_conversion.free_variables
-  | Constant _ -> st
+  | Constant _ | Special _ -> st
   | Prim (_, args) ->
       List.fold_left
         ~f:(fun st a ->
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
index 7842664242..349842aee4 100644
--- a/compiler/lib/wasm/wa_liveness.ml
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -110,7 +110,7 @@ let expr_used ~context ~closures ~ctx x e s =
   | Block (_, a, _) -> add_array ~ctx s a
   | Prim (_, l) -> add_prim_args ~ctx s l
   | Closure _ -> add_list ~ctx s (function_free_variables ~context ~closures x)
-  | Constant _ -> s
+  | Constant _ | Special _ -> s
   | Field (x, _) -> add_var ~ctx s x
 
 let propagate_through_instr ~context ~closures ~ctx (i, _) s =
@@ -185,7 +185,7 @@ let compute_instr_info ~blocks ~context ~closures ~domain ~ctx st =
                   | Apply _ | Prim _ ->
                       Var.Map.add x (Var.Set.remove x live_vars) live_info
                   | Block _ | Closure _ -> Var.Map.add x live_vars' live_info
-                  | Constant _ | Field _ -> live_info)
+                  | Constant _ | Field _ | Special _ -> live_info)
               | Assign _ | Offset_ref _ | Set_field _ | Array_set _ -> live_info
             in
             live_vars', live_info)
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
index 441d23326d..4c28b2f64f 100644
--- a/compiler/lib/wasm/wa_spilling.ml
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -167,7 +167,7 @@ let function_deps blocks ~context ~closures pc params =
           match i with
           | Let (x, e) -> (
               match e with
-              | Constant _ -> mark_non_spillable x
+              | Constant _ | Special _ -> mark_non_spillable x
               | Prim (p, _) when no_pointer p -> mark_non_spillable x
               | Closure _
                 when List.is_empty (function_free_variables ~context ~closures x) ->
@@ -205,7 +205,7 @@ let propagate_through_expr ~context ~closures s x e =
       if List.is_empty (function_free_variables ~context ~closures x)
       then s
       else Var.Set.empty
-  | Constant _ | Field _ -> s
+  | Constant _ | Field _ | Special _ -> s
 
 let propagate_through_instr ~context ~closures s (i, _) =
   match i with
@@ -310,7 +310,7 @@ let spilled_variables
                         ~f:(fun reloaded x -> check_spilled ~ctx loaded' x reloaded)
                         fv
                         ~init:Var.Set.empty
-                  | Constant _ -> Var.Set.empty
+                  | Constant _ | Special _ -> Var.Set.empty
                   | Field (x, _) -> check_spilled ~ctx loaded x Var.Set.empty)
               | Assign (_, x) | Offset_ref (x, _) ->
                   check_spilled ~ctx loaded x Var.Set.empty
@@ -490,7 +490,7 @@ let spilling blocks st env bound_vars spilled_vars live_info pc params =
                       in
                       instr_info := Var.Map.add x sp !instr_info;
                       stack, Var.Set.empty
-                  | Prim _ | Constant _ | Field _ -> stack, vars)
+                  | Prim _ | Constant _ | Field _ | Special _ -> stack, vars)
               | Assign _ | Offset_ref _ | Set_field _ | Array_set _ -> stack, vars
             in
             let vars =
diff --git a/compiler/tests-dynlink/export b/compiler/tests-dynlink/export
index f516f0a526..7aee0c5d9e 100644
--- a/compiler/tests-dynlink/export
+++ b/compiler/tests-dynlink/export
@@ -1,2 +1,3 @@
 Stdlib
-Stdlib__Buffer
\ No newline at end of file
+Stdlib__Buffer
+Stdlib__buffer
\ No newline at end of file

From c860567760972633b83f177ea23e7472e3917e91 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Fri, 1 Mar 2024 15:29:25 +0100
Subject: [PATCH 296/481] Compiler: remove last argument of Pushtrap (#1575)

---
 compiler/lib/code.ml              | 62 +++++++++++++++++++++++--------
 compiler/lib/code.mli             |  4 +-
 compiler/lib/deadcode.ml          | 12 ++----
 compiler/lib/effects.ml           |  9 ++---
 compiler/lib/eval.ml              |  7 +---
 compiler/lib/flow.ml              |  2 +-
 compiler/lib/freevars.ml          |  4 +-
 compiler/lib/generate.ml          |  6 +--
 compiler/lib/global_flow.ml       |  2 +-
 compiler/lib/inline.ml            |  3 +-
 compiler/lib/parse_bytecode.ml    | 55 +++------------------------
 compiler/lib/phisimpl.ml          |  2 +-
 compiler/lib/subst.ml             |  3 +-
 compiler/lib/tailcall.ml          |  3 +-
 compiler/lib/wasm/wa_generate.ml  |  2 +-
 compiler/lib/wasm/wa_liveness.ml  |  4 +-
 compiler/lib/wasm/wa_spilling.ml  |  4 +-
 compiler/lib/wasm/wa_structure.ml |  4 +-
 18 files changed, 85 insertions(+), 103 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index ddd4d7157f..779f8711f7 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -365,7 +365,7 @@ type last =
   | Branch of cont
   | Cond of Var.t * cont * cont
   | Switch of Var.t * cont array * cont array
-  | Pushtrap of cont * Var.t * cont * Addr.Set.t
+  | Pushtrap of cont * Var.t * cont
   | Poptrap of cont
 
 type block =
@@ -528,17 +528,8 @@ module Print = struct
         Array.iteri a1 ~f:(fun i c -> Format.fprintf f "int %d -> %a; " i cont c);
         Array.iteri a2 ~f:(fun i c -> Format.fprintf f "tag %d -> %a; " i cont c);
         Format.fprintf f "}"
-    | Pushtrap (cont1, x, cont2, pcs) ->
-        Format.fprintf
-          f
-          "pushtrap %a handler %a => %a continuation %s"
-          cont
-          cont1
-          Var.print
-          x
-          cont
-          cont2
-          (String.concat ~sep:", " (List.map (Addr.Set.elements pcs) ~f:string_of_int))
+    | Pushtrap (cont1, x, cont2) ->
+        Format.fprintf f "pushtrap %a handler %a => %a" cont cont1 Var.print x cont cont2
     | Poptrap c -> Format.fprintf f "poptrap %a" cont c
 
   type xinstr =
@@ -609,12 +600,51 @@ let is_empty p =
       | _ -> false)
   | _ -> false
 
+let poptraps blocks pc =
+  let rec loop blocks pc visited depth acc =
+    if Addr.Set.mem pc visited
+    then acc, visited
+    else
+      let visited = Addr.Set.add pc visited in
+      let block = Addr.Map.find pc blocks in
+      match fst block.branch with
+      | Return _ | Raise _ | Stop -> acc, visited
+      | Branch (pc', _) -> loop blocks pc' visited depth acc
+      | Poptrap (pc', _) ->
+          if depth = 0
+          then Addr.Set.add pc' acc, visited
+          else loop blocks pc' visited (depth - 1) acc
+      | Pushtrap ((pc', _), _, (pc_h, _)) ->
+          let acc, visited = loop blocks pc' visited (depth + 1) acc in
+          let acc, visited = loop blocks pc_h visited depth acc in
+          acc, visited
+      | Cond (_, (pc1, _), (pc2, _)) ->
+          let acc, visited = loop blocks pc1 visited depth acc in
+          let acc, visited = loop blocks pc2 visited depth acc in
+          acc, visited
+      | Switch (_, a1, a2) ->
+          let acc, visited =
+            Array.fold_right
+              ~init:(acc, visited)
+              ~f:(fun (pc, _) (acc, visited) -> loop blocks pc visited depth acc)
+              a1
+          in
+          let acc, visited =
+            Array.fold_right
+              ~init:(acc, visited)
+              ~f:(fun (pc, _) (acc, visited) -> loop blocks pc visited depth acc)
+              a2
+          in
+          acc, visited
+  in
+  loop blocks pc Addr.Set.empty 0 Addr.Set.empty |> fst
+
 let fold_children blocks pc f accu =
   let block = Addr.Map.find pc blocks in
   match fst block.branch with
   | Return _ | Raise _ | Stop -> accu
   | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
-  | Pushtrap ((pc', _), _, (pc_h, _), _) ->
+  | Pushtrap ((pc', _), _, (pc_h, _)) ->
       let accu = f pc' accu in
       let accu = f pc_h accu in
       accu
@@ -632,8 +662,8 @@ let fold_children_skip_try_body blocks pc f accu =
   match fst block.branch with
   | Return _ | Raise _ | Stop -> accu
   | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
-  | Pushtrap (_, _, (pc_h, _), pcs) ->
-      let accu = Addr.Set.fold f pcs accu in
+  | Pushtrap ((pc', _), _, (pc_h, _)) ->
+      let accu = Addr.Set.fold f (poptraps blocks pc') accu in
       let accu = f pc_h accu in
       accu
   | Cond (_, (pc1, _), (pc2, _)) ->
@@ -791,7 +821,7 @@ let invariant { blocks; start; _ } =
       | Switch (_x, a1, a2) ->
           Array.iteri a1 ~f:(fun _ cont -> check_cont cont);
           Array.iteri a2 ~f:(fun _ cont -> check_cont cont)
-      | Pushtrap (cont1, _x, cont2, _pcs) ->
+      | Pushtrap (cont1, _x, cont2) ->
           check_cont cont1;
           check_cont cont2
       | Poptrap cont -> check_cont cont
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 2f6125f83a..9c1d5cc592 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -212,7 +212,7 @@ type last =
   | Branch of cont
   | Cond of Var.t * cont * cont
   | Switch of Var.t * cont array * cont array
-  | Pushtrap of cont * Var.t * cont * Addr.Set.t
+  | Pushtrap of cont * Var.t * cont
   | Poptrap of cont
 
 type block =
@@ -276,6 +276,8 @@ val fold_children : 'c fold_blocs
 
 val fold_children_skip_try_body : 'c fold_blocs
 
+val poptraps : block Addr.Map.t -> Addr.t -> Addr.Set.t
+
 val traverse :
   fold_blocs_poly -> (Addr.t -> 'c -> 'c) -> Addr.t -> block Addr.Map.t -> 'c -> 'c
 
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index cd2a88736b..c04af06ff5 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -102,7 +102,7 @@ and mark_reachable st pc =
         mark_var st x;
         Array.iter a1 ~f:(fun cont -> mark_cont_reachable st cont);
         Array.iter a2 ~f:(fun cont -> mark_cont_reachable st cont)
-    | Pushtrap (cont1, _, cont2, _) ->
+    | Pushtrap (cont1, _, cont2) ->
         mark_cont_reachable st cont1;
         mark_cont_reachable st cont2)
 
@@ -142,12 +142,8 @@ let filter_live_last blocks st (l, loc) =
           ( x
           , Array.map a1 ~f:(fun cont -> filter_cont blocks st cont)
           , Array.map a2 ~f:(fun cont -> filter_cont blocks st cont) )
-    | Pushtrap (cont1, x, cont2, pcs) ->
-        Pushtrap
-          ( filter_cont blocks st cont1
-          , x
-          , filter_cont blocks st cont2
-          , Addr.Set.inter pcs st.reachable_blocks )
+    | Pushtrap (cont1, x, cont2) ->
+        Pushtrap (filter_cont blocks st cont1, x, filter_cont blocks st cont2)
     | Poptrap cont -> Poptrap (filter_cont blocks st cont)
   in
   l, loc
@@ -208,7 +204,7 @@ let f ({ blocks; _ } as p : Code.program) =
       | Switch (_, a1, a2) ->
           Array.iter a1 ~f:(fun cont -> add_cont_dep blocks defs cont);
           Array.iter a2 ~f:(fun cont -> add_cont_dep blocks defs cont)
-      | Pushtrap (cont, _, cont_h, _) ->
+      | Pushtrap (cont, _, cont_h) ->
           add_cont_dep blocks defs cont_h;
           add_cont_dep blocks defs cont
       | Poptrap cont -> add_cont_dep blocks defs cont)
diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml
index 1dd38eb105..6803085d81 100644
--- a/compiler/lib/effects.ml
+++ b/compiler/lib/effects.ml
@@ -191,7 +191,7 @@ let compute_needed_transformations ~cfg ~idom ~cps_needed ~blocks ~start =
               List.iter ~f:mark_needed englobing_exn_handlers;
               mark_continuation dst x
           | _ -> ())
-      | Pushtrap (_, x, (handler_pc, _), _) -> mark_continuation handler_pc x
+      | Pushtrap (_, x, (handler_pc, _)) -> mark_continuation handler_pc x
       | Poptrap _ | Raise _ -> (
           match englobing_exn_handlers with
           | handler_pc :: _ -> Hashtbl.add matching_exn_handler pc handler_pc
@@ -203,7 +203,7 @@ let compute_needed_transformations ~cfg ~idom ~cps_needed ~blocks ~start =
         (fun pc visited ->
           let englobing_exn_handlers =
             match block.branch with
-            | Pushtrap (_, _, (handler_pc, _), _), _ when pc <> handler_pc ->
+            | Pushtrap (_, _, (handler_pc, _)), _ when pc <> handler_pc ->
                 handler_pc :: englobing_exn_handlers
             | Poptrap _, _ -> List.tl englobing_exn_handlers
             | _ -> englobing_exn_handlers
@@ -438,7 +438,7 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
       ( alloc_jump_closures
       , ( Switch (x, Array.map c1 ~f:cps_jump_cont, Array.map c2 ~f:cps_jump_cont)
         , last_loc ) )
-  | Pushtrap (body_cont, exn, ((handler_pc, _) as handler_cont), _) -> (
+  | Pushtrap (body_cont, exn, ((handler_pc, _) as handler_cont)) -> (
       assert (Hashtbl.mem st.is_continuation handler_pc);
       match Addr.Set.mem handler_pc st.blocks_to_transform with
       | false -> alloc_jump_closures, (last, last_loc)
@@ -931,8 +931,7 @@ let remove_empty_blocks ~live_vars (p : Code.program) : Code.program =
                | Cond (x, cont1, cont2) -> Cond (x, resolve cont1, resolve cont2)
                | Switch (x, a1, a2) ->
                    Switch (x, Array.map ~f:resolve a1, Array.map ~f:resolve a2)
-               | Pushtrap (cont1, x, cont2, s) ->
-                   Pushtrap (resolve cont1, x, resolve cont2, s)
+               | Pushtrap (cont1, x, cont2) -> Pushtrap (resolve cont1, x, resolve cont2)
                | Poptrap cont -> Poptrap (resolve cont)
                | Return _ | Raise _ | Stop -> branch
              in
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 7370e5b4e3..19886b4ee3 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -444,8 +444,7 @@ let drop_exception_handler blocks =
   Addr.Map.fold
     (fun pc _ blocks ->
       match Addr.Map.find pc blocks with
-      | { branch = Pushtrap (((addr, _) as cont1), _x, _cont2, addrset), loc; _ } as b
-        -> (
+      | { branch = Pushtrap (((addr, _) as cont1), _x, _cont2), loc; _ } as b -> (
           try
             let visited = do_not_raise addr Addr.Set.empty blocks in
             let b = { b with branch = Branch cont1, loc } in
@@ -456,9 +455,7 @@ let drop_exception_handler blocks =
                   let b = Addr.Map.find pc2 blocks in
                   let branch =
                     match b.branch with
-                    | Poptrap ((addr, _) as cont), loc ->
-                        assert (Addr.Set.mem addr addrset);
-                        Branch cont, loc
+                    | Poptrap cont, loc -> Branch cont, loc
                     | x -> x
                   in
                   let b = { b with branch } in
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 7e719142fd..3d38339992 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -122,7 +122,7 @@ let program_deps { blocks; _ } =
       | Switch (_, a1, a2) ->
           Array.iter a1 ~f:(fun cont -> cont_deps blocks vars deps defs cont);
           Array.iter a2 ~f:(fun cont -> cont_deps blocks vars deps defs cont)
-      | Pushtrap (cont, x, cont_h, _) ->
+      | Pushtrap (cont, x, cont_h) ->
           add_param_def vars defs x;
           cont_deps blocks vars deps defs cont_h;
           cont_deps blocks vars deps defs cont)
diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml
index a635ee5086..feeacef212 100644
--- a/compiler/lib/freevars.ml
+++ b/compiler/lib/freevars.ml
@@ -69,7 +69,7 @@ let iter_last_free_var f l =
       f x;
       Array.iter a1 ~f:(fun c -> iter_cont_free_vars f c);
       Array.iter a2 ~f:(fun c -> iter_cont_free_vars f c)
-  | Pushtrap (cont1, _, cont2, _) ->
+  | Pushtrap (cont1, _, cont2) ->
       iter_cont_free_vars f cont1;
       iter_cont_free_vars f cont2
 
@@ -85,7 +85,7 @@ let iter_instr_bound_vars f i =
 let iter_last_bound_vars f l =
   match l with
   | Return _ | Raise _ | Stop | Branch _ | Cond _ | Switch _ | Poptrap _ -> ()
-  | Pushtrap (_, x, _, _) -> f x
+  | Pushtrap (_, x, _) -> f x
 
 let iter_block_bound_vars f block =
   List.iter ~f block.params;
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index baeb4ecd6e..4413d29042 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -758,7 +758,7 @@ let fold_children blocks pc f accu =
   match fst block.branch with
   | Return _ | Raise _ | Stop -> accu
   | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
-  | Pushtrap ((pc1, _), _, (pc2, _), _) ->
+  | Pushtrap ((pc1, _), _, (pc2, _)) ->
       let accu = f pc1 accu in
       let accu = f pc2 accu in
       accu
@@ -805,7 +805,7 @@ let build_graph ctx pc =
       List.iter pc_succs ~f:(fun pc' ->
           let pushtrap =
             match fst b.branch with
-            | Pushtrap ((pc1, _), _, (pc2, _), _remove) ->
+            | Pushtrap ((pc1, _), _, (pc2, _)) ->
                 if pc' = pc1
                 then (
                   Hashtbl.add poptrap pc Addr.Set.empty;
@@ -1866,7 +1866,7 @@ and compile_conditional st queue last loop_stack backs frontier interm =
         in
         true, flush_all queue [ J.Return_statement e_opt, loc ]
     | Branch cont -> compile_branch st queue cont loop_stack backs frontier interm
-    | Pushtrap (c1, x, e1, _) ->
+    | Pushtrap (c1, x, e1) ->
         let never_body, body = compile_branch st [] c1 loop_stack backs frontier interm in
         if debug () then Format.eprintf "@,}@]@,@[<hv 2>catch {@;";
         let never_handler, handler =
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index baeb0cd83d..4742ad5896 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -273,7 +273,7 @@ let program_deps st { blocks; _ } =
                     | _ -> ())
                   block.body)
               h
-      | Pushtrap (cont, x, cont_h, _) ->
+      | Pushtrap (cont, x, cont_h) ->
           add_var st x;
           st.defs.(Var.idx x) <- Phi { known = Var.Set.empty; others = true };
           cont_deps blocks st cont_h;
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 0b8fec6ef9..e23bcf9d6a 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -107,7 +107,8 @@ let fold_children blocks pc f accu =
   match fst block.branch with
   | Return _ | Raise _ | Stop -> accu
   | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
-  | Pushtrap (_, _, (pc1, _), pcs) -> f pc1 (Addr.Set.fold f pcs accu)
+  | Pushtrap ((try_body, _), _, (pc1, _)) ->
+      f pc1 (Addr.Set.fold f (Code.poptraps blocks try_body) accu)
   | Cond (_, (pc1, _), (pc2, _)) ->
       let accu = f pc1 accu in
       let accu = f pc2 accu in
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 9882493145..358303f99f 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -554,10 +554,7 @@ module State = struct
     | Var (x, _) -> Format.fprintf f "%a" Var.print x
     | Dummy -> Format.fprintf f "???"
 
-  type handler =
-    { block_pc : Addr.t
-    ; stack : elt list
-    }
+  type handler = { stack : elt list }
 
   type t =
     { accu : elt
@@ -566,7 +563,6 @@ module State = struct
     ; env_offset : int
     ; handlers : handler list
     ; globals : globals
-    ; current_pc : Addr.t
     }
 
   let fresh_var state loc =
@@ -647,7 +643,7 @@ module State = struct
   let start_function state env offset =
     { state with accu = Dummy; stack = []; env; env_offset = offset; handlers = [] }
 
-  let start_block current_pc state =
+  let start_block _current_pc state =
     let stack =
       List.fold_right state.stack ~init:[] ~f:(fun e stack ->
           match e with
@@ -656,7 +652,7 @@ module State = struct
               let y = Var.fork x in
               Var (y, l) :: stack)
     in
-    let state = { state with stack; current_pc } in
+    let state = { state with stack } in
     match state.accu with
     | Dummy -> state
     | Var (x, loc) ->
@@ -665,26 +661,12 @@ module State = struct
         state
 
   let push_handler state =
-    { state with
-      handlers = { block_pc = state.current_pc; stack = state.stack } :: state.handlers
-    }
+    { state with handlers = { stack = state.stack } :: state.handlers }
 
   let pop_handler state = { state with handlers = List.tl state.handlers }
 
-  let addr_of_current_handler state =
-    match state.handlers with
-    | [] -> assert false
-    | x :: _ -> x.block_pc
-
   let initial g =
-    { accu = Dummy
-    ; stack = []
-    ; env = [||]
-    ; env_offset = 0
-    ; handlers = []
-    ; globals = g
-    ; current_pc = -1
-    }
+    { accu = Dummy; stack = []; env = [||]; env_offset = 0; handlers = []; globals = g }
 
   let rec print_stack f l =
     match l with
@@ -832,8 +814,6 @@ let tagged_blocks = ref Addr.Set.empty
 
 let compiled_blocks = ref Addr.Map.empty
 
-let pushpop = ref Addr.Map.empty
-
 let method_cache_id = ref 1
 
 let clo_offset_3 = if new_closure_repr then 3 else 2
@@ -1727,8 +1707,7 @@ and compile infos pc state instrs =
             , ( Pushtrap
                   ( (body_addr, State.stack_vars state)
                   , x
-                  , (handler_addr, State.stack_vars handler_state)
-                  , Addr.Set.empty )
+                  , (handler_addr, State.stack_vars handler_state) )
               , loc ) )
             !compiled_blocks;
         compile_block
@@ -1756,12 +1735,6 @@ and compile infos pc state instrs =
         instrs, (Branch (interm_addr, State.stack_vars state), loc), state
     | POPTRAP ->
         let addr = pc + 1 in
-        let handler_addr = State.addr_of_current_handler state in
-        let set =
-          try Addr.Set.add addr (Addr.Map.find handler_addr !pushpop)
-          with Not_found -> Addr.Set.singleton addr
-        in
-        pushpop := Addr.Map.add handler_addr set !pushpop;
         compile_block
           infos.blocks
           infos.debug
@@ -2449,20 +2422,6 @@ and compile infos pc state instrs =
 
 (****)
 
-let match_exn_traps (blocks : 'a Addr.Map.t) =
-  Addr.Map.fold
-    (fun pc conts' blocks ->
-      match Addr.Map.find pc blocks with
-      | { branch = Pushtrap (cont1, x, cont2, conts), loc; _ } as block ->
-          assert (Addr.Set.is_empty conts);
-          let branch = Pushtrap (cont1, x, cont2, conts'), loc in
-          Addr.Map.add pc { block with branch } blocks
-      | _ -> assert false)
-    !pushpop
-    blocks
-
-(****)
-
 type one =
   { code : Code.program
   ; cmis : StringSet.t
@@ -2491,12 +2450,10 @@ let parse_bytecode code globals debug_data ~target =
             { params = State.stack_vars state; body = instr; branch = last })
           !compiled_blocks
       in
-      let blocks = match_exn_traps blocks in
       let free_pc = String.length code / 4 in
       { start; blocks; free_pc })
     else Code.empty
   in
-  pushpop := Addr.Map.empty;
   compiled_blocks := Addr.Map.empty;
   tagged_blocks := Addr.Set.empty;
   p
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 7cc81c4764..65d7b39606 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -80,7 +80,7 @@ let program_deps { blocks; _ } =
       | Switch (_, a1, a2) ->
           Array.iter a1 ~f:(fun cont -> cont_deps blocks vars deps defs cont);
           Array.iter a2 ~f:(fun cont -> cont_deps blocks vars deps defs cont)
-      | Pushtrap (cont, _, cont_h, _) ->
+      | Pushtrap (cont, _, cont_h) ->
           cont_deps blocks vars deps defs cont_h;
           cont_deps blocks vars deps defs cont
       | Poptrap cont -> cont_deps blocks vars deps defs cont)
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index 7e4d22b081..5f438c941a 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -55,8 +55,7 @@ let last s (l, loc) =
     match l with
     | Stop -> l
     | Branch cont -> Branch (subst_cont s cont)
-    | Pushtrap (cont1, x, cont2, pcs) ->
-        Pushtrap (subst_cont s cont1, x, subst_cont s cont2, pcs)
+    | Pushtrap (cont1, x, cont2) -> Pushtrap (subst_cont s cont1, x, subst_cont s cont2)
     | Return x -> Return (s x)
     | Raise (x, k) -> Raise (s x, k)
     | Cond (x, cont1, cont2) -> Cond (s x, subst_cont s cont1, subst_cont s cont2)
diff --git a/compiler/lib/tailcall.ml b/compiler/lib/tailcall.ml
index b37ff698cb..209625abed 100644
--- a/compiler/lib/tailcall.ml
+++ b/compiler/lib/tailcall.ml
@@ -63,7 +63,8 @@ let fold_children blocks pc f accu =
   match fst block.branch with
   | Return _ | Raise _ | Stop -> accu
   | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
-  | Pushtrap (_, _, (pc1, _), pcs) -> f pc1 (Addr.Set.fold f pcs accu)
+  | Pushtrap ((try_body, _), _, (pc1, _)) ->
+      f pc1 (Addr.Set.fold f (Code.poptraps blocks try_body) accu)
   | Cond (_, (pc1, _), (pc2, _)) ->
       let accu = f pc1 accu in
       let accu = f pc2 accu in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index fb574316a2..282d6b91a8 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -959,7 +959,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                 let* e = load x in
                 let* tag = register_import ~name:exception_name (Tag Value.value) in
                 instr (Throw (tag, e))
-            | Pushtrap (cont, x, cont', _) ->
+            | Pushtrap (cont, x, cont') ->
                 handle_exceptions
                   ~result_typ
                   ~fall_through
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
index 349842aee4..5b2d39cf7f 100644
--- a/compiler/lib/wasm/wa_liveness.ml
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -61,7 +61,7 @@ let block_deps deps block pc =
   | Switch (_, a1, a2) ->
       Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont);
       Array.iter a2 ~f:(fun cont -> cont_deps deps pc cont)
-  | Pushtrap (cont, _, cont_h, _) ->
+  | Pushtrap (cont, _, cont_h) ->
       cont_deps deps pc cont;
       cont_deps deps pc cont_h
 
@@ -131,7 +131,7 @@ let propagate_through_branch ~ctx (b, _) s =
   | Switch (_, a1, a2) ->
       let s = Array.fold_right a1 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s in
       Array.fold_right a2 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s
-  | Pushtrap (cont, x, cont_h, _) ->
+  | Pushtrap (cont, x, cont_h) ->
       s |> cont_used ~ctx cont |> cont_used ~ctx cont_h |> Var.Set.remove x
 
 let propagate blocks ~context ~closures ~ctx rev_deps st pc =
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
index 4c28b2f64f..3ccb0a5c0c 100644
--- a/compiler/lib/wasm/wa_spilling.ml
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -146,7 +146,7 @@ let block_deps bound_vars deps block pc =
   | Switch (_, a1, a2) ->
       Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont);
       Array.iter a2 ~f:(fun cont -> cont_deps deps pc cont)
-  | Pushtrap (cont, exn, cont_h, _) ->
+  | Pushtrap (cont, exn, cont_h) ->
       cont_deps deps pc cont;
       bound_vars := Var.Set.add exn !bound_vars;
       cont_deps deps pc ~exn cont_h
@@ -342,7 +342,7 @@ let spilled_variables
       | Switch (_, a1, a2) ->
           let spilled = Array.fold_right a1 ~f:handle_cont ~init:spilled in
           Array.fold_right a2 ~f:handle_cont ~init:spilled
-      | Pushtrap (cont, _, cont_h, _) -> spilled |> handle_cont cont |> handle_cont cont_h)
+      | Pushtrap (cont, _, cont_h) -> spilled |> handle_cont cont |> handle_cont cont_h)
     domain
     spilled
 
diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
index 80ea1e567a..520465a563 100644
--- a/compiler/lib/wasm/wa_structure.ml
+++ b/compiler/lib/wasm/wa_structure.ml
@@ -83,7 +83,7 @@ let build_graph blocks pc =
         (fun pc' ->
           let englobing_exn_handlers =
             match fst block.branch with
-            | Pushtrap ((body_pc, _), _, _, _) when pc' = body_pc ->
+            | Pushtrap ((body_pc, _), _, _) when pc' = body_pc ->
                 pc :: englobing_exn_handlers
             | Poptrap (leave_pc, _) -> (
                 match englobing_exn_handlers with
@@ -219,7 +219,7 @@ let shrink_loops blocks ({ succs; preds; reverse_post_order; _ } as g) =
            moved outside *)
         let ignored =
           match fst block.branch with
-          | Pushtrap ((body_pc, _), _, _, _) when pc' = body_pc ->
+          | Pushtrap ((body_pc, _), _, _) when pc' = body_pc ->
               Addr.Set.union ignored loops
           | _ -> ignored
         in

From 5db44d2d2ef16bd0582606e7b1f16223ae5a172d Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Thu, 18 Apr 2024 09:52:24 +0200
Subject: [PATCH 297/481] Compiler: track block mutability (#1603)

---
 compiler/lib/code.ml              | 18 +++++++++---
 compiler/lib/code.mli             |  6 +++-
 compiler/lib/deadcode.ml          |  2 +-
 compiler/lib/eval.ml              | 10 +++----
 compiler/lib/flow.ml              | 17 +++++------
 compiler/lib/freevars.ml          |  2 +-
 compiler/lib/generate.ml          |  2 +-
 compiler/lib/generate_closure.ml  |  2 +-
 compiler/lib/global_flow.ml       | 12 ++++----
 compiler/lib/inline.ml            |  4 +--
 compiler/lib/parse_bytecode.ml    | 48 ++++++++++++++++++++++++-------
 compiler/lib/phisimpl.ml          |  2 +-
 compiler/lib/specialize_js.ml     | 12 ++++----
 compiler/lib/subst.ml             |  2 +-
 compiler/lib/wasm/wa_generate.ml  |  2 +-
 compiler/lib/wasm/wa_globalize.ml |  2 +-
 compiler/lib/wasm/wa_liveness.ml  |  2 +-
 compiler/lib/wasm/wa_spilling.ml  |  2 +-
 18 files changed, 94 insertions(+), 53 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 779f8711f7..3fda9f32ad 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -338,13 +338,17 @@ type special =
   | Undefined
   | Alias_prim of string
 
+type mutability =
+  | Immutable
+  | Maybe_mutable
+
 type expr =
   | Apply of
       { f : Var.t
       ; args : Var.t list
       ; exact : bool
       }
-  | Block of int * Var.t array * array_or_not
+  | Block of int * Var.t array * array_or_not * mutability
   | Field of Var.t * int
   | Closure of Var.t list * cont
   | Constant of constant
@@ -492,8 +496,14 @@ module Print = struct
         if exact
         then Format.fprintf f "%a!(%a)" Var.print g var_list args
         else Format.fprintf f "%a(%a)" Var.print g var_list args
-    | Block (t, a, _) ->
-        Format.fprintf f "{tag=%d" t;
+    | Block (t, a, _, mut) ->
+        Format.fprintf
+          f
+          "%s{tag=%d"
+          (match mut with
+          | Immutable -> "imm"
+          | Maybe_mutable -> "")
+          t;
         for i = 0 to Array.length a - 1 do
           Format.fprintf f "; %d = %a" i Var.print a.(i)
         done;
@@ -790,7 +800,7 @@ let invariant { blocks; start; _ } =
     in
     let check_expr = function
       | Apply _ -> ()
-      | Block (_, _, _) -> ()
+      | Block (_, _, _, _) -> ()
       | Field (_, _) -> ()
       | Closure (l, cont) ->
           List.iter l ~f:define;
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 9c1d5cc592..67bd0d4ded 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -185,13 +185,17 @@ type special =
   | Undefined
   | Alias_prim of string
 
+type mutability =
+  | Immutable
+  | Maybe_mutable
+
 type expr =
   | Apply of
       { f : Var.t
       ; args : Var.t list
       ; exact : bool (* if true, then # of arguments = # of parameters *)
       }
-  | Block of int * Var.t array * array_or_not
+  | Block of int * Var.t array * array_or_not * mutability
   | Field of Var.t * int
   | Closure of Var.t list * cont
   | Constant of constant
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index c04af06ff5..0dd6622130 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -61,7 +61,7 @@ and mark_expr st e =
   | Apply { f; args; _ } ->
       mark_var st f;
       List.iter args ~f:(fun x -> mark_var st x)
-  | Block (_, a, _) -> Array.iter a ~f:(fun x -> mark_var st x)
+  | Block (_, a, _, _) -> Array.iter a ~f:(fun x -> mark_var st x)
   | Field (x, _) -> mark_var st x
   | Closure (_, (pc, _)) -> mark_reachable st pc
   | Special _ -> ()
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 19886b4ee3..bb637bdfbc 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -200,7 +200,7 @@ let is_int ~target info x =
               match target with
               | `JavaScript -> Y
               | `Wasm -> N)
-          | Expr (Block (_, _, _)) | Expr (Constant _) -> N
+          | Expr (Block (_, _, _, _)) | Expr (Constant _) -> N
           | _ -> Unknown)
         Unknown
         (fun u v ->
@@ -275,7 +275,7 @@ let eval_instr ~target info ((x, loc) as i) =
                    | `JavaScript -> "js_of_ocaml"
                    | `Wasm -> "wasm_of_ocaml")) )
         , noloc )
-      ; Let (x, Block (0, [| jsoo |], NotArray)), loc
+      ; Let (x, Block (0, [| jsoo |], NotArray, Immutable)), loc
       ]
   | Let (_, Prim (Extern ("%resume" | "%perform" | "%reperform"), _)) ->
       [ i ] (* We need that the arguments to this primitives remain variables *)
@@ -331,7 +331,7 @@ let the_case_of info x =
         (fun x ->
           match info.info_defs.(Var.idx x) with
           | Expr (Constant (Int (_, i))) -> CConst (Int32.to_int i)
-          | Expr (Block (j, _, _)) ->
+          | Expr (Block (j, _, _, _)) ->
               if Var.ISet.mem info.info_possibly_mutable x then Unknown else CTag j
           | Expr (Constant (Tuple (j, _, _))) -> CTag j
           | _ -> Unknown)
@@ -366,7 +366,7 @@ let the_cond_of info x =
             | NativeString _
             | Float_array _
             | Int64 _ )) -> Non_zero
-      | Expr (Block (_, _, _)) -> Non_zero
+      | Expr (Block (_, _, _, _)) -> Non_zero
       | Expr (Field _ | Closure _ | Prim _ | Apply _ | Special _) -> Unknown
       | Param | Phi _ -> Unknown)
     Unknown
@@ -414,7 +414,7 @@ let rec do_not_raise pc visited blocks =
         | Array_set (_, _, _) | Offset_ref (_, _) | Set_field (_, _, _) | Assign _ -> ()
         | Let (_, e) -> (
             match e with
-            | Block (_, _, _) | Field (_, _) | Constant _ | Closure _ -> ()
+            | Block (_, _, _, _) | Field (_, _) | Constant _ | Closure _ -> ()
             | Apply _ -> raise May_raise
             | Special _ -> ()
             | Prim (Extern name, _) when Primitive.is_pure name -> ()
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 3d38339992..b23fc060ba 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -93,7 +93,7 @@ let expr_deps blocks vars deps defs x e =
   | Closure (l, cont) ->
       List.iter l ~f:(fun x -> add_param_def vars defs x);
       cont_deps blocks vars deps defs cont
-  | Block (_, a, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
+  | Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
   | Field (y, _) -> add_dep deps x y
 
 let program_deps { blocks; _ } =
@@ -143,7 +143,7 @@ let propagate1 deps defs st x =
           var_set_lift
             (fun z ->
               match defs.(Var.idx z) with
-              | Expr (Block (_, a, _)) when n < Array.length a ->
+              | Expr (Block (_, a, _, _)) when n < Array.length a ->
                   let t = a.(n) in
                   add_dep deps x t;
                   Var.Tbl.get st t
@@ -185,7 +185,7 @@ let rec block_escape st x =
         Code.Var.ISet.add st.may_escape y;
         Code.Var.ISet.add st.possibly_mutable y;
         match st.defs.(Var.idx y) with
-        | Expr (Block (_, l, _)) -> Array.iter l ~f:(fun z -> block_escape st z)
+        | Expr (Block (_, l, _, _)) -> Array.iter l ~f:(fun z -> block_escape st z)
         | _ -> ()))
     (Var.Tbl.get st.known_origins x)
 
@@ -217,15 +217,16 @@ let expr_escape st _x e =
             | Pv v, `Shallow_const -> (
                 match st.defs.(Var.idx v) with
                 | Expr (Constant (Tuple _)) -> ()
-                | Expr (Block (_, a, _)) -> Array.iter a ~f:(fun x -> block_escape st x)
+                | Expr (Block (_, a, _, _)) ->
+                    Array.iter a ~f:(fun x -> block_escape st x)
                 | _ -> block_escape st v)
             | Pv v, `Object_literal -> (
                 match st.defs.(Var.idx v) with
                 | Expr (Constant (Tuple _)) -> ()
-                | Expr (Block (_, a, _)) ->
+                | Expr (Block (_, a, _, _)) ->
                     Array.iter a ~f:(fun x ->
                         match st.defs.(Var.idx x) with
-                        | Expr (Block (_, [| _k; v |], _)) -> block_escape st v
+                        | Expr (Block (_, [| _k; v |], _, _)) -> block_escape st v
                         | Expr (Constant _) -> ()
                         | _ -> block_escape st x)
                 | _ -> block_escape st v)
@@ -273,7 +274,7 @@ let propagate2 ?(skip_param = false) defs known_origins possibly_mutable st x =
           || Var.Set.exists
                (fun z ->
                  match defs.(Var.idx z) with
-                 | Expr (Block (_, a, _)) ->
+                 | Expr (Block (_, a, _, _)) ->
                      n >= Array.length a
                      || Var.ISet.mem possibly_mutable z
                      || Var.Tbl.get st a.(n)
@@ -368,7 +369,7 @@ let direct_approx info x =
           then None
           else
             match info.info_defs.(Var.idx z) with
-            | Expr (Block (_, a, _)) when n < Array.length a -> Some a.(n)
+            | Expr (Block (_, a, _, _)) when n < Array.length a -> Some a.(n)
             | _ -> None)
         None
         (fun u v ->
diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml
index feeacef212..ef964ee230 100644
--- a/compiler/lib/freevars.ml
+++ b/compiler/lib/freevars.ml
@@ -33,7 +33,7 @@ let iter_expr_free_vars f e =
   | Apply { f = x; args; _ } ->
       f x;
       List.iter ~f args
-  | Block (_, a, _) -> Array.iter ~f a
+  | Block (_, a, _, _) -> Array.iter ~f a
   | Field (x, _) -> f x
   | Closure _ -> ()
   | Special _ -> ()
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 4413d29042..1426ace705 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1222,7 +1222,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
       let prop = or_p prop prop' in
       let e = apply_fun ctx f args exact cps loc in
       (e, prop, queue), []
-  | Block (tag, a, array_or_not) ->
+  | Block (tag, a, array_or_not, _mut) ->
       let contents, prop, queue =
         List.fold_right
           ~f:(fun x (args, prop, queue) ->
diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml
index f32d0a68cf..9a638169ac 100644
--- a/compiler/lib/generate_closure.ml
+++ b/compiler/lib/generate_closure.ml
@@ -377,7 +377,7 @@ let rewrite_mutable
           ; body =
               closures_intern
               @ proj
-              @ [ Let (b, Block (0, Array.of_list new_xs, NotArray)), noloc ]
+              @ [ Let (b, Block (0, Array.of_list new_xs, NotArray, Immutable)), noloc ]
           ; branch = Return b, noloc
           }
         in
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index 4742ad5896..d6541cb419 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -201,15 +201,15 @@ let expr_deps blocks st x e =
             | Pv v, `Const -> do_escape st Escape_constant v
             | Pv v, `Shallow_const -> (
                 match st.defs.(Var.idx v) with
-                | Expr (Block (_, a, _)) ->
+                | Expr (Block (_, a, _, _)) ->
                     Array.iter a ~f:(fun x -> do_escape st Escape x)
                 | _ -> do_escape st Escape v)
             | Pv v, `Object_literal -> (
                 match st.defs.(Var.idx v) with
-                | Expr (Block (_, a, _)) ->
+                | Expr (Block (_, a, _, _)) ->
                     Array.iter a ~f:(fun x ->
                         match st.defs.(Var.idx x) with
-                        | Expr (Block (_, [| _k; v |], _)) -> do_escape st Escape v
+                        | Expr (Block (_, [| _k; v |], _, _)) -> do_escape st Escape v
                         | _ -> do_escape st Escape x)
                 | _ -> do_escape st Escape v)
             | Pv v, `Mutable -> do_escape st Escape v);
@@ -323,7 +323,7 @@ module Domain = struct
     then (
       st.may_escape.(idx) <- s;
       match st.defs.(idx) with
-      | Expr (Block (_, a, _)) ->
+      | Expr (Block (_, a, _, _)) ->
           Array.iter ~f:(fun y -> variable_escape ~update ~st ~approx s y) a;
           if Poly.equal s Escape
           then (
@@ -407,7 +407,7 @@ let propagate st ~update approx x =
                 ~approx
                 (fun z ->
                   match st.defs.(Var.idx z) with
-                  | Expr (Block (t, a, _))
+                  | Expr (Block (t, a, _, _))
                     when n < Array.length a
                          &&
                          match tags with
@@ -441,7 +441,7 @@ let propagate st ~update approx x =
                   ~others
                   (fun z ->
                     match st.defs.(Var.idx z) with
-                    | Expr (Block (_, lst, _)) ->
+                    | Expr (Block (_, lst, _, _)) ->
                         Array.iter ~f:(fun t -> add_dep st x t) lst;
                         let a =
                           Array.fold_left
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index e23bcf9d6a..9913505cae 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -169,8 +169,8 @@ let simple blocks cont mapping =
           | Prim (prim, args) ->
               `Exp (Prim (prim, List.map args ~f:(map_prim_arg mapping)))
           | Special _ -> `Exp exp
-          | Block (tag, args, aon) ->
-              `Exp (Block (tag, Array.map args ~f:(map_var mapping), aon))
+          | Block (tag, args, aon, mut) ->
+              `Exp (Block (tag, Array.map args ~f:(map_var mapping), aon, mut))
           | Field (x, i) -> `Exp (Field (map_var mapping x, i))
           | Closure _ -> `Fail
           | Constant _ -> `Fail
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 358303f99f..6095739819 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -1346,26 +1346,42 @@ and compile infos pc state instrs =
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
-        compile infos (pc + 1) state ((Let (x, Block (0, [||], Unknown)), loc) :: instrs)
+        compile
+          infos
+          (pc + 1)
+          state
+          ((Let (x, Block (0, [||], Unknown, Maybe_mutable)), loc) :: instrs)
     | ATOM ->
         let i = getu code (pc + 1) in
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
-        compile infos (pc + 2) state ((Let (x, Block (i, [||], NotArray)), loc) :: instrs)
+        compile
+          infos
+          (pc + 2)
+          state
+          ((Let (x, Block (i, [||], Unknown, Maybe_mutable)), loc) :: instrs)
     | PUSHATOM0 ->
         let state = State.push state loc in
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
-        compile infos (pc + 1) state ((Let (x, Block (0, [||], Unknown)), loc) :: instrs)
+        compile
+          infos
+          (pc + 1)
+          state
+          ((Let (x, Block (0, [||], Unknown, Maybe_mutable)), loc) :: instrs)
     | PUSHATOM ->
         let state = State.push state loc in
 
         let i = getu code (pc + 1) in
         let x, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
-        compile infos (pc + 2) state ((Let (x, Block (i, [||], NotArray)), loc) :: instrs)
+        compile
+          infos
+          (pc + 2)
+          state
+          ((Let (x, Block (i, [||], Unknown, Maybe_mutable)), loc) :: instrs)
     | MAKEBLOCK ->
         let size = getu code (pc + 1) in
         let tag = getu code (pc + 2) in
@@ -1384,7 +1400,12 @@ and compile infos pc state instrs =
           infos
           (pc + 3)
           state
-          ((Let (x, Block (tag, Array.of_list (List.map ~f:fst contents), Unknown)), loc)
+          (( Let
+               ( x
+               , Block
+                   (tag, Array.of_list (List.map ~f:fst contents), Unknown, Maybe_mutable)
+               )
+           , loc )
           :: instrs)
     | MAKEBLOCK1 ->
         let tag = getu code (pc + 1) in
@@ -1396,7 +1417,7 @@ and compile infos pc state instrs =
           infos
           (pc + 2)
           state
-          ((Let (x, Block (tag, [| y |], NotArray)), loc) :: instrs)
+          ((Let (x, Block (tag, [| y |], Unknown, Maybe_mutable)), loc) :: instrs)
     | MAKEBLOCK2 ->
         let tag = getu code (pc + 1) in
         let y, _ = State.accu state in
@@ -1410,7 +1431,7 @@ and compile infos pc state instrs =
           infos
           (pc + 2)
           (State.pop 1 state)
-          ((Let (x, Block (tag, [| y; z |], NotArray)), loc) :: instrs)
+          ((Let (x, Block (tag, [| y; z |], Unknown, Maybe_mutable)), loc) :: instrs)
     | MAKEBLOCK3 ->
         let tag = getu code (pc + 1) in
         let y, _ = State.accu state in
@@ -1434,7 +1455,7 @@ and compile infos pc state instrs =
           infos
           (pc + 2)
           (State.pop 2 state)
-          ((Let (x, Block (tag, [| y; z; t |], NotArray)), loc) :: instrs)
+          ((Let (x, Block (tag, [| y; z; t |], Unknown, Maybe_mutable)), loc) :: instrs)
     | MAKEFLOATBLOCK ->
         let size = getu code (pc + 1) in
         let state = State.push state loc in
@@ -1452,7 +1473,12 @@ and compile infos pc state instrs =
           infos
           (pc + 2)
           state
-          ((Let (x, Block (254, Array.of_list (List.map ~f:fst contents), Unknown)), loc)
+          (( Let
+               ( x
+               , Block
+                   (254, Array.of_list (List.map ~f:fst contents), Unknown, Maybe_mutable)
+               )
+           , loc )
           :: instrs)
     | GETFIELD0 ->
         let y, _ = State.accu state in
@@ -2470,7 +2496,7 @@ let override_global =
             let init_mod = Var.fresh_n "init_mod" in
             let update_mod = Var.fresh_n "update_mod" in
             ( x
-            , (Let (x, Block (0, [| init_mod; update_mod |], NotArray)), noloc)
+            , (Let (x, Block (0, [| init_mod; update_mod |], NotArray, Immutable)), noloc)
               :: ( Let (init_mod, Special (Alias_prim "caml_CamlinternalMod_init_mod"))
                  , noloc )
               :: ( Let (update_mod, Special (Alias_prim "caml_CamlinternalMod_update_mod"))
@@ -3050,7 +3076,7 @@ let predefined_exceptions ~target =
                          Regular
                        , Int32.of_int (-index - 1) )) )
             , noloc )
-          ; Let (exn, Block (248, [| v_name; v_index |], NotArray)), noloc
+          ; Let (exn, Block (248, [| v_name; v_index |], NotArray, Immutable)), noloc
           ; ( Let
                 ( Var.fresh ()
                 , Prim
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 65d7b39606..965c37fe32 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -52,7 +52,7 @@ let expr_deps blocks vars deps defs x e =
   match e with
   | Constant _ | Apply _ | Prim _ | Special _ -> ()
   | Closure (_, cont) -> cont_deps blocks vars deps defs cont
-  | Block (_, a, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
+  | Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
   | Field (y, _) -> add_dep deps x y
 
 let program_deps { blocks; _ } =
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 808c6d62a4..d3a376beeb 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -55,13 +55,13 @@ let specialize_instr ~target info i =
       | None -> i)
   | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), _ -> (
       match the_def_of info a with
-      | Some (Block (_, a, _)) ->
+      | Some (Block (_, a, _, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_call", f :: o :: Array.to_list a))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])), _ -> (
       match the_def_of info a with
-      | Some (Block (_, a, _)) ->
+      | Some (Block (_, a, _, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a))
       | _ -> i)
@@ -69,7 +69,7 @@ let specialize_instr ~target info i =
       match the_string_of info m with
       | Some m when Javascript.is_ident m -> (
           match the_def_of info a with
-          | Some (Block (_, a, _)) ->
+          | Some (Block (_, a, _, _)) ->
               let a = Array.map a ~f:(fun x -> Pv x) in
               Let
                 ( x
@@ -82,7 +82,7 @@ let specialize_instr ~target info i =
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_new", [ c; a ])), _ -> (
       match the_def_of info a with
-      | Some (Block (_, a, _)) ->
+      | Some (Block (_, a, _, _)) ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_new", c :: Array.to_list a))
       | _ -> i)
@@ -90,13 +90,13 @@ let specialize_instr ~target info i =
       try
         let a =
           match the_def_of info a with
-          | Some (Block (_, a, _)) -> a
+          | Some (Block (_, a, _, _)) -> a
           | _ -> raise Exit
         in
         let a =
           Array.map a ~f:(fun x ->
               match the_def_of info (Pv x) with
-              | Some (Block (_, [| k; v |], _)) ->
+              | Some (Block (_, [| k; v |], _, _)) ->
                   let k =
                     match the_string_of info (Pv k) with
                     | Some s when String.is_valid_utf_8 s ->
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index 5f438c941a..dc3404fa2a 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -28,7 +28,7 @@ let expr s e =
   | Constant _ -> e
   | Apply { f; args; exact } ->
       Apply { f = s f; args = List.map args ~f:(fun x -> s x); exact }
-  | Block (n, a, k) -> Block (n, Array.map a ~f:(fun x -> s x), k)
+  | Block (n, a, k, mut) -> Block (n, Array.map a ~f:(fun x -> s x), k, mut)
   | Field (x, n) -> Field (s x, n)
   | Closure (l, pc) -> Closure (l, subst_cont s pc)
   | Special _ -> e
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 282d6b91a8..3b8267add9 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -154,7 +154,7 @@ module Generate (Target : Wa_target_sig.S) = struct
         let* closure = load f in
         Stack.kill_variables stack_ctx;
         return (W.Call (apply, args @ [ closure ]))
-    | Block (tag, a, _) ->
+    | Block (tag, a, _, _) ->
         Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
     | Field (x, n) -> Memory.field (load x) n
     | Closure _ ->
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib/wasm/wa_globalize.ml
index e27c078bda..deaed96b3e 100644
--- a/compiler/lib/wasm/wa_globalize.ml
+++ b/compiler/lib/wasm/wa_globalize.ml
@@ -73,7 +73,7 @@ let traverse_expression x e st =
   match e with
   | Code.Apply { f; args; _ } ->
       st |> use f |> fun st -> List.fold_left ~f:(fun st x -> use x st) ~init:st args
-  | Block (_, a, _) -> Array.fold_right ~f:use a ~init:st
+  | Block (_, a, _, _) -> Array.fold_right ~f:use a ~init:st
   | Field (x, _) -> st |> use x
   | Closure _ ->
       List.fold_left
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
index 5b2d39cf7f..796cf36b44 100644
--- a/compiler/lib/wasm/wa_liveness.ml
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -107,7 +107,7 @@ let add_array ~ctx s a = Array.fold_left ~f:(fun s x -> add_var ~ctx s x) ~init:
 let expr_used ~context ~closures ~ctx x e s =
   match e with
   | Apply { f; args; _ } -> add_list ~ctx s (f :: args)
-  | Block (_, a, _) -> add_array ~ctx s a
+  | Block (_, a, _, _) -> add_array ~ctx s a
   | Prim (_, l) -> add_prim_args ~ctx s l
   | Closure _ -> add_list ~ctx s (function_free_variables ~context ~closures x)
   | Constant _ | Special _ -> s
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
index 3ccb0a5c0c..9c7c3e661d 100644
--- a/compiler/lib/wasm/wa_spilling.ml
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -291,7 +291,7 @@ let spilled_variables
                         ~f:(fun reloaded x -> check_spilled ~ctx loaded x reloaded)
                         (f :: args)
                         ~init:Var.Set.empty
-                  | Block (_, l, _) ->
+                  | Block (_, l, _, _) ->
                       Array.fold_left
                         ~f:(fun reloaded x -> check_spilled ~ctx loaded' x reloaded)
                         l

From e2c98ec840673ee0f716fdf912c72638c54481f4 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 27 Jul 2023 18:07:37 +0200
Subject: [PATCH 298/481] Compiler: lower level switch

---
 compiler/lib/code.ml                       |  23 +-
 compiler/lib/code.mli                      |   2 +-
 compiler/lib/deadcode.ml                   |  16 +-
 compiler/lib/effects.ml                    |   9 +-
 compiler/lib/eval.ml                       |  94 ++++---
 compiler/lib/flow.ml                       |   5 +-
 compiler/lib/freevars.ml                   |   5 +-
 compiler/lib/generate.ml                   |  61 +----
 compiler/lib/global_flow.ml                |  43 +--
 compiler/lib/inline.ml                     |   5 +-
 compiler/lib/parse_bytecode.ml             |  71 +++--
 compiler/lib/phisimpl.ml                   |   5 +-
 compiler/lib/subst.ml                      |   6 +-
 compiler/lib/tailcall.ml                   |   3 +-
 compiler/lib/wasm/wa_core_target.ml        |   4 +-
 compiler/lib/wasm/wa_gc_target.ml          |   2 +-
 compiler/lib/wasm/wa_generate.ml           |  20 +-
 compiler/lib/wasm/wa_liveness.ml           |   8 +-
 compiler/lib/wasm/wa_spilling.ml           |   8 +-
 compiler/tests-compiler/static_eval.ml     |  44 +++
 compiler/tests-full/stdlib.cma.expected.js | 294 +++++++++++----------
 21 files changed, 371 insertions(+), 357 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 3fda9f32ad..c4b47bd196 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -368,7 +368,7 @@ type last =
   | Stop
   | Branch of cont
   | Cond of Var.t * cont * cont
-  | Switch of Var.t * cont array * cont array
+  | Switch of Var.t * cont array
   | Pushtrap of cont * Var.t * cont
   | Poptrap of cont
 
@@ -533,10 +533,9 @@ module Print = struct
     | Branch c -> Format.fprintf f "branch %a" cont c
     | Cond (x, cont1, cont2) ->
         Format.fprintf f "if %a then %a else %a" Var.print x cont cont1 cont cont2
-    | Switch (x, a1, a2) ->
+    | Switch (x, a1) ->
         Format.fprintf f "switch %a {" Var.print x;
         Array.iteri a1 ~f:(fun i c -> Format.fprintf f "int %d -> %a; " i cont c);
-        Array.iteri a2 ~f:(fun i c -> Format.fprintf f "tag %d -> %a; " i cont c);
         Format.fprintf f "}"
     | Pushtrap (cont1, x, cont2) ->
         Format.fprintf f "pushtrap %a handler %a => %a" cont cont1 Var.print x cont cont2
@@ -632,19 +631,13 @@ let poptraps blocks pc =
           let acc, visited = loop blocks pc1 visited depth acc in
           let acc, visited = loop blocks pc2 visited depth acc in
           acc, visited
-      | Switch (_, a1, a2) ->
+      | Switch (_, a1) ->
           let acc, visited =
             Array.fold_right
               ~init:(acc, visited)
               ~f:(fun (pc, _) (acc, visited) -> loop blocks pc visited depth acc)
               a1
           in
-          let acc, visited =
-            Array.fold_right
-              ~init:(acc, visited)
-              ~f:(fun (pc, _) (acc, visited) -> loop blocks pc visited depth acc)
-              a2
-          in
           acc, visited
   in
   loop blocks pc Addr.Set.empty 0 Addr.Set.empty |> fst
@@ -662,9 +655,8 @@ let fold_children blocks pc f accu =
       let accu = f pc1 accu in
       let accu = f pc2 accu in
       accu
-  | Switch (_, a1, a2) ->
+  | Switch (_, a1) ->
       let accu = Array.fold_right ~init:accu ~f:(fun (pc, _) accu -> f pc accu) a1 in
-      let accu = Array.fold_right ~init:accu ~f:(fun (pc, _) accu -> f pc accu) a2 in
       accu
 
 let fold_children_skip_try_body blocks pc f accu =
@@ -680,9 +672,8 @@ let fold_children_skip_try_body blocks pc f accu =
       let accu = f pc1 accu in
       let accu = f pc2 accu in
       accu
-  | Switch (_, a1, a2) ->
+  | Switch (_, a1) ->
       let accu = Array.fold_right ~init:accu ~f:(fun (pc, _) accu -> f pc accu) a1 in
-      let accu = Array.fold_right ~init:accu ~f:(fun (pc, _) accu -> f pc accu) a2 in
       accu
 
 type 'c fold_blocs = block Addr.Map.t -> Addr.t -> (Addr.t -> 'c -> 'c) -> 'c -> 'c
@@ -828,9 +819,7 @@ let invariant { blocks; start; _ } =
       | Cond (_x, cont1, cont2) ->
           check_cont cont1;
           check_cont cont2
-      | Switch (_x, a1, a2) ->
-          Array.iteri a1 ~f:(fun _ cont -> check_cont cont);
-          Array.iteri a2 ~f:(fun _ cont -> check_cont cont)
+      | Switch (_x, a1) -> Array.iteri a1 ~f:(fun _ cont -> check_cont cont)
       | Pushtrap (cont1, _x, cont2) ->
           check_cont cont1;
           check_cont cont2
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 67bd0d4ded..8a22b98bf4 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -215,7 +215,7 @@ type last =
   | Stop
   | Branch of cont
   | Cond of Var.t * cont * cont
-  | Switch of Var.t * cont array * cont array
+  | Switch of Var.t * cont array
   | Pushtrap of cont * Var.t * cont
   | Poptrap of cont
 
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index 0dd6622130..ae182423f7 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -98,10 +98,9 @@ and mark_reachable st pc =
         mark_var st x;
         mark_cont_reachable st cont1;
         mark_cont_reachable st cont2
-    | Switch (x, a1, a2) ->
+    | Switch (x, a1) ->
         mark_var st x;
-        Array.iter a1 ~f:(fun cont -> mark_cont_reachable st cont);
-        Array.iter a2 ~f:(fun cont -> mark_cont_reachable st cont)
+        Array.iter a1 ~f:(fun cont -> mark_cont_reachable st cont)
     | Pushtrap (cont1, _, cont2) ->
         mark_cont_reachable st cont1;
         mark_cont_reachable st cont2)
@@ -137,11 +136,8 @@ let filter_live_last blocks st (l, loc) =
     | Branch cont -> Branch (filter_cont blocks st cont)
     | Cond (x, cont1, cont2) ->
         Cond (x, filter_cont blocks st cont1, filter_cont blocks st cont2)
-    | Switch (x, a1, a2) ->
-        Switch
-          ( x
-          , Array.map a1 ~f:(fun cont -> filter_cont blocks st cont)
-          , Array.map a2 ~f:(fun cont -> filter_cont blocks st cont) )
+    | Switch (x, a1) ->
+        Switch (x, Array.map a1 ~f:(fun cont -> filter_cont blocks st cont))
     | Pushtrap (cont1, x, cont2) ->
         Pushtrap (filter_cont blocks st cont1, x, filter_cont blocks st cont2)
     | Poptrap cont -> Poptrap (filter_cont blocks st cont)
@@ -201,9 +197,7 @@ let f ({ blocks; _ } as p : Code.program) =
       | Cond (_, cont1, cont2) ->
           add_cont_dep blocks defs cont1;
           add_cont_dep blocks defs cont2
-      | Switch (_, a1, a2) ->
-          Array.iter a1 ~f:(fun cont -> add_cont_dep blocks defs cont);
-          Array.iter a2 ~f:(fun cont -> add_cont_dep blocks defs cont)
+      | Switch (_, a1) -> Array.iter a1 ~f:(fun cont -> add_cont_dep blocks defs cont)
       | Pushtrap (cont, _, cont_h) ->
           add_cont_dep blocks defs cont_h;
           add_cont_dep blocks defs cont
diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml
index 6803085d81..26054b1f08 100644
--- a/compiler/lib/effects.ml
+++ b/compiler/lib/effects.ml
@@ -431,13 +431,11 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
             , cps_jump_cont ~st ~src:pc cont1 last_loc
             , cps_jump_cont ~st ~src:pc cont2 last_loc )
         , last_loc ) )
-  | Switch (x, c1, c2) ->
+  | Switch (x, c1) ->
       (* To avoid code duplication during JavaScript generation, we need
          to create a single block per continuation *)
       let cps_jump_cont = Fun.memoize (fun x -> cps_jump_cont ~st ~src:pc x last_loc) in
-      ( alloc_jump_closures
-      , ( Switch (x, Array.map c1 ~f:cps_jump_cont, Array.map c2 ~f:cps_jump_cont)
-        , last_loc ) )
+      alloc_jump_closures, (Switch (x, Array.map c1 ~f:cps_jump_cont), last_loc)
   | Pushtrap (body_cont, exn, ((handler_pc, _) as handler_cont)) -> (
       assert (Hashtbl.mem st.is_continuation handler_pc);
       match Addr.Set.mem handler_pc st.blocks_to_transform with
@@ -929,8 +927,7 @@ let remove_empty_blocks ~live_vars (p : Code.program) : Code.program =
                match branch with
                | Branch cont -> Branch (resolve cont)
                | Cond (x, cont1, cont2) -> Cond (x, resolve cont1, resolve cont2)
-               | Switch (x, a1, a2) ->
-                   Switch (x, Array.map ~f:resolve a1, Array.map ~f:resolve a2)
+               | Switch (x, a1) -> Switch (x, Array.map ~f:resolve a1)
                | Pushtrap (cont1, x, cont2) -> Pushtrap (resolve cont1, x, resolve cont2)
                | Poptrap cont -> Poptrap (resolve cont)
                | Return _ | Raise _ | Stop -> branch
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index bb637bdfbc..5a2f5fb939 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -216,6 +216,46 @@ let is_int ~target info x =
       | `Wasm -> N)
   | Pc _ -> N
 
+let the_tag_of info x get =
+  match x with
+  | Pv x ->
+      get_approx
+        info
+        (fun x ->
+          match info.info_defs.(Var.idx x) with
+          | Expr (Block (j, _, _, _)) ->
+              if Var.ISet.mem info.info_possibly_mutable x then None else get j
+          | Expr (Constant (Tuple (j, _, _))) -> get j
+          | _ -> None)
+        None
+        (fun u v ->
+          match u, v with
+          | Some i, Some j when Poly.(i = j) -> u
+          | _ -> None)
+        x
+  | Pc (Tuple (j, _, _)) -> get j
+  | _ -> None
+
+let the_cont_of info x (a : cont array) =
+  (* The value of [x] might be meaningless when we're inside a dead code.
+     The proper fix would be to remove the deadcode entirely.
+     Meanwhile, add guards to prevent Invalid_argument("index out of bounds")
+     see https://github.com/ocsigen/js_of_ocaml/issues/485 *)
+  let get i = if i >= 0 && i < Array.length a then Some a.(i) else None in
+  get_approx
+    info
+    (fun x ->
+      match info.info_defs.(Var.idx x) with
+      | Expr (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get
+      | Expr (Constant (Int (_, j))) -> get (Int32.to_int j)
+      | _ -> None)
+    None
+    (fun u v ->
+      match u, v with
+      | Some i, Some j when Poly.(i = j) -> u
+      | _ -> None)
+    x
+
 let eval_instr ~target info ((x, loc) as i) =
   match x with
   | Let (x, Prim (Extern ("caml_js_equals" | "caml_equal"), [ y; z ])) -> (
@@ -265,6 +305,13 @@ let eval_instr ~target info ((x, loc) as i) =
           let c = Constant (Int (Regular, b)) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
+  | Let (x, Prim (Extern "%direct_obj_tag", [ y ])) -> (
+      match the_tag_of info y (fun x -> Some x) with
+      | Some tag ->
+          let c = Constant (Int (Regular, Int32.of_int tag)) in
+          Flow.update_def info x c;
+          [ Let (x, c), loc ]
+      | None -> [ i ])
   | Let (x, Prim (Extern "caml_sys_const_backend_type", [ _ ])) ->
       let jsoo = Code.Var.fresh () in
       [ ( Let
@@ -318,34 +365,6 @@ let eval_instr ~target info ((x, loc) as i) =
           ])
   | _ -> [ i ]
 
-type case_of =
-  | CConst of int
-  | CTag of int
-  | Unknown
-
-let the_case_of info x =
-  match x with
-  | Pv x ->
-      get_approx
-        info
-        (fun x ->
-          match info.info_defs.(Var.idx x) with
-          | Expr (Constant (Int (_, i))) -> CConst (Int32.to_int i)
-          | Expr (Block (j, _, _, _)) ->
-              if Var.ISet.mem info.info_possibly_mutable x then Unknown else CTag j
-          | Expr (Constant (Tuple (j, _, _))) -> CTag j
-          | _ -> Unknown)
-        Unknown
-        (fun u v ->
-          match u, v with
-          | CTag i, CTag j when i = j -> u
-          | CConst i, CConst j when i = j -> u
-          | _ -> Unknown)
-        x
-  | Pc (Int (_, i)) -> CConst (Int32.to_int i)
-  | Pc (Tuple (j, _, _)) -> CTag j
-  | _ -> Unknown
-
 type cond_of =
   | Zero
   | Non_zero
@@ -388,15 +407,10 @@ let eval_branch info (l, loc) =
           | Zero -> Branch ffalse
           | Non_zero -> Branch ftrue
           | Unknown -> b)
-    | Switch (x, const, tags) as b -> (
-        (* [the_case_of info (Pv x)] might be meaningless when we're inside a dead code.
-           The proper fix would be to remove the deadcode entirely.
-           Meanwhile, add guards to prevent Invalid_argument("index out of bounds")
-           see https://github.com/ocsigen/js_of_ocaml/issues/485 *)
-        match the_case_of info (Pv x) with
-        | CConst j when j >= 0 && j < Array.length const -> Branch const.(j)
-        | CTag j when j >= 0 && j < Array.length tags -> Branch tags.(j)
-        | CConst _ | CTag _ | Unknown -> b)
+    | Switch (x, a) as b -> (
+        match the_cont_of info x a with
+        | Some cont -> Branch cont
+        | None -> b)
     | _ as b -> b
   in
   l, loc
@@ -428,15 +442,11 @@ let rec do_not_raise pc visited blocks =
         let visited = do_not_raise pc1 visited blocks in
         let visited = do_not_raise pc2 visited blocks in
         visited
-    | Switch (_, a1, a2) ->
+    | Switch (_, a1) ->
         let visited =
           Array.fold_left a1 ~init:visited ~f:(fun visited (pc, _) ->
               do_not_raise pc visited blocks)
         in
-        let visited =
-          Array.fold_left a2 ~init:visited ~f:(fun visited (pc, _) ->
-              do_not_raise pc visited blocks)
-        in
         visited
     | Pushtrap _ -> raise May_raise
 
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index b23fc060ba..ebf5773f59 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -119,9 +119,8 @@ let program_deps { blocks; _ } =
       | Cond (_, cont1, cont2) ->
           cont_deps blocks vars deps defs cont1;
           cont_deps blocks vars deps defs cont2
-      | Switch (_, a1, a2) ->
-          Array.iter a1 ~f:(fun cont -> cont_deps blocks vars deps defs cont);
-          Array.iter a2 ~f:(fun cont -> cont_deps blocks vars deps defs cont)
+      | Switch (_, a1) ->
+          Array.iter a1 ~f:(fun cont -> cont_deps blocks vars deps defs cont)
       | Pushtrap (cont, x, cont_h) ->
           add_param_def vars defs x;
           cont_deps blocks vars deps defs cont_h;
diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml
index ef964ee230..fdeaa83216 100644
--- a/compiler/lib/freevars.ml
+++ b/compiler/lib/freevars.ml
@@ -65,10 +65,9 @@ let iter_last_free_var f l =
       f x;
       iter_cont_free_vars f cont1;
       iter_cont_free_vars f cont2
-  | Switch (x, a1, a2) ->
+  | Switch (x, a1) ->
       f x;
-      Array.iter a1 ~f:(fun c -> iter_cont_free_vars f c);
-      Array.iter a2 ~f:(fun c -> iter_cont_free_vars f c)
+      Array.iter a1 ~f:(fun c -> iter_cont_free_vars f c)
   | Pushtrap (cont1, _, cont2) ->
       iter_cont_free_vars f cont1;
       iter_cont_free_vars f cont2
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 1426ace705..08de2518f1 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -763,10 +763,9 @@ let fold_children blocks pc f accu =
       let accu = f pc2 accu in
       accu
   | Cond (_, cont1, cont2) -> DTree.fold_cont f (DTree.build_if cont1 cont2) accu
-  | Switch (_, a1, a2) ->
-      let a1 = DTree.build_switch a1 and a2 = DTree.build_switch a2 in
+  | Switch (_, a1) ->
+      let a1 = DTree.build_switch a1 in
       let accu = DTree.fold_cont f a1 accu in
-      let accu = DTree.fold_cont f a2 accu in
       accu
 
 let build_graph ctx pc =
@@ -1102,6 +1101,7 @@ let _ =
   register_un_prim_ctx "%caml_format_int_special" `Pure (fun ctx cx loc ->
       let s = J.EBin (J.Plus, str_js_utf8 "", cx) in
       ocaml_string ~ctx ~loc s);
+  register_un_prim "%direct_obj_tag" `Mutator (fun cx _loc -> Mlvalue.Block.tag cx);
   register_bin_prim "caml_array_unsafe_get" `Mutable (fun cx cy _ ->
       Mlvalue.Array.field cx cy);
   register_bin_prim "%int_add" `Pure (fun cx cy _ -> to_int (plus_int cx cy));
@@ -1769,7 +1769,7 @@ and colapse_frontier name st (new_frontier' : Addr.Set.t) interm =
     let branch =
       let cases = Array.of_list (List.map a ~f:(fun pc -> pc, [])) in
       if Array.length cases > 2
-      then Code.Switch (x, cases, [||]), Code.noloc
+      then Code.Switch (x, cases), Code.noloc
       else Code.Cond (x, cases.(1), cases.(0)), Code.noloc
     in
     ( [ J.variable_declaration [ J.V x, (int default, J.N) ], J.N ]
@@ -1850,7 +1850,7 @@ and compile_conditional st queue last loop_stack backs frontier interm =
      | Raise _ -> Format.eprintf "raise;@;"
      | Stop -> Format.eprintf "stop;@;"
      | Cond (x, _, _) -> Format.eprintf "@[<hv 2>cond(%a){@;" Code.Var.print x
-     | Switch (x, _, _) -> Format.eprintf "@[<hv 2>switch(%a){@;" Code.Var.print x);
+     | Switch (x, _) -> Format.eprintf "@[<hv 2>switch(%a){@;" Code.Var.print x);
   let loc = source_location_ctx st.ctx pc in
   let res =
     match last with
@@ -1912,21 +1912,7 @@ and compile_conditional st queue last loop_stack backs frontier interm =
             (DTree.build_if c1 c2)
         in
         never, flush_all queue b
-    | Switch (x, [||], a2) ->
-        let (_px, cx), queue = access_queue queue x in
-        let never, code =
-          compile_decision_tree
-            st
-            loop_stack
-            backs
-            frontier
-            interm
-            loc
-            (Mlvalue.Block.tag cx)
-            (DTree.build_switch a2)
-        in
-        never, flush_all queue code
-    | Switch (x, a1, [||]) ->
+    | Switch (x, a1) ->
         let (_px, cx), queue = access_queue queue x in
         let never, code =
           compile_decision_tree
@@ -1940,41 +1926,6 @@ and compile_conditional st queue last loop_stack backs frontier interm =
             (DTree.build_switch a1)
         in
         never, flush_all queue code
-    | Switch (x, a1, a2) ->
-        (* The variable x is accessed several times, so we can directly
-           refer to it *)
-        let never1, b1 =
-          compile_decision_tree
-            st
-            loop_stack
-            backs
-            frontier
-            interm
-            loc
-            (var x)
-            (DTree.build_switch a1)
-        in
-        let never2, b2 =
-          compile_decision_tree
-            st
-            loop_stack
-            backs
-            frontier
-            interm
-            loc
-            (Mlvalue.Block.tag (var x))
-            (DTree.build_switch a2)
-        in
-        let code =
-          Js_simpl.if_statement
-            (Mlvalue.is_immediate (var x))
-            loc
-            (Js_simpl.block b1)
-            never1
-            (Js_simpl.block b2)
-            never2
-        in
-        never1 && never2, flush_all queue code
   in
   (if debug ()
    then
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index d6541cb419..26b4f45d32 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -252,27 +252,34 @@ let program_deps st { blocks; _ } =
       | Cond (x, cont1, cont2) ->
           cont_deps blocks st cont1;
           cont_deps blocks st ~ignore:x cont2
-      | Switch (x, a1, a2) ->
+      | Switch (x, a1) -> (
           Array.iter a1 ~f:(fun cont -> cont_deps blocks st cont);
-          Array.iter a2 ~f:(fun cont -> cont_deps blocks st cont);
-          let h = Hashtbl.create 16 in
-          Array.iteri
-            ~f:(fun i (pc, _) ->
-              Hashtbl.replace h pc (i :: (try Hashtbl.find h pc with Not_found -> [])))
-            a2;
           if not st.fast
           then
-            Hashtbl.iter
-              (fun pc tags ->
-                let block = Addr.Map.find pc blocks in
-                List.iter
-                  ~f:(fun (i, _) ->
-                    match i with
-                    | Let (y, Field (x', _)) when Var.equal x x' ->
-                        Hashtbl.add st.known_cases y tags
-                    | _ -> ())
-                  block.body)
-              h
+            (* looking up the def of x is fine here, because the tag
+               we're looking for is at addr [pc - 2] (see
+               parse_bytecode.ml) and [Addr.Map.iter] iterate in
+               increasing order *)
+            match st.defs.(Code.Var.idx x) with
+            | Expr (Prim (Extern "%direct_obj_tag", [ Pv b ])) ->
+                let h = Hashtbl.create 16 in
+                Array.iteri a1 ~f:(fun i (pc, _) ->
+                    Hashtbl.replace
+                      h
+                      pc
+                      (i :: (try Hashtbl.find h pc with Not_found -> [])));
+                Hashtbl.iter
+                  (fun pc tags ->
+                    let block = Addr.Map.find pc blocks in
+                    List.iter
+                      ~f:(fun (i, _) ->
+                        match i with
+                        | Let (y, Field (x', _)) when Var.equal b x' ->
+                            Hashtbl.add st.known_cases y tags
+                        | _ -> ())
+                      block.body)
+                  h
+            | Expr _ | Phi _ -> ())
       | Pushtrap (cont, x, cont_h) ->
           add_var st x;
           st.defs.(Var.idx x) <- Phi { known = Var.Set.empty; others = true };
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 9913505cae..40cebb0adc 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -38,7 +38,7 @@ let optimizable blocks pc _ =
             +
             match fst branch with
             | Cond _ -> 2
-            | Switch (_, a1, a2) -> Array.length a1 + Array.length a2
+            | Switch (_, a1) -> Array.length a1
             | _ -> 0)
       in
       let optimizable =
@@ -113,9 +113,8 @@ let fold_children blocks pc f accu =
       let accu = f pc1 accu in
       let accu = f pc2 accu in
       accu
-  | Switch (_, a1, a2) ->
+  | Switch (_, a1) ->
       let accu = Array.fold_right a1 ~init:accu ~f:(fun (pc, _) accu -> f pc accu) in
-      let accu = Array.fold_right a2 ~init:accu ~f:(fun (pc, _) accu -> f pc accu) in
       accu
 
 let rewrite_closure blocks cont_pc clos_pc =
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 6095739819..9ed5bf4849 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -870,12 +870,9 @@ let rec compile_block blocks debug_data ~target code pc state =
     | Cond (_, (pc1, _), (pc2, _)) ->
         compile_block blocks debug_data ~target code pc1 state';
         compile_block blocks debug_data ~target code pc2 state'
-    | Switch (_, l1, l2) ->
-        Array.iter l1 ~f:(fun (pc', _) ->
-            compile_block blocks debug_data ~target code pc' state');
-        Array.iter l2 ~f:(fun (pc', _) ->
-            compile_block blocks debug_data ~target code pc' state')
-    | Pushtrap _ | Raise _ | Return _ | Stop -> ())
+    | Switch (_, _) -> ()
+    | Pushtrap _ -> ()
+    | Raise _ | Return _ | Stop -> ())
 
 and compile infos pc state instrs =
   if debug_parser () then State.print state;
@@ -1694,20 +1691,62 @@ and compile infos pc state instrs =
         let x, _ = State.accu state in
         let args = State.stack_vars state in
         instrs, (Cond (x, (pc + 2, args), (pc + offset + 1, args)), loc), state
-    | SWITCH ->
+    | SWITCH -> (
         if debug_parser () then Format.printf "switch ...@.";
-
         let sz = getu code (pc + 1) in
         let x, _ = State.accu state in
         let args = State.stack_vars state in
-        let l = sz land 0xFFFF in
-        let it =
-          Array.init (sz land 0XFFFF) ~f:(fun i -> pc + 2 + gets code (pc + 2 + i), args)
-        in
-        let bt =
-          Array.init (sz lsr 16) ~f:(fun i -> pc + 2 + gets code (pc + 2 + l + i), args)
-        in
-        instrs, (Switch (x, it, bt), loc), state
+        let isize = sz land 0XFFFF in
+        let bsize = sz lsr 16 in
+        let base = pc + 2 in
+        let it = Array.init isize ~f:(fun i -> base + gets code (base + i)) in
+        let bt = Array.init bsize ~f:(fun i -> base + gets code (base + isize + i)) in
+        Array.iter it ~f:(fun pc' ->
+            compile_block infos.blocks infos.debug ~target:infos.target code pc' state);
+        Array.iter bt ~f:(fun pc' ->
+            compile_block infos.blocks infos.debug ~target:infos.target code pc' state);
+        match isize, bsize with
+        | _, 0 -> instrs, (Switch (x, Array.map it ~f:(fun pc -> pc, args)), loc), state
+        | 0, _ ->
+            let x_tag = Var.fresh () in
+            let instrs =
+              (Let (x_tag, Prim (Extern "%direct_obj_tag", [ Pv x ])), loc) :: instrs
+            in
+            instrs, (Switch (x_tag, Array.map bt ~f:(fun pc -> pc, args)), loc), state
+        | _, _ ->
+            let isint_branch = pc + 1 in
+            let isblock_branch = pc + 2 in
+            let () =
+              tagged_blocks := Addr.Set.add isint_branch !tagged_blocks;
+              let i_state = State.start_block isint_branch state in
+              let i_args = State.stack_vars i_state in
+              compiled_blocks :=
+                Addr.Map.add
+                  isint_branch
+                  (i_state, [], (Switch (x, Array.map it ~f:(fun pc -> pc, i_args)), loc))
+                  !compiled_blocks
+            in
+            let () =
+              tagged_blocks := Addr.Set.add isblock_branch !tagged_blocks;
+              let x_tag = Var.fresh () in
+              let b_state = State.start_block isblock_branch state in
+              let b_args = State.stack_vars b_state in
+              let instrs =
+                [ Let (x_tag, Prim (Extern "%direct_obj_tag", [ Pv x ])), loc ]
+              in
+              compiled_blocks :=
+                Addr.Map.add
+                  isblock_branch
+                  ( b_state
+                  , instrs
+                  , (Switch (x_tag, Array.map bt ~f:(fun pc -> pc, b_args)), loc) )
+                  !compiled_blocks
+            in
+            let isint_var = Var.fresh () in
+            let instrs = (Let (isint_var, Prim (IsInt, [ Pv x ])), loc) :: instrs in
+            ( instrs
+            , (Cond (isint_var, (isint_branch, args), (isblock_branch, args)), loc)
+            , state ))
     | BOOLNOT ->
         let y, _ = State.accu state in
         let x, state = State.fresh_var state loc in
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 965c37fe32..159c8570a5 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -77,9 +77,8 @@ let program_deps { blocks; _ } =
       | Cond (_, cont1, cont2) ->
           cont_deps blocks vars deps defs cont1;
           cont_deps blocks vars deps defs cont2
-      | Switch (_, a1, a2) ->
-          Array.iter a1 ~f:(fun cont -> cont_deps blocks vars deps defs cont);
-          Array.iter a2 ~f:(fun cont -> cont_deps blocks vars deps defs cont)
+      | Switch (_, a1) ->
+          Array.iter a1 ~f:(fun cont -> cont_deps blocks vars deps defs cont)
       | Pushtrap (cont, _, cont_h) ->
           cont_deps blocks vars deps defs cont_h;
           cont_deps blocks vars deps defs cont
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index dc3404fa2a..4e735576c3 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -59,11 +59,7 @@ let last s (l, loc) =
     | Return x -> Return (s x)
     | Raise (x, k) -> Raise (s x, k)
     | Cond (x, cont1, cont2) -> Cond (s x, subst_cont s cont1, subst_cont s cont2)
-    | Switch (x, a1, a2) ->
-        Switch
-          ( s x
-          , Array.map a1 ~f:(fun cont -> subst_cont s cont)
-          , Array.map a2 ~f:(fun cont -> subst_cont s cont) )
+    | Switch (x, a1) -> Switch (s x, Array.map a1 ~f:(fun cont -> subst_cont s cont))
     | Poptrap cont -> Poptrap (subst_cont s cont)
   in
   l, loc
diff --git a/compiler/lib/tailcall.ml b/compiler/lib/tailcall.ml
index 209625abed..84d31c3687 100644
--- a/compiler/lib/tailcall.ml
+++ b/compiler/lib/tailcall.ml
@@ -69,9 +69,8 @@ let fold_children blocks pc f accu =
       let accu = f pc1 accu in
       let accu = f pc2 accu in
       accu
-  | Switch (_, a1, a2) ->
+  | Switch (_, a1) ->
       let accu = Array.fold_right a1 ~init:accu ~f:(fun (pc, _) accu -> f pc accu) in
-      let accu = Array.fold_right a2 ~init:accu ~f:(fun (pc, _) accu -> f pc accu) in
       accu
 
 let rec traverse f pc visited blocks =
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 762a1d979d..ed4079d0eb 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -109,7 +109,9 @@ module Memory = struct
       Arith.(load p + const 4l)
   (*ZZZ Float array?*)
 
-  let tag e = Arith.(mem_load (e - const 4l) land const 0xffl)
+  let tag e =
+    let val_int i = Arith.((i lsl const 1l) + const 1l) in
+    val_int Arith.(mem_load (e - const 4l) land const 0xffl)
 
   let block_length e = Arith.(mem_load (e - const 4l) lsr const 10l)
 
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 67bb57cdac..d0b85b737b 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -688,7 +688,7 @@ module Memory = struct
       let* ty = Type.block_type in
       return (W.ArrayNewFixed (ty, RefI31 (Const (I32 (Int32.of_int tag))) :: l))
 
-  let tag e = Value.int_val (wasm_array_get e (Arith.const 0l))
+  let tag e = wasm_array_get e (Arith.const 0l)
 
   let array_length e =
     let* block = Type.block_type in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 3b8267add9..74197663c1 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -256,6 +256,7 @@ module Generate (Target : Wa_target_sig.S) = struct
             | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y
             | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y
             | Extern "%int_asr", [ x; y ] -> Value.int_asr x y
+            | Extern "%direct_obj_tag", [ x ] -> Memory.tag x
             | Extern "caml_check_bound", [ x; y ] ->
                 seq
                   (let* cond = Arith.uge (Value.int_val y) (Memory.array_length x) in
@@ -914,7 +915,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                 match fall_through with
                 | `Return -> instr (Push e)
                 | `Block _ -> instr (Return (Some e)))
-            | Switch (x, a1, a2) ->
+            | Switch (x, a1) ->
                 let l =
                   List.filter
                     ~f:(fun pc' ->
@@ -941,18 +942,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                       in
                       let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
                       instr (Br (label_index context pc', None))
-                  | [] -> (
-                      match a1, a2 with
-                      | [||], _ -> br_table (Memory.tag (load x)) a2 context
-                      | _, [||] -> br_table (Value.int_val (load x)) a1 context
-                      | _ ->
-                          (*ZZZ Use Br_on_cast *)
-                          let context' = extend_context fall_through context in
-                          if_
-                            { params = []; result = result_typ }
-                            (Value.check_is_int (load x))
-                            (br_table (Value.int_val (load x)) a1 context')
-                            (br_table (Memory.tag (load x)) a2 context'))
+                  | [] -> br_table (Value.int_val (load x)) a1 context
                 in
                 nest l context
             | Raise (x, _) ->
@@ -1211,9 +1201,7 @@ let fix_switch_branches p =
   Addr.Map.iter
     (fun _ block ->
       match fst block.branch with
-      | Switch (_, l, l') ->
-          fix_branches l;
-          fix_branches l'
+      | Switch (_, l) -> fix_branches l
       | _ -> ())
     p.blocks;
   !p'
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
index 796cf36b44..4a2dd90848 100644
--- a/compiler/lib/wasm/wa_liveness.ml
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -58,9 +58,7 @@ let block_deps deps block pc =
   | Cond (_, cont1, cont2) ->
       cont_deps deps pc cont1;
       cont_deps deps pc cont2
-  | Switch (_, a1, a2) ->
-      Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont);
-      Array.iter a2 ~f:(fun cont -> cont_deps deps pc cont)
+  | Switch (_, a1) -> Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont)
   | Pushtrap (cont, _, cont_h) ->
       cont_deps deps pc cont;
       cont_deps deps pc cont_h
@@ -128,9 +126,7 @@ let propagate_through_branch ~ctx (b, _) s =
   | Stop -> s
   | Branch cont | Poptrap cont -> cont_used ~ctx cont s
   | Cond (_, cont1, cont2) -> s |> cont_used ~ctx cont1 |> cont_used ~ctx cont2
-  | Switch (_, a1, a2) ->
-      let s = Array.fold_right a1 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s in
-      Array.fold_right a2 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s
+  | Switch (_, a1) -> Array.fold_right a1 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s
   | Pushtrap (cont, x, cont_h) ->
       s |> cont_used ~ctx cont |> cont_used ~ctx cont_h |> Var.Set.remove x
 
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
index 9c7c3e661d..2d1051c7bd 100644
--- a/compiler/lib/wasm/wa_spilling.ml
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -143,9 +143,7 @@ let block_deps bound_vars deps block pc =
   | Cond (_, cont1, cont2) ->
       cont_deps deps pc cont1;
       cont_deps deps pc cont2
-  | Switch (_, a1, a2) ->
-      Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont);
-      Array.iter a2 ~f:(fun cont -> cont_deps deps pc cont)
+  | Switch (_, a1) -> Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont)
   | Pushtrap (cont, exn, cont_h) ->
       cont_deps deps pc cont;
       bound_vars := Var.Set.add exn !bound_vars;
@@ -339,9 +337,7 @@ let spilled_variables
       | Stop -> spilled
       | Branch cont | Poptrap cont -> handle_cont cont spilled
       | Cond (_, cont1, cont2) -> spilled |> handle_cont cont1 |> handle_cont cont2
-      | Switch (_, a1, a2) ->
-          let spilled = Array.fold_right a1 ~f:handle_cont ~init:spilled in
-          Array.fold_right a2 ~f:handle_cont ~init:spilled
+      | Switch (_, a1) -> Array.fold_right a1 ~f:handle_cont ~init:spilled
       | Pushtrap (cont, _, cont_h) -> spilled |> handle_cont cont |> handle_cont cont_h)
     domain
     spilled
diff --git a/compiler/tests-compiler/static_eval.ml b/compiler/tests-compiler/static_eval.ml
index d904da2cca..204d45b3ee 100644
--- a/compiler/tests-compiler/static_eval.ml
+++ b/compiler/tests-compiler/static_eval.ml
@@ -157,3 +157,47 @@ let%expect_test "static eval of string get" =
      }
     }
     //end |}]
+
+let%expect_test "static eval of tags" =
+  let program =
+    compile_and_parse
+      {|
+
+      type t = A | B | C of t | D of t | E of t
+
+      let foobar =
+        let x = if Random.int 3 > 1 then C (D A) else D (A) in
+        match x with
+        | A -> 1
+        | B -> 2
+        | C _
+        | D _ -> 3
+        | E _ -> 5
+
+      let export = [|foobar;foobar|]
+  |}
+  in
+  print_program program;
+  [%expect
+    {|
+    (function(globalThis){
+       "use strict";
+       var runtime = globalThis.jsoo_runtime;
+       function caml_call1(f, a0){
+        return (f.l >= 0 ? f.l : f.l = f.length) == 1
+                ? f(a0)
+                : runtime.caml_call_gen(f, [a0]);
+       }
+       var
+        global_data = runtime.caml_get_global_data(),
+        Stdlib_Random = global_data.Stdlib__Random,
+        _a_ = [0, [1, 0]],
+        _b_ = [1, 0],
+        x = 1 < caml_call1(Stdlib_Random[5], 3) ? _a_ : _b_;
+       x[0];
+       var export$0 = [0, 3, 3], Test = [0, 3, export$0];
+       runtime.caml_register_global(3, Test, "Test");
+       return;
+      }
+      (globalThis));
+    //end |}]
diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js
index c4be1fc1d2..befd4f3dba 100644
--- a/compiler/tests-full/stdlib.cma.expected.js
+++ b/compiler/tests-full/stdlib.cma.expected.js
@@ -14794,12 +14794,13 @@
                ([0, Assert_failure, _b_], 1);
      }
     }
-    else
+    else{
+     var switch$1 = 0;
      switch(ty1[0]){
        case 0:
-        var rest1 = ty1[1], switch$1 = 0;
+        var rest1 = ty1[1], switch$2 = 0;
         if(typeof ty2 === "number")
-         switch$1 = 1;
+         switch$2 = 1;
         else
          switch(ty2[0]){
            case 0:
@@ -14807,26 +14808,26 @@
              /*<<camlinternalFormat.ml:804:36>>*/ return [0,
                     trans(rest1, rest2)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$1 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$2 = 1;
          }
-        if(switch$1) switch$0 = 7;
         break;
        case 1:
-        var rest1$0 = ty1[1], switch$2 = 0;
+        var rest1$0 = ty1[1], switch$3 = 0;
         if(typeof ty2 === "number")
-         switch$2 = 1;
+         switch$3 = 1;
         else
          switch(ty2[0]){
            case 1:
@@ -14834,26 +14835,26 @@
              /*<<camlinternalFormat.ml:805:40>>*/ return [1,
                     trans(rest1$0, rest2$0)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$2 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$3 = 1;
          }
-        if(switch$2) switch$0 = 7;
         break;
        case 2:
-        var rest1$1 = ty1[1], switch$3 = 0;
+        var rest1$1 = ty1[1], switch$4 = 0;
         if(typeof ty2 === "number")
-         switch$3 = 1;
+         switch$4 = 1;
         else
          switch(ty2[0]){
            case 2:
@@ -14861,26 +14862,26 @@
              /*<<camlinternalFormat.ml:807:34>>*/ return [2,
                     trans(rest1$1, rest2$1)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$3 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$4 = 1;
          }
-        if(switch$3) switch$0 = 7;
         break;
        case 3:
-        var rest1$2 = ty1[1], switch$4 = 0;
+        var rest1$2 = ty1[1], switch$5 = 0;
         if(typeof ty2 === "number")
-         switch$4 = 1;
+         switch$5 = 1;
         else
          switch(ty2[0]){
            case 3:
@@ -14888,26 +14889,26 @@
              /*<<camlinternalFormat.ml:808:38>>*/ return [3,
                     trans(rest1$2, rest2$2)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$4 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$5 = 1;
          }
-        if(switch$4) switch$0 = 7;
         break;
        case 4:
-        var rest1$3 = ty1[1], switch$5 = 0;
+        var rest1$3 = ty1[1], switch$6 = 0;
         if(typeof ty2 === "number")
-         switch$5 = 1;
+         switch$6 = 1;
         else
          switch(ty2[0]){
            case 4:
@@ -14915,26 +14916,26 @@
              /*<<camlinternalFormat.ml:810:46>>*/ return [4,
                     trans(rest1$3, rest2$3)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$5 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$6 = 1;
          }
-        if(switch$5) switch$0 = 7;
         break;
        case 5:
-        var rest1$4 = ty1[1], switch$6 = 0;
+        var rest1$4 = ty1[1], switch$7 = 0;
         if(typeof ty2 === "number")
-         switch$6 = 1;
+         switch$7 = 1;
         else
          switch(ty2[0]){
            case 5:
@@ -14942,26 +14943,26 @@
              /*<<camlinternalFormat.ml:809:38>>*/ return [5,
                     trans(rest1$4, rest2$4)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$6 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$7 = 1;
          }
-        if(switch$6) switch$0 = 7;
         break;
        case 6:
-        var rest1$5 = ty1[1], switch$7 = 0;
+        var rest1$5 = ty1[1], switch$8 = 0;
         if(typeof ty2 === "number")
-         switch$7 = 1;
+         switch$8 = 1;
         else
          switch(ty2[0]){
            case 6:
@@ -14969,26 +14970,26 @@
              /*<<camlinternalFormat.ml:811:38>>*/ return [6,
                     trans(rest1$5, rest2$5)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$7 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$8 = 1;
          }
-        if(switch$7) switch$0 = 7;
         break;
        case 7:
-        var rest1$6 = ty1[1], switch$8 = 0;
+        var rest1$6 = ty1[1], switch$9 = 0;
         if(typeof ty2 === "number")
-         switch$8 = 1;
+         switch$9 = 1;
         else
          switch(ty2[0]){
            case 7:
@@ -14996,26 +14997,26 @@
              /*<<camlinternalFormat.ml:806:36>>*/ return [7,
                     trans(rest1$6, rest2$6)];
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
-            switch$0 = 6; break;
-           case 10: break;
+            switch$0 = 6; switch$1 = 1; break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$8 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$9 = 1;
          }
-        if(switch$8) switch$0 = 7;
         break;
        case 8:
-        var rest1$7 = ty1[2], ty1$0 = ty1[1], switch$9 = 0;
+        var rest1$7 = ty1[2], ty1$0 = ty1[1], switch$10 = 0;
         if(typeof ty2 === "number")
-         switch$9 = 1;
+         switch$10 = 1;
         else
          switch(ty2[0]){
            case 8:
@@ -15027,29 +15028,30 @@
              /*<<camlinternalFormat.ml:835:4>>*/ return [8,
                     trans(ty1$0, ty2$0),
                     _de_];
-           case 10: break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$9 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$10 = 1;
          }
-        if(switch$9)
+        if(switch$10)
           /*<<camlinternalFormat.ml:836:26>>*/ throw  /*<<camlinternalFormat.ml:836:26>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _k_], 1);
         break;
        case 9:
-        var rest1$8 = ty1[3], ty12 = ty1[2], ty11 = ty1[1], switch$10 = 0;
+        var rest1$8 = ty1[3], ty12 = ty1[2], ty11 = ty1[1], switch$11 = 0;
         if(typeof ty2 === "number")
-         switch$10 = 1;
+         switch$11 = 1;
         else
          switch(ty2[0]){
            case 8:
-            switch$0 = 5; break;
+            switch$0 = 5; switch$1 = 1; break;
            case 9:
              /*<<camlinternalFormat.ml:841:13>>*/ var
              rest2$8 = ty2[3],
@@ -15066,18 +15068,19 @@
                     ty11,
                     ty22,
                     trans(rest1$8, rest2$8)];
-           case 10: break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
-            switch$0 = 4; break;
-           default: switch$10 = 1;
+            switch$0 = 4; switch$1 = 1; break;
+           default: switch$11 = 1;
          }
-        if(switch$10)
+        if(switch$11)
           /*<<camlinternalFormat.ml:846:28>>*/ throw  /*<<camlinternalFormat.ml:846:28>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _l_], 1);
         break;
@@ -15091,85 +15094,93 @@
          /*<<camlinternalFormat.ml:814:21>>*/ throw  /*<<camlinternalFormat.ml:814:21>>*/ caml_maybe_attach_backtrace
                ([0, Assert_failure, _m_], 1);
        case 11:
-        var rest1$10 = ty1[1], switch$11 = 0;
+        var rest1$10 = ty1[1], switch$12 = 0;
         if(typeof ty2 === "number")
-         switch$11 = 1;
+         switch$12 = 1;
         else
          switch(ty2[0]){
-           case 10: break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
             var rest2$10 = ty2[1];
              /*<<camlinternalFormat.ml:817:38>>*/ return [11,
                     trans(rest1$10, rest2$10)];
-           default: switch$11 = 1;
+           default: switch$12 = 1;
          }
-        if(switch$11)
+        if(switch$12)
           /*<<camlinternalFormat.ml:818:21>>*/ throw  /*<<camlinternalFormat.ml:818:21>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _n_], 1);
         break;
        case 12:
-        var rest1$11 = ty1[1], switch$12 = 0;
+        var rest1$11 = ty1[1], switch$13 = 0;
         if(typeof ty2 === "number")
-         switch$12 = 1;
+         switch$13 = 1;
         else
          switch(ty2[0]){
-           case 10: break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
             var rest2$11 = ty2[1];
              /*<<camlinternalFormat.ml:821:34>>*/ return [12,
                     trans(rest1$11, rest2$11)];
-           default: switch$12 = 1;
+           default: switch$13 = 1;
          }
-        if(switch$12)
+        if(switch$13)
           /*<<camlinternalFormat.ml:822:19>>*/ throw  /*<<camlinternalFormat.ml:822:19>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _o_], 1);
         break;
        case 13:
-        var rest1$12 = ty1[1], switch$13 = 0;
+        var rest1$12 = ty1[1], switch$14 = 0;
         if(typeof ty2 === "number")
-         switch$13 = 1;
+         switch$14 = 1;
         else
          switch(ty2[0]){
-           case 10: break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
             var rest2$12 = ty2[1];
              /*<<camlinternalFormat.ml:825:40>>*/ return [13,
                     trans(rest1$12, rest2$12)];
-           default: switch$13 = 1;
+           default: switch$14 = 1;
          }
-        if(switch$13)
+        if(switch$14)
           /*<<camlinternalFormat.ml:826:22>>*/ throw  /*<<camlinternalFormat.ml:826:22>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _p_], 1);
         break;
        default:
-        var rest1$13 = ty1[1], switch$14 = 0;
+        var rest1$13 = ty1[1], switch$15 = 0;
         if(typeof ty2 === "number")
-         switch$14 = 1;
+         switch$15 = 1;
         else
          switch(ty2[0]){
-           case 10: break;
+           case 10:
+            switch$1 = 1; break;
            case 11:
-            switch$0 = 1; break;
+            switch$0 = 1; switch$1 = 1; break;
            case 12:
-            switch$0 = 2; break;
+            switch$0 = 2; switch$1 = 1; break;
            case 13:
-            switch$0 = 3; break;
+            switch$0 = 3; switch$1 = 1; break;
            case 14:
             var rest2$13 = ty2[1];
              /*<<camlinternalFormat.ml:830:4>>*/ return [14,
                     trans(rest1$13, rest2$13)];
-           default: switch$14 = 1;
+           default: switch$15 = 1;
          }
-        if(switch$14)
+        if(switch$15)
           /*<<camlinternalFormat.ml:831:30>>*/ throw  /*<<camlinternalFormat.ml:831:30>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _q_], 1);
      }
+     if(! switch$1)
+       /*<<camlinternalFormat.ml:851:23>>*/ throw  /*<<camlinternalFormat.ml:851:23>>*/ caml_maybe_attach_backtrace
+             ([0, Assert_failure, _j_], 1);
+    }
     switch(switch$0){
       case 0:
         /*<<camlinternalFormat.ml:815:21>>*/ throw  /*<<camlinternalFormat.ml:815:21>>*/ caml_maybe_attach_backtrace
@@ -15189,12 +15200,9 @@
       case 5:
         /*<<camlinternalFormat.ml:837:26>>*/ throw  /*<<camlinternalFormat.ml:837:26>>*/ caml_maybe_attach_backtrace
               ([0, Assert_failure, _c_], 1);
-      case 6:
+      default:
         /*<<camlinternalFormat.ml:847:28>>*/ throw  /*<<camlinternalFormat.ml:847:28>>*/ caml_maybe_attach_backtrace
               ([0, Assert_failure, _d_], 1);
-      default:
-        /*<<camlinternalFormat.ml:851:23>>*/ throw  /*<<camlinternalFormat.ml:851:23>>*/ caml_maybe_attach_backtrace
-              ([0, Assert_failure, _j_], 1);
     }
     /*<<camlinternalFormat.ml:851:35>>*/ }
    function fmtty_of_padding_fmtty(pad, fmtty){
@@ -26423,8 +26431,9 @@
     }
     /*<<format.ml:1344:75>>*/ }
    function output_acc(ppf, acc){
-     /*<<format.ml:1350:29>>*/ var switch$0 = 0;
-    if(typeof acc === "number")  /*<<format.ml:1376:32>>*/ return 0;
+     /*<<format.ml:1350:29>>*/ if(typeof acc === "number")
+      /*<<format.ml:1376:32>>*/ return 0;
+    var switch$0 = 0;
     switch(acc[0]){
       case 0:
        var f = acc[2], p = acc[1];
@@ -26536,8 +26545,9 @@
     }
     /*<<format.ml:1376:34>>*/ }
    function strput_acc(ppf, acc){
-     /*<<format.ml:1382:29>>*/ var switch$0 = 0;
-    if(typeof acc === "number")  /*<<format.ml:1411:32>>*/ return 0;
+     /*<<format.ml:1382:29>>*/ if(typeof acc === "number")
+      /*<<format.ml:1411:32>>*/ return 0;
+    var switch$0 = 0;
     switch(acc[0]){
       case 0:
        var f = acc[2], p = acc[1];

From 3146b3240624c912e3f1c11693a5e1b69315de55 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Sat, 11 Nov 2023 13:44:12 +0100
Subject: [PATCH 299/481] Compiler: fix free variable for classes (#1524)

* Compiler: fix free variable for classes
---
 compiler/lib/js_traverse.ml       | 22 +++++++++++++++++++++-
 compiler/tests-compiler/minify.ml | 12 ++++++------
 2 files changed, 27 insertions(+), 7 deletions(-)

diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index 41efb1a781..14d760fdf9 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -825,6 +825,15 @@ class free =
           tbody#record_block (Params params);
           m#merge_info tbody;
           EFun (ident, (k, params, body, nid))
+      | EClass (ident_o, cl_decl) ->
+          let ident_o =
+            Option.map
+              ~f:(fun id ->
+                m#def_var id;
+                m#ident id)
+              ident_o
+          in
+          EClass (ident_o, m#class_decl cl_decl)
       | _ -> super#expression x
 
     method record_block _ = ()
@@ -855,6 +864,9 @@ class free =
           m#def_var id;
           m#merge_info tbody;
           Function_declaration (id, (k, params, body, nid))
+      | Class_declaration (id, cl_decl) ->
+          m#def_var id;
+          Class_declaration (id, m#class_decl cl_decl)
       | Block b -> Block (m#block b)
       | Try_statement (b, w, f) ->
           let same_level = level in
@@ -928,7 +940,12 @@ class rename_variable =
 
        inherit iter as super
 
-       method expression _ = ()
+       method expression e =
+         match e with
+         | EClass (ido, _) ->
+             Option.iter ido ~f:decl_var;
+             super#expression e
+         | _ -> super#expression e
 
        method fun_decl _ = ()
 
@@ -938,6 +955,9 @@ class rename_variable =
              decl_var id;
              self#fun_decl fd
          | Lexical_block, Function_declaration (_, fd) -> self#fun_decl fd
+         | (Fun_block _ | Lexical_block), Class_declaration (id, _) ->
+             decl_var id;
+             super#statement x
          | (Fun_block _ | Lexical_block), _ -> super#statement x
 
        method variable_declaration k l =
diff --git a/compiler/tests-compiler/minify.ml b/compiler/tests-compiler/minify.ml
index 1fd6f4d9a3..357f7ea96a 100644
--- a/compiler/tests-compiler/minify.ml
+++ b/compiler/tests-compiler/minify.ml
@@ -304,8 +304,8 @@ let%expect_test _ =
       let js_prog =
         {|
 (function () {
-  class f {
-    f() {
+  class longname {
+    longname() {
       const y = 2;
       return v
     }
@@ -327,8 +327,8 @@ let%expect_test _ =
         $ cat "test.js"
           1:
           2: (function () {
-          3:   class f {
-          4:     f() {
+          3:   class longname {
+          4:     longname() {
           5:       const y = 2;
           6:       return v
           7:     }
@@ -338,9 +338,9 @@ let%expect_test _ =
          11:
         $ cat "test.min.js"
           1: (function(){class
-          2: f{f(){const
+          2: a{longname(){const
           3: a=2;return v}}const
-          4: a=y}()); |}])
+          4: b=y}()); |}])
 
 let%expect_test _ =
   with_temp_dir ~f:(fun () ->

From 0ef5c70e4e4f39339eae0b892fe4ac6ba0c703bb Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 3 Aug 2023 08:14:24 +0200
Subject: [PATCH 300/481] Compiler: minify labels

---
 compiler/lib/generate.ml    |  6 +----
 compiler/lib/javascript.ml  | 14 ++--------
 compiler/lib/javascript.mli | 10 +++----
 compiler/lib/js_assign.ml   | 52 +++++++++++++++++++++++++++++++++++--
 compiler/lib/js_output.ml   | 10 ++++---
 compiler/lib/js_traverse.ml | 26 +++++++++++++++++++
 6 files changed, 90 insertions(+), 28 deletions(-)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 08de2518f1..2037cd59c5 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1585,11 +1585,7 @@ and compile_block st queue (pc : Addr.t) loop_stack frontier interm =
     | true ->
         if debug () then Format.eprintf "@[<hv 2>for(;;) {@,";
         let never_body, body =
-          let lab =
-            match loop_stack with
-            | (_, (l, _)) :: _ -> J.Label.succ l
-            | [] -> J.Label.zero
-          in
+          let lab = J.Label.fresh () in
           let lab_used = ref false in
           let loop_stack = (pc, (lab, lab_used)) :: loop_stack in
           let never_body, body =
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index c1c58273dd..756fdefdc5 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -143,20 +143,10 @@ end
 
 module Label = struct
   type t =
-    | L of int
+    | L of Code.Var.t
     | S of Utf8_string.t
 
-  let printer = Var_printer.create Var_printer.Alphabet.javascript
-
-  let zero = L 0
-
-  let succ = function
-    | L t -> L (succ t)
-    | S _ -> assert false
-
-  let to_string = function
-    | L t -> Utf8_string.of_string_exn (Var_printer.to_string printer t)
-    | S s -> s
+  let fresh () = L (Code.Var.fresh ())
 
   let of_string s = S s
 end
diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli
index 3d6ffbaeb3..75cf608a77 100644
--- a/compiler/lib/javascript.mli
+++ b/compiler/lib/javascript.mli
@@ -51,13 +51,11 @@ module Num : sig
 end
 
 module Label : sig
-  type t
-
-  val zero : t
-
-  val succ : t -> t
+  type t =
+    | L of Code.Var.t
+    | S of Utf8_string.t
 
-  val to_string : t -> Utf8_string.t
+  val fresh : unit -> t
 
   val of_string : Utf8_string.t -> t
 end
diff --git a/compiler/lib/js_assign.ml b/compiler/lib/js_assign.ml
index ded0a92fb7..67974304f0 100644
--- a/compiler/lib/js_assign.ml
+++ b/compiler/lib/js_assign.ml
@@ -329,11 +329,48 @@ class traverse record_block =
       super#record_block b
   end
 
+class traverse_labels h =
+  object
+    inherit Js_traverse.iter as super
+
+    val ldepth = 0
+
+    method fun_decl (_k, _params, body, _loc) =
+      let m = {<ldepth = 0>} in
+      m#function_body body
+
+    method statement =
+      function
+      | Labelled_statement (L l, (s, _)) ->
+          let m = {<ldepth = ldepth + 1>} in
+          Hashtbl.add h l ldepth;
+          m#statement s
+      | s -> super#statement s
+  end
+
+class name ident label =
+  object (m)
+    inherit Js_traverse.subst ident as super
+
+    method statement =
+      function
+      | Labelled_statement (l, (s, loc)) ->
+          Labelled_statement (label l, (m#statement s, loc))
+      | Break_statement (Some l) -> Break_statement (Some (label l))
+      | Continue_statement (Some l) -> Continue_statement (Some (label l))
+      | s -> super#statement s
+  end
+
 let program' (module Strategy : Strategy) p =
   let nv = Var.count () in
   let state = Strategy.create nv in
+  let labels = Hashtbl.create 20 in
   let mapper = new traverse (Strategy.record_block state) in
   let p = mapper#program p in
+  let () =
+    let o = new traverse_labels labels in
+    o#program p
+  in
   mapper#record_block Normal;
   let free =
     IdentSet.filter
@@ -350,7 +387,7 @@ let program' (module Strategy : Strategy) p =
       | S _ -> ()
       | V x -> names.(Var.idx x) <- "")
     free;
-  let color = function
+  let ident = function
     | V v -> (
         let name = names.(Var.idx v) in
         match name, has_free_var with
@@ -359,7 +396,18 @@ let program' (module Strategy : Strategy) p =
         | _, (true | false) -> ident ~var:v (Utf8_string.of_string_exn name))
     | x -> x
   in
-  let p = (new Js_traverse.subst color)#program p in
+  let label_printer = Var_printer.create Var_printer.Alphabet.javascript in
+  let max_label_depth = Hashtbl.fold (fun _ d acc -> max d acc) labels 0 in
+  let lname_per_depth =
+    Array.init (max_label_depth + 1) ~f:(fun i -> Var_printer.to_string label_printer i)
+  in
+  let label = function
+    | Label.S _ as l -> l
+    | L v ->
+        let i = Hashtbl.find labels v in
+        S (Utf8_string.of_string_exn lname_per_depth.(i))
+  in
+  let p = (new name ident label)#program p in
   (if has_free_var
    then
      let () =
diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index 82ba0c5559..2db393ddc0 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -60,6 +60,10 @@ end) =
 struct
   open D
 
+  let nane_of_label = function
+    | Javascript.Label.L _ -> assert false
+    | Javascript.Label.S n -> n
+
   let debug_enabled = Config.Flag.debuginfo ()
 
   let output_debug_info f loc =
@@ -1260,7 +1264,7 @@ struct
         last_semi ()
     | Continue_statement (Some s) ->
         PP.string f "continue ";
-        let (Utf8 l) = Javascript.Label.to_string s in
+        let (Utf8 l) = nane_of_label s in
         PP.string f l;
         last_semi ()
     | Break_statement None ->
@@ -1268,7 +1272,7 @@ struct
         last_semi ()
     | Break_statement (Some s) ->
         PP.string f "break ";
-        let (Utf8 l) = Javascript.Label.to_string s in
+        let (Utf8 l) = nane_of_label s in
         PP.string f l;
         last_semi ()
     | Return_statement e -> (
@@ -1309,7 +1313,7 @@ struct
             (* There MUST be a space between the return and its
                argument. A line return will not work *))
     | Labelled_statement (i, s) ->
-        let (Utf8 l) = Javascript.Label.to_string i in
+        let (Utf8 l) = nane_of_label i in
         PP.string f l;
         PP.string f ":";
         PP.space f;
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index 14d760fdf9..f3d1964000 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -996,6 +996,8 @@ class rename_variable =
 
     val decl = StringSet.empty
 
+    val labels = StringMap.empty
+
     method private update_state scope params iter_body =
       let declared_names = declared scope params iter_body in
       {<subst = StringSet.fold
@@ -1031,6 +1033,30 @@ class rename_variable =
 
     method statement s =
       match s with
+      | Labelled_statement (l, (s, loc)) ->
+          let l, m =
+            match l with
+            | L _ -> l, m
+            | S (Utf8 u) ->
+                let l = Label.fresh () in
+                let m = {<labels = StringMap.add u l labels>} in
+                l, m
+          in
+          Labelled_statement (l, (m#statement s, loc))
+      | Break_statement (Some l) -> (
+          match l with
+          | L _ -> s
+          | S (Utf8 l) -> (
+              match StringMap.find_opt l labels with
+              | None -> s
+              | Some l -> Break_statement (Some l)))
+      | Continue_statement (Some l) -> (
+          match l with
+          | L _ -> s
+          | S (Utf8 l) -> (
+              match StringMap.find_opt l labels with
+              | None -> s
+              | Some l -> Continue_statement (Some l)))
       | Function_declaration (id, (k, params, body, nid)) ->
           let ids = bound_idents_of_params params in
           let m' = m#update_state (Fun_block None) ids body in

From 6beaabe7ffeb5a3892c1c1f650c44ae0efaccf43 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 13 Nov 2023 22:38:01 +0100
Subject: [PATCH 301/481] Compiler: fix es6 scopes

---
 compiler/bin-jsoo_minify/jsoo_minify.ml    |   2 +-
 compiler/lib/js_traverse.ml                | 158 +++++++++++++++++++--
 compiler/lib/js_traverse.mli               |  14 +-
 compiler/lib/stdlib.ml                     |   4 +
 compiler/tests-full/stdlib.cma.expected.js |  16 +--
 5 files changed, 169 insertions(+), 25 deletions(-)

diff --git a/compiler/bin-jsoo_minify/jsoo_minify.ml b/compiler/bin-jsoo_minify/jsoo_minify.ml
index 80fcc9f74d..22ffdb132c 100644
--- a/compiler/bin-jsoo_minify/jsoo_minify.ml
+++ b/compiler/bin-jsoo_minify/jsoo_minify.ml
@@ -81,7 +81,7 @@ let f { Cmd_arg.common; output_file; use_stdin; files } =
     let true_ () = true in
     let open Config in
     let passes : ((unit -> bool) * (unit -> Js_traverse.mapper)) list =
-      [ (Flag.shortvar, fun () -> new Js_traverse.rename_variable)
+      [ (Flag.shortvar, fun () -> (new Js_traverse.rename_variable :> Js_traverse.mapper))
       ; (true_, fun () -> new Js_traverse.simpl)
       ; (true_, fun () -> new Js_traverse.clean)
       ]
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index f3d1964000..6f9c79cdff 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -35,6 +35,8 @@ class type mapper = object
 
   method class_decl : Javascript.class_declaration -> Javascript.class_declaration
 
+  method class_element : Javascript.class_element -> Javascript.class_element
+
   method initialiser :
        Javascript.expression * Javascript.location
     -> Javascript.expression * Javascript.location
@@ -108,7 +110,7 @@ class map : mapper =
       ; body = List.map x.body ~f:m#class_element
       }
 
-    method private class_element x =
+    method class_element x =
       match x with
       | CEMethod (s, n, meth) -> CEMethod (s, m#class_element_name n, m#method_ meth)
       | CEField (s, n, i) -> CEField (s, m#class_element_name n, m#initialiser_o i)
@@ -305,6 +307,8 @@ class map : mapper =
 class type iterator = object
   method fun_decl : Javascript.function_declaration -> unit
 
+  method class_decl : Javascript.class_declaration -> unit
+
   method early_error : Javascript.early_error -> unit
 
   method expression : Javascript.expression -> unit
@@ -373,7 +377,7 @@ class iter : iterator =
       m#formal_parameter_list params;
       m#function_body body
 
-    method private class_decl x =
+    method class_decl x =
       Option.iter x.extends ~f:m#expression;
       List.iter x.body ~f:m#class_element
 
@@ -826,14 +830,19 @@ class free =
           m#merge_info tbody;
           EFun (ident, (k, params, body, nid))
       | EClass (ident_o, cl_decl) ->
+          let same_level = level in
+          let cbody = {<state_ = empty; level = same_level>} in
           let ident_o =
             Option.map
               ~f:(fun id ->
-                m#def_var id;
-                m#ident id)
+                cbody#def_var id;
+                id)
               ident_o
           in
-          EClass (ident_o, m#class_decl cl_decl)
+          let cl_decl = cbody#class_decl cl_decl in
+          cbody#record_block Normal;
+          m#merge_block_info cbody;
+          EClass (ident_o, cl_decl)
       | _ -> super#expression x
 
     method record_block _ = ()
@@ -853,6 +862,16 @@ class free =
       m#merge_block_info tbody;
       b
 
+    method class_element x =
+      match x with
+      | CEStaticBLock l ->
+          let tbody = {<state_ = empty; level = level + 1>} in
+          let l = tbody#statements l in
+          tbody#record_block Normal;
+          m#merge_info tbody;
+          CEStaticBLock l
+      | _ -> super#class_element x
+
     method statement x =
       match x with
       | Function_declaration (id, (k, params, body, nid)) ->
@@ -865,9 +884,56 @@ class free =
           m#merge_info tbody;
           Function_declaration (id, (k, params, body, nid))
       | Class_declaration (id, cl_decl) ->
+          let same_level = level in
+          let cbody = {<state_ = empty; level = same_level>} in
+          let cl_decl = cbody#class_decl cl_decl in
+          cbody#record_block Normal;
+          m#merge_block_info cbody;
           m#def_var id;
-          Class_declaration (id, m#class_decl cl_decl)
+          Class_declaration (id, cl_decl)
       | Block b -> Block (m#block b)
+      | For_statement (Right (((Const | Let) as k), l), e1, e2, (st, loc)) ->
+          let same_level = level in
+          let m' = {<state_ = empty; level = same_level>} in
+          let l = List.map ~f:(m'#variable_declaration k) l in
+          let e1 = Option.map ~f:m'#expression e1 in
+          let e2 = Option.map ~f:m'#expression e2 in
+          let st = m'#statement st in
+          m'#record_block Normal;
+          m#merge_block_info m';
+          For_statement (Right (k, l), e1, e2, (st, m#loc loc))
+      | ForIn_statement (Right (((Const | Let) as k), l), e2, (st, loc)) ->
+          let same_level = level in
+          let m' = {<state_ = empty; level = same_level>} in
+          let l = m'#for_binding k l in
+          let e2 = m'#expression e2 in
+          let st = m'#statement st in
+          m'#record_block Normal;
+          m#merge_block_info m';
+          ForIn_statement (Right (k, l), e2, (st, m#loc loc))
+      | ForOf_statement (Right (((Const | Let) as k), l), e2, (st, loc)) ->
+          let same_level = level in
+          let m' = {<state_ = empty; level = same_level>} in
+          let l = m'#for_binding k l in
+          let e2 = m'#expression e2 in
+          let st = m'#statement st in
+          m'#record_block Normal;
+          m#merge_block_info m';
+          ForOf_statement (Right (k, l), e2, (st, m#loc loc))
+      | Switch_statement (e, l, def, l') ->
+          let same_level = level in
+          let m' = {<state_ = empty; level = same_level>} in
+          let l = List.map l ~f:(fun (e, s) -> m'#switch_case e, m'#statements s) in
+          let l' = List.map l' ~f:(fun (e, s) -> m'#switch_case e, m'#statements s) in
+          let def =
+            match def with
+            | None -> None
+            | Some l -> Some (m'#statements l)
+          in
+          let e = m#expression e in
+          m'#record_block Normal;
+          m#merge_block_info m';
+          Switch_statement (e, l, def, l')
       | Try_statement (b, w, f) ->
           let same_level = level in
           let b = m#block b in
@@ -940,24 +1006,38 @@ class rename_variable =
 
        inherit iter as super
 
-       method expression e =
-         match e with
-         | EClass (ido, _) ->
-             Option.iter ido ~f:decl_var;
-             super#expression e
-         | _ -> super#expression e
+       method expression _ = ()
 
        method fun_decl _ = ()
 
+       method class_decl _ = ()
+
        method statement x =
          match scope, x with
          | Fun_block _, Function_declaration (id, fd) ->
              decl_var id;
              self#fun_decl fd
          | Lexical_block, Function_declaration (_, fd) -> self#fun_decl fd
-         | (Fun_block _ | Lexical_block), Class_declaration (id, _) ->
+         | (Lexical_block | Fun_block _), Class_declaration (id, cl_decl) ->
              decl_var id;
-             super#statement x
+             self#class_decl cl_decl
+         | _, For_statement (Right (((Const | Let) as k), l), _e1, _e2, (st, _loc)) ->
+             let m = {<depth = depth + 1>} in
+             List.iter ~f:(m#variable_declaration k) l;
+             m#statement st
+         | _, ForOf_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) ->
+             let m = {<depth = depth + 1>} in
+             m#for_binding k l;
+             m#statement st
+         | _, ForIn_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) ->
+             let m = {<depth = depth + 1>} in
+             m#for_binding k l;
+             m#statement st
+         | _, Switch_statement (_, l, def, l') ->
+             let m = {<depth = depth + 1>} in
+             List.iter l ~f:(fun (_, s) -> m#statements s);
+             Option.iter def ~f:(fun l -> m#statements l);
+             List.iter l' ~f:(fun (_, s) -> m#statements s)
          | (Fun_block _ | Lexical_block), _ -> super#statement x
 
        method variable_declaration k l =
@@ -998,7 +1078,7 @@ class rename_variable =
 
     val labels = StringMap.empty
 
-    method private update_state scope params iter_body =
+    method update_state scope params iter_body =
       let declared_names = declared scope params iter_body in
       {<subst = StringSet.fold
                   (fun name subst -> StringMap.add name (Code.Var.fresh_n name) subst)
@@ -1012,6 +1092,13 @@ class rename_variable =
       | S { name = Utf8 name; _ } -> (
           try V (StringMap.find name subst) with Not_found -> x)
 
+    method class_element x =
+      match x with
+      | CEStaticBLock l ->
+          let m' = m#update_state (Fun_block None) [] l in
+          CEStaticBLock (m'#statements l)
+      | _ -> super#class_element x
+
     method fun_decl (k, params, body, nid) =
       let ids = bound_idents_of_params params in
       let m' = m#update_state (Fun_block None) ids body in
@@ -1029,6 +1116,9 @@ class rename_variable =
           EFun
             ( Option.map ident ~f:m'#ident
             , (k, m'#formal_parameter_list params, m'#function_body body, m#loc nid) )
+      | EClass (Some id, cl_decl) ->
+          let m' = m#update_state Lexical_block [ id ] [] in
+          EClass (Some (m'#ident id), m'#class_decl cl_decl)
       | _ -> super#expression e
 
     method statement s =
@@ -1063,6 +1153,28 @@ class rename_variable =
           Function_declaration
             ( m#ident id
             , (k, m'#formal_parameter_list params, m'#function_body body, m#loc nid) )
+      | For_statement (Right (((Const | Let) as k), l), e1, e2, (st, loc)) ->
+          let ids = List.concat_map ~f:bound_idents_of_variable_declaration l in
+          let m' = m#update_state Lexical_block ids [] in
+          For_statement
+            ( Right (k, List.map ~f:(m'#variable_declaration k) l)
+            , Option.map ~f:m'#expression e1
+            , Option.map ~f:m'#expression e2
+            , (m'#statement st, m'#loc loc) )
+      | ForOf_statement (Right (((Const | Let) as k), l), e2, (st, loc)) ->
+          let ids = bound_idents_of_binding l in
+          let m' = m#update_state Lexical_block ids [] in
+          ForOf_statement
+            ( Right (k, m'#for_binding k l)
+            , m'#expression e2
+            , (m'#statement st, m'#loc loc) )
+      | ForIn_statement (Right (((Const | Let) as k), l), e2, (st, loc)) ->
+          let ids = bound_idents_of_binding l in
+          let m' = m#update_state Lexical_block ids [] in
+          ForOf_statement
+            ( Right (k, m'#for_binding k l)
+            , m'#expression e2
+            , (m'#statement st, m'#loc loc) )
       | Block l ->
           let m' = m#update_state Lexical_block [] l in
           Block (m'#statements l)
@@ -1106,6 +1218,22 @@ class rename_variable =
                 Some (i, m'#statements catch)
           in
           Try_statement (block, catch, final)
+      | Switch_statement (e, l, def, l') ->
+          let all =
+            let r = ref [] in
+            Option.iter def ~f:(fun l -> r := List.rev_append l !r);
+            List.iter l ~f:(fun (_, s) -> r := List.rev_append s !r);
+            List.iter l' ~f:(fun (_, s) -> r := List.rev_append s !r);
+            !r
+          in
+          let m' = m#update_state Lexical_block [] all in
+          Switch_statement
+            ( m#expression e
+            , List.map l ~f:(fun (e, s) -> m'#switch_case e, m'#statements s)
+            , (match def with
+              | None -> None
+              | Some l -> Some (m'#statements l))
+            , List.map l' ~f:(fun (e, s) -> m'#switch_case e, m'#statements s) )
       | _ -> super#statement s
   end
 
diff --git a/compiler/lib/js_traverse.mli b/compiler/lib/js_traverse.mli
index ba625bab20..f931214e16 100644
--- a/compiler/lib/js_traverse.mli
+++ b/compiler/lib/js_traverse.mli
@@ -34,6 +34,8 @@ class type mapper = object
 
   method class_decl : Javascript.class_declaration -> Javascript.class_declaration
 
+  method class_element : Javascript.class_element -> Javascript.class_element
+
   method initialiser : expression * location -> expression * location
 
   method initialiser_o : (expression * location) option -> (expression * location) option
@@ -67,6 +69,8 @@ end
 class type iterator = object
   method fun_decl : Javascript.function_declaration -> unit
 
+  method class_decl : Javascript.class_declaration -> unit
+
   method early_error : Javascript.early_error -> unit
 
   method expression : Javascript.expression -> unit
@@ -147,7 +151,15 @@ end
 
 class free : freevar
 
-class rename_variable : mapper
+type scope =
+  | Lexical_block
+  | Fun_block of ident option
+
+class rename_variable : object ('a)
+  inherit mapper
+
+  method update_state : scope -> Javascript.ident list -> Javascript.statement_list -> 'a
+end
 
 class share_constant : mapper
 
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index 7afd1cd326..d81187b8a1 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -369,6 +369,10 @@ module Option = struct
     | None -> None
     | Some v -> Some (f v)
 
+  let to_list = function
+    | None -> []
+    | Some x -> [ x ]
+
   let bind ~f x =
     match x with
     | None -> None
diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js
index befd4f3dba..4d599ef02b 100644
--- a/compiler/tests-full/stdlib.cma.expected.js
+++ b/compiler/tests-full/stdlib.cma.expected.js
@@ -30123,11 +30123,11 @@
             function(n, m){
                /*<<?>>*/ return function(obj){
                 /*<<camlinternalOO.ml:492:18>>*/  /*<<camlinternalOO.ml:492:44>>*/ var
-                _k_ =
+                _l_ =
                    /*<<camlinternalOO.ml:492:44>>*/ caml_call1
                    (obj[1][1 + m], obj);
                 /*<<camlinternalOO.ml:492:44>>*/ return  /*<<camlinternalOO.ml:492:44>>*/ caml_call2
-                       (obj[1][1 + n], obj, _k_); /*<<camlinternalOO.ml:492:60>>*/ };
+                       (obj[1][1 + n], obj, _l_); /*<<camlinternalOO.ml:492:60>>*/ };
              }
              (n$15, m$1);
          break;
@@ -30154,8 +30154,8 @@
           clo$0 =
             function(m, n){
                /*<<?>>*/ return function(obj){
-                /*<<camlinternalOO.ml:497:4>>*/ var _j_ = obj[1 + n];
-               return caml_call1(caml_get_public_method(_j_, m, 0), _j_); /*<<camlinternalOO.ml:498:32>>*/ };
+                /*<<camlinternalOO.ml:497:4>>*/ var _k_ = obj[1 + n];
+               return caml_call1(caml_get_public_method(_k_, m, 0), _k_); /*<<camlinternalOO.ml:498:32>>*/ };
              }
              (m$3, n$16);
          break;
@@ -30169,8 +30169,8 @@
           clo$0 =
             function(m, e, n){
                /*<<?>>*/ return function(obj){
-                /*<<camlinternalOO.ml:501:4>>*/ var _i_ = obj[1 + e][1 + n];
-               return caml_call1(caml_get_public_method(_i_, m, 0), _i_); /*<<camlinternalOO.ml:504:34>>*/ };
+                /*<<camlinternalOO.ml:501:4>>*/ var _j_ = obj[1 + e][1 + n];
+               return caml_call1(caml_get_public_method(_j_, m, 0), _j_); /*<<camlinternalOO.ml:504:34>>*/ };
              }
              (m$4, e$4, n$17);
          break;
@@ -30184,11 +30184,11 @@
             function(m, n){
                /*<<?>>*/ return function(obj){
                 /*<<camlinternalOO.ml:507:4>>*/  /*<<camlinternalOO.ml:507:14>>*/ var
-                _l_ =
+                _i_ =
                    /*<<camlinternalOO.ml:507:14>>*/ caml_call1
                    (obj[1][1 + n], obj);
                 /*<<camlinternalOO.ml:507:14>>*/ return  /*<<camlinternalOO.ml:507:14>>*/ caml_call1
-                       (caml_get_public_method(_l_, m, 0), _l_); /*<<camlinternalOO.ml:507:59>>*/ };
+                       (caml_get_public_method(_i_, m, 0), _i_); /*<<camlinternalOO.ml:507:59>>*/ };
              }
              (m$5, n$18);
       }

From 7977f8579c6a6c7611781f65248d32640b18bda4 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Sat, 14 Oct 2023 15:28:13 +0200
Subject: [PATCH 302/481] Compiler: improve complexity in parser production

---
 compiler/lib/js_parser.mly | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

diff --git a/compiler/lib/js_parser.mly b/compiler/lib/js_parser.mly
index 8d7d6150a0..f3a1ccbfd0 100644
--- a/compiler/lib/js_parser.mly
+++ b/compiler/lib/js_parser.mly
@@ -217,19 +217,22 @@ T_BACKQUOTE
 (* Macros *)
 (*************************************************************************)
 
-listc(X):
+listc_rev(X):
  | X              { [$1] }
- | listc(X) "," X { $1 @ [$3] }
+ | listc_rev(X) "," X { $3 :: $1 }
 
-listc_with_empty_trail(X):
- | e=elision               { (List.map (fun () -> None) e) }
- | x=X e=elision           { Some x :: (List.map (fun () -> None) e) }
- | listc_with_empty_trail(X) x=X e=elision { $1 @ [Some x] @ (List.map (fun () -> None) e) }
+%inline listc(X):
+ | listc_rev(X) { List.rev $1 }
+
+listc_with_empty_trail_rev(X):
+ | e=elision               { (List.rev_map (fun () -> None) e) }
+ | x=X e=elision           { List.rev_append (List.rev_map (fun () -> None) e) [ Some x ]   }
+ | listc_with_empty_trail_rev(X) x=X e=elision { List.rev_append (List.rev_map (fun () -> None) e) (Some x :: $1) }
 
 listc_with_empty(X):
   | X                           { [ Some $1 ] }
-  | listc_with_empty_trail(X)   { $1 }
-  | listc_with_empty_trail(X) X { $1 @ [Some $2 ] }
+  | listc_with_empty_trail_rev(X)   { List.rev $1 }
+  | listc_with_empty_trail_rev(X) X { List.rev ((Some $2) :: $1) }
 optl(X):
  | (* empty *) { [] }
  | X           { $1 }

From 2263216f3e526b6f00529145908b41e548b12d65 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Sun, 26 Nov 2023 16:12:30 +0100
Subject: [PATCH 303/481] Compiler: support for es6 import/export (#1529)

---
 compiler/bin-jsoo_minify/jsoo_minify.ml |   3 +-
 compiler/lib/driver.ml                  |   2 +-
 compiler/lib/javascript.ml              |  40 +++++++
 compiler/lib/javascript.mli             |  40 +++++++
 compiler/lib/js_output.ml               | 153 ++++++++++++++++++++++--
 compiler/lib/js_parser.mly              | 133 ++++++++++++++++++++
 compiler/lib/js_simpl.ml                |   2 +
 compiler/lib/js_token.ml                |   3 +
 compiler/lib/js_token.mli               |   1 +
 compiler/lib/js_traverse.ml             | 135 +++++++++++++++++++--
 compiler/lib/js_traverse.mli            |  11 +-
 compiler/lib/parse_js.ml                |  20 +++-
 compiler/lib/stdlib.ml                  |   4 +
 compiler/lib/wasm/wa_link.ml            |   2 +-
 14 files changed, 526 insertions(+), 23 deletions(-)

diff --git a/compiler/bin-jsoo_minify/jsoo_minify.ml b/compiler/bin-jsoo_minify/jsoo_minify.ml
index 22ffdb132c..f607fa369b 100644
--- a/compiler/bin-jsoo_minify/jsoo_minify.ml
+++ b/compiler/bin-jsoo_minify/jsoo_minify.ml
@@ -81,7 +81,8 @@ let f { Cmd_arg.common; output_file; use_stdin; files } =
     let true_ () = true in
     let open Config in
     let passes : ((unit -> bool) * (unit -> Js_traverse.mapper)) list =
-      [ (Flag.shortvar, fun () -> (new Js_traverse.rename_variable :> Js_traverse.mapper))
+      [ ( Flag.shortvar
+        , fun () -> (new Js_traverse.rename_variable ~esm:false :> Js_traverse.mapper) )
       ; (true_, fun () -> new Js_traverse.simpl)
       ; (true_, fun () -> new Js_traverse.clean)
       ]
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 7c0ed54ff6..889ef36237 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -560,7 +560,7 @@ if (typeof module === 'object' && module.exports) {
     if Config.Flag.shortvar ()
     then (
       let t5 = Timer.make () in
-      let js = (new Js_traverse.rename_variable)#program js in
+      let js = (new Js_traverse.rename_variable ~esm:false)#program js in
       if times () then Format.eprintf "    shortten vars: %a@." Timer.print t5;
       js)
     else js
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index 756fdefdc5..256f3cc098 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -346,6 +346,8 @@ and statement =
   | Throw_statement of expression
   | Try_statement of block * (formal_parameter option * block) option * block option
   | Debugger_statement
+  | Import of import * Parse_info.t
+  | Export of export * Parse_info.t
 
 and ('left, 'right) either =
   | Left of 'left
@@ -422,6 +424,44 @@ and function_body = statement_list
 
 and program = statement_list
 
+and export =
+  | ExportVar of variable_declaration_kind * variable_declaration list
+  | ExportFun of ident * function_declaration
+  | ExportClass of ident * class_declaration
+  | ExportNames of (ident * Utf8_string.t) list
+  (* default *)
+  | ExportDefaultFun of ident * function_declaration
+  | ExportDefaultClass of ident * class_declaration
+  | ExportDefaultExpression of expression
+  (* from *)
+  | ExportFrom of
+      { kind : export_from_kind
+      ; from : Utf8_string.t
+      }
+  | CoverExportFrom of early_error
+
+and export_from_kind =
+  | Export_all of Utf8_string.t option
+  | Export_names of (Utf8_string.t * Utf8_string.t) list
+
+and import =
+  { from : Utf8_string.t
+  ; kind : import_kind
+  }
+
+and import_default = ident
+
+and import_kind =
+  | Namespace of import_default option * ident
+  (* import * as name from "fname" *)
+  (* import defaultname, * as name from "fname" *)
+  | Named of import_default option * (Utf8_string.t * ident) list
+  (* import { 'a' as a, ...} from "fname" *)
+  (* import defaultname, { 'a' as a, ...} from "fname" *)
+  | Default of import_default
+  (* import defaultname from "fname" *)
+  | SideEffect (* import "fname" *)
+
 and program_with_annots = (statement_list * (Js_token.Annot.t * Parse_info.t) list) list
 
 let compare_ident t1 t2 =
diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli
index 75cf608a77..69a87bea9d 100644
--- a/compiler/lib/javascript.mli
+++ b/compiler/lib/javascript.mli
@@ -266,6 +266,8 @@ and statement =
   | Throw_statement of expression
   | Try_statement of block * (formal_parameter option * block) option * block option
   | Debugger_statement
+  | Import of import * Parse_info.t
+  | Export of export * Parse_info.t
 
 and ('left, 'right) either =
   | Left of 'left
@@ -342,6 +344,44 @@ and function_body = statement_list
 
 and program = statement_list
 
+and export =
+  | ExportVar of variable_declaration_kind * variable_declaration list
+  | ExportFun of ident * function_declaration
+  | ExportClass of ident * class_declaration
+  | ExportNames of (ident * Utf8_string.t) list
+  (* default *)
+  | ExportDefaultFun of ident * function_declaration
+  | ExportDefaultClass of ident * class_declaration
+  | ExportDefaultExpression of expression
+  (* from *)
+  | ExportFrom of
+      { kind : export_from_kind
+      ; from : Utf8_string.t
+      }
+  | CoverExportFrom of early_error
+
+and export_from_kind =
+  | Export_all of Utf8_string.t option
+  | Export_names of (Utf8_string.t * Utf8_string.t) list
+
+and import =
+  { from : Utf8_string.t
+  ; kind : import_kind
+  }
+
+and import_default = ident
+
+and import_kind =
+  | Namespace of import_default option * ident
+  (* import * as name from "fname" *)
+  (* import defaultname, * as name from "fname" *)
+  | Named of import_default option * (Utf8_string.t * ident) list
+  (* import { 'a' as a, ...} from "fname" *)
+  (* import defaultname, { 'a' as a, ...} from "fname" *)
+  | Default of import_default
+  (* import defaultname from "fname" *)
+  | SideEffect (* import "fname" *)
+
 and program_with_annots = (statement_list * (Js_token.Annot.t * Parse_info.t) list) list
 
 val compare_ident : ident -> ident -> int
diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index 2db393ddc0..1898a8e01d 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -289,7 +289,9 @@ struct
     | Try_statement _
     | Function_declaration _
     | Class_declaration _
-    | Debugger_statement -> false
+    | Debugger_statement
+    | Import _
+    | Export _ -> false
 
   let starts_with ~obj ~funct ~let_identifier ~async_identifier l e =
     let rec traverse l e =
@@ -368,6 +370,13 @@ struct
     Buffer.add_char b quote;
     PP.string f (Buffer.contents b)
 
+  let pp_string_lit f (Stdlib.Utf8_string.Utf8 s) =
+    let quote = best_string_quote s in
+    pp_string f ~quote s
+
+  let pp_ident_or_string_lit f (Stdlib.Utf8_string.Utf8 s_lit as s) =
+    if is_ident s_lit then PP.string f s_lit else pp_string_lit f s
+
   let rec comma_list f f_elt l =
     match l with
     | [] -> ()
@@ -523,9 +532,7 @@ struct
         then (
           PP.string f ")";
           PP.end_group f)
-    | EStr (Utf8 s) ->
-        let quote = best_string_quote s in
-        pp_string f ~quote s
+    | EStr x -> pp_string_lit f x
     | ETemplate l -> template f l
     | EBool b -> PP.string f (if b then "true" else "false")
     | ENum num ->
@@ -833,9 +840,7 @@ struct
   and property_name f n =
     match n with
     | PNI (Utf8 s) -> PP.string f s
-    | PNS (Utf8 s) ->
-        let quote = best_string_quote s in
-        pp_string f ~quote s
+    | PNS s -> pp_string_lit f s
     | PNN v -> expression Expression f (ENum v)
     | PComputed e ->
         PP.string f "[";
@@ -1409,6 +1414,140 @@ struct
             PP.string f "finally";
             block f b);
         PP.end_group f
+    | Import ({ kind; from }, _loc) ->
+        PP.start_group f 0;
+        PP.string f "import";
+        (match kind with
+        | SideEffect -> ()
+        | Default i ->
+            PP.space f;
+            ident f i
+        | Namespace (def, i) ->
+            Option.iter def ~f:(fun def ->
+                PP.space f;
+                ident f def;
+                PP.string f ",");
+            PP.space f;
+            PP.string f "* as ";
+            ident f i
+        | Named (def, l) ->
+            Option.iter def ~f:(fun def ->
+                PP.space f;
+                ident f def;
+                PP.string f ",");
+            PP.space f;
+            PP.string f "{";
+            PP.space f;
+            comma_list
+              f
+              (fun f (s, i) ->
+                if match i with
+                   | S { name; _ } when Stdlib.Utf8_string.equal name s -> true
+                   | _ -> false
+                then ident f i
+                else (
+                  pp_ident_or_string_lit f s;
+                  PP.string f " as ";
+                  ident f i))
+              l;
+            PP.space f;
+            PP.string f "}");
+        (match kind with
+        | SideEffect -> ()
+        | _ ->
+            PP.space f;
+            PP.string f "from");
+        PP.space f;
+        pp_string_lit f from;
+        PP.string f ";";
+        PP.end_group f
+    | Export (e, _loc) ->
+        PP.start_group f 0;
+        PP.string f "export";
+        (match e with
+        | ExportNames l ->
+            PP.space f;
+            PP.string f "{";
+            PP.space f;
+            comma_list
+              f
+              (fun f (i, s) ->
+                if match i with
+                   | S { name; _ } when Stdlib.Utf8_string.equal name s -> true
+                   | _ -> false
+                then ident f i
+                else (
+                  ident f i;
+                  PP.string f " as ";
+                  pp_ident_or_string_lit f s))
+              l;
+            PP.space f;
+            PP.string f "};"
+        | ExportFrom { kind; from } ->
+            PP.space f;
+            (match kind with
+            | Export_all None -> PP.string f "*"
+            | Export_all (Some s) ->
+                PP.string f "* as ";
+                pp_ident_or_string_lit f s
+            | Export_names l ->
+                PP.string f "{";
+                PP.space f;
+                comma_list
+                  f
+                  (fun f (a, b) ->
+                    if Stdlib.Utf8_string.equal a b
+                    then pp_ident_or_string_lit f a
+                    else (
+                      pp_ident_or_string_lit f a;
+                      PP.string f " as ";
+                      pp_ident_or_string_lit f b))
+                  l;
+                PP.space f;
+                PP.string f "}");
+            PP.space f;
+            PP.string f "from";
+            PP.space f;
+            pp_string_lit f from;
+            PP.string f ";"
+        | ExportDefaultExpression ((EFun _ | EClass _) as e) ->
+            PP.space f;
+            PP.string f "default";
+            PP.space f;
+            expression Expression f e
+        | ExportDefaultExpression e ->
+            PP.space f;
+            PP.string f "default";
+            PP.space f;
+            parenthesized_expression
+              ~last_semi
+              ~obj:true
+              ~funct:true
+              ~let_identifier:true
+              Expression
+              f
+              e
+        | ExportDefaultFun (id, decl) ->
+            PP.space f;
+            PP.string f "default";
+            PP.space f;
+            statement f (Function_declaration (id, decl), loc)
+        | ExportDefaultClass (id, decl) ->
+            PP.space f;
+            PP.string f "default";
+            PP.space f;
+            statement f (Class_declaration (id, decl), loc)
+        | ExportFun (id, decl) ->
+            PP.space f;
+            statement f (Function_declaration (id, decl), loc)
+        | ExportClass (id, decl) ->
+            PP.space f;
+            statement f (Class_declaration (id, decl), loc)
+        | ExportVar (k, l) ->
+            PP.space f;
+            variable_declaration_list k (not can_omit_semi) f l
+        | CoverExportFrom e -> early_error e);
+        PP.end_group f
 
   and statement_list f ?skip_last_semi b =
     match b with
diff --git a/compiler/lib/js_parser.mly b/compiler/lib/js_parser.mly
index f3a1ccbfd0..3f95883748 100644
--- a/compiler/lib/js_parser.mly
+++ b/compiler/lib/js_parser.mly
@@ -67,6 +67,10 @@ let vartok pos tok =
 
 let utf8_s = Stdlib.Utf8_string.of_string_exn
 
+let name_of_ident = function
+  | S { name; _} -> name
+  | V _ -> assert false
+
 %}
 
 (*************************************************************************)
@@ -120,6 +124,7 @@ T_PACKAGE
 T_DEBUGGER
 T_GET T_SET
 T_FROM
+T_AS
 T_TARGET
 T_META
 (*-----------------------------------------*)
@@ -249,6 +254,9 @@ program:
 
 module_item:
   | item { $symbolstartpos, $1 }
+  | import_decl { $symbolstartpos, $1 }
+  | export_decl { $symbolstartpos, $1 }
+
 
 (*************************************************************************)
 (* statement                                                           *)
@@ -269,6 +277,131 @@ decl:
  | class_decl
    { let i,f = $1 in Class_declaration (i,f), p $symbolstartpos }
 
+(*************************************************************************)
+(* Namespace *)
+(*************************************************************************)
+(*----------------------------*)
+(* import *)
+(*----------------------------*)
+
+import_decl:
+ | T_IMPORT kind=import_clause from=from_clause sc
+    { let pos = $symbolstartpos in
+      Import ({ from; kind }, pi pos), p pos }
+ | T_IMPORT from=module_specifier sc
+    { let pos = $symbolstartpos in
+      Import ({ from; kind = SideEffect }, pi pos), p pos }
+
+import_clause:
+ | import_default                            { Default $1 }
+ | import_default "," "*" T_AS id=binding_id { Namespace (Some $1, id) }
+ | "*" T_AS id=binding_id                    { Namespace (None, id) }
+ | import_default "," x=named_imports { Named (Some $1, x) }
+ | x=named_imports                    { Named (None, x) }
+
+import_default: binding_id { $1 }
+
+named_imports:
+ | "{" "}"                             { [] }
+ | "{" listc(import_specifier) "}"     { $2 }
+ | "{" listc(import_specifier) "," "}" { $2 }
+
+(* also valid for export *)
+from_clause: T_FROM module_specifier {$2 }
+
+import_specifier:
+ | binding_id                 { (name_of_ident $1, $1) }
+ | string_or_ident T_AS binding_id         {
+   let (_,s,_) = $1 in
+   (s, $3) }
+
+%inline string_or_ident:
+ | T_STRING { `String, fst $1, $symbolstartpos }
+ | T_DEFAULT { `Ident, Stdlib.Utf8_string.of_string_exn "default", $symbolstartpos }
+ | id { `Ident, $1, $symbolstartpos }
+
+module_specifier:
+  | T_STRING { (fst $1) }
+
+(*----------------------------*)
+(* export *)
+(*----------------------------*)
+
+export_decl:
+  | T_EXPORT names=export_clause sc {
+    let exception Invalid of Lexing.position in
+    let k =
+      try
+        let names =
+          List.map (fun ((k, id,pos), (_,s,_)) ->
+                     match k with
+                     | `Ident -> (var (p pos) id, s)
+                     | `String -> raise (Invalid pos))
+          names
+        in
+        (ExportNames names)
+      with Invalid pos ->
+         CoverExportFrom (early_error (pi pos))
+    in
+    let pos = $symbolstartpos in
+    Export (k, pi pos), p pos }
+ | T_EXPORT v=variable_stmt
+    {
+      let pos = $symbolstartpos in
+      let k = match v with
+        | Variable_statement (k,l) -> ExportVar (k, l)
+        | _ -> assert false
+      in
+      Export (k, pi pos), p pos }
+ | T_EXPORT d=decl
+    { let k = match d with
+        | Variable_statement (k,l),_ -> ExportVar (k,l)
+        | Function_declaration (id, decl),_ -> ExportFun (id,decl)
+        | Class_declaration (id, decl),_ -> ExportClass (id,decl)
+        | _ -> assert false
+      in
+      let pos = $symbolstartpos in
+      Export (k,pi pos), p pos }
+ (* in theory just func/gen/class, no lexical_decl *)
+ | T_EXPORT T_DEFAULT e=assignment_expr sc
+    {
+      let k = match e with
+      | EFun (Some id, decl) ->
+         ExportDefaultFun (id,decl)
+      | EClass (Some id, decl) ->
+         ExportDefaultClass (id, decl)
+      | e -> ExportDefaultExpression e
+      in
+      let pos = $symbolstartpos in
+      Export (k,pi pos), p pos }
+| T_EXPORT "*" T_FROM from=module_specifier sc {
+    let kind = Export_all None in
+    let pos = $symbolstartpos in
+    Export (ExportFrom ({from; kind}),pi pos), p pos
+  }
+ | T_EXPORT "*" T_AS id=string_or_ident T_FROM from=module_specifier sc {
+    let (_,id,_) = id in
+    let kind = Export_all (Some id) in
+    let pos = $symbolstartpos in
+    Export (ExportFrom ({from; kind}), pi pos), p pos
+  }
+| T_EXPORT names=export_clause T_FROM from=module_specifier sc {
+    let names = List.map (fun ((_,a,_), (_,b,_)) -> a, b) names in
+    let kind = Export_names names in
+    let pos = $symbolstartpos in
+    Export (ExportFrom ({from; kind}), pi pos), p pos
+  }
+
+export_specifier:
+ | string_or_ident                       { ($1, $1) }
+ | string_or_ident T_AS string_or_ident  { ($1, $3) }
+
+export_clause:
+ | "{" "}"                              { [] }
+ | "{" listc(export_specifier) "}"      { $2 }
+ | "{" listc(export_specifier) ","  "}" { $2 }
+
+
 (*************************************************************************)
 (* Variable decl *)
 (*************************************************************************)
diff --git a/compiler/lib/js_simpl.ml b/compiler/lib/js_simpl.ml
index 536dc00bbd..f552f52492 100644
--- a/compiler/lib/js_simpl.ml
+++ b/compiler/lib/js_simpl.ml
@@ -179,6 +179,8 @@ let rec depth = function
   | Try_statement (b, _, None) -> depth_block b + 1
   | Try_statement (b, _, Some b2) -> max (depth_block b) (depth_block b2) + 1
   | Debugger_statement -> 1
+  | Import _ -> 1
+  | Export _ -> 1
 
 and depth_block b = List.fold_left b ~init:0 ~f:(fun acc (s, _) -> max acc (depth s))
 
diff --git a/compiler/lib/js_token.ml b/compiler/lib/js_token.ml
index 4f0e56c0d5..e6a4a7b614 100644
--- a/compiler/lib/js_token.ml
+++ b/compiler/lib/js_token.ml
@@ -148,6 +148,7 @@ type t =
   | T_BACKQUOTE
   | T_DOLLARCURLY
   | T_ENCAPSED_STRING of string
+  | T_AS
   (* Extra tokens *)
   | T_ERROR of string
   | T_EOF
@@ -303,6 +304,7 @@ let to_string = function
   | T_BACKQUOTE -> "`"
   | T_DOLLARCURLY -> "${"
   | T_ENCAPSED_STRING s -> s
+  | T_AS -> "as"
 
 let to_string_extra x =
   to_string x
@@ -375,4 +377,5 @@ let is_keyword s =
   | "from" -> Some T_FROM
   | "target" -> Some T_TARGET
   | "meta" -> Some T_META
+  | "as" -> Some T_AS
   | _ -> None
diff --git a/compiler/lib/js_token.mli b/compiler/lib/js_token.mli
index 6c6a38e62f..2771555d80 100644
--- a/compiler/lib/js_token.mli
+++ b/compiler/lib/js_token.mli
@@ -147,6 +147,7 @@ type t =
   | T_BACKQUOTE
   | T_DOLLARCURLY
   | T_ENCAPSED_STRING of string
+  | T_AS
   (* Extra tokens *)
   | T_ERROR of string
   | T_EOF
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index 6f9c79cdff..e747f3aa73 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -71,6 +71,10 @@ class type mapper = object
   method program : Javascript.program -> Javascript.program
 
   method function_body : statement_list -> statement_list
+
+  method import : import -> import
+
+  method export : export -> export
 end
 
 (* generic js ast walk/map *)
@@ -187,6 +191,47 @@ class map : mapper =
             , match final with
               | None -> None
               | Some s -> Some (m#block s) )
+      | Import (import, loc) -> Import (m#import import, loc)
+      | Export (export, loc) -> Export (m#export export, loc)
+
+    method import { from; kind } =
+      let kind =
+        match kind with
+        | Namespace (iopt, i) -> Namespace (Option.map ~f:m#ident iopt, m#ident i)
+        | Named (iopt, l) ->
+            Named
+              (Option.map ~f:m#ident iopt, List.map ~f:(fun (s, id) -> s, m#ident id) l)
+        | Default import_default -> Default (m#ident import_default)
+        | SideEffect -> SideEffect
+      in
+      { from; kind }
+
+    method export e =
+      match e with
+      | ExportVar (k, l) -> (
+          match m#statement (Variable_statement (k, l)) with
+          | Variable_statement (k, l) -> ExportVar (k, l)
+          | _ -> assert false)
+      | ExportFun (id, f) -> (
+          match m#statement (Function_declaration (id, f)) with
+          | Function_declaration (id, f) -> ExportFun (id, f)
+          | _ -> assert false)
+      | ExportClass (id, f) -> (
+          match m#statement (Class_declaration (id, f)) with
+          | Class_declaration (id, f) -> ExportClass (id, f)
+          | _ -> assert false)
+      | ExportNames l -> ExportNames (List.map ~f:(fun (id, s) -> m#ident id, s) l)
+      | ExportDefaultFun (id, decl) -> (
+          match m#statement (Function_declaration (id, decl)) with
+          | Function_declaration (id, decl) -> ExportDefaultFun (id, decl)
+          | _ -> assert false)
+      | ExportDefaultClass (id, decl) -> (
+          match m#statement (Class_declaration (id, decl)) with
+          | Class_declaration (id, decl) -> ExportDefaultClass (id, decl)
+          | _ -> assert false)
+      | ExportDefaultExpression e -> ExportDefaultExpression (m#expression e)
+      | ExportFrom l -> ExportFrom l
+      | CoverExportFrom e -> CoverExportFrom (m#early_error e)
 
     method statement_o x =
       match x with
@@ -340,6 +385,10 @@ class type iterator = object
   method program : Javascript.program -> unit
 
   method function_body : Javascript.statement_list -> unit
+
+  method import : import -> unit
+
+  method export : export -> unit
 end
 
 (* generic js ast iterator *)
@@ -466,6 +515,31 @@ class iter : iterator =
           match final with
           | None -> ()
           | Some s -> m#block s)
+      | Import (x, _loc) -> m#import x
+      | Export (x, _loc) -> m#export x
+
+    method import { from = _; kind } =
+      match kind with
+      | Namespace (iopt, i) ->
+          Option.iter ~f:m#ident iopt;
+          m#ident i
+      | Named (iopt, l) ->
+          Option.iter ~f:m#ident iopt;
+          List.iter ~f:(fun (_, id) -> m#ident id) l
+      | Default import_default -> m#ident import_default
+      | SideEffect -> ()
+
+    method export e =
+      match e with
+      | ExportVar (k, l) -> m#statement (Variable_statement (k, l))
+      | ExportFun (id, f) -> m#statement (Function_declaration (id, f))
+      | ExportClass (id, f) -> m#statement (Class_declaration (id, f))
+      | ExportNames l -> List.iter ~f:(fun (id, _) -> m#ident id) l
+      | ExportDefaultFun (id, decl) -> m#statement (Function_declaration (id, decl))
+      | ExportDefaultClass (id, decl) -> m#statement (Class_declaration (id, decl))
+      | ExportDefaultExpression e -> m#expression e
+      | ExportFrom { from = _; kind = _ } -> ()
+      | CoverExportFrom e -> m#early_error e
 
     method statement_o x =
       match x with
@@ -968,6 +1042,17 @@ class free =
             | Some f -> Some (m#block f)
           in
           Try_statement (b, w, f)
+      | Import ({ from = _; kind }, _) ->
+          (match kind with
+          | Namespace (iopt, i) ->
+              Option.iter ~f:m#def_local iopt;
+              m#def_local i
+          | Named (iopt, l) ->
+              Option.iter ~f:m#def_local iopt;
+              List.iter ~f:(fun (_, id) -> m#def_local id) l
+          | Default import_default -> m#def_local import_default
+          | SideEffect -> ());
+          super#statement x
       | _ -> super#statement x
 
     method for_binding k x =
@@ -985,10 +1070,11 @@ class free =
   end
 
 type scope =
+  | Module
   | Lexical_block
   | Fun_block of ident option
 
-class rename_variable =
+class rename_variable ~esm =
   let declared scope params body =
     let declared_names = ref StringSet.empty in
     let decl_var x =
@@ -997,6 +1083,7 @@ class rename_variable =
       | _ -> ()
     in
     (match scope with
+    | Module -> ()
     | Lexical_block -> ()
     | Fun_block None -> ()
     | Fun_block (Some x) -> decl_var x);
@@ -1014,13 +1101,14 @@ class rename_variable =
 
        method statement x =
          match scope, x with
-         | Fun_block _, Function_declaration (id, fd) ->
+         | (Fun_block _ | Module), Function_declaration (id, fd) ->
              decl_var id;
              self#fun_decl fd
          | Lexical_block, Function_declaration (_, fd) -> self#fun_decl fd
-         | (Lexical_block | Fun_block _), Class_declaration (id, cl_decl) ->
+         | (Fun_block _ | Module), Class_declaration (id, cl_decl) ->
              decl_var id;
              self#class_decl cl_decl
+         | Lexical_block, Class_declaration (_, cl_decl) -> self#class_decl cl_decl
          | _, For_statement (Right (((Const | Let) as k), l), _e1, _e2, (st, _loc)) ->
              let m = {<depth = depth + 1>} in
              List.iter ~f:(m#variable_declaration k) l;
@@ -1038,13 +1126,35 @@ class rename_variable =
              List.iter l ~f:(fun (_, s) -> m#statements s);
              Option.iter def ~f:(fun l -> m#statements l);
              List.iter l' ~f:(fun (_, s) -> m#statements s)
-         | (Fun_block _ | Lexical_block), _ -> super#statement x
+         | _, Import ({ kind; from = _ }, _loc) -> (
+             match kind with
+             | Namespace (iopt, i) ->
+                 Option.iter ~f:decl_var iopt;
+                 decl_var i
+             | Named (iopt, l) ->
+                 Option.iter ~f:decl_var iopt;
+                 List.iter ~f:(fun (_, id) -> decl_var id) l
+             | Default import_default -> decl_var import_default
+             | SideEffect -> ())
+         | (Fun_block _ | Lexical_block | Module), _ -> super#statement x
+
+       method export e =
+         match e with
+         | ExportVar (_k, _l) -> ()
+         | ExportFun (_id, _f) -> ()
+         | ExportClass (_id, _f) -> ()
+         | ExportNames l -> List.iter ~f:(fun (id, _) -> self#ident id) l
+         | ExportDefaultFun (id, decl) -> self#statement (Function_declaration (id, decl))
+         | ExportDefaultClass (id, decl) -> self#statement (Class_declaration (id, decl))
+         | ExportDefaultExpression e -> self#expression e
+         | ExportFrom { from = _; kind = _ } -> ()
+         | CoverExportFrom _ -> ()
 
        method variable_declaration k l =
          if match scope, k with
-            | (Lexical_block | Fun_block _), (Let | Const) -> depth = 0
+            | (Lexical_block | Fun_block _ | Module), (Let | Const) -> depth = 0
             | Lexical_block, Var -> false
-            | Fun_block _, Var -> true
+            | (Fun_block _ | Module), Var -> true
          then
            let ids = bound_idents_of_variable_declaration l in
            List.iter ids ~f:decl_var
@@ -1055,9 +1165,9 @@ class rename_variable =
 
        method for_binding k p =
          if match scope, k with
-            | (Lexical_block | Fun_block _), (Let | Const) -> depth = 0
+            | (Lexical_block | Fun_block _ | Module), (Let | Const) -> depth = 0
             | Lexical_block, Var -> false
-            | Fun_block _, Var -> true
+            | (Fun_block _ | Module), Var -> true
          then
            match p with
            | BindingIdent i -> decl_var i
@@ -1105,8 +1215,13 @@ class rename_variable =
       k, m'#formal_parameter_list params, m'#function_body body, m#loc nid
 
     method program p =
-      let m' = m#update_state Lexical_block [] p in
-      m'#statements p
+      if esm
+      then
+        let m' = m#update_state Module [] p in
+        m'#statements p
+      else
+        let m' = m#update_state Lexical_block [] p in
+        m'#statements p
 
     method expression e =
       match e with
diff --git a/compiler/lib/js_traverse.mli b/compiler/lib/js_traverse.mli
index f931214e16..062402eced 100644
--- a/compiler/lib/js_traverse.mli
+++ b/compiler/lib/js_traverse.mli
@@ -64,6 +64,10 @@ class type mapper = object
   method program : program -> program
 
   method function_body : statement_list -> statement_list
+
+  method import : import -> import
+
+  method export : export -> export
 end
 
 class type iterator = object
@@ -102,6 +106,10 @@ class type iterator = object
   method program : Javascript.program -> unit
 
   method function_body : Javascript.statement_list -> unit
+
+  method import : import -> unit
+
+  method export : export -> unit
 end
 
 class map : mapper
@@ -152,10 +160,11 @@ end
 class free : freevar
 
 type scope =
+  | Module
   | Lexical_block
   | Fun_block of ident option
 
-class rename_variable : object ('a)
+class rename_variable : esm:bool -> object ('a)
   inherit mapper
 
   method update_state : scope -> Javascript.ident list -> Javascript.statement_list -> 'a
diff --git a/compiler/lib/parse_js.ml b/compiler/lib/parse_js.ml
index 3a9edff265..5dcbfb3471 100644
--- a/compiler/lib/parse_js.ml
+++ b/compiler/lib/parse_js.ml
@@ -511,10 +511,26 @@ let parse_aux the_parser (lexbuf : Lexer.t) =
       raise (Parsing_error (Parse_info.t_of_pos p))
 
 let fail_early =
-  object
-    inherit Js_traverse.iter
+  object (m)
+    inherit Js_traverse.iter as super
 
     method early_error p = raise (Parsing_error p.loc)
+
+    method statement s =
+      match s with
+      | Import (_, loc) -> raise (Parsing_error loc)
+      | Export (_, loc) -> raise (Parsing_error loc)
+      | _ -> super#statement s
+
+    method program p =
+      List.iter p ~f:(fun ((p : Javascript.statement), _loc) ->
+          match p with
+          | Import _ -> super#statement p
+          | Export (e, _) -> (
+              match e with
+              | CoverExportFrom e -> m#early_error e
+              | _ -> super#statement p)
+          | _ -> super#statement p)
   end
 
 let check_program p = List.iter p ~f:(function _, p -> fail_early#program [ p ])
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index d81187b8a1..f68e8cdb53 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -1028,6 +1028,8 @@ module Utf8_string : sig
   val of_string_exn : string -> t
 
   val compare : t -> t -> int
+
+  val equal : t -> t -> bool
 end = struct
   type t = Utf8 of string [@@ocaml.unboxed]
 
@@ -1037,6 +1039,8 @@ end = struct
     else invalid_arg "Utf8_string.of_string: invalid utf8 string"
 
   let compare (Utf8 x) (Utf8 y) = String.compare x y
+
+  let equal (Utf8 x) (Utf8 y) = String.equal x y
 end
 
 module Int = struct
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 0c4efbc9ce..f778f9b564 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -315,7 +315,7 @@ let output_js js =
       | S { name = Utf8 x; _ } -> Var_printer.add_reserved x)
     free;
   let js =
-    if Config.Flag.shortvar () then (new Js_traverse.rename_variable)#program js else js
+    if Config.Flag.shortvar () then (new Js_traverse.rename_variable ~esm:false)#program js else js
   in
   let js = (new Js_traverse.simpl)#program js in
   let js = (new Js_traverse.clean)#program js in

From 924ab20b412bc216ebbfa4ab495a89b172807b59 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Sat, 14 Oct 2023 21:00:06 +0200
Subject: [PATCH 304/481] Compiler: lazy cmdliner term

---
 compiler/bin-js_of_ocaml/cmd_arg.ml |  4 +-
 compiler/bin-js_of_ocaml/link.ml    |  2 +-
 compiler/bin-jsoo_minify/cmd_arg.ml |  4 +-
 compiler/lib-cmdline/arg.ml         | 90 +++++++++++++++--------------
 compiler/lib-cmdline/arg.mli        |  2 +-
 5 files changed, 54 insertions(+), 48 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml
index fd9657b54a..2077da2674 100644
--- a/compiler/bin-js_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-js_of_ocaml/cmd_arg.ml
@@ -365,7 +365,7 @@ let options =
   let t =
     Term.(
       const build_t
-      $ Jsoo_cmdline.Arg.t
+      $ Lazy.force Jsoo_cmdline.Arg.t
       $ set_param
       $ set_env
       $ dynlink
@@ -604,7 +604,7 @@ let options_runtime_only =
   let t =
     Term.(
       const build_t
-      $ Jsoo_cmdline.Arg.t
+      $ Lazy.force Jsoo_cmdline.Arg.t
       $ toplevel
       $ no_cmis
       $ set_param
diff --git a/compiler/bin-js_of_ocaml/link.ml b/compiler/bin-js_of_ocaml/link.ml
index 4025734010..090913d20b 100644
--- a/compiler/bin-js_of_ocaml/link.ml
+++ b/compiler/bin-js_of_ocaml/link.ml
@@ -126,7 +126,7 @@ let options =
   let t =
     Term.(
       const build_t
-      $ Jsoo_cmdline.Arg.t
+      $ Lazy.force Jsoo_cmdline.Arg.t
       $ no_sourcemap
       $ sourcemap
       $ sourcemap_inline_in_js
diff --git a/compiler/bin-jsoo_minify/cmd_arg.ml b/compiler/bin-jsoo_minify/cmd_arg.ml
index 0260359a82..743cbe0e21 100644
--- a/compiler/bin-jsoo_minify/cmd_arg.ml
+++ b/compiler/bin-jsoo_minify/cmd_arg.ml
@@ -42,7 +42,9 @@ let options =
   let build_t common files output_file use_stdin =
     `Ok { common; use_stdin; output_file; files }
   in
-  let t = Term.(const build_t $ Jsoo_cmdline.Arg.t $ files $ output_file $ use_stdin) in
+  let t =
+    Term.(const build_t $ Lazy.force Jsoo_cmdline.Arg.t $ files $ output_file $ use_stdin)
+  in
   Term.ret t
 
 let info =
diff --git a/compiler/lib-cmdline/arg.ml b/compiler/lib-cmdline/arg.ml
index aa793f1d4a..925dc0f8aa 100644
--- a/compiler/lib-cmdline/arg.ml
+++ b/compiler/lib-cmdline/arg.ml
@@ -35,28 +35,31 @@ type t =
   }
 
 let debug =
-  let doc = "enable debug [$(docv)]." in
-  let all = List.map (Debug.available ()) ~f:(fun s -> s, s) in
-  let arg =
-    Arg.(value & opt_all (list (enum all)) [] & info [ "debug" ] ~docv:"SECTION" ~doc)
-  in
-  Term.(const List.flatten $ arg)
+  lazy
+    (let doc = "enable debug [$(docv)]." in
+     let all = List.map (Debug.available ()) ~f:(fun s -> s, s) in
+     let arg =
+       Arg.(value & opt_all (list (enum all)) [] & info [ "debug" ] ~docv:"SECTION" ~doc)
+     in
+     Term.(const List.flatten $ arg))
 
 let enable =
-  let doc = "Enable optimization [$(docv)]." in
-  let all = List.map (Config.Flag.available ()) ~f:(fun s -> s, s) in
-  let arg =
-    Arg.(value & opt_all (list (enum all)) [] & info [ "enable" ] ~docv:"OPT" ~doc)
-  in
-  Term.(const List.flatten $ arg)
+  lazy
+    (let doc = "Enable optimization [$(docv)]." in
+     let all = List.map (Config.Flag.available ()) ~f:(fun s -> s, s) in
+     let arg =
+       Arg.(value & opt_all (list (enum all)) [] & info [ "enable" ] ~docv:"OPT" ~doc)
+     in
+     Term.(const List.flatten $ arg))
 
 let disable =
-  let doc = "Disable optimization [$(docv)]." in
-  let all = List.map (Config.Flag.available ()) ~f:(fun s -> s, s) in
-  let arg =
-    Arg.(value & opt_all (list (enum all)) [] & info [ "disable" ] ~docv:"OPT" ~doc)
-  in
-  Term.(const List.flatten $ arg)
+  lazy
+    (let doc = "Disable optimization [$(docv)]." in
+     let all = List.map (Config.Flag.available ()) ~f:(fun s -> s, s) in
+     let arg =
+       Arg.(value & opt_all (list (enum all)) [] & info [ "disable" ] ~docv:"OPT" ~doc)
+     in
+     Term.(const List.flatten $ arg))
 
 let pretty =
   let doc = "Pretty print the output." in
@@ -86,31 +89,32 @@ let custom_header =
   Arg.(value & opt (some string) None & info [ "custom-header" ] ~doc)
 
 let t =
-  Term.(
-    const (fun debug enable disable pretty debuginfo noinline quiet werror c_header ->
-        let enable = if pretty then "pretty" :: enable else enable in
-        let enable = if debuginfo then "debuginfo" :: enable else enable in
-        let disable = if noinline then "inline" :: disable else disable in
-        let disable_if_pretty name disable =
-          if pretty && not (List.mem name ~set:enable) then name :: disable else disable
-        in
-        let disable = disable_if_pretty "shortvar" disable in
-        let disable = disable_if_pretty "share" disable in
-        { debug = { enable = debug; disable = [] }
-        ; optim = { enable; disable }
-        ; quiet
-        ; werror
-        ; custom_header = c_header
-        })
-    $ debug
-    $ enable
-    $ disable
-    $ pretty
-    $ debuginfo
-    $ noinline
-    $ is_quiet
-    $ is_werror
-    $ custom_header)
+  lazy
+    Term.(
+      const (fun debug enable disable pretty debuginfo noinline quiet werror c_header ->
+          let enable = if pretty then "pretty" :: enable else enable in
+          let enable = if debuginfo then "debuginfo" :: enable else enable in
+          let disable = if noinline then "inline" :: disable else disable in
+          let disable_if_pretty name disable =
+            if pretty && not (List.mem name ~set:enable) then name :: disable else disable
+          in
+          let disable = disable_if_pretty "shortvar" disable in
+          let disable = disable_if_pretty "share" disable in
+          { debug = { enable = debug; disable = [] }
+          ; optim = { enable; disable }
+          ; quiet
+          ; werror
+          ; custom_header = c_header
+          })
+      $ Lazy.force debug
+      $ Lazy.force enable
+      $ Lazy.force disable
+      $ pretty
+      $ debuginfo
+      $ noinline
+      $ is_quiet
+      $ is_werror
+      $ custom_header)
 
 let on_off on off t =
   List.iter ~f:on t.enable;
diff --git a/compiler/lib-cmdline/arg.mli b/compiler/lib-cmdline/arg.mli
index dfa35da022..295f58ac72 100644
--- a/compiler/lib-cmdline/arg.mli
+++ b/compiler/lib-cmdline/arg.mli
@@ -30,6 +30,6 @@ type t =
   ; custom_header : string option
   }
 
-val t : t Cmdliner.Term.t
+val t : t Cmdliner.Term.t Lazy.t
 
 val eval : t -> unit

From ad7a1c800507ec64d9e57a327a91d934471a9fa3 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 11 Dec 2023 14:23:43 +0100
Subject: [PATCH 305/481] Compiler: js-parser: fix class member printing

---
 compiler/lib/js_output.ml                    | 54 ++++++++++++--------
 compiler/tests-compiler/js_parser_printer.ml | 48 +++++++----------
 2 files changed, 51 insertions(+), 51 deletions(-)

diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index 1898a8e01d..247282fde7 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -435,14 +435,7 @@ struct
           | { async = false; generator = true } -> "function*"
         in
         function_declaration f prefix ident i l b pc
-    | EClass (i, cl_decl) ->
-        PP.string f "class";
-        (match i with
-        | None -> ()
-        | Some i ->
-            PP.space f;
-            ident f i);
-        class_declaration f cl_decl
+    | EClass (i, cl_decl) -> class_declaration f i cl_decl
     | EArrow ((k, p, b, pc), _) ->
         if Prec.(l > AssignementExpression)
         then (
@@ -1103,11 +1096,7 @@ struct
           | { async = false; generator = true } -> "function*"
         in
         function_declaration f prefix ident (Some i) l b loc'
-    | Class_declaration (i, cl_decl) ->
-        PP.string f "class";
-        PP.space f;
-        ident f i;
-        class_declaration f cl_decl
+    | Class_declaration (i, cl_decl) -> class_declaration f (Some i) cl_decl
     | Empty_statement -> PP.string f ";"
     | Debugger_statement ->
         PP.string f "debugger";
@@ -1599,23 +1588,39 @@ struct
     PP.string f "}";
     PP.end_group f
 
-  and class_declaration f x =
+  and class_declaration f i x =
+    PP.start_group f 1;
+    PP.start_group f 0;
+    PP.start_group f 0;
+    PP.string f "class";
+    (match i with
+    | None -> ()
+    | Some i ->
+        PP.space f;
+        ident f i);
+    PP.end_group f;
     Option.iter x.extends ~f:(fun e ->
         PP.space f;
         PP.string f "extends";
         PP.space f;
-        expression Expression f e);
+        expression Expression f e;
+        PP.space f);
+    PP.end_group f;
+    PP.start_group f 2;
     PP.string f "{";
-    List.iter x.body ~f:(fun x ->
-        match x with
+    PP.break f;
+    List.iter_last x.body ~f:(fun last x ->
+        (match x with
         | CEMethod (static, n, m) ->
+            PP.start_group f 0;
             if static
             then (
               PP.string f "static";
               PP.space f);
             method_ f class_element_name n m;
-            PP.break f
+            PP.end_group f
         | CEField (static, n, i) ->
+            PP.start_group f 0;
             if static
             then (
               PP.string f "static";
@@ -1629,12 +1634,19 @@ struct
                 PP.space f;
                 output_debug_info f loc;
                 expression Expression f e);
-            PP.break f
+            PP.string f ";";
+            PP.end_group f
         | CEStaticBLock l ->
+            PP.start_group f 0;
             PP.string f "static";
+            PP.space f;
             block f l;
-            PP.break f);
-    PP.string f "}"
+            PP.end_group f);
+        if not last then PP.break f);
+    PP.end_group f;
+    PP.break f;
+    PP.string f "}";
+    PP.end_group f
 
   and class_element_name f x =
     match x with
diff --git a/compiler/tests-compiler/js_parser_printer.ml b/compiler/tests-compiler/js_parser_printer.ml
index 53014de09a..e3e01d3419 100644
--- a/compiler/tests-compiler/js_parser_printer.ml
+++ b/compiler/tests-compiler/js_parser_printer.ml
@@ -527,36 +527,24 @@ class x extends p {
 
   [%expect
     {|
-     /*<<fake:2:0>>*/ class
-    x
-    extends
-    p{constructor(){
-      /*<<fake:4:6>>*/  /*<<fake:4:6>>*/ super(a, b, c);
-     /*<<fake:3:4>>*/ }
-    foo(){
-      /*<<fake:8:6>>*/  /*<<fake:8:12>>*/ var s = super[d];
-      /*<<fake:9:6>>*/  /*<<fake:9:12>>*/ var s = super.d;
-     /*<<fake:6:4>>*/ }
-    static
-    bar(){
-      /*<<fake:14:6>>*/  /*<<fake:14:12>>*/ var s = super[d];
-      /*<<fake:15:6>>*/  /*<<fake:15:12>>*/ var s = super.d;
-     /*<<fake:12:11>>*/ }
-    x
-    =
-     /*<<fake:17:5>>*/ 3
-    static
-    y
-    =
-     /*<<fake:19:12>>*/ 5
-    #z
-    =
-     /*<<fake:21:6>>*/ 6
-    static
-    #t
-    =
-     /*<<fake:23:13>>*/ 2
-    static{ /*<<fake:25:12>>*/  /*<<fake:25:18>>*/ var x = 3;}
+    /*<<fake:2:0>>*/ class x extends p {
+      constructor(){
+        /*<<fake:4:6>>*/  /*<<fake:4:6>>*/ super(a, b, c);
+       /*<<fake:3:4>>*/ }
+      foo(){
+        /*<<fake:8:6>>*/  /*<<fake:8:12>>*/ var s = super[d];
+        /*<<fake:9:6>>*/  /*<<fake:9:12>>*/ var s = super.d;
+       /*<<fake:6:4>>*/ }
+      static
+      bar(){
+        /*<<fake:14:6>>*/  /*<<fake:14:12>>*/ var s = super[d];
+        /*<<fake:15:6>>*/  /*<<fake:15:12>>*/ var s = super.d;
+       /*<<fake:12:11>>*/ }
+      x =  /*<<fake:17:5>>*/ 3;
+      static y =  /*<<fake:19:12>>*/ 5;
+      #z =  /*<<fake:21:6>>*/ 6;
+      static #t =  /*<<fake:23:13>>*/ 2;
+      static { /*<<fake:25:12>>*/  /*<<fake:25:18>>*/ var x = 3;}
     } |}]
 
 let%expect_test "ite" =

From df89877efd10f9d8c49eb23b5dbd6ac3abe852e6 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Sun, 17 Dec 2023 09:23:13 +0100
Subject: [PATCH 306/481] Compiler: js-parser: preserve consise body

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml |  4 ++--
 compiler/bin-wasm_of_ocaml/link.ml    |  2 +-
 compiler/lib/javascript.ml            |  2 +-
 compiler/lib/javascript.mli           |  2 +-
 compiler/lib/js_output.ml             |  8 ++++----
 compiler/lib/js_parser.mly            | 17 +++++++++++------
 compiler/lib/js_traverse.ml           | 18 +++++++++---------
 compiler/lib/wasm/wa_gc_target.ml     |  9 ++++++++-
 compiler/lib/wasm/wa_link.ml          |  6 +++++-
 compiler/tests-compiler/es6.ml        |  2 +-
 compiler/tests-compiler/util/util.ml  |  2 +-
 11 files changed, 44 insertions(+), 28 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index 59bd343d43..9579d7a1fe 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -145,7 +145,7 @@ let options =
   let t =
     Term.(
       const build_t
-      $ Jsoo_cmdline.Arg.t
+      $ Lazy.force Jsoo_cmdline.Arg.t
       $ set_param
       $ include_dirs
       $ profile
@@ -226,7 +226,7 @@ let options_runtime_only =
   let t =
     Term.(
       const build_t
-      $ Jsoo_cmdline.Arg.t
+      $ Lazy.force Jsoo_cmdline.Arg.t
       $ set_param
       $ include_dirs
       $ sourcemap
diff --git a/compiler/bin-wasm_of_ocaml/link.ml b/compiler/bin-wasm_of_ocaml/link.ml
index db36e305d4..117212847b 100644
--- a/compiler/bin-wasm_of_ocaml/link.ml
+++ b/compiler/bin-wasm_of_ocaml/link.ml
@@ -60,7 +60,7 @@ let options =
   let t =
     Term.(
       const build_t
-      $ Jsoo_cmdline.Arg.t
+      $ Lazy.force Jsoo_cmdline.Arg.t
       $ no_sourcemap
       $ sourcemap
       $ output_file
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index 256f3cc098..7825a535fe 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -283,7 +283,7 @@ and expression =
   | EVar of ident
   | EFun of ident option * function_declaration
   | EClass of ident option * class_declaration
-  | EArrow of function_declaration * arrow_info
+  | EArrow of function_declaration * bool * arrow_info
   | EStr of Utf8_string.t
   | ETemplate of template
   | EArr of array_litteral
diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli
index 69a87bea9d..2910aca877 100644
--- a/compiler/lib/javascript.mli
+++ b/compiler/lib/javascript.mli
@@ -200,7 +200,7 @@ and expression =
   | EVar of ident
   | EFun of ident option * function_declaration
   | EClass of ident option * class_declaration
-  | EArrow of function_declaration * arrow_info
+  | EArrow of function_declaration * bool * arrow_info
   | EStr of Utf8_string.t
   (* A UTF-8 encoded string that may contain escape sequences. *)
   | ETemplate of template
diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index 247282fde7..fb1646080c 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -436,7 +436,7 @@ struct
         in
         function_declaration f prefix ident i l b pc
     | EClass (i, cl_decl) -> class_declaration f i cl_decl
-    | EArrow ((k, p, b, pc), _) ->
+    | EArrow ((k, p, b, pc), consise, _) ->
         if Prec.(l > AssignementExpression)
         then (
           PP.start_group f 1;
@@ -461,15 +461,15 @@ struct
             PP.string f ")=>";
             PP.end_group f);
         PP.end_group f;
-        (match b with
-        | [ (Return_statement (Some e), loc) ] ->
+        (match b, consise with
+        | [ (Return_statement (Some e), loc) ], true ->
             (* Should not starts with '{' *)
             PP.start_group f 1;
             PP.break1 f;
             output_debug_info f loc;
             parenthesized_expression ~obj:true AssignementExpression f e;
             PP.end_group f
-        | l ->
+        | l, _ ->
             let b =
               match l with
               | [ (Block l, _) ] -> l
diff --git a/compiler/lib/js_parser.mly b/compiler/lib/js_parser.mly
index 3f95883748..be6500232a 100644
--- a/compiler/lib/js_parser.mly
+++ b/compiler/lib/js_parser.mly
@@ -1034,20 +1034,25 @@ encaps:
 (* TODO conflict with as then in indent_keyword_bis *)
 arrow_function:
   | i=ident T_ARROW b=arrow_body
-    { EArrow (({async = false; generator = false}, list [param' i],b, p $symbolstartpos), AUnknown) }
+    { let b,consise = b in
+      EArrow (({async = false; generator = false}, list [param' i],b, p $symbolstartpos), consise, AUnknown) }
   | T_LPAREN_ARROW a=formal_parameter_list_opt ")" T_ARROW b=arrow_body
-    { EArrow (({async = false; generator = false}, a,b, p $symbolstartpos), AUnknown) }
+    { let b,consise = b in
+      EArrow (({async = false; generator = false}, a,b, p $symbolstartpos), consise, AUnknown) }
 
 async_arrow_function:
-  | T_ASYNC i=ident T_ARROW b=arrow_body { EArrow(({async = true; generator = false}, list [param' i],b, p $symbolstartpos), AUnknown) }
+  | T_ASYNC i=ident T_ARROW b=arrow_body {
+      let b,consise = b in
+      EArrow(({async = true; generator = false}, list [param' i],b, p $symbolstartpos), consise, AUnknown) }
   | T_ASYNC T_LPAREN_ARROW a=formal_parameter_list_opt ")" T_ARROW b=arrow_body
-    { EArrow (({async = true; generator = false}, a,b, p $symbolstartpos), AUnknown) }
+    { let b,consise = b in
+      EArrow (({async = true; generator = false}, a,b, p $symbolstartpos), consise, AUnknown) }
 
 
 (* was called consise body in spec *)
 arrow_body:
- | "{" b=function_body "}" { b }
- | e=assignment_expr_for_consise_body { [(Return_statement (Some e), p $symbolstartpos)] }
+ | "{" b=function_body "}" { b, false }
+ | e=assignment_expr_for_consise_body { [(Return_statement (Some e), p $symbolstartpos)], true }
 
 (*----------------------------*)
 (* no in                    *)
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index e747f3aa73..96b0985565 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -270,7 +270,7 @@ class map : mapper =
           let idopt = Option.map ~f:m#ident idopt in
           EFun (idopt, m#fun_decl fun_decl)
       | EClass (id, cl_decl) -> EClass (Option.map ~f:m#ident id, m#class_decl cl_decl)
-      | EArrow (fun_decl, x) -> EArrow (m#fun_decl fun_decl, x)
+      | EArrow (fun_decl, consise, x) -> EArrow (m#fun_decl fun_decl, consise, x)
       | EArr l ->
           EArr
             (List.map l ~f:(function
@@ -595,7 +595,7 @@ class iter : iterator =
       | EClass (i, cl_decl) ->
           Option.iter ~f:m#ident i;
           m#class_decl cl_decl
-      | EArrow (fun_decl, _) -> m#fun_decl fun_decl
+      | EArrow (fun_decl, _, _) -> m#fun_decl fun_decl
       | EArr l ->
           List.iter l ~f:(function
               | ElementHole -> ()
@@ -1590,9 +1590,9 @@ let use_fun_context l =
 
        method expression x =
          match x with
-         | EArrow (_, ANo_fun_context) -> ()
-         | EArrow (_, AUse_parent_fun_context) -> raise True
-         | EArrow (fun_decl, AUnknown) -> super#fun_decl fun_decl
+         | EArrow (_, _, ANo_fun_context) -> ()
+         | EArrow (_, _, AUse_parent_fun_context) -> raise True
+         | EArrow (fun_decl, _, AUnknown) -> super#fun_decl fun_decl
          | _ -> super#expression x
     end)
       #statements
@@ -1632,11 +1632,11 @@ class simpl =
       | EFun
           (None, (({ generator = false; async = true | false }, _, body, _) as fun_decl))
         when Config.Flag.es6 () && not (use_fun_context body) ->
-          EArrow (fun_decl, ANo_fun_context)
-      | EArrow (((_, _, body, _) as fun_decl), AUnknown) ->
+          EArrow (fun_decl, false, ANo_fun_context)
+      | EArrow (((_, _, body, _) as fun_decl), consise, AUnknown) ->
           if use_fun_context body
-          then EArrow (fun_decl, AUse_parent_fun_context)
-          else EArrow (fun_decl, ANo_fun_context)
+          then EArrow (fun_decl, consise, AUse_parent_fun_context)
+          else EArrow (fun_decl, consise, ANo_fun_context)
       | e -> e
 
     method statement s =
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index d0b85b737b..4c0d714a1b 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1453,7 +1453,7 @@ let () =
               let name = Printf.sprintf "js_expr_%x" (String.hash str) in
               let* () =
                 register_fragment name (fun () ->
-                    EArrow (J.fun_ [] [ Return_statement (Some e), N ] N, AUnknown))
+                    EArrow (J.fun_ [] [ Return_statement (Some e), N ] N, true, AUnknown))
               in
               let* js_val = JavaScript.invoke_fragment name [] in
               return (W.Call (wrap, [ js_val ]))
@@ -1505,6 +1505,7 @@ let () =
                     , N )
                   ]
                   N
+              , true
               , AUnknown ))
       in
       let l = List.map ~f:transl_prim_arg l in
@@ -1531,6 +1532,7 @@ let () =
                     , N )
                   ]
                   N
+              , true
               , AUnknown ))
       in
       let l = List.map ~f:transl_prim_arg l in
@@ -1562,6 +1564,7 @@ let () =
                         , N )
                       ]
                       N
+                  , true
                   , AUnknown ))
           in
           let o = transl_prim_arg o in
@@ -1591,6 +1594,7 @@ let () =
                     , N )
                   ]
                   N
+              , true
               , AUnknown ))
       in
       let l = List.map ~f:transl_prim_arg l in
@@ -1610,6 +1614,7 @@ let () =
                       [ J.ident o ]
                       [ Return_statement (Some (J.dot (EVar (J.ident o)) prop)), N ]
                       N
+                  , true
                   , AUnknown ))
           in
           JavaScript.invoke_fragment name [ transl_prim_arg x ]
@@ -1636,6 +1641,7 @@ let () =
                         , N )
                       ]
                       N
+                  , true
                   , AUnknown ))
           in
           let l = List.map ~f:transl_prim_arg [ x; y ] in
@@ -1678,6 +1684,7 @@ let () =
                     , N )
                   ]
                   N
+              , true
               , AUnknown ))
       in
       let l = List.map ~f:transl_prim_arg vl in
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index f778f9b564..93aa9d82f1 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -315,7 +315,9 @@ let output_js js =
       | S { name = Utf8 x; _ } -> Var_printer.add_reserved x)
     free;
   let js =
-    if Config.Flag.shortvar () then (new Js_traverse.rename_variable ~esm:false)#program js else js
+    if Config.Flag.shortvar ()
+    then (new Js_traverse.rename_variable ~esm:false)#program js
+    else js
   in
   let js = (new Js_traverse.simpl)#program js in
   let js = (new Js_traverse.clean)#program js in
@@ -400,6 +402,7 @@ let build_runtime_arguments
                          , N )
                        ]
                        N
+                   , false
                    , AUnknown ) ))
              missing_primitives) )
       :: generated_js
@@ -434,6 +437,7 @@ let build_runtime_arguments
                ; Return_statement (Some (obj generated_js)), N
                ]
                N
+           , true
            , AUnknown ))
         [ EVar (Javascript.ident Constant.global_object_) ]
         N
diff --git a/compiler/tests-compiler/es6.ml b/compiler/tests-compiler/es6.ml
index f6c57fcfd4..da1a23a05d 100644
--- a/compiler/tests-compiler/es6.ml
+++ b/compiler/tests-compiler/es6.ml
@@ -18,7 +18,7 @@ let f x =
        "use strict";
        var
         runtime = globalThis.jsoo_runtime,
-        f = x=>{var g = y=>(x + y | 0) + 7 | 0; return g;},
+        f = x=>{var g = y=>{return (x + y | 0) + 7 | 0;}; return g;},
         Test = [0, f];
        runtime.caml_register_global(0, Test, "Test");
        return;})
diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml
index 6ee6908049..7606abf2da 100644
--- a/compiler/tests-compiler/util/util.ml
+++ b/compiler/tests-compiler/util/util.ml
@@ -465,7 +465,7 @@ class find_function_declaration r n =
           List.iter l ~f:(function
               | DeclIdent
                   ( (S { name = Utf8 name; _ } as id)
-                  , Some ((EFun (_, fun_decl) | EArrow (fun_decl, _)), _) ) -> (
+                  , Some ((EFun (_, fun_decl) | EArrow (fun_decl, _, _)), _) ) -> (
                   let fd = id, fun_decl in
                   match n with
                   | None -> r := fd :: !r

From d2b703a91b8003ecca699538df228771ad9b0f73 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 7 Dec 2023 10:54:28 +0100
Subject: [PATCH 307/481] Compiler: js-parser: fix assignment target

---
 compiler/lib/javascript.ml                   | 76 ++++++++++----------
 compiler/lib/javascript.mli                  | 20 +++++-
 compiler/lib/js_output.ml                    | 55 +++++++++++++-
 compiler/lib/js_parser.mly                   | 30 ++++----
 compiler/lib/js_traverse.ml                  | 47 +++++++++++-
 compiler/tests-compiler/js_parser_printer.ml | 46 +++++++-----
 6 files changed, 194 insertions(+), 80 deletions(-)

diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index 7825a535fe..633d96a86b 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -272,7 +272,7 @@ and property_name =
 and expression =
   | ESeq of expression * expression
   | ECond of expression * expression * expression
-  | EAssignTarget of binding_pattern
+  | EAssignTarget of assignment_target
   | EBin of binop * expression * expression
   | EUn of unop * expression
   | ECall of expression * access_kind * arguments * location
@@ -414,6 +414,22 @@ and binding_pattern =
   | ObjectBinding of (binding_property, binding_ident) list_with_rest
   | ArrayBinding of (binding_element option, binding) list_with_rest
 
+and object_target_elt =
+  | TargetPropertyId of ident * initialiser option
+  | TargetProperty of property_name * expression
+  | TargetPropertySpread of expression
+  | TargetPropertyMethod of property_name * method_
+
+and array_target_elt =
+  | TargetElementId of ident * initialiser option
+  | TargetElementHole
+  | TargetElement of expression
+  | TargetElementSpread of expression
+
+and assignment_target =
+  | ObjectTarget of object_target_elt list
+  | ArrayTarget of array_target_elt list
+
 and binding_ident = ident
 
 and binding_property =
@@ -557,51 +573,33 @@ let fun_ params body loc =
   , body
   , loc )
 
-let rec assignment_pattern_of_expr x =
+let rec assignment_target_of_expr' x =
   match x with
   | EObj l ->
-      let rest, l =
-        match List.rev l with
-        | PropertySpread (EVar x) :: l -> Some x, List.rev l
-        | _ -> None, l
-      in
       let list =
         List.map l ~f:(function
-            | Property (PNI (Utf8 i), EVar (S { name = Utf8 i2; loc = N; _ } as ident))
-              when String.equal i i2 -> Prop_ident (ident, None)
-            | Property (n, e) -> Prop_binding (n, binding_element_of_expression e)
-            | CoverInitializedName (_, i, e) -> Prop_ident (i, Some e)
-            | _ -> raise Not_found)
+            | Property (PNI n, EVar (S { name = n'; _ } as id))
+              when Utf8_string.equal n n' -> TargetPropertyId (id, None)
+            | Property (n, e) -> TargetProperty (n, assignment_target_of_expr' e)
+            | CoverInitializedName (_, i, (e, loc)) ->
+                TargetPropertyId (i, Some (assignment_target_of_expr' e, loc))
+            | PropertySpread e -> TargetPropertySpread (assignment_target_of_expr' e)
+            | PropertyMethod (n, m) -> TargetPropertyMethod (n, m))
       in
-      ObjectBinding { list; rest }
+      EAssignTarget (ObjectTarget list)
   | EArr l ->
-      let rest, l =
-        match List.rev l with
-        | ElementSpread e :: l -> Some (binding_of_expression e), List.rev l
-        | _ -> None, l
-      in
       let list =
         List.map l ~f:(function
-            | ElementHole -> None
-            | Element e -> Some (binding_element_of_expression e)
-            | ElementSpread _ -> raise Not_found)
+            | ElementHole -> TargetElementHole
+            | Element (EVar x) -> TargetElementId (x, None)
+            | Element (EBin (Eq, EVar x, rhs)) -> TargetElementId (x, Some (rhs, N))
+            | Element e -> TargetElement (assignment_target_of_expr' e)
+            | ElementSpread e -> TargetElementSpread (assignment_target_of_expr' e))
       in
-      ArrayBinding { list; rest }
-  | _ -> raise Not_found
-
-and binding_element_of_expression e =
-  match e with
-  | EBin (Eq, e1, e2) -> binding_of_expression e1, Some (e2, N)
-  | e -> binding_of_expression e, None
-
-and binding_of_expression e =
-  match e with
-  | EVar x -> BindingIdent x
-  | EObj _ as x -> BindingPattern (assignment_pattern_of_expr x)
-  | EArr _ as x -> BindingPattern (assignment_pattern_of_expr x)
-  | _ -> raise Not_found
-
-let assignment_pattern_of_expr op x =
+      EAssignTarget (ArrayTarget list)
+  | _ -> x
+
+and assignment_target_of_expr op x =
   match op with
-  | None | Some Eq -> ( try Some (assignment_pattern_of_expr x) with Not_found -> None)
-  | _ -> None
+  | None | Some Eq -> assignment_target_of_expr' x
+  | _ -> x
diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli
index 2910aca877..10716a427d 100644
--- a/compiler/lib/javascript.mli
+++ b/compiler/lib/javascript.mli
@@ -185,7 +185,7 @@ and property_name =
 and expression =
   | ESeq of expression * expression
   | ECond of expression * expression * expression
-  | EAssignTarget of binding_pattern
+  | EAssignTarget of assignment_target
   (* EAssignTarget is used on the LHS of assignment and in for-loops.
      for({name} in o);
      for([fst] in o);
@@ -334,6 +334,22 @@ and binding_pattern =
   | ObjectBinding of (binding_property, binding_ident) list_with_rest
   | ArrayBinding of (binding_element option, binding) list_with_rest
 
+and object_target_elt =
+  | TargetPropertyId of ident * initialiser option
+  | TargetProperty of property_name * expression
+  | TargetPropertySpread of expression
+  | TargetPropertyMethod of property_name * method_
+
+and array_target_elt =
+  | TargetElementId of ident * initialiser option
+  | TargetElementHole
+  | TargetElement of expression
+  | TargetElementSpread of expression
+
+and assignment_target =
+  | ObjectTarget of object_target_elt list
+  | ArrayTarget of array_target_elt list
+
 and binding_ident = ident
 
 and binding_property =
@@ -424,4 +440,4 @@ val early_error : ?reason:string -> Parse_info.t -> early_error
 
 val fun_ : ident list -> statement_list -> location -> function_declaration
 
-val assignment_pattern_of_expr : binop option -> expression -> binding_pattern option
+val assignment_target_of_expr : binop option -> expression -> expression
diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index fb1646080c..d1b3e32670 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -303,8 +303,8 @@ struct
       | ESeq (e, _) -> Prec.(l <= Expression) && traverse Expression e
       | ECond (e, _, _) ->
           Prec.(l <= ConditionalExpression) && traverse ShortCircuitExpression e
-      | EAssignTarget (ObjectBinding _) -> obj
-      | EAssignTarget (ArrayBinding _) -> false
+      | EAssignTarget (ObjectTarget _) -> obj
+      | EAssignTarget (ArrayTarget _) -> false
       | EBin (op, e, _) ->
           let out, lft, _rght = op_prec op in
           Prec.(l <= out) && traverse lft e
@@ -690,7 +690,56 @@ struct
         if Prec.(l > out) then PP.string f ")";
         PP.end_group f;
         PP.end_group f
-    | EAssignTarget p -> pattern f p
+    | EAssignTarget t -> (
+        let property f p =
+          match p with
+          | TargetPropertyId (id, None) -> ident f id
+          | TargetPropertyId (id, Some (e, _)) ->
+              ident f id;
+              PP.space f;
+              PP.string f "=";
+              PP.space f;
+              expression AssignementExpression f e
+          | TargetProperty (pn, e) ->
+              PP.start_group f 0;
+              property_name f pn;
+              PP.string f ":";
+              PP.space f;
+              expression AssignementExpression f e;
+              PP.end_group f
+          | TargetPropertySpread e ->
+              PP.string f "...";
+              expression AssignementExpression f e
+          | TargetPropertyMethod (n, m) -> method_ f property_name n m
+        in
+        let element f p =
+          match p with
+          | TargetElementHole -> ()
+          | TargetElementId (id, None) -> ident f id
+          | TargetElementId (id, Some (e, _)) ->
+              ident f id;
+              PP.space f;
+              PP.string f "=";
+              PP.space f;
+              expression AssignementExpression f e
+          | TargetElement e -> expression AssignementExpression f e
+          | TargetElementSpread e ->
+              PP.string f "...";
+              expression AssignementExpression f e
+        in
+        match t with
+        | ObjectTarget list ->
+            PP.start_group f 1;
+            PP.string f "{";
+            comma_list f property list;
+            PP.string f "}";
+            PP.end_group f
+        | ArrayTarget list ->
+            PP.start_group f 1;
+            PP.string f "[";
+            comma_list f element list;
+            PP.string f "]";
+            PP.end_group f)
     | EArr el ->
         PP.start_group f 1;
         PP.string f "[";
diff --git a/compiler/lib/js_parser.mly b/compiler/lib/js_parser.mly
index be6500232a..8c31449a4d 100644
--- a/compiler/lib/js_parser.mly
+++ b/compiler/lib/js_parser.mly
@@ -673,16 +673,14 @@ iteration_stmt:
    { For_statement (Right l, c, incr, st) }
 
  | T_FOR "(" left=left_hand_side_expr T_IN right=expr ")" body=stmt
-   { match assignment_pattern_of_expr None left with
-      | None -> ForIn_statement (Left left, right, body)
-      | Some b -> ForIn_statement (Left (EAssignTarget b), right, body) }
+   { let left = assignment_target_of_expr None left in
+     ForIn_statement (Left left, right, body) }
  | T_FOR "(" left=for_single_variable_decl T_IN right=expr ")" body=stmt
    { ForIn_statement (Right left, right, body) }
 
  | T_FOR "(" left=left_hand_side_expr T_OF right=assignment_expr ")" body=stmt
-    { match assignment_pattern_of_expr None left with
-      | None -> ForOf_statement (Left left, right, body)
-      | Some b -> ForOf_statement (Left (EAssignTarget b), right, body) }
+    { let left = assignment_target_of_expr None left in
+      ForOf_statement (Left left, right, body) }
  | T_FOR "(" left=for_single_variable_decl T_OF right=assignment_expr ")" body=stmt
    { ForOf_statement (Right left, right, body) }
 
@@ -751,9 +749,8 @@ assignment_expr:
  | conditional_expr(d1) { $1 }
  | e1=left_hand_side_expr_(d1) op=assignment_operator e2=assignment_expr
     {
-      match assignment_pattern_of_expr (Some op) e1 with
-        | None -> EBin (op, e1, e2)
-        | Some pat -> EBin (op, EAssignTarget pat, e2)
+      let e1 = assignment_target_of_expr (Some op) e1 in
+      EBin (op, e1, e2)
     }
  | arrow_function { $1 }
  | async_arrow_function { $1 }
@@ -1066,9 +1063,8 @@ assignment_expr_no_in:
  | conditional_expr_no_in { $1 }
  | e1=left_hand_side_expr_(d1) op=assignment_operator e2=assignment_expr_no_in
     {
-      match assignment_pattern_of_expr (Some op) e1 with
-        | None -> EBin (op, e1, e2)
-        | Some pat -> EBin (op, EAssignTarget pat, e2)
+      let e1 = assignment_target_of_expr (Some op) e1 in
+      EBin (op, e1, e2)
     }
 
 conditional_expr_no_in:
@@ -1109,9 +1105,8 @@ assignment_expr_no_stmt:
  | conditional_expr(primary_no_stmt) { $1 }
  | e1=left_hand_side_expr_(primary_no_stmt) op=assignment_operator e2=assignment_expr
     {
-      match assignment_pattern_of_expr (Some op) e1 with
-      | None -> EBin (op, e1, e2)
-      | Some pat -> EBin (op, EAssignTarget pat, e2)
+      let e1 = assignment_target_of_expr (Some op) e1 in
+      EBin (op, e1, e2)
     }
  (* es6: *)
  | arrow_function { $1 }
@@ -1134,9 +1129,8 @@ assignment_expr_for_consise_body:
  | conditional_expr(primary_for_consise_body) { $1 }
  | e1=left_hand_side_expr_(primary_for_consise_body) op=assignment_operator e2=assignment_expr
     {
-      match assignment_pattern_of_expr (Some op) e1 with
-      | None -> EBin (op, e1, e2)
-      | Some pat -> EBin (op, EAssignTarget pat, e2)
+      let e1 = assignment_target_of_expr (Some op) e1 in
+      EBin (op, e1, e2)
     }
  (* es6: *)
  | arrow_function { $1 }
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index 96b0985565..34fddd54e4 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -255,7 +255,29 @@ class map : mapper =
       | ESeq (e1, e2) -> ESeq (m#expression e1, m#expression e2)
       | ECond (e1, e2, e3) -> ECond (m#expression e1, m#expression e2, m#expression e3)
       | EBin (b, e1, e2) -> EBin (b, m#expression e1, m#expression e2)
-      | EAssignTarget p -> EAssignTarget (m#binding_pattern p)
+      | EAssignTarget x -> (
+          match x with
+          | ArrayTarget l ->
+              EAssignTarget
+                (ArrayTarget
+                   (List.map l ~f:(function
+                       | TargetElementHole -> TargetElementHole
+                       | TargetElementId (i, e) ->
+                           TargetElementId (m#ident i, m#initialiser_o e)
+                       | TargetElement e -> TargetElement (m#expression e)
+                       | TargetElementSpread e -> TargetElementSpread (m#expression e))))
+          | ObjectTarget l ->
+              EAssignTarget
+                (ObjectTarget
+                   (List.map l ~f:(function
+                       | TargetPropertyId (i, e) ->
+                           TargetPropertyId (m#ident i, m#initialiser_o e)
+                       | TargetProperty (i, e) ->
+                           TargetProperty (m#property_name i, m#expression e)
+                       | TargetPropertyMethod (n, x) ->
+                           TargetPropertyMethod (m#property_name n, m#method_ x)
+                       | TargetPropertySpread e -> TargetPropertySpread (m#expression e))))
+          )
       | EUn (b, e1) -> EUn (b, m#expression e1)
       | ECallTemplate (e1, t, loc) ->
           ECallTemplate (m#expression e1, m#template t, m#loc loc)
@@ -570,7 +592,28 @@ class iter : iterator =
       | EBin (_, e1, e2) ->
           m#expression e1;
           m#expression e2
-      | EAssignTarget p -> m#binding_pattern p
+      | EAssignTarget x -> (
+          match x with
+          | ArrayTarget l ->
+              List.iter l ~f:(function
+                  | TargetElementHole -> ()
+                  | TargetElementId (i, e) ->
+                      m#ident i;
+                      m#initialiser_o e
+                  | TargetElement e -> m#expression e
+                  | TargetElementSpread e -> m#expression e)
+          | ObjectTarget l ->
+              List.iter l ~f:(function
+                  | TargetPropertyId (i, e) ->
+                      m#ident i;
+                      m#initialiser_o e
+                  | TargetProperty (i, e) ->
+                      m#property_name i;
+                      m#expression e
+                  | TargetPropertyMethod (n, x) ->
+                      m#property_name n;
+                      m#method_ x
+                  | TargetPropertySpread e -> m#expression e))
       | EUn (_, e1) -> m#expression e1
       | ECall (e1, _ak, e2, _) ->
           m#expression e1;
diff --git a/compiler/tests-compiler/js_parser_printer.ml b/compiler/tests-compiler/js_parser_printer.ml
index e3e01d3419..d049b811a1 100644
--- a/compiler/tests-compiler/js_parser_printer.ml
+++ b/compiler/tests-compiler/js_parser_printer.ml
@@ -416,22 +416,20 @@ let%expect_test "assignment pattern" =
 
   [%expect
     {|
-     /*<<fake:2:4>>*/ var x, y, rest;
-     /*<<fake:3:4>>*/  /*<<fake:3:14>>*/ var [x, y] = [1, 2];
-     /*<<fake:4:4>>*/  /*<<fake:4:22>>*/ var [x, y, ...rest] = [1, 2, ...o];
-     /*<<fake:6:4>>*/  /*<<fake:6:14>>*/ var {x: x, y: y} = {x: 1, y: 2};
-     /*<<fake:7:4>>*/  /*<<fake:7:22>>*/ var
-     {x: x, y: y, ...rest} = {x: 1, y: 2, ...o};
-     /*<<fake:9:4>>*/ [x, y] = [1, 2];
-     /*<<fake:10:4>>*/ [x, y, ...rest] = [1, 2];
-     /*<<fake:12:4>>*/ ({x, y} = {x: 1, y: 2});
-     /*<<fake:13:4>>*/ ({x, y, ...rest} = {x: 1, y: 2});
-     /*<<fake:15:4>>*/ for
-    ([a, b, {c, d =  /*<<fake:15:17>>*/ e, [f]: [g, h, a, i, j]}] in 3)
-      /*<<fake:15:43>>*/ ;
-     /*<<fake:17:4>>*/ for
-    ([a, b, {c, d =  /*<<fake:17:17>>*/ e, [f]: [g, h, a, i, j]}] of 3)
-      /*<<fake:17:43>>*/ ; |}]
+    /*<<fake:2:4>>*/ var x, y, rest;
+    /*<<fake:3:4>>*/  /*<<fake:3:14>>*/ var [x, y] = [1, 2];
+    /*<<fake:4:4>>*/  /*<<fake:4:22>>*/ var [x, y, ...rest] = [1, 2, ...o];
+    /*<<fake:6:4>>*/  /*<<fake:6:14>>*/ var {x: x, y: y} = {x: 1, y: 2};
+    /*<<fake:7:4>>*/  /*<<fake:7:22>>*/ var
+    {x: x, y: y, ...rest} = {x: 1, y: 2, ...o};
+    /*<<fake:9:4>>*/ [x, y] = [1, 2];
+    /*<<fake:10:4>>*/ [x, y, ...rest] = [1, 2];
+    /*<<fake:12:4>>*/ ({x, y} = {x: 1, y: 2});
+    /*<<fake:13:4>>*/ ({x, y, ...rest} = {x: 1, y: 2});
+    /*<<fake:15:4>>*/ for([a, b, {c, d = e, [f]: [g, h, a, i, j]}] in 3)
+     /*<<fake:15:43>>*/ ;
+    /*<<fake:17:4>>*/ for([a, b, {c, d = e, [f]: [g, h, a, i, j]}] of 3)
+     /*<<fake:17:43>>*/ ; |}]
 
 let%expect_test "string template" =
   (* GH#1017 *)
@@ -630,6 +628,22 @@ var e = new (class f {})
     {|
     var e = new f; var e = new f(); var e = new class f{}; var e = new class f{}; |}]
 
+let%expect_test "assignment targets" =
+  print
+    ~debuginfo:false
+    ~compact:false
+    ~report:true
+    {|
+ [a,b,c, {a,b}] = [];
+ [[[x = 5]], {a,b}, ...rest] = [];
+ ({a: [a,b] = f(), b = 3, ...rest} = {});
+|};
+  [%expect
+    {|
+    [a, b, c, {a, b}] = [];
+    [[[x = 5]], {a, b}, ...rest] = [];
+    ({a: [a, b] = f(), b = 3, ...rest} = {}); |}]
+
 let%expect_test "error reporting" =
   (try
      print ~invalid:true ~compact:false {|

From ba117eefa2d6bbed9e22fced55ce530dbe235520 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 11 Sep 2023 15:11:28 +0200
Subject: [PATCH 308/481] Compiler: Make it possible to link runtime JavaScript
 file together with OCaml libraries

Use: js_of_ocaml --toplevel --no-runtime runtime.js library.cma
---
 compiler/bin-js_of_ocaml/compile.ml | 30 ++++++++++++--
 compiler/lib/driver.ml              | 64 ++++++++++++++++++++++++-----
 compiler/lib/linker.ml              | 24 ++++++++---
 compiler/lib/linker.mli             |  9 +++-
 compiler/lib/unit_info.ml           |  9 ++++
 compiler/lib/unit_info.mli          |  2 +
 toplevel/examples/lwt_toplevel/dune |  7 +++-
 7 files changed, 122 insertions(+), 23 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 926f393774..8ecc8fbbd7 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -120,7 +120,7 @@ let run
         Some (Hashtbl.fold (fun cmi () acc -> cmi :: acc) t [])
   in
   let runtime_files =
-    if toplevel || dynlink
+    if (not no_runtime) && (toplevel || dynlink)
     then
       let add_if_absent x l = if List.mem x ~set:l then l else x :: l in
       runtime_files |> add_if_absent "+toplevel.js" |> add_if_absent "+dynlink.js"
@@ -247,9 +247,22 @@ let run
     Pretty_print.string fmt (Unit_info.to_string uinfo);
     output code ~source_map ~standalone ~linkall:false output_file
   in
+  let output_runtime ~standalone ~source_map ((_, fmt) as output_file) =
+    assert (not standalone);
+    let uinfo = Unit_info.of_primitives (Linker.list_all () |> StringSet.elements) in
+    Pretty_print.string fmt "\n";
+    Pretty_print.string fmt (Unit_info.to_string uinfo);
+    let code =
+      { Parse_bytecode.code = Code.empty
+      ; cmis = StringSet.empty
+      ; debug = Parse_bytecode.Debug.create ~include_cmis:false false
+      }
+    in
+    output code ~source_map ~standalone ~linkall:true output_file
+  in
   (if runtime_only
    then (
-     let prims = Primitive.get_external () |> StringSet.elements in
+     let prims = Linker.list_all () |> StringSet.elements in
      assert (List.length prims > 0);
      let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`JavaScript in
      let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in
@@ -331,6 +344,7 @@ let run
              cmo
              ic
          in
+         let linkall = linkall || toplevel || dynlink in
          if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
          output_gen
            ~standalone:false
@@ -338,7 +352,13 @@ let run
            ~build_info:(Build_info.create `Cmo)
            ~source_map
            output_file
-           (output_partial cmo code)
+           (fun ~standalone ~source_map output ->
+             let source_map =
+               if linkall
+               then output_runtime ~standalone ~source_map output
+               else source_map
+             in
+             output_partial cmo code ~standalone ~source_map output)
      | `Cma cma when keep_unit_names ->
          List.iter cma.lib_units ~f:(fun cmo ->
              let output_file =
@@ -376,7 +396,11 @@ let run
                (`Name output_file)
                (output_partial cmo code))
      | `Cma cma ->
+         let linkall = linkall || toplevel || dynlink in
          let f ~standalone ~source_map output =
+           let source_map =
+             if linkall then output_runtime ~standalone ~source_map output else source_map
+           in
            List.fold_left cma.lib_units ~init:source_map ~f:(fun source_map cmo ->
                let t1 = Timer.make () in
                let code =
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 889ef36237..89e6c1d19f 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -276,7 +276,7 @@ let gen_missing js missing =
 let mark_start_of_generated_code = Debug.find ~even_if_quiet:true "mark-runtime-gen"
 
 let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output =
-  if not standalone
+  if not (linkall || standalone)
   then { runtime_code = js; always_required_codes = [] }
   else
     let t = Timer.make () in
@@ -313,7 +313,7 @@ let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output =
     let all_external = StringSet.union prim prov in
     let used = StringSet.inter free all_external in
     let linkinfos = Linker.init () in
-    let linkinfos, missing = Linker.resolve_deps ~linkall linkinfos used in
+    let linkinfos, missing = Linker.resolve_deps ~standalone ~linkall linkinfos used in
     (* gen_missing may use caml_failwith *)
     let linkinfos, missing =
       if (not (StringSet.is_empty missing)) && Config.Flag.genprim ()
@@ -336,18 +336,60 @@ let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output =
               let name = Utf8_string.of_string_exn name in
               Property (PNI name, EVar (ident name)))
         in
-        ( Expression_statement
-            (EBin
-               ( Eq
-               , dot
-                   (EVar (ident Constant.global_object_))
-                   (Utf8_string.of_string_exn "jsoo_runtime")
-               , EObj all ))
-        , N )
+        (if standalone
+         then
+           ( Expression_statement
+               (EBin
+                  ( Eq
+                  , dot
+                      (EVar (ident Constant.global_object_))
+                      (Utf8_string.of_string_exn "jsoo_runtime")
+                  , EObj all ))
+           , N )
+         else
+           ( Expression_statement
+               (call
+                  (dot
+                     (EVar (ident (Utf8_string.of_string_exn "Object")))
+                     (Utf8_string.of_string_exn "assign"))
+                  [ dot
+                      (EVar (ident Constant.global_object_))
+                      (Utf8_string.of_string_exn "jsoo_runtime")
+                  ; EObj all
+                  ]
+                  N)
+           , N ))
         :: js
       else js
     in
-    Linker.link js linkinfos
+    let missing = Linker.missing linkinfos in
+    let output = Linker.link ~standalone js linkinfos in
+    if not (List.is_empty missing)
+    then
+      { output with
+        runtime_code =
+          (let open Javascript in
+           ( Variable_statement
+               ( Var
+               , [ DeclPattern
+                     ( ObjectBinding
+                         { list =
+                             List.map
+                               ~f:(fun name ->
+                                 let name = Utf8_string.of_string_exn name in
+                                 Prop_ident (ident name, None))
+                               missing
+                         ; rest = None
+                         }
+                     , ( dot
+                           (EVar (ident Constant.global_object_))
+                           (Utf8_string.of_string_exn "jsoo_runtime")
+                       , N ) )
+                 ] )
+           , N )
+           :: output.runtime_code)
+      }
+    else output
 
 let check_js js =
   let t = Timer.make () in
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index 76808e78f9..76ff4972d1 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -393,6 +393,7 @@ type state =
   { ids : IntSet.t
   ; always_required_codes : always_required list
   ; codes : (Javascript.program pack * bool) list
+  ; missing : StringSet.t
   }
 
 type output =
@@ -596,10 +597,9 @@ let load_files ?(ignore_always_annotation = false) ~target_env l =
 
 (* resolve *)
 let rec resolve_dep_name_rev visited path nm =
-  let x =
-    try Hashtbl.find provided nm with Not_found -> error "missing dependency '%s'@." nm
-  in
-  resolve_dep_id_rev visited path x.id
+  match Hashtbl.find provided nm with
+  | x -> resolve_dep_id_rev visited path x.id
+  | exception Not_found -> { visited with missing = StringSet.add nm visited.missing }
 
 and resolve_dep_id_rev visited path id =
   if IntSet.mem id visited.ids
@@ -630,9 +630,17 @@ let init () =
   { ids = IntSet.empty
   ; always_required_codes = List.rev_map !always_included ~f:proj_always_required
   ; codes = []
+  ; missing = StringSet.empty
   }
 
-let resolve_deps ?(linkall = false) visited_rev used =
+let list_all () =
+  Hashtbl.fold (fun nm _ set -> StringSet.add nm set) provided StringSet.empty
+
+let check_missing state =
+  if not (StringSet.is_empty state.missing)
+  then error "missing dependency '%s'@." (StringSet.choose state.missing)
+
+let resolve_deps ?(standalone = true) ?(linkall = false) visited_rev used =
   (* link the special files *)
   let missing, visited_rev =
     if linkall
@@ -657,9 +665,10 @@ let resolve_deps ?(linkall = false) visited_rev used =
         used
         (StringSet.empty, visited_rev)
   in
+  if standalone then check_missing visited_rev;
   visited_rev, missing
 
-let link program (state : state) =
+let link ?(standalone = true) program (state : state) =
   let always, always_required =
     List.partition
       ~f:(function
@@ -676,6 +685,7 @@ let link program (state : state) =
         in
         { state with codes = (Ok always.program, false) :: state.codes })
   in
+  if standalone then check_missing state;
   let codes =
     List.map state.codes ~f:(fun (x, has_macro) ->
         let c = unpack x in
@@ -698,6 +708,8 @@ let all state =
     state.ids
     []
 
+let missing state = StringSet.elements state.missing
+
 let origin ~name =
   try
     let x = Hashtbl.find provided name in
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index cc13208dfa..9577a99ff9 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -61,14 +61,19 @@ type output =
   ; always_required_codes : always_required list
   }
 
+val list_all : unit -> StringSet.t
+
 val init : unit -> state
 
-val resolve_deps : ?linkall:bool -> state -> StringSet.t -> state * StringSet.t
+val resolve_deps :
+  ?standalone:bool -> ?linkall:bool -> state -> StringSet.t -> state * StringSet.t
 
-val link : Javascript.program -> state -> output
+val link : ?standalone:bool -> Javascript.program -> state -> output
 
 val get_provided : unit -> StringSet.t
 
 val all : state -> string list
 
+val missing : state -> string list
+
 val origin : name:string -> string option
diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml
index e99acd6d6c..6daa29e73a 100644
--- a/compiler/lib/unit_info.ml
+++ b/compiler/lib/unit_info.ml
@@ -37,6 +37,15 @@ let empty =
   ; effects_without_cps = false
   }
 
+let of_primitives l =
+  { provides = StringSet.empty
+  ; requires = StringSet.empty
+  ; primitives = l
+  ; crcs = StringMap.empty
+  ; force_link = true
+  ; effects_without_cps = false
+  }
+
 let of_cmo (cmo : Cmo_format.compilation_unit) =
   let open Ocaml_compiler in
   let provides = StringSet.singleton (Cmo_format.name cmo) in
diff --git a/compiler/lib/unit_info.mli b/compiler/lib/unit_info.mli
index 8e93e0e5af..cd0895fa9d 100644
--- a/compiler/lib/unit_info.mli
+++ b/compiler/lib/unit_info.mli
@@ -30,6 +30,8 @@ type t =
 
 val of_cmo : Cmo_format.compilation_unit -> t
 
+val of_primitives : string list -> t
+
 val union : t -> t -> t
 
 val empty : t
diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune
index 775b7b0c2f..81ca33c231 100644
--- a/toplevel/examples/lwt_toplevel/dune
+++ b/toplevel/examples/lwt_toplevel/dune
@@ -71,7 +71,12 @@
 (rule
  (targets test_dynlink.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --toplevel %{dep:test_dynlink.cmo})))
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --toplevel
+   %{read-strings:effects_flags.txt}
+   %{dep:test_dynlink.cmo})))
 
 (rule
  (targets export.txt)

From fa2742af1e7d93441ce563390c541e0d191fb2cb Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Sat, 27 Apr 2024 09:39:11 +0200
Subject: [PATCH 309/481] Compiler: small refactoring

---
 compiler/lib/driver.ml | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 89e6c1d19f..fa537fff18 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -275,8 +275,9 @@ let gen_missing js missing =
 
 let mark_start_of_generated_code = Debug.find ~even_if_quiet:true "mark-runtime-gen"
 
-let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output =
-  if not (linkall || standalone)
+let link ~export_runtime ~standalone ~linkall (js : Javascript.statement_list) :
+    Linker.output =
+  if (not export_runtime) && not standalone
   then { runtime_code = js; always_required_codes = [] }
   else
     let t = Timer.make () in
@@ -313,21 +314,21 @@ let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output =
     let all_external = StringSet.union prim prov in
     let used = StringSet.inter free all_external in
     let linkinfos = Linker.init () in
-    let linkinfos, missing = Linker.resolve_deps ~standalone ~linkall linkinfos used in
-    (* gen_missing may use caml_failwith *)
-    let linkinfos, missing =
+    let linkinfos, js =
+      let linkinfos, missing = Linker.resolve_deps ~standalone ~linkall linkinfos used in
+      (* gen_missing may use caml_failwith *)
       if (not (StringSet.is_empty missing)) && Config.Flag.genprim ()
       then
         let linkinfos, missing2 =
           Linker.resolve_deps linkinfos (StringSet.singleton "caml_failwith")
         in
-        linkinfos, StringSet.union missing missing2
-      else linkinfos, missing
+        let missing = StringSet.union missing missing2 in
+        linkinfos, gen_missing js missing
+      else linkinfos, js
     in
-    let js = if Config.Flag.genprim () then gen_missing js missing else js in
     if times () then Format.eprintf "  linking: %a@." Timer.print t;
     let js =
-      if linkall
+      if export_runtime
       then
         let open Javascript in
         let all = Linker.all linkinfos in
@@ -628,8 +629,9 @@ let target_flag (type a) (t : a target) =
   | Wasm -> `Wasm
 
 let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(linkall = false) p =
+  let export_runtime = linkall in
   p
-  |> link ~standalone ~linkall
+  |> link ~export_runtime ~standalone ~linkall
   |> pack ~wrap_with_fun ~standalone
   |> coloring
   |> check_js

From 4f541b992351afeeb76359c51946dd88ad9c7747 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 29 Apr 2024 14:53:44 +0200
Subject: [PATCH 310/481] Compiler: refactoring

---
 compiler/bin-js_of_ocaml/check_runtime.ml |  2 +-
 compiler/lib-runtime-files/gen/gen.ml     |  4 +--
 compiler/lib/driver.ml                    | 43 +++++++++++++----------
 compiler/lib/linker.ml                    | 41 +++++++--------------
 compiler/lib/linker.mli                   |  5 +--
 compiler/lib/wasm/wa_binaryen.ml          |  2 +-
 6 files changed, 41 insertions(+), 56 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/check_runtime.ml b/compiler/bin-js_of_ocaml/check_runtime.ml
index 41b9495b6b..14bca57e0a 100644
--- a/compiler/bin-js_of_ocaml/check_runtime.ml
+++ b/compiler/bin-js_of_ocaml/check_runtime.ml
@@ -88,7 +88,7 @@ let f (runtime_files, bytecode, target_env) =
       needed
   in
   let needed = StringSet.of_list (List.map ~f:fst needed) in
-  let from_runtime1 = Linker.get_provided () in
+  let from_runtime1 = Linker.list_all () in
   let from_runtime2 = Primitive.get_external () in
   (* [from_runtime2] is a superset of [from_runtime1].
      Extra primitives are registered on the ocaml side (e.g. generate.ml) *)
diff --git a/compiler/lib-runtime-files/gen/gen.ml b/compiler/lib-runtime-files/gen/gen.ml
index 0acc8b2821..3f01473575 100644
--- a/compiler/lib-runtime-files/gen/gen.ml
+++ b/compiler/lib-runtime-files/gen/gen.ml
@@ -65,9 +65,9 @@ let () =
               List.iter fragments ~f:(fun (filename, frags) ->
                   Js_of_ocaml_compiler.Linker.load_fragments ~target_env ~filename frags);
               let linkinfos = Js_of_ocaml_compiler.Linker.init () in
-              let prov = Js_of_ocaml_compiler.Linker.get_provided () in
+              let prov = Js_of_ocaml_compiler.Linker.list_all () in
               let _linkinfos, missing =
-                Js_of_ocaml_compiler.Linker.resolve_deps ~linkall:true linkinfos prov
+                Js_of_ocaml_compiler.Linker.resolve_deps linkinfos prov
               in
               Js_of_ocaml_compiler.Linker.check_deps ();
               assert (StringSet.is_empty missing)));
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index fa537fff18..e82d72283b 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -295,27 +295,32 @@ let link ~export_runtime ~standalone ~linkall (js : Javascript.statement_list) :
         :: js
       else js
     in
-    let free = traverse#get_free in
-    let free : StringSet.t =
-      Javascript.IdentSet.fold
-        (fun x acc ->
-          match x with
-          | V _ ->
-              (* This is an error. We don't complain here as we want
-                 to be able to name other variable to make it
-                 easier to spot the problematic ones *)
-              acc
-          | S { name = Utf8 x; _ } -> StringSet.add x acc)
-        free
-        StringSet.empty
+    let used =
+      let all_provided = Linker.list_all () in
+      if linkall
+      then all_provided
+      else
+        let free = traverse#get_free in
+        let free : StringSet.t =
+          Javascript.IdentSet.fold
+            (fun x acc ->
+              match x with
+              | V _ ->
+                  (* This is an error. We don't complain here as we want
+                     to be able to name other variable to make it
+                     easier to spot the problematic ones *)
+                  acc
+              | S { name = Utf8 x; _ } -> StringSet.add x acc)
+            free
+            StringSet.empty
+        in
+        let prim = Primitive.get_external () in
+        let all_external = StringSet.union prim all_provided in
+        StringSet.inter free all_external
     in
-    let prim = Primitive.get_external () in
-    let prov = Linker.get_provided () in
-    let all_external = StringSet.union prim prov in
-    let used = StringSet.inter free all_external in
     let linkinfos = Linker.init () in
     let linkinfos, js =
-      let linkinfos, missing = Linker.resolve_deps ~standalone ~linkall linkinfos used in
+      let linkinfos, missing = Linker.resolve_deps ~standalone linkinfos used in
       (* gen_missing may use caml_failwith *)
       if (not (StringSet.is_empty missing)) && Config.Flag.genprim ()
       then
@@ -408,7 +413,7 @@ let check_js js =
       StringSet.empty
   in
   let prim = Primitive.get_external () in
-  let prov = Linker.get_provided () in
+  let prov = Linker.list_all () in
   let all_external = StringSet.union prim prov in
   let missing = StringSet.inter free all_external in
   let missing = StringSet.diff missing Reserved.provided in
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index 76ff4972d1..5ed9b53e90 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -424,6 +424,9 @@ let reset () =
   Primitive.reset ();
   Generate.init ()
 
+let list_all () =
+  Hashtbl.fold (fun nm _ set -> StringSet.add nm set) provided StringSet.empty
+
 let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.t) =
   match f with
   | Always_include code ->
@@ -539,11 +542,8 @@ let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.
               StringSet.iter (fun alias -> Primitive.alias alias name) aliases;
               `Ok)
 
-let get_provided () =
-  Hashtbl.fold (fun k _ acc -> StringSet.add k acc) provided StringSet.empty
-
 let check_deps () =
-  let provided = get_provided () in
+  let provided = list_all () in
   Hashtbl.iter
     (fun id (code, _has_macro, requires) ->
       match code with
@@ -633,37 +633,20 @@ let init () =
   ; missing = StringSet.empty
   }
 
-let list_all () =
-  Hashtbl.fold (fun nm _ set -> StringSet.add nm set) provided StringSet.empty
-
 let check_missing state =
   if not (StringSet.is_empty state.missing)
   then error "missing dependency '%s'@." (StringSet.choose state.missing)
 
-let resolve_deps ?(standalone = true) ?(linkall = false) visited_rev used =
+let resolve_deps ?(standalone = true) visited_rev used =
   (* link the special files *)
   let missing, visited_rev =
-    if linkall
-    then
-      (* link all primitives *)
-      let prog, set =
-        Hashtbl.fold
-          (fun nm _ (visited, set) ->
-            resolve_dep_name_rev visited [] nm, StringSet.add nm set)
-          provided
-          (visited_rev, StringSet.empty)
-      in
-      let missing = StringSet.diff used set in
-      missing, prog
-    else
-      (* link used primitives *)
-      StringSet.fold
-        (fun nm (missing, visited) ->
-          if Hashtbl.mem provided nm
-          then missing, resolve_dep_name_rev visited [] nm
-          else StringSet.add nm missing, visited)
-        used
-        (StringSet.empty, visited_rev)
+    StringSet.fold
+      (fun nm (missing, visited) ->
+        if Hashtbl.mem provided nm
+        then missing, resolve_dep_name_rev visited [] nm
+        else StringSet.add nm missing, visited)
+      used
+      (StringSet.empty, visited_rev)
   in
   if standalone then check_missing visited_rev;
   visited_rev, missing
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index 9577a99ff9..f0822054a6 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -65,13 +65,10 @@ val list_all : unit -> StringSet.t
 
 val init : unit -> state
 
-val resolve_deps :
-  ?standalone:bool -> ?linkall:bool -> state -> StringSet.t -> state * StringSet.t
+val resolve_deps : ?standalone:bool -> state -> StringSet.t -> state * StringSet.t
 
 val link : ?standalone:bool -> Javascript.program -> state -> output
 
-val get_provided : unit -> StringSet.t
-
 val all : state -> string list
 
 val missing : state -> string list
diff --git a/compiler/lib/wasm/wa_binaryen.ml b/compiler/lib/wasm/wa_binaryen.ml
index 551c3a11bc..d7335f2725 100644
--- a/compiler/lib/wasm/wa_binaryen.ml
+++ b/compiler/lib/wasm/wa_binaryen.ml
@@ -96,7 +96,7 @@ let dead_code_elimination
   @@ fun deps_file ->
   Fs.with_intermediate_file (Filename.temp_file "usage" ".txt")
   @@ fun usage_file ->
-  let primitives = Linker.get_provided () in
+  let primitives = Linker.list_all () in
   Fs.write_file ~name:deps_file ~contents:(generate_dependencies ~dependencies primitives);
   command
     ("wasm-metadce"

From 3694f146912e38a0c2d6197c1defaed9c01c7a6e Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Sat, 20 Apr 2024 15:09:42 +0200
Subject: [PATCH 311/481] Compiler: remove deprecated cmdline runtime-only flag

---
 compiler/bin-js_of_ocaml/cmd_arg.ml | 24 +++++-------------------
 1 file changed, 5 insertions(+), 19 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml
index 2077da2674..38c6609678 100644
--- a/compiler/bin-js_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-js_of_ocaml/cmd_arg.ml
@@ -122,13 +122,6 @@ let options =
     let doc = "Do not include the standard runtime." in
     Arg.(value & flag & info [ "noruntime"; "no-runtime" ] ~doc)
   in
-  let runtime_only =
-    let doc =
-      "[DEPRECATED: use js_of_ocaml build-runtime instead]. Generate a JavaScript file \
-       containing/exporting the runtime only."
-    in
-    Arg.(value & flag & info [ "runtime-only" ] ~doc)
-  in
   let no_sourcemap =
     let doc =
       "Don't generate source map. All other source map related flags will be be ignored."
@@ -270,7 +263,6 @@ let options =
       no_cmis
       profile
       no_runtime
-      runtime_only
       no_sourcemap
       sourcemap
       sourcemap_inline_in_js
@@ -283,16 +275,11 @@ let options =
       keep_unit_names =
     let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in
     let runtime_files = js_files in
-    let runtime_files =
-      if runtime_only && Filename.check_suffix input_file ".js"
-      then runtime_files @ [ input_file ]
-      else runtime_files
-    in
-    let fs_external = fs_external || (toplevel && no_cmis) || runtime_only in
+    let fs_external = fs_external || (toplevel && no_cmis) in
     let input_file =
-      match input_file, runtime_only with
-      | "-", _ | _, true -> None
-      | x, false -> Some x
+      match input_file with
+      | "-" -> None
+      | x -> Some x
     in
     let output_file =
       match output_file with
@@ -351,7 +338,7 @@ let options =
       ; include_dirs
       ; runtime_files
       ; no_runtime
-      ; runtime_only
+      ; runtime_only = false
       ; fs_files
       ; fs_output
       ; fs_external
@@ -380,7 +367,6 @@ let options =
       $ no_cmis
       $ profile
       $ noruntime
-      $ runtime_only
       $ no_sourcemap
       $ sourcemap
       $ sourcemap_inline_in_js

From efbe91a576b377b111c002922e6400d023fe8bcb Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 29 Apr 2024 15:02:28 +0200
Subject: [PATCH 312/481] Compiler: refactoring

---
 compiler/lib/driver.ml  | 10 +++++++---
 compiler/lib/linker.ml  | 10 +++++-----
 compiler/lib/linker.mli |  4 ++--
 3 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index e82d72283b..63d53aa07f 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -280,6 +280,7 @@ let link ~export_runtime ~standalone ~linkall (js : Javascript.statement_list) :
   if (not export_runtime) && not standalone
   then { runtime_code = js; always_required_codes = [] }
   else
+    let check_missing = standalone in
     let t = Timer.make () in
     if times () then Format.eprintf "Start Linking...@.";
     let traverse = new Js_traverse.free in
@@ -320,12 +321,15 @@ let link ~export_runtime ~standalone ~linkall (js : Javascript.statement_list) :
     in
     let linkinfos = Linker.init () in
     let linkinfos, js =
-      let linkinfos, missing = Linker.resolve_deps ~standalone linkinfos used in
+      let linkinfos, missing = Linker.resolve_deps ~check_missing linkinfos used in
       (* gen_missing may use caml_failwith *)
       if (not (StringSet.is_empty missing)) && Config.Flag.genprim ()
       then
         let linkinfos, missing2 =
-          Linker.resolve_deps linkinfos (StringSet.singleton "caml_failwith")
+          Linker.resolve_deps
+            ~check_missing
+            linkinfos
+            (StringSet.singleton "caml_failwith")
         in
         let missing = StringSet.union missing missing2 in
         linkinfos, gen_missing js missing
@@ -369,7 +373,7 @@ let link ~export_runtime ~standalone ~linkall (js : Javascript.statement_list) :
       else js
     in
     let missing = Linker.missing linkinfos in
-    let output = Linker.link ~standalone js linkinfos in
+    let output = Linker.link ~check_missing js linkinfos in
     if not (List.is_empty missing)
     then
       { output with
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index 5ed9b53e90..eb76f9b709 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -633,11 +633,11 @@ let init () =
   ; missing = StringSet.empty
   }
 
-let check_missing state =
+let do_check_missing state =
   if not (StringSet.is_empty state.missing)
   then error "missing dependency '%s'@." (StringSet.choose state.missing)
 
-let resolve_deps ?(standalone = true) visited_rev used =
+let resolve_deps ?(check_missing = true) visited_rev used =
   (* link the special files *)
   let missing, visited_rev =
     StringSet.fold
@@ -648,10 +648,10 @@ let resolve_deps ?(standalone = true) visited_rev used =
       used
       (StringSet.empty, visited_rev)
   in
-  if standalone then check_missing visited_rev;
+  if check_missing then do_check_missing visited_rev;
   visited_rev, missing
 
-let link ?(standalone = true) program (state : state) =
+let link ?(check_missing = true) program (state : state) =
   let always, always_required =
     List.partition
       ~f:(function
@@ -668,7 +668,7 @@ let link ?(standalone = true) program (state : state) =
         in
         { state with codes = (Ok always.program, false) :: state.codes })
   in
-  if standalone then check_missing state;
+  if check_missing then do_check_missing state;
   let codes =
     List.map state.codes ~f:(fun (x, has_macro) ->
         let c = unpack x in
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index f0822054a6..1f87653973 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -65,9 +65,9 @@ val list_all : unit -> StringSet.t
 
 val init : unit -> state
 
-val resolve_deps : ?standalone:bool -> state -> StringSet.t -> state * StringSet.t
+val resolve_deps : ?check_missing:bool -> state -> StringSet.t -> state * StringSet.t
 
-val link : ?standalone:bool -> Javascript.program -> state -> output
+val link : ?check_missing:bool -> Javascript.program -> state -> output
 
 val all : state -> string list
 

From 0c714443a7fca09ff18f228b78d86e87b722bf64 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Fri, 3 May 2024 13:15:44 +0200
Subject: [PATCH 313/481] Compiler: new include-partial-runtime flag

---
 compiler/bin-js_of_ocaml/build_fs.ml  |  1 +
 compiler/bin-js_of_ocaml/cmd_arg.ml   | 11 ++++
 compiler/bin-js_of_ocaml/cmd_arg.mli  |  1 +
 compiler/bin-js_of_ocaml/compile.ml   | 77 +++++++++++++++++------
 compiler/bin-wasm_of_ocaml/compile.ml | 12 +++-
 compiler/lib/driver.ml                | 88 ++++++++++++++-------------
 compiler/lib/driver.mli               |  6 +-
 compiler/lib/link_js.ml               |  2 +-
 compiler/lib/linker.ml                | 71 ++++++++++++++-------
 compiler/lib/linker.mli               |  4 +-
 toplevel/bin/jsoo_mkcmis.ml           |  1 +
 11 files changed, 182 insertions(+), 92 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml
index 1b5931aefb..84ed7fb55d 100644
--- a/compiler/bin-js_of_ocaml/build_fs.ml
+++ b/compiler/bin-js_of_ocaml/build_fs.ml
@@ -78,6 +78,7 @@ function jsoo_create_file_extern(name,content){
           ~target:(JavaScript pfs_fmt)
           ~standalone:true
           ~wrap_with_fun:`Iife
+          ~link:`Needed
           (Parse_bytecode.Debug.create ~include_cmis:false false)
           code
       in
diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml
index 38c6609678..e8083a221c 100644
--- a/compiler/bin-js_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-js_of_ocaml/cmd_arg.ml
@@ -46,6 +46,7 @@ type t =
   ; source_map : (string option * Source_map.t) option
   ; runtime_files : string list
   ; no_runtime : bool
+  ; include_partial_runtime : bool
   ; runtime_only : bool
   ; output_file : [ `Name of string | `Stdout ] * bool
   ; input_file : string option
@@ -122,6 +123,12 @@ let options =
     let doc = "Do not include the standard runtime." in
     Arg.(value & flag & info [ "noruntime"; "no-runtime" ] ~doc)
   in
+  let include_partial_runtime =
+    let doc =
+      "Include (partial) runtime when compiling cmo and cma files to JavaScript."
+    in
+    Arg.(value & flag & info [ "include-partial-runtime" ] ~doc)
+  in
   let no_sourcemap =
     let doc =
       "Don't generate source map. All other source map related flags will be be ignored."
@@ -263,6 +270,7 @@ let options =
       no_cmis
       profile
       no_runtime
+      include_partial_runtime
       no_sourcemap
       sourcemap
       sourcemap_inline_in_js
@@ -338,6 +346,7 @@ let options =
       ; include_dirs
       ; runtime_files
       ; no_runtime
+      ; include_partial_runtime
       ; runtime_only = false
       ; fs_files
       ; fs_output
@@ -367,6 +376,7 @@ let options =
       $ no_cmis
       $ profile
       $ noruntime
+      $ include_partial_runtime
       $ no_sourcemap
       $ sourcemap
       $ sourcemap_inline_in_js
@@ -576,6 +586,7 @@ let options_runtime_only =
       ; include_dirs
       ; runtime_files
       ; no_runtime
+      ; include_partial_runtime = false
       ; runtime_only = true
       ; fs_files
       ; fs_output
diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli
index ee65275ccc..9bd5996a29 100644
--- a/compiler/bin-js_of_ocaml/cmd_arg.mli
+++ b/compiler/bin-js_of_ocaml/cmd_arg.mli
@@ -26,6 +26,7 @@ type t =
   ; source_map : (string option * Source_map.t) option
   ; runtime_files : string list
   ; no_runtime : bool
+  ; include_partial_runtime : bool
   ; runtime_only : bool
   ; output_file : [ `Name of string | `Stdout ] * bool
   ; input_file : string option
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 8ecc8fbbd7..6c16a5f2d6 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -68,7 +68,7 @@ let run
     { Cmd_arg.common
     ; profile
     ; source_map
-    ; runtime_files
+    ; runtime_files = runtime_files_from_cmdline
     ; no_runtime
     ; input_file
     ; output_file
@@ -87,6 +87,7 @@ let run
     ; fs_external
     ; export_file
     ; keep_unit_names
+    ; include_partial_runtime
     } =
   let include_cmis = toplevel && not no_cmis in
   let custom_header = common.Jsoo_cmdline.Arg.custom_header in
@@ -123,8 +124,10 @@ let run
     if (not no_runtime) && (toplevel || dynlink)
     then
       let add_if_absent x l = if List.mem x ~set:l then l else x :: l in
-      runtime_files |> add_if_absent "+toplevel.js" |> add_if_absent "+dynlink.js"
-    else runtime_files
+      runtime_files_from_cmdline
+      |> add_if_absent "+toplevel.js"
+      |> add_if_absent "+dynlink.js"
+    else runtime_files_from_cmdline
   in
   let runtime_files, builtin =
     List.partition_map runtime_files ~f:(fun name ->
@@ -176,7 +179,7 @@ let run
             , noloc )
           ])
   in
-  let output (one : Parse_bytecode.one) ~standalone ~source_map ~linkall output_file =
+  let output (one : Parse_bytecode.one) ~standalone ~source_map ~link output_file =
     check_debug one;
     let init_pseudo_fs = fs_external && standalone in
     let sm =
@@ -194,7 +197,7 @@ let run
             ~target:(JavaScript fmt)
             ~standalone
             ?profile
-            ~linkall
+            ~link
             ~wrap_with_fun
             ?source_map
             one.debug
@@ -218,7 +221,7 @@ let run
               ~target:(JavaScript fmt)
               ~standalone
               ?profile
-              ~linkall
+              ~link
               ~wrap_with_fun
               ?source_map
               one.debug
@@ -229,7 +232,14 @@ let run
                   let instr = fs_instr2 in
                   let code = Code.prepend Code.empty instr in
                   let pfs_fmt = Pretty_print.to_out_channel chan in
-                  Driver.f' ~standalone ?profile ~wrap_with_fun pfs_fmt one.debug code));
+                  Driver.f'
+                    ~standalone
+                    ~link:`Needed
+                    ?profile
+                    ~wrap_with_fun
+                    pfs_fmt
+                    one.debug
+                    code));
           res
     in
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
@@ -245,11 +255,14 @@ let run
     let uinfo = Unit_info.of_cmo cmo in
     Pretty_print.string fmt "\n";
     Pretty_print.string fmt (Unit_info.to_string uinfo);
-    output code ~source_map ~standalone ~linkall:false output_file
+    output code ~source_map ~standalone ~link:`No output_file
   in
-  let output_runtime ~standalone ~source_map ((_, fmt) as output_file) =
+  let output_partial_runtime ~standalone ~source_map ((_, fmt) as output_file) =
     assert (not standalone);
-    let uinfo = Unit_info.of_primitives (Linker.list_all () |> StringSet.elements) in
+    let uinfo =
+      Unit_info.of_primitives
+        (Linker.list_all ~from:runtime_files_from_cmdline () |> StringSet.elements)
+    in
     Pretty_print.string fmt "\n";
     Pretty_print.string fmt (Unit_info.to_string uinfo);
     let code =
@@ -258,7 +271,12 @@ let run
       ; debug = Parse_bytecode.Debug.create ~include_cmis:false false
       }
     in
-    output code ~source_map ~standalone ~linkall:true output_file
+    output
+      code
+      ~source_map
+      ~standalone
+      ~link:(`All_from runtime_files_from_cmdline)
+      output_file
   in
   (if runtime_only
    then (
@@ -281,7 +299,7 @@ let run
        (fun ~standalone ~source_map ((_, fmt) as output_file) ->
          Pretty_print.string fmt "\n";
          Pretty_print.string fmt (Unit_info.to_string uinfo);
-         output code ~source_map ~standalone ~linkall:true output_file))
+         output code ~source_map ~standalone ~link:`All output_file))
    else
      let kind, ic, close_ic, include_dirs =
        match input_file with
@@ -320,7 +338,7 @@ let run
            ~build_info:(Build_info.create `Exe)
            ~source_map
            (fst output_file)
-           (output code ~linkall)
+           (output code ~link:(if linkall then `All else `Needed))
      | `Cmo cmo ->
          let output_file =
            match output_file, keep_unit_names with
@@ -344,7 +362,6 @@ let run
              cmo
              ic
          in
-         let linkall = linkall || toplevel || dynlink in
          if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
          output_gen
            ~standalone:false
@@ -354,12 +371,33 @@ let run
            output_file
            (fun ~standalone ~source_map output ->
              let source_map =
-               if linkall
-               then output_runtime ~standalone ~source_map output
-               else source_map
+               if not include_partial_runtime
+               then source_map
+               else output_partial_runtime ~standalone ~source_map output
              in
              output_partial cmo code ~standalone ~source_map output)
      | `Cma cma when keep_unit_names ->
+         (if include_partial_runtime
+          then
+            let output_file =
+              let gen dir = Filename.concat dir "runtime.js" in
+              match output_file with
+              | `Stdout, false -> gen "./"
+              | `Name x, false -> gen (Filename.dirname x)
+              | `Name x, true
+                when String.length x > 0 && Char.equal x.[String.length x - 1] '/' ->
+                  gen x
+              | `Stdout, true | `Name _, true ->
+                  failwith "use [-o dirname/] or remove [--keep-unit-names]"
+            in
+            output_gen
+              ~standalone:false
+              ~custom_header
+              ~build_info:(Build_info.create `Runtime)
+              ~source_map
+              (`Name output_file)
+              (fun ~standalone ~source_map output ->
+                output_partial_runtime ~standalone ~source_map output));
          List.iter cma.lib_units ~f:(fun cmo ->
              let output_file =
                match output_file with
@@ -396,10 +434,11 @@ let run
                (`Name output_file)
                (output_partial cmo code))
      | `Cma cma ->
-         let linkall = linkall || toplevel || dynlink in
          let f ~standalone ~source_map output =
            let source_map =
-             if linkall then output_runtime ~standalone ~source_map output else source_map
+             if not include_partial_runtime
+             then source_map
+             else output_partial_runtime ~standalone ~source_map output
            in
            List.fold_left cma.lib_units ~init:source_map ~f:(fun source_map cmo ->
                let t1 = Timer.make () in
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index a76ec7df33..cfddd79c62 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -145,7 +145,11 @@ let generate_prelude ~out_file =
   @@ fun ch ->
   let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`Wasm in
   let live_vars, in_cps, p, debug =
-    Driver.f ~target:Wasm (Parse_bytecode.Debug.create ~include_cmis:false false) code
+    Driver.f
+      ~target:Wasm
+      ~link:`Needed
+      (Parse_bytecode.Debug.create ~include_cmis:false false)
+      code
   in
   let context = Wa_generate.start () in
   let _ = Wa_generate.f ~context ~unit_name:(Some "prelude") ~live_vars ~in_cps p in
@@ -180,7 +184,9 @@ let build_js_runtime ~primitives ?runtime_arguments () =
     in
     match
       List.split_last
-      @@ Driver.link_and_pack [ Javascript.Return_statement (Some (EObj l)), N ]
+      @@ Driver.link_and_pack
+           ~link:`Needed
+           [ Javascript.Return_statement (Some (EObj l)), N ]
     with
     | Some x -> x
     | None -> assert false
@@ -279,7 +285,7 @@ let run
     let code = one.code in
     let standalone = Option.is_none unit_name in
     let live_vars, in_cps, p, debug =
-      Driver.f ~target:Wasm ~standalone ?profile one.debug code
+      Driver.f ~target:Wasm ~standalone ?profile ~link:`No one.debug code
     in
     let context = Wa_generate.start () in
     let toplevel_name, generated_js =
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 63d53aa07f..0694e8370d 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -275,7 +275,7 @@ let gen_missing js missing =
 
 let mark_start_of_generated_code = Debug.find ~even_if_quiet:true "mark-runtime-gen"
 
-let link ~export_runtime ~standalone ~linkall (js : Javascript.statement_list) :
+let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) :
     Linker.output =
   if (not export_runtime) && not standalone
   then { runtime_code = js; always_required_codes = [] }
@@ -298,28 +298,37 @@ let link ~export_runtime ~standalone ~linkall (js : Javascript.statement_list) :
     in
     let used =
       let all_provided = Linker.list_all () in
-      if linkall
-      then all_provided
-      else
-        let free = traverse#get_free in
-        let free : StringSet.t =
-          Javascript.IdentSet.fold
-            (fun x acc ->
-              match x with
-              | V _ ->
-                  (* This is an error. We don't complain here as we want
-                     to be able to name other variable to make it
-                     easier to spot the problematic ones *)
-                  acc
-              | S { name = Utf8 x; _ } -> StringSet.add x acc)
-            free
-            StringSet.empty
-        in
-        let prim = Primitive.get_external () in
-        let all_external = StringSet.union prim all_provided in
-        StringSet.inter free all_external
+      match link with
+      | `All -> all_provided
+      | `All_from from -> Linker.list_all ~from ()
+      | `No -> StringSet.empty
+      | `Needed ->
+          let free = traverse#get_free in
+          let free : StringSet.t =
+            Javascript.IdentSet.fold
+              (fun x acc ->
+                match x with
+                | V _ ->
+                    (* This is an error. We don't complain here as we want
+                       to be able to name other variable to make it
+                       easier to spot the problematic ones *)
+                    acc
+                | S { name = Utf8 x; _ } -> StringSet.add x acc)
+              free
+              StringSet.empty
+          in
+          let prim = Primitive.get_external () in
+          let all_external = StringSet.union prim all_provided in
+          StringSet.inter free all_external
+    in
+    let linkinfos =
+      let from =
+        match link with
+        | `All_from l -> Some l
+        | `All | `No | `Needed -> None
+      in
+      Linker.init ?from ()
     in
-    let linkinfos = Linker.init () in
     let linkinfos, js =
       let linkinfos, missing = Linker.resolve_deps ~check_missing linkinfos used in
       (* gen_missing may use caml_failwith *)
@@ -637,10 +646,14 @@ let target_flag (type a) (t : a target) =
   | JavaScript _ -> `JavaScript
   | Wasm -> `Wasm
 
-let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(linkall = false) p =
-  let export_runtime = linkall in
+let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ~link p =
+  let export_runtime =
+    match link with
+    | `All | `All_from _ -> true
+    | `Needed | `No -> false
+  in
   p
-  |> link ~export_runtime ~standalone ~linkall
+  |> link' ~export_runtime ~standalone ~link
   |> pack ~wrap_with_fun ~standalone
   |> coloring
   |> check_js
@@ -651,7 +664,7 @@ let full
     ~standalone
     ~wrap_with_fun
     ~profile
-    ~linkall
+    ~link
     ~source_map
     d
     p : result =
@@ -679,7 +692,7 @@ let full
       let exported_runtime = not standalone in
       let emit formatter =
         generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
-        +> link_and_pack ~standalone ~wrap_with_fun ~linkall
+        +> link_and_pack ~standalone ~wrap_with_fun ~link
         +> output formatter ~source_map ()
       in
       let source_map = emit formatter r in
@@ -688,14 +701,14 @@ let full
       let (p, live_vars), _, in_cps = r in
       live_vars, in_cps, p, d
 
-let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~linkall d p =
+let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p =
   let (_ : Source_map.t option) =
     full
       ~target:(JavaScript formatter)
       ~standalone
       ~wrap_with_fun
       ~profile
-      ~linkall
+      ~link
       ~source_map:None
       d
       p
@@ -707,21 +720,14 @@ let f
     ?(standalone = true)
     ?(wrap_with_fun = `Iife)
     ?(profile = O1)
-    ?(linkall = false)
+    ~link
     ?source_map
     d
     p =
-  full ~target ~standalone ~wrap_with_fun ~profile ~linkall ~source_map d p
+  full ~target ~standalone ~wrap_with_fun ~profile ~link ~source_map d p
 
-let f'
-    ?(standalone = true)
-    ?(wrap_with_fun = `Iife)
-    ?(profile = O1)
-    ?(linkall = false)
-    formatter
-    d
-    p =
-  full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~linkall d p
+let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link formatter d p =
+  full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p
 
 let from_string ~prims ~debug s formatter =
   let p, d = Parse_bytecode.from_string ~prims ~debug s in
@@ -730,7 +736,7 @@ let from_string ~prims ~debug s formatter =
     ~standalone:false
     ~wrap_with_fun:`Anonymous
     ~profile:O1
-    ~linkall:false
+    ~link:`No
     d
     p
 
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 58c3c19c0e..8e8d0c97e4 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -31,7 +31,7 @@ val f :
   -> ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
   -> ?profile:profile
-  -> ?linkall:bool
+  -> link:[ `All | `All_from of string list | `Needed | `No ]
   -> ?source_map:Source_map.t
   -> Parse_bytecode.Debug.t
   -> Code.program
@@ -41,7 +41,7 @@ val f' :
      ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
   -> ?profile:profile
-  -> ?linkall:bool
+  -> link:[ `All | `All_from of string list | `Needed | `No ]
   -> Pretty_print.t
   -> Parse_bytecode.Debug.t
   -> Code.program
@@ -57,7 +57,7 @@ val from_string :
 val link_and_pack :
      ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
-  -> ?linkall:bool
+  -> link:[ `All | `All_from of string list | `Needed | `No ]
   -> Javascript.statement_list
   -> Javascript.statement_list
 
diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml
index 65418e2df8..23932e75fe 100644
--- a/compiler/lib/link_js.ml
+++ b/compiler/lib/link_js.ml
@@ -424,7 +424,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
           Driver.configure fmt;
           Driver.f'
             ~standalone:false
-            ~linkall:false
+            ~link:`No
             ~wrap_with_fun:`Iife
             fmt
             (Parse_bytecode.Debug.create ~include_cmis:false false)
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index eb76f9b709..d0a610d904 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -394,6 +394,7 @@ type state =
   ; always_required_codes : always_required list
   ; codes : (Javascript.program pack * bool) list
   ; missing : StringSet.t
+  ; include_ : string -> bool
   }
 
 type output =
@@ -404,6 +405,7 @@ type output =
 type provided =
   { id : int
   ; pi : Parse_info.t
+  ; filename : string
   ; weakdef : bool
   ; target_env : Target_env.t
   }
@@ -424,8 +426,16 @@ let reset () =
   Primitive.reset ();
   Generate.init ()
 
-let list_all () =
-  Hashtbl.fold (fun nm _ set -> StringSet.add nm set) provided StringSet.empty
+let list_all ?from () =
+  let include_ =
+    match from with
+    | None -> fun _ _ -> true
+    | Some l -> fun fn _nm -> List.mem fn ~set:l
+  in
+  Hashtbl.fold
+    (fun nm p set -> if include_ p.filename nm then StringSet.add nm set else set)
+    provided
+    StringSet.empty
 
 let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.t) =
   match f with
@@ -536,7 +546,10 @@ let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.
               let id = Hashtbl.length provided in
               Primitive.register name kind ka arity;
               StringSet.iter Primitive.register_named_value named_values;
-              Hashtbl.add provided name { id; pi; weakdef; target_env = fragment_target };
+              Hashtbl.add
+                provided
+                name
+                { id; pi; filename; weakdef; target_env = fragment_target };
               Hashtbl.add provided_rev id (name, pi);
               Hashtbl.add code_pieces id (code, has_macro, requires);
               StringSet.iter (fun alias -> Primitive.alias alias name) aliases;
@@ -596,13 +609,16 @@ let load_files ?(ignore_always_annotation = false) ~target_env l =
   check_deps ()
 
 (* resolve *)
-let rec resolve_dep_name_rev visited path nm =
+let rec resolve_dep_name_rev state path nm =
   match Hashtbl.find provided nm with
-  | x -> resolve_dep_id_rev visited path x.id
-  | exception Not_found -> { visited with missing = StringSet.add nm visited.missing }
-
-and resolve_dep_id_rev visited path id =
-  if IntSet.mem id visited.ids
+  | x ->
+      if state.include_ x.filename
+      then resolve_dep_id_rev state path x.id
+      else { state with missing = StringSet.add nm state.missing }
+  | exception Not_found -> { state with missing = StringSet.add nm state.missing }
+
+and resolve_dep_id_rev state path id =
+  if IntSet.mem id state.ids
   then (
     if List.memq id ~set:path
     then
@@ -611,25 +627,34 @@ and resolve_dep_id_rev visited path id =
         (String.concat
            ~sep:", "
            (List.map path ~f:(fun id -> fst (Hashtbl.find provided_rev id))));
-    visited)
+    state)
   else
     let path = id :: path in
     let code, has_macro, req = Hashtbl.find code_pieces id in
-    let visited = { visited with ids = IntSet.add id visited.ids } in
-    let visited =
-      List.fold_left req ~init:visited ~f:(fun visited nm ->
-          resolve_dep_name_rev visited path nm)
+    let state = { state with ids = IntSet.add id state.ids } in
+    let state =
+      List.fold_left req ~init:state ~f:(fun state nm ->
+          resolve_dep_name_rev state path nm)
     in
-    let visited = { visited with codes = (code, has_macro) :: visited.codes } in
-    visited
+    let state = { state with codes = (code, has_macro) :: state.codes } in
+    state
 
 let proj_always_required { ar_filename; ar_requires; ar_program } =
   { filename = ar_filename; requires = ar_requires; program = unpack ar_program }
 
-let init () =
+let init ?from () =
+  let include_ =
+    match from with
+    | None -> fun _ -> true
+    | Some l -> fun fn -> List.mem fn ~set:l
+  in
   { ids = IntSet.empty
-  ; always_required_codes = List.rev_map !always_included ~f:proj_always_required
+  ; always_required_codes =
+      List.rev
+        (List.filter_map !always_included ~f:(fun x ->
+             if include_ x.ar_filename then Some (proj_always_required x) else None))
   ; codes = []
+  ; include_
   ; missing = StringSet.empty
   }
 
@@ -637,19 +662,19 @@ let do_check_missing state =
   if not (StringSet.is_empty state.missing)
   then error "missing dependency '%s'@." (StringSet.choose state.missing)
 
-let resolve_deps ?(check_missing = true) visited_rev used =
+let resolve_deps ?(check_missing = true) state used =
   (* link the special files *)
-  let missing, visited_rev =
+  let missing, state =
     StringSet.fold
       (fun nm (missing, visited) ->
         if Hashtbl.mem provided nm
         then missing, resolve_dep_name_rev visited [] nm
         else StringSet.add nm missing, visited)
       used
-      (StringSet.empty, visited_rev)
+      (StringSet.empty, state)
   in
-  if check_missing then do_check_missing visited_rev;
-  visited_rev, missing
+  if check_missing then do_check_missing state;
+  state, missing
 
 let link ?(check_missing = true) program (state : state) =
   let always, always_required =
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index 1f87653973..246b959403 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -61,9 +61,9 @@ type output =
   ; always_required_codes : always_required list
   }
 
-val list_all : unit -> StringSet.t
+val list_all : ?from:string list -> unit -> StringSet.t
 
-val init : unit -> state
+val init : ?from:string list -> unit -> state
 
 val resolve_deps : ?check_missing:bool -> state -> StringSet.t -> state * StringSet.t
 
diff --git a/toplevel/bin/jsoo_mkcmis.ml b/toplevel/bin/jsoo_mkcmis.ml
index f87133cf6d..0c64fb785d 100644
--- a/toplevel/bin/jsoo_mkcmis.ml
+++ b/toplevel/bin/jsoo_mkcmis.ml
@@ -96,5 +96,6 @@ let () =
   Js_of_ocaml_compiler.Config.Flag.enable "pretty";
   Js_of_ocaml_compiler.Driver.f'
     pfs_fmt
+    ~link:`Needed
     (Js_of_ocaml_compiler.Parse_bytecode.Debug.create ~include_cmis:false false)
     program

From b4be1132223c9a2c2a06eab365453374a7cbd550 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 22 Feb 2024 00:13:37 +0100
Subject: [PATCH 314/481] Tests: add test for compact option

---
 compiler/tests-compiler/compact.ml    | 53 +++++++++++++++++++++++++++
 compiler/tests-compiler/dune.inc      | 15 ++++++++
 compiler/tests-compiler/util/util.ml  | 28 +++++++-------
 compiler/tests-compiler/util/util.mli |  3 ++
 4 files changed, 84 insertions(+), 15 deletions(-)
 create mode 100644 compiler/tests-compiler/compact.ml

diff --git a/compiler/tests-compiler/compact.ml b/compiler/tests-compiler/compact.ml
new file mode 100644
index 0000000000..151db3f39b
--- /dev/null
+++ b/compiler/tests-compiler/compact.ml
@@ -0,0 +1,53 @@
+(* Js_of_ocaml tests
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2024 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+(* Testing renaming for backward edges with the default [--enable compact] *)
+
+let%expect_test _ =
+  let prog =
+    {|
+let rec f x y z =
+  match x,y,z with
+  | 0, 0, 0 -> true
+  | _       -> f (x + z) (y - z) (z + x + y)
+
+|}
+  in
+  let program = Util.compile_and_parse ~pretty:false prog in
+  Util.print_program program;
+  [%expect
+    {|
+    (function(a){
+       "use strict";
+       var b = a.jsoo_runtime;
+       b.caml_register_global
+        (0,
+         [0,
+          function(a, b, c){
+           var f = a, e = b, d = c;
+           for(;;){
+            if(0 === f && 0 === e && 0 === d) return 1;
+            var g = (d + f | 0) + e | 0, f = f + d | 0, e = e - d | 0, d = g;
+           }
+          }],
+         "Test");
+       return;
+      }
+      (globalThis));
+    //end |}]
diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index a049c39a1a..5ab5836bf0 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -44,6 +44,21 @@
  (preprocess
   (pps ppx_expect)))
 
+(library
+ ;; compiler/tests-compiler/compact.ml
+ (name compact_15)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (modules compact)
+ (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
+ (inline_tests
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (deps
+   (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
+   (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
+ (flags (:standard -open Jsoo_compiler_expect_tests_helper))
+ (preprocess
+  (pps ppx_expect)))
+
 (library
  ;; compiler/tests-compiler/cond.ml
  (name cond_15)
diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml
index 7606abf2da..8f6e4330f6 100644
--- a/compiler/tests-compiler/util/util.ml
+++ b/compiler/tests-compiler/util/util.ml
@@ -505,6 +505,7 @@ let compile_and_run_bytecode ?unix s =
 
 let compile_and_run
     ?debug
+    ?pretty
     ?(skip_modern = false)
     ?(flags = [])
     ?effects
@@ -520,6 +521,7 @@ let compile_and_run
       in
       let output_without_stdlib_modern =
         compile_bc_to_javascript
+          ?pretty
           ~flags
           ?effects
           ?use_js_string
@@ -546,33 +548,29 @@ let compile_and_run
           print_string output_with_stdlib_modern;
           print_endline "==========================================="))
 
-let compile_and_parse_whole_program ?(debug = true) ?flags ?effects ?use_js_string ?unix s
-    =
+let compile_and_parse_whole_program
+    ?(debug = true)
+    ?pretty
+    ?flags
+    ?effects
+    ?use_js_string
+    ?unix
+    s =
   with_temp_dir ~f:(fun () ->
       s
       |> Filetype.ocaml_text_of_string
       |> Filetype.write_ocaml ~name:"test.ml"
       |> compile_ocaml_to_bc ?unix ~debug
-      |> compile_bc_to_javascript
-           ?flags
-           ?effects
-           ?use_js_string
-           ~pretty:true
-           ~sourcemap:debug
+      |> compile_bc_to_javascript ?pretty ?flags ?effects ?use_js_string ~sourcemap:debug
       |> parse_js)
 
-let compile_and_parse ?(debug = true) ?flags ?effects ?use_js_string s =
+let compile_and_parse ?(debug = true) ?pretty ?flags ?effects ?use_js_string s =
   with_temp_dir ~f:(fun () ->
       s
       |> Filetype.ocaml_text_of_string
       |> Filetype.write_ocaml ~name:"test.ml"
       |> compile_ocaml_to_cmo ~debug
-      |> compile_cmo_to_javascript
-           ?flags
-           ?effects
-           ?use_js_string
-           ~pretty:true
-           ~sourcemap:debug
+      |> compile_cmo_to_javascript ?pretty ?flags ?effects ?use_js_string ~sourcemap:debug
       |> parse_js)
 
 let normalize_path s =
diff --git a/compiler/tests-compiler/util/util.mli b/compiler/tests-compiler/util/util.mli
index 5cdf488398..a7f5de2c72 100644
--- a/compiler/tests-compiler/util/util.mli
+++ b/compiler/tests-compiler/util/util.mli
@@ -73,6 +73,7 @@ val print_fun_decl : Javascript.program -> string option -> unit
 
 val compile_and_run :
      ?debug:bool
+  -> ?pretty:bool
   -> ?skip_modern:bool
   -> ?flags:string list
   -> ?effects:bool
@@ -85,6 +86,7 @@ val compile_and_run_bytecode : ?unix:bool -> string -> unit
 
 val compile_and_parse :
      ?debug:bool
+  -> ?pretty:bool
   -> ?flags:string list
   -> ?effects:bool
   -> ?use_js_string:bool
@@ -93,6 +95,7 @@ val compile_and_parse :
 
 val compile_and_parse_whole_program :
      ?debug:bool
+  -> ?pretty:bool
   -> ?flags:string list
   -> ?effects:bool
   -> ?use_js_string:bool

From 7eee7ed4cb52786973c8ee55114fcd0aecb6a02b Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Fri, 8 Mar 2024 16:29:43 +0100
Subject: [PATCH 315/481] Compiler: use consise body in arrow when es6 is
 enabled

---
 compiler/lib/js_traverse.ml    |  7 ++++++-
 compiler/tests-compiler/es6.ml | 15 +++++++++++++--
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index 34fddd54e4..fdf6316162 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -1675,7 +1675,12 @@ class simpl =
       | EFun
           (None, (({ generator = false; async = true | false }, _, body, _) as fun_decl))
         when Config.Flag.es6 () && not (use_fun_context body) ->
-          EArrow (fun_decl, false, ANo_fun_context)
+          let consise =
+            match body with
+            | [ (Return_statement _, _) ] -> true
+            | _ -> false
+          in
+          EArrow (fun_decl, consise, ANo_fun_context)
       | EArrow (((_, _, body, _) as fun_decl), consise, AUnknown) ->
           if use_fun_context body
           then EArrow (fun_decl, consise, AUse_parent_fun_context)
diff --git a/compiler/tests-compiler/es6.ml b/compiler/tests-compiler/es6.ml
index da1a23a05d..9b64c1d5de 100644
--- a/compiler/tests-compiler/es6.ml
+++ b/compiler/tests-compiler/es6.ml
@@ -10,7 +10,7 @@ let f x =
     |}
   in
   let flags = [ "--enable"; "es6" ] in
-  let program = Util.compile_and_parse ~effects:false ~flags prog in
+  let program = Util.compile_and_parse ~effects:false ~pretty:true ~flags prog in
   Util.print_program program;
   [%expect
     {|
@@ -18,9 +18,20 @@ let f x =
        "use strict";
        var
         runtime = globalThis.jsoo_runtime,
-        f = x=>{var g = y=>{return (x + y | 0) + 7 | 0;}; return g;},
+        f = x=>{var g = y=>(x + y | 0) + 7 | 0; return g;},
         Test = [0, f];
        runtime.caml_register_global(0, Test, "Test");
        return;})
      (globalThis);
+    //end |}];
+  let program = Util.compile_and_parse ~effects:false ~pretty:false ~flags prog in
+  Util.print_program program;
+  [%expect
+    {|
+    (a=>{
+       "use strict";
+       var b = a.jsoo_runtime;
+       b.caml_register_global(0, [0, b=>a=>(b + a | 0) + 7 | 0], "Test");
+       return;})
+     (globalThis);
     //end |}]

From 7721b1656d1f2361b61c169fb816b95371f223f8 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 13 May 2024 23:14:11 +0200
Subject: [PATCH 316/481] Misc: disable some test on older ocaml

---
 compiler/tests-toplevel/dune | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune
index be8e3b3041..ba04748190 100644
--- a/compiler/tests-toplevel/dune
+++ b/compiler/tests-toplevel/dune
@@ -20,11 +20,12 @@
 
 (rule
  (target test_toplevel.referencejs)
+ (deps test_toplevel.js)
  (enabled_if
   (and
    (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
- (deps test_toplevel.js)
+   (<> %{profile} wasm-effects)
+   (>= %{ocaml_version} 5.2)))
  (action
   (with-stdout-to
    %{target}
@@ -35,7 +36,8 @@
  (enabled_if
   (and
    (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+   (<> %{profile} wasm-effects)
+   (>= %{ocaml_version} 5.2)))
  (deps test_toplevel.reference test_toplevel.referencejs)
  (action
   (diff test_toplevel.reference test_toplevel.referencejs)))

From 1c17c1e4e1b3b644dc4c7bc923fe771320302eb1 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Thu, 4 Jul 2024 17:08:42 +0200
Subject: [PATCH 317/481] Rename `cps_calls` into `trampolined_calls` for
 clarity

---
 compiler/lib/driver.ml    |  9 +++++---
 compiler/lib/effects.ml   | 16 ++++++-------
 compiler/lib/effects.mli  |  4 ++--
 compiler/lib/generate.ml  | 47 ++++++++++++++++++++-------------------
 compiler/lib/generate.mli |  2 +-
 5 files changed, 41 insertions(+), 37 deletions(-)

diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 7c0ed54ff6..a64e088e96 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -95,7 +95,10 @@ let effects p =
   then (
     if debug () then Format.eprintf "Effects...@.";
     p |> Deadcode.f +> Effects.f +> map_fst Lambda_lifting.f)
-  else p, (Code.Var.Set.empty : Effects.cps_calls), (Code.Var.Set.empty : Effects.in_cps)
+  else
+    ( p
+    , (Code.Var.Set.empty : Effects.trampolined_calls)
+    , (Code.Var.Set.empty : Effects.in_cps) )
 
 let exact_calls profile p =
   if not (Config.Flag.effects ())
@@ -179,14 +182,14 @@ let generate
     ~exported_runtime
     ~wrap_with_fun
     ~warn_on_unhandled_effect
-    ((p, live_vars), cps_calls, _) =
+    ((p, live_vars), trampolined_calls, _) =
   if times () then Format.eprintf "Start Generation...@.";
   let should_export = should_export wrap_with_fun in
   Generate.f
     p
     ~exported_runtime
     ~live_vars
-    ~cps_calls
+    ~trampolined_calls
     ~should_export
     ~warn_on_unhandled_effect
     d
diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml
index 1dd38eb105..c6b904ec27 100644
--- a/compiler/lib/effects.ml
+++ b/compiler/lib/effects.ml
@@ -247,7 +247,7 @@ let jump_closures blocks_to_transform idom : jump_closures =
     idom
     { closure_of_jump = Addr.Map.empty; closures_of_alloc_site = Addr.Map.empty }
 
-type cps_calls = Var.Set.t
+type trampolined_calls = Var.Set.t
 
 type in_cps = Var.Set.t
 
@@ -265,7 +265,7 @@ type st =
   ; block_order : (Addr.t, int) Hashtbl.t
   ; live_vars : Deadcode.variable_uses
   ; flow_info : Global_flow.info
-  ; cps_calls : cps_calls ref
+  ; trampolined_calls : trampolined_calls ref
   ; in_cps : in_cps ref
   }
 
@@ -286,7 +286,7 @@ let allocate_closure ~st ~params ~body ~branch loc =
 let tail_call ~st ?(instrs = []) ~exact ~in_cps ~check ~f args loc =
   assert (exact || check);
   let ret = Var.fresh () in
-  if check then st.cps_calls := Var.Set.add ret !(st.cps_calls);
+  if check then st.trampolined_calls := Var.Set.add ret !(st.trampolined_calls);
   if in_cps then st.in_cps := Var.Set.add ret !(st.in_cps);
   instrs @ [ Let (ret, Apply { f; args; exact }), loc ], (Return ret, loc)
 
@@ -617,7 +617,7 @@ let cps_block ~st ~k pc block =
 
 let cps_transform ~live_vars ~flow_info ~cps_needed p =
   let closure_info = Hashtbl.create 16 in
-  let cps_calls = ref Var.Set.empty in
+  let trampolined_calls = ref Var.Set.empty in
   let in_cps = ref Var.Set.empty in
   let p =
     Code.fold_closures_innermost_first
@@ -677,7 +677,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
           ; block_order = cfg.block_order
           ; flow_info
           ; live_vars
-          ; cps_calls
+          ; trampolined_calls
           ; in_cps
           }
         in
@@ -755,7 +755,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
         in
         { start = new_start; blocks; free_pc = new_start + 1 }
   in
-  p, !cps_calls, !in_cps
+  p, !trampolined_calls, !in_cps
 
 (****)
 
@@ -951,6 +951,6 @@ let f (p, live_vars) =
   let cps_needed = Partial_cps_analysis.f p flow_info in
   let p, cps_needed = rewrite_toplevel ~cps_needed p in
   let p = split_blocks ~cps_needed p in
-  let p, cps_calls, in_cps = cps_transform ~live_vars ~flow_info ~cps_needed p in
+  let p, trampolined_calls, in_cps = cps_transform ~live_vars ~flow_info ~cps_needed p in
   if Debug.find "times" () then Format.eprintf "  effects: %a@." Timer.print t;
-  p, cps_calls, in_cps
+  p, trampolined_calls, in_cps
diff --git a/compiler/lib/effects.mli b/compiler/lib/effects.mli
index f1a4d74502..44bc061046 100644
--- a/compiler/lib/effects.mli
+++ b/compiler/lib/effects.mli
@@ -16,8 +16,8 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-type cps_calls = Code.Var.Set.t
+type trampolined_calls = Code.Var.Set.t
 
 type in_cps = Code.Var.Set.t
 
-val f : Code.program * Deadcode.variable_uses -> Code.program * cps_calls * in_cps
+val f : Code.program * Deadcode.variable_uses -> Code.program * trampolined_calls * in_cps
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index cafd0748af..3571dcb305 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -66,7 +66,7 @@ let list_group f g l =
 type application_description =
   { arity : int
   ; exact : bool
-  ; cps : bool
+  ; trampolined : bool
   }
 
 module Share = struct
@@ -144,7 +144,7 @@ module Share = struct
         | _ -> t)
 
   let get
-      ~cps_calls
+      ~trampolined_calls
       ?alias_strings
       ?(alias_prims = false)
       ?(alias_apply = true)
@@ -161,9 +161,9 @@ module Share = struct
               match i with
               | Let (_, Constant c) -> get_constant c share
               | Let (x, Apply { args; exact; _ }) ->
-                  let cps = Var.Set.mem x cps_calls in
-                  if (not exact) || cps
-                  then add_apply { arity = List.length args; exact; cps } share
+                  let trampolined = Var.Set.mem x trampolined_calls in
+                  if (not exact) || trampolined
+                  then add_apply { arity = List.length args; exact; trampolined } share
                   else share
               | Let (_, Prim (Extern "%closure", [ Pc (String name) ])) ->
                   let name = Primitive.resolve name in
@@ -255,11 +255,11 @@ module Share = struct
       try J.EVar (AppMap.find desc t.vars.applies)
       with Not_found ->
         let x =
-          let { arity; exact; cps } = desc in
+          let { arity; exact; trampolined } = desc in
           Var.fresh_n
             (Printf.sprintf
                "caml_%scall%d"
-               (match exact, cps with
+               (match exact, trampolined with
                | true, false -> assert false
                | true, true -> "cps_exact_"
                | false, false -> ""
@@ -280,7 +280,7 @@ module Ctx = struct
     ; exported_runtime : (Code.Var.t * bool ref) option
     ; should_export : bool
     ; effect_warning : bool ref
-    ; cps_calls : Effects.cps_calls
+    ; trampolined_calls : Effects.trampolined_calls
     }
 
   let initial
@@ -289,7 +289,7 @@ module Ctx = struct
       ~should_export
       blocks
       live
-      cps_calls
+      trampolined_calls
       share
       debug =
     { blocks
@@ -299,7 +299,7 @@ module Ctx = struct
     ; exported_runtime
     ; should_export
     ; effect_warning = ref (not warn_on_unhandled_effect)
-    ; cps_calls
+    ; trampolined_calls
     }
 end
 
@@ -951,7 +951,7 @@ let parallel_renaming params args continuation queue =
 
 (****)
 
-let apply_fun_raw ctx f params exact cps =
+let apply_fun_raw ctx f params exact trampolined =
   let n = List.length params in
   let apply_directly =
     (* Make sure we are performing a regular call, not a (slower)
@@ -980,7 +980,7 @@ let apply_fun_raw ctx f params exact cps =
         , apply_directly
         , J.call (runtime_fun ctx "caml_call_gen") [ f; J.array params ] J.N )
   in
-  if cps
+  if trampolined
   then (
     assert (Config.Flag.effects ());
     (* When supporting effect, we systematically perform tailcall
@@ -993,7 +993,7 @@ let apply_fun_raw ctx f params exact cps =
       , J.call (runtime_fun ctx "caml_trampoline_return") [ f; J.array params ] J.N ))
   else apply
 
-let generate_apply_fun ctx { arity; exact; cps } =
+let generate_apply_fun ctx { arity; exact; trampolined } =
   let f' = Var.fresh_n "f" in
   let f = J.V f' in
   let params =
@@ -1008,23 +1008,24 @@ let generate_apply_fun ctx { arity; exact; cps } =
     ( None
     , J.fun_
         (f :: params)
-        [ J.Return_statement (Some (apply_fun_raw ctx f' params' exact cps)), J.N ]
+        [ J.Return_statement (Some (apply_fun_raw ctx f' params' exact trampolined)), J.N
+        ]
         J.N )
 
-let apply_fun ctx f params exact cps loc =
+let apply_fun ctx f params exact trampolined loc =
   (* We always go through an intermediate function when doing CPS
      calls. This function first checks the stack depth to prevent
      a stack overflow. This makes the code smaller than inlining
      the test, and we expect the performance impact to be low
      since the function should get inlined by the JavaScript
      engines. *)
-  if Config.Flag.inline_callgen () || (exact && not cps)
-  then apply_fun_raw ctx f params exact cps
+  if Config.Flag.inline_callgen () || (exact && not trampolined)
+  then apply_fun_raw ctx f params exact trampolined
   else
     let y =
       Share.get_apply
         (generate_apply_fun ctx)
-        { arity = List.length params; exact; cps }
+        { arity = List.length params; exact; trampolined }
         ctx.Ctx.share
     in
     J.call y (f :: params) loc
@@ -1209,7 +1210,7 @@ let throw_statement ctx cx k loc =
 let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
   match e with
   | Apply { f; args; exact } ->
-      let cps = Var.Set.mem x ctx.Ctx.cps_calls in
+      let trampolined = Var.Set.mem x ctx.Ctx.trampolined_calls in
       let args, prop, queue =
         List.fold_right
           ~f:(fun x (args, prop, queue) ->
@@ -1220,7 +1221,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
       in
       let (prop', f), queue = access_queue queue f in
       let prop = or_p prop prop' in
-      let e = apply_fun ctx f args exact cps loc in
+      let e = apply_fun ctx f args exact trampolined loc in
       (e, prop, queue), []
   | Block (tag, a, array_or_not) ->
       let contents, prop, queue =
@@ -2176,12 +2177,12 @@ let f
     (p : Code.program)
     ~exported_runtime
     ~live_vars
-    ~cps_calls
+    ~trampolined_calls
     ~should_export
     ~warn_on_unhandled_effect
     debug =
   let t' = Timer.make () in
-  let share = Share.get ~cps_calls ~alias_prims:exported_runtime p in
+  let share = Share.get ~trampolined_calls ~alias_prims:exported_runtime p in
   let exported_runtime =
     if exported_runtime then Some (Code.Var.fresh_n "runtime", ref false) else None
   in
@@ -2192,7 +2193,7 @@ let f
       ~should_export
       p.blocks
       live_vars
-      cps_calls
+      trampolined_calls
       share
       debug
   in
diff --git a/compiler/lib/generate.mli b/compiler/lib/generate.mli
index 21bb63ff5a..d8fe84647a 100644
--- a/compiler/lib/generate.mli
+++ b/compiler/lib/generate.mli
@@ -22,7 +22,7 @@ val f :
      Code.program
   -> exported_runtime:bool
   -> live_vars:Deadcode.variable_uses
-  -> cps_calls:Effects.cps_calls
+  -> trampolined_calls:Effects.trampolined_calls
   -> should_export:bool
   -> warn_on_unhandled_effect:bool
   -> Parse_bytecode.Debug.t

From 08316ce1881d891651c3fb1de9778828ecadd745 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 22 Jul 2024 14:50:03 +0200
Subject: [PATCH 318/481] Misc: yojson is no longer optional

---
 compiler/bin-js_of_ocaml/cmd_arg.ml        |  20 ----
 compiler/bin-js_of_ocaml/compile.ml        |   4 +-
 compiler/bin-wasm_of_ocaml/compile.ml      |   4 +-
 compiler/lib/dune                          |   6 +-
 compiler/lib/link_js.ml                    |   8 +-
 compiler/lib/source_map.ml                 | 106 +++++++++++++++++
 compiler/lib/source_map.mli                |  13 ++
 compiler/lib/source_map_io.mli             |  35 ------
 compiler/lib/source_map_io.unsupported.ml  |  28 -----
 compiler/lib/source_map_io.yojson.ml       | 132 ---------------------
 compiler/tests-compiler/util/util.ml       |   2 +-
 compiler/tests-sourcemap/dump_sourcemap.ml |   2 +-
 manual/install.wiki                        |   2 +-
 tools/sourcemap/jsoo_sourcemap.ml          |   4 +-
 14 files changed, 133 insertions(+), 233 deletions(-)
 delete mode 100644 compiler/lib/source_map_io.mli
 delete mode 100644 compiler/lib/source_map_io.unsupported.ml
 delete mode 100644 compiler/lib/source_map_io.yojson.ml

diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml
index fd9657b54a..64edb90a9a 100644
--- a/compiler/bin-js_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-js_of_ocaml/cmd_arg.ml
@@ -324,16 +324,6 @@ let options =
             } )
       else None
     in
-    let source_map =
-      if Option.is_some source_map && not Source_map_io.enabled
-      then (
-        warn
-          "Warning: '--source-map' flag ignored because js_of_ocaml was compiled without \
-           sourcemap support (install yojson to enable support)\n\
-           %!";
-        None)
-      else source_map
-    in
     let params : (string * string) list = List.flatten set_param in
     let static_env : (string * string) list = List.flatten set_env in
     let include_dirs = normalize_include_dirs include_dirs in
@@ -563,16 +553,6 @@ let options_runtime_only =
             } )
       else None
     in
-    let source_map =
-      if Option.is_some source_map && not Source_map_io.enabled
-      then (
-        warn
-          "Warning: '--source-map' flag ignored because js_of_ocaml was compiled without \
-           sourcemap support (install yojson to enable support)\n\
-           %!";
-        None)
-      else source_map
-    in
     let params : (string * string) list = List.flatten set_param in
     let static_env : (string * string) list = List.flatten set_env in
     let include_dirs = normalize_include_dirs include_dirs in
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 926f393774..ce3fc873ca 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -50,10 +50,10 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f
         let urlData =
           match output_file with
           | None ->
-              let data = Source_map_io.to_string sm in
+              let data = Source_map.to_string sm in
               "data:application/json;base64," ^ Base64.encode_exn data
           | Some output_file ->
-              Source_map_io.to_file sm ~file:output_file;
+              Source_map.to_file sm ~file:output_file;
               Filename.basename output_file
         in
         Pretty_print.newline fmt;
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index a76ec7df33..a4f87b5435 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -30,7 +30,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
   if Option.is_some sourcemap_root || not sourcemap_don't_inline_content
   then (
     let open Source_map in
-    let source_map, mappings = Source_map_io.of_file_no_mappings sourcemap_file in
+    let source_map, mappings = Source_map.of_file_no_mappings sourcemap_file in
     assert (List.is_empty (Option.value source_map.sources_content ~default:[]));
     (* Add source file contents to source map *)
     let sources_content =
@@ -50,7 +50,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
           (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot)
       }
     in
-    Source_map_io.to_file ?mappings source_map ~file:sourcemap_file)
+    Source_map.to_file ?mappings source_map ~file:sourcemap_file)
 
 let opt_with action x f =
   match x with
diff --git a/compiler/lib/dune b/compiler/lib/dune
index b03e41bdf8..075e086433 100644
--- a/compiler/lib/dune
+++ b/compiler/lib/dune
@@ -7,11 +7,7 @@
   compiler-libs.bytecomp
   menhirLib
   sedlex
-  (select
-   source_map_io.ml
-   from
-   (yojson -> source_map_io.yojson.ml)
-   (-> source_map_io.unsupported.ml)))
+  yojson)
  (flags
   (:standard -w -7-37 -safe-string))
  (preprocess
diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml
index 65418e2df8..002a3ee00c 100644
--- a/compiler/lib/link_js.ml
+++ b/compiler/lib/link_js.ml
@@ -177,7 +177,7 @@ let action ~resolve_sourcemap_url ~drop_source_map file line =
   | `Build_info bi, _ -> Build_info bi
   | (`Json_base64 _ | `Url _), true -> Drop
   | `Json_base64 offset, false ->
-      Source_map (Source_map_io.of_string (Base64.decode_exn ~off:offset line))
+      Source_map (Source_map.of_string (Base64.decode_exn ~off:offset line))
   | `Url _, false when not resolve_sourcemap_url -> Drop
   | `Url offset, false ->
       let url = String.sub line ~pos:offset ~len:(String.length line - offset) in
@@ -186,7 +186,7 @@ let action ~resolve_sourcemap_url ~drop_source_map file line =
       let l = in_channel_length ic in
       let content = really_input_string ic l in
       close_in ic;
-      Source_map (Source_map_io.of_string content)
+      Source_map (Source_map.of_string content)
 
 module Units : sig
   val read : Line_reader.t -> Unit_info.t -> Unit_info.t
@@ -465,11 +465,11 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
           in
           match file with
           | None ->
-              let data = Source_map_io.to_string sm in
+              let data = Source_map.to_string sm in
               let s = sourceMappingURL_base64 ^ Base64.encode_exn data in
               Line_writer.write oc s
           | Some file ->
-              Source_map_io.to_file sm ~file;
+              Source_map.to_file sm ~file;
               let s = sourceMappingURL ^ Filename.basename file in
               Line_writer.write oc s));
       if times () then Format.eprintf "  sourcemap: %a@." Timer.print t
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index 3d88b0d1bd..b8af36bf81 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -298,3 +298,109 @@ let merge = function
         ; names = List.rev acc_rev.names
         ; sources_content = Option.map ~f:List.rev acc_rev.sources_content
         }
+
+(* IO *)
+
+let json ?replace_mappings t =
+  let rewrite_path path =
+    if Filename.is_relative path
+    then path
+    else
+      match Build_path_prefix_map.get_build_path_prefix_map () with
+      | Some map -> Build_path_prefix_map.rewrite map path
+      | None -> path
+  in
+  `Assoc
+    [ "version", `Float (float_of_int t.version)
+    ; "file", `String (rewrite_path t.file)
+    ; ( "sourceRoot"
+      , `String
+          (match t.sourceroot with
+          | None -> ""
+          | Some s -> rewrite_path s) )
+    ; "names", `List (List.map t.names ~f:(fun s -> `String s))
+    ; "sources", `List (List.map t.sources ~f:(fun s -> `String (rewrite_path s)))
+    ; ( "mappings"
+      , `String (Option.value ~default:(string_of_mapping t.mappings) replace_mappings) )
+    ; ( "sourcesContent"
+      , `List
+          (match t.sources_content with
+          | None -> []
+          | Some l ->
+              List.map l ~f:(function
+                  | None -> `Null
+                  | Some s -> `String s)) )
+    ]
+
+let invalid () = invalid_arg "Source_map.of_json"
+
+let string name rest =
+  try
+    match List.assoc name rest with
+    | `String s -> Some s
+    | `Null -> None
+    | _ -> invalid ()
+  with Not_found -> None
+
+let list_string name rest =
+  try
+    match List.assoc name rest with
+    | `List l ->
+        Some
+          (List.map l ~f:(function
+              | `String s -> s
+              | _ -> invalid ()))
+    | _ -> invalid ()
+  with Not_found -> None
+
+let list_string_opt name rest =
+  try
+    match List.assoc name rest with
+    | `List l ->
+        Some
+          (List.map l ~f:(function
+              | `String s -> Some s
+              | `Null -> None
+              | _ -> invalid ()))
+    | _ -> invalid ()
+  with Not_found -> None
+
+let of_json ~parse_mappings json =
+  let parse ~version rest =
+      let def v d =
+        match v with
+        | None -> d
+        | Some v -> v
+      in
+      let file = string "file" rest in
+      let sourceroot = string "sourceRoot" rest in
+      let names = list_string "names" rest in
+      let sources = list_string "sources" rest in
+      let sources_content = list_string_opt "sourcesContent" rest in
+      let mappings = string "mappings" rest in
+      ( { version
+        ; file = def file ""
+        ; sourceroot
+        ; names = def names []
+        ; sources_content
+        ; sources = def sources []
+        ; mappings = mapping_of_string (def mappings "")
+        }
+      , if parse_mappings then None else mappings )
+  in
+  match json with
+  | `Assoc (("version", `Float version) :: rest) when int_of_float version = 3 ->
+      parse ~version:3 rest
+  | `Assoc (("version", `Int 3) :: rest) -> parse ~version:3 rest
+  | _ -> invalid ()
+
+let of_string s = of_json ~parse_mappings:true (Yojson.Basic.from_string s) |> fst
+
+let to_string m = Yojson.Basic.to_string (json m)
+
+let to_file ?mappings m ~file =
+  let replace_mappings = mappings in
+  Yojson.Basic.to_file file (json ?replace_mappings m)
+
+let of_file_no_mappings filename =
+  of_json ~parse_mappings:false (Yojson.Basic.from_file filename)
diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli
index b394fe8970..c928aae9f7 100644
--- a/compiler/lib/source_map.mli
+++ b/compiler/lib/source_map.mli
@@ -59,3 +59,16 @@ val mapping_of_string : string -> mapping
 val string_of_mapping : mapping -> string
 
 val empty : filename:string -> t
+
+val to_string : t -> string
+
+val of_string : string -> t
+
+val of_file_no_mappings : string -> t * string option
+(** Read source map from a file without parsing the mappings (which can be costly). The
+    [mappings] field is returned empty and the raw string is returned alongside the map.
+ *)
+
+val to_file : ?mappings:string -> t -> file:string -> unit
+(** Write to a file. If a string is supplied as [mappings], use it instead of the
+    sourcemap's [mappings]. *)
diff --git a/compiler/lib/source_map_io.mli b/compiler/lib/source_map_io.mli
deleted file mode 100644
index c27288de00..0000000000
--- a/compiler/lib/source_map_io.mli
+++ /dev/null
@@ -1,35 +0,0 @@
-(* Js_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2017 Hugo Heuzard
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-open Source_map
-
-val enabled : bool
-
-val to_string : t -> string
-
-val of_string : string -> t
-
-val of_file_no_mappings : string -> t * string option
-(** Read source map from a file without parsing the mappings (which can be costly). The
-    [mappings] field is returned empty and the raw string is returned alongside the map.
- *)
-
-val to_file : ?mappings:string -> t -> file:string -> unit
-(** Write to a file. If a string is supplied as [mappings], use it instead of the
-    sourcemap's [mappings]. *)
diff --git a/compiler/lib/source_map_io.unsupported.ml b/compiler/lib/source_map_io.unsupported.ml
deleted file mode 100644
index dbdb35816c..0000000000
--- a/compiler/lib/source_map_io.unsupported.ml
+++ /dev/null
@@ -1,28 +0,0 @@
-(* Js_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2017 Hugo Heuzard
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-let fail () = failwith "Sourcemap support not available"
-
-let to_string _ = fail ()
-
-let of_string _ = fail ()
-
-let to_file _ _ = fail ()
-
-let enabled = false
diff --git a/compiler/lib/source_map_io.yojson.ml b/compiler/lib/source_map_io.yojson.ml
deleted file mode 100644
index b9833d40a1..0000000000
--- a/compiler/lib/source_map_io.yojson.ml
+++ /dev/null
@@ -1,132 +0,0 @@
-(* Js_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- * Copyright (C) 2017 Hugo Heuzard
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-open Source_map
-
-let json ?replace_mappings t =
-  let rewrite_path path =
-    if Filename.is_relative path
-    then path
-    else
-      match Build_path_prefix_map.get_build_path_prefix_map () with
-      | Some map -> Build_path_prefix_map.rewrite map path
-      | None -> path
-  in
-  `Assoc
-    [ "version", `Float (float_of_int t.version)
-    ; "file", `String (rewrite_path t.file)
-    ; ( "sourceRoot"
-      , `String
-          (match t.sourceroot with
-          | None -> ""
-          | Some s -> rewrite_path s) )
-    ; "names", `List (List.map (fun s -> `String s) t.names)
-    ; "sources", `List (List.map (fun s -> `String (rewrite_path s)) t.sources)
-    ; ( "mappings"
-      , `String (Option.value ~default:(string_of_mapping t.mappings) replace_mappings) )
-    ; ( "sourcesContent"
-      , `List
-          (match t.sources_content with
-          | None -> []
-          | Some l ->
-              List.map
-                (function
-                  | None -> `Null
-                  | Some s -> `String s)
-                l) )
-    ]
-
-let invalid () = invalid_arg "Source_map_io.of_json"
-
-let string name rest =
-  try
-    match List.assoc name rest with
-    | `String s -> Some s
-    | `Null -> None
-    | _ -> invalid ()
-  with Not_found -> None
-
-let list_string name rest =
-  try
-    match List.assoc name rest with
-    | `List l ->
-        Some
-          (List.map
-             (function
-               | `String s -> s
-               | _ -> invalid ())
-             l)
-    | _ -> invalid ()
-  with Not_found -> None
-
-let list_string_opt name rest =
-  try
-    match List.assoc name rest with
-    | `List l ->
-        Some
-          (List.map
-             (function
-               | `String s -> Some s
-               | `Null -> None
-               | _ -> invalid ())
-             l)
-    | _ -> invalid ()
-  with Not_found -> None
-
-let of_json ~parse_mappings json =
-  let parse ~version rest =
-    let def v d =
-      match v with
-      | None -> d
-      | Some v -> v
-    in
-    let file = string "file" rest in
-    let sourceroot = string "sourceRoot" rest in
-    let names = list_string "names" rest in
-    let sources = list_string "sources" rest in
-    let sources_content = list_string_opt "sourcesContent" rest in
-    let mappings = string "mappings" rest in
-    ( { version
-      ; file = def file ""
-      ; sourceroot
-      ; names = def names []
-      ; sources_content
-      ; sources = def sources []
-      ; mappings = (if parse_mappings then mapping_of_string (def mappings "") else [])
-      }
-    , if parse_mappings then None else mappings )
-  in
-  match json with
-  | `Assoc (("version", `Float version) :: rest) when int_of_float version = 3 ->
-      parse ~version:3 rest
-  | `Assoc (("version", `Int 3) :: rest) -> parse ~version:3 rest
-  | _ -> invalid ()
-
-let of_string s = of_json ~parse_mappings:true (Yojson.Basic.from_string s) |> fst
-
-let to_string m = Yojson.Basic.to_string (json m)
-
-let to_file ?mappings m ~file =
-  let replace_mappings = mappings in
-  Yojson.Basic.to_file file (json ?replace_mappings m)
-
-let of_file_no_mappings filename =
-  of_json ~parse_mappings:false (Yojson.Basic.from_file filename)
-
-let enabled = true
diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml
index 6ee6908049..f31db4aeae 100644
--- a/compiler/tests-compiler/util/util.ml
+++ b/compiler/tests-compiler/util/util.ml
@@ -284,7 +284,7 @@ let extract_sourcemap file =
         | None -> String.concat ~sep:"\n" (input_lines line)
         | Some base64 -> Js_of_ocaml_compiler.Base64.decode_exn base64
       in
-      Some (Js_of_ocaml_compiler.Source_map_io.of_string content)
+      Some (Js_of_ocaml_compiler.Source_map.of_string content)
   | _ -> None
 
 let compile_to_javascript
diff --git a/compiler/tests-sourcemap/dump_sourcemap.ml b/compiler/tests-sourcemap/dump_sourcemap.ml
index eec55e5a8e..1d69de2fe9 100644
--- a/compiler/tests-sourcemap/dump_sourcemap.ml
+++ b/compiler/tests-sourcemap/dump_sourcemap.ml
@@ -33,7 +33,7 @@ let extract_sourcemap lines =
         | None -> String.concat ~sep:"\n" (input_lines line)
         | Some base64 -> Base64.decode_exn base64
       in
-      Some (Source_map_io.of_string content)
+      Some (Source_map.of_string content)
   | _ -> None
 
 let print_mapping lines (sm : Source_map.t) =
diff --git a/manual/install.wiki b/manual/install.wiki
index 5dce049e1e..7a3449d7e8 100644
--- a/manual/install.wiki
+++ b/manual/install.wiki
@@ -8,7 +8,7 @@ See opam files at the root of the repository for version constraints.
 Optional dependencies:
   * tyxml, see https://github.com/ocsigen/tyxml
   * reactiveData, see https://github.com/ocsigen/reactiveData
-  * yojson, see https://github.com/mjambon/yojson
+  * yojson, see https://github.com/ocaml-community/yojson
 
 == Install from opam
 {{{opam install js_of_ocaml js_of_ocaml-ppx js_of_ocaml-lwt}}}
diff --git a/tools/sourcemap/jsoo_sourcemap.ml b/tools/sourcemap/jsoo_sourcemap.ml
index 309358705d..571a06384b 100644
--- a/tools/sourcemap/jsoo_sourcemap.ml
+++ b/tools/sourcemap/jsoo_sourcemap.ml
@@ -44,5 +44,5 @@ let () =
         | Some base64 -> Js_of_ocaml_compiler.Base64.decode_exn base64)
     | _ -> failwith "unable to find sourcemap"
   in
-  let sm = Js_of_ocaml_compiler.Source_map_io.of_string content in
-  print_endline (Js_of_ocaml_compiler.Source_map_io.to_string sm)
+  let sm = Js_of_ocaml_compiler.Source_map.of_string content in
+  print_endline (Js_of_ocaml_compiler.Source_map.to_string sm)

From 3d1241ee280b28d88b23e00b4c7adf14fe267c24 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Sun, 4 Aug 2024 00:20:05 +0200
Subject: [PATCH 319/481] Compiler: speedup json parsing, relying on Yojson.Raw
 (#1640)

---
 compiler/lib/js_output.ml   |  10 +++-
 compiler/lib/source_map.ml  | 113 +++++++++++++++++++++++-------------
 compiler/lib/source_map.mli |   8 ++-
 3 files changed, 87 insertions(+), 44 deletions(-)

diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index 82ba0c5559..92ca2aa46b 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -1534,7 +1534,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p =
   let temp_mappings = ref [] in
   let files = Hashtbl.create 17 in
   let names = Hashtbl.create 17 in
-  let contents : string option list ref option =
+  let contents : Source_map.Source_content.t option list ref option =
     match source_map with
     | None | Some { Source_map.sources_content = None; _ } -> None
     | Some { Source_map.sources_content = Some _; _ } -> Some (ref [])
@@ -1577,7 +1577,13 @@ let program ?(accept_unnamed_var = false) f ?source_map p =
         with Not_found ->
           let pos = Hashtbl.length files in
           Hashtbl.add files file pos;
-          Option.iter contents ~f:(fun r -> r := find_source file :: !r);
+          Option.iter contents ~f:(fun r ->
+              let source_contents =
+                match find_source file with
+                | None -> None
+                | Some s -> Some (Source_map.Source_content.create s)
+              in
+              r := source_contents :: !r);
           pos)
     , (fun name ->
         try Hashtbl.find names name
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index b8af36bf81..e66dc3871f 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -19,6 +19,16 @@
 
 open! Stdlib
 
+module Source_content = struct
+  type t = Sc_as_Stringlit of string
+
+  let create s = Sc_as_Stringlit (Yojson.Safe.to_string (`String s))
+
+  let of_stringlit (`Stringlit s) = Sc_as_Stringlit s
+
+  let to_json (Sc_as_Stringlit s) = `Stringlit s
+end
+
 type map =
   | Gen of
       { gen_line : int
@@ -47,7 +57,7 @@ type t =
   ; file : string
   ; sourceroot : string option
   ; sources : string list
-  ; sources_content : string option list option
+  ; sources_content : Source_content.t option list option
   ; names : string list
   ; mappings : mapping
   }
@@ -310,18 +320,18 @@ let json ?replace_mappings t =
       | Some map -> Build_path_prefix_map.rewrite map path
       | None -> path
   in
+  let stringlit s = `Stringlit (Yojson.Safe.to_string (`String s)) in
   `Assoc
-    [ "version", `Float (float_of_int t.version)
-    ; "file", `String (rewrite_path t.file)
+    [ "version", `Intlit (string_of_int t.version)
+    ; "file", stringlit (rewrite_path t.file)
     ; ( "sourceRoot"
-      , `String
+      , stringlit
           (match t.sourceroot with
           | None -> ""
           | Some s -> rewrite_path s) )
-    ; "names", `List (List.map t.names ~f:(fun s -> `String s))
-    ; "sources", `List (List.map t.sources ~f:(fun s -> `String (rewrite_path s)))
-    ; ( "mappings"
-      , `String (Option.value ~default:(string_of_mapping t.mappings) replace_mappings) )
+    ; "names", `List (List.map t.names ~f:(fun s -> stringlit s))
+    ; "sources", `List (List.map t.sources ~f:(fun s -> stringlit (rewrite_path s)))
+    ; "mappings", stringlit (Option.value ~default:(string_of_mapping t.mappings) replace_mappings)
     ; ( "sourcesContent"
       , `List
           (match t.sources_content with
@@ -329,78 +339,99 @@ let json ?replace_mappings t =
           | Some l ->
               List.map l ~f:(function
                   | None -> `Null
-                  | Some s -> `String s)) )
+                  | Some x -> Source_content.to_json x)) )
     ]
 
 let invalid () = invalid_arg "Source_map.of_json"
 
-let string name rest =
+let string_of_stringlit (`Stringlit s) =
+  match Yojson.Safe.from_string s with
+  | `String s -> s
+  | _ -> invalid ()
+
+let stringlit name rest : [ `Stringlit of string ] option =
   try
     match List.assoc name rest with
-    | `String s -> Some s
+    | `Stringlit _ as s -> Some s
     | `Null -> None
     | _ -> invalid ()
   with Not_found -> None
 
-let list_string name rest =
+let list_stringlit name rest =
   try
     match List.assoc name rest with
     | `List l ->
         Some
           (List.map l ~f:(function
-              | `String s -> s
+              | `Stringlit _ as s -> s
               | _ -> invalid ()))
     | _ -> invalid ()
   with Not_found -> None
 
-let list_string_opt name rest =
+let list_stringlit_opt name rest =
   try
     match List.assoc name rest with
     | `List l ->
         Some
           (List.map l ~f:(function
-              | `String s -> Some s
+              | `Stringlit _ as s -> Some s
               | `Null -> None
               | _ -> invalid ()))
     | _ -> invalid ()
   with Not_found -> None
 
-let of_json ~parse_mappings json =
-  let parse ~version rest =
-      let def v d =
-        match v with
-        | None -> d
-        | Some v -> v
+let of_json ~parse_mappings (json : Yojson.Raw.t) =
+  match json with
+  | `Assoc (("version", `Intlit version) :: rest) when int_of_string version = 3 ->
+      let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in
+      let file =
+        match string "file" rest with
+        | None -> ""
+        | Some s -> s
       in
-      let file = string "file" rest in
       let sourceroot = string "sourceRoot" rest in
-      let names = list_string "names" rest in
-      let sources = list_string "sources" rest in
-      let sources_content = list_string_opt "sourcesContent" rest in
-      let mappings = string "mappings" rest in
-      ( { version
-        ; file = def file ""
+      let names =
+        match list_stringlit "names" rest with
+        | None -> []
+        | Some l -> List.map ~f:string_of_stringlit l
+      in
+      let sources =
+        match list_stringlit "sources" rest with
+        | None -> []
+        | Some l -> List.map ~f:string_of_stringlit l
+      in
+      let sources_content =
+        match list_stringlit_opt "sourcesContent" rest with
+        | None -> None
+        | Some l ->
+            Some
+              (List.map l ~f:(function
+                  | None -> None
+                  | Some s -> Some (Source_content.of_stringlit s)))
+      in
+      let mappings =
+        match string "mappings" rest with
+        | None -> mapping_of_string ""
+        | Some s -> mapping_of_string s
+      in
+      ( { version = int_of_float (float_of_string version)
+        ; file
         ; sourceroot
-        ; names = def names []
+        ; names
         ; sources_content
-        ; sources = def sources []
-        ; mappings = mapping_of_string (def mappings "")
+        ; sources
+        ; mappings
         }
-      , if parse_mappings then None else mappings )
-  in
-  match json with
-  | `Assoc (("version", `Float version) :: rest) when int_of_float version = 3 ->
-      parse ~version:3 rest
-  | `Assoc (("version", `Int 3) :: rest) -> parse ~version:3 rest
+      , if parse_mappings then None else Some mappings )
   | _ -> invalid ()
 
-let of_string s = of_json ~parse_mappings:true (Yojson.Basic.from_string s) |> fst
+let of_string s = of_json ~parse_mappings:true (Yojson.Raw.from_string s) |> fst
 
-let to_string m = Yojson.Basic.to_string (json m)
+let to_string m = Yojson.Raw.to_string (json m)
 
 let to_file ?mappings m ~file =
   let replace_mappings = mappings in
-  Yojson.Basic.to_file file (json ?replace_mappings m)
+  Yojson.Raw.to_file file (json ?replace_mappings m)
 
 let of_file_no_mappings filename =
-  of_json ~parse_mappings:false (Yojson.Basic.from_file filename)
+  of_json ~parse_mappings:false (Yojson.Raw.from_file filename)
diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli
index c928aae9f7..5c3d7543e5 100644
--- a/compiler/lib/source_map.mli
+++ b/compiler/lib/source_map.mli
@@ -17,6 +17,12 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
+module Source_content : sig
+  type t
+
+  val create : string -> t
+end
+
 type map =
   | Gen of
       { gen_line : int
@@ -45,7 +51,7 @@ type t =
   ; file : string
   ; sourceroot : string option
   ; sources : string list
-  ; sources_content : string option list option
+  ; sources_content : Source_content.t option list option
   ; names : string list
   ; mappings : mapping
   }

From c211d81227ec0f1acb814250570056fb2738e7ab Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 20 Aug 2024 14:55:37 +0200
Subject: [PATCH 320/481] Adapt Source_map after ocsigen/js_of_ocaml#1640

---
 compiler/bin-wasm_of_ocaml/compile.ml |  2 +-
 compiler/lib/source_map.ml            | 15 ++++++++++-----
 2 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index a4f87b5435..4f542258b1 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -40,7 +40,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
         Some
           (List.map source_map.sources ~f:(fun file ->
                if Sys.file_exists file && not (Sys.is_directory file)
-               then Some (Fs.read_file file)
+               then Some (Source_map.Source_content.create (Fs.read_file file))
                else None))
     in
     let source_map =
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index e66dc3871f..50aa2d0b3a 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -331,7 +331,10 @@ let json ?replace_mappings t =
           | Some s -> rewrite_path s) )
     ; "names", `List (List.map t.names ~f:(fun s -> stringlit s))
     ; "sources", `List (List.map t.sources ~f:(fun s -> stringlit (rewrite_path s)))
-    ; "mappings", stringlit (Option.value ~default:(string_of_mapping t.mappings) replace_mappings)
+    ; ( "mappings"
+      , stringlit (match replace_mappings with
+        | None -> string_of_mapping t.mappings
+        | Some m -> m) )
     ; ( "sourcesContent"
       , `List
           (match t.sources_content with
@@ -409,10 +412,12 @@ let of_json ~parse_mappings (json : Yojson.Raw.t) =
                   | None -> None
                   | Some s -> Some (Source_content.of_stringlit s)))
       in
+      let mappings_str = string "mappings" rest in
       let mappings =
-        match string "mappings" rest with
-        | None -> mapping_of_string ""
-        | Some s -> mapping_of_string s
+        match parse_mappings, mappings_str with
+        | false, _ -> mapping_of_string ""
+        | true, None -> mapping_of_string ""
+        | true, Some s -> mapping_of_string s
       in
       ( { version = int_of_float (float_of_string version)
         ; file
@@ -422,7 +427,7 @@ let of_json ~parse_mappings (json : Yojson.Raw.t) =
         ; sources
         ; mappings
         }
-      , if parse_mappings then None else Some mappings )
+      , if parse_mappings then None else mappings_str )
   | _ -> invalid ()
 
 let of_string s = of_json ~parse_mappings:true (Yojson.Raw.from_string s) |> fst

From 6e90b4e326e2e55f29312005b59d5402b54ce1a9 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Thu, 1 Aug 2024 12:05:11 +0200
Subject: [PATCH 321/481] Move Sexp functions to wasm/ subdirectory

This was made necessary by the changes requested in
ocsigen/js_of_ocaml#1657.
---
 compiler/lib/build_info.ml       | 16 ++-----
 compiler/lib/build_info.mli      |  4 +-
 compiler/lib/unit_info.ml        | 40 -----------------
 compiler/lib/unit_info.mli       |  4 --
 compiler/lib/{ => wasm}/sexp.ml  |  0
 compiler/lib/{ => wasm}/sexp.mli |  0
 compiler/lib/wasm/wa_link.ml     | 76 ++++++++++++++++++++++++++++++++
 7 files changed, 81 insertions(+), 59 deletions(-)
 rename compiler/lib/{ => wasm}/sexp.ml (100%)
 rename compiler/lib/{ => wasm}/sexp.mli (100%)

diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml
index df09835ca6..3d723a5c33 100644
--- a/compiler/lib/build_info.ml
+++ b/compiler/lib/build_info.ml
@@ -90,19 +90,9 @@ let parse s =
       in
       Some t
 
-let to_sexp info =
-  Sexp.List
-    (info
-    |> StringMap.bindings
-    |> List.map ~f:(fun (k, v) -> Sexp.List [ Atom k; Atom v ]))
-
-let from_sexp info =
-  let open Sexp.Util in
-  info
-  |> assoc
-  |> List.fold_left
-       ~f:(fun m (k, v) -> StringMap.add k (single string v) m)
-       ~init:StringMap.empty
+let to_map : t -> string StringMap.t = Fun.id
+
+let of_map : string StringMap.t -> t = Fun.id
 
 exception
   Incompatible_build_info of
diff --git a/compiler/lib/build_info.mli b/compiler/lib/build_info.mli
index 34c72abbc5..f80eee1646 100644
--- a/compiler/lib/build_info.mli
+++ b/compiler/lib/build_info.mli
@@ -34,9 +34,9 @@ val to_string : t -> string
 
 val parse : string -> t option
 
-val to_sexp : t -> Sexp.t
+val to_map : t -> string StringMap.t
 
-val from_sexp : Sexp.t -> t
+val of_map : string StringMap.t -> t
 
 val with_kind : t -> kind -> t
 
diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml
index 6daa29e73a..bcc168a56c 100644
--- a/compiler/lib/unit_info.ml
+++ b/compiler/lib/unit_info.ml
@@ -149,43 +149,3 @@ let parse acc s =
       | Some ("Effects_without_cps", b) ->
           Some { acc with effects_without_cps = bool_of_string (String.trim b) }
       | Some (_, _) -> None)
-
-let to_sexp t =
-  let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in
-  let set nm f rem =
-    add
-      nm
-      (List.equal ~eq:String.equal (f empty) (f t))
-      (List.map ~f:(fun x -> Sexp.Atom x) (f t))
-      rem
-  in
-  let bool nm f rem =
-    add
-      nm
-      (Bool.equal (f empty) (f t))
-      (if f t then [ Atom "true" ] else [ Atom "false" ])
-      rem
-  in
-  []
-  |> bool "effects_without_cps" (fun t -> t.effects_without_cps)
-  |> set "primitives" (fun t -> t.primitives)
-  |> bool "force_link" (fun t -> t.force_link)
-  |> set "requires" (fun t -> StringSet.elements t.requires)
-  |> add "provides" false [ Atom (StringSet.choose t.provides) ]
-
-let from_sexp t =
-  let open Sexp.Util in
-  let opt_list l = l |> Option.map ~f:(List.map ~f:string) in
-  let list default l = Option.value ~default (opt_list l) in
-  let set default l =
-    Option.value ~default (Option.map ~f:StringSet.of_list (opt_list l))
-  in
-  let bool default v = Option.value ~default (Option.map ~f:(single bool) v) in
-  { provides = t |> member "provides" |> mandatory (single string) |> StringSet.singleton
-  ; requires = t |> member "requires" |> set empty.requires
-  ; primitives = t |> member "primitives" |> list empty.primitives
-  ; force_link = t |> member "force_link" |> bool empty.force_link
-  ; effects_without_cps =
-      t |> member "effects_without_cps" |> bool empty.effects_without_cps
-  ; crcs = StringMap.empty
-  }
diff --git a/compiler/lib/unit_info.mli b/compiler/lib/unit_info.mli
index cd0895fa9d..1899b5657b 100644
--- a/compiler/lib/unit_info.mli
+++ b/compiler/lib/unit_info.mli
@@ -41,7 +41,3 @@ val prefix : string
 val to_string : t -> string
 
 val parse : t -> string -> t option
-
-val to_sexp : t -> Sexp.t list
-
-val from_sexp : Sexp.t -> t
diff --git a/compiler/lib/sexp.ml b/compiler/lib/wasm/sexp.ml
similarity index 100%
rename from compiler/lib/sexp.ml
rename to compiler/lib/wasm/sexp.ml
diff --git a/compiler/lib/sexp.mli b/compiler/lib/wasm/sexp.mli
similarity index 100%
rename from compiler/lib/sexp.mli
rename to compiler/lib/wasm/sexp.mli
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 93aa9d82f1..453c658585 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -20,6 +20,82 @@ open Stdlib
 
 let times = Debug.find "times"
 
+module Build_info : sig
+  include module type of Build_info
+
+  val to_sexp : t -> Sexp.t
+
+  val from_sexp : Sexp.t -> t
+end = struct
+  include Build_info
+
+  let to_sexp info =
+    Sexp.List
+      (info
+      |> to_map
+      |> StringMap.bindings
+      |> List.map ~f:(fun (k, v) -> Sexp.List [ Atom k; Atom v ]))
+
+  let from_sexp info =
+    let open Sexp.Util in
+    info
+    |> assoc
+    |> List.fold_left
+         ~f:(fun m (k, v) -> StringMap.add k (single string v) m)
+         ~init:StringMap.empty
+    |> of_map
+end
+
+module Unit_info : sig
+  include module type of Unit_info
+
+  val to_sexp : t -> Sexp.t list
+
+  val from_sexp : Sexp.t -> t
+end = struct
+  include Unit_info
+
+  let to_sexp t =
+    let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in
+    let set nm f rem =
+      add
+        nm
+        (List.equal ~eq:String.equal (f empty) (f t))
+        (List.map ~f:(fun x -> Sexp.Atom x) (f t))
+        rem
+    in
+    let bool nm f rem =
+      add
+        nm
+        (Bool.equal (f empty) (f t))
+        (if f t then [ Atom "true" ] else [ Atom "false" ])
+        rem
+    in
+    []
+    |> bool "effects_without_cps" (fun t -> t.effects_without_cps)
+    |> set "primitives" (fun t -> t.primitives)
+    |> bool "force_link" (fun t -> t.force_link)
+    |> set "requires" (fun t -> StringSet.elements t.requires)
+    |> add "provides" false [ Atom (StringSet.choose t.provides) ]
+
+  let from_sexp t =
+    let open Sexp.Util in
+    let opt_list l = l |> Option.map ~f:(List.map ~f:string) in
+    let list default l = Option.value ~default (opt_list l) in
+    let set default l =
+      Option.value ~default (Option.map ~f:StringSet.of_list (opt_list l))
+    in
+    let bool default v = Option.value ~default (Option.map ~f:(single bool) v) in
+    { provides = t |> member "provides" |> mandatory (single string) |> StringSet.singleton
+    ; requires = t |> member "requires" |> set empty.requires
+    ; primitives = t |> member "primitives" |> list empty.primitives
+    ; force_link = t |> member "force_link" |> bool empty.force_link
+    ; effects_without_cps =
+        t |> member "effects_without_cps" |> bool empty.effects_without_cps
+    ; crcs = StringMap.empty
+    }
+end
+
 module Wasm_binary = struct
   let header = "\000asm\001\000\000\000"
 

From 929eed28f055d21dc16c81b251c75c8739769b22 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Fri, 28 Jun 2024 08:50:08 +0200
Subject: [PATCH 322/481] Compiler: fix toplevel

---
 compiler/lib/link_js.ml                       |  4 ++--
 compiler/lib/parse_bytecode.ml                |  4 ++++
 compiler/lib/parse_bytecode.mli               |  2 +-
 compiler/tests-toplevel/dune                  | 21 +++++++++++++++++--
 compiler/tests-toplevel/test_toplevel.ml      |  8 +++++--
 .../tests-toplevel/test_toplevel.reference    |  8 ++++---
 6 files changed, 37 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml
index 23932e75fe..4f41268fd0 100644
--- a/compiler/lib/link_js.ml
+++ b/compiler/lib/link_js.ml
@@ -409,8 +409,8 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
       | Some bi ->
           Build_info.configure bi;
           let primitives =
-            List.fold_left units ~init:[] ~f:(fun acc (u : Unit_info.t) ->
-                acc @ u.primitives)
+            List.fold_left units ~init:StringSet.empty ~f:(fun acc (u : Unit_info.t) ->
+                StringSet.union acc (StringSet.of_list u.primitives))
           in
           let code =
             Parse_bytecode.link_info
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 9ed5bf4849..1caac8caf2 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -3161,6 +3161,10 @@ let link_info ~target ~symtable ~primitives ~crcs =
       []
     |> Array.of_list
   in
+  let primitives =
+    (* Add the externals translated by jsoo directly (in generate.ml) *)
+    StringSet.union (Primitive.get_external ()) primitives |> StringSet.elements
+  in
   let body = [] in
   let body =
     (* Include linking information *)
diff --git a/compiler/lib/parse_bytecode.mli b/compiler/lib/parse_bytecode.mli
index 5500e4f4ab..244472cd41 100644
--- a/compiler/lib/parse_bytecode.mli
+++ b/compiler/lib/parse_bytecode.mli
@@ -95,6 +95,6 @@ val predefined_exceptions : target:[ `JavaScript | `Wasm ] -> Code.program * Uni
 val link_info :
      target:[ `JavaScript | `Wasm ]
   -> symtable:Ocaml_compiler.Symtable.GlobalMap.t
-  -> primitives:string list
+  -> primitives:StringSet.t
   -> crcs:(string * Digest.t option) list
   -> Code.program
diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune
index ba04748190..2e541eec64 100644
--- a/compiler/tests-toplevel/dune
+++ b/compiler/tests-toplevel/dune
@@ -7,7 +7,9 @@
  (libraries js_of_ocaml-compiler.dynlink compiler-libs.toplevel)
  (flags
   (:standard -linkall))
- (modes byte))
+ (js_of_ocaml
+  (flags :standard --toplevel))
+ (modes byte js))
 
 (rule
  (targets test_toplevel.js)
@@ -31,6 +33,19 @@
    %{target}
    (run node ./test_toplevel.js))))
 
+(rule
+ (target test_toplevel.referencebcjs)
+ (deps test_toplevel.bc.js)
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)
+   (>= %{ocaml_version} 5.2)))
+ (action
+  (with-stdout-to
+   %{target}
+   (run node ./test_toplevel.bc.js))))
+
 (rule
  (alias runtest)
  (enabled_if
@@ -40,4 +55,6 @@
    (>= %{ocaml_version} 5.2)))
  (deps test_toplevel.reference test_toplevel.referencejs)
  (action
-  (diff test_toplevel.reference test_toplevel.referencejs)))
+  (progn
+   (diff test_toplevel.reference test_toplevel.referencebcjs)
+   (diff test_toplevel.reference test_toplevel.referencejs))))
diff --git a/compiler/tests-toplevel/test_toplevel.ml b/compiler/tests-toplevel/test_toplevel.ml
index fde3c45798..e35a3ea90e 100644
--- a/compiler/tests-toplevel/test_toplevel.ml
+++ b/compiler/tests-toplevel/test_toplevel.ml
@@ -1,9 +1,13 @@
 let () =
-  let content = {|
+  let content =
+    {|
 let () = print_endline "hello";;
+1+1;;
 1+;;
 Missing_module.f;;
-|} in
+let y = float 1 /. float 3;;
+|}
+  in
   Topdirs.dir_directory "/static/cmis";
   Toploop.initialize_toplevel_env ();
   Toploop.input_name := "//toplevel//";
diff --git a/compiler/tests-toplevel/test_toplevel.reference b/compiler/tests-toplevel/test_toplevel.reference
index 3ab394a970..81e85b3449 100644
--- a/compiler/tests-toplevel/test_toplevel.reference
+++ b/compiler/tests-toplevel/test_toplevel.reference
@@ -1,5 +1,7 @@
 hello
-Line 3, characters 2-4:
+- : int = 2
+Line 4, characters 2-4:
 Error: Syntax error
-Line 4, characters 0-16:
-Error: Unbound module Missing_module
+Line 5, characters 0-16:
+Error: Unbound module "Missing_module"
+val y : float = 0.333333333333333315

From e15a9bc0bea405ebf3fc2bae6f9829057210915f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 4 Jul 2024 15:09:13 +0200
Subject: [PATCH 323/481] Updated dune support

---
 .github/workflows/build-wasm_of_ocaml.yml | 4 ++--
 README.md                                 | 2 +-
 dune                                      | 4 ++--
 dune-project                              | 2 +-
 js_of_ocaml-compiler.opam                 | 2 +-
 js_of_ocaml-lwt.opam                      | 2 +-
 js_of_ocaml-ppx.opam                      | 2 +-
 js_of_ocaml-ppx_deriving_json.opam        | 2 +-
 js_of_ocaml-toplevel.opam                 | 2 +-
 js_of_ocaml-tyxml.opam                    | 2 +-
 js_of_ocaml.opam                          | 2 +-
 tools/ci_setup.ml                         | 4 ++--
 wasm_of_ocaml-compiler.opam               | 2 +-
 13 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 81fd5c5854..c13a33b8f2 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -123,7 +123,7 @@ jobs:
 
       - name: Pin dune
         run: |
-          opam pin add -n dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm-separate-compilation
+          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
 
       - name: Pin wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
@@ -137,7 +137,7 @@ jobs:
         run: opam exec -- ocaml wasm_of_ocaml/tools/ci_setup.ml
 
       - name: Update test dependencies
-        run: opam install num cohttp-lwt-unix ppx_expect
+        run: opam install num cohttp-lwt-unix ppx_expect cstruct
 
       - name: Install wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
diff --git a/README.md b/README.md
index 0bacdc5e9d..c0c3ccfb35 100644
--- a/README.md
+++ b/README.md
@@ -28,7 +28,7 @@ The following commands will perform a minimal installation:
 ```
 git clone https://github.com/ocaml-wasm/wasm_of_ocaml
 cd wasm_of_ocaml
-opam pin add dune.3.13 https://github.com/ocaml-wasm/dune.git#wasm
+opam pin add dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
 opam pin add -n --with-version 5.3.0-wasm .
 opam install wasm_of_ocaml-compiler
 ```
diff --git a/dune b/dune
index 1ea17bb722..cb16ed5816 100644
--- a/dune
+++ b/dune
@@ -14,7 +14,7 @@
    (tools/node_wrapper.sh as node))
   (js_of_ocaml
    (compilation_mode separate)
-   (targets wasm)))
+   (submodes wasm)))
  (wasm-effects
   (binaries
    (tools/node_wrapper.sh as node))
@@ -22,7 +22,7 @@
    (compilation_mode separate)
    (flags
     (:standard --enable effects))
-   (targets wasm)))
+   (submodes wasm)))
  (bench_no_debug
   (flags
    (:standard \ -g))
diff --git a/dune-project b/dune-project
index a8fa29678c..5db90cd23a 100644
--- a/dune-project
+++ b/dune-project
@@ -1,4 +1,4 @@
-(lang dune 3.11)
+(lang dune 3.17)
 (using menhir 2.0)
 (name js_of_ocaml)
 
diff --git a/js_of_ocaml-compiler.opam b/js_of_ocaml-compiler.opam
index bf328a6a58..cf0554034d 100644
--- a/js_of_ocaml-compiler.opam
+++ b/js_of_ocaml-compiler.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08" & < "5.1"}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}
diff --git a/js_of_ocaml-lwt.opam b/js_of_ocaml-lwt.opam
index 4f1cdaf328..af46230bdb 100644
--- a/js_of_ocaml-lwt.opam
+++ b/js_of_ocaml-lwt.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "js_of_ocaml-ppx" {= version}
diff --git a/js_of_ocaml-ppx.opam b/js_of_ocaml-ppx.opam
index 7b25cb474f..52f72e2c13 100644
--- a/js_of_ocaml-ppx.opam
+++ b/js_of_ocaml-ppx.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "ppxlib" {>= "0.15.0"}
diff --git a/js_of_ocaml-ppx_deriving_json.opam b/js_of_ocaml-ppx_deriving_json.opam
index b801a671c8..0600f216b2 100644
--- a/js_of_ocaml-ppx_deriving_json.opam
+++ b/js_of_ocaml-ppx_deriving_json.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "ppxlib" {>= "0.15"}
diff --git a/js_of_ocaml-toplevel.opam b/js_of_ocaml-toplevel.opam
index 1463580f29..6ab9818071 100644
--- a/js_of_ocaml-toplevel.opam
+++ b/js_of_ocaml-toplevel.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml-compiler" {= version}
   "ocamlfind" {>= "1.5.1"}
diff --git a/js_of_ocaml-tyxml.opam b/js_of_ocaml-tyxml.opam
index 34d89bb0e4..819f7a2a70 100644
--- a/js_of_ocaml-tyxml.opam
+++ b/js_of_ocaml-tyxml.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml" {= version}
   "js_of_ocaml-ppx" {= version}
diff --git a/js_of_ocaml.opam b/js_of_ocaml.opam
index c480de1528..5425a5c0e8 100644
--- a/js_of_ocaml.opam
+++ b/js_of_ocaml.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08"}
   "js_of_ocaml-compiler" {= version}
   "ppxlib" {>= "0.15"}
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index 5b15026e74..dc94596a4d 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -25,11 +25,11 @@ let do_pin = StringSet.of_list [ "base"; "ppx_expect"; "ppx_inline_test"; "time_
 let aliases = [ "ocaml-cstruct", "cstruct" ]
 
 let dune_workspace =
-  {|(lang dune 3.13)
+  {|(lang dune 3.17)
 (env
  (_
   (env-vars (TESTING_FRAMEWORK inline-test))
-  (js_of_ocaml (targets wasm))
+  (js_of_ocaml (submodes wasm))
   (flags :standard -warn-error -8-32-34-49-52-55 -w -67-69)))
 |}
 
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
index 5d825e93d0..19f71ea31b 100644
--- a/wasm_of_ocaml-compiler.opam
+++ b/wasm_of_ocaml-compiler.opam
@@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
-  "dune" {>= "3.11"}
+  "dune" {>= "3.17"}
   "ocaml" {>= "4.08" & < "5.1"}
   "js_of_ocaml" {= version}
   "num" {with-test}

From e6dbb0f5fe1d15d54a9d176be2f5935f40bf6f56 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 25 Jun 2024 14:01:32 +0200
Subject: [PATCH 324/481] Always put Wasm code and source map into an asset
 directory

---
 compiler/bin-wasm_of_ocaml/compile.ml | 52 +++++++++---------
 compiler/lib/wasm/wa_binaryen.ml      | 12 ++---
 compiler/lib/wasm/wa_binaryen.mli     |  1 -
 compiler/lib/wasm/wa_link.ml          | 76 +++++++++++++++++----------
 compiler/lib/wasm/wa_link.mli         |  8 +--
 runtime/wasm/runtime.js               | 12 ++---
 6 files changed, 90 insertions(+), 71 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index a76ec7df33..0b6d371829 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -67,7 +67,6 @@ let link_and_optimize
     ~sourcemap_root
     ~sourcemap_don't_inline_content
     ~opt_sourcemap
-    ~opt_sourcemap_url
     runtime_wasm_files
     wat_files
     output_file =
@@ -113,7 +112,6 @@ let link_and_optimize
     ~profile
     ~opt_input_sourcemap:opt_temp_sourcemap'
     ~opt_output_sourcemap:opt_sourcemap
-    ~opt_sourcemap_url
     ~input_file:temp_file'
     ~output_file;
   Option.iter
@@ -136,7 +134,6 @@ let link_runtime ~profile runtime_wasm_files output_file =
     ~profile
     ~opt_input_sourcemap:None
     ~opt_output_sourcemap:None
-    ~opt_sourcemap_url:None
     ~input_file:temp_file
     ~output_file
 
@@ -163,8 +160,7 @@ let build_prelude z =
     ~input_file:prelude_file
     ~output_file:tmp_prelude_file
     ~opt_input_sourcemap:None
-    ~opt_output_sourcemap:None
-    ~opt_sourcemap_url:None;
+    ~opt_output_sourcemap:None;
   Zip.add_file z ~name:"prelude.wasm" ~file:tmp_prelude_file;
   predefined_exceptions
 
@@ -357,8 +353,6 @@ let run
          ~profile
          ~opt_input_sourcemap:None
          ~opt_output_sourcemap
-         ~opt_sourcemap_url:
-           (if enable_source_maps then Some (unit_name ^ ".wasm.map") else None)
          ~input_file:wat_file
          ~output_file:tmp_wasm_file;
        Option.iter
@@ -385,35 +379,43 @@ let run
          if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
          Fs.gen_file (Filename.chop_extension output_file ^ ".wat")
          @@ fun wat_file ->
-         let wasm_file =
-           if Filename.check_suffix output_file ".wasm.js"
-           then Filename.chop_extension output_file
-           else Filename.chop_extension output_file ^ ".wasm"
+         let dir = Filename.chop_extension output_file ^ ".assets" in
+         Fs.gen_file dir
+         @@ fun tmp_dir ->
+         Sys.mkdir tmp_dir 0o777;
+         let opt_sourcemap =
+           if enable_source_maps
+           then Some (Filename.concat tmp_dir "code.wasm.map")
+           else None
          in
-         Fs.gen_file wasm_file
-         @@ fun tmp_wasm_file ->
-         opt_with
-           Fs.gen_file
-           (if enable_source_maps then Some (wasm_file ^ ".map") else None)
-         @@ fun opt_tmp_sourcemap ->
          let generated_js = output_gen wat_file (output code ~unit_name:None) in
+         let tmp_wasm_file = Filename.concat tmp_dir "code.wasm" in
          let primitives =
            link_and_optimize
              ~profile
              ~sourcemap_root
              ~sourcemap_don't_inline_content
-             ~opt_sourcemap:opt_tmp_sourcemap
-             ~opt_sourcemap_url:
-               (if enable_source_maps
-                then Some (Filename.basename wasm_file ^ ".map")
-                else None)
+             ~opt_sourcemap
              runtime_wasm_files
              [ wat_file ]
              tmp_wasm_file
          in
+         let wasm_name =
+           Printf.sprintf
+             "code-%s"
+             (String.sub (Digest.to_hex (Digest.file tmp_wasm_file)) ~pos:0 ~len:20)
+         in
+         let tmp_wasm_file' = Filename.concat tmp_dir (wasm_name ^ ".wasm") in
+         Sys.rename tmp_wasm_file tmp_wasm_file';
+         if enable_source_maps
+         then (
+           Sys.rename (Filename.concat tmp_dir "code.wasm.map") (tmp_wasm_file' ^ ".map");
+           Wa_link.Wasm_binary.append_source_map_section
+             ~file:tmp_wasm_file'
+             ~url:(wasm_name ^ ".wasm.map"));
          let js_runtime =
            let missing_primitives =
-             let l = Wa_link.Wasm_binary.read_imports ~file:tmp_wasm_file in
+             let l = Wa_link.Wasm_binary.read_imports ~file:tmp_wasm_file' in
              List.filter_map
                ~f:(fun { Wa_link.Wasm_binary.module_; name; _ } ->
                  if String.equal module_ "env" then Some name else None)
@@ -424,7 +426,9 @@ let run
              ~runtime_arguments:
                (Wa_link.build_runtime_arguments
                   ~missing_primitives
-                  ~wasm_file
+                  ~wasm_dir:dir
+                  ~link_spec:[ wasm_name, None ]
+                  ~separate_compilation:false
                   ~generated_js:[ None, generated_js ]
                   ())
              ()
diff --git a/compiler/lib/wasm/wa_binaryen.ml b/compiler/lib/wasm/wa_binaryen.ml
index 551c3a11bc..9ec9d0daf4 100644
--- a/compiler/lib/wasm/wa_binaryen.ml
+++ b/compiler/lib/wasm/wa_binaryen.ml
@@ -114,13 +114,8 @@ let optimization_options =
    ; [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ]
   |]
 
-let optimize
-    ~profile
-    ~opt_input_sourcemap
-    ~input_file
-    ~opt_output_sourcemap
-    ~opt_sourcemap_url
-    ~output_file =
+let optimize ~profile ~opt_input_sourcemap ~input_file ~opt_output_sourcemap ~output_file
+    =
   let level =
     match profile with
     | None -> 1
@@ -132,5 +127,4 @@ let optimize
         @ optimization_options.(level - 1)
         @ [ Filename.quote input_file; "-o"; Filename.quote output_file ])
     @ opt_flag "--input-source-map" opt_input_sourcemap
-    @ opt_flag "--output-source-map" opt_output_sourcemap
-    @ opt_flag "--output-source-map-url" opt_sourcemap_url)
+    @ opt_flag "--output-source-map" opt_output_sourcemap)
diff --git a/compiler/lib/wasm/wa_binaryen.mli b/compiler/lib/wasm/wa_binaryen.mli
index 473d2cbcfc..3e07e06f88 100644
--- a/compiler/lib/wasm/wa_binaryen.mli
+++ b/compiler/lib/wasm/wa_binaryen.mli
@@ -36,6 +36,5 @@ val optimize :
   -> opt_input_sourcemap:string option
   -> input_file:string
   -> opt_output_sourcemap:string option
-  -> opt_sourcemap_url:string option
   -> output_file:string
   -> unit
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 0c4efbc9ce..e78a3f76fa 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -183,6 +183,30 @@ module Wasm_binary = struct
             find_sections i)
     in
     find_sections { imports = []; exports = [] }
+
+  let append_source_map_section ~file ~url =
+    let ch = open_out_gen [ Open_wronly; Open_append; Open_binary ] 0o666 file in
+    let rec output_uint buf i =
+      if i < 128
+      then Buffer.add_char buf (Char.chr i)
+      else (
+        Buffer.add_char buf (Char.chr (128 + (i land 127)));
+        output_uint buf (i lsr 7))
+    in
+    let buf = Buffer.create 16 in
+    let output_name buf s =
+      output_uint buf (String.length s);
+      Buffer.add_string buf s
+    in
+    output_name buf "sourceMappingURL";
+    output_name buf url;
+    let section_contents = Buffer.contents buf in
+    Buffer.clear buf;
+    Buffer.add_char buf '\000';
+    output_uint buf (String.length section_contents);
+    output_string ch (Buffer.contents buf);
+    output_string ch section_contents;
+    close_out ch
 end
 
 let trim_semi s =
@@ -295,7 +319,6 @@ let generate_start_function ~to_link ~out_file =
     ~profile:(Driver.profile 1)
     ~opt_input_sourcemap:None
     ~opt_output_sourcemap:None
-    ~opt_sourcemap_url:None
     ~input_file:wat_file
     ~output_file:wasm_file;
   if times () then Format.eprintf "    generate start: %a@." Timer.print t1
@@ -333,10 +356,10 @@ let report_missing_primitives missing =
     List.iter ~f:(fun nm -> warn "  %s@." nm) missing)
 
 let build_runtime_arguments
-    ?(link_spec = [])
-    ?(separate_compilation = false)
+    ~link_spec
+    ~separate_compilation
     ~missing_primitives
-    ~wasm_file
+    ~wasm_dir
     ~generated_js
     () =
   let missing_primitives = if Config.Flag.genprim () then missing_primitives else [] in
@@ -440,29 +463,26 @@ let build_runtime_arguments
   in
   obj
     [ ( "link"
-      , if List.is_empty link_spec
-        then ENum (Javascript.Num.of_int32 (if separate_compilation then 1l else 0l))
-        else
-          EArr
-            (List.map
-               ~f:(fun (m, deps) ->
-                 Javascript.Element
-                   (EArr
-                      [ Element (EStr (Utf8_string.of_string_exn m))
-                      ; Element
-                          (match deps with
-                          | None -> ENum (Javascript.Num.of_int32 0l)
-                          | Some l ->
-                              EArr
-                                (List.map
-                                   ~f:(fun i ->
-                                     Javascript.Element
-                                       (ENum (Javascript.Num.of_int32 (Int32.of_int i))))
-                                   l))
-                      ]))
-               link_spec) )
+      , EArr
+          (List.map
+             ~f:(fun (m, deps) ->
+               Javascript.Element
+                 (EArr
+                    [ Element (EStr (Utf8_string.of_string_exn m))
+                    ; Element
+                        (match deps with
+                        | None -> ENum (Javascript.Num.of_int32 0l)
+                        | Some l ->
+                            EArr
+                              (List.map
+                                 ~f:(fun i ->
+                                   Javascript.Element
+                                     (ENum (Javascript.Num.of_int32 (Int32.of_int i))))
+                                 l))
+                    ]))
+             link_spec) )
     ; "generated", generated_js
-    ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_file))
+    ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_dir))
     ]
 
 let link_to_directory ~set_to_link ~files ~enable_source_maps ~dir =
@@ -662,7 +682,7 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
   if times () then Format.eprintf "    finding what to link: %a@." Timer.print t1;
   if times () then Format.eprintf "  scan: %a@." Timer.print t;
   let t = Timer.make () in
-  let interfaces, wasm_file, link_spec =
+  let interfaces, wasm_dir, link_spec =
     let dir = Filename.chop_extension output_file ^ ".assets" in
     Fs.gen_file dir
     @@ fun tmp_dir ->
@@ -706,7 +726,7 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
         ~link_spec
         ~separate_compilation:true
         ~missing_primitives
-        ~wasm_file
+        ~wasm_dir
         ~generated_js
         ()
     in
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index a54bc14903..8500fdb852 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -25,6 +25,8 @@ module Wasm_binary : sig
     }
 
   val read_imports : file:string -> import list
+
+  val append_source_map_section : file:string -> url:string -> unit
 end
 
 type unit_data =
@@ -42,10 +44,10 @@ val add_info :
   -> unit
 
 val build_runtime_arguments :
-     ?link_spec:(string * int list option) list
-  -> ?separate_compilation:bool
+     link_spec:(string * int list option) list
+  -> separate_compilation:bool
   -> missing_primitives:string list
-  -> wasm_file:string
+  -> wasm_dir:string
   -> generated_js:
        (string option * (string list * (string * Javascript.expression) list)) list
   -> unit
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index ad25d118c9..9379286355 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -402,14 +402,14 @@
         }
       }
       await loadModule(link[0], 1);
-      await loadModule(link[1]);
-      const workers = new Array(20).fill(link.slice(2).values()).map(loadModules);
-      await Promise.all(workers);
+      if (link.length > 1) {
+        await loadModule(link[1]);
+        const workers = new Array(20).fill(link.slice(2).values()).map(loadModules);
+        await Promise.all(workers);
+      }
       return {instance:{exports: Object.assign(imports.env, imports.OCaml)}}
     }
-    const wasmModule =
-      await ((link)?instantiateFromDir()
-                   :instantiateModule(loadCode(src)))
+    const wasmModule = await instantiateFromDir()
 
     var {caml_callback, caml_alloc_tm, caml_start_fiber,
          caml_handle_uncaught_exception, caml_buffer,

From c75898281228518124f0e43993eca2fa9535659c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 11 Sep 2024 18:48:56 +0200
Subject: [PATCH 325/481] JS runtime: only link jslib_js_of_ocaml.js

---
 compiler/bin-wasm_of_ocaml/compile.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 19c493b16a..365ff6461e 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -249,7 +249,7 @@ let run
         | None -> `Fst name)
   in
   let t1 = Timer.make () in
-  let builtin = Js_of_ocaml_compiler_runtime_files.runtime @ builtin in
+  let builtin = [Js_of_ocaml_compiler_runtime_files.jslib_js_of_ocaml] @ builtin in
   List.iter builtin ~f:(fun t ->
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in

From a02584d5b99ebbc896aab64b7a726e41c0c094c1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 11 Sep 2024 18:49:32 +0200
Subject: [PATCH 326/481] No longer ignore always annotation

---
 compiler/bin-wasm_of_ocaml/compile.ml |  2 --
 compiler/lib/linker.ml                | 16 +++++++---------
 compiler/lib/linker.mli               |  5 ++---
 3 files changed, 9 insertions(+), 14 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 365ff6461e..321b493661 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -254,12 +254,10 @@ let run
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in
       Linker.load_fragments
-        ~ignore_always_annotation:true
         ~target_env:Target_env.Isomorphic
         ~filename
         runtimes);
   Linker.load_files
-    ~ignore_always_annotation:true
     ~target_env:Target_env.Isomorphic
     runtime_js_files;
   Linker.check_deps ();
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index d0a610d904..f77d25b5f0 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -437,7 +437,7 @@ let list_all ?from () =
     provided
     StringSet.empty
 
-let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.t) =
+let load_fragment ~target_env ~filename (f : Fragment.t) =
   match f with
   | Always_include code ->
       always_included :=
@@ -482,8 +482,6 @@ let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.
                 filename;
             if always
             then (
-              if not ignore_always_annotation
-              then
                 always_included :=
                   { ar_filename = filename; ar_program = code; ar_requires = requires }
                   :: !always_included;
@@ -588,24 +586,24 @@ let check_deps () =
           ())
     code_pieces
 
-let load_file ~ignore_always_annotation ~target_env filename =
+let load_file ~target_env filename =
   List.iter (Fragment.parse_file filename) ~f:(fun frag ->
       let (`Ok | `Ignored) =
-        load_fragment ~ignore_always_annotation ~target_env ~filename frag
+        load_fragment ~target_env ~filename frag
       in
       ())
 
-let load_fragments ?(ignore_always_annotation = false) ~target_env ~filename l =
+let load_fragments ~target_env ~filename l =
   List.iter l ~f:(fun frag ->
       let (`Ok | `Ignored) =
-        load_fragment ~ignore_always_annotation ~target_env ~filename frag
+        load_fragment ~target_env ~filename frag
       in
       ());
   check_deps ()
 
-let load_files ?(ignore_always_annotation = false) ~target_env l =
+let load_files ~target_env l =
   List.iter l ~f:(fun filename ->
-      load_file ~ignore_always_annotation ~target_env filename);
+      load_file ~target_env filename);
   check_deps ()
 
 (* resolve *)
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index 246b959403..91f9f68064 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -37,11 +37,10 @@ end
 val reset : unit -> unit
 
 val load_files :
-  ?ignore_always_annotation:bool -> target_env:Target_env.t -> string list -> unit
+  target_env:Target_env.t -> string list -> unit
 
 val load_fragments :
-     ?ignore_always_annotation:bool
-  -> target_env:Target_env.t
+  target_env:Target_env.t
   -> filename:string
   -> Fragment.t list
   -> unit

From c0f0c8fafeaec847d9e777d669438705dbeba88e Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Thu, 12 Sep 2024 18:23:27 +0200
Subject: [PATCH 327/481] Handle primitives that depend on the OCaml version

---
 runtime/wasm/domain.wat         | 22 ++------
 runtime/wasm/dune               | 96 ++++++++++++++++++++++++++++++++-
 runtime/wasm/post-5.2.wat       | 57 ++++++++++++++++++++
 runtime/wasm/pre-5.2.wat        | 42 +++++++++++++++
 runtime/wasm/runtime_events.wat |  4 --
 5 files changed, 196 insertions(+), 25 deletions(-)
 create mode 100644 runtime/wasm/post-5.2.wat
 create mode 100644 runtime/wasm/pre-5.2.wat

diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index 2ba72bcf9c..d07d700532 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -19,11 +19,6 @@
    (type $block (array (mut (ref eq))))
    (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
    (type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
-   (import "sync" "caml_ml_mutex_unlock"
-      (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
-   (import "obj" "caml_callback_1"
-      (func $caml_callback_1
-         (param (ref eq)) (param (ref eq)) (result (ref eq))))
 
    (func (export "caml_atomic_cas")
       (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
@@ -96,20 +91,9 @@
       (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 1)))
 
-   (global $caml_domain_id (mut i32) (i32.const 0))
-   (global $caml_domain_latest_id (mut i32) (i32.const 1))
-
-   (func (export "caml_domain_spawn")
-      (param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq))
-      (local $id i32) (local $old i32)
-      (local.set $id (global.get $caml_domain_latest_id))
-      (global.set $caml_domain_latest_id
-         (i32.add (local.get $id) (i32.const 1)))
-      (local.set $old (global.get $caml_domain_id))
-      (drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
-      (global.set $caml_domain_id (local.get $old))
-      (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
-      (ref.i31 (local.get $id)))
+   (global $caml_domain_id (export "caml_domain_id") (mut i32) (i32.const 0))
+   (global $caml_domain_latest_id (export "caml_domain_latest_id") (mut i32)
+      (i32.const 1))
 
    (func (export "caml_ml_domain_id") (param (ref eq)) (result (ref eq))
       (ref.i31 (global.get $caml_domain_id)))
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 2923b1ac9f..cf759a62b8 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -3,11 +3,64 @@
  (package wasm_of_ocaml-compiler)
  (files runtime.wasm runtime.js))
 
+(rule
+  (target version-dependent.wat)
+  (deps post-5.2.wat)
+  (enabled_if (>= %{ocaml_version} 5.2.0))
+  (action
+    (copy %{deps} %{target})))
+
+(rule
+  (target version-dependent.wat)
+  (deps pre-5.2.wat)
+  (enabled_if (< %{ocaml_version} 5.2.0))
+  (action
+    (copy %{deps} %{target})))
+
 (rule
  (target runtime.wasm)
  (deps
   args
-  (glob_files *.wat))
+  array.wat
+  backtrace.wat
+  bigarray.wat
+  bigstring.wat
+  compare.wat
+  custom.wat
+  domain.wat
+  dynlink.wat
+  effect.wat
+  fail.wat
+  float.wat
+  fs.wat
+  gc.wat
+  hash.wat
+  int32.wat
+  int64.wat
+  ints.wat
+  io.wat
+  jslib.wat
+  jslib_js_of_ocaml.wat
+  jsstring.wat
+  lexing.wat
+  marshal.wat
+  md5.wat
+  nat.wat
+  obj.wat
+  parsing.wat
+  printexc.wat
+  prng.wat
+  runtime_events.wat
+  stdlib.wat
+  str.wat
+  string.wat
+  sync.wat
+  sys.wat
+  toplevel.wat
+  unix.wat
+  version-dependent.wat
+  weak.wat
+  zstd.wat)
  (action
   (progn
    (system
@@ -47,7 +100,46 @@
  (target args)
  (deps
   args.ml
-  (glob_files *.wat))
+  array.wat
+  backtrace.wat
+  bigarray.wat
+  bigstring.wat
+  compare.wat
+  custom.wat
+  domain.wat
+  dynlink.wat
+  effect.wat
+  fail.wat
+  float.wat
+  fs.wat
+  gc.wat
+  hash.wat
+  int32.wat
+  int64.wat
+  ints.wat
+  io.wat
+  jslib.wat
+  jslib_js_of_ocaml.wat
+  jsstring.wat
+  lexing.wat
+  marshal.wat
+  md5.wat
+  nat.wat
+  obj.wat
+  parsing.wat
+  printexc.wat
+  prng.wat
+  runtime_events.wat
+  stdlib.wat
+  str.wat
+  string.wat
+  sync.wat
+  sys.wat
+  toplevel.wat
+  unix.wat
+  version-dependent.wat
+  weak.wat
+  zstd.wat)
  (action
   (with-stdout-to
    %{target}
diff --git a/runtime/wasm/post-5.2.wat b/runtime/wasm/post-5.2.wat
new file mode 100644
index 0000000000..cd99832f16
--- /dev/null
+++ b/runtime/wasm/post-5.2.wat
@@ -0,0 +1,57 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
+(module
+   (type $block (array (mut (ref eq))))
+   (import "obj" "caml_callback_1"
+      (func $caml_callback_1
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "sync" "caml_ml_mutex_unlock"
+      (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
+   (import "domain" "caml_domain_latest_id"
+     (global $caml_domain_latest_id (mut i32)))
+   (import "domain" "caml_domain_id"
+     (global $caml_domain_id (mut i32)))
+
+   (func (export "caml_runtime_events_user_write")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_domain_spawn")
+      (param $f (ref eq)) (param $term_sync_v (ref eq)) (result (ref eq))
+      (local $id i32) (local $old i32) (local $ts (ref $block)) (local $res (ref eq))
+      (local.set $id (global.get $caml_domain_latest_id))
+      (global.set $caml_domain_latest_id
+         (i32.add (local.get $id) (i32.const 1)))
+      (local.set $old (global.get $caml_domain_id))
+      (local.set $res
+         (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
+      (global.set $caml_domain_id (local.get $old))
+      (local.set $ts (ref.cast (ref $block) (local.get $term_sync_v)))
+      (drop (call $caml_ml_mutex_unlock (array.get $block (local.get $ts) (i32.const 2))))
+      ;; TODO: fix exn case
+      (array.set
+         $block
+         (local.get $ts)
+         (i32.const 1)
+         (array.new_fixed
+            $block
+            2
+            (ref.i31 (i32.const 0))
+            (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $res))))
+      (ref.i31 (local.get $id)))
+)
diff --git a/runtime/wasm/pre-5.2.wat b/runtime/wasm/pre-5.2.wat
new file mode 100644
index 0000000000..fafc0413c7
--- /dev/null
+++ b/runtime/wasm/pre-5.2.wat
@@ -0,0 +1,42 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
+(module
+   (import "obj" "caml_callback_1"
+      (func $caml_callback_1
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "sync" "caml_ml_mutex_unlock"
+      (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
+   (import "domain" "caml_domain_latest_id"
+     (global $caml_domain_latest_id (mut i32)))
+
+   (func (export "caml_runtime_events_user_write")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_domain_spawn")
+      (param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq))
+      (local $id i32) (local $old i32)
+      (local.set $id (global.get $caml_domain_latest_id))
+      (global.set $caml_domain_latest_id
+         (i32.add (local.get $id) (i32.const 1)))
+      (local.set $old (global.get $caml_domain_id))
+      (drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
+      (global.set $caml_domain_id (local.get $old))
+      (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
+      (ref.i31 (local.get $id)))
+)
diff --git a/runtime/wasm/runtime_events.wat b/runtime/wasm/runtime_events.wat
index ff77e5570d..8a50583cd7 100644
--- a/runtime/wasm/runtime_events.wat
+++ b/runtime/wasm/runtime_events.wat
@@ -33,10 +33,6 @@
          (local.get $evtag)
          (local.get $evtype)))
 
-   (func (export "caml_runtime_events_user_write")
-      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (ref.i31 (i32.const 0)))
-
    (func (export "caml_runtime_events_user_resolve")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))

From d30fe1f1f98eb001cc6c77c1551a0572438c0b86 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 13 Sep 2024 11:45:06 +0200
Subject: [PATCH 328/481] Move version-dependant files to subdirectory

---
 runtime/wasm/dune                             | 86 +------------------
 .../wasm/{ => version-dependent}/post-5.2.wat |  0
 .../wasm/{ => version-dependent}/pre-5.2.wat  |  0
 3 files changed, 4 insertions(+), 82 deletions(-)
 rename runtime/wasm/{ => version-dependent}/post-5.2.wat (100%)
 rename runtime/wasm/{ => version-dependent}/pre-5.2.wat (100%)

diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index cf759a62b8..8f501d40fc 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -5,14 +5,14 @@
 
 (rule
   (target version-dependent.wat)
-  (deps post-5.2.wat)
+  (deps version-dependent/post-5.2.wat)
   (enabled_if (>= %{ocaml_version} 5.2.0))
   (action
     (copy %{deps} %{target})))
 
 (rule
   (target version-dependent.wat)
-  (deps pre-5.2.wat)
+  (deps version-dependent/pre-5.2.wat)
   (enabled_if (< %{ocaml_version} 5.2.0))
   (action
     (copy %{deps} %{target})))
@@ -21,46 +21,7 @@
  (target runtime.wasm)
  (deps
   args
-  array.wat
-  backtrace.wat
-  bigarray.wat
-  bigstring.wat
-  compare.wat
-  custom.wat
-  domain.wat
-  dynlink.wat
-  effect.wat
-  fail.wat
-  float.wat
-  fs.wat
-  gc.wat
-  hash.wat
-  int32.wat
-  int64.wat
-  ints.wat
-  io.wat
-  jslib.wat
-  jslib_js_of_ocaml.wat
-  jsstring.wat
-  lexing.wat
-  marshal.wat
-  md5.wat
-  nat.wat
-  obj.wat
-  parsing.wat
-  printexc.wat
-  prng.wat
-  runtime_events.wat
-  stdlib.wat
-  str.wat
-  string.wat
-  sync.wat
-  sys.wat
-  toplevel.wat
-  unix.wat
-  version-dependent.wat
-  weak.wat
-  zstd.wat)
+  (glob_files *.wat))
  (action
   (progn
    (system
@@ -100,46 +61,7 @@
  (target args)
  (deps
   args.ml
-  array.wat
-  backtrace.wat
-  bigarray.wat
-  bigstring.wat
-  compare.wat
-  custom.wat
-  domain.wat
-  dynlink.wat
-  effect.wat
-  fail.wat
-  float.wat
-  fs.wat
-  gc.wat
-  hash.wat
-  int32.wat
-  int64.wat
-  ints.wat
-  io.wat
-  jslib.wat
-  jslib_js_of_ocaml.wat
-  jsstring.wat
-  lexing.wat
-  marshal.wat
-  md5.wat
-  nat.wat
-  obj.wat
-  parsing.wat
-  printexc.wat
-  prng.wat
-  runtime_events.wat
-  stdlib.wat
-  str.wat
-  string.wat
-  sync.wat
-  sys.wat
-  toplevel.wat
-  unix.wat
-  version-dependent.wat
-  weak.wat
-  zstd.wat)
+  (glob_files *.wat))
  (action
   (with-stdout-to
    %{target}
diff --git a/runtime/wasm/post-5.2.wat b/runtime/wasm/version-dependent/post-5.2.wat
similarity index 100%
rename from runtime/wasm/post-5.2.wat
rename to runtime/wasm/version-dependent/post-5.2.wat
diff --git a/runtime/wasm/pre-5.2.wat b/runtime/wasm/version-dependent/pre-5.2.wat
similarity index 100%
rename from runtime/wasm/pre-5.2.wat
rename to runtime/wasm/version-dependent/pre-5.2.wat

From 5e9c0ea5c52a1c975924a79fb4208dd93075c5d3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 13 Sep 2024 11:45:14 +0200
Subject: [PATCH 329/481] Small fix

---
 runtime/wasm/version-dependent/pre-5.2.wat | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/runtime/wasm/version-dependent/pre-5.2.wat b/runtime/wasm/version-dependent/pre-5.2.wat
index fafc0413c7..27c671a243 100644
--- a/runtime/wasm/version-dependent/pre-5.2.wat
+++ b/runtime/wasm/version-dependent/pre-5.2.wat
@@ -23,6 +23,8 @@
       (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
    (import "domain" "caml_domain_latest_id"
      (global $caml_domain_latest_id (mut i32)))
+   (import "domain" "caml_domain_id"
+     (global $caml_domain_id (mut i32)))
 
    (func (export "caml_runtime_events_user_write")
       (param (ref eq)) (param (ref eq)) (result (ref eq))

From 6d43b92a1c96cf11e6f2bc686ba505e11525dda0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 13 Sep 2024 11:54:58 +0200
Subject: [PATCH 330/481] Format dune file

---
 runtime/wasm/dune | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 8f501d40fc..e9afd68df4 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -4,18 +4,20 @@
  (files runtime.wasm runtime.js))
 
 (rule
-  (target version-dependent.wat)
-  (deps version-dependent/post-5.2.wat)
-  (enabled_if (>= %{ocaml_version} 5.2.0))
-  (action
-    (copy %{deps} %{target})))
+ (target version-dependent.wat)
+ (deps version-dependent/post-5.2.wat)
+ (enabled_if
+  (>= %{ocaml_version} 5.2.0))
+ (action
+  (copy %{deps} %{target})))
 
 (rule
-  (target version-dependent.wat)
-  (deps version-dependent/pre-5.2.wat)
-  (enabled_if (< %{ocaml_version} 5.2.0))
-  (action
-    (copy %{deps} %{target})))
+ (target version-dependent.wat)
+ (deps version-dependent/pre-5.2.wat)
+ (enabled_if
+  (< %{ocaml_version} 5.2.0))
+ (action
+  (copy %{deps} %{target})))
 
 (rule
  (target runtime.wasm)

From 9744f8997174a502170f806191fab0197ceb8d04 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 13 Sep 2024 13:18:17 +0200
Subject: [PATCH 331/481] Fix link of packed modules

Fixes #74
---
 compiler/bin-wasm_of_ocaml/compile.ml |  5 +-
 compiler/lib/wasm/wa_link.ml          | 68 ++++++++-------------------
 compiler/lib/wasm/wa_link.mli         |  5 +-
 3 files changed, 24 insertions(+), 54 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 19c493b16a..d85c9fdb2f 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -343,7 +343,7 @@ let run
            ic
        in
        let unit_info = Unit_info.of_cmo cmo in
-       let unit_name = StringSet.choose unit_info.provides in
+       let unit_name = Ocaml_compiler.Cmo_format.name cmo in
        if times () then Format.eprintf "  parsing: %a (%s)@." Timer.print t1 unit_name;
        Fs.with_intermediate_file (Filename.temp_file unit_name ".wat")
        @@ fun wat_file ->
@@ -369,7 +369,7 @@ let run
        Zip.add_file z ~name:(unit_name ^ ".wasm") ~file:tmp_wasm_file;
        if enable_source_maps
        then Zip.add_file z ~name:(unit_name ^ ".wasm.map") ~file:tmp_map_file;
-       { Wa_link.unit_info; strings; fragments }
+       { Wa_link.unit_name; unit_info; strings; fragments }
      in
      (match kind with
      | `Exe ->
@@ -456,7 +456,6 @@ let run
          @@ fun tmp_output_file ->
          let z = Zip.open_out tmp_output_file in
          let unit_data = List.map ~f:(fun cmo -> compile_cmo z cmo) cma.lib_units in
-         let unit_data = Wa_link.simplify_unit_info unit_data in
          Wa_link.add_info z ~build_info:(Build_info.create `Cma) ~unit_data ();
          Zip.close_out z);
      close_ic ());
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index e55583f8bd..ce09e7082e 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -76,7 +76,7 @@ end = struct
     |> set "primitives" (fun t -> t.primitives)
     |> bool "force_link" (fun t -> t.force_link)
     |> set "requires" (fun t -> StringSet.elements t.requires)
-    |> add "provides" false [ Atom (StringSet.choose t.provides) ]
+    |> set "provides" (fun t -> StringSet.elements t.provides)
 
   let from_sexp t =
     let open Sexp.Util in
@@ -86,7 +86,7 @@ end = struct
       Option.value ~default (Option.map ~f:StringSet.of_list (opt_list l))
     in
     let bool default v = Option.value ~default (Option.map ~f:(single bool) v) in
-    { provides = t |> member "provides" |> mandatory (single string) |> StringSet.singleton
+    { provides = t |> member "provides" |> set empty.provides
     ; requires = t |> member "requires" |> set empty.requires
     ; primitives = t |> member "primitives" |> list empty.primitives
     ; force_link = t |> member "force_link" |> bool empty.force_link
@@ -299,7 +299,8 @@ let trim_semi s =
   String.sub s ~pos:0 ~len:!l
 
 type unit_data =
-  { unit_info : Unit_info.t
+  { unit_name : string
+  ; unit_info : Unit_info.t
   ; strings : string list
   ; fragments : (string * Javascript.expression) list
   }
@@ -308,9 +309,10 @@ let info_to_sexp ~predefined_exceptions ~build_info ~unit_data =
   let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in
   let units =
     List.map
-      ~f:(fun { unit_info; strings; fragments } ->
+      ~f:(fun { unit_name; unit_info; strings; fragments } ->
         Sexp.List
           (Unit_info.to_sexp unit_info
+          |> add "name" false [ Atom unit_name ]
           |> add
                "strings"
                (List.is_empty strings)
@@ -348,6 +350,9 @@ let info_from_sexp info =
     |> Option.value ~default:[]
     |> List.map ~f:(fun u ->
            let unit_info = u |> Unit_info.from_sexp in
+           let unit_name =
+             u |> member "name" |> Option.value ~default:[] |> single string
+           in
            let strings =
              u |> member "strings" |> Option.value ~default:[] |> List.map ~f:string
            in
@@ -365,7 +370,7 @@ let info_from_sexp info =
                                   , let lex = Parse_js.Lexer.of_string (to_string e) in
                                     Parse_js.parse_expr lex ))*)
            in
-           { unit_info; strings; fragments })
+           { unit_name; unit_info; strings; fragments })
   in
   build_info, predefined_exceptions, unit_data
 
@@ -586,8 +591,7 @@ let link_to_directory ~set_to_link ~files ~enable_source_maps ~dir =
         let z = Zip.open_in file in
         let res =
           List.map
-            ~f:(fun { unit_info; _ } ->
-              let unit_name = StringSet.choose unit_info.provides in
+            ~f:(fun { unit_name; unit_info; _ } ->
               if StringSet.mem unit_name set_to_link
               then (
                 let name = unit_name ^ ".wasm" in
@@ -606,43 +610,11 @@ let link_to_directory ~set_to_link ~files ~enable_source_maps ~dir =
   in
   runtime :: prelude :: List.map ~f:fst lst, (runtime_intf, List.map ~f:snd lst)
 
-(* Remove some unnecessary dependencies *)
-let simplify_unit_info l =
-  let t = Timer.make () in
-  let prev_requires = Hashtbl.create 16 in
-  let res =
-    List.map
-      ~f:(fun (unit_data : unit_data) ->
-        let info = unit_data.unit_info in
-        assert (StringSet.cardinal info.provides = 1);
-        let name = StringSet.choose info.provides in
-        assert (not (StringSet.mem name info.requires));
-        let requires =
-          StringSet.fold
-            (fun dep (requires : StringSet.t) ->
-              match Hashtbl.find prev_requires dep with
-              | exception Not_found -> requires
-              | s -> StringSet.union s requires)
-            info.requires
-            StringSet.empty
-        in
-        let info = { info with requires = StringSet.diff info.requires requires } in
-        Hashtbl.add prev_requires name (StringSet.union info.requires requires);
-        { unit_data with unit_info = info })
-      l
-  in
-  if times () then Format.eprintf "unit info simplification: %a@." Timer.print t;
-  res
-
 let compute_dependencies ~set_to_link ~files =
   let h = Hashtbl.create 128 in
   let l = List.concat (List.map ~f:(fun (_, (_, units)) -> units) files) in
-  (*
-  let l = simplify_unit_info l in
-  *)
   List.filter_map
-    ~f:(fun { unit_info; _ } ->
-      let unit_name = StringSet.choose unit_info.provides in
+    ~f:(fun { unit_name; unit_info; _ } ->
       if StringSet.mem unit_name set_to_link
       then (
         Hashtbl.add h unit_name (Hashtbl.length h);
@@ -721,7 +693,10 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
           | `Cmo -> true
           | `Cma | `Exe | `Runtime | `Unknown -> false
         in
-        List.fold_right units ~init:acc ~f:(fun { unit_info; _ } (requires, to_link) ->
+        List.fold_right
+          units
+          ~init:acc
+          ~f:(fun { unit_name; unit_info; _ } (requires, to_link) ->
             if (not (Config.Flag.auto_link ()))
                || cmo_file
                || linkall
@@ -731,7 +706,7 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
               ( StringSet.diff
                   (StringSet.union unit_info.requires requires)
                   unit_info.provides
-              , StringSet.elements unit_info.provides @ to_link )
+              , unit_name :: to_link )
             else requires, to_link))
   in
   let set_to_link = StringSet.of_list to_link in
@@ -745,10 +720,7 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
           | `Cma | `Exe | `Unknown -> false
           | `Cmo | `Runtime -> true)
           || List.exists
-               ~f:(fun { unit_info; _ } ->
-                 StringSet.exists
-                   (fun nm -> StringSet.mem nm set_to_link)
-                   unit_info.provides)
+               ~f:(fun { unit_name; _ } -> StringSet.mem unit_name set_to_link)
                units)
         files
   in
@@ -797,8 +769,8 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
   let generated_js =
     List.concat
     @@ List.map files ~f:(fun (_, (_, units)) ->
-           List.map units ~f:(fun { unit_info; strings; fragments } ->
-               Some (StringSet.choose unit_info.provides), (strings, fragments)))
+           List.map units ~f:(fun { unit_name; unit_info; strings; fragments } ->
+               Some unit_name, (strings, fragments)))
   in
   let runtime_args =
     let js =
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index 8500fdb852..b4a95ec697 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -30,7 +30,8 @@ module Wasm_binary : sig
 end
 
 type unit_data =
-  { unit_info : Unit_info.t
+  { unit_name : string
+  ; unit_info : Unit_info.t
   ; strings : string list
   ; fragments : (string * Javascript.expression) list
   }
@@ -53,8 +54,6 @@ val build_runtime_arguments :
   -> unit
   -> Javascript.expression
 
-val simplify_unit_info : unit_data list -> unit_data list
-
 val output_js : Javascript.program -> string
 
 val link :

From f41575cdf32d793f8ebfceb44003469032b2f7fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 13 Sep 2024 11:54:10 +0200
Subject: [PATCH 332/481] Marshal header size change in OCaml 5.1

---
 runtime/wasm/dune                             | 14 +++++-
 runtime/wasm/marshal.wat                      |  4 +-
 .../{pre-5.2.wat => post-5.1.wat}             |  2 +
 runtime/wasm/version-dependent/post-5.2.wat   |  2 +
 runtime/wasm/version-dependent/pre-5.1.wat    | 46 +++++++++++++++++++
 5 files changed, 64 insertions(+), 4 deletions(-)
 rename runtime/wasm/version-dependent/{pre-5.2.wat => post-5.1.wat} (96%)
 create mode 100644 runtime/wasm/version-dependent/pre-5.1.wat

diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index e9afd68df4..4ec8e8693c 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -13,9 +13,19 @@
 
 (rule
  (target version-dependent.wat)
- (deps version-dependent/pre-5.2.wat)
+ (deps version-dependent/post-5.2.wat)
+ (enabled_if
+  (and
+   (>= %{ocaml_version} 5.1.0)
+   (< %{ocaml_version} 5.2.0)))
+ (action
+  (copy %{deps} %{target})))
+
+(rule
+ (target version-dependent.wat)
+ (deps version-dependent/pre-5.1.wat)
  (enabled_if
-  (< %{ocaml_version} 5.2.0))
+  (< %{ocaml_version} 5.1.0))
  (action
   (copy %{deps} %{target})))
 
diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat
index 491d843854..46373b2bf7 100644
--- a/runtime/wasm/marshal.wat
+++ b/runtime/wasm/marshal.wat
@@ -48,8 +48,8 @@
       (func $caml_find_custom_operations
          (param (ref $string)) (result (ref null $custom_operations))))
 
-   (global $caml_marshal_header_size (export "caml_marshal_header_size")
-      (mut i32) (i32.const 20))
+   (import "version-dependent" "caml_marshal_header_size"
+      (global $caml_marshal_header_size i32))
 
    (global $input_val_from_string (ref $string)
       (array.new_fixed $string 21
diff --git a/runtime/wasm/version-dependent/pre-5.2.wat b/runtime/wasm/version-dependent/post-5.1.wat
similarity index 96%
rename from runtime/wasm/version-dependent/pre-5.2.wat
rename to runtime/wasm/version-dependent/post-5.1.wat
index 27c671a243..258505a5e9 100644
--- a/runtime/wasm/version-dependent/pre-5.2.wat
+++ b/runtime/wasm/version-dependent/post-5.1.wat
@@ -41,4 +41,6 @@
       (global.set $caml_domain_id (local.get $old))
       (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
       (ref.i31 (local.get $id)))
+
+   (global (export "caml_marshal_header_size") i32 (i32.const 16))
 )
diff --git a/runtime/wasm/version-dependent/post-5.2.wat b/runtime/wasm/version-dependent/post-5.2.wat
index cd99832f16..b4183d2dcb 100644
--- a/runtime/wasm/version-dependent/post-5.2.wat
+++ b/runtime/wasm/version-dependent/post-5.2.wat
@@ -54,4 +54,6 @@
             (ref.i31 (i32.const 0))
             (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $res))))
       (ref.i31 (local.get $id)))
+
+   (global (export "caml_marshal_header_size") i32 (i32.const 16))
 )
diff --git a/runtime/wasm/version-dependent/pre-5.1.wat b/runtime/wasm/version-dependent/pre-5.1.wat
new file mode 100644
index 0000000000..cc23b90ad7
--- /dev/null
+++ b/runtime/wasm/version-dependent/pre-5.1.wat
@@ -0,0 +1,46 @@
+;; Wasm_of_ocaml runtime support
+;; http://www.ocsigen.org/js_of_ocaml/
+;;
+;; 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, with linking exception;
+;; either version 2.1 of the License, or (at your option) any 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.
+
+(module
+   (import "obj" "caml_callback_1"
+      (func $caml_callback_1
+         (param (ref eq)) (param (ref eq)) (result (ref eq))))
+   (import "sync" "caml_ml_mutex_unlock"
+      (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
+   (import "domain" "caml_domain_latest_id"
+     (global $caml_domain_latest_id (mut i32)))
+   (import "domain" "caml_domain_id"
+     (global $caml_domain_id (mut i32)))
+
+   (func (export "caml_runtime_events_user_write")
+      (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
+
+   (func (export "caml_domain_spawn")
+      (param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq))
+      (local $id i32) (local $old i32)
+      (local.set $id (global.get $caml_domain_latest_id))
+      (global.set $caml_domain_latest_id
+         (i32.add (local.get $id) (i32.const 1)))
+      (local.set $old (global.get $caml_domain_id))
+      (drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
+      (global.set $caml_domain_id (local.get $old))
+      (drop (call $caml_ml_mutex_unlock (local.get $mutex)))
+      (ref.i31 (local.get $id)))
+
+   (global (export "caml_marshal_header_size") i32 (i32.const 20))
+)

From 73b379142c27f9e10331cbe9edd43ad50261064f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 4 Jun 2024 14:12:55 +0200
Subject: [PATCH 333/481] Wasm code linker

---
 compiler/lib/wasm/wa_source_map.ml  |  244 +++
 compiler/lib/wasm/wa_source_map.mli |   27 +
 compiler/lib/wasm/wa_wasm_link.ml   | 2443 +++++++++++++++++++++++++++
 compiler/lib/wasm/wa_wasm_link.mli  |    9 +
 4 files changed, 2723 insertions(+)
 create mode 100644 compiler/lib/wasm/wa_source_map.ml
 create mode 100644 compiler/lib/wasm/wa_source_map.mli
 create mode 100644 compiler/lib/wasm/wa_wasm_link.ml
 create mode 100644 compiler/lib/wasm/wa_wasm_link.mli

diff --git a/compiler/lib/wasm/wa_source_map.ml b/compiler/lib/wasm/wa_source_map.ml
new file mode 100644
index 0000000000..7356be983b
--- /dev/null
+++ b/compiler/lib/wasm/wa_source_map.ml
@@ -0,0 +1,244 @@
+open Stdlib
+
+type resize_data =
+  { mutable i : int
+  ; mutable pos : int array
+  ; mutable delta : int array
+  }
+
+type t = Yojson.Raw.t
+
+type u =
+  { mappings : string
+  ; mutable pos : int
+  }
+
+module Vlq = struct
+  let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
+
+  let code_rev =
+    let a = Array.make 255 (-1) in
+    for i = 0 to String.length code - 1 do
+      a.(Char.code code.[i]) <- i
+    done;
+    a
+
+  let vlq_base_shift = 5
+
+  let vlq_base = 1 lsl vlq_base_shift
+
+  let vlq_base_mask = vlq_base - 1
+
+  let vlq_continuation_bit = vlq_base
+
+  let rec decode' src s pos offset i =
+    let digit = Array.unsafe_get code_rev (Char.code s.[pos]) in
+    if digit = -1 then invalid_arg "Vql64.decode'";
+    let i = i + ((digit land vlq_base_mask) lsl offset) in
+    if digit >= vlq_continuation_bit
+    then decode' src s (pos + 1) (offset + vlq_base_shift) i
+    else (
+      src.pos <- pos + 1;
+      i)
+
+  let fromVLQSigned v =
+    let is_neg = v land 1 = 1 in
+    let shift = v lsr 1 in
+    if is_neg then -shift else shift
+
+  let toVLQSigned v = if v < 0 then (-v lsl 1) + 1 else v lsl 1
+
+  let decode src = fromVLQSigned (decode' src src.mappings src.pos 0 0)
+
+  let rec encode' buf i =
+    let digit = i land vlq_base_mask in
+    let i = i lsr vlq_base_shift in
+    if i = 0
+    then Buffer.add_char buf (String.unsafe_get code digit)
+    else (
+      Buffer.add_char buf (String.unsafe_get code (digit lor vlq_continuation_bit));
+      encode' buf i)
+
+  let encode buf i = encode' buf (toVLQSigned i)
+end
+
+let rec next' src mappings pos =
+  match mappings.[pos] with
+  | '"' ->
+      src.pos <- pos + 1;
+      false
+  | ',' ->
+      src.pos <- pos + 1;
+      true
+  | _ -> next' src mappings (pos + 1)
+
+let next src = next' src src.mappings src.pos
+
+let flush buf src start pos =
+  if start < pos then Buffer.add_substring buf src.mappings start (pos - start)
+
+let rec resize_rec buf start src resize_data i col0 delta0 col =
+  let pos = src.pos in
+  let delta = Vlq.decode src in
+  let col = col + delta in
+  if col < col0
+  then
+    if next src
+    then resize_rec buf start src resize_data i col0 delta0 col
+    else flush buf src start (String.length src.mappings)
+  else
+    let delta = delta + delta0 in
+    adjust buf start src resize_data i col delta pos
+
+and adjust buf start src (resize_data : resize_data) i col delta pos =
+  assert (delta > 0);
+  if i < resize_data.i
+  then
+    let col0 = resize_data.pos.(i) in
+    let delta0 = resize_data.delta.(i) in
+    if col < col0
+    then (
+      flush buf src start pos;
+      Vlq.encode buf delta;
+      let start = src.pos in
+      if next src
+      then resize_rec buf start src resize_data (i + 1) col0 delta0 col
+      else flush buf src start (String.length src.mappings))
+    else
+      let delta = delta + delta0 in
+      adjust buf start src resize_data (i + 1) col delta pos
+  else (
+    flush buf src start pos;
+    Vlq.encode buf delta;
+    let start = src.pos in
+    flush buf src start (String.length src.mappings))
+
+let resize_mappings (resize_data : resize_data) mappings =
+  if String.equal mappings "\"\"" || resize_data.i = 0
+  then mappings
+  else
+    let col0 = resize_data.pos.(0) in
+    let delta0 = resize_data.delta.(0) in
+    let buf = Buffer.create (String.length mappings) in
+    resize_rec buf 0 { mappings; pos = 1 } resize_data 1 col0 delta0 0;
+    Buffer.contents buf
+
+let to_raw_string v =
+  match v with
+  | `Stringlit s -> s
+  | _ -> assert false
+
+let replace_member assoc m v =
+  `Assoc ((m, v) :: List.remove_assoc m (Yojson.Raw.Util.to_assoc assoc))
+
+let resize resize_data sm =
+  let open Yojson.Raw.Util in
+  let mappings = to_raw_string (member "mappings" sm) in
+  let mappings = resize_mappings resize_data mappings in
+  replace_member sm "mappings" (`Stringlit mappings)
+
+let is_empty sm =
+  let open Yojson.Raw.Util in
+  match member "mappings" sm with
+  | `Stringlit "\"\"" -> true
+  | _ -> false
+
+let concatenate l =
+  `Assoc
+    [ "version", `Intlit "3"
+    ; ( "sections"
+      , `List
+          (List.map
+             ~f:(fun (ofs, sm) ->
+               `Assoc
+                 [ ( "offset"
+                   , `Assoc [ "line", `Intlit "0"; "column", `Intlit (string_of_int ofs) ]
+                   )
+                 ; "map", sm
+                 ])
+             l) )
+    ]
+
+let parse ?tmp_buf s = Yojson.Raw.from_string ?buf:tmp_buf s
+
+let load ?tmp_buf name = parse ?tmp_buf (Fs.read_file name)
+
+let write name sm = Yojson.Raw.to_file name sm
+
+let string_from_raw_string s = Yojson.Basic.Util.to_string (Yojson.Basic.from_string s)
+
+let raw_string_from_string s = Yojson.Basic.to_string (`String s)
+
+let iter_sources' sm i f =
+  let open Yojson.Raw.Util in
+  let l = sm |> member "sources" |> to_option to_list |> Option.value ~default:[] in
+  let single = List.length l = 1 in
+  List.iteri
+    ~f:(fun j nm ->
+      f i (if single then None else Some j) (string_from_raw_string (to_raw_string nm)))
+    l
+
+let iter_sources sm f =
+  let open Yojson.Raw.Util in
+  match to_option to_list (member "sections" sm) with
+  | None -> iter_sources' sm None f
+  | Some l ->
+      let single_map = List.length l = 1 in
+      List.iteri
+        ~f:(fun i entry ->
+          iter_sources' (member "map" entry) (if single_map then None else Some i) f)
+        l
+
+let insert_source_contents' ~rewrite_path sm i f =
+  let rewrite_path path =
+    raw_string_from_string (rewrite_path (string_from_raw_string path))
+  in
+  let open Yojson.Raw.Util in
+  let l = sm |> member "sources" |> to_option to_list |> Option.value ~default:[] in
+  let single = List.length l = 1 in
+  let contents =
+    List.mapi
+      ~f:(fun j nm ->
+        match
+          f
+            i
+            (if single then None else Some j)
+            (string_from_raw_string (to_raw_string nm))
+        with
+        | Some c -> `Stringlit c
+        | None -> `Null)
+      l
+  in
+  let sm = replace_member sm "sourcesContent" (`List contents) in
+  let sm =
+    replace_member
+      sm
+      "sources"
+      (match member "sources" sm with
+      | `Null -> `Null
+      | `List l ->
+          `List (List.map ~f:(fun s -> `Stringlit (rewrite_path (to_raw_string s))) l)
+      | _ -> assert false)
+  in
+  sm
+
+let insert_source_contents ~rewrite_path sm f =
+  let open Yojson.Raw.Util in
+  match to_option to_list (member "sections" sm) with
+  | None -> insert_source_contents' ~rewrite_path sm None f
+  | Some l ->
+      let single_map = List.length l = 1 in
+      let sections =
+        List.mapi
+          ~f:(fun i entry ->
+            replace_member
+              entry
+              "map"
+              (insert_source_contents'
+                 ~rewrite_path
+                 (member "map" entry)
+                 (if single_map then None else Some i)
+                 f))
+          l
+      in
+      replace_member sm "sections" (`List sections)
diff --git a/compiler/lib/wasm/wa_source_map.mli b/compiler/lib/wasm/wa_source_map.mli
new file mode 100644
index 0000000000..a088539755
--- /dev/null
+++ b/compiler/lib/wasm/wa_source_map.mli
@@ -0,0 +1,27 @@
+type t
+
+val load : ?tmp_buf:Buffer.t -> string -> t
+
+val parse : ?tmp_buf:Buffer.t -> string -> t
+
+val write : string -> t -> unit
+
+val is_empty : t -> bool
+
+type resize_data =
+  { mutable i : int
+  ; mutable pos : int array
+  ; mutable delta : int array
+  }
+
+val resize : resize_data -> t -> t
+
+val concatenate : (int * t) list -> t
+
+val iter_sources : t -> (int option -> int option -> string -> unit) -> unit
+
+val insert_source_contents :
+     rewrite_path:(string -> string)
+  -> t
+  -> (int option -> int option -> string -> string option)
+  -> t
diff --git a/compiler/lib/wasm/wa_wasm_link.ml b/compiler/lib/wasm/wa_wasm_link.ml
new file mode 100644
index 0000000000..bf1b7fe09b
--- /dev/null
+++ b/compiler/lib/wasm/wa_wasm_link.ml
@@ -0,0 +1,2443 @@
+open Stdlib
+
+type heaptype =
+  | Func
+  | Nofunc
+  | Extern
+  | Noextern
+  | Any
+  | Eq
+  | I31
+  | Struct
+  | Array
+  | None_
+  | Type of int
+
+type reftype =
+  { nullable : bool
+  ; typ : heaptype
+  }
+
+type valtype =
+  | I32
+  | I64
+  | F32
+  | F64
+  | V128
+  | Ref of reftype
+
+type packedtype =
+  | I8
+  | I16
+
+type storagetype =
+  | Val of valtype
+  | Packed of packedtype
+
+type 'ty mut =
+  { mut : bool
+  ; typ : 'ty
+  }
+
+type fieldtype = storagetype mut
+
+type comptype =
+  | Func of
+      { params : valtype array
+      ; results : valtype array
+      }
+  | Struct of fieldtype array
+  | Array of fieldtype
+
+type subtype =
+  { final : bool
+  ; supertype : int option
+  ; typ : comptype
+  }
+
+type rectype = subtype array
+
+type limits =
+  { min : int
+  ; max : int option
+  ; shared : bool
+  ; index_type : [ `I32 | `I64 ]
+  }
+
+type tabletype =
+  { limits : limits
+  ; typ : reftype
+  }
+
+type importdesc =
+  | Func of int
+  | Table of tabletype
+  | Mem of limits
+  | Global of valtype mut
+  | Tag of int
+
+type import =
+  { module_ : string
+  ; name : string
+  ; desc : importdesc
+  }
+
+type exportable =
+  | Func
+  | Table
+  | Mem
+  | Global
+  | Tag
+
+let rec output_uint ch i =
+  if i < 128
+  then output_byte ch i
+  else (
+    output_byte ch (128 + (i land 127));
+    output_uint ch (i lsr 7))
+
+module Write = struct
+  type st = { mutable type_index_count : int }
+
+  let byte ch b = Buffer.add_char ch (Char.chr b)
+
+  let string ch s = Buffer.add_string ch s
+
+  let rec sint ch i =
+    if i >= -64 && i < 64
+    then byte ch (i land 127)
+    else (
+      byte ch (128 + (i land 127));
+      sint ch (i asr 7))
+
+  let rec uint ch i =
+    if i < 128
+    then byte ch i
+    else (
+      byte ch (128 + (i land 127));
+      uint ch (i lsr 7))
+
+  let vec f ch l =
+    uint ch (Array.length l);
+    Array.iter ~f:(fun x -> f ch x) l
+
+  let name ch name =
+    uint ch (String.length name);
+    string ch name
+
+  let typeidx st idx = if idx < 0 then lnot idx + st.type_index_count else idx
+
+  let heaptype st ch typ =
+    match (typ : heaptype) with
+    | Nofunc -> byte ch 0x73
+    | Noextern -> byte ch 0x72
+    | None_ -> byte ch 0x71
+    | Func -> byte ch 0x70
+    | Extern -> byte ch 0x6F
+    | Any -> byte ch 0x6E
+    | Eq -> byte ch 0x6D
+    | I31 -> byte ch 0x6C
+    | Struct -> byte ch 0x6B
+    | Array -> byte ch 0x6A
+    | Type idx -> sint ch (typeidx st idx)
+
+  let reftype st ch { nullable; typ } =
+    (match nullable, typ with
+    | false, _ -> byte ch 0x64
+    | true, Type _ -> byte ch 0x63
+    | _ -> ());
+    heaptype st ch typ
+
+  let valtype st ch (typ : valtype) =
+    match typ with
+    | I32 -> byte ch 0x7F
+    | I64 -> byte ch 0x7E
+    | F32 -> byte ch 0x7D
+    | F64 -> byte ch 0x7C
+    | V128 -> byte ch 0x7B
+    | Ref typ -> reftype st ch typ
+
+  let mutability ch mut = byte ch (if mut then 0x01 else 0x00)
+
+  let fieldtype st ch { mut; typ } =
+    (match typ with
+    | Val typ -> valtype st ch typ
+    | Packed typ -> (
+        match typ with
+        | I8 -> byte ch 0x78
+        | I16 -> byte ch 0x77));
+    mutability ch mut
+
+  let functype st ch params results =
+    byte ch 0x60;
+    vec (valtype st) ch params;
+    vec (valtype st) ch results
+
+  let subtype st ch { final; supertype; typ } =
+    (match supertype, final with
+    | None, true -> ()
+    | None, false ->
+        byte ch 0x50;
+        byte ch 0
+    | Some supertype, _ ->
+        byte ch (if final then 0X4F else 0x50);
+        byte ch 1;
+        uint ch (typeidx st supertype));
+    match typ with
+    | Array field_type ->
+        byte ch 0x5E;
+        fieldtype st ch field_type
+    | Struct l ->
+        byte ch 0x5F;
+        vec (fieldtype st) ch l
+    | Func { params; results } -> functype st ch params results
+
+  let rectype st ch l =
+    let len = Array.length l in
+    if len > 1
+    then (
+      byte ch 0x4E;
+      uint ch len);
+    Array.iter ~f:(subtype st ch) l;
+    st.type_index_count <- st.type_index_count + len
+
+  let types ch l =
+    let st = { type_index_count = 0 } in
+    vec (rectype st) ch l;
+    st
+
+  let limits ch { min; max; shared; index_type } =
+    let kind =
+      (if Option.is_none max then 0 else 1)
+      + (if shared then 2 else 0)
+      +
+      match index_type with
+      | `I64 -> 4
+      | `I32 -> 0
+    in
+    byte ch kind;
+    uint ch min;
+    Option.iter ~f:(uint ch) max
+
+  let globaltype st ch mut typ =
+    valtype st ch typ;
+    mutability ch mut
+
+  let tabletype st ch { limits = l; typ } =
+    reftype st ch typ;
+    limits ch l
+
+  let imports st ch imports =
+    vec
+      (fun ch { module_; name = nm; desc } ->
+        name ch module_;
+        name ch nm;
+        match desc with
+        | Func typ ->
+            byte ch 0x00;
+            uint ch typ
+        | Table typ ->
+            byte ch 0x01;
+            tabletype st ch typ
+        | Mem l ->
+            byte ch 0x03;
+            limits ch l
+        | Global { mut; typ } ->
+            byte ch 0x03;
+            globaltype st ch mut typ
+        | Tag typ ->
+            byte ch 0x04;
+            byte ch 0x00;
+            uint ch typ)
+      ch
+      imports
+
+  let functions = vec uint
+
+  let memtype = limits
+
+  let memories = vec memtype
+
+  let export ch kind nm idx =
+    name ch nm;
+    byte
+      ch
+      (match kind with
+      | Func -> 0
+      | Table -> 1
+      | Mem -> 2
+      | Global -> 3
+      | Tag -> 4);
+    uint ch idx
+
+  let start = uint
+
+  let tag ch tag =
+    byte ch 0;
+    uint ch tag
+
+  let tags = vec tag
+
+  let data_count = uint
+
+  let nameassoc ch idx nm =
+    uint ch idx;
+    name ch nm
+
+  let namemap = vec (fun ch (idx, name) -> nameassoc ch idx name)
+end
+
+type 'a exportable_info =
+  { mutable func : 'a
+  ; mutable table : 'a
+  ; mutable mem : 'a
+  ; mutable global : 'a
+  ; mutable tag : 'a
+  }
+
+let iter_exportable_info f { func; table; mem; global; tag } =
+  f Func func;
+  f Table table;
+  f Mem mem;
+  f Global global;
+  f Tag tag
+
+let map_exportable_info f { func; table; mem; global; tag } =
+  { func = f Func func
+  ; table = f Table table
+  ; mem = f Mem mem
+  ; global = f Global global
+  ; tag = f Tag tag
+  }
+
+let fold_exportable_info f acc { func; table; mem; global; tag } =
+  acc |> f Func func |> f Table table |> f Mem mem |> f Global global |> f Tag tag
+
+let init_exportable_info f =
+  { func = f (); table = f (); mem = f (); global = f (); tag = f () }
+
+let make_exportable_info v = init_exportable_info (fun _ -> v)
+
+let exportable_kind d =
+  match d with
+  | 0 -> Func
+  | 1 -> Table
+  | 2 -> Mem
+  | 3 -> Global
+  | 4 -> Tag
+  | _ -> assert false
+
+let get_exportable_info info kind =
+  match kind with
+  | Func -> info.func
+  | Table -> info.table
+  | Mem -> info.mem
+  | Global -> info.global
+  | Tag -> info.tag
+
+let set_exportable_info info kind v =
+  match kind with
+  | Func -> info.func <- v
+  | Table -> info.table <- v
+  | Mem -> info.mem <- v
+  | Global -> info.global <- v
+  | Tag -> info.tag <- v
+
+module Read = struct
+  let header = "\000asm\001\000\000\000"
+
+  let check_header file contents =
+    if String.length contents < 8
+       || not (String.equal header (String.sub contents ~pos:0 ~len:8))
+    then failwith (file ^ " is not a Wasm binary file (bad magic)")
+
+  type ch =
+    { buf : string
+    ; mutable pos : int
+    ; limit : int
+    }
+
+  let pos_in ch = ch.pos
+
+  let seek_in ch pos = ch.pos <- pos
+
+  let input_byte ch =
+    let pos = ch.pos in
+    ch.pos <- pos + 1;
+    Char.code ch.buf.[pos]
+
+  let peek_byte ch = Char.code ch.buf.[ch.pos]
+
+  let really_input_string ch len =
+    let pos = ch.pos in
+    ch.pos <- pos + len;
+    String.sub ch.buf ~pos ~len
+
+  let rec uint ?(n = 5) ch =
+    let i = input_byte ch in
+    if n = 1 then assert (i < 16);
+    if i < 128 then i else i - 128 + (uint ~n:(n - 1) ch lsl 7)
+
+  let rec sint ?(n = 5) ch =
+    let i = input_byte ch in
+    if n = 1 then assert (i < 8 || (i > 120 && i < 128));
+    if i < 64 then i else if i < 128 then i - 128 else i - 128 + (sint ~n:(n - 1) ch lsl 7)
+
+  let repeat n f ch = Array.init n ~f:(fun _ -> f ch)
+
+  let vec f ch = repeat (uint ch) f ch
+
+  let repeat' n f ch =
+    for _ = 1 to n do
+      f ch
+    done
+
+  let vec' f ch = repeat' (uint ch) f ch
+
+  let name ch = really_input_string ch (uint ch)
+
+  type section =
+    { id : int
+    ; pos : int
+    ; size : int
+    }
+
+  type index =
+    { sections : (int, section) Hashtbl.t
+    ; custom_sections : (string, section) Hashtbl.t
+    }
+
+  let next_section ch =
+    if pos_in ch = ch.limit
+    then None
+    else
+      let id = input_byte ch in
+      let size = uint ch in
+      Some { id; pos = pos_in ch; size }
+
+  let skip_section ch { pos; size; _ } = seek_in ch (pos + size)
+
+  let index ch =
+    let index = { sections = Hashtbl.create 16; custom_sections = Hashtbl.create 16 } in
+    let rec loop () =
+      match next_section ch with
+      | None -> index
+      | Some sect ->
+          if sect.id = 0
+          then Hashtbl.add index.custom_sections (name ch) sect
+          else Hashtbl.add index.sections sect.id sect;
+          skip_section ch sect;
+          loop ()
+    in
+    loop ()
+
+  type t =
+    { ch : ch
+    ; mutable type_mapping : int array
+    ; mutable type_index_count : int
+    ; index : index
+    }
+
+  let open_in f buf =
+    check_header f buf;
+    let ch = { buf; pos = 8; limit = String.length buf } in
+    { ch; type_mapping = [||]; type_index_count = 0; index = index ch }
+
+  let find_section contents n =
+    match Hashtbl.find contents.index.sections n with
+    | { pos; _ } ->
+        seek_in contents.ch pos;
+        true
+    | exception Not_found -> false
+
+  let get_custom_section contents name =
+    Hashtbl.find_opt contents.index.custom_sections name
+
+  let focus_on_custom_section contents section =
+    let pos, limit =
+      match get_custom_section contents section with
+      | Some { pos; size; _ } -> pos, pos + size
+      | None -> 0, 0
+    in
+    let ch = { buf = contents.ch.buf; pos; limit } in
+    if limit > 0 then ignore (name ch);
+    { contents with index = index ch }
+
+  module RecTypeTbl = Hashtbl.Make (struct
+    type t = rectype
+
+    let hash t =
+      (* We have large structs, that tend to hash to the same value *)
+      Hashtbl.hash_param 15 100 t
+
+    let heaptype_eq t1 t2 =
+      Stdlib.phys_equal t1 t2
+      ||
+      match t1, t2 with
+      | Type i1, Type i2 -> i1 = i2
+      | _ -> false
+
+    let reftype_eq { nullable = n1; typ = t1 } { nullable = n2; typ = t2 } =
+      Bool.(n1 = n2) && heaptype_eq t1 t2
+
+    let valtype_eq t1 t2 =
+      Stdlib.phys_equal t1 t2
+      ||
+      match t1, t2 with
+      | Ref t1, Ref t2 -> reftype_eq t1 t2
+      | _ -> false
+
+    let storagetype_eq t1 t2 =
+      match t1, t2 with
+      | Val v1, Val v2 -> valtype_eq v1 v2
+      | Packed p1, Packed p2 -> Stdlib.phys_equal p1 p2
+      | _ -> false
+
+    let fieldtype_eq { mut = m1; typ = t1 } { mut = m2; typ = t2 } =
+      Bool.(m1 = m2) && storagetype_eq t1 t2
+
+    (* Does not allocate and return false on length mismatch *)
+    let array_for_all2 p a1 a2 =
+      let n1 = Array.length a1 and n2 = Array.length a2 in
+      n1 = n2
+      &&
+      let rec loop p a1 a2 n1 i =
+        i = n1 || (p a1.(i) a2.(i) && loop p a1 a2 n1 (succ i))
+      in
+      loop p a1 a2 n1 0
+
+    let comptype_eq (t1 : comptype) (t2 : comptype) =
+      match t1, t2 with
+      | Func { params = p1; results = r1 }, Func { params = p2; results = r2 } ->
+          array_for_all2 valtype_eq p1 p2 && array_for_all2 valtype_eq r1 r2
+      | Struct l1, Struct l2 -> array_for_all2 fieldtype_eq l1 l2
+      | Array f1, Array f2 -> fieldtype_eq f1 f2
+      | _ -> false
+
+    let subtype_eq
+        { final = f1; supertype = s1; typ = t1 }
+        { final = f2; supertype = s2; typ = t2 } =
+      Bool.(f1 = f2)
+      && (match s1, s2 with
+         | Some _, None | None, Some _ -> false
+         | None, None -> true
+         | Some i1, Some i2 -> i1 = i2)
+      && comptype_eq t1 t2
+
+    let equal t1 t2 =
+      match t1, t2 with
+      | [| t1 |], [| t2 |] -> subtype_eq t1 t2
+      | _ -> array_for_all2 subtype_eq t1 t2
+  end)
+
+  type types =
+    { types : int RecTypeTbl.t
+    ; mutable last_index : int
+    ; mutable rev_list : rectype list
+    }
+
+  let create_types () = { types = RecTypeTbl.create 2000; last_index = 0; rev_list = [] }
+
+  let add_rectype types typ =
+    try RecTypeTbl.find types.types typ
+    with Not_found ->
+      let index = types.last_index in
+      RecTypeTbl.add types.types typ index;
+      types.last_index <- Array.length typ + index;
+      types.rev_list <- typ :: types.rev_list;
+      index
+
+  let heaptype st ch =
+    let i = sint ch in
+    match i + 128 with
+    | 0X73 -> Nofunc
+    | 0x72 -> Noextern
+    | 0x71 -> None_
+    | 0x70 -> Func
+    | 0x6F -> Extern
+    | 0x6E -> Any
+    | 0x6D -> Eq
+    | 0x6C -> I31
+    | 0x6B -> Struct
+    | 0x6A -> Array
+    | _ ->
+        if i < 0 then failwith (Printf.sprintf "Unknown heaptype %x@." i);
+        let i =
+          if i >= st.type_index_count
+          then lnot (i - st.type_index_count)
+          else st.type_mapping.(i)
+        in
+        Type i
+
+  let nullable typ = { nullable = true; typ }
+
+  let ref_eq = { nullable = false; typ = Eq }
+
+  let ref_i31 = { nullable = false; typ = I31 }
+
+  let reftype' st i ch =
+    match i with
+    | 0X73 -> nullable Nofunc
+    | 0x72 -> nullable Noextern
+    | 0x71 -> nullable None_
+    | 0x70 -> nullable Func
+    | 0x6F -> nullable Extern
+    | 0x6E -> nullable Any
+    | 0x6D -> nullable Eq
+    | 0x6C -> nullable I31
+    | 0x6B -> nullable Struct
+    | 0x6A -> nullable Array
+    | 0x63 -> nullable (heaptype st ch)
+    | 0x64 -> { nullable = false; typ = heaptype st ch }
+    | _ -> failwith (Printf.sprintf "Unknown reftype %x@." i)
+
+  let reftype st ch = reftype' st (input_byte ch) ch
+
+  let ref_i31 = Ref ref_i31
+
+  let ref_eq = Ref ref_eq
+
+  let valtype' st i ch =
+    match i with
+    | 0x7B -> V128
+    | 0x7C -> F64
+    | 0x7D -> F32
+    | 0x7E -> I64
+    | 0x7F -> I32
+    | 0x64 -> (
+        match peek_byte ch with
+        | 0x6C ->
+            ignore (input_byte ch);
+            ref_i31
+        | 0x6D ->
+            ignore (input_byte ch);
+            ref_eq
+        | _ -> Ref { nullable = false; typ = heaptype st ch })
+    | _ -> Ref (reftype' st i ch)
+
+  let valtype st ch =
+    let i = uint ch in
+    valtype' st i ch
+
+  let storagetype st ch =
+    let i = uint ch in
+    match i with
+    | 0x78 -> Packed I8
+    | 0x77 -> Packed I16
+    | _ -> Val (valtype' st i ch)
+
+  let fieldtype st ch =
+    let typ = storagetype st ch in
+    let mut = input_byte ch <> 0 in
+    { mut; typ }
+
+  let comptype st i ch =
+    match i with
+    | 0x5E -> Array (fieldtype st ch)
+    | 0x5F -> Struct (vec (fieldtype st) ch)
+    | 0x60 ->
+        let params = vec (valtype st) ch in
+        let results = vec (valtype st) ch in
+        Func { params; results }
+    | c -> failwith (Printf.sprintf "Unknown comptype %d" c)
+
+  let supertype st ch =
+    match input_byte ch with
+    | 0 -> None
+    | 1 ->
+        let t = uint ch in
+        Some
+          (if t >= st.type_index_count
+           then lnot (t - st.type_index_count)
+           else st.type_mapping.(t))
+    | _ -> assert false
+
+  let subtype st i ch =
+    match i with
+    | 0x50 ->
+        let supertype = supertype st ch in
+        { final = false; supertype; typ = comptype st (input_byte ch) ch }
+    | 0x4F ->
+        let supertype = supertype st ch in
+        { final = true; supertype; typ = comptype st (input_byte ch) ch }
+    | _ -> { final = true; supertype = None; typ = comptype st i ch }
+
+  let rectype st ch =
+    match input_byte ch with
+    | 0x4E -> vec (fun ch -> subtype st (input_byte ch) ch) ch
+    | i -> [| subtype st i ch |]
+
+  let type_section st types ch =
+    let n = uint ch in
+    st.type_mapping <- Array.make n 0;
+    st.type_index_count <- 0;
+    repeat'
+      n
+      (fun ch ->
+        let ty = rectype st ch in
+        let pos = st.type_index_count in
+        let pos' = add_rectype types ty in
+        let count = Array.length ty in
+        for i = 0 to count - 1 do
+          st.type_mapping.(pos + i) <- pos' + i
+        done;
+        st.type_index_count <- pos + count)
+      ch
+
+  let limits ch =
+    let kind = input_byte ch in
+    assert (kind < 8);
+    let shared = kind land 2 <> 0 in
+    let index_type = if kind land 4 = 0 then `I32 else `I64 in
+    let min = uint ch in
+    let max = if kind land 1 = 0 then None else Some (uint ch) in
+    { min; max; shared; index_type }
+
+  let memtype = limits
+
+  let tabletype st ch =
+    let typ = reftype st ch in
+    let limits = limits ch in
+    { limits; typ }
+
+  let typeidx st ch = st.type_mapping.(uint ch)
+
+  let globaltype st ch =
+    let typ = valtype st ch in
+    let mut = input_byte ch in
+    assert (mut < 2);
+    { mut = mut <> 0; typ }
+
+  let import tbl st ch =
+    let module_ = name ch in
+    let name = name ch in
+    let d = uint ch in
+    if d > 4 then failwith (Printf.sprintf "Unknown import %x@." d);
+    let importdesc : importdesc =
+      match d with
+      | 0 -> Func st.type_mapping.(uint ch)
+      | 1 -> Table (tabletype st ch)
+      | 2 -> Mem (memtype ch)
+      | 3 -> Global (globaltype st ch)
+      | 4 ->
+          let b = uint ch in
+          assert (b = 0);
+          Tag st.type_mapping.(uint ch)
+      | _ -> assert false
+    in
+    let entry = { module_; name; desc = importdesc } in
+    let kind = exportable_kind d in
+    set_exportable_info tbl kind (entry :: get_exportable_info tbl kind)
+
+  let export tbl ch =
+    let name = name ch in
+    let d = uint ch in
+    if d > 4 then failwith (Printf.sprintf "Unknown export %x@." d);
+    let idx = uint ch in
+    let entry = name, idx in
+    let kind = exportable_kind d in
+    set_exportable_info tbl kind (entry :: get_exportable_info tbl kind)
+
+  type interface =
+    { imports : import array exportable_info
+    ; exports : (string * int) list exportable_info
+    }
+
+  let type_section types contents =
+    if find_section contents 1 then type_section contents types contents.ch
+
+  let interface contents =
+    let imports =
+      if find_section contents 2
+      then (
+        let tbl = make_exportable_info [] in
+        vec' (import tbl contents) contents.ch;
+        map_exportable_info (fun _ l -> Array.of_list (List.rev l)) tbl)
+      else make_exportable_info [||]
+    in
+    let exports =
+      let tbl = make_exportable_info [] in
+      if find_section contents 7 then vec' (export tbl) contents.ch;
+      tbl
+    in
+    { imports; exports }
+
+  let functions contents =
+    if find_section contents 3
+    then vec (fun ch -> typeidx contents ch) contents.ch
+    else [||]
+
+  let memories contents = if find_section contents 5 then vec memtype contents.ch else [||]
+
+  let tag contents ch =
+    let b = input_byte ch in
+    assert (b = 0);
+    typeidx contents ch
+
+  let tags contents =
+    if find_section contents 13 then vec (tag contents) contents.ch else [||]
+
+  let data_count contents =
+    if find_section contents 12
+    then uint contents.ch
+    else if find_section contents 11
+    then uint contents.ch
+    else 0
+
+  let start contents = if find_section contents 8 then Some (uint contents.ch) else None
+
+  let nameassoc ch =
+    let idx = uint ch in
+    let name = name ch in
+    idx, name
+
+  let namemap contents = vec nameassoc contents.ch
+end
+
+module Scan = struct
+  let debug = false
+
+  type maps =
+    { typ : int array
+    ; func : int array
+    ; table : int array
+    ; mem : int array
+    ; global : int array
+    ; elem : int array
+    ; data : int array
+    ; tag : int array
+    }
+
+  let default_maps =
+    { typ = [||]
+    ; func = [||]
+    ; table = [||]
+    ; mem = [||]
+    ; global = [||]
+    ; elem = [||]
+    ; data = [||]
+    ; tag = [||]
+    }
+
+  type resize_data = Wa_source_map.resize_data =
+    { mutable i : int
+    ; mutable pos : int array
+    ; mutable delta : int array
+    }
+
+  let push_resize resize_data pos delta =
+    let p = resize_data.pos in
+    let i = resize_data.i in
+    let p =
+      if i = Array.length p
+      then (
+        let p = Array.make (2 * i) 0 in
+        let d = Array.make (2 * i) 0 in
+        Array.blit ~src:resize_data.pos ~src_pos:0 ~dst:p ~dst_pos:0 ~len:i;
+        Array.blit ~src:resize_data.delta ~src_pos:0 ~dst:d ~dst_pos:0 ~len:i;
+        resize_data.pos <- p;
+        resize_data.delta <- d;
+        p)
+      else p
+    in
+    p.(i) <- pos;
+    resize_data.delta.(i) <- delta;
+    resize_data.i <- i + 1
+
+  let create_resize_data () =
+    { i = 0; pos = Array.make 1024 0; delta = Array.make 1024 0 }
+
+  let clear_resize_data resize_data = resize_data.i <- 0
+
+  type position_data =
+    { mutable i : int
+    ; mutable pos : int array
+    }
+
+  let create_position_data () = { i = 0; pos = Array.make 100 0 }
+
+  let clear_position_data position_data = position_data.i <- 0
+
+  let push_position position_data pos =
+    let p = position_data.pos in
+    let i = position_data.i in
+    let p =
+      if i = Array.length p
+      then (
+        let p = Array.make (2 * i) 0 in
+        Array.blit ~src:position_data.pos ~src_pos:0 ~dst:p ~dst_pos:0 ~len:i;
+        position_data.pos <- p;
+        p)
+      else p
+    in
+    p.(i) <- pos;
+    position_data.i <- i + 1
+
+  let scanner report mark maps buf code =
+    let rec output_uint buf i =
+      if i < 128
+      then Buffer.add_char buf (Char.chr i)
+      else (
+        Buffer.add_char buf (Char.chr (128 + (i land 127)));
+        output_uint buf (i lsr 7))
+    in
+    let rec output_sint buf i =
+      if i >= -64 && i < 64
+      then Buffer.add_char buf (Char.chr (i land 127))
+      else (
+        Buffer.add_char buf (Char.chr (128 + (i land 127)));
+        output_sint buf (i asr 7))
+    in
+    let start = ref 0 in
+    let get pos = Char.code (String.get code pos) in
+    let rec int pos = if get pos >= 128 then int (pos + 1) else pos + 1 in
+    let rec uint32 pos =
+      let i = get pos in
+      if i < 128
+      then pos + 1, i
+      else
+        let pos, i' = pos + 1 |> uint32 in
+        pos, (i' lsl 7) + (i land 0x7f)
+    in
+    let rec sint32 pos =
+      let i = get pos in
+      if i < 64
+      then pos + 1, i
+      else if i < 128
+      then pos + 1, i - 128
+      else
+        let pos, i' = pos + 1 |> sint32 in
+        pos, i - 128 + (i' lsl 7)
+    in
+    let rec repeat n f pos = if n = 0 then pos else repeat (n - 1) f (f pos) in
+    let vector f pos =
+      let pos, i =
+        let i = get pos in
+        if i < 128 then pos + 1, i else uint32 pos
+      in
+      repeat i f pos
+    in
+    let name pos =
+      let pos', i =
+        let i = get pos in
+        if i < 128 then pos + 1, i else uint32 pos
+      in
+      pos' + i
+    in
+    let flush' pos pos' =
+      if !start < pos then Buffer.add_substring buf code !start (pos - !start);
+      start := pos'
+    in
+    let flush pos = flush' pos pos in
+    let rewrite map pos =
+      let pos', idx =
+        let i = get pos in
+        if i < 128
+        then pos + 1, i
+        else
+          let i' = get (pos + 1) in
+          if i' < 128 then pos + 2, (i' lsl 7) + (i land 0x7f) else uint32 pos
+      in
+      let idx' = map idx in
+      if idx <> idx'
+      then (
+        flush' pos pos';
+        let p = Buffer.length buf in
+        output_uint buf idx';
+        let p' = Buffer.length buf in
+        let dp = p' - p in
+        let dpos = pos' - pos in
+        if dp <> dpos then report pos (dp - dpos));
+      pos'
+    in
+    let rewrite_signed map pos =
+      let pos', idx =
+        let i = get pos in
+        if i < 64 then pos + 1, i else if i < 128 then pos + 1, i - 128 else sint32 pos
+      in
+      let idx' = map idx in
+      if idx <> idx'
+      then (
+        flush' pos pos';
+        let p = Buffer.length buf in
+        output_sint buf idx';
+        let p' = Buffer.length buf in
+        let dp = p' - p in
+        let dpos = pos' - pos in
+        if dp <> dpos then report pos (dp - dpos));
+      pos'
+    in
+    let typ_map idx = maps.typ.(idx) in
+    let typeidx pos = rewrite typ_map pos in
+    let signed_typeidx pos = rewrite_signed typ_map pos in
+    let func_map idx = maps.func.(idx) in
+    let funcidx pos = rewrite func_map pos in
+    let table_map idx = maps.table.(idx) in
+    let tableidx pos = rewrite table_map pos in
+    let mem_map idx = maps.mem.(idx) in
+    let memidx pos = rewrite mem_map pos in
+    let global_map idx = maps.global.(idx) in
+    let globalidx pos = rewrite global_map pos in
+    let elem_map idx = maps.elem.(idx) in
+    let elemidx pos = rewrite elem_map pos in
+    let data_map idx = maps.data.(idx) in
+    let dataidx pos = rewrite data_map pos in
+    let tag_map idx = maps.tag.(idx) in
+    let tagidx pos = rewrite tag_map pos in
+    let labelidx = int in
+    let localidx = int in
+    let laneidx pos = pos + 1 in
+    let heaptype pos =
+      let c = get pos in
+      if c >= 64 && c < 128 then (* absheaptype *) pos + 1 else signed_typeidx pos
+    in
+    let absheaptype pos =
+      match get pos with
+      | 0X73 (* nofunc *)
+      | 0x72 (* noextern *)
+      | 0x71 (* none *)
+      | 0x70 (* func *)
+      | 0x6F (* extern *)
+      | 0x6E (* any *)
+      | 0x6D (* eq *)
+      | 0x6C (* i31 *)
+      | 0x6B (* struct *)
+      | 0x6A (* array *) -> pos + 1
+      | c -> failwith (Printf.sprintf "Bad heap type 0x%02X@." c)
+    in
+    let reftype pos =
+      match get pos with
+      | 0x63 | 0x64 -> pos + 1 |> heaptype
+      | _ -> pos |> absheaptype
+    in
+    let valtype pos =
+      let c = get pos in
+      match c with
+      | 0x63 (* ref null ht *) | 0x64 (* ref ht *) -> pos + 1 |> heaptype
+      | _ -> pos + 1
+    in
+    let blocktype pos =
+      let c = get pos in
+      if c >= 64 && c < 128 then pos |> valtype else pos |> signed_typeidx
+    in
+    let memarg pos =
+      let pos', c = uint32 pos in
+      if c < 64
+      then (
+        if mem_map 0 <> 0
+        then (
+          flush' pos pos';
+          let p = Buffer.length buf in
+          output_uint buf (c + 64);
+          output_uint buf (mem_map 0);
+          let p' = Buffer.length buf in
+          let dp = p' - p in
+          let dpos = pos' - pos in
+          if dp <> dpos then report pos (dp - dpos));
+        pos' |> int)
+      else pos' |> memidx |> int
+    in
+    let rec instructions pos =
+      if debug then Format.eprintf "0x%02X (@%d)@." (get pos) pos;
+      match get pos with
+      (* Control instruction *)
+      | 0x00 (* unreachable *) | 0x01 (* nop *) | 0x0F (* return *) ->
+          pos + 1 |> instructions
+      | 0x02 (* block *) | 0x03 (* loop *) ->
+          pos + 1 |> blocktype |> instructions |> block_end |> instructions
+      | 0x04 (* if *) -> pos + 1 |> blocktype |> instructions |> opt_else |> instructions
+      | 0x0C (* br *)
+      | 0x0D (* br_if *)
+      | 0xD5 (* br_on_null *)
+      | 0xD6 (* br_on_non_null *) -> pos + 1 |> labelidx |> instructions
+      | 0x0E (* br_table *) -> pos + 1 |> vector labelidx |> labelidx |> instructions
+      | 0x10 (* call *) | 0x12 (* return_call *) -> pos + 1 |> funcidx |> instructions
+      | 0x11 (* call_indirect *) | 0x13 (* return_call_indirect *) ->
+          pos + 1 |> typeidx |> tableidx |> instructions
+      | 0x14 (* call_ref *) | 0x15 (* return_call_ref *) ->
+          pos + 1 |> typeidx |> instructions
+      (* Exceptions *)
+      | 0x06 (* try *) -> pos + 1 |> blocktype |> instructions |> opt_catch
+      | 0x08 (* throw *) -> pos + 1 |> tagidx |> instructions
+      | 0x09 (* rethrow *) -> pos + 1 |> int |> instructions
+      | 0x0A (* throw_ref *) -> pos + 1 |> instructions
+      (* Parametric instructions *)
+      | 0x1A (* drop *) | 0x1B (* select *) -> pos + 1 |> instructions
+      | 0x1C (* select *) -> pos + 1 |> vector valtype |> instructions
+      | 0x1F (* try_table *) ->
+          pos + 1
+          |> blocktype
+          |> vector catch
+          |> instructions
+          |> block_end
+          |> instructions
+      (* Variable instructions *)
+      | 0x20 (* local.get *) | 0x21 (* local.set *) | 0x22 (* local.tee *) ->
+          pos + 1 |> localidx |> instructions
+      | 0x23 (* global.get *) | 0x24 (* global.set *) ->
+          pos + 1 |> globalidx |> instructions
+      (* Table instructions *)
+      | 0x25 (* table.get *) | 0x26 (* table.set *) -> pos + 1 |> tableidx |> instructions
+      (* Memory instructions *)
+      | 0x28
+      | 0x29
+      | 0x2A
+      | 0x2B
+      | 0x2C
+      | 0x2D
+      | 0x2E
+      | 0x2F
+      | 0x30
+      | 0x31
+      | 0x32
+      | 0x33
+      | 0x34
+      | 0x35 (* load *)
+      | 0x36 | 0x37 | 0x38 | 0x39 | 0x3A | 0x3B | 0x3C | 0x3D | 0x3E (* store *) ->
+          pos + 1 |> memarg |> instructions
+      | 0x3F | 0x40 -> pos + 1 |> memidx |> instructions
+      (* Numeric instructions *)
+      | 0x41 (* i32.const *) | 0x42 (* i64.const *) -> pos + 1 |> int |> instructions
+      | 0x43 (* f32.const *) -> pos + 5 |> instructions
+      | 0x44 (* f64.const *) -> pos + 9 |> instructions
+      | 0x45
+      | 0x46
+      | 0x47
+      | 0x48
+      | 0x49
+      | 0x4A
+      | 0x4B
+      | 0x4C
+      | 0x4D
+      | 0x4E
+      | 0x4F
+      | 0x50
+      | 0x51
+      | 0x52
+      | 0x53
+      | 0x54
+      | 0x55
+      | 0x56
+      | 0x57
+      | 0x58
+      | 0x59
+      | 0x5A
+      | 0x5B
+      | 0x5C
+      | 0x5D
+      | 0x5E
+      | 0x5F
+      | 0x60
+      | 0x61
+      | 0x62
+      | 0x63
+      | 0x64
+      | 0x65
+      | 0x66
+      | 0x67
+      | 0x68
+      | 0x69
+      | 0x6A
+      | 0x6B
+      | 0x6C
+      | 0x6D
+      | 0x6E
+      | 0x6F
+      | 0x70
+      | 0x71
+      | 0x72
+      | 0x73
+      | 0x74
+      | 0x75
+      | 0x76
+      | 0x77
+      | 0x78
+      | 0x79
+      | 0x7A
+      | 0x7B
+      | 0x7C
+      | 0x7D
+      | 0x7E
+      | 0x7F
+      | 0x80
+      | 0x81
+      | 0x82
+      | 0x83
+      | 0x84
+      | 0x85
+      | 0x86
+      | 0x87
+      | 0x88
+      | 0x89
+      | 0x8A
+      | 0x8B
+      | 0x8C
+      | 0x8D
+      | 0x8E
+      | 0x8F
+      | 0x90
+      | 0x91
+      | 0x92
+      | 0x93
+      | 0x94
+      | 0x95
+      | 0x96
+      | 0x97
+      | 0x98
+      | 0x99
+      | 0x9A
+      | 0x9B
+      | 0x9C
+      | 0x9D
+      | 0x9E
+      | 0x9F
+      | 0xA0
+      | 0xA1
+      | 0xA2
+      | 0xA3
+      | 0xA4
+      | 0xA5
+      | 0xA6
+      | 0xA7
+      | 0xA8
+      | 0xA9
+      | 0xAA
+      | 0xAB
+      | 0xAC
+      | 0xAD
+      | 0xAE
+      | 0xAF
+      | 0xB0
+      | 0xB1
+      | 0xB2
+      | 0xB3
+      | 0xB4
+      | 0xB5
+      | 0xB6
+      | 0xB7
+      | 0xB8
+      | 0xB9
+      | 0xBA
+      | 0xBB
+      | 0xBC
+      | 0xBD
+      | 0xBE
+      | 0xBF
+      | 0xC0
+      | 0xC1
+      | 0xC2
+      | 0xC3
+      | 0xC4 -> pos + 1 |> instructions
+      (* Reference instructions *)
+      | 0xD0 (* ref.null *) -> pos + 1 |> heaptype |> instructions
+      | 0xD1 (* ref.is_null *) | 0xD3 (* ref.eq *) | 0xD4 (* ref.as_non_null *) ->
+          pos + 1 |> instructions
+      | 0xD2 (* ref.func *) -> pos + 1 |> funcidx |> instructions
+      | 0xFB -> pos + 1 |> gc_instruction
+      | 0xFC -> (
+          if debug then Format.eprintf "  %d@." (get (pos + 1));
+          match get (pos + 1) with
+          | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 (* xx.trunc_sat_xxx_x *) ->
+              pos + 2 |> instructions
+          | 8 (* memory.init *) -> pos + 2 |> dataidx |> memidx |> instructions
+          | 9 (* data.drop *) -> pos + 2 |> dataidx |> instructions
+          | 10 (* memory.copy *) -> pos + 2 |> memidx |> memidx |> instructions
+          | 11 (* memory.fill *) -> pos + 2 |> memidx |> instructions
+          | 12 (* table.init *) -> pos + 2 |> elemidx |> tableidx |> instructions
+          | 13 (* elem.drop *) -> pos + 2 |> elemidx |> instructions
+          | 14 (* table.copy *) -> pos + 2 |> tableidx |> tableidx |> instructions
+          | 15 (* table.grow *) | 16 (* table.size *) | 17 (* table.fill *) ->
+              pos + 2 |> tableidx |> instructions
+          | c -> failwith (Printf.sprintf "Bad instruction 0xFC 0x%02X" c))
+      | 0xFD -> pos + 1 |> vector_instruction
+      | 0xFE -> pos + 1 |> atomic_instruction
+      | _ -> pos
+    and gc_instruction pos =
+      if debug then Format.eprintf "  %d@." (get pos);
+      match get pos with
+      | 0 (* struct.new *)
+      | 1 (* struct.new_default *)
+      | 6 (* array.new *)
+      | 7 (* array.new_default *)
+      | 11 (* array.get *)
+      | 12 (* array.get_s *)
+      | 13 (* array.get_u *)
+      | 14 (* array.set *)
+      | 16 (* array.fill *) -> pos + 1 |> typeidx |> instructions
+      | 2 (* struct.get *)
+      | 3 (* struct.get_s *)
+      | 4 (* struct.get_u *)
+      | 5 (* struct.set *)
+      | 8 (* array.new_fixed *) -> pos + 1 |> typeidx |> int |> instructions
+      | 9 (* array.new_data *) | 18 (* array.init_data *) ->
+          pos + 1 |> typeidx |> dataidx |> instructions
+      | 10 (* array.new_elem *) | 19 (* array.init_elem *) ->
+          pos + 1 |> typeidx |> elemidx |> instructions
+      | 15 (* array.len *)
+      | 26 (* any.convert_extern *)
+      | 27 (* extern.convert_any *)
+      | 28 (* ref.i31 *)
+      | 29 (* i31.get_s *)
+      | 30 (* i31.get_u *) -> pos + 1 |> instructions
+      | 17 (* array.copy *) -> pos + 1 |> typeidx |> typeidx |> instructions
+      | 20 | 21 (* ref_test *) | 22 | 23 (* ref.cast*) ->
+          pos + 1 |> heaptype |> instructions
+      | 24 (* br_on_cast *) | 25 (* br_on_cast_fail *) ->
+          pos + 2 |> labelidx |> heaptype |> heaptype |> instructions
+      | c -> failwith (Printf.sprintf "Bad instruction 0xFB 0x%02X" c)
+    and vector_instruction pos =
+      if debug then Format.eprintf "  %d@." (get pos);
+      let pos, i = uint32 pos in
+      match i with
+      | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 92 | 93 (* v128.load / store *)
+        -> pos + 1 |> memarg |> instructions
+      | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 (* v128.load/store_lane *) ->
+          pos + 1 |> memarg |> laneidx |> instructions
+      | 12 (* v128.const *) | 13 (* v128.shuffle *) -> pos + 17 |> instructions
+      | 21
+      | 22
+      | 23
+      | 24
+      | 25
+      | 26
+      | 27
+      | 28
+      | 29
+      | 30
+      | 31
+      | 32
+      | 33
+      | 34 (* xx.extract/replace_lane *) -> pos + 1 |> laneidx |> instructions
+      | ( 162
+        | 165
+        | 166
+        | 175
+        | 176
+        | 178
+        | 179
+        | 180
+        | 187
+        | 194
+        | 197
+        | 198
+        | 207
+        | 208
+        | 210
+        | 211
+        | 212
+        | 226
+        | 238 ) as c -> failwith (Printf.sprintf "Bad instruction 0xFD 0x%02X" c)
+      | c ->
+          if c <= 275
+          then pos + 1 |> instructions
+          else failwith (Printf.sprintf "Bad instruction 0xFD 0x%02X" c)
+    and atomic_instruction pos =
+      if debug then Format.eprintf "  %d@." (get pos);
+      match get pos with
+      | 0 (* memory.atomic.notify *)
+      | 1 | 2 (* memory.atomic.waitxx *)
+      | 16 | 17 | 18 | 19 | 20 | 21 | 22 (* xx.atomic.load *)
+      | 23 | 24 | 25 | 26 | 27 | 28 | 29 (* xx.atomic.store *)
+      | 30 | 31 | 32 | 33 | 34 | 35 | 36 (* xx.atomic.rmw.add *)
+      | 37 | 38 | 39 | 40 | 41 | 42 | 43 (* xx.atomic.rmw.sub *)
+      | 44 | 45 | 46 | 47 | 48 | 49 | 50 (* xx.atomic.rmw.and *)
+      | 51 | 52 | 53 | 54 | 55 | 56 | 57 (* xx.atomic.rmw.or *)
+      | 58 | 59 | 60 | 61 | 62 | 63 | 64 (* xx.atomic.rmw.xor *)
+      | 65 | 66 | 67 | 68 | 69 | 70 | 71 (* xx.atomic.rmw.xchg *)
+      | 72 | 73 | 74 | 75 | 76 | 77 | 78 (* xx.atomic.rmw.cmpxchg *) ->
+          pos + 1 |> memarg |> instructions
+      | 3 (* memory.fence *) ->
+          let c = get pos + 1 in
+          assert (c = 0);
+          pos + 2 |> instructions
+      | c -> failwith (Printf.sprintf "Bad instruction 0xFE 0x%02X" c)
+    and opt_else pos =
+      if debug then Format.eprintf "0x%02X (@%d) else@." (get pos) pos;
+      match get pos with
+      | 0x05 (* else *) -> pos + 1 |> instructions |> block_end |> instructions
+      | _ -> pos |> block_end |> instructions
+    and opt_catch pos =
+      if debug then Format.eprintf "0x%02X (@%d) catch@." (get pos) pos;
+      match get pos with
+      | 0x07 (* catch *) -> pos + 1 |> tagidx |> instructions |> opt_catch
+      | 0x05 (* catch_all *) -> pos + 1 |> instructions |> block_end |> instructions
+      | _ -> pos |> block_end |> instructions
+    and catch pos =
+      match get pos with
+      | 0 (* catch *) | 1 (* catch_ref *) -> pos + 1 |> tagidx |> labelidx
+      | 2 (* catch_all *) | 3 (* catch_all_ref *) -> pos + 1 |> labelidx
+      | c -> failwith (Printf.sprintf "bad catch 0x02%d@." c)
+    and block_end pos =
+      if debug then Format.eprintf "0x%02X (@%d) block end@." (get pos) pos;
+      match get pos with
+      | 0x0B -> pos + 1
+      | c -> failwith (Printf.sprintf "Bad instruction 0x%02X" c)
+    in
+    let locals pos = pos |> int |> valtype in
+    let expr pos = pos |> instructions |> block_end in
+    let func pos =
+      start := pos;
+      pos |> vector locals |> expr |> flush
+    in
+    let mut pos = pos + 1 in
+    let limits pos =
+      let c = get pos in
+      assert (c < 8);
+      if c land 1 = 0 then pos |> int else pos |> int |> int
+    in
+    let tabletype pos =
+      mark pos;
+      pos |> reftype |> limits
+    in
+    let table pos =
+      match get pos with
+      | 0x40 ->
+          assert (get (pos + 1) = 0);
+          pos + 2 |> tabletype |> expr
+      | _ -> pos |> tabletype
+    in
+    let table_section ~count pos =
+      start := pos;
+      pos |> repeat count table |> flush
+    in
+    let globaltype pos =
+      mark pos;
+      pos |> valtype |> mut
+    in
+    let global pos = pos |> globaltype |> expr in
+    let global_section ~count pos =
+      start := pos;
+      pos |> repeat count global |> flush
+    in
+    let elemkind pos =
+      assert (get pos = 0);
+      pos + 1
+    in
+    let elem pos =
+      match get pos with
+      | 0 -> pos + 1 |> expr |> vector funcidx
+      | 1 -> pos + 1 |> elemkind |> vector funcidx
+      | 2 -> pos + 1 |> tableidx |> expr |> elemkind |> vector funcidx
+      | 3 -> pos + 1 |> elemkind |> vector funcidx
+      | 4 -> pos + 1 |> expr |> vector expr
+      | 5 -> pos + 1 |> reftype |> vector expr
+      | 6 -> pos + 1 |> tableidx |> expr |> reftype |> vector expr
+      | 7 -> pos + 1 |> reftype |> vector expr
+      | c -> failwith (Printf.sprintf "Bad element 0x%02X" c)
+    in
+    let bytes pos =
+      let pos, len = uint32 pos in
+      pos + len
+    in
+    let data pos =
+      match get pos with
+      | 0 -> pos + 1 |> expr |> bytes
+      | 1 -> pos + 1 |> bytes
+      | 2 -> pos + 1 |> memidx |> expr |> bytes
+      | c -> failwith (Printf.sprintf "Bad data segment 0x%02X" c)
+    in
+    let elem_section ~count pos =
+      start := pos;
+      !start |> repeat count elem |> flush
+    in
+    let data_section ~count pos =
+      start := pos;
+      !start |> repeat count data |> flush
+    in
+    let local_nameassoc pos = pos |> localidx |> name in
+    let local_namemap pos =
+      start := pos;
+      pos |> vector local_nameassoc |> flush
+    in
+    table_section, global_section, elem_section, data_section, func, local_namemap
+
+  let table_section positions maps buf s =
+    let table_section, _, _, _, _, _ =
+      scanner (fun _ _ -> ()) (fun pos -> push_position positions pos) maps buf s
+    in
+    table_section
+
+  let global_section positions maps buf s =
+    let _, global_section, _, _, _, _ =
+      scanner (fun _ _ -> ()) (fun pos -> push_position positions pos) maps buf s
+    in
+    global_section
+
+  let elem_section maps buf s =
+    let _, _, elem_section, _, _, _ = scanner (fun _ _ -> ()) (fun _ -> ()) maps buf s in
+    elem_section
+
+  let data_section maps buf s =
+    let _, _, _, data_section, _, _ = scanner (fun _ _ -> ()) (fun _ -> ()) maps buf s in
+    data_section
+
+  let func resize_data maps buf s =
+    let _, _, _, _, func, _ =
+      scanner
+        (fun pos delta -> push_resize resize_data pos delta)
+        (fun _ -> ())
+        maps
+        buf
+        s
+    in
+    func
+
+  let local_namemap buf s =
+    let _, _, _, _, _, local_namemap =
+      scanner (fun _ _ -> ()) (fun _ -> ()) default_maps buf s
+    in
+    local_namemap
+end
+
+let interface types contents =
+  Read.type_section types contents;
+  Read.interface contents
+
+type t =
+  { module_name : string
+  ; file : string
+  ; contents : Read.t
+  ; source_map_contents : Wa_source_map.t option
+  }
+
+type import_status =
+  | Resolved of int * int
+  | Unresolved of int
+
+let check_limits export import =
+  export.min >= import.min
+  &&
+  match export.max, import.max with
+  | _, None -> true
+  | None, Some _ -> false
+  | Some e, Some i -> e <= i
+
+let rec subtype subtyping_info (i : int) i' =
+  i = i'
+  ||
+  match subtyping_info.(i).supertype with
+  | None -> false
+  | Some s -> subtype subtyping_info s i'
+
+let heap_subtype (subtyping_info : subtype array) (ty : heaptype) (ty' : heaptype) =
+  match ty, ty' with
+  | (Func | Nofunc), Func
+  | Nofunc, Nofunc
+  | (Extern | Noextern), Extern
+  | (Any | Eq | I31 | Struct | Array | None_ | Type _), Any
+  | (Eq | I31 | Struct | Array | None_ | Type _), Eq
+  | (I31 | None_), I31
+  | (Struct | None_), Struct
+  | (Array | None_), Array
+  | None_, None_ -> true
+  | Type i, Struct -> (
+      match subtyping_info.(i).typ with
+      | Struct _ -> true
+      | Array _ | Func _ -> false)
+  | Type i, Array -> (
+      match subtyping_info.(i).typ with
+      | Array _ -> true
+      | Struct _ | Func _ -> false)
+  | Type i, Func -> (
+      match subtyping_info.(i).typ with
+      | Func _ -> true
+      | Struct _ | Array _ -> false)
+  | Type i, Type i' -> subtype subtyping_info i i'
+  | _ -> false
+
+let ref_subtype subtyping_info { nullable; typ } { nullable = nullable'; typ = typ' } =
+  ((not nullable) || nullable') && heap_subtype subtyping_info typ typ'
+
+let val_subtype subtyping_info ty ty' =
+  match ty, ty' with
+  | Ref t, Ref t' -> ref_subtype subtyping_info t t'
+  | _ -> Stdlib.phys_equal ty ty'
+
+let check_export_import_types ~subtyping_info ~files i (desc : importdesc) i' import =
+  let ok =
+    match desc, import.desc with
+    | Func t, Func t' -> subtype subtyping_info t t'
+    | Table { limits; typ }, Table { limits = limits'; typ = typ' } ->
+        check_limits limits limits' && Poly.(typ = typ')
+    | Mem limits, Mem limits' -> check_limits limits limits'
+    | Global { mut; typ }, Global { mut = mut'; typ = typ' } ->
+        Bool.(mut = mut')
+        && if mut then Poly.(typ = typ') else val_subtype subtyping_info typ typ'
+    | Tag t, Tag t' -> t = t'
+    | _ -> false
+  in
+  if not ok
+  then
+    failwith
+      (Printf.sprintf
+         "In module %s, the import %s / %s refers to an export in module %s of an \
+          incompatible type"
+         files.(i').file
+         import.module_
+         import.name
+         files.(i).file)
+
+let build_mappings resolved_imports unresolved_imports kind counts =
+  let current_offset = ref (get_exportable_info unresolved_imports kind) in
+  let mappings =
+    Array.mapi
+      ~f:(fun i count ->
+        let imports = get_exportable_info resolved_imports.(i) kind in
+        let import_count = Array.length imports in
+        let offset = !current_offset - import_count in
+        current_offset := !current_offset + count;
+        Array.init
+          (Array.length imports + count)
+          ~f:(fun i ->
+            if i < import_count
+            then
+              match imports.(i) with
+              | Unresolved i -> i
+              | Resolved _ -> -1
+            else i + offset))
+      counts
+  in
+  Array.iteri
+    ~f:(fun i map ->
+      let imports = get_exportable_info resolved_imports.(i) kind in
+      for i = 0 to Array.length imports - 1 do
+        match imports.(i) with
+        | Unresolved _ -> ()
+        | Resolved (j, k) -> map.(i) <- mappings.(j).(k)
+      done)
+    mappings;
+  mappings
+
+let build_simple_mappings ~counts =
+  let current_offset = ref 0 in
+  Array.map
+    ~f:(fun count ->
+      let offset = !current_offset in
+      current_offset := !current_offset + count;
+      Array.init count ~f:(fun j -> j + offset))
+    counts
+
+let add_section out_ch ~id ?count buf =
+  match count with
+  | Some 0 -> Buffer.clear buf
+  | _ ->
+      let buf' = Buffer.create 5 in
+      Option.iter ~f:(fun c -> Write.uint buf' c) count;
+      output_byte out_ch id;
+      output_uint out_ch (Buffer.length buf' + Buffer.length buf);
+      Buffer.output_buffer out_ch buf';
+      Buffer.output_buffer out_ch buf;
+      Buffer.clear buf
+
+let add_subsection buf ~id ?count buf' =
+  match count with
+  | Some 0 -> Buffer.clear buf'
+  | _ ->
+      let buf'' = Buffer.create 5 in
+      Option.iter ~f:(fun c -> Write.uint buf'' c) count;
+      Buffer.add_char buf (Char.chr id);
+      Write.uint buf (Buffer.length buf'' + Buffer.length buf');
+      Buffer.add_buffer buf buf'';
+      Buffer.add_buffer buf buf';
+      Buffer.clear buf'
+
+let check_exports_against_imports
+    ~intfs
+    ~subtyping_info
+    ~resolved_imports
+    ~files
+    ~kind
+    ~to_desc =
+  Array.iteri
+    ~f:(fun i intf ->
+      let imports = get_exportable_info intf.Read.imports kind in
+      let statuses = get_exportable_info resolved_imports.(i) kind in
+      Array.iter2
+        ~f:(fun import status ->
+          match status with
+          | Unresolved _ -> ()
+          | Resolved (i', idx') -> (
+              match to_desc i' idx' with
+              | None -> ()
+              | Some desc ->
+                  check_export_import_types ~subtyping_info ~files i' desc i import))
+        imports
+        statuses)
+    intfs
+
+let read_desc_from_file ~intfs ~files ~positions ~read i j =
+  let offset = Array.length (get_exportable_info intfs.(i).Read.imports Table) in
+  if j < offset
+  then None
+  else
+    let { contents; _ } = files.(i) in
+    Read.seek_in contents.ch positions.(i).Scan.pos.(j - offset);
+    Some (read contents)
+
+let index_in_output ~unresolved_imports ~mappings ~kind ~get i' idx' =
+  let offset = get_exportable_info unresolved_imports kind in
+  let idx'' = mappings.(i').(idx') - offset in
+  if idx'' >= 0 then Some (get idx'') else None
+
+let write_simple_section
+    ~intfs
+    ~subtyping_info
+    ~resolved_imports
+    ~unresolved_imports
+    ~files
+    ~out_ch
+    ~buf
+    ~kind
+    ~id
+    ~read
+    ~to_type
+    ~write =
+  let data = Array.map ~f:(fun f -> read f.contents) files in
+  let entries = Array.concat (Array.to_list data) in
+  if Array.length entries <> 0
+  then (
+    write buf entries;
+    add_section out_ch ~id buf);
+  let counts = Array.map ~f:Array.length data in
+  let mappings = build_mappings resolved_imports unresolved_imports kind counts in
+  check_exports_against_imports
+    ~intfs
+    ~subtyping_info
+    ~resolved_imports
+    ~files
+    ~kind
+    ~to_desc:
+      (index_in_output ~unresolved_imports ~mappings ~kind ~get:(fun idx ->
+           to_type entries.(idx)));
+  mappings
+
+let write_section_with_scan ~files ~out_ch ~buf ~id ~scan =
+  let counts =
+    Array.mapi
+      ~f:(fun i { contents; _ } ->
+        if Read.find_section contents id
+        then (
+          let count = Read.uint contents.ch in
+          scan
+            i
+            { Scan.default_maps with typ = contents.type_mapping }
+            buf
+            contents.ch.buf
+            ~count
+            contents.ch.pos;
+          count)
+        else 0)
+      files
+  in
+  add_section out_ch ~id ~count:(Array.fold_left ~f:( + ) ~init:0 counts) buf;
+  counts
+
+let write_simple_namemap ~name_sections ~name_section_buffer ~buf ~section_id ~mappings =
+  let count = ref 0 in
+  Array.iter2
+    ~f:(fun name_section mapping ->
+      if Read.find_section name_section section_id
+      then (
+        let map = Read.namemap name_section in
+        Array.iter ~f:(fun (idx, name) -> Write.nameassoc buf mapping.(idx) name) map;
+        count := !count + Array.length map))
+    name_sections
+    mappings;
+  add_subsection name_section_buffer ~id:section_id ~count:!count buf
+
+let write_namemap
+    ~resolved_imports
+    ~unresolved_imports
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~kind
+    ~section_id
+    ~mappings =
+  let import_names = Array.make (get_exportable_info unresolved_imports kind) None in
+  Array.iteri
+    ~f:(fun i name_section ->
+      if Read.find_section name_section section_id
+      then
+        let imports = get_exportable_info resolved_imports.(i) kind in
+        let import_count = Array.length imports in
+        let n = Read.uint name_section.ch in
+        let rec loop j =
+          if j < n
+          then
+            let idx = Read.uint name_section.ch in
+            let name = Read.name name_section.ch in
+            if idx < import_count
+            then (
+              let idx' =
+                match imports.(idx) with
+                | Unresolved idx' -> idx'
+                | Resolved (i', idx') -> mappings.(i').(idx')
+              in
+              if idx' < Array.length import_names && Option.is_none import_names.(idx')
+              then import_names.(idx') <- Some name;
+              loop (j + 1))
+        in
+        loop 0)
+    name_sections;
+  let count = ref 0 in
+  Array.iteri
+    ~f:(fun idx name ->
+      match name with
+      | None -> ()
+      | Some name ->
+          incr count;
+          Write.nameassoc buf idx name)
+    import_names;
+  Array.iteri
+    ~f:(fun i name_section ->
+      if Read.find_section name_section section_id
+      then
+        let mapping = mappings.(i) in
+        let imports = get_exportable_info resolved_imports.(i) kind in
+        let import_count = Array.length imports in
+        let n = Read.uint name_section.ch in
+        let ch = name_section.ch in
+        for _ = 1 to n do
+          let idx = Read.uint ch in
+          let len = Read.uint ch in
+          if idx >= import_count
+          then (
+            incr count;
+            Write.uint buf mapping.(idx);
+            Write.uint buf len;
+            Buffer.add_substring buf ch.buf ch.pos len);
+          ch.pos <- ch.pos + len
+        done)
+    name_sections;
+  add_subsection name_section_buffer ~id:section_id ~count:!count buf
+
+let write_indirectnamemap ~name_sections ~name_section_buffer ~buf ~section_id ~mappings =
+  let count = ref 0 in
+  Array.iter2
+    ~f:(fun name_section mapping ->
+      if Read.find_section name_section section_id
+      then (
+        let n = Read.uint name_section.ch in
+        let scan_map = Scan.local_namemap buf name_section.ch.buf in
+        for _ = 1 to n do
+          let idx = mapping.(Read.uint name_section.ch) in
+          Write.uint buf idx;
+          let p = Buffer.length buf in
+          scan_map name_section.ch.pos;
+          name_section.ch.pos <- name_section.ch.pos + Buffer.length buf - p
+        done;
+        count := !count + n))
+    name_sections
+    mappings;
+  add_subsection name_section_buffer ~id:section_id ~count:!count buf
+
+let rec resolve
+    depth
+    ~files
+    ~intfs
+    ~subtyping_info
+    ~exports
+    ~kind
+    i
+    ({ module_; name; _ } as import) =
+  let i', index = Hashtbl.find exports (module_, name) in
+  let imports = get_exportable_info intfs.(i').Read.imports kind in
+  if index < Array.length imports
+  then (
+    if depth > 100 then failwith (Printf.sprintf "Import loop on %s %s" module_ name);
+    let entry = imports.(index) in
+    check_export_import_types ~subtyping_info ~files i' entry.desc i import;
+    try resolve (depth + 1) ~files ~intfs ~subtyping_info ~exports ~kind i' entry
+    with Not_found -> i', index)
+  else i', index
+
+type input =
+  { module_name : string
+  ; file : string
+  ; code : string option
+  ; opt_source_map : [ `File of string | `Data of string ] option
+  }
+
+let f files ~output_file ~opt_output_sourcemap_file =
+  let files =
+    let tmp_buf = Buffer.create 10000 in
+    Array.map
+      ~f:(fun { module_name; file; code; opt_source_map } ->
+        let data =
+          match code with
+          | None -> Fs.read_file file
+          | Some data -> data
+        in
+        let contents = Read.open_in file data in
+        { module_name
+        ; file
+        ; contents
+        ; source_map_contents =
+            Option.map
+              ~f:(fun src ->
+                match src with
+                | `File file -> Wa_source_map.load ~tmp_buf file
+                | `Data data -> Wa_source_map.parse ~tmp_buf data)
+              opt_source_map
+        })
+      (Array.of_list files)
+  in
+
+  let out_ch = open_out output_file in
+  output_string out_ch Read.header;
+  let buf = Buffer.create 100000 in
+
+  (* 1: type *)
+  let types = Read.create_types () in
+  let intfs = Array.map ~f:(fun f -> interface types f.contents) files in
+  let type_list = List.rev types.rev_list in
+  let subtyping_info = Array.concat type_list in
+  let st = Write.types buf (Array.of_list type_list) in
+  add_section out_ch ~id:1 buf;
+
+  (* 2: import *)
+  let exports = init_exportable_info (fun _ -> Hashtbl.create 128) in
+  Array.iteri
+    ~f:(fun i intf ->
+      iter_exportable_info
+        (fun kind lst ->
+          let h = get_exportable_info exports kind in
+          List.iter
+            ~f:(fun (name, index) ->
+              Hashtbl.add h (files.(i).module_name, name) (i, index))
+            lst)
+        intf.Read.exports)
+    intfs;
+  let import_list = ref [] in
+  let unresolved_imports = make_exportable_info 0 in
+  let resolved_imports =
+    let tbl = Hashtbl.create 128 in
+    Array.mapi
+      ~f:(fun i intf ->
+        map_exportable_info
+          (fun kind imports ->
+            let exports = get_exportable_info exports kind in
+            Array.map
+              ~f:(fun (import : import) ->
+                match resolve 0 ~files ~intfs ~subtyping_info ~exports ~kind i import with
+                | i', idx -> Resolved (i', idx)
+                | exception Not_found -> (
+                    match Hashtbl.find tbl import with
+                    | status -> status
+                    | exception Not_found ->
+                        let idx = get_exportable_info unresolved_imports kind in
+                        let status = Unresolved idx in
+                        Hashtbl.replace tbl import status;
+                        set_exportable_info unresolved_imports kind (1 + idx);
+                        import_list := import :: !import_list;
+                        status))
+              imports)
+          intf.Read.imports)
+      intfs
+  in
+  Write.imports st buf (Array.of_list (List.rev !import_list));
+  add_section out_ch ~id:2 buf;
+
+  let start_count =
+    Array.fold_left
+      ~f:(fun count f ->
+        match Read.start f.contents with
+        | None -> count
+        | Some _ -> count + 1)
+      ~init:0
+      files
+  in
+
+  (* 3: function *)
+  let functions = Array.map ~f:(fun f -> Read.functions f.contents) files in
+  let func_types =
+    let l = Array.to_list functions in
+    let l =
+      if start_count > 1
+      then
+        let ty =
+          let typ : comptype = Func { params = [||]; results = [||] } in
+          Read.add_rectype types [| { final = true; supertype = None; typ } |]
+        in
+        l @ [ [| ty |] ]
+      else l
+    in
+    Array.concat l
+  in
+  Write.functions buf func_types;
+  add_section out_ch ~id:3 buf;
+  let func_counts = Array.map ~f:Array.length functions in
+  let func_mappings =
+    build_mappings resolved_imports unresolved_imports Func func_counts
+  in
+  let func_count =
+    Array.fold_left ~f:( + ) ~init:(if start_count > 1 then 1 else 0) func_counts
+  in
+  check_exports_against_imports
+    ~intfs
+    ~subtyping_info
+    ~resolved_imports
+    ~files
+    ~kind:Func
+    ~to_desc:
+      (index_in_output
+         ~unresolved_imports
+         ~mappings:func_mappings
+         ~kind:Func
+         ~get:(fun idx : importdesc -> Func func_types.(idx)));
+
+  (* 4: table *)
+  let positions =
+    Array.init (Array.length files) ~f:(fun _ -> Scan.create_position_data ())
+  in
+  let table_counts =
+    write_section_with_scan ~files ~out_ch ~buf ~id:4 ~scan:(fun i maps ->
+        Scan.table_section positions.(i) { maps with func = func_mappings.(i) })
+  in
+  let table_mappings =
+    build_mappings resolved_imports unresolved_imports Table table_counts
+  in
+  check_exports_against_imports
+    ~intfs
+    ~subtyping_info
+    ~resolved_imports
+    ~files
+    ~kind:Table
+    ~to_desc:
+      (read_desc_from_file ~intfs ~files ~positions ~read:(fun contents : importdesc ->
+           Table (Read.tabletype contents contents.ch)));
+  Array.iter ~f:Scan.clear_position_data positions;
+
+  (* 5: memory *)
+  let mem_mappings =
+    write_simple_section
+      ~intfs
+      ~subtyping_info
+      ~resolved_imports
+      ~unresolved_imports
+      ~out_ch
+      ~buf
+      ~kind:Mem
+      ~id:5
+      ~read:Read.memories
+      ~to_type:(fun limits -> Mem limits)
+      ~write:Write.memories
+      ~files
+  in
+
+  (* 13: tag *)
+  let tag_mappings =
+    write_simple_section
+      ~intfs
+      ~subtyping_info
+      ~resolved_imports
+      ~unresolved_imports
+      ~out_ch
+      ~buf
+      ~kind:Tag
+      ~id:13
+      ~read:Read.tags
+      ~to_type:(fun ty -> Tag ty)
+      ~write:Write.tags
+      ~files
+  in
+
+  (* 6: global *)
+  let global_mappings = Array.make (Array.length files) [||] in
+  let global_counts =
+    let current_offset = ref (get_exportable_info unresolved_imports Global) in
+    Array.mapi
+      ~f:(fun i { file; contents; _ } ->
+        let imports = get_exportable_info resolved_imports.(i) Global in
+        let import_count = Array.length imports in
+        let offset = !current_offset - import_count in
+        let build_map count =
+          let map =
+            Array.init
+              (Array.length imports + count)
+              ~f:(fun j ->
+                if j < import_count
+                then (
+                  match imports.(j) with
+                  | Unresolved j' -> j'
+                  | Resolved (i', j') ->
+                      (if i' > i
+                       then
+                         let import =
+                           (get_exportable_info intfs.(i).imports Global).(j)
+                         in
+                         failwith
+                           (Printf.sprintf
+                              "In module %s, the import %s / %s refers to an export in a \
+                               later module %s"
+                              file
+                              import.module_
+                              import.name
+                              files.(i').file));
+                      global_mappings.(i').(j'))
+                else j + offset)
+          in
+          global_mappings.(i) <- map;
+          map
+        in
+        let count =
+          if Read.find_section contents 6
+          then (
+            let count = Read.uint contents.ch in
+            let map = build_map count in
+            Scan.global_section
+              positions.(i)
+              { Scan.default_maps with
+                typ = contents.type_mapping
+              ; func = func_mappings.(i)
+              ; global = map
+              }
+              buf
+              contents.ch.buf
+              contents.ch.pos
+              ~count;
+            count)
+          else (
+            ignore (build_map 0);
+            0)
+        in
+        current_offset := !current_offset + count;
+        count)
+      files
+  in
+  add_section out_ch ~id:6 ~count:(Array.fold_left ~f:( + ) ~init:0 global_counts) buf;
+  check_exports_against_imports
+    ~intfs
+    ~subtyping_info
+    ~resolved_imports
+    ~files
+    ~kind:Global
+    ~to_desc:(fun i j : importdesc option ->
+      let offset = Array.length (get_exportable_info intfs.(i).imports Global) in
+      if j < offset
+      then None
+      else
+        let { contents; _ } = files.(i) in
+        Read.seek_in contents.ch positions.(i).pos.(j - offset);
+        Some (Global (Read.globaltype contents contents.ch)));
+  Array.iter ~f:Scan.clear_position_data positions;
+
+  (* 7: export *)
+  let export_count =
+    Array.fold_left
+      ~f:(fun count intf ->
+        fold_exportable_info
+          (fun _ exports count -> List.length exports + count)
+          count
+          intf.Read.exports)
+      ~init:0
+      intfs
+  in
+  Write.uint buf export_count;
+  let exports = Hashtbl.create 128 in
+  Array.iteri
+    ~f:(fun i intf ->
+      iter_exportable_info
+        (fun kind lst ->
+          let map =
+            match kind with
+            | Func -> func_mappings.(i)
+            | Table -> table_mappings.(i)
+            | Mem -> mem_mappings.(i)
+            | Global -> global_mappings.(i)
+            | Tag -> tag_mappings.(i)
+          in
+          List.iter
+            ~f:(fun (name, idx) ->
+              match Hashtbl.find exports name with
+              | i' ->
+                  failwith
+                    (Printf.sprintf
+                       "Duplicated export %s from %s and %s"
+                       name
+                       files.(i').file
+                       files.(i).file)
+              | exception Not_found ->
+                  Hashtbl.add exports name i;
+                  Write.export buf kind name map.(idx))
+            lst)
+        intf.Read.exports)
+    intfs;
+  add_section out_ch ~id:7 buf;
+
+  (* 8: start *)
+  let starts =
+    Array.mapi
+      ~f:(fun i f ->
+        Read.start f.contents |> Option.map ~f:(fun idx -> func_mappings.(i).(idx)))
+      files
+    |> Array.to_list
+    |> List.filter_map ~f:(fun x -> x)
+  in
+  (match starts with
+  | [] -> ()
+  | [ start ] ->
+      Write.start buf start;
+      add_section out_ch ~id:8 buf
+  | _ :: _ :: _ ->
+      Write.start buf (func_count - 1);
+      add_section out_ch ~id:8 buf);
+
+  (* 9: elements *)
+  let elem_counts =
+    write_section_with_scan ~files ~out_ch ~buf ~id:9 ~scan:(fun i maps ->
+        Scan.elem_section
+          { maps with func = func_mappings.(i); global = global_mappings.(i) })
+  in
+  let elem_mappings = build_simple_mappings ~counts:elem_counts in
+
+  (* 12: data count *)
+  let data_mappings, data_count =
+    let data_counts = Array.map ~f:(fun f -> Read.data_count f.contents) files in
+    let data_count = Array.fold_left ~f:( + ) ~init:0 data_counts in
+    let data_mappings = build_simple_mappings ~counts:data_counts in
+    data_mappings, data_count
+  in
+  if data_count > 0
+  then (
+    Write.data_count buf data_count;
+    add_section out_ch ~id:12 buf);
+
+  (* 10: code *)
+  let code_pieces = Buffer.create 100000 in
+  let resize_data = Scan.create_resize_data () in
+  let source_maps = ref [] in
+  Write.uint code_pieces func_count;
+  Array.iteri
+    ~f:(fun i { contents; source_map_contents; _ } ->
+      if Read.find_section contents 10
+      then (
+        let pos = Buffer.length code_pieces in
+        let scan_func =
+          Scan.func
+            resize_data
+            { typ = contents.type_mapping
+            ; func = func_mappings.(i)
+            ; table = table_mappings.(i)
+            ; mem = mem_mappings.(i)
+            ; global = global_mappings.(i)
+            ; elem = elem_mappings.(i)
+            ; data = data_mappings.(i)
+            ; tag = tag_mappings.(i)
+            }
+            buf
+            contents.ch.buf
+        in
+        let code (ch : Read.ch) =
+          let pos = ch.pos in
+          let i = resize_data.i in
+          Scan.push_resize resize_data pos 0;
+          let size = Read.uint ch in
+          let pos' = ch.pos in
+          scan_func ch.pos;
+          ch.pos <- ch.pos + size;
+          let p = Buffer.length code_pieces in
+          Write.uint code_pieces (Buffer.length buf);
+          let p' = Buffer.length code_pieces in
+          let delta = p' - p - pos' + pos in
+          resize_data.delta.(i) <- delta;
+          Buffer.add_buffer code_pieces buf;
+          Buffer.clear buf
+        in
+        let count = Read.uint contents.ch in
+        Scan.clear_resize_data resize_data;
+        Scan.push_resize resize_data 0 (-Read.pos_in contents.ch);
+        Read.repeat' count code contents.ch;
+        Option.iter
+          ~f:(fun sm ->
+            if not (Wa_source_map.is_empty sm)
+            then source_maps := (pos, Wa_source_map.resize resize_data sm) :: !source_maps)
+          source_map_contents))
+    files;
+  if start_count > 1
+  then (
+    (* no local *)
+    Buffer.add_char buf (Char.chr 0);
+    List.iter
+      ~f:(fun idx ->
+        (* call idx *)
+        Buffer.add_char buf (Char.chr 0x10);
+        Write.uint buf idx)
+      starts;
+    Buffer.add_buffer code_pieces buf;
+    Buffer.clear buf);
+  let code_section_offset =
+    let b = Buffer.create 5 in
+    Write.uint b (Buffer.length code_pieces);
+    pos_out out_ch + 1 + Buffer.length b
+  in
+  add_section out_ch ~id:10 code_pieces;
+  Option.iter
+    ~f:(fun file ->
+      Wa_source_map.write
+        file
+        (Wa_source_map.concatenate
+           (List.map
+              ~f:(fun (pos, sm) -> pos + code_section_offset, sm)
+              (List.rev !source_maps))))
+    opt_output_sourcemap_file;
+
+  (* 11: data *)
+  ignore
+    (write_section_with_scan ~files ~out_ch ~buf ~id:11 ~scan:(fun i maps ->
+         Scan.data_section { maps with global = global_mappings.(i) }));
+
+  (* Custom section: name *)
+  let name_sections =
+    Array.map
+      ~f:(fun { contents; _ } -> Read.focus_on_custom_section contents "name")
+      files
+  in
+  let name_section_buffer = Buffer.create 100000 in
+  Write.name name_section_buffer "name";
+
+  (* 1: functions *)
+  write_namemap
+    ~resolved_imports
+    ~unresolved_imports
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~kind:Func
+    ~section_id:1
+    ~mappings:func_mappings;
+  (* 2: locals *)
+  write_indirectnamemap
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~section_id:2
+    ~mappings:func_mappings;
+  (* 3: labels *)
+  write_indirectnamemap
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~section_id:3
+    ~mappings:func_mappings;
+
+  (* 4: types *)
+  let type_names = Array.make types.last_index None in
+  Array.iter2
+    ~f:(fun { contents; _ } name_section ->
+      if Read.find_section name_section 4
+      then
+        let map = Read.namemap name_section in
+        Array.iter
+          ~f:(fun (idx, name) ->
+            let idx = contents.type_mapping.(idx) in
+            if Option.is_none type_names.(idx) then type_names.(idx) <- Some (idx, name))
+          map)
+    files
+    name_sections;
+  Write.namemap
+    buf
+    (Array.of_list (List.filter_map ~f:(fun x -> x) (Array.to_list type_names)));
+  add_subsection name_section_buffer ~id:4 buf;
+
+  (* 5: tables *)
+  write_namemap
+    ~resolved_imports
+    ~unresolved_imports
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~kind:Table
+    ~section_id:5
+    ~mappings:table_mappings;
+  (* 6: memories *)
+  write_namemap
+    ~resolved_imports
+    ~unresolved_imports
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~kind:Mem
+    ~section_id:6
+    ~mappings:mem_mappings;
+  (* 7: globals *)
+  write_namemap
+    ~resolved_imports
+    ~unresolved_imports
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~kind:Global
+    ~section_id:7
+    ~mappings:global_mappings;
+  (* 8: elems *)
+  write_simple_namemap
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~section_id:8
+    ~mappings:elem_mappings;
+  (* 9: data segments *)
+  write_simple_namemap
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~section_id:9
+    ~mappings:data_mappings;
+
+  (* 10: field names *)
+  let type_field_names = Array.make types.last_index None in
+  Array.iter2
+    ~f:(fun { contents; _ } name_section ->
+      if Read.find_section name_section 10
+      then
+        let n = Read.uint name_section.ch in
+        let scan_map = Scan.local_namemap buf name_section.ch.buf in
+        for _ = 1 to n do
+          let idx = contents.type_mapping.(Read.uint name_section.ch) in
+          scan_map name_section.ch.pos;
+          name_section.ch.pos <- name_section.ch.pos + Buffer.length buf;
+          if Option.is_none type_field_names.(idx)
+          then type_field_names.(idx) <- Some (idx, Buffer.contents buf);
+          Buffer.clear buf
+        done)
+    files
+    name_sections;
+  let type_field_names =
+    Array.of_list (List.filter_map ~f:(fun x -> x) (Array.to_list type_field_names))
+  in
+  Write.uint buf (Array.length type_field_names);
+  for i = 0 to Array.length type_field_names - 1 do
+    let idx, map = type_field_names.(i) in
+    Write.uint buf idx;
+    Buffer.add_string buf map
+  done;
+  add_subsection name_section_buffer ~id:10 buf;
+
+  (* 11: tags *)
+  write_namemap
+    ~resolved_imports
+    ~unresolved_imports
+    ~name_sections
+    ~name_section_buffer
+    ~buf
+    ~kind:Tag
+    ~section_id:11
+    ~mappings:tag_mappings;
+
+  add_section out_ch ~id:0 name_section_buffer;
+
+  close_out out_ch
+
+(*
+LATER
+- testsuite : import/export matching, source maps, multiple start functions, ...
+- missing instructions ==> typed continuations (?)
+- check features?
+
+MAYBE
+- topologic sort of globals?
+  => easy: just look at the import/export dependencies between modules
+- reorder types/globals/functions to generate a smaller binary
+*)
diff --git a/compiler/lib/wasm/wa_wasm_link.mli b/compiler/lib/wasm/wa_wasm_link.mli
new file mode 100644
index 0000000000..96f21db202
--- /dev/null
+++ b/compiler/lib/wasm/wa_wasm_link.mli
@@ -0,0 +1,9 @@
+type input =
+  { module_name : string
+  ; file : string
+  ; code : string option
+  ; opt_source_map : [ `File of string | `Data of string ] option
+  }
+
+val f :
+  input list -> output_file:string -> opt_output_sourcemap_file:string option -> unit

From 7d2d95c63f856afc8ba609e7378dc8e1b35485c5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 4 Jun 2024 14:22:58 +0200
Subject: [PATCH 334/481] Generate one single wasm file per cma archive

---
 compiler/bin-wasm_of_ocaml/compile.ml | 103 ++++++++++++-----
 compiler/lib/wasm/wa_link.ml          | 154 ++++++++++++++++----------
 compiler/lib/wasm/wa_link.mli         |   2 +
 3 files changed, 178 insertions(+), 81 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index d85c9fdb2f..5a0135aa44 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -214,6 +214,23 @@ let build_js_runtime ~primitives ?runtime_arguments () =
   in
   prelude ^ launcher
 
+let add_source_map sourcemap_don't_inline_content z opt_source_map_file =
+  Option.iter
+    ~f:(fun file ->
+      Zip.add_file z ~name:"source_map.map" ~file;
+      if not sourcemap_don't_inline_content
+      then
+        let sm = Wa_source_map.load file in
+        Wa_source_map.iter_sources sm (fun i j file ->
+            if Sys.file_exists file && not (Sys.is_directory file)
+            then
+              let sm = Fs.read_file file in
+              Zip.add_entry
+                z
+                ~name:(Wa_link.source_name i j file)
+                ~contents:(Yojson.Basic.to_string (`String sm))))
+    opt_source_map_file
+
 let run
     { Cmd_arg.common
     ; profile
@@ -332,7 +349,7 @@ let run
        let include_dirs = Filename.dirname input_file :: include_dirs in
        res, ch, (fun () -> close_in ch), include_dirs
      in
-     let compile_cmo z cmo =
+     let compile_cmo cmo cont =
        let t1 = Timer.make () in
        let code =
          Parse_bytecode.from_cmo
@@ -345,31 +362,29 @@ let run
        let unit_info = Unit_info.of_cmo cmo in
        let unit_name = Ocaml_compiler.Cmo_format.name cmo in
        if times () then Format.eprintf "  parsing: %a (%s)@." Timer.print t1 unit_name;
-       Fs.with_intermediate_file (Filename.temp_file unit_name ".wat")
-       @@ fun wat_file ->
        Fs.with_intermediate_file (Filename.temp_file unit_name ".wasm")
        @@ fun tmp_wasm_file ->
-       Fs.with_intermediate_file (Filename.temp_file unit_name ".wasm.map")
-       @@ fun tmp_map_file ->
-       let strings, fragments =
-         output_gen wat_file (output code ~unit_name:(Some unit_name))
-       in
-       let opt_output_sourcemap =
-         if enable_source_maps then Some tmp_map_file else None
+       opt_with
+         Fs.with_intermediate_file
+         (if enable_source_maps
+          then Some (Filename.temp_file unit_name ".wasm.map")
+          else None)
+       @@ fun opt_tmp_map_file ->
+       let unit_data =
+         Fs.with_intermediate_file (Filename.temp_file unit_name ".wat")
+         @@ fun wat_file ->
+         let strings, fragments =
+           output_gen wat_file (output code ~unit_name:(Some unit_name))
+         in
+         Wa_binaryen.optimize
+           ~profile
+           ~opt_input_sourcemap:None
+           ~opt_output_sourcemap:opt_tmp_map_file
+           ~input_file:wat_file
+           ~output_file:tmp_wasm_file;
+         { Wa_link.unit_name; unit_info; strings; fragments }
        in
-       Wa_binaryen.optimize
-         ~profile
-         ~opt_input_sourcemap:None
-         ~opt_output_sourcemap
-         ~input_file:wat_file
-         ~output_file:tmp_wasm_file;
-       Option.iter
-         ~f:(update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content)
-         opt_output_sourcemap;
-       Zip.add_file z ~name:(unit_name ^ ".wasm") ~file:tmp_wasm_file;
-       if enable_source_maps
-       then Zip.add_file z ~name:(unit_name ^ ".wasm.map") ~file:tmp_map_file;
-       { Wa_link.unit_name; unit_info; strings; fragments }
+       cont unit_data unit_name tmp_wasm_file opt_tmp_map_file
      in
      (match kind with
      | `Exe ->
@@ -448,14 +463,52 @@ let run
          Fs.gen_file output_file
          @@ fun tmp_output_file ->
          let z = Zip.open_out tmp_output_file in
-         let unit_data = [ compile_cmo z cmo ] in
+         let compile_cmo' z cmo =
+           compile_cmo cmo (fun unit_data _ tmp_wasm_file opt_tmp_map_file ->
+               Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file;
+               add_source_map sourcemap_don't_inline_content z opt_tmp_map_file;
+               unit_data)
+         in
+         let unit_data = [ compile_cmo' z cmo ] in
          Wa_link.add_info z ~build_info:(Build_info.create `Cmo) ~unit_data ();
          Zip.close_out z
      | `Cma cma ->
          Fs.gen_file output_file
          @@ fun tmp_output_file ->
          let z = Zip.open_out tmp_output_file in
-         let unit_data = List.map ~f:(fun cmo -> compile_cmo z cmo) cma.lib_units in
+         let unit_data =
+           List.fold_right
+             ~f:(fun cmo cont l ->
+               compile_cmo cmo
+               @@ fun unit_data unit_name tmp_wasm_file opt_tmp_map_file ->
+               cont ((unit_data, unit_name, tmp_wasm_file, opt_tmp_map_file) :: l))
+             cma.lib_units
+             ~init:(fun l ->
+               Fs.with_intermediate_file (Filename.temp_file "wasm" ".wasm")
+               @@ fun tmp_wasm_file ->
+               opt_with
+                 Fs.with_intermediate_file
+                 (if enable_source_maps
+                  then Some (Filename.temp_file "wasm" ".map")
+                  else None)
+               @@ fun opt_output_sourcemap_file ->
+               let l = List.rev l in
+               Wa_wasm_link.f
+                 (List.map
+                    ~f:(fun (_, _, file, opt_source_map) ->
+                      { Wa_wasm_link.module_name = "OCaml"
+                      ; file
+                      ; code = None
+                      ; opt_source_map = Option.map ~f:(fun f -> `File f) opt_source_map
+                      })
+                    l)
+                 ~output_file:tmp_wasm_file
+                 ~opt_output_sourcemap_file;
+               Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file;
+               add_source_map sourcemap_don't_inline_content z opt_output_sourcemap_file;
+               List.map ~f:(fun (unit_data, _, _, _) -> unit_data) l)
+             []
+         in
          Wa_link.add_info z ~build_info:(Build_info.create `Cma) ~unit_data ();
          Zip.close_out z);
      close_ic ());
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index ce09e7082e..e2282b316b 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -570,11 +570,44 @@ let build_runtime_arguments
     ; "src", EStr (Utf8_string.of_string_exn (Filename.basename wasm_dir))
     ]
 
-let link_to_directory ~set_to_link ~files ~enable_source_maps ~dir =
-  let process_file z ~name =
+let source_name i j file =
+  let prefix =
+    match i, j with
+    | None, None -> "src-"
+    | Some i, None -> Printf.sprintf "src-%d-" i
+    | None, Some j -> Printf.sprintf "src-%d-" j
+    | Some i, Some j -> Printf.sprintf "src-%d.%d-" i j
+  in
+  prefix ^ Filename.basename file ^ ".json"
+
+let extract_source_map ~dir ~name z =
+  if Zip.has_entry z ~name:"source_map.map"
+  then (
+    let sm = Wa_source_map.parse (Zip.read_entry z ~name:"source_map.map") in
+    let sm =
+      let rewrite_path path =
+        if Filename.is_relative path
+        then path
+        else
+          match Build_path_prefix_map.get_build_path_prefix_map () with
+          | Some map -> Build_path_prefix_map.rewrite map path
+          | None -> path
+      in
+      Wa_source_map.insert_source_contents ~rewrite_path sm (fun i j file ->
+          let name = source_name i j file in
+          if Zip.has_entry z ~name then Some (Zip.read_entry z ~name) else None)
+    in
+    let map_name = name ^ ".wasm.map" in
+    Wa_source_map.write (Filename.concat dir map_name) sm;
+    Wasm_binary.append_source_map_section
+      ~file:(Filename.concat dir (name ^ ".wasm"))
+      ~url:map_name)
+
+let link_to_directory ~files_to_link ~files ~enable_source_maps ~dir =
+  let process_file z ~name ~name' =
     let ch, pos, len, crc = Zip.get_entry z ~name:(name ^ ".wasm") in
     let intf = Wasm_binary.read_interface (Wasm_binary.from_channel ~name ch pos len) in
-    let name' = Printf.sprintf "%s-%08lx" name crc in
+    let name' = Printf.sprintf "%s-%08lx" name' crc in
     Zip.extract_file
       z
       ~name:(name ^ ".wasm")
@@ -582,50 +615,48 @@ let link_to_directory ~set_to_link ~files ~enable_source_maps ~dir =
     name', intf
   in
   let z = Zip.open_in (fst (List.hd files)) in
-  let runtime, runtime_intf = process_file z ~name:"runtime" in
-  let prelude, _ = process_file z ~name:"prelude" in
+  let runtime, runtime_intf = process_file z ~name:"runtime" ~name':"runtime" in
+  let prelude, _ = process_file z ~name:"prelude" ~name':"prelude" in
   Zip.close_in z;
   let lst =
-    List.map
-      ~f:(fun (file, (_, units)) ->
-        let z = Zip.open_in file in
-        let res =
-          List.map
-            ~f:(fun { unit_name; unit_info; _ } ->
-              if StringSet.mem unit_name set_to_link
-              then (
-                let name = unit_name ^ ".wasm" in
-                let res = process_file z ~name:unit_name in
-                let map = name ^ ".map" in
-                if enable_source_maps && Zip.has_entry z ~name:map
-                then Zip.extract_file z ~name:map ~file:(Filename.concat dir map);
-                Some res)
-              else None)
-            units
-        in
-        Zip.close_in z;
-        List.filter_map ~f:(fun x -> x) res)
-      files
-    |> List.flatten
+    List.tl files
+    |> List.map ~f:(fun (file, _) ->
+           if StringSet.mem file files_to_link
+           then (
+             let z = Zip.open_in file in
+             let name' = file |> Filename.basename |> Filename.remove_extension in
+             let ((name', _) as res) = process_file z ~name:"code" ~name' in
+             if enable_source_maps then extract_source_map ~dir ~name:name' z;
+             Zip.close_in z;
+             Some res)
+           else None)
+    |> List.filter_map ~f:(fun x -> x)
   in
   runtime :: prelude :: List.map ~f:fst lst, (runtime_intf, List.map ~f:snd lst)
 
-let compute_dependencies ~set_to_link ~files =
+let compute_dependencies ~files_to_link ~files =
   let h = Hashtbl.create 128 in
-  let l = List.concat (List.map ~f:(fun (_, (_, units)) -> units) files) in
+  let i = ref 2 in
   List.filter_map
-    ~f:(fun { unit_name; unit_info; _ } ->
-      if StringSet.mem unit_name set_to_link
+    ~f:(fun (file, (_, units)) ->
+      if StringSet.mem file files_to_link
       then (
-        Hashtbl.add h unit_name (Hashtbl.length h);
-        Some
-          (Some
-             (List.sort ~cmp:compare
-             @@ List.filter_map
-                  ~f:(fun req -> Option.map ~f:(fun i -> i + 2) (Hashtbl.find_opt h req))
-                  (StringSet.elements unit_info.requires))))
+        let s =
+          List.fold_left
+            ~f:(fun s { unit_info; _ } ->
+              StringSet.fold
+                (fun unit_name s ->
+                  try IntSet.add (Hashtbl.find h unit_name) s with Not_found -> s)
+                unit_info.requires
+                s)
+            ~init:IntSet.empty
+            units
+        in
+        List.iter ~f:(fun { unit_name; _ } -> Hashtbl.add h unit_name !i) units;
+        incr i;
+        Some (Some (IntSet.elements s)))
       else None)
-    l
+    (List.tl files)
 
 let compute_missing_primitives (runtime_intf, intfs) =
   let provided_primitives = StringSet.of_list runtime_intf.Wasm_binary.exports in
@@ -683,7 +714,33 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
            r));
   if times () then Format.eprintf "    reading information: %a@." Timer.print t;
   let t1 = Timer.make () in
-  let missing, to_link =
+  let missing, files_to_link =
+    List.fold_right
+      files
+      ~init:(StringSet.empty, StringSet.empty)
+      ~f:(fun (file, (build_info, units)) (requires, files_to_link) ->
+        let cmo_file =
+          match Build_info.kind build_info with
+          | `Cmo -> true
+          | `Cma | `Exe | `Runtime | `Unknown -> false
+        in
+        if (not (Config.Flag.auto_link ()))
+           || cmo_file
+           || linkall
+           || List.exists ~f:(fun { unit_info; _ } -> unit_info.force_link) units
+           || List.exists
+                ~f:(fun { unit_info; _ } ->
+                  not (StringSet.is_empty (StringSet.inter requires unit_info.provides)))
+                units
+        then
+          ( List.fold_right units ~init:requires ~f:(fun { unit_info; _ } requires ->
+                StringSet.diff
+                  (StringSet.union unit_info.requires requires)
+                  unit_info.provides)
+          , StringSet.add file files_to_link )
+        else requires, files_to_link)
+  in
+  let _, to_link =
     List.fold_right
       files
       ~init:(StringSet.empty, [])
@@ -709,21 +766,6 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
               , unit_name :: to_link )
             else requires, to_link))
   in
-  let set_to_link = StringSet.of_list to_link in
-  let files =
-    if linkall
-    then files
-    else
-      List.filter
-        ~f:(fun (_file, (build_info, units)) ->
-          (match Build_info.kind build_info with
-          | `Cma | `Exe | `Unknown -> false
-          | `Cmo | `Runtime -> true)
-          || List.exists
-               ~f:(fun { unit_name; _ } -> StringSet.mem unit_name set_to_link)
-               units)
-        files
-  in
   let missing = StringSet.diff missing predefined_exceptions in
   if not (StringSet.is_empty missing)
   then
@@ -750,11 +792,11 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
       ~to_link
       ~out_file:(Filename.concat tmp_dir (start_module ^ ".wasm"));
     let module_names, interfaces =
-      link_to_directory ~set_to_link ~files ~enable_source_maps ~dir:tmp_dir
+      link_to_directory ~files_to_link ~files ~enable_source_maps ~dir:tmp_dir
     in
     ( interfaces
     , dir
-    , let to_link = compute_dependencies ~set_to_link ~files in
+    , let to_link = compute_dependencies ~files_to_link ~files in
       List.combine module_names (None :: None :: to_link) @ [ start_module, None ] )
   in
   let missing_primitives = compute_missing_primitives interfaces in
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index b4a95ec697..bed24894a8 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -62,3 +62,5 @@ val link :
   -> enable_source_maps:bool
   -> files:string list
   -> unit
+
+val source_name : int option -> int option -> string -> string

From 5a458047774e928f6a5ec21adc4d3af63541b97c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 4 Jun 2024 14:39:57 +0200
Subject: [PATCH 335/481] Wasm output

---
 compiler/lib/wasm/wa_wasm_output.ml  | 1184 ++++++++++++++++++++++++++
 compiler/lib/wasm/wa_wasm_output.mli |    1 +
 2 files changed, 1185 insertions(+)
 create mode 100644 compiler/lib/wasm/wa_wasm_output.ml
 create mode 100644 compiler/lib/wasm/wa_wasm_output.mli

diff --git a/compiler/lib/wasm/wa_wasm_output.ml b/compiler/lib/wasm/wa_wasm_output.ml
new file mode 100644
index 0000000000..f90543581b
--- /dev/null
+++ b/compiler/lib/wasm/wa_wasm_output.ml
@@ -0,0 +1,1184 @@
+open! Stdlib
+open Wa_ast
+
+module Feature : sig
+  type set
+
+  val make : unit -> set
+
+  val get : set -> string list
+
+  type t
+
+  val register : set -> string -> t
+
+  val require : t -> unit
+
+  val test : t -> bool
+end = struct
+  type t = string * bool ref
+
+  type set = t list ref
+
+  let make () = ref []
+
+  let get l = !l |> List.filter ~f:(fun (_, b) -> !b) |> List.map ~f:fst
+
+  let register l name =
+    let f = name, ref false in
+    l := f :: !l;
+    f
+
+  let require (_, b) = b := true
+
+  let test (_, b) = !b
+end
+
+module Make (Output : sig
+  type t
+
+  val position : t -> int
+
+  val seek : t -> int -> unit
+
+  val byte : t -> int -> unit
+
+  val string : t -> string -> unit
+end) : sig
+  val output_module : Output.t -> module_field list -> unit
+end = struct
+  let features = Feature.make ()
+
+  let mutable_globals = Feature.register features "mutable-globals"
+
+  let nontrapping_fptoint = Feature.register features "nontrapping-fptoint"
+
+  let multivalue = Feature.register features "multivalue"
+
+  let exception_handling = Feature.register features "exception-handling"
+
+  let tail_call = Feature.register features "tail-call"
+
+  let bulk_memory = Feature.register features "bulk-memory"
+
+  let gc = Feature.register features "gc"
+
+  let reference_types = Feature.register features "reference-types"
+
+  let position = Output.position
+
+  let seek = Output.seek
+
+  let output_byte = Output.byte
+
+  let output_string = Output.string
+
+  let rec output_uint ch i =
+    if i < 128
+    then output_byte ch i
+    else (
+      output_byte ch (128 + (i land 127));
+      output_uint ch (i lsr 7))
+
+  let rec output_sint ch i =
+    if i >= -64 && i < 64
+    then output_byte ch (i land 127)
+    else (
+      output_byte ch (128 + (i land 127));
+      output_sint ch (i asr 7))
+
+  let output_sint32 ch i =
+    if Poly.(i >= -64l && i < 64l)
+    then
+      let i = Int32.to_int i in
+      if i >= 0 then output_byte ch i else output_byte ch (i + 128)
+    else (
+      output_byte ch (128 + (Int32.to_int i land 127));
+      output_sint ch (Int32.to_int (Int32.shift_right i 7)))
+
+  let rec output_sint64 ch i =
+    if Poly.(i >= -64L && i < 64L)
+    then
+      let i = Int64.to_int i in
+      if i >= 0 then output_byte ch i else output_byte ch (i + 128)
+    else (
+      output_byte ch (128 + (Int64.to_int i land 127));
+      output_sint64 ch (Int64.shift_right i 7))
+
+  let output_bytes32 ch v =
+    let v = ref v in
+    for _ = 0 to 3 do
+      output_byte ch (Int32.to_int !v land 255);
+      v := Int32.shift_right !v 8
+    done
+
+  let output_bytes64 ch v =
+    let v = ref v in
+    for _ = 0 to 7 do
+      output_byte ch (Int64.to_int !v land 255);
+      v := Int64.shift_right !v 8
+    done
+
+  let output_f32 ch f = output_bytes32 ch (Int32.bits_of_float f)
+
+  let output_f64 ch f = output_bytes64 ch (Int64.bits_of_float f)
+
+  let output_name ch name =
+    output_uint ch (String.length name);
+    output_string ch name
+
+  let output_vec f ch l =
+    output_uint ch (List.length l);
+    List.iter ~f:(fun x -> f ch x) l
+
+  let output_uint32_placeholder ch =
+    let pos = position ch in
+    output_string ch "\x80\x80\x80\x80\x00";
+    pos
+
+  let output_uint32_fixed ch ~pos v =
+    let pos' = position ch in
+    seek ch pos;
+    let v = ref v in
+    for _ = 0 to 3 do
+      output_byte ch ((!v land 0x7f) + 128);
+      v := !v lsr 7
+    done;
+    output_byte ch !v;
+    seek ch pos'
+
+  let with_size f ch x =
+    let pos = output_uint32_placeholder ch in
+    let res = f ch x in
+    output_uint32_fixed ch ~pos (position ch - pos - 5);
+    res
+
+  (****)
+  let output_heaptype type_names ch typ =
+    match (typ : heap_type) with
+    | Func -> output_byte ch 0x70
+    | Extern -> output_byte ch 0x6F
+    | Any -> output_byte ch 0x6E
+    | Eq -> output_byte ch 0x6D
+    | I31 -> output_byte ch 0x6C
+    | Type nm -> output_sint ch (Hashtbl.find type_names nm)
+
+  let output_valtype type_names ch (typ : value_type) =
+    match typ with
+    | I32 -> output_byte ch 0x7F
+    | I64 -> output_byte ch 0x7E
+    | F32 -> output_byte ch 0x7D
+    | F64 -> output_byte ch 0x7C
+    | Ref { nullable; typ } ->
+        output_byte ch (if nullable then 0x63 else 0x64);
+        output_heaptype type_names ch typ
+
+  let output_mut ch mut = output_byte ch (if mut then 0x01 else 0x00)
+
+  let output_fieldtype type_names ch { mut; typ } =
+    (match typ with
+    | Value typ -> output_valtype type_names ch typ
+    | Packed typ -> (
+        match typ with
+        | I8 -> output_byte ch 0x78
+        | I16 -> output_byte ch 0x77));
+    output_mut ch mut
+
+  let output_functype type_names ch { params; result } =
+    if List.length result > 1 then Feature.require multivalue;
+    output_byte ch 0x60;
+    output_vec (output_valtype type_names) ch params;
+    output_vec (output_valtype type_names) ch result
+
+  let output_globaltype type_names ch { typ; mut } =
+    output_valtype type_names ch typ;
+    output_mut ch mut
+
+  let fold_types func_type explicit_definition acc fields =
+    List.fold_left
+      ~f:(fun acc field ->
+        match field with
+        | Function { typ; _ } | Import { desc = Fun typ; _ } -> func_type acc typ
+        | Import { desc = Tag typ; _ } -> func_type acc { params = [ typ ]; result = [] }
+        | Type l -> explicit_definition acc l
+        | Import { desc = Global _; _ } | Data _ | Global _ | Tag _ -> acc)
+      ~init:acc
+      fields
+
+  let output_types ch fields =
+    let count =
+      let func_types = Hashtbl.create 16 in
+      fold_types
+        (fun count typ ->
+          if Hashtbl.mem func_types typ
+          then count
+          else (
+            Hashtbl.add func_types typ ();
+            count + 1))
+        (fun count _ -> count + 1)
+        0
+        fields
+    in
+    output_uint ch count;
+    let func_types = Hashtbl.create 16 in
+    let type_names = Hashtbl.create 16 in
+    let _idx =
+      fold_types
+        (fun idx typ ->
+          if Hashtbl.mem func_types typ
+          then idx
+          else (
+            Hashtbl.add func_types typ idx;
+            output_functype type_names ch typ;
+            idx + 1))
+        (fun idx l ->
+          let len = List.length l in
+          if List.length l > 1
+          then (
+            output_byte ch 0x4E;
+            output_uint ch len);
+          List.fold_left
+            ~f:(fun idx { name; typ; supertype; final } ->
+              Hashtbl.add type_names name idx;
+              (match supertype, final with
+              | None, true -> ()
+              | None, false ->
+                  output_byte ch 0x50;
+                  output_byte ch 0
+              | Some supertype, _ ->
+                  output_byte ch (if final then 0X4F else 0x50);
+                  output_byte ch 1;
+                  output_uint ch (Hashtbl.find type_names supertype));
+              (match typ with
+              | Array field_type ->
+                  output_byte ch 0x5E;
+                  output_fieldtype type_names ch field_type
+              | Struct l ->
+                  output_byte ch 0x5F;
+                  output_vec (output_fieldtype type_names) ch l
+              | Func typ -> output_functype type_names ch typ);
+              idx + 1)
+            ~init:idx
+            l)
+        0
+        fields
+    in
+    func_types, type_names
+
+  let output_imports ch (func_types, type_names, fields) =
+    let count =
+      List.fold_left
+        ~f:(fun count field ->
+          match field with
+          | Import _ -> count + 1
+          | Function _ | Type _ | Data _ | Global _ | Tag _ -> count)
+        ~init:0
+        fields
+    in
+    output_uint ch count;
+    let func_idx = ref 0 in
+    let func_names = Hashtbl.create 16 in
+    let global_idx = ref 0 in
+    let global_names = Hashtbl.create 16 in
+    let tag_idx = ref 0 in
+    let tag_names = Hashtbl.create 16 in
+    List.iter
+      ~f:(fun field ->
+        match field with
+        | Function _ | Type _ | Data _ | Global _ | Tag _ -> ()
+        | Import { import_module; import_name; name; desc } -> (
+            output_name ch import_module;
+            output_name ch import_name;
+            match desc with
+            | Fun typ ->
+                output_byte ch 0x00;
+                output_uint ch (Hashtbl.find func_types typ);
+                Hashtbl.add func_names name !func_idx;
+                incr func_idx
+            | Global typ ->
+                if typ.mut then Feature.require mutable_globals;
+                output_byte ch 0x03;
+                output_globaltype type_names ch typ;
+                Hashtbl.add global_names (V name) !global_idx;
+                incr global_idx
+            | Tag typ ->
+                Feature.require exception_handling;
+                output_byte ch 0x04;
+                output_byte ch 0x00;
+                output_uint ch (Hashtbl.find func_types { params = [ typ ]; result = [] });
+                Hashtbl.add tag_names name !tag_idx;
+                incr tag_idx))
+      fields;
+    !func_idx, func_names, !global_idx, global_names, !tag_idx, tag_names
+
+  let output_functions ch (func_idx, func_names, func_types, fields) =
+    let l =
+      List.fold_left
+        ~f:(fun acc field ->
+          match field with
+          | Function { typ; _ } -> typ :: acc
+          | Type _ | Import _ | Data _ | Global _ | Tag _ -> acc)
+        ~init:[]
+        fields
+    in
+    let _ =
+      List.fold_left
+        ~f:(fun idx field ->
+          match field with
+          | Function { name; _ } ->
+              Hashtbl.add func_names name idx;
+              idx + 1
+          | Type _ | Import _ | Data _ | Global _ | Tag _ -> idx)
+        ~init:func_idx
+        fields
+    in
+    output_vec
+      (fun ch typ -> output_uint ch (Hashtbl.find func_types typ))
+      ch
+      (List.rev l)
+
+  let int_un_op (arith, comp, trunc, reinterpret) ch op =
+    match op with
+    | Clz -> output_byte ch arith
+    | Ctz -> output_byte ch (arith + 1)
+    | Popcnt -> output_byte ch (arith + 2)
+    | Eqz -> output_byte ch comp
+    | TruncSatF64 signage ->
+        Feature.require nontrapping_fptoint;
+        output_byte ch 0xFC;
+        output_byte
+          ch
+          (trunc
+          +
+          match signage with
+          | S -> 0
+          | U -> 1)
+    | ReinterpretF -> output_byte ch reinterpret
+
+  let int_bin_op (arith, comp) op =
+    match (op : int_bin_op) with
+    | Add -> arith + 3
+    | Sub -> arith + 4
+    | Mul -> arith + 5
+    | Div S -> arith + 6
+    | Div U -> arith + 7
+    | Rem S -> arith + 8
+    | Rem U -> arith + 9
+    | And -> arith + 10
+    | Or -> arith + 11
+    | Xor -> arith + 12
+    | Shl -> arith + 13
+    | Shr S -> arith + 14
+    | Shr U -> arith + 15
+    | Rotl -> arith + 16
+    | Rotr -> arith + 17
+    | Eq -> comp + 1
+    | Ne -> comp + 2
+    | Lt S -> comp + 3
+    | Lt U -> comp + 4
+    | Gt S -> comp + 5
+    | Gt U -> comp + 6
+    | Le S -> comp + 7
+    | Le U -> comp + 8
+    | Ge S -> comp + 9
+    | Ge U -> comp + 10
+
+  let float_un_op (arith, convert, reinterpret) op =
+    match op with
+    | Abs -> arith
+    | Neg -> arith + 1
+    | Ceil -> arith + 2
+    | Floor -> arith + 3
+    | Trunc -> arith + 4
+    | Nearest -> arith + 5
+    | Sqrt -> arith + 6
+    | Convert (size, signage) -> (
+        convert
+        + (match size with
+          | `I32 -> 0
+          | `I64 -> 2)
+        +
+        match signage with
+        | S -> 0
+        | U -> 1)
+    | ReinterpretI -> reinterpret
+
+  let float_bin_op (arith, comp) op =
+    match op with
+    | Add -> arith + 7
+    | Sub -> arith + 8
+    | Mul -> arith + 9
+    | Div -> arith + 10
+    | Min -> arith + 11
+    | Max -> arith + 12
+    | CopySign -> arith + 13
+    | Eq -> comp
+    | Ne -> comp + 1
+    | Lt -> comp + 2
+    | Gt -> comp + 3
+    | Le -> comp + 4
+    | Ge -> comp + 5
+
+  let output_blocktype type_names ch typ =
+    match typ with
+    | { params = []; result = [] } -> output_byte ch 0x40
+    | { params = []; result = [ typ ] } -> output_valtype type_names ch typ
+    | _ -> assert false
+
+  type st =
+    { type_names : (var, int) Hashtbl.t
+    ; func_names : (var, int) Hashtbl.t
+    ; global_names : (symbol, int) Hashtbl.t
+    ; data_names : (var, int) Hashtbl.t
+    ; tag_names : (var, int) Hashtbl.t
+    ; local_names : (var, (var, int) Hashtbl.t) Hashtbl.t
+    ; current_local_names : (var, int) Hashtbl.t
+    }
+
+  let rec output_expression st ch e =
+    match e with
+    | Const c -> (
+        match c with
+        | I32 d ->
+            output_byte ch 0x41;
+            output_sint32 ch d
+        | I64 d ->
+            output_byte ch 0x42;
+            output_sint64 ch d
+        | F32 d ->
+            output_byte ch 0x43;
+            output_f32 ch d
+        | F64 d ->
+            output_byte ch 0x44;
+            output_f64 ch d)
+    | UnOp (op, e') -> (
+        output_expression st ch e';
+        match op with
+        | I32 op -> int_un_op (0x67, 0x45, 2, 0xBC) ch op
+        | I64 op -> int_un_op (0x79, 0x50, 6, 0xBD) ch op
+        | F32 op -> output_byte ch (float_un_op (0x8B, 0xB2, 0xBE) op)
+        | F64 op -> output_byte ch (float_un_op (0x99, 0xB7, 0xBF) op))
+    | BinOp (op, e', e'') -> (
+        output_expression st ch e';
+        output_expression st ch e'';
+        match op with
+        | I32 op -> output_byte ch (int_bin_op (0x67, 0x45) op)
+        | I64 op -> output_byte ch (int_bin_op (0x79, 0x50) op)
+        | F32 op -> output_byte ch (float_bin_op (0x8B, 0x5B) op)
+        | F64 op -> output_byte ch (float_bin_op (0x99, 0x61) op))
+    | I32WrapI64 e' ->
+        output_expression st ch e';
+        output_byte ch 0xA7
+    | I64ExtendI32 (S, e') ->
+        output_expression st ch e';
+        output_byte ch 0xAC
+    | I64ExtendI32 (U, e') ->
+        output_expression st ch e';
+        output_byte ch 0xAD
+    | F32DemoteF64 e' ->
+        output_expression st ch e';
+        output_byte ch 0xB6
+    | F64PromoteF32 e' ->
+        output_expression st ch e';
+        output_byte ch 0xBB
+    | Call_indirect _ | ConstSym _ | Load _ | Load8 _ | MemoryGrow _ -> assert false
+    | LocalGet i ->
+        output_byte ch 0x20;
+        output_uint ch (Hashtbl.find st.current_local_names i)
+    | LocalTee (i, e') ->
+        output_expression st ch e';
+        output_byte ch 0x22;
+        output_uint ch (Hashtbl.find st.current_local_names i)
+    | GlobalGet g ->
+        output_byte ch 0x23;
+        output_uint ch (Hashtbl.find st.global_names g)
+    | BlockExpr (typ, l) ->
+        output_byte ch 0x02;
+        output_blocktype st.type_names ch typ;
+        List.iter ~f:(fun i' -> output_instruction st ch i') l;
+        output_byte ch 0x0B
+    | Call (f, l) ->
+        List.iter ~f:(fun e' -> output_expression st ch e') l;
+        output_byte ch 0x10;
+        output_uint ch (Hashtbl.find st.func_names f)
+    | Seq _ -> assert false
+    | Pop _ -> ()
+    | RefFunc f ->
+        Feature.require reference_types;
+        output_byte ch 0xD2;
+        output_uint ch (Hashtbl.find st.func_names f)
+    | Call_ref (typ, e', l) ->
+        Feature.require gc;
+        List.iter ~f:(fun e' -> output_expression st ch e') l;
+        output_expression st ch e';
+        output_byte ch 0x14;
+        output_uint ch (Hashtbl.find st.type_names typ)
+    | RefI31 e' ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        output_byte ch 0x1C
+    | I31Get (s, e') -> (
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        match s with
+        | S -> output_byte ch 0x1D
+        | U -> output_byte ch 0x1E)
+    | ArrayNew (typ, e', e'') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_expression st ch e'';
+        output_byte ch 0xFB;
+        output_byte ch 6;
+        output_uint ch (Hashtbl.find st.type_names typ)
+    | ArrayNewFixed (typ, l) ->
+        Feature.require gc;
+        List.iter ~f:(fun e' -> output_expression st ch e') l;
+        output_byte ch 0xFB;
+        output_byte ch 8;
+        output_uint ch (Hashtbl.find st.type_names typ);
+        output_uint ch (List.length l)
+    | ArrayNewData (typ, data, e', e'') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_expression st ch e'';
+        output_byte ch 0xFB;
+        output_byte ch 9;
+        output_uint ch (Hashtbl.find st.type_names typ);
+        output_uint ch (Hashtbl.find st.data_names data)
+    | ArrayGet (signage, typ, e', e'') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_expression st ch e'';
+        output_byte ch 0xFB;
+        output_byte
+          ch
+          (match signage with
+          | None -> 0x0B
+          | Some S -> 0x0C
+          | Some U -> 0x0D);
+        output_uint ch (Hashtbl.find st.type_names typ)
+    | ArrayLen e' ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        output_byte ch 0x0F
+    | StructNew (typ, l) ->
+        Feature.require gc;
+        List.iter ~f:(fun e' -> output_expression st ch e') l;
+        output_byte ch 0xFB;
+        output_byte ch 0;
+        output_uint ch (Hashtbl.find st.type_names typ)
+    | StructGet (signage, typ, idx, e') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        output_byte
+          ch
+          (match signage with
+          | None -> 0x02
+          | Some S -> 0x03
+          | Some U -> 0x04);
+        output_uint ch (Hashtbl.find st.type_names typ);
+        output_uint ch idx
+    | RefCast ({ typ; nullable }, e') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        output_byte ch (if nullable then 0x17 else 0x16);
+        output_heaptype st.type_names ch typ
+    | RefTest ({ typ; nullable }, e') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        output_byte ch (if nullable then 0x15 else 0x14);
+        output_heaptype st.type_names ch typ
+    | RefEq (e', e'') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_expression st ch e'';
+        output_byte ch 0xD3
+    | RefNull typ ->
+        Feature.require reference_types;
+        output_byte ch 0xD0;
+        output_heaptype st.type_names ch typ
+    | Br_on_cast (i, typ1, typ2, e') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        output_byte ch 0x18;
+        output_byte ch ((if typ1.nullable then 1 else 0) + if typ2.nullable then 2 else 0);
+        output_uint ch i;
+        output_heaptype st.type_names ch typ1.typ;
+        output_heaptype st.type_names ch typ2.typ
+    | Br_on_cast_fail (i, typ1, typ2, e') ->
+        Feature.require gc;
+        output_expression st ch e';
+        output_byte ch 0xFB;
+        output_byte ch 0x19;
+        output_byte ch ((if typ1.nullable then 1 else 0) + if typ2.nullable then 2 else 0);
+        output_uint ch i;
+        output_heaptype st.type_names ch typ1.typ;
+        output_heaptype st.type_names ch typ2.typ
+    | IfExpr (typ, e1, e2, e3) ->
+        output_expression st ch e1;
+        output_byte ch 0x04;
+        output_valtype st.type_names ch typ;
+        output_expression st ch e2;
+        output_byte ch 0x05;
+        output_expression st ch e3;
+        output_byte ch 0x0B
+
+  and output_instruction st ch i =
+    match i with
+    | Drop e ->
+        output_expression st ch e;
+        output_byte ch 0x1A
+    | Store _ | Store8 _ -> assert false
+    | LocalSet (i, e) ->
+        output_expression st ch e;
+        output_byte ch 0x21;
+        output_uint ch (Hashtbl.find st.current_local_names i)
+    | GlobalSet (g, e) ->
+        output_expression st ch e;
+        output_byte ch 0x24;
+        output_uint ch (Hashtbl.find st.global_names g)
+    | Loop (typ, l) ->
+        output_byte ch 0x03;
+        output_blocktype st.type_names ch typ;
+        List.iter ~f:(fun i' -> output_instruction st ch i') l;
+        output_byte ch 0x0B
+    | Block (typ, l) ->
+        output_byte ch 0x02;
+        output_blocktype st.type_names ch typ;
+        List.iter ~f:(fun i' -> output_instruction st ch i') l;
+        output_byte ch 0x0B
+    | If (typ, e, l1, l2) ->
+        output_expression st ch e;
+        output_byte ch 0x04;
+        output_blocktype st.type_names ch typ;
+        List.iter ~f:(fun i' -> output_instruction st ch i') l1;
+        if not (List.is_empty l2)
+        then (
+          output_byte ch 0x05;
+          List.iter ~f:(fun i' -> output_instruction st ch i') l2);
+        output_byte ch 0x0B
+    | Br_table (e, l, i) ->
+        output_expression st ch e;
+        output_byte ch 0x0E;
+        output_vec output_uint ch l;
+        output_uint ch i
+    | Br (i, None) ->
+        output_byte ch 0x0C;
+        output_uint ch i
+    | Br (i, Some e) ->
+        output_expression st ch e;
+        output_byte ch 0x0C;
+        output_uint ch i
+    | Br_if (i, e) ->
+        output_expression st ch e;
+        output_byte ch 0x0D;
+        output_uint ch i
+    | Return None -> output_byte ch 0x0F
+    | Return (Some e) ->
+        output_expression st ch e;
+        output_byte ch 0x0F
+    | CallInstr (f, l) ->
+        List.iter ~f:(fun e -> output_expression st ch e) l;
+        output_byte ch 0x10;
+        output_uint ch (Hashtbl.find st.func_names f)
+    | Nop -> ()
+    | Push e -> output_expression st ch e
+    | Try (typ, l, catches, catchall) ->
+        Feature.require exception_handling;
+        output_byte ch 0x06;
+        output_blocktype st.type_names ch typ;
+        List.iter ~f:(fun i' -> output_instruction st ch i') l;
+        List.iter
+          ~f:(fun (tag, l) ->
+            output_byte ch 0x07;
+            output_uint ch (Hashtbl.find st.tag_names tag);
+            List.iter ~f:(fun i' -> output_instruction st ch i') l)
+          catches;
+        (match catchall with
+        | Some l ->
+            output_byte ch 0x05;
+            List.iter ~f:(fun i' -> output_instruction st ch i') l
+        | None -> ());
+        output_byte ch 0X0B
+    | Throw (tag, e) ->
+        Feature.require exception_handling;
+        output_expression st ch e;
+        output_byte ch 0x08;
+        output_uint ch (Hashtbl.find st.tag_names tag)
+    | Rethrow i ->
+        Feature.require exception_handling;
+        output_byte ch 0x09;
+        output_uint ch i
+    | ArraySet (typ, e1, e2, e3) ->
+        Feature.require gc;
+        output_expression st ch e1;
+        output_expression st ch e2;
+        output_expression st ch e3;
+        output_byte ch 0xFB;
+        output_byte ch 0x0E;
+        output_uint ch (Hashtbl.find st.type_names typ)
+    | StructSet (typ, idx, e1, e2) ->
+        Feature.require gc;
+        output_expression st ch e1;
+        output_expression st ch e2;
+        output_byte ch 0xFB;
+        output_byte ch 0x05;
+        output_uint ch (Hashtbl.find st.type_names typ);
+        output_uint ch idx
+    | Return_call_indirect _ -> assert false
+    | Return_call (f, l) ->
+        Feature.require tail_call;
+        List.iter ~f:(fun e -> output_expression st ch e) l;
+        output_byte ch 0x12;
+        output_uint ch (Hashtbl.find st.func_names f)
+    | Return_call_ref (typ, e', l) ->
+        Feature.require tail_call;
+        List.iter ~f:(fun e' -> output_expression st ch e') l;
+        output_expression st ch e';
+        output_byte ch 0x15;
+        output_uint ch (Hashtbl.find st.type_names typ)
+    | Location (_, i') -> output_instruction st ch i'
+
+  let output_globals ch (st, global_idx, fields) =
+    let count =
+      List.fold_left
+        ~f:(fun count field ->
+          match field with
+          | Global _ -> count + 1
+          | Function _ | Type _ | Import _ | Data _ | Tag _ -> count)
+        ~init:0
+        fields
+    in
+    output_uint ch count;
+    let _idx =
+      List.fold_left
+        ~f:(fun idx field ->
+          match field with
+          | Global { name; typ; init; _ } ->
+              Hashtbl.add st.global_names name idx;
+              output_globaltype st.type_names ch typ;
+              output_expression st ch init;
+              output_byte ch 0x0B;
+              idx + 1
+          | Function _ | Type _ | Import _ | Data _ | Tag _ -> idx)
+        ~init:global_idx
+        fields
+    in
+    ()
+
+  let output_exports ch (func_names, global_names, fields) =
+    let count =
+      List.fold_left
+        ~f:(fun count field ->
+          match field with
+          | Function { exported_name = Some _; _ } | Global { exported_name = Some _; _ }
+            -> count + 1
+          | Function { exported_name = None; _ }
+          | Global { exported_name = None; _ }
+          | Import _ | Type _ | Data _ | Tag _ -> count)
+        ~init:0
+        fields
+    in
+    output_uint ch count;
+    List.iter
+      ~f:(fun field ->
+        match field with
+        | Function { exported_name = None; _ }
+        | Type _ | Data _
+        | Global { exported_name = None; _ }
+        | Tag _ | Import _ -> ()
+        | Function { name; exported_name = Some exported_name; _ } ->
+            output_name ch exported_name;
+            output_byte ch 0x00;
+            output_uint ch (Hashtbl.find func_names name)
+        | Global { name; exported_name = Some exported_name; typ; _ } ->
+            if typ.mut then Feature.require mutable_globals;
+            output_name ch exported_name;
+            output_byte ch 0x03;
+            output_uint ch (Hashtbl.find global_names name))
+      fields
+
+  let compute_data_names fields =
+    let data_count =
+      List.fold_left
+        ~f:(fun count field ->
+          match field with
+          | Data _ -> count + 1
+          | Function _ | Type _ | Import _ | Global _ | Tag _ -> count)
+        ~init:0
+        fields
+    in
+    let data_names = Hashtbl.create 16 in
+    let _idx =
+      List.fold_left
+        ~f:(fun idx field ->
+          match field with
+          | Data { name; _ } ->
+              Hashtbl.add data_names name idx;
+              idx + 1
+          | Function _ | Type _ | Import _ | Global _ | Tag _ -> idx)
+        ~init:0
+        fields
+    in
+    data_count, data_names
+
+  let data_contents contents =
+    let b = Buffer.create 16 in
+    List.iter
+      ~f:(fun d ->
+        match d with
+        | DataI8 c -> Buffer.add_uint8 b c
+        | DataI32 i -> Buffer.add_int32_le b i
+        | DataI64 i -> Buffer.add_int64_le b i
+        | DataBytes s -> Buffer.add_string b s
+        | DataSym _ -> assert false
+        | DataSpace n -> Buffer.add_string b (String.make n '\000'))
+      contents;
+    Buffer.contents b
+
+  let output_data_count ch data_count = output_uint ch data_count
+
+  let output_data ch (data_count, fields) =
+    output_uint ch data_count;
+    ignore
+      (List.fold_left
+         ~f:(fun idx field ->
+           match field with
+           | Data { active; contents; _ } ->
+               assert (not active);
+               output_byte ch 1;
+               output_name ch (data_contents contents);
+               idx + 1
+           | Function _ | Type _ | Import _ | Global _ | Tag _ -> idx)
+         ~init:0
+         fields)
+
+  let rec expr_function_references e set =
+    match e with
+    | Const _ | LocalGet _ | GlobalGet _ | Pop _ | RefNull _ -> set
+    | UnOp (_, e')
+    | I32WrapI64 e'
+    | I64ExtendI32 (_, e')
+    | F32DemoteF64 e'
+    | F64PromoteF32 e'
+    | LocalTee (_, e')
+    | RefI31 e'
+    | I31Get (_, e')
+    | ArrayLen e'
+    | StructGet (_, _, _, e')
+    | RefCast (_, e')
+    | RefTest (_, e')
+    | Br_on_cast (_, _, _, e')
+    | Br_on_cast_fail (_, _, _, e') -> expr_function_references e' set
+    | BinOp (_, e', e'')
+    | ArrayNew (_, e', e'')
+    | ArrayNewData (_, _, e', e'')
+    | ArrayGet (_, _, e', e'')
+    | RefEq (e', e'') ->
+        set |> expr_function_references e' |> expr_function_references e''
+    | Call_indirect _ | ConstSym _ | Load _ | Load8 _ | MemoryGrow _ -> assert false
+    | IfExpr (_, e1, e2, e3) ->
+        set
+        |> expr_function_references e1
+        |> expr_function_references e2
+        |> expr_function_references e3
+    | BlockExpr (_, l) ->
+        List.fold_left ~f:(fun set i -> instr_function_references i set) ~init:set l
+    | Call (_, l) | ArrayNewFixed (_, l) | StructNew (_, l) ->
+        List.fold_left ~f:(fun set i -> expr_function_references i set) ~init:set l
+    | Seq _ -> assert false
+    | RefFunc f -> Code.Var.Set.add f set
+    | Call_ref (_, e', l) ->
+        List.fold_left
+          ~f:(fun set i -> expr_function_references i set)
+          ~init:(expr_function_references e' set)
+          l
+
+  and instr_function_references i set =
+    match i with
+    | Drop e
+    | LocalSet (_, e)
+    | GlobalSet (_, e)
+    | Br (_, Some e)
+    | Br_table (e, _, _)
+    | Br_if (_, e)
+    | Return (Some e)
+    | Push e
+    | Throw (_, e) -> expr_function_references e set
+    | Store _ | Store8 _ -> assert false
+    | Loop (_, l) | Block (_, l) ->
+        List.fold_left ~f:(fun set i -> instr_function_references i set) ~init:set l
+    | If (_, e, l1, l2) ->
+        set
+        |> expr_function_references e
+        |> (fun init ->
+             List.fold_left ~f:(fun set i -> instr_function_references i set) ~init l1)
+        |> fun init ->
+        List.fold_left ~f:(fun set i -> instr_function_references i set) ~init l2
+    | Br (_, None) | Return None | Nop | Rethrow _ -> set
+    | CallInstr (_, l) ->
+        List.fold_left ~f:(fun set i -> expr_function_references i set) ~init:set l
+    | Try (_, l, catches, catchall) ->
+        List.fold_left ~f:(fun set i -> instr_function_references i set) ~init:set l
+        |> (fun init ->
+             List.fold_left
+               ~f:(fun set (_, l) ->
+                 List.fold_left
+                   ~f:(fun set i -> instr_function_references i set)
+                   ~init:set
+                   l)
+               ~init
+               catches)
+        |> fun init ->
+        List.fold_left
+          ~f:(fun set i -> instr_function_references i set)
+          ~init
+          (match catchall with
+          | Some l -> l
+          | None -> [])
+    | ArraySet (_, e1, e2, e3) ->
+        set
+        |> expr_function_references e1
+        |> expr_function_references e2
+        |> expr_function_references e3
+    | StructSet (_, _, e1, e2) ->
+        set |> expr_function_references e1 |> expr_function_references e2
+    | Return_call_indirect _ -> assert false
+    | Return_call (_, l) ->
+        List.fold_left ~f:(fun set i -> expr_function_references i set) ~init:set l
+    | Return_call_ref (_, e', l) ->
+        List.fold_left
+          ~f:(fun set i -> expr_function_references i set)
+          ~init:(expr_function_references e' set)
+          l
+    | Location (_, i') -> instr_function_references i' set
+
+  let function_references fields set =
+    List.fold_left
+      ~f:(fun set field ->
+        match field with
+        | Function { body; _ } ->
+            List.fold_left
+              ~f:(fun set i -> instr_function_references i set)
+              ~init:set
+              body
+        | Global _ | Import _ | Type _ | Data _ | Tag _ -> set)
+      ~init:set
+      fields
+
+  let output_elem ch (st, refs) =
+    output_byte ch (* declare *) 1;
+    output_byte ch (* func *) 3;
+    output_byte ch 0x00;
+    let refs = Code.Var.Set.elements refs in
+    output_vec (fun ch f -> output_uint ch (Hashtbl.find st.func_names f)) ch refs
+
+  let coalesce_locals l =
+    let rec loop acc n t l =
+      match l with
+      | [] -> List.rev ((n, t) :: acc)
+      | (_, t') :: r ->
+          if Poly.equal t t' then loop acc (n + 1) t r else loop ((n, t) :: acc) 1 t' r
+    in
+    match l with
+    | [] -> []
+    | (_, t) :: rem -> loop [] 1 t rem
+
+  let output_code ch (st, fields) =
+    let l =
+      List.fold_left
+        ~f:(fun acc field ->
+          match field with
+          | Function { name; param_names; locals; body; _ } ->
+              (name, param_names, locals, body) :: acc
+          | Type _ | Import _ | Data _ | Global _ | Tag _ -> acc)
+        ~init:[]
+        fields
+    in
+    output_vec
+      (with_size (fun ch (name, param_names, locals, body) ->
+           let current_local_names = Hashtbl.create 8 in
+           let idx =
+             List.fold_left
+               ~f:(fun idx x ->
+                 Hashtbl.add current_local_names x idx;
+                 idx + 1)
+               ~init:0
+               param_names
+           in
+           let _ =
+             List.fold_left
+               ~f:(fun idx (x, _) ->
+                 Hashtbl.add current_local_names x idx;
+                 idx + 1)
+               ~init:idx
+               locals
+           in
+           Hashtbl.add st.local_names name current_local_names;
+           let st = { st with current_local_names } in
+           output_vec
+             (fun ch (n, typ) ->
+               output_uint ch n;
+               output_valtype st.type_names ch typ)
+             ch
+             (coalesce_locals locals);
+           (try List.iter ~f:(fun i -> output_instruction st ch i) body
+            with e ->
+              let backtrace = Printexc.get_backtrace () in
+              prerr_endline (Printexc.to_string e);
+              prerr_endline backtrace;
+              assert false);
+           output_byte ch 0x0B))
+      ch
+      (List.rev l)
+
+  let output_section id f ch x =
+    output_byte ch id;
+    with_size f ch x
+
+  let rec find_available_name used name i =
+    let nm = Printf.sprintf "%s$%d" name i in
+    if StringSet.mem nm used then find_available_name used name (i + 1) else nm
+
+  let assign_names f tbl =
+    let names = Hashtbl.fold (fun name idx rem -> (idx, name) :: rem) tbl [] in
+    let names = List.sort ~cmp:(fun (idx, _) (idx', _) -> compare idx idx') names in
+    let used = ref StringSet.empty in
+    let names =
+      List.map
+        ~f:(fun (idx, x) ->
+          match f x with
+          | None -> idx, None
+          | Some nm ->
+              let nm =
+                if StringSet.mem nm !used then find_available_name !used nm 1 else nm
+              in
+              used := StringSet.add nm !used;
+              idx, Some nm)
+        names
+    in
+    let printer = Var_printer.create Var_printer.Alphabet.javascript in
+    let i = ref 0 in
+    let rec first_available_name () =
+      let nm = Var_printer.to_string printer !i in
+      incr i;
+      if StringSet.mem nm !used then first_available_name () else nm
+    in
+    List.map
+      ~f:(fun (idx, nm) ->
+        match nm with
+        | Some nm -> idx, nm
+        | None -> idx, first_available_name ())
+      names
+
+  let output_names ch st =
+    output_name ch "name";
+    let index = Code.Var.get_name in
+    let symbol name =
+      match name with
+      | V name -> Code.Var.get_name name
+      | S name -> Some name
+    in
+    let out id f tbl =
+      let names = assign_names f tbl in
+      if not (List.is_empty names)
+      then
+        output_section
+          id
+          (output_vec (fun ch (idx, name) ->
+               output_uint ch idx;
+               output_name ch name))
+          ch
+          names
+    in
+    let locals =
+      Hashtbl.fold
+        (fun name tbl rem -> (Hashtbl.find st.func_names name, tbl) :: rem)
+        st.local_names
+        []
+      |> List.sort ~cmp:(fun (idx, _) (idx', _) -> compare idx idx')
+    in
+    out 1 index st.func_names;
+    output_section
+      2
+      (output_vec (fun ch (idx, tbl) ->
+           output_uint ch idx;
+           let locals = assign_names index tbl in
+           output_vec
+             (fun ch (idx, name) ->
+               output_uint ch idx;
+               output_name ch name)
+             ch
+             locals))
+      ch
+      locals;
+    out 4 index st.type_names;
+    out 7 symbol st.global_names;
+    out 9 index st.data_names;
+    out 11 index st.tag_names
+
+  let output_features ch () =
+    output_name ch "target_features";
+    output_vec
+      (fun ch f ->
+        output_byte ch 0x2b;
+        output_name ch f)
+      ch
+      (Feature.get features)
+
+  let output_module ch fields =
+    output_string ch "\x00\x61\x73\x6D\x01\x00\x00\x00";
+    let func_types, type_names = output_section 1 output_types ch fields in
+    let func_idx, func_names, global_idx, global_names, _, tag_names =
+      output_section 2 output_imports ch (func_types, type_names, fields)
+    in
+    output_section 3 output_functions ch (func_idx, func_names, func_types, fields);
+    let st =
+      { type_names
+      ; func_names
+      ; global_names
+      ; data_names = Hashtbl.create 1
+      ; tag_names
+      ; local_names = Hashtbl.create 8
+      ; current_local_names = Hashtbl.create 8
+      }
+    in
+    output_section 6 output_globals ch (st, global_idx, fields);
+    output_section 7 output_exports ch (func_names, global_names, fields);
+    let refs = function_references fields Code.Var.Set.empty in
+    output_section 9 output_elem ch (st, refs);
+    let data_count, data_names = compute_data_names fields in
+    if data_count > 0
+    then (
+      Feature.require bulk_memory;
+      output_section 12 output_data_count ch data_count);
+    let st = { st with data_names } in
+    output_section 10 output_code ch (st, fields);
+    output_section 11 output_data ch (data_count, fields);
+    if Config.Flag.pretty () then output_section 0 output_names ch st;
+    if Feature.test gc then Feature.require reference_types;
+    output_section 0 output_features ch ()
+end
+
+let f ch fields =
+  let module O = Make (struct
+    type t = out_channel
+
+    let position = pos_out
+
+    let seek = seek_out
+
+    let byte = output_byte
+
+    let string = output_string
+  end) in
+  Code.Var.set_pretty true;
+  Code.Var.set_stable (Config.Flag.stable_var ());
+  O.output_module ch fields
diff --git a/compiler/lib/wasm/wa_wasm_output.mli b/compiler/lib/wasm/wa_wasm_output.mli
new file mode 100644
index 0000000000..59f2b93d9a
--- /dev/null
+++ b/compiler/lib/wasm/wa_wasm_output.mli
@@ -0,0 +1 @@
+val f : out_channel -> Wa_ast.module_field list -> unit

From 965988a6d3ebd3383f5c3ffba6e7c650c2765e62 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 4 Jun 2024 14:47:40 +0200
Subject: [PATCH 336/481] Start function: directly generate wasm code

---
 compiler/lib/wasm/wa_generate.ml  |  5 +++++
 compiler/lib/wasm/wa_generate.mli |  2 ++
 compiler/lib/wasm/wa_link.ml      | 16 ++--------------
 3 files changed, 9 insertions(+), 14 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 27a85ae441..7dcc3ca6db 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -1269,3 +1269,8 @@ let output ch ~context ~debug =
       let module G = Generate (Wa_gc_target) in
       let fields = G.output ~context in
       Wa_wat_output.f ~debug ch fields
+
+let wasm_output ch ~context =
+  let module G = Generate (Wa_gc_target) in
+  let fields = G.output ~context in
+  Wa_wasm_output.f ch fields
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index d7e2e86627..836a6393d3 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -38,3 +38,5 @@ val output :
   -> context:Wa_code_generation.context
   -> debug:Parse_bytecode.Debug.t
   -> unit
+
+val wasm_output : out_channel -> context:Wa_code_generation.context -> unit
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index e2282b316b..e14c5cd32c 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -385,23 +385,11 @@ let read_info z = info_from_sexp (Sexp.from_string (Zip.read_entry z ~name:"info
 
 let generate_start_function ~to_link ~out_file =
   let t1 = Timer.make () in
-  Fs.gen_file out_file
-  @@ fun wasm_file ->
-  let wat_file = Filename.chop_extension out_file ^ ".wat" in
-  (Filename.gen_file wat_file
+  Filename.gen_file out_file
   @@ fun ch ->
   let context = Wa_generate.start () in
   Wa_generate.add_init_function ~context ~to_link:("prelude" :: to_link);
-  Wa_generate.output
-    ch
-    ~context
-    ~debug:(Parse_bytecode.Debug.create ~include_cmis:false false));
-  Wa_binaryen.optimize
-    ~profile:(Driver.profile 1)
-    ~opt_input_sourcemap:None
-    ~opt_output_sourcemap:None
-    ~input_file:wat_file
-    ~output_file:wasm_file;
+  Wa_generate.wasm_output ch ~context;
   if times () then Format.eprintf "    generate start: %a@." Timer.print t1
 
 let output_js js =

From ca9dcba0611522ed7b504f3acf6d224e220dd6c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 5 Jun 2024 15:29:08 +0200
Subject: [PATCH 337/481] Support linking wasmo files into one wasma file

---
 .github/workflows/build-wasm_of_ocaml.yml |   2 +-
 compiler/bin-wasm_of_ocaml/link.ml        |  19 +++-
 compiler/lib/wasm/wa_link.ml              | 122 +++++++++++++++++++++-
 compiler/lib/wasm/wa_link.mli             |   1 +
 4 files changed, 136 insertions(+), 8 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index c13a33b8f2..3bacb9b63d 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -123,7 +123,7 @@ jobs:
 
       - name: Pin dune
         run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml-incremental
 
       - name: Pin wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
diff --git a/compiler/bin-wasm_of_ocaml/link.ml b/compiler/bin-wasm_of_ocaml/link.ml
index 117212847b..7dfcbf5ae8 100644
--- a/compiler/bin-wasm_of_ocaml/link.ml
+++ b/compiler/bin-wasm_of_ocaml/link.ml
@@ -25,6 +25,7 @@ type t =
   ; files : string list
   ; output_file : string
   ; linkall : bool
+  ; mklib : bool
   ; enable_source_maps : bool
   }
 
@@ -53,9 +54,16 @@ let options =
     let doc = "Link all compilation units." in
     Arg.(value & flag & info [ "linkall" ] ~doc)
   in
-  let build_t common no_sourcemap sourcemap output_file files linkall =
+  let mklib =
+    let doc =
+      "Build a library (.wasma file) with the .wasmo files given on the command line. \
+       Similar to ocamlc -a."
+    in
+    Arg.(value & flag & info [ "a" ] ~doc)
+  in
+  let build_t common no_sourcemap sourcemap output_file files linkall mklib =
     let enable_source_maps = (not no_sourcemap) && sourcemap in
-    `Ok { common; output_file; files; linkall; enable_source_maps }
+    `Ok { common; output_file; files; linkall; mklib; enable_source_maps }
   in
   let t =
     Term.(
@@ -65,13 +73,14 @@ let options =
       $ sourcemap
       $ output_file
       $ files
-      $ linkall)
+      $ linkall
+      $ mklib)
   in
   Term.ret t
 
-let f { common; output_file; files; linkall; enable_source_maps } =
+let f { common; output_file; files; linkall; enable_source_maps; mklib } =
   Jsoo_cmdline.Arg.eval common;
-  Wa_link.link ~output_file ~linkall ~enable_source_maps ~files
+  Wa_link.link ~output_file ~linkall ~mklib ~enable_source_maps ~files
 
 let info =
   Info.make
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index e14c5cd32c..186d4404d5 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -822,8 +822,126 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
   if times () then Format.eprintf "    build JS runtime: %a@." Timer.print t1;
   if times () then Format.eprintf "  emit: %a@." Timer.print t
 
-let link ~output_file ~linkall ~enable_source_maps ~files =
-  try link ~output_file ~linkall ~enable_source_maps ~files
+let opt_with action x f =
+  match x with
+  | None -> f None
+  | Some x -> action x (fun y -> f (Some y))
+
+let rec get_source_map_files files src_index =
+  let z = Zip.open_in files.(!src_index) in
+  incr src_index;
+  if Zip.has_entry z ~name:"source_map.map"
+  then
+    let data = Zip.read_entry z ~name:"source_map.map" in
+    let sm = Wa_source_map.parse data in
+    if not (Wa_source_map.is_empty sm)
+    then (
+      let l = ref [] in
+      Wa_source_map.iter_sources sm (fun i j file -> l := source_name i j file :: !l);
+      if not (List.is_empty !l)
+      then z, Array.of_list (List.rev !l)
+      else (
+        Zip.close_in z;
+        get_source_map_files files src_index))
+    else (
+      Zip.close_in z;
+      get_source_map_files files src_index)
+  else get_source_map_files files src_index
+
+let add_source_map files z opt_source_map_file =
+  Option.iter
+    ~f:(fun file ->
+      Zip.add_file z ~name:"source_map.map" ~file;
+      let sm = Wa_source_map.load file in
+      let files = Array.of_list files in
+      let src_index = ref 0 in
+      let st = ref None in
+      let finalize () =
+        match !st with
+        | Some (_, (z', _)) -> Zip.close_in z'
+        | None -> ()
+      in
+      Wa_source_map.iter_sources sm (fun i j file ->
+          let z', files =
+            match !st with
+            | Some (i', st) when Poly.equal i i' -> st
+            | _ ->
+                let st' = get_source_map_files files src_index in
+                finalize ();
+                st := Some (i, st');
+                st'
+          in
+          if Array.length files > 0 (* Source has source map *)
+          then
+            let name = files.(Option.value ~default:0 j) in
+            if Zip.has_entry z' ~name
+            then Zip.copy_file z' z ~src_name:name ~dst_name:(source_name i j file));
+      finalize ())
+    opt_source_map_file
+
+let make_library ~output_file ~enable_source_maps ~files =
+  let info =
+    List.map files ~f:(fun file ->
+        let build_info, _predefined_exceptions, unit_data =
+          Zip.with_open_in file read_info
+        in
+        (match Build_info.kind build_info with
+        | `Cmo -> ()
+        | `Runtime | `Cma | `Exe | `Unknown ->
+            failwith (Printf.sprintf "File '%s' is not a .wasmo file." file));
+        file, build_info, unit_data)
+  in
+  let build_info =
+    Build_info.with_kind
+      (match info with
+      | (file, bi, _) :: r ->
+          Build_info.configure bi;
+          List.fold_left
+            ~init:bi
+            ~f:(fun bi (file', bi', _) -> Build_info.merge file bi file' bi')
+            r
+      | [] -> Build_info.create `Cma)
+      `Cma
+  in
+  let unit_data = List.concat (List.map ~f:(fun (_, _, unit_data) -> unit_data) info) in
+  Fs.gen_file output_file
+  @@ fun tmp_output_file ->
+  let z = Zip.open_out tmp_output_file in
+  add_info z ~build_info ~unit_data ();
+  (*
+- Merge all code files into a single code file (gathering source maps)
+- Copy source files
+*)
+  Fs.with_intermediate_file (Filename.temp_file "wasm" ".wasm")
+  @@ fun tmp_wasm_file ->
+  opt_with
+    Fs.with_intermediate_file
+    (if enable_source_maps then Some (Filename.temp_file "wasm" ".map") else None)
+  @@ fun opt_output_sourcemap_file ->
+  Wa_wasm_link.f
+    (List.map
+       ~f:(fun file ->
+         let z' = Zip.open_in file in
+         { Wa_wasm_link.module_name = "OCaml"
+         ; file
+         ; code = Some (Zip.read_entry z' ~name:"code.wasm")
+         ; opt_source_map =
+             (if Zip.has_entry z' ~name:"source_map.map"
+              then Some (`Data (Zip.read_entry z' ~name:"source_map.map"))
+              else None)
+         })
+       files)
+    ~output_file:tmp_wasm_file
+    ~opt_output_sourcemap_file;
+  Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file;
+  add_source_map files z opt_output_sourcemap_file;
+  Zip.close_out z
+
+let link ~output_file ~linkall ~mklib ~enable_source_maps ~files =
+  try
+    if mklib
+    then make_library ~output_file ~enable_source_maps ~files
+    else link ~output_file ~linkall ~enable_source_maps ~files
   with Build_info.Incompatible_build_info { key; first = f1, v1; second = f2, v2 } ->
     let string_of_v = function
       | None -> "<empty>"
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index bed24894a8..c9bf6e5d9b 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -59,6 +59,7 @@ val output_js : Javascript.program -> string
 val link :
      output_file:string
   -> linkall:bool
+  -> mklib:bool
   -> enable_source_maps:bool
   -> files:string list
   -> unit

From dd019869bd3256520f112b48df051bbd5aec4c1b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 13 Sep 2024 17:58:32 +0200
Subject: [PATCH 338/481] ocamlformat

---
 compiler/bin-wasm_of_ocaml/compile.ml | 11 +++--------
 compiler/lib/linker.ml                | 17 ++++++-----------
 compiler/lib/linker.mli               | 11 +++--------
 compiler/lib/source_map.ml            |  7 ++++---
 lib/js_of_ocaml/typed_array.ml        |  2 +-
 lib/js_of_ocaml/typed_array.mli       |  2 +-
 6 files changed, 18 insertions(+), 32 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index ff2ef3ec87..eb6a1e99d6 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -266,17 +266,12 @@ let run
         | None -> `Fst name)
   in
   let t1 = Timer.make () in
-  let builtin = [Js_of_ocaml_compiler_runtime_files.jslib_js_of_ocaml] @ builtin in
+  let builtin = [ Js_of_ocaml_compiler_runtime_files.jslib_js_of_ocaml ] @ builtin in
   List.iter builtin ~f:(fun t ->
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in
-      Linker.load_fragments
-        ~target_env:Target_env.Isomorphic
-        ~filename
-        runtimes);
-  Linker.load_files
-    ~target_env:Target_env.Isomorphic
-    runtime_js_files;
+      Linker.load_fragments ~target_env:Target_env.Isomorphic ~filename runtimes);
+  Linker.load_files ~target_env:Target_env.Isomorphic runtime_js_files;
   Linker.check_deps ();
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index f77d25b5f0..1629afc5a8 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -482,9 +482,9 @@ let load_fragment ~target_env ~filename (f : Fragment.t) =
                 filename;
             if always
             then (
-                always_included :=
-                  { ar_filename = filename; ar_program = code; ar_requires = requires }
-                  :: !always_included;
+              always_included :=
+                { ar_filename = filename; ar_program = code; ar_requires = requires }
+                :: !always_included;
               `Ok)
             else
               error
@@ -588,22 +588,17 @@ let check_deps () =
 
 let load_file ~target_env filename =
   List.iter (Fragment.parse_file filename) ~f:(fun frag ->
-      let (`Ok | `Ignored) =
-        load_fragment ~target_env ~filename frag
-      in
+      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
       ())
 
 let load_fragments ~target_env ~filename l =
   List.iter l ~f:(fun frag ->
-      let (`Ok | `Ignored) =
-        load_fragment ~target_env ~filename frag
-      in
+      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
       ());
   check_deps ()
 
 let load_files ~target_env l =
-  List.iter l ~f:(fun filename ->
-      load_file ~target_env filename);
+  List.iter l ~f:(fun filename -> load_file ~target_env filename);
   check_deps ()
 
 (* resolve *)
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index 91f9f68064..b7d49194c7 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -36,14 +36,9 @@ end
 
 val reset : unit -> unit
 
-val load_files :
-  target_env:Target_env.t -> string list -> unit
-
-val load_fragments :
-  target_env:Target_env.t
-  -> filename:string
-  -> Fragment.t list
-  -> unit
+val load_files : target_env:Target_env.t -> string list -> unit
+
+val load_fragments : target_env:Target_env.t -> filename:string -> Fragment.t list -> unit
 
 val check_deps : unit -> unit
 
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index 50aa2d0b3a..aa5ec3c524 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -332,9 +332,10 @@ let json ?replace_mappings t =
     ; "names", `List (List.map t.names ~f:(fun s -> stringlit s))
     ; "sources", `List (List.map t.sources ~f:(fun s -> stringlit (rewrite_path s)))
     ; ( "mappings"
-      , stringlit (match replace_mappings with
-        | None -> string_of_mapping t.mappings
-        | Some m -> m) )
+      , stringlit
+          (match replace_mappings with
+          | None -> string_of_mapping t.mappings
+          | Some m -> m) )
     ; ( "sourcesContent"
       , `List
           (match t.sources_content with
diff --git a/lib/js_of_ocaml/typed_array.ml b/lib/js_of_ocaml/typed_array.ml
index e06f3b50bf..1cd51fd127 100644
--- a/lib/js_of_ocaml/typed_array.ml
+++ b/lib/js_of_ocaml/typed_array.ml
@@ -43,7 +43,7 @@ class type arrayBufferView = object
 end
 
 class type ['a, 'b, 'c] typedArray = object
-    inherit arrayBufferView
+  inherit arrayBufferView
 
   method _BYTES_PER_ELEMENT : int readonly_prop
 
diff --git a/lib/js_of_ocaml/typed_array.mli b/lib/js_of_ocaml/typed_array.mli
index 33d5eca019..5405054eca 100644
--- a/lib/js_of_ocaml/typed_array.mli
+++ b/lib/js_of_ocaml/typed_array.mli
@@ -45,7 +45,7 @@ class type arrayBufferView = object
 end
 
 class type ['a, 'b, 'c] typedArray = object
-    inherit arrayBufferView
+  inherit arrayBufferView
 
   method _BYTES_PER_ELEMENT : int readonly_prop
 

From 3a3ca744e9ce56448915977b84a1e3c2d64b2d81 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 13 Sep 2024 23:03:15 +0200
Subject: [PATCH 339/481] Update outdated info in readme

---
 README.md | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/README.md b/README.md
index c0c3ccfb35..33e401e1d4 100644
--- a/README.md
+++ b/README.md
@@ -64,9 +64,7 @@ wasm_of_ocaml _build/default/bin/web/index.bc-for-jsoo
 
 ## Implementation status
 
-A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions and dynamic linking are not supported yet.
-
-Separate compilation is not implemented yet.
+A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions are not supported yet.
 
 ## Compatibility with Js_of_ocaml
 

From c290fb16c8d8d99a920b3e510dc3fc7896191837 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Mon, 16 Sep 2024 12:08:15 +0200
Subject: [PATCH 340/481] Update README.md

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 33e401e1d4..050d5a5c5d 100644
--- a/README.md
+++ b/README.md
@@ -64,7 +64,7 @@ wasm_of_ocaml _build/default/bin/web/index.bc-for-jsoo
 
 ## Implementation status
 
-A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions are not supported yet.
+A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions and dynamic linking are not supported yet.
 
 ## Compatibility with Js_of_ocaml
 

From ab2525d48c43a62494756996952ee974eb8debc0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 16 Sep 2024 13:47:46 +0200
Subject: [PATCH 341/481] Fix warning

---
 compiler/lib/wasm/wa_link.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 186d4404d5..ffb185ca8a 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -799,7 +799,7 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
   let generated_js =
     List.concat
     @@ List.map files ~f:(fun (_, (_, units)) ->
-           List.map units ~f:(fun { unit_name; unit_info; strings; fragments } ->
+           List.map units ~f:(fun { unit_name; strings; fragments; _ } ->
                Some unit_name, (strings, fragments)))
   in
   let runtime_args =

From cfcef83bf1fc18302ae4681c990da2cfc07cfd0e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 17 Sep 2024 11:24:23 +0200
Subject: [PATCH 342/481] Revert "No longer ignore always annotation"

This reverts commit a02584d5b99ebbc896aab64b7a726e41c0c094c1.
---
 compiler/bin-wasm_of_ocaml/compile.ml | 11 +++++++++--
 compiler/lib/linker.ml                | 27 +++++++++++++++++----------
 compiler/lib/linker.mli               | 12 +++++++++---
 3 files changed, 35 insertions(+), 15 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index eb6a1e99d6..a2e82283e8 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -270,8 +270,15 @@ let run
   List.iter builtin ~f:(fun t ->
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in
-      Linker.load_fragments ~target_env:Target_env.Isomorphic ~filename runtimes);
-  Linker.load_files ~target_env:Target_env.Isomorphic runtime_js_files;
+      Linker.load_fragments
+        ~ignore_always_annotation:true
+        ~target_env:Target_env.Isomorphic
+        ~filename
+        runtimes);
+  Linker.load_files
+    ~ignore_always_annotation:true
+    ~target_env:Target_env.Isomorphic
+    runtime_js_files;
   Linker.check_deps ();
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index 1629afc5a8..d0a610d904 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -437,7 +437,7 @@ let list_all ?from () =
     provided
     StringSet.empty
 
-let load_fragment ~target_env ~filename (f : Fragment.t) =
+let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.t) =
   match f with
   | Always_include code ->
       always_included :=
@@ -482,9 +482,11 @@ let load_fragment ~target_env ~filename (f : Fragment.t) =
                 filename;
             if always
             then (
-              always_included :=
-                { ar_filename = filename; ar_program = code; ar_requires = requires }
-                :: !always_included;
+              if not ignore_always_annotation
+              then
+                always_included :=
+                  { ar_filename = filename; ar_program = code; ar_requires = requires }
+                  :: !always_included;
               `Ok)
             else
               error
@@ -586,19 +588,24 @@ let check_deps () =
           ())
     code_pieces
 
-let load_file ~target_env filename =
+let load_file ~ignore_always_annotation ~target_env filename =
   List.iter (Fragment.parse_file filename) ~f:(fun frag ->
-      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
+      let (`Ok | `Ignored) =
+        load_fragment ~ignore_always_annotation ~target_env ~filename frag
+      in
       ())
 
-let load_fragments ~target_env ~filename l =
+let load_fragments ?(ignore_always_annotation = false) ~target_env ~filename l =
   List.iter l ~f:(fun frag ->
-      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
+      let (`Ok | `Ignored) =
+        load_fragment ~ignore_always_annotation ~target_env ~filename frag
+      in
       ());
   check_deps ()
 
-let load_files ~target_env l =
-  List.iter l ~f:(fun filename -> load_file ~target_env filename);
+let load_files ?(ignore_always_annotation = false) ~target_env l =
+  List.iter l ~f:(fun filename ->
+      load_file ~ignore_always_annotation ~target_env filename);
   check_deps ()
 
 (* resolve *)
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index b7d49194c7..246b959403 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -36,9 +36,15 @@ end
 
 val reset : unit -> unit
 
-val load_files : target_env:Target_env.t -> string list -> unit
-
-val load_fragments : target_env:Target_env.t -> filename:string -> Fragment.t list -> unit
+val load_files :
+  ?ignore_always_annotation:bool -> target_env:Target_env.t -> string list -> unit
+
+val load_fragments :
+     ?ignore_always_annotation:bool
+  -> target_env:Target_env.t
+  -> filename:string
+  -> Fragment.t list
+  -> unit
 
 val check_deps : unit -> unit
 

From d3969bebedd26f8280d125e88c13a195b0bb71f0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 17 Sep 2024 11:25:41 +0200
Subject: [PATCH 343/481] Revert "JS runtime: only link jslib_js_of_ocaml.js"

This reverts commit c75898281228518124f0e43993eca2fa9535659c.
---
 compiler/bin-wasm_of_ocaml/compile.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index a2e82283e8..5a0135aa44 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -266,7 +266,7 @@ let run
         | None -> `Fst name)
   in
   let t1 = Timer.make () in
-  let builtin = [ Js_of_ocaml_compiler_runtime_files.jslib_js_of_ocaml ] @ builtin in
+  let builtin = Js_of_ocaml_compiler_runtime_files.runtime @ builtin in
   List.iter builtin ~f:(fun t ->
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in

From d8a442cc86859178ad84a0e0b7c078fa23f9113e Mon Sep 17 00:00:00 2001
From: Jason Gross <jasongross9@gmail.com>
Date: Wed, 18 Sep 2024 00:41:25 -0700
Subject: [PATCH 344/481] README: Pin more than just dune

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 050d5a5c5d..55160b1d5b 100644
--- a/README.md
+++ b/README.md
@@ -28,7 +28,7 @@ The following commands will perform a minimal installation:
 ```
 git clone https://github.com/ocaml-wasm/wasm_of_ocaml
 cd wasm_of_ocaml
-opam pin add dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+opam pin add https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
 opam pin add -n --with-version 5.3.0-wasm .
 opam install wasm_of_ocaml-compiler
 ```

From e8f80e0b525095e15e4c2c3bbd9c7f10d490739a Mon Sep 17 00:00:00 2001
From: Jason Gross <jasongross9@gmail.com>
Date: Wed, 18 Sep 2024 12:48:52 -0700
Subject: [PATCH 345/481] Update README.md
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Co-authored-by: Jérôme Vouillon <jerome.vouillon@gmail.com>
---
 README.md | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 55160b1d5b..3397028701 100644
--- a/README.md
+++ b/README.md
@@ -28,7 +28,8 @@ The following commands will perform a minimal installation:
 ```
 git clone https://github.com/ocaml-wasm/wasm_of_ocaml
 cd wasm_of_ocaml
-opam pin add https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+opam pin add -n --with-version 3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+opam install dune
 opam pin add -n --with-version 5.3.0-wasm .
 opam install wasm_of_ocaml-compiler
 ```

From e9befa0d88f9048d5fb4b326b02ce27dea996cb3 Mon Sep 17 00:00:00 2001
From: Jason Gross <jasongross9@gmail.com>
Date: Wed, 18 Sep 2024 12:58:37 -0700
Subject: [PATCH 346/481] Update README.md

---
 README.md | 1 -
 1 file changed, 1 deletion(-)

diff --git a/README.md b/README.md
index 3397028701..711ec239c3 100644
--- a/README.md
+++ b/README.md
@@ -29,7 +29,6 @@ The following commands will perform a minimal installation:
 git clone https://github.com/ocaml-wasm/wasm_of_ocaml
 cd wasm_of_ocaml
 opam pin add -n --with-version 3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
-opam install dune
 opam pin add -n --with-version 5.3.0-wasm .
 opam install wasm_of_ocaml-compiler
 ```

From 65a9948215b120bf92bbc5c6e1074f24ffb0ca3c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 11 Jun 2024 16:29:18 +0200
Subject: [PATCH 347/481] Refactor distinction between integer types

---
 compiler/lib/code.ml                | 65 ++++++++++++++++------
 compiler/lib/code.mli               |  4 +-
 compiler/lib/effects.ml             | 10 ++--
 compiler/lib/eval.ml                | 85 +++++++++++++++--------------
 compiler/lib/flow.ml                |  2 +-
 compiler/lib/generate.ml            |  6 +-
 compiler/lib/generate_closure.ml    |  8 +--
 compiler/lib/ocaml_compiler.ml      | 18 +++---
 compiler/lib/parse_bytecode.ml      | 59 +++++++++++---------
 compiler/lib/specialize_js.ml       |  4 +-
 compiler/lib/wasm/wa_core_target.ml |  8 +--
 compiler/lib/wasm/wa_gc_target.ml   | 12 ++--
 compiler/lib/wasm/wa_generate.ml    |  4 +-
 13 files changed, 166 insertions(+), 119 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index c4b47bd196..b7143e3f23 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -284,9 +284,11 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
+  | Int of int32
+  | Int32 of int32
   | Int64 of int64
+  | NativeInt of nativeint
   | Tuple of int * constant array * array_or_not
-  | Int of int_kind * int32
 
 let rec constant_equal a b =
   match a, b with
@@ -304,26 +306,59 @@ let rec constant_equal a b =
           | Some s, Some c -> same := Some (s && c)
         done;
         !same
+  | Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
   | Int64 a, Int64 b -> Some (Int64.equal a b)
+  | NativeInt a, NativeInt b -> Some (Nativeint.equal a b)
   | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
-  | Int (k, a), Int (k', b) -> if Poly.(k = k') then Some (Int32.equal a b) else None
   | Float a, Float b -> Some (Float.equal a b)
   | String _, NativeString _ | NativeString _, String _ -> None
   | Int _, Float _ | Float _, Int _ -> None
   | Tuple ((0 | 254), _, _), Float_array _ -> None
   | Float_array _, Tuple ((0 | 254), _, _) -> None
-  | Tuple _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Float_array _) ->
+  | ( Tuple _
+    , ( String _
+      | NativeString _
+      | Int64 _
+      | Int _
+      | Int32 _
+      | NativeInt _
+      | Float _
+      | Float_array _ ) ) -> Some false
+  | ( Float_array _
+    , ( String _
+      | NativeString _
+      | Int64 _
+      | Int _
+      | Int32 _
+      | NativeInt _
+      | Float _
+      | Tuple _ ) ) -> Some false
+  | ( String _
+    , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
       Some false
-  | Float_array _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Tuple _) ->
-      Some false
-  | String _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
-  | NativeString _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
-  | Int64 _, (String _ | NativeString _ | Int _ | Float _ | Tuple _ | Float_array _) ->
+  | ( NativeString _
+    , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
       Some false
+  | ( Int64 _
+    , ( String _
+      | NativeString _
+      | Int _
+      | Int32 _
+      | NativeInt _
+      | Float _
+      | Tuple _
+      | Float_array _ ) ) -> Some false
   | Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
       Some false
-  | Int _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
+  | ( (Int _ | Int32 _ | NativeInt _)
+    , (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ) ->
       Some false
+  (* Note: the following cases should not occur when compiling to Javascript *)
+  | Int _, (Int32 _ | NativeInt _)
+  | Int32 _, (Int _ | NativeInt _)
+  | NativeInt _, (Int _ | Int32 _)
+  | (Int32 _ | NativeInt _), Float _
+  | Float _, (Int32 _ | NativeInt _) -> None
 
 type loc =
   | No
@@ -413,7 +448,10 @@ module Print = struct
           Format.fprintf f "%.12g" a.(i)
         done;
         Format.fprintf f "|]"
+    | Int i -> Format.fprintf f "%ld" i
+    | Int32 i -> Format.fprintf f "%ldl" i
     | Int64 i -> Format.fprintf f "%LdL" i
+    | NativeInt i -> Format.fprintf f "%ndn" i
     | Tuple (tag, a, _) -> (
         Format.fprintf f "<%d>" tag;
         match Array.length a with
@@ -430,15 +468,6 @@ module Print = struct
               constant f a.(i)
             done;
             Format.fprintf f ")")
-    | Int (k, i) ->
-        Format.fprintf
-          f
-          "%ld%s"
-          i
-          (match k with
-          | Regular -> ""
-          | Int32 -> "l"
-          | Native -> "n")
 
   let arg f a =
     match a with
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 8a22b98bf4..16af487375 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -162,9 +162,11 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
+  | Int of int32
+  | Int32 of int32  (** Only produced when compiling to WebAssembly. *)
   | Int64 of int64
+  | NativeInt of nativeint  (** Only produced when compiling to WebAssembly. *)
   | Tuple of int * constant array * array_or_not
-  | Int of int_kind * int32
 
 val constant_equal : constant -> constant -> bool option
 
diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml
index 7424b6bdd8..66c79a3ed7 100644
--- a/compiler/lib/effects.ml
+++ b/compiler/lib/effects.ml
@@ -300,7 +300,7 @@ let cps_branch ~st ~src (pc, args) loc =
           (* We are jumping to a block that is also used as a continuation.
              We pass it a dummy argument. *)
           let x = Var.fresh () in
-          [ x ], [ Let (x, Constant (Int (Regular, 0l))), noloc ]
+          [ x ], [ Let (x, Constant (Int 0l)), noloc ]
         else args, []
       in
       (* We check the stack depth only for backward edges (so, at
@@ -402,7 +402,7 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
                         ( x'
                         , Prim
                             ( Extern "caml_maybe_attach_backtrace"
-                            , [ Pv x; Pc (Int (Regular, if force then 1l else 0l)) ] ) )
+                            , [ Pv x; Pc (Int (if force then 1l else 0l)) ] ) )
                     , noloc )
                   ]
                 in
@@ -480,12 +480,12 @@ let cps_instr ~st (instr : instr) : instr =
       Let (x, Closure (params @ [ k ], cont))
   | Let (x, Prim (Extern "caml_alloc_dummy_function", [ size; arity ])) -> (
       match arity with
-      | Pc (Int (_, a)) ->
+      | Pc (Int a) ->
           Let
             ( x
             , Prim
                 ( Extern "caml_alloc_dummy_function"
-                , [ size; Pc (Int (Regular, Int32.succ a)) ] ) )
+                , [ size; Pc (Int (Int32.succ a)) ] ) )
       | _ -> assert false)
   | Let (x, Apply { f; args; _ }) when not (Var.Set.mem x st.cps_needed) ->
       (* At the moment, we turn into CPS any function not called with
@@ -563,7 +563,7 @@ let cps_block ~st ~k pc block =
               [ arg; k' ]
               loc)
     | Prim (Extern "%perform", [ Pv effect ]) ->
-        perform_effect ~effect ~continuation:(Pc (Int (Regular, 0l))) loc
+        perform_effect ~effect ~continuation:(Pc (Int 0l)) loc
     | Prim (Extern "%reperform", [ Pv effect; continuation ]) ->
         perform_effect ~effect ~continuation loc
     | _ -> None
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 5a2f5fb939..e61bd48a55 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -33,22 +33,22 @@ module Int = Int32
 
 let int_binop l w f =
   match l with
-  | [ Int (_, i); Int (_, j) ] -> Some (Int (Regular, w (f i j)))
+  | [ Int i; Int j ] -> Some (Int (w (f i j)))
   | _ -> None
 
 let shift l w t f =
   match l with
-  | [ Int (_, i); Int (_, j) ] ->
-      Some (Int (Regular, w (f (t i) (Int32.to_int j land 0x1f))))
+  | [ Int i; Int j ] ->
+      Some (Int (w (f (t i) (Int32.to_int j land 0x1f))))
   | _ -> None
 
 let float_binop_aux l f =
   let args =
     match l with
     | [ Float i; Float j ] -> Some (i, j)
-    | [ Int (_, i); Int (_, j) ] -> Some (Int32.to_float i, Int32.to_float j)
-    | [ Int (_, i); Float j ] -> Some (Int32.to_float i, j)
-    | [ Float i; Int (_, j) ] -> Some (i, Int32.to_float j)
+    | [ Int i; Int j ] -> Some (Int32.to_float i, Int32.to_float j)
+    | [ Int i; Float j ] -> Some (Int32.to_float i, j)
+    | [ Float i; Int j ] -> Some (i, Int32.to_float j)
     | _ -> None
   in
   match args with
@@ -63,25 +63,25 @@ let float_binop l f =
 let float_unop l f =
   match l with
   | [ Float i ] -> Some (Float (f i))
-  | [ Int (_, i) ] -> Some (Float (f (Int32.to_float i)))
+  | [ Int i ] -> Some (Float (f (Int32.to_float i)))
   | _ -> None
 
 let float_binop_bool l f =
   match float_binop_aux l f with
-  | Some true -> Some (Int (Regular, 1l))
-  | Some false -> Some (Int (Regular, 0l))
+  | Some true -> Some (Int 1l)
+  | Some false -> Some (Int 0l)
   | None -> None
 
-let bool b = Some (Int (Regular, if b then 1l else 0l))
+let bool b = Some (Int (if b then 1l else 0l))
 
 let eval_prim ~target x =
   match x with
-  | Not, [ Int (_, i) ] -> bool Int32.(i = 0l)
-  | Lt, [ Int (_, i); Int (_, j) ] -> bool Int32.(i < j)
-  | Le, [ Int (_, i); Int (_, j) ] -> bool Int32.(i <= j)
-  | Eq, [ Int (_, i); Int (_, j) ] -> bool Int32.(i = j)
-  | Neq, [ Int (_, i); Int (_, j) ] -> bool Int32.(i <> j)
-  | Ult, [ Int (_, i); Int (_, j) ] -> bool (Int32.(j < 0l) || Int32.(i < j))
+  | Not, [ Int i ] -> bool Int32.(i = 0l)
+  | Lt, [ Int i; Int j ] -> bool Int32.(i < j)
+  | Le, [ Int i; Int j ] -> bool Int32.(i <= j)
+  | Eq, [ Int i; Int j ] -> bool Int32.(i = j)
+  | Neq, [ Int i; Int j ] -> bool Int32.(i <> j)
+  | Ult, [ Int i; Int j ] -> bool (Int32.(j < 0l) || Int32.(i < j))
   | Extern name, l -> (
       let name = Primitive.resolve name in
       let wrap =
@@ -94,7 +94,7 @@ let eval_prim ~target x =
       | "%int_add", _ -> int_binop l wrap Int.add
       | "%int_sub", _ -> int_binop l wrap Int.sub
       | "%direct_int_mul", _ -> int_binop l wrap Int.mul
-      | "%direct_int_div", [ _; Int (_, 0l) ] -> None
+      | "%direct_int_div", [ _; Int 0l ] -> None
       | "%direct_int_div", _ -> int_binop l wrap Int.div
       | "%direct_int_mod", _ -> int_binop l wrap Int.rem
       | "%int_and", _ -> int_binop l wrap Int.logand
@@ -110,7 +110,7 @@ let eval_prim ~target x =
             | `Wasm -> fun i -> Int.logand i 0x7fffffffl)
             Int.shift_right_logical
       | "%int_asr", _ -> shift l wrap Fun.id Int.shift_right
-      | "%int_neg", [ Int (_, i) ] -> Some (Int (Regular, Int.neg i))
+      | "%int_neg", [ Int i ] -> Some (Int (Int.neg i))
       (* float *)
       | "caml_eq_float", _ -> float_binop_bool l Float.( = )
       | "caml_neq_float", _ -> float_binop_bool l Float.( <> )
@@ -123,9 +123,9 @@ let eval_prim ~target x =
       | "caml_mul_float", _ -> float_binop l ( *. )
       | "caml_div_float", _ -> float_binop l ( /. )
       | "caml_fmod_float", _ -> float_binop l mod_float
-      | "caml_int_of_float", [ Float f ] -> Some (Int (Regular, Int.of_float f))
-      | "to_int", [ Float f ] -> Some (Int (Regular, Int.of_float f))
-      | "to_int", [ Int (_, i) ] -> Some (Int (Regular, i))
+      | "caml_int_of_float", [ Float f ] -> Some (Int (Int.of_float f))
+      | "to_int", [ Float f ] -> Some (Int (Int.of_float f))
+      | "to_int", [ Int i ] -> Some (Int i)
       (* Math *)
       | "caml_neg_float", _ -> float_unop l ( ~-. )
       | "caml_abs_float", _ -> float_unop l abs_float
@@ -142,10 +142,10 @@ let eval_prim ~target x =
       | "caml_sin_float", _ -> float_unop l sin
       | "caml_sqrt_float", _ -> float_unop l sqrt
       | "caml_tan_float", _ -> float_unop l tan
-      | ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int (_, pos) ] ->
+      | ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int pos ] ->
           let pos = Int32.to_int pos in
           if Config.Flag.safe_string () && pos >= 0 && pos < String.length s
-          then Some (Int (Regular, Int32.of_int (Char.code s.[pos])))
+          then Some (Int (Int32.of_int (Char.code s.[pos])))
           else None
       | "caml_string_equal", [ String s1; String s2 ] -> bool (String.equal s1 s2)
       | "caml_string_notequal", [ String s1; String s2 ] ->
@@ -154,16 +154,15 @@ let eval_prim ~target x =
           match get_static_env s with
           | Some env -> Some (String env)
           | None -> None)
-      | "caml_sys_const_word_size", [ _ ] -> Some (Int (Regular, 32l))
+      | "caml_sys_const_word_size", [ _ ] -> Some (Int 32l)
       | "caml_sys_const_int_size", [ _ ] ->
           Some
             (Int
-               ( Regular
-               , match target with
-                 | `JavaScript -> 32l
-                 | `Wasm -> 31l ))
-      | "caml_sys_const_big_endian", [ _ ] -> Some (Int (Regular, 0l))
-      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int (Regular, 0l))
+               (match target with
+                | `JavaScript -> 32l
+                | `Wasm -> 31l ))
+      | "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
+      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
       | _ -> None)
   | _ -> None
 
@@ -195,8 +194,8 @@ let is_int ~target info x =
         info
         (fun x ->
           match info.info_defs.(Var.idx x) with
-          | Expr (Constant (Int (Regular, _))) -> Y
-          | Expr (Constant (Int _)) -> (
+          | Expr (Constant (Int _)) -> Y
+          | Expr (Constant (Int32 _ | NativeInt _)) -> (
               match target with
               | `JavaScript -> Y
               | `Wasm -> N)
@@ -209,8 +208,8 @@ let is_int ~target info x =
           | N, N -> N
           | _ -> Unknown)
         x
-  | Pc (Int (Regular, _)) -> Y
-  | Pc (Int _) -> (
+  | Pc (Int _) -> Y
+  | Pc (Int32 _ | NativeInt _) -> (
       match target with
       | `JavaScript -> Y
       | `Wasm -> N)
@@ -247,7 +246,7 @@ let the_cont_of info x (a : cont array) =
     (fun x ->
       match info.info_defs.(Var.idx x) with
       | Expr (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get
-      | Expr (Constant (Int (_, j))) -> get (Int32.to_int j)
+      | Expr (Constant (Int j)) -> get (Int32.to_int j)
       | _ -> None)
     None
     (fun u v ->
@@ -265,7 +264,7 @@ let eval_instr ~target info ((x, loc) as i) =
           | None -> [ i ]
           | Some c ->
               let c = if c then 1l else 0l in
-              let c = Constant (Int (Regular, c)) in
+              let c = Constant (Int c) in
               Flow.update_def info x c;
               [ Let (x, c), loc ])
       | _ -> [ i ])
@@ -279,7 +278,7 @@ let eval_instr ~target info ((x, loc) as i) =
       match c with
       | None -> [ i ]
       | Some c ->
-          let c = Constant (Int (Regular, c)) in
+          let c = Constant (Int c) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
   | Let
@@ -302,13 +301,13 @@ let eval_instr ~target info ((x, loc) as i) =
       | Unknown -> [ i ]
       | (Y | N) as b ->
           let b = if Poly.(b = N) then 0l else 1l in
-          let c = Constant (Int (Regular, b)) in
+          let c = Constant (Int b) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
   | Let (x, Prim (Extern "%direct_obj_tag", [ y ])) -> (
       match the_tag_of info y (fun x -> Some x) with
       | Some tag ->
-          let c = Constant (Int (Regular, Int32.of_int tag)) in
+          let c = Constant (Int (Int32.of_int tag)) in
           Flow.update_def info x c;
           [ Let (x, c), loc ]
       | None -> [ i ])
@@ -374,11 +373,13 @@ let the_cond_of info x =
   get_approx
     info
     (fun x ->
-      match info.info_defs.(Var.idx x) with
-      | Expr (Constant (Int (_, 0l))) -> Zero
-      | Expr
+      match Flow.Info.def info x with
+      | Some (Constant (Int 0l)) -> Zero
+      | Some
           (Constant
             ( Int _
+            | Int32 _
+            | NativeInt _
             | Float _
             | Tuple _
             | String _
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index ebf5773f59..b5ee88b9a2 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -344,7 +344,7 @@ let the_const_of info x =
 
 let the_int info x =
   match the_const_of info x with
-  | Some (Int (_, i)) -> Some i
+  | Some (Int i) -> Some i
   | _ -> None
 
 let the_string_of info x =
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 45859f1d72..5dcf214e43 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -451,7 +451,7 @@ let rec constant_rec ~ctx x level instrs =
       let constant_max_depth = Config.Param.constant_max_depth () in
       let rec detect_list n acc = function
         | Tuple (0, [| x; l |], _) -> detect_list (succ n) (x :: acc) l
-        | Int (_, 0l) -> if n > constant_max_depth then Some acc else None
+        | Int 0l -> if n > constant_max_depth then Some acc else None
         | _ -> None
       in
       match detect_list 0 [] x with
@@ -488,7 +488,9 @@ let rec constant_rec ~ctx x level instrs =
             else List.rev l, instrs
           in
           Mlvalue.Block.make ~tag ~args:l, instrs)
-  | Int (_, i) -> int32 i, instrs
+  | Int i -> int32 i, instrs
+  | Int32 _ | NativeInt _ ->
+      assert false (* Should not be produced when compiling to Javascript *)
 
 let constant ~ctx x level =
   let expr, instr = constant_rec ~ctx x level [] in
diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml
index 9a638169ac..3094ac98c3 100644
--- a/compiler/lib/generate_closure.ml
+++ b/compiler/lib/generate_closure.ml
@@ -107,7 +107,7 @@ module Trampoline = struct
         ; body =
             [ ( Let
                   ( counter_plus_1
-                  , Prim (Extern "%int_add", [ Pv counter; Pc (Int (Regular, 1l)) ]) )
+                  , Prim (Extern "%int_add", [ Pv counter; Pc (Int 1l) ]) )
               , noloc )
             ; Let (return, Apply { f; args = counter_plus_1 :: args; exact = true }), loc
             ]
@@ -123,7 +123,7 @@ module Trampoline = struct
               ( new_args
               , Prim
                   ( Extern "%js_array"
-                  , Pc (Int (Regular, 0l)) :: List.map args ~f:(fun x -> Pv x) ) )
+                  , Pc (Int 0l) :: List.map args ~f:(fun x -> Pv x) ) )
           , noloc )
         ; Let (return, Prim (Extern "caml_trampoline_return", [ Pv f; Pv new_args ])), loc
         ]
@@ -142,7 +142,7 @@ module Trampoline = struct
               ; Let (result2, Prim (Extern "caml_trampoline", [ Pv result1 ])), noloc
               ]
           | Some counter ->
-              [ Let (counter, Constant (Int (Regular, 0l))), noloc
+              [ Let (counter, Constant (Int 0l)), noloc
               ; Let (result1, Apply { f; args = counter :: args; exact = true }), loc
               ; Let (result2, Prim (Extern "caml_trampoline", [ Pv result1 ])), noloc
               ])
@@ -248,7 +248,7 @@ module Trampoline = struct
                                         , [ Pv counter
                                           ; Pc
                                               (Int
-                                                 (Regular, Int32.of_int tailcall_max_depth))
+                                                 (Int32.of_int tailcall_max_depth))
                                           ] ) )
                                 , noloc )
                               in
diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
index 5709ada026..d42742b842 100644
--- a/compiler/lib/ocaml_compiler.ml
+++ b/compiler/lib/ocaml_compiler.ml
@@ -24,18 +24,22 @@ let rec constant_of_const ~target c : Code.constant =
   match c with
   | Const_base (Const_int i) ->
       Int
-        ( Regular
-        , match target with
-          | `JavaScript -> Int32.of_int_warning_on_overflow i
-          | `Wasm -> Int31.of_int_warning_on_overflow i )
-  | Const_base (Const_char c) -> Int (Regular, Int32.of_int (Char.code c))
+        (match target with
+         | `JavaScript -> Int32.of_int_warning_on_overflow i
+         | `Wasm -> Int31.of_int_warning_on_overflow i)
+  | Const_base (Const_char c) -> Int (Int32.of_int (Char.code c))
   | ((Const_base (Const_string (s, _))) [@if ocaml_version < (4, 11, 0)])
   | ((Const_base (Const_string (s, _, _))) [@if ocaml_version >= (4, 11, 0)]) -> String s
   | Const_base (Const_float s) -> Float (float_of_string s)
-  | Const_base (Const_int32 i) -> Int (Int32, i)
+  | Const_base (Const_int32 i) ->
+      (match target with
+       | `JavaScript -> Int i
+       | `Wasm -> Int32 i)
   | Const_base (Const_int64 i) -> Int64 i
   | Const_base (Const_nativeint i) ->
-      Int (Native, Int32.of_nativeint_warning_on_overflow i)
+      (match target with
+       | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
+       | `Wasm -> NativeInt i)
   | Const_immstring s -> String s
   | Const_float_array sl ->
       let l = List.map ~f:(fun f -> float_of_string f) sl in
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 1caac8caf2..906895a534 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -465,10 +465,16 @@ end = struct
       else if tag = Obj.custom_tag
       then
         match ident_of_custom x with
-        | Some name when same_ident name ident_32 -> Int (Int32, (Obj.magic x : int32))
+        | Some name when same_ident name ident_32 ->
+            let i : int32 = Obj.magic x in
+            (match target with
+             | `JavaScript -> Int i
+             | `Wasm -> Int32 i)
         | Some name when same_ident name ident_native ->
             let i : nativeint = Obj.magic x in
-            Int (Native, Int32.of_nativeint_warning_on_overflow i)
+            (match target with
+             | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
+             | `Wasm -> NativeInt i)
         | Some name when same_ident name ident_64 -> Int64 (Obj.magic x : int64)
         | Some name ->
             failwith
@@ -486,10 +492,9 @@ end = struct
     else
       let i : int = Obj.magic x in
       Int
-        ( Regular
-        , match target with
-          | `JavaScript -> Int32.of_int_warning_on_overflow i
-          | `Wasm -> Int31.of_int_warning_on_overflow i )
+        (match target with
+         | `JavaScript -> Int32.of_int_warning_on_overflow i
+         | `Wasm -> Int31.of_int_warning_on_overflow i)
 
   let inlined = function
     | String _ | NativeString _ -> false
@@ -498,9 +503,10 @@ end = struct
     | Int64 _ -> false
     | Tuple _ -> false
     | Int _ -> true
+    | Int32 _ | NativeInt _ -> false
 end
 
-let const i = Constant (Int (Regular, i))
+let const i = Constant (Int i)
 
 (* Globals *)
 type globals =
@@ -770,7 +776,7 @@ let register_global ~target ?(force = false) g i loc rem =
         ( Var.fresh ()
         , Prim
             ( Extern "caml_register_global"
-            , Pc (Int (Regular, Int32.of_int i)) :: Pv (access_global g i) :: args ) )
+            , Pc (Int (Int32.of_int i)) :: Pv (access_global g i) :: args ) )
     , loc )
     :: rem
   else rem
@@ -1522,7 +1528,7 @@ and compile infos pc state instrs =
                ( x
                , Prim
                    ( Extern "caml_floatarray_unsafe_get"
-                   , [ Pv y; Pc (Int (Regular, Int32.of_int n)) ] ) )
+                   , [ Pv y; Pc (Int (Int32.of_int n)) ] ) )
            , loc )
           :: instrs)
     | SETFIELD0 ->
@@ -1602,7 +1608,7 @@ and compile infos pc state instrs =
                ( x
                , Prim
                    ( Extern "caml_floatarray_unsafe_set"
-                   , [ Pv y; Pc (Int (Regular, Int32.of_int n)); Pv z ] ) )
+                   , [ Pv y; Pc (Int (Int32.of_int n)); Pv z ] ) )
            , loc )
           :: instrs)
     | VECTLENGTH ->
@@ -2236,7 +2242,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Eq, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Eq, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BNEQ ->
@@ -2246,7 +2252,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Eq, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Eq, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | BLTINT ->
@@ -2256,7 +2262,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Lt, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Lt, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BLEINT ->
@@ -2266,7 +2272,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Le, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Le, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BGTINT ->
@@ -2276,7 +2282,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Le, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Le, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | BGEINT ->
@@ -2286,7 +2292,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Lt, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Lt, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | BULTINT ->
@@ -2296,7 +2302,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Ult, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Ult, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + offset + 2, args), (pc + 3, args)), loc)
         , state )
     | BUGEINT ->
@@ -2306,7 +2312,7 @@ and compile infos pc state instrs =
         let args = State.stack_vars state in
         let y = Var.fresh () in
 
-        ( (Let (y, Prim (Ult, [ Pc (Int (Regular, n)); Pv x ])), loc) :: instrs
+        ( (Let (y, Prim (Ult, [ Pc (Int n); Pv x ])), loc) :: instrs
         , (Cond (y, (pc + 3, args), (pc + offset + 2, args)), loc)
         , state )
     | ULTINT ->
@@ -2369,7 +2375,7 @@ and compile infos pc state instrs =
                ( m
                , Prim
                    ( Extern "caml_get_public_method"
-                   , [ Pv obj; Pv tag; Pc (Int (Regular, Int32.of_int cache)) ] ) )
+                   , [ Pv obj; Pv tag; Pc (Int (Int32.of_int cache)) ] ) )
            , loc )
           :: (Let (tag, const n), loc)
           :: instrs)
@@ -2396,7 +2402,7 @@ and compile infos pc state instrs =
                ( m
                , Prim
                    ( Extern "caml_get_public_method"
-                   , [ Pv obj; Pv tag; Pc (Int (Regular, 0l)) ] ) )
+                   , [ Pv obj; Pv tag; Pc (Int 0l) ] ) )
            , loc )
           :: instrs)
     | GETMETHOD ->
@@ -2728,7 +2734,7 @@ let from_exe
       let need_gdata = ref false in
       let infos =
         [ "toc", Constants.parse ~target (Obj.repr toc)
-        ; "prim_count", Int (Regular, Int32.of_int (Array.length globals.primitives))
+        ; "prim_count", Int (Int32.of_int (Array.length globals.primitives))
         ]
       in
       let body =
@@ -3110,17 +3116,16 @@ let predefined_exceptions ~target =
                 ( v_index
                 , Constant
                     (Int
-                       ( (* Predefined exceptions are registered in
-                            Symtable.init with [-index - 1] *)
-                         Regular
-                       , Int32.of_int (-index - 1) )) )
+                       ((* Predefined exceptions are registered in
+                           Symtable.init with [-index - 1] *)
+                        Int32.of_int (-index - 1) )))
             , noloc )
           ; Let (exn, Block (248, [| v_name; v_index |], NotArray, Immutable)), noloc
           ; ( Let
                 ( Var.fresh ()
                 , Prim
                     ( Extern "caml_register_global"
-                    , [ Pc (Int (Regular, Int32.of_int index))
+                    , [ Pc (Int (Int32.of_int index))
                       ; Pv exn
                       ; Pv
                           (match target with
@@ -3177,7 +3182,7 @@ let link_info ~target ~symtable ~primitives ~crcs =
     in
     let infos =
       [ "toc", Constants.parse ~target (Obj.repr toc)
-      ; "prim_count", Int (Regular, Int32.of_int (List.length primitives))
+      ; "prim_count", Int (Int32.of_int (List.length primitives))
       ]
     in
     let body =
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index d3a376beeb..3140865215 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -51,7 +51,7 @@ let specialize_instr ~target info i =
       match the_string_of info y with
       | Some s when Primitive.need_named_value s ->
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
-      | Some _ -> Let (x, Constant (Int (Regular, 0l)))
+      | Some _ -> Let (x, Constant (Int 0l))
       | None -> i)
   | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), _ -> (
       match the_def_of info a with
@@ -284,7 +284,7 @@ let f_once p =
                  , [ _; _; _ ] ) as p) ) ->
             let x' = Code.Var.fork x in
             let acc =
-              (Let (x', p), loc) :: (Let (x, Constant (Int (Regular, 0l))), loc) :: acc
+              (Let (x', p), loc) :: (Let (x, Constant (Int 0l)), loc) :: acc
             in
             loop acc r
         | _ -> loop ((i, loc) :: acc) r)
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index ed4079d0eb..0e7eafda25 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -348,7 +348,7 @@ end
 module Constant = struct
   let rec translate_rec context c =
     match c with
-    | Code.Int (Regular, i) -> W.DataI32 Int32.(add (add i i) 1l)
+    | Code.Int i -> W.DataI32 Int32.(add (add i i) 1l)
     | Tuple (tag, a, _) ->
         let h = Memory.header ~const:true ~tag ~len:(Array.length a) () in
         let name = Code.Var.fresh_n "block" in
@@ -397,7 +397,7 @@ module Constant = struct
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
         W.DataSym (V name, 4)
-    | Int (Int32, i) ->
+    | Int32 i ->
         let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:2 () in
         let name = Code.Var.fresh_n "int32" in
         let block =
@@ -405,13 +405,13 @@ module Constant = struct
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
         W.DataSym (V name, 4)
-    | Int (Native, i) ->
+    | NativeInt i ->
         let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:2 () in
         let name = Code.Var.fresh_n "nativeint" in
         let block =
           [ W.DataI32 h
           ; DataI32 0l (*ZZZ DataSym (S "caml_nativeint_ops", 0)*)
-          ; DataI32 i
+          ; DataI32 (Int32.of_nativeint_warning_on_overflow i)
           ]
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 5b7b954801..9f452b6682 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -933,7 +933,7 @@ module Constant = struct
 
   let rec translate_rec c =
     match c with
-    | Code.Int (Regular, i) -> return (Const, W.RefI31 (Const (I32 i)))
+    | Code.Int i -> return (Const, W.RefI31 (Const (I32 i)))
     | Tuple (tag, a, _) ->
         let* ty = Type.block_type in
         let* l =
@@ -1031,11 +1031,15 @@ module Constant = struct
     | Int64 i ->
         let* e = Memory.make_int64 (return (W.Const (I64 i))) in
         return (Const, e)
-    | Int (Int32, i) ->
+    | Int32 i ->
         let* e = Memory.make_int32 ~kind:`Int32 (return (W.Const (I32 i))) in
         return (Const, e)
-    | Int (Native, i) ->
-        let* e = Memory.make_int32 ~kind:`Nativeint (return (W.Const (I32 i))) in
+    | NativeInt i ->
+        let* e =
+          Memory.make_int32
+            ~kind:`Nativeint
+            (return (W.Const (I32 (Int32.of_nativeint_warning_on_overflow i))))
+        in
         return (Const, e)
 
   let translate c =
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 7dcc3ca6db..62c8d80ee0 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -166,9 +166,9 @@ module Generate (Target : Wa_target_sig.S) = struct
           ~cps:(Var.Set.mem x ctx.in_cps)
           x
     | Constant c -> Constant.translate c
-    | Special Undefined -> Constant.translate (Int (Regular, 0l))
+    | Special Undefined -> Constant.translate (Int 0l)
     | Special (Alias_prim _) -> assert false
-    | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int (_, arity)) ])
+    | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int arity) ])
       when Poly.(target = `GC) ->
         Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:(Int32.to_int arity)
     | Prim (Extern "caml_alloc_dummy_infix", _) when Poly.(target = `GC) ->

From 2034c1932df6dabbf8ed38d8dd5d85e7c0ed2694 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 28 Aug 2024 15:23:29 +0200
Subject: [PATCH 348/481] Distinguish float field accesses in the Code IR

---
 compiler/lib/code.ml           | 20 +++++++++----
 compiler/lib/code.mli          |  8 +++--
 compiler/lib/deadcode.ml       |  6 ++--
 compiler/lib/eval.ml           | 11 +++----
 compiler/lib/flow.ml           | 10 +++----
 compiler/lib/freevars.ml       |  4 +--
 compiler/lib/generate.ml       |  4 +--
 compiler/lib/global_flow.ml    |  8 ++---
 compiler/lib/parse_bytecode.ml | 54 +++++++++++++---------------------
 compiler/lib/phisimpl.ml       |  2 +-
 compiler/lib/subst.ml          |  4 +--
 11 files changed, 65 insertions(+), 66 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index b7143e3f23..591cac4c1d 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -377,6 +377,10 @@ type mutability =
   | Immutable
   | Maybe_mutable
 
+type field_type =
+  | Non_float
+  | Float
+
 type expr =
   | Apply of
       { f : Var.t
@@ -384,7 +388,7 @@ type expr =
       ; exact : bool
       }
   | Block of int * Var.t array * array_or_not * mutability
-  | Field of Var.t * int
+  | Field of Var.t * int * field_type
   | Closure of Var.t list * cont
   | Constant of constant
   | Prim of prim * prim_arg list
@@ -393,7 +397,7 @@ type expr =
 type instr =
   | Let of Var.t * expr
   | Assign of Var.t * Var.t
-  | Set_field of Var.t * int * Var.t
+  | Set_field of Var.t * int * field_type * Var.t
   | Offset_ref of Var.t * int
   | Array_set of Var.t * Var.t * Var.t
 
@@ -537,7 +541,8 @@ module Print = struct
           Format.fprintf f "; %d = %a" i Var.print a.(i)
         done;
         Format.fprintf f "}"
-    | Field (x, i) -> Format.fprintf f "%a[%d]" Var.print x i
+    | Field (x, i, Non_float) -> Format.fprintf f "%a[%d]" Var.print x i
+    | Field (x, i, Float) -> Format.fprintf f "FLOAT{%a[%d]}" Var.print x i
     | Closure (l, c) -> Format.fprintf f "fun(%a){%a}" var_list l cont c
     | Constant c -> Format.fprintf f "CONST{%a}" constant c
     | Prim (p, l) -> prim f p l
@@ -547,7 +552,10 @@ module Print = struct
     match i with
     | Let (x, e) -> Format.fprintf f "%a = %a" Var.print x expr e
     | Assign (x, y) -> Format.fprintf f "(assign) %a = %a" Var.print x Var.print y
-    | Set_field (x, i, y) -> Format.fprintf f "%a[%d] = %a" Var.print x i Var.print y
+    | Set_field (x, i, Non_float, y) ->
+        Format.fprintf f "%a[%d] = %a" Var.print x i Var.print y
+    | Set_field (x, i, Float, y) ->
+        Format.fprintf f "FLOAT{%a[%d]} = %a" Var.print x i Var.print y
     | Offset_ref (x, i) -> Format.fprintf f "%a[0] += %d" Var.print x i
     | Array_set (x, y, z) ->
         Format.fprintf f "%a[%a] = %a" Var.print x Var.print y Var.print z
@@ -821,7 +829,7 @@ let invariant { blocks; start; _ } =
     let check_expr = function
       | Apply _ -> ()
       | Block (_, _, _, _) -> ()
-      | Field (_, _) -> ()
+      | Field (_, _, _) -> ()
       | Closure (l, cont) ->
           List.iter l ~f:define;
           check_cont cont
@@ -835,7 +843,7 @@ let invariant { blocks; start; _ } =
           define x;
           check_expr e
       | Assign _ -> ()
-      | Set_field (_, _i, _) -> ()
+      | Set_field (_, _i, _, _) -> ()
       | Offset_ref (_x, _i) -> ()
       | Array_set (_x, _y, _z) -> ()
     in
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 16af487375..6e8f0d0bd8 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -191,6 +191,10 @@ type mutability =
   | Immutable
   | Maybe_mutable
 
+type field_type =
+  | Non_float
+  | Float
+
 type expr =
   | Apply of
       { f : Var.t
@@ -198,7 +202,7 @@ type expr =
       ; exact : bool (* if true, then # of arguments = # of parameters *)
       }
   | Block of int * Var.t array * array_or_not * mutability
-  | Field of Var.t * int
+  | Field of Var.t * int * field_type
   | Closure of Var.t list * cont
   | Constant of constant
   | Prim of prim * prim_arg list
@@ -207,7 +211,7 @@ type expr =
 type instr =
   | Let of Var.t * expr
   | Assign of Var.t * Var.t
-  | Set_field of Var.t * int * Var.t
+  | Set_field of Var.t * int * field_type * Var.t
   | Offset_ref of Var.t * int
   | Array_set of Var.t * Var.t * Var.t
 
diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml
index ae182423f7..5e7b61756b 100644
--- a/compiler/lib/deadcode.ml
+++ b/compiler/lib/deadcode.ml
@@ -62,7 +62,7 @@ and mark_expr st e =
       mark_var st f;
       List.iter args ~f:(fun x -> mark_var st x)
   | Block (_, a, _, _) -> Array.iter a ~f:(fun x -> mark_var st x)
-  | Field (x, _) -> mark_var st x
+  | Field (x, _, _) -> mark_var st x
   | Closure (_, (pc, _)) -> mark_reachable st pc
   | Special _ -> ()
   | Prim (_, l) ->
@@ -82,7 +82,7 @@ and mark_reachable st pc =
         match i with
         | Let (_, e) -> if not (pure_expr st.pure_funs e) then mark_expr st e
         | Assign _ -> ()
-        | Set_field (x, _, y) ->
+        | Set_field (x, _, _, y) ->
             mark_var st x;
             mark_var st y
         | Array_set (x, y, z) ->
@@ -190,7 +190,7 @@ let f ({ blocks; _ } as p : Code.program) =
           match i with
           | Let (x, e) -> add_def defs x (Expr e)
           | Assign (x, y) -> add_def defs x (Var y)
-          | Set_field (_, _, _) | Array_set (_, _, _) | Offset_ref (_, _) -> ());
+          | Set_field (_, _, _, _) | Array_set (_, _, _) | Offset_ref (_, _) -> ());
       match fst block.branch with
       | Return _ | Raise _ | Stop -> ()
       | Branch cont -> add_cont_dep blocks defs cont
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index e61bd48a55..d8a4e48e24 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -42,7 +42,7 @@ let shift l w t f =
       Some (Int (w (f (t i) (Int32.to_int j land 0x1f))))
   | _ -> None
 
-let float_binop_aux l f =
+let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option =
   let args =
     match l with
     | [ Float i; Float j ] -> Some (i, j)
@@ -55,12 +55,12 @@ let float_binop_aux l f =
   | None -> None
   | Some (i, j) -> Some (f i j)
 
-let float_binop l f =
+let float_binop (l : constant list) (f : float -> float -> float) : constant option =
   match float_binop_aux l f with
   | Some x -> Some (Float x)
   | None -> None
 
-let float_unop l f =
+let float_unop (l : constant list) (f : float -> float) : constant option =
   match l with
   | [ Float i ] -> Some (Float (f i))
   | [ Int i ] -> Some (Float (f (Int32.to_float i)))
@@ -426,10 +426,11 @@ let rec do_not_raise pc visited blocks =
     let b = Addr.Map.find pc blocks in
     List.iter b.body ~f:(fun (i, _loc) ->
         match i with
-        | Array_set (_, _, _) | Offset_ref (_, _) | Set_field (_, _, _) | Assign _ -> ()
+        | Array_set (_, _, _) | Offset_ref (_, _) | Set_field (_, _, _, _) | Assign _ ->
+            ()
         | Let (_, e) -> (
             match e with
-            | Block (_, _, _, _) | Field (_, _) | Constant _ | Closure _ -> ()
+            | Block (_, _, _, _) | Field (_, _, _) | Constant _ | Closure _ -> ()
             | Apply _ -> raise May_raise
             | Special _ -> ()
             | Prim (Extern name, _) when Primitive.is_pure name -> ()
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index b5ee88b9a2..f5e8193ea9 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -94,7 +94,7 @@ let expr_deps blocks vars deps defs x e =
       List.iter l ~f:(fun x -> add_param_def vars defs x);
       cont_deps blocks vars deps defs cont
   | Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
-  | Field (y, _) -> add_dep deps x y
+  | Field (y, _, _) -> add_dep deps x y
 
 let program_deps { blocks; _ } =
   let nv = Var.count () in
@@ -138,7 +138,7 @@ let propagate1 deps defs st x =
       match e with
       | Constant _ | Apply _ | Prim _ | Special _ | Closure _ | Block _ ->
           Var.Set.singleton x
-      | Field (y, n) ->
+      | Field (y, n, _) ->
           var_set_lift
             (fun z ->
               match defs.(Var.idx z) with
@@ -244,7 +244,7 @@ let program_escape defs known_origins { blocks; _ } =
           match i with
           | Let (x, e) -> expr_escape st x e
           | Assign _ -> ()
-          | Set_field (x, _, y) | Array_set (x, _, y) ->
+          | Set_field (x, _, _, y) | Array_set (x, _, y) ->
               Var.Set.iter
                 (fun y -> Var.ISet.add possibly_mutable y)
                 (Var.Tbl.get known_origins x);
@@ -268,7 +268,7 @@ let propagate2 ?(skip_param = false) defs known_origins possibly_mutable st x =
   | Expr e -> (
       match e with
       | Constant _ | Closure _ | Apply _ | Prim _ | Block _ | Special _ -> false
-      | Field (y, n) ->
+      | Field (y, n, _) ->
           Var.Tbl.get st y
           || Var.Set.exists
                (fun z ->
@@ -360,7 +360,7 @@ let the_native_string_of info x =
 (*XXX Maybe we could iterate? *)
 let direct_approx info x =
   match info.info_defs.(Var.idx x) with
-  | Expr (Field (y, n)) ->
+  | Expr (Field (y, n, _)) ->
       get_approx
         info
         (fun z ->
diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml
index fdeaa83216..b0601ccbaa 100644
--- a/compiler/lib/freevars.ml
+++ b/compiler/lib/freevars.ml
@@ -34,7 +34,7 @@ let iter_expr_free_vars f e =
       f x;
       List.iter ~f args
   | Block (_, a, _, _) -> Array.iter ~f a
-  | Field (x, _) -> f x
+  | Field (x, _, _) -> f x
   | Closure _ -> ()
   | Special _ -> ()
   | Prim (_, l) ->
@@ -46,7 +46,7 @@ let iter_expr_free_vars f e =
 let iter_instr_free_vars f i =
   match i with
   | Let (_, e) -> iter_expr_free_vars f e
-  | Set_field (x, _, y) ->
+  | Set_field (x, _, _, y) ->
       f x;
       f y
   | Offset_ref (x, _) -> f x
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 5dcf214e43..58893caaef 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1240,7 +1240,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
         | NotArray | Unknown -> Mlvalue.Block.make ~tag ~args:contents
       in
       (x, prop, queue), []
-  | Field (x, n) ->
+  | Field (x, n, _) ->
       let (px, cx), queue = access_queue queue x in
       (Mlvalue.Block.field cx n, or_p px mutable_p, queue), []
   | Closure (args, ((pc, _) as cont)) ->
@@ -1532,7 +1532,7 @@ and translate_instr ctx expr_queue instr =
             expr_queue
             prop
             (instrs @ [ J.variable_declaration [ J.V x, (ce, loc) ], loc ]))
-  | Set_field (x, n, y) ->
+  | Set_field (x, n, _, y) ->
       let loc = source_location_ctx ctx pc in
       let (_px, cx), expr_queue = access_queue expr_queue x in
       let (_py, cy), expr_queue = access_queue expr_queue y in
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
index 26b4f45d32..12c5caaee4 100644
--- a/compiler/lib/global_flow.ml
+++ b/compiler/lib/global_flow.ml
@@ -230,7 +230,7 @@ let expr_deps blocks st x e =
   | Closure (l, cont) ->
       List.iter l ~f:(fun x -> add_param_def st x);
       cont_deps blocks st cont
-  | Field (y, _) -> add_dep st x y
+  | Field (y, _, _) -> add_dep st x y
 
 let program_deps st { blocks; _ } =
   Addr.Map.iter
@@ -241,7 +241,7 @@ let program_deps st { blocks; _ } =
               add_expr_def st x e;
               expr_deps blocks st x e
           | Assign (x, y) -> add_assign_def st x y
-          | Set_field (x, _, y) | Array_set (x, _, y) ->
+          | Set_field (x, _, _, y) | Array_set (x, _, y) ->
               possibly_mutable st x;
               do_escape st Escape y
           | Offset_ref _ -> ());
@@ -274,7 +274,7 @@ let program_deps st { blocks; _ } =
                     List.iter
                       ~f:(fun (i, _) ->
                         match i with
-                        | Let (y, Field (x', _)) when Var.equal b x' ->
+                        | Let (y, Field (x', _, _)) when Var.equal b x' ->
                             Hashtbl.add st.known_cases y tags
                         | _ -> ())
                       block.body)
@@ -401,7 +401,7 @@ let propagate st ~update approx x =
           (* A constant cannot contain a function *)
           Domain.bot
       | Closure _ | Block _ -> Domain.singleton x
-      | Field (y, n) -> (
+      | Field (y, n, _) -> (
           match Var.Tbl.get approx y with
           | Values { known; others } ->
               let tags =
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 906895a534..9f5c4fa43a 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -1313,7 +1313,7 @@ and compile infos pc state instrs =
         let j = getu code (pc + 2) in
         let y, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
-        compile infos (pc + 3) state ((Let (y, Field (x, j)), loc) :: instrs)
+        compile infos (pc + 3) state ((Let (y, Field (x, j, Non_float)), loc) :: instrs)
     | PUSHGETGLOBALFIELD ->
         let state = State.push state loc in
 
@@ -1322,7 +1322,7 @@ and compile infos pc state instrs =
         let j = getu code (pc + 2) in
         let y, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
-        compile infos (pc + 3) state ((Let (y, Field (x, j)), loc) :: instrs)
+        compile infos (pc + 3) state ((Let (y, Field (x, j, Non_float)), loc) :: instrs)
     | SETGLOBAL ->
         let i = getu code (pc + 1) in
         State.size_globals state (i + 1);
@@ -1488,49 +1488,40 @@ and compile infos pc state instrs =
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = %a[0]@." Var.print x Var.print y;
-        compile infos (pc + 1) state ((Let (x, Field (y, 0)), loc) :: instrs)
+        compile infos (pc + 1) state ((Let (x, Field (y, 0, Non_float)), loc) :: instrs)
     | GETFIELD1 ->
         let y, _ = State.accu state in
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = %a[1]@." Var.print x Var.print y;
-        compile infos (pc + 1) state ((Let (x, Field (y, 1)), loc) :: instrs)
+        compile infos (pc + 1) state ((Let (x, Field (y, 1, Non_float)), loc) :: instrs)
     | GETFIELD2 ->
         let y, _ = State.accu state in
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = %a[2]@." Var.print x Var.print y;
-        compile infos (pc + 1) state ((Let (x, Field (y, 2)), loc) :: instrs)
+        compile infos (pc + 1) state ((Let (x, Field (y, 2, Non_float)), loc) :: instrs)
     | GETFIELD3 ->
         let y, _ = State.accu state in
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = %a[3]@." Var.print x Var.print y;
-        compile infos (pc + 1) state ((Let (x, Field (y, 3)), loc) :: instrs)
+        compile infos (pc + 1) state ((Let (x, Field (y, 3, Non_float)), loc) :: instrs)
     | GETFIELD ->
         let y, _ = State.accu state in
         let n = getu code (pc + 1) in
         let x, state = State.fresh_var state loc in
 
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
-        compile infos (pc + 2) state ((Let (x, Field (y, n)), loc) :: instrs)
+        compile infos (pc + 2) state ((Let (x, Field (y, n, Non_float)), loc) :: instrs)
     | GETFLOATFIELD ->
         let y, _ = State.accu state in
         let n = getu code (pc + 1) in
         let x, state = State.fresh_var state loc in
 
-        if debug_parser () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
-        compile
-          infos
-          (pc + 2)
-          state
-          (( Let
-               ( x
-               , Prim
-                   ( Extern "caml_floatarray_unsafe_get"
-                   , [ Pv y; Pc (Int (Int32.of_int n)) ] ) )
-           , loc )
-          :: instrs)
+        if debug_parser ()
+        then Format.printf "%a = FLOAT{%a[%d]}@." Var.print x Var.print y n;
+        compile infos (pc + 2) state ((Let (x, Field (y, n, Float)), loc) :: instrs)
     | SETFIELD0 ->
         let y, _ = State.accu state in
         let z, _ = State.peek 0 state in
@@ -1542,7 +1533,7 @@ and compile infos pc state instrs =
           infos
           (pc + 1)
           (State.pop 1 state)
-          ((Let (x, const 0l), loc) :: (Set_field (y, 0, z), loc) :: instrs)
+          ((Let (x, const 0l), loc) :: (Set_field (y, 0, Non_float, z), loc) :: instrs)
     | SETFIELD1 ->
         let y, _ = State.accu state in
         let z, _ = State.peek 0 state in
@@ -1554,7 +1545,7 @@ and compile infos pc state instrs =
           infos
           (pc + 1)
           (State.pop 1 state)
-          ((Let (x, const 0l), loc) :: (Set_field (y, 1, z), loc) :: instrs)
+          ((Let (x, const 0l), loc) :: (Set_field (y, 1, Non_float, z), loc) :: instrs)
     | SETFIELD2 ->
         let y, _ = State.accu state in
         let z, _ = State.peek 0 state in
@@ -1566,7 +1557,7 @@ and compile infos pc state instrs =
           infos
           (pc + 1)
           (State.pop 1 state)
-          ((Let (x, const 0l), loc) :: (Set_field (y, 2, z), loc) :: instrs)
+          ((Let (x, const 0l), loc) :: (Set_field (y, 2, Non_float, z), loc) :: instrs)
     | SETFIELD3 ->
         let y, _ = State.accu state in
         let z, _ = State.peek 0 state in
@@ -1578,7 +1569,7 @@ and compile infos pc state instrs =
           infos
           (pc + 1)
           (State.pop 1 state)
-          ((Let (x, const 0l), loc) :: (Set_field (y, 3, z), loc) :: instrs)
+          ((Let (x, const 0l), loc) :: (Set_field (y, 3, Non_float, z), loc) :: instrs)
     | SETFIELD ->
         let y, _ = State.accu state in
         let z, _ = State.peek 0 state in
@@ -1591,26 +1582,21 @@ and compile infos pc state instrs =
           infos
           (pc + 2)
           (State.pop 1 state)
-          ((Let (x, const 0l), loc) :: (Set_field (y, n, z), loc) :: instrs)
+          ((Let (x, const 0l), loc) :: (Set_field (y, n, Non_float, z), loc) :: instrs)
     | SETFLOATFIELD ->
         let y, _ = State.accu state in
         let z, _ = State.peek 0 state in
         let n = getu code (pc + 1) in
 
-        if debug_parser () then Format.printf "%a[%d] = %a@." Var.print y n Var.print z;
+        if debug_parser ()
+        then Format.printf "FLOAT{%a[%d]} = %a@." Var.print y n Var.print z;
         let x, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = 0@." Var.print x;
         compile
           infos
           (pc + 2)
           (State.pop 1 state)
-          (( Let
-               ( x
-               , Prim
-                   ( Extern "caml_floatarray_unsafe_set"
-                   , [ Pv y; Pc (Int (Int32.of_int n)); Pv z ] ) )
-           , loc )
-          :: instrs)
+          ((Let (x, const 0l), loc) :: (Set_field (y, n, Float, z), loc) :: instrs)
     | VECTLENGTH ->
         let y, _ = State.accu state in
         let x, state = State.fresh_var state loc in
@@ -2418,7 +2404,7 @@ and compile infos pc state instrs =
           (pc + 1)
           state
           ((Let (m, Prim (Array_get, [ Pv meths; Pv lab ])), loc)
-          :: (Let (meths, Field (obj, 0)), loc)
+          :: (Let (meths, Field (obj, 0, Non_float)), loc)
           :: instrs)
     | STOP -> instrs, (Stop, loc), state
     | RESUME ->
@@ -2847,7 +2833,7 @@ let from_bytes ~prims ~debug (code : bytecode) =
                | None -> ()
                | Some name -> Code.Var.name x name);
             need_gdata := true;
-            (Let (x, Field (gdata, i)), noloc) :: l
+            (Let (x, Field (gdata, i, Non_float)), noloc) :: l
         | _ -> l)
   in
   let body =
diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml
index 159c8570a5..88e541e69d 100644
--- a/compiler/lib/phisimpl.ml
+++ b/compiler/lib/phisimpl.ml
@@ -53,7 +53,7 @@ let expr_deps blocks vars deps defs x e =
   | Constant _ | Apply _ | Prim _ | Special _ -> ()
   | Closure (_, cont) -> cont_deps blocks vars deps defs cont
   | Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
-  | Field (y, _) -> add_dep deps x y
+  | Field (y, _, _) -> add_dep deps x y
 
 let program_deps { blocks; _ } =
   let nv = Var.count () in
diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml
index 4e735576c3..bd1e41f411 100644
--- a/compiler/lib/subst.ml
+++ b/compiler/lib/subst.ml
@@ -29,7 +29,7 @@ let expr s e =
   | Apply { f; args; exact } ->
       Apply { f = s f; args = List.map args ~f:(fun x -> s x); exact }
   | Block (n, a, k, mut) -> Block (n, Array.map a ~f:(fun x -> s x), k, mut)
-  | Field (x, n) -> Field (s x, n)
+  | Field (x, n, typ) -> Field (s x, n, typ)
   | Closure (l, pc) -> Closure (l, subst_cont s pc)
   | Special _ -> e
   | Prim (p, l) ->
@@ -44,7 +44,7 @@ let instr s i =
   match i with
   | Let (x, e) -> Let (x, expr s e)
   | Assign (x, y) -> Assign (x, s y) (* x is handled like a parameter *)
-  | Set_field (x, n, y) -> Set_field (s x, n, s y)
+  | Set_field (x, n, typ, y) -> Set_field (s x, n, typ, s y)
   | Offset_ref (x, n) -> Offset_ref (s x, n)
   | Array_set (x, y, z) -> Array_set (s x, s y, s z)
 

From 1a24255e67b9a847f0128735fcd75c2c528d8207 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 3 Sep 2024 15:33:49 +0200
Subject: [PATCH 349/481] WSOO side of "Distinguish float field accesses in the
 Code IR"

See ocsigen/js_of_ocaml#1649
---
 compiler/lib/wasm/wa_generate.ml  | 17 +++++++++++++++--
 compiler/lib/wasm/wa_globalize.ml |  4 ++--
 compiler/lib/wasm/wa_liveness.ml  |  4 ++--
 compiler/lib/wasm/wa_spilling.ml  |  4 ++--
 4 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 62c8d80ee0..9eedaa7e95 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -157,7 +157,11 @@ module Generate (Target : Wa_target_sig.S) = struct
         return (W.Call (apply, args @ [ closure ]))
     | Block (tag, a, _, _) ->
         Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
-    | Field (x, n) -> Memory.field (load x) n
+    | Field (x, n, Non_float) -> Memory.field (load x) n
+    | Field (x, n, Float) ->
+        Memory.float_array_get
+          (load x)
+          (Constant.translate (Int (Int31.of_int_warning_on_overflow n)))
     | Closure _ ->
         Closure.translate
           ~context:ctx.global_context
@@ -668,7 +672,16 @@ module Generate (Target : Wa_target_sig.S) = struct
           if ctx.live.(Var.idx x) = 0
           then drop (translate_expr ctx stack_ctx context x e)
           else store x (translate_expr ctx stack_ctx context x e)
-      | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
+      | Set_field (x, n, Non_float, y) ->
+          Memory.set_field
+            (load x)
+            n
+            (load y)
+      | Set_field (x, n, Float, y) ->
+          Memory.float_array_set
+            (load x)
+            (Constant.translate (Int (Int31.of_int_warning_on_overflow n)))
+            (load y)
       | Offset_ref (x, n) ->
           Memory.set_field
             (load x)
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib/wasm/wa_globalize.ml
index deaed96b3e..5c2cc2d473 100644
--- a/compiler/lib/wasm/wa_globalize.ml
+++ b/compiler/lib/wasm/wa_globalize.ml
@@ -74,7 +74,7 @@ let traverse_expression x e st =
   | Code.Apply { f; args; _ } ->
       st |> use f |> fun st -> List.fold_left ~f:(fun st x -> use x st) ~init:st args
   | Block (_, a, _, _) -> Array.fold_right ~f:use a ~init:st
-  | Field (x, _) -> st |> use x
+  | Field (x, _, _) -> st |> use x
   | Closure _ ->
       List.fold_left
         ~f:(fun st x -> use x st)
@@ -95,7 +95,7 @@ let traverse_instruction st i =
   match fst i with
   | Code.Let (x, e) -> st |> declare x |> traverse_expression x e
   | Assign (_, x) | Offset_ref (x, _) -> st |> use x
-  | Set_field (x, _, y) -> st |> use x |> use y
+  | Set_field (x, _, _, y) -> st |> use x |> use y
   | Array_set (x, y, z) -> st |> use x |> use y |> use z
 
 let traverse_block p st pc =
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
index 4a2dd90848..59c528411e 100644
--- a/compiler/lib/wasm/wa_liveness.ml
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -109,12 +109,12 @@ let expr_used ~context ~closures ~ctx x e s =
   | Prim (_, l) -> add_prim_args ~ctx s l
   | Closure _ -> add_list ~ctx s (function_free_variables ~context ~closures x)
   | Constant _ | Special _ -> s
-  | Field (x, _) -> add_var ~ctx s x
+  | Field (x, _, _) -> add_var ~ctx s x
 
 let propagate_through_instr ~context ~closures ~ctx (i, _) s =
   match i with
   | Let (x, e) -> expr_used ~context ~closures ~ctx x e (Var.Set.remove x s)
-  | Set_field (x, _, y) -> add_var ~ctx (add_var ~ctx s x) y
+  | Set_field (x, _, _, y) -> add_var ~ctx (add_var ~ctx s x) y
   | Assign (_, x) | Offset_ref (x, _) -> add_var ~ctx s x
   | Array_set (x, y, z) -> add_var ~ctx (add_var ~ctx (add_var ~ctx s x) y) z
 
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
index 2d1051c7bd..f1eaa1b805 100644
--- a/compiler/lib/wasm/wa_spilling.ml
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -309,10 +309,10 @@ let spilled_variables
                         fv
                         ~init:Var.Set.empty
                   | Constant _ | Special _ -> Var.Set.empty
-                  | Field (x, _) -> check_spilled ~ctx loaded x Var.Set.empty)
+                  | Field (x, _, _) -> check_spilled ~ctx loaded x Var.Set.empty)
               | Assign (_, x) | Offset_ref (x, _) ->
                   check_spilled ~ctx loaded x Var.Set.empty
-              | Set_field (x, _, y) ->
+              | Set_field (x, _, _, y) ->
                   Var.Set.empty
                   |> check_spilled ~ctx loaded x
                   |> check_spilled ~ctx loaded y

From 989a1d6c57e546617b84946d53820eb26cccf77b Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Thu, 19 Sep 2024 15:11:30 +0200
Subject: [PATCH 350/481] Fix build

---
 compiler/lib/eval.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index d8a4e48e24..21b1041dcb 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -351,7 +351,7 @@ let eval_instr ~target info ((x, loc) as i) =
                 , Prim
                     ( prim
                     , List.map2 prim_args prim_args' ~f:(fun arg c ->
-                          match c, target with
+                          match (c : constant), target with
                           | Some ((Int _ | NativeString _) as c), _ -> Pc c
                           | Some (Float _ as c), `JavaScript -> Pc c
                           | Some (String _ as c), `JavaScript

From d7de3b6702a6d5029d23407b26679ea2114f97e7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 20 Sep 2024 10:40:52 +0200
Subject: [PATCH 351/481] Fixes

---
 compiler/lib/eval.ml             | 15 +++++++--------
 compiler/lib/generate_closure.ml | 15 +++++----------
 compiler/lib/inline.ml           |  2 +-
 3 files changed, 13 insertions(+), 19 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 21b1041dcb..77eb5e3329 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -38,8 +38,7 @@ let int_binop l w f =
 
 let shift l w t f =
   match l with
-  | [ Int i; Int j ] ->
-      Some (Int (w (f (t i) (Int32.to_int j land 0x1f))))
+  | [ Int i; Int j ] -> Some (Int (w (f (t i) (Int32.to_int j land 0x1f))))
   | _ -> None
 
 let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option =
@@ -159,8 +158,8 @@ let eval_prim ~target x =
           Some
             (Int
                (match target with
-                | `JavaScript -> 32l
-                | `Wasm -> 31l ))
+               | `JavaScript -> 32l
+               | `Wasm -> 31l))
       | "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
       | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
       | _ -> None)
@@ -351,7 +350,7 @@ let eval_instr ~target info ((x, loc) as i) =
                 , Prim
                     ( prim
                     , List.map2 prim_args prim_args' ~f:(fun arg c ->
-                          match (c : constant), target with
+                          match (c : constant option), target with
                           | Some ((Int _ | NativeString _) as c), _ -> Pc c
                           | Some (Float _ as c), `JavaScript -> Pc c
                           | Some (String _ as c), `JavaScript
@@ -373,9 +372,9 @@ let the_cond_of info x =
   get_approx
     info
     (fun x ->
-      match Flow.Info.def info x with
-      | Some (Constant (Int 0l)) -> Zero
-      | Some
+      match info.info_defs.(Var.idx x) with
+      | Expr (Constant (Int 0l)) -> Zero
+      | Expr
           (Constant
             ( Int _
             | Int32 _
diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml
index 3094ac98c3..87f5d0cfe5 100644
--- a/compiler/lib/generate_closure.ml
+++ b/compiler/lib/generate_closure.ml
@@ -105,9 +105,7 @@ module Trampoline = struct
         let counter_plus_1 = Code.Var.fork counter in
         { params = []
         ; body =
-            [ ( Let
-                  ( counter_plus_1
-                  , Prim (Extern "%int_add", [ Pv counter; Pc (Int 1l) ]) )
+            [ ( Let (counter_plus_1, Prim (Extern "%int_add", [ Pv counter; Pc (Int 1l) ]))
               , noloc )
             ; Let (return, Apply { f; args = counter_plus_1 :: args; exact = true }), loc
             ]
@@ -121,9 +119,8 @@ module Trampoline = struct
     ; body =
         [ ( Let
               ( new_args
-              , Prim
-                  ( Extern "%js_array"
-                  , Pc (Int 0l) :: List.map args ~f:(fun x -> Pv x) ) )
+              , Prim (Extern "%js_array", Pc (Int 0l) :: List.map args ~f:(fun x -> Pv x))
+              )
           , noloc )
         ; Let (return, Prim (Extern "caml_trampoline_return", [ Pv f; Pv new_args ])), loc
         ]
@@ -246,9 +243,7 @@ module Trampoline = struct
                                     , Prim
                                         ( Lt
                                         , [ Pv counter
-                                          ; Pc
-                                              (Int
-                                                 (Int32.of_int tailcall_max_depth))
+                                          ; Pc (Int (Int32.of_int tailcall_max_depth))
                                           ] ) )
                                 , noloc )
                               in
@@ -388,7 +383,7 @@ let rewrite_mutable
           ]
           @ List.mapi closures_extern ~f:(fun i x ->
                 match x with
-                | Let (x, Closure _), loc -> Let (x, Field (closure', i)), loc
+                | Let (x, Closure _), loc -> Let (x, Field (closure', i, Non_float)), loc
                 | _ -> assert false)
         in
         free_pc, blocks, body
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 40cebb0adc..16b9ae5353 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -170,7 +170,7 @@ let simple blocks cont mapping =
           | Special _ -> `Exp exp
           | Block (tag, args, aon, mut) ->
               `Exp (Block (tag, Array.map args ~f:(map_var mapping), aon, mut))
-          | Field (x, i) -> `Exp (Field (map_var mapping x, i))
+          | Field (x, i, kind) -> `Exp (Field (map_var mapping x, i, kind))
           | Closure _ -> `Fail
           | Constant _ -> `Fail
           | Apply _ -> `Fail)

From d4853b392201ff36ac504a7fce06a6053a5e4fd7 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 24 Jul 2024 13:18:22 +0200
Subject: [PATCH 352/481] Compiler: fix link of packed modules

---
 compiler/lib/ocaml_compiler.ml  | 15 +++++++++++++++
 compiler/lib/ocaml_compiler.mli |  2 ++
 compiler/lib/unit_info.ml       |  3 ++-
 3 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
index d42742b842..1e8f66566e 100644
--- a/compiler/lib/ocaml_compiler.ml
+++ b/compiler/lib/ocaml_compiler.ml
@@ -228,6 +228,21 @@ module Cmo_format = struct
   let requires (t : t) = List.map t.cu_required_compunits ~f:(fun (Compunit u) -> u)
   [@@if ocaml_version >= (5, 2, 0)]
 
+  let provides (t : t) =
+    List.filter_map t.cu_reloc ~f:(fun ((reloc : Cmo_format.reloc_info), _) ->
+        match reloc with
+        | Reloc_setglobal i -> Some (Ident.name i)
+        | Reloc_getglobal _ | Reloc_literal _ | Reloc_primitive _ -> None)
+  [@@if ocaml_version < (5, 2, 0)]
+
+  let provides (t : t) =
+    List.filter_map t.cu_reloc ~f:(fun ((reloc : Cmo_format.reloc_info), _) ->
+        match reloc with
+        | Reloc_setcompunit (Compunit u) -> Some u
+        | Reloc_getcompunit _ | Reloc_getpredef _ | Reloc_literal _ | Reloc_primitive _ ->
+            None)
+  [@@if ocaml_version >= (5, 2, 0)]
+
   let primitives (t : t) = t.cu_primitives
 
   let imports (t : t) = t.cu_imports
diff --git a/compiler/lib/ocaml_compiler.mli b/compiler/lib/ocaml_compiler.mli
index 5fec5260ed..4a9a6fb87a 100644
--- a/compiler/lib/ocaml_compiler.mli
+++ b/compiler/lib/ocaml_compiler.mli
@@ -66,6 +66,8 @@ module Cmo_format : sig
 
   val requires : t -> string list
 
+  val provides : t -> string list
+
   val primitives : t -> string list
 
   val force_link : t -> bool
diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml
index bcc168a56c..9449b7f656 100644
--- a/compiler/lib/unit_info.ml
+++ b/compiler/lib/unit_info.ml
@@ -48,7 +48,8 @@ let of_primitives l =
 
 let of_cmo (cmo : Cmo_format.compilation_unit) =
   let open Ocaml_compiler in
-  let provides = StringSet.singleton (Cmo_format.name cmo) in
+  (* A packed librariy register global for packed modules. *)
+  let provides = StringSet.of_list (Cmo_format.name cmo :: Cmo_format.provides cmo) in
   let requires = StringSet.of_list (Cmo_format.requires cmo) in
   let requires = StringSet.diff requires provides in
   let effects_without_cps =

From 4174f52193a757a7f9e9c365a42468933ec55326 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 20 Sep 2024 14:53:04 +0200
Subject: [PATCH 353/481] JavaScript linker: make it easier to add flags

---
 compiler/lib/linker.ml | 66 ++++++++++++++++++------------------------
 1 file changed, 28 insertions(+), 38 deletions(-)

diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index d0a610d904..5e72a0c6c7 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -177,12 +177,17 @@ module Fragment = struct
     ; weakdef : bool
     ; always : bool
     ; code : Javascript.program pack
-    ; js_string : bool option
-    ; effects : bool option
+    ; conditions : bool StringMap.t
     ; fragment_target : Target_env.t option
     ; aliases : StringSet.t
     }
 
+  let allowed_flags =
+    List.fold_left
+      ~f:(fun m (k, v) -> StringMap.add k v m)
+      ~init:StringMap.empty
+      [ "js-string", Config.Flag.use_js_string; "effects", Config.Flag.effects ]
+
   type t =
     | Always_include of Javascript.program pack
     | Fragment of fragment_
@@ -247,8 +252,7 @@ module Fragment = struct
                 ; always = false
                 ; has_macro = false
                 ; code = Ok code
-                ; js_string = None
-                ; effects = None
+                ; conditions = StringMap.empty
                 ; fragment_target = None
                 ; aliases = StringSet.empty
                 }
@@ -281,31 +285,24 @@ module Fragment = struct
                     | `Always -> { fragment with always = true }
                     | `Alias name ->
                         { fragment with aliases = StringSet.add name fragment.aliases }
-                    | (`Ifnot "js-string" | `If "js-string") as i ->
-                        let b =
-                          match i with
-                          | `If _ -> true
-                          | `Ifnot _ -> false
-                        in
-                        if Option.is_some fragment.js_string
-                        then Format.eprintf "Duplicated js-string in %s\n" (loc pi);
-                        { fragment with js_string = Some b }
-                    | (`Ifnot "effects" | `If "effects") as i ->
+                    | `If name when Option.is_some (Target_env.of_string name) ->
+                        if Option.is_some fragment.fragment_target
+                        then Format.eprintf "Duplicated target_env in %s\n" (loc pi);
+                        { fragment with fragment_target = Target_env.of_string name }
+                    | (`Ifnot v | `If v) when not (StringMap.mem v allowed_flags) ->
+                        Format.eprintf "Unkown flag %S in %s\n" v (loc pi);
+                        fragment
+                    | (`Ifnot v | `If v) as i ->
+                        if StringMap.mem v fragment.conditions
+                        then Format.eprintf "Duplicated %s in %s\n" v (loc pi);
                         let b =
                           match i with
                           | `If _ -> true
                           | `Ifnot _ -> false
                         in
-                        if Option.is_some fragment.effects
-                        then Format.eprintf "Duplicated effects in %s\n" (loc pi);
-                        { fragment with effects = Some b }
-                    | `If name when Option.is_some (Target_env.of_string name) ->
-                        if Option.is_some fragment.fragment_target
-                        then Format.eprintf "Duplicated target_env in %s\n" (loc pi);
-                        { fragment with fragment_target = Target_env.of_string name }
-                    | `If name | `Ifnot name ->
-                        Format.eprintf "Unkown flag %S in %s\n" name (loc pi);
-                        fragment)
+                        { fragment with
+                          conditions = StringMap.add v b fragment.conditions
+                        })
               in
               Fragment fragment)
     in
@@ -451,25 +448,18 @@ let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.
       ; weakdef
       ; always
       ; code
-      ; js_string
-      ; effects
       ; fragment_target
       ; aliases
       ; has_macro
+      ; conditions
       } -> (
-      let ignore_because_of_js_string =
-        match js_string, Config.Flag.use_js_string () with
-        | Some true, false | Some false, true -> true
-        | None, _ | Some true, true | Some false, false -> false
-      in
-      let ignore_because_of_effects =
-        match effects, Config.Flag.effects () with
-        | Some true, false | Some false, true -> true
-        | None, _ | Some true, true | Some false, false -> false
+      let should_ignore =
+        StringMap.exists
+          (fun flag b ->
+            not (Bool.equal b (StringMap.find flag Fragment.allowed_flags ())))
+          conditions
       in
-      if (not version_constraint_ok)
-         || ignore_because_of_js_string
-         || ignore_because_of_effects
+      if (not version_constraint_ok) || should_ignore
       then `Ignored
       else
         match provides with

From a40f9a01520a06e0475924d863a1a1ecd5803c78 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 27 Aug 2024 11:09:11 +0200
Subject: [PATCH 354/481] Compiler: Document non-trivial function
 Code.constant_equal, and fix related bugs (#1659)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* Document non-trivial function Code.constant_equal

Co-authored-by: Jérome Vouillon <jerome.vouillon@gmail.com>

* Fix bugs related to constant equality

See #1659.

* More static evaluation of equalities in eval

* Statically evaluate caml_js_strict_equals too

* Compiler: small refactoring in eval

---------

Co-authored-by: Jérome Vouillon <jerome.vouillon@gmail.com>
Co-authored-by: Hugo Heuzard <hugo.heuzard@gmail.com>
---
 compiler/lib/code.ml                          | 142 +++++++++---------
 compiler/lib/code.mli                         |  10 +-
 compiler/lib/driver.ml                        |  30 ++--
 compiler/lib/eval.ml                          |  55 +++++--
 compiler/lib/flow.ml                          |  24 ++-
 compiler/lib/generate.ml                      |   4 +-
 .../lib/{constant.ml => global_constant.ml}   |   0
 compiler/lib/javascript.ml                    |   4 +-
 compiler/lib/linker.ml                        |   6 +-
 compiler/lib/stdlib.ml                        |   6 +-
 compiler/tests-compiler/dune.inc              |  15 ++
 compiler/tests-compiler/gh1659.ml             |  62 ++++++++
 12 files changed, 256 insertions(+), 102 deletions(-)
 rename compiler/lib/{constant.ml => global_constant.ml} (100%)
 create mode 100644 compiler/tests-compiler/gh1659.ml

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 591cac4c1d..d9fffb4eec 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -290,75 +290,79 @@ type constant =
   | NativeInt of nativeint
   | Tuple of int * constant array * array_or_not
 
-let rec constant_equal a b =
-  match a, b with
-  | String a, String b -> Some (String.equal a b)
-  | NativeString a, NativeString b -> Some (Native_string.equal a b)
-  | Tuple (ta, a, _), Tuple (tb, b, _) ->
-      if ta <> tb || Array.length a <> Array.length b
-      then Some false
-      else
-        let same = ref (Some true) in
-        for i = 0 to Array.length a - 1 do
-          match !same, constant_equal a.(i) b.(i) with
-          | None, _ -> ()
-          | _, None -> same := None
-          | Some s, Some c -> same := Some (s && c)
-        done;
-        !same
-  | Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
-  | Int64 a, Int64 b -> Some (Int64.equal a b)
-  | NativeInt a, NativeInt b -> Some (Nativeint.equal a b)
-  | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
-  | Float a, Float b -> Some (Float.equal a b)
-  | String _, NativeString _ | NativeString _, String _ -> None
-  | Int _, Float _ | Float _, Int _ -> None
-  | Tuple ((0 | 254), _, _), Float_array _ -> None
-  | Float_array _, Tuple ((0 | 254), _, _) -> None
-  | ( Tuple _
-    , ( String _
-      | NativeString _
-      | Int64 _
-      | Int _
-      | Int32 _
-      | NativeInt _
-      | Float _
-      | Float_array _ ) ) -> Some false
-  | ( Float_array _
-    , ( String _
-      | NativeString _
-      | Int64 _
-      | Int _
-      | Int32 _
-      | NativeInt _
-      | Float _
-      | Tuple _ ) ) -> Some false
-  | ( String _
-    , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
-      Some false
-  | ( NativeString _
-    , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
-      Some false
-  | ( Int64 _
-    , ( String _
-      | NativeString _
-      | Int _
-      | Int32 _
-      | NativeInt _
-      | Float _
-      | Tuple _
-      | Float_array _ ) ) -> Some false
-  | Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
-      Some false
-  | ( (Int _ | Int32 _ | NativeInt _)
-    , (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ) ->
-      Some false
-  (* Note: the following cases should not occur when compiling to Javascript *)
-  | Int _, (Int32 _ | NativeInt _)
-  | Int32 _, (Int _ | NativeInt _)
-  | NativeInt _, (Int _ | Int32 _)
-  | (Int32 _ | NativeInt _), Float _
-  | Float _, (Int32 _ | NativeInt _) -> None
+module Constant = struct
+  type t = constant
+
+  let rec ocaml_equal a b =
+    match a, b with
+    | String a, String b -> Some (String.equal a b)
+    | NativeString a, NativeString b -> Some (Native_string.equal a b)
+    | Tuple (ta, a, _), Tuple (tb, b, _) ->
+        if ta <> tb || Array.length a <> Array.length b
+        then Some false
+        else
+          let same = ref (Some true) in
+          for i = 0 to Array.length a - 1 do
+            match !same, ocaml_equal a.(i) b.(i) with
+            | None, _ -> ()
+            | _, None -> same := None
+            | Some s, Some c -> same := Some (s && c)
+          done;
+          !same
+    | Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
+    | Int64 a, Int64 b -> Some (Int64.equal a b)
+    | NativeInt a, NativeInt b -> Some (Nativeint.equal a b)
+    | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b)
+    | Float a, Float b -> Some (Float.ieee_equal a b)
+    | String _, NativeString _ | NativeString _, String _ -> None
+    | Int _, Float _ | Float _, Int _ -> None
+    | Tuple ((0 | 254), _, _), Float_array _ -> None
+    | Float_array _, Tuple ((0 | 254), _, _) -> None
+    | ( Tuple _
+      , ( String _
+        | NativeString _
+        | Int64 _
+        | Int _
+        | Int32 _
+        | NativeInt _
+        | Float _
+        | Float_array _ ) ) -> Some false
+    | ( Float_array _
+      , ( String _
+        | NativeString _
+        | Int64 _
+        | Int _
+        | Int32 _
+        | NativeInt _
+        | Float _
+        | Tuple _ ) ) -> Some false
+    | ( String _
+      , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
+        Some false
+    | ( NativeString _
+      , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
+        Some false
+    | ( Int64 _
+      , ( String _
+        | NativeString _
+        | Int _
+        | Int32 _
+        | NativeInt _
+        | Float _
+        | Tuple _
+        | Float_array _ ) ) -> Some false
+    | Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
+        Some false
+    | ( (Int _ | Int32 _ | NativeInt _)
+      , (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ) ->
+        Some false
+    (* Note: the following cases should not occur when compiling to Javascript *)
+    | Int _, (Int32 _ | NativeInt _)
+    | Int32 _, (Int _ | NativeInt _)
+    | NativeInt _, (Int _ | Int32 _)
+    | (Int32 _ | NativeInt _), Float _
+    | Float _, (Int32 _ | NativeInt _) -> None
+end
 
 type loc =
   | No
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 6e8f0d0bd8..1c107d75eb 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -150,6 +150,8 @@ module Native_string : sig
   val of_string : string -> t
 
   val of_bytestring : string -> t
+
+  val equal : t -> t -> bool
 end
 
 type int_kind =
@@ -168,7 +170,13 @@ type constant =
   | NativeInt of nativeint  (** Only produced when compiling to WebAssembly. *)
   | Tuple of int * constant array * array_or_not
 
-val constant_equal : constant -> constant -> bool option
+module Constant : sig
+  type t = constant
+
+  val ocaml_equal : t -> t -> bool option
+  (** Guaranteed equality in terms of OCaml [(=)]: if [constant_equal a b =
+    Some v], then [Poly.(=) a b = v]. This is used for optimization purposes. *)
+end
 
 type loc =
   | No
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 8882829f10..bb4ce4aaf2 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -241,9 +241,9 @@ let gen_missing js missing =
         , ( ECond
               ( EBin
                   ( NotEqEq
-                  , dot (EVar (ident Constant.global_object_)) prim
+                  , dot (EVar (ident Global_constant.global_object_)) prim
                   , EVar (ident_s "undefined") )
-              , dot (EVar (ident Constant.global_object_)) prim
+              , dot (EVar (ident Global_constant.global_object_)) prim
               , EFun
                   ( None
                   , fun_
@@ -364,7 +364,7 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) :
                (EBin
                   ( Eq
                   , dot
-                      (EVar (ident Constant.global_object_))
+                      (EVar (ident Global_constant.global_object_))
                       (Utf8_string.of_string_exn "jsoo_runtime")
                   , EObj all ))
            , N )
@@ -375,7 +375,7 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) :
                      (EVar (ident (Utf8_string.of_string_exn "Object")))
                      (Utf8_string.of_string_exn "assign"))
                   [ dot
-                      (EVar (ident Constant.global_object_))
+                      (EVar (ident Global_constant.global_object_))
                       (Utf8_string.of_string_exn "jsoo_runtime")
                   ; EObj all
                   ]
@@ -404,7 +404,7 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) :
                          ; rest = None
                          }
                      , ( dot
-                           (EVar (ident Constant.global_object_))
+                           (EVar (ident Global_constant.global_object_))
                            (Utf8_string.of_string_exn "jsoo_runtime")
                        , N ) )
                  ] )
@@ -510,27 +510,30 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_
       o#get_free
     in
     let export_shim js =
-      if J.IdentSet.mem (J.ident Constant.exports_) freenames
+      if J.IdentSet.mem (J.ident Global_constant.exports_) freenames
       then
         if should_export wrap_with_fun
-        then var Constant.exports_ (J.EObj []) :: js
+        then var Global_constant.exports_ (J.EObj []) :: js
         else
           let export_node =
             let s =
               Printf.sprintf
                 {|((typeof module === 'object' && module.exports) || %s)|}
-                Constant.global_object
+                Global_constant.global_object
             in
             let lex = Parse_js.Lexer.of_string s in
             Parse_js.parse_expr lex
           in
-          var Constant.exports_ export_node :: js
+          var Global_constant.exports_ export_node :: js
       else js
     in
     let old_global_object_shim js =
-      if J.IdentSet.mem (J.ident Constant.old_global_object_) freenames
+      if J.IdentSet.mem (J.ident Global_constant.old_global_object_) freenames
       then
-        var Constant.old_global_object_ (J.EVar (J.ident Constant.global_object_)) :: js
+        var
+          Global_constant.old_global_object_
+          (J.EVar (J.ident Global_constant.global_object_))
+        :: js
       else js
     in
 
@@ -544,14 +547,15 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_
         then expr (J.EStr (Utf8_string.of_string_exn "use strict")) :: js
         else js
       in
-      f [ J.ident Constant.global_object_ ] js
+      f [ J.ident Global_constant.global_object_ ] js
     in
     match wrap_with_fun with
     | `Anonymous -> expr (mk efun)
     | `Named name ->
         let name = Utf8_string.of_string_exn name in
         mk (sfun (J.ident name))
-    | `Iife -> expr (J.call (mk efun) [ J.EVar (J.ident Constant.global_object_) ] J.N)
+    | `Iife ->
+        expr (J.call (mk efun) [ J.EVar (J.ident Global_constant.global_object_) ] J.N)
   in
   let always_required_js =
     (* consider adding a comments in the generated file with original
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 77eb5e3329..75d655bbbf 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -65,14 +65,15 @@ let float_unop (l : constant list) (f : float -> float) : constant option =
   | [ Int i ] -> Some (Float (f (Int32.to_float i)))
   | _ -> None
 
+let bool' b = Int (if b then 1l else 0l)
+
+let bool b = Some (bool' b)
+
 let float_binop_bool l f =
   match float_binop_aux l f with
-  | Some true -> Some (Int 1l)
-  | Some false -> Some (Int 0l)
+  | Some b -> bool b
   | None -> None
 
-let bool b = Some (Int (if b then 1l else 0l))
-
 let eval_prim ~target x =
   match x with
   | Not, [ Int i ] -> bool Int32.(i = 0l)
@@ -254,16 +255,51 @@ let the_cont_of info x (a : cont array) =
       | _ -> None)
     x
 
+(* If [constant_js_equal a b = Some v], then [caml_js_equals a b = v]). *)
+let constant_js_equal a b =
+  match a, b with
+  | Int i, Int j -> Some (Int32.equal i j)
+  | Float a, Float b -> Some (Float.ieee_equal a b)
+  | NativeString a, NativeString b -> Some (Native_string.equal a b)
+  | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
+  | Int _, Float _ | Float _, Int _ -> None
+  (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
+  | String _, _
+  | _, String _
+  | NativeString _, _
+  | _, NativeString _
+  | Float_array _, _
+  | _, Float_array _
+  | Int64 _, _
+  | _, Int64 _
+  | Tuple _, _
+  | _, Tuple _ -> None
+
 let eval_instr ~target info ((x, loc) as i) =
   match x with
-  | Let (x, Prim (Extern ("caml_js_equals" | "caml_equal"), [ y; z ])) -> (
+  | Let (x, Prim (Extern (("caml_equal" | "caml_notequal") as prim), [ y; z ])) -> (
+      match the_const_of info y, the_const_of info z with
+      | Some e1, Some e2 -> (
+          match Code.Constant.ocaml_equal e1 e2 with
+          | None -> [ i ]
+          | Some c ->
+              let c =
+                match prim with
+                | "caml_equal" -> c
+                | "caml_notequal" -> not c
+                | _ -> assert false
+              in
+              let c = Constant (bool' c) in
+              Flow.update_def info x c;
+              [ Let (x, c), loc ])
+      | _ -> [ i ])
+  | Let (x, Prim (Extern ("caml_js_equals" | "caml_js_strict_equals"), [ y; z ])) -> (
       match the_const_of info y, the_const_of info z with
       | Some e1, Some e2 -> (
-          match constant_equal e1 e2 with
+          match constant_js_equal e1 e2 with
           | None -> [ i ]
           | Some c ->
-              let c = if c then 1l else 0l in
-              let c = Constant (Int c) in
+              let c = Constant (bool' c) in
               Flow.update_def info x c;
               [ Let (x, c), loc ])
       | _ -> [ i ])
@@ -299,8 +335,7 @@ let eval_instr ~target info ((x, loc) as i) =
       match is_int ~target info y with
       | Unknown -> [ i ]
       | (Y | N) as b ->
-          let b = if Poly.(b = N) then 0l else 1l in
-          let c = Constant (Int b) in
+          let c = Constant (bool' Poly.(b = Y)) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
   | Let (x, Prim (Extern "%direct_obj_tag", [ y ])) -> (
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index f5e8193ea9..1212e56f0f 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -322,6 +322,28 @@ let the_def_of info x =
         x
   | Pc c -> Some (Constant c)
 
+(* If [constant_identical a b = true], then the two values cannot be
+   distinguished, i.e., they are not different objects (and [caml_js_equals a b
+   = true]) and if both are floats, they are bitwise equal. *)
+let constant_identical a b =
+  match a, b with
+  | Int i, Int j -> Int32.equal i j
+  | Float a, Float b -> Float.bitwise_equal a b
+  | NativeString a, NativeString b -> Native_string.equal a b
+  | String a, String b -> Config.Flag.use_js_string () && String.equal a b
+  | Int _, Float _ | Float _, Int _ -> false
+  (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
+  | String _, _
+  | _, String _
+  | NativeString _, _
+  | _, NativeString _
+  | Float_array _, _
+  | _, Float_array _
+  | Int64 _, _
+  | _, Int64 _
+  | Tuple _, _
+  | _, Tuple _ -> false
+
 let the_const_of info x =
   match x with
   | Pv x ->
@@ -337,7 +359,7 @@ let the_const_of info x =
         None
         (fun u v ->
           match u, v with
-          | Some i, Some j when Poly.(Code.constant_equal i j = Some true) -> u
+          | Some i, Some j when constant_identical i j -> u
           | _ -> None)
         x
   | Pc c -> Some c
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 58893caaef..16ff54a5e2 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1861,7 +1861,7 @@ and compile_conditional st queue last loop_stack backs frontier interm =
         true, flush_all queue (throw_statement st.ctx cx k loc)
     | Stop ->
         let e_opt =
-          if st.ctx.Ctx.should_export then Some (s_var Constant.exports) else None
+          if st.ctx.Ctx.should_export then Some (s_var Global_constant.exports) else None
         in
         true, flush_all queue [ J.Return_statement e_opt, loc ]
     | Branch cont -> compile_branch st queue cont loop_stack backs frontier interm
@@ -2006,7 +2006,7 @@ let generate_shared_value ctx =
          | Some (v, _) ->
              [ ( J.V v
                , ( J.dot
-                     (s_var Constant.global_object)
+                     (s_var Global_constant.global_object)
                      (Utf8_string.of_string_exn "jsoo_runtime")
                  , J.N ) )
              ])
diff --git a/compiler/lib/constant.ml b/compiler/lib/global_constant.ml
similarity index 100%
rename from compiler/lib/constant.ml
rename to compiler/lib/global_constant.ml
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index 633d96a86b..acd03eee35 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -112,14 +112,14 @@ end = struct
     | FP_infinite -> if Float.(v < 0.) then "-Infinity" else "Infinity"
     | FP_normal | FP_subnormal -> (
         let vint = int_of_float v in
-        if Float.equal (float_of_int vint) v
+        if Float.ieee_equal (float_of_int vint) v
         then Printf.sprintf "%d." vint
         else
           match
             find_smaller
               ~f:(fun prec ->
                 let s = float_to_string prec v in
-                if Float.equal v (float_of_string s) then Some s else None)
+                if Float.ieee_equal v (float_of_string s) then Some s else None)
               ~bad:0
               ~good:18
               ~good_s:"max"
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index 5e72a0c6c7..4e007ecf8c 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -134,9 +134,9 @@ module Check = struct
     in
     let freename = StringSet.diff freename Reserved.keyword in
     let freename = StringSet.diff freename Reserved.provided in
-    let freename = StringSet.remove Constant.global_object freename in
+    let freename = StringSet.remove Global_constant.global_object freename in
     let freename = if has_flags then StringSet.remove "FLAG" freename else freename in
-    if StringSet.mem Constant.old_global_object freename && false
+    if StringSet.mem Global_constant.old_global_object freename && false
        (* Don't warn yet, we want to give a transition period where both
           "globalThis" and "joo_global_object" are allowed without extra
           noise *)
@@ -145,7 +145,7 @@ module Check = struct
         "warning: %s: 'joo_global_object' is being deprecated, please use `globalThis` \
          instead@."
         (loc pi);
-    let freename = StringSet.remove Constant.old_global_object freename in
+    let freename = StringSet.remove Global_constant.old_global_object freename in
     let defname = to_stringset free#get_def in
     if not (StringSet.mem name defname)
     then
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index f68e8cdb53..d5c7122c4d 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -423,7 +423,11 @@ end
 module Float = struct
   type t = float
 
-  let equal (a : float) (b : float) =
+  let equal (_ : float) (_ : float) = `Use_ieee_equal_or_bitwise_equal
+
+  let ieee_equal (a : float) (b : float) = Poly.equal a b
+
+  let bitwise_equal (a : float) (b : float) =
     Int64.equal (Int64.bits_of_float a) (Int64.bits_of_float b)
 
   (* Re-defined here to stay compatible with OCaml 4.02 *)
diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index 5ab5836bf0..f541039ba0 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -359,6 +359,21 @@
  (preprocess
   (pps ppx_expect)))
 
+(library
+ ;; compiler/tests-compiler/gh1659.ml
+ (name gh1659_15)
+ (enabled_if true)
+ (modules gh1659)
+ (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
+ (inline_tests
+  (enabled_if true)
+  (deps
+   (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
+   (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
+ (flags (:standard -open Jsoo_compiler_expect_tests_helper))
+ (preprocess
+  (pps ppx_expect)))
+
 (library
  ;; compiler/tests-compiler/gh747.ml
  (name gh747_15)
diff --git a/compiler/tests-compiler/gh1659.ml b/compiler/tests-compiler/gh1659.ml
new file mode 100644
index 0000000000..3607703f22
--- /dev/null
+++ b/compiler/tests-compiler/gh1659.ml
@@ -0,0 +1,62 @@
+let%expect_test _ =
+  let prog =
+    {|
+let f a b = a = b
+let () = Printf.printf "(0., 0.) = (-0., 0.) => %B\n" (f (0., 0.) (-0., 0.))
+let f a b = a = b
+let () = Printf.printf "0. = -0. => %B\n" (f 0. (-0.));;
+let f a b = a = b
+let nan1 = 0. /. 0.
+let nan2 = 0. /. 0.
+let () = Printf.printf "nan = nan => %B\n" (f nan1 nan2);;
+  |}
+  in
+  Util.compile_and_run prog;
+  [%expect
+    {|
+    (0., 0.) = (-0., 0.) => true
+    0. = -0. => true
+    nan = nan => false
+    |}]
+
+let%expect_test _ =
+  let prog =
+    {|
+external equals : 'a -> 'a -> bool = "caml_js_equals";;
+let () = Printf.printf "x = (0., 0.); x = x => %B\n" (let x = (0., 0.) in equals x x)
+let () = Printf.printf "(0., 0.) = (0., 0.) => %B\n" (equals (0., 0.) (0., 0.))
+let () = Printf.printf "0. = -0. => %B\n" (equals 0. (-0.));;
+let nan1 = 0. /. 0.
+let nan2 = 0. /. 0.
+let () = Printf.printf "nan = nan => %B\n" (equals nan1 nan2);;
+  |}
+  in
+  Util.compile_and_run prog;
+  [%expect
+    {|
+    x = (0., 0.); x = x => true
+    (0., 0.) = (0., 0.) => false
+    0. = -0. => true
+    nan = nan => false
+    |}]
+
+let%expect_test _ =
+  let prog =
+    {|
+external equals : 'a -> 'a -> bool = "caml_js_strict_equals";;
+let () = Printf.printf "x = (0., 0.); x = x => %B\n" (let x = (0., 0.) in equals x x)
+let () = Printf.printf "(0., 0.) = (0., 0.) => %B\n" (equals (0., 0.) (0., 0.))
+let () = Printf.printf "0. = -0. => %B\n" (equals 0. (-0.));;
+let nan1 = 0. /. 0.
+let nan2 = 0. /. 0.
+let () = Printf.printf "nan = nan => %B\n" (equals nan1 nan2);;
+  |}
+  in
+  Util.compile_and_run prog;
+  [%expect
+    {|
+    x = (0., 0.); x = x => true
+    (0., 0.) = (0., 0.) => false
+    0. = -0. => true
+    nan = nan => false
+    |}]

From 48b465ffd94ead4ae415ec1033f1990749b4184e Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 3 Sep 2024 15:36:06 +0200
Subject: [PATCH 355/481] WSOO side of ocsigen/js_of_ocaml#1659

---
 compiler/lib/wasm/wa_link.ml | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index ffb185ca8a..37eed7dafc 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -510,28 +510,28 @@ let build_runtime_arguments
       Javascript.call
         (EArrow
            ( Javascript.fun_
-               [ Javascript.ident Constant.global_object_ ]
+               [ Javascript.ident Global_constant.global_object_ ]
                [ var
-                   Constant.old_global_object_
-                   (EVar (Javascript.ident Constant.global_object_))
+                   Global_constant.old_global_object_
+                   (EVar (Javascript.ident Global_constant.global_object_))
                ; var
-                   Constant.exports_
+                   Global_constant.exports_
                    (EBin
                       ( Or
                       , EDot
                           ( EDot
-                              ( EVar (Javascript.ident Constant.global_object_)
+                              ( EVar (Javascript.ident Global_constant.global_object_)
                               , ANullish
                               , Utf8_string.of_string_exn "module" )
                           , ANullish
                           , Utf8_string.of_string_exn "export" )
-                      , EVar (Javascript.ident Constant.global_object_) ))
+                      , EVar (Javascript.ident Global_constant.global_object_) ))
                ; Return_statement (Some (obj generated_js)), N
                ]
                N
            , true
            , AUnknown ))
-        [ EVar (Javascript.ident Constant.global_object_) ]
+        [ EVar (Javascript.ident Global_constant.global_object_) ]
         N
   in
   obj

From 68bf91e36905f68283660055e87b0eff15b8814f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 20 Sep 2024 10:49:48 +0200
Subject: [PATCH 356/481] Fixes

---
 compiler/lib/eval.ml             | 4 ++++
 compiler/lib/flow.ml             | 4 ++++
 compiler/tests-compiler/dune.inc | 4 ++--
 3 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 75d655bbbf..6ecb48faeb 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -272,6 +272,10 @@ let constant_js_equal a b =
   | _, Float_array _
   | Int64 _, _
   | _, Int64 _
+  | Int32 _, _
+  | _, Int32 _
+  | NativeInt _, _
+  | _, NativeInt _
   | Tuple _, _
   | _, Tuple _ -> None
 
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 1212e56f0f..95aa383a24 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -341,6 +341,10 @@ let constant_identical a b =
   | _, Float_array _
   | Int64 _, _
   | _, Int64 _
+  | Int32 _, _
+  | _, Int32 _
+  | NativeInt _, _
+  | _, NativeInt _
   | Tuple _, _
   | _, Tuple _ -> false
 
diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index f541039ba0..f1af6980a2 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -362,11 +362,11 @@
 (library
  ;; compiler/tests-compiler/gh1659.ml
  (name gh1659_15)
- (enabled_if true)
+ (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1659)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))

From 26864d1af6aae7d80ac44eab58c7c34e43a4b870 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 20 Sep 2024 15:36:17 +0200
Subject: [PATCH 357/481] Fix constant_identical for Wasm target

---
 compiler/lib/eval.ml          | 12 +++----
 compiler/lib/flow.ml          | 61 ++++++++++++++++++-----------------
 compiler/lib/flow.mli         |  8 ++---
 compiler/lib/specialize_js.ml | 34 +++++++++----------
 4 files changed, 58 insertions(+), 57 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 6ecb48faeb..5faec48bfb 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -166,14 +166,14 @@ let eval_prim ~target x =
       | _ -> None)
   | _ -> None
 
-let the_length_of info x =
+let the_length_of ~target info x =
   get_approx
     info
     (fun x ->
       match info.info_defs.(Var.idx x) with
       | Expr (Constant (String s)) -> Some (Int32.of_int (String.length s))
       | Expr (Prim (Extern "caml_create_string", [ arg ]))
-      | Expr (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int info arg
+      | Expr (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int ~target info arg
       | _ -> None)
     None
     (fun u v ->
@@ -282,7 +282,7 @@ let constant_js_equal a b =
 let eval_instr ~target info ((x, loc) as i) =
   match x with
   | Let (x, Prim (Extern (("caml_equal" | "caml_notequal") as prim), [ y; z ])) -> (
-      match the_const_of info y, the_const_of info z with
+      match the_const_of ~target info y, the_const_of ~target info z with
       | Some e1, Some e2 -> (
           match Code.Constant.ocaml_equal e1 e2 with
           | None -> [ i ]
@@ -298,7 +298,7 @@ let eval_instr ~target info ((x, loc) as i) =
               [ Let (x, c), loc ])
       | _ -> [ i ])
   | Let (x, Prim (Extern ("caml_js_equals" | "caml_js_strict_equals"), [ y; z ])) -> (
-      match the_const_of info y, the_const_of info z with
+      match the_const_of ~target info y, the_const_of ~target info z with
       | Some e1, Some e2 -> (
           match constant_js_equal e1 e2 with
           | None -> [ i ]
@@ -311,7 +311,7 @@ let eval_instr ~target info ((x, loc) as i) =
       let c =
         match s with
         | Pc (String s) -> Some (Int32.of_int (String.length s))
-        | Pv v -> the_length_of info v
+        | Pv v -> the_length_of ~target info v
         | _ -> None
       in
       match c with
@@ -364,7 +364,7 @@ let eval_instr ~target info ((x, loc) as i) =
   | Let (_, Prim (Extern ("%resume" | "%perform" | "%reperform"), _)) ->
       [ i ] (* We need that the arguments to this primitives remain variables *)
   | Let (x, Prim (prim, prim_args)) -> (
-      let prim_args' = List.map prim_args ~f:(fun x -> the_const_of info x) in
+      let prim_args' = List.map prim_args ~f:(fun x -> the_const_of ~target info x) in
       let res =
         if List.for_all prim_args' ~f:(function
                | Some _ -> true
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 95aa383a24..5cf4025858 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -325,30 +325,31 @@ let the_def_of info x =
 (* If [constant_identical a b = true], then the two values cannot be
    distinguished, i.e., they are not different objects (and [caml_js_equals a b
    = true]) and if both are floats, they are bitwise equal. *)
-let constant_identical a b =
-  match a, b with
-  | Int i, Int j -> Int32.equal i j
-  | Float a, Float b -> Float.bitwise_equal a b
-  | NativeString a, NativeString b -> Native_string.equal a b
-  | String a, String b -> Config.Flag.use_js_string () && String.equal a b
-  | Int _, Float _ | Float _, Int _ -> false
+let constant_identical ~(target : [`JavaScript | `Wasm]) a b =
+  match a, b, target with
+  | Int i, Int j, _ -> Int32.equal i j
+  | Float a, Float b, `JavaScript -> Float.bitwise_equal a b
+  | Float _, Float _, `Wasm -> false
+  | NativeString a, NativeString b, `JavaScript -> Native_string.equal a b
+  | String a, String b, `JavaScript -> Config.Flag.use_js_string () && String.equal a b
+  | Int _, Float _, _ | Float _, Int _, _ -> false
   (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
-  | String _, _
-  | _, String _
-  | NativeString _, _
-  | _, NativeString _
-  | Float_array _, _
-  | _, Float_array _
-  | Int64 _, _
-  | _, Int64 _
-  | Int32 _, _
-  | _, Int32 _
-  | NativeInt _, _
-  | _, NativeInt _
-  | Tuple _, _
-  | _, Tuple _ -> false
-
-let the_const_of info x =
+  | String _, _, _
+  | _, String _, _
+  | NativeString _, _, _
+  | _, NativeString _, _
+  | Float_array _, _, _
+  | _, Float_array _, _
+  | Int64 _, _, _
+  | _, Int64 _, _
+  | Int32 _, _, _
+  | _, Int32 _, _
+  | NativeInt _, _, _
+  | _, NativeInt _, _
+  | Tuple _, _, _
+  | _, Tuple _, _-> false
+
+let the_const_of ~target info x =
   match x with
   | Pv x ->
       get_approx
@@ -363,23 +364,23 @@ let the_const_of info x =
         None
         (fun u v ->
           match u, v with
-          | Some i, Some j when constant_identical i j -> u
+          | Some i, Some j when constant_identical ~target i j -> u
           | _ -> None)
         x
   | Pc c -> Some c
 
-let the_int info x =
-  match the_const_of info x with
+let the_int ~target info x =
+  match the_const_of ~target info x with
   | Some (Int i) -> Some i
   | _ -> None
 
-let the_string_of info x =
-  match the_const_of info x with
+let the_string_of ~target info x =
+  match the_const_of info ~target x with
   | Some (String i) -> Some i
   | _ -> None
 
-let the_native_string_of info x =
-  match the_const_of info x with
+let the_native_string_of ~target info x =
+  match the_const_of ~target info x with
   | Some (NativeString i) -> Some i
   | _ -> None
 
diff --git a/compiler/lib/flow.mli b/compiler/lib/flow.mli
index 3dfb875511..23cffa5a5d 100644
--- a/compiler/lib/flow.mli
+++ b/compiler/lib/flow.mli
@@ -54,13 +54,13 @@ val get_approx :
 
 val the_def_of : info -> Code.prim_arg -> Code.expr option
 
-val the_const_of : info -> Code.prim_arg -> Code.constant option
+val the_const_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.constant option
 
-val the_string_of : info -> Code.prim_arg -> string option
+val the_string_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> string option
 
-val the_native_string_of : info -> Code.prim_arg -> Code.Native_string.t option
+val the_native_string_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.Native_string.t option
 
-val the_int : info -> Code.prim_arg -> int32 option
+val the_int : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> int32 option
 
 val update_def : info -> Code.Var.t -> Code.expr -> unit
 
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 3140865215..66f1c7fa15 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -25,14 +25,14 @@ open Flow
 let specialize_instr ~target info i =
   match i, target with
   | Let (x, Prim (Extern "caml_format_int", [ y; z ])), `JavaScript -> (
-      match the_string_of info y with
+      match the_string_of ~target info y with
       | Some "%d" -> (
-          match the_int info z with
+          match the_int ~target info z with
           | Some i -> Let (x, Constant (String (Int32.to_string i)))
           | None -> Let (x, Prim (Extern "%caml_format_int_special", [ z ])))
       | _ -> i)
   | Let (x, Prim (Extern "%caml_format_int_special", [ z ])), `JavaScript -> (
-      match the_int info z with
+      match the_int ~target info z with
       | Some i -> Let (x, Constant (String (Int32.to_string i)))
       | None -> i)
   (* inline the String constant argument so that generate.ml can attempt to parse it *)
@@ -43,12 +43,12 @@ let specialize_instr ~target info i =
             , [ (Pv _ as y) ] ) )
     , _ )
     when Config.Flag.safe_string () -> (
-      match the_string_of info y with
+      match the_string_of ~target info y with
       | Some s -> Let (x, Prim (Extern prim, [ Pc (String s) ]))
       | _ -> i)
   | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ y; z ])), `JavaScript
     -> (
-      match the_string_of info y with
+      match the_string_of ~target info y with
       | Some s when Primitive.need_named_value s ->
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
       | Some _ -> Let (x, Constant (Int 0l))
@@ -66,7 +66,7 @@ let specialize_instr ~target info i =
           Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), _ -> (
-      match the_string_of info m with
+      match the_string_of ~target info m with
       | Some m when Javascript.is_ident m -> (
           match the_def_of info a with
           | Some (Block (_, a, _, _)) ->
@@ -98,7 +98,7 @@ let specialize_instr ~target info i =
               match the_def_of info (Pv x) with
               | Some (Block (_, [| k; v |], _, _)) ->
                   let k =
-                    match the_string_of info (Pv k) with
+                    match the_string_of ~target info (Pv k) with
                     | Some s when String.is_valid_utf_8 s ->
                         Pc (NativeString (Native_string.of_string s))
                     | Some _ | None -> raise Exit
@@ -112,40 +112,40 @@ let specialize_instr ~target info i =
         Let (x, Prim (Extern "%caml_js_opt_object", List.flatten (Array.to_list a)))
       with Exit -> i)
   | Let (x, Prim (Extern "caml_js_get", [ o; (Pv _ as f) ])), _ -> (
-      match the_native_string_of info f with
+      match the_native_string_of ~target info f with
       | Some s -> Let (x, Prim (Extern "caml_js_get", [ o; Pc (NativeString s) ]))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_set", [ o; (Pv _ as f); v ])), _ -> (
-      match the_native_string_of info f with
+      match the_native_string_of ~target info f with
       | Some s -> Let (x, Prim (Extern "caml_js_set", [ o; Pc (NativeString s); v ]))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_delete", [ o; (Pv _ as f) ])), _ -> (
-      match the_native_string_of info f with
+      match the_native_string_of ~target info f with
       | Some s -> Let (x, Prim (Extern "caml_js_delete", [ o; Pc (NativeString s) ]))
       | _ -> i)
   | Let (x, Prim (Extern ("caml_jsstring_of_string" | "caml_js_from_string"), [ y ])), _
     -> (
-      match the_string_of info y with
+      match the_string_of ~target info y with
       | Some s when String.is_valid_utf_8 s ->
           Let (x, Constant (NativeString (Native_string.of_string s)))
       | Some _ | None -> i)
   | Let (x, Prim (Extern "caml_jsbytes_of_string", [ y ])), _ -> (
-      match the_string_of info y with
+      match the_string_of ~target info y with
       | Some s -> Let (x, Constant (NativeString (Native_string.of_bytestring s)))
       | None -> i)
   | Let (x, Prim (Extern "%int_mul", [ y; z ])), `JavaScript -> (
-      match the_int info y, the_int info z with
+      match the_int ~target info y, the_int ~target info z with
       | Some j, _ when Int32.(abs j < 0x200000l) ->
           Let (x, Prim (Extern "%direct_int_mul", [ y; z ]))
       | _, Some j when Int32.(abs j < 0x200000l) ->
           Let (x, Prim (Extern "%direct_int_mul", [ y; z ]))
       | _ -> i)
   | Let (x, Prim (Extern "%int_div", [ y; z ])), _ -> (
-      match the_int info z with
+      match the_int ~target info z with
       | Some j when Int32.(j <> 0l) -> Let (x, Prim (Extern "%direct_int_div", [ y; z ]))
       | _ -> i)
   | Let (x, Prim (Extern "%int_mod", [ y; z ])), _ -> (
-      match the_int info z with
+      match the_int ~target info z with
       | Some j when Int32.(j <> 0l) -> Let (x, Prim (Extern "%direct_int_mod", [ y; z ]))
       | _ -> i)
   | _, _ -> i
@@ -170,7 +170,7 @@ let specialize_instrs ~target info l =
                      | "caml_array_get_addr" ) as prim)
                 , [ y; z ] ) ) ->
             let idx =
-              match the_int info z with
+              match the_int ~target info z with
               | Some idx -> `Cst idx
               | None -> `Var z
             in
@@ -213,7 +213,7 @@ let specialize_instrs ~target info l =
                      | "caml_array_set_addr" ) as prim)
                 , [ y; z; t ] ) ) ->
             let idx =
-              match the_int info z with
+              match the_int ~target info z with
               | Some idx -> `Cst idx
               | None -> `Var z
             in

From 13128c5e192d8cb78a1ea5e7e1f8fec705516683 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 23 Sep 2024 11:23:37 +0200
Subject: [PATCH 358/481] Fix performance issue when assigning short names to
 variables

---
 compiler/lib/wasm/wa_wasm_output.ml | 19 ++++++++++++++-----
 compiler/lib/wasm/wa_wat_output.ml  | 17 +++++++++++++----
 2 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/compiler/lib/wasm/wa_wasm_output.ml b/compiler/lib/wasm/wa_wasm_output.ml
index f90543581b..114ce0edc8 100644
--- a/compiler/lib/wasm/wa_wasm_output.ml
+++ b/compiler/lib/wasm/wa_wasm_output.ml
@@ -1043,14 +1043,23 @@ end = struct
     output_byte ch id;
     with_size f ch x
 
-  let rec find_available_name used name i =
-    let nm = Printf.sprintf "%s$%d" name i in
-    if StringSet.mem nm used then find_available_name used name (i + 1) else nm
-
   let assign_names f tbl =
     let names = Hashtbl.fold (fun name idx rem -> (idx, name) :: rem) tbl [] in
     let names = List.sort ~cmp:(fun (idx, _) (idx', _) -> compare idx idx') names in
     let used = ref StringSet.empty in
+    let counts = Hashtbl.create 101 in
+    let rec find_available_name used name =
+      let i =
+        try Hashtbl.find counts name
+        with Not_found ->
+          let i = ref 0 in
+          Hashtbl.replace counts name i;
+          i
+      in
+      incr i;
+      let nm = Printf.sprintf "%s$%d" name !i in
+      if StringSet.mem nm used then find_available_name used name else nm
+    in
     let names =
       List.map
         ~f:(fun (idx, x) ->
@@ -1058,7 +1067,7 @@ end = struct
           | None -> idx, None
           | Some nm ->
               let nm =
-                if StringSet.mem nm !used then find_available_name !used nm 1 else nm
+                if StringSet.mem nm !used then find_available_name !used nm else nm
               in
               used := StringSet.add nm !used;
               idx, Some nm)
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 3e72493bea..a01874b4ea 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -23,9 +23,18 @@ let target = `Binaryen (*`Reference*)
 
 let assign_names ?(reversed = true) f names =
   let used = ref StringSet.empty in
-  let rec find_available_name used name i =
-    let nm = Printf.sprintf "%s$%d" name i in
-    if StringSet.mem nm used then find_available_name used name (i + 1) else nm
+  let counts = Hashtbl.create 101 in
+  let rec find_available_name used name =
+    let i =
+      try Hashtbl.find counts name
+      with Not_found ->
+        let i = ref 0 in
+        Hashtbl.replace counts name i;
+        i
+    in
+    incr i;
+    let nm = Printf.sprintf "%s$%d" name !i in
+    if StringSet.mem nm used then find_available_name used name else nm
   in
   let names = if reversed then List.rev names else names in
   let names =
@@ -35,7 +44,7 @@ let assign_names ?(reversed = true) f names =
         | None -> x, None
         | Some nm ->
             let nm =
-              if StringSet.mem nm !used then find_available_name !used nm 1 else nm
+              if StringSet.mem nm !used then find_available_name !used nm else nm
             in
             used := StringSet.add nm !used;
             x, Some nm)

From c4fa5d4a5ae8282c46ee24502b7bda97f62636bb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 23 Sep 2024 15:37:15 +0200
Subject: [PATCH 359/481] opam: requires ocaml >= 4.14

---
 dune-project                | 2 +-
 wasm_of_ocaml-compiler.opam | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/dune-project b/dune-project
index a878900ca3..ed1856d813 100644
--- a/dune-project
+++ b/dune-project
@@ -138,7 +138,7 @@
  (description
   "Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js")
  (depends
-  (ocaml (and (>= 4.08) (< 5.1)))
+  (ocaml (and (>= 4.14) (< 5.1)))
   (js_of_ocaml (= :version))
   (num :with-test)
   (ppx_expect (and (>= v0.14.2) :with-test))
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
index 19f71ea31b..e7ffee8300 100644
--- a/wasm_of_ocaml-compiler.opam
+++ b/wasm_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.17"}
-  "ocaml" {>= "4.08" & < "5.1"}
+  "ocaml" {>= "4.14" & < "5.1"}
   "js_of_ocaml" {= version}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}

From 87f2119ec4669485db98be53d2a2924656951b81 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 23 Sep 2024 17:44:43 +0200
Subject: [PATCH 360/481] ocamlformat

---
 compiler/lib/effects.ml          |  5 ++---
 compiler/lib/flow.ml             |  4 ++--
 compiler/lib/flow.mli            | 11 +++++++----
 compiler/lib/ocaml_compiler.ml   | 20 ++++++++++----------
 compiler/lib/parse_bytecode.ml   | 28 +++++++++++++---------------
 compiler/lib/specialize_js.ml    |  4 +---
 compiler/lib/wasm/wa_generate.ml |  6 +-----
 7 files changed, 36 insertions(+), 42 deletions(-)

diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml
index 66c79a3ed7..5b4e310367 100644
--- a/compiler/lib/effects.ml
+++ b/compiler/lib/effects.ml
@@ -483,9 +483,8 @@ let cps_instr ~st (instr : instr) : instr =
       | Pc (Int a) ->
           Let
             ( x
-            , Prim
-                ( Extern "caml_alloc_dummy_function"
-                , [ size; Pc (Int (Int32.succ a)) ] ) )
+            , Prim (Extern "caml_alloc_dummy_function", [ size; Pc (Int (Int32.succ a)) ])
+            )
       | _ -> assert false)
   | Let (x, Apply { f; args; _ }) when not (Var.Set.mem x st.cps_needed) ->
       (* At the moment, we turn into CPS any function not called with
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 5cf4025858..c37a9a30b5 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -325,7 +325,7 @@ let the_def_of info x =
 (* If [constant_identical a b = true], then the two values cannot be
    distinguished, i.e., they are not different objects (and [caml_js_equals a b
    = true]) and if both are floats, they are bitwise equal. *)
-let constant_identical ~(target : [`JavaScript | `Wasm]) a b =
+let constant_identical ~(target : [ `JavaScript | `Wasm ]) a b =
   match a, b, target with
   | Int i, Int j, _ -> Int32.equal i j
   | Float a, Float b, `JavaScript -> Float.bitwise_equal a b
@@ -347,7 +347,7 @@ let constant_identical ~(target : [`JavaScript | `Wasm]) a b =
   | NativeInt _, _, _
   | _, NativeInt _, _
   | Tuple _, _, _
-  | _, Tuple _, _-> false
+  | _, Tuple _, _ -> false
 
 let the_const_of ~target info x =
   match x with
diff --git a/compiler/lib/flow.mli b/compiler/lib/flow.mli
index 23cffa5a5d..956ccec1e6 100644
--- a/compiler/lib/flow.mli
+++ b/compiler/lib/flow.mli
@@ -54,13 +54,16 @@ val get_approx :
 
 val the_def_of : info -> Code.prim_arg -> Code.expr option
 
-val the_const_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.constant option
+val the_const_of :
+  target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.constant option
 
-val the_string_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> string option
+val the_string_of :
+  target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> string option
 
-val the_native_string_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.Native_string.t option
+val the_native_string_of :
+  target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.Native_string.t option
 
-val the_int : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> int32 option
+val the_int : target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> int32 option
 
 val update_def : info -> Code.Var.t -> Code.expr -> unit
 
diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
index 1e8f66566e..9b2cf1d9ae 100644
--- a/compiler/lib/ocaml_compiler.ml
+++ b/compiler/lib/ocaml_compiler.ml
@@ -25,21 +25,21 @@ let rec constant_of_const ~target c : Code.constant =
   | Const_base (Const_int i) ->
       Int
         (match target with
-         | `JavaScript -> Int32.of_int_warning_on_overflow i
-         | `Wasm -> Int31.of_int_warning_on_overflow i)
+        | `JavaScript -> Int32.of_int_warning_on_overflow i
+        | `Wasm -> Int31.of_int_warning_on_overflow i)
   | Const_base (Const_char c) -> Int (Int32.of_int (Char.code c))
   | ((Const_base (Const_string (s, _))) [@if ocaml_version < (4, 11, 0)])
   | ((Const_base (Const_string (s, _, _))) [@if ocaml_version >= (4, 11, 0)]) -> String s
   | Const_base (Const_float s) -> Float (float_of_string s)
-  | Const_base (Const_int32 i) ->
-      (match target with
-       | `JavaScript -> Int i
-       | `Wasm -> Int32 i)
+  | Const_base (Const_int32 i) -> (
+      match target with
+      | `JavaScript -> Int i
+      | `Wasm -> Int32 i)
   | Const_base (Const_int64 i) -> Int64 i
-  | Const_base (Const_nativeint i) ->
-      (match target with
-       | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
-       | `Wasm -> NativeInt i)
+  | Const_base (Const_nativeint i) -> (
+      match target with
+      | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
+      | `Wasm -> NativeInt i)
   | Const_immstring s -> String s
   | Const_float_array sl ->
       let l = List.map ~f:(fun f -> float_of_string f) sl in
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 9f5c4fa43a..155c3cf3be 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -465,16 +465,16 @@ end = struct
       else if tag = Obj.custom_tag
       then
         match ident_of_custom x with
-        | Some name when same_ident name ident_32 ->
+        | Some name when same_ident name ident_32 -> (
             let i : int32 = Obj.magic x in
-            (match target with
-             | `JavaScript -> Int i
-             | `Wasm -> Int32 i)
-        | Some name when same_ident name ident_native ->
+            match target with
+            | `JavaScript -> Int i
+            | `Wasm -> Int32 i)
+        | Some name when same_ident name ident_native -> (
             let i : nativeint = Obj.magic x in
-            (match target with
-             | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
-             | `Wasm -> NativeInt i)
+            match target with
+            | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
+            | `Wasm -> NativeInt i)
         | Some name when same_ident name ident_64 -> Int64 (Obj.magic x : int64)
         | Some name ->
             failwith
@@ -493,8 +493,8 @@ end = struct
       let i : int = Obj.magic x in
       Int
         (match target with
-         | `JavaScript -> Int32.of_int_warning_on_overflow i
-         | `Wasm -> Int31.of_int_warning_on_overflow i)
+        | `JavaScript -> Int32.of_int_warning_on_overflow i
+        | `Wasm -> Int31.of_int_warning_on_overflow i)
 
   let inlined = function
     | String _ | NativeString _ -> false
@@ -2385,10 +2385,7 @@ and compile infos pc state instrs =
           (pc + 1)
           state
           (( Let
-               ( m
-               , Prim
-                   ( Extern "caml_get_public_method"
-                   , [ Pv obj; Pv tag; Pc (Int 0l) ] ) )
+               (m, Prim (Extern "caml_get_public_method", [ Pv obj; Pv tag; Pc (Int 0l) ]))
            , loc )
           :: instrs)
     | GETMETHOD ->
@@ -3104,7 +3101,8 @@ let predefined_exceptions ~target =
                     (Int
                        ((* Predefined exceptions are registered in
                            Symtable.init with [-index - 1] *)
-                        Int32.of_int (-index - 1) )))
+                        Int32.of_int
+                          (-index - 1))) )
             , noloc )
           ; Let (exn, Block (248, [| v_name; v_index |], NotArray, Immutable)), noloc
           ; ( Let
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 66f1c7fa15..39f0209029 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -283,9 +283,7 @@ let f_once p =
                      | "caml_floatarray_unsafe_set" )
                  , [ _; _; _ ] ) as p) ) ->
             let x' = Code.Var.fork x in
-            let acc =
-              (Let (x', p), loc) :: (Let (x, Constant (Int 0l)), loc) :: acc
-            in
+            let acc = (Let (x', p), loc) :: (Let (x, Constant (Int 0l)), loc) :: acc in
             loop acc r
         | _ -> loop ((i, loc) :: acc) r)
   in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 9eedaa7e95..d01daad091 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -672,11 +672,7 @@ module Generate (Target : Wa_target_sig.S) = struct
           if ctx.live.(Var.idx x) = 0
           then drop (translate_expr ctx stack_ctx context x e)
           else store x (translate_expr ctx stack_ctx context x e)
-      | Set_field (x, n, Non_float, y) ->
-          Memory.set_field
-            (load x)
-            n
-            (load y)
+      | Set_field (x, n, Non_float, y) -> Memory.set_field (load x) n (load y)
       | Set_field (x, n, Float, y) ->
           Memory.float_array_set
             (load x)

From 99c46f0dfbe4ab69b9b2bbc440a2a5ef1ded917b Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 26 Sep 2024 20:21:06 +0200
Subject: [PATCH 361/481] Compiler: nativeInt is always 32bit

---
 compiler/lib/code.ml  | 12 ++++++------
 compiler/lib/code.mli |  8 ++++----
 2 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index d9fffb4eec..a05b1aefd1 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -284,10 +284,10 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
-  | Int of int32
-  | Int32 of int32
-  | Int64 of int64
-  | NativeInt of nativeint
+  | Int of Int32.t
+  | Int32 of Int32.t
+  | Int64 of Int64.t
+  | NativeInt of Int32.t (* Native int are 32bit on all known backend *)
   | Tuple of int * constant array * array_or_not
 
 module Constant = struct
@@ -311,7 +311,7 @@ module Constant = struct
           !same
     | Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
     | Int64 a, Int64 b -> Some (Int64.equal a b)
-    | NativeInt a, NativeInt b -> Some (Nativeint.equal a b)
+    | NativeInt a, NativeInt b -> Some (Int32.equal a b)
     | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b)
     | Float a, Float b -> Some (Float.ieee_equal a b)
     | String _, NativeString _ | NativeString _, String _ -> None
@@ -459,7 +459,7 @@ module Print = struct
     | Int i -> Format.fprintf f "%ld" i
     | Int32 i -> Format.fprintf f "%ldl" i
     | Int64 i -> Format.fprintf f "%LdL" i
-    | NativeInt i -> Format.fprintf f "%ndn" i
+    | NativeInt i -> Format.fprintf f "%ldn" i
     | Tuple (tag, a, _) -> (
         Format.fprintf f "<%d>" tag;
         match Array.length a with
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 1c107d75eb..f0df91b3b2 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -164,10 +164,10 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
-  | Int of int32
-  | Int32 of int32  (** Only produced when compiling to WebAssembly. *)
-  | Int64 of int64
-  | NativeInt of nativeint  (** Only produced when compiling to WebAssembly. *)
+  | Int of Int32.t
+  | Int32 of Int32.t  (** Only produced when compiling to WebAssembly. *)
+  | Int64 of Int64.t
+  | NativeInt of Int32.t  (** Only produced when compiling to WebAssembly. *)
   | Tuple of int * constant array * array_or_not
 
 module Constant : sig

From 2ab1d30d9f012a2173e6084ad5cd12dafd62ca96 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 27 Sep 2024 14:37:46 +0200
Subject: [PATCH 362/481] Target-specific code (#1655)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Co-authored-by: Olivier Nicole <olivier@chnik.fr>
Co-authored-by: Jérôme Vouillon <jerome.vouillon@gmail.com>
Co-authored-by: Hugo Heuzard <hugo.heuzard@gmail.com>
---
 compiler/bin-js_of_ocaml/build_fs.ml          |   2 +-
 compiler/bin-js_of_ocaml/check_runtime.ml     |   3 +-
 compiler/bin-js_of_ocaml/compile.ml           |   7 +-
 compiler/bin-js_of_ocaml/link.ml              |   1 +
 .../js_of_ocaml_compiler_dynlink.ml           |   3 +
 compiler/lib-runtime-files/gen/gen.ml         |   1 +
 compiler/lib/code.ml                          |  18 +-
 compiler/lib/config.ml                        |  14 +-
 compiler/lib/config.mli                       |  11 +
 compiler/lib/driver.ml                        | 149 ++++++-------
 compiler/lib/driver.mli                       |  22 +-
 compiler/lib/eval.ml                          | 177 ++++++++++------
 compiler/lib/eval.mli                         |   2 +-
 compiler/lib/flow.ml                          |  33 +--
 compiler/lib/inline.ml                        |   4 +-
 compiler/lib/inline.mli                       |   3 +-
 compiler/lib/ocaml_compiler.ml                |  19 +-
 compiler/lib/parse_bytecode.ml                | 198 ++++++++++--------
 compiler/lib/specialize_js.ml                 |  14 +-
 compiler/lib/specialize_js.mli                |   2 +-
 compiler/lib/stdlib.ml                        |  92 +++++++-
 compiler/tests-num/dune                       |  10 +
 compiler/tests-num/test_int31.ml              | 194 +++++++++++++++++
 dune-project                                  |   1 +
 dune-workspace.dev                            |   2 +-
 25 files changed, 686 insertions(+), 296 deletions(-)
 create mode 100644 compiler/tests-num/test_int31.ml

diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml
index 84ed7fb55d..16ac22a23d 100644
--- a/compiler/bin-js_of_ocaml/build_fs.ml
+++ b/compiler/bin-js_of_ocaml/build_fs.ml
@@ -75,10 +75,10 @@ function jsoo_create_file_extern(name,content){
       let pfs_fmt = Pretty_print.to_out_channel chan in
       let (_ : Source_map.t option) =
         Driver.f
-          ~target:(JavaScript pfs_fmt)
           ~standalone:true
           ~wrap_with_fun:`Iife
           ~link:`Needed
+          ~formatter:pfs_fmt
           (Parse_bytecode.Debug.create ~include_cmis:false false)
           code
       in
diff --git a/compiler/bin-js_of_ocaml/check_runtime.ml b/compiler/bin-js_of_ocaml/check_runtime.ml
index 14bca57e0a..29b541914a 100644
--- a/compiler/bin-js_of_ocaml/check_runtime.ml
+++ b/compiler/bin-js_of_ocaml/check_runtime.ml
@@ -43,7 +43,8 @@ let print_groups output l =
               output_string output (Printf.sprintf "%s\n" name)))
 
 let f (runtime_files, bytecode, target_env) =
-  Generate.init ();
+  Config.set_target `JavaScript;
+  Linker.reset ();
   let runtime_files, builtin =
     List.partition_map runtime_files ~f:(fun name ->
         match Builtins.find name with
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index b456d69c36..caeb138842 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -91,6 +91,7 @@ let run
     } =
   let include_cmis = toplevel && not no_cmis in
   let custom_header = common.Jsoo_cmdline.Arg.custom_header in
+  Config.set_target `JavaScript;
   Jsoo_cmdline.Arg.eval common;
   Generate.init ();
   (match output_file with
@@ -184,7 +185,7 @@ let run
     let init_pseudo_fs = fs_external && standalone in
     let sm =
       match output_file with
-      | `Stdout, fmt ->
+      | `Stdout, formatter ->
           let instr =
             List.concat
               [ pseudo_fs_instr `create_file one.debug one.cmis
@@ -200,9 +201,10 @@ let run
             ~link
             ~wrap_with_fun
             ?source_map
+            ~formatter
             one.debug
             code
-      | `File, fmt ->
+      | `File, formatter ->
           let fs_instr1, fs_instr2 =
             match fs_output with
             | None -> pseudo_fs_instr `create_file one.debug one.cmis, []
@@ -224,6 +226,7 @@ let run
               ~link
               ~wrap_with_fun
               ?source_map
+              ~formatter
               one.debug
               code
           in
diff --git a/compiler/bin-js_of_ocaml/link.ml b/compiler/bin-js_of_ocaml/link.ml
index 090913d20b..7719679702 100644
--- a/compiler/bin-js_of_ocaml/link.ml
+++ b/compiler/bin-js_of_ocaml/link.ml
@@ -150,6 +150,7 @@ let f
     ; mklib
     ; toplevel
     } =
+  Config.set_target `JavaScript;
   Jsoo_cmdline.Arg.eval common;
   let with_output f =
     match output_file with
diff --git a/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml
index 9bf10680d9..c296919d62 100644
--- a/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml
+++ b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml
@@ -16,6 +16,9 @@ let split_primitives p =
 external get_section_table : unit -> (string * Obj.t) list = "caml_get_section_table"
 
 let () =
+  (match Sys.backend_type with
+  | Sys.Other "js_of_ocaml" -> Config.set_target `JavaScript
+  | Sys.(Native | Bytecode | Other _) -> failwith "Expected backend `js_of_ocaml`");
   let global = J.pure_js_expr "globalThis" in
   Config.Flag.set "use-js-string" (Jsoo_runtime.Sys.Config.use_js_string ());
   Config.Flag.set "effects" (Jsoo_runtime.Sys.Config.effects ());
diff --git a/compiler/lib-runtime-files/gen/gen.ml b/compiler/lib-runtime-files/gen/gen.ml
index 3f01473575..a482399814 100644
--- a/compiler/lib-runtime-files/gen/gen.ml
+++ b/compiler/lib-runtime-files/gen/gen.ml
@@ -47,6 +47,7 @@ let rec list_product l =
 let bool = [ true; false ]
 
 let () =
+  Js_of_ocaml_compiler.Config.set_target `JavaScript;
   let () = set_binary_mode_out stdout true in
   match Array.to_list Sys.argv with
   | [] -> assert false
diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index a05b1aefd1..0bb91ffffc 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -816,6 +816,7 @@ let with_invariant = Debug.find "invariant"
 let check_defs = false
 
 let invariant { blocks; start; _ } =
+  let target = Config.target () in
   if with_invariant ()
   then (
     assert (Addr.Map.mem start blocks);
@@ -830,6 +831,19 @@ let invariant { blocks; start; _ } =
         assert (not (Var.ISet.mem defs x));
         Var.ISet.add defs x)
     in
+    let check_constant = function
+      | NativeInt _ | Int32 _ ->
+          assert (
+            match target with
+            | `Wasm -> true
+            | _ -> false)
+      | String _ | NativeString _ | Float _ | Float_array _ | Int _ | Int64 _
+      | Tuple (_, _, _) -> ()
+    in
+    let check_prim_arg = function
+      | Pc c -> check_constant c
+      | Pv _ -> ()
+    in
     let check_expr = function
       | Apply _ -> ()
       | Block (_, _, _, _) -> ()
@@ -837,8 +851,8 @@ let invariant { blocks; start; _ } =
       | Closure (l, cont) ->
           List.iter l ~f:define;
           check_cont cont
-      | Constant _ -> ()
-      | Prim (_, _) -> ()
+      | Constant c -> check_constant c
+      | Prim (_, args) -> List.iter ~f:check_prim_arg args
       | Special _ -> ()
     in
     let check_instr (i, _loc) =
diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml
index 95193f49c3..3f8e875453 100644
--- a/compiler/lib/config.ml
+++ b/compiler/lib/config.ml
@@ -162,7 +162,7 @@ module Param = struct
     p
       ~name:"tc"
       ~desc:"Set tailcall optimisation"
-      (enum [ "trampoline", TcTrampoline; (* default *) "none", TcNone ])
+      (enum [ "trampoline", TcTrampoline (* default *); "none", TcNone ])
 
   let lambda_lifting_threshold =
     (* When we reach this depth, we start looking for functions to be lifted *)
@@ -178,3 +178,15 @@ module Param = struct
       ~desc:"Set baseline for lifting deeply nested functions"
       (int 1)
 end
+
+(****)
+
+let target_ : [ `JavaScript | `Wasm | `None ] ref = ref `None
+
+let target () =
+  match !target_ with
+  | `None -> failwith "target was not set"
+  | (`JavaScript | `Wasm) as t -> t
+
+let set_target (t : [ `JavaScript | `Wasm ]) =
+  target_ := (t :> [ `JavaScript | `Wasm | `None ])
diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli
index ac1672bdef..ab1f49d980 100644
--- a/compiler/lib/config.mli
+++ b/compiler/lib/config.mli
@@ -78,6 +78,7 @@ module Flag : sig
   val disable : string -> unit
 end
 
+(** This module contains parameters that may be modified through command-line flags. *)
 module Param : sig
   val set : string -> string -> unit
 
@@ -102,3 +103,13 @@ module Param : sig
 
   val lambda_lifting_baseline : unit -> int
 end
+
+(****)
+
+(** {2 Parameters that are constant across a program run} *)
+
+(** These parameters should be set at most once at the beginning of the program. *)
+
+val target : unit -> [ `JavaScript | `Wasm ]
+
+val set_target : [ `JavaScript | `Wasm ] -> unit
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index bb4ce4aaf2..ba7c18511e 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -23,6 +23,14 @@ let debug = Debug.find "main"
 
 let times = Debug.find "times"
 
+type optimized_result =
+  { program : Code.program
+  ; variable_uses : Deadcode.variable_uses
+  ; trampolined_calls : Effects.trampolined_calls
+  ; in_cps : Effects.in_cps
+  ; deadcode_sentinal : Code.Var.t
+  }
+
 type profile =
   | O1
   | O2
@@ -44,35 +52,35 @@ let deadcode p =
   let r, _ = deadcode' p in
   r
 
-let inline ~target p =
+let inline p =
   if Config.Flag.inline () && Config.Flag.deadcode ()
   then (
     let p, live_vars = deadcode' p in
     if debug () then Format.eprintf "Inlining...@.";
-    Inline.f ~target p live_vars)
+    Inline.f p live_vars)
   else p
 
 let specialize_1 (p, info) =
   if debug () then Format.eprintf "Specialize...@.";
   Specialize.f ~function_arity:(fun f -> Specialize.function_arity info f) p
 
-let specialize_js ~target (p, info) =
+let specialize_js (p, info) =
   if debug () then Format.eprintf "Specialize js...@.";
-  Specialize_js.f ~target info p
+  Specialize_js.f info p
 
 let specialize_js_once p =
   if debug () then Format.eprintf "Specialize js once...@.";
   Specialize_js.f_once p
 
-let specialize' ~target (p, info) =
+let specialize' (p, info) =
   let p = specialize_1 (p, info) in
-  let p = specialize_js ~target (p, info) in
+  let p = specialize_js (p, info) in
   p, info
 
-let specialize ~target p = fst (specialize' ~target p)
+let specialize p = fst (specialize' p)
 
-let eval ~target (p, info) =
-  if Config.Flag.staticeval () then Eval.f ~target info p else p
+let eval (p, info) =
+  if Config.Flag.staticeval () then Eval.f info p else p
 
 let flow p =
   if debug () then Format.eprintf "Data flow...@.";
@@ -128,53 +136,53 @@ let identity x = x
 
 (* o1 *)
 
-let o1 ~target : 'a -> 'a =
+let o1 : 'a -> 'a =
   print
   +> tailcall
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
-  +> specialize' ~target
-  +> eval ~target
-  +> inline ~target (* inlining may reveal new tailcall opt *)
+  +> specialize'
+  +> eval
+  +> inline (* inlining may reveal new tailcall opt *)
   +> deadcode
   +> tailcall
   +> phi
   +> flow
-  +> specialize' ~target
-  +> eval ~target
-  +> inline ~target
+  +> specialize'
+  +> eval
+  +> inline
   +> deadcode
   +> print
   +> flow
-  +> specialize' ~target
-  +> eval ~target
-  +> inline ~target
+  +> specialize'
+  +> eval
+  +> inline
   +> deadcode
   +> phi
   +> flow
-  +> specialize ~target
+  +> specialize
   +> identity
 
 (* o2 *)
 
-let o2 ~target : 'a -> 'a = loop 10 "o1" (o1 ~target) 1 +> print
+let o2 : 'a -> 'a = loop 10 "o1" o1 1 +> print
 
 (* o3 *)
 
-let round1 ~target : 'a -> 'a =
+let round1 : 'a -> 'a =
   print
   +> tailcall
-  +> inline ~target (* inlining may reveal new tailcall opt *)
+  +> inline (* inlining may reveal new tailcall opt *)
   +> deadcode (* deadcode required before flow simple -> provided by constant *)
   +> flow_simple (* flow simple to keep information for future tailcall opt *)
-  +> specialize' ~target
-  +> eval ~target
+  +> specialize'
+  +> eval
   +> identity
 
-let round2 ~target = flow +> specialize' ~target +> eval ~target +> deadcode +> o1 ~target
+let round2 = flow +> specialize' +> eval +> deadcode +> o1
 
-let o3 ~target =
-  loop 10 "tailcall+inline" (round1 ~target) 1
-  +> loop 10 "flow" (round2 ~target) 1
+let o3 =
+  loop 10 "tailcall+inline" round1 1
+  +> loop 10 "flow" round2 1
   +> print
 
 let generate
@@ -182,13 +190,13 @@ let generate
     ~exported_runtime
     ~wrap_with_fun
     ~warn_on_unhandled_effect
-    ((p, live_vars), trampolined_calls, _) =
+    { program; variable_uses; trampolined_calls; deadcode_sentinal = _; in_cps = _ } =
   if times () then Format.eprintf "Start Generation...@.";
   let should_export = should_export wrap_with_fun in
   Generate.f
-    p
+    program
     ~exported_runtime
-    ~live_vars
+    ~live_vars:variable_uses
     ~trampolined_calls
     ~should_export
     ~warn_on_unhandled_effect
@@ -642,18 +650,7 @@ let configure formatter =
   Code.Var.set_pretty (pretty && not (Config.Flag.shortvar ()));
   Code.Var.set_stable (Config.Flag.stable_var ())
 
-type 'a target =
-  | JavaScript : Pretty_print.t -> Source_map.t option target
-  | Wasm
-      : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
-        target
-
-let target_flag (type a) (t : a target) =
-  match t with
-  | JavaScript _ -> `JavaScript
-  | Wasm -> `Wasm
-
-let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ~link p =
+let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p =
   let export_runtime =
     match link with
     | `All | `All_from _ -> true
@@ -665,73 +662,57 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ~link p =
   |> coloring
   |> check_js
 
-let full
-    (type result)
-    ~(target : result target)
-    ~standalone
-    ~wrap_with_fun
-    ~profile
-    ~link
-    ~source_map
-    d
-    p : result =
+let optimize ~profile p =
+  let deadcode_sentinal =
+    (* If deadcode is disabled, this field is just fresh variable *)
+    Code.Var.fresh_n "dummy"
+  in
   let opt =
     specialize_js_once
     +> (match profile with
        | O1 -> o1
        | O2 -> o2
        | O3 -> o3)
-         ~target:(target_flag target)
     +> exact_calls profile
     +> effects
     +> map_fst
-         ((match target with
-          | JavaScript _ -> Generate_closure.f
-          | Wasm -> Fun.id)
-         +> deadcode')
+         (match Config.target (), Config.Flag.effects () with
+         | `JavaScript, false -> Generate_closure.f
+         | `JavaScript, true | `Wasm, _ -> Fun.id)
+    +> map_fst deadcode'
   in
   if times () then Format.eprintf "Start Optimizing...@.";
   let t = Timer.make () in
-  let r = opt p in
+  let (program, variable_uses), trampolined_calls, in_cps = opt p in
   let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
-  match target with
-  | JavaScript formatter ->
-      let exported_runtime = not standalone in
-      let emit formatter =
-        generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
-        +> link_and_pack ~standalone ~wrap_with_fun ~link
-        +> output formatter ~source_map ()
-      in
-      let source_map = emit formatter r in
-      source_map
-  | Wasm ->
-      let (p, live_vars), _, in_cps = r in
-      live_vars, in_cps, p, d
+  { program; variable_uses; trampolined_calls; in_cps; deadcode_sentinal }
+
+let full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p =
+  let optimized_code = optimize ~profile p in
+  let exported_runtime = not standalone in
+  let emit formatter =
+    generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
+    +> link_and_pack ~standalone ~wrap_with_fun ~link
+    +> output formatter ~source_map ()
+  in
+  emit formatter optimized_code
 
 let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p =
   let (_ : Source_map.t option) =
-    full
-      ~target:(JavaScript formatter)
-      ~standalone
-      ~wrap_with_fun
-      ~profile
-      ~link
-      ~source_map:None
-      d
-      p
+    full ~standalone ~wrap_with_fun ~profile ~link ~source_map:None ~formatter d p
   in
   ()
 
 let f
-    ~target
     ?(standalone = true)
     ?(wrap_with_fun = `Iife)
     ?(profile = O1)
     ~link
     ?source_map
+    ~formatter
     d
     p =
-  full ~target ~standalone ~wrap_with_fun ~profile ~link ~source_map d p
+  full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p
 
 let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link formatter d p =
   full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 8e8d0c97e4..91f846b989 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -20,22 +20,26 @@
 
 type profile
 
-type 'a target =
-  | JavaScript : Pretty_print.t -> Source_map.t option target
-  | Wasm
-      : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
-        target
+type optimized_result =
+  { program : Code.program
+  ; variable_uses : Deadcode.variable_uses
+  ; trampolined_calls : Effects.trampolined_calls
+  ; in_cps : Effects.in_cps
+  ; deadcode_sentinal : Code.Var.t
+  }
+
+val optimize : profile:profile -> Code.program -> optimized_result
 
 val f :
-     target:'result target
-  -> ?standalone:bool
+     ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
   -> ?profile:profile
   -> link:[ `All | `All_from of string list | `Needed | `No ]
   -> ?source_map:Source_map.t
+  -> formatter:Pretty_print.t
   -> Parse_bytecode.Debug.t
   -> Code.program
-  -> 'result
+  -> Source_map.t option
 
 val f' :
      ?standalone:bool
@@ -57,7 +61,7 @@ val from_string :
 val link_and_pack :
      ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
-  -> link:[ `All | `All_from of string list | `Needed | `No ]
+  -> ?link:[ `All | `All_from of string list | `Needed | `No ]
   -> Javascript.statement_list
   -> Javascript.statement_list
 
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 5faec48bfb..a5f78a38e5 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -29,17 +29,73 @@ let set_static_env s value = Hashtbl.add static_env s value
 
 let get_static_env s = try Some (Hashtbl.find static_env s) with Not_found -> None
 
-module Int = Int32
+module type Int = sig
+  include Arith_ops
 
-let int_binop l w f =
-  match l with
-  | [ Int i; Int j ] -> Some (Int (w (f i j)))
-  | _ -> None
+  val int_unop : constant list -> (t -> t) -> constant option
 
-let shift l w t f =
-  match l with
-  | [ Int i; Int j ] -> Some (Int (w (f (t i) (Int32.to_int j land 0x1f))))
-  | _ -> None
+  val int_binop : constant list -> (t -> t -> t) -> constant option
+
+  val shift_op : constant list -> (t -> int -> t) -> constant option
+
+  val of_int32_warning_on_overflow : int32 -> t
+
+  val to_int32 : t -> int32
+
+  val numbits : int
+end
+
+module Int32 = struct
+  include Int32
+
+  let int_unop l f =
+    match l with
+    | [ Int i ] -> Some (Int (f i))
+    | _ -> None
+
+  let int_binop l f =
+    match l with
+    | [ Int i; Int j ] -> Some (Int (f i j))
+    | _ -> None
+
+  (* For when the underlying function takes an [int] (not [t]) as its second argument *)
+  let shift_op l f =
+    match l with
+    | [ Int i; Int j ] -> Some (Int (f i (to_int j)))
+    | _ -> None
+
+  let numbits = 32
+
+  let of_int32_warning_on_overflow = Fun.id
+
+  let to_int32 = Fun.id
+end
+
+module Int31 : Int = struct
+  include Int31
+
+  let int_unop l f =
+    match l with
+    | [ Int i ] -> Some (Int (to_int32 (f (of_int32_warning_on_overflow i))))
+    | _ -> None
+
+  let int_binop l f =
+    match l with
+    | [ Int i; Int j ] ->
+        Some
+          (Int
+             (to_int32
+                (f (of_int32_warning_on_overflow i) (of_int32_warning_on_overflow j))))
+    | _ -> None
+
+  let shift_op l f =
+    match l with
+    | [ Int i; Int j ] ->
+        Some (Int (to_int32 (f (of_int32_warning_on_overflow i) (Int32.to_int j))))
+    | _ -> None
+
+  let numbits = 31
+end
 
 let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option =
   let args =
@@ -83,34 +139,27 @@ let eval_prim ~target x =
   | Neq, [ Int i; Int j ] -> bool Int32.(i <> j)
   | Ult, [ Int i; Int j ] -> bool (Int32.(j < 0l) || Int32.(i < j))
   | Extern name, l -> (
-      let name = Primitive.resolve name in
-      let wrap =
+      let (module Int : Int) =
         match target with
-        | `JavaScript -> fun i -> i
-        | `Wasm -> Int31.wrap
+        | `JavaScript -> (module Int32)
+        | `Wasm -> (module Int31)
       in
+      let name = Primitive.resolve name in
       match name, l with
       (* int *)
-      | "%int_add", _ -> int_binop l wrap Int.add
-      | "%int_sub", _ -> int_binop l wrap Int.sub
-      | "%direct_int_mul", _ -> int_binop l wrap Int.mul
+      | "%int_add", _ -> Int.int_binop l Int.add
+      | "%int_sub", _ -> Int.int_binop l Int.sub
+      | "%direct_int_mul", _ -> Int.int_binop l Int.mul
       | "%direct_int_div", [ _; Int 0l ] -> None
-      | "%direct_int_div", _ -> int_binop l wrap Int.div
-      | "%direct_int_mod", _ -> int_binop l wrap Int.rem
-      | "%int_and", _ -> int_binop l wrap Int.logand
-      | "%int_or", _ -> int_binop l wrap Int.logor
-      | "%int_xor", _ -> int_binop l wrap Int.logxor
-      | "%int_lsl", _ -> shift l wrap Fun.id Int.shift_left
-      | "%int_lsr", _ ->
-          shift
-            l
-            wrap
-            (match target with
-            | `JavaScript -> Fun.id
-            | `Wasm -> fun i -> Int.logand i 0x7fffffffl)
-            Int.shift_right_logical
-      | "%int_asr", _ -> shift l wrap Fun.id Int.shift_right
-      | "%int_neg", [ Int i ] -> Some (Int (Int.neg i))
+      | "%direct_int_div", _ -> Int.int_binop l Int.div
+      | "%direct_int_mod", _ -> Int.int_binop l Int.rem
+      | "%int_and", _ -> Int.int_binop l Int.logand
+      | "%int_or", _ -> Int.int_binop l Int.logor
+      | "%int_xor", _ -> Int.int_binop l Int.logxor
+      | "%int_lsl", _ -> Int.shift_op l Int.shift_left
+      | "%int_lsr", _ -> Int.shift_op l Int.shift_right_logical
+      | "%int_asr", _ -> Int.shift_op l Int.shift_right
+      | "%int_neg", _ -> Int.int_unop l Int.neg
       (* float *)
       | "caml_eq_float", _ -> float_binop_bool l Float.( = )
       | "caml_neq_float", _ -> float_binop_bool l Float.( <> )
@@ -123,9 +172,9 @@ let eval_prim ~target x =
       | "caml_mul_float", _ -> float_binop l ( *. )
       | "caml_div_float", _ -> float_binop l ( /. )
       | "caml_fmod_float", _ -> float_binop l mod_float
-      | "caml_int_of_float", [ Float f ] -> Some (Int (Int.of_float f))
-      | "to_int", [ Float f ] -> Some (Int (Int.of_float f))
-      | "to_int", [ Int i ] -> Some (Int i)
+      | "caml_int_of_float", [ Float f ] ->
+          Some
+            (Int (Int32.of_float f |> Int.of_int32_warning_on_overflow |> Int.to_int32))
       (* Math *)
       | "caml_neg_float", _ -> float_unop l ( ~-. )
       | "caml_abs_float", _ -> float_unop l abs_float
@@ -155,12 +204,7 @@ let eval_prim ~target x =
           | Some env -> Some (String env)
           | None -> None)
       | "caml_sys_const_word_size", [ _ ] -> Some (Int 32l)
-      | "caml_sys_const_int_size", [ _ ] ->
-          Some
-            (Int
-               (match target with
-               | `JavaScript -> 32l
-               | `Wasm -> 31l))
+      | "caml_sys_const_int_size", [ _ ] -> Some (Int (Int32.of_int Int.numbits))
       | "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
       | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
       | _ -> None)
@@ -187,7 +231,7 @@ type is_int =
   | N
   | Unknown
 
-let is_int ~target info x =
+let is_int info x =
   match x with
   | Pv x ->
       get_approx
@@ -195,11 +239,10 @@ let is_int ~target info x =
         (fun x ->
           match info.info_defs.(Var.idx x) with
           | Expr (Constant (Int _)) -> Y
-          | Expr (Constant (Int32 _ | NativeInt _)) -> (
-              match target with
-              | `JavaScript -> Y
-              | `Wasm -> N)
-          | Expr (Block (_, _, _, _)) | Expr (Constant _) -> N
+          | Expr (Constant (NativeInt _ | Int32 _)) ->
+              (* These Wasm-specific constants are boxed *)
+              N
+          | Expr (Block (_, _, _, _) | Constant _) -> N
           | _ -> Unknown)
         Unknown
         (fun u v ->
@@ -209,10 +252,9 @@ let is_int ~target info x =
           | _ -> Unknown)
         x
   | Pc (Int _) -> Y
-  | Pc (Int32 _ | NativeInt _) -> (
-      match target with
-      | `JavaScript -> Y
-      | `Wasm -> N)
+  | Pc (NativeInt _ | Int32 _) ->
+      (* These Wasm-specific constants are boxed *)
+      N
   | Pc _ -> N
 
 let the_tag_of info x get =
@@ -336,7 +378,7 @@ let eval_instr ~target info ((x, loc) as i) =
            below fail. *)
       [ i ]
   | Let (x, Prim (IsInt, [ y ])) -> (
-      match is_int ~target info y with
+      match is_int info y with
       | Unknown -> [ i ]
       | (Y | N) as b ->
           let c = Constant (bool' Poly.(b = Y)) in
@@ -351,14 +393,12 @@ let eval_instr ~target info ((x, loc) as i) =
       | None -> [ i ])
   | Let (x, Prim (Extern "caml_sys_const_backend_type", [ _ ])) ->
       let jsoo = Code.Var.fresh () in
-      [ ( Let
-            ( jsoo
-            , Constant
-                (String
-                   (match target with
-                   | `JavaScript -> "js_of_ocaml"
-                   | `Wasm -> "wasm_of_ocaml")) )
-        , noloc )
+      let backend_name =
+        match target with
+        | `JavaScript -> "js_of_ocaml"
+        | `Wasm -> "wasm_of_ocaml"
+      in
+      [ Let (jsoo, Constant (String backend_name)), noloc
       ; Let (x, Block (0, [| jsoo |], NotArray, Immutable)), loc
       ]
   | Let (_, Prim (Extern ("%resume" | "%perform" | "%reperform"), _)) ->
@@ -388,10 +428,15 @@ let eval_instr ~target info ((x, loc) as i) =
                 ( x
                 , Prim
                     ( prim
-                    , List.map2 prim_args prim_args' ~f:(fun arg c ->
-                          match (c : constant option), target with
-                          | Some ((Int _ | NativeString _) as c), _ -> Pc c
-                          | Some (Float _ as c), `JavaScript -> Pc c
+                    , List.map2 prim_args prim_args' ~f:(fun arg (c : constant option) ->
+                          match c, target with
+                          | Some (Int _ as c), _ -> Pc c
+                          | Some (Int32 _ | NativeInt _ | NativeString _), `Wasm ->
+                              (* Avoid duplicating the constant here as it would cause an
+                                 allocation *)
+                              arg
+                          | Some (Int32 _ | NativeInt _), `JavaScript -> assert false
+                          | Some ((Float _ | NativeString _) as c), `JavaScript -> Pc c
                           | Some (String _ as c), `JavaScript
                             when Config.Flag.use_js_string () -> Pc c
                           | Some _, _
@@ -527,7 +572,7 @@ let eval ~target info blocks =
       { block with Code.body; Code.branch })
     blocks
 
-let f ~target info p =
-  let blocks = eval ~target info p.blocks in
+let f info p =
+  let blocks = eval ~target:(Config.target ()) info p.blocks in
   let blocks = drop_exception_handler blocks in
   { p with blocks }
diff --git a/compiler/lib/eval.mli b/compiler/lib/eval.mli
index 30a36b08f6..a71f611ca1 100644
--- a/compiler/lib/eval.mli
+++ b/compiler/lib/eval.mli
@@ -21,4 +21,4 @@ val clear_static_env : unit -> unit
 
 val set_static_env : string -> string -> unit
 
-val f : target:[ `JavaScript | `Wasm ] -> Flow.info -> Code.program -> Code.program
+val f : Flow.info -> Code.program -> Code.program
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index c37a9a30b5..c32428f2bc 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -331,23 +331,26 @@ let constant_identical ~(target : [ `JavaScript | `Wasm ]) a b =
   | Float a, Float b, `JavaScript -> Float.bitwise_equal a b
   | Float _, Float _, `Wasm -> false
   | NativeString a, NativeString b, `JavaScript -> Native_string.equal a b
+  | NativeString _, NativeString _, `Wasm ->
+      false
+      (* Native strings are boxed (JavaScript objects) in Wasm and are
+          possibly different objects *)
   | String a, String b, `JavaScript -> Config.Flag.use_js_string () && String.equal a b
-  | Int _, Float _, _ | Float _, Int _, _ -> false
+  | String _, String _, `Wasm ->
+      false (* Strings are boxed in Wasm and are possibly different objects *)
+  | Int32 _, Int32 _, `Wasm ->
+      false (* [Int32]s are boxed in Wasm and are possibly different objects *)
+  | Int32 _, Int32 _, `JavaScript -> assert false
+  | NativeInt _, NativeInt _, `Wasm ->
+      false (* [NativeInt]s are boxed in Wasm and are possibly different objects *)
+  | NativeInt _, NativeInt _, `JavaScript -> assert false
   (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
-  | String _, _, _
-  | _, String _, _
-  | NativeString _, _, _
-  | _, NativeString _, _
-  | Float_array _, _, _
-  | _, Float_array _, _
-  | Int64 _, _, _
-  | _, Int64 _, _
-  | Int32 _, _, _
-  | _, Int32 _, _
-  | NativeInt _, _, _
-  | _, NativeInt _, _
-  | Tuple _, _, _
-  | _, Tuple _, _ -> false
+  | Int64 _, Int64 _, _ -> false
+  | Tuple _, Tuple _, _ -> false
+  | Float_array _, Float_array _, _ -> false
+  | (Int _ | Float _ | Int64 _ | Int32 _ | NativeInt _), _, _ -> false
+  | (String _ | NativeString _), _, _ -> false
+  | (Float_array _ | Tuple _), _, _ -> false
 
 let the_const_of ~target info x =
   match x with
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
index 16b9ae5353..a87ca60225 100644
--- a/compiler/lib/inline.ml
+++ b/compiler/lib/inline.ml
@@ -264,9 +264,9 @@ let inline ~first_class_primitives live_vars closures pc (outer, blocks, free_pc
 
 let times = Debug.find "times"
 
-let f ~target p live_vars =
+let f p live_vars =
   let first_class_primitives =
-    match target with
+    match Config.target () with
     | `JavaScript -> not (Config.Flag.effects ())
     | `Wasm -> false
   in
diff --git a/compiler/lib/inline.mli b/compiler/lib/inline.mli
index 2bc18bc4f2..9799e882a2 100644
--- a/compiler/lib/inline.mli
+++ b/compiler/lib/inline.mli
@@ -18,5 +18,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f :
-  target:[ `JavaScript | `Wasm ] -> Code.program -> Deadcode.variable_uses -> Code.program
+val f : Code.program -> Deadcode.variable_uses -> Code.program
diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
index 9b2cf1d9ae..b2057d431f 100644
--- a/compiler/lib/ocaml_compiler.ml
+++ b/compiler/lib/ocaml_compiler.ml
@@ -18,27 +18,28 @@
 
 open! Stdlib
 
-let rec constant_of_const ~target c : Code.constant =
+let rec constant_of_const c : Code.constant =
   let open Lambda in
   let open Asttypes in
   match c with
   | Const_base (Const_int i) ->
       Int
-        (match target with
+        (match Config.target () with
         | `JavaScript -> Int32.of_int_warning_on_overflow i
-        | `Wasm -> Int31.of_int_warning_on_overflow i)
+        | `Wasm -> Int31.(of_int_warning_on_overflow i |> to_int32))
   | Const_base (Const_char c) -> Int (Int32.of_int (Char.code c))
   | ((Const_base (Const_string (s, _))) [@if ocaml_version < (4, 11, 0)])
   | ((Const_base (Const_string (s, _, _))) [@if ocaml_version >= (4, 11, 0)]) -> String s
   | Const_base (Const_float s) -> Float (float_of_string s)
   | Const_base (Const_int32 i) -> (
-      match target with
+      match Config.target () with
       | `JavaScript -> Int i
       | `Wasm -> Int32 i)
   | Const_base (Const_int64 i) -> Int64 i
   | Const_base (Const_nativeint i) -> (
-      match target with
-      | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
+      let i = Int32.of_nativeint_warning_on_overflow i in
+      match Config.target () with
+      | `JavaScript -> Int i
       | `Wasm -> NativeInt i)
   | Const_immstring s -> String s
   | Const_float_array sl ->
@@ -46,11 +47,11 @@ let rec constant_of_const ~target c : Code.constant =
       Float_array (Array.of_list l)
   | ((Const_pointer i) [@if ocaml_version < (4, 12, 0)]) ->
       Int
-        (match target with
+        (match Config.target () with
         | `JavaScript -> Int32.of_int_warning_on_overflow i
-        | `Wasm -> Int31.of_int_warning_on_overflow i)
+        | `Wasm -> Int31.(of_int_warning_on_overflow i |> to_int32))
   | Const_block (tag, l) ->
-      let l = Array.of_list (List.map l ~f:(fun c -> constant_of_const ~target c)) in
+      let l = Array.of_list (List.map l ~f:(fun c -> constant_of_const c)) in
       Tuple (tag, l, Unknown)
 
 let rec find_loc_in_summary ident' = function
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 155c3cf3be..02a7053dfa 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -467,13 +467,14 @@ end = struct
         match ident_of_custom x with
         | Some name when same_ident name ident_32 -> (
             let i : int32 = Obj.magic x in
-            match target with
+            match Config.target () with
             | `JavaScript -> Int i
             | `Wasm -> Int32 i)
         | Some name when same_ident name ident_native -> (
             let i : nativeint = Obj.magic x in
-            match target with
-            | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i)
+            let i = Int32.of_nativeint_warning_on_overflow i in
+            match Config.target () with
+            | `JavaScript -> Int i
             | `Wasm -> NativeInt i)
         | Some name when same_ident name ident_64 -> Int64 (Obj.magic x : int64)
         | Some name ->
@@ -492,9 +493,9 @@ end = struct
     else
       let i : int = Obj.magic x in
       Int
-        (match target with
+        (match Config.target () with
         | `JavaScript -> Int32.of_int_warning_on_overflow i
-        | `Wasm -> Int31.of_int_warning_on_overflow i)
+        | `Wasm -> Int31.(of_int_warning_on_overflow i |> to_int32))
 
   let inlined = function
     | String _ | NativeString _ -> false
@@ -745,76 +746,88 @@ let access_global g i =
       g.vars.(i) <- Some x;
       x
 
-let register_global ~target ?(force = false) g i loc rem =
-  if g.is_exported.(i)
-     &&
-     match target with
-     | `Wasm -> true
-     | `JavaScript -> false
-  then (
-    let name =
-      match g.named_value.(i) with
-      | None -> assert false
-      | Some name -> name
-    in
-    Code.Var.name (access_global g i) name;
-    ( Let
-        ( Var.fresh ()
-        , Prim (Extern "caml_set_global", [ Pc (String name); Pv (access_global g i) ]) )
-    , loc )
-    :: rem)
-  else if force || g.is_exported.(i)
-  then
-    let args =
-      match g.named_value.(i) with
-      | None -> []
-      | Some name ->
-          Code.Var.name (access_global g i) name;
-          [ Pc (NativeString (Native_string.of_string name)) ]
-    in
-    ( Let
-        ( Var.fresh ()
-        , Prim
-            ( Extern "caml_register_global"
-            , Pc (Int (Int32.of_int i)) :: Pv (access_global g i) :: args ) )
-    , loc )
-    :: rem
-  else rem
+let register_global ?(force = false) g i loc rem =
+  match g.is_exported.(i), force, Config.target () with
+  | true, _, `Wasm ->
+      (* Register a compilation unit (Wasm) *)
+      assert (not force);
+      let name =
+        match g.named_value.(i) with
+        | None -> assert false
+        | Some name -> name
+      in
+      Code.Var.name (access_global g i) name;
+      ( Let
+          ( Var.fresh ()
+          , Prim (Extern "caml_set_global", [ Pc (String name); Pv (access_global g i) ])
+          )
+      , loc )
+      :: rem
+  | true, _, (`JavaScript as target) | false, true, ((`Wasm | `JavaScript) as target) ->
+      (* Register an exception (if force = true), or a compilation unit
+         (Javascript) *)
+      let args =
+        match g.named_value.(i) with
+        | None -> []
+        | Some name ->
+            Code.Var.name (access_global g i) name;
+            [ Pc
+                (match target with
+                | `JavaScript -> NativeString (Native_string.of_string name)
+                | `Wasm -> String name)
+            ]
+      in
+      ( Let
+          ( Var.fresh ()
+          , Prim
+              ( Extern "caml_register_global"
+              , Pc (Int (Int32.of_int i)) :: Pv (access_global g i) :: args ) )
+      , loc )
+      :: rem
+  | false, false, (`JavaScript | `Wasm) -> rem
 
 let get_global ~target state instrs i loc =
   State.size_globals state (i + 1);
   let g = State.globals state in
   match g.vars.(i) with
   | Some x ->
+      (* Registered global *)
       if debug_parser () then Format.printf "(global access %a)@." Var.print x;
       x, State.set_accu state x loc, instrs
   | None -> (
       if i < Array.length g.constants && Constants.inlined g.constants.(i)
       then
+        (* Inlined constant *)
         let x, state = State.fresh_var state loc in
         let cst = g.constants.(i) in
         x, state, (Let (x, Constant cst), loc) :: instrs
-      else if i < Array.length g.constants
-              ||
-              match target with
-              | `Wasm -> false
-              | `JavaScript -> true
-      then (
-        g.is_const.(i) <- true;
-        let x, state = State.fresh_var state loc in
-        if debug_parser () then Format.printf "%a = CONST(%d)@." Var.print x i;
-        g.vars.(i) <- Some x;
-        x, state, instrs)
       else
-        match g.named_value.(i) with
-        | None -> assert false
-        | Some name ->
+        match i < Array.length g.constants, Config.target () with
+        | true, _ | false, `JavaScript ->
+            (* Non-inlined constant, and reference to another compilation
+               units in case of separate compilation (JavaScript).
+               Some code is generated in a prelude to store the relevant
+               module in variable [x]. *)
+            g.is_const.(i) <- true;
             let x, state = State.fresh_var state loc in
-            if debug_parser () then Format.printf "%a = get_global(%s)@." Var.print x name;
-            ( x
-            , state
-            , (Let (x, Prim (Extern "caml_get_global", [ Pc (String name) ])), loc)
-              :: instrs ))
+            if debug_parser () then Format.printf "%a = CONST(%d)@." Var.print x i;
+            g.vars.(i) <- Some x;
+            x, state, instrs
+        | false, `Wasm -> (
+            (* Reference to another compilation units in case of separate
+               compilation (Wasm).
+               The toplevel module is available in an imported global
+               variables. *)
+            match g.named_value.(i) with
+            | None -> assert false
+            | Some name ->
+                let x, state = State.fresh_var state loc in
+                if debug_parser ()
+                then Format.printf "%a = get_global(%s)@." Var.print x name;
+                ( x
+                , state
+                , (Let (x, Prim (Extern "caml_get_global", [ Pc (String name) ])), loc)
+                  :: instrs )))
 
 let tagged_blocks = ref Addr.Set.empty
 
@@ -3079,50 +3092,49 @@ let from_channel ic =
           `Exe
       | _ -> raise Magic_number.(Bad_magic_number (to_string magic)))
 
-let predefined_exceptions ~target =
+let predefined_exceptions () =
+  (* Register predefined exceptions in case of separate compilation *)
   let body =
     let open Code in
     List.map predefined_exceptions ~f:(fun (index, name) ->
         assert (String.is_valid_utf_8 name);
         let exn = Var.fresh () in
         let v_name = Var.fresh () in
-        let v_name_js = Var.fresh () in
         let v_index = Var.fresh () in
-        [ Let (v_name, Constant (String name)), noloc ]
-        @ (match target with
-          | `Wasm -> []
-          | `JavaScript ->
-              [ ( Let (v_name_js, Constant (NativeString (Native_string.of_string name)))
-                , noloc )
-              ])
-        @ [ ( Let
-                ( v_index
-                , Constant
-                    (Int
-                       ((* Predefined exceptions are registered in
-                           Symtable.init with [-index - 1] *)
-                        Int32.of_int
-                          (-index - 1))) )
-            , noloc )
-          ; Let (exn, Block (248, [| v_name; v_index |], NotArray, Immutable)), noloc
-          ; ( Let
-                ( Var.fresh ()
-                , Prim
-                    ( Extern "caml_register_global"
-                    , [ Pc (Int (Int32.of_int index))
-                      ; Pv exn
-                      ; Pv
-                          (match target with
-                          | `JavaScript -> v_name_js
-                          | `Wasm -> v_name)
-                      ] ) )
-            , noloc )
-          ]
+        [ Let (v_name, Constant (String name)), noloc
+        ; ( Let
+              ( v_index
+              , Constant
+                  (Int
+                     ((* Predefined exceptions are registered in
+                         Symtable.init with [-index - 1] *)
+                      Int32.of_int
+                        (-index - 1))) )
+          , noloc )
+        ; Let (exn, Block (248, [| v_name; v_index |], NotArray, Immutable)), noloc
+        ]
         @
-        match target with
-        | `JavaScript -> []
+        match Config.target () with
+        | `JavaScript ->
+            let v_name_js = Var.fresh () in
+            [ ( Let (v_name_js, Constant (NativeString (Native_string.of_string name)))
+              , noloc )
+            ; ( Let
+                  ( Var.fresh ()
+                  , Prim
+                      ( Extern "caml_register_global"
+                      , [ Pc (Int (Int32.of_int index)); Pv exn; Pv v_name_js ] ) )
+              , noloc )
+            ]
         | `Wasm ->
             [ ( Let
+                  ( Var.fresh ()
+                  , Prim
+                      ( Extern "caml_register_global"
+                      , [ Pc (Int (Int32.of_int index)); Pv exn; Pv v_name ] ) )
+              , noloc )
+              (* Also make the exception available to the generated code *)
+            ; ( Let
                   ( Var.fresh ()
                   , Prim (Extern "caml_set_global", [ Pc (String name); Pv exn ]) )
               , noloc )
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 39f0209029..ff5b89beb2 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -25,6 +25,9 @@ open Flow
 let specialize_instr ~target info i =
   match i, target with
   | Let (x, Prim (Extern "caml_format_int", [ y; z ])), `JavaScript -> (
+      (* We can implement the special case where the format string is "%s" in JavaScript
+         in a concise and efficient way with [""+x]. It does not make as much sense in
+         Wasm to have a special case for this. *)
       match the_string_of ~target info y with
       | Some "%d" -> (
           match the_int ~target info z with
@@ -41,13 +44,11 @@ let specialize_instr ~target info i =
         , Prim
             ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim)
             , [ (Pv _ as y) ] ) )
-    , _ )
-    when Config.Flag.safe_string () -> (
+    , target ) -> (
       match the_string_of ~target info y with
       | Some s -> Let (x, Prim (Extern prim, [ Pc (String s) ]))
       | _ -> i)
-  | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ y; z ])), `JavaScript
-    -> (
+  | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ y; z ])), _ -> (
       match the_string_of ~target info y with
       | Some s when Primitive.need_named_value s ->
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
@@ -134,6 +135,9 @@ let specialize_instr ~target info i =
       | Some s -> Let (x, Constant (NativeString (Native_string.of_bytestring s)))
       | None -> i)
   | Let (x, Prim (Extern "%int_mul", [ y; z ])), `JavaScript -> (
+      (* Using * to multiply integers in JavaScript yields a float; and if the
+         float is large enough, some bits can be lost. So, in the general case,
+         we have to use Math.imul. There is no such issue in Wasm. *)
       match the_int ~target info y, the_int ~target info z with
       | Some j, _ when Int32.(abs j < 0x200000l) ->
           Let (x, Prim (Extern "%direct_int_mul", [ y; z ]))
@@ -262,7 +266,7 @@ let specialize_all_instrs ~target info p =
 
 (****)
 
-let f ~target info p = specialize_all_instrs ~target info p
+let f info p = specialize_all_instrs ~target:(Config.target ()) info p
 
 let f_once p =
   let rec loop acc l =
diff --git a/compiler/lib/specialize_js.mli b/compiler/lib/specialize_js.mli
index 4bf26256a8..3ed1f1a6c5 100644
--- a/compiler/lib/specialize_js.mli
+++ b/compiler/lib/specialize_js.mli
@@ -18,6 +18,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : target:[ `JavaScript | `Wasm ] -> Flow.info -> Code.program -> Code.program
+val f : Flow.info -> Code.program -> Code.program
 
 val f_once : Code.program -> Code.program
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index d5c7122c4d..86d6e56bf1 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -341,7 +341,49 @@ module Int32 = struct
       n
 end
 
-module Int31 = struct
+module type Arith_ops = sig
+  type t
+
+  val neg : t -> t
+
+  val add : t -> t -> t
+
+  val sub : t -> t -> t
+
+  val mul : t -> t -> t
+
+  val div : t -> t -> t
+
+  val rem : t -> t -> t
+
+  val logand : t -> t -> t
+
+  val logor : t -> t -> t
+
+  val logxor : t -> t -> t
+
+  val shift_left : t -> int -> t
+
+  val shift_right : t -> int -> t
+
+  val shift_right_logical : t -> int -> t
+end
+
+module Int31 : sig
+  type t
+
+  include Arith_ops with type t := t
+
+  val of_int_warning_on_overflow : int -> t
+
+  val of_nativeint_warning_on_overflow : nativeint -> t
+
+  val of_int32_warning_on_overflow : int32 -> t
+
+  val to_int32 : t -> int32
+end = struct
+  type t = int32
+
   let wrap i = Int32.(shift_right (shift_left i 1) 1)
 
   let of_int_warning_on_overflow i =
@@ -361,6 +403,54 @@ module Int31 = struct
       ~to_dec:(Printf.sprintf "%nd")
       ~to_hex:(Printf.sprintf "%nx")
       n
+
+  let of_int32_warning_on_overflow n =
+    Int32.convert_warning_on_overflow
+      ~to_int32:(fun i -> wrap i)
+      ~of_int32:Fun.id
+      ~equal:Int32.equal
+      ~to_dec:(Printf.sprintf "%ld")
+      ~to_hex:(Printf.sprintf "%lx")
+      n
+
+  let two_pow n =
+    assert (0 <= n && n <= 31);
+    Int32.shift_left 1l n
+
+  let min_int = Int32.neg (two_pow 30)
+
+  let neg x = if Int32.equal x min_int then x else Int32.neg x
+
+  let int_binop f x y = wrap (f x y)
+
+  let add = int_binop Int32.add
+
+  let sub = int_binop Int32.sub
+
+  let mul = int_binop Int32.mul
+
+  let div = int_binop Int32.div
+
+  let rem = int_binop Int32.rem
+
+  let logand = int_binop Int32.logand
+
+  let logor = int_binop Int32.logor
+
+  let logxor = int_binop Int32.logxor
+
+  let shift_op f x y =
+    (* Limit the shift offset to [0, 31] *)
+    wrap (f x (y land 0x1f))
+
+  let shift_left = shift_op Int32.shift_left
+
+  let shift_right = shift_op Int32.shift_right
+
+  let shift_right_logical a b =
+    shift_op Int32.shift_right_logical (Int32.logand a 0x7fffffffl) b
+
+  let to_int32 (x : t) : int32 = x
 end
 
 module Option = struct
diff --git a/compiler/tests-num/dune b/compiler/tests-num/dune
index 1bd90f4076..056775229e 100644
--- a/compiler/tests-num/dune
+++ b/compiler/tests-num/dune
@@ -1,5 +1,6 @@
 (executable
  (name main)
+ (modules main test_nats test test_big_ints test_ratios test_nums test_io)
  (libraries num)
  (modes
   js
@@ -7,6 +8,15 @@
  (flags
   (:standard -linkall -w -3-7-33-35-37 -safe-string -no-strict-sequence)))
 
+(library
+ (name test_int31)
+ (modules test_int31)
+ (inline_tests)
+ (enabled_if %{lib-available:qcheck})
+ (preprocess
+  (pps ppx_expect))
+ (libraries js_of_ocaml-compiler qcheck))
+
 (rule
  (target main.referencejs)
  (enabled_if
diff --git a/compiler/tests-num/test_int31.ml b/compiler/tests-num/test_int31.ml
new file mode 100644
index 0000000000..2b4743dd0d
--- /dev/null
+++ b/compiler/tests-num/test_int31.ml
@@ -0,0 +1,194 @@
+open! Js_of_ocaml_compiler.Stdlib
+open QCheck2
+
+let () = Printexc.record_backtrace false
+
+let min_int31 = Int32.(neg (shift_left 1l 30))
+let max_int31 = Int32.(sub (shift_left 1l 30) 1l)
+
+let in_range i =
+  Int32.(min_int31 <= i && i <= max_int31)
+
+let in_range_i32 =
+  Gen.(Int32.of_int <$> int_range (- (1 lsl 30)) (1 lsl 30 - 1))
+
+let out_of_range_int =
+  let open Gen in
+  oneof [ int_range (- (1 lsl 31)) (- (1 lsl 30) - 1);
+          int_range (1 lsl 30) (1 lsl 31 - 1) ]
+
+let out_of_range_i32 =
+  out_of_range_int |> Gen.map Int32.of_int
+
+let t_corner =
+  let open Gen in
+  graft_corners in_range_i32 [min_int31; max_int31] ()
+  |> map Int31.of_int32_warning_on_overflow
+
+let print_t t =
+  Format.sprintf "%ld" (Int31.to_int32 t)
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.of_int32_warning_on_overflow: normal"
+    in_range_i32
+    (fun i ->
+      Int32.equal Int31.(to_int32 (of_int32_warning_on_overflow i)) i);
+  [%expect ""]
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.of_int_warning_on_overflow: normal"
+    (Gen.map Int32.to_int in_range_i32)
+    (fun i ->
+      Int.equal (Int31.(to_int32 (of_int_warning_on_overflow i)) |> Int32.to_int) i);
+  [%expect ""]
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.of_nativeint_warning_on_overflow: normal"
+    (Gen.map Nativeint.of_int32 in_range_i32)
+    (fun i ->
+      Nativeint.equal
+        (Int31.(to_int32 (of_nativeint_warning_on_overflow i)) |> Nativeint.of_int32)
+        i);
+  [%expect ""]
+
+let%expect_test _ =
+  let i = Gen.(generate1 (no_shrink out_of_range_i32)) in
+  let i_trunc = Int32.(shift_right (shift_left i 1) 1) in
+  ignore (Int31.of_int32_warning_on_overflow i);
+  let output = [%expect.output] in
+  let expected =
+    Format.sprintf "Warning: integer overflow: integer 0x%lx (%ld) truncated to 0x%lx (%ld); the generated code might be incorrect.@." i i i_trunc i_trunc
+  in
+  if not (String.equal output expected) then
+    Format.printf "Unexpected output string@.%s@.Expected:@.%s@." output expected;
+  [%expect ""]
+
+let%expect_test _ =
+  let i = Gen.(generate1 (no_shrink out_of_range_int)) in
+  let i_trunc = Int32.(shift_right (shift_left (of_int i) 1) 1) in
+  ignore (Int31.of_int_warning_on_overflow i);
+  let output = [%expect.output] in
+  let expected =
+    Format.sprintf "Warning: integer overflow: integer 0x%x (%d) truncated to 0x%lx (%ld); the generated code might be incorrect.@." i i i_trunc i_trunc
+  in
+  if not (String.equal output expected) then
+    Format.printf "Unexpected output string@.%s@.Expected:@.%s@." output expected;
+  [%expect ""]
+
+let%expect_test _ =
+  let i = Gen.(generate1 (no_shrink (Nativeint.of_int <$> out_of_range_int))) in
+  let i_trunc = Int32.(shift_right (shift_left (Nativeint.to_int32 i) 1) 1) in
+  ignore (Int31.of_nativeint_warning_on_overflow i);
+  let output = [%expect.output] in
+  let expected =
+    Format.sprintf "Warning: integer overflow: integer 0x%nx (%nd) truncated to 0x%lx (%ld); the generated code might be incorrect.@." i i i_trunc i_trunc
+  in
+  if not (String.equal output expected) then
+    Format.printf "Unexpected output string@.%s@.Expected:@.%s@." output expected;
+  [%expect ""]
+
+let modulus = Int32.(shift_left 1l 31)
+
+let canonicalize x =
+  if in_range x then x else Int32.(sub x modulus)
+
+let canon_equal x y =
+  Int32.(=) (canonicalize x) (canonicalize y)
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.neg"
+    t_corner
+    ~print:print_t
+    (fun i ->
+      let r_int31 = Int31.(neg i |> to_int32) in
+      let r_int32 = Int32.neg (Int31.to_int32 i) in
+      in_range r_int31 && canon_equal r_int31 r_int32);
+  [%expect ""]
+
+let binop_prop op_i31 op_i32 i j =
+  let r_int31 = op_i31 i j |> Int31.to_int32 in
+  let r_int32 = op_i32 (Int31.to_int32 i) (Int31.to_int32 j) in
+  in_range r_int31 && canon_equal r_int31 r_int32
+
+let binop_check ~count ~name op_i31 op_i32 =
+  Test.check_exn @@ Test.make ~count ~name
+    Gen.(tup2 t_corner t_corner)
+    ~print:(Print.tup2 print_t print_t)
+    (fun (i, j) -> binop_prop op_i31 op_i32 i j)
+
+let%expect_test _ =
+  binop_check ~count:1000 ~name:"Int31.add" Int31.add Int32.add;
+  [%expect ""]
+
+let%expect_test _ =
+  binop_check ~count:1000 ~name:"Int31.sub" Int31.sub Int32.sub;
+  [%expect ""]
+
+let%expect_test _ =
+  binop_check ~count:1000 ~name:"Int31.mul" Int31.mul Int32.mul;
+  [%expect ""]
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.div"
+    Gen.(tup2 t_corner t_corner)
+    ~print:(Print.tup2 print_t print_t)
+    (fun (i, j) ->
+      try binop_prop Int31.div Int32.div i j
+      with Division_by_zero -> Int32.equal (Int31.to_int32 j) 0l)
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.rem"
+    Gen.(tup2 t_corner t_corner)
+    ~print:(Print.tup2 print_t print_t)
+    (fun (i, j) ->
+      try binop_prop Int31.rem Int32.rem i j
+      with Division_by_zero -> Int32.equal (Int31.to_int32 j) 0l)
+
+let%expect_test _ =
+  binop_check ~count:1000 ~name:"Int31.logand" Int31.logand Int32.logand;
+  [%expect ""]
+
+let%expect_test _ =
+  binop_check ~count:1000 ~name:"Int31.logor" Int31.logor Int32.logor;
+  [%expect ""]
+
+let%expect_test _ =
+  binop_check ~count:1000 ~name:"Int31.logxor" Int31.logxor Int32.logxor;
+  [%expect ""]
+
+let shift_op_prop op_i31 op_i32 x i =
+  let r_int31 = op_i31 x i |> Int31.to_int32 in
+  let r_int32 = op_i32 (Int31.to_int32 x) i in
+  in_range r_int31 && canon_equal r_int31 r_int32
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.shift_left"
+    Gen.(tup2 t_corner (int_bound 31))
+    ~print:Print.(tup2 print_t int)
+    (fun (x, i) -> shift_op_prop Int31.shift_left Int32.shift_left x i)
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:1000 ~name:"Int31.shift_right"
+    Gen.(tup2 t_corner (int_bound 31))
+    ~print:Print.(tup2 print_t int)
+    (fun (x, i) -> shift_op_prop Int31.shift_right Int32.shift_right x i)
+
+(* Logical implication *)
+let (-->) p q = not p || q
+
+let%expect_test _ =
+  Test.check_exn @@ Test.make ~count:10_000 ~name:"Int31.shift_right_logical"
+    Gen.(tup2 t_corner (int_bound 31))
+    ~print:Print.(tup2 print_t int)
+    (fun (x, i) ->
+      let r_int31 = Int31.shift_right_logical x i |> Int31.to_int32 in
+      let x_int32 = Int31.to_int32 x in
+      let r_int32 =
+        if Int_replace_polymorphic_compare.( i = 0 ) then x_int32
+        else Int32.(shift_right_logical (logand 0x7fffffffl x_int32) i)
+      in
+      (* The bits should be unchanged if the shift amount is zero, otherwise they should
+         match the result of shifting the 31 lower bits of the canonical representation *)
+      in_range r_int31 && Int32.equal r_int31 r_int32
+      && (Int.equal i 0 --> Int32.(r_int31 = x_int32)));
+  [%expect ""]
diff --git a/dune-project b/dune-project
index ed1856d813..6cd544bd75 100644
--- a/dune-project
+++ b/dune-project
@@ -25,6 +25,7 @@
   (re :with-test)
   (cmdliner (>= 1.1.0))
   (sedlex (>= 2.3))
+  (qcheck :with-test)
   menhir
   menhirLib
   menhirSdk
diff --git a/dune-workspace.dev b/dune-workspace.dev
index a21211017e..0f4dc203a3 100644
--- a/dune-workspace.dev
+++ b/dune-workspace.dev
@@ -1,4 +1,4 @@
-(lang dune 3.7)
+(lang dune 3.15)
 
 ;; Install the following opam switches, copy this file as
 ;; dune-workspace and run:

From f27e20ba48f898c588c843fc5a9b6c62d300304b Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Mon, 30 Sep 2024 14:44:42 +0200
Subject: [PATCH 363/481] WSOO side of Target-specific code

---
 compiler/bin-js_of_ocaml/compile.ml     |  7 +--
 compiler/bin-wasm_of_ocaml/compile.ml   | 45 ++++++---------
 compiler/lib/driver.ml                  | 10 +---
 compiler/lib/driver.mli                 |  2 +-
 compiler/lib/ocaml_compiler.mli         |  3 +-
 compiler/lib/parse_bytecode.ml          | 76 +++++++++++--------------
 compiler/lib/parse_bytecode.mli         |  8 +--
 compiler/lib/stdlib.ml                  |  4 ++
 compiler/lib/wasm/wa_code_generation.ml |  6 +-
 compiler/lib/wasm/wa_core_target.ml     |  2 +-
 compiler/lib/wasm/wa_gc_target.ml       |  6 +-
 compiler/lib/wasm/wa_generate.ml        |  4 +-
 12 files changed, 70 insertions(+), 103 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index caeb138842..53069baed1 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -195,7 +195,6 @@ let run
           in
           let code = Code.prepend one.code instr in
           Driver.f
-            ~target:(JavaScript fmt)
             ~standalone
             ?profile
             ~link
@@ -220,7 +219,6 @@ let run
           let code = Code.prepend one.code instr in
           let res =
             Driver.f
-              ~target:(JavaScript fmt)
               ~standalone
               ?profile
               ~link
@@ -285,7 +283,7 @@ let run
    then (
      let prims = Linker.list_all () |> StringSet.elements in
      assert (List.length prims > 0);
-     let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`JavaScript in
+     let code, uinfo = Parse_bytecode.predefined_exceptions () in
      let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in
      let code : Parse_bytecode.one =
        { code
@@ -358,7 +356,6 @@ let run
          let t1 = Timer.make () in
          let code =
            Parse_bytecode.from_cmo
-             ~target:`JavaScript
              ~includes:include_dirs
              ~include_cmis
              ~debug:need_debug
@@ -415,7 +412,6 @@ let run
              let t1 = Timer.make () in
              let code =
                Parse_bytecode.from_cmo
-                 ~target:`JavaScript
                  ~includes:include_dirs
                  ~include_cmis
                  ~debug:need_debug
@@ -447,7 +443,6 @@ let run
                let t1 = Timer.make () in
                let code =
                  Parse_bytecode.from_cmo
-                   ~target:`JavaScript
                    ~includes:include_dirs
                    ~include_cmis
                    ~debug:need_debug
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 5a0135aa44..beb883e81d 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -140,17 +140,18 @@ let link_runtime ~profile runtime_wasm_files output_file =
 let generate_prelude ~out_file =
   Filename.gen_file out_file
   @@ fun ch ->
-  let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`Wasm in
-  let live_vars, in_cps, p, debug =
-    Driver.f
-      ~target:Wasm
-      ~link:`Needed
-      (Parse_bytecode.Debug.create ~include_cmis:false false)
-      code
-  in
+  let code, uinfo = Parse_bytecode.predefined_exceptions () in
+  let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize code in
   let context = Wa_generate.start () in
+  let debug = Parse_bytecode.Debug.create ~include_cmis:false false in
   let _ =
-    Wa_generate.f ~context ~unit_name:(Some "prelude") ~live_vars ~in_cps ~debug p
+    Wa_generate.f
+      ~context
+      ~unit_name:(Some "prelude")
+      ~live_vars:variable_uses
+      ~in_cps
+      ~debug
+      program
   in
   Wa_generate.output ch ~context ~debug;
   uinfo.provides
@@ -244,6 +245,7 @@ let run
     ; sourcemap_root
     ; sourcemap_don't_inline_content
     } =
+  Config.set_target `Wasm;
   Jsoo_cmdline.Arg.eval common;
   Wa_generate.init ();
   let output_file = fst output_file in
@@ -270,15 +272,8 @@ let run
   List.iter builtin ~f:(fun t ->
       let filename = Builtins.File.name t in
       let runtimes = Linker.Fragment.parse_builtin t in
-      Linker.load_fragments
-        ~ignore_always_annotation:true
-        ~target_env:Target_env.Isomorphic
-        ~filename
-        runtimes);
-  Linker.load_files
-    ~ignore_always_annotation:true
-    ~target_env:Target_env.Isomorphic
-    runtime_js_files;
+      Linker.load_fragments ~target_env:Target_env.Isomorphic ~filename runtimes);
+  Linker.load_files ~target_env:Target_env.Isomorphic runtime_js_files;
   Linker.check_deps ();
   if times () then Format.eprintf "  parsing js: %a@." Timer.print t1;
   if times () then Format.eprintf "Start parsing...@.";
@@ -299,12 +294,11 @@ let run
     check_debug one;
     let code = one.code in
     let standalone = Option.is_none unit_name in
-    let live_vars, in_cps, p, debug =
-      Driver.f ~target:Wasm ~standalone ?profile ~link:`No one.debug code
-    in
+    let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ?profile code in
     let context = Wa_generate.start () in
+    let debug = one.debug in
     let toplevel_name, generated_js =
-      Wa_generate.f ~context ~unit_name ~live_vars ~in_cps ~debug p
+      Wa_generate.f ~context ~unit_name ~live_vars:variable_uses ~in_cps ~debug program
     in
     if standalone then Wa_generate.add_start_function ~context toplevel_name;
     Wa_generate.output ch ~context ~debug;
@@ -352,12 +346,7 @@ let run
      let compile_cmo cmo cont =
        let t1 = Timer.make () in
        let code =
-         Parse_bytecode.from_cmo
-           ~target:`Wasm
-           ~includes:include_dirs
-           ~debug:need_debug
-           cmo
-           ic
+         Parse_bytecode.from_cmo ~includes:include_dirs ~debug:need_debug cmo ic
        in
        let unit_info = Unit_info.of_cmo cmo in
        let unit_name = Ocaml_compiler.Cmo_format.name cmo in
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index ba7c18511e..ea9c868608 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -79,8 +79,7 @@ let specialize' (p, info) =
 
 let specialize p = fst (specialize' p)
 
-let eval (p, info) =
-  if Config.Flag.staticeval () then Eval.f info p else p
+let eval (p, info) = if Config.Flag.staticeval () then Eval.f info p else p
 
 let flow p =
   if debug () then Format.eprintf "Data flow...@.";
@@ -180,10 +179,7 @@ let round1 : 'a -> 'a =
 
 let round2 = flow +> specialize' +> eval +> deadcode +> o1
 
-let o3 =
-  loop 10 "tailcall+inline" round1 1
-  +> loop 10 "flow" round2 1
-  +> print
+let o3 = loop 10 "tailcall+inline" round1 1 +> loop 10 "flow" round2 1 +> print
 
 let generate
     d
@@ -662,7 +658,7 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p
   |> coloring
   |> check_js
 
-let optimize ~profile p =
+let optimize ?(profile = O1) p =
   let deadcode_sentinal =
     (* If deadcode is disabled, this field is just fresh variable *)
     Code.Var.fresh_n "dummy"
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 91f846b989..16103a488f 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -28,7 +28,7 @@ type optimized_result =
   ; deadcode_sentinal : Code.Var.t
   }
 
-val optimize : profile:profile -> Code.program -> optimized_result
+val optimize : ?profile:profile -> Code.program -> optimized_result
 
 val f :
      ?standalone:bool
diff --git a/compiler/lib/ocaml_compiler.mli b/compiler/lib/ocaml_compiler.mli
index 4a9a6fb87a..0cb2d3ac56 100644
--- a/compiler/lib/ocaml_compiler.mli
+++ b/compiler/lib/ocaml_compiler.mli
@@ -16,8 +16,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val constant_of_const :
-  target:[ `JavaScript | `Wasm ] -> Lambda.structured_constant -> Code.constant
+val constant_of_const : Lambda.structured_constant -> Code.constant
 
 val find_loc_in_summary : Ident.t -> Env.summary -> Location.t option
 
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index 02a7053dfa..c433d93e3a 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -786,7 +786,7 @@ let register_global ?(force = false) g i loc rem =
       :: rem
   | false, false, (`JavaScript | `Wasm) -> rem
 
-let get_global ~target state instrs i loc =
+let get_global state instrs i loc =
   State.size_globals state (i + 1);
   let g = State.globals state in
   match g.vars.(i) with
@@ -842,7 +842,6 @@ type compile_info =
   ; code : string
   ; limit : int
   ; debug : Debug.t
-  ; target : [ `JavaScript | `Wasm ]
   }
 
 let string_of_addr debug_data addr =
@@ -870,7 +869,7 @@ let ( ||| ) x y =
   | No -> y
   | _ -> x
 
-let rec compile_block blocks debug_data ~target code pc state =
+let rec compile_block blocks debug_data code pc state =
   if not (Addr.Set.mem pc !tagged_blocks)
   then (
     let limit = Blocks.next blocks pc in
@@ -879,16 +878,16 @@ let rec compile_block blocks debug_data ~target code pc state =
     let state = State.start_block pc state in
     tagged_blocks := Addr.Set.add pc !tagged_blocks;
     let instr, last, state' =
-      compile { blocks; code; limit; debug = debug_data; target } pc state []
+      compile { blocks; code; limit; debug = debug_data } pc state []
     in
     assert (not (Addr.Map.mem pc !compiled_blocks));
     compiled_blocks := Addr.Map.add pc (state, List.rev instr, last) !compiled_blocks;
     match fst last with
     | Branch (pc', _) | Poptrap (pc', _) ->
-        compile_block blocks debug_data ~target code pc' state'
+        compile_block blocks debug_data code pc' state'
     | Cond (_, (pc1, _), (pc2, _)) ->
-        compile_block blocks debug_data ~target code pc1 state';
-        compile_block blocks debug_data ~target code pc2 state'
+        compile_block blocks debug_data code pc1 state';
+        compile_block blocks debug_data code pc2 state'
     | Switch (_, _) -> ()
     | Pushtrap _ -> ()
     | Raise _ | Return _ | Stop -> ())
@@ -1226,7 +1225,7 @@ and compile infos pc state instrs =
         let params, state' = State.make_stack nparams state' loc in
         if debug_parser () then Format.printf ") {@.";
         let state' = State.clear_accu state' in
-        compile_block infos.blocks infos.debug ~target:infos.target code addr state';
+        compile_block infos.blocks infos.debug code addr state';
         if debug_parser () then Format.printf "}@.";
         let args = State.stack_vars state' in
         let state'', _, _ = Addr.Map.find addr !compiled_blocks in
@@ -1283,7 +1282,7 @@ and compile infos pc state instrs =
               let params, state' = State.make_stack nparams state' loc in
               if debug_parser () then Format.printf ") {@.";
               let state' = State.clear_accu state' in
-              compile_block infos.blocks infos.debug ~target:infos.target code addr state';
+              compile_block infos.blocks infos.debug code addr state';
               if debug_parser () then Format.printf "}@.";
               let args = State.stack_vars state' in
               let state'', _, _ = Addr.Map.find addr !compiled_blocks in
@@ -1313,16 +1312,16 @@ and compile infos pc state instrs =
         compile infos (pc + 2) (State.env_acc n state) instrs
     | GETGLOBAL ->
         let i = getu code (pc + 1) in
-        let _, state, instrs = get_global ~target:infos.target state instrs i loc in
+        let _, state, instrs = get_global state instrs i loc in
         compile infos (pc + 2) state instrs
     | PUSHGETGLOBAL ->
         let state = State.push state loc in
         let i = getu code (pc + 1) in
-        let _, state, instrs = get_global ~target:infos.target state instrs i loc in
+        let _, state, instrs = get_global state instrs i loc in
         compile infos (pc + 2) state instrs
     | GETGLOBALFIELD ->
         let i = getu code (pc + 1) in
-        let x, state, instrs = get_global ~target:infos.target state instrs i loc in
+        let x, state, instrs = get_global state instrs i loc in
         let j = getu code (pc + 2) in
         let y, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
@@ -1331,7 +1330,7 @@ and compile infos pc state instrs =
         let state = State.push state loc in
 
         let i = getu code (pc + 1) in
-        let x, state, instrs = get_global ~target:infos.target state instrs i loc in
+        let x, state, instrs = get_global state instrs i loc in
         let j = getu code (pc + 2) in
         let y, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j;
@@ -1356,7 +1355,7 @@ and compile infos pc state instrs =
         in
         let x, state = State.fresh_var state loc in
         if debug_parser () then Format.printf "%a = 0@." Var.print x;
-        let instrs = register_global ~target:infos.target g i loc instrs in
+        let instrs = register_global g i loc instrs in
         compile infos (pc + 2) state ((Let (x, const 0l), loc) :: instrs)
     | ATOM0 ->
         let x, state = State.fresh_var state loc in
@@ -1707,9 +1706,9 @@ and compile infos pc state instrs =
         let it = Array.init isize ~f:(fun i -> base + gets code (base + i)) in
         let bt = Array.init bsize ~f:(fun i -> base + gets code (base + isize + i)) in
         Array.iter it ~f:(fun pc' ->
-            compile_block infos.blocks infos.debug ~target:infos.target code pc' state);
+            compile_block infos.blocks infos.debug code pc' state);
         Array.iter bt ~f:(fun pc' ->
-            compile_block infos.blocks infos.debug ~target:infos.target code pc' state);
+            compile_block infos.blocks infos.debug code pc' state);
         match isize, bsize with
         | _, 0 -> instrs, (Switch (x, Array.map it ~f:(fun pc -> pc, args)), loc), state
         | 0, _ ->
@@ -1780,17 +1779,10 @@ and compile infos pc state instrs =
                   , (handler_addr, State.stack_vars handler_state) )
               , loc ) )
             !compiled_blocks;
+        compile_block infos.blocks infos.debug code handler_addr handler_state;
         compile_block
           infos.blocks
           infos.debug
-          ~target:infos.target
-          code
-          handler_addr
-          handler_state;
-        compile_block
-          infos.blocks
-          infos.debug
-          ~target:infos.target
           code
           body_addr
           { (State.push_handler handler_ctx_state) with
@@ -1808,7 +1800,6 @@ and compile infos pc state instrs =
         compile_block
           infos.blocks
           infos.debug
-          ~target:infos.target
           code
           addr
           (State.pop 4 (State.pop_handler state));
@@ -2495,7 +2486,7 @@ type one =
   ; debug : Debug.t
   }
 
-let parse_bytecode code globals debug_data ~target =
+let parse_bytecode code globals debug_data =
   let state = State.initial globals in
   Code.Var.reset ();
   let blocks = Blocks.analyse debug_data code in
@@ -2510,7 +2501,7 @@ let parse_bytecode code globals debug_data ~target =
     if not (Blocks.is_empty blocks')
     then (
       let start = 0 in
-      compile_block blocks' debug_data ~target code start state;
+      compile_block blocks' debug_data code start state;
       let blocks =
         Addr.Map.mapi
           (fun _ (state, instr, last) ->
@@ -2691,12 +2682,12 @@ let from_exe
     Ocaml_compiler.Symtable.GlobalMap.iter symbols ~f:(fun id n ->
         globals.named_value.(n) <- Some (Ocaml_compiler.Symtable.Global.name id);
         globals.is_exported.(n) <- true);
-  let p = parse_bytecode code globals debug_data ~target in
+  let p = parse_bytecode code globals debug_data in
   (* register predefined exception *)
   let body =
     List.fold_left predefined_exceptions ~init:[] ~f:(fun body (i, name) ->
         globals.named_value.(i) <- Some name;
-        let body = register_global ~target ~force:true globals i noloc body in
+        let body = register_global ~force:true globals i noloc body in
         globals.is_exported.(i) <- false;
         body)
   in
@@ -2704,7 +2695,7 @@ let from_exe
     Array.fold_right_i globals.constants ~init:body ~f:(fun i _ l ->
         match globals.vars.(i) with
         | Some x when globals.is_const.(i) ->
-            let l = register_global ~target globals i noloc l in
+            let l = register_global globals i noloc l in
             (Let (x, Constant globals.constants.(i)), noloc) :: l
         | _ -> l)
   in
@@ -2820,7 +2811,7 @@ let from_bytes ~prims ~debug (code : bytecode) =
     t
   in
   let globals = make_globals 0 [||] prims in
-  let p = parse_bytecode code globals debug_data ~target:`JavaScript in
+  let p = parse_bytecode code globals debug_data in
   let gdata = Var.fresh_n "global_data" in
   let need_gdata = ref false in
   let find_name i =
@@ -2885,13 +2876,13 @@ module Reloc = struct
   let constant_of_const x = Constants.parse x [@@if ocaml_version >= (5, 1, 0)]
 
   (* We currently rely on constants to be relocated before globals. *)
-  let step1 ~target t compunit code =
+  let step1 t compunit code =
     if t.step2_started then assert false;
     let open Cmo_format in
     List.iter compunit.cu_primitives ~f:(fun name ->
         Hashtbl.add t.primitives name (Hashtbl.length t.primitives));
     let slot_for_literal sc =
-      t.constants <- constant_of_const ~target sc :: t.constants;
+      t.constants <- constant_of_const sc :: t.constants;
       let pos = t.pos in
       t.pos <- succ t.pos;
       pos
@@ -2959,16 +2950,16 @@ module Reloc = struct
     globals
 end
 
-let from_compilation_units ~target ~includes:_ ~include_cmis ~debug_data l =
+let from_compilation_units ~includes:_ ~include_cmis ~debug_data l =
   let reloc = Reloc.create () in
-  List.iter l ~f:(fun (compunit, code) -> Reloc.step1 ~target reloc compunit code);
+  List.iter l ~f:(fun (compunit, code) -> Reloc.step1 reloc compunit code);
   List.iter l ~f:(fun (compunit, code) -> Reloc.step2 reloc compunit code);
   let globals = Reloc.make_globals reloc in
   let code =
     let l = List.map l ~f:(fun (_, c) -> Bytes.to_string c) in
     String.concat ~sep:"" l
   in
-  let prog = parse_bytecode code globals debug_data ~target in
+  let prog = parse_bytecode code globals debug_data in
   let gdata = Var.fresh_n "global_data" in
   let need_gdata = ref false in
   let body =
@@ -2977,7 +2968,7 @@ let from_compilation_units ~target ~includes:_ ~include_cmis ~debug_data l =
         | Some x when globals.is_const.(i) -> (
             match globals.named_value.(i) with
             | None ->
-                let l = register_global ~target globals i noloc l in
+                let l = register_global globals i noloc l in
                 let cst = globals.constants.(i) in
                 (match cst, Code.Var.get_name x with
                 | String str, None -> Code.Var.name x (Printf.sprintf "cst_%s" str)
@@ -3010,8 +3001,7 @@ let from_compilation_units ~target ~includes:_ ~include_cmis ~debug_data l =
   in
   { code = prepend prog body; cmis; debug = debug_data }
 
-let from_cmo ~target ?(includes = []) ?(include_cmis = false) ?(debug = false) compunit ic
-    =
+let from_cmo ?(includes = []) ?(include_cmis = false) ?(debug = false) compunit ic =
   let debug_data = Debug.create ~include_cmis debug in
   seek_in ic compunit.Cmo_format.cu_pos;
   let code = Bytes.create compunit.Cmo_format.cu_codesize in
@@ -3022,13 +3012,11 @@ let from_cmo ~target ?(includes = []) ?(include_cmis = false) ?(debug = false) c
     seek_in ic compunit.Cmo_format.cu_debug;
     Debug.read_event_list debug_data ~crcs:[] ~includes ~orig:0 ic);
   if times () then Format.eprintf "    read debug events: %a@." Timer.print t;
-  let p =
-    from_compilation_units ~target ~includes ~include_cmis ~debug_data [ compunit, code ]
-  in
+  let p = from_compilation_units ~includes ~include_cmis ~debug_data [ compunit, code ] in
   Code.invariant p.code;
   p
 
-let from_cma ~target ?(includes = []) ?(include_cmis = false) ?(debug = false) lib ic =
+let from_cma ?(includes = []) ?(include_cmis = false) ?(debug = false) lib ic =
   let debug_data = Debug.create ~include_cmis debug in
   let orig = ref 0 in
   let t = ref 0. in
@@ -3047,7 +3035,7 @@ let from_cma ~target ?(includes = []) ?(include_cmis = false) ?(debug = false) l
         compunit, code)
   in
   if times () then Format.eprintf "    read debug events: %.2f@." !t;
-  let p = from_compilation_units ~target ~includes ~include_cmis ~debug_data units in
+  let p = from_compilation_units ~includes ~include_cmis ~debug_data units in
   Code.invariant p.code;
   p
 
diff --git a/compiler/lib/parse_bytecode.mli b/compiler/lib/parse_bytecode.mli
index 244472cd41..863d146c87 100644
--- a/compiler/lib/parse_bytecode.mli
+++ b/compiler/lib/parse_bytecode.mli
@@ -63,8 +63,7 @@ val from_exe :
   -> one
 
 val from_cmo :
-     target:[ `JavaScript | `Wasm ]
-  -> ?includes:string list
+     ?includes:string list
   -> ?include_cmis:bool
   -> ?debug:bool
   -> Cmo_format.compilation_unit
@@ -72,8 +71,7 @@ val from_cmo :
   -> one
 
 val from_cma :
-     target:[ `JavaScript | `Wasm ]
-  -> ?includes:string list
+     ?includes:string list
   -> ?include_cmis:bool
   -> ?debug:bool
   -> Cmo_format.library
@@ -90,7 +88,7 @@ val from_string :
   -> string
   -> Code.program * Debug.t
 
-val predefined_exceptions : target:[ `JavaScript | `Wasm ] -> Code.program * Unit_info.t
+val predefined_exceptions : unit -> Code.program * Unit_info.t
 
 val link_info :
      target:[ `JavaScript | `Wasm ]
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index 86d6e56bf1..40fe5b2e88 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -380,12 +380,16 @@ module Int31 : sig
 
   val of_int32_warning_on_overflow : int32 -> t
 
+  val of_int32_truncate : int32 -> t
+
   val to_int32 : t -> int32
 end = struct
   type t = int32
 
   let wrap i = Int32.(shift_right (shift_left i 1) 1)
 
+  let of_int32_truncate i = wrap i
+
   let of_int_warning_on_overflow i =
     Int32.convert_warning_on_overflow
       ~to_int32:(fun i -> wrap (Int32.of_int i))
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index ab29068687..2760a1fc3c 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -396,10 +396,12 @@ module Arith = struct
     | W.I31Get (S, n') -> return n'
     | _ -> return (W.RefI31 n)
 
+  let wrap31 n = Int31.(of_int32_truncate n |> to_int32)
+
   let of_int31 n =
     let* n = n in
     match n with
-    | W.RefI31 (Const (I32 n)) -> return (W.Const (I32 (Int31.wrap n)))
+    | W.RefI31 (Const (I32 n)) -> return (W.Const (I32 (wrap31 n)))
     | _ -> return (W.I31Get (S, n))
 end
 
@@ -422,7 +424,7 @@ let bin_op_is_smi (op : W.int_bin_op) =
 
 let rec is_smi e =
   match e with
-  | W.Const (I32 i) -> Int32.equal (Int31.wrap i) i
+  | W.Const (I32 i) -> Int32.equal (Arith.wrap31 i) i
   | UnOp ((I32 op | I64 op), _) -> un_op_is_smi op
   | BinOp ((I32 op | I64 op), _, _) -> bin_op_is_smi op
   | I31Get (S, _) -> true
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
index 0e7eafda25..8d102567d5 100644
--- a/compiler/lib/wasm/wa_core_target.ml
+++ b/compiler/lib/wasm/wa_core_target.ml
@@ -411,7 +411,7 @@ module Constant = struct
         let block =
           [ W.DataI32 h
           ; DataI32 0l (*ZZZ DataSym (S "caml_nativeint_ops", 0)*)
-          ; DataI32 (Int32.of_nativeint_warning_on_overflow i)
+          ; DataI32 i
           ]
         in
         context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 9f452b6682..734fb39ac6 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1035,11 +1035,7 @@ module Constant = struct
         let* e = Memory.make_int32 ~kind:`Int32 (return (W.Const (I32 i))) in
         return (Const, e)
     | NativeInt i ->
-        let* e =
-          Memory.make_int32
-            ~kind:`Nativeint
-            (return (W.Const (I32 (Int32.of_nativeint_warning_on_overflow i))))
-        in
+        let* e = Memory.make_int32 ~kind:`Nativeint (return (W.Const (I32 i))) in
         return (Const, e)
 
   let translate c =
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index d01daad091..511d7b17f1 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -161,7 +161,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     | Field (x, n, Float) ->
         Memory.float_array_get
           (load x)
-          (Constant.translate (Int (Int31.of_int_warning_on_overflow n)))
+          (Constant.translate (Int Int31.(of_int_warning_on_overflow n |> to_int32)))
     | Closure _ ->
         Closure.translate
           ~context:ctx.global_context
@@ -676,7 +676,7 @@ module Generate (Target : Wa_target_sig.S) = struct
       | Set_field (x, n, Float, y) ->
           Memory.float_array_set
             (load x)
-            (Constant.translate (Int (Int31.of_int_warning_on_overflow n)))
+            (Constant.translate (Int Int31.(of_int_warning_on_overflow n |> to_int32)))
             (load y)
       | Offset_ref (x, n) ->
           Memory.set_field

From af34f714ed24846bf433737c8dd93f94069d7a17 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 1 Oct 2024 16:42:08 +0200
Subject: [PATCH 364/481] Upgrade Dune lang version

---
 dune-workspace.dev        | 2 +-
 js_of_ocaml-compiler.opam | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/dune-workspace.dev b/dune-workspace.dev
index 0f4dc203a3..5b5373a125 100644
--- a/dune-workspace.dev
+++ b/dune-workspace.dev
@@ -1,4 +1,4 @@
-(lang dune 3.15)
+(lang dune 3.17)
 
 ;; Install the following opam switches, copy this file as
 ;; dune-workspace and run:
diff --git a/js_of_ocaml-compiler.opam b/js_of_ocaml-compiler.opam
index cf0554034d..11414a3d4b 100644
--- a/js_of_ocaml-compiler.opam
+++ b/js_of_ocaml-compiler.opam
@@ -20,6 +20,7 @@ depends: [
   "re" {with-test}
   "cmdliner" {>= "1.1.0"}
   "sedlex" {>= "2.3"}
+  "qcheck" {with-test}
   "menhir"
   "menhirLib"
   "menhirSdk"

From b078432b57500491ef4015fdac7a8dfd47a0c518 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 11 Sep 2024 18:49:32 +0200
Subject: [PATCH 365/481] No longer ignore always annotation

---
 compiler/lib/linker.ml  | 27 ++++++++++-----------------
 compiler/lib/linker.mli | 12 +++---------
 2 files changed, 13 insertions(+), 26 deletions(-)

diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index 4e007ecf8c..d9c93b3002 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -434,7 +434,7 @@ let list_all ?from () =
     provided
     StringSet.empty
 
-let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.t) =
+let load_fragment ~target_env ~filename (f : Fragment.t) =
   match f with
   | Always_include code ->
       always_included :=
@@ -472,11 +472,9 @@ let load_fragment ~ignore_always_annotation ~target_env ~filename (f : Fragment.
                 filename;
             if always
             then (
-              if not ignore_always_annotation
-              then
-                always_included :=
-                  { ar_filename = filename; ar_program = code; ar_requires = requires }
-                  :: !always_included;
+              always_included :=
+                { ar_filename = filename; ar_program = code; ar_requires = requires }
+                :: !always_included;
               `Ok)
             else
               error
@@ -578,24 +576,19 @@ let check_deps () =
           ())
     code_pieces
 
-let load_file ~ignore_always_annotation ~target_env filename =
+let load_file ~target_env filename =
   List.iter (Fragment.parse_file filename) ~f:(fun frag ->
-      let (`Ok | `Ignored) =
-        load_fragment ~ignore_always_annotation ~target_env ~filename frag
-      in
+      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
       ())
 
-let load_fragments ?(ignore_always_annotation = false) ~target_env ~filename l =
+let load_fragments ~target_env ~filename l =
   List.iter l ~f:(fun frag ->
-      let (`Ok | `Ignored) =
-        load_fragment ~ignore_always_annotation ~target_env ~filename frag
-      in
+      let (`Ok | `Ignored) = load_fragment ~target_env ~filename frag in
       ());
   check_deps ()
 
-let load_files ?(ignore_always_annotation = false) ~target_env l =
-  List.iter l ~f:(fun filename ->
-      load_file ~ignore_always_annotation ~target_env filename);
+let load_files ~target_env l =
+  List.iter l ~f:(fun filename -> load_file ~target_env filename);
   check_deps ()
 
 (* resolve *)
diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli
index 246b959403..b7d49194c7 100644
--- a/compiler/lib/linker.mli
+++ b/compiler/lib/linker.mli
@@ -36,15 +36,9 @@ end
 
 val reset : unit -> unit
 
-val load_files :
-  ?ignore_always_annotation:bool -> target_env:Target_env.t -> string list -> unit
-
-val load_fragments :
-     ?ignore_always_annotation:bool
-  -> target_env:Target_env.t
-  -> filename:string
-  -> Fragment.t list
-  -> unit
+val load_files : target_env:Target_env.t -> string list -> unit
+
+val load_fragments : target_env:Target_env.t -> filename:string -> Fragment.t list -> unit
 
 val check_deps : unit -> unit
 

From 2a7f41384f75565e200a148c325f6659bf6a9c0e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 17 Sep 2024 11:14:25 +0200
Subject: [PATCH 366/481] JavaScript linker: add 'wasm' flag

---
 compiler/lib/linker.ml | 9 ++++++++-
 runtime/sys.js         | 1 +
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index d9c93b3002..a49cd797d2 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -186,7 +186,14 @@ module Fragment = struct
     List.fold_left
       ~f:(fun m (k, v) -> StringMap.add k v m)
       ~init:StringMap.empty
-      [ "js-string", Config.Flag.use_js_string; "effects", Config.Flag.effects ]
+      [ "js-string", Config.Flag.use_js_string
+      ; "effects", Config.Flag.effects
+      ; ( "wasm"
+        , fun () ->
+            match Config.target () with
+            | `JavaScript -> false
+            | `Wasm -> true )
+      ]
 
   type t =
     | Always_include of Javascript.program pack
diff --git a/runtime/sys.js b/runtime/sys.js
index 02c57da15b..ff811d998b 100644
--- a/runtime/sys.js
+++ b/runtime/sys.js
@@ -352,6 +352,7 @@ function caml_sys_is_regular_file(name) {
 }
 //Always
 //Requires: caml_fatal_uncaught_exception
+//If: !wasm
 function caml_setup_uncaught_exception_handler() {
   var process = globalThis.process;
   if(process && process.on) {

From fb225da53b0b2c7f7ab9860a4c263c6151fe167e Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 20 Sep 2024 18:00:39 +0200
Subject: [PATCH 367/481] Fixup: Fix Source_map uses

---
 compiler/bin-js_of_ocaml/compile.ml   |  2 +-
 compiler/bin-wasm_of_ocaml/compile.ml |  4 +--
 compiler/lib/link_js.ml               |  2 +-
 compiler/lib/source_map.ml            | 46 +++++++++++----------------
 compiler/lib/source_map.mli           |  9 ++----
 5 files changed, 24 insertions(+), 39 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index 53069baed1..dc1826c60b 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -53,7 +53,7 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f
               let data = Source_map.to_string sm in
               "data:application/json;base64," ^ Base64.encode_exn data
           | Some output_file ->
-              Source_map.to_file sm ~file:output_file;
+              Source_map.to_file sm output_file;
               Filename.basename output_file
         in
         Pretty_print.newline fmt;
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index beb883e81d..b21cff736a 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -30,7 +30,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
   if Option.is_some sourcemap_root || not sourcemap_don't_inline_content
   then (
     let open Source_map in
-    let source_map, mappings = Source_map.of_file_no_mappings sourcemap_file in
+    let source_map = Source_map.of_file sourcemap_file in
     assert (List.is_empty (Option.value source_map.sources_content ~default:[]));
     (* Add source file contents to source map *)
     let sources_content =
@@ -50,7 +50,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
           (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot)
       }
     in
-    Source_map.to_file ?mappings source_map ~file:sourcemap_file)
+    Source_map.to_file source_map sourcemap_file)
 
 let opt_with action x f =
   match x with
diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml
index cdd4d610c8..67a665c504 100644
--- a/compiler/lib/link_js.ml
+++ b/compiler/lib/link_js.ml
@@ -469,7 +469,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
               let s = sourceMappingURL_base64 ^ Base64.encode_exn data in
               Line_writer.write oc s
           | Some file ->
-              Source_map.to_file sm ~file;
+              Source_map.to_file sm file;
               let s = sourceMappingURL ^ Filename.basename file in
               Line_writer.write oc s));
       if times () then Format.eprintf "  sourcemap: %a@." Timer.print t
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index aa5ec3c524..90b097479b 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -311,7 +311,7 @@ let merge = function
 
 (* IO *)
 
-let json ?replace_mappings t =
+let json t =
   let rewrite_path path =
     if Filename.is_relative path
     then path
@@ -331,11 +331,7 @@ let json ?replace_mappings t =
           | Some s -> rewrite_path s) )
     ; "names", `List (List.map t.names ~f:(fun s -> stringlit s))
     ; "sources", `List (List.map t.sources ~f:(fun s -> stringlit (rewrite_path s)))
-    ; ( "mappings"
-      , stringlit
-          (match replace_mappings with
-          | None -> string_of_mapping t.mappings
-          | Some m -> m) )
+    ; "mappings", stringlit (string_of_mapping t.mappings)
     ; ( "sourcesContent"
       , `List
           (match t.sources_content with
@@ -384,7 +380,7 @@ let list_stringlit_opt name rest =
     | _ -> invalid ()
   with Not_found -> None
 
-let of_json ~parse_mappings (json : Yojson.Raw.t) =
+let of_json (json : Yojson.Raw.t) =
   match json with
   | `Assoc (("version", `Intlit version) :: rest) when int_of_string version = 3 ->
       let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in
@@ -413,31 +409,25 @@ let of_json ~parse_mappings (json : Yojson.Raw.t) =
                   | None -> None
                   | Some s -> Some (Source_content.of_stringlit s)))
       in
-      let mappings_str = string "mappings" rest in
       let mappings =
-        match parse_mappings, mappings_str with
-        | false, _ -> mapping_of_string ""
-        | true, None -> mapping_of_string ""
-        | true, Some s -> mapping_of_string s
+        match string "mappings" rest with
+        | None -> mapping_of_string ""
+        | Some s -> mapping_of_string s
       in
-      ( { version = int_of_float (float_of_string version)
-        ; file
-        ; sourceroot
-        ; names
-        ; sources_content
-        ; sources
-        ; mappings
-        }
-      , if parse_mappings then None else mappings_str )
+      { version = int_of_float (float_of_string version)
+      ; file
+      ; sourceroot
+      ; names
+      ; sources_content
+      ; sources
+      ; mappings
+      }
   | _ -> invalid ()
 
-let of_string s = of_json ~parse_mappings:true (Yojson.Raw.from_string s) |> fst
+let of_string s = of_json (Yojson.Raw.from_string s)
 
-let to_string m = Yojson.Raw.to_string (json m)
+let of_file filename = of_json (Yojson.Raw.from_file filename)
 
-let to_file ?mappings m ~file =
-  let replace_mappings = mappings in
-  Yojson.Raw.to_file file (json ?replace_mappings m)
+let to_string m = Yojson.Raw.to_string (json m)
 
-let of_file_no_mappings filename =
-  of_json ~parse_mappings:false (Yojson.Raw.from_file filename)
+let to_file m file = Yojson.Raw.to_file file (json m)
diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli
index 5c3d7543e5..1c305d4c4b 100644
--- a/compiler/lib/source_map.mli
+++ b/compiler/lib/source_map.mli
@@ -70,11 +70,6 @@ val to_string : t -> string
 
 val of_string : string -> t
 
-val of_file_no_mappings : string -> t * string option
-(** Read source map from a file without parsing the mappings (which can be costly). The
-    [mappings] field is returned empty and the raw string is returned alongside the map.
- *)
+val to_file : t -> string -> unit
 
-val to_file : ?mappings:string -> t -> file:string -> unit
-(** Write to a file. If a string is supplied as [mappings], use it instead of the
-    sourcemap's [mappings]. *)
+val of_file : string -> t

From b16557e799356c3a7d25934d785376116f95bee8 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 2 Oct 2024 10:49:10 +0200
Subject: [PATCH 368/481] Realign Driver.optimize

---
 compiler/bin-wasm_of_ocaml/compile.ml | 15 +++++++++++++--
 compiler/lib/driver.ml                |  2 +-
 compiler/lib/driver.mli               |  2 +-
 3 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index b21cff736a..e1f9bf0c25 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -141,7 +141,12 @@ let generate_prelude ~out_file =
   Filename.gen_file out_file
   @@ fun ch ->
   let code, uinfo = Parse_bytecode.predefined_exceptions () in
-  let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize code in
+  let profile =
+    match Driver.profile 1 with
+    | Some p -> p
+    | None -> assert false
+  in
+  let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ~profile code in
   let context = Wa_generate.start () in
   let debug = Parse_bytecode.Debug.create ~include_cmis:false false in
   let _ =
@@ -294,7 +299,13 @@ let run
     check_debug one;
     let code = one.code in
     let standalone = Option.is_none unit_name in
-    let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ?profile code in
+    let profile =
+      match profile, Driver.profile 1 with
+      | Some p, _ -> p
+      | None, Some p -> p
+      | None, None -> assert false
+    in
+    let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ~profile code in
     let context = Wa_generate.start () in
     let debug = one.debug in
     let toplevel_name, generated_js =
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index ea9c868608..6d05e00274 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -658,7 +658,7 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p
   |> coloring
   |> check_js
 
-let optimize ?(profile = O1) p =
+let optimize ~profile p =
   let deadcode_sentinal =
     (* If deadcode is disabled, this field is just fresh variable *)
     Code.Var.fresh_n "dummy"
diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli
index 16103a488f..91f846b989 100644
--- a/compiler/lib/driver.mli
+++ b/compiler/lib/driver.mli
@@ -28,7 +28,7 @@ type optimized_result =
   ; deadcode_sentinal : Code.Var.t
   }
 
-val optimize : ?profile:profile -> Code.program -> optimized_result
+val optimize : profile:profile -> Code.program -> optimized_result
 
 val f :
      ?standalone:bool

From 509636ed543960b398970bb127e8a2a8bac87fda Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 2 Oct 2024 10:59:50 +0200
Subject: [PATCH 369/481] Fix Parse_bytecode types

---
 compiler/bin-js_of_ocaml/compile.ml   |  1 -
 compiler/bin-wasm_of_ocaml/compile.ml |  1 -
 compiler/lib/link_js.ml               |  8 +-------
 compiler/lib/parse_bytecode.ml        | 18 +++++++-----------
 compiler/lib/parse_bytecode.mli       |  6 ++----
 5 files changed, 10 insertions(+), 24 deletions(-)

diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
index dc1826c60b..e0399c4ab8 100644
--- a/compiler/bin-js_of_ocaml/compile.ml
+++ b/compiler/bin-js_of_ocaml/compile.ml
@@ -323,7 +323,6 @@ let run
          let linkall = linkall || toplevel || dynlink in
          let code =
            Parse_bytecode.from_exe
-             ~target:`JavaScript
              ~includes:include_dirs
              ~include_cmis
              ~link_info:(toplevel || dynlink)
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index e1f9bf0c25..5448f089ad 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -391,7 +391,6 @@ let run
          let t1 = Timer.make () in
          let code =
            Parse_bytecode.from_exe
-             ~target:`Wasm
              ~includes:include_dirs
              ~include_cmis:false
              ~link_info:false
diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml
index 67a665c504..6cacff87e3 100644
--- a/compiler/lib/link_js.ml
+++ b/compiler/lib/link_js.ml
@@ -412,13 +412,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
             List.fold_left units ~init:StringSet.empty ~f:(fun acc (u : Unit_info.t) ->
                 StringSet.union acc (StringSet.of_list u.primitives))
           in
-          let code =
-            Parse_bytecode.link_info
-              ~target:`JavaScript
-              ~symtable:!sym
-              ~primitives
-              ~crcs:[]
-          in
+          let code = Parse_bytecode.link_info ~symtable:!sym ~primitives ~crcs:[] in
           let b = Buffer.create 100 in
           let fmt = Pretty_print.to_buffer b in
           Driver.configure fmt;
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
index c433d93e3a..ba5c16b627 100644
--- a/compiler/lib/parse_bytecode.ml
+++ b/compiler/lib/parse_bytecode.ml
@@ -418,7 +418,7 @@ end
 
 (* Parse constants *)
 module Constants : sig
-  val parse : target:[ `JavaScript | `Wasm ] -> Obj.t -> Code.constant
+  val parse : Obj.t -> Code.constant
 
   val inlined : Code.constant -> bool
 end = struct
@@ -452,7 +452,7 @@ end = struct
 
   let ident_native = ident_of_custom (Obj.repr 0n)
 
-  let rec parse ~target x =
+  let rec parse x =
     if Obj.is_block x
     then
       let tag = Obj.tag x in
@@ -485,10 +485,7 @@ end = struct
         | None -> assert false
       else if tag < Obj.no_scan_tag
       then
-        Tuple
-          ( tag
-          , Array.init (Obj.size x) ~f:(fun i -> parse ~target (Obj.field x i))
-          , Unknown )
+        Tuple (tag, Array.init (Obj.size x) ~f:(fun i -> parse (Obj.field x i)), Unknown)
       else assert false
     else
       let i : int = Obj.magic x in
@@ -2613,7 +2610,6 @@ let read_primitives toc ic =
   String.split_char ~sep:'\000' (String.sub prim ~pos:0 ~len:(String.length prim - 1))
 
 let from_exe
-    ~target
     ?(includes = [])
     ~linkall
     ~link_info
@@ -2627,7 +2623,7 @@ let from_exe
   let primitive_table = Array.of_list primitives in
   let code = Toc.read_code toc ic in
   let init_data = Toc.read_data toc ic in
-  let init_data = Array.map ~f:(Constants.parse ~target) init_data in
+  let init_data = Array.map ~f:Constants.parse init_data in
   let orig_symbols = Toc.read_symb toc ic in
   let orig_crcs = Toc.read_crcs toc ic in
   let keeps =
@@ -2720,7 +2716,7 @@ let from_exe
       let gdata = Var.fresh () in
       let need_gdata = ref false in
       let infos =
-        [ "toc", Constants.parse ~target (Obj.repr toc)
+        [ "toc", Constants.parse (Obj.repr toc)
         ; "prim_count", Int (Int32.of_int (Array.length globals.primitives))
         ]
       in
@@ -3141,7 +3137,7 @@ let predefined_exceptions () =
   in
   { start = 0; blocks = Addr.Map.singleton 0 block; free_pc = 1 }, unit_info
 
-let link_info ~target ~symtable ~primitives ~crcs =
+let link_info ~symtable ~primitives ~crcs =
   let gdata = Code.Var.fresh_n "global_data" in
   let symtable_js =
     Ocaml_compiler.Symtable.GlobalMap.fold
@@ -3165,7 +3161,7 @@ let link_info ~target ~symtable ~primitives ~crcs =
       ]
     in
     let infos =
-      [ "toc", Constants.parse ~target (Obj.repr toc)
+      [ "toc", Constants.parse (Obj.repr toc)
       ; "prim_count", Int (Int32.of_int (List.length primitives))
       ]
     in
diff --git a/compiler/lib/parse_bytecode.mli b/compiler/lib/parse_bytecode.mli
index 863d146c87..e34133d39b 100644
--- a/compiler/lib/parse_bytecode.mli
+++ b/compiler/lib/parse_bytecode.mli
@@ -52,8 +52,7 @@ end
 val read_primitives : Toc.t -> in_channel -> string list
 
 val from_exe :
-     target:[ `JavaScript | `Wasm ]
-  -> ?includes:string list
+     ?includes:string list
   -> linkall:bool
   -> link_info:bool
   -> include_cmis:bool
@@ -91,8 +90,7 @@ val from_string :
 val predefined_exceptions : unit -> Code.program * Unit_info.t
 
 val link_info :
-     target:[ `JavaScript | `Wasm ]
-  -> symtable:Ocaml_compiler.Symtable.GlobalMap.t
+     symtable:Ocaml_compiler.Symtable.GlobalMap.t
   -> primitives:StringSet.t
   -> crcs:(string * Digest.t option) list
   -> Code.program

From a6eefa0c74b23433dd130326a3caa0e91b7caaf2 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 2 Oct 2024 14:09:27 +0200
Subject: [PATCH 370/481] Add Int31.of_int32_truncate

---
 compiler/lib/stdlib.ml | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index bb01e08dab..4e9c137397 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -380,12 +380,16 @@ module Int31 : sig
 
   val of_int32_warning_on_overflow : int32 -> t
 
+  val of_int32_truncate : int32 -> t
+
   val to_int32 : t -> int32
 end = struct
   type t = int32
 
   let wrap i = Int32.(shift_right (shift_left i 1) 1)
 
+  let of_int32_truncate i = wrap i
+
   let of_int_warning_on_overflow i =
     Int32.convert_warning_on_overflow
       ~to_int32:(fun i -> wrap (Int32.of_int i))

From 00c87cbb4d182395169e8df728951f69735006c2 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 2 Oct 2024 14:26:15 +0200
Subject: [PATCH 371/481] Add some Source_map functions

---
 compiler/lib/source_map.ml  | 2 ++
 compiler/lib/source_map.mli | 2 ++
 2 files changed, 4 insertions(+)

diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index a2d30d9f85..ac06cec65e 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -440,6 +440,8 @@ let of_json (json : Yojson.Raw.t) =
 
 let of_string s = of_json (Yojson.Raw.from_string s)
 
+let of_file filename = of_json (Yojson.Raw.from_file filename)
+
 let to_string m = Yojson.Raw.to_string (json m)
 
 let to_file m file = Yojson.Raw.to_file file (json m)
diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli
index a5d6278329..4daf45f8cf 100644
--- a/compiler/lib/source_map.mli
+++ b/compiler/lib/source_map.mli
@@ -91,3 +91,5 @@ val to_string : t -> string
 val to_file : t -> string -> unit
 
 val of_string : string -> t
+
+val of_file : string -> t

From b8865366913466ce7b46d73c24f2e3053055e9d3 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 2 Oct 2024 14:10:08 +0200
Subject: [PATCH 372/481] Remove special Undefined

---
 compiler/lib/wasm/wa_generate.ml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 511d7b17f1..44a7badc3e 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -170,7 +170,6 @@ module Generate (Target : Wa_target_sig.S) = struct
           ~cps:(Var.Set.mem x ctx.in_cps)
           x
     | Constant c -> Constant.translate c
-    | Special Undefined -> Constant.translate (Int 0l)
     | Special (Alias_prim _) -> assert false
     | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int arity) ])
       when Poly.(target = `GC) ->

From d3faed04608104798bd950e7532226ac3df0213b Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 2 Oct 2024 17:11:59 +0200
Subject: [PATCH 373/481] CI fixes

---
 .gitattributes                            |  4 ++++
 .github/workflows/build-wasm_of_ocaml.yml |  8 +++++++
 .github/workflows/build.yml               | 26 ++++++++++++++++++++++-
 biome.json                                |  6 +++++-
 dune-project                              |  5 +++--
 wasm_of_ocaml-compiler.opam               |  3 ++-
 6 files changed, 47 insertions(+), 5 deletions(-)

diff --git a/.gitattributes b/.gitattributes
index e9a3efdd53..e32e0c03c0 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -1,2 +1,6 @@
 *.ml linguist-language=OCaml
 *.mli linguist-language=OCaml
+
+# We are pinning wasm_of_ocaml using this file in the CI. This would
+# fail on Windows otherwise.
+VERSION -text
diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 3bacb9b63d..0a0eba09f6 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -114,6 +114,14 @@ jobs:
         with:
           path: wasm_of_ocaml
 
+      - name: Pin faked binaryen-bin package
+        # It's faster to use a cached version
+        working-directory: ./wasm_of_ocaml
+        run: |
+          echo opam-version: '"2.0"' > binaryen-bin.opam
+          opam pin -n .
+          rm binaryen-bin.opam
+
       - name: Checkout Jane Street opam repository
         uses: actions/checkout@v4
         with:
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 8f7f35b87a..c7c0c7eda1 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -88,13 +88,31 @@ jobs:
           dune-cache: true
           opam-pin: false
 
+      - name: Pin dune
+        run: |
+          opam pin add dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+
       - run: opam install conf-pkg-config
         if: runner.os == 'Windows'
 
       - run: opam install . --best-effort
         if: ${{ matrix.skip-test }}
 
-      - run: opam install . --with-test
+      - run: cat VERSION | xargs opam pin wasm_of_ocaml-compiler . -n --with-version 
+        if: ${{ !matrix.skip-test }}
+        shell: bash
+
+      - run: opam install conf-c++
+        # Otherwise, the next step fails reinstalling gcc while compiling
+        # other packages
+        if: ${{ !matrix.skip-test && runner.os == 'Windows' }}
+
+      - run: opam install . --with-test --deps-only
+        # Install the test dependencies
+        if: ${{ !matrix.skip-test }}
+
+      - run: opam install .
+        # Install the packages (without running the tests)
         if: ${{ !matrix.skip-test }}
 
       - run: opam exec -- make all
@@ -134,6 +152,9 @@ jobs:
         with:
           ocaml-compiler: "5.2"
           dune-cache: true
+      - name: Pin dune
+        run: |
+          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
       - uses: ocaml/setup-ocaml/lint-opam@v3
 
   lint-fmt:
@@ -146,6 +167,9 @@ jobs:
         with:
           ocaml-compiler: "5.2"
           dune-cache: true
+      - name: Pin dune
+        run: |
+          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
       - uses: ocaml/setup-ocaml/lint-fmt@v3
 
   lint-runtime:
diff --git a/biome.json b/biome.json
index 6bcb2055d9..32dc645b83 100644
--- a/biome.json
+++ b/biome.json
@@ -2,7 +2,11 @@
   "$schema": "https://biomejs.dev/schemas/1.9.1/schema.json",
   "files": {
     "include": ["runtime"],
-    "ignore": ["runtime/zstd.ts"]
+    "ignore": [
+      "runtime/zstd.ts",
+      "runtime/wasm/runtime.js",
+      "runtime/wasm/deps.json"
+    ]
   },
   "formatter": {
     "enabled": true,
diff --git a/dune-project b/dune-project
index f3587b2252..2f54a94764 100644
--- a/dune-project
+++ b/dune-project
@@ -139,7 +139,7 @@
  (description
   "Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js")
  (depends
-  (ocaml (and (>= 4.14) (< 5.1)))
+  (ocaml (and (>= 4.14) (< 5.3)))
   (js_of_ocaml (= :version))
   (num :with-test)
   (ppx_expect (and (>= v0.14.2) :with-test))
@@ -150,7 +150,8 @@
   menhir
   menhirLib
   menhirSdk
-  yojson)
+  yojson
+  binaryen-bin)
  (depopts
   ocamlfind)
  (conflicts
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
index e7ffee8300..3d1a938bfd 100644
--- a/wasm_of_ocaml-compiler.opam
+++ b/wasm_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.17"}
-  "ocaml" {>= "4.14" & < "5.1"}
+  "ocaml" {>= "4.14" & < "5.3"}
   "js_of_ocaml" {= version}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}
@@ -25,6 +25,7 @@ depends: [
   "menhirLib"
   "menhirSdk"
   "yojson"
+  "binaryen-bin"
   "odoc" {with-doc}
 ]
 depopts: ["ocamlfind"]

From af6384ddb62a450e63e43f154bb11547cc876221 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 3 Oct 2024 19:57:51 +0200
Subject: [PATCH 374/481] Fix compilation of the Wasm runtime under Windows.

---
 compiler/bin-wasm_of_ocaml/gen/gen.ml |  6 +--
 runtime/wasm/dune                     | 64 ++++++++++++++-------------
 2 files changed, 37 insertions(+), 33 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml
index 7c841a192c..b7a20c4e3e 100644
--- a/compiler/bin-wasm_of_ocaml/gen/gen.ml
+++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml
@@ -4,10 +4,10 @@ let () =
   let () = set_binary_mode_out stdout true in
   Format.printf
     "let wasm_runtime = \"%s\"@."
-    (String.escaped (read_file (open_in Sys.argv.(1))));
+    (String.escaped (read_file (open_in_bin Sys.argv.(1))));
   Format.printf
     "let js_runtime = \"%s\"@."
-    (String.escaped (read_file (open_in Sys.argv.(2))));
+    (String.escaped (read_file (open_in_bin Sys.argv.(2))));
   Format.printf
     "let dependencies = \"%s\"@."
-    (String.escaped (read_file (open_in Sys.argv.(3))))
+    (String.escaped (read_file (open_in_bin Sys.argv.(3))))
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 4ec8e8693c..375ceacbf7 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -31,43 +31,47 @@
 
 (rule
  (target runtime.wasm)
+ (deps runtime.merged.wasm)
+ (action
+  (run
+   wasm-opt
+   -g
+   --enable-gc
+   --enable-exception-handling
+   --enable-reference-types
+   --enable-tail-call
+   --enable-strings
+   --enable-multivalue
+   --enable-bulk-memory
+   %{deps}
+   -O3
+   -o
+   %{target})))
+
+(rule
+ (target runtime.merged.wasm)
  (deps
   args
   (glob_files *.wat))
  (action
   (progn
-   (system
+   (bash
     "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
-   (system
+   (bash
     "wasm-merge --version | grep -q 'version \\(11[89]\\|1[2-9][0-9]\\)' || (echo 'Error: Binaryen version 118 or greater is currently required'; false)")
-   (pipe-stdout
-    (run
-     wasm-merge
-     -g
-     --enable-gc
-     --enable-exception-handling
-     --enable-reference-types
-     --enable-tail-call
-     --enable-strings
-     --enable-multivalue
-     --enable-bulk-memory
-     %{read-lines:args}
-     -o
-     -)
-    (run
-     wasm-opt
-     -g
-     --enable-gc
-     --enable-exception-handling
-     --enable-reference-types
-     --enable-tail-call
-     --enable-strings
-     --enable-multivalue
-     --enable-bulk-memory
-     -
-     -O3
-     -o
-     %{target})))))
+   (run
+    wasm-merge
+    -g
+    --enable-gc
+    --enable-exception-handling
+    --enable-reference-types
+    --enable-tail-call
+    --enable-strings
+    --enable-multivalue
+    --enable-bulk-memory
+    %{read-lines:args}
+    -o
+    %{target}))))
 
 (rule
  (target args)

From a54ca81b845df647299e24b0d5a5bc32e5330cc9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 11:28:31 +0200
Subject: [PATCH 375/481] Fix parsing test

It is no longer necessary to flush stdout/stderr since OCaml 5.1
(see ocaml/ocaml#12046).
---
 compiler/tests-jsoo/dune          | 24 ++++++++++++++++++++----
 compiler/tests-jsoo/flush_stubs.c | 12 ------------
 compiler/tests-jsoo/runtime.js    |  2 --
 3 files changed, 20 insertions(+), 18 deletions(-)
 delete mode 100644 compiler/tests-jsoo/flush_stubs.c
 delete mode 100644 compiler/tests-jsoo/runtime.js

diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune
index 711186b489..ca6f45862f 100644
--- a/compiler/tests-jsoo/dune
+++ b/compiler/tests-jsoo/dune
@@ -20,16 +20,32 @@
  (preprocess
   (pps ppx_expect)))
 
+(library
+ (name jsoo_testsuite_parsing)
+ (modules test_parsing calc_parser calc_lexer)
+ (libraries unix compiler-libs.common js_of_ocaml-compiler)
+ (enabled_if
+  (>= %{ocaml_version} 5.1.1))
+ (inline_tests
+  (modes js best))
+ (preprocess
+  (pps ppx_expect)))
+
 (library
  (name jsoo_testsuite)
  (modules
-  (:standard \ test_io test_floats test_marshal_compressed))
+  (:standard
+   \
+   test_io
+   test_floats
+   test_marshal_compressed
+   test_parsing
+   calc_parser
+   calc_lexer))
  (libraries unix compiler-libs.common js_of_ocaml-compiler)
  (foreign_stubs
   (language c)
-  (names bigarray_stubs flush_stubs))
- (js_of_ocaml
-  (javascript_files runtime.js))
+  (names bigarray_stubs))
  (inline_tests
   (modes js best))
  (preprocess
diff --git a/compiler/tests-jsoo/flush_stubs.c b/compiler/tests-jsoo/flush_stubs.c
deleted file mode 100644
index 099b0927d6..0000000000
--- a/compiler/tests-jsoo/flush_stubs.c
+++ /dev/null
@@ -1,12 +0,0 @@
-
-#include <stdio.h>
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-
-CAMLprim value flush_stdout_stderr (value unit) {
-  (void)unit;
-  CAMLparam0 ();   /* v is ignored */
-  fflush(stderr);
-  fflush(stdout);
-  CAMLreturn (Val_unit);
-}
diff --git a/compiler/tests-jsoo/runtime.js b/compiler/tests-jsoo/runtime.js
deleted file mode 100644
index 0734415a19..0000000000
--- a/compiler/tests-jsoo/runtime.js
+++ /dev/null
@@ -1,2 +0,0 @@
-//Provides: flush_stdout_stderr
-function flush_stdout_stderr(_unit) { return 0 }

From a6c7e8938e40df2488dd5dd6760381aeacd62eab Mon Sep 17 00:00:00 2001
From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com>
Date: Fri, 4 Oct 2024 11:53:19 +0000
Subject: [PATCH 376/481] Bump ocaml/setup-ocaml from 2 to 3

Bumps [ocaml/setup-ocaml](https://github.com/ocaml/setup-ocaml) from 2 to 3.
- [Release notes](https://github.com/ocaml/setup-ocaml/releases)
- [Changelog](https://github.com/ocaml/setup-ocaml/blob/master/CHANGELOG.md)
- [Commits](https://github.com/ocaml/setup-ocaml/compare/v2...v3)

---
updated-dependencies:
- dependency-name: ocaml/setup-ocaml
  dependency-type: direct:production
  update-type: version-update:semver-major
...

Signed-off-by: dependabot[bot] <support@github.com>
---
 .github/workflows/build-wasm_of_ocaml.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 0a0eba09f6..34f7391153 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -83,7 +83,7 @@ jobs:
 
       - name: Install OCaml ${{ matrix.ocaml-compiler }}
         if: steps.cache-ocaml.outputs.cache-hit != 'true'
-        uses: ocaml/setup-ocaml@v2
+        uses: ocaml/setup-ocaml@v3
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
           dune-cache: true

From d49fe946e9989ea153cf8a72af48d784e4293a12 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 16:31:38 +0200
Subject: [PATCH 377/481] Runtime: fix primitive selection for OCaml 5.01

---
 runtime/wasm/dune | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 375ceacbf7..90422c0f9d 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -13,7 +13,7 @@
 
 (rule
  (target version-dependent.wat)
- (deps version-dependent/post-5.2.wat)
+ (deps version-dependent/post-5.1.wat)
  (enabled_if
   (and
    (>= %{ocaml_version} 5.1.0)

From 0b4b6d36bfd639658e4387e0eaebae9342862145 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 16:32:19 +0200
Subject: [PATCH 378/481] Disable js_of_ocaml tests

---
 ppx/ppx_deriving_json/tests/dune | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/ppx/ppx_deriving_json/tests/dune b/ppx/ppx_deriving_json/tests/dune
index d2607ddee2..59ffdaf6d2 100644
--- a/ppx/ppx_deriving_json/tests/dune
+++ b/ppx/ppx_deriving_json/tests/dune
@@ -27,7 +27,10 @@
 (rule
  (alias runtest)
  (enabled_if
-  (>= %{ocaml_version} 5.1))
+  (and
+   (>= %{ocaml_version} 5.1)
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  ;; (package js_of_ocaml-ppx)
  (action
   (diff ppx.mlt ppx.mlt.corrected)))
@@ -35,7 +38,10 @@
 (rule
  (alias runtest)
  (enabled_if
-  (>= %{ocaml_version} 5.1))
+  (and
+   (>= %{ocaml_version} 5.1)
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  ;; (package js_of_ocaml-ppx)
  (action
   (diff gen.mlt gen.mlt.corrected)))

From dd3c5c15e00a27fe680a60ff4652aa37445b3b61 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 16:33:50 +0200
Subject: [PATCH 379/481] CI: test with OCaml 5.01

---
 .github/workflows/build-wasm_of_ocaml.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 0a0eba09f6..061bc0c4bd 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -18,6 +18,7 @@ jobs:
         ocaml-compiler:
           - 4.14.x
           - 5.00.x
+          - 5.01.x
 
     runs-on: ${{ matrix.os }}
 

From 90db9c5d997fe8130f3d1be81051615d4aa6f862 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 17:49:09 +0200
Subject: [PATCH 380/481] Wasm runtime: JavaScript clean-up

---
 biome.json              |  9 +++------
 runtime/wasm/deps.json  |  2 +-
 runtime/wasm/runtime.js | 30 +++++++++++++++---------------
 3 files changed, 19 insertions(+), 22 deletions(-)

diff --git a/biome.json b/biome.json
index 32dc645b83..68920977df 100644
--- a/biome.json
+++ b/biome.json
@@ -2,11 +2,7 @@
   "$schema": "https://biomejs.dev/schemas/1.9.1/schema.json",
   "files": {
     "include": ["runtime"],
-    "ignore": [
-      "runtime/zstd.ts",
-      "runtime/wasm/runtime.js",
-      "runtime/wasm/deps.json"
-    ]
+    "ignore": ["runtime/zstd.ts"]
   },
   "formatter": {
     "enabled": true,
@@ -46,7 +42,8 @@
         "noDoubleEquals": "off",
         "noFallthroughSwitchClause": "off",
         "noRedeclare": "off",
-        "noSelfCompare": "off"
+        "noSelfCompare": "off",
+        "noRedundantUseStrict": "off"
       }
     }
   },
diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 12c5230deb..42b8150fcf 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,7 +1,7 @@
 [
   {
     "name": "root",
-    "reaches": ["init","exn","mem","strings"],
+    "reaches": ["init", "exn", "mem", "strings"],
     "root": true
   },
   {
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 9379286355..dbfe9b0ab8 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -17,11 +17,11 @@
 
 ((js) => async (args) => {
     "use strict";
-    let {link, src, generated} = args;
+    const {link, src, generated} = args;
 
     const isNode = globalThis?.process?.versions?.node;
 
-    let math =
+    const math =
         {cos:Math.cos, sin:Math.sin, tan:Math.tan,
          acos:Math.acos, asin:Math.asin, atan:Math.atan,
          cosh:Math.cosh, sinh:Math.sinh, tanh:Math.tanh,
@@ -31,16 +31,16 @@
          atan2:Math.atan2, hypot:Math.hypot, pow:Math.pow,
          fmod:(x, y) => x%y}
 
-    let typed_arrays =
+    const typed_arrays =
       [Float32Array, Float64Array, Int8Array, Uint8Array, Int16Array,
        Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
        Float32Array, Float64Array, Uint8Array, Uint8ClampedArray]
 
-    const fs = isNode&&require('fs')
+    const fs = isNode&&require('node:fs')
 
-    let fs_cst = fs?.constants;
+    const fs_cst = fs?.constants;
 
-    let open_flags =
+    const open_flags =
       fs?[fs_cst.RDONLY,fs_cst.O_WRONLY,fs_cst.O_APPEND,fs_cst.O_CREAT,
           fs_cst.O_TRUNC,fs_cst.O_EXCL,fs_cst.O_NONBLOCK]:[]
 
@@ -97,7 +97,7 @@
       return h ^ s.length;
     }
 
-    let bindings =
+    const bindings =
         {jstag:
          WebAssembly.JSTag||
          // ZZZ not supported in Firefox yet
@@ -117,7 +117,7 @@
          new_obj:()=>({}),
          new:(c,args)=>new c(...args),
          global_this:globalThis,
-         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwnProperty(nm)) f(nm)},
+         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwn(nm)) f(nm)},
          array_length:(a)=>a.length,
          array_get:(a,i)=>a[i],
          array_set:(a,i,v)=>a[i]=v,
@@ -128,8 +128,8 @@
          append_string:(s1,s2)=>s1+s2,
          write_string:(s)=>{
            var start = 0, len = s.length;
-           while (1) {
-             let {read,written} = encoder.encodeInto(s.slice(start), out_buffer);
+           for(;;) {
+             const {read,written} = encoder.encodeInto(s.slice(start), out_buffer);
              len -= read;
              if (!len) return written;
              caml_extract_string(written);
@@ -227,7 +227,7 @@
              if (Math.abs(x) < 1.0) {
                return x.toFixed(dp);
              } else {
-               var e = parseInt(x.toString().split('+')[1]);
+               var e = Number.parseInt(x.toString().split('+')[1]);
                if (e > 20) {
                  e -= 20;
                  x /= Math.pow(10,e);
@@ -322,7 +322,7 @@
          argv:()=>isNode?process.argv.slice(1):['a.out'],
          getenv:(n)=>isNode?process.env[n]:null,
          system:(c)=>{
-           var res = require('child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
+           var res = require('node:child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
            if(res.error)throw res.error; return res.signal?255:res.status
          },
          time:()=>performance.now(),
@@ -350,7 +350,7 @@
          map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    let string_ops =
+    const string_ops =
         {test:(v)=>+(typeof v==="string"),
          compare:(s1,s2)=>(s1<s2)?-1:+(s1>s2),
          hash:hash_string,
@@ -366,9 +366,9 @@
     const options = { builtins: ['js-string', 'text-decoder', 'text-encoder'] }
 
     function loadRelative(src) {
-      const path = require('path');
+      const path = require('node:path');
       const f = path.join(path.dirname(require.main.filename),src);
-      return require('fs/promises').readFile(f)
+      return require('node:fs/promises').readFile(f)
     }
     function fetchRelative(src) {
       const base = globalThis?.document?.currentScript?.src;

From 78760fdde9c7ac568af02208923b17cf540889dd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 17:51:12 +0200
Subject: [PATCH 381/481] Wasm runtime: reformat the JavaScript code

---
 runtime/wasm/runtime.js | 909 ++++++++++++++++++++++------------------
 1 file changed, 512 insertions(+), 397 deletions(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index dbfe9b0ab8..393c2c270d 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -15,426 +15,541 @@
 // along with this program; if not, write to the Free Software
 // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
-((js) => async (args) => {
-    "use strict";
-    const {link, src, generated} = args;
+(js) => async (args) => {
+  "use strict";
+  const { link, src, generated } = args;
 
-    const isNode = globalThis?.process?.versions?.node;
+  const isNode = globalThis?.process?.versions?.node;
 
-    const math =
-        {cos:Math.cos, sin:Math.sin, tan:Math.tan,
-         acos:Math.acos, asin:Math.asin, atan:Math.atan,
-         cosh:Math.cosh, sinh:Math.sinh, tanh:Math.tanh,
-         acosh:Math.acosh, asinh:Math.asinh, atanh:Math.atanh,
-         cbrt:Math.cbrt, exp:Math.exp, expm1:Math.expm1,
-         log:Math.log, log1p:Math.log1p, log2:Math.log2, log10:Math.log10,
-         atan2:Math.atan2, hypot:Math.hypot, pow:Math.pow,
-         fmod:(x, y) => x%y}
+  const math = {
+    cos: Math.cos,
+    sin: Math.sin,
+    tan: Math.tan,
+    acos: Math.acos,
+    asin: Math.asin,
+    atan: Math.atan,
+    cosh: Math.cosh,
+    sinh: Math.sinh,
+    tanh: Math.tanh,
+    acosh: Math.acosh,
+    asinh: Math.asinh,
+    atanh: Math.atanh,
+    cbrt: Math.cbrt,
+    exp: Math.exp,
+    expm1: Math.expm1,
+    log: Math.log,
+    log1p: Math.log1p,
+    log2: Math.log2,
+    log10: Math.log10,
+    atan2: Math.atan2,
+    hypot: Math.hypot,
+    pow: Math.pow,
+    fmod: (x, y) => x % y,
+  };
 
-    const typed_arrays =
-      [Float32Array, Float64Array, Int8Array, Uint8Array, Int16Array,
-       Uint16Array, Int32Array, Int32Array, Int32Array, Int32Array,
-       Float32Array, Float64Array, Uint8Array, Uint8ClampedArray]
+  const typed_arrays = [
+    Float32Array,
+    Float64Array,
+    Int8Array,
+    Uint8Array,
+    Int16Array,
+    Uint16Array,
+    Int32Array,
+    Int32Array,
+    Int32Array,
+    Int32Array,
+    Float32Array,
+    Float64Array,
+    Uint8Array,
+    Uint8ClampedArray,
+  ];
 
-    const fs = isNode&&require('node:fs')
+  const fs = isNode && require("node:fs");
 
-    const fs_cst = fs?.constants;
+  const fs_cst = fs?.constants;
 
-    const open_flags =
-      fs?[fs_cst.RDONLY,fs_cst.O_WRONLY,fs_cst.O_APPEND,fs_cst.O_CREAT,
-          fs_cst.O_TRUNC,fs_cst.O_EXCL,fs_cst.O_NONBLOCK]:[]
+  const open_flags = fs
+    ? [
+        fs_cst.RDONLY,
+        fs_cst.O_WRONLY,
+        fs_cst.O_APPEND,
+        fs_cst.O_CREAT,
+        fs_cst.O_TRUNC,
+        fs_cst.O_EXCL,
+        fs_cst.O_NONBLOCK,
+      ]
+    : [];
 
-    var out_channels =
-      { map : new WeakMap(), set : new Set(),
-        finalization :
-          new FinalizationRegistry ((ref)=>out_channels.set.delete(ref)) };
+  var out_channels = {
+    map: new WeakMap(),
+    set: new Set(),
+    finalization: new FinalizationRegistry((ref) =>
+      out_channels.set.delete(ref),
+    ),
+  };
 
-    function register_channel (ch) {
-      const ref = new WeakRef (ch);
-      out_channels.map.set(ch, ref);
-      out_channels.set.add(ref);
-      out_channels.finalization.register(ch, ref, ch);
-    }
+  function register_channel(ch) {
+    const ref = new WeakRef(ch);
+    out_channels.map.set(ch, ref);
+    out_channels.set.add(ref);
+    out_channels.finalization.register(ch, ref, ch);
+  }
 
-    function unregister_channel (ch) {
-      const ref = out_channels.map.get(ch);
-      if (ref) {
-        out_channels.map.delete(ch);
-        out_channels.set.delete(ref);
-        out_channels.finalization.unregister(ch);
-      }
+  function unregister_channel(ch) {
+    const ref = out_channels.map.get(ch);
+    if (ref) {
+      out_channels.map.delete(ch);
+      out_channels.set.delete(ref);
+      out_channels.finalization.unregister(ch);
     }
+  }
 
-    function channel_list () {
-      return [...out_channels.set].map((ref) => ref.deref()).filter((ch)=>ch);
-    }
+  function channel_list() {
+    return [...out_channels.set].map((ref) => ref.deref()).filter((ch) => ch);
+  }
 
-    var start_fiber
+  var start_fiber;
 
-    function wrap_fun (t,f,a) {
-       // Don't wrap if js-promise-integration is not enabled
-       // There is no way to check this without calling WebAssembly.Function
-       try {
-         return new WebAssembly.Function(t,f,a)
-       } catch (e) {
-         return f
-       }
+  function wrap_fun(t, f, a) {
+    // Don't wrap if js-promise-integration is not enabled
+    // There is no way to check this without calling WebAssembly.Function
+    try {
+      return new WebAssembly.Function(t, f, a);
+    } catch (e) {
+      return f;
     }
+  }
 
-    const decoder = new TextDecoder('utf-8', {ignoreBOM: 1});
-    const encoder = new TextEncoder;
+  const decoder = new TextDecoder("utf-8", { ignoreBOM: 1 });
+  const encoder = new TextEncoder();
 
-    function hash_int(h,d) {
-      d = Math.imul(d, 0xcc9e2d51|0);
-      d = (d << 15) | (d >>> 17); // ROTL32(d, 15);
-      d = Math.imul(d, 0x1b873593);
-      h ^= d;
-      h = (h << 13) | (h >>> 19);   //ROTL32(h, 13);
-      return (((h + (h << 2))|0) + (0xe6546b64|0))|0;
-    }
-    function hash_string(h,s) {
-      for (var i = 0; i < s.length; i++) h = hash_int(h,s.charCodeAt(i));
-      return h ^ s.length;
-    }
+  function hash_int(h, d) {
+    d = Math.imul(d, 0xcc9e2d51 | 0);
+    d = (d << 15) | (d >>> 17); // ROTL32(d, 15);
+    d = Math.imul(d, 0x1b873593);
+    h ^= d;
+    h = (h << 13) | (h >>> 19); //ROTL32(h, 13);
+    return (((h + (h << 2)) | 0) + (0xe6546b64 | 0)) | 0;
+  }
+  function hash_string(h, s) {
+    for (var i = 0; i < s.length; i++) h = hash_int(h, s.charCodeAt(i));
+    return h ^ s.length;
+  }
 
-    const bindings =
-        {jstag:
-         WebAssembly.JSTag||
-         // ZZZ not supported in Firefox yet
-         new WebAssembly.Tag({parameters:['externref'],results:[]}),
-         identity:(x)=>x,
-         from_bool:(x)=>!!x,
-         get:(x,y)=>x[y],
-         set:(x,y,z)=>x[y]=z,
-         delete:(x,y)=>delete x[y],
-         instanceof:(x,y)=>x instanceof y,
-         typeof:(x)=>typeof x,
-         equals:(x,y)=>x==y,
-         strict_equals:(x,y)=>x===y,
-         fun_call:(f,o,args)=>f.apply(o,args),
-         meth_call:(o,f,args)=>o[f].apply(o,args),
-         new_array:(n)=>new Array(n),
-         new_obj:()=>({}),
-         new:(c,args)=>new c(...args),
-         global_this:globalThis,
-         iter_props:(o,f)=>{for (var nm in o) if(o.hasOwn(nm)) f(nm)},
-         array_length:(a)=>a.length,
-         array_get:(a,i)=>a[i],
-         array_set:(a,i,v)=>a[i]=v,
-         read_string:(l)=>
-           decoder.decode(new Uint8Array(buffer, 0, l)),
-         read_string_stream:(l, stream)=>
-           decoder.decode(new Uint8Array(buffer, 0, l), {stream}),
-         append_string:(s1,s2)=>s1+s2,
-         write_string:(s)=>{
-           var start = 0, len = s.length;
-           for(;;) {
-             const {read,written} = encoder.encodeInto(s.slice(start), out_buffer);
-             len -= read;
-             if (!len) return written;
-             caml_extract_string(written);
-             start += read;
-           }
-         },
-         ta_create:(k,sz)=> new(typed_arrays[k])(sz),
-         ta_normalize:(a)=>
-           a instanceof Uint32Array?
-           new Int32Array(a.buffer,a.byteOffset,a.length):a,
-         ta_kind:(a)=>typed_arrays.findIndex((c)=>a instanceof c),
-         ta_length:(a)=>a.length,
-         ta_get_f64:(a,i)=>a[i],
-         ta_get_f32:(a,i)=>a[i],
-         ta_get_i32:(a,i)=>a[i],
-         ta_get_i16:(a,i)=>a[i],
-         ta_get_ui16:(a,i)=>a[i],
-         ta_get_i8:(a,i)=>a[i],
-         ta_get_ui8:(a,i)=>a[i],
-         ta_set_f64:(a,i,v)=>a[i]=v,
-         ta_set_f32:(a,i,v)=>a[i]=v,
-         ta_set_i32:(a,i,v)=>a[i]=v,
-         ta_set_i16:(a,i,v)=>a[i]=v,
-         ta_set_ui16:(a,i,v)=>a[i]=v,
-         ta_set_i8:(a,i,v)=>a[i]=v,
-         ta_set_ui8:(a,i,v)=>a[i]=v,
-         ta_fill:(a,v)=>a.fill(v),
-         ta_blit:(s,d)=>d.set(s),
-         ta_subarray:(a,i,j)=>a.subarray(i,j),
-         ta_set:(a,b,i)=>a.set(b,i),
-         ta_new:(len)=>new Uint8Array(len),
-         ta_copy:(ta,t,s,n)=>ta.copyWithin(t,s,n),
-         ta_bytes:(a)=>
-           new Uint8Array(a.buffer, a.byteOffset,
-                          a.length * a.BYTES_PER_ELEMENT),
-         wrap_callback:(f)=>function (){
-             var n = arguments.length;
-             if(n > 0) {
-                 var args = new Array(n);
-                 for (var i = 0; i < n; i++) args[i] = arguments[i];
-             } else {
-                 args = [undefined];
-             }
-             return caml_callback(f, args.length, args, 1);
-         },
-         wrap_callback_args:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n);
-             for (var i = 0; i < n; i++) args[i] = arguments[i];
-             return caml_callback(f, 1, [args], 0);
-         },
-         wrap_callback_strict:(arity,f)=>function (){
-             var n = arguments.length;
-             var args = new Array(arity);
-             var len = Math.min(arguments.length, arity)
-             for (var i = 0; i < len; i++) args[i] = arguments[i];
-             return caml_callback(f, arity, args, 0);
-         },
-         wrap_callback_unsafe:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n);
-             for (var i = 0; i < n; i++) args[i] = arguments[i];
-             return caml_callback(f, args.length, args, 2);
-         },
-         wrap_meth_callback:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n+1);
-             args[0] = this;
-             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
-             return caml_callback(f, args.length, args, 1);
-         },
-         wrap_meth_callback_args:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n);
-             for (var i = 0; i < n; i++) args[i] = arguments[i];
-             return caml_callback(f, 2, [this, args], 0);
-         },
-         wrap_meth_callback_strict:(arity,f)=>function (){
-             var args = new Array(arity + 1);
-             var len = Math.min(arguments.length, arity)
-             args[0] = this;
-             for (var i = 0; i < len; i++) args[i+1] = arguments[i];
-             return caml_callback(f, args.length, args, 0);
-         },
-         wrap_meth_callback_unsafe:(f)=>function (){
-             var n = arguments.length;
-             var args = new Array(n+1);
-             args[0] = this;
-             for (var i = 0; i < n; i++) args[i+1] = arguments[i];
-             return caml_callback(f, args.length, args, 2);
-         },
-         wrap_fun_arguments:(f)=>function(){return f(arguments)},
-         format_float:(prec, conversion, pad, x)=>{
-           function toFixed(x,dp) {
-             if (Math.abs(x) < 1.0) {
-               return x.toFixed(dp);
-             } else {
-               var e = Number.parseInt(x.toString().split('+')[1]);
-               if (e > 20) {
-                 e -= 20;
-                 x /= Math.pow(10,e);
-                 x += (new Array(e+1)).join('0');
-                 if(dp > 0) {
-                   x = x + '.' + (new Array(dp+1)).join('0');
-                 }
-                 return x;
-               }
-               else return x.toFixed(dp)
-             }
-           }
-           switch (conversion) {
-           case 0:
-             var s = x.toExponential(prec);
-             // exponent should be at least two digits
-             var i = s.length;
-             if (s.charAt(i - 3) == 'e')
-               s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
-             break;
-           case 1:
-             s = toFixed(x, prec); break;
-           case 2:
-             prec = prec?prec:1;
-             s = x.toExponential(prec - 1);
-             var j = s.indexOf('e');
-             var exp = +s.slice(j + 1);
-             if (exp < -4 || x >= 1e21 || x.toFixed(0).length > prec) {
-               // remove trailing zeroes
-               var i = j - 1; while (s.charAt(i) == '0') i--;
-               if (s.charAt(i) == '.') i--;
-               s = s.slice(0, i + 1) + s.slice(j);
-               i = s.length;
-               if (s.charAt(i - 3) == 'e')
-                 s = s.slice (0, i - 1) + '0' + s.slice (i - 1);
-               break;
-             } else {
-               var p = prec;
-               if (exp < 0) { p -= exp + 1; s = x.toFixed(p); }
-               else while (s = x.toFixed(p), s.length > prec + 1) p--;
-               if (p) {
-                 // remove trailing zeroes
-                 var i = s.length - 1; while (s.charAt(i) == '0') i--;
-                 if (s.charAt(i) == '.') i--;
-                 s = s.slice(0, i + 1);
-               }
-             }
-             break;
-           }
-           return pad?" "+s:s
-         },
-         gettimeofday:()=>(new Date()).getTime() / 1000,
-         gmtime:(t)=>{
-           var d = new Date (t * 1000);
-           var d_num = d.getTime();
-           var januaryfirst =
-             (new Date(Date.UTC(d.getUTCFullYear(), 0, 1))).getTime();
-           var doy = Math.floor((d_num - januaryfirst) / 86400000);
-           return caml_alloc_tm(d.getUTCSeconds(), d.getUTCMinutes(),
-                                d.getUTCHours(), d.getUTCDate(),
-                                d.getUTCMonth(), d.getUTCFullYear() - 1900,
-                                d.getUTCDay(), doy, false)
-         },
-         localtime:(t)=>{
-           var d = new Date (t * 1000);
-           var d_num = d.getTime();
-           var januaryfirst = (new Date(d.getFullYear(), 0, 1)).getTime();
-           var doy = Math.floor((d_num - januaryfirst) / 86400000);
-           var jan = new Date(d.getFullYear(), 0, 1);
-           var jul = new Date(d.getFullYear(), 6, 1);
-           var stdTimezoneOffset =
-               Math.max(jan.getTimezoneOffset(), jul.getTimezoneOffset());
-           return caml_alloc_tm(d.getSeconds(), d.getMinutes(), d.getHours(),
-                                d.getDate(), d.getMonth(),
-                                d.getFullYear() - 1900,
-                                d.getDay(), doy,
-                                (d.getTimezoneOffset() < stdTimezoneOffset))
-         },
-         mktime:(year,month,day,h,m,s)=>new Date(year,month,day,h,m,s).getTime(),
-         random_seed:()=>crypto.getRandomValues(new Int32Array(12)),
-         open:(p,flags,perm)=>
-           fs.openSync(p,open_flags.reduce((f,v,i)=>(flags&(1<<i))?(f|v):f,0),
-                       perm),
-         close:(fd)=>fs.closeSync(fd),
-         write:(fd,b,o,l,p)=>fs?fs.writeSync(fd,b,o,l,p==null?p:Number(p)):(console[fd==2?'error':'log'](typeof b=='string'?b:decoder.decode(b.slice(o,o+l))),l),
-         read:(fd,b,o,l,p)=>fs.readSync(fd,b,o,l,p),
-         file_size:(fd)=>fs.fstatSync(fd,{bigint:true}).size,
-         register_channel,
-         unregister_channel,
-         channel_list,
-         exit:(n)=>isNode&&process.exit(n),
-         argv:()=>isNode?process.argv.slice(1):['a.out'],
-         getenv:(n)=>isNode?process.env[n]:null,
-         system:(c)=>{
-           var res = require('node:child_process').spawnSync(c,{shell:true, stdio: 'inherit'});
-           if(res.error)throw res.error; return res.signal?255:res.status
-         },
-         time:()=>performance.now(),
-         getcwd:()=>isNode?process.cwd():'/static',
-         chdir:(x)=>process.chdir(x),
-         mkdir:(p,m)=>fs.mkdirSync(p,m),
-         unlink:(p)=>fs.unlinkSync(p),
-         readdir:(p)=>fs.readdirSync(p),
-         file_exists:(p)=>+fs.existsSync(p),
-         rename:(o,n)=>fs.renameSync(o, n),
-         throw:(e)=>{throw e},
-         start_fiber:(x)=>start_fiber(x),
-         suspend_fiber:
-         wrap_fun(
-             {parameters: ['externref','funcref','eqref'], results: ['eqref']},
-             ((f, env)=>new Promise((k)=> f(k, env))),
-             {suspending:"first"}),
-         resume_fiber:(k,v)=>k(v),
-         weak_new:(v)=>new WeakRef(v),
-         weak_deref:(w)=>{var v = w.deref(); return v==undefined?null:v},
-         weak_map_new:()=>new WeakMap,
-         map_new:()=>new Map,
-         map_get:(m,x)=>{var v = m.get(x); return v==undefined?null:v},
-         map_set:(m,x,v)=>m.set(x,v),
-         map_delete:(m,x)=>m.delete(x),
-         log:(x)=>console.log('ZZZZZ', x)
+  const bindings = {
+    jstag:
+      WebAssembly.JSTag ||
+      // ZZZ not supported in Firefox yet
+      new WebAssembly.Tag({ parameters: ["externref"], results: [] }),
+    identity: (x) => x,
+    from_bool: (x) => !!x,
+    get: (x, y) => x[y],
+    set: (x, y, z) => (x[y] = z),
+    delete: (x, y) => delete x[y],
+    instanceof: (x, y) => x instanceof y,
+    typeof: (x) => typeof x,
+    equals: (x, y) => x == y,
+    strict_equals: (x, y) => x === y,
+    fun_call: (f, o, args) => f.apply(o, args),
+    meth_call: (o, f, args) => o[f].apply(o, args),
+    new_array: (n) => new Array(n),
+    new_obj: () => ({}),
+    new: (c, args) => new c(...args),
+    global_this: globalThis,
+    iter_props: (o, f) => {
+      for (var nm in o) if (o.hasOwn(nm)) f(nm);
+    },
+    array_length: (a) => a.length,
+    array_get: (a, i) => a[i],
+    array_set: (a, i, v) => (a[i] = v),
+    read_string: (l) => decoder.decode(new Uint8Array(buffer, 0, l)),
+    read_string_stream: (l, stream) =>
+      decoder.decode(new Uint8Array(buffer, 0, l), { stream }),
+    append_string: (s1, s2) => s1 + s2,
+    write_string: (s) => {
+      var start = 0,
+        len = s.length;
+      for (;;) {
+        const { read, written } = encoder.encodeInto(
+          s.slice(start),
+          out_buffer,
+        );
+        len -= read;
+        if (!len) return written;
+        caml_extract_string(written);
+        start += read;
+      }
+    },
+    ta_create: (k, sz) => new typed_arrays[k](sz),
+    ta_normalize: (a) =>
+      a instanceof Uint32Array
+        ? new Int32Array(a.buffer, a.byteOffset, a.length)
+        : a,
+    ta_kind: (a) => typed_arrays.findIndex((c) => a instanceof c),
+    ta_length: (a) => a.length,
+    ta_get_f64: (a, i) => a[i],
+    ta_get_f32: (a, i) => a[i],
+    ta_get_i32: (a, i) => a[i],
+    ta_get_i16: (a, i) => a[i],
+    ta_get_ui16: (a, i) => a[i],
+    ta_get_i8: (a, i) => a[i],
+    ta_get_ui8: (a, i) => a[i],
+    ta_set_f64: (a, i, v) => (a[i] = v),
+    ta_set_f32: (a, i, v) => (a[i] = v),
+    ta_set_i32: (a, i, v) => (a[i] = v),
+    ta_set_i16: (a, i, v) => (a[i] = v),
+    ta_set_ui16: (a, i, v) => (a[i] = v),
+    ta_set_i8: (a, i, v) => (a[i] = v),
+    ta_set_ui8: (a, i, v) => (a[i] = v),
+    ta_fill: (a, v) => a.fill(v),
+    ta_blit: (s, d) => d.set(s),
+    ta_subarray: (a, i, j) => a.subarray(i, j),
+    ta_set: (a, b, i) => a.set(b, i),
+    ta_new: (len) => new Uint8Array(len),
+    ta_copy: (ta, t, s, n) => ta.copyWithin(t, s, n),
+    ta_bytes: (a) =>
+      new Uint8Array(a.buffer, a.byteOffset, a.length * a.BYTES_PER_ELEMENT),
+    wrap_callback: (f) =>
+      function () {
+        var n = arguments.length;
+        if (n > 0) {
+          var args = new Array(n);
+          for (var i = 0; i < n; i++) args[i] = arguments[i];
+        } else {
+          args = [undefined];
         }
-    const string_ops =
-        {test:(v)=>+(typeof v==="string"),
-         compare:(s1,s2)=>(s1<s2)?-1:+(s1>s2),
-         hash:hash_string,
-         decodeStringFromUTF8Array:()=>"",
-         encodeStringToUTF8Array:()=>0}
-    const imports =
-        Object.assign({Math:math, bindings, js,
-                       "wasm:js-string":string_ops,
-                       "wasm:text-decoder":string_ops,
-                       "wasm:text-encoder":string_ops,
-                       env:{}},
-                      generated)
-    const options = { builtins: ['js-string', 'text-decoder', 'text-encoder'] }
-
-    function loadRelative(src) {
-      const path = require('node:path');
-      const f = path.join(path.dirname(require.main.filename),src);
-      return require('node:fs/promises').readFile(f)
-    }
-    function fetchRelative(src) {
-      const base = globalThis?.document?.currentScript?.src;
-      const url = base?new URL(src, base):src;
-      return fetch(url)
-    }
-    const loadCode= isNode?loadRelative:fetchRelative;
-    async function instantiateModule(code) {
-      return isNode?WebAssembly.instantiate(await code, imports, options)
-               :WebAssembly.instantiateStreaming(code,imports, options)
-    }
-    async function instantiateFromDir() {
-      imports.OCaml = {};
-      const deps = []
-      async function loadModule(module, isRuntime) {
-        const sync = module[1].constructor !== Array
-        async function instantiate () {
-          const code = loadCode(src + "/" + module[0] + ".wasm")
-          await Promise.all(sync?deps:module[1].map((i)=>deps[i]));
-          const wasmModule = await instantiateModule(code)
-          Object.assign(isRuntime?imports.env:imports.OCaml,
-                        wasmModule.instance.exports);
+        return caml_callback(f, args.length, args, 1);
+      },
+    wrap_callback_args: (f) =>
+      function () {
+        var n = arguments.length;
+        var args = new Array(n);
+        for (var i = 0; i < n; i++) args[i] = arguments[i];
+        return caml_callback(f, 1, [args], 0);
+      },
+    wrap_callback_strict: (arity, f) =>
+      function () {
+        var n = arguments.length;
+        var args = new Array(arity);
+        var len = Math.min(arguments.length, arity);
+        for (var i = 0; i < len; i++) args[i] = arguments[i];
+        return caml_callback(f, arity, args, 0);
+      },
+    wrap_callback_unsafe: (f) =>
+      function () {
+        var n = arguments.length;
+        var args = new Array(n);
+        for (var i = 0; i < n; i++) args[i] = arguments[i];
+        return caml_callback(f, args.length, args, 2);
+      },
+    wrap_meth_callback: (f) =>
+      function () {
+        var n = arguments.length;
+        var args = new Array(n + 1);
+        args[0] = this;
+        for (var i = 0; i < n; i++) args[i + 1] = arguments[i];
+        return caml_callback(f, args.length, args, 1);
+      },
+    wrap_meth_callback_args: (f) =>
+      function () {
+        var n = arguments.length;
+        var args = new Array(n);
+        for (var i = 0; i < n; i++) args[i] = arguments[i];
+        return caml_callback(f, 2, [this, args], 0);
+      },
+    wrap_meth_callback_strict: (arity, f) =>
+      function () {
+        var args = new Array(arity + 1);
+        var len = Math.min(arguments.length, arity);
+        args[0] = this;
+        for (var i = 0; i < len; i++) args[i + 1] = arguments[i];
+        return caml_callback(f, args.length, args, 0);
+      },
+    wrap_meth_callback_unsafe: (f) =>
+      function () {
+        var n = arguments.length;
+        var args = new Array(n + 1);
+        args[0] = this;
+        for (var i = 0; i < n; i++) args[i + 1] = arguments[i];
+        return caml_callback(f, args.length, args, 2);
+      },
+    wrap_fun_arguments: (f) =>
+      function () {
+        return f(arguments);
+      },
+    format_float: (prec, conversion, pad, x) => {
+      function toFixed(x, dp) {
+        if (Math.abs(x) < 1.0) {
+          return x.toFixed(dp);
+        } else {
+          var e = Number.parseInt(x.toString().split("+")[1]);
+          if (e > 20) {
+            e -= 20;
+            x /= Math.pow(10, e);
+            x += new Array(e + 1).join("0");
+            if (dp > 0) {
+              x = x + "." + new Array(dp + 1).join("0");
+            }
+            return x;
+          } else return x.toFixed(dp);
         }
-        const promise = instantiate();
-        deps.push(promise);
-        return promise;
       }
-      async function loadModules(lst) {
-        for (const module of lst) {
-          await loadModule(module);
-        }
+      switch (conversion) {
+        case 0:
+          var s = x.toExponential(prec);
+          // exponent should be at least two digits
+          var i = s.length;
+          if (s.charAt(i - 3) == "e")
+            s = s.slice(0, i - 1) + "0" + s.slice(i - 1);
+          break;
+        case 1:
+          s = toFixed(x, prec);
+          break;
+        case 2:
+          prec = prec ? prec : 1;
+          s = x.toExponential(prec - 1);
+          var j = s.indexOf("e");
+          var exp = +s.slice(j + 1);
+          if (exp < -4 || x >= 1e21 || x.toFixed(0).length > prec) {
+            // remove trailing zeroes
+            var i = j - 1;
+            while (s.charAt(i) == "0") i--;
+            if (s.charAt(i) == ".") i--;
+            s = s.slice(0, i + 1) + s.slice(j);
+            i = s.length;
+            if (s.charAt(i - 3) == "e")
+              s = s.slice(0, i - 1) + "0" + s.slice(i - 1);
+            break;
+          } else {
+            var p = prec;
+            if (exp < 0) {
+              p -= exp + 1;
+              s = x.toFixed(p);
+            } else while (((s = x.toFixed(p)), s.length > prec + 1)) p--;
+            if (p) {
+              // remove trailing zeroes
+              var i = s.length - 1;
+              while (s.charAt(i) == "0") i--;
+              if (s.charAt(i) == ".") i--;
+              s = s.slice(0, i + 1);
+            }
+          }
+          break;
+      }
+      return pad ? " " + s : s;
+    },
+    gettimeofday: () => new Date().getTime() / 1000,
+    gmtime: (t) => {
+      var d = new Date(t * 1000);
+      var d_num = d.getTime();
+      var januaryfirst = new Date(Date.UTC(d.getUTCFullYear(), 0, 1)).getTime();
+      var doy = Math.floor((d_num - januaryfirst) / 86400000);
+      return caml_alloc_tm(
+        d.getUTCSeconds(),
+        d.getUTCMinutes(),
+        d.getUTCHours(),
+        d.getUTCDate(),
+        d.getUTCMonth(),
+        d.getUTCFullYear() - 1900,
+        d.getUTCDay(),
+        doy,
+        false,
+      );
+    },
+    localtime: (t) => {
+      var d = new Date(t * 1000);
+      var d_num = d.getTime();
+      var januaryfirst = new Date(d.getFullYear(), 0, 1).getTime();
+      var doy = Math.floor((d_num - januaryfirst) / 86400000);
+      var jan = new Date(d.getFullYear(), 0, 1);
+      var jul = new Date(d.getFullYear(), 6, 1);
+      var stdTimezoneOffset = Math.max(
+        jan.getTimezoneOffset(),
+        jul.getTimezoneOffset(),
+      );
+      return caml_alloc_tm(
+        d.getSeconds(),
+        d.getMinutes(),
+        d.getHours(),
+        d.getDate(),
+        d.getMonth(),
+        d.getFullYear() - 1900,
+        d.getDay(),
+        doy,
+        d.getTimezoneOffset() < stdTimezoneOffset,
+      );
+    },
+    mktime: (year, month, day, h, m, s) =>
+      new Date(year, month, day, h, m, s).getTime(),
+    random_seed: () => crypto.getRandomValues(new Int32Array(12)),
+    open: (p, flags, perm) =>
+      fs.openSync(
+        p,
+        open_flags.reduce((f, v, i) => (flags & (1 << i) ? f | v : f), 0),
+        perm,
+      ),
+    close: (fd) => fs.closeSync(fd),
+    write: (fd, b, o, l, p) =>
+      fs
+        ? fs.writeSync(fd, b, o, l, p == null ? p : Number(p))
+        : (console[fd == 2 ? "error" : "log"](
+            typeof b == "string" ? b : decoder.decode(b.slice(o, o + l)),
+          ),
+          l),
+    read: (fd, b, o, l, p) => fs.readSync(fd, b, o, l, p),
+    file_size: (fd) => fs.fstatSync(fd, { bigint: true }).size,
+    register_channel,
+    unregister_channel,
+    channel_list,
+    exit: (n) => isNode && process.exit(n),
+    argv: () => (isNode ? process.argv.slice(1) : ["a.out"]),
+    getenv: (n) => (isNode ? process.env[n] : null),
+    system: (c) => {
+      var res = require("node:child_process").spawnSync(c, {
+        shell: true,
+        stdio: "inherit",
+      });
+      if (res.error) throw res.error;
+      return res.signal ? 255 : res.status;
+    },
+    time: () => performance.now(),
+    getcwd: () => (isNode ? process.cwd() : "/static"),
+    chdir: (x) => process.chdir(x),
+    mkdir: (p, m) => fs.mkdirSync(p, m),
+    unlink: (p) => fs.unlinkSync(p),
+    readdir: (p) => fs.readdirSync(p),
+    file_exists: (p) => +fs.existsSync(p),
+    rename: (o, n) => fs.renameSync(o, n),
+    throw: (e) => {
+      throw e;
+    },
+    start_fiber: (x) => start_fiber(x),
+    suspend_fiber: wrap_fun(
+      { parameters: ["externref", "funcref", "eqref"], results: ["eqref"] },
+      (f, env) => new Promise((k) => f(k, env)),
+      { suspending: "first" },
+    ),
+    resume_fiber: (k, v) => k(v),
+    weak_new: (v) => new WeakRef(v),
+    weak_deref: (w) => {
+      var v = w.deref();
+      return v == undefined ? null : v;
+    },
+    weak_map_new: () => new WeakMap(),
+    map_new: () => new Map(),
+    map_get: (m, x) => {
+      var v = m.get(x);
+      return v == undefined ? null : v;
+    },
+    map_set: (m, x, v) => m.set(x, v),
+    map_delete: (m, x) => m.delete(x),
+    log: (x) => console.log("ZZZZZ", x),
+  };
+  const string_ops = {
+    test: (v) => +(typeof v === "string"),
+    compare: (s1, s2) => (s1 < s2 ? -1 : +(s1 > s2)),
+    hash: hash_string,
+    decodeStringFromUTF8Array: () => "",
+    encodeStringToUTF8Array: () => 0,
+  };
+  const imports = Object.assign(
+    {
+      Math: math,
+      bindings,
+      js,
+      "wasm:js-string": string_ops,
+      "wasm:text-decoder": string_ops,
+      "wasm:text-encoder": string_ops,
+      env: {},
+    },
+    generated,
+  );
+  const options = { builtins: ["js-string", "text-decoder", "text-encoder"] };
+
+  function loadRelative(src) {
+    const path = require("node:path");
+    const f = path.join(path.dirname(require.main.filename), src);
+    return require("node:fs/promises").readFile(f);
+  }
+  function fetchRelative(src) {
+    const base = globalThis?.document?.currentScript?.src;
+    const url = base ? new URL(src, base) : src;
+    return fetch(url);
+  }
+  const loadCode = isNode ? loadRelative : fetchRelative;
+  async function instantiateModule(code) {
+    return isNode
+      ? WebAssembly.instantiate(await code, imports, options)
+      : WebAssembly.instantiateStreaming(code, imports, options);
+  }
+  async function instantiateFromDir() {
+    imports.OCaml = {};
+    const deps = [];
+    async function loadModule(module, isRuntime) {
+      const sync = module[1].constructor !== Array;
+      async function instantiate() {
+        const code = loadCode(src + "/" + module[0] + ".wasm");
+        await Promise.all(sync ? deps : module[1].map((i) => deps[i]));
+        const wasmModule = await instantiateModule(code);
+        Object.assign(
+          isRuntime ? imports.env : imports.OCaml,
+          wasmModule.instance.exports,
+        );
       }
-      await loadModule(link[0], 1);
-      if (link.length > 1) {
-        await loadModule(link[1]);
-        const workers = new Array(20).fill(link.slice(2).values()).map(loadModules);
-        await Promise.all(workers);
+      const promise = instantiate();
+      deps.push(promise);
+      return promise;
+    }
+    async function loadModules(lst) {
+      for (const module of lst) {
+        await loadModule(module);
       }
-      return {instance:{exports: Object.assign(imports.env, imports.OCaml)}}
     }
-    const wasmModule = await instantiateFromDir()
+    await loadModule(link[0], 1);
+    if (link.length > 1) {
+      await loadModule(link[1]);
+      const workers = new Array(20)
+        .fill(link.slice(2).values())
+        .map(loadModules);
+      await Promise.all(workers);
+    }
+    return { instance: { exports: Object.assign(imports.env, imports.OCaml) } };
+  }
+  const wasmModule = await instantiateFromDir();
 
-    var {caml_callback, caml_alloc_tm, caml_start_fiber,
-         caml_handle_uncaught_exception, caml_buffer,
-         caml_extract_string, _initialize} =
-        wasmModule.instance.exports;
+  var {
+    caml_callback,
+    caml_alloc_tm,
+    caml_start_fiber,
+    caml_handle_uncaught_exception,
+    caml_buffer,
+    caml_extract_string,
+    _initialize,
+  } = wasmModule.instance.exports;
 
-    var buffer = caml_buffer?.buffer
-    var out_buffer = buffer&&new Uint8Array(buffer,0,buffer.length)
+  var buffer = caml_buffer?.buffer;
+  var out_buffer = buffer && new Uint8Array(buffer, 0, buffer.length);
 
-    start_fiber = wrap_fun(
-        {parameters: ['eqref'], results: ['externref']},
-        caml_start_fiber, {promising: 'first'}
-    )
-    var _initialize = wrap_fun(
-        {parameters: [], results: ['externref']},
-        _initialize, {promising: 'first'}
-    )
-    var process = globalThis.process;
-    if(process && process.on) {
-        process.on('uncaughtException', (err, origin) =>
-            caml_handle_uncaught_exception(err))
-    }
-    else if(globalThis.addEventListener){
-        globalThis.addEventListener('error', event=>
-            event.error&&caml_handle_uncaught_exception(event.error))
-    }
-    await _initialize();
-})
+  start_fiber = wrap_fun(
+    { parameters: ["eqref"], results: ["externref"] },
+    caml_start_fiber,
+    { promising: "first" },
+  );
+  var _initialize = wrap_fun(
+    { parameters: [], results: ["externref"] },
+    _initialize,
+    { promising: "first" },
+  );
+  var process = globalThis.process;
+  if (process && process.on) {
+    process.on("uncaughtException", (err, origin) =>
+      caml_handle_uncaught_exception(err),
+    );
+  } else if (globalThis.addEventListener) {
+    globalThis.addEventListener(
+      "error",
+      (event) => event.error && caml_handle_uncaught_exception(event.error),
+    );
+  }
+  await _initialize();
+};

From 67d2add12dcd93737bce2b31fefa9de50081836b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 16:39:30 +0200
Subject: [PATCH 382/481] Disable BLAKE2b tests for now

---
 compiler/tests-ocaml/lib-digest/dune | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/compiler/tests-ocaml/lib-digest/dune b/compiler/tests-ocaml/lib-digest/dune
index e68a7bae95..253e0bac42 100644
--- a/compiler/tests-ocaml/lib-digest/dune
+++ b/compiler/tests-ocaml/lib-digest/dune
@@ -22,7 +22,10 @@
  (names digests)
  (libraries)
  (enabled_if
-  (>= %{ocaml_version} 5.2))
+  (and
+   (>= %{ocaml_version} 5.2)
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (modules digests)
  (modes js))
 
@@ -30,6 +33,9 @@
  (alias runtest)
  (deps digests.bc.js)
  (enabled_if
-  (>= %{ocaml_version} 5.2))
+  (and
+   (>= %{ocaml_version} 5.2)
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (action
   (run node ./digests.bc.js)))

From eb1128b5fc6dc95510e3306db6cdaa2788d87eb2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 16:39:56 +0200
Subject: [PATCH 383/481] CI: test with OCaml 5.02

---
 .github/workflows/build-wasm_of_ocaml.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 061bc0c4bd..7736d5c6e0 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -19,6 +19,7 @@ jobs:
           - 4.14.x
           - 5.00.x
           - 5.01.x
+          - 5.02.x
 
     runs-on: ${{ matrix.os }}
 

From 86d3f4b6346f627fea6bc45dffee4f0684033b2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 4 Oct 2024 16:44:02 +0200
Subject: [PATCH 384/481] CI: test with MacOS

---
 .github/workflows/build-wasm_of_ocaml.yml | 23 +++++++++++++++++++----
 tools/node_wrapper.sh                     |  2 +-
 2 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 7736d5c6e0..26e5aafa0c 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -20,6 +20,9 @@ jobs:
           - 5.00.x
           - 5.01.x
           - 5.02.x
+        include:
+          - os: macos-latest
+            ocaml-compiler: 5.02.x
 
     runs-on: ${{ matrix.os }}
 
@@ -51,10 +54,14 @@ jobs:
           submodules: true
           ref: version_118
 
-      - name: Install ninja
-        if: steps.cache-binaryen.outputs.cache-hit != 'true'
+      - name: Install ninja (Ubuntu)
+        if: matrix.os == 'ubuntu-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
         run: sudo apt-get install ninja-build
 
+      - name: Install ninja (MacOS)
+        if: matrix.os == 'macos-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
+        run: brew install ninja
+
       - name: Build binaryen
         if: steps.cache-binaryen.outputs.cache-hit != 'true'
         working-directory: ./binaryen
@@ -81,6 +88,7 @@ jobs:
             ~/.opam
             _opam
             /opt/hostedtoolcache/opam
+            /Users/runner/hostedtoolcache/opam
           key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
 
       - name: Install OCaml ${{ matrix.ocaml-compiler }}
@@ -92,14 +100,20 @@ jobs:
           opam-depext: true
           opam-depext-flags: --with-test
 
-      - name: Install packages
-        if: steps.cache-ocaml.outputs.cache-hit
+      - name: Install packages (Ubuntu)
+        if: matrix.os == 'ubuntu-latest' && steps.cache-ocaml.outputs.cache-hit
         run: sudo apt-get install bubblewrap
 
+      - name: Install packages (MacOs)
+        if: matrix.os == 'macos-latest' && steps.cache-ocaml.outputs.cache-hit
+        # for graphics
+        run: brew install xquartz
+
       - name: Set opam path
         if: steps.cache-ocaml.outputs.cache-hit
         run: |
           echo /opt/hostedtoolcache/opam/*/x86_64 >> $GITHUB_PATH
+          echo /Users/runner/hostedtoolcache/opam/*/arm64 >> $GITHUB_PATH
 
       - name: Cache OCaml
         if: steps.cache-ocaml.outputs.cache-hit != 'true'
@@ -109,6 +123,7 @@ jobs:
             ~/.opam
             _opam
             /opt/hostedtoolcache/opam
+            /Users/runner/hostedtoolcache/opam
           key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
 
       - name: Checkout code
diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh
index 8e09e597e7..9912795db0 100755
--- a/tools/node_wrapper.sh
+++ b/tools/node_wrapper.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively
-exec node --experimental-wasm-imported-strings --experimental-wasm-stack-switching --stack-size=7000 "$@"
+exec node --experimental-wasm-imported-strings --experimental-wasm-stack-switching --stack-size=10000 "$@"

From 62fc9ed33b255ff1d504bc342b15a62db14408a2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 8 Oct 2024 09:28:43 +0200
Subject: [PATCH 385/481] CI fix

---
 .github/workflows/build-wasm_of_ocaml.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 63704b86c7..2bf59ab4a9 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -133,7 +133,7 @@ jobs:
 
       - name: Pin faked binaryen-bin package
         # It's faster to use a cached version
-        working-directory: ./wasm_of_ocaml
+        working-directory: ./binaryen
         run: |
           echo opam-version: '"2.0"' > binaryen-bin.opam
           opam pin -n .

From 090b7b29fc17a39353cbbf9ee7933d7371db93cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 8 Oct 2024 13:40:33 +0200
Subject: [PATCH 386/481] Runtime: typos

---
 runtime/wasm/bigarray.wat | 2 +-
 runtime/wasm/stdlib.wat   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index cdedf6db40..b049c59aff 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -2137,7 +2137,7 @@
                   (ref.i31 (array.get $string (local.get $s) (local.get $i))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop))))
-      (call $wrap (extern.internalize (local.get $ta))))
+      (call $wrap (any.convert_extern (local.get $ta))))
 
    (func (export "caml_ba_get_kind") (param (ref eq)) (result i32)
       (struct.get $bigarray $ba_kind (ref.cast (ref $bigarray) (local.get 0))))
diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat
index 0d12af292a..89ca56e627 100644
--- a/runtime/wasm/stdlib.wat
+++ b/runtime/wasm/stdlib.wat
@@ -54,7 +54,7 @@
          (field (mut (ref eq)))
          (field (mut (ref null $assoc)))))
 
-   (type $assoc_array (array (field (mut (ref null $assoc)))))
+   (type $assoc_array (array (mut (ref null $assoc))))
 
    (global $Named_value_size i32 (i32.const 13))
 

From 364c37c2705176e6227b6407063a9af5f05568f5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 8 Oct 2024 15:36:32 +0200
Subject: [PATCH 387/481] WAT output: no longer emit 'pop' instructions

This instruction is not standard and the Binaryen parser no longer needs it.
---
 compiler/lib/wasm/wa_wat_output.ml | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index a01874b4ea..1d66b078dc 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -19,8 +19,6 @@
 open! Stdlib
 open Wa_ast
 
-let target = `Binaryen (*`Reference*)
-
 let assign_names ?(reversed = true) f names =
   let used = ref StringSet.empty in
   let counts = Hashtbl.create 101 in
@@ -394,10 +392,7 @@ let expression_or_instructions ctx st in_function =
         ]
     | MemoryGrow (_, e) -> [ List (Atom "memory.grow" :: expression e) ]
     | Seq (l, e) -> instructions l @ expression e
-    | Pop ty -> (
-        match target with
-        | `Binaryen -> [ List [ Atom "pop"; value_type st ty ] ]
-        | `Reference -> [])
+    | Pop _ -> []
     | RefFunc symb ->
         if in_function then reference_function ctx symb;
         [ List [ Atom "ref.func"; index st.func_names symb ] ]

From 5f736b1d10590ae2457f3630bd02aa5bddeeb9cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 8 Oct 2024 15:42:35 +0200
Subject: [PATCH 388/481] Use Js_of_ocaml_compiler.Structure instead of
 Wa_structure

Module Structure was basically copied from Wa_structure.
---
 compiler/lib/generate.ml           |   2 +-
 compiler/lib/structure.ml          |   4 +-
 compiler/lib/structure.mli         |   2 +
 compiler/lib/wasm/wa_generate.ml   |  18 +--
 compiler/lib/wasm/wa_globalize.ml  |   2 +-
 compiler/lib/wasm/wa_globalize.mli |   2 +-
 compiler/lib/wasm/wa_structure.ml  | 251 -----------------------------
 compiler/lib/wasm/wa_structure.mli |  37 -----
 8 files changed, 17 insertions(+), 301 deletions(-)
 delete mode 100644 compiler/lib/wasm/wa_structure.ml
 delete mode 100644 compiler/lib/wasm/wa_structure.mli

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 3d1a0a6ee7..8ce83db0b7 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1642,7 +1642,7 @@ and compile_block_no_loop st queue (pc : Addr.t) ~fall_through scope_stack =
         | true -> never, [ J.Labelled_statement (l, (J.Block inner, J.N)), J.N ] @ code
         | false -> never, inner @ code)
   in
-  let never_after, after = loop ~scope_stack ~fall_through (List.rev new_scopes) in
+  let never_after, after = loop ~scope_stack ~fall_through new_scopes in
   never_after, seq @ after
 
 and compile_decision_tree kind st scope_stack loc cx dtree ~fall_through =
diff --git a/compiler/lib/structure.ml b/compiler/lib/structure.ml
index 503b6021e4..3fe927bbbe 100644
--- a/compiler/lib/structure.ml
+++ b/compiler/lib/structure.ml
@@ -147,7 +147,9 @@ let is_loop_header g pc =
   Addr.Set.exists (fun pc' -> Hashtbl.find g.block_order pc' >= o) s
 
 let sort_in_post_order t l =
-  List.sort ~cmp:(fun a b -> compare (block_order t a) (block_order t b)) l
+  List.sort ~cmp:(fun a b -> compare (block_order t b) (block_order t a)) l
+
+let blocks_in_reverse_post_order g = g.reverse_post_order
 
 (*
 
diff --git a/compiler/lib/structure.mli b/compiler/lib/structure.mli
index 6278174c6f..1aa1a10940 100644
--- a/compiler/lib/structure.mli
+++ b/compiler/lib/structure.mli
@@ -21,4 +21,6 @@ val is_loop_header : t -> Addr.t -> bool
 
 val sort_in_post_order : t -> Addr.t list -> Addr.t list
 
+val blocks_in_reverse_post_order : t -> Code.Addr.t list
+
 val get_nodes : t -> Addr.Set.t
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 15e99e3fa1..49f413fef3 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -856,15 +856,15 @@ module Generate (Target : Wa_target_sig.S) = struct
         ~pc
         ~params
     in
-    let g = Wa_structure.build_graph ctx.blocks pc in
-    let dom = Wa_structure.dominator_tree g in
+    let g = Structure.build_graph ctx.blocks pc in
+    let dom = Structure.dominator_tree g in
     let rec translate_tree result_typ fall_through pc context =
       let block = Addr.Map.find pc ctx.blocks in
       let keep_ouside pc' =
         match fst block.branch with
         | Switch _ -> true
         | Cond (_, (pc1, _), (pc2, _)) when pc' = pc1 && pc' = pc2 -> true
-        | _ -> Wa_structure.is_merge_node g pc'
+        | _ -> Structure.is_merge_node g pc'
       in
       let code ~context =
         translate_node_within
@@ -873,13 +873,13 @@ module Generate (Target : Wa_target_sig.S) = struct
           ~pc
           ~l:
             (pc
-            |> Wa_structure.get_edges dom
+            |> Structure.get_edges dom
             |> Addr.Set.elements
             |> List.filter ~f:keep_ouside
-            |> Wa_structure.sort_in_post_order g)
+            |> Structure.sort_in_post_order g)
           ~context
       in
-      if Wa_structure.is_loop_header g pc
+      if Structure.is_loop_header g pc
       then
         loop { params = []; result = result_typ } (code ~context:(`Block pc :: context))
       else code ~context
@@ -943,7 +943,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                   List.filter
                     ~f:(fun pc' ->
                       Stack.stack_adjustment_needed stack_ctx ~src:pc ~dst:pc')
-                    (List.rev (Addr.Set.elements (Wa_structure.get_edges dom pc)))
+                    (List.rev (Addr.Set.elements (Structure.get_edges dom pc)))
                 in
                 let br_table e a context =
                   let len = Array.length a in
@@ -999,8 +999,8 @@ module Generate (Target : Wa_target_sig.S) = struct
       match fall_through with
       | `Block dst' when dst = dst' -> return ()
       | _ ->
-          if (src >= 0 && Wa_structure.is_backward g src dst)
-             || Wa_structure.is_merge_node g dst
+          if (src >= 0 && Structure.is_backward g src dst)
+             || Structure.is_merge_node g dst
           then instr (Br (label_index context dst, None))
           else translate_tree result_typ fall_through dst context
     in
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib/wasm/wa_globalize.ml
index 5c2cc2d473..5a255b767b 100644
--- a/compiler/lib/wasm/wa_globalize.ml
+++ b/compiler/lib/wasm/wa_globalize.ml
@@ -104,7 +104,7 @@ let traverse_block p st pc =
   List.fold_left ~f:(fun st i -> traverse_instruction st i) ~init:st b.Code.body
 
 let f p g closures =
-  let l = Wa_structure.blocks_in_reverse_post_order g in
+  let l = Structure.blocks_in_reverse_post_order g in
   let in_loop = Freevars.find_loops_in_closure p p.Code.start in
   let st =
     List.fold_left
diff --git a/compiler/lib/wasm/wa_globalize.mli b/compiler/lib/wasm/wa_globalize.mli
index 9819b18f4e..efbc79aa77 100644
--- a/compiler/lib/wasm/wa_globalize.mli
+++ b/compiler/lib/wasm/wa_globalize.mli
@@ -18,6 +18,6 @@
 
 val f :
      Code.program
-  -> Wa_structure.control_flow_graph
+  -> Structure.t
   -> Wa_closure_conversion.closure Code.Var.Map.t
   -> Code.Var.Set.t
diff --git a/compiler/lib/wasm/wa_structure.ml b/compiler/lib/wasm/wa_structure.ml
deleted file mode 100644
index 520465a563..0000000000
--- a/compiler/lib/wasm/wa_structure.ml
+++ /dev/null
@@ -1,251 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-open Stdlib
-open Code
-
-type graph = (Addr.t, Addr.Set.t) Hashtbl.t
-
-let get_edges g src = try Hashtbl.find g src with Not_found -> Addr.Set.empty
-
-let add_edge g src dst = Hashtbl.replace g src (Addr.Set.add dst (get_edges g src))
-
-let reverse_graph g =
-  let g' = Hashtbl.create 16 in
-  Hashtbl.iter
-    (fun child parents -> Addr.Set.iter (fun parent -> add_edge g' parent child) parents)
-    g;
-  g'
-
-let reverse_tree t =
-  let g = Hashtbl.create 16 in
-  Hashtbl.iter (fun child parent -> add_edge g parent child) t;
-  g
-
-type control_flow_graph =
-  { succs : (Addr.t, Addr.Set.t) Hashtbl.t
-  ; preds : (Addr.t, Addr.Set.t) Hashtbl.t
-  ; reverse_post_order : Addr.t list
-  ; block_order : (Addr.t, int) Hashtbl.t
-  }
-
-let is_backward g pc pc' = Hashtbl.find g.block_order pc >= Hashtbl.find g.block_order pc'
-
-let is_forward g pc pc' = Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc'
-
-(* pc has at least two forward edges moving into it *)
-let is_merge_node' block_order preds pc =
-  let s = try Hashtbl.find preds pc with Not_found -> Addr.Set.empty in
-  let o = Hashtbl.find block_order pc in
-  let n =
-    Addr.Set.fold (fun pc' n -> if Hashtbl.find block_order pc' < o then n + 1 else n) s 0
-  in
-  n > 1
-
-let rec leave_try_body block_order preds blocks pc =
-  if is_merge_node' block_order preds pc
-  then false
-  else
-    match Addr.Map.find pc blocks with
-    | { body = []; branch = (Return _ | Stop), _; _ } -> false
-    | { body = []; branch = Branch (pc', _), _; _ } ->
-        leave_try_body block_order preds blocks pc'
-    | _ -> true
-
-let build_graph blocks pc =
-  let succs = Hashtbl.create 16 in
-  let l = ref [] in
-  let visited = Hashtbl.create 16 in
-  let poptraps = ref [] in
-  let rec traverse ~englobing_exn_handlers pc =
-    if not (Hashtbl.mem visited pc)
-    then (
-      Hashtbl.add visited pc ();
-      let successors = Code.fold_children blocks pc Addr.Set.add Addr.Set.empty in
-      Hashtbl.add succs pc successors;
-      let block = Addr.Map.find pc blocks in
-      Addr.Set.iter
-        (fun pc' ->
-          let englobing_exn_handlers =
-            match fst block.branch with
-            | Pushtrap ((body_pc, _), _, _) when pc' = body_pc ->
-                pc :: englobing_exn_handlers
-            | Poptrap (leave_pc, _) -> (
-                match englobing_exn_handlers with
-                | [] -> assert false
-                | enter_pc :: rem ->
-                    poptraps := (enter_pc, leave_pc) :: !poptraps;
-                    rem)
-            | _ -> englobing_exn_handlers
-          in
-          traverse ~englobing_exn_handlers pc')
-        successors;
-      l := pc :: !l)
-  in
-  traverse ~englobing_exn_handlers:[] pc;
-  let block_order = Hashtbl.create 16 in
-  List.iteri !l ~f:(fun i pc -> Hashtbl.add block_order pc i);
-  let preds = reverse_graph succs in
-  List.iter !poptraps ~f:(fun (enter_pc, leave_pc) ->
-      if leave_try_body block_order preds blocks leave_pc
-      then (
-        (* Add an edge to limit the [try] body *)
-        Hashtbl.replace
-          succs
-          enter_pc
-          (Addr.Set.add leave_pc (Hashtbl.find succs enter_pc));
-        Hashtbl.replace
-          preds
-          leave_pc
-          (Addr.Set.add enter_pc (Hashtbl.find preds leave_pc))));
-  { succs; preds; reverse_post_order = !l; block_order }
-
-let reversed_dominator_tree g =
-  (* A Simple, Fast Dominance Algorithm
-     Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy *)
-  let dom = Hashtbl.create 16 in
-  let rec inter pc pc' =
-    (* Compute closest common ancestor *)
-    if pc = pc'
-    then pc
-    else if is_forward g pc pc'
-    then inter pc (Hashtbl.find dom pc')
-    else inter (Hashtbl.find dom pc) pc'
-  in
-  List.iter g.reverse_post_order ~f:(fun pc ->
-      let l = Hashtbl.find g.succs pc in
-      Addr.Set.iter
-        (fun pc' ->
-          if is_forward g pc pc'
-          then
-            let d = try inter pc (Hashtbl.find dom pc') with Not_found -> pc in
-            Hashtbl.replace dom pc' d)
-        l);
-  (* Check we have reached a fixed point (reducible graph) *)
-  List.iter g.reverse_post_order ~f:(fun pc ->
-      let l = Hashtbl.find g.succs pc in
-      Addr.Set.iter
-        (fun pc' ->
-          if is_forward g pc pc'
-          then
-            let d = Hashtbl.find dom pc' in
-            assert (inter pc d = d))
-        l);
-  dom
-
-let dominator_tree g = reverse_tree (reversed_dominator_tree g)
-
-(* pc has at least two forward edges moving into it *)
-let is_merge_node g pc = is_merge_node' g.block_order g.preds pc
-
-let is_loop_header g pc =
-  let s = try Hashtbl.find g.preds pc with Not_found -> Addr.Set.empty in
-  let o = Hashtbl.find g.block_order pc in
-  Addr.Set.exists (fun pc' -> Hashtbl.find g.block_order pc' >= o) s
-
-let sort_in_post_order g l =
-  List.sort
-    ~cmp:(fun b b' ->
-      compare (Hashtbl.find g.block_order b') (Hashtbl.find g.block_order b))
-    l
-
-let blocks_in_reverse_post_order g = g.reverse_post_order
-
-(* Compute a map from each block to the set of loops it belongs to *)
-let mark_loops g =
-  let in_loop = Hashtbl.create 16 in
-  Hashtbl.iter
-    (fun pc preds ->
-      let rec mark_loop pc' =
-        if not (Addr.Set.mem pc (get_edges in_loop pc'))
-        then (
-          add_edge in_loop pc' pc;
-          if pc' <> pc then Addr.Set.iter mark_loop (Hashtbl.find g.preds pc'))
-      in
-      Addr.Set.iter (fun pc' -> if is_backward g pc' pc then mark_loop pc') preds)
-    g.preds;
-  in_loop
-
-let rec measure blocks g pc limit =
-  let b = Addr.Map.find pc blocks in
-  let limit = limit - List.length b.body in
-  if limit < 0
-  then limit
-  else
-    Addr.Set.fold
-      (fun pc limit -> if limit < 0 then limit else measure blocks g pc limit)
-      (get_edges g.succs pc)
-      limit
-
-let is_small blocks g pc = measure blocks g pc 20 >= 0
-
-(* V8 uses the distance between the position of a backward jump and
-   the loop header as an estimation of the cost of executing the loop,
-   to decide whether to optimize a function containing a loop. So, for
-   a large function when the loop includes all the remaining code, the
-   estimation can be widely off. In particular, it may decide to
-   optimize the toplevel code, which is especially costly since it is
-   very large, and uncessary since it is executed only once. *)
-let shrink_loops blocks ({ succs; preds; reverse_post_order; _ } as g) =
-  let add_edge pred succ =
-    Hashtbl.replace succs pred (Addr.Set.add succ (Hashtbl.find succs pred));
-    Hashtbl.replace preds succ (Addr.Set.add pred (Hashtbl.find preds succ))
-  in
-  let in_loop = mark_loops g in
-  let dom = dominator_tree g in
-  let root = List.hd reverse_post_order in
-  let rec traverse ignored pc =
-    let succs = get_edges dom pc in
-    let loops = get_edges in_loop pc in
-    let block = Addr.Map.find pc blocks in
-    Addr.Set.iter
-      (fun pc' ->
-        (* Whatever is in the scope of an exception handler should not be
-           moved outside *)
-        let ignored =
-          match fst block.branch with
-          | Pushtrap ((body_pc, _), _, _) when pc' = body_pc ->
-              Addr.Set.union ignored loops
-          | _ -> ignored
-        in
-        let loops' = get_edges in_loop pc' in
-        let left_loops = Addr.Set.diff (Addr.Set.diff loops loops') ignored in
-        (* If we leave a loop, we add an edge from a predecessor of
-           the loop header to the current block, so that it is
-           considered outside of the loop. *)
-        if not (Addr.Set.is_empty left_loops || is_small blocks g pc')
-        then
-          Addr.Set.iter
-            (fun pc0 ->
-              match
-                Addr.Set.find_first
-                  (fun pc -> is_forward g pc pc0)
-                  (get_edges g.preds pc0)
-              with
-              | pc -> add_edge pc pc'
-              | exception Not_found -> ())
-            left_loops;
-        traverse ignored pc')
-      succs
-  in
-  traverse Addr.Set.empty root
-
-let build_graph blocks pc =
-  let g = build_graph blocks pc in
-  shrink_loops blocks g;
-  g
diff --git a/compiler/lib/wasm/wa_structure.mli b/compiler/lib/wasm/wa_structure.mli
deleted file mode 100644
index 53be40e9da..0000000000
--- a/compiler/lib/wasm/wa_structure.mli
+++ /dev/null
@@ -1,37 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-type graph
-
-val get_edges : graph -> Code.Addr.t -> Code.Addr.Set.t
-
-type control_flow_graph
-
-val build_graph : Code.block Code.Addr.Map.t -> Code.Addr.t -> control_flow_graph
-
-val dominator_tree : control_flow_graph -> graph
-
-val is_loop_header : control_flow_graph -> Code.Addr.t -> bool
-
-val is_merge_node : control_flow_graph -> Code.Addr.t -> bool
-
-val is_backward : control_flow_graph -> Code.Addr.t -> Code.Addr.t -> bool
-
-val sort_in_post_order : control_flow_graph -> Code.Addr.t list -> Code.Addr.t list
-
-val blocks_in_reverse_post_order : control_flow_graph -> Code.Addr.t list

From f4f188a63551caf94685e257f0daad99c1f43eee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 8 Oct 2024 16:27:00 +0200
Subject: [PATCH 389/481] Remove code corresponding to an hypothetical core
 Wasm support

---
 compiler/lib/wasm/wa_asm_output.ml        | 679 ------------------
 compiler/lib/wasm/wa_asm_output.mli       |  19 -
 compiler/lib/wasm/wa_ast.ml               |  30 +-
 compiler/lib/wasm/wa_code_generation.ml   |  42 +-
 compiler/lib/wasm/wa_code_generation.mli  |   8 +-
 compiler/lib/wasm/wa_core_target.ml       | 684 ------------------
 compiler/lib/wasm/wa_core_target.mli      |  19 -
 compiler/lib/wasm/wa_curry.ml             | 140 +---
 compiler/lib/wasm/wa_gc_target.ml         |  84 +--
 compiler/lib/wasm/wa_generate.ml          | 461 +++++--------
 compiler/lib/wasm/wa_initialize_locals.ml |  11 +-
 compiler/lib/wasm/wa_liveness.ml          | 246 -------
 compiler/lib/wasm/wa_liveness.mli         |  38 -
 compiler/lib/wasm/wa_spilling.ml          | 805 ----------------------
 compiler/lib/wasm/wa_spilling.mli         |  89 ---
 compiler/lib/wasm/wa_tail_call.ml         |   7 -
 compiler/lib/wasm/wa_target_sig.ml        |  71 +-
 compiler/lib/wasm/wa_wasm_output.ml       |  36 +-
 compiler/lib/wasm/wa_wat_output.ml        | 189 +----
 19 files changed, 247 insertions(+), 3411 deletions(-)
 delete mode 100644 compiler/lib/wasm/wa_asm_output.ml
 delete mode 100644 compiler/lib/wasm/wa_asm_output.mli
 delete mode 100644 compiler/lib/wasm/wa_core_target.ml
 delete mode 100644 compiler/lib/wasm/wa_core_target.mli
 delete mode 100644 compiler/lib/wasm/wa_liveness.ml
 delete mode 100644 compiler/lib/wasm/wa_liveness.mli
 delete mode 100644 compiler/lib/wasm/wa_spilling.ml
 delete mode 100644 compiler/lib/wasm/wa_spilling.mli

diff --git a/compiler/lib/wasm/wa_asm_output.ml b/compiler/lib/wasm/wa_asm_output.ml
deleted file mode 100644
index 3726fd8ba7..0000000000
--- a/compiler/lib/wasm/wa_asm_output.ml
+++ /dev/null
@@ -1,679 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-open! Stdlib
-
-module PP : sig
-  type t
-
-  val empty : t
-
-  val ( ^^ ) : t -> t -> t
-
-  val string : string -> t
-
-  val line : t -> t
-
-  val indent : t -> t
-
-  val concat_map : ('a -> t) -> 'a list -> t
-
-  val separate_map : t -> ('a -> t) -> 'a list -> t
-
-  val delayed : (unit -> t) -> t
-
-  val to_channel : out_channel -> t -> unit
-
-  (*  val to_buffer : Buffer.t -> t -> unit *)
-end = struct
-  let spaces = "\t" ^ String.make 80 ' '
-
-  type st =
-    { mutable indent : int
-    ; output : string -> int -> int -> unit
-    }
-
-  type t = st -> unit
-
-  let empty _ = ()
-
-  let string s st = st.output s 0 (String.length s)
-
-  let ( ^^ ) s s' st =
-    s st;
-    s' st
-
-  let line l st =
-    st.output spaces 0 (min (String.length spaces) st.indent);
-    l st;
-    st.output "\n" 0 1
-
-  let indent x st =
-    st.indent <- st.indent + 1;
-    x st;
-    st.indent <- st.indent - 1
-
-  let concat_map f l st = List.iter ~f:(fun x -> f x st) l
-
-  let separate_map sep f l st =
-    List.iteri
-      ~f:(fun i x ->
-        if i > 0 then sep st;
-        f x st)
-      l
-
-  let delayed f st = f () st
-
-  let to_channel ch doc = doc { indent = 0; output = output_substring ch }
-
-  (*
-  let to_buffer b doc =
-    doc { indent = 0; output = (fun s i l -> Buffer.add_substring b s i l) }
-  *)
-end
-
-module Feature : sig
-  type set
-
-  val make : unit -> set
-
-  val get : set -> string list
-
-  type t
-
-  val register : set -> string -> t
-
-  val require : t -> unit
-end = struct
-  type t = string * bool ref
-
-  type set = t list ref
-
-  let make () = ref []
-
-  let get l = !l |> List.filter ~f:(fun (_, b) -> !b) |> List.map ~f:fst
-
-  let register l name =
-    let f = name, ref false in
-    l := f :: !l;
-    f
-
-  let require (_, b) = b := true
-end
-
-module Output () = struct
-  open PP
-  open Wa_ast
-
-  let features = Feature.make ()
-
-  let mutable_globals = Feature.register features "mutable-globals"
-
-  let nontrapping_fptoint = Feature.register features "nontrapping-fptoint"
-
-  let exception_handling = Feature.register features "exception-handling"
-
-  let tail_call = Feature.register features "tail-call"
-
-  let value_type (t : value_type) =
-    string
-      (match t with
-      | I32 -> "i32"
-      | I64 -> "i64"
-      | F32 -> "f32"
-      | F64 -> "f64"
-      | Ref _ -> assert false (* Not supported *))
-
-  let func_type { params; result } =
-    assert (List.length result <= 1);
-    string "("
-    ^^ separate_map (string ", ") value_type params
-    ^^ string ") -> ("
-    ^^ separate_map (string ", ") value_type result
-    ^^ string ")"
-
-  let block_type ty =
-    match ty with
-    | { params = []; result = [] } -> empty
-    | { params = []; result = [ res ] } -> string " " ^^ value_type res
-    | _ -> assert false
-
-  let type_prefix op =
-    match op with
-    | I32 _ -> string "i32."
-    | I64 _ -> string "i64."
-    | F32 _ -> string "f32."
-    | F64 _ -> string "f64."
-
-  let signage op (s : Wa_ast.signage) =
-    op
-    ^
-    match s with
-    | S -> "_s"
-    | U -> "_u"
-
-  let int_un_op sz op =
-    match op with
-    | Clz -> "clz"
-    | Ctz -> "ctz"
-    | Popcnt -> "popcnt"
-    | Eqz -> "eqz"
-    | TruncSatF64 s ->
-        Feature.require nontrapping_fptoint;
-        signage "trunc_sat_f64" s
-    | ReinterpretF -> "reinterpret_f" ^ sz
-
-  let int_bin_op _ (op : int_bin_op) =
-    match op with
-    | Add -> "add"
-    | Sub -> "sub"
-    | Mul -> "mul"
-    | Div s -> signage "div" s
-    | Rem s -> signage "rem" s
-    | And -> "and"
-    | Or -> "or"
-    | Xor -> "xor"
-    | Shl -> "shl"
-    | Shr s -> signage "shr" s
-    | Rotl -> "rotl"
-    | Rotr -> "rotr"
-    | Eq -> "eq"
-    | Ne -> "ne"
-    | Lt s -> signage "lt" s
-    | Gt s -> signage "gt" s
-    | Le s -> signage "le" s
-    | Ge s -> signage "ge" s
-
-  let float_un_op sz op =
-    match op with
-    | Neg -> "neg"
-    | Abs -> "abs"
-    | Ceil -> "ceil"
-    | Floor -> "floor"
-    | Trunc -> "trunc"
-    | Nearest -> "nearest"
-    | Sqrt -> "sqrt"
-    | Convert (`I32, s) -> signage "convert_i32" s
-    | Convert (`I64, s) -> signage "convert_i64" s
-    | ReinterpretI -> "reinterpret_i" ^ sz
-
-  let float_bin_op _ op =
-    match op with
-    | Add -> "add"
-    | Sub -> "sub"
-    | Mul -> "mul"
-    | Div -> "div"
-    | Min -> "min"
-    | Max -> "max"
-    | CopySign -> "copysign"
-    | Eq -> "eq"
-    | Ne -> "ne"
-    | Lt -> "lt"
-    | Gt -> "gt"
-    | Le -> "le"
-    | Ge -> "ge"
-
-  let select i32 i64 f32 f64 op =
-    match op with
-    | I32 x -> i32 "32" x
-    | I64 x -> i64 "64" x
-    | F32 x -> f32 "32" x
-    | F64 x -> f64 "64" x
-
-  let integer i = string (string_of_int i)
-
-  let integer32 _ i =
-    string
-      (if Poly.(i > -10000l && i < 10000l)
-       then Int32.to_string i
-       else Printf.sprintf "0x%lx" i)
-
-  let integer64 _ i =
-    string
-      (if Poly.(i > -10000L && i < 10000L)
-       then Int64.to_string i
-       else Printf.sprintf "0x%Lx" i)
-
-  let float32 _ f = string (Printf.sprintf "%h" f) (*ZZZ nan with payload*)
-
-  let float64 _ f = string (Printf.sprintf "%h" f) (*ZZZ nan with payload*)
-
-  let index name = string (Code.Var.to_string name)
-
-  let symbol name offset =
-    string
-      (match name with
-      | V name -> Code.Var.to_string name
-      | S name -> name)
-    ^^
-    if offset = 0
-    then empty
-    else (if offset < 0 then empty else string "+") ^^ integer offset
-
-  let offs _ i = Int32.to_string i
-
-  let rec expression m e =
-    match e with
-    | Const op ->
-        line
-          (type_prefix op
-          ^^ string "const "
-          ^^ select integer32 integer64 float32 float64 op)
-    | ConstSym (name, offset) ->
-        line (type_prefix (I32 ()) ^^ string "const " ^^ symbol name offset)
-    | UnOp (op, e') ->
-        expression m e'
-        ^^ line
-             (type_prefix op
-             ^^ string (select int_un_op int_un_op float_un_op float_un_op op))
-    | BinOp (op, e1, e2) ->
-        expression m e1
-        ^^ expression m e2
-        ^^ line
-             (type_prefix op
-             ^^ string (select int_bin_op int_bin_op float_bin_op float_bin_op op))
-    | I32WrapI64 e -> expression m e ^^ line (string "i32.wrap_i64")
-    | I64ExtendI32 (s, e) -> expression m e ^^ line (string (signage "i64.extend_i32" s))
-    | F32DemoteF64 e -> expression m e ^^ line (string "f32.demote_f64")
-    | F64PromoteF32 e -> expression m e ^^ line (string "f64.promote_f32")
-    | Load (offset, e') ->
-        expression m e'
-        ^^ line
-             (type_prefix offset
-             ^^ string "load "
-             ^^ string (select offs offs offs offs offset))
-    | Load8 (s, offset, e') ->
-        expression m e'
-        ^^ line
-             (type_prefix offset
-             ^^ string (signage "load8" s)
-             ^^ string " "
-             ^^ string (select offs offs offs offs offset))
-    | LocalGet i -> line (string "local.get " ^^ integer (Hashtbl.find m i))
-    | LocalTee (i, e') ->
-        expression m e' ^^ line (string "local.tee " ^^ integer (Hashtbl.find m i))
-    | GlobalGet nm -> line (string "global.get " ^^ symbol nm 0)
-    | BlockExpr (ty, l) ->
-        line (string "block" ^^ block_type ty)
-        ^^ indent (concat_map (instruction m) l)
-        ^^ line (string "end_block")
-    | Call_indirect (typ, f, l) ->
-        concat_map (expression m) l
-        ^^ expression m f
-        ^^ line (string "call_indirect " ^^ func_type typ)
-    | Call (x, l) -> concat_map (expression m) l ^^ line (string "call " ^^ index x)
-    | MemoryGrow (mem, e) -> expression m e ^^ line (string "memory.grow " ^^ integer mem)
-    | Seq (l, e') -> concat_map (instruction m) l ^^ expression m e'
-    | Pop _ -> empty
-    | IfExpr (ty, e, e1, e2) ->
-        expression m e
-        ^^ line (string "if" ^^ block_type { params = []; result = [ ty ] })
-        ^^ indent (expression m e1)
-        ^^ line (string "else")
-        ^^ indent (expression m e2)
-        ^^ line (string "end_if")
-    | RefFunc _
-    | Call_ref _
-    | RefI31 _
-    | I31Get _
-    | ArrayNew _
-    | ArrayNewFixed _
-    | ArrayNewData _
-    | ArrayGet _
-    | ArrayLen _
-    | StructNew _
-    | StructGet _
-    | RefCast _
-    | RefTest _
-    | RefEq _
-    | RefNull _
-    | Br_on_cast _
-    | Br_on_cast_fail _ -> assert false (* Not supported *)
-
-  and instruction m i =
-    match i with
-    | Drop e -> expression m e ^^ line (string "drop")
-    | Store (offset, e, e') ->
-        expression m e
-        ^^ expression m e'
-        ^^ line
-             (type_prefix offset
-             ^^ string "store "
-             ^^ string (select offs offs offs offs offset))
-    | Store8 (offset, e, e') ->
-        expression m e
-        ^^ expression m e'
-        ^^ line
-             (type_prefix offset
-             ^^ string "store8 "
-             ^^ string (select offs offs offs offs offset))
-    | LocalSet (i, e) ->
-        expression m e ^^ line (string "local.set " ^^ integer (Hashtbl.find m i))
-    | GlobalSet (nm, e) -> expression m e ^^ line (string "global.set " ^^ symbol nm 0)
-    | Loop (ty, l) ->
-        line (string "loop" ^^ block_type ty)
-        ^^ indent (concat_map (instruction m) l)
-        ^^ line (string "end_loop")
-    | Block (ty, l) ->
-        line (string "block" ^^ block_type ty)
-        ^^ indent (concat_map (instruction m) l)
-        ^^ line (string "end_block")
-    | If (ty, e, l1, l2) ->
-        expression m e
-        ^^ line (string "if" ^^ block_type ty)
-        ^^ indent (concat_map (instruction m) l1)
-        ^^ line (string "else")
-        ^^ indent (concat_map (instruction m) l2)
-        ^^ line (string "end_if")
-    | Br_table (e, l, i) ->
-        expression m e
-        ^^ line
-             (string "br_table {"
-             ^^ separate_map (string ", ") integer (l @ [ i ])
-             ^^ string "}")
-    | Br (i, Some e) -> expression m e ^^ instruction m (Br (i, None))
-    | Br (i, None) -> line (string "br " ^^ integer i)
-    | Br_if (i, e) -> expression m e ^^ line (string "br_if " ^^ integer i)
-    | Return (Some e) -> expression m e ^^ instruction m (Return None)
-    | Return None -> line (string "return")
-    | CallInstr (x, l) -> concat_map (expression m) l ^^ line (string "call " ^^ index x)
-    | Nop -> empty
-    | Push e -> expression m e
-    | Try (ty, body, catches, catch_all) ->
-        Feature.require exception_handling;
-        line (string "try" ^^ block_type ty)
-        ^^ indent (concat_map (instruction m) body)
-        ^^ concat_map
-             (fun (tag, l) ->
-               line (string "catch " ^^ index tag)
-               ^^ indent (concat_map (instruction m) l))
-             catches
-        ^^ (match catch_all with
-           | None -> empty
-           | Some l -> line (string "catch_all") ^^ indent (concat_map (instruction m) l))
-        ^^ line (string "end_try")
-    | Throw (i, e) ->
-        Feature.require exception_handling;
-        expression m e ^^ line (string "throw " ^^ index i)
-    | Rethrow i ->
-        Feature.require exception_handling;
-        line (string "rethrow " ^^ integer i)
-    | Return_call_indirect (typ, f, l) ->
-        Feature.require tail_call;
-        concat_map (expression m) l
-        ^^ expression m f
-        ^^ line (string "return_call_indirect " ^^ func_type typ)
-    | Return_call (x, l) ->
-        Feature.require tail_call;
-        concat_map (expression m) l ^^ line (string "return_call " ^^ index x)
-    | Location (_, i) ->
-        (* Source maps not supported for the non-GC target *)
-        instruction m i
-    | ArraySet _ | StructSet _ | Return_call_ref _ -> assert false (* Not supported *)
-
-  let escape_string s =
-    let b = Buffer.create (String.length s + 2) in
-    for i = 0 to String.length s - 1 do
-      let c = s.[i] in
-      if Poly.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\')
-      then Buffer.add_char b c
-      else Printf.bprintf b "\\x%02x" (Char.code c)
-    done;
-    Buffer.contents b
-
-  let section_header kind name =
-    line
-      (string ".section ."
-      ^^ string kind
-      ^^ string "."
-      ^^ symbol name 0
-      ^^ string ",\"\",@")
-
-  let vector l =
-    line (string ".int8 " ^^ integer (List.length l)) ^^ concat_map (fun x -> x) l
-
-  let len_string s =
-    line (string ".int8 " ^^ integer (String.length s))
-    ^^ line (string ".ascii \"" ^^ string (escape_string s) ^^ string "\"")
-
-  let producer_section =
-    delayed
-    @@ fun () ->
-    indent
-      (section_header "custom_section" (S "producers")
-      ^^ vector
-           [ len_string "language"
-             ^^ vector [ len_string "OCaml" ^^ len_string Sys.ocaml_version ]
-           ; len_string "processed-by"
-             ^^ vector
-                  [ len_string "wasm_of_ocaml"
-                    ^^ len_string
-                         (match Compiler_version.git_version with
-                         | "" -> Compiler_version.s
-                         | v -> Printf.sprintf "%s+git-%s" Compiler_version.s v)
-                  ]
-           ])
-
-  let target_features =
-    delayed
-    @@ fun () ->
-    indent
-      (section_header "custom_section" (S "target_features")
-      ^^ vector
-           (List.map
-              ~f:(fun f -> line (string ".ascii \"+\"") ^^ len_string f)
-              (Feature.get features)))
-
-  let export name exported_name =
-    match exported_name with
-    | None -> empty
-    | Some exported_name ->
-        line
-          (string ".export_name " ^^ symbol name 0 ^^ string "," ^^ string exported_name)
-
-  let f ch fields =
-    List.iter
-      ~f:(fun f ->
-        match f with
-        | Global { name = S name; _ } -> Var_printer.add_reserved name
-        | Import _ | Function _ | Data _ | Global { name = V _; _ } | Tag _ | Type _ -> ())
-      fields;
-    to_channel ch
-    @@
-    let types =
-      List.filter_map
-        ~f:(fun f ->
-          match f with
-          | Function { name; typ; _ } -> Some (name, typ, None)
-          | Import { import_module; import_name; name; desc = Fun typ } ->
-              Some (name, typ, Some (import_module, import_name))
-          | Import { desc = Global _ | Tag _; _ } | Data _ | Global _ | Tag _ | Type _ ->
-              None)
-        fields
-    in
-    let globals =
-      List.filter_map
-        ~f:(fun f ->
-          match f with
-          | Function _ | Import { desc = Fun _ | Tag _; _ } | Data _ | Tag _ | Type _ ->
-              None
-          | Import { import_module; import_name; name; desc = Global typ } ->
-              if typ.mut then Feature.require mutable_globals;
-              Some (V name, typ, Some (import_module, import_name))
-          | Global { name; typ; init; _ } ->
-              assert (Poly.equal init (Const (I32 0l)));
-              Some (name, typ, None))
-        fields
-    in
-    let tags =
-      List.filter_map
-        ~f:(fun f ->
-          match f with
-          | Function _
-          | Import { desc = Fun _ | Global _; _ }
-          | Data _ | Global _ | Type _ -> None
-          | Import { import_module; import_name; name; desc = Tag typ } ->
-              Some (name, typ, Some (import_module, import_name))
-          | Tag { name; typ } ->
-              Feature.require exception_handling;
-              Some (name, typ, None))
-        fields
-    in
-    let define_symbol name =
-      line (string ".hidden " ^^ symbol name 0) ^^ line (string ".globl " ^^ symbol name 0)
-    in
-    let name_import name import =
-      (match import with
-      | None | Some ("env", _) -> empty
-      | Some (m, _) ->
-          line (string ".import_module " ^^ symbol name 0 ^^ string ", " ^^ string m))
-      ^^
-      match import with
-      | None -> empty
-      | Some (_, nm) ->
-          line (string ".import_name " ^^ symbol name 0 ^^ string ", " ^^ string nm)
-    in
-    let declare_global name { mut; typ } import =
-      line
-        (string ".globaltype "
-        ^^ symbol name 0
-        ^^ string ", "
-        ^^ value_type typ
-        ^^ if mut then empty else string ", immutable")
-      ^^ name_import name import
-    in
-    let declare_tag name typ import =
-      line (string ".tagtype " ^^ index name ^^ string " " ^^ value_type typ)
-      ^^ name_import (V name) import
-    in
-    let declare_func_type name typ import =
-      line (string ".functype " ^^ index name ^^ string " " ^^ func_type typ)
-      ^^ name_import (V name) import
-    in
-    let data_sections =
-      concat_map
-        (fun f ->
-          match f with
-          | Function _ | Import _ | Type _ -> empty
-          | Data { name; read_only; active; contents } ->
-              assert active;
-              (* Not supported *)
-              let size =
-                List.fold_left
-                  ~init:0
-                  ~f:(fun s d ->
-                    s
-                    +
-                    match d with
-                    | DataI8 _ -> 1
-                    | DataI32 _ | DataSym _ -> 4
-                    | DataI64 _ -> 8
-                    | DataBytes b -> String.length b
-                    | DataSpace n -> n)
-                  contents
-              in
-              indent
-                (section_header (if read_only then "rodata" else "data") (V name)
-                ^^ define_symbol (V name)
-                ^^ line (string ".p2align 2")
-                ^^ line (string ".size " ^^ index name ^^ string ", " ^^ integer size))
-              ^^ line (index name ^^ string ":")
-              ^^ indent
-                   (concat_map
-                      (fun d ->
-                        line
-                          (match d with
-                          | DataI8 i -> string ".int8 " ^^ integer i
-                          | DataI32 i -> string ".int32 " ^^ integer32 "32" i
-                          | DataI64 i -> string ".int64 " ^^ integer64 "64" i
-                          | DataBytes b ->
-                              string ".ascii \""
-                              ^^ string (escape_string b)
-                              ^^ string "\""
-                          | DataSym (name, offset) ->
-                              string ".int32 " ^^ symbol name offset
-                          | DataSpace n -> string ".space " ^^ integer n))
-                      contents)
-          | Global { name; exported_name; typ; _ } ->
-              if typ.mut && Option.is_some exported_name
-              then Feature.require mutable_globals;
-              indent
-                (section_header "data" name
-                ^^ define_symbol name
-                ^^ export name exported_name)
-          | Tag { name; _ } ->
-              indent (section_header "data" (V name) ^^ define_symbol (V name))
-              ^^ line (index name ^^ string ":"))
-        fields
-    in
-    let function_section =
-      concat_map
-        (fun f ->
-          match f with
-          | Function { name; exported_name; typ; param_names; locals; body } ->
-              let local_names = Hashtbl.create 8 in
-              let idx =
-                List.fold_left
-                  ~f:(fun idx x ->
-                    Hashtbl.add local_names x idx;
-                    idx + 1)
-                  ~init:0
-                  param_names
-              in
-              let _ =
-                List.fold_left
-                  ~f:(fun idx (x, _) ->
-                    Hashtbl.add local_names x idx;
-                    idx + 1)
-                  ~init:idx
-                  locals
-              in
-              indent
-                (section_header "text" (V name)
-                ^^ define_symbol (V name)
-                ^^ export (V name) exported_name)
-              ^^ line (index name ^^ string ":")
-              ^^ indent
-                   (declare_func_type name typ None
-                   ^^ (if List.is_empty locals
-                       then empty
-                       else
-                         line
-                           (string ".local "
-                           ^^ separate_map
-                                (string ", ")
-                                (fun (_, ty) -> value_type ty)
-                                locals))
-                   ^^ concat_map (instruction local_names) body
-                   ^^ line (string "end_function"))
-          | Import _ | Data _ | Global _ | Tag _ | Type _ -> empty)
-        fields
-    in
-    indent
-      (concat_map (fun (name, typ, import) -> declare_global name typ import) globals
-      ^^ concat_map (fun (name, typ, import) -> declare_func_type name typ import) types
-      ^^ concat_map (fun (name, typ, import) -> declare_tag name typ import) tags)
-    ^^ function_section
-    ^^ data_sections
-    ^^ producer_section
-    ^^ target_features
-end
-
-let f ch fields =
-  let module O = Output () in
-  O.f ch fields
diff --git a/compiler/lib/wasm/wa_asm_output.mli b/compiler/lib/wasm/wa_asm_output.mli
deleted file mode 100644
index 3a2fc50a10..0000000000
--- a/compiler/lib/wasm/wa_asm_output.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-val f : out_channel -> Wa_ast.module_field list -> unit
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 6de691b26a..0d3af3a0c5 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -18,10 +18,6 @@
 
 type var = Code.Var.t
 
-type symbol =
-  | V of var
-  | S of string
-
 type packed_type =
   | I8
   | I16
@@ -137,7 +133,6 @@ type memarg = int32
 
 type expression =
   | Const of (int32, int64, float, float) op
-  | ConstSym of symbol * int
   | UnOp of (int_un_op, int_un_op, float_un_op, float_un_op) op * expression
   | BinOp of
       (int_bin_op, int_bin_op, float_bin_op, float_bin_op) op * expression * expression
@@ -145,15 +140,11 @@ type expression =
   | I64ExtendI32 of signage * expression
   | F32DemoteF64 of expression
   | F64PromoteF32 of expression
-  | Load of (memarg, memarg, memarg, memarg) op * expression
-  | Load8 of signage * (memarg, memarg, memarg, memarg) op * expression
   | LocalGet of var
   | LocalTee of var * expression
-  | GlobalGet of symbol
+  | GlobalGet of var
   | BlockExpr of func_type * instruction list
-  | Call_indirect of func_type * expression * expression list
   | Call of var * expression list
-  | MemoryGrow of int * expression
   | Seq of instruction list * expression
   | Pop of value_type
   | RefFunc of var
@@ -177,10 +168,8 @@ type expression =
 
 and instruction =
   | Drop of expression
-  | Store of (memarg, memarg, memarg, memarg) op * expression * expression
-  | Store8 of (memarg, memarg, memarg, memarg) op * expression * expression
   | LocalSet of var * expression
-  | GlobalSet of symbol * expression
+  | GlobalSet of var * expression
   | Loop of func_type * instruction list
   | Block of func_type * instruction list
   | If of func_type * expression * instruction list * instruction list
@@ -200,7 +189,6 @@ and instruction =
   | Rethrow of int
   | ArraySet of var * expression * expression * expression
   | StructSet of var * int * expression * expression
-  | Return_call_indirect of func_type * expression * expression list
   | Return_call of var * expression list
   | Return_call_ref of var * expression * expression list
   | Location of Code.loc * instruction
@@ -211,14 +199,6 @@ type import_desc =
   | Global of global_type
   | Tag of value_type
 
-type data =
-  | DataI8 of int
-  | DataI32 of int32
-  | DataI64 of int64
-  | DataBytes of string
-  | DataSym of symbol * int
-  | DataSpace of int
-
 type type_field =
   { name : var
   ; typ : str_type
@@ -237,12 +217,10 @@ type module_field =
       }
   | Data of
       { name : var
-      ; active : bool
-      ; read_only : bool
-      ; contents : data list
+      ; contents : string
       }
   | Global of
-      { name : symbol
+      { name : var
       ; exported_name : string option
       ; typ : global_type
       ; init : expression
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 5c195668c8..d4ca6b355b 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -38,7 +38,7 @@ type constant_global =
 
 type context =
   { constants : (Var.t, W.expression) Hashtbl.t
-  ; mutable data_segments : (bool * W.data list) Var.Map.t
+  ; mutable data_segments : string Var.Map.t
   ; mutable constant_globals : constant_global Var.Map.t
   ; mutable other_fields : W.module_field list
   ; mutable imports : (Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
@@ -119,12 +119,10 @@ let expression_list f l =
   in
   loop [] l
 
-let register_data_segment x ~active v st =
-  st.context.data_segments <- Var.Map.add x (active, v) st.context.data_segments;
+let register_data_segment x v st =
+  st.context.data_segments <- Var.Map.add x v st.context.data_segments;
   (), st
 
-let get_data_segment x st = Var.Map.find x st.context.data_segments, st
-
 let get_context st = st.context, st
 
 let register_constant x e st =
@@ -180,16 +178,13 @@ let heap_type_sub (ty : W.heap_type) (ty' : W.heap_type) st =
 let register_global name ?exported_name ?(constant = false) typ init st =
   st.context.other_fields <-
     W.Global { name; exported_name; typ; init } :: st.context.other_fields;
-  (match name with
-  | S _ -> ()
-  | V name ->
-      st.context.constant_globals <-
-        Var.Map.add
-          name
-          { init = (if not typ.mut then Some init else None)
-          ; constant = (not typ.mut) || constant
-          }
-          st.context.constant_globals);
+  st.context.constant_globals <-
+    Var.Map.add
+      name
+      { init = (if not typ.mut then Some init else None)
+      ; constant = (not typ.mut) || constant
+      }
+      st.context.constant_globals;
   (), st
 
 let global_is_registered name =
@@ -331,8 +326,6 @@ module Arith = struct
       | W.Const (I32 n), W.Const (I32 n') -> W.Const (I32 (Int32.add n n'))
       | W.Const (I32 0l), _ -> e'
       | _, W.Const (I32 0l) -> e
-      | W.ConstSym (sym, offset), W.Const (I32 n) ->
-          W.ConstSym (sym, offset + Int32.to_int n)
       | W.Const _, _ -> W.BinOp (I32 Add, e', e)
       | _ -> W.BinOp (I32 Add, e, e'))
 
@@ -407,8 +400,8 @@ end
 
 let is_small_constant e =
   match e with
-  | W.ConstSym _ | W.Const _ | W.RefI31 (W.Const _) | W.RefFunc _ -> return true
-  | W.GlobalGet (V name) -> global_is_constant name
+  | W.Const _ | W.RefI31 (W.Const _) | W.RefFunc _ -> return true
+  | W.GlobalGet name -> global_is_constant name
   | _ -> return false
 
 let un_op_is_smi op =
@@ -430,21 +423,16 @@ let rec is_smi e =
   | I31Get (S, _) -> true
   | I31Get (U, _)
   | Const (I64 _ | F32 _ | F64 _)
-  | ConstSym _
   | UnOp ((F32 _ | F64 _), _)
   | I32WrapI64 _
   | I64ExtendI32 _
   | F32DemoteF64 _
   | F64PromoteF32 _
-  | Load _
-  | Load8 _
   | LocalGet _
   | LocalTee _
   | GlobalGet _
   | BlockExpr _
-  | Call_indirect _
   | Call _
-  | MemoryGrow _
   | Seq _
   | Pop _
   | RefFunc _
@@ -526,12 +514,12 @@ let rec store ?(always = false) ?typ x e =
             else
               register_global
                 ~constant:true
-                (V x)
+                x
                 { mut = true; typ }
                 (W.RefI31 (Const (I32 0l)))
           in
-          let* () = register_constant x (W.GlobalGet (V x)) in
-          instr (GlobalSet (V x, e))
+          let* () = register_constant x (W.GlobalGet x) in
+          instr (GlobalSet (x, e))
         else
           let* i = add_var ?typ x in
           instr (LocalSet (i, e))
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index d83649c819..93f4f22f31 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -22,7 +22,7 @@ type constant_global
 
 type context =
   { constants : (Code.Var.t, Wa_ast.expression) Hashtbl.t
-  ; mutable data_segments : (bool * Wa_ast.data list) Code.Var.Map.t
+  ; mutable data_segments : string Code.Var.Map.t
   ; mutable constant_globals : constant_global Code.Var.Map.t
   ; mutable other_fields : Wa_ast.module_field list
   ; mutable imports : (Code.Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
@@ -154,7 +154,7 @@ val register_import :
   ?import_module:string -> name:string -> Wa_ast.import_desc -> Wa_ast.var t
 
 val register_global :
-     Wa_ast.symbol
+     Wa_ast.var
   -> ?exported_name:string
   -> ?constant:bool
   -> Wa_ast.global_type
@@ -163,9 +163,7 @@ val register_global :
 
 val get_global : Code.Var.t -> Wa_ast.expression option t
 
-val register_data_segment : Code.Var.t -> active:bool -> Wa_ast.data list -> unit t
-
-val get_data_segment : Code.Var.t -> (bool * Wa_ast.data list) t
+val register_data_segment : Code.Var.t -> string -> unit t
 
 val register_init_code : unit t -> unit t
 
diff --git a/compiler/lib/wasm/wa_core_target.ml b/compiler/lib/wasm/wa_core_target.ml
deleted file mode 100644
index 09f12d2df6..0000000000
--- a/compiler/lib/wasm/wa_core_target.ml
+++ /dev/null
@@ -1,684 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-open! Stdlib
-module W = Wa_ast
-open Wa_code_generation
-
-type expression = Wa_ast.expression Wa_code_generation.t
-
-module Stack = Wa_spilling
-
-module Memory = struct
-  let mem_load ?(offset = 0) e =
-    assert (offset >= 0);
-    let* e = e in
-    match e with
-    | W.ConstSym (V x, offset') ->
-        let rec get_data offset l =
-          match l with
-          | [] -> assert false
-          | W.DataI32 i :: _ when offset = 0 -> W.Const (I32 i)
-          | W.DataSym (sym, ofs) :: _ when offset = 0 -> W.ConstSym (sym, ofs)
-          | (W.DataI32 _ | DataSym _) :: r -> get_data (offset - 4) r
-          | (DataI8 _ | DataBytes _ | DataSpace _ | DataI64 _) :: _ -> assert false
-        in
-        let* _, l = get_data_segment x in
-        let data = get_data (offset + offset') l in
-        return data
-    | _ -> return (W.Load (I32 (Int32.of_int offset), e))
-
-  let mem_init ?(offset = 0) e e' =
-    assert (offset >= 0);
-    let* e = e in
-    let* e' = e' in
-    instr (Store (I32 (Int32.of_int offset), e, e'))
-
-  let mem_store ?(offset = 0) e e' =
-    assert (offset >= 0);
-    let* e = Arith.(e + const (Int32.of_int offset)) in
-    let* e' = e' in
-    let* f =
-      register_import ~name:"caml_modify" (Fun { W.params = [ I32; I32 ]; result = [] })
-    in
-    instr (CallInstr (f, [ e; e' ]))
-
-  (*ZZZ
-    p = young_ptr - size;
-    if (p < young_limit) {caml_call_gc(); p = young_ptr - size}
-    ...
-    return p + 4
-  *)
-  let header ?(const = false) ~tag ~len () =
-    Int32.(add (shift_left (of_int len) 10) (of_int (tag + if const then 3 * 256 else 0)))
-
-  let allocate stack_ctx x ~tag l =
-    let len = List.length l in
-    let p = Code.Var.fresh_n "p" in
-    let size = (len + 1) * 4 in
-    seq
-      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-       let* v =
-         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
-       in
-       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
-       let* () = mem_init (load p) (Arith.const (header ~tag ~len ())) in
-       Stack.kill_variables stack_ctx;
-       let* () =
-         Stack.perform_reloads
-           stack_ctx
-           (`Vars
-             (List.fold_left
-                ~f:(fun s v ->
-                  match v with
-                  | `Expr _ -> s
-                  | `Var x -> Code.Var.Set.add x s)
-                ~init:Code.Var.Set.empty
-                l))
-       in
-       snd
-         (List.fold_right
-            ~init:(len, return ())
-            ~f:(fun v (i, cont) ->
-              ( i - 1
-              , let* () =
-                  mem_init
-                    ~offset:(4 * i)
-                    (load p)
-                    (match v with
-                    | `Var y -> load y
-                    | `Expr e -> return e)
-                in
-                cont ))
-            l))
-      Arith.(load p + const 4l)
-  (*ZZZ Float array?*)
-
-  let tag e =
-    let val_int i = Arith.((i lsl const 1l) + const 1l) in
-    val_int Arith.(mem_load (e - const 4l) land const 0xffl)
-
-  let block_length e = Arith.(mem_load (e - const 4l) lsr const 10l)
-
-  let array_get e e' = mem_load Arith.(e + ((e' - const 1l) lsl const 1l))
-
-  let array_set e e' e'' = mem_store Arith.(e + ((e' - const 1l) lsl const 1l)) e''
-
-  let float_array_get = array_get
-
-  let float_array_set = array_set
-
-  let gen_array_get = array_get
-
-  let gen_array_set = array_set
-
-  let array_length = block_length
-
-  let float_array_length = array_length
-
-  let gen_array_length = array_length
-
-  let bytes_length e =
-    let l = Code.Var.fresh () in
-    Arith.(
-      tee l ((block_length e lsl const 2l) - const 1l)
-      - let* tail = e + load l in
-        return (W.Load8 (U, I32 0l, tail)))
-
-  let bytes_get e e' =
-    let* addr = Arith.(e + e' - const 1l) in
-    return (W.Load8 (U, I32 (Int32.of_int 0), addr))
-
-  let bytes_set e e' e'' =
-    let* addr = Arith.(e + e' - const 1l) in
-    let* e'' = e'' in
-    instr (W.Store8 (I32 (Int32.of_int 0), addr, e''))
-
-  let field e idx = mem_load ~offset:(4 * idx) e
-
-  let set_field e idx e' = mem_store ~offset:(4 * idx) e e'
-
-  let load_function_pointer ~cps:_ ~arity ?skip_cast:_ closure =
-    let* e = field closure (if arity = 1 then 0 else 2) in
-    return (`Index, e)
-
-  let load_function_arity closure = Arith.(field closure 1 lsr const 24l)
-
-  let load_real_closure ~cps:_ ~arity:_ _ = assert false
-
-  let check_function_arity f ~cps:_ ~arity if_match if_mismatch =
-    let func_arity = load_function_arity (load f) in
-    if_
-      { params = []; result = [ I32 ] }
-      Arith.(func_arity = const (Int32.of_int arity))
-      (let* res = if_match ~typ:None (load f) in
-       instr (Push res))
-      if_mismatch
-
-  let box_float stack_ctx x e =
-    let p = Code.Var.fresh_n "p" in
-    let size = 12 in
-    seq
-      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-       let* v =
-         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
-       in
-       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
-       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
-       Stack.kill_variables stack_ctx;
-       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
-       let* p = load p in
-       let* e = e in
-       instr (Store (F64 (Int32.of_int 4), p, e)))
-      Arith.(load p + const 4l)
-
-  let unbox_float e =
-    let* e = e in
-    match e with
-    | W.ConstSym (V x, 4) ->
-        let get_data l =
-          match l with
-          | [ W.DataI32 _; W.DataI64 f ] -> W.Const (F64 (Int64.float_of_bits f))
-          | _ -> assert false
-        in
-        let* _, l = get_data_segment x in
-        return (get_data l)
-    | _ ->
-        (*ZZZ aligned?*)
-        return (W.Load (F64 0l, e))
-
-  let box_int32 stack_ctx x e =
-    let p = Code.Var.fresh_n "p" in
-    let size = 16 in
-    seq
-      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-       let* v =
-         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
-       in
-       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
-       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
-       Stack.kill_variables stack_ctx;
-       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
-       let* p = load p in
-       (* ZZZ int32_ops *)
-       let* () = instr (Store (I32 4l, p, Const (I32 0l))) in
-       let* e = e in
-       instr (Store (I32 8l, p, e)))
-      Arith.(load p + const 4l)
-
-  let unbox_int32 e =
-    let* e = e in
-    match e with
-    | W.ConstSym (V x, 4) ->
-        let get_data l =
-          match l with
-          | [ W.DataI32 _; (W.DataI32 _ | W.DataSym _); W.DataI32 f ] -> W.Const (I32 f)
-          | _ -> assert false
-        in
-        let* _, l = get_data_segment x in
-        return (get_data l)
-    | _ -> return (W.Load (I32 4l, e))
-
-  let box_int64 stack_ctx x e =
-    let p = Code.Var.fresh_n "p" in
-    let size = 16 in
-    seq
-      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-       let* v =
-         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
-       in
-       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
-       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
-       Stack.kill_variables stack_ctx;
-       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
-       let* p = load p in
-       let* () = instr (Store (I32 4l, p, ConstSym (S "int64_ops", 0))) in
-       let* e = e in
-       instr (Store (I64 8l, p, e)))
-      Arith.(load p + const 4l)
-
-  let unbox_int64 e =
-    let* e = e in
-    match e with
-    | W.ConstSym (V x, 4) ->
-        let get_data l =
-          match l with
-          | [ W.DataI32 _; W.DataSym _; W.DataI64 f ] -> W.Const (I64 f)
-          | _ -> assert false
-        in
-        let* _, l = get_data_segment x in
-        return (get_data l)
-    | _ -> return (W.Load (F64 4l, e))
-
-  let box_nativeint stack_ctx x e =
-    let p = Code.Var.fresh_n "p" in
-    let size = 16 in
-    seq
-      (let* () = Stack.perform_spilling stack_ctx (`Instr x) in
-       let* v =
-         tee p Arith.(return (W.GlobalGet (S "young_ptr")) - const (Int32.of_int size))
-       in
-       let* () = instr (W.GlobalSet (S "young_ptr", v)) in
-       let* () = mem_init (load p) (Arith.const (header ~tag:Obj.double_tag ~len:2 ())) in
-       Stack.kill_variables stack_ctx;
-       let* () = Stack.perform_reloads stack_ctx (`Vars Code.Var.Set.empty) in
-       let* p = load p in
-       (* ZZZ nativeint_ops *)
-       let* () = instr (Store (I32 4l, p, Const (I32 0l))) in
-       let* e = e in
-       instr (Store (I32 8l, p, e)))
-      Arith.(load p + const 4l)
-
-  let unbox_nativeint = unbox_int32
-end
-
-module Value = struct
-  let value : W.value_type = I32
-
-  let block_type = return value
-
-  let unit = Arith.const 1l
-
-  let dummy_block = unit
-
-  let as_block e = e
-
-  let val_int i = Arith.((i lsl const 1l) + const 1l)
-
-  let int_val i = Arith.(i asr const 1l)
-
-  let check_is_not_zero i = Arith.(i <> const 1l)
-
-  let check_is_int i = Arith.(i land const 1l)
-
-  let not b = Arith.(const 4l - b)
-
-  let lt i i' = val_int Arith.(i < i')
-
-  let le i i' = val_int Arith.(i <= i')
-
-  let eq i i' = val_int Arith.(i = i')
-
-  let neq i i' = val_int Arith.(i <> i')
-
-  let ult i i' = val_int Arith.(ult i i')
-
-  let is_int i = val_int Arith.(i land const 1l)
-
-  let int_add i i' = Arith.(i + i' - const 1l)
-
-  let int_sub i i' = Arith.(i - i' + const 1l)
-
-  let int_mul i i' = val_int Arith.(int_val i * int_val i')
-
-  let int_div i i' = val_int Arith.(int_val i / int_val i')
-
-  let int_mod i i' = val_int Arith.(int_val i mod int_val i')
-
-  let int_neg i = Arith.(const 2l - i)
-
-  let int_or i i' = Arith.(i lor i')
-
-  let int_and i i' = Arith.(i land i')
-
-  let int_xor i i' = Arith.(i lxor i' lor const 1l)
-
-  let int_lsl i i' = Arith.(((i - const 1l) lsl int_val i') + const 1l)
-
-  let int_lsr i i' = Arith.((i lsr int_val i') lor const 1l)
-
-  let int_asr i i' = Arith.((i asr int_val i') lor const 1l)
-end
-
-module Constant = struct
-  let rec translate_rec context c =
-    match c with
-    | Code.Int i ->
-        let i = Targetint.to_int32 i in
-        W.DataI32 Int32.(add (add i i) 1l)
-    | Tuple (tag, a, _) ->
-        let h = Memory.header ~const:true ~tag ~len:(Array.length a) () in
-        let name = Code.Var.fresh_n "block" in
-        let block =
-          W.DataI32 h :: List.map ~f:(fun c -> translate_rec context c) (Array.to_list a)
-        in
-        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
-    | NativeString (Byte s | Utf (Utf8 s)) | String s ->
-        let l = String.length s in
-        let len = (l + 4) / 4 in
-        let h = Memory.header ~const:true ~tag:Obj.string_tag ~len () in
-        let name = Code.Var.fresh_n "str" in
-        let extra = (4 * len) - l - 1 in
-        let string =
-          W.DataI32 h
-          :: DataBytes s
-          :: (if extra = 0 then [ DataI8 0 ] else [ DataSpace extra; DataI8 extra ])
-        in
-        context.data_segments <-
-          Code.Var.Map.add name (true, string) context.data_segments;
-        W.DataSym (V name, 4)
-    | Float f ->
-        let h = Memory.header ~const:true ~tag:Obj.double_tag ~len:2 () in
-        let name = Code.Var.fresh_n "float" in
-        let block = [ W.DataI32 h; DataI64 (Int64.bits_of_float f) ] in
-        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
-    | Float_array l ->
-        (*ZZZ Boxed array? *)
-        let l = Array.to_list l in
-        let h =
-          Memory.header ~const:true ~tag:Obj.double_array_tag ~len:(List.length l) ()
-        in
-        let name = Code.Var.fresh_n "float_array" in
-        let block =
-          W.DataI32 h :: List.map ~f:(fun f -> translate_rec context (Float f)) l
-        in
-        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
-    | Int64 i ->
-        let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:3 () in
-        let name = Code.Var.fresh_n "int64" in
-        let block =
-          [ W.DataI32 h; DataI32 0l (*ZZZ DataSym (S "caml_int64_ops", 0)*); DataI64 i ]
-        in
-        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
-    | Int32 i ->
-        let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:2 () in
-        let name = Code.Var.fresh_n "int32" in
-        let block =
-          [ W.DataI32 h; DataI32 0l (*ZZZ DataSym (S "caml_int32_ops", 0)*); DataI32 i ]
-        in
-        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
-    | NativeInt i ->
-        let h = Memory.header ~const:true ~tag:Obj.custom_tag ~len:2 () in
-        let name = Code.Var.fresh_n "nativeint" in
-        let block =
-          [ W.DataI32 h
-          ; DataI32 0l (*ZZZ DataSym (S "caml_nativeint_ops", 0)*)
-          ; DataI32 i
-          ]
-        in
-        context.data_segments <- Code.Var.Map.add name (true, block) context.data_segments;
-        W.DataSym (V name, 4)
-
-  let translate c =
-    let* context = get_context in
-    return
-      (match translate_rec context c with
-      | W.DataSym (name, offset) -> W.ConstSym (name, offset)
-      | W.DataI32 i -> W.Const (I32 i)
-      | _ -> assert false)
-end
-
-module Closure = struct
-  let get_free_variables ~context info =
-    List.filter
-      ~f:(fun x -> not (Hashtbl.mem context.constants x))
-      info.Wa_closure_conversion.free_variables
-
-  let closure_stats =
-    let s = ref 0 in
-    let n = ref 0 in
-    fun context info ->
-      let free_variables = get_free_variables ~context info in
-      if false && not (List.is_empty free_variables)
-      then
-        (incr n;
-         s := !s + List.length free_variables;
-         Format.eprintf
-           "OOO %d %f %s@."
-           (List.length free_variables)
-           (float !s /. float !n))
-          (Code.Var.to_string (fst (List.hd info.functions)))
-
-  let closure_env_start info =
-    List.fold_left
-      ~f:(fun i (_, arity) -> i + if arity > 1 then 4 else 3)
-      ~init:(-1)
-      info.Wa_closure_conversion.functions
-
-  let function_offset_in_closure info f =
-    let rec index i l =
-      match l with
-      | [] -> assert false
-      | (g, arity) :: r ->
-          if Code.Var.equal f g then i else index (i + if arity > 1 then 4 else 3) r
-    in
-    index 0 info.Wa_closure_conversion.functions
-
-  let closure_info ~arity ~sz =
-    W.Const (I32 Int32.(add (shift_left (of_int arity) 24) (of_int ((sz lsl 1) + 1))))
-
-  let translate ~context ~closures ~stack_ctx ~cps x =
-    let info = Code.Var.Map.find x closures in
-    let f, _ = List.hd info.Wa_closure_conversion.functions in
-    let* () = set_closure_env x x in
-    if Code.Var.equal x f
-    then (
-      let start_env = closure_env_start info in
-      let* _, start =
-        List.fold_left
-          ~f:(fun accu (f, arity) ->
-            let* i, start = accu in
-            let* curry_fun = if arity > 1 then need_curry_fun ~cps ~arity else return f in
-            let start =
-              if i = 0
-              then start
-              else W.Const (I32 (Memory.header ~tag:Obj.infix_tag ~len:i ())) :: start
-            in
-            let clos_info = closure_info ~arity ~sz:(start_env - i) in
-            let start = clos_info :: W.ConstSym (V curry_fun, 0) :: start in
-            return
-              (if arity > 1 then i + 4, W.ConstSym (V f, 0) :: start else i + 3, start))
-          ~init:(return (0, []))
-          info.functions
-      in
-      closure_stats context info;
-      let free_variables = get_free_variables ~context info in
-      if List.is_empty free_variables
-      then
-        let l =
-          List.rev_map
-            ~f:(fun e ->
-              match e with
-              | W.Const (I32 i) -> W.DataI32 i
-              | ConstSym (sym, offset) -> DataSym (sym, offset)
-              | _ -> assert false)
-            start
-        in
-        let h = Memory.header ~const:true ~tag:Obj.closure_tag ~len:(List.length l) () in
-        let name = Code.Var.fresh_n "closure" in
-        let* () = register_data_segment name ~active:true (W.DataI32 h :: l) in
-        let* () =
-          (* In case we did not detect that this closure was constant
-             during the spilling analysis *)
-          Stack.perform_spilling stack_ctx (`Instr x)
-        in
-        return (W.ConstSym (V name, 4))
-      else
-        Memory.allocate
-          stack_ctx
-          x
-          ~tag:Obj.closure_tag
-          (List.rev_map ~f:(fun e -> `Expr e) start
-          @ List.map ~f:(fun x -> `Var x) free_variables))
-    else
-      let offset = Int32.of_int (4 * function_offset_in_closure info x) in
-      Arith.(load f + const offset)
-
-  let bind_environment ~context ~closures ~cps:_ f =
-    if Hashtbl.mem context.constants f
-    then
-      (* The closures are all constants and the environment is empty. *)
-      let* _ = add_var (Code.Var.fresh ()) in
-      return ()
-    else
-      let info = Code.Var.Map.find f closures in
-      let funct_index = function_offset_in_closure info f in
-      let* _ = add_var f in
-      let* () =
-        snd
-          (List.fold_left
-             ~f:(fun (i, prev) (x, arity) ->
-               ( (i + if arity > 1 then 4 else 3)
-               , let* () = prev in
-                 if i = 0
-                 then return ()
-                 else
-                   define_var
-                     x
-                     (let offset = 4 * i in
-                      Arith.(load f + const (Int32.of_int offset))) ))
-             ~init:(-funct_index, return ())
-             info.functions)
-      in
-      let start_env = closure_env_start info in
-      let offset = start_env - funct_index in
-      let free_variables = get_free_variables ~context info in
-      snd
-        (List.fold_left
-           ~f:(fun (i, prev) x ->
-             ( i + 1
-             , let* () = prev in
-               define_var
-                 x
-                 (let* f = load f in
-                  return (W.Load (I32 (Int32.of_int (4 * i)), f))) ))
-           ~init:(offset, return ())
-           free_variables)
-
-  let curry_allocate ~stack_ctx ~x ~cps:_ ~arity _ ~f ~closure ~arg =
-    Memory.allocate
-      stack_ctx
-      x
-      ~tag:Obj.closure_tag
-      [ `Expr (W.ConstSym (V f, 0))
-      ; `Expr (closure_info ~arity ~sz:2)
-      ; `Var closure
-      ; `Var arg
-      ]
-
-  let curry_load ~cps:_ ~arity:_ _ closure =
-    return (Memory.field (load closure) 3, Memory.field (load closure) 4, None)
-
-  let dummy ~cps:_ ~arity:_ = assert false
-end
-
-module Math = struct
-  let float_func_type n =
-    { W.params = List.init ~len:n ~f:(fun _ : W.value_type -> F64); result = [ F64 ] }
-
-  let unary name x =
-    let* f = register_import ~name (Fun (float_func_type 1)) in
-    let* x = x in
-    return (W.Call (f, [ x ]))
-
-  let cos f = unary "cos" f
-
-  let sin f = unary "sin" f
-
-  let tan f = unary "tan" f
-
-  let acos f = unary "acos" f
-
-  let asin f = unary "asin" f
-
-  let atan f = unary "atan" f
-
-  let cosh f = unary "cosh" f
-
-  let sinh f = unary "sinh" f
-
-  let tanh f = unary "tanh" f
-
-  let acosh f = unary "acosh" f
-
-  let asinh f = unary "asinh" f
-
-  let atanh f = unary "atanh" f
-
-  let cbrt f = unary "cbrt" f
-
-  let exp f = unary "exp" f
-
-  let exp2 f = unary "exp2" f
-
-  let expm1 f = unary "expm1" f
-
-  let log f = unary "log" f
-
-  let log1p f = unary "log1p" f
-
-  let log2 f = unary "log2" f
-
-  let log10 f = unary "log10" f
-
-  let round f = unary "round" f
-
-  let binary name x y =
-    let* f = register_import ~name (Fun (float_func_type 2)) in
-    let* x = x in
-    let* y = y in
-    return (W.Call (f, [ x; y ]))
-
-  let atan2 f g = binary "atan2" f g
-
-  let hypot f g = binary "hypot" f g
-
-  let power f g = binary "pow" f g
-
-  let fmod f g = binary "fmod" f g
-end
-
-let internal_primitives = Hashtbl.create 0
-
-let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
-  let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in
-  try_
-    { params = []; result = result_typ }
-    (body ~result_typ ~fall_through:(`Block (-1)) ~context)
-    [ ( ocaml_tag
-      , let* () = store ~always:true x (return (W.Pop Value.value)) in
-        exn_handler ~result_typ ~fall_through ~context )
-    ]
-
-let post_process_function_body ~param_names:_ ~locals:_ instrs = instrs
-
-let entry_point ~toplevel_fun =
-  let code =
-    let declare_global name =
-      register_global (S name) { mut = true; typ = I32 } (Const (I32 0l))
-    in
-    let* () = declare_global "sp" in
-    let* () = declare_global "young_ptr" in
-    let* () = declare_global "young_limit" in
-    let* call_ctors =
-      register_import ~name:"__wasm_call_ctors" (Fun { W.params = []; result = [] })
-    in
-    let* () = instr (W.CallInstr (call_ctors, [])) in
-    let* sz = Arith.const 3l in
-    let* high = Arith.((return (W.MemoryGrow (0, sz)) + const 3l) lsl const 16l) in
-    let* () = instr (W.GlobalSet (S "young_ptr", high)) in
-    let low = W.ConstSym (S "__heap_base", 0) in
-    let* () = instr (W.GlobalSet (S "young_limit", low)) in
-    drop (return (W.Call (toplevel_fun, [])))
-  in
-  { W.params = []; result = [] }, [], code
diff --git a/compiler/lib/wasm/wa_core_target.mli b/compiler/lib/wasm/wa_core_target.mli
deleted file mode 100644
index e44faa1a1f..0000000000
--- a/compiler/lib/wasm/wa_core_target.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-include Wa_target_sig.S
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index f3640b3b49..e689ca6b6b 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -42,16 +42,14 @@ module Make (Target : Wa_target_sig.S) = struct
     let funct = Var.fresh () in
     let* closure = tee ?typ funct closure in
     let args = args @ [ closure ] in
-    let* kind, funct =
+    let* ty, funct =
       Memory.load_function_pointer
         ~cps
         ~arity
         ~skip_cast:(Option.is_some typ)
         (load funct)
     in
-    match kind with
-    | `Index -> return (W.Call_indirect (func_type (List.length args), funct, args))
-    | `Ref ty -> return (W.Call_ref (ty, funct, args))
+    return (W.Call_ref (ty, funct, args))
 
   let curry_app_name n m = Printf.sprintf "curry_app %d_%d" n m
 
@@ -125,40 +123,7 @@ module Make (Target : Wa_target_sig.S) = struct
     let body =
       let* _ = add_var x in
       let* _ = add_var f in
-      let res = Code.Var.fresh_n "res" in
-      let stack_info, stack =
-        Stack.make_info ()
-        |> fun info ->
-        Stack.add_spilling
-          info
-          ~location:res
-          ~stack:[]
-          ~live_vars:Var.Set.empty
-          ~spilled_vars:(Var.Set.of_list [ x; f ])
-      in
-      let ret = Code.Var.fresh_n "ret" in
-      let stack_info, _ =
-        Stack.add_spilling
-          stack_info
-          ~location:ret
-          ~stack
-          ~live_vars:Var.Set.empty
-          ~spilled_vars:Var.Set.empty
-      in
-      let stack_ctx = Stack.start_function ~context stack_info in
-      let* () =
-        push
-          (Closure.curry_allocate
-             ~stack_ctx
-             ~x:res
-             ~cps:false
-             ~arity
-             m
-             ~f:name'
-             ~closure:f
-             ~arg:x)
-      in
-      Stack.perform_spilling stack_ctx (`Instr ret)
+      push (Closure.curry_allocate ~cps:false ~arity m ~f:name' ~closure:f ~arg:x)
     in
     let param_names = [ x; f ] in
     let locals, body = function_body ~context ~param_names ~body in
@@ -230,39 +195,7 @@ module Make (Target : Wa_target_sig.S) = struct
       let* _ = add_var x in
       let* _ = add_var cont in
       let* _ = add_var f in
-      let res = Code.Var.fresh_n "res" in
-      let stack_info, stack =
-        Stack.make_info ()
-        |> fun info ->
-        Stack.add_spilling
-          info
-          ~location:res
-          ~stack:[]
-          ~live_vars:Var.Set.empty
-          ~spilled_vars:(Var.Set.of_list [ x; f ])
-      in
-      let ret = Code.Var.fresh_n "ret" in
-      let stack_info, _ =
-        Stack.add_spilling
-          stack_info
-          ~location:ret
-          ~stack
-          ~live_vars:Var.Set.empty
-          ~spilled_vars:Var.Set.empty
-      in
-      let stack_ctx = Stack.start_function ~context stack_info in
-      let* e =
-        Closure.curry_allocate
-          ~stack_ctx
-          ~x:res
-          ~cps:true
-          ~arity
-          m
-          ~f:name'
-          ~closure:f
-          ~arg:x
-      in
-      let* () = Stack.perform_spilling stack_ctx (`Instr ret) in
+      let* e = Closure.curry_allocate ~cps:true ~arity m ~f:name' ~closure:f ~arg:x in
       let* c = call ~cps:false ~arity:1 (load cont) [ e ] in
       instr (W.Return (Some c))
     in
@@ -291,39 +224,14 @@ module Make (Target : Wa_target_sig.S) = struct
         (fun ~typ closure ->
           let* l = expression_list load l in
           call ?typ ~cps:false ~arity closure l)
-        (let rec build_spilling_info stack_info stack live_vars acc l =
-           match l with
-           | [] -> stack_info, List.rev acc
-           | x :: rem ->
-               let live_vars = Var.Set.remove x live_vars in
-               let y = Var.fresh () in
-               let stack_info, stack =
-                 Stack.add_spilling
-                   stack_info
-                   ~location:y
-                   ~stack
-                   ~live_vars
-                   ~spilled_vars:
-                     (if List.is_empty stack then live_vars else Var.Set.empty)
-               in
-               build_spilling_info stack_info stack live_vars ((x, y) :: acc) rem
-         in
-         let stack_info, l =
-           build_spilling_info (Stack.make_info ()) [] (Var.Set.of_list l) [] l
-         in
-         let stack_ctx = Stack.start_function ~context stack_info in
-         let rec build_applies y l =
+        (let rec build_applies y l =
            match l with
            | [] ->
                let* y = y in
                instr (Push y)
-           | (x, y') :: rem ->
-               let* () = Stack.perform_reloads stack_ctx (`Vars (Var.Set.singleton x)) in
-               let* () = Stack.perform_spilling stack_ctx (`Instr y') in
+           | x :: rem ->
                let* x = load x in
-               Stack.kill_variables stack_ctx;
-               let* () = store y' (call ~cps:false ~arity:1 y [ x ]) in
-               build_applies (load y') rem
+               build_applies (call ~cps:false ~arity:1 y [ x ]) rem
          in
          build_applies (load f) l)
     in
@@ -349,46 +257,16 @@ module Make (Target : Wa_target_sig.S) = struct
         (fun ~typ closure ->
           let* l = expression_list load l in
           call ?typ ~cps:true ~arity closure l)
-        (let args = Code.Var.fresh_n "args" in
-         let stack_info, stack =
-           Stack.make_info ()
-           |> fun info ->
-           Stack.add_spilling
-             info
-             ~location:args
-             ~stack:[]
-             ~live_vars:(Var.Set.of_list (f :: l))
-             ~spilled_vars:(Var.Set.of_list (f :: l))
-         in
-         let ret = Code.Var.fresh_n "ret" in
-         let stack_info, _ =
-           Stack.add_spilling
-             stack_info
-             ~location:ret
-             ~stack
-             ~live_vars:Var.Set.empty
-             ~spilled_vars:Var.Set.empty
-         in
-         let stack_ctx = Stack.start_function ~context stack_info in
-         let* args =
-           Memory.allocate
-             stack_ctx
-             args
-             ~tag:0
-             (List.map ~f:(fun x -> `Var x) (List.tl l))
-         in
+        (let* args = Memory.allocate ~tag:0 (List.map ~f:(fun x -> `Var x) (List.tl l)) in
          let* make_iterator =
            register_import ~name:"caml_apply_continuation" (Fun (func_type 0))
          in
-         Stack.kill_variables stack_ctx;
          let iterate = Var.fresh_n "iterate" in
          let* () = store iterate (return (W.Call (make_iterator, [ args ]))) in
          let x = List.hd l in
-         let* () = Stack.perform_reloads stack_ctx (`Vars (Var.Set.of_list [ x; f ])) in
          let* x = load x in
          let* iterate = load iterate in
-         let* () = push (call ~cps:true ~arity:2 (load f) [ x; iterate ]) in
-         Stack.perform_spilling stack_ctx (`Instr ret))
+         push (call ~cps:true ~arity:2 (load f) [ x; iterate ]))
     in
     let param_names = l @ [ f ] in
     let locals, body = function_body ~context ~param_names ~body in
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 1ebf6943cc..262d14d4b5 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -480,7 +480,7 @@ module Value = struct
         match typ.typ with
         | W.I31 | Eq | Any -> return (W.Const (I32 1l))
         | Type _ | Func | Extern -> return (W.Const (I32 0l)))
-    | GlobalGet (V nm) -> (
+    | GlobalGet nm -> (
         let* init = get_global nm in
         match init with
         | Some (W.ArrayNewFixed (t, _) | W.StructNew (t, _)) ->
@@ -502,14 +502,12 @@ module Value = struct
 
   let rec effect_free e =
     match e with
-    | W.Const _ | ConstSym _ | LocalGet _ | GlobalGet _ | RefFunc _ | RefNull _ -> true
+    | W.Const _ | LocalGet _ | GlobalGet _ | RefFunc _ | RefNull _ -> true
     | UnOp (_, e')
     | I32WrapI64 e'
     | I64ExtendI32 (_, e')
     | F32DemoteF64 e'
     | F64PromoteF32 e'
-    | Load (_, e')
-    | Load8 (_, _, e')
     | RefI31 e'
     | I31Get (_, e')
     | ArrayLen e'
@@ -523,9 +521,7 @@ module Value = struct
     | RefEq (e1, e2) -> effect_free e1 && effect_free e2
     | LocalTee _
     | BlockExpr _
-    | Call_indirect _
     | Call _
-    | MemoryGrow _
     | Seq _
     | Pop _
     | Call_ref _
@@ -619,7 +615,7 @@ module Memory = struct
   let wasm_struct_get ty e i =
     let* e = e in
     match e with
-    | W.RefCast ({ typ; _ }, GlobalGet (V nm)) -> (
+    | W.RefCast ({ typ; _ }, GlobalGet nm) -> (
         let* init = get_global nm in
         match init with
         | Some (W.StructNew (ty', l)) ->
@@ -651,7 +647,7 @@ module Memory = struct
     let* e'' = e'' in
     instr (W.ArraySet (ty, e, e', e''))
 
-  let box_float _ _ e =
+  let box_float e =
     let* ty = Type.float_type in
     let* e = e in
     return (W.StructNew (ty, [ e ]))
@@ -660,7 +656,7 @@ module Memory = struct
     let* ty = Type.float_type in
     wasm_struct_get ty (wasm_cast ty e) 0
 
-  let allocate _ _ ~tag l =
+  let allocate ~tag l =
     if tag = 254
     then
       let* l =
@@ -730,7 +726,7 @@ module Memory = struct
   let array_set e e' e'' = wasm_array_set e Arith.(Value.int_val e' + const 1l) e''
 
   let float_array_get e e' =
-    box_float () () (wasm_array_get ~ty:Type.float_array_type e (Value.int_val e'))
+    box_float (wasm_array_get ~ty:Type.float_array_type e (Value.int_val e'))
 
   let float_array_set e e' e'' =
     wasm_array_set ~ty:Type.float_array_type e (Value.int_val e') (unbox_float e'')
@@ -760,9 +756,7 @@ module Memory = struct
                in
                instr (Br (1, Some e))))
        in
-       let* e =
-         box_float () () (wasm_array_get ~ty:Type.float_array_type (load a) (load i))
-       in
+       let* e = box_float (wasm_array_get ~ty:Type.float_array_type (load a) (load i)) in
        instr (W.Push e))
 
   let gen_array_set e e' e'' =
@@ -821,7 +815,7 @@ module Memory = struct
     let* fun_ty = Type.function_type ~cps arity in
     let casted_closure = if skip_cast then closure else wasm_cast ty closure in
     let* e = wasm_struct_get ty casted_closure (env_start arity - 1) in
-    return (`Ref fun_ty, e)
+    return (fun_ty, e)
 
   let load_real_closure ~cps ~arity closure =
     let arity = if cps then arity - 1 else arity in
@@ -866,9 +860,9 @@ module Memory = struct
     in
     let* ty = Type.int32_type in
     let* e = e in
-    return (W.StructNew (ty, [ GlobalGet (V int32_ops); e ]))
+    return (W.StructNew (ty, [ GlobalGet int32_ops; e ]))
 
-  let box_int32 _ _ e = make_int32 ~kind:`Int32 e
+  let box_int32 e = make_int32 ~kind:`Int32 e
 
   let unbox_int32 e =
     let* ty = Type.int32_type in
@@ -884,15 +878,15 @@ module Memory = struct
     in
     let* ty = Type.int64_type in
     let* e = e in
-    return (W.StructNew (ty, [ GlobalGet (V int64_ops); e ]))
+    return (W.StructNew (ty, [ GlobalGet int64_ops; e ]))
 
-  let box_int64 _ _ e = make_int64 e
+  let box_int64 e = make_int64 e
 
   let unbox_int64 e =
     let* ty = Type.int64_type in
     wasm_struct_get ty (wasm_cast ty e) 1
 
-  let box_nativeint _ _ e = make_int32 ~kind:`Nativeint e
+  let box_nativeint e = make_int32 ~kind:`Nativeint e
 
   let unbox_nativeint e =
     let* ty = Type.int32_type in
@@ -906,8 +900,8 @@ module Constant = struct
 
   let store_in_global ?(name = "const") c =
     let name = Code.Var.fresh_n name in
-    let* () = register_global (V name) { mut = false; typ = Type.value } c in
-    return (W.GlobalGet (V name))
+    let* () = register_global name { mut = false; typ = Type.value } c in
+    return (W.GlobalGet name)
 
   let str_js_utf8 s =
     let b = Buffer.create (String.length s) in
@@ -1000,13 +994,13 @@ module Constant = struct
             (Global { mut = false; typ = Ref { nullable = false; typ = Any } })
         in
         let* ty = Type.js_type in
-        return (Const_named ("str_" ^ s), W.StructNew (ty, [ GlobalGet (V x) ]))
+        return (Const_named ("str_" ^ s), W.StructNew (ty, [ GlobalGet x ]))
     | String s ->
         let* ty = Type.string_type in
         if String.length s >= string_length_threshold
         then
           let name = Code.Var.fresh_n "string" in
-          let* () = register_data_segment name ~active:false [ DataBytes s ] in
+          let* () = register_data_segment name s in
           return
             ( Mutated
             , W.ArrayNewData
@@ -1050,12 +1044,12 @@ module Constant = struct
         let* () =
           register_global
             ~constant:true
-            (V name)
+            name
             { mut = true; typ = Type.value }
             (W.RefI31 (Const (I32 0l)))
         in
-        let* () = register_init_code (instr (W.GlobalSet (V name, c))) in
-        return (W.GlobalGet (V name))
+        let* () = register_init_code (instr (W.GlobalSet (name, c))) in
+        return (W.GlobalGet name)
 end
 
 module Closure = struct
@@ -1070,7 +1064,7 @@ module Closure = struct
     | [ (g, _) ] -> Code.Var.equal f g
     | _ :: r -> is_last_fun r f
 
-  let translate ~context ~closures ~stack_ctx:_ ~cps f =
+  let translate ~context ~closures ~cps f =
     let info = Code.Var.Map.find f closures in
     let free_variables = get_free_variables ~context info in
     assert (
@@ -1087,7 +1081,7 @@ module Closure = struct
       let name = Code.Var.fork f in
       let* () =
         register_global
-          (V name)
+          name
           { mut = false; typ = Type.value }
           (W.StructNew
              ( typ
@@ -1101,7 +1095,7 @@ module Closure = struct
                  then Const (I32 (Int32.of_int arity)) :: code_pointers
                  else code_pointers ))
       in
-      return (W.GlobalGet (V name))
+      return (W.GlobalGet name)
     else
       let free_variable_count = List.length free_variables in
       match info.Wa_closure_conversion.functions with
@@ -1238,7 +1232,7 @@ module Closure = struct
                ~init:(0, return ())
                (List.map ~f:fst functions @ free_variables))
 
-  let curry_allocate ~stack_ctx:_ ~x:_ ~cps ~arity m ~f ~closure ~arg =
+  let curry_allocate ~cps ~arity m ~f ~closure ~arg =
     let* ty = Type.curry_type ~cps arity m in
     let* cl_ty =
       if m = arity
@@ -1291,36 +1285,6 @@ module Closure = struct
            else closure_contents ))
 end
 
-module Stack = struct
-  type stack = Code.Var.t option list
-
-  type info = unit
-
-  let generate_spilling_information _ ~context:_ ~closures:_ ~pc:_ ~env:_ ~params:_ = ()
-
-  let add_spilling _ ~location:_ ~stack:_ ~live_vars:_ ~spilled_vars:_ = (), []
-
-  type ctx = unit
-
-  let start_function ~context:_ _ = ()
-
-  let start_block ~context:_ _ _ = ()
-
-  let perform_reloads _ _ = return ()
-
-  let perform_spilling _ _ = return ()
-
-  let kill_variables _ = ()
-
-  let assign _ _ = return ()
-
-  let make_info () = ()
-
-  let adjust_stack _ ~src:_ ~dst:_ = return ()
-
-  let stack_adjustment_needed _ ~src:_ ~dst:_ = false
-end
-
 module Math = struct
   let float_func_type n =
     { W.params = List.init ~len:n ~f:(fun _ : W.value_type -> F64); result = [ F64 ] }
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 49f413fef3..6b3c0d807f 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -21,8 +21,6 @@ open Code
 module W = Wa_ast
 open Wa_code_generation
 
-let target = `GC (*`Core*)
-
 module Generate (Target : Wa_target_sig.S) = struct
   open Target
 
@@ -43,55 +41,54 @@ module Generate (Target : Wa_target_sig.S) = struct
   let func_type n =
     { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
 
-  let float_bin_op' stack_ctx x op f g =
-    Memory.box_float stack_ctx x (op (Memory.unbox_float f) (Memory.unbox_float g))
+  let float_bin_op' op f g =
+    Memory.box_float (op (Memory.unbox_float f) (Memory.unbox_float g))
 
-  let float_bin_op stack_ctx x op f g =
+  let float_bin_op op f g =
     let* f = Memory.unbox_float f in
     let* g = Memory.unbox_float g in
-    Memory.box_float stack_ctx x (return (W.BinOp (F64 op, f, g)))
+    Memory.box_float (return (W.BinOp (F64 op, f, g)))
 
-  let float_un_op' stack_ctx x op f =
-    Memory.box_float stack_ctx x (op (Memory.unbox_float f))
+  let float_un_op' op f = Memory.box_float (op (Memory.unbox_float f))
 
-  let float_un_op stack_ctx x op f =
+  let float_un_op op f =
     let* f = Memory.unbox_float f in
-    Memory.box_float stack_ctx x (return (W.UnOp (F64 op, f)))
+    Memory.box_float (return (W.UnOp (F64 op, f)))
 
   let float_comparison op f g =
     let* f = Memory.unbox_float f in
     let* g = Memory.unbox_float g in
     Value.val_int (return (W.BinOp (F64 op, f, g)))
 
-  let int32_bin_op stack_ctx x op f g =
+  let int32_bin_op op f g =
     let* f = Memory.unbox_int32 f in
     let* g = Memory.unbox_int32 g in
-    Memory.box_int32 stack_ctx x (return (W.BinOp (I32 op, f, g)))
+    Memory.box_int32 (return (W.BinOp (I32 op, f, g)))
 
-  let int32_shift_op stack_ctx x op f g =
+  let int32_shift_op op f g =
     let* f = Memory.unbox_int32 f in
     let* g = Value.int_val g in
-    Memory.box_int32 stack_ctx x (return (W.BinOp (I32 op, f, g)))
+    Memory.box_int32 (return (W.BinOp (I32 op, f, g)))
 
-  let int64_bin_op stack_ctx x op f g =
+  let int64_bin_op op f g =
     let* f = Memory.unbox_int64 f in
     let* g = Memory.unbox_int64 g in
-    Memory.box_int64 stack_ctx x (return (W.BinOp (I64 op, f, g)))
+    Memory.box_int64 (return (W.BinOp (I64 op, f, g)))
 
-  let int64_shift_op stack_ctx x op f g =
+  let int64_shift_op op f g =
     let* f = Memory.unbox_int64 f in
     let* g = Value.int_val g in
-    Memory.box_int64 stack_ctx x (return (W.BinOp (I64 op, f, I64ExtendI32 (S, g))))
+    Memory.box_int64 (return (W.BinOp (I64 op, f, I64ExtendI32 (S, g))))
 
-  let nativeint_bin_op stack_ctx x op f g =
+  let nativeint_bin_op op f g =
     let* f = Memory.unbox_nativeint f in
     let* g = Memory.unbox_nativeint g in
-    Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 op, f, g)))
+    Memory.box_nativeint (return (W.BinOp (I32 op, f, g)))
 
-  let nativeint_shift_op stack_ctx x op f g =
+  let nativeint_shift_op op f g =
     let* f = Memory.unbox_nativeint f in
     let* g = Value.int_val g in
-    Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 op, f, g)))
+    Memory.box_nativeint (return (W.BinOp (I32 op, f, g)))
 
   let label_index context pc =
     let rec index_rec context pc i =
@@ -106,57 +103,48 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   let zero_divide_pc = -2
 
-  let rec translate_expr ctx stack_ctx context x e =
+  let rec translate_expr ctx context x e =
     match e with
     | Apply { f; args; exact }
       when exact || List.length args = if Var.Set.mem x ctx.in_cps then 2 else 1 ->
-        let* () = Stack.perform_spilling stack_ctx (`Instr x) in
         let rec loop acc l =
           match l with
           | [] -> (
               let arity = List.length args in
               let funct = Var.fresh () in
               let* closure = tee funct (load f) in
-              let* kind, funct =
+              let* ty, funct =
                 Memory.load_function_pointer
                   ~cps:(Var.Set.mem x ctx.in_cps)
                   ~arity
                   (load funct)
               in
-              Stack.kill_variables stack_ctx;
               let* b = is_closure f in
               if b
               then return (W.Call (f, List.rev (closure :: acc)))
               else
-                match kind, funct with
-                | `Index, W.ConstSym (V g, 0) | `Ref _, W.RefFunc g ->
+                match funct with
+                | W.RefFunc g ->
                     (* Functions with constant closures ignore their
                        environment. In case of partial application, we
                        still need the closure. *)
                     let* cl = if exact then Value.unit else return closure in
                     return (W.Call (g, List.rev (cl :: acc)))
-                | `Index, _ ->
-                    return
-                      (W.Call_indirect
-                         (func_type (arity + 1), funct, List.rev (closure :: acc)))
-                | `Ref ty, _ -> return (W.Call_ref (ty, funct, List.rev (closure :: acc)))
-              )
+                | _ -> return (W.Call_ref (ty, funct, List.rev (closure :: acc))))
           | x :: r ->
               let* x = load x in
               loop (x :: acc) r
         in
         loop [] args
     | Apply { f; args; _ } ->
-        let* () = Stack.perform_spilling stack_ctx (`Instr x) in
         let* apply =
           need_apply_fun ~cps:(Var.Set.mem x ctx.in_cps) ~arity:(List.length args)
         in
         let* args = expression_list load args in
         let* closure = load f in
-        Stack.kill_variables stack_ctx;
         return (W.Call (apply, args @ [ closure ]))
     | Block (tag, a, _, _) ->
-        Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
+        Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
     | Field (x, n, Non_float) -> Memory.field (load x) n
     | Field (x, n, Float) ->
         Memory.float_array_get
@@ -166,15 +154,13 @@ module Generate (Target : Wa_target_sig.S) = struct
         Closure.translate
           ~context:ctx.global_context
           ~closures:ctx.closures
-          ~stack_ctx
           ~cps:(Var.Set.mem x ctx.in_cps)
           x
     | Constant c -> Constant.translate c
     | Special (Alias_prim _) -> assert false
-    | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int arity) ])
-      when Poly.(target = `GC) ->
+    | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int arity) ]) ->
         Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:(Targetint.to_int_exn arity)
-    | Prim (Extern "caml_alloc_dummy_infix", _) when Poly.(target = `GC) ->
+    | Prim (Extern "caml_alloc_dummy_infix", _) ->
         Closure.dummy ~cps:(Config.Flag.effects ()) ~arity:1
     | Prim (Extern "caml_get_global", [ Pc (String name) ]) ->
         let* x =
@@ -183,7 +169,7 @@ module Generate (Target : Wa_target_sig.S) = struct
             List.find_map
               ~f:(fun f ->
                 match f with
-                | W.Global { name = V name'; exported_name = Some exported_name; _ }
+                | W.Global { name = name'; exported_name = Some exported_name; _ }
                   when String.equal exported_name name -> Some name'
                 | _ -> None)
               context.other_fields
@@ -193,18 +179,18 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* typ = Value.block_type in
               register_import ~import_module:"OCaml" ~name (Global { mut = true; typ })
         in
-        return (W.GlobalGet (V x))
+        return (W.GlobalGet x)
     | Prim (Extern "caml_set_global", [ Pc (String name); v ]) ->
         let v = transl_prim_arg v in
         let x = Var.fresh_n name in
         let* () =
           let* typ = Value.block_type in
           let* dummy = Value.dummy_block in
-          register_global (V x) ~exported_name:name { mut = true; typ } dummy
+          register_global x ~exported_name:name { mut = true; typ } dummy
         in
         seq
           (let* v = Value.as_block v in
-           instr (W.GlobalSet (V x, v)))
+           instr (W.GlobalSet (x, v)))
           Value.unit
     | Prim (p, l) -> (
         match p with
@@ -278,23 +264,22 @@ module Generate (Target : Wa_target_sig.S) = struct
                    in
                    instr (W.Br_if (label_index context bound_error_pc, cond)))
                   x
-            | Extern "caml_add_float", [ f; g ] -> float_bin_op stack_ctx x Add f g
-            | Extern "caml_sub_float", [ f; g ] -> float_bin_op stack_ctx x Sub f g
-            | Extern "caml_mul_float", [ f; g ] -> float_bin_op stack_ctx x Mul f g
-            | Extern "caml_div_float", [ f; g ] -> float_bin_op stack_ctx x Div f g
-            | Extern "caml_copysign_float", [ f; g ] ->
-                float_bin_op stack_ctx x CopySign f g
+            | Extern "caml_add_float", [ f; g ] -> float_bin_op Add f g
+            | Extern "caml_sub_float", [ f; g ] -> float_bin_op Sub f g
+            | Extern "caml_mul_float", [ f; g ] -> float_bin_op Mul f g
+            | Extern "caml_div_float", [ f; g ] -> float_bin_op Div f g
+            | Extern "caml_copysign_float", [ f; g ] -> float_bin_op CopySign f g
             | Extern "caml_signbit_float", [ f ] ->
                 let* f = Memory.unbox_float f in
                 let sign = W.BinOp (F64 CopySign, Const (F64 1.), f) in
                 Value.val_int (return (W.BinOp (F64 Lt, sign, Const (F64 0.))))
-            | Extern "caml_neg_float", [ f ] -> float_un_op stack_ctx x Neg f
-            | Extern "caml_abs_float", [ f ] -> float_un_op stack_ctx x Abs f
-            | Extern "caml_ceil_float", [ f ] -> float_un_op stack_ctx x Ceil f
-            | Extern "caml_floor_float", [ f ] -> float_un_op stack_ctx x Floor f
-            | Extern "caml_trunc_float", [ f ] -> float_un_op stack_ctx x Trunc f
-            | Extern "caml_round_float", [ f ] -> float_un_op' stack_ctx x Math.round f
-            | Extern "caml_sqrt_float", [ f ] -> float_un_op stack_ctx x Sqrt f
+            | Extern "caml_neg_float", [ f ] -> float_un_op Neg f
+            | Extern "caml_abs_float", [ f ] -> float_un_op Abs f
+            | Extern "caml_ceil_float", [ f ] -> float_un_op Ceil f
+            | Extern "caml_floor_float", [ f ] -> float_un_op Floor f
+            | Extern "caml_trunc_float", [ f ] -> float_un_op Trunc f
+            | Extern "caml_round_float", [ f ] -> float_un_op' Math.round f
+            | Extern "caml_sqrt_float", [ f ] -> float_un_op Sqrt f
             | Extern "caml_eq_float", [ f; g ] -> float_comparison Eq f g
             | Extern "caml_neq_float", [ f; g ] -> float_comparison Ne f g
             | Extern "caml_ge_float", [ f; g ] -> float_comparison Ge f g
@@ -306,71 +291,52 @@ module Generate (Target : Wa_target_sig.S) = struct
                 Value.val_int (return (W.UnOp (I32 (TruncSatF64 S), f)))
             | Extern "caml_float_of_int", [ n ] ->
                 let* n = Value.int_val n in
-                Memory.box_float
-                  stack_ctx
-                  x
-                  (return (W.UnOp (F64 (Convert (`I32, S)), n)))
-            | Extern "caml_cos_float", [ f ] -> float_un_op' stack_ctx x Math.cos f
-            | Extern "caml_sin_float", [ f ] -> float_un_op' stack_ctx x Math.sin f
-            | Extern "caml_tan_float", [ f ] -> float_un_op' stack_ctx x Math.tan f
-            | Extern "caml_acos_float", [ f ] -> float_un_op' stack_ctx x Math.acos f
-            | Extern "caml_asin_float", [ f ] -> float_un_op' stack_ctx x Math.asin f
-            | Extern "caml_atan_float", [ f ] -> float_un_op' stack_ctx x Math.atan f
-            | Extern "caml_atan2_float", [ f; g ] ->
-                float_bin_op' stack_ctx x Math.atan2 f g
-            | Extern "caml_cosh_float", [ f ] -> float_un_op' stack_ctx x Math.cosh f
-            | Extern "caml_sinh_float", [ f ] -> float_un_op' stack_ctx x Math.sinh f
-            | Extern "caml_tanh_float", [ f ] -> float_un_op' stack_ctx x Math.tanh f
-            | Extern "caml_acosh_float", [ f ] -> float_un_op' stack_ctx x Math.acosh f
-            | Extern "caml_asinh_float", [ f ] -> float_un_op' stack_ctx x Math.asinh f
-            | Extern "caml_atanh_float", [ f ] -> float_un_op' stack_ctx x Math.atanh f
-            | Extern "caml_cbrt_float", [ f ] -> float_un_op' stack_ctx x Math.cbrt f
-            | Extern "caml_exp_float", [ f ] -> float_un_op' stack_ctx x Math.exp f
-            | Extern "caml_exp2_float", [ f ] -> float_un_op' stack_ctx x Math.exp2 f
-            | Extern "caml_log_float", [ f ] -> float_un_op' stack_ctx x Math.log f
-            | Extern "caml_expm1_float", [ f ] -> float_un_op' stack_ctx x Math.expm1 f
-            | Extern "caml_log1p_float", [ f ] -> float_un_op' stack_ctx x Math.log1p f
-            | Extern "caml_log2_float", [ f ] -> float_un_op' stack_ctx x Math.log2 f
-            | Extern "caml_log10_float", [ f ] -> float_un_op' stack_ctx x Math.log10 f
-            | Extern "caml_power_float", [ f; g ] ->
-                float_bin_op' stack_ctx x Math.power f g
-            | Extern "caml_hypot_float", [ f; g ] ->
-                float_bin_op' stack_ctx x Math.hypot f g
-            | Extern "caml_fmod_float", [ f; g ] ->
-                float_bin_op' stack_ctx x Math.fmod f g
+                Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+            | Extern "caml_cos_float", [ f ] -> float_un_op' Math.cos f
+            | Extern "caml_sin_float", [ f ] -> float_un_op' Math.sin f
+            | Extern "caml_tan_float", [ f ] -> float_un_op' Math.tan f
+            | Extern "caml_acos_float", [ f ] -> float_un_op' Math.acos f
+            | Extern "caml_asin_float", [ f ] -> float_un_op' Math.asin f
+            | Extern "caml_atan_float", [ f ] -> float_un_op' Math.atan f
+            | Extern "caml_atan2_float", [ f; g ] -> float_bin_op' Math.atan2 f g
+            | Extern "caml_cosh_float", [ f ] -> float_un_op' Math.cosh f
+            | Extern "caml_sinh_float", [ f ] -> float_un_op' Math.sinh f
+            | Extern "caml_tanh_float", [ f ] -> float_un_op' Math.tanh f
+            | Extern "caml_acosh_float", [ f ] -> float_un_op' Math.acosh f
+            | Extern "caml_asinh_float", [ f ] -> float_un_op' Math.asinh f
+            | Extern "caml_atanh_float", [ f ] -> float_un_op' Math.atanh f
+            | Extern "caml_cbrt_float", [ f ] -> float_un_op' Math.cbrt f
+            | Extern "caml_exp_float", [ f ] -> float_un_op' Math.exp f
+            | Extern "caml_exp2_float", [ f ] -> float_un_op' Math.exp2 f
+            | Extern "caml_log_float", [ f ] -> float_un_op' Math.log f
+            | Extern "caml_expm1_float", [ f ] -> float_un_op' Math.expm1 f
+            | Extern "caml_log1p_float", [ f ] -> float_un_op' Math.log1p f
+            | Extern "caml_log2_float", [ f ] -> float_un_op' Math.log2 f
+            | Extern "caml_log10_float", [ f ] -> float_un_op' Math.log10 f
+            | Extern "caml_power_float", [ f; g ] -> float_bin_op' Math.power f g
+            | Extern "caml_hypot_float", [ f; g ] -> float_bin_op' Math.hypot f g
+            | Extern "caml_fmod_float", [ f; g ] -> float_bin_op' Math.fmod f g
             | Extern "caml_int32_bits_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
-                Memory.box_int32
-                  stack_ctx
-                  x
-                  (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
+                Memory.box_int32 (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
             | Extern "caml_int32_float_of_bits", [ i ] ->
                 let* i = Memory.unbox_int32 i in
-                Memory.box_float
-                  stack_ctx
-                  x
-                  (return (W.F64PromoteF32 (UnOp (F32 ReinterpretI, i))))
+                Memory.box_float (return (W.F64PromoteF32 (UnOp (F32 ReinterpretI, i))))
             | Extern "caml_int32_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
-                Memory.box_int32 stack_ctx x (return (W.UnOp (I32 (TruncSatF64 S), f)))
+                Memory.box_int32 (return (W.UnOp (I32 (TruncSatF64 S), f)))
             | Extern "caml_int32_to_float", [ n ] ->
                 let* n = Memory.unbox_int32 n in
-                Memory.box_float
-                  stack_ctx
-                  x
-                  (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+                Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n)))
             | Extern "caml_int32_neg", [ i ] ->
                 let* i = Memory.unbox_int32 i in
-                Memory.box_int32
-                  stack_ctx
-                  x
-                  (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
-            | Extern "caml_int32_add", [ i; j ] -> int32_bin_op stack_ctx x Add i j
-            | Extern "caml_int32_sub", [ i; j ] -> int32_bin_op stack_ctx x Sub i j
-            | Extern "caml_int32_mul", [ i; j ] -> int32_bin_op stack_ctx x Mul i j
-            | Extern "caml_int32_and", [ i; j ] -> int32_bin_op stack_ctx x And i j
-            | Extern "caml_int32_or", [ i; j ] -> int32_bin_op stack_ctx x Or i j
-            | Extern "caml_int32_xor", [ i; j ] -> int32_bin_op stack_ctx x Xor i j
+                Memory.box_int32 (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
+            | Extern "caml_int32_add", [ i; j ] -> int32_bin_op Add i j
+            | Extern "caml_int32_sub", [ i; j ] -> int32_bin_op Sub i j
+            | Extern "caml_int32_mul", [ i; j ] -> int32_bin_op Mul i j
+            | Extern "caml_int32_and", [ i; j ] -> int32_bin_op And i j
+            | Extern "caml_int32_or", [ i; j ] -> int32_bin_op Or i j
+            | Extern "caml_int32_xor", [ i; j ] -> int32_bin_op Xor i j
             | Extern "caml_int32_div", [ i; j ] ->
                 let res = Var.fresh () in
                 (*ZZZ Can we do better?*)
@@ -403,7 +369,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                         (let* i = load i' in
                          let* j = load j' in
                          return (W.BinOp (I32 (Div S), i, j)))))
-                  (Memory.box_int32 stack_ctx x (load res))
+                  (Memory.box_int32 (load res))
             | Extern "caml_int32_mod", [ i; j ] ->
                 let j' = Var.fresh () in
                 seq
@@ -413,43 +379,34 @@ module Generate (Target : Wa_target_sig.S) = struct
                      (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
                   (let* i = Memory.unbox_int32 i in
                    let* j = load j' in
-                   Memory.box_int32 stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
-            | Extern "caml_int32_shift_left", [ i; j ] ->
-                int32_shift_op stack_ctx x Shl i j
-            | Extern "caml_int32_shift_right", [ i; j ] ->
-                int32_shift_op stack_ctx x (Shr S) i j
+                   Memory.box_int32 (return (W.BinOp (I32 (Rem S), i, j))))
+            | Extern "caml_int32_shift_left", [ i; j ] -> int32_shift_op Shl i j
+            | Extern "caml_int32_shift_right", [ i; j ] -> int32_shift_op (Shr S) i j
             | Extern "caml_int32_shift_right_unsigned", [ i; j ] ->
-                int32_shift_op stack_ctx x (Shr U) i j
+                int32_shift_op (Shr U) i j
             | Extern "caml_int32_to_int", [ i ] -> Value.val_int (Memory.unbox_int32 i)
-            | Extern "caml_int32_of_int", [ i ] ->
-                Memory.box_int32 stack_ctx x (Value.int_val i)
+            | Extern "caml_int32_of_int", [ i ] -> Memory.box_int32 (Value.int_val i)
             | Extern "caml_int64_bits_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
-                Memory.box_int64 stack_ctx x (return (W.UnOp (I64 ReinterpretF, f)))
+                Memory.box_int64 (return (W.UnOp (I64 ReinterpretF, f)))
             | Extern "caml_int64_float_of_bits", [ i ] ->
                 let* i = Memory.unbox_int64 i in
-                Memory.box_float stack_ctx x (return (W.UnOp (F64 ReinterpretI, i)))
+                Memory.box_float (return (W.UnOp (F64 ReinterpretI, i)))
             | Extern "caml_int64_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
-                Memory.box_int64 stack_ctx x (return (W.UnOp (I64 (TruncSatF64 S), f)))
+                Memory.box_int64 (return (W.UnOp (I64 (TruncSatF64 S), f)))
             | Extern "caml_int64_to_float", [ n ] ->
                 let* n = Memory.unbox_int64 n in
-                Memory.box_float
-                  stack_ctx
-                  x
-                  (return (W.UnOp (F64 (Convert (`I64, S)), n)))
+                Memory.box_float (return (W.UnOp (F64 (Convert (`I64, S)), n)))
             | Extern "caml_int64_neg", [ i ] ->
                 let* i = Memory.unbox_int64 i in
-                Memory.box_int64
-                  stack_ctx
-                  x
-                  (return (W.BinOp (I64 Sub, Const (I64 0L), i)))
-            | Extern "caml_int64_add", [ i; j ] -> int64_bin_op stack_ctx x Add i j
-            | Extern "caml_int64_sub", [ i; j ] -> int64_bin_op stack_ctx x Sub i j
-            | Extern "caml_int64_mul", [ i; j ] -> int64_bin_op stack_ctx x Mul i j
-            | Extern "caml_int64_and", [ i; j ] -> int64_bin_op stack_ctx x And i j
-            | Extern "caml_int64_or", [ i; j ] -> int64_bin_op stack_ctx x Or i j
-            | Extern "caml_int64_xor", [ i; j ] -> int64_bin_op stack_ctx x Xor i j
+                Memory.box_int64 (return (W.BinOp (I64 Sub, Const (I64 0L), i)))
+            | Extern "caml_int64_add", [ i; j ] -> int64_bin_op Add i j
+            | Extern "caml_int64_sub", [ i; j ] -> int64_bin_op Sub i j
+            | Extern "caml_int64_mul", [ i; j ] -> int64_bin_op Mul i j
+            | Extern "caml_int64_and", [ i; j ] -> int64_bin_op And i j
+            | Extern "caml_int64_or", [ i; j ] -> int64_bin_op Or i j
+            | Extern "caml_int64_xor", [ i; j ] -> int64_bin_op Xor i j
             | Extern "caml_int64_div", [ i; j ] ->
                 let res = Var.fresh () in
                 (*ZZZ Can we do better?*)
@@ -482,7 +439,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                         (let* i = load i' in
                          let* j = load j' in
                          return (W.BinOp (I64 (Div S), i, j)))))
-                  (Memory.box_int64 stack_ctx x (load res))
+                  (Memory.box_int64 (load res))
             | Extern "caml_int64_mod", [ i; j ] ->
                 let j' = Var.fresh () in
                 seq
@@ -492,78 +449,54 @@ module Generate (Target : Wa_target_sig.S) = struct
                      (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j))))
                   (let* i = Memory.unbox_int64 i in
                    let* j = load j' in
-                   Memory.box_int64 stack_ctx x (return (W.BinOp (I64 (Rem S), i, j))))
-            | Extern "caml_int64_shift_left", [ i; j ] ->
-                int64_shift_op stack_ctx x Shl i j
-            | Extern "caml_int64_shift_right", [ i; j ] ->
-                int64_shift_op stack_ctx x (Shr S) i j
+                   Memory.box_int64 (return (W.BinOp (I64 (Rem S), i, j))))
+            | Extern "caml_int64_shift_left", [ i; j ] -> int64_shift_op Shl i j
+            | Extern "caml_int64_shift_right", [ i; j ] -> int64_shift_op (Shr S) i j
             | Extern "caml_int64_shift_right_unsigned", [ i; j ] ->
-                int64_shift_op stack_ctx x (Shr U) i j
+                int64_shift_op (Shr U) i j
             | Extern "caml_int64_to_int", [ i ] ->
                 let* i = Memory.unbox_int64 i in
                 Value.val_int (return (W.I32WrapI64 i))
             | Extern "caml_int64_of_int", [ i ] ->
                 let* i = Value.int_val i in
                 Memory.box_int64
-                  stack_ctx
-                  x
                   (return
                      (match i with
                      | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i))
                      | _ -> W.I64ExtendI32 (S, i)))
             | Extern "caml_int64_to_int32", [ i ] ->
                 let* i = Memory.unbox_int64 i in
-                Memory.box_int32 stack_ctx x (return (W.I32WrapI64 i))
+                Memory.box_int32 (return (W.I32WrapI64 i))
             | Extern "caml_int64_of_int32", [ i ] ->
                 let* i = Memory.unbox_int32 i in
-                Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
+                Memory.box_int64 (return (W.I64ExtendI32 (S, i)))
             | Extern "caml_int64_to_nativeint", [ i ] ->
                 let* i = Memory.unbox_int64 i in
-                Memory.box_nativeint stack_ctx x (return (W.I32WrapI64 i))
+                Memory.box_nativeint (return (W.I32WrapI64 i))
             | Extern "caml_int64_of_nativeint", [ i ] ->
                 let* i = Memory.unbox_nativeint i in
-                Memory.box_int64 stack_ctx x (return (W.I64ExtendI32 (S, i)))
+                Memory.box_int64 (return (W.I64ExtendI32 (S, i)))
             | Extern "caml_nativeint_bits_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
-                Memory.box_nativeint
-                  stack_ctx
-                  x
-                  (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
+                Memory.box_nativeint (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))
             | Extern "caml_nativeint_float_of_bits", [ i ] ->
                 let* i = Memory.unbox_int64 i in
-                Memory.box_float
-                  stack_ctx
-                  x
-                  (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
+                Memory.box_float (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))
             | Extern "caml_nativeint_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
-                Memory.box_nativeint
-                  stack_ctx
-                  x
-                  (return (W.UnOp (I32 (TruncSatF64 S), f)))
+                Memory.box_nativeint (return (W.UnOp (I32 (TruncSatF64 S), f)))
             | Extern "caml_nativeint_to_float", [ n ] ->
                 let* n = Memory.unbox_nativeint n in
-                Memory.box_float
-                  stack_ctx
-                  x
-                  (return (W.UnOp (F64 (Convert (`I32, S)), n)))
+                Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n)))
             | Extern "caml_nativeint_neg", [ i ] ->
                 let* i = Memory.unbox_nativeint i in
-                Memory.box_nativeint
-                  stack_ctx
-                  x
-                  (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
-            | Extern "caml_nativeint_add", [ i; j ] ->
-                nativeint_bin_op stack_ctx x Add i j
-            | Extern "caml_nativeint_sub", [ i; j ] ->
-                nativeint_bin_op stack_ctx x Sub i j
-            | Extern "caml_nativeint_mul", [ i; j ] ->
-                nativeint_bin_op stack_ctx x Mul i j
-            | Extern "caml_nativeint_and", [ i; j ] ->
-                nativeint_bin_op stack_ctx x And i j
-            | Extern "caml_nativeint_or", [ i; j ] -> nativeint_bin_op stack_ctx x Or i j
-            | Extern "caml_nativeint_xor", [ i; j ] ->
-                nativeint_bin_op stack_ctx x Xor i j
+                Memory.box_nativeint (return (W.BinOp (I32 Sub, Const (I32 0l), i)))
+            | Extern "caml_nativeint_add", [ i; j ] -> nativeint_bin_op Add i j
+            | Extern "caml_nativeint_sub", [ i; j ] -> nativeint_bin_op Sub i j
+            | Extern "caml_nativeint_mul", [ i; j ] -> nativeint_bin_op Mul i j
+            | Extern "caml_nativeint_and", [ i; j ] -> nativeint_bin_op And i j
+            | Extern "caml_nativeint_or", [ i; j ] -> nativeint_bin_op Or i j
+            | Extern "caml_nativeint_xor", [ i; j ] -> nativeint_bin_op Xor i j
             | Extern "caml_nativeint_div", [ i; j ] ->
                 let res = Var.fresh () in
                 (*ZZZ Can we do better?*)
@@ -596,7 +529,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                         (let* i = load i' in
                          let* j = load j' in
                          return (W.BinOp (I32 (Div S), i, j)))))
-                  (Memory.box_nativeint stack_ctx x (load res))
+                  (Memory.box_nativeint (load res))
             | Extern "caml_nativeint_mod", [ i; j ] ->
                 let j' = Var.fresh () in
                 seq
@@ -606,17 +539,16 @@ module Generate (Target : Wa_target_sig.S) = struct
                      (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))))
                   (let* i = Memory.unbox_nativeint i in
                    let* j = load j' in
-                   Memory.box_nativeint stack_ctx x (return (W.BinOp (I32 (Rem S), i, j))))
-            | Extern "caml_nativeint_shift_left", [ i; j ] ->
-                nativeint_shift_op stack_ctx x Shl i j
+                   Memory.box_nativeint (return (W.BinOp (I32 (Rem S), i, j))))
+            | Extern "caml_nativeint_shift_left", [ i; j ] -> nativeint_shift_op Shl i j
             | Extern "caml_nativeint_shift_right", [ i; j ] ->
-                nativeint_shift_op stack_ctx x (Shr S) i j
+                nativeint_shift_op (Shr S) i j
             | Extern "caml_nativeint_shift_right_unsigned", [ i; j ] ->
-                nativeint_shift_op stack_ctx x (Shr U) i j
+                nativeint_shift_op (Shr U) i j
             | Extern "caml_nativeint_to_int", [ i ] ->
                 Value.val_int (Memory.unbox_nativeint i)
             | Extern "caml_nativeint_of_int", [ i ] ->
-                Memory.box_nativeint stack_ctx x (Value.int_val i)
+                Memory.box_nativeint (Value.int_val i)
             | Extern "caml_int_compare", [ i; j ] ->
                 Value.val_int
                   Arith.(
@@ -632,17 +564,14 @@ module Generate (Target : Wa_target_sig.S) = struct
                     l
                     ~init:(return [])
                 in
-                Memory.allocate stack_ctx x ~tag:0 l
+                Memory.allocate ~tag:0 l
             | Extern name, l ->
                 let name = Primitive.resolve name in
                 (*ZZZ Different calling convention when large number of parameters *)
                 let* f = register_import ~name (Fun (func_type (List.length l))) in
-                let* () = Stack.perform_spilling stack_ctx (`Instr x) in
                 let rec loop acc l =
                   match l with
-                  | [] ->
-                      Stack.kill_variables stack_ctx;
-                      return (W.Call (f, List.rev acc))
+                  | [] -> return (W.Call (f, List.rev acc))
                   | x :: r ->
                       let* x = x in
                       loop (x :: acc) r
@@ -660,17 +589,15 @@ module Generate (Target : Wa_target_sig.S) = struct
             | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
                 assert false))
 
-  and translate_instr ctx stack_ctx context (i, loc) =
+  and translate_instr ctx context (i, loc) =
     with_location
       loc
       (match i with
-      | Assign (x, y) ->
-          let* () = assign x (load y) in
-          Stack.assign stack_ctx x
+      | Assign (x, y) -> assign x (load y)
       | Let (x, e) ->
           if ctx.live.(Var.idx x) = 0
-          then drop (translate_expr ctx stack_ctx context x e)
-          else store x (translate_expr ctx stack_ctx context x e)
+          then drop (translate_expr ctx context x e)
+          else store x (translate_expr ctx context x e)
       | Set_field (x, n, Non_float, y) -> Memory.set_field (load x) n (load y)
       | Set_field (x, n, Float, y) ->
           Memory.float_array_set
@@ -685,13 +612,12 @@ module Generate (Target : Wa_target_sig.S) = struct
                Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
       | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z))
 
-  and translate_instrs ctx stack_ctx context l =
+  and translate_instrs ctx context l =
     match l with
     | [] -> return ()
     | i :: rem ->
-        let* () = Stack.perform_reloads stack_ctx (`Instr (fst i)) in
-        let* () = translate_instr ctx stack_ctx context i in
-        translate_instrs ctx stack_ctx context rem
+        let* () = translate_instr ctx context i in
+        translate_instrs ctx context rem
 
   let parallel_renaming params args =
     let rec visit visited prev s m x l =
@@ -844,18 +770,6 @@ module Generate (Target : Wa_target_sig.S) = struct
           { ctx with blocks }
       | None -> ctx
     in
-    let stack_info =
-      Stack.generate_spilling_information
-        p
-        ~context:ctx.global_context
-        ~closures:ctx.closures
-        ~env:
-          (match name_opt with
-          | Some name -> name
-          | None -> Var.fresh ())
-        ~pc
-        ~params
-    in
     let g = Structure.build_graph ctx.blocks pc in
     let dom = Structure.dominator_tree g in
     let rec translate_tree result_typ fall_through pc context =
@@ -910,17 +824,12 @@ module Generate (Target : Wa_target_sig.S) = struct
           translate_tree result_typ fall_through pc' context
       | [] ->
           let block = Addr.Map.find pc ctx.blocks in
-          let* global_context = get_context in
-          let stack_ctx = Stack.start_block ~context:global_context stack_info pc in
-          let* () = translate_instrs ctx stack_ctx context block.body in
-          let* () = Stack.perform_reloads stack_ctx (`Branch (fst block.branch)) in
-          let* () = Stack.perform_spilling stack_ctx (`Block pc) in
+          let* () = translate_instrs ctx context block.body in
           let branch, loc = block.branch in
           with_location
             loc
             (match branch with
-            | Branch cont ->
-                translate_branch result_typ fall_through pc cont context stack_ctx
+            | Branch cont -> translate_branch result_typ fall_through pc cont context
             | Return x -> (
                 let* e = load x in
                 match fall_through with
@@ -931,43 +840,22 @@ module Generate (Target : Wa_target_sig.S) = struct
                 if_
                   { params = []; result = result_typ }
                   (Value.check_is_not_zero (load x))
-                  (translate_branch result_typ fall_through pc cont1 context' stack_ctx)
-                  (translate_branch result_typ fall_through pc cont2 context' stack_ctx)
+                  (translate_branch result_typ fall_through pc cont1 context')
+                  (translate_branch result_typ fall_through pc cont2 context')
             | Stop -> (
                 let* e = Value.unit in
                 match fall_through with
                 | `Return -> instr (Push e)
                 | `Block _ -> instr (Return (Some e)))
-            | Switch (x, a1) ->
-                let l =
-                  List.filter
-                    ~f:(fun pc' ->
-                      Stack.stack_adjustment_needed stack_ctx ~src:pc ~dst:pc')
-                    (List.rev (Addr.Set.elements (Structure.get_edges dom pc)))
-                in
-                let br_table e a context =
-                  let len = Array.length a in
-                  let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
-                  let dest (pc, args) =
-                    assert (List.is_empty args);
-                    label_index context pc
-                  in
-                  let* e = e in
-                  instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
+            | Switch (x, a) ->
+                let len = Array.length a in
+                let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
+                let dest (pc, args) =
+                  assert (List.is_empty args);
+                  label_index context pc
                 in
-                let rec nest l context =
-                  match l with
-                  | pc' :: rem ->
-                      let* () =
-                        Wa_code_generation.block
-                          { params = []; result = [] }
-                          (nest rem (`Block pc' :: context))
-                      in
-                      let* () = Stack.adjust_stack stack_ctx ~src:pc ~dst:pc' in
-                      instr (Br (label_index context pc', None))
-                  | [] -> br_table (Value.int_val (load x)) a1 context
-                in
-                nest l context
+                let* e = Value.int_val (load x) in
+                instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
             | Raise (x, _) ->
                 let* e = load x in
                 let* tag = register_import ~name:exception_name (Tag Value.value) in
@@ -981,13 +869,12 @@ module Generate (Target : Wa_target_sig.S) = struct
                      p
                      (fst cont)
                      (fun ~result_typ ~fall_through ~context ->
-                       translate_branch result_typ fall_through pc cont context stack_ctx))
+                       translate_branch result_typ fall_through pc cont context))
                   x
                   (fun ~result_typ ~fall_through ~context ->
-                    translate_branch result_typ fall_through pc cont' context stack_ctx)
-            | Poptrap cont ->
-                translate_branch result_typ fall_through pc cont context stack_ctx)
-    and translate_branch result_typ fall_through src (dst, args) context stack_ctx =
+                    translate_branch result_typ fall_through pc cont' context)
+            | Poptrap cont -> translate_branch result_typ fall_through pc cont context)
+    and translate_branch result_typ fall_through src (dst, args) context =
       let* () =
         if List.is_empty args
         then return ()
@@ -995,7 +882,6 @@ module Generate (Target : Wa_target_sig.S) = struct
           let block = Addr.Map.find dst ctx.blocks in
           parallel_renaming block.params args
       in
-      let* () = Stack.adjust_stack stack_ctx ~src ~dst in
       match fall_through with
       | `Block dst' when dst = dst' -> return ()
       | _ ->
@@ -1042,8 +928,6 @@ module Generate (Target : Wa_target_sig.S) = struct
         ~param_names
         ~body:
           (let* () = build_initial_env in
-           let stack_ctx = Stack.start_function ~context:ctx.global_context stack_info in
-           let* () = Stack.perform_spilling stack_ctx `Function in
            wrap_with_handlers
              p
              pc
@@ -1051,7 +935,7 @@ module Generate (Target : Wa_target_sig.S) = struct
              ~fall_through:`Return
              ~context:[]
              (fun ~result_typ ~fall_through ~context ->
-               translate_branch result_typ fall_through (-1) cont context stack_ctx))
+               translate_branch result_typ fall_through (-1) cont context))
     in
     let body = post_process_function_body ~param_names ~locals body in
     W.Function
@@ -1174,8 +1058,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     in
     let constant_data =
       List.map
-        ~f:(fun (name, (active, contents)) ->
-          W.Data { name; read_only = true; active; contents })
+        ~f:(fun (name, contents) -> W.Data { name; contents })
         (Var.Map.bindings context.data_segments)
     in
     List.rev_append context.other_fields (imports @ constant_data)
@@ -1232,51 +1115,25 @@ let fix_switch_branches p =
     p.blocks;
   !p'
 
-let start () =
-  make_context
-    ~value_type:
-      (match target with
-      | `Core -> Wa_core_target.Value.value
-      | `GC -> Wa_gc_target.Value.value)
+let start () = make_context ~value_type:Wa_gc_target.Value.value
 
 let f ~context ~unit_name p ~live_vars ~in_cps ~debug =
   let p = if Config.Flag.effects () then fix_switch_branches p else p in
-  match target with
-  | `Core ->
-      let module G = Generate (Wa_core_target) in
-      G.f ~context ~unit_name ~live_vars ~in_cps ~debug p
-  | `GC ->
-      let module G = Generate (Wa_gc_target) in
-      G.f ~context ~unit_name ~live_vars ~in_cps ~debug p
+  let module G = Generate (Wa_gc_target) in
+  G.f ~context ~unit_name ~live_vars ~in_cps ~debug p
 
 let add_start_function =
-  match target with
-  | `Core ->
-      let module G = Generate (Wa_core_target) in
-      G.add_start_function
-  | `GC ->
-      let module G = Generate (Wa_gc_target) in
-      G.add_start_function
+  let module G = Generate (Wa_gc_target) in
+  G.add_start_function
 
 let add_init_function =
-  match target with
-  | `Core ->
-      let module G = Generate (Wa_core_target) in
-      G.add_init_function
-  | `GC ->
-      let module G = Generate (Wa_gc_target) in
-      G.add_init_function
+  let module G = Generate (Wa_gc_target) in
+  G.add_init_function
 
 let output ch ~context ~debug =
-  match target with
-  | `Core ->
-      let module G = Generate (Wa_core_target) in
-      let fields = G.output ~context in
-      Wa_asm_output.f ch fields
-  | `GC ->
-      let module G = Generate (Wa_gc_target) in
-      let fields = G.output ~context in
-      Wa_wat_output.f ~debug ch fields
+  let module G = Generate (Wa_gc_target) in
+  let fields = G.output ~context in
+  Wa_wat_output.f ~debug ch fields
 
 let wasm_output ch ~context =
   let module G = Generate (Wa_gc_target) in
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
index 3d7ea6a819..acbec8649c 100644
--- a/compiler/lib/wasm/wa_initialize_locals.ml
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -33,15 +33,12 @@ let check_initialized ctx i =
 
 let rec scan_expression ctx e =
   match e with
-  | Wa_ast.Const _ | ConstSym _ | GlobalGet _ | Pop _ | RefFunc _ | RefNull _ -> ()
+  | Wa_ast.Const _ | GlobalGet _ | Pop _ | RefFunc _ | RefNull _ -> ()
   | UnOp (_, e')
   | I32WrapI64 e'
   | I64ExtendI32 (_, e')
   | F32DemoteF64 e'
   | F64PromoteF32 e'
-  | Load (_, e')
-  | Load8 (_, _, e')
-  | MemoryGrow (_, e')
   | RefI31 e'
   | I31Get (_, e')
   | ArrayLen e'
@@ -61,7 +58,7 @@ let rec scan_expression ctx e =
   | LocalTee (i, e') ->
       scan_expression ctx e';
       mark_initialized ctx i
-  | Call_indirect (_, e', l) | Call_ref (_, e', l) ->
+  | Call_ref (_, e', l) ->
       scan_expressions ctx l;
       scan_expression ctx e'
   | Call (_, l) | ArrayNewFixed (_, l) | StructNew (_, l) -> scan_expressions ctx l
@@ -84,7 +81,7 @@ and scan_instruction ctx i =
   | Throw (_, e)
   | Return (Some e)
   | Push e -> scan_expression ctx e
-  | Store (_, e, e') | Store8 (_, e, e') | StructSet (_, _, e, e') ->
+  | StructSet (_, _, e, e') ->
       scan_expression ctx e;
       scan_expression ctx e'
   | LocalSet (i, e) ->
@@ -105,7 +102,7 @@ and scan_instruction ctx i =
       scan_expression ctx e;
       scan_expression ctx e';
       scan_expression ctx e''
-  | Return_call_indirect (_, e', l) | Return_call_ref (_, e', l) ->
+  | Return_call_ref (_, e', l) ->
       scan_expressions ctx l;
       scan_expression ctx e'
   | Location (_, i) -> scan_instruction ctx i
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
deleted file mode 100644
index 59c528411e..0000000000
--- a/compiler/lib/wasm/wa_liveness.ml
+++ /dev/null
@@ -1,246 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-(*
-ZZZ If live in exception handler, live any place we may raise in the body
-*)
-
-open! Stdlib
-open Code
-
-module Domain = struct
-  type t =
-    { input : Var.Set.t
-    ; output : Var.Set.t
-    }
-
-  let bot = { input = Var.Set.empty; output = Var.Set.empty }
-
-  let equal v v' = Var.Set.equal v.input v'.input
-end
-
-(*ZZZ from wa_generate *)
-let get_free_variables ~context info =
-  List.filter
-    ~f:(fun x -> not (Hashtbl.mem context.Wa_code_generation.constants x))
-    info.Wa_closure_conversion.free_variables
-
-let function_free_variables ~context ~closures x =
-  let info = Var.Map.find x closures in
-  let f, _ = List.hd info.Wa_closure_conversion.functions in
-  if Var.equal x f then get_free_variables ~context info else []
-
-let get_set h x = try Hashtbl.find h x with Not_found -> Addr.Set.empty
-
-let cont_deps (deps, rev_deps) pc (pc', _) =
-  Hashtbl.replace deps pc' (Addr.Set.add pc (get_set deps pc'));
-  Hashtbl.replace rev_deps pc (Addr.Set.add pc' (get_set rev_deps pc))
-
-let block_deps deps block pc =
-  match fst block.branch with
-  | Return _ | Raise _ | Stop -> ()
-  | Branch cont | Poptrap cont -> cont_deps deps pc cont
-  | Cond (_, cont1, cont2) ->
-      cont_deps deps pc cont1;
-      cont_deps deps pc cont2
-  | Switch (_, a1) -> Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont)
-  | Pushtrap (cont, _, cont_h) ->
-      cont_deps deps pc cont;
-      cont_deps deps pc cont_h
-
-let function_deps blocks pc =
-  let deps = Hashtbl.create 16, Hashtbl.create 16 in
-  Code.traverse
-    { fold = fold_children }
-    (fun pc () ->
-      let block = Addr.Map.find pc blocks in
-      block_deps deps block pc)
-    pc
-    blocks
-    ();
-  deps
-
-type ctx =
-  { env : Var.t
-  ; bound_vars : Var.Set.t
-  ; spilled_vars : Var.Set.t
-  ; context : Wa_code_generation.context
-  }
-
-let add_var ~ctx s x =
-  if Hashtbl.mem ctx.context.Wa_code_generation.constants x
-  then s
-  else
-    let x = if Var.Set.mem x ctx.bound_vars then x else ctx.env in
-    if Var.Set.mem x ctx.spilled_vars then Var.Set.add x s else s
-
-let add_list ~ctx s l = List.fold_left ~f:(fun s x -> add_var ~ctx s x) ~init:s l
-
-let add_prim_args ~ctx s l =
-  List.fold_left
-    ~f:(fun s x ->
-      match x with
-      | Pc _ -> s
-      | Pv x -> add_var ~ctx s x)
-    ~init:s
-    l
-
-let add_array ~ctx s a = Array.fold_left ~f:(fun s x -> add_var ~ctx s x) ~init:s a
-
-let expr_used ~context ~closures ~ctx x e s =
-  match e with
-  | Apply { f; args; _ } -> add_list ~ctx s (f :: args)
-  | Block (_, a, _, _) -> add_array ~ctx s a
-  | Prim (_, l) -> add_prim_args ~ctx s l
-  | Closure _ -> add_list ~ctx s (function_free_variables ~context ~closures x)
-  | Constant _ | Special _ -> s
-  | Field (x, _, _) -> add_var ~ctx s x
-
-let propagate_through_instr ~context ~closures ~ctx (i, _) s =
-  match i with
-  | Let (x, e) -> expr_used ~context ~closures ~ctx x e (Var.Set.remove x s)
-  | Set_field (x, _, _, y) -> add_var ~ctx (add_var ~ctx s x) y
-  | Assign (_, x) | Offset_ref (x, _) -> add_var ~ctx s x
-  | Array_set (x, y, z) -> add_var ~ctx (add_var ~ctx (add_var ~ctx s x) y) z
-
-let cont_used ~ctx (_, args) s = add_list ~ctx s args
-
-let propagate_through_branch ~ctx (b, _) s =
-  match b with
-  | Return x | Raise (x, _) -> add_var ~ctx s x
-  | Stop -> s
-  | Branch cont | Poptrap cont -> cont_used ~ctx cont s
-  | Cond (_, cont1, cont2) -> s |> cont_used ~ctx cont1 |> cont_used ~ctx cont2
-  | Switch (_, a1) -> Array.fold_right a1 ~f:(fun cont s -> cont_used ~ctx cont s) ~init:s
-  | Pushtrap (cont, x, cont_h) ->
-      s |> cont_used ~ctx cont |> cont_used ~ctx cont_h |> Var.Set.remove x
-
-let propagate blocks ~context ~closures ~ctx rev_deps st pc =
-  let input =
-    pc
-    |> get_set rev_deps
-    |> Addr.Set.elements
-    |> List.map ~f:(fun pc' -> (Addr.Map.find pc' st).Domain.output)
-    |> List.fold_left ~f:Var.Set.union ~init:Var.Set.empty
-  in
-  let b = Addr.Map.find pc blocks in
-  let s = propagate_through_branch ~ctx b.branch input in
-  let output =
-    List.fold_right
-      ~f:(fun i s -> propagate_through_instr ~context ~closures ~ctx i s)
-      ~init:s
-      b.body
-  in
-  let output = Var.Set.diff output (Var.Set.of_list b.params) in
-  { Domain.input; output }
-
-module G = Dgraph.Make (Int) (Addr.Set) (Addr.Map)
-module Solver = G.Solver (Domain)
-
-type block_info =
-  { initially_live : Var.Set.t (* Live at start of block *)
-  ; live_before_branch : Var.Set.t
-  }
-
-type info =
-  { instr : Var.Set.t Var.Map.t (* Live variables at spilling point *)
-  ; block : block_info Addr.Map.t
-  }
-
-let compute_instr_info ~blocks ~context ~closures ~domain ~ctx st =
-  Addr.Set.fold
-    (fun pc live_info ->
-      let live_vars = (Addr.Map.find pc st).Domain.input in
-      let block = Addr.Map.find pc blocks in
-      let live_vars = propagate_through_branch ~ctx block.Code.branch live_vars in
-      let _, live_info =
-        List.fold_right
-          ~f:(fun i (live_vars, live_info) ->
-            let live_vars' =
-              propagate_through_instr ~context ~closures ~ctx i live_vars
-            in
-            let live_info =
-              match fst i with
-              | Let (x, e) -> (
-                  match e with
-                  | Apply _ | Prim _ ->
-                      Var.Map.add x (Var.Set.remove x live_vars) live_info
-                  | Block _ | Closure _ -> Var.Map.add x live_vars' live_info
-                  | Constant _ | Field _ | Special _ -> live_info)
-              | Assign _ | Offset_ref _ | Set_field _ | Array_set _ -> live_info
-            in
-            live_vars', live_info)
-          ~init:(live_vars, live_info)
-          block.body
-      in
-      live_info)
-    domain
-    Var.Map.empty
-
-let compute_block_info ~blocks ~ctx st =
-  Addr.Map.mapi
-    (fun pc { Domain.input; output } ->
-      let block = Addr.Map.find pc blocks in
-      let live_before_branch = propagate_through_branch ~ctx block.Code.branch input in
-      { initially_live = output; live_before_branch })
-    st
-
-let f ~blocks ~context ~closures ~domain ~env ~bound_vars ~spilled_vars ~pc =
-  let ctx = { env; bound_vars; spilled_vars; context } in
-  let deps, rev_deps = function_deps blocks pc in
-  let fold_children f pc acc = Addr.Set.fold f (get_set deps pc) acc in
-  let g = { G.domain; fold_children } in
-  let st =
-    Solver.f g (fun st pc -> propagate blocks ~context ~closures ~ctx rev_deps st pc)
-  in
-  let instr = compute_instr_info ~blocks ~context ~closures ~domain ~ctx st in
-  let block = compute_block_info ~blocks ~ctx st in
-  (*
-  Addr.Set.iter
-    (fun pc ->
-      let { Domain.input; output } = Addr.Map.find pc st in
-      Format.eprintf "input:";
-      Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) input;
-      Format.eprintf "@.";
-      Format.eprintf "output:";
-      Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) output;
-      Format.eprintf "@.";
-      let b = Addr.Map.find pc blocks in
-      let print_vars s =
-        Format.asprintf
-          "{%a}"
-          (fun f l ->
-            Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f " ") Var.print f l)
-          (Var.Set.elements s)
-      in
-      Code.Print.block
-        (fun _pc loc ->
-          match loc with
-          | Instr (Let (x, _), _) -> (
-              match Var.Map.find_opt x instr with
-              | Some s -> print_vars s
-              | None -> "")
-          | Instr _ -> ""
-          | Last _ ->
-              let s = Addr.Map.find pc block in
-              print_vars s.live_before_branch)
-        pc
-        b)
-    domain;
-  *)
-  { block; instr }
diff --git a/compiler/lib/wasm/wa_liveness.mli b/compiler/lib/wasm/wa_liveness.mli
deleted file mode 100644
index e6f7e3d2f2..0000000000
--- a/compiler/lib/wasm/wa_liveness.mli
+++ /dev/null
@@ -1,38 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-type block_info =
-  { initially_live : Code.Var.Set.t (* Live at start of block *)
-  ; live_before_branch : Code.Var.Set.t
-  }
-
-type info =
-  { instr : Code.Var.Set.t Code.Var.Map.t (* Live variables at spilling point *)
-  ; block : block_info Code.Addr.Map.t
-  }
-
-val f :
-     blocks:Code.block Code.Addr.Map.t
-  -> context:Wa_code_generation.context
-  -> closures:Wa_closure_conversion.closure Code.Var.Map.t
-  -> domain:Code.Addr.Set.t
-  -> env:Code.Var.t
-  -> bound_vars:Code.Var.Set.t
-  -> spilled_vars:Code.Var.Set.t
-  -> pc:int
-  -> info
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
deleted file mode 100644
index f1eaa1b805..0000000000
--- a/compiler/lib/wasm/wa_spilling.ml
+++ /dev/null
@@ -1,805 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any 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.
- *)
-
-(*
-We add spilling points at the end of each block and before each
-possible GC: function calls and allocations. Local variables are
-spilled at most once, at the first following spilling points.
-
-We first compute which local variables contain valid values at the
-beginning of each block: either there has been no GC since their
-definition or they have been accessed since the last GC point (so they
-must have been reloaded).
-Then, we compute which variables neeeds to be spilled at some point
-(we access the local variable while it does not contain any valid
-value).
-From this, we can compute what need to be spilled at each spilling
-point, and the stack contents at any point in the program.
-
-When allocating, we currently always spill everything. We should
-probably spill everything only when a GC takes place. To keep the code
-short, we should always spill variables that are still live after the
-allocation, but variables that are no longer live after the allocation
-only need to be spilled when a GC takes place.
-
-We should find a way to reuse local variables while they are spilled,
-to minimize the number of local variables used.
-*)
-
-let debug = Debug.find "spilling"
-
-open! Stdlib
-open Code
-
-module Domain = struct
-  type t =
-    | Bot
-    | Set of
-        { input : Var.Set.t
-        ; output : Var.Set.t
-        }
-
-  let bot = Bot
-
-  let equal v v' =
-    match v, v' with
-    | Bot, Bot -> true
-    | Bot, Set _ | Set _, Bot -> false
-    | Set { input; _ }, Set { input = input'; _ } -> Var.Set.equal input input'
-end
-
-let make_table l =
-  let h = Hashtbl.create 16 in
-  List.iter ~f:(fun s -> Hashtbl.add h s ()) l;
-  h
-
-(*ZZZ See lambda/translprim.ml + stdlib *)
-let no_alloc_tbl =
-  make_table
-    [ "caml_array_unsafe_set"
-    ; "caml_string_unsafe_get"
-    ; "caml_string_unsafe_set"
-    ; "caml_bytes_unsafe_get"
-    ; "caml_bytes_unsafe_set"
-    ; "%int_add"
-    ; "%int_sub"
-    ; "%int_mul"
-    ; "%int_neg"
-    ; "%int_or"
-    ; "%int_and"
-    ; "%int_xor"
-    ; "%int_lsl"
-    ; "%int_lsr"
-    ; "%int_asr"
-    ]
-
-let no_pointer_tbl =
-  make_table
-    [ "caml_string_unsafe_get"
-    ; "caml_string_unsafe_set"
-    ; "caml_bytes_unsafe_get"
-    ; "caml_bytes_unsafe_set"
-    ; "%int_add"
-    ; "%int_sub"
-    ; "%int_mul"
-    ; "%int_neg"
-    ; "%int_or"
-    ; "%int_and"
-    ; "%int_xor"
-    ; "%int_lsl"
-    ; "%int_lsr"
-    ; "%int_asr"
-    ]
-
-let no_alloc p =
-  match p with
-  | Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult -> true
-  | Extern nm -> Hashtbl.mem no_alloc_tbl nm (* ZZZ Refine *)
-
-let no_pointer p =
-  match p with
-  | Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult -> true
-  | Extern nm -> Hashtbl.mem no_pointer_tbl nm (* ZZZ Refine *)
-  | Array_get -> false
-
-(*ZZZ from wa_generate *)
-let get_free_variables ~context info =
-  List.filter
-    ~f:(fun x -> not (Hashtbl.mem context.Wa_code_generation.constants x))
-    info.Wa_closure_conversion.free_variables
-
-let function_free_variables ~context ~closures x =
-  let info = Code.Var.Map.find x closures in
-  let f, _ = List.hd info.Wa_closure_conversion.functions in
-  if Code.Var.equal x f then get_free_variables ~context info else []
-
-let get_set h x = try Hashtbl.find h x with Not_found -> Addr.Set.empty
-
-let get_list h x = try Hashtbl.find h x with Not_found -> []
-
-let cont_deps (deps, rev_deps) pc ?exn (pc', _) =
-  Hashtbl.replace deps pc (Addr.Set.add pc' (get_set deps pc));
-  Hashtbl.replace rev_deps pc' ((pc, exn) :: get_list rev_deps pc')
-
-let block_deps bound_vars deps block pc =
-  match fst block.branch with
-  | Return _ | Raise _ | Stop -> ()
-  | Branch cont | Poptrap cont -> cont_deps deps pc cont
-  | Cond (_, cont1, cont2) ->
-      cont_deps deps pc cont1;
-      cont_deps deps pc cont2
-  | Switch (_, a1) -> Array.iter a1 ~f:(fun cont -> cont_deps deps pc cont)
-  | Pushtrap (cont, exn, cont_h) ->
-      cont_deps deps pc cont;
-      bound_vars := Var.Set.add exn !bound_vars;
-      cont_deps deps pc ~exn cont_h
-
-let function_deps blocks ~context ~closures pc params =
-  let bound_vars = ref params in
-  let non_spillable_vars = ref Var.Set.empty in
-  let domain = ref Addr.Set.empty in
-  let deps = Hashtbl.create 16, Hashtbl.create 16 in
-  let mark_non_spillable x = non_spillable_vars := Var.Set.add x !non_spillable_vars in
-  Code.traverse
-    { fold = fold_children }
-    (fun pc () ->
-      domain := Addr.Set.add pc !domain;
-      let block = Addr.Map.find pc blocks in
-      List.iter
-        ~f:(fun (i, _) ->
-          match i with
-          | Let (x, e) -> (
-              match e with
-              | Constant _ | Special _ -> mark_non_spillable x
-              | Prim (p, _) when no_pointer p -> mark_non_spillable x
-              | Closure _
-                when List.is_empty (function_free_variables ~context ~closures x) ->
-                  mark_non_spillable x
-              | Prim _ | Closure _ | Apply _ | Block _ | Field _ -> ())
-          | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> ())
-        block.body;
-      bound_vars :=
-        List.fold_left
-          ~f:(fun vars (i, _) ->
-            match i with
-            | Let (x, _) -> Var.Set.add x vars
-            | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> vars)
-          ~init:!bound_vars
-          block.body;
-      bound_vars := Var.Set.union !bound_vars (Var.Set.of_list block.params);
-      block_deps bound_vars deps block pc)
-    pc
-    blocks
-    ();
-  !domain, deps, !bound_vars, Var.Set.diff !bound_vars !non_spillable_vars
-
-let inter s s' =
-  match s, s' with
-  | None, None -> None
-  | _, None -> s
-  | None, _ -> s'
-  | Some s, Some s' -> Some (Var.Set.inter s s')
-
-let propagate_through_expr ~context ~closures s x e =
-  match e with
-  | Apply _ | Block _ -> Var.Set.empty
-  | Prim (p, _) -> if no_alloc p then s else Var.Set.empty
-  | Closure _ ->
-      if List.is_empty (function_free_variables ~context ~closures x)
-      then s
-      else Var.Set.empty
-  | Constant _ | Field _ | Special _ -> s
-
-let propagate_through_instr ~context ~closures s (i, _) =
-  match i with
-  | Let (x, e) -> Var.Set.add x (propagate_through_expr ~context ~closures s x e)
-  | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> s
-
-let propagate blocks ~context ~closures rev_deps pc0 params st pc =
-  let input =
-    pc
-    |> get_list rev_deps
-    |> List.map ~f:(fun (pc', exn_opt) ->
-           match Addr.Map.find pc' st with
-           | Domain.Bot -> None
-           | Set { output; _ } ->
-               Some
-                 (match exn_opt with
-                 | None -> output
-                 | Some x -> Var.Set.add x output))
-    |> List.fold_left ~f:inter ~init:None
-  in
-  let input = if pc = pc0 then inter input (Some params) else input in
-  match input with
-  | None -> Domain.Bot
-  | Some input ->
-      let b = Addr.Map.find pc blocks in
-      let input = Var.Set.union input (Var.Set.of_list b.params) in
-      let output =
-        List.fold_left
-          ~f:(fun s i -> propagate_through_instr ~context ~closures s i)
-          ~init:input
-          b.body
-      in
-      Set { input; output }
-
-module G = Dgraph.Make (Int) (Addr.Set) (Addr.Map)
-module Solver = G.Solver (Domain)
-
-type spill_ctx =
-  { env : Var.t
-  ; bound_vars : Var.Set.t
-  ; spillable_vars : Var.Set.t
-  ; context : Wa_code_generation.context
-  }
-
-let check_spilled ~ctx loaded x spilled =
-  if Hashtbl.mem ctx.context.Wa_code_generation.constants x
-  then spilled
-  else
-    let x = if Var.Set.mem x ctx.bound_vars then x else ctx.env in
-    if Var.Set.mem x loaded || not (Var.Set.mem x ctx.spillable_vars)
-    then spilled
-    else Var.Set.add x spilled
-
-let spilled_variables
-    ~blocks
-    ~context
-    ~closures
-    ~domain
-    ~env
-    ~bound_vars
-    ~spillable_vars
-    st =
-  let spilled = Var.Set.empty in
-  let ctx = { env; bound_vars; spillable_vars; context } in
-  Addr.Set.fold
-    (fun pc spilled ->
-      let loaded =
-        match Addr.Map.find pc st with
-        | Domain.Bot -> assert false
-        | Domain.Set { input; _ } -> input
-      in
-      let block = Addr.Map.find pc blocks in
-      let loaded, spilled =
-        List.fold_left
-          ~f:(fun (loaded, spilled) i ->
-            let loaded' = propagate_through_instr ~context ~closures loaded i in
-            let reloaded =
-              match fst i with
-              | Let (x, e) -> (
-                  match e with
-                  | Apply { f; args; _ } ->
-                      List.fold_left
-                        ~f:(fun reloaded x -> check_spilled ~ctx loaded x reloaded)
-                        (f :: args)
-                        ~init:Var.Set.empty
-                  | Block (_, l, _, _) ->
-                      Array.fold_left
-                        ~f:(fun reloaded x -> check_spilled ~ctx loaded' x reloaded)
-                        l
-                        ~init:Var.Set.empty
-                  | Prim (_, args) ->
-                      List.fold_left
-                        ~f:(fun reloaded x ->
-                          match x with
-                          | Pv x -> check_spilled ~ctx loaded x reloaded
-                          | Pc _ -> reloaded)
-                        args
-                        ~init:Var.Set.empty
-                  | Closure _ ->
-                      let fv = function_free_variables ~context ~closures x in
-                      List.fold_left
-                        ~f:(fun reloaded x -> check_spilled ~ctx loaded' x reloaded)
-                        fv
-                        ~init:Var.Set.empty
-                  | Constant _ | Special _ -> Var.Set.empty
-                  | Field (x, _, _) -> check_spilled ~ctx loaded x Var.Set.empty)
-              | Assign (_, x) | Offset_ref (x, _) ->
-                  check_spilled ~ctx loaded x Var.Set.empty
-              | Set_field (x, _, _, y) ->
-                  Var.Set.empty
-                  |> check_spilled ~ctx loaded x
-                  |> check_spilled ~ctx loaded y
-              | Array_set (x, y, z) ->
-                  Var.Set.empty
-                  |> check_spilled ~ctx loaded x
-                  |> check_spilled ~ctx loaded y
-                  |> check_spilled ~ctx loaded z
-            in
-            Var.Set.union loaded' reloaded, Var.Set.union spilled reloaded)
-          ~init:(loaded, spilled)
-          block.body
-      in
-      let handle_cont (_, args) spilled =
-        List.fold_left
-          ~f:(fun spilled x -> check_spilled ~ctx loaded x spilled)
-          args
-          ~init:spilled
-      in
-      match fst block.branch with
-      | Return x | Raise (x, _) -> check_spilled ~ctx loaded x spilled
-      | Stop -> spilled
-      | Branch cont | Poptrap cont -> handle_cont cont spilled
-      | Cond (_, cont1, cont2) -> spilled |> handle_cont cont1 |> handle_cont cont2
-      | Switch (_, a1) -> Array.fold_right a1 ~f:handle_cont ~init:spilled
-      | Pushtrap (cont, _, cont_h) -> spilled |> handle_cont cont |> handle_cont cont_h)
-    domain
-    spilled
-
-let traverse ~f pc blocks input =
-  let rec traverse_rec f pc visited blocks inp =
-    if not (Addr.Set.mem pc visited)
-    then
-      let visited = Addr.Set.add pc visited in
-      let out = f pc inp in
-      Code.fold_children
-        blocks
-        pc
-        (fun pc visited -> traverse_rec f pc visited blocks out)
-        visited
-    else visited
-  in
-  ignore (traverse_rec f pc Addr.Set.empty blocks input)
-
-let filter_stack live stack =
-  List.fold_right
-    ~f:(fun v rem ->
-      match v, rem with
-      | Some x, _ when Var.Set.mem x live -> v :: rem
-      | _, [] -> []
-      | _ -> None :: rem)
-    stack
-    ~init:[]
-
-let rec spill i x stack =
-  match stack with
-  | None :: rem -> i, Some x :: rem
-  | [] -> i, [ Some x ]
-  | v :: rem ->
-      let i, rem = spill (i + 1) x rem in
-      i, v :: rem
-
-let spill_vars live vars stack =
-  let stack = filter_stack live stack in
-  let stack, spills =
-    Var.Set.fold
-      (fun x (stack, spills) ->
-        let i, stack = spill 0 x stack in
-        stack, (x, i) :: spills)
-      vars
-      (stack, [])
-  in
-  let last = List.length stack - 1 in
-  stack, List.map ~f:(fun (x, i) -> x, last - i) spills
-
-let print_stack s =
-  if List.is_empty s
-  then ""
-  else
-    Format.asprintf
-      "{%a}"
-      (fun f l ->
-        Format.pp_print_list
-          ~pp_sep:(fun f () -> Format.fprintf f " ")
-          (fun f v ->
-            match v with
-            | None -> Format.fprintf f "*"
-            | Some x -> Var.print f x)
-          f
-          l)
-      s
-
-type stack = Var.t option list
-
-type spilling_info =
-  { depth_change : int
-  ; spills : (Var.t * int) list
-  ; stack : stack
-  }
-
-let print_spilling { depth_change; spills; stack; _ } =
-  let print_actions f l =
-    Format.pp_print_list
-      ~pp_sep:(fun f () -> Format.fprintf f " ")
-      (fun f (x, i) -> Format.fprintf f "%d:%a" i Var.print x)
-      f
-      l
-  in
-  if false
-  then print_stack stack
-  else Format.asprintf "%d %s {%a}" depth_change (print_stack stack) print_actions spills
-
-type block_info =
-  { initial_stack : stack (* Stack at beginning of block *)
-  ; loaded_variables : Var.Set.t (* Values in local variables at beginning of block *)
-  ; spilling : spilling_info (* Spilling at end of block *)
-  }
-
-type info =
-  { max_depth : int
-  ; subcalls : bool
-  ; env : Var.t
-  ; bound_vars : Var.Set.t
-  ; initial_spilling : spilling_info
-  ; block : block_info Addr.Map.t
-  ; instr : spilling_info Var.Map.t
-  }
-
-let update_stack ~max_depth live_vars vars stack =
-  let stack', spills = spill_vars live_vars vars stack in
-  max_depth := max !max_depth (List.length stack);
-  { depth_change = List.length stack' - List.length stack; stack = stack'; spills }
-
-let spilling blocks st env bound_vars spilled_vars live_info pc params =
-  let stack = [] in
-  let max_depth = ref 0 in
-  let subcalls = ref false in
-  let vars = Var.Set.inter params spilled_vars in
-  let stack, spills = spill_vars Var.Set.empty vars stack in
-  let initial_spilling = { depth_change = List.length stack; stack; spills } in
-  let instr_info = ref Var.Map.empty in
-  let block_info = ref Addr.Map.empty in
-  traverse pc blocks stack ~f:(fun pc stack ->
-      let block = Addr.Map.find pc blocks in
-      let block_live_vars = Addr.Map.find pc live_info.Wa_liveness.block in
-      let initial_stack, _ =
-        spill_vars block_live_vars.initially_live Var.Set.empty stack
-      in
-      let vars = Var.Set.inter (Var.Set.of_list block.params) spilled_vars in
-      let stack, vars =
-        List.fold_left
-          ~f:(fun (stack, vars) (i, _) ->
-            let stack, vars =
-              match i with
-              | Let (x, e) -> (
-                  match e with
-                  | Apply _ | Block _ | Closure _ ->
-                      let live_vars = Var.Map.find x live_info.instr in
-                      let ({ stack; _ } as sp) =
-                        update_stack ~max_depth live_vars vars stack
-                      in
-                      instr_info := Var.Map.add x sp !instr_info;
-                      (match e with
-                      | Apply _ when not (List.is_empty stack) -> subcalls := true
-                      | _ -> ());
-                      stack, Var.Set.empty
-                  | Prim (p, _) when not (no_alloc p) ->
-                      let live_vars = Var.Map.find x live_info.instr in
-                      let ({ stack; _ } as sp) =
-                        update_stack ~max_depth live_vars vars stack
-                      in
-                      instr_info := Var.Map.add x sp !instr_info;
-                      stack, Var.Set.empty
-                  | Prim _ | Constant _ | Field _ | Special _ -> stack, vars)
-              | Assign _ | Offset_ref _ | Set_field _ | Array_set _ -> stack, vars
-            in
-            let vars =
-              match i with
-              | Let (x, _) when Var.Set.mem x spilled_vars -> Var.Set.add x vars
-              | _ -> vars
-            in
-            stack, vars)
-          ~init:(initial_stack, vars)
-          block.body
-      in
-      (* ZZZ Spilling at end of block *)
-      let ({ stack; _ } as sp) =
-        update_stack ~max_depth block_live_vars.live_before_branch vars stack
-      in
-      let loaded_variables =
-        match Addr.Map.find pc st with
-        | Domain.Bot -> assert false
-        | Domain.Set { input; _ } -> input
-      in
-      block_info :=
-        Addr.Map.add pc { initial_stack; loaded_variables; spilling = sp } !block_info;
-      stack);
-  { max_depth = !max_depth
-  ; subcalls = !subcalls
-  ; env
-  ; bound_vars
-  ; initial_spilling
-  ; block = !block_info
-  ; instr = !instr_info
-  }
-
-let generate_spilling_information { blocks; _ } ~context ~closures ~pc:pc0 ~env ~params =
-  let params = Var.Set.add env (Var.Set.of_list params) in
-  let domain, (deps, rev_deps), bound_vars, spillable_vars =
-    function_deps blocks ~context ~closures pc0 params
-  in
-  let fold_children f pc acc = Addr.Set.fold f (get_set deps pc) acc in
-  let g = { G.domain; fold_children } in
-  let st =
-    Solver.f g (fun st pc ->
-        propagate blocks ~context ~closures rev_deps pc0 params st pc)
-  in
-  let spilled_vars =
-    spilled_variables
-      ~blocks
-      ~context
-      ~closures
-      ~domain
-      ~env
-      ~bound_vars
-      ~spillable_vars
-      st
-  in
-  if debug ()
-  then (
-    Format.eprintf "PARAMS: (%a)" Var.print env;
-    Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) params;
-    Format.eprintf "@.";
-    Format.eprintf "SPILLED:";
-    Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) spilled_vars;
-    Format.eprintf "@.");
-  (*
-  Addr.Set.iter
-    (fun pc ->
-      let s = Addr.Map.find pc st in
-      (match s with
-      | Domain.Bot -> ()
-      | Domain.Set { input; output } ->
-          Format.eprintf "INPUT:";
-          Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) input;
-          Format.eprintf "@.";
-          Format.eprintf "OUTPUT:";
-          Var.Set.iter (fun x -> Format.eprintf " %a" Var.print x) output;
-          Format.eprintf "@.");
-      let block = Addr.Map.find pc blocks in
-      Code.Print.block (fun _ _ -> "") pc block)
-    domain;
-  *)
-  let live_info =
-    Wa_liveness.f
-      ~blocks
-      ~context
-      ~closures
-      ~domain
-      ~env
-      ~bound_vars
-      ~spilled_vars
-      ~pc:pc0
-  in
-  let info = spilling blocks st env bound_vars spilled_vars live_info pc0 params in
-  if debug ()
-  then (
-    Format.eprintf "== %d == depth %d calls %b@." pc0 info.max_depth info.subcalls;
-    Format.eprintf "%s@." (print_spilling info.initial_spilling);
-    Addr.Set.iter
-      (fun pc ->
-        let block = Addr.Map.find pc blocks in
-        let _print_vars s =
-          if Var.Set.is_empty s
-          then ""
-          else
-            Format.asprintf
-              "{%a}"
-              (fun f l ->
-                Format.pp_print_list
-                  ~pp_sep:(fun f () -> Format.fprintf f " ")
-                  Var.print
-                  f
-                  l)
-              (Var.Set.elements s)
-        in
-        Code.Print.block
-          (fun _pc loc ->
-            match loc with
-            | Instr (Let (x, _), _) -> (
-                match Var.Map.find_opt x info.instr with
-                | Some s -> print_spilling s
-                | None -> "")
-            | Instr _ -> ""
-            | Last _ ->
-                let s = Addr.Map.find pc info.block in
-                print_spilling s.spilling)
-          pc
-          block)
-      domain);
-  info
-
-type context =
-  { loaded_variables : Var.Set.t
-  ; loaded_sp : Code.Var.t option
-  ; stack : stack
-  ; info : info
-  ; context : Wa_code_generation.context
-  }
-
-type ctx = context ref
-
-open Wa_code_generation
-module W = Wa_ast
-
-let rec find_in_stack x stack =
-  match stack with
-  | [] -> raise Not_found
-  | Some y :: rem when Var.equal x y -> List.length rem
-  | _ :: rem -> find_in_stack x rem
-
-let load_sp ctx =
-  match !ctx.loaded_sp with
-  | Some sp -> return sp
-  | None ->
-      let sp = Var.fresh_n "sp" in
-      ctx := { !ctx with loaded_sp = Some sp };
-      let* () = store sp (return (W.GlobalGet (S "sp"))) in
-      return sp
-
-let perform_reloads ctx l =
-  let vars = ref Var.Map.empty in
-  let add_var x =
-    if not (Hashtbl.mem !ctx.context.Wa_code_generation.constants x)
-    then
-      let x = if Var.Set.mem x !ctx.info.bound_vars then x else !ctx.info.env in
-      if not (Var.Set.mem x !ctx.loaded_variables)
-      then
-        try
-          let i = find_in_stack x !ctx.stack in
-          vars := Var.Map.add x i !vars
-        with Not_found -> ()
-  in
-  (match l with
-  | `Instr i -> Freevars.iter_instr_free_vars add_var i
-  | `Branch l -> Freevars.iter_last_free_var add_var l
-  | `Vars s -> Var.Set.iter add_var s);
-  if Var.Map.is_empty !vars
-  then return ()
-  else
-    let* sp = load_sp ctx in
-    let* () =
-      List.fold_left
-        ~f:(fun before (x, i) ->
-          let* () = before in
-          let* sp = load sp in
-          let offset = 4 * i in
-          store x (return (W.Load (I32 (Int32.of_int offset), sp))))
-        (List.sort ~cmp:(fun (_, i) (_, j) -> compare i j) (Var.Map.bindings !vars))
-        ~init:(return ())
-    in
-    ctx :=
-      { !ctx with
-        loaded_variables =
-          Var.Set.union
-            !ctx.loaded_variables
-            (Var.Map.fold (fun x _ s -> Var.Set.add x s) !vars Var.Set.empty)
-      };
-    return ()
-
-let assign ctx x =
-  match find_in_stack x !ctx.stack with
-  | exception Not_found -> return ()
-  | i ->
-      let* sp = load_sp ctx in
-      let* sp = load sp in
-      let* x = load x in
-      let offset = 4 * i in
-      instr (W.Store (I32 (Int32.of_int offset), sp, x))
-
-let perform_spilling ctx loc =
-  match
-    match loc with
-    | `Function -> !ctx.info.initial_spilling
-    | `Instr x -> Var.Map.find x !ctx.info.instr
-    | `Block pc -> (Addr.Map.find pc !ctx.info.block).spilling
-  with
-  | exception Not_found -> return ()
-  | spilling ->
-      if spilling.depth_change = 0 && List.is_empty spilling.spills
-      then return ()
-      else
-        let* sp = load_sp ctx in
-        let* sp =
-          if spilling.depth_change = 0
-          then return sp
-          else
-            let sp' = Var.fresh_n "sp" in
-            let delta = -4 * spilling.depth_change in
-            let* sp = tee sp' Arith.(load sp + const (Int32.of_int delta)) in
-            ctx := { !ctx with loaded_sp = Some sp' };
-            let* () = instr (W.GlobalSet (S "sp", sp)) in
-            return sp'
-        in
-        let* () =
-          List.fold_left
-            ~f:(fun before (x, i) ->
-              let* () = before in
-              let* sp = load sp in
-              let* x = load x in
-              let offset = 4 * i in
-              instr (W.Store (I32 (Int32.of_int offset), sp, x)))
-            spilling.spills
-            ~init:(return ())
-        in
-        ctx := { !ctx with stack = spilling.stack };
-        return ()
-
-let adjust_stack ctx ~src ~dst =
-  let src_stack =
-    if src = -1 then !ctx.stack else (Addr.Map.find src !ctx.info.block).spilling.stack
-  in
-  let dst_info = Addr.Map.find dst !ctx.info.block in
-  let delta = List.length dst_info.initial_stack - List.length src_stack in
-  if delta = 0
-  then return ()
-  else
-    let* sp = load_sp ctx in
-    let delta = -4 * delta in
-    let* sp = Arith.(load sp + const (Int32.of_int delta)) in
-    instr (W.GlobalSet (S "sp", sp))
-
-let stack_adjustment_needed ctx ~src ~dst =
-  let src_stack =
-    if src = -1 then !ctx.stack else (Addr.Map.find src !ctx.info.block).spilling.stack
-  in
-  let dst_info = Addr.Map.find dst !ctx.info.block in
-  let delta = List.length dst_info.initial_stack - List.length src_stack in
-  delta <> 0
-
-let start_block ~context spilling_info pc =
-  let info = Addr.Map.find pc spilling_info.block in
-  ref
-    { loaded_variables = info.loaded_variables
-    ; loaded_sp = None
-    ; stack = info.initial_stack
-    ; info = spilling_info
-    ; context
-    }
-
-let start_function ~context (spilling_info : info) =
-  (*ZZZ Check stack depth *)
-  ref
-    { loaded_variables = Var.Set.empty
-    ; loaded_sp = None
-    ; stack = []
-    ; info = spilling_info
-    ; context
-    }
-
-let kill_variables ctx =
-  ctx := { !ctx with loaded_variables = Var.Set.empty; loaded_sp = None }
-
-let make_info () =
-  { max_depth = 0
-  ; subcalls = false
-  ; env = Var.fresh ()
-  ; bound_vars = Var.Set.empty
-  ; initial_spilling = { depth_change = 0; spills = []; stack = [] }
-  ; block = Addr.Map.empty
-  ; instr = Var.Map.empty
-  }
-
-let add_spilling info ~location:x ~stack ~live_vars ~spilled_vars =
-  let max_depth = ref info.max_depth in
-  let spilling = update_stack ~max_depth live_vars spilled_vars stack in
-  ( { info with
-      max_depth = !max_depth
-    ; instr = Var.Map.add x spilling info.instr
-    ; bound_vars = Var.Set.union info.bound_vars spilled_vars
-    }
-  , spilling.stack )
-
-(*
-ZZZ TODO
-- We could improve the code generated for stack adjustment after a switch
-- We need to deal with exceptions...
-- Check available stack depth at beginning of function (also for curry/apply)
-- We could zero-out no longer used stack slots to avoid memory leaks
-*)
diff --git a/compiler/lib/wasm/wa_spilling.mli b/compiler/lib/wasm/wa_spilling.mli
deleted file mode 100644
index 5c4ac9db86..0000000000
--- a/compiler/lib/wasm/wa_spilling.mli
+++ /dev/null
@@ -1,89 +0,0 @@
-(* Wasm_of_ocaml compiler
- * http://www.ocsigen.org/js_of_ocaml/
- *
- * 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, with linking exception;
- * either version 2.1 of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- *)
-
-(*
-type stack = Code.Var.t option list
-
-type spilling_info =
-  { reloads : (Code.Var.t * int) list
-  ; depth_change : int
-  ; spills : (Code.Var.t * int) list
-  ; stack : stack
-  }
-
-type block_info =
-  { initial_depth : int
-  ; loaded_variables : Code.Var.Set.t
-  ; spilling : spilling_info
-  }
-
-type info =
-  { max_depth : int
-  ; subcalls : bool
-  ; initial_spilling : spilling_info
-  ; block : block_info Code.Addr.Map.t
-  ; instr : spilling_info Code.Var.Map.t
-  }
-*)
-
-type stack = Code.Var.t option list
-
-type info
-
-val generate_spilling_information :
-     Code.program
-  -> context:Wa_code_generation.context
-  -> closures:Wa_closure_conversion.closure Code.Var.Map.t
-  -> pc:Code.Addr.t
-  -> env:Code.Var.t
-  -> params:Code.Var.t list
-  -> info
-
-val make_info : unit -> info
-
-val add_spilling :
-     info
-  -> location:Code.Var.t
-  -> stack:stack
-  -> live_vars:Code.Var.Set.t
-  -> spilled_vars:Code.Var.Set.t
-  -> info * stack
-
-type ctx
-
-val start_function : context:Wa_code_generation.context -> info -> ctx
-
-val start_block : context:Wa_code_generation.context -> info -> Code.Addr.t -> ctx
-
-val perform_reloads :
-     ctx
-  -> [ `Branch of Code.last | `Instr of Code.instr | `Vars of Code.Var.Set.t ]
-  -> unit Wa_code_generation.t
-
-val perform_spilling :
-     ctx
-  -> [ `Function | `Instr of Code.Var.t | `Block of Code.Addr.t ]
-  -> unit Wa_code_generation.t
-
-val kill_variables : ctx -> unit
-
-val assign : ctx -> Code.Var.t -> unit Wa_code_generation.t
-
-val adjust_stack : ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> unit Wa_code_generation.t
-
-val stack_adjustment_needed : ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> bool
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index b0c1a40c82..8b71358fe0 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -30,8 +30,6 @@ let rec rewrite_tail_call ~y i =
   | Wa_ast.Location (loc, i') ->
       Option.map ~f:(fun i -> Wa_ast.Location (loc, i)) (rewrite_tail_call ~y i')
   | LocalSet (x, Call (symb, l)) when Code.Var.equal x y -> Some (Return_call (symb, l))
-  | LocalSet (x, Call_indirect (ty, e, l)) when Code.Var.equal x y ->
-      Some (Return_call_indirect (ty, e, l))
   | LocalSet (x, Call_ref (ty, e, l)) when Code.Var.equal x y ->
       Some (Return_call_ref (ty, e, l))
   | _ -> None
@@ -48,17 +46,13 @@ let rec instruction ~tail i =
         , List.map ~f:(fun (tag, l) -> tag, instructions ~tail l) catches
         , Option.map ~f:(fun l -> instructions ~tail l) catch_all )
   | Return (Some (Call (symb, l))) -> Return_call (symb, l)
-  | Return (Some (Call_indirect (ty, e, l))) -> Return_call_indirect (ty, e, l)
   | Return (Some (Call_ref (ty, e, l))) -> Return_call_ref (ty, e, l)
   | Push (Call (symb, l)) when tail -> Return_call (symb, l)
-  | Push (Call_indirect (ty, e, l)) when tail -> Return_call_indirect (ty, e, l)
   | Push (Call_ref (ty, e, l)) when tail -> Return_call_ref (ty, e, l)
   | Location (loc, i) -> Location (loc, instruction ~tail i)
   | Push (Call_ref _) -> i
   | Drop (BlockExpr (typ, l)) -> Drop (BlockExpr (typ, instructions ~tail:false l))
   | Drop _
-  | Store _
-  | Store8 _
   | LocalSet _
   | GlobalSet _
   | Br_table _
@@ -72,7 +66,6 @@ let rec instruction ~tail i =
   | Push _
   | ArraySet _
   | StructSet _
-  | Return_call_indirect _
   | Return_call _
   | Return_call_ref _ -> i
 
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index e5f221e881..422720ed06 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -19,70 +19,16 @@
 module type S = sig
   type expression = Wa_code_generation.expression
 
-  module Stack : sig
-    type stack = Code.Var.t option list
-
-    type info
-
-    val generate_spilling_information :
-         Code.program
-      -> context:Wa_code_generation.context
-      -> closures:Wa_closure_conversion.closure Code.Var.Map.t
-      -> pc:Code.Addr.t
-      -> env:Code.Var.t
-      -> params:Code.Var.t list
-      -> info
-
-    val make_info : unit -> info
-
-    val add_spilling :
-         info
-      -> location:Code.Var.t
-      -> stack:stack
-      -> live_vars:Code.Var.Set.t
-      -> spilled_vars:Code.Var.Set.t
-      -> info * stack
-
-    type ctx
-
-    val start_function : context:Wa_code_generation.context -> info -> ctx
-
-    val start_block : context:Wa_code_generation.context -> info -> Code.Addr.t -> ctx
-
-    val perform_reloads :
-         ctx
-      -> [ `Branch of Code.last | `Instr of Code.instr | `Vars of Code.Var.Set.t ]
-      -> unit Wa_code_generation.t
-
-    val perform_spilling :
-         ctx
-      -> [ `Function | `Instr of Code.Var.t | `Block of Code.Addr.t ]
-      -> unit Wa_code_generation.t
-
-    val kill_variables : ctx -> unit
-
-    val assign : ctx -> Code.Var.t -> unit Wa_code_generation.t
-
-    val adjust_stack :
-      ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> unit Wa_code_generation.t
-
-    val stack_adjustment_needed : ctx -> src:Code.Addr.t -> dst:Code.Addr.t -> bool
-  end
-
   module Memory : sig
     val allocate :
-         Stack.ctx
-      -> Code.Var.t
-      -> tag:int
-      -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list
-      -> expression
+      tag:int -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list -> expression
 
     val load_function_pointer :
          cps:bool
       -> arity:int
       -> ?skip_cast:bool
       -> expression
-      -> ([ `Index | `Ref of Wa_ast.var ] * Wa_ast.expression) Wa_code_generation.t
+      -> (Wa_ast.var * Wa_ast.expression) Wa_code_generation.t
 
     val load_real_closure :
          cps:bool
@@ -130,19 +76,19 @@ module type S = sig
 
     val bytes_set : expression -> expression -> expression -> unit Wa_code_generation.t
 
-    val box_float : Stack.ctx -> Code.Var.t -> expression -> expression
+    val box_float : expression -> expression
 
     val unbox_float : expression -> expression
 
-    val box_int32 : Stack.ctx -> Code.Var.t -> expression -> expression
+    val box_int32 : expression -> expression
 
     val unbox_int32 : expression -> expression
 
-    val box_int64 : Stack.ctx -> Code.Var.t -> expression -> expression
+    val box_int64 : expression -> expression
 
     val unbox_int64 : expression -> expression
 
-    val box_nativeint : Stack.ctx -> Code.Var.t -> expression -> expression
+    val box_nativeint : expression -> expression
 
     val unbox_nativeint : expression -> expression
   end
@@ -215,7 +161,6 @@ module type S = sig
     val translate :
          context:Wa_code_generation.context
       -> closures:Wa_closure_conversion.closure Code.Var.Map.t
-      -> stack_ctx:Stack.ctx
       -> cps:bool
       -> Code.Var.t
       -> expression
@@ -228,9 +173,7 @@ module type S = sig
       -> unit Wa_code_generation.t
 
     val curry_allocate :
-         stack_ctx:Stack.ctx
-      -> x:Code.Var.t
-      -> cps:bool
+         cps:bool
       -> arity:int
       -> int
       -> f:Code.Var.t
diff --git a/compiler/lib/wasm/wa_wasm_output.ml b/compiler/lib/wasm/wa_wasm_output.ml
index 114ce0edc8..68c6018c9d 100644
--- a/compiler/lib/wasm/wa_wasm_output.ml
+++ b/compiler/lib/wasm/wa_wasm_output.ml
@@ -299,7 +299,7 @@ end = struct
                 if typ.mut then Feature.require mutable_globals;
                 output_byte ch 0x03;
                 output_globaltype type_names ch typ;
-                Hashtbl.add global_names (V name) !global_idx;
+                Hashtbl.add global_names name !global_idx;
                 incr global_idx
             | Tag typ ->
                 Feature.require exception_handling;
@@ -428,7 +428,7 @@ end = struct
   type st =
     { type_names : (var, int) Hashtbl.t
     ; func_names : (var, int) Hashtbl.t
-    ; global_names : (symbol, int) Hashtbl.t
+    ; global_names : (var, int) Hashtbl.t
     ; data_names : (var, int) Hashtbl.t
     ; tag_names : (var, int) Hashtbl.t
     ; local_names : (var, (var, int) Hashtbl.t) Hashtbl.t
@@ -481,7 +481,6 @@ end = struct
     | F64PromoteF32 e' ->
         output_expression st ch e';
         output_byte ch 0xBB
-    | Call_indirect _ | ConstSym _ | Load _ | Load8 _ | MemoryGrow _ -> assert false
     | LocalGet i ->
         output_byte ch 0x20;
         output_uint ch (Hashtbl.find st.current_local_names i)
@@ -635,7 +634,6 @@ end = struct
     | Drop e ->
         output_expression st ch e;
         output_byte ch 0x1A
-    | Store _ | Store8 _ -> assert false
     | LocalSet (i, e) ->
         output_expression st ch e;
         output_byte ch 0x21;
@@ -732,7 +730,6 @@ end = struct
         output_byte ch 0x05;
         output_uint ch (Hashtbl.find st.type_names typ);
         output_uint ch idx
-    | Return_call_indirect _ -> assert false
     | Return_call (f, l) ->
         Feature.require tail_call;
         List.iter ~f:(fun e -> output_expression st ch e) l;
@@ -829,20 +826,6 @@ end = struct
     in
     data_count, data_names
 
-  let data_contents contents =
-    let b = Buffer.create 16 in
-    List.iter
-      ~f:(fun d ->
-        match d with
-        | DataI8 c -> Buffer.add_uint8 b c
-        | DataI32 i -> Buffer.add_int32_le b i
-        | DataI64 i -> Buffer.add_int64_le b i
-        | DataBytes s -> Buffer.add_string b s
-        | DataSym _ -> assert false
-        | DataSpace n -> Buffer.add_string b (String.make n '\000'))
-      contents;
-    Buffer.contents b
-
   let output_data_count ch data_count = output_uint ch data_count
 
   let output_data ch (data_count, fields) =
@@ -851,10 +834,9 @@ end = struct
       (List.fold_left
          ~f:(fun idx field ->
            match field with
-           | Data { active; contents; _ } ->
-               assert (not active);
+           | Data { contents; _ } ->
                output_byte ch 1;
-               output_name ch (data_contents contents);
+               output_name ch contents;
                idx + 1
            | Function _ | Type _ | Import _ | Global _ | Tag _ -> idx)
          ~init:0
@@ -883,7 +865,6 @@ end = struct
     | ArrayGet (_, _, e', e'')
     | RefEq (e', e'') ->
         set |> expr_function_references e' |> expr_function_references e''
-    | Call_indirect _ | ConstSym _ | Load _ | Load8 _ | MemoryGrow _ -> assert false
     | IfExpr (_, e1, e2, e3) ->
         set
         |> expr_function_references e1
@@ -912,7 +893,6 @@ end = struct
     | Return (Some e)
     | Push e
     | Throw (_, e) -> expr_function_references e set
-    | Store _ | Store8 _ -> assert false
     | Loop (_, l) | Block (_, l) ->
         List.fold_left ~f:(fun set i -> instr_function_references i set) ~init:set l
     | If (_, e, l1, l2) ->
@@ -950,7 +930,6 @@ end = struct
         |> expr_function_references e3
     | StructSet (_, _, e1, e2) ->
         set |> expr_function_references e1 |> expr_function_references e2
-    | Return_call_indirect _ -> assert false
     | Return_call (_, l) ->
         List.fold_left ~f:(fun set i -> expr_function_references i set) ~init:set l
     | Return_call_ref (_, e', l) ->
@@ -1090,11 +1069,6 @@ end = struct
   let output_names ch st =
     output_name ch "name";
     let index = Code.Var.get_name in
-    let symbol name =
-      match name with
-      | V name -> Code.Var.get_name name
-      | S name -> Some name
-    in
     let out id f tbl =
       let names = assign_names f tbl in
       if not (List.is_empty names)
@@ -1129,7 +1103,7 @@ end = struct
       ch
       locals;
     out 4 index st.type_names;
-    out 7 symbol st.global_names;
+    out 7 index st.global_names;
     out 9 index st.data_names;
     out 11 index st.tag_names
 
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 1d66b078dc..ef157c69e2 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -70,7 +70,7 @@ let assign_names ?(reversed = true) f names =
 type st =
   { type_names : (var, string) Hashtbl.t
   ; func_names : (var, string) Hashtbl.t
-  ; global_names : (symbol, string) Hashtbl.t
+  ; global_names : (var, string) Hashtbl.t
   ; data_names : (var, string) Hashtbl.t
   ; tag_names : (var, string) Hashtbl.t
   ; local_names : (var, string) Hashtbl.t
@@ -94,18 +94,13 @@ let build_name_tables fields =
       | Import { name; desc; _ } -> (
           match desc with
           | Fun _ -> push func_names name
-          | Global _ -> push global_names (V name)
+          | Global _ -> push global_names name
           | Tag _ -> push tag_names name))
     fields;
   let index = Code.Var.get_name in
-  let symbol name =
-    match name with
-    | V name -> Code.Var.get_name name
-    | S name -> Some name
-  in
   { type_names = assign_names index !type_names
   ; func_names = assign_names index !func_names
-  ; global_names = assign_names symbol !global_names
+  ; global_names = assign_names index !global_names
   ; data_names = assign_names index !data_names
   ; tag_names = assign_names index !tag_names
   ; local_names = Hashtbl.create 1
@@ -134,8 +129,6 @@ let rec format_sexp f s =
 
 let index tbl x = Atom ("$" ^ Hashtbl.find tbl x)
 
-let symbol tbl name = index tbl.global_names name
-
 let heap_type st (ty : heap_type) =
   match ty with
   | Func -> Atom "func"
@@ -288,28 +281,12 @@ let select i32 i64 f32 f64 op =
   | F64 x -> f64 "64" x
 
 type ctx =
-  { addresses : int Code.Var.Map.t
-  ; mutable functions : int Code.Var.Map.t
-  ; mutable function_refs : Code.Var.Set.t
-  ; mutable function_count : int
+  { mutable function_refs : Code.Var.Set.t
   ; debug : Parse_bytecode.Debug.t
   }
 
 let reference_function ctx f = ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
 
-let lookup_symbol ctx (x : symbol) =
-  match x with
-  | S _ -> assert false
-  | V x -> (
-      try Code.Var.Map.find x ctx.addresses
-      with Not_found -> (
-        try Code.Var.Map.find x ctx.functions
-        with Not_found ->
-          let i = ctx.function_count in
-          ctx.functions <- Code.Var.Map.add x i ctx.functions;
-          ctx.function_count <- ctx.function_count + 1;
-          i))
-
 let remove_nops l = List.filter ~f:(fun i -> not (Poly.equal i Nop)) l
 
 let float64 _ f =
@@ -337,9 +314,6 @@ let expression_or_instructions ctx st in_function =
                    op)
             ]
         ]
-    | ConstSym (symb, ofs) ->
-        let i = lookup_symbol ctx symb in
-        [ List [ Atom "i32.const"; Atom (string_of_int (i + ofs)) ] ]
     | UnOp (op, e') ->
         [ List
             (Atom (type_prefix op (select int_un_op int_un_op float_un_op float_un_op op))
@@ -357,40 +331,17 @@ let expression_or_instructions ctx st in_function =
     | I64ExtendI32 (s, e) -> [ List (Atom (signage "i64.extend_i32" s) :: expression e) ]
     | F32DemoteF64 e -> [ List (Atom "f32.demote_f64" :: expression e) ]
     | F64PromoteF32 e -> [ List (Atom "f64.promote_f32" :: expression e) ]
-    | Load (offset, e') ->
-        let offs _ i =
-          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
-        in
-        [ List
-            ((Atom (type_prefix offset "load") :: select offs offs offs offs offset)
-            @ expression e')
-        ]
-    | Load8 (s, offset, e') ->
-        let offs _ i =
-          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
-        in
-        [ List
-            (Atom (type_prefix offset (signage "load" s))
-             :: select offs offs offs offs offset
-            @ expression e')
-        ]
     | LocalGet i -> [ List [ Atom "local.get"; index st.local_names i ] ]
     | LocalTee (i, e') ->
         [ List (Atom "local.tee" :: index st.local_names i :: expression e') ]
-    | GlobalGet nm -> [ List [ Atom "global.get"; symbol st nm ] ]
+    | GlobalGet nm -> [ List [ Atom "global.get"; index st.global_names nm ] ]
     | BlockExpr (ty, l) -> [ List (Atom "block" :: (block_type st ty @ instructions l)) ]
-    | Call_indirect (typ, e, l) ->
-        [ List
-            ((Atom "call_indirect" :: func_type st typ)
-            @ List.concat (List.map ~f:expression (l @ [ e ])))
-        ]
     | Call (f, l) ->
         [ List
             (Atom "call"
             :: index st.func_names f
             :: List.concat (List.map ~f:expression l))
         ]
-    | MemoryGrow (_, e) -> [ List (Atom "memory.grow" :: expression e) ]
     | Seq (l, e) -> instructions l @ expression e
     | Pop _ -> []
     | RefFunc symb ->
@@ -483,26 +434,11 @@ let expression_or_instructions ctx st in_function =
   and instruction i =
     match i with
     | Drop e -> [ List (Atom "drop" :: expression e) ]
-    | Store (offset, e1, e2) ->
-        let offs _ i =
-          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
-        in
-        [ List
-            (Atom (type_prefix offset "store")
-            :: (select offs offs offs offs offset @ expression e1 @ expression e2))
-        ]
-    | Store8 (offset, e1, e2) ->
-        let offs _ i =
-          if Int32.equal i 0l then [] else [ Atom (Printf.sprintf "offset=%ld" i) ]
-        in
-        [ List
-            (Atom (type_prefix offset "store8")
-            :: (select offs offs offs offs offset @ expression e1 @ expression e2))
-        ]
     | LocalSet (i, Seq (l, e)) -> instructions (l @ [ LocalSet (i, e) ])
     | LocalSet (i, e) ->
         [ List (Atom "local.set" :: index st.local_names i :: expression e) ]
-    | GlobalSet (nm, e) -> [ List (Atom "global.set" :: symbol st nm :: expression e) ]
+    | GlobalSet (nm, e) ->
+        [ List (Atom "global.set" :: index st.global_names nm :: expression e) ]
     | Loop (ty, l) -> [ List (Atom "loop" :: (block_type st ty @ instructions l)) ]
     | Block (ty, l) -> [ List (Atom "block" :: (block_type st ty @ instructions l)) ]
     | If (ty, e, l1, l2) ->
@@ -574,11 +510,6 @@ let expression_or_instructions ctx st in_function =
             :: Atom (string_of_int i)
             :: (expression e @ expression e'))
         ]
-    | Return_call_indirect (typ, e, l) ->
-        [ List
-            ((Atom "return_call_indirect" :: func_type st typ)
-            @ List.concat (List.map ~f:expression (l @ [ e ])))
-        ]
     | Return_call (f, l) ->
         [ List
             (Atom "return_call"
@@ -635,7 +566,8 @@ let import st f =
           ; List
               (match desc with
               | Fun typ -> Atom "func" :: index st.func_names name :: func_type st typ
-              | Global ty -> [ Atom "global"; symbol st (V name); global_type st ty ]
+              | Global ty ->
+                  [ Atom "global"; index st.global_names name; global_type st ty ]
               | Tag ty ->
                   [ Atom "tag"
                   ; index st.tag_names name
@@ -654,21 +586,6 @@ let escape_string s =
   done;
   Buffer.contents b
 
-let data_contents ctx contents =
-  let b = Buffer.create 16 in
-  List.iter
-    ~f:(fun d ->
-      match d with
-      | DataI8 c -> Buffer.add_uint8 b c
-      | DataI32 i -> Buffer.add_int32_le b i
-      | DataI64 i -> Buffer.add_int64_le b i
-      | DataBytes s -> Buffer.add_string b s
-      | DataSym (symb, ofs) ->
-          Buffer.add_int32_le b (Int32.of_int (lookup_symbol ctx symb + ofs))
-      | DataSpace n -> Buffer.add_string b (String.make n '\000'))
-    contents;
-  escape_string (Buffer.contents b)
-
 let type_field st { name; typ; supertype; final } =
   if final && Option.is_none supertype
   then List [ Atom "type"; index st.type_names name; str_type st typ ]
@@ -692,7 +609,7 @@ let field ctx st f =
   | Global { name; exported_name; typ; init } ->
       [ List
           (Atom "global"
-          :: symbol st name
+          :: index st.global_names name
           :: (export exported_name @ (global_type st typ :: expression ctx st init)))
       ]
   | Tag { name; typ } ->
@@ -703,85 +620,22 @@ let field ctx st f =
           ]
       ]
   | Import _ -> []
-  | Data { name; active; contents; _ } ->
+  | Data { name; contents } ->
       [ List
-          (Atom "data"
-          :: index st.data_names name
-          :: ((if active
-               then
-                 expression
-                   ctx
-                   st
-                   (Const (I32 (Int32.of_int (lookup_symbol ctx (V name)))))
-               else [])
-             @ [ Atom ("\"" ^ data_contents ctx contents ^ "\"") ]))
+          [ Atom "data"
+          ; index st.data_names name
+          ; Atom ("\"" ^ escape_string contents ^ "\"")
+          ]
       ]
   | Type [ t ] -> [ type_field st t ]
   | Type l -> [ List (Atom "rec" :: List.map ~f:(type_field st) l) ]
 
-let data_size contents =
-  List.fold_left
-    ~f:(fun sz d ->
-      sz
-      +
-      match d with
-      | DataI8 _ -> 1
-      | DataI32 _ -> 4
-      | DataI64 _ -> 8
-      | DataBytes s -> String.length s
-      | DataSym _ -> 4
-      | DataSpace n -> n)
-    ~init:0
-    contents
-
-let data_offsets fields =
-  List.fold_left
-    ~f:(fun (i, addresses) f ->
-      match f with
-      | Data { name; contents; active = true; _ } ->
-          i + data_size contents, Code.Var.Map.add name i addresses
-      | Function _ | Global _ | Tag _ | Import _ | Data { active = false; _ } | Type _ ->
-          i, addresses)
-    ~init:(0, Code.Var.Map.empty)
-    fields
-
 let f ~debug ch fields =
   let st = build_name_tables fields in
-  let heap_base, addresses = data_offsets fields in
-  let ctx =
-    { addresses
-    ; functions = Code.Var.Map.empty
-    ; function_refs = Code.Var.Set.empty
-    ; function_count = 0
-    ; debug
-    }
-  in
+  let ctx = { function_refs = Code.Var.Set.empty; debug } in
   let other_fields = List.concat (List.map ~f:(fun f -> field ctx st f) fields) in
-  let funct_table =
-    let functions =
-      List.map
-        ~f:fst
-        (List.sort
-           ~cmp:(fun (_, i) (_, j) -> compare i j)
-           (Code.Var.Map.bindings ctx.functions))
-    in
-    if List.is_empty functions
-    then []
-    else
-      [ List
-          [ Atom "table"
-          ; Atom "funcref"
-          ; List (Atom "elem" :: List.map ~f:(index st.func_names) functions)
-          ]
-      ]
-  in
   let funct_decl =
-    let functions =
-      Code.Var.Set.elements
-        (Code.Var.Set.filter
-           (fun f -> not (Code.Var.Map.mem f ctx.functions))
-           ctx.function_refs)
-    in
+    let functions = Code.Var.Set.elements ctx.function_refs in
     if List.is_empty functions
     then []
     else
@@ -799,14 +653,5 @@ let f ~debug ch fields =
     (List
        (Atom "module"
        :: (List.concat (List.map ~f:(fun i -> import st i) fields)
-          @ (if Code.Var.Map.is_empty addresses
-             then []
-             else
-               [ List
-                   [ Atom "memory"
-                   ; Atom (string_of_int ((heap_base + 0xffff) / 0x10000))
-                   ]
-               ])
-          @ funct_table
           @ funct_decl
           @ other_fields)))

From c3cf34b0176723581ce090185bea530d601a82ef Mon Sep 17 00:00:00 2001
From: Ricky Vetter <rickywvetter@gmail.com>
Date: Tue, 8 Oct 2024 14:59:37 -0400
Subject: [PATCH 390/481] Calculate fetchBase once at toplevel

> It's important to note that this will not reference the <script> element if the code in the script is being called as a callback or event handler; it will only reference the element while it's initially being processed.

https://developer.mozilla.org/en-US/docs/Web/API/Document/currentScript

Base was applied to the first wasm file, but not to subsequent files. This is an issue if you're loading a page at /foo/bar/baz and have your wasm hosted at /client.bc.wasm.assets, only appears in separate compilation.
---
 runtime/wasm/runtime.js | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 393c2c270d..64a5824ce3 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -471,9 +471,9 @@
     const f = path.join(path.dirname(require.main.filename), src);
     return require("node:fs/promises").readFile(f);
   }
+  const fetchBase = globalThis?.document?.currentScript?.src;
   function fetchRelative(src) {
-    const base = globalThis?.document?.currentScript?.src;
-    const url = base ? new URL(src, base) : src;
+    const url = fetchBase ? new URL(src, fetchBase) : src;
     return fetch(url);
   }
   const loadCode = isNode ? loadRelative : fetchRelative;

From 1bc3ab8cde58915a35b4f2af59fae9c27f8dc392 Mon Sep 17 00:00:00 2001
From: Ricky Vetter <rickywvetter@gmail.com>
Date: Mon, 14 Oct 2024 18:26:31 -0400
Subject: [PATCH 391/481] Use static Object.hasOwn

I think the initial change in 90db9c5d997fe8130f3d1be81051615d4aa6f862 meant to use the static hasOwn but instead is calling on the object itself.
---
 runtime/wasm/runtime.js | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 64a5824ce3..341e224ba5 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -157,7 +157,7 @@
     new: (c, args) => new c(...args),
     global_this: globalThis,
     iter_props: (o, f) => {
-      for (var nm in o) if (o.hasOwn(nm)) f(nm);
+      for (var nm in o) if (Object.hasOwn(o, nm)) f(nm);
     },
     array_length: (a) => a.length,
     array_get: (a, i) => a[i],

From 38abfd54f6d7573fc6b1f9cd985b55eca091997d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 25 Sep 2024 21:37:10 +0200
Subject: [PATCH 392/481] Move boxing/unboxing outside of some runtime
 primitives

This makes it visible to binaryen, which than is able to eliminate so
unncessary boxing.
---
 compiler/lib/wasm/wa_generate.ml | 103 ++++++++++++++++++++++++---
 runtime/wasm/bigarray.wat        | 108 ++++++++++++++--------------
 runtime/wasm/float.wat           |  60 ++++++----------
 runtime/wasm/int32.wat           |  42 +++--------
 runtime/wasm/int64.wat           |  32 ++++-----
 runtime/wasm/prng.wat            |   6 +-
 runtime/wasm/string.wat          | 116 ++++++++++++++-----------------
 7 files changed, 240 insertions(+), 227 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 6b3c0d807f..be77eb246b 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -38,6 +38,71 @@ module Generate (Target : Wa_target_sig.S) = struct
     ; debug : Parse_bytecode.Debug.t
     }
 
+  type repr =
+    | Value
+    | Float
+    | Int32
+    | Nativeint
+    | Int64
+
+  let repr_type r =
+    match r with
+    | Value -> Value.value
+    | Float -> F64
+    | Int32 -> I32
+    | Nativeint -> I32
+    | Int64 -> I64
+
+  let specialized_func_type (params, result) =
+    { W.params = List.map ~f:repr_type params; result = [ repr_type result ] }
+
+  let box_value r e =
+    match r with
+    | Value -> e
+    | Float -> Memory.box_float e
+    | Int32 -> Memory.box_int32 e
+    | Nativeint -> Memory.box_nativeint e
+    | Int64 -> Memory.box_int64 e
+
+  let unbox_value r e =
+    match r with
+    | Value -> e
+    | Float -> Memory.unbox_float e
+    | Int32 -> Memory.unbox_int32 e
+    | Nativeint -> Memory.unbox_nativeint e
+    | Int64 -> Memory.unbox_int64 e
+
+  let specialized_primitives =
+    let h = Hashtbl.create 18 in
+    List.iter
+      ~f:(fun (nm, typ) -> Hashtbl.add h nm typ)
+      [ "caml_int32_bswap", ([ Int32 ], Int32)
+      ; "caml_nativeint_bswap", ([ Nativeint ], Nativeint)
+      ; "caml_int64_bswap", ([ Int64 ], Int64)
+      ; "caml_int32_compare", ([ Int32; Int32 ], Value)
+      ; "caml_nativeint_compare", ([ Nativeint; Nativeint ], Value)
+      ; "caml_int64_compare", ([ Int64; Int64 ], Value)
+      ; "caml_string_get32", ([ Value; Value ], Int32)
+      ; "caml_string_get64", ([ Value; Value ], Int64)
+      ; "caml_bytes_get32", ([ Value; Value ], Int32)
+      ; "caml_bytes_get64", ([ Value; Value ], Int64)
+      ; "caml_bytes_set32", ([ Value; Value; Int32 ], Value)
+      ; "caml_bytes_set64", ([ Value; Value; Int64 ], Value)
+      ; "caml_lxm_next", ([ Value ], Int64)
+      ; "caml_ba_uint8_get32", ([ Value; Value ], Int32)
+      ; "caml_ba_uint8_get64", ([ Value; Value ], Int64)
+      ; "caml_ba_uint8_set32", ([ Value; Value; Int32 ], Value)
+      ; "caml_ba_uint8_set64", ([ Value; Value; Int64 ], Value)
+      ; "caml_nextafter_float", ([ Float; Float ], Float)
+      ; "caml_classify_float", ([ Float ], Value)
+      ; "caml_ldexp_float", ([ Float; Value ], Float)
+      ; "caml_signbit_float", ([ Float ], Value)
+      ; "caml_erf_float", ([ Float ], Float)
+      ; "caml_erfc_float", ([ Float ], Float)
+      ; "caml_float_compare", ([ Float; Float ], Value)
+      ];
+    h
+
   let func_type n =
     { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
 
@@ -386,6 +451,10 @@ module Generate (Target : Wa_target_sig.S) = struct
                 int32_shift_op (Shr U) i j
             | Extern "caml_int32_to_int", [ i ] -> Value.val_int (Memory.unbox_int32 i)
             | Extern "caml_int32_of_int", [ i ] -> Memory.box_int32 (Value.int_val i)
+            | Extern "caml_nativeint_of_int32", [ i ] ->
+                Memory.box_nativeint (Memory.unbox_int32 i)
+            | Extern "caml_nativeint_to_int32", [ i ] ->
+                Memory.box_int32 (Memory.unbox_nativeint i)
             | Extern "caml_int64_bits_of_float", [ f ] ->
                 let* f = Memory.unbox_float f in
                 Memory.box_int64 (return (W.UnOp (I64 ReinterpretF, f)))
@@ -565,18 +634,30 @@ module Generate (Target : Wa_target_sig.S) = struct
                     ~init:(return [])
                 in
                 Memory.allocate ~tag:0 l
-            | Extern name, l ->
+            | Extern name, l -> (
                 let name = Primitive.resolve name in
-                (*ZZZ Different calling convention when large number of parameters *)
-                let* f = register_import ~name (Fun (func_type (List.length l))) in
-                let rec loop acc l =
-                  match l with
-                  | [] -> return (W.Call (f, List.rev acc))
-                  | x :: r ->
-                      let* x = x in
-                      loop (x :: acc) r
-                in
-                loop [] l
+                try
+                  let typ = Hashtbl.find specialized_primitives name in
+                  let* f = register_import ~name (Fun (specialized_func_type typ)) in
+                  let rec loop acc arg_typ l =
+                    match arg_typ, l with
+                    | [], [] -> box_value (snd typ) (return (W.Call (f, List.rev acc)))
+                    | repr :: rem, x :: r ->
+                        let* x = unbox_value repr x in
+                        loop (x :: acc) rem r
+                    | [], _ :: _ | _ :: _, [] -> assert false
+                  in
+                  loop [] (fst typ) l
+                with Not_found ->
+                  let* f = register_import ~name (Fun (func_type (List.length l))) in
+                  let rec loop acc l =
+                    match l with
+                    | [] -> return (W.Call (f, List.rev acc))
+                    | x :: r ->
+                        let* x = x in
+                        loop (x :: acc) r
+                  in
+                  loop [] l)
             | Not, [ x ] -> Value.not x
             | Lt, [ x; y ] -> Value.lt x y
             | Le, [ x; y ] -> Value.le x y
diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index b049c59aff..3e8d799435 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -1919,7 +1919,7 @@
                            (i32.const 8)))))
 
    (func (export "caml_ba_uint8_get32")
-      (param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (param $vba (ref eq)) (param $i (ref eq)) (result i32)
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32)
@@ -1933,23 +1933,22 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (return_call $caml_copy_int32
+      (i32.or
+         (i32.or
+            (call $ta_get_ui8 (local.get $data) (local.get $p))
+            (i32.shl (call $ta_get_ui8 (local.get $data)
+                        (i32.add (local.get $p) (i32.const 1)))
+                     (i32.const 8)))
          (i32.or
-            (i32.or
-               (call $ta_get_ui8 (local.get $data) (local.get $p))
-               (i32.shl (call $ta_get_ui8 (local.get $data)
-                           (i32.add (local.get $p) (i32.const 1)))
-                        (i32.const 8)))
-            (i32.or
-               (i32.shl (call $ta_get_ui8 (local.get $data)
-                           (i32.add (local.get $p) (i32.const 2)))
-                        (i32.const 16))
-               (i32.shl (call $ta_get_ui8 (local.get $data)
-                           (i32.add (local.get $p) (i32.const 3)))
-                        (i32.const 24))))))
+            (i32.shl (call $ta_get_ui8 (local.get $data)
+                        (i32.add (local.get $p) (i32.const 2)))
+                     (i32.const 16))
+            (i32.shl (call $ta_get_ui8 (local.get $data)
+                        (i32.add (local.get $p) (i32.const 3)))
+                     (i32.const 24)))))
 
    (func (export "caml_ba_uint8_get64")
-      (param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (param $vba (ref eq)) (param $i (ref eq)) (result i64)
       (local $ba (ref $bigarray))
       (local $data (ref extern))
       (local $p i32)
@@ -1963,44 +1962,43 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (return_call $caml_copy_int64
+      (i64.or
+         (i64.or
+            (i64.or
+               (i64.extend_i32_u
+                  (call $ta_get_ui8 (local.get $data) (local.get $p)))
+               (i64.shl (i64.extend_i32_u
+                           (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 1))))
+                        (i64.const 8)))
+            (i64.or
+               (i64.shl (i64.extend_i32_u
+                           (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 2))))
+                        (i64.const 16))
+               (i64.shl (i64.extend_i32_u
+                           (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 3))))
+                        (i64.const 24))))
          (i64.or
             (i64.or
-               (i64.or
-                  (i64.extend_i32_u
-                     (call $ta_get_ui8 (local.get $data) (local.get $p)))
-                  (i64.shl (i64.extend_i32_u
-                              (call $ta_get_ui8 (local.get $data)
-                                 (i32.add (local.get $p) (i32.const 1))))
-                           (i64.const 8)))
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (call $ta_get_ui8 (local.get $data)
-                                 (i32.add (local.get $p) (i32.const 2))))
-                           (i64.const 16))
-                  (i64.shl (i64.extend_i32_u
-                              (call $ta_get_ui8 (local.get $data)
-                                 (i32.add (local.get $p) (i32.const 3))))
-                           (i64.const 24))))
+               (i64.shl (i64.extend_i32_u
+                           (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 4))))
+                        (i64.const 32))
+               (i64.shl (i64.extend_i32_u
+                           (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 5))))
+                        (i64.const 40)))
             (i64.or
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (call $ta_get_ui8 (local.get $data)
-                                 (i32.add (local.get $p) (i32.const 4))))
-                           (i64.const 32))
-                  (i64.shl (i64.extend_i32_u
-                              (call $ta_get_ui8 (local.get $data)
-                                 (i32.add (local.get $p) (i32.const 5))))
-                           (i64.const 40)))
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (call $ta_get_ui8 (local.get $data)
-                                 (i32.add (local.get $p) (i32.const 6))))
-                           (i64.const 48))
-                  (i64.shl (i64.extend_i32_u
-                              (call $ta_get_ui8 (local.get $data)
-                                 (i32.add (local.get $p) (i32.const 7))))
-                           (i64.const 56)))))))
+               (i64.shl (i64.extend_i32_u
+                           (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 6))))
+                        (i64.const 48))
+               (i64.shl (i64.extend_i32_u
+                           (call $ta_get_ui8 (local.get $data)
+                              (i32.add (local.get $p) (i32.const 7))))
+                        (i64.const 56))))))
 
    (func (export "caml_ba_uint8_set16")
       (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
@@ -2026,15 +2024,14 @@
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_uint8_set32")
-      (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (param $vba (ref eq)) (param $i (ref eq)) (param $d i32)
       (result (ref eq))
       (local $ba (ref $bigarray))
       (local $data (ref extern))
-      (local $p i32) (local $d i32)
+      (local $p i32)
       (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
-      (local.set $d (call $Int32_val (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -2056,15 +2053,14 @@
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_uint8_set64")
-      (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
+      (param $vba (ref eq)) (param $i (ref eq)) (param $d i64)
       (result (ref eq))
       (local $ba (ref $bigarray))
       (local $data (ref extern))
-      (local $p i32) (local $d i64)
+      (local $p i32)
       (local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
       (local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
-      (local.set $d (call $Int64_val (local.get $v)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 4705b04c98..95a3759aea 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -661,19 +661,17 @@
       (return (ref.i31 (i32.const 0))))
 
    (func (export "caml_nextafter_float")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $y f64) (local $i i64) (local $j i64)
-      (local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
-      (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
-      (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
+      (param $x f64) (param $y f64) (result f64)
+      (local $i i64) (local $j i64)
+      (if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get $x))))
+      (if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get $y))))
       (if (f64.eq (local.get $x) (local.get $y))
-         (then (return (local.get 1))))
-      (if (result (ref eq)) (f64.eq (local.get $x) (f64.const 0))
+         (then (return (local.get $y))))
+      (if (f64.eq (local.get $x) (f64.const 0))
          (then
             (if (f64.ge (local.get $y) (f64.const 0))
-               (then (return (struct.new $float (f64.const 0x1p-1074))))
-               (else (return (struct.new $float (f64.const -0x1p-1074))))))
+               (then (return (f64.const 0x1p-1074)))
+               (else (return (f64.const -0x1p-1074)))))
          (else
             (local.set $i (i64.reinterpret_f64 (local.get $x)))
             (local.set $j (i64.reinterpret_f64 (local.get $y)))
@@ -681,12 +679,11 @@
                          (i64.lt_u (local.get $i) (local.get $j)))
                (then (local.set $i (i64.add (local.get $i) (i64.const 1))))
                (else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
-            (return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
+            (return (f64.reinterpret_i64 (local.get $i))))))
 
-   (func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
+   (func (export "caml_classify_float") (param $x f64) (result (ref eq))
       (local $a f64)
-      (local.set $a
-         (f64.abs (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
+      (local.set $a (f64.abs (local.get $x)))
       (ref.i31
          (if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
             (then
@@ -753,11 +750,10 @@
                      (i64.const 52)))))
 
    (func (export "caml_ldexp_float")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (struct.new $float
-         (call $ldexp
-            (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))
-            (i31.get_s (ref.cast (ref i31) (local.get 1))))))
+      (param $x f64) (param $i (ref eq)) (result f64)
+      (call $ldexp
+         (local.get $x)
+         (i31.get_s (ref.cast (ref i31) (local.get $i)))))
 
    (func $frexp (param $x f64) (result f64 i32)
       (local $y i64)
@@ -799,15 +795,12 @@
          (struct.new $float (tuple.extract 2 0 (local.get $r)))
          (ref.i31 (tuple.extract 2 1 (local.get $r)))))
 
-   (func (export "caml_signbit_float") (param (ref eq)) (result (ref eq))
+   (func (export "caml_signbit_float") (param $x f64) (result (ref eq))
       (ref.i31
          (i32.wrap_i64
-            (i64.shr_u
-               (i64.reinterpret_f64
-                  (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
-               (i64.const 63)))))
+            (i64.shr_u (i64.reinterpret_f64 (local.get $x)) (i64.const 63)))))
 
-   (func $erf (param $x f64) (result f64)
+   (func $erf (export "caml_erf_float") (param $x f64) (result f64)
       (local $a1 f64) (local $a2 f64) (local $a3 f64)
       (local $a4 f64) (local $a5 f64) (local $p f64)
       (local $t f64) (local $y f64)
@@ -844,16 +837,8 @@
                       (f64.neg (f64.mul (local.get $x) (local.get $x))))))))
       (f64.copysign (local.get $y) (local.get $x)))
 
-   (func (export "caml_erf_float") (param (ref eq)) (result (ref eq))
-      (struct.new $float
-         (call $erf
-            (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))))
-
-   (func (export "caml_erfc_float") (param (ref eq)) (result (ref eq))
-      (struct.new $float
-         (f64.sub (f64.const 1)
-            (call $erf
-               (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))))
+   (func (export "caml_erfc_float") (param $x f64) (result f64)
+      (f64.sub (f64.const 1) (call $erf (local.get $x))))
 
    (func (export "caml_fma_float")
       (param $vx (ref eq)) (param $vy (ref eq)) (param $vz (ref eq))
@@ -1154,10 +1139,7 @@
       (struct.new $float (local.get $y)))
 
    (func (export "caml_float_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $x f64) (local $y f64)
-      (local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
-      (local.set $y (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
+      (param $x f64) (param $y f64) (result (ref eq))
       (ref.i31
          (i32.add
             (i32.sub (f64.gt (local.get $x) (local.get $y))
diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat
index 6a56cbb312..79ce5095d8 100644
--- a/runtime/wasm/int32.wat
+++ b/runtime/wasm/int32.wat
@@ -108,15 +108,14 @@
    (func $Int32_val (export "Int32_val") (param (ref eq)) (result i32)
       (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
 
-   (func (export "caml_int32_bswap") (param (ref eq)) (result (ref eq))
-      (local $i i32)
-      (local.set $i (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
-      (return_call $caml_copy_int32
-         (i32.or
-            (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
-                      (i32.const 8))
-            (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00))
-                      (i32.const 8)))))
+   (export "caml_nativeint_bswap" (func $caml_int32_bswap))
+   (func $caml_int32_bswap (export "caml_int32_bswap")
+      (param $i i32) (result i32)
+      (i32.or
+         (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
+                   (i32.const 8))
+         (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00))
+                   (i32.const 8))))
 
    (global $INT32_ERRMSG (ref $string)
       (array.new_fixed $string 15 ;; "Int32.of_string"
@@ -132,12 +131,7 @@
 
    (export "caml_nativeint_compare" (func $caml_int32_compare))
    (func $caml_int32_compare (export "caml_int32_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $i1 i32) (local $i2 i32)
-      (local.set $i1
-         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
-      (local.set $i2
-         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 1))))
+      (param $i1 i32) (param $i2 i32) (result (ref eq))
       (ref.i31 (i32.sub (i32.gt_s (local.get $i1) (local.get $i2))
                         (i32.lt_s (local.get $i1) (local.get $i2)))))
 
@@ -177,16 +171,6 @@
       (param $i i32) (result (ref eq))
       (struct.new $int32 (global.get $nativeint_ops) (local.get $i)))
 
-   (func (export "caml_nativeint_bswap") (param (ref eq)) (result (ref eq))
-      (local $i i32)
-      (local.set $i (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0))))
-      (return_call $caml_copy_nativeint
-         (i32.or
-            (i32.rotr (i32.and (local.get $i) (i32.const 0x00FF00FF))
-                      (i32.const 8))
-            (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00))
-                      (i32.const 8)))))
-
    (global $NATIVEINT_ERRMSG (ref $string)
       (array.new_fixed $string 16 ;; "Nativeint.of_string"
          (i32.const 78) (i32.const 97) (i32.const 116) (i32.const 105)
@@ -206,12 +190,4 @@
       (return_call $format_int (local.get 0)
          (struct.get $int32 1
             (ref.cast (ref $int32) (local.get 1))) (i32.const 0)))
-
-   (func (export "caml_nativeint_of_int32") (param (ref eq)) (result (ref eq))
-      (return_call $caml_copy_nativeint
-         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0)))))
-
-   (func (export "caml_nativeint_to_int32") (param (ref eq)) (result (ref eq))
-      (return_call $caml_copy_int32
-         (struct.get $int32 1 (ref.cast (ref $int32) (local.get 0)))))
 )
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 102b7d176b..6059623126 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -111,29 +111,21 @@
    (func (export "Int64_val") (param (ref eq)) (result i64)
       (struct.get $int64 1 (ref.cast (ref $int64) (local.get 0))))
 
-   (func (export "caml_int64_bswap") (param (ref eq)) (result (ref eq))
-      (local $i i64)
-      (local.set $i (struct.get $int64 1 (ref.cast (ref $int64) (local.get 0))))
-      (return_call $caml_copy_int64
+   (func (export "caml_int64_bswap") (param $i i64) (result i64)
+      (i64.or
+         (i64.or
+            (i64.rotr (i64.and (local.get $i) (i64.const 0x000000FF000000FF))
+                      (i64.const 8))
+            (i64.rotr (i64.and (local.get $i) (i64.const 0x0000FF000000FF00))
+                      (i64.const 24)))
          (i64.or
-            (i64.or
-               (i64.rotr (i64.and (local.get $i) (i64.const 0x000000FF000000FF))
-                         (i64.const 8))
-               (i64.rotr (i64.and (local.get $i) (i64.const 0x0000FF000000FF00))
-                         (i64.const 24)))
-            (i64.or
-               (i64.rotl (i64.and (local.get $i) (i64.const 0x00FF000000FF0000))
-                         (i64.const 24))
-               (i64.rotl (i64.and (local.get $i) (i64.const 0xFF000000FF000000))
-                         (i64.const 8))))))
+            (i64.rotl (i64.and (local.get $i) (i64.const 0x00FF000000FF0000))
+                      (i64.const 24))
+            (i64.rotl (i64.and (local.get $i) (i64.const 0xFF000000FF000000))
+                      (i64.const 8)))))
 
    (func (export "caml_int64_compare")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      (local $i1 i64) (local $i2 i64)
-      (local.set $i1
-         (struct.get $int64 1 (ref.cast (ref $int64) (local.get 0))))
-      (local.set $i2
-         (struct.get $int64 1 (ref.cast (ref $int64) (local.get 1))))
+      (param $i1 i64) (param $i2 i64) (result (ref eq))
       (ref.i31 (i32.sub (i64.gt_s (local.get $i1) (local.get $i2))
                         (i64.lt_s (local.get $i1) (local.get $i2)))))
 
diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat
index 082a7b1bf3..4918eaa0bf 100644
--- a/runtime/wasm/prng.wat
+++ b/runtime/wasm/prng.wat
@@ -16,8 +16,6 @@
 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (module
-   (import "int64" "caml_copy_int64"
-      (func $caml_copy_int64 (param i64) (result (ref eq))))
    (import "bindings" "ta_get_i32"
       (func $ta_get_i32 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_set_i32"
@@ -25,7 +23,7 @@
    (import "bigarray" "caml_ba_get_data"
       (func $caml_ba_get_data (param (ref eq)) (result (ref extern))))
 
-   (func (export "caml_lxm_next") (param $v (ref eq)) (result (ref eq))
+   (func (export "caml_lxm_next") (param $v (ref eq)) (result i64)
       (local $data (ref extern))
       (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64)
       (local $z i64)
@@ -93,5 +91,5 @@
          (i32.wrap_i64 (local.get $q1)))
       (call $ta_set_i32 (local.get $data) (i32.const 7)
          (i32.wrap_i64 (i64.shr_u (local.get $q1) (i64.const 32))))
-      (return_call $caml_copy_int64 (local.get $z)))
+      (return (local.get $z)))
 )
diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat
index 1f41937bd5..bf43b2f9e4 100644
--- a/runtime/wasm/string.wat
+++ b/runtime/wasm/string.wat
@@ -19,14 +19,6 @@
    (import "fail" "caml_bound_error" (func $caml_bound_error))
    (import "fail" "caml_invalid_argument"
       (func $caml_invalid_argument (param $arg (ref eq))))
-   (import "int32" "caml_copy_int32"
-      (func $caml_copy_int32 (param i32) (result (ref eq))))
-   (import "int32" "Int32_val"
-      (func $Int32_val (param (ref eq)) (result i32)))
-   (import "int64" "caml_copy_int64"
-      (func $caml_copy_int64 (param i64) (result (ref eq))))
-   (import "int64" "Int64_val"
-      (func $Int64_val (param (ref eq)) (result i64)))
 
    (type $string (array (mut i8)))
 
@@ -182,7 +174,7 @@
 
    (export "caml_string_get32" (func $caml_bytes_get32))
    (func $caml_bytes_get32 (export "caml_bytes_get32")
-      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (param $v (ref eq)) (param $i (ref eq)) (result i32)
       (local $s (ref $string)) (local $p i32)
       (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
@@ -191,24 +183,23 @@
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
                     (array.len (local.get $s)))
          (then (call $caml_bound_error)))
-      (return_call $caml_copy_int32
+      (i32.or
+         (i32.or
+            (array.get_u $string (local.get $s) (local.get $p))
+            (i32.shl (array.get_u $string (local.get $s)
+                        (i32.add (local.get $p) (i32.const 1)))
+                     (i32.const 8)))
          (i32.or
-            (i32.or
-               (array.get_u $string (local.get $s) (local.get $p))
-               (i32.shl (array.get_u $string (local.get $s)
-                           (i32.add (local.get $p) (i32.const 1)))
-                        (i32.const 8)))
-            (i32.or
-               (i32.shl (array.get_u $string (local.get $s)
-                           (i32.add (local.get $p) (i32.const 2)))
-                        (i32.const 16))
-               (i32.shl (array.get_u $string (local.get $s)
-                           (i32.add (local.get $p) (i32.const 3)))
-                        (i32.const 24))))))
+            (i32.shl (array.get_u $string (local.get $s)
+                        (i32.add (local.get $p) (i32.const 2)))
+                     (i32.const 16))
+            (i32.shl (array.get_u $string (local.get $s)
+                        (i32.add (local.get $p) (i32.const 3)))
+                     (i32.const 24)))))
 
    (export "caml_string_get64" (func $caml_bytes_get64))
    (func $caml_bytes_get64 (export "caml_bytes_get64")
-      (param $v (ref eq)) (param $i (ref eq)) (result (ref eq))
+      (param $v (ref eq)) (param $i (ref eq)) (result i64)
       (local $s (ref $string)) (local $p i32)
       (local.set $s (ref.cast (ref $string) (local.get $v)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
@@ -217,44 +208,43 @@
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
                     (array.len (local.get $s)))
          (then (call $caml_bound_error)))
-      (return_call $caml_copy_int64
+      (i64.or
+         (i64.or
+            (i64.or
+               (i64.extend_i32_u
+                  (array.get_u $string (local.get $s) (local.get $p)))
+               (i64.shl (i64.extend_i32_u
+                           (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 1))))
+                        (i64.const 8)))
+            (i64.or
+               (i64.shl (i64.extend_i32_u
+                           (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 2))))
+                        (i64.const 16))
+               (i64.shl (i64.extend_i32_u
+                           (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 3))))
+                        (i64.const 24))))
          (i64.or
             (i64.or
-               (i64.or
-                  (i64.extend_i32_u
-                     (array.get_u $string (local.get $s) (local.get $p)))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 1))))
-                           (i64.const 8)))
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 2))))
-                           (i64.const 16))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 3))))
-                           (i64.const 24))))
+               (i64.shl (i64.extend_i32_u
+                           (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 4))))
+                        (i64.const 32))
+               (i64.shl (i64.extend_i32_u
+                           (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 5))))
+                        (i64.const 40)))
             (i64.or
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 4))))
-                           (i64.const 32))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 5))))
-                           (i64.const 40)))
-               (i64.or
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 6))))
-                           (i64.const 48))
-                  (i64.shl (i64.extend_i32_u
-                              (array.get_u $string (local.get $s)
-                                 (i32.add (local.get $p) (i32.const 7))))
-                           (i64.const 56)))))))
+               (i64.shl (i64.extend_i32_u
+                           (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 6))))
+                        (i64.const 48))
+               (i64.shl (i64.extend_i32_u
+                           (array.get_u $string (local.get $s)
+                              (i32.add (local.get $p) (i32.const 7))))
+                        (i64.const 56))))))
 
    (func (export "caml_bytes_set16")
       (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
@@ -274,11 +264,10 @@
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_bytes_set32")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32) (local $v i32)
+      (param (ref eq)) (param (ref eq)) (param $v i32) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
       (local.set $s (ref.cast (ref $string) (local.get 0)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
-      (local.set $v (call $Int32_val (local.get 2)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -297,11 +286,10 @@
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_bytes_set64")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      (local $s (ref $string)) (local $p i32) (local $v i64)
+      (param (ref eq)) (param (ref eq)) (param $v i64) (result (ref eq))
+      (local $s (ref $string)) (local $p i32)
       (local.set $s (ref.cast (ref $string) (local.get 0)))
       (local.set $p (i31.get_s (ref.cast (ref i31) (local.get 1))))
-      (local.set $v (call $Int64_val (local.get 2)))
       (if (i32.lt_s (local.get $p) (i32.const 0))
          (then (call $caml_bound_error)))
       (if (i32.ge_u (i32.add (local.get $p) (i32.const 7))

From 6d62d29b9e7e373141e4ff31dd5e22adcba339a8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 26 Sep 2024 12:59:09 +0200
Subject: [PATCH 393/481] Bigstring: add JavaScript functions to access 2 or 4
 bytes at once

Calling a JavaScript function is costly. This reduces the number of calls
to a JavaScript function that we need to make to get or set a 16-bit or
32-bit integer.
---
 runtime/wasm/bigarray.wat  | 127 +++++++------------------------------
 runtime/wasm/bigstring.wat |  16 +----
 runtime/wasm/runtime.js    |  13 ++++
 3 files changed, 39 insertions(+), 117 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 3e8d799435..412d9723fe 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -38,6 +38,10 @@
       (func $ta_get_i8 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_get_ui8"
       (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32)))
+   (import "bindings" "ta_get32_ui8"
+      (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32)))
+   (import "bindings" "ta_get16_ui8"
+      (func $ta_get16_ui8 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_set_f64"
       (func $ta_set_f64 (param (ref extern)) (param i32) (param f64)))
    (import "bindings" "ta_set_f32"
@@ -52,6 +56,10 @@
       (func $ta_set_i8 (param (ref extern)) (param i32) (param (ref i31))))
    (import "bindings" "ta_set_ui8"
       (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set16_ui8"
+      (func $ta_set16_ui8 (param (ref extern)) (param i32) (param (ref i31))))
+   (import "bindings" "ta_set32_ui8"
+      (func $ta_set32_ui8 (param (ref extern)) (param i32) (param i32)))
    (import "bindings" "ta_fill"
       (func $ta_fill_int (param (ref extern)) (param i32)))
    (import "bindings" "ta_fill"
@@ -268,19 +276,7 @@
                   (local.set $h
                      (call $caml_hash_mix_int
                         (local.get $h)
-                        (i32.or
-                           (i32.or
-                              (call $ta_get_ui8 (local.get $data) (local.get $i))
-                              (i32.shl (call $ta_get_ui8 (local.get $data)
-                                          (i32.add (local.get $i) (i32.const 1)))
-                                       (i32.const 8)))
-                           (i32.or
-                              (i32.shl (call $ta_get_ui8 (local.get $data)
-                                          (i32.add (local.get $i) (i32.const 2)))
-                                       (i32.const 16))
-                              (i32.shl (call $ta_get_ui8 (local.get $data)
-                                          (i32.add (local.get $i) (i32.const 3)))
-                                       (i32.const 24))))))
+                        (call $ta_get32_ui8 (local.get $data) (local.get $i))))
                   (local.set $i (i32.add (local.get $i) (i32.const 4)))
                   (br $loop))))
          (local.set $w (i32.const 0))
@@ -1912,11 +1908,7 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (ref.i31 (i32.or
-                  (call $ta_get_ui8 (local.get $data) (local.get $p))
-                  (i32.shl (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 1)))
-                           (i32.const 8)))))
+      (ref.i31 (call $ta_get16_ui8 (local.get $data) (local.get $p))))
 
    (func (export "caml_ba_uint8_get32")
       (param $vba (ref eq)) (param $i (ref eq)) (result i32)
@@ -1933,19 +1925,7 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (i32.or
-         (i32.or
-            (call $ta_get_ui8 (local.get $data) (local.get $p))
-            (i32.shl (call $ta_get_ui8 (local.get $data)
-                        (i32.add (local.get $p) (i32.const 1)))
-                     (i32.const 8)))
-         (i32.or
-            (i32.shl (call $ta_get_ui8 (local.get $data)
-                        (i32.add (local.get $p) (i32.const 2)))
-                     (i32.const 16))
-            (i32.shl (call $ta_get_ui8 (local.get $data)
-                        (i32.add (local.get $p) (i32.const 3)))
-                     (i32.const 24)))))
+      (return_call $ta_get32_ui8 (local.get $data) (local.get $p)))
 
    (func (export "caml_ba_uint8_get64")
       (param $vba (ref eq)) (param $i (ref eq)) (result i64)
@@ -1963,42 +1943,12 @@
                 (i32.const 0)))
          (then (call $caml_bound_error)))
       (i64.or
-         (i64.or
-            (i64.or
-               (i64.extend_i32_u
-                  (call $ta_get_ui8 (local.get $data) (local.get $p)))
-               (i64.shl (i64.extend_i32_u
-                           (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 1))))
-                        (i64.const 8)))
-            (i64.or
-               (i64.shl (i64.extend_i32_u
-                           (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 2))))
-                        (i64.const 16))
-               (i64.shl (i64.extend_i32_u
-                           (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 3))))
-                        (i64.const 24))))
-         (i64.or
-            (i64.or
-               (i64.shl (i64.extend_i32_u
-                           (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 4))))
-                        (i64.const 32))
-               (i64.shl (i64.extend_i32_u
-                           (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 5))))
-                        (i64.const 40)))
-            (i64.or
-               (i64.shl (i64.extend_i32_u
-                           (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 6))))
-                        (i64.const 48))
-               (i64.shl (i64.extend_i32_u
-                           (call $ta_get_ui8 (local.get $data)
-                              (i32.add (local.get $p) (i32.const 7))))
-                        (i64.const 56))))))
+         (i64.extend_i32_u
+            (call $ta_get32_ui8 (local.get $data) (local.get $p)))
+         (i64.shl (i64.extend_i32_u
+                     (call $ta_get32_ui8 (local.get $data)
+                        (i32.add (local.get $p) (i32.const 4))))
+                  (i64.const 32))))
 
    (func (export "caml_ba_uint8_set16")
       (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
@@ -2017,10 +1967,7 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (call $ta_set_ui8 (local.get $data) (local.get $p) (local.get $d))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 1))
-         (ref.i31 (i32.shr_u (i31.get_s (local.get $d)) (i32.const 8))))
+      (call $ta_set16_ui8 (local.get $data) (local.get $p) (local.get $d))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_uint8_set32")
@@ -2039,17 +1986,7 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (call $ta_set_ui8 (local.get $data) (local.get $p)
-         (ref.i31 (local.get $d)))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 1))
-         (ref.i31 (i32.shr_u (local.get $d) (i32.const 8))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 2))
-         (ref.i31 (i32.shr_u (local.get $d) (i32.const 16))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 3))
-         (ref.i31 (i32.shr_u (local.get $d) (i32.const 24))))
+      (call $ta_set32_ui8 (local.get $data) (local.get $p) (local.get $d))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_ba_uint8_set64")
@@ -2068,29 +2005,11 @@
                 (struct.get $bigarray $ba_dim (local.get $ba))
                 (i32.const 0)))
          (then (call $caml_bound_error)))
-      (call $ta_set_ui8 (local.get $data) (local.get $p)
-         (ref.i31 (i32.wrap_i64 (local.get $d))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 1))
-         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 8)))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 2))
-         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 16)))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 3))
-         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 24)))))
-      (call $ta_set_ui8 (local.get $data)
+      (call $ta_set32_ui8 (local.get $data) (local.get $p)
+         (i32.wrap_i64 (local.get $d)))
+      (call $ta_set32_ui8 (local.get $data)
          (i32.add (local.get $p) (i32.const 4))
-         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 5))
-         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 40)))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 6))
-         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 48)))))
-      (call $ta_set_ui8 (local.get $data)
-         (i32.add (local.get $p) (i32.const 7))
-         (ref.i31 (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 56)))))
+         (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32))))
       (ref.i31 (i32.const 0)))
 
    (export "caml_bytes_of_array" (func $caml_string_of_array))
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index 6d404b19a3..eb2ca8f134 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -35,6 +35,8 @@
       (func $ta_create (param i32) (param anyref) (result anyref)))
    (import "bindings" "ta_get_ui8"
       (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32)))
+   (import "bindings" "ta_get32_ui8"
+      (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32)))
    (import "bindings" "ta_set_ui8"
       (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31))))
    (import "bindings" "ta_subarray"
@@ -63,19 +65,7 @@
                (local.set $h
                   (call $caml_hash_mix_int
                      (local.get $h)
-                     (i32.or
-                        (i32.or
-                           (call $ta_get_ui8 (local.get $data) (local.get $i))
-                           (i32.shl (call $ta_get_ui8 (local.get $data)
-                                       (i32.add (local.get $i) (i32.const 1)))
-                                    (i32.const 8)))
-                        (i32.or
-                           (i32.shl (call $ta_get_ui8 (local.get $data)
-                                       (i32.add (local.get $i) (i32.const 2)))
-                                    (i32.const 16))
-                           (i32.shl (call $ta_get_ui8 (local.get $data)
-                                       (i32.add (local.get $i) (i32.const 3)))
-                                    (i32.const 24))))))
+                     (call $ta_get32_ui8 (local.get $data) (local.get $i))))
                (local.set $i (i32.add (local.get $i) (i32.const 4)))
                (br $loop))))
       (local.set $w (i32.const 0))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 341e224ba5..93f7a5d911 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -194,6 +194,9 @@
     ta_get_ui16: (a, i) => a[i],
     ta_get_i8: (a, i) => a[i],
     ta_get_ui8: (a, i) => a[i],
+    ta_get16_ui8: (a, i) => a[i] | (a[i + 1] << 8),
+    ta_get32_ui8: (a, i) =>
+      a[i] | (a[i + 1] << 8) | (a[i + 2] << 16) | (a[i + 3] << 24),
     ta_set_f64: (a, i, v) => (a[i] = v),
     ta_set_f32: (a, i, v) => (a[i] = v),
     ta_set_i32: (a, i, v) => (a[i] = v),
@@ -201,6 +204,16 @@
     ta_set_ui16: (a, i, v) => (a[i] = v),
     ta_set_i8: (a, i, v) => (a[i] = v),
     ta_set_ui8: (a, i, v) => (a[i] = v),
+    ta_set16_ui8: (a, i, v) => {
+      a[i] = v;
+      a[i + 1] = v >> 8;
+    },
+    ta_set32_ui8: (a, i, v) => {
+      a[i] = v;
+      a[i + 1] = v >> 8;
+      a[i + 2] = v >> 16;
+      a[i + 3] = v >> 24;
+    },
     ta_fill: (a, v) => a.fill(v),
     ta_blit: (s, d) => d.set(s),
     ta_subarray: (a, i, j) => a.subarray(i, j),

From c3ba9956b7c88c8a67bd0e337ff9304aa3a27aa9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 26 Sep 2024 13:47:36 +0200
Subject: [PATCH 394/481] Optimized blitting between strings and bigstrings

---
 runtime/wasm/bigarray.wat  | 46 +++++++++++++++++++++++---------------
 runtime/wasm/bigstring.wat | 39 +++++++++++++++-----------------
 runtime/wasm/deps.json     | 10 ++++++++-
 runtime/wasm/io.wat        | 42 +++++++++++++---------------------
 runtime/wasm/runtime.js    |  8 +++++++
 5 files changed, 78 insertions(+), 67 deletions(-)

diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat
index 412d9723fe..812055eca7 100644
--- a/runtime/wasm/bigarray.wat
+++ b/runtime/wasm/bigarray.wat
@@ -69,6 +69,14 @@
    (import "bindings" "ta_subarray"
       (func $ta_subarray
          (param (ref extern)) (param i32) (param i32) (result (ref extern))))
+   (import "bindings" "ta_blit_from_string"
+      (func $ta_blit_from_string
+         (param (ref $string)) (param i32) (param (ref extern)) (param i32)
+         (param i32)))
+   (import "bindings" "ta_blit_to_string"
+      (func $ta_blit_to_string
+         (param (ref extern)) (param i32) (param (ref $string)) (param i32)
+         (param i32)))
    (import "fail" "caml_bound_error" (func $caml_bound_error))
    (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory))
    (import "fail" "caml_invalid_argument"
@@ -2016,26 +2024,22 @@
    (func $caml_string_of_array (export "caml_string_of_array")
       (param (ref eq)) (result (ref eq))
       ;; used to convert a typed array to a string
-      (local $a (ref extern)) (local $len i32) (local $i i32)
+      (local $a (ref extern)) (local $len i32)
       (local $s (ref $string))
       (local.set $a
          (ref.as_non_null (extern.convert_any (call $unwrap (local.get 0)))))
       (local.set $len (call $ta_length (local.get $a)))
       (local.set $s (array.new $string (i32.const 0) (local.get $len)))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $len))
-            (then
-               (array.set $string (local.get $s) (local.get $i)
-                  (call $ta_get_ui8 (local.get $a) (local.get $i)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (call $ta_blit_to_string
+         (local.get $a) (i32.const 0) (local.get $s) (i32.const 0)
+         (local.get $len))
       (local.get $s))
 
    (export "caml_uint8_array_of_bytes" (func $caml_uint8_array_of_string))
    (func $caml_uint8_array_of_string (export "caml_uint8_array_of_string")
       (param (ref eq)) (result (ref eq))
       ;; Convert a string to a typed array
-      (local $ta (ref extern)) (local $len i32) (local $i i32)
+      (local $ta (ref extern)) (local $len i32)
       (local $s (ref $string))
       (local.set $s (ref.cast (ref $string) (local.get 0)))
       (local.set $len (array.len (local.get $s)))
@@ -2043,15 +2047,9 @@
          (call $ta_create
             (i32.const 3) ;; Uint8Array
             (local.get $len)))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $len))
-            (then
-               (call $ta_set_ui8
-                  (local.get $ta)
-                  (local.get $i)
-                  (ref.i31 (array.get $string (local.get $s) (local.get $i))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (call $ta_blit_from_string
+         (local.get $s) (i32.const 0) (local.get $ta) (i32.const 0)
+         (local.get $len))
       (call $wrap (any.convert_extern (local.get $ta))))
 
    (func (export "caml_ba_get_kind") (param (ref eq)) (result i32)
@@ -2082,4 +2080,16 @@
          (local.get $num_dims)
          (local.get $kind)
          (local.get $layout)))
+
+   (func (export "string_set")
+      (param $s externref) (param $i i32) (param $v i32)
+      (array.set $string
+         (ref.cast (ref null $string) (any.convert_extern (local.get $s)))
+         (local.get $i) (local.get $v)))
+
+   (func (export "string_get")
+      (param $s externref) (param $i i32) (result i32)
+      (array.get $string
+         (ref.cast (ref null $string) (any.convert_extern (local.get $s)))
+         (local.get $i)))
 )
diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat
index eb2ca8f134..94a9621743 100644
--- a/runtime/wasm/bigstring.wat
+++ b/runtime/wasm/bigstring.wat
@@ -48,6 +48,14 @@
       (func $ta_length (param (ref extern)) (result i32)))
    (import "bindings" "ta_bytes"
       (func $ta_bytes (param anyref) (result anyref)))
+   (import "bindings" "ta_blit_from_string"
+      (func $ta_blit_from_string
+         (param (ref $string)) (param i32) (param (ref extern)) (param i32)
+         (param i32)))
+   (import "bindings" "ta_blit_to_string"
+      (func $ta_blit_to_string
+         (param (ref extern)) (param i32) (param (ref $string)) (param i32)
+         (param i32)))
    (import "hash" "caml_hash_mix_int"
       (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
 
@@ -202,7 +210,7 @@
       (param $str1 (ref eq)) (param $vpos1 (ref eq))
       (param $ba2 (ref eq)) (param $vpos2 (ref eq))
       (param $vlen (ref eq)) (result (ref eq))
-      (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
+      (local $pos1 i32) (local $pos2 i32) (local $len i32)
       (local $s1 (ref $string))
       (local $d2 (ref extern))
       (local.set $s1 (ref.cast (ref $string) (local.get $str1)))
@@ -210,23 +218,17 @@
       (local.set $d2 (call $caml_ba_get_data (local.get $ba2)))
       (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $len))
-            (then
-               (call $ta_set_ui8 (local.get $d2)
-                  (i32.add (local.get $pos2) (local.get $i))
-                  (ref.i31
-                     (array.get_u $string (local.get $s1)
-                        (i32.add (local.get $pos1) (local.get $i)))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (call $ta_blit_from_string
+         (local.get $s1) (local.get $pos1)
+         (local.get $d2) (local.get $pos2)
+         (local.get $len))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_bigstring_blit_ba_to_bytes")
       (param $ba1 (ref eq)) (param $vpos1 (ref eq))
       (param $str2 (ref eq)) (param $vpos2 (ref eq))
       (param $vlen (ref eq)) (result (ref eq))
-      (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32)
+      (local $pos1 i32) (local $pos2 i32) (local $len i32)
       (local $d1 (ref extern))
       (local $s2 (ref $string))
       (local.set $d1 (call $caml_ba_get_data (local.get $ba1)))
@@ -234,15 +236,10 @@
       (local.set $s2 (ref.cast (ref $string) (local.get $str2)))
       (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2))))
       (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $len))
-            (then
-               (array.set $string (local.get $s2)
-                  (i32.add (local.get $pos2) (local.get $i))
-                  (call $ta_get_ui8 (local.get $d1)
-                     (i32.add (local.get $pos1) (local.get $i))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (call $ta_blit_to_string
+         (local.get $d1) (local.get $pos1)
+         (local.get $s2) (local.get $pos2)
+         (local.get $len))
       (ref.i31 (i32.const 0)))
 
    (func (export "caml_bigstring_blit_ba_to_ba")
diff --git a/runtime/wasm/deps.json b/runtime/wasm/deps.json
index 42b8150fcf..c06b08f8aa 100644
--- a/runtime/wasm/deps.json
+++ b/runtime/wasm/deps.json
@@ -1,7 +1,7 @@
 [
   {
     "name": "root",
-    "reaches": ["init", "exn", "mem", "strings"],
+    "reaches": ["init", "exn", "mem", "strings", "string_get", "string_set"],
     "root": true
   },
   {
@@ -20,6 +20,14 @@
     "name": "strings",
     "export": "caml_extract_string"
   },
+  {
+    "name": "string_get",
+    "export": "string_get"
+  },
+  {
+    "name": "string_set",
+    "export": "string_set"
+  },
   {
     "name": "callback",
     "export": "caml_callback"
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index 01fd089fc2..e5b523c8cf 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -56,6 +56,14 @@
       (func $ta_set_ui8 (param (ref extern)) (param i32) (param i32))) ;; ZZZ ??
    (import "bindings" "ta_get_ui8"
       (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32)))
+   (import "bindings" "ta_blit_from_string"
+      (func $ta_blit_from_string
+         (param (ref $string)) (param i32) (param (ref extern)) (param i32)
+         (param i32)))
+   (import "bindings" "ta_blit_to_string"
+      (func $ta_blit_to_string
+         (param (ref extern)) (param i32) (param (ref $string)) (param i32)
+         (param i32)))
    (import "custom" "custom_compare_id"
       (func $custom_compare_id
         (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
@@ -330,20 +338,6 @@
          (i64.add (local.get $offset) (i64.extend_i32_u (local.get $n))))
       (local.get $n))
 
-   (func $copy_from_buffer
-      (param $buf (ref extern)) (param $curr i32)
-      (param $s (ref $string)) (param $pos i32) (param $len i32)
-      (local $i i32)
-      (loop $loop
-        (if (i32.lt_u (local.get $i) (local.get $len))
-           (then
-              (array.set $string (local.get $s)
-                 (i32.add (local.get $pos) (local.get $i))
-                 (call $ta_get_ui8 (local.get $buf)
-                    (i32.add (local.get $curr) (local.get $i))))
-              (local.set $i (i32.add (local.get $i) (i32.const 1)))
-              (br $loop)))))
-
    (func $caml_refill (param $ch (ref $channel)) (result i32)
       (local $n i32)
       (local $buf (ref extern))
@@ -374,7 +368,7 @@
          (then
             (if (i32.gt_u (local.get $len) (local.get $avail))
                (then (local.set $len (local.get $avail))))
-            (call $copy_from_buffer
+            (call $ta_blit_to_string
                (struct.get $channel $buffer (local.get $ch))
                (struct.get $channel $curr (local.get $ch))
                (local.get $s) (local.get $pos)
@@ -389,7 +383,7 @@
       (struct.set $channel $max (local.get $ch) (local.get $nread))
       (if (i32.gt_u (local.get $len) (local.get $nread))
          (then (local.set $len (local.get $nread))))
-      (call $copy_from_buffer
+      (call $ta_blit_to_string
          (struct.get $channel $buffer (local.get $ch))
          (i32.const 0)
          (local.get $s) (local.get $pos)
@@ -445,7 +439,7 @@
                   (local.set $curr (i32.const 0))
                   (if (i32.gt_u (local.get $len) (local.get $nread))
                      (then (local.set $len (local.get $nread))))))))
-      (call $copy_from_buffer
+      (call $ta_blit_to_string
          (local.get $buf) (local.get $curr)
          (local.get $s) (local.get $pos) (local.get $len))
       (struct.set $channel $curr (local.get $ch)
@@ -730,7 +724,7 @@
    (func $caml_putblock
       (param $ch (ref $channel)) (param $s (ref $string)) (param $pos i32)
       (param $len i32) (result i32)
-      (local $free i32) (local $curr i32) (local $i i32)
+      (local $free i32) (local $curr i32)
       (local $buf (ref extern))
       (local.set $curr (struct.get $channel $curr (local.get $ch)))
       (local.set $free
@@ -738,15 +732,9 @@
       (if (i32.ge_u (local.get $len) (local.get $free))
          (then (local.set $len (local.get $free))))
       (local.set $buf (struct.get $channel $buffer (local.get $ch)))
-      (loop $loop
-         (if (i32.lt_u (local.get $i) (local.get $len))
-            (then
-               (call $ta_set_ui8 (local.get $buf)
-                  (i32.add (local.get $curr) (local.get $i))
-                  (array.get_u $string (local.get $s)
-                     (i32.add (local.get $pos) (local.get $i))))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
+      (call $ta_blit_from_string
+         (local.get $s) (local.get $pos)
+         (local.get $buf) (local.get $curr) (local.get $len))
       (struct.set $channel $curr (local.get $ch)
          (i32.add (local.get $curr) (local.get $len)))
       (if (i32.ge_u (local.get $len) (local.get $free))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 93f7a5d911..2a0d73f489 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -222,6 +222,12 @@
     ta_copy: (ta, t, s, n) => ta.copyWithin(t, s, n),
     ta_bytes: (a) =>
       new Uint8Array(a.buffer, a.byteOffset, a.length * a.BYTES_PER_ELEMENT),
+    ta_blit_from_string: (s, p1, a, p2, l) => {
+      for (let i = 0; i < l; i++) a[p2 + i] = string_get(s, p1 + i);
+    },
+    ta_blit_to_string: (a, p1, s, p2, l) => {
+      for (let i = 0; i < l; i++) string_set(s, p2 + i, a[p1 + i]);
+    },
     wrap_callback: (f) =>
       function () {
         var n = arguments.length;
@@ -537,6 +543,8 @@
     caml_handle_uncaught_exception,
     caml_buffer,
     caml_extract_string,
+    string_get,
+    string_set,
     _initialize,
   } = wasmModule.instance.exports;
 

From 4206f85b8545096d48cd7c27a9bd5579a7f56237 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 21 Oct 2024 15:47:05 +0200
Subject: [PATCH 395/481] Add --linkall option for compatibility with
 Js_of_ocaml

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index 9579d7a1fe..7ea4eaed4b 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -71,6 +71,10 @@ let options =
     let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in
     Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc)
   in
+  let linkall =
+    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    Arg.(value & flag & info [ "linkall" ] ~doc)
+  in
   let no_sourcemap =
     let doc = "Disable sourcemap output." in
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
@@ -104,6 +108,7 @@ let options =
       set_param
       include_dirs
       profile
+      _
       sourcemap
       no_sourcemap
       sourcemap_don't_inline_content
@@ -149,6 +154,7 @@ let options =
       $ set_param
       $ include_dirs
       $ profile
+      $ linkall
       $ sourcemap
       $ no_sourcemap
       $ sourcemap_don't_inline_content

From a4e7b0528881649cf05d6de0bac460ec1225553f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 21 Oct 2024 15:49:18 +0200
Subject: [PATCH 396/481] Source maps: fix documentation of command line
 arguments

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index 7ea4eaed4b..bb66364437 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -175,11 +175,13 @@ let options_runtime_only =
     Arg.(required & opt (some string) None & info [ "o" ] ~docv:"FILE" ~doc)
   in
   let no_sourcemap =
-    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    let doc =
+      "Don't generate source map. All other source map related flags will be be ignored."
+    in
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
   in
   let sourcemap =
-    let doc = "Currently ignored (for compatibility with Js_of_ocaml)." in
+    let doc = "Generate source map." in
     Arg.(value & flag & info [ "sourcemap"; "source-map"; "source-map-inline" ] ~doc)
   in
   let sourcemap_don't_inline_content =

From 886b6b25367d30d2a19e13386efae1bb29ca2c5b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 23 Oct 2024 11:20:15 +0200
Subject: [PATCH 397/481] Test float record with dead field

---
 compiler/tests-wasm_of_ocaml/dune     | 14 ++++++++++++--
 compiler/tests-wasm_of_ocaml/gh107.ml | 11 +++++++++++
 2 files changed, 23 insertions(+), 2 deletions(-)
 create mode 100644 compiler/tests-wasm_of_ocaml/gh107.ml

diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune
index 3d99da815c..c75ed2d21d 100644
--- a/compiler/tests-wasm_of_ocaml/dune
+++ b/compiler/tests-wasm_of_ocaml/dune
@@ -1,8 +1,8 @@
 (executables
- (names gh38 gh46)
+ (names gh38 gh46 gh107)
  (modes js)
  (js_of_ocaml
-  (flags :standard --disable optcall)))
+  (flags :standard --disable optcall --no-inline)))
 
 (rule
  (target gh38.actual)
@@ -23,3 +23,13 @@
   (with-outputs-to
    %{target}
    (run node %{dep:gh46.bc.js}))))
+
+(rule
+ (target gh107.actual)
+ (enabled_if
+  (= %{profile} wasm))
+ (alias runtest)
+ (action
+  (with-outputs-to
+   %{target}
+   (run node %{dep:gh107.bc.js}))))
diff --git a/compiler/tests-wasm_of_ocaml/gh107.ml b/compiler/tests-wasm_of_ocaml/gh107.ml
new file mode 100644
index 0000000000..21f42c725d
--- /dev/null
+++ b/compiler/tests-wasm_of_ocaml/gh107.ml
@@ -0,0 +1,11 @@
+[@@@warning "-69"]
+
+type t =
+  { x : float
+  ; y : float
+  }
+
+let () =
+  let f x = { x; y = 2. } in
+  let x = f 1. in
+  Format.eprintf "%f@." x.y

From 0b432e7718707db9e63de83e255c996e9c5983e8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 23 Oct 2024 10:56:20 +0200
Subject: [PATCH 398/481] Fix bad interaction of deadcode elimination and
 unboxed float records

When one of the fields is not used, we fill it with the float value 0.
rather than using the generic placeholder `(ref.i31 (i32.const 0))`,
which does not make sense.
---
 compiler/bin-wasm_of_ocaml/compile.ml | 18 +++++++++++++++---
 compiler/lib/wasm/wa_curry.ml         |  8 +++++++-
 compiler/lib/wasm/wa_gc_target.ml     | 12 +++++++-----
 compiler/lib/wasm/wa_generate.ml      | 22 +++++++++++++++++-----
 compiler/lib/wasm/wa_generate.mli     |  1 +
 compiler/lib/wasm/wa_target_sig.ml    |  5 ++++-
 6 files changed, 51 insertions(+), 15 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 5448f089ad..e97c643759 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -146,7 +146,9 @@ let generate_prelude ~out_file =
     | Some p -> p
     | None -> assert false
   in
-  let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ~profile code in
+  let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
+    Driver.optimize ~profile code
+  in
   let context = Wa_generate.start () in
   let debug = Parse_bytecode.Debug.create ~include_cmis:false false in
   let _ =
@@ -155,6 +157,7 @@ let generate_prelude ~out_file =
       ~unit_name:(Some "prelude")
       ~live_vars:variable_uses
       ~in_cps
+      ~deadcode_sentinal
       ~debug
       program
   in
@@ -305,11 +308,20 @@ let run
       | None, Some p -> p
       | None, None -> assert false
     in
-    let Driver.{ program; variable_uses; in_cps; _ } = Driver.optimize ~profile code in
+    let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
+      Driver.optimize ~profile code
+    in
     let context = Wa_generate.start () in
     let debug = one.debug in
     let toplevel_name, generated_js =
-      Wa_generate.f ~context ~unit_name ~live_vars:variable_uses ~in_cps ~debug program
+      Wa_generate.f
+        ~context
+        ~unit_name
+        ~live_vars:variable_uses
+        ~in_cps
+        ~deadcode_sentinal
+        ~debug
+        program
     in
     if standalone then Wa_generate.add_start_function ~context toplevel_name;
     Wa_generate.output ch ~context ~debug;
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index e689ca6b6b..1224b37a97 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -257,7 +257,13 @@ module Make (Target : Wa_target_sig.S) = struct
         (fun ~typ closure ->
           let* l = expression_list load l in
           call ?typ ~cps:true ~arity closure l)
-        (let* args = Memory.allocate ~tag:0 (List.map ~f:(fun x -> `Var x) (List.tl l)) in
+        (let* args =
+           (* We don't need the deadcode sentinal when the tag is 0 *)
+           Memory.allocate
+             ~tag:0
+             ~deadcode_sentinal:(Code.Var.fresh ())
+             (List.map ~f:(fun x -> `Var x) (List.tl l))
+         in
          let* make_iterator =
            register_import ~name:"caml_apply_continuation" (Fun (func_type 0))
          in
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 262d14d4b5..576cf00b10 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -656,16 +656,18 @@ module Memory = struct
     let* ty = Type.float_type in
     wasm_struct_get ty (wasm_cast ty e) 0
 
-  let allocate ~tag l =
+  let allocate ~tag ~deadcode_sentinal l =
     if tag = 254
     then
       let* l =
         expression_list
           (fun v ->
-            unbox_float
-              (match v with
-              | `Var y -> load y
-              | `Expr e -> return e))
+            match v with
+            | `Var y ->
+                if Code.Var.equal y deadcode_sentinal
+                then return (W.Const (F64 0.))
+                else unbox_float (load y)
+            | `Expr e -> unbox_float (return e))
           l
       in
       let* ty = Type.float_array_type in
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index be77eb246b..738a1b8bc7 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -32,6 +32,7 @@ module Generate (Target : Wa_target_sig.S) = struct
   type ctx =
     { live : int array
     ; in_cps : Effects.in_cps
+    ; deadcode_sentinal : Var.t
     ; blocks : block Addr.Map.t
     ; closures : Wa_closure_conversion.closure Var.Map.t
     ; global_context : Wa_code_generation.context
@@ -209,7 +210,10 @@ module Generate (Target : Wa_target_sig.S) = struct
         let* closure = load f in
         return (W.Call (apply, args @ [ closure ]))
     | Block (tag, a, _, _) ->
-        Memory.allocate ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
+        Memory.allocate
+          ~deadcode_sentinal:ctx.deadcode_sentinal
+          ~tag
+          (List.map ~f:(fun x -> `Var x) (Array.to_list a))
     | Field (x, n, Non_float) -> Memory.field (load x) n
     | Field (x, n, Float) ->
         Memory.float_array_get
@@ -633,7 +637,7 @@ module Generate (Target : Wa_target_sig.S) = struct
                     l
                     ~init:(return [])
                 in
-                Memory.allocate ~tag:0 l
+                Memory.allocate ~tag:0 ~deadcode_sentinal:ctx.deadcode_sentinal l
             | Extern name, l -> (
                 let name = Primitive.resolve name in
                 try
@@ -1088,6 +1092,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     ~should_export
     ~warn_on_unhandled_effect
 *)
+      ~deadcode_sentinal
       ~debug =
     global_context.unit_name <- unit_name;
     let p, closures = Wa_closure_conversion.f p in
@@ -1095,7 +1100,14 @@ module Generate (Target : Wa_target_sig.S) = struct
   Code.Print.program (fun _ _ -> "") p;
 *)
     let ctx =
-      { live = live_vars; in_cps; blocks = p.blocks; closures; global_context; debug }
+      { live = live_vars
+      ; in_cps
+      ; deadcode_sentinal
+      ; blocks = p.blocks
+      ; closures
+      ; global_context
+      ; debug
+      }
     in
     let toplevel_name = Var.fresh_n "toplevel" in
     let functions =
@@ -1198,10 +1210,10 @@ let fix_switch_branches p =
 
 let start () = make_context ~value_type:Wa_gc_target.Value.value
 
-let f ~context ~unit_name p ~live_vars ~in_cps ~debug =
+let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~debug =
   let p = if Config.Flag.effects () then fix_switch_branches p else p in
   let module G = Generate (Wa_gc_target) in
-  G.f ~context ~unit_name ~live_vars ~in_cps ~debug p
+  G.f ~context ~unit_name ~live_vars ~in_cps ~deadcode_sentinal ~debug p
 
 let add_start_function =
   let module G = Generate (Wa_gc_target) in
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index 836a6393d3..e376410fb4 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -26,6 +26,7 @@ val f :
   -> Code.program
   -> live_vars:int array
   -> in_cps:Effects.in_cps
+  -> deadcode_sentinal:Code.Var.t
   -> debug:Parse_bytecode.Debug.t
   -> Wa_ast.var * (string list * (string * Javascript.expression) list)
 
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 422720ed06..83ece707c3 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -21,7 +21,10 @@ module type S = sig
 
   module Memory : sig
     val allocate :
-      tag:int -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list -> expression
+         tag:int
+      -> deadcode_sentinal:Code.Var.t
+      -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list
+      -> expression
 
     val load_function_pointer :
          cps:bool

From 7a1d85c9b3df0b933f60bba4060000b3b6a52cd2 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 10 Oct 2024 11:02:25 +0200
Subject: [PATCH 399/481] Tests: more test for float conv

---
 compiler/tests-jsoo/test_floats.ml | 34 +++++++++++++++++++++++++++---
 1 file changed, 31 insertions(+), 3 deletions(-)

diff --git a/compiler/tests-jsoo/test_floats.ml b/compiler/tests-jsoo/test_floats.ml
index b67e1fe224..3e19c7d8c9 100644
--- a/compiler/tests-jsoo/test_floats.ml
+++ b/compiler/tests-jsoo/test_floats.ml
@@ -177,10 +177,38 @@ let%expect_test "log2" =
   p 1024.0;
   [%expect {| 10.000000 |}]
 
+let print' f = try print (f ()) with e -> print_endline (Printexc.to_string e)
+
 let%expect_test "of_string" =
   let x = "0x1.1" in
-  print (float_of_string x);
+  print' (fun () -> float_of_string x);
   [%expect {| 1.062500 |}];
   let x = "0x1.1p-1" in
-  print (float_of_string x);
-  [%expect {| 0.531250 |}]
+  print' (fun () -> float_of_string x);
+  [%expect {| 0.531250 |}];
+  let x = "  0x1.1" in
+  print' (fun () -> float_of_string x);
+  [%expect {| 1.062500 |}];
+  let x = "  0x1.1 " in
+  print' (fun () -> float_of_string x);
+  [%expect {| Failure("float_of_string") |}];
+  let x = "0x1.1 p-1" in
+  print' (fun () -> float_of_string x);
+  [%expect {| Failure("float_of_string") |}]
+
+let%expect_test "of_string" =
+  let x = "3.14" in
+  print' (fun () -> float_of_string x);
+  [%expect {| 3.140000 |}];
+  let x = " 3.14" in
+  print' (fun () -> float_of_string x);
+  [%expect {| 3.140000 |}];
+  let x = "3. 14" in
+  print' (fun () -> float_of_string x);
+  [%expect {| Failure("float_of_string") |}];
+  let x = "3.1 4" in
+  print' (fun () -> float_of_string x);
+  [%expect {| Failure("float_of_string") |}];
+  let x = "3.14 " in
+  print' (fun () -> float_of_string x);
+  [%expect {| Failure("float_of_string") |}]

From aede507d2dc75564d1ce88671ba40efb30500f69 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Thu, 10 Oct 2024 14:36:30 +0200
Subject: [PATCH 400/481] Runtime: make float_of_string strict

---
 runtime/ieee_754.js | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/runtime/ieee_754.js b/runtime/ieee_754.js
index d890101b19..09c41b0375 100644
--- a/runtime/ieee_754.js
+++ b/runtime/ieee_754.js
@@ -567,13 +567,16 @@ function caml_format_float(fmt, x) {
 //Requires: caml_failwith, caml_jsbytes_of_string
 function caml_float_of_string(s) {
   var res;
+  var r_float = /^ *[-+]?(?:\d*\.?\d+|\d+\.?\d*)(?:[eE][-+]?\d+)?$/;
   s = caml_jsbytes_of_string(s);
   res = +s;
-  if (s.length > 0 && res === res) return res;
+  //Fast path
+  if (!Number.isNaN(res) && r_float.test(s)) return res;
   s = s.replace(/_/g, "");
   res = +s;
-  if ((s.length > 0 && res === res) || /^[+-]?nan$/i.test(s)) return res;
-  var m = /^ *([+-]?)0x([0-9a-f]+)\.?([0-9a-f]*)(p([+-]?[0-9]+))?/i.exec(s);
+  if ((!Number.isNaN(res) && r_float.test(s)) || /^[+-]?nan$/i.test(s))
+    return res;
+  var m = /^ *([+-]?)0x([0-9a-f]+)\.?([0-9a-f]*)(p([+-]?[0-9]+))?$/i.exec(s);
   //          1        2             3           5
   if (m) {
     var m3 = m[3].replace(/0+$/, "");

From 48c22c6516151f9c02c54cea0c27e118e4ef2e2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 24 Oct 2024 11:36:09 +0200
Subject: [PATCH 401/481] Stricter float_of_string

---
 runtime/wasm/float.wat | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
index 95a3759aea..50e0b200d0 100644
--- a/runtime/wasm/float.wat
+++ b/runtime/wasm/float.wat
@@ -483,6 +483,12 @@
          (array.new_data $string $float_of_string (i32.const 0) (i32.const 15)))
       (f64.const 0))
 
+   (func $on_whitespace (param $s (ref $string)) (param $i i32) (result i32)
+      (local $c i32)
+      (local.set $c (array.get_u $string (local.get $s) (local.get $i)))
+      (i32.or (i32.eq (local.get $c) (i32.const 32)) ;; ' '
+         (i32.le_u (i32.sub (local.get $c) (i32.const 9)) (i32.const 4))))
+
    (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq))
       (local $s (ref $string)) (local $len i32) (local $i i32) (local $j i32)
       (local $s' (ref $string))
@@ -525,13 +531,15 @@
       (loop $skip_spaces
          (if (i32.lt_u (local.get $i) (local.get $len))
             (then
-               (if (i32.eq (i32.const 32) ;; ' '
-                           (array.get_u $string (local.get $s) (local.get $i)))
+               (if (call $on_whitespace (local.get $s) (local.get $i))
                   (then
                      (local.set $i (i32.add (local.get $i) (i32.const 1)))
                      (br $skip_spaces))))))
       (block $error
          (br_if $error (i32.eq (local.get $i) (local.get $len)))
+         (br_if $error
+            (call $on_whitespace
+               (local.get $s) (i32.sub (local.get $len) (i32.const 1))))
          (local.set $c (array.get_u $string (local.get $s) (i32.const 0)))
          (if (i32.eq (local.get $c) (i32.const 45)) ;; '-'
             (then

From 3698fe45911fddeadcf15181212681abf8285094 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 18 Oct 2024 10:42:19 +0200
Subject: [PATCH 402/481] JavaScript if statement simplification: use
 appropriate locations

---
 compiler/lib/js_simpl.ml                   |  11 +-
 compiler/tests-full/stdlib.cma.expected.js | 123 +++++++++++----------
 2 files changed, 67 insertions(+), 67 deletions(-)

diff --git a/compiler/lib/js_simpl.ml b/compiler/lib/js_simpl.ml
index efdb3137db..463406ed14 100644
--- a/compiler/lib/js_simpl.ml
+++ b/compiler/lib/js_simpl.ml
@@ -252,9 +252,9 @@ let if_statement e loc iftrue truestop iffalse falsestop =
   let e = simplify_condition e in
   match iftrue, iffalse with
   (* Shared statements *)
-  | (J.If_statement (e', iftrue', iffalse'), loc), _ when Poly.(iffalse = unopt iffalse')
-    -> if_statement_2 (J.EBin (J.And, e, e')) loc iftrue' truestop iffalse falsestop
-  | (J.If_statement (e', iftrue', iffalse'), loc), _ when Poly.(iffalse = iftrue') ->
+  | (J.If_statement (e', iftrue', iffalse'), _), _ when Poly.(iffalse = unopt iffalse') ->
+      if_statement_2 (J.EBin (J.And, e, e')) loc iftrue' truestop iffalse falsestop
+  | (J.If_statement (e', iftrue', iffalse'), _), _ when Poly.(iffalse = iftrue') ->
       if_statement_2
         (J.EBin (J.And, e, J.EUn (J.Not, e')))
         loc
@@ -262,10 +262,9 @@ let if_statement e loc iftrue truestop iffalse falsestop =
         truestop
         iffalse
         falsestop
-  | _, (J.If_statement (e', iftrue', iffalse'), loc) when Poly.(iftrue = iftrue') ->
+  | _, (J.If_statement (e', iftrue', iffalse'), _) when Poly.(iftrue = iftrue') ->
       if_statement_2 (J.EBin (J.Or, e, e')) loc iftrue truestop (unopt iffalse') falsestop
-  | _, (J.If_statement (e', iftrue', iffalse'), loc) when Poly.(iftrue = unopt iffalse')
-    ->
+  | _, (J.If_statement (e', iftrue', iffalse'), _) when Poly.(iftrue = unopt iffalse') ->
       if_statement_2
         (J.EBin (J.Or, e, J.EUn (J.Not, e')))
         loc
diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js
index 254b13f11a..03bf177f2f 100644
--- a/compiler/tests-full/stdlib.cma.expected.js
+++ b/compiler/tests-full/stdlib.cma.expected.js
@@ -1243,14 +1243,15 @@
    function of_val(x){
      /*<<obj.ml:75:4>>*/ a:
     {
-     if
+      /*<<obj.ml:77:9>>*/ if
       (is_block(x)
        &&  /*<<obj.ml:77:25>>*/ caml_obj_tag(x) !== 248 && 1 <= x.length - 1){var slot = x[1]; break a;}
      var slot = x;
     }
     a:
     {
-     if(is_block(slot) &&  /*<<obj.ml:81:28>>*/ caml_obj_tag(slot) === 248){var name = slot[1]; break a;}
+      /*<<obj.ml:81:9>>*/ if
+      (is_block(slot) &&  /*<<obj.ml:81:28>>*/ caml_obj_tag(slot) === 248){var name = slot[1]; break a;}
      var
       name =
          /*<<obj.ml:82:11>>*/ caml_call1
@@ -5148,8 +5149,7 @@
      /*<<bytes.ml:161:10>>*/  /*<<bytes.ml:161:10>>*/ var
      j = [0, len - 1 | 0];
     for(;;){
-      /*<<bytes.ml:162:20>>*/ if
-      (i[1] <= j[1] && is_space(caml_bytes_unsafe_get(s, j[1]))){j[1]--; continue;}
+     if(i[1] <= j[1] && is_space(caml_bytes_unsafe_get(s, j[1]))){j[1]--; continue;}
      return i[1] <= j[1] ? sub(s, i[1], (j[1] - i[1] | 0) + 1 | 0) : empty;
     }
     /*<<bytes.ml:168:9>>*/ }
@@ -5459,13 +5459,14 @@
     /*<<bytes.ml:324:50>>*/ }
    function index_from(s, i, c){
      /*<<bytes.ml:328:2>>*/ var l = caml_ml_bytes_length(s);
-    if(0 <= i && l >= i)  /*<<bytes.ml:330:2>>*/ return index_rec(s, l, i, c);
+     /*<<bytes.ml:329:2>>*/ if(0 <= i && l >= i)
+      /*<<bytes.ml:330:2>>*/ return index_rec(s, l, i, c);
      /*<<bytes.ml:329:25>>*/ return  /*<<bytes.ml:329:25>>*/ caml_call1
             (Stdlib[1], cst_String_index_from_Bytes_in);
     /*<<bytes.ml:330:19>>*/ }
    function index_from_opt(s, i, c){
      /*<<bytes.ml:334:2>>*/ var l = caml_ml_bytes_length(s);
-    if(0 <= i && l >= i)
+     /*<<bytes.ml:335:2>>*/ if(0 <= i && l >= i)
       /*<<bytes.ml:338:4>>*/ return index_rec_opt(s, l, i, c);
      /*<<bytes.ml:336:4>>*/ return  /*<<bytes.ml:336:4>>*/ caml_call1
             (Stdlib[1], cst_String_index_from_opt_Byte);
@@ -5514,7 +5515,7 @@
     /*<<bytes.ml:368:24>>*/ }
    function contains_from(s, i, c){
      /*<<bytes.ml:373:2>>*/ var l = caml_ml_bytes_length(s);
-    if(0 <= i && l >= i)
+     /*<<bytes.ml:374:2>>*/ if(0 <= i && l >= i)
       /*<<bytes.ml:377:4>>*/ try{
        /*<<bytes.ml:377:15>>*/ index_rec(s, l, i, c);
        /*<<bytes.ml:377:36>>*/  /*<<bytes.ml:377:36>>*/ var _K_ = 1;
@@ -6031,7 +6032,7 @@
           case 0:
             /*<<bytes.ml:708:8>>*/  /*<<bytes.ml:708:8>>*/ var
             last = i + 2 | 0;
-            /*<<bytes.ml:711:11>>*/ if
+           if
             (max >= last
              &&
               !
@@ -6046,7 +6047,7 @@
           case 3:
             /*<<bytes.ml:715:8>>*/  /*<<bytes.ml:715:8>>*/ var
             last$1 = i + 3 | 0;
-            /*<<bytes.ml:719:11>>*/ if
+           if
             (max >= last$1
              &&
               !
@@ -6064,7 +6065,7 @@
           case 7:
             /*<<bytes.ml:731:8>>*/  /*<<bytes.ml:731:8>>*/ var
             last$3 = i + 3 | 0;
-            /*<<bytes.ml:735:11>>*/ if
+           if
             (max >= last$3
              &&
               !
@@ -6084,7 +6085,7 @@
           default:
             /*<<bytes.ml:723:8>>*/  /*<<bytes.ml:723:8>>*/ var
             last$2 = i + 3 | 0;
-            /*<<bytes.ml:727:11>>*/ if
+           if
             (max >= last$2
              &&
               !
@@ -6104,7 +6105,7 @@
        else if(225 > match){
          /*<<bytes.ml:694:8>>*/  /*<<bytes.ml:694:8>>*/ var
          last$4 = i + 2 | 0;
-         /*<<bytes.ml:697:11>>*/ if
+        if
          (max >= last$4
           &&
            !
@@ -6118,7 +6119,7 @@
          /*<<bytes.ml:698:13>>*/ return 0;
        }
         /*<<bytes.ml:701:8>>*/  /*<<bytes.ml:701:8>>*/ var last$0 = i + 2 | 0;
-        /*<<bytes.ml:704:11>>*/ if
+       if
         (max >= last$0
          &&
           !
@@ -6138,7 +6139,7 @@
       }
       if(194 <= match){
         /*<<bytes.ml:688:8>>*/  /*<<bytes.ml:688:8>>*/ var last$5 = i + 1 | 0;
-        /*<<bytes.ml:690:11>>*/ if
+       if
         (max >= last$5
          && ! not_in_x80_to_xBF(caml_bytes_unsafe_get(b, last$5))){
          /*<<bytes.ml:692:13>>*/  /*<<bytes.ml:692:13>>*/ var
@@ -6155,13 +6156,13 @@
    function get_utf_16be_uchar(b, i){
      /*<<bytes.ml:745:2>>*/  /*<<bytes.ml:746:2>>*/ var
      max =  /*<<bytes.ml:746:2>>*/ caml_ml_bytes_length(b) - 1 | 0;
-    if(0 <= i && max >= i){
+     /*<<bytes.ml:747:2>>*/ if(0 <= i && max >= i){
      if(i === max)
        /*<<bytes.ml:748:18>>*/ return  /*<<bytes.ml:748:18>>*/ caml_call1
               (dec_invalid, 1);
       /*<<bytes.ml:749:8>>*/  /*<<bytes.ml:749:8>>*/ var
       hi = unsafe_get_uint16_be(b, i);
-     if(55296 <= hi && 57343 >= hi){
+      /*<<bytes.ml:750:11>>*/ if(55296 <= hi && 57343 >= hi){
        /*<<bytes.ml:751:11>>*/ if(56319 < hi)
         /*<<bytes.ml:751:25>>*/ return  /*<<bytes.ml:751:25>>*/ caml_call1
                (dec_invalid, 2);
@@ -6169,7 +6170,7 @@
       if(max < last) return caml_call1(dec_invalid, (max - i | 0) + 1 | 0);
        /*<<bytes.ml:755:12>>*/  /*<<bytes.ml:755:12>>*/ var
        lo = unsafe_get_uint16_be(b, i + 2 | 0);
-      if(56320 <= lo && 57343 >= lo){
+       /*<<bytes.ml:756:15>>*/ if(56320 <= lo && 57343 >= lo){
        var u = ((hi & 1023) << 10 | lo & 1023) + 65536 | 0;
         /*<<bytes.ml:759:10>>*/ return dec_ret(4, u);
       }
@@ -6184,7 +6185,7 @@
    function set_utf_16be_uchar(b, i, u){
      /*<<bytes.ml:762:2>>*/  /*<<bytes.ml:763:2>>*/ var
      max =  /*<<bytes.ml:763:2>>*/ caml_ml_bytes_length(b) - 1 | 0;
-    if(0 <= i && max >= i){
+     /*<<bytes.ml:764:2>>*/ if(0 <= i && max >= i){
       /*<<bytes.ml:765:8>>*/  /*<<bytes.ml:765:8>>*/ var
       u$0 =  /*<<bytes.ml:765:8>>*/ caml_call1(Stdlib_Uchar[10], u);
       /*<<bytes.ml:766:11>>*/ if(0 > u$0)
@@ -6217,14 +6218,14 @@
      if(i === max)  /*<<bytes.ml:783:20>>*/ return 0;
       /*<<bytes.ml:784:10>>*/  /*<<bytes.ml:784:10>>*/ var
       u = unsafe_get_uint16_be(b, i);
-     if(55296 <= u && 57343 >= u){
+      /*<<bytes.ml:785:13>>*/ if(55296 <= u && 57343 >= u){
        /*<<bytes.ml:786:13>>*/ if(56319 < u)
         /*<<bytes.ml:786:27>>*/ return 0;
        /*<<bytes.ml:788:8>>*/  /*<<bytes.ml:788:8>>*/ var last = i + 3 | 0;
       if(max < last)  /*<<bytes.ml:789:27>>*/ return 0;
        /*<<bytes.ml:790:14>>*/  /*<<bytes.ml:790:14>>*/ var
        u$0 = unsafe_get_uint16_be(b, i + 2 | 0);
-      if(56320 <= u$0 && 57343 >= u$0){
+       /*<<bytes.ml:791:17>>*/ if(56320 <= u$0 && 57343 >= u$0){
         /*<<bytes.ml:792:17>>*/  /*<<bytes.ml:792:17>>*/ var i$1 = i + 4 | 0;
        i = i$1;
        continue;
@@ -6238,13 +6239,13 @@
    function get_utf_16le_uchar(b, i){
      /*<<bytes.ml:799:2>>*/  /*<<bytes.ml:800:2>>*/ var
      max =  /*<<bytes.ml:800:2>>*/ caml_ml_bytes_length(b) - 1 | 0;
-    if(0 <= i && max >= i){
+     /*<<bytes.ml:801:2>>*/ if(0 <= i && max >= i){
      if(i === max)
        /*<<bytes.ml:802:18>>*/ return  /*<<bytes.ml:802:18>>*/ caml_call1
               (dec_invalid, 1);
       /*<<bytes.ml:803:8>>*/  /*<<bytes.ml:803:8>>*/ var
       hi = unsafe_get_uint16_le(b, i);
-     if(55296 <= hi && 57343 >= hi){
+      /*<<bytes.ml:804:11>>*/ if(55296 <= hi && 57343 >= hi){
        /*<<bytes.ml:805:11>>*/ if(56319 < hi)
         /*<<bytes.ml:805:25>>*/ return  /*<<bytes.ml:805:25>>*/ caml_call1
                (dec_invalid, 2);
@@ -6252,7 +6253,7 @@
       if(max < last) return caml_call1(dec_invalid, (max - i | 0) + 1 | 0);
        /*<<bytes.ml:809:12>>*/  /*<<bytes.ml:809:12>>*/ var
        lo = unsafe_get_uint16_le(b, i + 2 | 0);
-      if(56320 <= lo && 57343 >= lo){
+       /*<<bytes.ml:810:15>>*/ if(56320 <= lo && 57343 >= lo){
        var u = ((hi & 1023) << 10 | lo & 1023) + 65536 | 0;
         /*<<bytes.ml:813:10>>*/ return dec_ret(4, u);
       }
@@ -6267,7 +6268,7 @@
    function set_utf_16le_uchar(b, i, u){
      /*<<bytes.ml:816:2>>*/  /*<<bytes.ml:817:2>>*/ var
      max =  /*<<bytes.ml:817:2>>*/ caml_ml_bytes_length(b) - 1 | 0;
-    if(0 <= i && max >= i){
+     /*<<bytes.ml:818:2>>*/ if(0 <= i && max >= i){
       /*<<bytes.ml:819:8>>*/  /*<<bytes.ml:819:8>>*/ var
       u$0 =  /*<<bytes.ml:819:8>>*/ caml_call1(Stdlib_Uchar[10], u);
       /*<<bytes.ml:820:11>>*/ if(0 > u$0)
@@ -6300,14 +6301,14 @@
      if(i === max)  /*<<bytes.ml:837:20>>*/ return 0;
       /*<<bytes.ml:838:10>>*/  /*<<bytes.ml:838:10>>*/ var
       u = unsafe_get_uint16_le(b, i);
-     if(55296 <= u && 57343 >= u){
+      /*<<bytes.ml:839:13>>*/ if(55296 <= u && 57343 >= u){
        /*<<bytes.ml:840:13>>*/ if(56319 < u)
         /*<<bytes.ml:840:27>>*/ return 0;
        /*<<bytes.ml:842:8>>*/  /*<<bytes.ml:842:8>>*/ var last = i + 3 | 0;
       if(max < last)  /*<<bytes.ml:843:27>>*/ return 0;
        /*<<bytes.ml:844:14>>*/  /*<<bytes.ml:844:14>>*/ var
        u$0 = unsafe_get_uint16_le(b, i + 2 | 0);
-      if(56320 <= u$0 && 57343 >= u$0){
+       /*<<bytes.ml:845:17>>*/ if(56320 <= u$0 && 57343 >= u$0){
         /*<<bytes.ml:846:17>>*/  /*<<bytes.ml:846:17>>*/ var i$1 = i + 4 | 0;
        i = i$1;
        continue;
@@ -6620,7 +6621,7 @@
    function trim(s){
      /*<<string.ml:102:2>>*/ if(s == cst$0)
       /*<<string.ml:102:17>>*/ return s;
-     /*<<string.ml:103:39>>*/ if
+     /*<<string.ml:103:10>>*/ if
      (!
       is_space(caml_string_unsafe_get(s, 0))
       &&
@@ -6670,14 +6671,14 @@
     /*<<string.ml:127:50>>*/ }
    function index_from(s, i, c){
      /*<<string.ml:131:2>>*/ var l = caml_ml_string_length(s);
-    if(0 <= i && l >= i)
+     /*<<string.ml:132:2>>*/ if(0 <= i && l >= i)
       /*<<string.ml:133:4>>*/ return index_rec(s, l, i, c);
      /*<<string.ml:132:25>>*/ return  /*<<string.ml:132:25>>*/ caml_call1
             (Stdlib[1], cst_String_index_from_Bytes_in);
     /*<<string.ml:133:21>>*/ }
    function index_from_opt(s, i, c){
      /*<<string.ml:137:2>>*/ var l = caml_ml_string_length(s);
-    if(0 <= i && l >= i)
+     /*<<string.ml:138:2>>*/ if(0 <= i && l >= i)
       /*<<string.ml:141:4>>*/ return index_rec_opt(s, l, i, c);
      /*<<string.ml:139:4>>*/ return  /*<<string.ml:139:4>>*/ caml_call1
             (Stdlib[1], cst_String_index_from_opt_Byte);
@@ -6726,7 +6727,7 @@
     /*<<string.ml:171:24>>*/ }
    function contains_from(s, i, c){
      /*<<string.ml:175:2>>*/ var l = caml_ml_string_length(s);
-    if(0 <= i && l >= i)
+     /*<<string.ml:176:2>>*/ if(0 <= i && l >= i)
       /*<<string.ml:179:4>>*/ try{
        /*<<string.ml:179:15>>*/ index_rec(s, l, i, c);
        /*<<string.ml:179:36>>*/  /*<<string.ml:179:36>>*/ var _G_ = 1;
@@ -8181,7 +8182,7 @@
    function min(x, y){
      /*<<float.ml:139:2>>*/ a:
     if(! (x < y)){
-      /*<<float.ml:139:34>>*/ if
+      /*<<float.ml:139:18>>*/ if
       (!
         /*<<float.ml:139:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:139:34>>*/ caml_signbit_float(x))
@@ -8193,7 +8194,7 @@
    function max(x, y){
      /*<<float.ml:144:2>>*/ a:
     if(! (x < y)){
-      /*<<float.ml:144:34>>*/ if
+      /*<<float.ml:144:18>>*/ if
       (!
         /*<<float.ml:144:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:144:34>>*/ caml_signbit_float(x))
@@ -8206,7 +8207,7 @@
      /*<<float.ml:149:2>>*/ if(x == x && y == y){
      a:
      if(! (x < y)){
-       /*<<float.ml:150:39>>*/ if
+       /*<<float.ml:150:23>>*/ if
        (!
          /*<<float.ml:150:23>>*/ caml_signbit_float(y)
         &&  /*<<float.ml:150:39>>*/ caml_signbit_float(x))
@@ -8220,7 +8221,7 @@
    function min_num(x, y){
      /*<<float.ml:153:2>>*/ a:
     if(! (x < y)){
-      /*<<float.ml:153:34>>*/ if
+      /*<<float.ml:153:18>>*/ if
       (!
         /*<<float.ml:153:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:153:34>>*/ caml_signbit_float(x))
@@ -8232,7 +8233,7 @@
    function max_num(x, y){
      /*<<float.ml:158:2>>*/ a:
     if(! (x < y)){
-      /*<<float.ml:158:34>>*/ if
+      /*<<float.ml:158:18>>*/ if
       (!
         /*<<float.ml:158:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:158:34>>*/ caml_signbit_float(x))
@@ -8248,7 +8249,7 @@
       /*<<float.ml:164:24>>*/ return [0, x, x];
     a:
     if(! (x < y)){
-      /*<<float.ml:165:39>>*/ if
+      /*<<float.ml:165:23>>*/ if
       (!
         /*<<float.ml:165:23>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:165:39>>*/ caml_signbit_float(x))
@@ -12717,7 +12718,8 @@
       /*<<buffer.ml:65:2>>*/ match = b[1],
      length = match[2],
      buffer = match[1];
-    if(0 <= ofs && position > ofs && length >= position)
+     /*<<buffer.ml:66:2>>*/ if
+     (0 <= ofs && position > ofs && length >= position)
      return runtime.caml_bytes_unsafe_get(buffer, ofs);
      /*<<buffer.ml:67:3>>*/ return  /*<<buffer.ml:67:3>>*/ caml_call1
             (Stdlib[1], cst_Buffer_nth);
@@ -16727,7 +16729,7 @@
       default:
        a:
        if(0 < len){
-         /*<<camlinternalFormat.ml:1337:63>>*/ if
+         /*<<camlinternalFormat.ml:1337:29>>*/ if
          (43
           !==  /*<<camlinternalFormat.ml:1337:29>>*/ caml_string_get(str, 0)
           &&
@@ -16756,7 +16758,7 @@
          &&
           48
           ===  /*<<camlinternalFormat.ml:1340:28>>*/ caml_string_get(str, 0)){
-         /*<<camlinternalFormat.ml:1340:63>>*/ if
+         /*<<camlinternalFormat.ml:1340:46>>*/ if
          (120
           !==  /*<<camlinternalFormat.ml:1340:46>>*/ caml_string_get(str, 1)
           &&
@@ -16801,7 +16803,7 @@
           case 5:
            c:
            if(len < (prec$0 + 2 | 0) && 1 < len){
-             /*<<camlinternalFormat.ml:1358:60>>*/ if
+             /*<<camlinternalFormat.ml:1358:43>>*/ if
              (120
               !==
                 /*<<camlinternalFormat.ml:1358:43>>*/ caml_string_get(str, 1)
@@ -18648,7 +18650,7 @@
             match$0 = [0, [17, _O_, fmt_rest$5]];
            break a;
           case 5:
-            /*<<camlinternalFormat.ml:2626:42>>*/ if
+           if
             ((str_ind$0 + 1 | 0) < end_ind
              &&
               37
@@ -19198,8 +19200,7 @@
        /*<<camlinternalFormat.ml:2320:7>>*/ var
         /*<<camlinternalFormat.ml:2320:13>>*/ pad = get_pad(0),
         /*<<camlinternalFormat.ml:2320:25>>*/ match = get_prec(0);
-       /*<<camlinternalFormat.ml:2320:25>>*/ if
-       (typeof match === "number" && ! match)
+      if(typeof match === "number" && ! match)
         /*<<camlinternalFormat.ml:2321:32>>*/ return pad;
       if(typeof pad === "number")
         /*<<camlinternalFormat.ml:2322:32>>*/ return 0;
@@ -21676,7 +21677,7 @@
          (Stdlib_Printf[5], b, _k_, progname, s$1);
      }
       /*<<arg.ml:159:4>>*/ usage_b(b, speclist[1], errmsg);
-      /*<<arg.ml:160:34>>*/ if
+      /*<<arg.ml:160:7>>*/ if
       (!
         /*<<arg.ml:160:7>>*/ caml_equal(error, _g_)
        && !  /*<<arg.ml:160:34>>*/ caml_equal(error, _h_))
@@ -22179,7 +22180,7 @@
       var len = caml_ml_string_length(word);
       a:
       {
-        /*<<arg.ml:381:16>>*/ if
+        /*<<arg.ml:381:2>>*/ if
         (0 < len
          && 13 ===  /*<<arg.ml:381:16>>*/ caml_string_get(word, len - 1 | 0)){
         var
@@ -25023,7 +25024,7 @@
       r =
          /*<<random.ml:242:12>>*/ caml_int64_to_int32
          ( /*<<random.ml:242:27>>*/ caml_lxm_next(s));
-      /*<<random.ml:243:18>>*/ if
+      /*<<random.ml:243:7>>*/ if
       (!
         /*<<random.ml:243:7>>*/ caml_lessthan(r, min)
        && !  /*<<random.ml:243:18>>*/ caml_greaterthan(r, max))
@@ -25075,7 +25076,7 @@
      /*<<random.ml:277:4>>*/ for(;;){
       /*<<random.ml:277:12>>*/  /*<<random.ml:277:12>>*/ var
       r =  /*<<random.ml:277:12>>*/ caml_lxm_next(s);
-      /*<<random.ml:278:18>>*/ if
+      /*<<random.ml:278:7>>*/ if
       (!
         /*<<random.ml:278:7>>*/ caml_lessthan(r, min)
        && !  /*<<random.ml:278:18>>*/ caml_greaterthan(r, max))
@@ -29555,7 +29556,7 @@
     }
      /*<<scanf.ml:530:2>>*/  /*<<scanf.ml:530:2>>*/ var
      l =  /*<<scanf.ml:530:2>>*/ caml_ml_string_length(tok);
-     /*<<scanf.ml:531:14>>*/ if
+     /*<<scanf.ml:531:2>>*/ if
      (0 !== l && 43 ===  /*<<scanf.ml:531:14>>*/ caml_string_get(tok, 0))
       /*<<scanf.ml:531:43>>*/ return  /*<<scanf.ml:531:43>>*/ caml_call3
              (Stdlib_String[16], tok, 1, l - 1 | 0);
@@ -29838,7 +29839,7 @@
         /*<<scanf.ml:804:16>>*/  /*<<scanf.ml:804:16>>*/ var
         width$4 =
           check_case_insensitive_string(width$3, ib, bad_hex_float, cst_x);
-        /*<<scanf.ml:805:20>>*/ if(0 !== width$4 && ! end_of_input(ib)){
+        /*<<scanf.ml:805:4>>*/ if(0 !== width$4 && ! end_of_input(ib)){
          /*<<scanf.ml:806:24>>*/  /*<<scanf.ml:806:24>>*/ var
          _aG_ = peek_char(ib) - 46 | 0;
         b:
@@ -29856,7 +29857,7 @@
          }
          var width$5 = width$4;
         }
-         /*<<scanf.ml:809:22>>*/ if(0 !== width$5 && ! end_of_input(ib)){
+         /*<<scanf.ml:809:6>>*/ if(0 !== width$5 && ! end_of_input(ib)){
           /*<<scanf.ml:810:26>>*/  /*<<scanf.ml:810:26>>*/ var
           c$0 = peek_char(ib);
          if(46 === c$0){
@@ -29864,7 +29865,7 @@
            width$6 = store_char(width$5, ib, c$0);
           b:
           {
-            /*<<scanf.ml:813:28>>*/ if(0 !== width$6 && ! end_of_input(ib)){
+            /*<<scanf.ml:813:12>>*/ if(0 !== width$6 && ! end_of_input(ib)){
              /*<<scanf.ml:814:20>>*/  /*<<scanf.ml:814:20>>*/ var
              match = peek_char(ib);
             c:
@@ -29896,7 +29897,7 @@
          }
          else
           var width$8 = width$5;
-          /*<<scanf.ml:821:24>>*/ if(0 !== width$8 && ! end_of_input(ib)){
+          /*<<scanf.ml:821:8>>*/ if(0 !== width$8 && ! end_of_input(ib)){
            /*<<scanf.ml:822:16>>*/  /*<<scanf.ml:822:16>>*/ var
            c$1 = peek_char(ib);
           if(80 !== c$1 && 112 !== c$1)
@@ -30024,7 +30025,7 @@
           width$4 = store_char(width$10, ib, c$1);
          c:
          {
-           /*<<scanf.ml:882:26>>*/ if(0 !== width$4 && ! end_of_input(ib)){
+           /*<<scanf.ml:882:10>>*/ if(0 !== width$4 && ! end_of_input(ib)){
             /*<<scanf.ml:883:18>>*/  /*<<scanf.ml:883:18>>*/ var
             match = peek_char(ib);
            d:
@@ -30062,7 +30063,7 @@
       }
       var width$7 = width$6;
      }
-      /*<<scanf.ml:891:22>>*/ if(0 !== width$7 && ! end_of_input(ib)){
+      /*<<scanf.ml:891:6>>*/ if(0 !== width$7 && ! end_of_input(ib)){
        /*<<scanf.ml:892:14>>*/  /*<<scanf.ml:892:14>>*/ var
        c$2 = peek_char(ib);
       if(80 !== c$2 && 112 !== c$2)  /*<<scanf.ml:897:15>>*/ return width$7;
@@ -30148,7 +30149,7 @@
           | 0;
        b:
        {
-        if(0 <= c && 255 >= c){
+         /*<<scanf.ml:959:2>>*/ if(0 <= c && 255 >= c){
          var _ab_ =  /*<<scanf.ml:963:2>>*/ caml_call1(Stdlib[29], c);
          break b;
         }
@@ -30187,7 +30188,7 @@
           c$0 = (16 * hexadecimal_value_of_char(c1) | 0) + ___ | 0;
          b:
          {
-          if(0 <= c$0 && 255 >= c$0){
+           /*<<scanf.ml:986:2>>*/ if(0 <= c$0 && 255 >= c$0){
            var _aa_ =  /*<<scanf.ml:989:2>>*/ caml_call1(Stdlib[29], c$0);
            break b;
           }
@@ -32546,7 +32547,7 @@
        a:
        if(typeof shape === "number"){
         if(2 === shape){
-         if
+          /*<<camlinternalMod.ml:72:13>>*/ if
           (0 ===  /*<<camlinternalMod.ml:72:13>>*/ caml_obj_tag(n$0)
            && 4 === n$0.length - 1){
            /*<<camlinternalMod.ml:73:14>>*/ var
@@ -33367,7 +33368,7 @@
        /*<<ephemeron.ml:541:26>>*/ match$0 = get_key2(c);
      if(match && match$0){
       var k2$0 = match$0[1], k1$0 = match[1];
-       /*<<ephemeron.ml:544:34>>*/ if
+       /*<<ephemeron.ml:544:15>>*/ if
        ( /*<<ephemeron.ml:544:15>>*/ caml_call2(H1[1], k1, k1$0)
         &&  /*<<ephemeron.ml:544:34>>*/ caml_call2(H2[1], k2, k2$0))
         /*<<ephemeron.ml:545:17>>*/ return 0;
@@ -34674,7 +34675,7 @@
     dirname$2 = Sysdeps[14];
    function concat(dirname, filename){
      /*<<filename.ml:290:2>>*/ var l = caml_ml_string_length(dirname);
-     /*<<filename.ml:291:14>>*/ if
+     /*<<filename.ml:291:2>>*/ if
      (0 !== l && ! is_dir_sep$1(dirname, l - 1 | 0)){
       /*<<filename.ml:293:17>>*/  /*<<filename.ml:293:17>>*/ var
       _p_ =
@@ -34701,7 +34702,7 @@
      i$3 = caml_ml_string_length(name) - 1 | 0,
      i0 = i$3;
      /*<<filename.ml:307:4>>*/ for(;;){
-      /*<<filename.ml:307:16>>*/ if(0 <= i0 && ! is_dir_sep$1(name, i0)){
+     if(0 <= i0 && ! is_dir_sep$1(name, i0)){
        /*<<filename.ml:308:12>>*/ if
        (46 ===  /*<<filename.ml:308:12>>*/ caml_string_get(name, i0))
        break;
@@ -34716,7 +34717,7 @@
       /*<<filename.ml:308:32>>*/ i$1 = i0 - 1 | 0,
      i = i$1;
      /*<<filename.ml:302:4>>*/ for(;;){
-      /*<<filename.ml:302:16>>*/ if(0 <= i && ! is_dir_sep$1(name, i)){
+     if(0 <= i && ! is_dir_sep$1(name, i)){
        /*<<filename.ml:303:12>>*/ if
        (46 !==  /*<<filename.ml:303:12>>*/ caml_string_get(name, i))
        return caml_ml_string_length(name) - i0 | 0;

From f1f0d24e990263286b235ad74b0eb74d46fcfaef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 18 Oct 2024 11:42:24 +0200
Subject: [PATCH 403/481] Add location after return statement

---
 compiler/bin-wasm_of_ocaml/compile.ml        |    2 +-
 compiler/lib/generate.ml                     |   24 +-
 compiler/lib/javascript.ml                   |    2 +-
 compiler/lib/javascript.mli                  |    2 +-
 compiler/lib/js_output.ml                    |   12 +-
 compiler/lib/js_parser.mly                   |    4 +-
 compiler/lib/js_simpl.ml                     |   39 +-
 compiler/lib/js_simpl.mli                    |    3 +-
 compiler/lib/js_traverse.ml                  |   16 +-
 compiler/lib/wasm/wa_gc_target.ml            |   82 +-
 compiler/lib/wasm/wa_link.ml                 |    2 +-
 compiler/tests-compiler/gh747.ml             |   18 +-
 compiler/tests-compiler/global_deadcode.ml   |   15 +-
 compiler/tests-compiler/js_parser_printer.ml |   71 +-
 compiler/tests-compiler/sourcemap.ml         |    3 +-
 compiler/tests-full/stdlib.cma.expected.js   | 6768 ++++++++++--------
 compiler/tests-sourcemap/dump.reference      |    1 +
 17 files changed, 3771 insertions(+), 3293 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index e97c643759..1d322b5e5a 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -193,7 +193,7 @@ let build_js_runtime ~primitives ?runtime_arguments () =
       List.split_last
       @@ Driver.link_and_pack
            ~link:`Needed
-           [ Javascript.Return_statement (Some (EObj l)), N ]
+           [ Javascript.Return_statement (Some (EObj l), N), N ]
     with
     | Some x -> x
     | None -> assert false
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 8ce83db0b7..cf0e7c4124 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -561,6 +561,7 @@ type state =
   ; dom : Structure.graph
   ; visited_blocks : Addr.Set.t ref
   ; ctx : Ctx.t
+  ; pc : Addr.t
   }
 
 module DTree = struct
@@ -681,7 +682,7 @@ let build_graph ctx pc =
   let visited_blocks = ref Addr.Set.empty in
   let structure = Structure.build_graph ctx.Ctx.blocks pc in
   let dom = Structure.dominator_tree structure in
-  { visited_blocks; structure; dom; ctx }
+  { visited_blocks; structure; dom; ctx; pc }
 
 (****)
 
@@ -835,7 +836,8 @@ let generate_apply_fun ctx { arity; exact; trampolined } =
     ( None
     , J.fun_
         (f :: params)
-        [ J.Return_statement (Some (apply_fun_raw ctx f' params' exact trampolined)), J.N
+        [ ( J.Return_statement (Some (apply_fun_raw ctx f' params' exact trampolined), J.N)
+          , J.N )
         ]
         J.N )
 
@@ -1282,7 +1284,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
                 loc
             in
             let e =
-              J.EFun (Some f, J.fun_ args [ J.Return_statement (Some call), J.N ] J.N)
+              J.EFun (Some f, J.fun_ args [ J.Return_statement (Some call, J.N), J.N ] J.N)
             in
             e, const_p, queue
         | Extern "caml_alloc_dummy_function", _ -> assert false
@@ -1675,6 +1677,8 @@ and compile_decision_tree kind st scope_stack loc cx dtree ~fall_through =
         in
         ( never1 && never2
         , Js_simpl.if_statement
+            ~function_end:(fun () ->
+              source_location_ctx st.ctx ~force:After (After st.pc))
             e'
             loc
             (Js_simpl.block iftrue)
@@ -1758,7 +1762,17 @@ and compile_conditional st queue ~fall_through last scope_stack : _ * _ =
         let return_expr =
           if Var.equal st.ctx.deadcode_sentinal x then None else Some cx
         in
-        true, flush_all queue [ J.Return_statement return_expr, loc ]
+        let loc' =
+          match cx with
+          | ECall _ -> (
+              (* We usually don't have a good locations for tail
+                 calls, so use the end of the function instead *)
+              match source_location_ctx st.ctx ~force:After (After st.pc) with
+              | J.N -> loc
+              | loc -> loc)
+          | _ -> loc
+        in
+        true, flush_all queue [ J.Return_statement (return_expr, loc'), loc ]
     | Raise (x, k) ->
         let (_px, cx), queue = access_queue queue x in
         true, flush_all queue (throw_statement st.ctx cx k loc)
@@ -1766,7 +1780,7 @@ and compile_conditional st queue ~fall_through last scope_stack : _ * _ =
         let e_opt =
           if st.ctx.Ctx.should_export then Some (s_var Global_constant.exports) else None
         in
-        true, flush_all queue [ J.Return_statement e_opt, loc ]
+        true, flush_all queue [ J.Return_statement (e_opt, loc), loc ]
     | Branch cont -> compile_branch st queue cont scope_stack ~fall_through
     | Pushtrap (c1, x, e1) ->
         let never_body, body = compile_branch st [] c1 scope_stack ~fall_through in
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index 952b196769..a5a7109240 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -347,7 +347,7 @@ and statement =
       * (statement * location)
   | Continue_statement of Label.t option
   | Break_statement of Label.t option
-  | Return_statement of expression option
+  | Return_statement of expression option * location
   | With_statement of expression * (statement * location)
   | Labelled_statement of Label.t * (statement * location)
   | Switch_statement of
diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli
index af02260783..732650be20 100644
--- a/compiler/lib/javascript.mli
+++ b/compiler/lib/javascript.mli
@@ -265,7 +265,7 @@ and statement =
       * (statement * location)
   | Continue_statement of Label.t option
   | Break_statement of Label.t option
-  | Return_statement of expression option
+  | Return_statement of expression option * location
   | With_statement of expression * (statement * location)
   | Labelled_statement of Label.t * (statement * location)
   | Switch_statement of
diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index 64dcdcab64..836e43c92e 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -509,13 +509,14 @@ struct
             PP.end_group f);
         PP.end_group f;
         (match b, consise with
-        | [ (Return_statement (Some e), loc) ], true ->
+        | [ (Return_statement (Some e, loc), loc') ], true ->
             (* Should not starts with '{' *)
             PP.start_group f 1;
             PP.break1 f;
-            output_debug_info f loc;
+            output_debug_info f loc';
             parenthesized_expression ~obj:true AssignementExpression f e;
-            PP.end_group f
+            PP.end_group f;
+            output_debug_info f loc
         | l, _ ->
             let b =
               match l with
@@ -1466,10 +1467,11 @@ struct
         let (Utf8 l) = nane_of_label s in
         PP.string f l;
         last_semi ()
-    | Return_statement e -> (
+    | Return_statement (e, loc) -> (
         match e with
         | None ->
             PP.string f "return";
+            output_debug_info f loc;
             last_semi ()
         | Some (EFun (i, ({ async = false; generator = false }, l, b, pc))) ->
             PP.start_group f 1;
@@ -1490,6 +1492,7 @@ struct
             function_body f b;
             output_debug_info f pc;
             PP.string f "}";
+            output_debug_info f loc;
             last_semi ();
             PP.end_group f
         | Some e ->
@@ -1498,6 +1501,7 @@ struct
             PP.non_breaking_space f;
             PP.start_group f 0;
             expression Expression f e;
+            output_debug_info f loc;
             last_semi ();
             PP.end_group f;
             PP.end_group f
diff --git a/compiler/lib/js_parser.mly b/compiler/lib/js_parser.mly
index b649a8acd1..c433f476cb 100644
--- a/compiler/lib/js_parser.mly
+++ b/compiler/lib/js_parser.mly
@@ -736,7 +736,7 @@ break_stmt:
  | T_BREAK l=label? sc { (Break_statement (l)) }
 
 return_stmt:
- | T_RETURN e=expr? sc { (Return_statement e) }
+ | T_RETURN e=expr? sc { (Return_statement (e, p $endpos(e))) }
 
 switch_stmt:
  | T_SWITCH "(" subject=expr ")" cb=case_block
@@ -1100,7 +1100,7 @@ async_arrow_function:
 (* was called consise body in spec *)
 arrow_body:
  | "{" b=function_body "}" { b, false }
- | e=assignment_expr_for_consise_body { [(Return_statement (Some e), p $symbolstartpos)], true }
+ | e=assignment_expr_for_consise_body { [(Return_statement (Some e, p $endpos), p $symbolstartpos)], true }
 
 (*----------------------------*)
 (* no in                    *)
diff --git a/compiler/lib/js_simpl.ml b/compiler/lib/js_simpl.ml
index 463406ed14..ef7181855c 100644
--- a/compiler/lib/js_simpl.ml
+++ b/compiler/lib/js_simpl.ml
@@ -110,13 +110,13 @@ exception Not_expression
 
 let rec expression_of_statement_list l =
   match l with
-  | (J.Return_statement (Some e), _) :: _ -> e
+  | (J.Return_statement (Some e, _), _) :: _ -> e
   | (J.Expression_statement e, _) :: rem -> J.ESeq (e, expression_of_statement_list rem)
   | _ -> raise Not_expression
 
 let expression_of_statement st =
   match fst st with
-  | J.Return_statement (Some e) -> e
+  | J.Return_statement (Some e, _) -> e
   | J.Block l -> expression_of_statement_list l
   | _ -> raise Not_expression
 
@@ -194,7 +194,7 @@ and depth_class_block b =
       | J.CEField _ -> acc
       | J.CEStaticBLock b -> depth_block b + 2)
 
-let rec if_statement_2 e loc iftrue truestop iffalse falsestop =
+let rec if_statement_2 ~function_end e loc iftrue truestop iffalse falsestop =
   let e = simplify_condition e in
   match fst iftrue, fst iffalse with
   (* Empty blocks *)
@@ -202,7 +202,8 @@ let rec if_statement_2 e loc iftrue truestop iffalse falsestop =
       match e with
       | J.EVar _ -> []
       | _ -> [ J.Expression_statement e, loc ])
-  | J.Block [], _ -> if_statement_2 (enot e) loc iffalse falsestop iftrue truestop
+  | J.Block [], _ ->
+      if_statement_2 ~function_end (enot e) loc iffalse falsestop iftrue truestop
   | _, J.Block [] -> [ J.If_statement (e, iftrue, None), loc ]
   | _ -> (
       try
@@ -226,7 +227,7 @@ let rec if_statement_2 e loc iftrue truestop iffalse falsestop =
         try
           let e1 = expression_of_statement iftrue in
           let e2 = expression_of_statement iffalse in
-          [ J.Return_statement (Some (J.ECond (e, e1, e2))), loc ]
+          [ J.Return_statement (Some (J.ECond (e, e1, e2)), function_end ()), loc ]
         with Not_expression ->
           let truestop, falsestop =
             if truestop && falsestop
@@ -247,15 +248,23 @@ let unopt b =
   | Some b -> b
   | None -> J.Block [], J.N
 
-let if_statement e loc iftrue truestop iffalse falsestop =
+let if_statement ~function_end e loc iftrue truestop iffalse falsestop =
   (*FIX: should be done at an earlier stage*)
   let e = simplify_condition e in
   match iftrue, iffalse with
   (* Shared statements *)
   | (J.If_statement (e', iftrue', iffalse'), _), _ when Poly.(iffalse = unopt iffalse') ->
-      if_statement_2 (J.EBin (J.And, e, e')) loc iftrue' truestop iffalse falsestop
+      if_statement_2
+        ~function_end
+        (J.EBin (J.And, e, e'))
+        loc
+        iftrue'
+        truestop
+        iffalse
+        falsestop
   | (J.If_statement (e', iftrue', iffalse'), _), _ when Poly.(iffalse = iftrue') ->
       if_statement_2
+        ~function_end
         (J.EBin (J.And, e, J.EUn (J.Not, e')))
         loc
         (unopt iffalse')
@@ -263,16 +272,24 @@ let if_statement e loc iftrue truestop iffalse falsestop =
         iffalse
         falsestop
   | _, (J.If_statement (e', iftrue', iffalse'), _) when Poly.(iftrue = iftrue') ->
-      if_statement_2 (J.EBin (J.Or, e, e')) loc iftrue truestop (unopt iffalse') falsestop
+      if_statement_2
+        ~function_end
+        (J.EBin (J.Or, e, e'))
+        loc
+        iftrue
+        truestop
+        (unopt iffalse')
+        falsestop
   | _, (J.If_statement (e', iftrue', iffalse'), _) when Poly.(iftrue = unopt iffalse') ->
       if_statement_2
+        ~function_end
         (J.EBin (J.Or, e, J.EUn (J.Not, e')))
         loc
         iftrue
         truestop
         iftrue'
         falsestop
-  | _ -> if_statement_2 e loc iftrue truestop iffalse falsestop
+  | _ -> if_statement_2 ~function_end e loc iftrue truestop iffalse falsestop
 
 let function_body b =
   (* We only check for a return at the end since it is by far the most
@@ -281,7 +298,7 @@ let function_body b =
     let rec check l =
       match l with
       | [] -> false
-      | [ (J.Return_statement None, _) ] -> true
+      | [ (J.Return_statement (None, _), _) ] -> true
       | _ :: r -> check r
     in
     check b
@@ -291,7 +308,7 @@ let function_body b =
     let rec remove acc l =
       match l with
       | [] -> acc
-      | [ (J.Return_statement None, _) ] -> acc
+      | [ (J.Return_statement (None, _), _) ] -> acc
       | i :: r -> remove (i :: acc) r
     in
     List.rev (remove [] b)
diff --git a/compiler/lib/js_simpl.mli b/compiler/lib/js_simpl.mli
index 4d81f4ef24..d640595c9a 100644
--- a/compiler/lib/js_simpl.mli
+++ b/compiler/lib/js_simpl.mli
@@ -21,7 +21,8 @@
 open Javascript
 
 val if_statement :
-     expression
+     function_end:(unit -> location)
+  -> expression
   -> location
   -> statement * location
   -> bool
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index aea066c1e9..ba65d8968f 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -187,7 +187,7 @@ class map : mapper =
           ForAwaitOf_statement (e1, m#expression e2, (m#statement s, m#loc loc))
       | Continue_statement s -> Continue_statement s
       | Break_statement s -> Break_statement s
-      | Return_statement e -> Return_statement (m#expression_o e)
+      | Return_statement (e, loc) -> Return_statement (m#expression_o e, m#loc loc)
       | Labelled_statement (l, (s, loc)) ->
           Labelled_statement (l, (m#statement s, m#loc loc))
       | Throw_statement e -> Throw_statement (m#expression e)
@@ -549,7 +549,7 @@ class iter : iterator =
           m#statement s
       | Continue_statement _ -> ()
       | Break_statement _ -> ()
-      | Return_statement e -> m#expression_o e
+      | Return_statement (e, _) -> m#expression_o e
       | Labelled_statement (_, (s, _)) -> m#statement s
       | Throw_statement e -> m#expression e
       | Switch_statement (e, l, def, l') ->
@@ -1750,8 +1750,16 @@ class simpl =
           | If_statement (ENum n, _, iffalse) when Num.is_zero n -> opt_cons iffalse rem
           (* if (e1) return e2 else return e3 --> return e1 ? e2 : e3 *)
           | If_statement
-              (cond, (Return_statement (Some e1), _), Some (Return_statement (Some e2), _))
-            -> (Return_statement (Some (ECond (cond, e1, e2))), loc) :: rem
+              ( cond
+              , (Return_statement (Some e1, _), _)
+              , Some (Return_statement (Some e2, _), _) ) ->
+              ( Return_statement
+                  ( Some (ECond (cond, e1, e2))
+                  , U
+                    (*TODO: it would be better to use the location of the
+                      end of the function, but we can't easily get it. *) )
+              , loc )
+              :: rem
           (* if (e1) v1 = e2 else v1 = e3 --> v1 = e1 ? e2 : e3 *)
           | If_statement
               ( cond
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index 576cf00b10..ce1b619eee 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1417,7 +1417,8 @@ let () =
               let name = Printf.sprintf "js_expr_%x" (String.hash str) in
               let* () =
                 register_fragment name (fun () ->
-                    EArrow (J.fun_ [] [ Return_statement (Some e), N ] N, true, AUnknown))
+                    EArrow
+                      (J.fun_ [] [ Return_statement (Some e, N), N ] N, true, AUnknown))
               in
               let* js_val = JavaScript.invoke_fragment name [] in
               return (W.Call (wrap, [ js_val ]))
@@ -1459,13 +1460,14 @@ let () =
               ( J.fun_
                   (List.map ~f:J.ident (f :: o :: params))
                   [ ( Return_statement
-                        (Some
-                           (J.call
-                              (J.dot
-                                 (EVar (J.ident f))
-                                 (Utf8_string.of_string_exn "call"))
-                              (List.map ~f:(fun x -> J.EVar (J.ident x)) (o :: params))
-                              N))
+                        ( Some
+                            (J.call
+                               (J.dot
+                                  (EVar (J.ident f))
+                                  (Utf8_string.of_string_exn "call"))
+                               (List.map ~f:(fun x -> J.EVar (J.ident x)) (o :: params))
+                               N)
+                        , N )
                     , N )
                   ]
                   N
@@ -1488,11 +1490,12 @@ let () =
               ( J.fun_
                   (List.map ~f:J.ident (f :: params))
                   [ ( Return_statement
-                        (Some
-                           (J.call
-                              (EVar (J.ident f))
-                              (List.map ~f:(fun x -> J.EVar (J.ident x)) params)
-                              N))
+                        ( Some
+                            (J.call
+                               (EVar (J.ident f))
+                               (List.map ~f:(fun x -> J.EVar (J.ident x)) params)
+                               N)
+                        , N )
                     , N )
                   ]
                   N
@@ -1520,11 +1523,12 @@ let () =
                   ( J.fun_
                       (List.map ~f:J.ident (o :: params))
                       [ ( Return_statement
-                            (Some
-                               (J.call
-                                  (J.dot (EVar (J.ident o)) meth)
-                                  (List.map ~f:(fun x -> J.EVar (J.ident x)) params)
-                                  N))
+                            ( Some
+                                (J.call
+                                   (J.dot (EVar (J.ident o)) meth)
+                                   (List.map ~f:(fun x -> J.EVar (J.ident x)) params)
+                                   N)
+                            , N )
                         , N )
                       ]
                       N
@@ -1549,12 +1553,14 @@ let () =
               ( J.fun_
                   (List.map ~f:J.ident (c :: params))
                   [ ( Return_statement
-                        (Some
-                           (ENew
-                              ( EVar (J.ident c)
-                              , Some
-                                  (List.map ~f:(fun x -> J.Arg (EVar (J.ident x))) params)
-                              )))
+                        ( Some
+                            (ENew
+                               ( EVar (J.ident c)
+                               , Some
+                                   (List.map
+                                      ~f:(fun x -> J.Arg (EVar (J.ident x)))
+                                      params) ))
+                        , N )
                     , N )
                   ]
                   N
@@ -1576,7 +1582,7 @@ let () =
                 EArrow
                   ( J.fun_
                       [ J.ident o ]
-                      [ Return_statement (Some (J.dot (EVar (J.ident o)) prop)), N ]
+                      [ Return_statement (Some (J.dot (EVar (J.ident o)) prop), N), N ]
                       N
                   , true
                   , AUnknown ))
@@ -1599,9 +1605,10 @@ let () =
                   ( J.fun_
                       [ J.ident o; J.ident v ]
                       [ ( Return_statement
-                            (Some
-                               (J.EBin
-                                  (J.Eq, J.dot (EVar (J.ident o)) prop, EVar (J.ident v))))
+                            ( Some
+                                (J.EBin
+                                   (J.Eq, J.dot (EVar (J.ident o)) prop, EVar (J.ident v)))
+                            , N )
                         , N )
                       ]
                       N
@@ -1636,15 +1643,16 @@ let () =
               ( J.fun_
                   (List.map ~f:J.ident params)
                   [ ( Return_statement
-                        (Some
-                           (EObj
-                              (List.map2
-                                 ~f:(fun k x ->
-                                   J.Property
-                                     ( (if J.is_ident' k then J.PNI k else J.PNS k)
-                                     , EVar (J.ident x) ))
-                                 kl
-                                 params)))
+                        ( Some
+                            (EObj
+                               (List.map2
+                                  ~f:(fun k x ->
+                                    J.Property
+                                      ( (if J.is_ident' k then J.PNI k else J.PNS k)
+                                      , EVar (J.ident x) ))
+                                  kl
+                                  params))
+                        , N )
                     , N )
                   ]
                   N
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 5594500bdb..1c945156b7 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -526,7 +526,7 @@ let build_runtime_arguments
                           , ANullish
                           , Utf8_string.of_string_exn "export" )
                       , EVar (Javascript.ident Global_constant.global_object_) ))
-               ; Return_statement (Some (obj generated_js)), N
+               ; Return_statement (Some (obj generated_js), N), N
                ]
                N
            , true
diff --git a/compiler/tests-compiler/gh747.ml b/compiler/tests-compiler/gh747.ml
index c2cb059cf9..29a229b3ec 100644
--- a/compiler/tests-compiler/gh747.ml
+++ b/compiler/tests-compiler/gh747.ml
@@ -314,7 +314,7 @@ end
      89:     function info(is_raise){
      90:       /*<<test.ml:46:4>>*/ return is_raise
      91:              ? 0 === pos ? cst_Raised_at : cst_Re_raised_at
-     92:              : 0 === pos ? cst_Raised_by_primitive_operat : cst_Called_from;
+     92:              : 0 === pos ? cst_Raised_by_primitive_operat : cst_Called_from /*<<test.ml:49:75>>*/ ;
      93:      /*<<test.ml:49:75>>*/ }
      94:      /*<<test.ml:51:2>>*/ if(0 === slot[0]){
      95:       /*<<test.ml:59:14>>*/ var
@@ -327,17 +327,17 @@ end
     102:        /*<<test.ml:59:14>>*/ _n_ = info(slot[1]);
     103:       /*<<test.ml:58:6>>*/ return [0,
     104:               /*<<test.ml:58:11>>*/ caml_call8
-    105:               (Stdlib_Printf[4], _a_, _n_, _m_, _l_, _k_, _j_, _i_, _h_)];
+    105:               (Stdlib_Printf[4], _a_, _n_, _m_, _l_, _k_, _j_, _i_, _h_)] /*<<test.ml:58:6>>*/ ;
     106:     }
-    107:     if(slot[1])  /*<<test.ml:54:50>>*/ return 0;
+    107:     if(slot[1])  /*<<test.ml:54:50>>*/ return 0 /*<<test.ml:54:50>>*/ ;
     108:      /*<<test.ml:56:51>>*/  /*<<test.ml:56:51>>*/ var _o_ = info(0);
     109:      /*<<test.ml:56:8>>*/ return [0,
-    110:              /*<<test.ml:56:13>>*/ caml_call2(Stdlib_Printf[4], _b_, _o_)];
+    110:              /*<<test.ml:56:13>>*/ caml_call2(Stdlib_Printf[4], _b_, _o_)] /*<<test.ml:56:8>>*/ ;
     111:     /*<<test.ml:61:52>>*/ }
     112:    function print_exception_backtrace(outchan, backtrace){
     113:      /*<<test.ml:64:2>>*/ if(! backtrace)
     114:       /*<<test.ml:66:6>>*/ return  /*<<test.ml:66:6>>*/ caml_call2
-    115:              (Stdlib_Printf[1], outchan, _d_);
+    115:              (Stdlib_Printf[1], outchan, _d_) /*<<test.ml:73:10>>*/ ;
     116:     var a = backtrace[1], _f_ = a.length - 2 | 0, _e_ = 0;
     117:     if(_f_ >= 0){
     118:      var i = _e_;
@@ -359,16 +359,16 @@ end
     134:    function compare(left, right, e1, e2){
     135:      /*<<test.ml:77:35>>*/ if(0 === e1[0]){
     136:      var v1 = e1[1];
-    137:      if(0 !== e2[0])  /*<<test.ml:80:23>>*/ return -1;
+    137:      if(0 !== e2[0])  /*<<test.ml:80:23>>*/ return -1 /*<<test.ml:80:23>>*/ ;
     138:      var v2 = e2[1];
     139:       /*<<test.ml:78:24>>*/ return  /*<<test.ml:78:24>>*/ caml_call2
-    140:              (left, v1, v2);
+    140:              (left, v1, v2) /*<<test.ml:81:24>>*/ ;
     141:     }
     142:     var v1$0 = e1[1];
-    143:     if(0 === e2[0])  /*<<test.ml:81:23>>*/ return 1;
+    143:     if(0 === e2[0])  /*<<test.ml:81:23>>*/ return 1 /*<<test.ml:81:23>>*/ ;
     144:     var v2$0 = e2[1];
     145:      /*<<test.ml:79:26>>*/ return  /*<<test.ml:79:26>>*/ caml_call2
-    146:             (right, v1$0, v2$0);
+    146:             (right, v1$0, v2$0) /*<<test.ml:81:24>>*/ ;
     147:     /*<<test.ml:81:24>>*/ }
     148:     /*<<test.ml:75:16>>*/ var
     149:      /*<<test.ml:75:16>>*/ Either = [0, compare],
diff --git a/compiler/tests-compiler/global_deadcode.ml b/compiler/tests-compiler/global_deadcode.ml
index 4103bea426..8d6ce59918 100644
--- a/compiler/tests-compiler/global_deadcode.ml
+++ b/compiler/tests-compiler/global_deadcode.ml
@@ -21,15 +21,16 @@ let%expect_test "Eliminates unused functions from functor" =
    | Javascript.ECall (EVar (S { name = Utf8 name; _ }), _, _, _) -> (
        let _, _, body, _ = find_function program name in
        match List.rev body with
-       | (Return_statement (Some (EArr return)), loc) :: rest ->
+       | (Return_statement (Some (EArr return), loc), loc') :: rest ->
            let return =
              ( Javascript.Return_statement
-                 (Some
-                    (EArr
-                       (List.filter return ~f:(function
-                           | Javascript.ElementHole -> false
-                           | _ -> true))))
-             , loc )
+                 ( Some
+                     (EArr
+                        (List.filter return ~f:(function
+                            | Javascript.ElementHole -> false
+                            | _ -> true)))
+                 , loc )
+             , loc' )
            in
            print_program (List.rev (return :: rest))
        | _ -> ())
diff --git a/compiler/tests-compiler/js_parser_printer.ml b/compiler/tests-compiler/js_parser_printer.ml
index 79b879db9d..f392d699e8 100644
--- a/compiler/tests-compiler/js_parser_printer.ml
+++ b/compiler/tests-compiler/js_parser_printer.ml
@@ -234,10 +234,14 @@ let%expect_test "arrow" =
 
   [%expect
     {|
-    /*<<fake:2:4>>*/  /*<<fake:2:10>>*/ var a = x=> /*<<fake:2:18>>*/ x + 2;
-    /*<<fake:3:4>>*/  /*<<fake:3:10>>*/ var a = ()=> /*<<fake:3:19>>*/ 2;
-    /*<<fake:4:4>>*/  /*<<fake:4:10>>*/ var a = x=> /*<<fake:4:20>>*/ x + 2;
-    /*<<fake:5:4>>*/  /*<<fake:5:10>>*/ var a = (x, y)=> /*<<fake:5:22>>*/ x + y;
+    /*<<fake:2:4>>*/  /*<<fake:2:10>>*/ var
+    a = x=> /*<<fake:2:18>>*/ x + 2 /*<<fake:2:23>>*/ ;
+    /*<<fake:3:4>>*/  /*<<fake:3:10>>*/ var
+    a = ()=> /*<<fake:3:19>>*/ 2 /*<<fake:3:20>>*/ ;
+    /*<<fake:4:4>>*/  /*<<fake:4:10>>*/ var
+    a = x=> /*<<fake:4:20>>*/ x + 2 /*<<fake:4:25>>*/ ;
+    /*<<fake:5:4>>*/  /*<<fake:5:10>>*/ var
+    a = (x, y)=> /*<<fake:5:22>>*/ x + y /*<<fake:5:27>>*/ ;
     /*<<fake:7:4>>*/  /*<<fake:7:10>>*/ var
     a = x=>{ /*<<fake:7:20>>*/ x + 2; /*<<fake:7:13>>*/ };
     /*<<fake:8:4>>*/  /*<<fake:8:10>>*/ var
@@ -245,16 +249,23 @@ let%expect_test "arrow" =
     /*<<fake:9:4>>*/  /*<<fake:9:10>>*/ var
     a = x=>{ /*<<fake:9:22>>*/ x + 2; /*<<fake:9:13>>*/ };
     /*<<fake:11:4>>*/  /*<<fake:11:10>>*/ var
-    a = ( /*<<fake:11:16>>*/ x = 1 / 2)=> /*<<fake:11:28>>*/ x + 10;
+    a =
+      ( /*<<fake:11:16>>*/ x = 1 / 2)=> /*<<fake:11:28>>*/ x + 10 /*<<fake:11:34>>*/ ;
     /*<<fake:13:4>>*/  /*<<fake:13:10>>*/ var
-    a = ( /*<<fake:13:16>>*/ x = /qwe/g)=> /*<<fake:13:30>>*/ x + 10;
+    a =
+      ( /*<<fake:13:16>>*/ x = /qwe/g)=> /*<<fake:13:30>>*/ x + 10 /*<<fake:13:36>>*/ ;
     /*<<fake:16:4>>*/  /*<<fake:16:10>>*/ var
-    a = x=> /*<<fake:16:17>>*/ y=> /*<<fake:16:22>>*/ x + y;
+    a =
+      x=>
+          /*<<fake:16:17>>*/ y=> /*<<fake:16:22>>*/ x + y /*<<fake:16:27>>*/  /*<<fake:16:27>>*/ ;
     /*<<fake:17:4>>*/  /*<<fake:17:10>>*/ var
-    a = x=> /*<<fake:17:17>>*/ y=> /*<<fake:17:23>>*/ x + y;
-    /*<<fake:19:4>>*/  /*<<fake:19:10>>*/ var a = async x=> /*<<fake:19:23>>*/ y;
+    a =
+      x=>
+          /*<<fake:17:17>>*/ y=> /*<<fake:17:23>>*/ x + y /*<<fake:17:28>>*/  /*<<fake:17:29>>*/ ;
+    /*<<fake:19:4>>*/  /*<<fake:19:10>>*/ var
+    a = async x=> /*<<fake:19:23>>*/ y /*<<fake:19:24>>*/ ;
     /*<<fake:20:4>>*/  /*<<fake:20:10>>*/ var
-    a = async (a, b)=> /*<<fake:20:27>>*/ a + b; |}]
+    a = async (a, b)=> /*<<fake:20:27>>*/ a + b /*<<fake:20:32>>*/ ; |}]
 
 let%expect_test "trailing comma" =
   (* GH#989 *)
@@ -287,7 +298,7 @@ function rehb_shape(_face /*: fk_face */, text /*: string */) {
   [%expect
     {|
     /*<<fake:4:0>>*/ function rehb_new_face(_fontName){
-     /*<<fake:7:2>>*/ return undefined;
+     /*<<fake:7:2>>*/ return undefined /*<<fake:7:18>>*/ ;
     /*<<fake:8:0>>*/ }
     /*<<fake:12:0>>*/ function rehb_shape(_face, text){
      /*<<fake:13:2>>*/  /*<<fake:13:10>>*/ var
@@ -296,10 +307,10 @@ function rehb_shape(_face /*: fk_face */, text /*: string */) {
      ret =
         /*<<fake:14:12>>*/  /*<<fake:14:12>>*/ str.split("").map
         (function mapper(_char){
-           /*<<fake:15:6>>*/ return [0, 0, 0];
+           /*<<fake:15:6>>*/ return [0, 0, 0] /*<<fake:15:69>>*/ ;
           /*<<fake:14:30>>*/ });
      /*<<fake:19:2>>*/  /*<<fake:19:2>>*/ ret.unshift(0);
-     /*<<fake:20:2>>*/ return ret;
+     /*<<fake:20:2>>*/ return ret /*<<fake:20:12>>*/ ;
     /*<<fake:21:0>>*/ } |}]
 
 let%expect_test "rest parameters" =
@@ -323,8 +334,8 @@ let%expect_test "rest parameters" =
               ().then
              (function(){
                 /*<<fake:4:10>>*/ return  /*<<fake:4:17>>*/ callWithProto
-                       (api_json[key_module][key_func], args);
-               /*<<fake:3:41>>*/ });
+                       (api_json[key_module][key_func], args) /*<<fake:4:68>>*/ ;
+               /*<<fake:3:41>>*/ }) /*<<fake:5:10>>*/ ;
      /*<<fake:2:38>>*/ }; |}]
 
 let%expect_test "async/await" =
@@ -368,7 +379,7 @@ let%expect_test "async/await" =
      /*<<fake:7:11>>*/  /*<<fake:7:25>>*/ const
      glslang = await  /*<<fake:7:33>>*/ glslangModule.default();
      /*<<fake:8:11>>*/ return  /*<<fake:8:18>>*/ glslang.compileGLSL
-            (src, "compute");
+            (src, "compute") /*<<fake:8:53>>*/ ;
     /*<<fake:2:9>>*/ }
     /*<<fake:12:4>>*/ async;
     /*<<fake:13:4>>*/ function test(){ /*<<fake:13:22>>*/ }
@@ -401,13 +412,21 @@ let%expect_test "get/set property" =
     {|
     /*<<fake:2:5>>*/  /*<<fake:2:11>>*/ var
     x =
-      {get prop(){ /*<<fake:3:20>>*/ return 3; /*<<fake:3:7>>*/ },
-       set prop(x){ /*<<fake:4:21>>*/ return x == 2; /*<<fake:4:7>>*/ },
+      {get prop(){
+         /*<<fake:3:20>>*/ return 3 /*<<fake:3:28>>*/ ;
+        /*<<fake:3:7>>*/ },
+       set prop(x){
+         /*<<fake:4:21>>*/ return x == 2 /*<<fake:4:34>>*/ ;
+        /*<<fake:4:7>>*/ },
        a: 4,
-       b(){ /*<<fake:6:13>>*/ return 5; /*<<fake:6:7>>*/ },
-       * e(){ /*<<fake:7:14>>*/ return 5; /*<<fake:7:7>>*/ },
-       async e(){ /*<<fake:8:19>>*/ return 5; /*<<fake:8:7>>*/ },
-       async* e(){ /*<<fake:9:20>>*/ return 5; /*<<fake:9:7>>*/ },
+       b(){ /*<<fake:6:13>>*/ return 5 /*<<fake:6:21>>*/ ; /*<<fake:6:7>>*/ },
+       * e(){ /*<<fake:7:14>>*/ return 5 /*<<fake:7:22>>*/ ; /*<<fake:7:7>>*/ },
+       async e(){
+         /*<<fake:8:19>>*/ return 5 /*<<fake:8:27>>*/ ;
+        /*<<fake:8:7>>*/ },
+       async* e(){
+         /*<<fake:9:20>>*/ return 5 /*<<fake:9:28>>*/ ;
+        /*<<fake:9:7>>*/ },
        ["field" + 1]: 3}; |}]
 
 let%expect_test "assignment pattern" =
@@ -513,13 +532,15 @@ let%expect_test "from keyword" =
      function from(field, get){
        /*<<fake:5:6>>*/ if(! get)
         /*<<fake:5:14>>*/ get =
-        function get(x){ /*<<fake:5:34>>*/ return x; /*<<fake:5:18>>*/ };
+        function get(x){
+          /*<<fake:5:34>>*/ return x /*<<fake:5:42>>*/ ;
+         /*<<fake:5:18>>*/ };
        /*<<fake:6:6>>*/ return  /*<<fake:6:13>>*/ this.compute
               ([field],
                function(state){
                  /*<<fake:6:50>>*/ return  /*<<fake:6:57>>*/ get
-                        ( /*<<fake:6:61>>*/ state.field(field));
-                /*<<fake:6:34>>*/ });
+                        ( /*<<fake:6:61>>*/ state.field(field)) /*<<fake:6:80>>*/ ;
+                /*<<fake:6:34>>*/ }) /*<<fake:6:83>>*/ ;
       /*<<fake:4:3>>*/ }}); |}]
 
 let%expect_test "new.target" =
diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml
index 6625996539..3e4aa963fb 100644
--- a/compiler/tests-compiler/sourcemap.ml
+++ b/compiler/tests-compiler/sourcemap.ml
@@ -78,6 +78,7 @@ let%expect_test _ =
       /dune-root/test.ml:1:7 -> 6:15
       /dune-root/test.ml:1:11 -> 6:18
       /dune-root/test.ml:1:7 -> 6:25
+      /dune-root/test.ml:1:11 -> 6:26
       /dune-root/test.ml:1:12 -> 6:27
       /dune-root/test.ml:1:4 -> 7:18
       null -> 10:2
@@ -105,7 +106,7 @@ function x (a, b) {
       4: }
     $ cat "test.min.js"
       1:  /*<<test.ml:2:0>>*/ function x(a, b){
-      2:   /*<<test.ml:3:2>>*/ return a + b;
+      2:   /*<<test.ml:3:2>>*/ return a + b /*<<test.ml:3:14>>*/ ;
       3:  /*<<test.ml:4:0>>*/ }
  |}]
 
diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js
index 03bf177f2f..6be730302c 100644
--- a/compiler/tests-full/stdlib.cma.expected.js
+++ b/compiler/tests-full/stdlib.cma.expected.js
@@ -6,170 +6,170 @@
    var runtime = globalThis.jsoo_runtime;
    function erase_rel(param){
      /*<<?>>*/ if(typeof param === "number")
-      /*<<camlinternalFormatBasics.ml:562:20>>*/ return 0;
+      /*<<camlinternalFormatBasics.ml:562:20>>*/ return 0 /*<<camlinternalFormatBasics.ml:562:20>>*/ ;
     switch(param[0]){
       case 0:
        var rest = param[1];
-        /*<<camlinternalFormatBasics.ml:533:4>>*/ return [0, erase_rel(rest)];
+        /*<<camlinternalFormatBasics.ml:533:4>>*/ return [0, erase_rel(rest)] /*<<camlinternalFormatBasics.ml:533:4>>*/ ;
       case 1:
        var rest$0 = param[1];
         /*<<camlinternalFormatBasics.ml:535:4>>*/ return [1,
-               erase_rel(rest$0)];
+               erase_rel(rest$0)] /*<<camlinternalFormatBasics.ml:535:4>>*/ ;
       case 2:
        var rest$1 = param[1];
         /*<<camlinternalFormatBasics.ml:537:4>>*/ return [2,
-               erase_rel(rest$1)];
+               erase_rel(rest$1)] /*<<camlinternalFormatBasics.ml:537:4>>*/ ;
       case 3:
        var rest$2 = param[1];
         /*<<camlinternalFormatBasics.ml:539:4>>*/ return [3,
-               erase_rel(rest$2)];
+               erase_rel(rest$2)] /*<<camlinternalFormatBasics.ml:539:4>>*/ ;
       case 4:
        var rest$3 = param[1];
         /*<<camlinternalFormatBasics.ml:543:4>>*/ return [4,
-               erase_rel(rest$3)];
+               erase_rel(rest$3)] /*<<camlinternalFormatBasics.ml:543:4>>*/ ;
       case 5:
        var rest$4 = param[1];
         /*<<camlinternalFormatBasics.ml:541:4>>*/ return [5,
-               erase_rel(rest$4)];
+               erase_rel(rest$4)] /*<<camlinternalFormatBasics.ml:541:4>>*/ ;
       case 6:
        var rest$5 = param[1];
         /*<<camlinternalFormatBasics.ml:545:4>>*/ return [6,
-               erase_rel(rest$5)];
+               erase_rel(rest$5)] /*<<camlinternalFormatBasics.ml:545:4>>*/ ;
       case 7:
        var rest$6 = param[1];
         /*<<camlinternalFormatBasics.ml:547:4>>*/ return [7,
-               erase_rel(rest$6)];
+               erase_rel(rest$6)] /*<<camlinternalFormatBasics.ml:547:4>>*/ ;
       case 8:
        var rest$7 = param[2], ty = param[1];
         /*<<camlinternalFormatBasics.ml:549:4>>*/ return [8,
                ty,
-               erase_rel(rest$7)];
+               erase_rel(rest$7)] /*<<camlinternalFormatBasics.ml:549:4>>*/ ;
       case 9:
        var rest$8 = param[3], ty1 = param[1];
         /*<<camlinternalFormatBasics.ml:551:4>>*/ return [9,
                ty1,
                ty1,
-               erase_rel(rest$8)];
+               erase_rel(rest$8)] /*<<camlinternalFormatBasics.ml:551:4>>*/ ;
       case 10:
        var rest$9 = param[1];
         /*<<camlinternalFormatBasics.ml:553:4>>*/ return [10,
-               erase_rel(rest$9)];
+               erase_rel(rest$9)] /*<<camlinternalFormatBasics.ml:553:4>>*/ ;
       case 11:
        var rest$10 = param[1];
         /*<<camlinternalFormatBasics.ml:555:4>>*/ return [11,
-               erase_rel(rest$10)];
+               erase_rel(rest$10)] /*<<camlinternalFormatBasics.ml:555:4>>*/ ;
       case 12:
        var rest$11 = param[1];
         /*<<camlinternalFormatBasics.ml:557:4>>*/ return [12,
-               erase_rel(rest$11)];
+               erase_rel(rest$11)] /*<<camlinternalFormatBasics.ml:557:4>>*/ ;
       case 13:
        var rest$12 = param[1];
         /*<<camlinternalFormatBasics.ml:559:4>>*/ return [13,
-               erase_rel(rest$12)];
+               erase_rel(rest$12)] /*<<camlinternalFormatBasics.ml:559:4>>*/ ;
       default:
        var rest$13 = param[1];
         /*<<camlinternalFormatBasics.ml:561:4>>*/ return [14,
-               erase_rel(rest$13)];
+               erase_rel(rest$13)] /*<<camlinternalFormatBasics.ml:561:4>>*/ ;
     }
    }
    function concat_fmtty(fmtty1, fmtty2){
      /*<<camlinternalFormatBasics.ml:590:21>>*/ if(typeof fmtty1 === "number")
-      /*<<camlinternalFormatBasics.ml:621:20>>*/ return fmtty2;
+      /*<<camlinternalFormatBasics.ml:621:20>>*/ return fmtty2 /*<<camlinternalFormatBasics.ml:621:20>>*/ ;
     switch(fmtty1[0]){
       case 0:
        var rest = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:592:4>>*/ return [0,
-               concat_fmtty(rest, fmtty2)];
+               concat_fmtty(rest, fmtty2)] /*<<camlinternalFormatBasics.ml:592:4>>*/ ;
       case 1:
        var rest$0 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:594:4>>*/ return [1,
-               concat_fmtty(rest$0, fmtty2)];
+               concat_fmtty(rest$0, fmtty2)] /*<<camlinternalFormatBasics.ml:594:4>>*/ ;
       case 2:
        var rest$1 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:596:4>>*/ return [2,
-               concat_fmtty(rest$1, fmtty2)];
+               concat_fmtty(rest$1, fmtty2)] /*<<camlinternalFormatBasics.ml:596:4>>*/ ;
       case 3:
        var rest$2 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:598:4>>*/ return [3,
-               concat_fmtty(rest$2, fmtty2)];
+               concat_fmtty(rest$2, fmtty2)] /*<<camlinternalFormatBasics.ml:598:4>>*/ ;
       case 4:
        var rest$3 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:600:4>>*/ return [4,
-               concat_fmtty(rest$3, fmtty2)];
+               concat_fmtty(rest$3, fmtty2)] /*<<camlinternalFormatBasics.ml:600:4>>*/ ;
       case 5:
        var rest$4 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:602:4>>*/ return [5,
-               concat_fmtty(rest$4, fmtty2)];
+               concat_fmtty(rest$4, fmtty2)] /*<<camlinternalFormatBasics.ml:602:4>>*/ ;
       case 6:
        var rest$5 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:604:4>>*/ return [6,
-               concat_fmtty(rest$5, fmtty2)];
+               concat_fmtty(rest$5, fmtty2)] /*<<camlinternalFormatBasics.ml:604:4>>*/ ;
       case 7:
        var rest$6 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:606:4>>*/ return [7,
-               concat_fmtty(rest$6, fmtty2)];
+               concat_fmtty(rest$6, fmtty2)] /*<<camlinternalFormatBasics.ml:606:4>>*/ ;
       case 8:
        var rest$7 = fmtty1[2], ty = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:618:4>>*/ return [8,
                ty,
-               concat_fmtty(rest$7, fmtty2)];
+               concat_fmtty(rest$7, fmtty2)] /*<<camlinternalFormatBasics.ml:618:4>>*/ ;
       case 9:
        var rest$8 = fmtty1[3], ty2 = fmtty1[2], ty1 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:620:4>>*/ return [9,
                ty1,
                ty2,
-               concat_fmtty(rest$8, fmtty2)];
+               concat_fmtty(rest$8, fmtty2)] /*<<camlinternalFormatBasics.ml:620:4>>*/ ;
       case 10:
        var rest$9 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:608:4>>*/ return [10,
-               concat_fmtty(rest$9, fmtty2)];
+               concat_fmtty(rest$9, fmtty2)] /*<<camlinternalFormatBasics.ml:608:4>>*/ ;
       case 11:
        var rest$10 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:610:4>>*/ return [11,
-               concat_fmtty(rest$10, fmtty2)];
+               concat_fmtty(rest$10, fmtty2)] /*<<camlinternalFormatBasics.ml:610:4>>*/ ;
       case 12:
        var rest$11 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:612:4>>*/ return [12,
-               concat_fmtty(rest$11, fmtty2)];
+               concat_fmtty(rest$11, fmtty2)] /*<<camlinternalFormatBasics.ml:612:4>>*/ ;
       case 13:
        var rest$12 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:614:4>>*/ return [13,
-               concat_fmtty(rest$12, fmtty2)];
+               concat_fmtty(rest$12, fmtty2)] /*<<camlinternalFormatBasics.ml:614:4>>*/ ;
       default:
        var rest$13 = fmtty1[1];
         /*<<camlinternalFormatBasics.ml:616:4>>*/ return [14,
-               concat_fmtty(rest$13, fmtty2)];
+               concat_fmtty(rest$13, fmtty2)] /*<<camlinternalFormatBasics.ml:616:4>>*/ ;
     }
     /*<<camlinternalFormatBasics.ml:621:26>>*/ }
    function concat_fmt(fmt1, fmt2){
      /*<<camlinternalFormatBasics.ml:631:17>>*/ if(typeof fmt1 === "number")
-      /*<<camlinternalFormatBasics.ml:690:4>>*/ return fmt2;
+      /*<<camlinternalFormatBasics.ml:690:4>>*/ return fmt2 /*<<camlinternalFormatBasics.ml:690:4>>*/ ;
     switch(fmt1[0]){
       case 0:
        var rest = fmt1[1];
         /*<<camlinternalFormatBasics.ml:649:4>>*/ return [0,
-               concat_fmt(rest, fmt2)];
+               concat_fmt(rest, fmt2)] /*<<camlinternalFormatBasics.ml:649:4>>*/ ;
       case 1:
        var rest$0 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:651:4>>*/ return [1,
-               concat_fmt(rest$0, fmt2)];
+               concat_fmt(rest$0, fmt2)] /*<<camlinternalFormatBasics.ml:651:4>>*/ ;
       case 2:
        var rest$1 = fmt1[2], pad = fmt1[1];
         /*<<camlinternalFormatBasics.ml:633:4>>*/ return [2,
                pad,
-               concat_fmt(rest$1, fmt2)];
+               concat_fmt(rest$1, fmt2)] /*<<camlinternalFormatBasics.ml:633:4>>*/ ;
       case 3:
        var rest$2 = fmt1[2], pad$0 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:635:4>>*/ return [3,
                pad$0,
-               concat_fmt(rest$2, fmt2)];
+               concat_fmt(rest$2, fmt2)] /*<<camlinternalFormatBasics.ml:635:4>>*/ ;
       case 4:
        var rest$3 = fmt1[4], prec = fmt1[3], pad$1 = fmt1[2], iconv = fmt1[1];
         /*<<camlinternalFormatBasics.ml:638:4>>*/ return [4,
                iconv,
                pad$1,
                prec,
-               concat_fmt(rest$3, fmt2)];
+               concat_fmt(rest$3, fmt2)] /*<<camlinternalFormatBasics.ml:638:4>>*/ ;
       case 5:
        var
         rest$4 = fmt1[4],
@@ -180,7 +180,7 @@
                iconv$0,
                pad$2,
                prec$0,
-               concat_fmt(rest$4, fmt2)];
+               concat_fmt(rest$4, fmt2)] /*<<camlinternalFormatBasics.ml:640:4>>*/ ;
       case 6:
        var
         rest$5 = fmt1[4],
@@ -191,7 +191,7 @@
                iconv$1,
                pad$3,
                prec$1,
-               concat_fmt(rest$5, fmt2)];
+               concat_fmt(rest$5, fmt2)] /*<<camlinternalFormatBasics.ml:642:4>>*/ ;
       case 7:
        var
         rest$6 = fmt1[4],
@@ -202,7 +202,7 @@
                iconv$2,
                pad$4,
                prec$2,
-               concat_fmt(rest$6, fmt2)];
+               concat_fmt(rest$6, fmt2)] /*<<camlinternalFormatBasics.ml:644:4>>*/ ;
       case 8:
        var
         rest$7 = fmt1[4],
@@ -213,86 +213,86 @@
                fconv,
                pad$5,
                prec$3,
-               concat_fmt(rest$7, fmt2)];
+               concat_fmt(rest$7, fmt2)] /*<<camlinternalFormatBasics.ml:646:4>>*/ ;
       case 9:
        var rest$8 = fmt1[2], pad$6 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:653:4>>*/ return [9,
                pad$6,
-               concat_fmt(rest$8, fmt2)];
+               concat_fmt(rest$8, fmt2)] /*<<camlinternalFormatBasics.ml:653:4>>*/ ;
       case 10:
        var rest$9 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:663:4>>*/ return [10,
-               concat_fmt(rest$9, fmt2)];
+               concat_fmt(rest$9, fmt2)] /*<<camlinternalFormatBasics.ml:663:4>>*/ ;
       case 11:
        var rest$10 = fmt1[2], str = fmt1[1];
         /*<<camlinternalFormatBasics.ml:666:4>>*/ return [11,
                str,
-               concat_fmt(rest$10, fmt2)];
+               concat_fmt(rest$10, fmt2)] /*<<camlinternalFormatBasics.ml:666:4>>*/ ;
       case 12:
        var rest$11 = fmt1[2], chr = fmt1[1];
         /*<<camlinternalFormatBasics.ml:668:4>>*/ return [12,
                chr,
-               concat_fmt(rest$11, fmt2)];
+               concat_fmt(rest$11, fmt2)] /*<<camlinternalFormatBasics.ml:668:4>>*/ ;
       case 13:
        var rest$12 = fmt1[3], fmtty = fmt1[2], pad$7 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:671:4>>*/ return [13,
                pad$7,
                fmtty,
-               concat_fmt(rest$12, fmt2)];
+               concat_fmt(rest$12, fmt2)] /*<<camlinternalFormatBasics.ml:671:4>>*/ ;
       case 14:
        var rest$13 = fmt1[3], fmtty$0 = fmt1[2], pad$8 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:673:4>>*/ return [14,
                pad$8,
                fmtty$0,
-               concat_fmt(rest$13, fmt2)];
+               concat_fmt(rest$13, fmt2)] /*<<camlinternalFormatBasics.ml:673:4>>*/ ;
       case 15:
        var rest$14 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:655:4>>*/ return [15,
-               concat_fmt(rest$14, fmt2)];
+               concat_fmt(rest$14, fmt2)] /*<<camlinternalFormatBasics.ml:655:4>>*/ ;
       case 16:
        var rest$15 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:657:4>>*/ return [16,
-               concat_fmt(rest$15, fmt2)];
+               concat_fmt(rest$15, fmt2)] /*<<camlinternalFormatBasics.ml:657:4>>*/ ;
       case 17:
        var rest$16 = fmt1[2], fmting_lit = fmt1[1];
         /*<<camlinternalFormatBasics.ml:685:4>>*/ return [17,
                fmting_lit,
-               concat_fmt(rest$16, fmt2)];
+               concat_fmt(rest$16, fmt2)] /*<<camlinternalFormatBasics.ml:685:4>>*/ ;
       case 18:
        var rest$17 = fmt1[2], fmting_gen = fmt1[1];
         /*<<camlinternalFormatBasics.ml:687:4>>*/ return [18,
                fmting_gen,
-               concat_fmt(rest$17, fmt2)];
+               concat_fmt(rest$17, fmt2)] /*<<camlinternalFormatBasics.ml:687:4>>*/ ;
       case 19:
        var rest$18 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:661:4>>*/ return [19,
-               concat_fmt(rest$18, fmt2)];
+               concat_fmt(rest$18, fmt2)] /*<<camlinternalFormatBasics.ml:661:4>>*/ ;
       case 20:
        var rest$19 = fmt1[3], char_set = fmt1[2], width_opt = fmt1[1];
         /*<<camlinternalFormatBasics.ml:676:4>>*/ return [20,
                width_opt,
                char_set,
-               concat_fmt(rest$19, fmt2)];
+               concat_fmt(rest$19, fmt2)] /*<<camlinternalFormatBasics.ml:676:4>>*/ ;
       case 21:
        var rest$20 = fmt1[2], counter = fmt1[1];
         /*<<camlinternalFormatBasics.ml:678:4>>*/ return [21,
                counter,
-               concat_fmt(rest$20, fmt2)];
+               concat_fmt(rest$20, fmt2)] /*<<camlinternalFormatBasics.ml:678:4>>*/ ;
       case 22:
        var rest$21 = fmt1[1];
         /*<<camlinternalFormatBasics.ml:680:4>>*/ return [22,
-               concat_fmt(rest$21, fmt2)];
+               concat_fmt(rest$21, fmt2)] /*<<camlinternalFormatBasics.ml:680:4>>*/ ;
       case 23:
        var rest$22 = fmt1[2], ign = fmt1[1];
         /*<<camlinternalFormatBasics.ml:682:4>>*/ return [23,
                ign,
-               concat_fmt(rest$22, fmt2)];
+               concat_fmt(rest$22, fmt2)] /*<<camlinternalFormatBasics.ml:682:4>>*/ ;
       default:
        var rest$23 = fmt1[3], f = fmt1[2], arity = fmt1[1];
         /*<<camlinternalFormatBasics.ml:659:4>>*/ return [24,
                arity,
                f,
-               concat_fmt(rest$23, fmt2)];
+               concat_fmt(rest$23, fmt2)] /*<<camlinternalFormatBasics.ml:659:4>>*/ ;
     }
     /*<<camlinternalFormatBasics.ml:690:8>>*/ }
    var CamlinternalFormatBasics = [0, concat_fmtty, erase_rel, concat_fmt];
@@ -376,16 +376,16 @@
      /*<<stdlib.ml:74:14>>*/ return  /*<<stdlib.ml:74:17>>*/ runtime.caml_lessequal
              (x, y)
             ? x
-            : y;
+            : y /*<<stdlib.ml:74:37>>*/ ;
     /*<<stdlib.ml:74:37>>*/ }
    function max(x, y){
      /*<<stdlib.ml:75:14>>*/ return  /*<<stdlib.ml:75:17>>*/ runtime.caml_greaterequal
              (x, y)
             ? x
-            : y;
+            : y /*<<stdlib.ml:75:37>>*/ ;
     /*<<stdlib.ml:75:37>>*/ }
    function abs(x){
-     /*<<stdlib.ml:98:12>>*/ return 0 <= x ? x : - x | 0;
+     /*<<stdlib.ml:98:12>>*/ return 0 <= x ? x : - x | 0 /*<<stdlib.ml:98:36>>*/ ;
     /*<<stdlib.ml:98:36>>*/ }
    function lnot(x){
      /*<<stdlib.ml:104:13>>*/ return x ^ -1;
@@ -418,34 +418,35 @@
     _b_ = [0, 0];
    function char_of_int(n){
      /*<<stdlib.ml:224:2>>*/ if(0 <= n && 255 >= n)
-      /*<<stdlib.ml:224:58>>*/ return n;
-     /*<<stdlib.ml:224:27>>*/ return invalid_arg(cst_char_of_int);
+      /*<<stdlib.ml:224:58>>*/ return n /*<<stdlib.ml:224:58>>*/ ;
+     /*<<stdlib.ml:224:27>>*/ return invalid_arg(cst_char_of_int) /*<<stdlib.ml:224:78>>*/ ;
     /*<<stdlib.ml:224:78>>*/ }
    function string_of_bool(b){
-     /*<<stdlib.ml:254:2>>*/ return b ? cst_true : cst_false;
+     /*<<stdlib.ml:254:2>>*/ return b ? cst_true : cst_false /*<<stdlib.ml:254:31>>*/ ;
     /*<<stdlib.ml:254:31>>*/ }
    function bool_of_string(param){
      /*<<stdlib.ml:255:21>>*/ return param !== cst_false$0
             ? param !== cst_true$0 ? invalid_arg(cst_bool_of_string) : 1
-            : 0;
+            : 0 /*<<stdlib.ml:258:37>>*/ ;
     /*<<stdlib.ml:258:37>>*/ }
    function bool_of_string_opt(param){
      /*<<stdlib.ml:260:25>>*/ return param !== cst_false$0
             ? param !== cst_true$0 ? 0 : _a_
-            : _b_;
+            : _b_ /*<<stdlib.ml:263:13>>*/ ;
     /*<<stdlib.ml:263:13>>*/ }
    function string_of_int(n){
-     /*<<stdlib.ml:266:2>>*/ return "" + n;
+     /*<<stdlib.ml:266:2>>*/ return "" + n /*<<stdlib.ml:266:2>>*/ ;
     /*<<stdlib.ml:266:19>>*/ }
    function int_of_string_opt(s){
      /*<<stdlib.ml:272:2>>*/ try{
       /*<<stdlib.ml:272:6>>*/  /*<<stdlib.ml:272:6>>*/ var
       _w_ = [0,  /*<<stdlib.ml:272:11>>*/ caml_int_of_string(s)];
-      /*<<stdlib.ml:272:6>>*/ return _w_;
+      /*<<stdlib.ml:272:6>>*/ return _w_ /*<<stdlib.ml:272:6>>*/ ;
     }
     catch(_x_){
      var _v_ = caml_wrap_exception(_x_);
-     if(_v_[1] === Failure)  /*<<stdlib.ml:273:20>>*/ return 0;
+     if(_v_[1] === Failure)
+       /*<<stdlib.ml:273:20>>*/ return 0 /*<<stdlib.ml:273:20>>*/ ;
      throw caml_maybe_attach_backtrace(_v_, 0);
     }
     /*<<stdlib.ml:273:24>>*/ }
@@ -458,7 +459,7 @@
      a:
      {
       if(48 <= match){if(58 > match) break a;} else if(45 === match) break a;
-       /*<<stdlib.ml:279:2>>*/ return s1;
+       /*<<stdlib.ml:279:2>>*/ return s1 /*<<stdlib.ml:279:2>>*/ ;
      }
       /*<<stdlib.ml:282:26>>*/  /*<<stdlib.ml:282:26>>*/ var i$0 = i + 1 | 0;
      i = i$0;
@@ -466,26 +467,30 @@
     /*<<stdlib.ml:285:8>>*/ }
    function string_of_float(f){
      /*<<stdlib.ml:287:24>>*/ return valid_float_lexem
-            ( /*<<stdlib.ml:287:42>>*/ runtime.caml_format_float("%.12g", f));
+            ( /*<<stdlib.ml:287:42>>*/ runtime.caml_format_float("%.12g", f)) /*<<stdlib.ml:287:66>>*/ ;
     /*<<stdlib.ml:287:66>>*/ }
    function float_of_string_opt(s){
      /*<<stdlib.ml:293:2>>*/ try{
       /*<<stdlib.ml:293:6>>*/  /*<<stdlib.ml:293:6>>*/ var
       _t_ = [0,  /*<<stdlib.ml:293:11>>*/ caml_float_of_string(s)];
-      /*<<stdlib.ml:293:6>>*/ return _t_;
+      /*<<stdlib.ml:293:6>>*/ return _t_ /*<<stdlib.ml:293:6>>*/ ;
     }
     catch(_u_){
      var _s_ = caml_wrap_exception(_u_);
-     if(_s_[1] === Failure)  /*<<stdlib.ml:294:20>>*/ return 0;
+     if(_s_[1] === Failure)
+       /*<<stdlib.ml:294:20>>*/ return 0 /*<<stdlib.ml:294:20>>*/ ;
      throw caml_maybe_attach_backtrace(_s_, 0);
     }
     /*<<stdlib.ml:294:24>>*/ }
    function symbol(l1, l2){
-     /*<<stdlib.ml:299:2>>*/ if(! l1)  /*<<stdlib.ml:300:10>>*/ return l2;
+     /*<<stdlib.ml:299:2>>*/ if(! l1)
+      /*<<stdlib.ml:300:10>>*/ return l2 /*<<stdlib.ml:300:10>>*/ ;
     var _q_ = l1[2], h1 = l1[1];
-    if(! _q_)  /*<<stdlib.ml:301:16>>*/ return [0, h1, l2];
+    if(! _q_)
+      /*<<stdlib.ml:301:16>>*/ return [0, h1, l2] /*<<stdlib.ml:301:16>>*/ ;
     var match = _q_[2], h2 = _q_[1];
-    if(! match)  /*<<stdlib.ml:302:22>>*/ return [0, h1, [0, h2, l2]];
+    if(! match)
+      /*<<stdlib.ml:302:22>>*/ return [0, h1, [0, h2, l2]] /*<<stdlib.ml:302:22>>*/ ;
      /*<<stdlib.ml:303:40>>*/ var
      tl = match[2],
      h3 = match[1],
@@ -516,7 +521,7 @@
      }
      else
       dst[1 + offset] = l2;
-      /*<<stdlib.ml:303:28>>*/ return [0, h1, [0, h2, block]];
+      /*<<stdlib.ml:303:28>>*/ return [0, h1, [0, h2, block]] /*<<stdlib.ml:303:28>>*/ ;
     }
     /*<<stdlib.ml:303:55>>*/ }
     /*<<stdlib.ml:314:12>>*/ var
@@ -541,19 +546,20 @@
         ( /*<<stdlib.ml:331:29>>*/ caml_sys_open(name, mode, perm));
      /*<<stdlib.ml:332:2>>*/  /*<<stdlib.ml:332:2>>*/ caml_ml_set_channel_name
      (c, name);
-     /*<<stdlib.ml:332:2>>*/ return c;
+     /*<<stdlib.ml:332:2>>*/ return c /*<<stdlib.ml:332:2>>*/ ;
     /*<<stdlib.ml:333:3>>*/ }
    function open_out(name){
-     /*<<stdlib.ml:336:2>>*/ return open_out_gen(_c_, 438, name);
+     /*<<stdlib.ml:336:2>>*/ return open_out_gen(_c_, 438, name) /*<<stdlib.ml:336:74>>*/ ;
     /*<<stdlib.ml:336:74>>*/ }
    function open_out_bin(name){
-     /*<<stdlib.ml:339:2>>*/ return open_out_gen(_d_, 438, name);
+     /*<<stdlib.ml:339:2>>*/ return open_out_gen(_d_, 438, name) /*<<stdlib.ml:339:76>>*/ ;
     /*<<stdlib.ml:339:76>>*/ }
    function flush_all(param){
      /*<<stdlib.ml:347:2>>*/ var
      param$0 =  /*<<stdlib.ml:356:10>>*/ runtime.caml_ml_out_channels_list(0);
      /*<<stdlib.ml:347:17>>*/ for(;;){
-     if(! param$0)  /*<<stdlib.ml:348:12>>*/ return 0;
+     if(! param$0)
+       /*<<stdlib.ml:348:12>>*/ return 0 /*<<stdlib.ml:348:12>>*/ ;
      var l = param$0[2], a = param$0[1];
       /*<<stdlib.ml:350:8>>*/ try{
        /*<<stdlib.ml:351:12>>*/  /*<<stdlib.ml:351:12>>*/ caml_ml_flush(a);
@@ -567,34 +573,34 @@
     /*<<stdlib.ml:356:32>>*/ }
    function output_bytes(oc, s){
      /*<<stdlib.ml:366:2>>*/ return  /*<<stdlib.ml:366:2>>*/ caml_ml_output_bytes
-            (oc, s, 0, caml_ml_bytes_length(s));
+            (oc, s, 0, caml_ml_bytes_length(s)) /*<<stdlib.ml:366:39>>*/ ;
     /*<<stdlib.ml:366:39>>*/ }
    function output_string(oc, s){
      /*<<stdlib.ml:369:2>>*/ return  /*<<stdlib.ml:369:2>>*/ caml_ml_output
-            (oc, s, 0, caml_ml_string_length(s));
+            (oc, s, 0, caml_ml_string_length(s)) /*<<stdlib.ml:369:47>>*/ ;
     /*<<stdlib.ml:369:47>>*/ }
    function output(oc, s, ofs, len){
      /*<<stdlib.ml:372:2>>*/ if
      (0 <= ofs && 0 <= len && (caml_ml_bytes_length(s) - len | 0) >= ofs)
       /*<<stdlib.ml:374:7>>*/ return  /*<<stdlib.ml:374:7>>*/ caml_ml_output_bytes
-             (oc, s, ofs, len);
-     /*<<stdlib.ml:373:7>>*/ return invalid_arg(cst_output);
+             (oc, s, ofs, len) /*<<stdlib.ml:374:33>>*/ ;
+     /*<<stdlib.ml:373:7>>*/ return invalid_arg(cst_output) /*<<stdlib.ml:374:33>>*/ ;
     /*<<stdlib.ml:374:33>>*/ }
    function output_substring(oc, s, ofs, len){
      /*<<stdlib.ml:377:2>>*/ if
      (0 <= ofs && 0 <= len && (caml_ml_string_length(s) - len | 0) >= ofs)
       /*<<stdlib.ml:379:7>>*/ return  /*<<stdlib.ml:379:7>>*/ caml_ml_output
-             (oc, s, ofs, len);
-     /*<<stdlib.ml:378:7>>*/ return invalid_arg(cst_output_substring);
+             (oc, s, ofs, len) /*<<stdlib.ml:379:40>>*/ ;
+     /*<<stdlib.ml:378:7>>*/ return invalid_arg(cst_output_substring) /*<<stdlib.ml:379:40>>*/ ;
     /*<<stdlib.ml:379:40>>*/ }
    function output_value(chan, v){
      /*<<stdlib.ml:386:26>>*/ return  /*<<stdlib.ml:386:26>>*/ runtime.caml_output_value
-            (chan, v, 0);
+            (chan, v, 0) /*<<stdlib.ml:386:54>>*/ ;
     /*<<stdlib.ml:386:54>>*/ }
    function close_out(oc){
      /*<<stdlib.ml:392:19>>*/  /*<<stdlib.ml:392:19>>*/ caml_ml_flush(oc);
      /*<<stdlib.ml:392:29>>*/ return  /*<<stdlib.ml:392:29>>*/ caml_ml_close_channel
-            (oc);
+            (oc) /*<<stdlib.ml:392:49>>*/ ;
     /*<<stdlib.ml:392:49>>*/ }
    function close_out_noerr(oc){
      /*<<stdlib.ml:394:2>>*/ try{
@@ -604,9 +610,9 @@
      /*<<stdlib.ml:395:2>>*/ try{
       /*<<stdlib.ml:395:7>>*/  /*<<stdlib.ml:395:7>>*/ var
       _l_ =  /*<<stdlib.ml:395:7>>*/ caml_ml_close_channel(oc);
-      /*<<stdlib.ml:395:7>>*/ return _l_;
+      /*<<stdlib.ml:395:7>>*/ return _l_ /*<<stdlib.ml:395:7>>*/ ;
     }
-    catch(_m_){ /*<<stdlib.ml:395:38>>*/ return 0;}
+    catch(_m_){ /*<<stdlib.ml:395:38>>*/ return 0 /*<<stdlib.ml:395:38>>*/ ;}
     /*<<stdlib.ml:395:41>>*/ }
    function open_in_gen(mode, perm, name){
      /*<<stdlib.ml:405:2>>*/  /*<<stdlib.ml:405:10>>*/ var
@@ -615,25 +621,26 @@
         ( /*<<stdlib.ml:405:28>>*/ caml_sys_open(name, mode, perm));
      /*<<stdlib.ml:406:2>>*/  /*<<stdlib.ml:406:2>>*/ caml_ml_set_channel_name
      (c, name);
-     /*<<stdlib.ml:406:2>>*/ return c;
+     /*<<stdlib.ml:406:2>>*/ return c /*<<stdlib.ml:406:2>>*/ ;
     /*<<stdlib.ml:407:3>>*/ }
    function open_in(name){
-     /*<<stdlib.ml:410:2>>*/ return open_in_gen(_e_, 0, name);
+     /*<<stdlib.ml:410:2>>*/ return open_in_gen(_e_, 0, name) /*<<stdlib.ml:410:45>>*/ ;
     /*<<stdlib.ml:410:45>>*/ }
    function open_in_bin(name){
-     /*<<stdlib.ml:413:2>>*/ return open_in_gen(_f_, 0, name);
+     /*<<stdlib.ml:413:2>>*/ return open_in_gen(_f_, 0, name) /*<<stdlib.ml:413:47>>*/ ;
     /*<<stdlib.ml:413:47>>*/ }
    function input(ic, s, ofs, len){
      /*<<stdlib.ml:421:2>>*/ if
      (0 <= ofs && 0 <= len && (caml_ml_bytes_length(s) - len | 0) >= ofs)
       /*<<stdlib.ml:423:7>>*/ return  /*<<stdlib.ml:423:7>>*/ caml_ml_input
-             (ic, s, ofs, len);
-     /*<<stdlib.ml:422:7>>*/ return invalid_arg(cst_input);
+             (ic, s, ofs, len) /*<<stdlib.ml:423:32>>*/ ;
+     /*<<stdlib.ml:422:7>>*/ return invalid_arg(cst_input) /*<<stdlib.ml:423:32>>*/ ;
     /*<<stdlib.ml:423:32>>*/ }
    function unsafe_really_input(ic, s, ofs, len){
      /*<<stdlib.ml:426:2>>*/ var ofs$0 = ofs, len$0 = len;
      /*<<stdlib.ml:426:2>>*/ for(;;){
-     if(0 >= len$0)  /*<<stdlib.ml:426:19>>*/ return 0;
+     if(0 >= len$0)
+       /*<<stdlib.ml:426:19>>*/ return 0 /*<<stdlib.ml:426:19>>*/ ;
       /*<<stdlib.ml:427:12>>*/  /*<<stdlib.ml:427:12>>*/ var
       r =  /*<<stdlib.ml:427:12>>*/ caml_ml_input(ic, s, ofs$0, len$0);
       /*<<stdlib.ml:428:4>>*/ if(0 === r)
@@ -647,20 +654,21 @@
    function really_input(ic, s, ofs, len){
      /*<<stdlib.ml:434:2>>*/ if
      (0 <= ofs && 0 <= len && (caml_ml_bytes_length(s) - len | 0) >= ofs)
-      /*<<stdlib.ml:436:7>>*/ return unsafe_really_input(ic, s, ofs, len);
-     /*<<stdlib.ml:435:7>>*/ return invalid_arg(cst_really_input);
+      /*<<stdlib.ml:436:7>>*/ return unsafe_really_input(ic, s, ofs, len) /*<<stdlib.ml:436:39>>*/ ;
+     /*<<stdlib.ml:435:7>>*/ return invalid_arg(cst_really_input) /*<<stdlib.ml:436:39>>*/ ;
     /*<<stdlib.ml:436:39>>*/ }
    function really_input_string(ic, len){
      /*<<stdlib.ml:439:2>>*/  /*<<stdlib.ml:439:10>>*/ var
      s =  /*<<stdlib.ml:439:10>>*/ caml_create_bytes(len);
      /*<<stdlib.ml:440:2>>*/ really_input(ic, s, 0, len);
-    return caml_string_of_bytes(s);
+    return caml_string_of_bytes(s) /*<<stdlib.ml:441:26>>*/ ;
     /*<<stdlib.ml:441:26>>*/ }
    function input_line(chan){
      /*<<stdlib.ml:446:2>>*/ function build_result(buf, pos, param){
      var pos$0 = pos, param$0 = param;
      for(;;){
-      if(! param$0)  /*<<stdlib.ml:447:10>>*/ return buf;
+      if(! param$0)
+        /*<<stdlib.ml:447:10>>*/ return buf /*<<stdlib.ml:447:10>>*/ ;
        /*<<stdlib.ml:449:6>>*/ var
        tl = param$0[2],
        hd = param$0[1],
@@ -717,96 +725,96 @@
        var _k_ = res;
      }
       /*<<stdlib.ml:471:28>>*/ return  /*<<stdlib.ml:471:28>>*/ caml_string_of_bytes
-             (_k_);
+             (_k_) /*<<stdlib.ml:471:39>>*/ ;
     }
     /*<<stdlib.ml:471:39>>*/ }
    function close_in_noerr(ic){
      /*<<stdlib.ml:480:24>>*/ try{
       /*<<stdlib.ml:480:29>>*/  /*<<stdlib.ml:480:29>>*/ var
       _i_ =  /*<<stdlib.ml:480:29>>*/ caml_ml_close_channel(ic);
-      /*<<stdlib.ml:480:29>>*/ return _i_;
+      /*<<stdlib.ml:480:29>>*/ return _i_ /*<<stdlib.ml:480:29>>*/ ;
     }
-    catch(_j_){ /*<<stdlib.ml:480:51>>*/ return 0;}
+    catch(_j_){ /*<<stdlib.ml:480:51>>*/ return 0 /*<<stdlib.ml:480:51>>*/ ;}
     /*<<stdlib.ml:480:54>>*/ }
    function print_char(c){
      /*<<stdlib.ml:486:19>>*/ return  /*<<stdlib.ml:486:19>>*/ caml_ml_output_char
-            (stdout, c);
+            (stdout, c) /*<<stdlib.ml:486:39>>*/ ;
     /*<<stdlib.ml:486:39>>*/ }
    function print_string(s){
-     /*<<stdlib.ml:487:21>>*/ return output_string(stdout, s);
+     /*<<stdlib.ml:487:21>>*/ return output_string(stdout, s) /*<<stdlib.ml:487:43>>*/ ;
     /*<<stdlib.ml:487:43>>*/ }
    function print_bytes(s){
-     /*<<stdlib.ml:488:20>>*/ return output_bytes(stdout, s);
+     /*<<stdlib.ml:488:20>>*/ return output_bytes(stdout, s) /*<<stdlib.ml:488:41>>*/ ;
     /*<<stdlib.ml:488:41>>*/ }
    function print_int(i){
-     /*<<stdlib.ml:489:18>>*/ return output_string(stdout, "" + i);
+     /*<<stdlib.ml:489:18>>*/ return output_string(stdout, "" + i) /*<<stdlib.ml:489:56>>*/ ;
     /*<<stdlib.ml:489:56>>*/ }
    function print_float(f){
-     /*<<stdlib.ml:490:20>>*/ return output_string(stdout, string_of_float(f));
+     /*<<stdlib.ml:490:20>>*/ return output_string(stdout, string_of_float(f)) /*<<stdlib.ml:490:60>>*/ ;
     /*<<stdlib.ml:490:60>>*/ }
    function print_endline(s){
      /*<<stdlib.ml:492:2>>*/ output_string(stdout, s);
      /*<<stdlib.ml:492:26>>*/  /*<<stdlib.ml:492:26>>*/ caml_ml_output_char
      (stdout, 10);
      /*<<stdlib.ml:492:51>>*/ return  /*<<stdlib.ml:492:51>>*/ caml_ml_flush
-            (stdout);
+            (stdout) /*<<stdlib.ml:492:63>>*/ ;
     /*<<stdlib.ml:492:63>>*/ }
    function print_newline(param){
      /*<<stdlib.ml:493:23>>*/  /*<<stdlib.ml:493:23>>*/ caml_ml_output_char
      (stdout, 10);
      /*<<stdlib.ml:493:48>>*/ return  /*<<stdlib.ml:493:48>>*/ caml_ml_flush
-            (stdout);
+            (stdout) /*<<stdlib.ml:493:60>>*/ ;
     /*<<stdlib.ml:493:60>>*/ }
    function prerr_char(c){
      /*<<stdlib.ml:497:19>>*/ return  /*<<stdlib.ml:497:19>>*/ caml_ml_output_char
-            (stderr, c);
+            (stderr, c) /*<<stdlib.ml:497:39>>*/ ;
     /*<<stdlib.ml:497:39>>*/ }
    function prerr_string(s){
-     /*<<stdlib.ml:498:21>>*/ return output_string(stderr, s);
+     /*<<stdlib.ml:498:21>>*/ return output_string(stderr, s) /*<<stdlib.ml:498:43>>*/ ;
     /*<<stdlib.ml:498:43>>*/ }
    function prerr_bytes(s){
-     /*<<stdlib.ml:499:20>>*/ return output_bytes(stderr, s);
+     /*<<stdlib.ml:499:20>>*/ return output_bytes(stderr, s) /*<<stdlib.ml:499:41>>*/ ;
     /*<<stdlib.ml:499:41>>*/ }
    function prerr_int(i){
-     /*<<stdlib.ml:500:18>>*/ return output_string(stderr, "" + i);
+     /*<<stdlib.ml:500:18>>*/ return output_string(stderr, "" + i) /*<<stdlib.ml:500:56>>*/ ;
     /*<<stdlib.ml:500:56>>*/ }
    function prerr_float(f){
-     /*<<stdlib.ml:501:20>>*/ return output_string(stderr, string_of_float(f));
+     /*<<stdlib.ml:501:20>>*/ return output_string(stderr, string_of_float(f)) /*<<stdlib.ml:501:60>>*/ ;
     /*<<stdlib.ml:501:60>>*/ }
    function prerr_endline(s){
      /*<<stdlib.ml:503:2>>*/ output_string(stderr, s);
      /*<<stdlib.ml:503:26>>*/  /*<<stdlib.ml:503:26>>*/ caml_ml_output_char
      (stderr, 10);
      /*<<stdlib.ml:503:51>>*/ return  /*<<stdlib.ml:503:51>>*/ caml_ml_flush
-            (stderr);
+            (stderr) /*<<stdlib.ml:503:63>>*/ ;
     /*<<stdlib.ml:503:63>>*/ }
    function prerr_newline(param){
      /*<<stdlib.ml:504:23>>*/  /*<<stdlib.ml:504:23>>*/ caml_ml_output_char
      (stderr, 10);
      /*<<stdlib.ml:504:48>>*/ return  /*<<stdlib.ml:504:48>>*/ caml_ml_flush
-            (stderr);
+            (stderr) /*<<stdlib.ml:504:60>>*/ ;
     /*<<stdlib.ml:504:60>>*/ }
    function read_line(param){
      /*<<stdlib.ml:508:19>>*/  /*<<stdlib.ml:508:19>>*/ caml_ml_flush(stdout);
-     /*<<stdlib.ml:314:12>>*/ return input_line(stdin);
+     /*<<stdlib.ml:314:12>>*/ return input_line(stdin) /*<<stdlib.ml:508:49>>*/ ;
     /*<<stdlib.ml:508:49>>*/ }
    function read_int(param){
      /*<<stdlib.ml:509:18>>*/ return  /*<<stdlib.ml:509:18>>*/ caml_int_of_string
-            (read_line(0));
+            (read_line(0)) /*<<stdlib.ml:509:44>>*/ ;
     /*<<stdlib.ml:509:44>>*/ }
    function read_int_opt(param){
-     /*<<stdlib.ml:510:22>>*/ return int_of_string_opt(read_line(0));
+     /*<<stdlib.ml:510:22>>*/ return int_of_string_opt(read_line(0)) /*<<stdlib.ml:510:52>>*/ ;
     /*<<stdlib.ml:510:52>>*/ }
    function read_float(param){
      /*<<stdlib.ml:511:20>>*/ return  /*<<stdlib.ml:511:20>>*/ caml_float_of_string
-            (read_line(0));
+            (read_line(0)) /*<<stdlib.ml:511:48>>*/ ;
     /*<<stdlib.ml:511:48>>*/ }
    function read_float_opt(param){
-     /*<<stdlib.ml:512:24>>*/ return float_of_string_opt(read_line(0));
+     /*<<stdlib.ml:512:24>>*/ return float_of_string_opt(read_line(0)) /*<<stdlib.ml:512:56>>*/ ;
     /*<<stdlib.ml:512:56>>*/ }
    function string_of_format(param){
     var str = param[2];
-     /*<<stdlib.ml:538:44>>*/ return str;
+     /*<<stdlib.ml:538:44>>*/ return str /*<<stdlib.ml:538:44>>*/ ;
    }
    function symbol$0(_h_, param){
     var
@@ -818,7 +826,7 @@
      /*<<stdlib.ml:545:2>>*/ return [0,
              /*<<stdlib.ml:545:10>>*/ caml_call2
              (CamlinternalFormatBasics[3], fmt1, fmt2),
-            str1 + s2];
+            str1 + s2] /*<<stdlib.ml:545:2>>*/ ;
    }
     /*<<stdlib.ml:559:20>>*/  /*<<stdlib.ml:559:20>>*/ var
     exit_function = [0, flush_all];
@@ -835,29 +843,29 @@
           /*<<stdlib.ml:566:4>>*/ if(caml_atomic_cas(f_yet_to_run$0, 1, 0))
            /*<<stdlib.ml:566:59>>*/  /*<<stdlib.ml:566:59>>*/ caml_call1(f, 0);
           /*<<stdlib.ml:566:59>>*/ return  /*<<stdlib.ml:566:59>>*/ caml_call1
-                 (old_exit$0, 0);
+                 (old_exit$0, 0) /*<<stdlib.ml:567:15>>*/ ;
          /*<<stdlib.ml:567:15>>*/ },
       success = caml_atomic_cas(exit_function, old_exit, new_exit),
        /*<<stdlib.ml:570:2>>*/ _g_ = 1 - success;
-     if(! _g_)  /*<<stdlib.ml:570:2>>*/ return _g_;
+     if(! _g_)  /*<<stdlib.ml:570:2>>*/ return _g_ /*<<stdlib.ml:570:2>>*/ ;
     }
     /*<<stdlib.ml:570:31>>*/ }
     /*<<stdlib.ml:572:30>>*/  /*<<stdlib.ml:572:30>>*/ var
     do_domain_local_at_exit =
       [0,
        function(param){
-         /*<<stdlib.ml:572:45>>*/ return 0;
+         /*<<stdlib.ml:572:45>>*/ return 0 /*<<stdlib.ml:572:45>>*/ ;
         /*<<stdlib.ml:572:47>>*/ }];
    function do_at_exit(param){
      /*<<stdlib.ml:575:2>>*/  /*<<stdlib.ml:575:2>>*/ caml_call1
      (do_domain_local_at_exit[1], 0);
      /*<<stdlib.ml:575:2>>*/ return  /*<<stdlib.ml:575:2>>*/ caml_call1
-            (caml_atomic_load(exit_function), 0);
+            (caml_atomic_load(exit_function), 0) /*<<stdlib.ml:576:31>>*/ ;
     /*<<stdlib.ml:576:31>>*/ }
    function exit(retcode){
      /*<<stdlib.ml:579:2>>*/ do_at_exit(0);
      /*<<stdlib.ml:580:2>>*/ return  /*<<stdlib.ml:580:2>>*/ runtime.caml_sys_exit
-            (retcode);
+            (retcode) /*<<stdlib.ml:580:18>>*/ ;
     /*<<stdlib.ml:580:18>>*/ }
     /*<<stdlib.ml:582:8>>*/  /*<<stdlib.ml:582:8>>*/ runtime.caml_register_named_value
     ("Pervasives.do_at_exit", do_at_exit);
@@ -994,60 +1002,62 @@
             : runtime.caml_call_gen(f, [a0, a1]);
    }
    function left(v){
-     /*<<either.ml:18:13>>*/ return [0, v];
+     /*<<either.ml:18:13>>*/ return [0, v] /*<<either.ml:18:13>>*/ ;
     /*<<either.ml:18:19>>*/ }
    function right(v){
-     /*<<either.ml:19:14>>*/ return [1, v];
+     /*<<either.ml:19:14>>*/ return [1, v] /*<<either.ml:19:14>>*/ ;
     /*<<either.ml:19:21>>*/ }
    function is_left(param){
-     /*<<either.ml:21:14>>*/ return 0 === param[0] ? 1 : 0;
+     /*<<either.ml:21:14>>*/ return 0 === param[0] ? 1 : 0 /*<<either.ml:23:18>>*/ ;
     /*<<either.ml:23:18>>*/ }
    function is_right(param){
-     /*<<either.ml:25:15>>*/ return 0 === param[0] ? 0 : 1;
+     /*<<either.ml:25:15>>*/ return 0 === param[0] ? 0 : 1 /*<<either.ml:27:17>>*/ ;
     /*<<either.ml:27:17>>*/ }
    function find_left(param){
      /*<<either.ml:29:16>>*/ if(0 !== param[0])
-      /*<<either.ml:31:13>>*/ return 0;
+      /*<<either.ml:31:13>>*/ return 0 /*<<either.ml:31:13>>*/ ;
     var v = param[1];
-     /*<<either.ml:30:12>>*/ return [0, v];
+     /*<<either.ml:30:12>>*/ return [0, v] /*<<either.ml:30:12>>*/ ;
     /*<<either.ml:31:17>>*/ }
    function find_right(param){
      /*<<either.ml:33:17>>*/ if(0 === param[0])
-      /*<<either.ml:34:12>>*/ return 0;
+      /*<<either.ml:34:12>>*/ return 0 /*<<either.ml:34:12>>*/ ;
     var v = param[1];
-     /*<<either.ml:35:13>>*/ return [0, v];
+     /*<<either.ml:35:13>>*/ return [0, v] /*<<either.ml:35:13>>*/ ;
     /*<<either.ml:35:19>>*/ }
    function map_left(f, e){
-     /*<<?>>*/ if(0 !== e[0])  /*<<either.ml:39:18>>*/ return e;
+     /*<<?>>*/ if(0 !== e[0])
+      /*<<either.ml:39:18>>*/ return e /*<<either.ml:39:18>>*/ ;
     var v = e[1];
      /*<<either.ml:38:12>>*/ return [0,
-             /*<<either.ml:38:17>>*/ caml_call1(f, v)];
+             /*<<either.ml:38:17>>*/ caml_call1(f, v)] /*<<either.ml:38:12>>*/ ;
    }
    function map_right(f, e){
-     /*<<?>>*/ if(0 === e[0])  /*<<either.ml:42:17>>*/ return e;
+     /*<<?>>*/ if(0 === e[0])
+      /*<<either.ml:42:17>>*/ return e /*<<either.ml:42:17>>*/ ;
     var v = e[1];
      /*<<either.ml:43:13>>*/ return [1,
-             /*<<either.ml:43:19>>*/ caml_call1(f, v)];
+             /*<<either.ml:43:19>>*/ caml_call1(f, v)] /*<<either.ml:43:13>>*/ ;
    }
    function map(left, right, param){
      /*<<?>>*/ if(0 === param[0]){
      var v = param[1];
       /*<<either.ml:46:12>>*/ return [0,
-              /*<<either.ml:46:17>>*/ caml_call1(left, v)];
+              /*<<either.ml:46:17>>*/ caml_call1(left, v)] /*<<either.ml:46:12>>*/ ;
     }
     var v$0 = param[1];
      /*<<either.ml:47:13>>*/ return [1,
-             /*<<either.ml:47:19>>*/ caml_call1(right, v$0)];
+             /*<<either.ml:47:19>>*/ caml_call1(right, v$0)] /*<<either.ml:47:13>>*/ ;
    }
    function fold(left, right, param){
      /*<<?>>*/ if(0 === param[0]){
      var v = param[1];
       /*<<either.ml:50:12>>*/ return  /*<<either.ml:50:12>>*/ caml_call1
-             (left, v);
+             (left, v) /*<<either.ml:50:12>>*/ ;
     }
     var v$0 = param[1];
      /*<<either.ml:51:13>>*/ return  /*<<either.ml:51:13>>*/ caml_call1
-            (right, v$0);
+            (right, v$0) /*<<either.ml:51:13>>*/ ;
    }
    function equal(left, right, e1, e2){
      /*<<either.ml:57:31>>*/ if(0 === e1[0]){
@@ -1055,7 +1065,7 @@
      if(0 === e2[0]){
       var v2 = e2[1];
        /*<<either.ml:58:22>>*/ return  /*<<either.ml:58:22>>*/ caml_call2
-              (left, v1, v2);
+              (left, v1, v2) /*<<either.ml:60:44>>*/ ;
      }
     }
     else{
@@ -1063,24 +1073,26 @@
      if(0 !== e2[0]){
       var v2$0 = e2[1];
        /*<<either.ml:59:24>>*/ return  /*<<either.ml:59:24>>*/ caml_call2
-              (right, v1$0, v2$0);
+              (right, v1$0, v2$0) /*<<either.ml:60:44>>*/ ;
      }
     }
-     /*<<either.ml:60:39>>*/ return 0;
+     /*<<either.ml:60:39>>*/ return 0 /*<<either.ml:60:39>>*/ ;
     /*<<either.ml:60:44>>*/ }
    function compare(left, right, e1, e2){
      /*<<either.ml:62:33>>*/ if(0 === e1[0]){
      var v1 = e1[1];
-     if(0 !== e2[0])  /*<<either.ml:65:21>>*/ return -1;
+     if(0 !== e2[0])
+       /*<<either.ml:65:21>>*/ return -1 /*<<either.ml:65:21>>*/ ;
      var v2 = e2[1];
       /*<<either.ml:63:22>>*/ return  /*<<either.ml:63:22>>*/ caml_call2
-             (left, v1, v2);
+             (left, v1, v2) /*<<either.ml:66:22>>*/ ;
     }
     var v1$0 = e1[1];
-    if(0 === e2[0])  /*<<either.ml:66:21>>*/ return 1;
+    if(0 === e2[0])
+      /*<<either.ml:66:21>>*/ return 1 /*<<either.ml:66:21>>*/ ;
     var v2$0 = e2[1];
      /*<<either.ml:64:24>>*/ return  /*<<either.ml:64:24>>*/ caml_call2
-            (right, v1$0, v2$0);
+            (right, v1$0, v2$0) /*<<either.ml:66:22>>*/ ;
     /*<<either.ml:66:22>>*/ }
    var
     Stdlib_Either =
@@ -1131,23 +1143,27 @@
      /*<<sys.ml.in:60:2>>*/ try{
       /*<<sys.ml.in:60:6>>*/  /*<<sys.ml.in:60:6>>*/ var
       _d_ = [0,  /*<<sys.ml.in:60:11>>*/ runtime.caml_sys_getenv(s)];
-      /*<<sys.ml.in:60:6>>*/ return _d_;
+      /*<<sys.ml.in:60:6>>*/ return _d_ /*<<sys.ml.in:60:6>>*/ ;
     }
     catch(_e_){
      var _c_ = caml_wrap_exception(_e_);
-     if(_c_ === Stdlib[8])  /*<<sys.ml.in:61:20>>*/ return 0;
+     if(_c_ === Stdlib[8])
+       /*<<sys.ml.in:61:20>>*/ return 0 /*<<sys.ml.in:61:20>>*/ ;
      throw caml_maybe_attach_backtrace(_c_, 0);
     }
     /*<<sys.ml.in:61:24>>*/ }
     /*<<sys.ml.in:72:18>>*/  /*<<sys.ml.in:72:18>>*/ var interactive = [0, 0];
-   function set_signal(sig_num, sig_beh){ /*<<sys.ml.in:82:33>>*/ return 0;
+   function set_signal(sig_num, sig_beh){
+     /*<<sys.ml.in:82:33>>*/ return 0 /*<<sys.ml.in:82:39>>*/ ;
     /*<<sys.ml.in:82:63>>*/ }
     /*<<sys.ml.in:113:0>>*/  /*<<sys.ml.in:113:0>>*/ var
     Break = [248, "Stdlib.Sys.Break", runtime.caml_fresh_oo_id(0)];
    function catch_break(on){
-     /*<<sys.ml.in:116:2>>*/ return on ? 0 : 0;
+     /*<<sys.ml.in:116:2>>*/ return on ? 0 : 0 /*<<sys.ml.in:119:36>>*/ ;
     /*<<sys.ml.in:119:36>>*/ }
-   function Make(_b_, _a_){ /*<<sys.ml.in:163:70>>*/ return [0, 1];}
+   function Make(_b_, _a_){
+     /*<<sys.ml.in:163:70>>*/ return [0, 1] /*<<sys.ml.in:163:70>>*/ ;
+   }
     /*<<sys.ml.in:155:21>>*/ var
      /*<<sys.ml.in:155:21>>*/ Immediate64 = [0, Make],
     Stdlib_Sys =
@@ -1231,11 +1247,11 @@
      /*<<obj.ml:26:34>>*/ return 1 - (typeof a === "number" ? 1 : 0);
     /*<<obj.ml:26:48>>*/ }
    function double_field(x, i){
-     /*<<obj.ml:35:40>>*/ return caml_check_bound(x, i)[1 + i];
+     /*<<obj.ml:35:40>>*/ return caml_check_bound(x, i)[1 + i] /*<<obj.ml:35:40>>*/ ;
     /*<<obj.ml:35:77>>*/ }
    function set_double_field(x, i, v){
      /*<<obj.ml:37:2>>*/ caml_check_bound(x, i)[1 + i] = v;
-     /*<<obj.ml:37:2>>*/ return 0;
+     /*<<obj.ml:37:2>>*/ return 0 /*<<obj.ml:37:2>>*/ ;
     /*<<obj.ml:37:41>>*/ }
    var
     cst_Obj_extension_constructor = cst_Obj_extension_constructor$1,
@@ -1260,13 +1276,13 @@
     return  /*<<obj.ml:84:9>>*/ caml_obj_tag(name) === 252
             ? slot
             :  /*<<obj.ml:85:11>>*/ caml_call1
-              (Stdlib[1], cst_Obj_extension_constructor);
+              (Stdlib[1], cst_Obj_extension_constructor) /*<<obj.ml:85:50>>*/ ;
     /*<<obj.ml:85:50>>*/ }
    function name(slot){
-     /*<<obj.ml:88:5>>*/ return slot[1];
+     /*<<obj.ml:88:5>>*/ return slot[1] /*<<obj.ml:88:9>>*/ ;
     /*<<obj.ml:88:30>>*/ }
    function id(slot){
-     /*<<obj.ml:91:5>>*/ return slot[2];
+     /*<<obj.ml:91:5>>*/ return slot[2] /*<<obj.ml:91:9>>*/ ;
     /*<<obj.ml:91:30>>*/ }
     /*<<obj.ml:72:0>>*/ var
      /*<<obj.ml:72:0>>*/ Extension_constructor = [0, of_val, name, id],
@@ -1286,7 +1302,7 @@
       /*<<obj.ml:106:6>>*/  /*<<obj.ml:106:6>>*/ caml_call1
       (Stdlib[1], cst_Obj_Ephemeron_create);
      /*<<obj.ml:107:4>>*/ return  /*<<obj.ml:107:4>>*/ runtime.caml_ephe_create
-            (l);
+            (l) /*<<obj.ml:107:12>>*/ ;
     /*<<obj.ml:107:12>>*/ }
    function length(x){
      /*<<obj.ml:109:17>>*/ return x.length - 3 | 0;
@@ -1296,37 +1312,37 @@
      _c_ = 0 <= o ? 1 : 0,
      _d_ = _c_ ? o < length(e) ? 1 : 0 : _c_,
      _e_ = 1 - _d_;
-    return _e_ ?  /*<<obj.ml:113:6>>*/ caml_call1(Stdlib[1], msg) : _e_;
+    return _e_ ?  /*<<obj.ml:113:6>>*/ caml_call1(Stdlib[1], msg) : _e_ /*<<obj.ml:113:21>>*/ ;
     /*<<obj.ml:113:21>>*/ }
    function get_key(e, o){
      /*<<obj.ml:117:4>>*/ raise_if_invalid_offset
      (e, o, cst_Obj_Ephemeron_get_key);
      /*<<obj.ml:118:4>>*/ return  /*<<obj.ml:118:4>>*/ runtime.caml_ephe_get_key
-            (e, o);
+            (e, o) /*<<obj.ml:118:15>>*/ ;
     /*<<obj.ml:118:15>>*/ }
    function get_key_copy(e, o){
      /*<<obj.ml:122:4>>*/ raise_if_invalid_offset
      (e, o, cst_Obj_Ephemeron_get_key_copy);
      /*<<obj.ml:123:4>>*/ return  /*<<obj.ml:123:4>>*/ runtime.caml_ephe_get_key_copy
-            (e, o);
+            (e, o) /*<<obj.ml:123:20>>*/ ;
     /*<<obj.ml:123:20>>*/ }
    function set_key(e, o, x){
      /*<<obj.ml:127:4>>*/ raise_if_invalid_offset
      (e, o, cst_Obj_Ephemeron_set_key);
      /*<<obj.ml:128:4>>*/ return  /*<<obj.ml:128:4>>*/ runtime.caml_ephe_set_key
-            (e, o, x);
+            (e, o, x) /*<<obj.ml:128:17>>*/ ;
     /*<<obj.ml:128:17>>*/ }
    function unset_key(e, o){
      /*<<obj.ml:132:4>>*/ raise_if_invalid_offset
      (e, o, cst_Obj_Ephemeron_unset_key);
      /*<<obj.ml:133:4>>*/ return  /*<<obj.ml:133:4>>*/ runtime.caml_ephe_unset_key
-            (e, o);
+            (e, o) /*<<obj.ml:133:17>>*/ ;
     /*<<obj.ml:133:17>>*/ }
    function check_key(e, o){
      /*<<obj.ml:137:4>>*/ raise_if_invalid_offset
      (e, o, cst_Obj_Ephemeron_check_key);
      /*<<obj.ml:138:4>>*/ return  /*<<obj.ml:138:4>>*/ runtime.caml_ephe_check_key
-            (e, o);
+            (e, o) /*<<obj.ml:138:17>>*/ ;
     /*<<obj.ml:138:17>>*/ }
    function blit_key(e1, o1, e2, o2, l){
      /*<<obj.ml:144:4>>*/ if
@@ -1341,10 +1357,10 @@
          ?  /*<<obj.ml:147:24>>*/ runtime.caml_ephe_blit_key
            (e1, o1, e2, o2, l)
          : _a_;
-      /*<<obj.ml:147:24>>*/ return _b_;
+      /*<<obj.ml:147:24>>*/ return _b_ /*<<obj.ml:147:24>>*/ ;
     }
      /*<<obj.ml:146:9>>*/ return  /*<<obj.ml:146:9>>*/ caml_call1
-            (Stdlib[1], cst_Obj_Ephemeron_blit_key);
+            (Stdlib[1], cst_Obj_Ephemeron_blit_key) /*<<obj.ml:147:46>>*/ ;
     /*<<obj.ml:147:46>>*/ }
    var
     Stdlib_Obj =
@@ -1411,16 +1427,16 @@
    function make(param){
      /*<<type.ml:32:4>>*/  /*<<type.ml:32:43>>*/ var
      Id = [248, cst_Id, runtime.caml_fresh_oo_id(0)];
-     /*<<type.ml:32:12>>*/ return [0, Id];
+     /*<<type.ml:32:12>>*/ return [0, Id] /*<<type.ml:32:12>>*/ ;
     /*<<type.ml:32:57>>*/ }
    function uid(A){
      /*<<type.ml:35:4>>*/  /*<<type.ml:35:33>>*/ var
      _b_ =  /*<<type.ml:35:33>>*/ caml_call1(Stdlib_Obj[22][1], A[1]);
      /*<<type.ml:35:33>>*/ return  /*<<type.ml:35:33>>*/ caml_call1
-            (Stdlib_Obj[22][3], _b_);
+            (Stdlib_Obj[22][3], _b_) /*<<type.ml:35:72>>*/ ;
     /*<<type.ml:35:72>>*/ }
    function provably_equal(A, B){
-     /*<<type.ml:40:4>>*/ return A[1] === B[1] ? _a_ : 0;
+     /*<<type.ml:40:4>>*/ return A[1] === B[1] ? _a_ : 0 /*<<type.ml:40:50>>*/ ;
     /*<<type.ml:40:50>>*/ }
     /*<<type.ml:22:12>>*/ var
      /*<<type.ml:22:12>>*/ Id = [0, make, uid, provably_equal],
@@ -1452,7 +1468,9 @@
    var
     Stdlib_Atomic =
       [0,
-       function(_a_){ /*<<atomic.ml:17:0>>*/ return [0, _a_];},
+       function(_a_){
+         /*<<atomic.ml:17:0>>*/ return [0, _a_] /*<<atomic.ml:17:0>>*/ ;
+       },
        runtime.caml_atomic_make_contended,
        runtime.caml_atomic_load,
        set,
@@ -1503,7 +1521,7 @@
       /*<<camlinternalLazy.ml:64:2>>*/ blk[1] = result$0;
       /*<<camlinternalLazy.ml:65:2>>*/  /*<<camlinternalLazy.ml:65:2>>*/ caml_lazy_update_to_forward
       (blk);
-      /*<<camlinternalLazy.ml:65:2>>*/ return result$0;
+      /*<<camlinternalLazy.ml:65:2>>*/ return result$0 /*<<camlinternalLazy.ml:65:2>>*/ ;
     }
      /*<<camlinternalLazy.ml:46:25>>*/  /*<<camlinternalLazy.ml:46:25>>*/ var
      closure = blk[1];
@@ -1514,7 +1532,7 @@
       /*<<camlinternalLazy.ml:50:4>>*/ blk[1] = result;
       /*<<camlinternalLazy.ml:51:4>>*/  /*<<camlinternalLazy.ml:51:4>>*/ caml_lazy_update_to_forward
       (blk);
-      /*<<camlinternalLazy.ml:51:4>>*/ return result;
+      /*<<camlinternalLazy.ml:51:4>>*/ return result /*<<camlinternalLazy.ml:51:4>>*/ ;
     }
     catch(e$0){
      var e = caml_wrap_exception(e$0);
@@ -1530,17 +1548,17 @@
     }
     /*<<camlinternalLazy.ml:75:24>>*/ }
    function force_lazy_block(blk){
-     /*<<camlinternalLazy.ml:78:27>>*/ return force_gen_lazy_block(0, blk);
+     /*<<camlinternalLazy.ml:78:27>>*/ return force_gen_lazy_block(0, blk) /*<<camlinternalLazy.ml:78:67>>*/ ;
     /*<<camlinternalLazy.ml:78:67>>*/ }
    function force_gen(only_val, lzv){
      /*<<camlinternalLazy.ml:93:2>>*/  /*<<camlinternalLazy.ml:99:10>>*/ var
      t =  /*<<camlinternalLazy.ml:99:10>>*/ runtime.caml_obj_tag(lzv);
     if(t === Stdlib_Obj[12])
-      /*<<camlinternalLazy.ml:101:13>>*/ return lzv[1];
+      /*<<camlinternalLazy.ml:101:13>>*/ return lzv[1] /*<<camlinternalLazy.ml:101:13>>*/ ;
     if(t === Stdlib_Obj[6])
       /*<<camlinternalLazy.ml:103:35>>*/ throw  /*<<camlinternalLazy.ml:103:35>>*/ caml_maybe_attach_backtrace
             (Undefined, 1);
-    return t !== Stdlib_Obj[8] ? lzv : force_gen_lazy_block(only_val, lzv);
+    return t !== Stdlib_Obj[8] ? lzv : force_gen_lazy_block(only_val, lzv) /*<<camlinternalLazy.ml:105:41>>*/ ;
     /*<<camlinternalLazy.ml:105:41>>*/ }
    var CamlinternalLazy = [0, Undefined, force_lazy_block, force_gen];
    runtime.caml_register_global(2, CamlinternalLazy, "CamlinternalLazy");
@@ -1571,13 +1589,13 @@
     Undefined = CamlinternalLazy[1];
    function force_val(l){
      /*<<lazy.ml:56:18>>*/ return  /*<<lazy.ml:56:18>>*/ caml_call2
-            (CamlinternalLazy[3], 1, l);
+            (CamlinternalLazy[3], 1, l) /*<<lazy.ml:56:61>>*/ ;
     /*<<lazy.ml:56:61>>*/ }
    function from_fun(f){
      /*<<lazy.ml:59:2>>*/  /*<<lazy.ml:59:10>>*/ var
      x =  /*<<lazy.ml:59:10>>*/ runtime.caml_obj_block(Stdlib_Obj[8], 1);
      /*<<lazy.ml:60:2>>*/ x[1] = f;
-     /*<<lazy.ml:60:2>>*/ return x;
+     /*<<lazy.ml:60:2>>*/ return x /*<<lazy.ml:60:2>>*/ ;
     /*<<lazy.ml:61:22>>*/ }
    function from_val(v){
      /*<<lazy.ml:64:2>>*/  /*<<lazy.ml:64:10>>*/ var
@@ -1585,16 +1603,16 @@
     if
      (t !== Stdlib_Obj[12]
       && t !== Stdlib_Obj[8] && t !== Stdlib_Obj[6] && t !== Stdlib_Obj[16])
-      /*<<lazy.ml:69:5>>*/ return v;
+      /*<<lazy.ml:69:5>>*/ return v /*<<lazy.ml:69:5>>*/ ;
      /*<<lazy.ml:66:52>>*/ return  /*<<lazy.ml:66:52>>*/ runtime.caml_lazy_make_forward
-            (v);
+            (v) /*<<lazy.ml:70:5>>*/ ;
     /*<<lazy.ml:70:5>>*/ }
    function is_val(l){
      /*<<lazy.ml:72:26>>*/  /*<<lazy.ml:72:26>>*/ var _i_ = Stdlib_Obj[8];
      /*<<lazy.ml:72:26>>*/ return  /*<<lazy.ml:72:26>>*/ caml_obj_tag(l)
             !== _i_
             ? 1
-            : 0;
+            : 0 /*<<lazy.ml:72:26>>*/ ;
     /*<<lazy.ml:72:62>>*/ }
    function map(f, x){
      /*<<lazy.ml:75:2>>*/ return [246,
@@ -1608,8 +1626,8 @@
               var _h_ = caml_call1(CamlinternalLazy[2], x);
              }
               /*<<lazy.ml:75:10>>*/ return  /*<<lazy.ml:75:10>>*/ caml_call1
-                     (f, _h_);
-            }];
+                     (f, _h_) /*<<lazy.ml:75:10>>*/ ;
+            }] /*<<lazy.ml:75:7>>*/ ;
     /*<<lazy.ml:75:20>>*/ }
    function map_val(f, x){
      /*<<lazy.ml:78:2>>*/ if(! is_val(x))
@@ -1624,8 +1642,8 @@
                var _e_ = caml_call1(CamlinternalLazy[2], x);
               }
                /*<<lazy.ml:80:15>>*/ return  /*<<lazy.ml:80:15>>*/ caml_call1
-                      (f, _e_);
-             }];
+                      (f, _e_) /*<<lazy.ml:80:15>>*/ ;
+             }] /*<<lazy.ml:80:12>>*/ ;
     var _a_ = caml_obj_tag(x);
     a:
     if(250 === _a_)
@@ -1635,7 +1653,7 @@
      var _b_ = caml_call1(CamlinternalLazy[2], x);
     }
      /*<<lazy.ml:79:16>>*/ return from_val
-            ( /*<<lazy.ml:79:16>>*/ caml_call1(f, _b_));
+            ( /*<<lazy.ml:79:16>>*/ caml_call1(f, _b_)) /*<<lazy.ml:80:25>>*/ ;
     /*<<lazy.ml:80:25>>*/ }
    var
     Stdlib_Lazy =
@@ -1679,39 +1697,39 @@
     cst_Seq_take = "Seq.take",
     cst_Seq_drop = "Seq.drop";
    function empty(param){
-     /*<<seq.ml:24:15>>*/ return 0;
+     /*<<seq.ml:24:15>>*/ return 0 /*<<seq.ml:24:15>>*/ ;
     /*<<seq.ml:24:18>>*/ }
    function return$0(x, param){
-     /*<<seq.ml:26:18>>*/ return [0, x, empty];
+     /*<<seq.ml:26:18>>*/ return [0, x, empty] /*<<seq.ml:26:18>>*/ ;
     /*<<seq.ml:26:33>>*/ }
    function cons(x, next, param){
-     /*<<seq.ml:28:21>>*/ return [0, x, next];
+     /*<<seq.ml:28:21>>*/ return [0, x, next] /*<<seq.ml:28:21>>*/ ;
     /*<<seq.ml:28:35>>*/ }
    function append(seq1, seq2, param){
      /*<<seq.ml:31:2>>*/  /*<<seq.ml:31:8>>*/ var
      match =  /*<<seq.ml:31:8>>*/ caml_call1(seq1, 0);
     if(! match)
-      /*<<seq.ml:32:11>>*/ return  /*<<seq.ml:32:11>>*/ caml_call1(seq2, 0);
+      /*<<seq.ml:32:11>>*/ return  /*<<seq.ml:32:11>>*/ caml_call1(seq2, 0) /*<<seq.ml:33:48>>*/ ;
     var next = match[2], x = match[1];
      /*<<seq.ml:33:22>>*/ return [0,
             x,
-            function(_au_){ /*<<?>>*/ return append(next, seq2, _au_);}];
+            function(_au_){ /*<<?>>*/ return append(next, seq2, _au_);}] /*<<seq.ml:33:22>>*/ ;
     /*<<seq.ml:33:48>>*/ }
    function map(f, seq, param){
      /*<<seq.ml:35:23>>*/  /*<<seq.ml:35:29>>*/ var
      match =  /*<<seq.ml:35:29>>*/ caml_call1(seq, 0);
-    if(! match)  /*<<seq.ml:36:11>>*/ return 0;
+    if(! match)  /*<<seq.ml:36:11>>*/ return 0 /*<<seq.ml:36:11>>*/ ;
     var next = match[2], x = match[1];
      /*<<seq.ml:37:22>>*/ return [0,
              /*<<seq.ml:37:28>>*/ caml_call1(f, x),
-            function(_at_){ /*<<?>>*/ return map(f, next, _at_);}];
+            function(_at_){ /*<<?>>*/ return map(f, next, _at_);}] /*<<seq.ml:37:22>>*/ ;
     /*<<seq.ml:37:44>>*/ }
    function filter_map(f, seq, param){
      /*<<seq.ml:39:30>>*/ var seq$0 = seq;
      /*<<seq.ml:39:30>>*/ for(;;){
       /*<<seq.ml:39:36>>*/  /*<<seq.ml:39:36>>*/ var
       match =  /*<<seq.ml:39:36>>*/ caml_call1(seq$0, 0);
-     if(! match)  /*<<seq.ml:40:11>>*/ return 0;
+     if(! match)  /*<<seq.ml:40:11>>*/ return 0 /*<<seq.ml:40:11>>*/ ;
       /*<<seq.ml:42:12>>*/ var
       next = match[2],
       x = match[1],
@@ -1720,7 +1738,7 @@
       var y = match$0[1];
        /*<<seq.ml:44:20>>*/ return [0,
               y,
-              function(_as_){ /*<<?>>*/ return filter_map(f, next, _as_);}];
+              function(_as_){ /*<<?>>*/ return filter_map(f, next, _as_);}] /*<<seq.ml:44:20>>*/ ;
      }
      seq$0 = next;
     }
@@ -1730,39 +1748,39 @@
      /*<<seq.ml:46:26>>*/ for(;;){
       /*<<seq.ml:46:32>>*/  /*<<seq.ml:46:32>>*/ var
       match =  /*<<seq.ml:46:32>>*/ caml_call1(seq$0, 0);
-     if(! match)  /*<<seq.ml:47:11>>*/ return 0;
+     if(! match)  /*<<seq.ml:47:11>>*/ return 0 /*<<seq.ml:47:11>>*/ ;
      var next = match[2], x = match[1];
       /*<<seq.ml:49:9>>*/ if( /*<<seq.ml:49:9>>*/ caml_call1(f, x))
        /*<<seq.ml:50:11>>*/ return [0,
               x,
-              function(_ar_){ /*<<?>>*/ return filter(f, next, _ar_);}];
+              function(_ar_){ /*<<?>>*/ return filter(f, next, _ar_);}] /*<<seq.ml:50:11>>*/ ;
      seq$0 = next;
     }
     /*<<seq.ml:51:27>>*/ }
    function concat(seq, param){
      /*<<seq.ml:53:24>>*/  /*<<seq.ml:53:30>>*/ var
      match =  /*<<seq.ml:53:30>>*/ caml_call1(seq, 0);
-    if(! match)  /*<<seq.ml:54:11>>*/ return 0;
+    if(! match)  /*<<seq.ml:54:11>>*/ return 0 /*<<seq.ml:54:11>>*/ ;
     var next = match[2], x = match[1];
      /*<<seq.ml:56:5>>*/ return append
-            (x, function(_aq_){ /*<<?>>*/ return concat(next, _aq_);}, 0);
+            (x, function(_aq_){ /*<<?>>*/ return concat(next, _aq_);}, 0) /*<<seq.ml:56:30>>*/ ;
     /*<<seq.ml:56:30>>*/ }
    function flat_map(f, seq, param){
      /*<<seq.ml:58:28>>*/  /*<<seq.ml:58:34>>*/ var
      match =  /*<<seq.ml:58:34>>*/ caml_call1(seq, 0);
-    if(! match)  /*<<seq.ml:59:11>>*/ return 0;
+    if(! match)  /*<<seq.ml:59:11>>*/ return 0 /*<<seq.ml:59:11>>*/ ;
     var next = match[2], x = match[1];
      /*<<seq.ml:61:4>>*/ return append
             ( /*<<seq.ml:61:11>>*/ caml_call1(f, x),
              function(_ap_){ /*<<?>>*/ return flat_map(f, next, _ap_);},
-             0);
+             0) /*<<seq.ml:61:37>>*/ ;
     /*<<seq.ml:61:37>>*/ }
    function fold_left(f, acc, seq){
      /*<<seq.ml:66:2>>*/ var acc$0 = acc, seq$0 = seq;
      /*<<seq.ml:66:2>>*/ for(;;){
       /*<<seq.ml:66:8>>*/  /*<<seq.ml:66:8>>*/ var
       match =  /*<<seq.ml:66:8>>*/ caml_call1(seq$0, 0);
-     if(! match)  /*<<seq.ml:67:13>>*/ return acc$0;
+     if(! match)  /*<<seq.ml:67:13>>*/ return acc$0 /*<<seq.ml:67:13>>*/ ;
       /*<<seq.ml:69:18>>*/ var
       next = match[2],
       x = match[1],
@@ -1777,7 +1795,7 @@
      /*<<seq.ml:73:2>>*/ for(;;){
       /*<<seq.ml:73:8>>*/  /*<<seq.ml:73:8>>*/ var
       match =  /*<<seq.ml:73:8>>*/ caml_call1(seq$0, 0);
-     if(! match)  /*<<seq.ml:74:13>>*/ return 0;
+     if(! match)  /*<<seq.ml:74:13>>*/ return 0 /*<<seq.ml:74:13>>*/ ;
      var next = match[2], x = match[1];
       /*<<seq.ml:76:8>>*/  /*<<seq.ml:76:8>>*/ caml_call1(f, x);
      seq$0 = next;
@@ -1786,28 +1804,28 @@
    function unfold(f, u, param){
      /*<<seq.ml:80:2>>*/  /*<<seq.ml:80:8>>*/ var
      match =  /*<<seq.ml:80:8>>*/ caml_call1(f, u);
-    if(! match)  /*<<seq.ml:81:12>>*/ return 0;
+    if(! match)  /*<<seq.ml:81:12>>*/ return 0 /*<<seq.ml:81:12>>*/ ;
     var match$0 = match[1], u$0 = match$0[2], x = match$0[1];
      /*<<seq.ml:82:20>>*/ return [0,
             x,
-            function(_ao_){ /*<<?>>*/ return unfold(f, u$0, _ao_);}];
+            function(_ao_){ /*<<?>>*/ return unfold(f, u$0, _ao_);}] /*<<seq.ml:82:20>>*/ ;
     /*<<seq.ml:82:41>>*/ }
    function is_empty(xs){
-     /*<<seq.ml:85:2>>*/ return  /*<<seq.ml:85:8>>*/ caml_call1(xs, 0) ? 0 : 1;
+     /*<<seq.ml:85:2>>*/ return  /*<<seq.ml:85:8>>*/ caml_call1(xs, 0) ? 0 : 1 /*<<seq.ml:89:11>>*/ ;
     /*<<seq.ml:89:11>>*/ }
    function uncons(xs){
      /*<<seq.ml:92:2>>*/  /*<<seq.ml:92:8>>*/ var
      match =  /*<<seq.ml:92:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:96:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:96:6>>*/ return 0 /*<<seq.ml:96:6>>*/ ;
     var xs$0 = match[2], x = match[1];
-     /*<<seq.ml:94:6>>*/ return [0, [0, x, xs$0]];
+     /*<<seq.ml:94:6>>*/ return [0, [0, x, xs$0]] /*<<seq.ml:94:6>>*/ ;
     /*<<seq.ml:96:10>>*/ }
    function length(xs$1){
      /*<<seq.ml:108:2>>*/ var accu = 0, xs = xs$1;
      /*<<seq.ml:101:2>>*/ for(;;){
       /*<<seq.ml:101:8>>*/  /*<<seq.ml:101:8>>*/ var
       match =  /*<<seq.ml:101:8>>*/ caml_call1(xs, 0);
-     if(! match)  /*<<seq.ml:103:6>>*/ return accu;
+     if(! match)  /*<<seq.ml:103:6>>*/ return accu /*<<seq.ml:103:6>>*/ ;
       /*<<seq.ml:105:6>>*/ var
       xs$0 = match[2],
        /*<<seq.ml:105:6>>*/ accu$0 = accu + 1 | 0;
@@ -1820,7 +1838,7 @@
      /*<<seq.ml:111:2>>*/ for(;;){
       /*<<seq.ml:111:8>>*/  /*<<seq.ml:111:8>>*/ var
       match =  /*<<seq.ml:111:8>>*/ caml_call1(xs, 0);
-     if(! match)  /*<<seq.ml:113:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:113:6>>*/ return 0 /*<<seq.ml:113:6>>*/ ;
      var xs$0 = match[2], x = match[1];
       /*<<seq.ml:115:6>>*/  /*<<seq.ml:115:6>>*/ caml_call2(f, i, x);
      var i$0 = i + 1 | 0;
@@ -1833,7 +1851,7 @@
      /*<<seq.ml:122:2>>*/ for(;;){
       /*<<seq.ml:122:8>>*/  /*<<seq.ml:122:8>>*/ var
       match =  /*<<seq.ml:122:8>>*/ caml_call1(xs, 0);
-     if(! match)  /*<<seq.ml:124:6>>*/ return accu;
+     if(! match)  /*<<seq.ml:124:6>>*/ return accu /*<<seq.ml:124:6>>*/ ;
       /*<<seq.ml:126:17>>*/ var
       xs$0 = match[2],
       x = match[1],
@@ -1850,12 +1868,13 @@
      /*<<seq.ml:133:2>>*/ for(;;){
       /*<<seq.ml:133:8>>*/  /*<<seq.ml:133:8>>*/ var
       match =  /*<<seq.ml:133:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:135:6>>*/ return 1;
+     if(! match)  /*<<seq.ml:135:6>>*/ return 1 /*<<seq.ml:135:6>>*/ ;
       /*<<seq.ml:137:6>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:137:6>>*/ _an_ =  /*<<seq.ml:137:6>>*/ caml_call1(p, x);
-      /*<<seq.ml:137:6>>*/ if(! _an_)  /*<<seq.ml:137:6>>*/ return _an_;
+      /*<<seq.ml:137:6>>*/ if(! _an_)
+       /*<<seq.ml:137:6>>*/ return _an_ /*<<seq.ml:137:6>>*/ ;
      xs$0 = xs$1;
     }
     /*<<seq.ml:137:25>>*/ }
@@ -1864,12 +1883,13 @@
      /*<<seq.ml:140:2>>*/ for(;;){
       /*<<seq.ml:140:8>>*/  /*<<seq.ml:140:8>>*/ var
       match =  /*<<seq.ml:140:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:142:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:142:6>>*/ return 0 /*<<seq.ml:142:6>>*/ ;
       /*<<seq.ml:144:6>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:144:6>>*/ _am_ =  /*<<seq.ml:144:6>>*/ caml_call1(p, x);
-      /*<<seq.ml:144:6>>*/ if(_am_)  /*<<seq.ml:144:6>>*/ return _am_;
+      /*<<seq.ml:144:6>>*/ if(_am_)
+       /*<<seq.ml:144:6>>*/ return _am_ /*<<seq.ml:144:6>>*/ ;
      xs$0 = xs$1;
     }
     /*<<seq.ml:144:24>>*/ }
@@ -1878,10 +1898,10 @@
      /*<<seq.ml:147:2>>*/ for(;;){
       /*<<seq.ml:147:8>>*/  /*<<seq.ml:147:8>>*/ var
       match =  /*<<seq.ml:147:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:149:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:149:6>>*/ return 0 /*<<seq.ml:149:6>>*/ ;
      var xs$1 = match[2], x = match[1];
       /*<<seq.ml:151:9>>*/ if( /*<<seq.ml:151:9>>*/ caml_call1(p, x))
-       /*<<seq.ml:151:18>>*/ return [0, x];
+       /*<<seq.ml:151:18>>*/ return [0, x] /*<<seq.ml:151:18>>*/ ;
      xs$0 = xs$1;
     }
     /*<<seq.ml:151:39>>*/ }
@@ -1890,10 +1910,10 @@
      /*<<seq.ml:154:21>>*/ for(;;){
       /*<<seq.ml:154:27>>*/  /*<<seq.ml:154:27>>*/ var
       match =  /*<<seq.ml:154:27>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:156:8>>*/ return 0;
+     if(! match)  /*<<seq.ml:156:8>>*/ return 0 /*<<seq.ml:156:8>>*/ ;
      var xs$1 = match[2], x = match[1];
       /*<<seq.ml:158:11>>*/ if( /*<<seq.ml:158:11>>*/ caml_call1(p, x))
-       /*<<seq.ml:158:20>>*/ return [0, i];
+       /*<<seq.ml:158:20>>*/ return [0, i] /*<<seq.ml:158:20>>*/ ;
      var i$0 = i + 1 | 0;
      i = i$0;
      xs$0 = xs$1;
@@ -1904,12 +1924,12 @@
      /*<<seq.ml:162:2>>*/ for(;;){
       /*<<seq.ml:162:8>>*/  /*<<seq.ml:162:8>>*/ var
       match =  /*<<seq.ml:162:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:164:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:164:6>>*/ return 0 /*<<seq.ml:164:6>>*/ ;
       /*<<seq.ml:166:12>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:166:12>>*/ result =  /*<<seq.ml:166:12>>*/ caml_call1(f, x);
-     if(result)  /*<<seq.ml:170:10>>*/ return result;
+     if(result)  /*<<seq.ml:170:10>>*/ return result /*<<seq.ml:170:10>>*/ ;
      xs$0 = xs$1;
     }
     /*<<seq.ml:170:16>>*/ }
@@ -1918,13 +1938,13 @@
      /*<<seq.ml:173:21>>*/ for(;;){
       /*<<seq.ml:173:27>>*/  /*<<seq.ml:173:27>>*/ var
       match =  /*<<seq.ml:173:27>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:175:8>>*/ return 0;
+     if(! match)  /*<<seq.ml:175:8>>*/ return 0 /*<<seq.ml:175:8>>*/ ;
       /*<<seq.ml:177:14>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:177:14>>*/ result =
          /*<<seq.ml:177:14>>*/ caml_call2(f, i, x);
-     if(result)  /*<<seq.ml:181:12>>*/ return result;
+     if(result)  /*<<seq.ml:181:12>>*/ return result /*<<seq.ml:181:12>>*/ ;
      var i$0 = i + 1 | 0;
      i = i$0;
      xs$0 = xs$1;
@@ -1935,13 +1955,13 @@
      /*<<seq.ml:192:2>>*/ for(;;){
       /*<<seq.ml:192:8>>*/  /*<<seq.ml:192:8>>*/ var
       match =  /*<<seq.ml:192:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:194:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:194:6>>*/ return 0 /*<<seq.ml:194:6>>*/ ;
       /*<<seq.ml:196:12>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:196:12>>*/ match$0 =
          /*<<seq.ml:196:12>>*/ caml_call1(ys$0, 0);
-     if(! match$0)  /*<<seq.ml:198:10>>*/ return 0;
+     if(! match$0)  /*<<seq.ml:198:10>>*/ return 0 /*<<seq.ml:198:10>>*/ ;
      var ys$1 = match$0[2], y = match$0[1];
       /*<<seq.ml:200:10>>*/  /*<<seq.ml:200:10>>*/ caml_call2(f, x, y);
      xs$0 = xs$1;
@@ -1953,13 +1973,14 @@
      /*<<seq.ml:204:2>>*/ for(;;){
       /*<<seq.ml:204:8>>*/  /*<<seq.ml:204:8>>*/ var
       match =  /*<<seq.ml:204:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:206:6>>*/ return accu$0;
+     if(! match)  /*<<seq.ml:206:6>>*/ return accu$0 /*<<seq.ml:206:6>>*/ ;
       /*<<seq.ml:208:12>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:208:12>>*/ match$0 =
          /*<<seq.ml:208:12>>*/ caml_call1(ys$0, 0);
-     if(! match$0)  /*<<seq.ml:210:10>>*/ return accu$0;
+     if(! match$0)
+       /*<<seq.ml:210:10>>*/ return accu$0 /*<<seq.ml:210:10>>*/ ;
       /*<<seq.ml:212:21>>*/ var
       ys$1 = match$0[2],
       y = match$0[1],
@@ -1975,18 +1996,19 @@
      /*<<seq.ml:216:2>>*/ for(;;){
       /*<<seq.ml:216:8>>*/  /*<<seq.ml:216:8>>*/ var
       match =  /*<<seq.ml:216:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:218:6>>*/ return 1;
+     if(! match)  /*<<seq.ml:218:6>>*/ return 1 /*<<seq.ml:218:6>>*/ ;
       /*<<seq.ml:220:12>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:220:12>>*/ match$0 =
          /*<<seq.ml:220:12>>*/ caml_call1(ys$0, 0);
-     if(! match$0)  /*<<seq.ml:222:10>>*/ return 1;
+     if(! match$0)  /*<<seq.ml:222:10>>*/ return 1 /*<<seq.ml:222:10>>*/ ;
       /*<<seq.ml:224:10>>*/ var
       ys$1 = match$0[2],
       y = match$0[1],
        /*<<seq.ml:224:10>>*/ _al_ =  /*<<seq.ml:224:10>>*/ caml_call2(f, x, y);
-      /*<<seq.ml:224:10>>*/ if(! _al_)  /*<<seq.ml:224:10>>*/ return _al_;
+      /*<<seq.ml:224:10>>*/ if(! _al_)
+       /*<<seq.ml:224:10>>*/ return _al_ /*<<seq.ml:224:10>>*/ ;
      xs$0 = xs$1;
      ys$0 = ys$1;
     }
@@ -1996,18 +2018,19 @@
      /*<<seq.ml:227:2>>*/ for(;;){
       /*<<seq.ml:227:8>>*/  /*<<seq.ml:227:8>>*/ var
       match =  /*<<seq.ml:227:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:229:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:229:6>>*/ return 0 /*<<seq.ml:229:6>>*/ ;
       /*<<seq.ml:231:12>>*/ var
       xs$1 = match[2],
       x = match[1],
        /*<<seq.ml:231:12>>*/ match$0 =
          /*<<seq.ml:231:12>>*/ caml_call1(ys$0, 0);
-     if(! match$0)  /*<<seq.ml:233:10>>*/ return 0;
+     if(! match$0)  /*<<seq.ml:233:10>>*/ return 0 /*<<seq.ml:233:10>>*/ ;
       /*<<seq.ml:235:10>>*/ var
       ys$1 = match$0[2],
       y = match$0[1],
        /*<<seq.ml:235:10>>*/ _ak_ =  /*<<seq.ml:235:10>>*/ caml_call2(f, x, y);
-      /*<<seq.ml:235:10>>*/ if(_ak_)  /*<<seq.ml:235:10>>*/ return _ak_;
+      /*<<seq.ml:235:10>>*/ if(_ak_)
+       /*<<seq.ml:235:10>>*/ return _ak_ /*<<seq.ml:235:10>>*/ ;
      xs$0 = xs$1;
      ys$0 = ys$1;
     }
@@ -2028,14 +2051,15 @@
         x = match[1],
          /*<<seq.ml:242:6>>*/ _aj_ =
            /*<<seq.ml:242:6>>*/ caml_call2(eq, x, y);
-        /*<<seq.ml:242:6>>*/ if(! _aj_)  /*<<seq.ml:242:6>>*/ return _aj_;
+        /*<<seq.ml:242:6>>*/ if(! _aj_)
+         /*<<seq.ml:242:6>>*/ return _aj_ /*<<seq.ml:242:6>>*/ ;
        xs$0 = xs$1;
        ys$0 = ys$1;
        continue;
       }
      }
-     else if(! match$0)  /*<<seq.ml:240:6>>*/ return 1;
-      /*<<seq.ml:245:6>>*/ return 0;
+     else if(! match$0)  /*<<seq.ml:240:6>>*/ return 1 /*<<seq.ml:240:6>>*/ ;
+      /*<<seq.ml:245:6>>*/ return 0 /*<<seq.ml:245:6>>*/ ;
     }
     /*<<seq.ml:245:11>>*/ }
    function compare(cmp, xs, ys){
@@ -2045,107 +2069,109 @@
        /*<<seq.ml:248:8>>*/ match =  /*<<seq.ml:248:8>>*/ caml_call1(xs$0, 0),
        /*<<seq.ml:248:14>>*/ match$0 =
          /*<<seq.ml:248:14>>*/ caml_call1(ys$0, 0);
-     if(! match) return match$0 ? -1 : 0;
+     if(! match) return match$0 ? -1 : 0 /*<<seq.ml:257:8>>*/ ;
      var xs$1 = match[2], x = match[1];
-     if(! match$0)  /*<<seq.ml:257:6>>*/ return 1;
+     if(! match$0)  /*<<seq.ml:257:6>>*/ return 1 /*<<seq.ml:257:6>>*/ ;
       /*<<seq.ml:252:14>>*/ var
       ys$1 = match$0[2],
       y = match$0[1],
        /*<<seq.ml:252:14>>*/ c =  /*<<seq.ml:252:14>>*/ caml_call2(cmp, x, y);
-      /*<<seq.ml:253:6>>*/ if(0 !== c)  /*<<seq.ml:253:21>>*/ return c;
+      /*<<seq.ml:253:6>>*/ if(0 !== c)
+       /*<<seq.ml:253:21>>*/ return c /*<<seq.ml:253:21>>*/ ;
      xs$0 = xs$1;
      ys$0 = ys$1;
     }
     /*<<seq.ml:257:8>>*/ }
    function init_aux(f, i, j, param){
-     /*<<seq.ml:264:2>>*/ if(i >= j)  /*<<seq.ml:268:4>>*/ return 0;
+     /*<<seq.ml:264:2>>*/ if(i >= j)
+      /*<<seq.ml:268:4>>*/ return 0 /*<<seq.ml:268:4>>*/ ;
     var _ah_ = i + 1 | 0;
      /*<<seq.ml:264:16>>*/ return [0,
              /*<<seq.ml:265:10>>*/ caml_call1(f, i),
-            function(_ai_){ /*<<?>>*/ return init_aux(f, _ah_, j, _ai_);}];
+            function(_ai_){ /*<<?>>*/ return init_aux(f, _ah_, j, _ai_);}] /*<<seq.ml:264:16>>*/ ;
     /*<<seq.ml:268:7>>*/ }
    function init(n, f){
      /*<<seq.ml:271:2>>*/ if(0 > n)
       /*<<seq.ml:272:4>>*/ return  /*<<seq.ml:272:4>>*/ caml_call1
-             (Stdlib[1], cst_Seq_init);
+             (Stdlib[1], cst_Seq_init) /*<<seq.ml:274:18>>*/ ;
     var _af_ = 0;
      /*<<seq.ml:274:4>>*/ return function(_ag_){
-      /*<<?>>*/ return init_aux(f, _af_, n, _ag_);};
+      /*<<?>>*/ return init_aux(f, _af_, n, _ag_);} /*<<seq.ml:274:4>>*/ ;
     /*<<seq.ml:274:18>>*/ }
    function repeat(x, param){
      /*<<seq.ml:277:2>>*/ return [0,
             x,
-            function(_ae_){ /*<<?>>*/ return repeat(x, _ae_);}];
+            function(_ae_){ /*<<?>>*/ return repeat(x, _ae_);}] /*<<seq.ml:277:2>>*/ ;
     /*<<seq.ml:277:20>>*/ }
    function forever(f, param){
      /*<<seq.ml:280:2>>*/ return [0,
              /*<<seq.ml:280:8>>*/ caml_call1(f, 0),
-            function(_ad_){ /*<<?>>*/ return forever(f, _ad_);}];
+            function(_ad_){ /*<<?>>*/ return forever(f, _ad_);}] /*<<seq.ml:280:2>>*/ ;
     /*<<seq.ml:280:23>>*/ }
    function cycle_nonempty(xs, param){
      /*<<seq.ml:287:2>>*/ return append
             (xs,
              function(_ac_){ /*<<?>>*/ return cycle_nonempty(xs, _ac_);},
-             0);
+             0) /*<<seq.ml:287:34>>*/ ;
     /*<<seq.ml:287:34>>*/ }
    function cycle(xs, param){
      /*<<seq.ml:295:2>>*/  /*<<seq.ml:295:8>>*/ var
      match =  /*<<seq.ml:295:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:297:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:297:6>>*/ return 0 /*<<seq.ml:297:6>>*/ ;
     var xs$0 = match[2], x = match[1];
      /*<<seq.ml:299:26>>*/ function _$_(_ab_){
       /*<<?>>*/ return cycle_nonempty(xs, _ab_);
     }
      /*<<seq.ml:299:6>>*/ return [0,
             x,
-            function(_aa_){ /*<<?>>*/ return append(xs$0, _$_, _aa_);}];
+            function(_aa_){ /*<<?>>*/ return append(xs$0, _$_, _aa_);}] /*<<seq.ml:299:6>>*/ ;
     /*<<seq.ml:299:46>>*/ }
    function iterate1(f, x, param){
      /*<<seq.ml:306:2>>*/  /*<<seq.ml:306:10>>*/ var
      y =  /*<<seq.ml:306:10>>*/ caml_call1(f, x);
      /*<<seq.ml:307:2>>*/ return [0,
             y,
-            function(___){ /*<<?>>*/ return iterate1(f, y, ___);}];
+            function(___){ /*<<?>>*/ return iterate1(f, y, ___);}] /*<<seq.ml:307:2>>*/ ;
     /*<<seq.ml:307:24>>*/ }
    function iterate(f, x){
      /*<<seq.ml:319:9>>*/ function next(_Z_){
       /*<<?>>*/ return iterate1(f, x, _Z_);
     }
      /*<<seq.ml:319:9>>*/ return function(_Y_){
-      /*<<seq.ml:28:21>>*/ return [0, x, next];};
+      /*<<seq.ml:28:21>>*/ return [0, x, next] /*<<seq.ml:28:21>>*/ ;} /*<<seq.ml:319:9>>*/ ;
     /*<<seq.ml:319:23>>*/ }
    function mapi_aux(f, i, xs, param){
      /*<<seq.ml:324:2>>*/  /*<<seq.ml:324:8>>*/ var
      match =  /*<<seq.ml:324:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:326:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:326:6>>*/ return 0 /*<<seq.ml:326:6>>*/ ;
     var xs$0 = match[2], x = match[1],  /*<<seq.ml:328:6>>*/ _W_ = i + 1 | 0;
      /*<<seq.ml:328:6>>*/ return [0,
              /*<<seq.ml:328:12>>*/ caml_call2(f, i, x),
-            function(_X_){ /*<<?>>*/ return mapi_aux(f, _W_, xs$0, _X_);}];
+            function(_X_){ /*<<?>>*/ return mapi_aux(f, _W_, xs$0, _X_);}] /*<<seq.ml:328:6>>*/ ;
     /*<<seq.ml:328:39>>*/ }
    function mapi(f, xs){
      /*<<seq.ml:331:2>>*/ var _U_ = 0;
      /*<<seq.ml:331:2>>*/ return function(_V_){
-      /*<<?>>*/ return mapi_aux(f, _U_, xs, _V_);};
+      /*<<?>>*/ return mapi_aux(f, _U_, xs, _V_);} /*<<seq.ml:331:2>>*/ ;
     /*<<seq.ml:331:17>>*/ }
    function tail_scan(f, s, xs, param){
      /*<<seq.ml:340:2>>*/  /*<<seq.ml:340:8>>*/ var
      match =  /*<<seq.ml:340:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:342:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:342:6>>*/ return 0 /*<<seq.ml:342:6>>*/ ;
      /*<<seq.ml:344:14>>*/ var
      xs$0 = match[2],
      x = match[1],
       /*<<seq.ml:344:14>>*/ s$0 =  /*<<seq.ml:344:14>>*/ caml_call2(f, s, x);
      /*<<seq.ml:345:6>>*/ return [0,
             s$0,
-            function(_T_){ /*<<?>>*/ return tail_scan(f, s$0, xs$0, _T_);}];
+            function(_T_){ /*<<?>>*/ return tail_scan(f, s$0, xs$0, _T_);}] /*<<seq.ml:345:6>>*/ ;
     /*<<seq.ml:345:32>>*/ }
    function scan(f, s, xs){
      /*<<seq.ml:348:9>>*/ function next(_S_){
       /*<<?>>*/ return tail_scan(f, s, xs, _S_);
     }
      /*<<seq.ml:348:9>>*/ return function(_R_){
-      /*<<seq.ml:28:21>>*/ return [0, s, next];};
+      /*<<seq.ml:28:21>>*/ return [0, s, next] /*<<seq.ml:28:21>>*/ ;} /*<<seq.ml:348:9>>*/ ;
     /*<<seq.ml:348:27>>*/ }
    function take_aux(n, xs){
      /*<<seq.ml:354:2>>*/ return 0 === n
@@ -2154,16 +2180,17 @@
              (param){
                /*<<seq.ml:358:6>>*/  /*<<seq.ml:358:12>>*/ var
                match =  /*<<seq.ml:358:12>>*/ caml_call1(xs, 0);
-              if(! match)  /*<<seq.ml:360:10>>*/ return 0;
+              if(! match)
+                /*<<seq.ml:360:10>>*/ return 0 /*<<seq.ml:360:10>>*/ ;
               var xs$0 = match[2], x = match[1];
-               /*<<seq.ml:362:10>>*/ return [0, x, take_aux(n - 1 | 0, xs$0)];
-              /*<<seq.ml:362:37>>*/ };
+               /*<<seq.ml:362:10>>*/ return [0, x, take_aux(n - 1 | 0, xs$0)] /*<<seq.ml:362:10>>*/ ;
+              /*<<seq.ml:362:37>>*/ } /*<<seq.ml:362:37>>*/ ;
     /*<<seq.ml:362:37>>*/ }
    function take(n, xs){
      /*<<seq.ml:365:2>>*/ if(n < 0)
       /*<<seq.ml:365:16>>*/  /*<<seq.ml:365:16>>*/ caml_call1
       (Stdlib[1], cst_Seq_take);
-     /*<<seq.ml:365:16>>*/ return take_aux(n, xs);
+     /*<<seq.ml:365:16>>*/ return take_aux(n, xs) /*<<seq.ml:366:15>>*/ ;
     /*<<seq.ml:366:15>>*/ }
    function drop(n, xs){
      /*<<seq.ml:387:2>>*/ return 0 <= n
@@ -2176,46 +2203,47 @@
                  /*<<seq.ml:373:2>>*/ for(;;){
                   /*<<seq.ml:373:8>>*/  /*<<seq.ml:373:8>>*/ var
                   match =  /*<<seq.ml:373:8>>*/ caml_call1(xs$0, 0);
-                 if(! match)  /*<<seq.ml:375:6>>*/ return 0;
+                 if(! match)
+                   /*<<seq.ml:375:6>>*/ return 0 /*<<seq.ml:375:6>>*/ ;
                   /*<<seq.ml:377:6>>*/ var
                   xs$1 = match[2],
                    /*<<seq.ml:377:6>>*/ n$1 = n$0 - 1 | 0;
                   /*<<seq.ml:378:6>>*/ if(0 === n$1)
                    /*<<seq.ml:379:8>>*/ return  /*<<seq.ml:379:8>>*/ caml_call1
-                          (xs$1, 0);
+                          (xs$1, 0) /*<<seq.ml:392:21>>*/ ;
                  n$0 = n$1;
                  xs$0 = xs$1;
                 }
                 /*<<seq.ml:392:21>>*/ }
-            :  /*<<seq.ml:387:16>>*/ caml_call1(Stdlib[1], cst_Seq_drop);
+            :  /*<<seq.ml:387:16>>*/ caml_call1(Stdlib[1], cst_Seq_drop) /*<<seq.ml:392:21>>*/ ;
     /*<<seq.ml:392:21>>*/ }
    function take_while(p, xs, param){
      /*<<seq.ml:395:2>>*/  /*<<seq.ml:395:8>>*/ var
      match =  /*<<seq.ml:395:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:397:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:397:6>>*/ return 0 /*<<seq.ml:397:6>>*/ ;
     var xs$0 = match[2], x = match[1];
      /*<<seq.ml:399:9>>*/ return  /*<<seq.ml:399:9>>*/ caml_call1(p, x)
             ? [0,
               x,
               function(_Q_){ /*<<?>>*/ return take_while(p, xs$0, _Q_);}]
-            : 0;
+            : 0 /*<<seq.ml:399:52>>*/ ;
     /*<<seq.ml:399:52>>*/ }
    function drop_while(p, xs, param){
      /*<<seq.ml:402:2>>*/ var xs$0 = xs;
      /*<<seq.ml:402:2>>*/ for(;;){
       /*<<seq.ml:402:8>>*/  /*<<seq.ml:402:8>>*/ var
       node =  /*<<seq.ml:402:8>>*/ caml_call1(xs$0, 0);
-     if(! node)  /*<<seq.ml:404:6>>*/ return 0;
+     if(! node)  /*<<seq.ml:404:6>>*/ return 0 /*<<seq.ml:404:6>>*/ ;
      var xs$1 = node[2], x = node[1];
       /*<<seq.ml:406:9>>*/ if(!  /*<<seq.ml:406:9>>*/ caml_call1(p, x))
-       /*<<seq.ml:406:42>>*/ return node;
+       /*<<seq.ml:406:42>>*/ return node /*<<seq.ml:406:42>>*/ ;
      xs$0 = xs$1;
     }
     /*<<seq.ml:406:46>>*/ }
    function group(eq, xs, param){
      /*<<seq.ml:409:2>>*/  /*<<seq.ml:409:8>>*/ var
      match =  /*<<seq.ml:409:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:411:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:411:6>>*/ return 0 /*<<seq.ml:411:6>>*/ ;
     var
      xs$0 = match[2],
      x = match[1],
@@ -2228,8 +2256,10 @@
       /*<<?>>*/ return take_while(_L_, xs$0, _O_);
     }
      /*<<seq.ml:413:6>>*/ return [0,
-            function(_N_){ /*<<seq.ml:28:21>>*/ return [0, x, next];},
-            function(_M_){ /*<<?>>*/ return group(eq, _K_, _M_);}];
+            function(_N_){
+              /*<<seq.ml:28:21>>*/ return [0, x, next] /*<<seq.ml:28:21>>*/ ;
+            },
+            function(_M_){ /*<<?>>*/ return group(eq, _K_, _M_);}] /*<<seq.ml:413:6>>*/ ;
     /*<<seq.ml:413:75>>*/ }
     /*<<seq.ml:415:0>>*/ var
      /*<<seq.ml:415:0>>*/ Forced_twice =
@@ -2244,71 +2274,72 @@
     function s$0(param){
       /*<<seq.ml:460:4>>*/  /*<<seq.ml:460:10>>*/ var
       match =  /*<<seq.ml:460:10>>*/ caml_call1(xs, 0);
-     if(! match)  /*<<seq.ml:462:8>>*/ return 0;
+     if(! match)  /*<<seq.ml:462:8>>*/ return 0 /*<<seq.ml:462:8>>*/ ;
      var xs$0 = match[2], x = match[1];
-      /*<<seq.ml:464:8>>*/ return [0, x, memoize(xs$0)];
+      /*<<seq.ml:464:8>>*/ return [0, x, memoize(xs$0)] /*<<seq.ml:464:8>>*/ ;
      /*<<seq.ml:464:28>>*/ }
      /*<<seq.ml:434:14>>*/  /*<<seq.ml:434:14>>*/ var
      s =  /*<<seq.ml:434:14>>*/ caml_call1(to_lazy, s$0);
      /*<<seq.ml:429:4>>*/ return function(param){
       /*<<seq.ml:429:14>>*/ var _I_ = runtime.caml_obj_tag(s);
      if(250 === _I_) return s[1];
-     if(246 !== _I_ && 244 !== _I_)  /*<<seq.ml:429:4>>*/ return s;
+     if(246 !== _I_ && 244 !== _I_)
+       /*<<seq.ml:429:4>>*/ return s /*<<seq.ml:429:4>>*/ ;
       /*<<seq.ml:429:4>>*/ return  /*<<seq.ml:429:4>>*/ caml_call1
-             (CamlinternalLazy[2], s); /*<<seq.ml:429:26>>*/ };
+             (CamlinternalLazy[2], s) /*<<seq.ml:429:26>>*/ ; /*<<seq.ml:429:26>>*/ } /*<<seq.ml:429:4>>*/ ;
     /*<<seq.ml:465:3>>*/ }
    function once(xs){
     function f(param){
       /*<<seq.ml:469:4>>*/  /*<<seq.ml:469:10>>*/ var
       match =  /*<<seq.ml:469:10>>*/ caml_call1(xs, 0);
-     if(! match)  /*<<seq.ml:471:8>>*/ return 0;
+     if(! match)  /*<<seq.ml:471:8>>*/ return 0 /*<<seq.ml:471:8>>*/ ;
      var xs$0 = match[2], x = match[1];
-      /*<<seq.ml:473:8>>*/ return [0, x, once(xs$0)];
+      /*<<seq.ml:473:8>>*/ return [0, x, once(xs$0)] /*<<seq.ml:473:8>>*/ ;
      /*<<seq.ml:473:25>>*/ }
      /*<<seq.ml:448:17>>*/  /*<<seq.ml:448:17>>*/ var
      action =  /*<<seq.ml:448:17>>*/ caml_call1(Stdlib_Atomic[1], f);
      /*<<seq.ml:449:4>>*/ return function(param){
       /*<<seq.ml:453:6>>*/  /*<<seq.ml:453:14>>*/ var
       f =  /*<<seq.ml:453:14>>*/ caml_call2(Stdlib_Atomic[5], action, failure);
-      /*<<seq.ml:454:6>>*/ return  /*<<seq.ml:454:6>>*/ caml_call1(f, 0); /*<<seq.ml:454:9>>*/ };
+      /*<<seq.ml:454:6>>*/ return  /*<<seq.ml:454:6>>*/ caml_call1(f, 0) /*<<seq.ml:454:9>>*/ ; /*<<seq.ml:454:9>>*/ } /*<<seq.ml:449:4>>*/ ;
     /*<<seq.ml:474:3>>*/ }
    function zip(xs, ys, param){
      /*<<seq.ml:478:2>>*/  /*<<seq.ml:478:8>>*/ var
      match =  /*<<seq.ml:478:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:480:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:480:6>>*/ return 0 /*<<seq.ml:480:6>>*/ ;
      /*<<seq.ml:482:12>>*/ var
      xs$0 = match[2],
      x = match[1],
       /*<<seq.ml:482:12>>*/ match$0 =  /*<<seq.ml:482:12>>*/ caml_call1(ys, 0);
-    if(! match$0)  /*<<seq.ml:484:10>>*/ return 0;
+    if(! match$0)  /*<<seq.ml:484:10>>*/ return 0 /*<<seq.ml:484:10>>*/ ;
     var ys$0 = match$0[2], y = match$0[1];
      /*<<seq.ml:486:10>>*/ return [0,
             [0, x, y],
-            function(_H_){ /*<<?>>*/ return zip(xs$0, ys$0, _H_);}];
+            function(_H_){ /*<<?>>*/ return zip(xs$0, ys$0, _H_);}] /*<<seq.ml:486:10>>*/ ;
     /*<<seq.ml:486:34>>*/ }
    function map2(f, xs, ys, param){
      /*<<seq.ml:489:2>>*/  /*<<seq.ml:489:8>>*/ var
      match =  /*<<seq.ml:489:8>>*/ caml_call1(xs, 0);
-    if(! match)  /*<<seq.ml:491:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:491:6>>*/ return 0 /*<<seq.ml:491:6>>*/ ;
      /*<<seq.ml:493:12>>*/ var
      xs$0 = match[2],
      x = match[1],
       /*<<seq.ml:493:12>>*/ match$0 =  /*<<seq.ml:493:12>>*/ caml_call1(ys, 0);
-    if(! match$0)  /*<<seq.ml:495:10>>*/ return 0;
+    if(! match$0)  /*<<seq.ml:495:10>>*/ return 0 /*<<seq.ml:495:10>>*/ ;
     var ys$0 = match$0[2], y = match$0[1];
      /*<<seq.ml:497:10>>*/ return [0,
              /*<<seq.ml:497:16>>*/ caml_call2(f, x, y),
-            function(_G_){ /*<<?>>*/ return map2(f, xs$0, ys$0, _G_);}];
+            function(_G_){ /*<<?>>*/ return map2(f, xs$0, ys$0, _G_);}] /*<<seq.ml:497:10>>*/ ;
     /*<<seq.ml:497:36>>*/ }
    function interleave(xs, ys, param){
      /*<<seq.ml:500:2>>*/  /*<<seq.ml:500:8>>*/ var
      match =  /*<<seq.ml:500:8>>*/ caml_call1(xs, 0);
     if(! match)
-      /*<<seq.ml:502:6>>*/ return  /*<<seq.ml:502:6>>*/ caml_call1(ys, 0);
+      /*<<seq.ml:502:6>>*/ return  /*<<seq.ml:502:6>>*/ caml_call1(ys, 0) /*<<seq.ml:504:32>>*/ ;
     var xs$0 = match[2], x = match[1];
      /*<<seq.ml:504:6>>*/ return [0,
             x,
-            function(_F_){ /*<<?>>*/ return interleave(ys, xs$0, _F_);}];
+            function(_F_){ /*<<?>>*/ return interleave(ys, xs$0, _F_);}] /*<<seq.ml:504:6>>*/ ;
     /*<<seq.ml:504:32>>*/ }
    function sorted_merge1(cmp, x, xs, y, ys){
      /*<<seq.ml:533:2>>*/ return 0
@@ -2318,19 +2349,21 @@
               function(_D_){
                 /*<<seq.ml:519:8>>*/  /*<<seq.ml:519:8>>*/ var
                 match =  /*<<seq.ml:519:8>>*/ caml_call1(ys, 0);
-               if(! match)  /*<<seq.ml:521:6>>*/ return [0, x, xs];
+               if(! match)
+                 /*<<seq.ml:521:6>>*/ return [0, x, xs] /*<<seq.ml:521:6>>*/ ;
                var ys$0 = match[2], y = match[1];
-                /*<<seq.ml:523:6>>*/ return sorted_merge1(cmp, x, xs, y, ys$0);
+                /*<<seq.ml:523:6>>*/ return sorted_merge1(cmp, x, xs, y, ys$0) /*<<seq.ml:523:6>>*/ ;
               }]
             : [0,
               x,
               function(_E_){
                 /*<<seq.ml:526:8>>*/  /*<<seq.ml:526:8>>*/ var
                 match =  /*<<seq.ml:526:8>>*/ caml_call1(xs, 0);
-               if(! match)  /*<<seq.ml:528:6>>*/ return [0, y, ys];
+               if(! match)
+                 /*<<seq.ml:528:6>>*/ return [0, y, ys] /*<<seq.ml:528:6>>*/ ;
                var xs$0 = match[2], x = match[1];
-                /*<<seq.ml:530:6>>*/ return sorted_merge1(cmp, x, xs$0, y, ys);
-              }];
+                /*<<seq.ml:530:6>>*/ return sorted_merge1(cmp, x, xs$0, y, ys) /*<<seq.ml:530:6>>*/ ;
+              }] /*<<seq.ml:536:40>>*/ ;
     /*<<seq.ml:536:40>>*/ }
    function sorted_merge(cmp, xs, ys, param){
      /*<<seq.ml:539:2>>*/ var
@@ -2339,42 +2372,45 @@
     if(match){
      if(match$0){
       var ys$0 = match$0[2], y = match$0[1], xs$0 = match[2], x = match[1];
-       /*<<seq.ml:546:8>>*/ return sorted_merge1(cmp, x, xs$0, y, ys$0);
+       /*<<seq.ml:546:8>>*/ return sorted_merge1(cmp, x, xs$0, y, ys$0) /*<<seq.ml:546:35>>*/ ;
      }
      var c = match;
     }
-    else{if(! match$0)  /*<<seq.ml:541:8>>*/ return 0; var c = match$0;}
-     /*<<seq.ml:544:8>>*/ return c;
+    else{
+     if(! match$0)  /*<<seq.ml:541:8>>*/ return 0 /*<<seq.ml:541:8>>*/ ;
+     var c = match$0;
+    }
+     /*<<seq.ml:544:8>>*/ return c /*<<seq.ml:544:8>>*/ ;
     /*<<seq.ml:546:35>>*/ }
    function map_fst(xys, param){
      /*<<seq.ml:550:2>>*/  /*<<seq.ml:550:8>>*/ var
      match =  /*<<seq.ml:550:8>>*/ caml_call1(xys, 0);
-    if(! match)  /*<<seq.ml:552:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:552:6>>*/ return 0 /*<<seq.ml:552:6>>*/ ;
     var xys$0 = match[2], x = match[1][1];
      /*<<seq.ml:554:6>>*/ return [0,
             x,
-            function(_C_){ /*<<?>>*/ return map_fst(xys$0, _C_);}];
+            function(_C_){ /*<<?>>*/ return map_fst(xys$0, _C_);}] /*<<seq.ml:554:6>>*/ ;
     /*<<seq.ml:554:27>>*/ }
    function map_snd(xys, param){
      /*<<seq.ml:557:2>>*/  /*<<seq.ml:557:8>>*/ var
      match =  /*<<seq.ml:557:8>>*/ caml_call1(xys, 0);
-    if(! match)  /*<<seq.ml:559:6>>*/ return 0;
+    if(! match)  /*<<seq.ml:559:6>>*/ return 0 /*<<seq.ml:559:6>>*/ ;
     var xys$0 = match[2], y = match[1][2];
      /*<<seq.ml:561:6>>*/ return [0,
             y,
-            function(_B_){ /*<<?>>*/ return map_snd(xys$0, _B_);}];
+            function(_B_){ /*<<?>>*/ return map_snd(xys$0, _B_);}] /*<<seq.ml:561:6>>*/ ;
     /*<<seq.ml:561:27>>*/ }
    function unzip(xys){
      /*<<seq.ml:564:2>>*/ return [0,
             function(_A_){ /*<<?>>*/ return map_fst(xys, _A_);},
-            function(_z_){ /*<<?>>*/ return map_snd(xys, _z_);}];
+            function(_z_){ /*<<?>>*/ return map_snd(xys, _z_);}] /*<<seq.ml:564:2>>*/ ;
     /*<<seq.ml:564:26>>*/ }
    function filter_map_find_left_map(f, xs, param){
      /*<<seq.ml:573:2>>*/ var xs$0 = xs;
      /*<<seq.ml:573:2>>*/ for(;;){
       /*<<seq.ml:573:8>>*/  /*<<seq.ml:573:8>>*/ var
       match =  /*<<seq.ml:573:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:575:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:575:6>>*/ return 0 /*<<seq.ml:575:6>>*/ ;
       /*<<seq.ml:577:12>>*/ var
       xs$1 = match[2],
       x = match[1],
@@ -2385,7 +2421,7 @@
               y,
               function(_y_){
                 /*<<?>>*/ return filter_map_find_left_map(f, xs$1, _y_);
-              }];
+              }] /*<<seq.ml:579:10>>*/ ;
      }
      xs$0 = xs$1;
     }
@@ -2395,7 +2431,7 @@
      /*<<seq.ml:584:2>>*/ for(;;){
       /*<<seq.ml:584:8>>*/  /*<<seq.ml:584:8>>*/ var
       match =  /*<<seq.ml:584:8>>*/ caml_call1(xs$0, 0);
-     if(! match)  /*<<seq.ml:586:6>>*/ return 0;
+     if(! match)  /*<<seq.ml:586:6>>*/ return 0 /*<<seq.ml:586:6>>*/ ;
       /*<<seq.ml:588:12>>*/ var
       xs$1 = match[2],
       x = match[1],
@@ -2406,7 +2442,7 @@
               z,
               function(_x_){
                 /*<<?>>*/ return filter_map_find_right_map(f, xs$1, _x_);
-              }];
+              }] /*<<seq.ml:592:10>>*/ ;
      }
      xs$0 = xs$1;
     }
@@ -2418,19 +2454,19 @@
             },
             function(_v_){
               /*<<?>>*/ return filter_map_find_right_map(f, xs, _v_);
-            }];
+            }] /*<<seq.ml:595:2>>*/ ;
     /*<<seq.ml:596:32>>*/ }
    function partition(p, xs){
     function _s_(x){
-      /*<<seq.ml:599:32>>*/ return 1 -  /*<<seq.ml:599:36>>*/ caml_call1(p, x);
+      /*<<seq.ml:599:32>>*/ return 1 -  /*<<seq.ml:599:36>>*/ caml_call1(p, x) /*<<seq.ml:599:36>>*/ ;
      /*<<seq.ml:599:41>>*/ }
      /*<<seq.ml:599:2>>*/ return [0,
             function(_u_){ /*<<?>>*/ return filter(p, xs, _u_);},
-            function(_t_){ /*<<?>>*/ return filter(_s_, xs, _t_);}];
+            function(_t_){ /*<<?>>*/ return filter(_s_, xs, _t_);}] /*<<seq.ml:599:2>>*/ ;
     /*<<seq.ml:599:45>>*/ }
    function peel(xss){
      /*<<seq.ml:611:2>>*/ return unzip
-            (function(_r_){ /*<<?>>*/ return filter_map(uncons, xss, _r_);});
+            (function(_r_){ /*<<?>>*/ return filter_map(uncons, xss, _r_);}) /*<<seq.ml:611:31>>*/ ;
     /*<<seq.ml:611:31>>*/ }
    function transpose(xss, param){
      /*<<seq.ml:614:2>>*/ var
@@ -2440,15 +2476,17 @@
      /*<<seq.ml:615:5>>*/ if(! is_empty(heads))
       /*<<seq.ml:620:4>>*/ return [0,
              heads,
-             function(_q_){ /*<<?>>*/ return transpose(tails, _q_);}];
-     /*<<seq.ml:616:11>>*/ if(is_empty(tails))  /*<<seq.ml:617:4>>*/ return 0;
+             function(_q_){ /*<<?>>*/ return transpose(tails, _q_);}] /*<<seq.ml:620:4>>*/ ;
+     /*<<seq.ml:616:11>>*/ if(is_empty(tails))
+      /*<<seq.ml:617:4>>*/ return 0 /*<<seq.ml:617:4>>*/ ;
      /*<<seq.ml:616:4>>*/ throw  /*<<seq.ml:616:4>>*/ caml_maybe_attach_backtrace
            ([0, Assert_failure, _a_], 1);
     /*<<seq.ml:620:33>>*/ }
    function _b_(remainders, xss, param){
      /*<<seq.ml:627:2>>*/  /*<<seq.ml:627:8>>*/ var
      match =  /*<<seq.ml:627:8>>*/ caml_call1(xss, 0);
-    if(! match)  /*<<seq.ml:649:6>>*/ return transpose(remainders, 0);
+    if(! match)
+      /*<<seq.ml:649:6>>*/ return transpose(remainders, 0) /*<<seq.ml:649:29>>*/ ;
      /*<<seq.ml:629:18>>*/ var
      xss$0 = match[2],
      xs = match[1],
@@ -2461,10 +2499,14 @@
       tails = match$1[2],
       heads = match$1[1],
        /*<<seq.ml:638:40>>*/ _l_ =
-        function(_p_){ /*<<seq.ml:28:21>>*/ return [0, xs$0, tails];};
+        function(_p_){
+          /*<<seq.ml:28:21>>*/ return [0, xs$0, tails] /*<<seq.ml:28:21>>*/ ;
+        };
       /*<<seq.ml:638:10>>*/ return [0,
-             function(_o_){ /*<<seq.ml:28:21>>*/ return [0, x, heads];},
-             function(_n_){ /*<<?>>*/ return _b_(_l_, xss$0, _n_);}];
+             function(_o_){
+               /*<<seq.ml:28:21>>*/ return [0, x, heads] /*<<seq.ml:28:21>>*/ ;
+             },
+             function(_n_){ /*<<?>>*/ return _b_(_l_, xss$0, _n_);}] /*<<seq.ml:638:10>>*/ ;
     }
      /*<<seq.ml:643:29>>*/ var
       /*<<seq.ml:643:29>>*/ match$2 = peel(remainders),
@@ -2472,15 +2514,15 @@
      heads$0 = match$2[1];
      /*<<seq.ml:644:10>>*/ return [0,
             heads$0,
-            function(_m_){ /*<<?>>*/ return _b_(tails$0, xss$0, _m_);}];
+            function(_m_){ /*<<?>>*/ return _b_(tails$0, xss$0, _m_);}] /*<<seq.ml:644:10>>*/ ;
     /*<<seq.ml:649:29>>*/ }
    function map_product(f, xs, ys){
     function _f_(x){
      function _j_(y){
-       /*<<seq.ml:671:8>>*/ return  /*<<seq.ml:671:8>>*/ caml_call2(f, x, y);
+       /*<<seq.ml:671:8>>*/ return  /*<<seq.ml:671:8>>*/ caml_call2(f, x, y) /*<<seq.ml:671:13>>*/ ;
       /*<<seq.ml:671:13>>*/ }
       /*<<seq.ml:670:10>>*/ return function(_k_){
-       /*<<?>>*/ return map(_j_, ys, _k_);};
+       /*<<?>>*/ return map(_j_, ys, _k_);} /*<<seq.ml:670:10>>*/ ;
      /*<<seq.ml:672:10>>*/ }
      /*<<seq.ml:668:20>>*/ function xss(_i_){
       /*<<?>>*/ return map(_f_, xs, _i_);
@@ -2489,41 +2531,41 @@
       /*<<?>>*/ return _b_(empty, xss, _h_);
     }
      /*<<seq.ml:668:9>>*/ return function(_g_){
-      /*<<?>>*/ return concat(_e_, _g_);};
+      /*<<?>>*/ return concat(_e_, _g_);} /*<<seq.ml:668:9>>*/ ;
     /*<<seq.ml:674:4>>*/ }
    function product(xs, ys){
      /*<<seq.ml:677:2>>*/ return map_product
             (function(x, y){
-               /*<<seq.ml:677:26>>*/ return [0, x, y];
+               /*<<seq.ml:677:26>>*/ return [0, x, y] /*<<seq.ml:677:26>>*/ ;
               /*<<seq.ml:677:32>>*/ },
              xs,
-             ys);
+             ys) /*<<seq.ml:677:39>>*/ ;
     /*<<seq.ml:677:39>>*/ }
    function of_dispenser(it){
     function c(param){
       /*<<seq.ml:681:4>>*/  /*<<seq.ml:681:10>>*/ var
       match =  /*<<seq.ml:681:10>>*/ caml_call1(it, 0);
-     if(! match)  /*<<seq.ml:683:8>>*/ return 0;
+     if(! match)  /*<<seq.ml:683:8>>*/ return 0 /*<<seq.ml:683:8>>*/ ;
      var x = match[1];
-      /*<<seq.ml:685:8>>*/ return [0, x, c];
+      /*<<seq.ml:685:8>>*/ return [0, x, c] /*<<seq.ml:685:8>>*/ ;
      /*<<seq.ml:685:19>>*/ }
-     /*<<seq.ml:687:2>>*/ return c;
+     /*<<seq.ml:687:2>>*/ return c /*<<seq.ml:687:2>>*/ ;
     /*<<seq.ml:687:3>>*/ }
    function to_dispenser(xs){
      /*<<seq.ml:690:2>>*/  /*<<seq.ml:690:10>>*/ var s = [0, xs];
      /*<<seq.ml:691:2>>*/ return function(param){
       /*<<seq.ml:692:4>>*/  /*<<seq.ml:692:10>>*/ var
       match =  /*<<seq.ml:692:10>>*/ caml_call1(s[1], 0);
-     if(! match)  /*<<seq.ml:694:8>>*/ return 0;
+     if(! match)  /*<<seq.ml:694:8>>*/ return 0 /*<<seq.ml:694:8>>*/ ;
      var xs = match[2], x = match[1];
      s[1] = xs;
-      /*<<seq.ml:697:8>>*/ return [0, x]; /*<<seq.ml:697:14>>*/ };
+      /*<<seq.ml:697:8>>*/ return [0, x] /*<<seq.ml:697:8>>*/ ; /*<<seq.ml:697:14>>*/ } /*<<seq.ml:691:2>>*/ ;
     /*<<seq.ml:697:14>>*/ }
    function ints(i, param){
      /*<<seq.ml:702:2>>*/  /*<<seq.ml:702:2>>*/ var _c_ = i + 1 | 0;
      /*<<seq.ml:702:2>>*/ return [0,
             i,
-            function(_d_){ /*<<?>>*/ return ints(_c_, _d_);}];
+            function(_d_){ /*<<?>>*/ return ints(_c_, _d_);}] /*<<seq.ml:702:2>>*/ ;
     /*<<seq.ml:702:24>>*/ }
    var
     Stdlib_Seq =
@@ -2614,89 +2656,97 @@
     Stdlib = global_data.Stdlib,
     cst_option_is_None = "option is None";
    function some(v){
-     /*<<option.ml:19:13>>*/ return [0, v];
+     /*<<option.ml:19:13>>*/ return [0, v] /*<<option.ml:19:13>>*/ ;
     /*<<option.ml:19:19>>*/ }
    function value(o, default$0){
      /*<<option.ml:20:23>>*/ if(! o)
-      /*<<option.ml:20:58>>*/ return default$0;
+      /*<<option.ml:20:58>>*/ return default$0 /*<<option.ml:20:58>>*/ ;
     var v = o[1];
-     /*<<option.ml:20:46>>*/ return v;
+     /*<<option.ml:20:46>>*/ return v /*<<option.ml:20:46>>*/ ;
     /*<<option.ml:20:65>>*/ }
    function get(param){
      /*<<option.ml:21:10>>*/ if(! param)
       /*<<option.ml:21:41>>*/ return  /*<<option.ml:21:41>>*/ caml_call1
-             (Stdlib[1], cst_option_is_None);
+             (Stdlib[1], cst_option_is_None) /*<<option.ml:21:69>>*/ ;
     var v = param[1];
-     /*<<option.ml:21:29>>*/ return v;
+     /*<<option.ml:21:29>>*/ return v /*<<option.ml:21:29>>*/ ;
     /*<<option.ml:21:69>>*/ }
    function bind(o, f){
-     /*<<option.ml:22:15>>*/ if(! o)  /*<<option.ml:22:36>>*/ return 0;
+     /*<<option.ml:22:15>>*/ if(! o)
+      /*<<option.ml:22:36>>*/ return 0 /*<<option.ml:22:36>>*/ ;
     var v = o[1];
-     /*<<option.ml:22:53>>*/ return  /*<<option.ml:22:53>>*/ caml_call1(f, v);
+     /*<<option.ml:22:53>>*/ return  /*<<option.ml:22:53>>*/ caml_call1(f, v) /*<<option.ml:22:56>>*/ ;
     /*<<option.ml:22:56>>*/ }
    function join(param){
-     /*<<option.ml:23:11>>*/ if(! param)  /*<<option.ml:23:42>>*/ return 0;
+     /*<<option.ml:23:11>>*/ if(! param)
+      /*<<option.ml:23:42>>*/ return 0 /*<<option.ml:23:42>>*/ ;
     var o = param[1];
-     /*<<option.ml:23:30>>*/ return o;
+     /*<<option.ml:23:30>>*/ return o /*<<option.ml:23:30>>*/ ;
     /*<<option.ml:23:46>>*/ }
    function map(f, o){
-     /*<<option.ml:24:14>>*/ if(! o)  /*<<option.ml:24:35>>*/ return 0;
+     /*<<option.ml:24:14>>*/ if(! o)
+      /*<<option.ml:24:35>>*/ return 0 /*<<option.ml:24:35>>*/ ;
     var v = o[1];
      /*<<option.ml:24:52>>*/ return [0,
-             /*<<option.ml:24:57>>*/ caml_call1(f, v)];
+             /*<<option.ml:24:57>>*/ caml_call1(f, v)] /*<<option.ml:24:52>>*/ ;
     /*<<option.ml:24:62>>*/ }
    function fold(none, some, param){
-     /*<<?>>*/ if(! param)  /*<<option.ml:25:59>>*/ return none;
+     /*<<?>>*/ if(! param)
+      /*<<option.ml:25:59>>*/ return none /*<<option.ml:25:59>>*/ ;
     var v = param[1];
      /*<<option.ml:25:42>>*/ return  /*<<option.ml:25:42>>*/ caml_call1
-            (some, v);
+            (some, v) /*<<option.ml:25:42>>*/ ;
    }
    function iter(f, param){
-     /*<<?>>*/ if(! param)  /*<<option.ml:26:46>>*/ return 0;
+     /*<<?>>*/ if(! param)
+      /*<<option.ml:26:46>>*/ return 0 /*<<option.ml:26:46>>*/ ;
     var v = param[1];
-     /*<<option.ml:26:32>>*/ return  /*<<option.ml:26:32>>*/ caml_call1(f, v);
+     /*<<option.ml:26:32>>*/ return  /*<<option.ml:26:32>>*/ caml_call1(f, v) /*<<option.ml:26:32>>*/ ;
    }
    function is_none(param){
-     /*<<option.ml:27:14>>*/ return param ? 0 : 1;
+     /*<<option.ml:27:14>>*/ return param ? 0 : 1 /*<<option.ml:27:53>>*/ ;
     /*<<option.ml:27:53>>*/ }
    function is_some(param){
-     /*<<option.ml:28:14>>*/ return param ? 1 : 0;
+     /*<<option.ml:28:14>>*/ return param ? 1 : 0 /*<<option.ml:28:53>>*/ ;
     /*<<option.ml:28:53>>*/ }
    function equal(eq, o0, o1){
      /*<<option.ml:30:21>>*/ if(o0){
      if(o1){
       var v1 = o1[1], v0 = o0[1];
        /*<<option.ml:31:22>>*/ return  /*<<option.ml:31:22>>*/ caml_call2
-              (eq, v0, v1);
+              (eq, v0, v1) /*<<option.ml:33:12>>*/ ;
      }
     }
-    else if(! o1)  /*<<option.ml:32:16>>*/ return 1;
-     /*<<option.ml:33:7>>*/ return 0;
+    else if(! o1)  /*<<option.ml:32:16>>*/ return 1 /*<<option.ml:32:16>>*/ ;
+     /*<<option.ml:33:7>>*/ return 0 /*<<option.ml:33:7>>*/ ;
     /*<<option.ml:33:12>>*/ }
    function compare(cmp, o0, o1){
-     /*<<option.ml:35:24>>*/ if(! o0) return o1 ? -1 : 0;
+     /*<<option.ml:35:24>>*/ if(! o0)
+     return o1 ? -1 : 0 /*<<option.ml:39:19>>*/ ;
     var v0 = o0[1];
-    if(! o1)  /*<<option.ml:39:18>>*/ return 1;
+    if(! o1)  /*<<option.ml:39:18>>*/ return 1 /*<<option.ml:39:18>>*/ ;
     var v1 = o1[1];
      /*<<option.ml:36:22>>*/ return  /*<<option.ml:36:22>>*/ caml_call2
-            (cmp, v0, v1);
+            (cmp, v0, v1) /*<<option.ml:39:19>>*/ ;
     /*<<option.ml:39:19>>*/ }
    function to_result(none, param){
-     /*<<?>>*/ if(! param)  /*<<option.ml:41:39>>*/ return [1, none];
+     /*<<?>>*/ if(! param)
+      /*<<option.ml:41:39>>*/ return [1, none] /*<<option.ml:41:39>>*/ ;
     var v = param[1];
-     /*<<option.ml:41:62>>*/ return [0, v];
+     /*<<option.ml:41:62>>*/ return [0, v] /*<<option.ml:41:62>>*/ ;
    }
    function to_list(param){
-     /*<<option.ml:42:14>>*/ if(! param)  /*<<option.ml:42:31>>*/ return 0;
+     /*<<option.ml:42:14>>*/ if(! param)
+      /*<<option.ml:42:31>>*/ return 0 /*<<option.ml:42:31>>*/ ;
     var v = param[1];
-     /*<<option.ml:42:46>>*/ return [0, v, 0];
+     /*<<option.ml:42:46>>*/ return [0, v, 0] /*<<option.ml:42:46>>*/ ;
     /*<<option.ml:42:49>>*/ }
    function to_seq(param){
      /*<<option.ml:43:13>>*/ if(! param)
-      /*<<option.ml:43:30>>*/ return Stdlib_Seq[20];
+      /*<<option.ml:43:30>>*/ return Stdlib_Seq[20] /*<<option.ml:43:30>>*/ ;
     var v = param[1];
      /*<<option.ml:43:52>>*/ return  /*<<option.ml:43:52>>*/ caml_call1
-            (Stdlib_Seq[21], v);
+            (Stdlib_Seq[21], v) /*<<option.ml:43:64>>*/ ;
     /*<<option.ml:43:64>>*/ }
    var
     Stdlib_Option =
@@ -2745,78 +2795,84 @@
     cst_result_is_Error = "result is Error _",
     cst_result_is_Ok = "result is Ok _";
    function ok(v){
-     /*<<result.ml:18:11>>*/ return [0, v];
+     /*<<result.ml:18:11>>*/ return [0, v] /*<<result.ml:18:11>>*/ ;
     /*<<result.ml:18:15>>*/ }
    function error(e){
-     /*<<result.ml:19:14>>*/ return [1, e];
+     /*<<result.ml:19:14>>*/ return [1, e] /*<<result.ml:19:14>>*/ ;
     /*<<result.ml:19:21>>*/ }
    function value(r, default$0){
      /*<<result.ml:20:23>>*/ if(0 !== r[0])
-      /*<<result.ml:20:59>>*/ return default$0;
+      /*<<result.ml:20:59>>*/ return default$0 /*<<result.ml:20:59>>*/ ;
     var v = r[1];
-     /*<<result.ml:20:44>>*/ return v;
+     /*<<result.ml:20:44>>*/ return v /*<<result.ml:20:44>>*/ ;
     /*<<result.ml:20:66>>*/ }
    function get_ok(param){
      /*<<result.ml:21:13>>*/ if(0 !== param[0])
       /*<<result.ml:21:45>>*/ return  /*<<result.ml:21:45>>*/ caml_call1
-             (Stdlib[1], cst_result_is_Error);
+             (Stdlib[1], cst_result_is_Error) /*<<result.ml:21:76>>*/ ;
     var v = param[1];
-     /*<<result.ml:21:30>>*/ return v;
+     /*<<result.ml:21:30>>*/ return v /*<<result.ml:21:30>>*/ ;
     /*<<result.ml:21:76>>*/ }
    function get_error(param){
      /*<<result.ml:22:16>>*/ if(0 === param[0])
       /*<<result.ml:22:48>>*/ return  /*<<result.ml:22:48>>*/ caml_call1
-             (Stdlib[1], cst_result_is_Ok);
+             (Stdlib[1], cst_result_is_Ok) /*<<result.ml:22:76>>*/ ;
     var e = param[1];
-     /*<<result.ml:22:36>>*/ return e;
+     /*<<result.ml:22:36>>*/ return e /*<<result.ml:22:36>>*/ ;
     /*<<result.ml:22:76>>*/ }
    function bind(r, f){
-     /*<<result.ml:23:15>>*/ if(0 !== r[0])  /*<<result.ml:23:58>>*/ return r;
+     /*<<result.ml:23:15>>*/ if(0 !== r[0])
+      /*<<result.ml:23:58>>*/ return r /*<<result.ml:23:58>>*/ ;
     var v = r[1];
-     /*<<result.ml:23:36>>*/ return  /*<<result.ml:23:36>>*/ caml_call1(f, v);
+     /*<<result.ml:23:36>>*/ return  /*<<result.ml:23:36>>*/ caml_call1(f, v) /*<<result.ml:23:59>>*/ ;
     /*<<result.ml:23:59>>*/ }
    function join(e){
-     /*<<result.ml:24:11>>*/ if(0 !== e[0])  /*<<result.ml:24:48>>*/ return e;
+     /*<<result.ml:24:11>>*/ if(0 !== e[0])
+      /*<<result.ml:24:48>>*/ return e /*<<result.ml:24:48>>*/ ;
     var r = e[1];
-     /*<<result.ml:24:28>>*/ return r;
+     /*<<result.ml:24:28>>*/ return r /*<<result.ml:24:28>>*/ ;
     /*<<result.ml:24:49>>*/ }
    function map(f, e){
-     /*<<?>>*/ if(0 !== e[0])  /*<<result.ml:25:56>>*/ return e;
+     /*<<?>>*/ if(0 !== e[0])
+      /*<<result.ml:25:56>>*/ return e /*<<result.ml:25:56>>*/ ;
     var v = e[1];
      /*<<result.ml:25:29>>*/ return [0,
-             /*<<result.ml:25:32>>*/ caml_call1(f, v)];
+             /*<<result.ml:25:32>>*/ caml_call1(f, v)] /*<<result.ml:25:29>>*/ ;
    }
    function map_error(f, v){
-     /*<<?>>*/ if(0 === v[0])  /*<<result.ml:26:65>>*/ return v;
+     /*<<?>>*/ if(0 === v[0])
+      /*<<result.ml:26:65>>*/ return v /*<<result.ml:26:65>>*/ ;
     var e = v[1];
      /*<<result.ml:26:38>>*/ return [1,
-             /*<<result.ml:26:44>>*/ caml_call1(f, e)];
+             /*<<result.ml:26:44>>*/ caml_call1(f, e)] /*<<result.ml:26:38>>*/ ;
    }
    function fold(ok, error, param){
      /*<<?>>*/ if(0 === param[0]){
      var v = param[1];
       /*<<result.ml:27:39>>*/ return  /*<<result.ml:27:39>>*/ caml_call1
-             (ok, v);
+             (ok, v) /*<<result.ml:27:39>>*/ ;
     }
     var e = param[1];
      /*<<result.ml:27:57>>*/ return  /*<<result.ml:27:57>>*/ caml_call1
-            (error, e);
+            (error, e) /*<<result.ml:27:57>>*/ ;
    }
    function iter(f, param){
-     /*<<?>>*/ if(0 !== param[0])  /*<<result.ml:28:47>>*/ return 0;
+     /*<<?>>*/ if(0 !== param[0])
+      /*<<result.ml:28:47>>*/ return 0 /*<<result.ml:28:47>>*/ ;
     var v = param[1];
-     /*<<result.ml:28:30>>*/ return  /*<<result.ml:28:30>>*/ caml_call1(f, v);
+     /*<<result.ml:28:30>>*/ return  /*<<result.ml:28:30>>*/ caml_call1(f, v) /*<<result.ml:28:30>>*/ ;
    }
    function iter_error(f, param){
-     /*<<?>>*/ if(0 === param[0])  /*<<result.ml:29:53>>*/ return 0;
+     /*<<?>>*/ if(0 === param[0])
+      /*<<result.ml:29:53>>*/ return 0 /*<<result.ml:29:53>>*/ ;
     var e = param[1];
-     /*<<result.ml:29:39>>*/ return  /*<<result.ml:29:39>>*/ caml_call1(f, e);
+     /*<<result.ml:29:39>>*/ return  /*<<result.ml:29:39>>*/ caml_call1(f, e) /*<<result.ml:29:39>>*/ ;
    }
    function is_ok(param){
-     /*<<result.ml:30:12>>*/ return 0 === param[0] ? 1 : 0;
+     /*<<result.ml:30:12>>*/ return 0 === param[0] ? 1 : 0 /*<<result.ml:30:52>>*/ ;
     /*<<result.ml:30:52>>*/ }
    function is_error(param){
-     /*<<result.ml:31:15>>*/ return 0 === param[0] ? 0 : 1;
+     /*<<result.ml:31:15>>*/ return 0 === param[0] ? 0 : 1 /*<<result.ml:31:55>>*/ ;
     /*<<result.ml:31:55>>*/ }
    function equal(ok, error, r0, r1){
      /*<<result.ml:33:29>>*/ if(0 === r0[0]){
@@ -2824,7 +2880,7 @@
      if(0 === r1[0]){
       var v1 = r1[1];
        /*<<result.ml:34:18>>*/ return  /*<<result.ml:34:18>>*/ caml_call2
-              (ok, v0, v1);
+              (ok, v0, v1) /*<<result.ml:36:15>>*/ ;
      }
     }
     else{
@@ -2832,43 +2888,45 @@
      if(0 !== r1[0]){
       var e1 = r1[1];
        /*<<result.ml:35:24>>*/ return  /*<<result.ml:35:24>>*/ caml_call2
-              (error, e0, e1);
+              (error, e0, e1) /*<<result.ml:36:15>>*/ ;
      }
     }
-     /*<<result.ml:36:10>>*/ return 0;
+     /*<<result.ml:36:10>>*/ return 0 /*<<result.ml:36:10>>*/ ;
     /*<<result.ml:36:15>>*/ }
    function compare(ok, error, r0, r1){
      /*<<result.ml:38:31>>*/ if(0 === r0[0]){
      var v0 = r0[1];
-     if(0 !== r1[0])  /*<<result.ml:41:19>>*/ return -1;
+     if(0 !== r1[0])
+       /*<<result.ml:41:19>>*/ return -1 /*<<result.ml:41:19>>*/ ;
      var v1 = r1[1];
       /*<<result.ml:39:18>>*/ return  /*<<result.ml:39:18>>*/ caml_call2
-             (ok, v0, v1);
+             (ok, v0, v1) /*<<result.ml:42:20>>*/ ;
     }
     var e0 = r0[1];
-    if(0 === r1[0])  /*<<result.ml:42:19>>*/ return 1;
+    if(0 === r1[0])
+      /*<<result.ml:42:19>>*/ return 1 /*<<result.ml:42:19>>*/ ;
     var e1 = r1[1];
      /*<<result.ml:40:24>>*/ return  /*<<result.ml:40:24>>*/ caml_call2
-            (error, e0, e1);
+            (error, e0, e1) /*<<result.ml:42:20>>*/ ;
     /*<<result.ml:42:20>>*/ }
    function to_option(param){
      /*<<result.ml:44:16>>*/ if(0 !== param[0])
-      /*<<result.ml:44:53>>*/ return 0;
+      /*<<result.ml:44:53>>*/ return 0 /*<<result.ml:44:53>>*/ ;
     var v = param[1];
-     /*<<result.ml:44:33>>*/ return [0, v];
+     /*<<result.ml:44:33>>*/ return [0, v] /*<<result.ml:44:33>>*/ ;
     /*<<result.ml:44:57>>*/ }
    function to_list(param){
      /*<<result.ml:45:14>>*/ if(0 !== param[0])
-      /*<<result.ml:45:48>>*/ return 0;
+      /*<<result.ml:45:48>>*/ return 0 /*<<result.ml:45:48>>*/ ;
     var v = param[1];
-     /*<<result.ml:45:31>>*/ return [0, v, 0];
+     /*<<result.ml:45:31>>*/ return [0, v, 0] /*<<result.ml:45:31>>*/ ;
     /*<<result.ml:45:50>>*/ }
    function to_seq(param){
      /*<<result.ml:46:13>>*/ if(0 !== param[0])
-      /*<<result.ml:46:56>>*/ return Stdlib_Seq[20];
+      /*<<result.ml:46:56>>*/ return Stdlib_Seq[20] /*<<result.ml:46:56>>*/ ;
     var v = param[1];
      /*<<result.ml:46:30>>*/ return  /*<<result.ml:46:30>>*/ caml_call1
-            (Stdlib_Seq[21], v);
+            (Stdlib_Seq[21], v) /*<<result.ml:46:65>>*/ ;
     /*<<result.ml:46:65>>*/ }
    var
     Stdlib_Result =
@@ -2907,18 +2965,18 @@
     cst_true = "true",
     cst_false = "false";
    function to_float(param){
-     /*<<bool.ml:24:15>>*/ return param ? 1. : 0.;
+     /*<<bool.ml:24:15>>*/ return param ? 1. : 0. /*<<bool.ml:24:48>>*/ ;
     /*<<bool.ml:24:48>>*/ }
    function to_string(param){
-     /*<<bool.ml:33:16>>*/ return param ? cst_true : cst_false;
+     /*<<bool.ml:33:16>>*/ return param ? cst_true : cst_false /*<<bool.ml:33:58>>*/ ;
     /*<<bool.ml:33:58>>*/ }
    function seeded_hash(seed, x){
      /*<<bool.ml:37:25>>*/ return  /*<<bool.ml:37:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<bool.ml:37:56>>*/ ;
     /*<<bool.ml:37:56>>*/ }
    function hash(x){
      /*<<bool.ml:38:13>>*/ return  /*<<bool.ml:38:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<bool.ml:38:41>>*/ ;
     /*<<bool.ml:38:41>>*/ }
    var
     Stdlib_Bool =
@@ -2964,29 +3022,32 @@
     cst_r = "\\r";
    function chr(n){
      /*<<char.ml:22:2>>*/ if(0 <= n && 255 >= n)
-      /*<<char.ml:22:55>>*/ return n;
+      /*<<char.ml:22:55>>*/ return n /*<<char.ml:22:55>>*/ ;
      /*<<char.ml:22:27>>*/ return  /*<<char.ml:22:27>>*/ caml_call1
-            (Stdlib[1], cst_Char_chr);
+            (Stdlib[1], cst_Char_chr) /*<<char.ml:22:67>>*/ ;
     /*<<char.ml:22:67>>*/ }
    function escaped(c){
      /*<<char.ml:29:14>>*/ a:
     {
      if(40 <= c){
-      if(92 === c)  /*<<char.ml:31:12>>*/ return cst;
+      if(92 === c)  /*<<char.ml:31:12>>*/ return cst /*<<char.ml:31:12>>*/ ;
       if(127 > c) break a;
      }
      else{
-      if(32 <= c){if(39 <= c)  /*<<char.ml:30:12>>*/ return cst$0; break a;}
+      if(32 <= c){
+       if(39 <= c)  /*<<char.ml:30:12>>*/ return cst$0 /*<<char.ml:30:12>>*/ ;
+       break a;
+      }
       if(14 > c)
        switch(c){
          case 8:
-           /*<<char.ml:35:12>>*/ return cst_b;
+           /*<<char.ml:35:12>>*/ return cst_b /*<<char.ml:35:12>>*/ ;
          case 9:
-           /*<<char.ml:33:12>>*/ return cst_t;
+           /*<<char.ml:33:12>>*/ return cst_t /*<<char.ml:33:12>>*/ ;
          case 10:
-           /*<<char.ml:32:12>>*/ return cst_n;
+           /*<<char.ml:32:12>>*/ return cst_n /*<<char.ml:32:12>>*/ ;
          case 13:
-           /*<<char.ml:34:12>>*/ return cst_r;
+           /*<<char.ml:34:12>>*/ return cst_r /*<<char.ml:34:12>>*/ ;
        }
      }
       /*<<char.ml:42:14>>*/  /*<<char.ml:42:14>>*/ var
@@ -2995,18 +3056,18 @@
      caml_bytes_unsafe_set(s, 1, 48 + (c / 100 | 0) | 0);
      caml_bytes_unsafe_set(s, 2, 48 + ((c / 10 | 0) % 10 | 0) | 0);
      caml_bytes_unsafe_set(s, 3, 48 + (c % 10 | 0) | 0);
-     return caml_string_of_bytes(s);
+     return caml_string_of_bytes(s) /*<<char.ml:47:24>>*/ ;
     }
      /*<<char.ml:37:14>>*/  /*<<char.ml:37:14>>*/ var
      s$0 =  /*<<char.ml:37:14>>*/ caml_create_bytes(1);
     caml_bytes_unsafe_set(s$0, 0, c);
-    return caml_string_of_bytes(s$0);
+    return caml_string_of_bytes(s$0) /*<<char.ml:47:24>>*/ ;
     /*<<char.ml:47:24>>*/ }
    function lowercase_ascii(c){
-     /*<<char.ml:49:22>>*/ return 25 < c - 65 >>> 0 ? c : c + 32 | 0;
+     /*<<char.ml:49:22>>*/ return 25 < c - 65 >>> 0 ? c : c + 32 | 0 /*<<char.ml:51:10>>*/ ;
     /*<<char.ml:51:10>>*/ }
    function uppercase_ascii(c){
-     /*<<char.ml:53:22>>*/ return 25 < c - 97 >>> 0 ? c : c - 32 | 0;
+     /*<<char.ml:53:22>>*/ return 25 < c - 97 >>> 0 ? c : c - 32 | 0 /*<<char.ml:55:10>>*/ ;
     /*<<char.ml:55:10>>*/ }
    function compare(c1, c2){
      /*<<char.ml:59:20>>*/ return c1 - c2 | 0;
@@ -3016,11 +3077,11 @@
     /*<<char.ml:60:45>>*/ }
    function seeded_hash(seed, x){
      /*<<char.ml:64:25>>*/ return  /*<<char.ml:64:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<char.ml:64:56>>*/ ;
     /*<<char.ml:64:56>>*/ }
    function hash(x){
      /*<<char.ml:65:13>>*/ return  /*<<char.ml:65:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<char.ml:65:41>>*/ ;
     /*<<char.ml:65:41>>*/ }
    var
     Stdlib_Char =
@@ -3072,12 +3133,12 @@
    function succ(u){
      /*<<uchar.ml:34:2>>*/ return u === 55295
             ? hi_bound
-            : u === 1114111 ? caml_call1(Stdlib[1], err_no_succ) : u + 1 | 0;
+            : u === 1114111 ? caml_call1(Stdlib[1], err_no_succ) : u + 1 | 0 /*<<uchar.ml:36:7>>*/ ;
     /*<<uchar.ml:36:7>>*/ }
    function pred(u){
      /*<<uchar.ml:39:2>>*/ return u === 57344
             ? lo_bound
-            : u === 0 ? caml_call1(Stdlib[1], err_no_pred) : u - 1 | 0;
+            : u === 0 ? caml_call1(Stdlib[1], err_no_pred) : u - 1 | 0 /*<<uchar.ml:41:7>>*/ ;
     /*<<uchar.ml:41:7>>*/ }
    function is_valid(i){
      /*<<uchar.ml:43:17>>*/ var
@@ -3090,7 +3151,8 @@
     return _p_;
     /*<<uchar.ml:43:75>>*/ }
    function of_int(i){
-     /*<<uchar.ml:44:15>>*/ if(is_valid(i))  /*<<uchar.ml:44:34>>*/ return i;
+     /*<<uchar.ml:44:15>>*/ if(is_valid(i))
+      /*<<uchar.ml:44:34>>*/ return i /*<<uchar.ml:44:34>>*/ ;
      /*<<uchar.ml:20:19>>*/  /*<<uchar.ml:20:19>>*/ var
      _m_ =
         /*<<uchar.ml:20:19>>*/ caml_call2
@@ -3098,16 +3160,17 @@
           /*<<uchar.ml:20:19>>*/ caml_format_int("%X", i),
          cst_is_not_an_Unicode_scalar_v);
      /*<<uchar.ml:44:53>>*/ return  /*<<uchar.ml:44:53>>*/ caml_call1
-            (Stdlib[1], _m_);
+            (Stdlib[1], _m_) /*<<uchar.ml:44:67>>*/ ;
     /*<<uchar.ml:44:67>>*/ }
    function is_char(u){
      /*<<uchar.ml:48:16>>*/ return u < 256 ? 1 : 0;
     /*<<uchar.ml:48:23>>*/ }
    function of_char(c){
-     /*<<uchar.ml:49:16>>*/ return c;
+     /*<<uchar.ml:49:16>>*/ return c /*<<uchar.ml:49:16>>*/ ;
     /*<<uchar.ml:49:27>>*/ }
    function to_char(u){
-     /*<<uchar.ml:51:2>>*/ if(255 >= u)  /*<<uchar.ml:52:2>>*/ return u;
+     /*<<uchar.ml:51:2>>*/ if(255 >= u)
+      /*<<uchar.ml:52:2>>*/ return u /*<<uchar.ml:52:2>>*/ ;
      /*<<uchar.ml:21:30>>*/ var
       /*<<uchar.ml:21:30>>*/ _k_ =
         /*<<uchar.ml:21:30>>*/ caml_call2
@@ -3117,7 +3180,7 @@
       /*<<uchar.ml:21:30>>*/ _l_ =
         /*<<uchar.ml:21:30>>*/ caml_call2(Stdlib[28], cst_U, _k_);
      /*<<uchar.ml:51:30>>*/ return  /*<<uchar.ml:51:30>>*/ caml_call1
-            (Stdlib[1], _l_);
+            (Stdlib[1], _l_) /*<<uchar.ml:52:19>>*/ ;
     /*<<uchar.ml:52:19>>*/ }
    function unsafe_to_char(_j_){ /*<<?>>*/ return _j_;}
    function equal(_i_, _h_){ /*<<?>>*/ return _i_ === _h_ ? 1 : 0;}
@@ -3147,23 +3210,27 @@
      /*<<uchar.ml:79:26>>*/ if(0 > u)
       /*<<uchar.ml:80:18>>*/ throw  /*<<uchar.ml:80:18>>*/ caml_maybe_attach_backtrace
             ([0, Assert_failure, _b_], 1);
-     /*<<uchar.ml:81:9>>*/ if(127 >= u)  /*<<uchar.ml:81:24>>*/ return 1;
-     /*<<uchar.ml:82:9>>*/ if(2047 >= u)  /*<<uchar.ml:82:24>>*/ return 2;
-     /*<<uchar.ml:83:9>>*/ if(65535 >= u)  /*<<uchar.ml:83:24>>*/ return 3;
+     /*<<uchar.ml:81:9>>*/ if(127 >= u)
+      /*<<uchar.ml:81:24>>*/ return 1 /*<<uchar.ml:81:24>>*/ ;
+     /*<<uchar.ml:82:9>>*/ if(2047 >= u)
+      /*<<uchar.ml:82:24>>*/ return 2 /*<<uchar.ml:82:24>>*/ ;
+     /*<<uchar.ml:83:9>>*/ if(65535 >= u)
+      /*<<uchar.ml:83:24>>*/ return 3 /*<<uchar.ml:83:24>>*/ ;
      /*<<uchar.ml:84:9>>*/ if(1114111 < u)
       /*<<uchar.ml:85:7>>*/ throw  /*<<uchar.ml:85:7>>*/ caml_maybe_attach_backtrace
             ([0, Assert_failure, _a_], 1);
-     /*<<uchar.ml:84:26>>*/ return 4;
+     /*<<uchar.ml:84:26>>*/ return 4 /*<<uchar.ml:84:26>>*/ ;
     /*<<uchar.ml:85:19>>*/ }
    function utf_16_byte_length(u){
      /*<<uchar.ml:87:27>>*/ if(0 > u)
       /*<<uchar.ml:88:18>>*/ throw  /*<<uchar.ml:88:18>>*/ caml_maybe_attach_backtrace
             ([0, Assert_failure, _d_], 1);
-     /*<<uchar.ml:89:9>>*/ if(65535 >= u)  /*<<uchar.ml:89:24>>*/ return 2;
+     /*<<uchar.ml:89:9>>*/ if(65535 >= u)
+      /*<<uchar.ml:89:24>>*/ return 2 /*<<uchar.ml:89:24>>*/ ;
      /*<<uchar.ml:90:9>>*/ if(1114111 < u)
       /*<<uchar.ml:91:7>>*/ throw  /*<<uchar.ml:91:7>>*/ caml_maybe_attach_backtrace
             ([0, Assert_failure, _c_], 1);
-     /*<<uchar.ml:90:26>>*/ return 4;
+     /*<<uchar.ml:90:26>>*/ return 4 /*<<uchar.ml:90:26>>*/ ;
     /*<<uchar.ml:91:19>>*/ }
    var
     Stdlib_Uchar =
@@ -3234,7 +3301,7 @@
    function length(l$0){
      /*<<list.ml:25:15>>*/ var len = 0, param = l$0;
     for(;;){
-     if(! param)  /*<<list.ml:22:10>>*/ return len;
+     if(! param)  /*<<list.ml:22:10>>*/ return len /*<<list.ml:22:10>>*/ ;
       /*<<list.ml:23:12>>*/ var
       l = param[2],
        /*<<list.ml:23:12>>*/ len$0 = len + 1 | 0;
@@ -3243,33 +3310,34 @@
     }
     /*<<list.ml:25:29>>*/ }
    function cons(a, l){
-     /*<<list.ml:27:15>>*/ return [0, a, l];
+     /*<<list.ml:27:15>>*/ return [0, a, l] /*<<list.ml:27:15>>*/ ;
     /*<<list.ml:27:19>>*/ }
    function hd(param){
      /*<<list.ml:29:9>>*/ if(! param)
       /*<<list.ml:30:10>>*/ return  /*<<list.ml:30:10>>*/ caml_call1
-             (Stdlib[2], cst_hd);
+             (Stdlib[2], cst_hd) /*<<list.ml:31:13>>*/ ;
     var a = param[1];
-     /*<<list.ml:31:12>>*/ return a;
+     /*<<list.ml:31:12>>*/ return a /*<<list.ml:31:12>>*/ ;
     /*<<list.ml:31:13>>*/ }
    function tl(param){
      /*<<list.ml:33:9>>*/ if(! param)
       /*<<list.ml:34:10>>*/ return  /*<<list.ml:34:10>>*/ caml_call1
-             (Stdlib[2], cst_tl);
+             (Stdlib[2], cst_tl) /*<<list.ml:35:13>>*/ ;
     var l = param[2];
-     /*<<list.ml:35:12>>*/ return l;
+     /*<<list.ml:35:12>>*/ return l /*<<list.ml:35:12>>*/ ;
     /*<<list.ml:35:13>>*/ }
    function nth(l, n){
      /*<<list.ml:38:2>>*/ if(0 > n)
       /*<<list.ml:38:16>>*/ return  /*<<list.ml:38:16>>*/ caml_call1
-             (Stdlib[1], cst_List_nth);
+             (Stdlib[1], cst_List_nth) /*<<list.ml:43:16>>*/ ;
     var l$0 = l, n$0 = n;
      /*<<list.ml:40:4>>*/ for(;;){
      if(! l$0)
        /*<<list.ml:41:12>>*/ return  /*<<list.ml:41:12>>*/ caml_call1
-              (Stdlib[2], cst_nth);
+              (Stdlib[2], cst_nth) /*<<list.ml:43:16>>*/ ;
      var l$1 = l$0[2], a = l$0[1];
-      /*<<list.ml:42:14>>*/ if(0 === n$0)  /*<<list.ml:42:28>>*/ return a;
+      /*<<list.ml:42:14>>*/ if(0 === n$0)
+       /*<<list.ml:42:28>>*/ return a /*<<list.ml:42:28>>*/ ;
       /*<<list.ml:42:35>>*/  /*<<list.ml:42:35>>*/ var n$1 = n$0 - 1 | 0;
      l$0 = l$1;
      n$0 = n$1;
@@ -3278,13 +3346,13 @@
    function nth_opt(l, n){
      /*<<list.ml:46:2>>*/ if(0 > n)
       /*<<list.ml:46:16>>*/ return  /*<<list.ml:46:16>>*/ caml_call1
-             (Stdlib[1], cst_List_nth$0);
+             (Stdlib[1], cst_List_nth$0) /*<<list.ml:51:16>>*/ ;
     var l$0 = l, n$0 = n;
      /*<<list.ml:48:4>>*/ for(;;){
-     if(! l$0)  /*<<list.ml:49:12>>*/ return 0;
+     if(! l$0)  /*<<list.ml:49:12>>*/ return 0 /*<<list.ml:49:12>>*/ ;
      var l$1 = l$0[2], a = l$0[1];
       /*<<list.ml:50:14>>*/ if(0 === n$0)
-       /*<<list.ml:50:28>>*/ return [0, a];
+       /*<<list.ml:50:28>>*/ return [0, a] /*<<list.ml:50:28>>*/ ;
       /*<<list.ml:50:40>>*/  /*<<list.ml:50:40>>*/ var n$1 = n$0 - 1 | 0;
      l$0 = l$1;
      n$0 = n$1;
@@ -3306,7 +3374,7 @@
    function rev_append(l1, l2){
      /*<<list.ml:56:2>>*/ var l1$0 = l1, l2$0 = l2;
      /*<<list.ml:56:2>>*/ for(;;){
-     if(! l1$0)  /*<<list.ml:57:10>>*/ return l2$0;
+     if(! l1$0)  /*<<list.ml:57:10>>*/ return l2$0 /*<<list.ml:57:10>>*/ ;
       /*<<list.ml:58:27>>*/ var
       l1$1 = l1$0[2],
       a = l1$0[1],
@@ -3316,18 +3384,18 @@
     }
     /*<<list.ml:58:36>>*/ }
    function rev(l){
-     /*<<list.ml:60:12>>*/ return rev_append(l, 0);
+     /*<<list.ml:60:12>>*/ return rev_append(l, 0) /*<<list.ml:60:27>>*/ ;
     /*<<list.ml:60:27>>*/ }
    function init(len, f){
      /*<<list.ml:71:2>>*/ if(0 > len)
       /*<<list.ml:71:18>>*/ return  /*<<list.ml:71:18>>*/ caml_call1
-             (Stdlib[1], cst_List_init);
+             (Stdlib[1], cst_List_init) /*<<list.ml:72:20>>*/ ;
     var last = len - 1 | 0, i$1 = 0;
-    if(last < 0)  /*<<list.ml:63:19>>*/ return 0;
+    if(last < 0)  /*<<list.ml:63:19>>*/ return 0 /*<<list.ml:63:19>>*/ ;
     if(0 === last)
       /*<<list.ml:64:24>>*/ return [0,
               /*<<list.ml:64:25>>*/ caml_call1(f, i$1),
-             0];
+             0] /*<<list.ml:64:24>>*/ ;
      /*<<list.ml:66:13>>*/ var
       /*<<list.ml:66:13>>*/ r1 =  /*<<list.ml:66:13>>*/ caml_call1(f, i$1),
       /*<<list.ml:67:13>>*/ r2 =  /*<<list.ml:67:13>>*/ caml_call1(f, 1),
@@ -3354,25 +3422,27 @@
       }
       dst[1 + offset] = [0,  /*<<list.ml:64:25>>*/ caml_call1(f, i), 0];
      }
-      /*<<list.ml:68:4>>*/ return [0, r1, block];
+      /*<<list.ml:68:4>>*/ return [0, r1, block] /*<<list.ml:68:4>>*/ ;
     }
     /*<<list.ml:72:20>>*/ }
    function flatten(param){
-     /*<<list.ml:74:18>>*/ if(! param)  /*<<list.ml:75:10>>*/ return 0;
+     /*<<list.ml:74:18>>*/ if(! param)
+      /*<<list.ml:75:10>>*/ return 0 /*<<list.ml:75:10>>*/ ;
      /*<<list.ml:76:16>>*/ var
      r = param[2],
      l = param[1],
       /*<<list.ml:76:16>>*/ _I_ = flatten(r);
      /*<<list.ml:76:16>>*/ return  /*<<list.ml:76:16>>*/ caml_call2
-            (Stdlib[37], l, _I_);
+            (Stdlib[37], l, _I_) /*<<list.ml:76:25>>*/ ;
     /*<<list.ml:76:25>>*/ }
    function map(f, param){
-     /*<<?>>*/ if(! param)  /*<<list.ml:81:10>>*/ return 0;
+     /*<<?>>*/ if(! param)
+      /*<<list.ml:81:10>>*/ return 0 /*<<list.ml:81:10>>*/ ;
     var match = param[2], a1 = param[1];
     if(! match){
       /*<<list.ml:83:15>>*/  /*<<list.ml:83:15>>*/ var
       r1$0 =  /*<<list.ml:83:15>>*/ caml_call1(f, a1);
-      /*<<list.ml:84:6>>*/ return [0, r1$0, 0];
+      /*<<list.ml:84:6>>*/ return [0, r1$0, 0] /*<<list.ml:84:6>>*/ ;
     }
      /*<<list.ml:86:15>>*/ var
      l = match[2],
@@ -3407,17 +3477,17 @@
      }
      else
       dst[1 + offset] = 0;
-      /*<<list.ml:88:6>>*/ return [0, r1, block];
+      /*<<list.ml:88:6>>*/ return [0, r1, block] /*<<list.ml:88:6>>*/ ;
     }
    }
    function mapi(f, l$1){
      /*<<list.ml:100:15>>*/ var i$1 = 0;
-    if(! l$1)  /*<<list.ml:91:10>>*/ return 0;
+    if(! l$1)  /*<<list.ml:91:10>>*/ return 0 /*<<list.ml:91:10>>*/ ;
     var match = l$1[2], a1 = l$1[1];
     if(! match){
       /*<<list.ml:93:15>>*/  /*<<list.ml:93:15>>*/ var
       r1$0 =  /*<<list.ml:93:15>>*/ caml_call2(f, i$1, a1);
-      /*<<list.ml:94:6>>*/ return [0, r1$0, 0];
+      /*<<list.ml:94:6>>*/ return [0, r1$0, 0] /*<<list.ml:94:6>>*/ ;
     }
      /*<<list.ml:96:15>>*/ var
      l = match[2],
@@ -3455,13 +3525,13 @@
      }
      else
       dst[1 + offset] = 0;
-      /*<<list.ml:98:6>>*/ return [0, r1, block];
+      /*<<list.ml:98:6>>*/ return [0, r1, block] /*<<list.ml:98:6>>*/ ;
     }
     /*<<list.ml:100:25>>*/ }
    function rev_map(f, l){
      /*<<list.ml:103:2>>*/ var accu = 0, param = l;
     for(;;){
-     if(! param)  /*<<list.ml:104:12>>*/ return accu;
+     if(! param)  /*<<list.ml:104:12>>*/ return accu /*<<list.ml:104:12>>*/ ;
       /*<<list.ml:105:21>>*/ var
       l$0 = param[2],
       a = param[1],
@@ -3474,7 +3544,7 @@
    function iter(f, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:111:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:111:10>>*/ return 0 /*<<list.ml:111:10>>*/ ;
      var l = param$0[2], a = param$0[1];
       /*<<list.ml:112:12>>*/  /*<<list.ml:112:12>>*/ caml_call1(f, a);
      param$0 = l;
@@ -3483,7 +3553,7 @@
    function iteri(f, l$0){
      /*<<list.ml:118:16>>*/ var i = 0, param = l$0;
     for(;;){
-     if(! param)  /*<<list.ml:115:10>>*/ return 0;
+     if(! param)  /*<<list.ml:115:10>>*/ return 0 /*<<list.ml:115:10>>*/ ;
      var l = param[2], a = param[1];
       /*<<list.ml:116:12>>*/  /*<<list.ml:116:12>>*/ caml_call2(f, i, a);
      var i$0 = i + 1 | 0;
@@ -3494,7 +3564,7 @@
    function fold_left(f, accu, l){
      /*<<list.ml:121:2>>*/ var accu$0 = accu, l$0 = l;
      /*<<list.ml:121:2>>*/ for(;;){
-     if(! l$0)  /*<<list.ml:122:10>>*/ return accu$0;
+     if(! l$0)  /*<<list.ml:122:10>>*/ return accu$0 /*<<list.ml:122:10>>*/ ;
       /*<<list.ml:123:24>>*/ var
       l$1 = l$0[2],
       a = l$0[1],
@@ -3505,10 +3575,11 @@
     }
     /*<<list.ml:123:36>>*/ }
    function fold_right(f, l, accu){
-     /*<<list.ml:126:2>>*/ if(! l)  /*<<list.ml:127:10>>*/ return accu;
+     /*<<list.ml:126:2>>*/ if(! l)
+      /*<<list.ml:127:10>>*/ return accu /*<<list.ml:127:10>>*/ ;
     var l$0 = l[2], a = l[1];
      /*<<list.ml:128:16>>*/ return  /*<<list.ml:128:16>>*/ caml_call2
-            (f, a, fold_right(f, l$0, accu));
+            (f, a, fold_right(f, l$0, accu)) /*<<list.ml:128:37>>*/ ;
     /*<<list.ml:128:37>>*/ }
    function map2(f, l1, l2){
      /*<<list.ml:131:2>>*/ if(l1){
@@ -3573,7 +3644,7 @@
           else if(! l2$1){dst[1 + offset] = 0; break a;}
           dst[1 + offset] = caml_call1(Stdlib[1], cst_List_map2$0);
          }
-          /*<<list.ml:139:6>>*/ return [0, r1, block];
+          /*<<list.ml:139:6>>*/ return [0, r1, block] /*<<list.ml:139:6>>*/ ;
         }
        }
       }
@@ -3583,12 +3654,12 @@
        b1$0 = l2[1],
         /*<<list.ml:134:15>>*/ r1$0 =
           /*<<list.ml:134:15>>*/ caml_call2(f, a1, b1$0);
-       /*<<list.ml:135:6>>*/ return [0, r1$0, 0];
+       /*<<list.ml:135:6>>*/ return [0, r1$0, 0] /*<<list.ml:135:6>>*/ ;
      }
     }
-    else if(! l2)  /*<<list.ml:132:16>>*/ return 0;
+    else if(! l2)  /*<<list.ml:132:16>>*/ return 0 /*<<list.ml:132:16>>*/ ;
      /*<<list.ml:140:14>>*/ return  /*<<list.ml:140:14>>*/ caml_call1
-            (Stdlib[1], cst_List_map2);
+            (Stdlib[1], cst_List_map2) /*<<list.ml:140:37>>*/ ;
     /*<<list.ml:140:37>>*/ }
    function rev_map2(f, l1, l2){
      /*<<list.ml:143:2>>*/ var accu = 0, l1$0 = l1, l2$0 = l2;
@@ -3608,9 +3679,10 @@
        continue;
       }
      }
-     else if(! l2$0)  /*<<list.ml:145:18>>*/ return accu;
+     else if(! l2$0)
+       /*<<list.ml:145:18>>*/ return accu /*<<list.ml:145:18>>*/ ;
       /*<<list.ml:147:16>>*/ return  /*<<list.ml:147:16>>*/ caml_call1
-             (Stdlib[1], cst_List_rev_map2);
+             (Stdlib[1], cst_List_rev_map2) /*<<list.ml:149:18>>*/ ;
     }
     /*<<list.ml:149:18>>*/ }
    function iter2(f, l1, l2){
@@ -3625,9 +3697,9 @@
        continue;
       }
      }
-     else if(! l2$0)  /*<<list.ml:154:16>>*/ return 0;
+     else if(! l2$0)  /*<<list.ml:154:16>>*/ return 0 /*<<list.ml:154:16>>*/ ;
       /*<<list.ml:156:14>>*/ return  /*<<list.ml:156:14>>*/ caml_call1
-             (Stdlib[1], cst_List_iter2);
+             (Stdlib[1], cst_List_iter2) /*<<list.ml:156:38>>*/ ;
     }
     /*<<list.ml:156:38>>*/ }
    function fold_left2(f, accu, l1, l2){
@@ -3648,9 +3720,10 @@
        continue;
       }
      }
-     else if(! l2$0)  /*<<list.ml:160:16>>*/ return accu$0;
+     else if(! l2$0)
+       /*<<list.ml:160:16>>*/ return accu$0 /*<<list.ml:160:16>>*/ ;
       /*<<list.ml:162:14>>*/ return  /*<<list.ml:162:14>>*/ caml_call1
-             (Stdlib[1], cst_List_fold_left2);
+             (Stdlib[1], cst_List_fold_left2) /*<<list.ml:162:43>>*/ ;
     }
     /*<<list.ml:162:43>>*/ }
    function fold_right2(f, l1, l2, accu){
@@ -3658,34 +3731,36 @@
      if(l2){
       var l2$0 = l2[2], a2 = l2[1], l1$0 = l1[2], a1 = l1[1];
        /*<<list.ml:167:32>>*/ return  /*<<list.ml:167:32>>*/ caml_call3
-              (f, a1, a2, fold_right2(f, l1$0, l2$0, accu));
+              (f, a1, a2, fold_right2(f, l1$0, l2$0, accu)) /*<<list.ml:168:44>>*/ ;
      }
     }
-    else if(! l2)  /*<<list.ml:166:16>>*/ return accu;
+    else if(! l2)  /*<<list.ml:166:16>>*/ return accu /*<<list.ml:166:16>>*/ ;
      /*<<list.ml:168:14>>*/ return  /*<<list.ml:168:14>>*/ caml_call1
-            (Stdlib[1], cst_List_fold_right2);
+            (Stdlib[1], cst_List_fold_right2) /*<<list.ml:168:44>>*/ ;
     /*<<list.ml:168:44>>*/ }
    function for_all(p, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:171:10>>*/ return 1;
+     if(! param$0)  /*<<list.ml:171:10>>*/ return 1 /*<<list.ml:171:10>>*/ ;
       /*<<list.ml:172:12>>*/ var
       l = param$0[2],
       a = param$0[1],
        /*<<list.ml:172:12>>*/ _F_ =  /*<<list.ml:172:12>>*/ caml_call1(p, a);
-      /*<<list.ml:172:12>>*/ if(! _F_)  /*<<list.ml:172:12>>*/ return _F_;
+      /*<<list.ml:172:12>>*/ if(! _F_)
+       /*<<list.ml:172:12>>*/ return _F_ /*<<list.ml:172:12>>*/ ;
      param$0 = l;
     }
    }
    function exists(p, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:175:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:175:10>>*/ return 0 /*<<list.ml:175:10>>*/ ;
       /*<<list.ml:176:12>>*/ var
       l = param$0[2],
       a = param$0[1],
        /*<<list.ml:176:12>>*/ _E_ =  /*<<list.ml:176:12>>*/ caml_call1(p, a);
-      /*<<list.ml:176:12>>*/ if(_E_)  /*<<list.ml:176:12>>*/ return _E_;
+      /*<<list.ml:176:12>>*/ if(_E_)
+       /*<<list.ml:176:12>>*/ return _E_ /*<<list.ml:176:12>>*/ ;
      param$0 = l;
     }
    }
@@ -3701,15 +3776,16 @@
         a1 = l1$0[1],
          /*<<list.ml:181:24>>*/ _D_ =
            /*<<list.ml:181:24>>*/ caml_call2(p, a1, a2);
-        /*<<list.ml:181:24>>*/ if(! _D_)  /*<<list.ml:181:24>>*/ return _D_;
+        /*<<list.ml:181:24>>*/ if(! _D_)
+         /*<<list.ml:181:24>>*/ return _D_ /*<<list.ml:181:24>>*/ ;
        l1$0 = l1$1;
        l2$0 = l2$1;
        continue;
       }
      }
-     else if(! l2$0)  /*<<list.ml:180:16>>*/ return 1;
+     else if(! l2$0)  /*<<list.ml:180:16>>*/ return 1 /*<<list.ml:180:16>>*/ ;
       /*<<list.ml:182:14>>*/ return  /*<<list.ml:182:14>>*/ caml_call1
-             (Stdlib[1], cst_List_for_all2);
+             (Stdlib[1], cst_List_for_all2) /*<<list.ml:182:41>>*/ ;
     }
     /*<<list.ml:182:41>>*/ }
    function exists2(p, l1, l2){
@@ -3724,21 +3800,22 @@
         a1 = l1$0[1],
          /*<<list.ml:187:24>>*/ _C_ =
            /*<<list.ml:187:24>>*/ caml_call2(p, a1, a2);
-        /*<<list.ml:187:24>>*/ if(_C_)  /*<<list.ml:187:24>>*/ return _C_;
+        /*<<list.ml:187:24>>*/ if(_C_)
+         /*<<list.ml:187:24>>*/ return _C_ /*<<list.ml:187:24>>*/ ;
        l1$0 = l1$1;
        l2$0 = l2$1;
        continue;
       }
      }
-     else if(! l2$0)  /*<<list.ml:186:16>>*/ return 0;
+     else if(! l2$0)  /*<<list.ml:186:16>>*/ return 0 /*<<list.ml:186:16>>*/ ;
       /*<<list.ml:188:14>>*/ return  /*<<list.ml:188:14>>*/ caml_call1
-             (Stdlib[1], cst_List_exists2);
+             (Stdlib[1], cst_List_exists2) /*<<list.ml:188:40>>*/ ;
     }
     /*<<list.ml:188:40>>*/ }
    function mem(x, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:191:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:191:10>>*/ return 0 /*<<list.ml:191:10>>*/ ;
      var
       l = param$0[2],
       a = param$0[1],
@@ -3750,7 +3827,7 @@
    function memq(x, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:195:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:195:10>>*/ return 0 /*<<list.ml:195:10>>*/ ;
      var l = param$0[2], a = param$0[1], _A_ = a === x ? 1 : 0;
      if(_A_) return _A_;
      param$0 = l;
@@ -3765,18 +3842,18 @@
      var l = param$0[2], match = param$0[1], b = match[2], a = match[1];
       /*<<list.ml:200:19>>*/ if
       (0 ===  /*<<list.ml:200:19>>*/ caml_compare(a, x))
-       /*<<list.ml:200:40>>*/ return b;
+       /*<<list.ml:200:40>>*/ return b /*<<list.ml:200:40>>*/ ;
      param$0 = l;
     }
    }
    function assoc_opt(x, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:203:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:203:10>>*/ return 0 /*<<list.ml:203:10>>*/ ;
      var l = param$0[2], match = param$0[1], b = match[2], a = match[1];
       /*<<list.ml:204:19>>*/ if
       (0 ===  /*<<list.ml:204:19>>*/ caml_compare(a, x))
-       /*<<list.ml:204:40>>*/ return [0, b];
+       /*<<list.ml:204:40>>*/ return [0, b] /*<<list.ml:204:40>>*/ ;
      param$0 = l;
     }
    }
@@ -3787,23 +3864,24 @@
        /*<<list.ml:207:10>>*/ throw  /*<<list.ml:207:10>>*/ caml_maybe_attach_backtrace
              (Stdlib[8], 1);
      var l = param$0[2], match = param$0[1], b = match[2], a = match[1];
-     if(a === x)  /*<<list.ml:208:31>>*/ return b;
+     if(a === x)  /*<<list.ml:208:31>>*/ return b /*<<list.ml:208:31>>*/ ;
      param$0 = l;
     }
    }
    function assq_opt(x, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:211:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:211:10>>*/ return 0 /*<<list.ml:211:10>>*/ ;
      var l = param$0[2], match = param$0[1], b = match[2], a = match[1];
-     if(a === x)  /*<<list.ml:212:31>>*/ return [0, b];
+     if(a === x)
+       /*<<list.ml:212:31>>*/ return [0, b] /*<<list.ml:212:31>>*/ ;
      param$0 = l;
     }
    }
    function mem_assoc(x, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:215:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:215:10>>*/ return 0 /*<<list.ml:215:10>>*/ ;
      var
       l = param$0[2],
       a = param$0[1][1],
@@ -3815,14 +3893,15 @@
    function mem_assq(x, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:219:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:219:10>>*/ return 0 /*<<list.ml:219:10>>*/ ;
      var l = param$0[2], a = param$0[1][1], _y_ = a === x ? 1 : 0;
      if(_y_) return _y_;
      param$0 = l;
     }
    }
    function remove_assoc(x, param){
-     /*<<?>>*/ if(! param)  /*<<list.ml:223:10>>*/ return 0;
+     /*<<?>>*/ if(! param)
+      /*<<list.ml:223:10>>*/ return 0 /*<<list.ml:223:10>>*/ ;
     var l = param[2], pair = param[1], a = pair[1];
      /*<<list.ml:225:9>>*/ return 0
             ===  /*<<list.ml:225:9>>*/ caml_compare(a, x)
@@ -3830,7 +3909,8 @@
             : [0, pair, remove_assoc(x, l)];
    }
    function remove_assq(x, param){
-     /*<<?>>*/ if(! param)  /*<<list.ml:228:10>>*/ return 0;
+     /*<<?>>*/ if(! param)
+      /*<<list.ml:228:10>>*/ return 0 /*<<list.ml:228:10>>*/ ;
     var l = param[2], pair = param[1], a = pair[1];
     return a === x ? l : [0, pair, remove_assq(x, l)];
    }
@@ -3842,17 +3922,17 @@
              (Stdlib[8], 1);
      var l = param$0[2], x = param$0[1];
       /*<<list.ml:233:17>>*/ if( /*<<list.ml:233:17>>*/ caml_call1(p, x))
-       /*<<list.ml:233:26>>*/ return x;
+       /*<<list.ml:233:26>>*/ return x /*<<list.ml:233:26>>*/ ;
      param$0 = l;
     }
    }
    function find_opt(p, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:236:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:236:10>>*/ return 0 /*<<list.ml:236:10>>*/ ;
      var l = param$0[2], x = param$0[1];
       /*<<list.ml:237:17>>*/ if( /*<<list.ml:237:17>>*/ caml_call1(p, x))
-       /*<<list.ml:237:26>>*/ return [0, x];
+       /*<<list.ml:237:26>>*/ return [0, x] /*<<list.ml:237:26>>*/ ;
      param$0 = l;
     }
    }
@@ -3861,25 +3941,25 @@
      /*<<list.ml:243:2>>*/ return function(param$0){
      var i$0 = i, param = param$0;
      for(;;){
-      if(! param)  /*<<list.ml:241:10>>*/ return 0;
+      if(! param)  /*<<list.ml:241:10>>*/ return 0 /*<<list.ml:241:10>>*/ ;
       var l = param[2], a = param[1];
        /*<<list.ml:242:17>>*/ if( /*<<list.ml:242:17>>*/ caml_call1(p, a))
-        /*<<list.ml:242:26>>*/ return [0, i$0];
+        /*<<list.ml:242:26>>*/ return [0, i$0] /*<<list.ml:242:26>>*/ ;
       var i$1 = i$0 + 1 | 0;
       i$0 = i$1;
       param = l;
-     }};
+     }} /*<<list.ml:243:2>>*/ ;
     /*<<list.ml:243:7>>*/ }
    function find_map(f, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:246:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:246:10>>*/ return 0 /*<<list.ml:246:10>>*/ ;
       /*<<list.ml:248:17>>*/ var
       l = param$0[2],
       x = param$0[1],
        /*<<list.ml:248:17>>*/ result =
          /*<<list.ml:248:17>>*/ caml_call1(f, x);
-     if(result)  /*<<list.ml:249:29>>*/ return result;
+     if(result)  /*<<list.ml:249:29>>*/ return result /*<<list.ml:249:29>>*/ ;
      param$0 = l;
     }
    }
@@ -3888,22 +3968,23 @@
      /*<<list.ml:261:2>>*/ return function(param$0){
      var i$0 = i, param = param$0;
      for(;;){
-      if(! param)  /*<<list.ml:255:10>>*/ return 0;
+      if(! param)  /*<<list.ml:255:10>>*/ return 0 /*<<list.ml:255:10>>*/ ;
        /*<<list.ml:257:17>>*/ var
        l = param[2],
        x = param[1],
         /*<<list.ml:257:17>>*/ result =
           /*<<list.ml:257:17>>*/ caml_call2(f, i$0, x);
-      if(result)  /*<<list.ml:258:29>>*/ return result;
+      if(result)
+        /*<<list.ml:258:29>>*/ return result /*<<list.ml:258:29>>*/ ;
       var i$1 = i$0 + 1 | 0;
       i$0 = i$1;
       param = l;
-     }};
+     }} /*<<list.ml:261:2>>*/ ;
     /*<<list.ml:261:7>>*/ }
    function find_all(p, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:264:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:264:10>>*/ return 0 /*<<list.ml:264:10>>*/ ;
      var l = param$0[2], x = param$0[1];
       /*<<list.ml:265:17>>*/ if( /*<<list.ml:265:17>>*/ caml_call1(p, x)){
        /*<<list.ml:265:26>>*/ var
@@ -3914,7 +3995,7 @@
       for(;;){
        if(! param$1){
         dst[1 + offset] = 0;
-         /*<<list.ml:265:31>>*/ return block;
+         /*<<list.ml:265:31>>*/ return block /*<<list.ml:265:31>>*/ ;
        }
        var l$0 = param$1[2], x$0 = param$1[1];
         /*<<list.ml:265:17>>*/ if( /*<<list.ml:265:17>>*/ caml_call1(p, x$0)){
@@ -3936,7 +4017,7 @@
    function filteri(p, l$1){
      /*<<list.ml:275:18>>*/ var i = 0, param = l$1;
     for(;;){
-     if(! param)  /*<<list.ml:270:10>>*/ return 0;
+     if(! param)  /*<<list.ml:270:10>>*/ return 0 /*<<list.ml:270:10>>*/ ;
       /*<<list.ml:272:6>>*/ var
       l = param[2],
       x = param[1],
@@ -3953,7 +4034,10 @@
      i$1 = i$0,
      param$0 = l;
     for(;;){
-     if(! param$0){dst[1 + offset] = 0;  /*<<list.ml:273:25>>*/ return block;}
+     if(! param$0){
+      dst[1 + offset] = 0;
+       /*<<list.ml:273:25>>*/ return block /*<<list.ml:273:25>>*/ ;
+     }
       /*<<list.ml:272:6>>*/ var
       l$0 = param$0[2],
       x$0 = param$0[1],
@@ -3973,7 +4057,7 @@
    function filter_map(f, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:278:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:278:10>>*/ return 0 /*<<list.ml:278:10>>*/ ;
       /*<<list.ml:280:12>>*/ var
       l = param$0[2],
       x = param$0[1],
@@ -3988,7 +4072,7 @@
       for(;;){
        if(! param$1){
         dst[1 + offset] = 0;
-         /*<<list.ml:282:23>>*/ return block;
+         /*<<list.ml:282:23>>*/ return block /*<<list.ml:282:23>>*/ ;
        }
         /*<<list.ml:280:12>>*/ var
         l$0 = param$1[2],
@@ -4015,7 +4099,7 @@
    function concat_map(f, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<list.ml:285:10>>*/ return 0;
+     if(! param$0)  /*<<list.ml:285:10>>*/ return 0 /*<<list.ml:285:10>>*/ ;
       /*<<list.ml:286:32>>*/ var
       xs = param$0[2],
       x = param$0[1],
@@ -4041,7 +4125,10 @@
         ys$2 = ys$3;
        }
        else{
-        if(! xs$1){dst[1 + offset] = 0;  /*<<list.ml:290:20>>*/ return block;}
+        if(! xs$1){
+         dst[1 + offset] = 0;
+          /*<<list.ml:290:20>>*/ return block /*<<list.ml:290:20>>*/ ;
+        }
          /*<<list.ml:286:32>>*/ var
          xs$0 = xs$1[2],
          x$0 = xs$1[1],
@@ -4058,7 +4145,8 @@
    function fold_left_map(f, accu, l){
      /*<<list.ml:293:2>>*/ var accu$0 = accu, l_accu = 0, param = l;
     for(;;){
-     if(! param)  /*<<list.ml:294:12>>*/ return [0, accu$0, rev(l_accu)];
+     if(! param)
+       /*<<list.ml:294:12>>*/ return [0, accu$0, rev(l_accu)] /*<<list.ml:294:12>>*/ ;
       /*<<list.ml:296:22>>*/ var
       l$0 = param[2],
       x = param[1],
@@ -4077,7 +4165,7 @@
     for(;;){
      if(! param){
        /*<<list.ml:302:20>>*/  /*<<list.ml:302:20>>*/ var _x_ = rev(no);
-       /*<<list.ml:302:10>>*/ return [0, rev(yes), _x_];
+       /*<<list.ml:302:10>>*/ return [0, rev(yes), _x_] /*<<list.ml:302:10>>*/ ;
      }
      var l$0 = param[2], x = param[1];
       /*<<list.ml:303:17>>*/ if( /*<<list.ml:303:17>>*/ caml_call1(p, x)){
@@ -4097,7 +4185,7 @@
     for(;;){
      if(! param){
        /*<<list.ml:308:21>>*/  /*<<list.ml:308:21>>*/ var _w_ = rev(right);
-       /*<<list.ml:308:10>>*/ return [0, rev(left), _w_];
+       /*<<list.ml:308:10>>*/ return [0, rev(left), _w_] /*<<list.ml:308:10>>*/ ;
      }
       /*<<list.ml:310:17>>*/ var
       l$0 = param[2],
@@ -4120,7 +4208,8 @@
     }
     /*<<list.ml:315:14>>*/ }
    function split(param){
-     /*<<list.ml:317:16>>*/ if(! param)  /*<<list.ml:318:10>>*/ return _a_;
+     /*<<list.ml:317:16>>*/ if(! param)
+      /*<<list.ml:318:10>>*/ return _a_ /*<<list.ml:318:10>>*/ ;
      /*<<list.ml:320:21>>*/ var
      l = param[2],
      match = param[1],
@@ -4129,27 +4218,28 @@
       /*<<list.ml:320:21>>*/ match$0 = split(l),
      ry = match$0[2],
      rx = match$0[1];
-     /*<<list.ml:320:32>>*/ return [0, [0, x, rx], [0, y, ry]];
+     /*<<list.ml:320:32>>*/ return [0, [0, x, rx], [0, y, ry]] /*<<list.ml:320:32>>*/ ;
     /*<<list.ml:320:46>>*/ }
    function combine(l1, l2){
      /*<<list.ml:323:2>>*/ if(l1){
      if(l2){
       var l2$0 = l2[2], a2 = l2[1], l1$0 = l1[2], a1 = l1[1];
-       /*<<list.ml:325:24>>*/ return [0, [0, a1, a2], combine(l1$0, l2$0)];
+       /*<<list.ml:325:24>>*/ return [0, [0, a1, a2], combine(l1$0, l2$0)] /*<<list.ml:325:24>>*/ ;
      }
     }
-    else if(! l2)  /*<<list.ml:324:16>>*/ return 0;
+    else if(! l2)  /*<<list.ml:324:16>>*/ return 0 /*<<list.ml:324:16>>*/ ;
      /*<<list.ml:326:14>>*/ return  /*<<list.ml:326:14>>*/ caml_call1
-            (Stdlib[1], cst_List_combine);
+            (Stdlib[1], cst_List_combine) /*<<list.ml:326:40>>*/ ;
     /*<<list.ml:326:40>>*/ }
    function merge(cmp, l1, l2){
-     /*<<list.ml:331:2>>*/ if(! l1)  /*<<list.ml:332:14>>*/ return l2;
-    if(! l2)  /*<<list.ml:333:14>>*/ return l1;
+     /*<<list.ml:331:2>>*/ if(! l1)
+      /*<<list.ml:332:14>>*/ return l2 /*<<list.ml:332:14>>*/ ;
+    if(! l2)  /*<<list.ml:333:14>>*/ return l1 /*<<list.ml:333:14>>*/ ;
     var t2 = l2[2], h2 = l2[1], t1 = l1[2], h1 = l1[1];
      /*<<list.ml:335:9>>*/ return 0
             <  /*<<list.ml:335:9>>*/ caml_call2(cmp, h1, h2)
             ? [0, h2, merge(cmp, l1, t2)]
-            : [0, h1, merge(cmp, t1, l2)];
+            : [0, h1, merge(cmp, t1, l2)] /*<<list.ml:337:32>>*/ ;
     /*<<list.ml:337:32>>*/ }
    function stable_sort(cmp, l){
     function sort(n, l){
@@ -4165,7 +4255,7 @@
            0 <  /*<<list.ml:362:19>>*/ caml_call2(cmp, x1, x2)
             ? [0, x2, [0, x1, 0]]
             : [0, x1, [0, x2, 0]];
-         /*<<list.ml:363:8>>*/ return [0, s, tl];
+         /*<<list.ml:363:8>>*/ return [0, s, tl] /*<<list.ml:363:8>>*/ ;
        }
       }
      }
@@ -4195,7 +4285,7 @@
                 ? [0, x3, [0, x1$0, [0, x2$0, 0]]]
                 : [0, x1$0, [0, x3, [0, x2$0, 0]]]
               : [0, x1$0, [0, x2$0, [0, x3, 0]]];
-         /*<<list.ml:374:8>>*/ return [0, s$0, tl$1];
+         /*<<list.ml:374:8>>*/ return [0, s$0, tl$1] /*<<list.ml:374:8>>*/ ;
        }
       }
      }
@@ -4233,7 +4323,7 @@
       }
       else
        var _u_ = rev_append(l2, accu);
-       /*<<list.ml:380:8>>*/ return [0, _u_, tl$0];
+       /*<<list.ml:380:8>>*/ return [0, _u_, tl$0] /*<<list.ml:380:8>>*/ ;
      }
      /*<<list.ml:380:36>>*/ }
     function rev_sort(n, l){
@@ -4249,7 +4339,7 @@
            0 <  /*<<list.ml:384:19>>*/ caml_call2(cmp, x1, x2)
             ? [0, x1, [0, x2, 0]]
             : [0, x2, [0, x1, 0]];
-         /*<<list.ml:385:8>>*/ return [0, s, tl];
+         /*<<list.ml:385:8>>*/ return [0, s, tl] /*<<list.ml:385:8>>*/ ;
        }
       }
      }
@@ -4279,7 +4369,7 @@
                 <  /*<<list.ml:393:18>>*/ caml_call2(cmp, x2$0, x3)
                 ? [0, x2$0, [0, x3, [0, x1$0, 0]]]
                 : [0, x3, [0, x2$0, [0, x1$0, 0]]];
-         /*<<list.ml:396:8>>*/ return [0, s$0, tl$1];
+         /*<<list.ml:396:8>>*/ return [0, s$0, tl$1] /*<<list.ml:396:8>>*/ ;
        }
       }
      }
@@ -4317,11 +4407,11 @@
       }
       else
        var _s_ = rev_append(l2, accu);
-       /*<<list.ml:402:8>>*/ return [0, _s_, tl$0];
+       /*<<list.ml:402:8>>*/ return [0, _s_, tl$0] /*<<list.ml:402:8>>*/ ;
      }
      /*<<list.ml:402:32>>*/ }
      /*<<list.ml:404:12>>*/  /*<<list.ml:404:12>>*/ var len = length(l);
-     /*<<list.ml:405:2>>*/ return 2 <= len ? sort(len, l)[1] : l;
+     /*<<list.ml:405:2>>*/ return 2 <= len ? sort(len, l)[1] : l /*<<list.ml:405:41>>*/ ;
     /*<<list.ml:405:41>>*/ }
    function sort_uniq(cmp, l){
     function sort(n, l){
@@ -4339,7 +4429,7 @@
            0 === c$0
             ? [0, x1, 0]
             : 0 <= c$0 ? [0, x2, [0, x1, 0]] : [0, x1, [0, x2, 0]];
-         /*<<list.ml:449:8>>*/ return [0, s, tl];
+         /*<<list.ml:449:8>>*/ return [0, s, tl] /*<<list.ml:449:8>>*/ ;
        }
       }
      }
@@ -4406,7 +4496,7 @@
           var _q_ = [0, x1$0, [0, x2$0, [0, x3, 0]]];
          var s$0 = _q_;
         }
-         /*<<list.ml:475:8>>*/ return [0, s$0, tl$1];
+         /*<<list.ml:475:8>>*/ return [0, s$0, tl$1] /*<<list.ml:475:8>>*/ ;
        }
       }
      }
@@ -4457,7 +4547,7 @@
       }
       else
        var _l_ = rev_append(l2, accu);
-       /*<<list.ml:481:8>>*/ return [0, _l_, tl$0];
+       /*<<list.ml:481:8>>*/ return [0, _l_, tl$0] /*<<list.ml:481:8>>*/ ;
      }
      /*<<list.ml:481:36>>*/ }
     function rev_sort(n, l){
@@ -4475,7 +4565,7 @@
            0 === c$0
             ? [0, x1, 0]
             : 0 < c$0 ? [0, x1, [0, x2, 0]] : [0, x2, [0, x1, 0]];
-         /*<<list.ml:489:8>>*/ return [0, s, tl];
+         /*<<list.ml:489:8>>*/ return [0, s, tl] /*<<list.ml:489:8>>*/ ;
        }
       }
      }
@@ -4542,7 +4632,7 @@
            _j_ = _k_;
          var s$0 = _j_;
         }
-         /*<<list.ml:515:8>>*/ return [0, s$0, tl$1];
+         /*<<list.ml:515:8>>*/ return [0, s$0, tl$1] /*<<list.ml:515:8>>*/ ;
        }
       }
      }
@@ -4593,17 +4683,17 @@
       }
       else
        var _e_ = rev_append(l2, accu);
-       /*<<list.ml:521:8>>*/ return [0, _e_, tl$0];
+       /*<<list.ml:521:8>>*/ return [0, _e_, tl$0] /*<<list.ml:521:8>>*/ ;
      }
      /*<<list.ml:521:32>>*/ }
      /*<<list.ml:523:12>>*/  /*<<list.ml:523:12>>*/ var len = length(l);
-     /*<<list.ml:524:2>>*/ return 2 <= len ? sort(len, l)[1] : l;
+     /*<<list.ml:524:2>>*/ return 2 <= len ? sort(len, l)[1] : l /*<<list.ml:524:41>>*/ ;
     /*<<list.ml:524:41>>*/ }
    function compare_lengths(l1, l2){
      /*<<list.ml:528:2>>*/ var l1$0 = l1, l2$0 = l2;
      /*<<list.ml:528:2>>*/ for(;;){
-     if(! l1$0) return l2$0 ? -1 : 0;
-     if(! l2$0)  /*<<list.ml:531:13>>*/ return 1;
+     if(! l1$0) return l2$0 ? -1 : 0 /*<<list.ml:532:45>>*/ ;
+     if(! l2$0)  /*<<list.ml:531:13>>*/ return 1 /*<<list.ml:531:13>>*/ ;
      var l2$1 = l2$0[2], l1$1 = l1$0[2];
      l1$0 = l1$1;
      l2$0 = l2$1;
@@ -4612,16 +4702,18 @@
    function compare_length_with(l, n){
      /*<<list.ml:535:2>>*/ var l$0 = l, n$0 = n;
      /*<<list.ml:535:2>>*/ for(;;){
-     if(! l$0) return 0 === n$0 ? 0 : 0 < n$0 ? -1 : 1;
+     if(! l$0)
+      return 0 === n$0 ? 0 : 0 < n$0 ? -1 : 1 /*<<list.ml:541:33>>*/ ;
      var l$1 = l$0[2];
-      /*<<list.ml:540:4>>*/ if(0 >= n$0)  /*<<list.ml:540:19>>*/ return 1;
+      /*<<list.ml:540:4>>*/ if(0 >= n$0)
+       /*<<list.ml:540:19>>*/ return 1 /*<<list.ml:540:19>>*/ ;
       /*<<list.ml:541:6>>*/  /*<<list.ml:541:6>>*/ var n$1 = n$0 - 1 | 0;
      l$0 = l$1;
      n$0 = n$1;
     }
     /*<<list.ml:541:33>>*/ }
    function is_empty(param){
-     /*<<list.ml:543:15>>*/ return param ? 0 : 1;
+     /*<<list.ml:543:15>>*/ return param ? 0 : 1 /*<<list.ml:545:19>>*/ ;
     /*<<list.ml:545:19>>*/ }
    function equal(eq, l1, l2){
      /*<<list.ml:555:2>>*/ var l1$0 = l1, l2$0 = l2;
@@ -4635,53 +4727,57 @@
         a1 = l1$0[1],
          /*<<list.ml:558:22>>*/ _d_ =
            /*<<list.ml:558:22>>*/ caml_call2(eq, a1, a2);
-        /*<<list.ml:558:22>>*/ if(! _d_)  /*<<list.ml:558:22>>*/ return _d_;
+        /*<<list.ml:558:22>>*/ if(! _d_)
+         /*<<list.ml:558:22>>*/ return _d_ /*<<list.ml:558:22>>*/ ;
        l1$0 = l1$1;
        l2$0 = l2$1;
        continue;
       }
      }
-     else if(! l2$0)  /*<<list.ml:556:14>>*/ return 1;
-      /*<<list.ml:557:27>>*/ return 0;
+     else if(! l2$0)  /*<<list.ml:556:14>>*/ return 1 /*<<list.ml:556:14>>*/ ;
+      /*<<list.ml:557:27>>*/ return 0 /*<<list.ml:557:27>>*/ ;
     }
     /*<<list.ml:558:48>>*/ }
    function compare(cmp, l1, l2){
      /*<<list.ml:561:2>>*/ var l1$0 = l1, l2$0 = l2;
      /*<<list.ml:561:2>>*/ for(;;){
-     if(! l1$0) return l2$0 ? -1 : 0;
+     if(! l1$0) return l2$0 ? -1 : 0 /*<<list.ml:568:26>>*/ ;
      var l1$1 = l1$0[2], a1 = l1$0[1];
-     if(! l2$0)  /*<<list.ml:564:16>>*/ return 1;
+     if(! l2$0)  /*<<list.ml:564:16>>*/ return 1 /*<<list.ml:564:16>>*/ ;
       /*<<list.ml:566:12>>*/ var
       l2$1 = l2$0[2],
       a2 = l2$0[1],
        /*<<list.ml:566:12>>*/ c =
          /*<<list.ml:566:12>>*/ caml_call2(cmp, a1, a2);
-      /*<<list.ml:567:4>>*/ if(0 !== c)  /*<<list.ml:567:19>>*/ return c;
+      /*<<list.ml:567:4>>*/ if(0 !== c)
+       /*<<list.ml:567:19>>*/ return c /*<<list.ml:567:19>>*/ ;
      l1$0 = l1$1;
      l2$0 = l2$1;
     }
     /*<<list.ml:568:26>>*/ }
    function to_seq(l){
      /*<<list.ml:573:2>>*/ function aux(l, param){
-      /*<<list.ml:573:21>>*/ if(! l)  /*<<list.ml:574:12>>*/ return 0;
+      /*<<list.ml:573:21>>*/ if(! l)
+       /*<<list.ml:574:12>>*/ return 0 /*<<list.ml:574:12>>*/ ;
      var tail = l[2], x = l[1];
       /*<<list.ml:575:19>>*/ return [0,
              x,
-             function(_c_){ /*<<?>>*/ return aux(tail, _c_);}];
+             function(_c_){ /*<<?>>*/ return aux(tail, _c_);}] /*<<list.ml:575:19>>*/ ;
      /*<<list.ml:575:41>>*/ }
      /*<<list.ml:577:2>>*/ return function(_b_){
-      /*<<?>>*/ return aux(l, _b_);};
+      /*<<?>>*/ return aux(l, _b_);} /*<<list.ml:577:2>>*/ ;
     /*<<list.ml:577:7>>*/ }
    function of_seq(seq){
      /*<<list.ml:580:2>>*/  /*<<list.ml:580:8>>*/ var
      match =  /*<<list.ml:580:8>>*/ caml_call1(seq, 0);
-    if(! match)  /*<<list.ml:581:15>>*/ return 0;
+    if(! match)  /*<<list.ml:581:15>>*/ return 0 /*<<list.ml:581:15>>*/ ;
      /*<<list.ml:583:18>>*/ var
      seq$0 = match[2],
      x1 = match[1],
       /*<<list.ml:583:18>>*/ match$0 =
         /*<<list.ml:583:18>>*/ caml_call1(seq$0, 0);
-    if(! match$0)  /*<<list.ml:584:19>>*/ return [0, x1, 0];
+    if(! match$0)
+      /*<<list.ml:584:19>>*/ return [0, x1, 0] /*<<list.ml:584:19>>*/ ;
      /*<<list.ml:585:36>>*/ var
      seq$1 = match$0[2],
      x2 = match$0[1],
@@ -4713,7 +4809,7 @@
      }
      else
       dst[1 + offset] = 0;
-      /*<<list.ml:585:30>>*/ return [0, x1, block];
+      /*<<list.ml:585:30>>*/ return [0, x1, block] /*<<list.ml:585:30>>*/ ;
     }
     /*<<list.ml:586:9>>*/ }
    var
@@ -4794,7 +4890,7 @@
    "use strict";
    var runtime = globalThis.jsoo_runtime, caml_hash = runtime.caml_hash;
    function abs(x){
-     /*<<int.ml:29:12>>*/ return 0 <= x ? x : - x | 0;
+     /*<<int.ml:29:12>>*/ return 0 <= x ? x : - x | 0 /*<<int.ml:29:36>>*/ ;
     /*<<int.ml:29:36>>*/ }
    function lognot(x){
      /*<<int.ml:35:15>>*/ return x ^ -1;
@@ -4802,21 +4898,21 @@
    function equal(_b_, _a_){ /*<<?>>*/ return _b_ === _a_ ? 1 : 0;}
    var compare = runtime.caml_int_compare;
    function min(x, y){
-     /*<<int.ml:41:18>>*/ return x <= y ? x : y;
+     /*<<int.ml:41:18>>*/ return x <= y ? x : y /*<<int.ml:41:41>>*/ ;
     /*<<int.ml:41:41>>*/ }
    function max(x, y){
-     /*<<int.ml:42:18>>*/ return y <= x ? x : y;
+     /*<<int.ml:42:18>>*/ return y <= x ? x : y /*<<int.ml:42:41>>*/ ;
     /*<<int.ml:42:41>>*/ }
    function to_string(x){
-     /*<<int.ml:52:18>>*/ return "" + x;
+     /*<<int.ml:52:18>>*/ return "" + x /*<<int.ml:52:18>>*/ ;
     /*<<int.ml:52:35>>*/ }
    function seeded_hash(seed, x){
      /*<<int.ml:56:25>>*/ return  /*<<int.ml:56:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<int.ml:56:56>>*/ ;
     /*<<int.ml:56:56>>*/ }
    function hash(x){
      /*<<int.ml:57:13>>*/ return  /*<<int.ml:57:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<int.ml:57:41>>*/ ;
     /*<<int.ml:57:41>>*/ }
    var
     Stdlib_Int =
@@ -4894,7 +4990,7 @@
      /*<<bytes.ml:42:2>>*/  /*<<bytes.ml:42:10>>*/ var
      s =  /*<<bytes.ml:42:10>>*/ caml_create_bytes(n);
      /*<<bytes.ml:43:2>>*/  /*<<bytes.ml:43:2>>*/ caml_fill_bytes(s, 0, n, c);
-     /*<<bytes.ml:43:2>>*/ return s;
+     /*<<bytes.ml:43:2>>*/ return s /*<<bytes.ml:43:2>>*/ ;
     /*<<bytes.ml:44:3>>*/ }
    function init(n, f){
      /*<<bytes.ml:47:2>>*/ var
@@ -4910,7 +5006,7 @@
       i = _aq_;
      }
     }
-     /*<<bytes.ml:51:2>>*/ return s;
+     /*<<bytes.ml:51:2>>*/ return s /*<<bytes.ml:51:2>>*/ ;
     /*<<bytes.ml:51:3>>*/ }
     /*<<bytes.ml:53:12>>*/ var
      /*<<bytes.ml:53:12>>*/ empty =
@@ -4938,14 +5034,14 @@
         /*<<bytes.ml:57:10>>*/ caml_create_bytes(len);
      /*<<bytes.ml:58:2>>*/  /*<<bytes.ml:58:2>>*/ caml_blit_bytes
      (s, 0, r, 0, len);
-     /*<<bytes.ml:58:2>>*/ return r;
+     /*<<bytes.ml:58:2>>*/ return r /*<<bytes.ml:58:2>>*/ ;
     /*<<bytes.ml:59:3>>*/ }
    function to_string(b){
      /*<<bytes.ml:61:18>>*/ return  /*<<bytes.ml:61:35>>*/ caml_string_of_bytes
-            (copy(b));
+            (copy(b)) /*<<bytes.ml:61:43>>*/ ;
     /*<<bytes.ml:61:43>>*/ }
    function of_string(s){
-     /*<<bytes.ml:62:18>>*/ return copy(caml_bytes_of_string(s));
+     /*<<bytes.ml:62:18>>*/ return copy(caml_bytes_of_string(s)) /*<<bytes.ml:62:43>>*/ ;
     /*<<bytes.ml:62:43>>*/ }
    function sub(s, ofs, len){
      /*<<bytes.ml:65:2>>*/ if
@@ -4954,14 +5050,14 @@
       r =  /*<<bytes.ml:68:12>>*/ caml_create_bytes(len);
       /*<<bytes.ml:69:4>>*/  /*<<bytes.ml:69:4>>*/ caml_blit_bytes
       (s, ofs, r, 0, len);
-      /*<<bytes.ml:69:4>>*/ return r;
+      /*<<bytes.ml:69:4>>*/ return r /*<<bytes.ml:69:4>>*/ ;
     }
      /*<<bytes.ml:66:7>>*/ return  /*<<bytes.ml:66:7>>*/ caml_call1
-            (Stdlib[1], cst_String_sub_Bytes_sub);
+            (Stdlib[1], cst_String_sub_Bytes_sub) /*<<bytes.ml:71:5>>*/ ;
     /*<<bytes.ml:71:5>>*/ }
    function sub_string(b, ofs, len){
      /*<<bytes.ml:73:27>>*/ return  /*<<bytes.ml:73:44>>*/ caml_string_of_bytes
-            (sub(b, ofs, len));
+            (sub(b, ofs, len)) /*<<bytes.ml:73:59>>*/ ;
     /*<<bytes.ml:73:59>>*/ }
    function symbol(a, b){
      /*<<bytes.ml:77:2>>*/ var
@@ -4971,10 +5067,10 @@
     a:
     {
      if(a < 0){if(_an_ && ! match) break a;} else if(! _an_ && match) break a;
-      /*<<bytes.ml:81:9>>*/ return c;
+      /*<<bytes.ml:81:9>>*/ return c /*<<bytes.ml:81:9>>*/ ;
     }
      /*<<bytes.ml:80:27>>*/ return  /*<<bytes.ml:80:27>>*/ caml_call1
-            (Stdlib[1], cst_Bytes_extend);
+            (Stdlib[1], cst_Bytes_extend) /*<<bytes.ml:81:10>>*/ ;
     /*<<bytes.ml:81:10>>*/ }
    function extend(s, left, right){
      /*<<bytes.ml:84:2>>*/ var
@@ -4995,15 +5091,15 @@
     if(0 < cpylen)
       /*<<bytes.ml:88:21>>*/  /*<<bytes.ml:88:21>>*/ caml_blit_bytes
       (s, srcoff, r, dstoff, cpylen);
-     /*<<bytes.ml:88:21>>*/ return r;
+     /*<<bytes.ml:88:21>>*/ return r /*<<bytes.ml:88:21>>*/ ;
     /*<<bytes.ml:89:3>>*/ }
    function fill(s, ofs, len, c){
      /*<<bytes.ml:92:2>>*/ if
      (0 <= ofs && 0 <= len && (caml_ml_bytes_length(s) - len | 0) >= ofs)
       /*<<bytes.ml:94:7>>*/ return  /*<<bytes.ml:94:7>>*/ caml_fill_bytes
-             (s, ofs, len, c);
+             (s, ofs, len, c) /*<<bytes.ml:94:30>>*/ ;
      /*<<bytes.ml:93:7>>*/ return  /*<<bytes.ml:93:7>>*/ caml_call1
-            (Stdlib[1], cst_String_fill_Bytes_fill);
+            (Stdlib[1], cst_String_fill_Bytes_fill) /*<<bytes.ml:94:30>>*/ ;
     /*<<bytes.ml:94:30>>*/ }
    function blit(s1, ofs1, s2, ofs2, len){
      /*<<bytes.ml:97:2>>*/ if
@@ -5014,9 +5110,9 @@
         (caml_ml_bytes_length(s1) - len | 0) >= ofs1
         && 0 <= ofs2 && (caml_ml_bytes_length(s2) - len | 0) >= ofs2)
       /*<<bytes.ml:100:7>>*/ return  /*<<bytes.ml:100:7>>*/ caml_blit_bytes
-             (s1, ofs1, s2, ofs2, len);
+             (s1, ofs1, s2, ofs2, len) /*<<bytes.ml:100:38>>*/ ;
      /*<<bytes.ml:99:7>>*/ return  /*<<bytes.ml:99:7>>*/ caml_call1
-            (Stdlib[1], cst_Bytes_blit);
+            (Stdlib[1], cst_Bytes_blit) /*<<bytes.ml:100:38>>*/ ;
     /*<<bytes.ml:100:38>>*/ }
    function blit_string(s1, ofs1, s2, ofs2, len){
      /*<<bytes.ml:103:2>>*/ if
@@ -5027,9 +5123,9 @@
         (runtime.caml_ml_string_length(s1) - len | 0) >= ofs1
         && 0 <= ofs2 && (caml_ml_bytes_length(s2) - len | 0) >= ofs2)
       /*<<bytes.ml:106:7>>*/ return  /*<<bytes.ml:106:7>>*/ runtime.caml_blit_string
-             (s1, ofs1, s2, ofs2, len);
+             (s1, ofs1, s2, ofs2, len) /*<<bytes.ml:106:45>>*/ ;
      /*<<bytes.ml:105:7>>*/ return  /*<<bytes.ml:105:7>>*/ caml_call1
-            (Stdlib[1], cst_String_blit_Bytes_blit_str);
+            (Stdlib[1], cst_String_blit_Bytes_blit_str) /*<<bytes.ml:106:45>>*/ ;
     /*<<bytes.ml:106:45>>*/ }
    function iter(f, a){
      /*<<bytes.ml:110:2>>*/ var
@@ -5064,7 +5160,8 @@
     return 0;
     /*<<bytes.ml:114:56>>*/ }
    function concat(sep, l){
-     /*<<?>>*/ if(! l)  /*<<bytes.ml:53:12>>*/ return empty;
+     /*<<?>>*/ if(! l)
+      /*<<bytes.ml:53:12>>*/ return empty /*<<bytes.ml:53:12>>*/ ;
     var seplen = caml_ml_bytes_length(sep);
     a:
     {
@@ -5096,12 +5193,13 @@
      pos = pos$1,
      param$0 = l;
     for(;;){
-     if(! param$0)  /*<<bytes.ml:124:10>>*/ return dst;
+     if(! param$0)
+       /*<<bytes.ml:124:10>>*/ return dst /*<<bytes.ml:124:10>>*/ ;
      var hd$0 = param$0[1];
      if(! param$0[2]){
        /*<<bytes.ml:126:4>>*/  /*<<bytes.ml:126:4>>*/ caml_blit_bytes
        (hd$0, 0, dst, pos, caml_ml_bytes_length(hd$0));
-       /*<<bytes.ml:126:4>>*/ return dst;
+       /*<<bytes.ml:126:4>>*/ return dst /*<<bytes.ml:126:4>>*/ ;
      }
      var tl$0 = param$0[2];
       /*<<bytes.ml:128:4>>*/  /*<<bytes.ml:128:4>>*/ caml_blit_bytes
@@ -5124,7 +5222,7 @@
      (s1, 0, r, 0, l1);
      /*<<bytes.ml:144:2>>*/  /*<<bytes.ml:144:2>>*/ caml_blit_bytes
      (s2, 0, r, l1, l2);
-     /*<<bytes.ml:144:2>>*/ return r;
+     /*<<bytes.ml:144:2>>*/ return r /*<<bytes.ml:144:2>>*/ ;
     /*<<bytes.ml:145:3>>*/ }
    function is_space(param){
      /*<<bytes.ml:151:15>>*/  /*<<bytes.ml:151:15>>*/ var
@@ -5132,9 +5230,9 @@
     a:
     {
      if(4 < _af_ >>> 0){if(23 !== _af_) break a;} else if(2 === _af_) break a;
-      /*<<bytes.ml:152:41>>*/ return 1;
+      /*<<bytes.ml:152:41>>*/ return 1 /*<<bytes.ml:152:41>>*/ ;
     }
-     /*<<bytes.ml:153:9>>*/ return 0;
+     /*<<bytes.ml:153:9>>*/ return 0 /*<<bytes.ml:153:9>>*/ ;
     /*<<bytes.ml:153:14>>*/ }
    function trim(s){
      /*<<bytes.ml:156:2>>*/ var
@@ -5150,7 +5248,7 @@
      j = [0, len - 1 | 0];
     for(;;){
      if(i[1] <= j[1] && is_space(caml_bytes_unsafe_get(s, j[1]))){j[1]--; continue;}
-     return i[1] <= j[1] ? sub(s, i[1], (j[1] - i[1] | 0) + 1 | 0) : empty;
+     return i[1] <= j[1] ? sub(s, i[1], (j[1] - i[1] | 0) + 1 | 0) : empty /*<<bytes.ml:168:9>>*/ ;
     }
     /*<<bytes.ml:168:9>>*/ }
    function unsafe_escape(s){
@@ -5193,7 +5291,8 @@
       i$0 = _ae_;
      }
     }
-    if(n[1] === caml_ml_bytes_length(s))  /*<<bytes.ml:192:24>>*/ return s;
+    if(n[1] === caml_ml_bytes_length(s))
+      /*<<bytes.ml:192:24>>*/ return s /*<<bytes.ml:192:24>>*/ ;
      /*<<bytes.ml:194:13>>*/  /*<<bytes.ml:194:13>>*/ var
      s$0 =  /*<<bytes.ml:194:13>>*/ caml_create_bytes(n[1]);
     n[1] = 0;
@@ -5264,15 +5363,16 @@
       i = _ab_;
      }
     }
-     /*<<bytes.ml:221:4>>*/ return s$0;
+     /*<<bytes.ml:221:4>>*/ return s$0 /*<<bytes.ml:221:4>>*/ ;
     /*<<bytes.ml:222:5>>*/ }
    function escaped(b){
      /*<<bytes.ml:225:2>>*/  /*<<bytes.ml:225:10>>*/ var b$0 = copy(b);
-     /*<<bytes.ml:228:2>>*/ return unsafe_escape(b$0);
+     /*<<bytes.ml:228:2>>*/ return unsafe_escape(b$0) /*<<bytes.ml:228:17>>*/ ;
     /*<<bytes.ml:228:17>>*/ }
    function map(f, s){
      /*<<bytes.ml:231:2>>*/ var l = caml_ml_bytes_length(s);
-     /*<<bytes.ml:232:2>>*/ if(0 === l)  /*<<bytes.ml:232:16>>*/ return s;
+     /*<<bytes.ml:232:2>>*/ if(0 === l)
+      /*<<bytes.ml:232:16>>*/ return s /*<<bytes.ml:232:16>>*/ ;
      /*<<bytes.ml:233:12>>*/ var
       /*<<bytes.ml:233:12>>*/ r =
         /*<<bytes.ml:233:12>>*/ caml_create_bytes(l),
@@ -5290,11 +5390,12 @@
       i = _Y_;
      }
     }
-     /*<<bytes.ml:235:4>>*/ return r;
+     /*<<bytes.ml:235:4>>*/ return r /*<<bytes.ml:235:4>>*/ ;
     /*<<bytes.ml:236:5>>*/ }
    function mapi(f, s){
      /*<<bytes.ml:239:2>>*/ var l = caml_ml_bytes_length(s);
-     /*<<bytes.ml:240:2>>*/ if(0 === l)  /*<<bytes.ml:240:16>>*/ return s;
+     /*<<bytes.ml:240:2>>*/ if(0 === l)
+      /*<<bytes.ml:240:16>>*/ return s /*<<bytes.ml:240:16>>*/ ;
      /*<<bytes.ml:241:12>>*/ var
       /*<<bytes.ml:241:12>>*/ r =
         /*<<bytes.ml:241:12>>*/ caml_create_bytes(l),
@@ -5312,7 +5413,7 @@
       i = _V_;
      }
     }
-     /*<<bytes.ml:243:4>>*/ return r;
+     /*<<bytes.ml:243:4>>*/ return r /*<<bytes.ml:243:4>>*/ ;
     /*<<bytes.ml:244:5>>*/ }
    function fold_left(f, x, a){
      /*<<bytes.ml:247:2>>*/ var
@@ -5353,10 +5454,10 @@
    function exists(p, s){
      /*<<bytes.ml:261:2>>*/ var n = caml_ml_bytes_length(s), i = 0;
      /*<<bytes.ml:263:4>>*/ for(;;){
-     if(i === n)  /*<<bytes.ml:263:18>>*/ return 0;
+     if(i === n)  /*<<bytes.ml:263:18>>*/ return 0 /*<<bytes.ml:263:18>>*/ ;
       /*<<bytes.ml:264:12>>*/ if
       ( /*<<bytes.ml:264:12>>*/ caml_call1(p, caml_bytes_unsafe_get(s, i)))
-       /*<<bytes.ml:264:36>>*/ return 1;
+       /*<<bytes.ml:264:36>>*/ return 1 /*<<bytes.ml:264:36>>*/ ;
       /*<<bytes.ml:265:9>>*/  /*<<bytes.ml:265:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -5364,35 +5465,35 @@
    function for_all(p, s){
      /*<<bytes.ml:269:2>>*/ var n = caml_ml_bytes_length(s), i = 0;
      /*<<bytes.ml:271:4>>*/ for(;;){
-     if(i === n)  /*<<bytes.ml:271:18>>*/ return 1;
+     if(i === n)  /*<<bytes.ml:271:18>>*/ return 1 /*<<bytes.ml:271:18>>*/ ;
       /*<<bytes.ml:272:12>>*/ if
       (!  /*<<bytes.ml:272:12>>*/ caml_call1(p, caml_bytes_unsafe_get(s, i)))
-       /*<<bytes.ml:273:9>>*/ return 0;
+       /*<<bytes.ml:273:9>>*/ return 0 /*<<bytes.ml:273:9>>*/ ;
       /*<<bytes.ml:272:36>>*/  /*<<bytes.ml:272:36>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
     /*<<bytes.ml:274:8>>*/ }
    function uppercase_ascii(s){
-     /*<<bytes.ml:276:24>>*/ return map(Stdlib_Char[4], s);
+     /*<<bytes.ml:276:24>>*/ return map(Stdlib_Char[4], s) /*<<bytes.ml:276:50>>*/ ;
     /*<<bytes.ml:276:50>>*/ }
    function lowercase_ascii(s){
-     /*<<bytes.ml:277:24>>*/ return map(Stdlib_Char[3], s);
+     /*<<bytes.ml:277:24>>*/ return map(Stdlib_Char[3], s) /*<<bytes.ml:277:50>>*/ ;
     /*<<bytes.ml:277:50>>*/ }
    function apply1(f, s){
      /*<<bytes.ml:280:2>>*/ if(0 === caml_ml_bytes_length(s))
-      /*<<bytes.ml:280:23>>*/ return s;
+      /*<<bytes.ml:280:23>>*/ return s /*<<bytes.ml:280:23>>*/ ;
      /*<<bytes.ml:281:12>>*/  /*<<bytes.ml:281:12>>*/ var r = copy(s);
     caml_bytes_unsafe_set
      (r,
       0,
        /*<<bytes.ml:282:19>>*/ caml_call1(f, caml_bytes_unsafe_get(s, 0)));
-     /*<<bytes.ml:283:4>>*/ return r;
+     /*<<bytes.ml:283:4>>*/ return r /*<<bytes.ml:283:4>>*/ ;
     /*<<bytes.ml:284:5>>*/ }
    function capitalize_ascii(s){
-     /*<<bytes.ml:286:25>>*/ return apply1(Stdlib_Char[4], s);
+     /*<<bytes.ml:286:25>>*/ return apply1(Stdlib_Char[4], s) /*<<bytes.ml:286:54>>*/ ;
     /*<<bytes.ml:286:54>>*/ }
    function uncapitalize_ascii(s){
-     /*<<bytes.ml:287:27>>*/ return apply1(Stdlib_Char[3], s);
+     /*<<bytes.ml:287:27>>*/ return apply1(Stdlib_Char[3], s) /*<<bytes.ml:287:56>>*/ ;
     /*<<bytes.ml:287:56>>*/ }
    function starts_with(prefix, s){
      /*<<bytes.ml:291:2>>*/ var
@@ -5402,9 +5503,10 @@
     if(! _N_) return _N_;
     var i = 0;
      /*<<bytes.ml:294:4>>*/ for(;;){
-     if(i === len_pre)  /*<<bytes.ml:294:24>>*/ return 1;
+     if(i === len_pre)
+       /*<<bytes.ml:294:24>>*/ return 1 /*<<bytes.ml:294:24>>*/ ;
      if(caml_bytes_unsafe_get(s, i) !== caml_bytes_unsafe_get(prefix, i))
-       /*<<bytes.ml:295:55>>*/ return 0;
+       /*<<bytes.ml:295:55>>*/ return 0 /*<<bytes.ml:295:55>>*/ ;
       /*<<bytes.ml:296:9>>*/  /*<<bytes.ml:296:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -5418,11 +5520,12 @@
     if(! _M_) return _M_;
     var i = 0;
      /*<<bytes.ml:305:4>>*/ for(;;){
-     if(i === len_suf)  /*<<bytes.ml:305:24>>*/ return 1;
+     if(i === len_suf)
+       /*<<bytes.ml:305:24>>*/ return 1 /*<<bytes.ml:305:24>>*/ ;
      if
       (caml_bytes_unsafe_get(s, diff + i | 0)
        !== caml_bytes_unsafe_get(suffix, i))
-       /*<<bytes.ml:306:64>>*/ return 0;
+       /*<<bytes.ml:306:64>>*/ return 0 /*<<bytes.ml:306:64>>*/ ;
       /*<<bytes.ml:307:9>>*/  /*<<bytes.ml:307:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -5434,42 +5537,43 @@
        /*<<bytes.ml:312:19>>*/ throw  /*<<bytes.ml:312:19>>*/ caml_maybe_attach_backtrace
              (Stdlib[8], 1);
      if(caml_bytes_unsafe_get(s, i$0) === c)
-       /*<<bytes.ml:313:29>>*/ return i$0;
+       /*<<bytes.ml:313:29>>*/ return i$0 /*<<bytes.ml:313:29>>*/ ;
      var i$1 = i$0 + 1 | 0;
      i$0 = i$1;
     }
     /*<<bytes.ml:313:61>>*/ }
    function index(s, c){
      /*<<bytes.ml:316:16>>*/ return index_rec
-            (s, caml_ml_bytes_length(s), 0, c);
+            (s, caml_ml_bytes_length(s), 0, c) /*<<bytes.ml:316:42>>*/ ;
     /*<<bytes.ml:316:42>>*/ }
    function index_rec_opt(s, lim, i, c){
      /*<<bytes.ml:320:2>>*/ var i$0 = i;
      /*<<bytes.ml:320:2>>*/ for(;;){
-     if(lim <= i$0)  /*<<bytes.ml:320:19>>*/ return 0;
+     if(lim <= i$0)
+       /*<<bytes.ml:320:19>>*/ return 0 /*<<bytes.ml:320:19>>*/ ;
      if(caml_bytes_unsafe_get(s, i$0) === c)
-       /*<<bytes.ml:321:29>>*/ return [0, i$0];
+       /*<<bytes.ml:321:29>>*/ return [0, i$0] /*<<bytes.ml:321:29>>*/ ;
      var i$1 = i$0 + 1 | 0;
      i$0 = i$1;
     }
     /*<<bytes.ml:321:70>>*/ }
    function index_opt(s, c){
      /*<<bytes.ml:324:20>>*/ return index_rec_opt
-            (s, caml_ml_bytes_length(s), 0, c);
+            (s, caml_ml_bytes_length(s), 0, c) /*<<bytes.ml:324:50>>*/ ;
     /*<<bytes.ml:324:50>>*/ }
    function index_from(s, i, c){
      /*<<bytes.ml:328:2>>*/ var l = caml_ml_bytes_length(s);
      /*<<bytes.ml:329:2>>*/ if(0 <= i && l >= i)
-      /*<<bytes.ml:330:2>>*/ return index_rec(s, l, i, c);
+      /*<<bytes.ml:330:2>>*/ return index_rec(s, l, i, c) /*<<bytes.ml:330:19>>*/ ;
      /*<<bytes.ml:329:25>>*/ return  /*<<bytes.ml:329:25>>*/ caml_call1
-            (Stdlib[1], cst_String_index_from_Bytes_in);
+            (Stdlib[1], cst_String_index_from_Bytes_in) /*<<bytes.ml:330:19>>*/ ;
     /*<<bytes.ml:330:19>>*/ }
    function index_from_opt(s, i, c){
      /*<<bytes.ml:334:2>>*/ var l = caml_ml_bytes_length(s);
      /*<<bytes.ml:335:2>>*/ if(0 <= i && l >= i)
-      /*<<bytes.ml:338:4>>*/ return index_rec_opt(s, l, i, c);
+      /*<<bytes.ml:338:4>>*/ return index_rec_opt(s, l, i, c) /*<<bytes.ml:338:25>>*/ ;
      /*<<bytes.ml:336:4>>*/ return  /*<<bytes.ml:336:4>>*/ caml_call1
-            (Stdlib[1], cst_String_index_from_opt_Byte);
+            (Stdlib[1], cst_String_index_from_opt_Byte) /*<<bytes.ml:338:25>>*/ ;
     /*<<bytes.ml:338:25>>*/ }
    function rindex_rec(s, i, c){
      /*<<bytes.ml:342:2>>*/ var i$0 = i;
@@ -5478,40 +5582,40 @@
        /*<<bytes.ml:342:16>>*/ throw  /*<<bytes.ml:342:16>>*/ caml_maybe_attach_backtrace
              (Stdlib[8], 1);
      if(caml_bytes_unsafe_get(s, i$0) === c)
-       /*<<bytes.ml:343:29>>*/ return i$0;
+       /*<<bytes.ml:343:29>>*/ return i$0 /*<<bytes.ml:343:29>>*/ ;
      var i$1 = i$0 - 1 | 0;
      i$0 = i$1;
     }
     /*<<bytes.ml:343:58>>*/ }
    function rindex(s, c){
      /*<<bytes.ml:346:17>>*/ return rindex_rec
-            (s, caml_ml_bytes_length(s) - 1 | 0, c);
+            (s, caml_ml_bytes_length(s) - 1 | 0, c) /*<<bytes.ml:346:46>>*/ ;
     /*<<bytes.ml:346:46>>*/ }
    function rindex_from(s, i, c){
      /*<<bytes.ml:350:2>>*/ if(-1 <= i && caml_ml_bytes_length(s) > i)
-      /*<<bytes.ml:353:4>>*/ return rindex_rec(s, i, c);
+      /*<<bytes.ml:353:4>>*/ return rindex_rec(s, i, c) /*<<bytes.ml:353:20>>*/ ;
      /*<<bytes.ml:351:4>>*/ return  /*<<bytes.ml:351:4>>*/ caml_call1
-            (Stdlib[1], cst_String_rindex_from_Bytes_r);
+            (Stdlib[1], cst_String_rindex_from_Bytes_r) /*<<bytes.ml:353:20>>*/ ;
     /*<<bytes.ml:353:20>>*/ }
    function rindex_rec_opt(s, i, c){
      /*<<bytes.ml:357:2>>*/ var i$0 = i;
      /*<<bytes.ml:357:2>>*/ for(;;){
-     if(0 > i$0)  /*<<bytes.ml:357:16>>*/ return 0;
+     if(0 > i$0)  /*<<bytes.ml:357:16>>*/ return 0 /*<<bytes.ml:357:16>>*/ ;
      if(caml_bytes_unsafe_get(s, i$0) === c)
-       /*<<bytes.ml:358:29>>*/ return [0, i$0];
+       /*<<bytes.ml:358:29>>*/ return [0, i$0] /*<<bytes.ml:358:29>>*/ ;
      var i$1 = i$0 - 1 | 0;
      i$0 = i$1;
     }
     /*<<bytes.ml:358:67>>*/ }
    function rindex_opt(s, c){
      /*<<bytes.ml:361:21>>*/ return rindex_rec_opt
-            (s, caml_ml_bytes_length(s) - 1 | 0, c);
+            (s, caml_ml_bytes_length(s) - 1 | 0, c) /*<<bytes.ml:361:54>>*/ ;
     /*<<bytes.ml:361:54>>*/ }
    function rindex_from_opt(s, i, c){
      /*<<bytes.ml:365:2>>*/ if(-1 <= i && caml_ml_bytes_length(s) > i)
-      /*<<bytes.ml:368:4>>*/ return rindex_rec_opt(s, i, c);
+      /*<<bytes.ml:368:4>>*/ return rindex_rec_opt(s, i, c) /*<<bytes.ml:368:24>>*/ ;
      /*<<bytes.ml:366:4>>*/ return  /*<<bytes.ml:366:4>>*/ caml_call1
-            (Stdlib[1], cst_String_rindex_from_opt_Byt);
+            (Stdlib[1], cst_String_rindex_from_opt_Byt) /*<<bytes.ml:368:24>>*/ ;
     /*<<bytes.ml:368:24>>*/ }
    function contains_from(s, i, c){
      /*<<bytes.ml:373:2>>*/ var l = caml_ml_bytes_length(s);
@@ -5519,33 +5623,35 @@
       /*<<bytes.ml:377:4>>*/ try{
        /*<<bytes.ml:377:15>>*/ index_rec(s, l, i, c);
        /*<<bytes.ml:377:36>>*/  /*<<bytes.ml:377:36>>*/ var _K_ = 1;
-       /*<<bytes.ml:377:36>>*/ return _K_;
+       /*<<bytes.ml:377:36>>*/ return _K_ /*<<bytes.ml:377:36>>*/ ;
      }
      catch(_L_){
       var _J_ = caml_wrap_exception(_L_);
-      if(_J_ === Stdlib[8])  /*<<bytes.ml:377:59>>*/ return 0;
+      if(_J_ === Stdlib[8])
+        /*<<bytes.ml:377:59>>*/ return 0 /*<<bytes.ml:377:59>>*/ ;
       throw caml_maybe_attach_backtrace(_J_, 0);
      }
      /*<<bytes.ml:375:4>>*/ return  /*<<bytes.ml:375:4>>*/ caml_call1
-            (Stdlib[1], cst_String_contains_from_Bytes);
+            (Stdlib[1], cst_String_contains_from_Bytes) /*<<bytes.ml:377:64>>*/ ;
     /*<<bytes.ml:377:64>>*/ }
    function contains(s, c){
-     /*<<bytes.ml:381:19>>*/ return contains_from(s, 0, c);
+     /*<<bytes.ml:381:19>>*/ return contains_from(s, 0, c) /*<<bytes.ml:381:38>>*/ ;
     /*<<bytes.ml:381:38>>*/ }
    function rcontains_from(s, i, c){
      /*<<bytes.ml:385:2>>*/ if(0 <= i && caml_ml_bytes_length(s) > i)
       /*<<bytes.ml:388:4>>*/ try{
        /*<<bytes.ml:388:15>>*/ rindex_rec(s, i, c);
        /*<<bytes.ml:388:35>>*/  /*<<bytes.ml:388:35>>*/ var _H_ = 1;
-       /*<<bytes.ml:388:35>>*/ return _H_;
+       /*<<bytes.ml:388:35>>*/ return _H_ /*<<bytes.ml:388:35>>*/ ;
      }
      catch(_I_){
       var _G_ = caml_wrap_exception(_I_);
-      if(_G_ === Stdlib[8])  /*<<bytes.ml:388:58>>*/ return 0;
+      if(_G_ === Stdlib[8])
+        /*<<bytes.ml:388:58>>*/ return 0 /*<<bytes.ml:388:58>>*/ ;
       throw caml_maybe_attach_backtrace(_G_, 0);
      }
      /*<<bytes.ml:386:4>>*/ return  /*<<bytes.ml:386:4>>*/ caml_call1
-            (Stdlib[1], cst_String_rcontains_from_Byte);
+            (Stdlib[1], cst_String_rcontains_from_Byte) /*<<bytes.ml:388:63>>*/ ;
     /*<<bytes.ml:388:63>>*/ }
    var
     compare = runtime.caml_bytes_compare,
@@ -5571,39 +5677,39 @@
      }
     }
     var _D_ = r[1];
-     /*<<bytes.ml:406:2>>*/ return [0, sub(s, 0, j[1]), _D_];
+     /*<<bytes.ml:406:2>>*/ return [0, sub(s, 0, j[1]), _D_] /*<<bytes.ml:406:2>>*/ ;
     /*<<bytes.ml:406:18>>*/ }
    function to_seq(s){
     function aux(i, param){
       /*<<bytes.ml:412:4>>*/ if(i === caml_ml_bytes_length(s))
-       /*<<bytes.ml:412:25>>*/ return 0;
+       /*<<bytes.ml:412:25>>*/ return 0 /*<<bytes.ml:412:25>>*/ ;
       /*<<bytes.ml:414:14>>*/ var
        /*<<bytes.ml:414:14>>*/ x =
          /*<<bytes.ml:414:14>>*/ caml_bytes_get(s, i),
        /*<<bytes.ml:414:14>>*/ _A_ = i + 1 | 0;
       /*<<bytes.ml:415:6>>*/ return [0,
              x,
-             function(_B_){ /*<<?>>*/ return aux(_A_, _B_);}];
+             function(_B_){ /*<<?>>*/ return aux(_A_, _B_);}] /*<<bytes.ml:415:6>>*/ ;
      /*<<bytes.ml:415:29>>*/ }
      /*<<bytes.ml:417:2>>*/ var _y_ = 0;
      /*<<bytes.ml:417:2>>*/ return function(_z_){
-      /*<<?>>*/ return aux(_y_, _z_);};
+      /*<<?>>*/ return aux(_y_, _z_);} /*<<bytes.ml:417:2>>*/ ;
     /*<<bytes.ml:417:7>>*/ }
    function to_seqi(s){
     function aux(i, param){
       /*<<bytes.ml:421:4>>*/ if(i === caml_ml_bytes_length(s))
-       /*<<bytes.ml:421:25>>*/ return 0;
+       /*<<bytes.ml:421:25>>*/ return 0 /*<<bytes.ml:421:25>>*/ ;
       /*<<bytes.ml:423:14>>*/ var
        /*<<bytes.ml:423:14>>*/ x =
          /*<<bytes.ml:423:14>>*/ caml_bytes_get(s, i),
        /*<<bytes.ml:423:14>>*/ _w_ = i + 1 | 0;
       /*<<bytes.ml:424:6>>*/ return [0,
              [0, i, x],
-             function(_x_){ /*<<?>>*/ return aux(_w_, _x_);}];
+             function(_x_){ /*<<?>>*/ return aux(_w_, _x_);}] /*<<bytes.ml:424:6>>*/ ;
      /*<<bytes.ml:424:33>>*/ }
      /*<<bytes.ml:426:2>>*/ var _u_ = 0;
      /*<<bytes.ml:426:2>>*/ return function(_v_){
-      /*<<?>>*/ return aux(_u_, _v_);};
+      /*<<?>>*/ return aux(_u_, _v_);} /*<<bytes.ml:426:2>>*/ ;
     /*<<bytes.ml:426:7>>*/ }
    function of_seq(i){
      /*<<bytes.ml:429:2>>*/ var
@@ -5633,19 +5739,19 @@
        return 0;
        /*<<bytes.ml:443:13>>*/ },
       i);
-    return sub(buf[1], 0, n[1]);
+    return sub(buf[1], 0, n[1]) /*<<bytes.ml:445:15>>*/ ;
     /*<<bytes.ml:445:15>>*/ }
    function unsafe_get_uint16_le(b, i){
      /*<<bytes.ml:470:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:471:14>>*/ caml_bswap16
               ( /*<<bytes.ml:471:14>>*/ caml_bytes_get16(b, i))
-            :  /*<<bytes.ml:472:7>>*/ caml_bytes_get16(b, i);
+            :  /*<<bytes.ml:472:7>>*/ caml_bytes_get16(b, i) /*<<bytes.ml:472:31>>*/ ;
     /*<<bytes.ml:472:31>>*/ }
    function unsafe_get_uint16_be(b, i){
      /*<<bytes.ml:475:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:476:7>>*/ caml_bytes_get16(b, i)
             :  /*<<bytes.ml:477:14>>*/ caml_bswap16
-              ( /*<<bytes.ml:477:14>>*/ caml_bytes_get16(b, i));
+              ( /*<<bytes.ml:477:14>>*/ caml_bytes_get16(b, i)) /*<<bytes.ml:477:40>>*/ ;
     /*<<bytes.ml:477:40>>*/ }
    function get_int8(b, i){
      /*<<bytes.ml:480:2>>*/ var
@@ -5657,13 +5763,13 @@
      /*<<bytes.ml:483:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:483:32>>*/ caml_bswap16
               ( /*<<bytes.ml:483:32>>*/ caml_bytes_get16(b, i))
-            :  /*<<bytes.ml:484:7>>*/ caml_bytes_get16(b, i);
+            :  /*<<bytes.ml:484:7>>*/ caml_bytes_get16(b, i) /*<<bytes.ml:484:24>>*/ ;
     /*<<bytes.ml:484:24>>*/ }
    function get_uint16_be(b, i){
      /*<<bytes.ml:487:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:488:7>>*/ caml_bytes_get16(b, i)
             :  /*<<bytes.ml:487:36>>*/ caml_bswap16
-              ( /*<<bytes.ml:487:36>>*/ caml_bytes_get16(b, i));
+              ( /*<<bytes.ml:487:36>>*/ caml_bytes_get16(b, i)) /*<<bytes.ml:488:24>>*/ ;
     /*<<bytes.ml:488:24>>*/ }
    function get_int16_ne(b, i){
      /*<<bytes.ml:491:2>>*/ var
@@ -5687,38 +5793,38 @@
      /*<<bytes.ml:500:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:500:25>>*/ caml_int32_bswap
               ( /*<<bytes.ml:500:32>>*/ caml_bytes_get32(b, i))
-            :  /*<<bytes.ml:501:7>>*/ caml_bytes_get32(b, i);
+            :  /*<<bytes.ml:501:7>>*/ caml_bytes_get32(b, i) /*<<bytes.ml:501:23>>*/ ;
     /*<<bytes.ml:501:23>>*/ }
    function get_int32_be(b, i){
      /*<<bytes.ml:504:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:505:7>>*/ caml_bytes_get32(b, i)
             :  /*<<bytes.ml:504:29>>*/ caml_int32_bswap
-              ( /*<<bytes.ml:504:36>>*/ caml_bytes_get32(b, i));
+              ( /*<<bytes.ml:504:36>>*/ caml_bytes_get32(b, i)) /*<<bytes.ml:505:23>>*/ ;
     /*<<bytes.ml:505:23>>*/ }
    function get_int64_le(b, i){
      /*<<bytes.ml:508:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:508:25>>*/ caml_int64_bswap
               ( /*<<bytes.ml:508:32>>*/ caml_bytes_get64(b, i))
-            :  /*<<bytes.ml:509:7>>*/ caml_bytes_get64(b, i);
+            :  /*<<bytes.ml:509:7>>*/ caml_bytes_get64(b, i) /*<<bytes.ml:509:23>>*/ ;
     /*<<bytes.ml:509:23>>*/ }
    function get_int64_be(b, i){
      /*<<bytes.ml:512:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:513:7>>*/ caml_bytes_get64(b, i)
             :  /*<<bytes.ml:512:29>>*/ caml_int64_bswap
-              ( /*<<bytes.ml:512:36>>*/ caml_bytes_get64(b, i));
+              ( /*<<bytes.ml:512:36>>*/ caml_bytes_get64(b, i)) /*<<bytes.ml:513:23>>*/ ;
     /*<<bytes.ml:513:23>>*/ }
    function unsafe_set_uint16_le(b, i, x){
      /*<<bytes.ml:516:2>>*/ if(Stdlib_Sys[11]){
       /*<<bytes.ml:517:7>>*/  /*<<bytes.ml:517:7>>*/ caml_bytes_set16
       (b, i, caml_bswap16(x));
-      /*<<bytes.ml:517:7>>*/ return;
+      /*<<bytes.ml:517:7>>*/ return /*<<bytes.ml:517:7>>*/ ;
     }
      /*<<bytes.ml:518:7>>*/  /*<<bytes.ml:518:7>>*/ caml_bytes_set16(b, i, x);
     /*<<bytes.ml:518:33>>*/ }
    function unsafe_set_uint16_be(b, i, x){
      /*<<bytes.ml:521:2>>*/ if(Stdlib_Sys[11]){
       /*<<bytes.ml:522:7>>*/  /*<<bytes.ml:522:7>>*/ caml_bytes_set16(b, i, x);
-      /*<<bytes.ml:522:7>>*/ return;
+      /*<<bytes.ml:522:7>>*/ return /*<<bytes.ml:522:7>>*/ ;
     }
      /*<<bytes.ml:523:2>>*/  /*<<bytes.ml:523:2>>*/ caml_bytes_set16
      (b, i, caml_bswap16(x));
@@ -5726,36 +5832,36 @@
    function set_int16_le(b, i, x){
      /*<<bytes.ml:526:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:526:25>>*/ caml_bytes_set16(b, i, caml_bswap16(x))
-            :  /*<<bytes.ml:527:7>>*/ caml_bytes_set16(b, i, x);
+            :  /*<<bytes.ml:527:7>>*/ caml_bytes_set16(b, i, x) /*<<bytes.ml:527:25>>*/ ;
     /*<<bytes.ml:527:25>>*/ }
    function set_int16_be(b, i, x){
      /*<<bytes.ml:530:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:531:7>>*/ caml_bytes_set16(b, i, x)
-            :  /*<<bytes.ml:530:29>>*/ caml_bytes_set16(b, i, caml_bswap16(x));
+            :  /*<<bytes.ml:530:29>>*/ caml_bytes_set16(b, i, caml_bswap16(x)) /*<<bytes.ml:531:25>>*/ ;
     /*<<bytes.ml:531:25>>*/ }
    function set_int32_le(b, i, x){
      /*<<bytes.ml:534:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:534:25>>*/ caml_bytes_set32
               (b, i,  /*<<bytes.ml:534:42>>*/ caml_int32_bswap(x))
-            :  /*<<bytes.ml:535:7>>*/ caml_bytes_set32(b, i, x);
+            :  /*<<bytes.ml:535:7>>*/ caml_bytes_set32(b, i, x) /*<<bytes.ml:535:25>>*/ ;
     /*<<bytes.ml:535:25>>*/ }
    function set_int32_be(b, i, x){
      /*<<bytes.ml:538:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:539:7>>*/ caml_bytes_set32(b, i, x)
             :  /*<<bytes.ml:538:29>>*/ caml_bytes_set32
-              (b, i,  /*<<bytes.ml:538:46>>*/ caml_int32_bswap(x));
+              (b, i,  /*<<bytes.ml:538:46>>*/ caml_int32_bswap(x)) /*<<bytes.ml:539:25>>*/ ;
     /*<<bytes.ml:539:25>>*/ }
    function set_int64_le(b, i, x){
      /*<<bytes.ml:542:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:542:25>>*/ caml_bytes_set64
               (b, i,  /*<<bytes.ml:542:42>>*/ caml_int64_bswap(x))
-            :  /*<<bytes.ml:543:7>>*/ caml_bytes_set64(b, i, x);
+            :  /*<<bytes.ml:543:7>>*/ caml_bytes_set64(b, i, x) /*<<bytes.ml:543:25>>*/ ;
     /*<<bytes.ml:543:25>>*/ }
    function set_int64_be(b, i, x){
      /*<<bytes.ml:546:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:547:7>>*/ caml_bytes_set64(b, i, x)
             :  /*<<bytes.ml:546:29>>*/ caml_bytes_set64
-              (b, i,  /*<<bytes.ml:546:46>>*/ caml_int64_bswap(x));
+              (b, i,  /*<<bytes.ml:546:46>>*/ caml_int64_bswap(x)) /*<<bytes.ml:547:25>>*/ ;
     /*<<bytes.ml:547:25>>*/ }
    var
     set_uint8 = caml_bytes_set,
@@ -5775,7 +5881,7 @@
      /*<<bytes.ml:557:27>>*/  /*<<bytes.ml:557:46>>*/ var
      _l_ =  /*<<bytes.ml:557:46>>*/ caml_call1(Stdlib_Uchar[9], u);
      /*<<bytes.ml:557:46>>*/ return  /*<<bytes.ml:557:46>>*/ caml_call2
-            (Stdlib_Uchar[21], n, _l_);
+            (Stdlib_Uchar[21], n, _l_) /*<<bytes.ml:557:69>>*/ ;
     /*<<bytes.ml:557:69>>*/ }
    function not_in_x80_to_xBF(b){
      /*<<bytes.ml:575:35>>*/ return 2 !== (b >>> 6 | 0) ? 1 : 0;
@@ -5819,156 +5925,157 @@
            /*<<bytes.ml:619:6>>*/  /*<<bytes.ml:619:6>>*/ var i$0 = i + 1 | 0;
           if(max < i$0)
             /*<<bytes.ml:619:39>>*/ return  /*<<bytes.ml:619:39>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
           var b1$4 = caml_bytes_unsafe_get(b, i$0);
            /*<<bytes.ml:620:29>>*/ if(not_in_x80_to_x9F(b1$4))
             /*<<bytes.ml:620:55>>*/ return  /*<<bytes.ml:620:55>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
            /*<<bytes.ml:621:6>>*/  /*<<bytes.ml:621:6>>*/ var
            i$1 = i$0 + 1 | 0;
           if(max < i$1)
             /*<<bytes.ml:621:39>>*/ return  /*<<bytes.ml:621:39>>*/ caml_call1
-                   (dec_invalid, 2);
+                   (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
           var b2$3 = caml_bytes_unsafe_get(b, i$1);
            /*<<bytes.ml:622:29>>*/ return not_in_x80_to_xBF(b2$3)
                   ?  /*<<bytes.ml:622:55>>*/ caml_call1(dec_invalid, 2)
-                  : dec_ret(3, utf_8_uchar_3(b0, b1$4, b2$3));
+                  : dec_ret(3, utf_8_uchar_3(b0, b1$4, b2$3)) /*<<bytes.ml:648:22>>*/ ;
          case 3:
            /*<<bytes.ml:625:6>>*/  /*<<bytes.ml:625:6>>*/ var i$4 = i + 1 | 0;
           if(max < i$4)
             /*<<bytes.ml:625:39>>*/ return  /*<<bytes.ml:625:39>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
           var b1$2 = caml_bytes_unsafe_get(b, i$4);
            /*<<bytes.ml:626:29>>*/ if(not_in_x90_to_xBF(b1$2))
             /*<<bytes.ml:626:55>>*/ return  /*<<bytes.ml:626:55>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
            /*<<bytes.ml:627:6>>*/  /*<<bytes.ml:627:6>>*/ var
            i$5 = i$4 + 1 | 0;
           if(max < i$5)
             /*<<bytes.ml:627:39>>*/ return  /*<<bytes.ml:627:39>>*/ caml_call1
-                   (dec_invalid, 2);
+                   (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
           var b2$1 = caml_bytes_unsafe_get(b, i$5);
            /*<<bytes.ml:628:29>>*/ if(not_in_x80_to_xBF(b2$1))
             /*<<bytes.ml:628:55>>*/ return  /*<<bytes.ml:628:55>>*/ caml_call1
-                   (dec_invalid, 2);
+                   (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
            /*<<bytes.ml:629:6>>*/  /*<<bytes.ml:629:6>>*/ var
            i$6 = i$5 + 1 | 0;
           if(max < i$6)
             /*<<bytes.ml:629:39>>*/ return  /*<<bytes.ml:629:39>>*/ caml_call1
-                   (dec_invalid, 3);
+                   (dec_invalid, 3) /*<<bytes.ml:648:22>>*/ ;
           var b3$1 = caml_bytes_unsafe_get(b, i$6);
            /*<<bytes.ml:630:29>>*/ return not_in_x80_to_xBF(b3$1)
                   ?  /*<<bytes.ml:630:55>>*/ caml_call1(dec_invalid, 3)
-                  : dec_ret(4, utf_8_uchar_4(b0, b1$2, b2$1, b3$1));
+                  : dec_ret(4, utf_8_uchar_4(b0, b1$2, b2$1, b3$1)) /*<<bytes.ml:648:22>>*/ ;
          case 7:
            /*<<bytes.ml:641:6>>*/  /*<<bytes.ml:641:6>>*/ var
            i$10 = i + 1 | 0;
           if(max < i$10)
             /*<<bytes.ml:641:39>>*/ return  /*<<bytes.ml:641:39>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
           var b1$0 = caml_bytes_unsafe_get(b, i$10);
            /*<<bytes.ml:642:29>>*/ if(not_in_x80_to_x8F(b1$0))
             /*<<bytes.ml:642:55>>*/ return  /*<<bytes.ml:642:55>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
            /*<<bytes.ml:643:6>>*/  /*<<bytes.ml:643:6>>*/ var
            i$11 = i$10 + 1 | 0;
           if(max < i$11)
             /*<<bytes.ml:643:39>>*/ return  /*<<bytes.ml:643:39>>*/ caml_call1
-                   (dec_invalid, 2);
+                   (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
           var b2 = caml_bytes_unsafe_get(b, i$11);
            /*<<bytes.ml:644:29>>*/ if(not_in_x80_to_xBF(b2))
             /*<<bytes.ml:644:55>>*/ return  /*<<bytes.ml:644:55>>*/ caml_call1
-                   (dec_invalid, 2);
+                   (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
            /*<<bytes.ml:645:6>>*/  /*<<bytes.ml:645:6>>*/ var
            i$12 = i$11 + 1 | 0;
           if(max < i$12)
             /*<<bytes.ml:645:39>>*/ return  /*<<bytes.ml:645:39>>*/ caml_call1
-                   (dec_invalid, 3);
+                   (dec_invalid, 3) /*<<bytes.ml:648:22>>*/ ;
           var b3 = caml_bytes_unsafe_get(b, i$12);
            /*<<bytes.ml:646:29>>*/ return not_in_x80_to_xBF(b3)
                   ?  /*<<bytes.ml:646:55>>*/ caml_call1(dec_invalid, 3)
-                  : dec_ret(4, utf_8_uchar_4(b0, b1$0, b2, b3));
+                  : dec_ret(4, utf_8_uchar_4(b0, b1$0, b2, b3)) /*<<bytes.ml:648:22>>*/ ;
          case 1:
          case 2: break;
          default:
            /*<<bytes.ml:633:6>>*/  /*<<bytes.ml:633:6>>*/ var i$7 = i + 1 | 0;
           if(max < i$7)
             /*<<bytes.ml:633:39>>*/ return  /*<<bytes.ml:633:39>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
           var b1$1 = caml_bytes_unsafe_get(b, i$7);
            /*<<bytes.ml:634:29>>*/ if(not_in_x80_to_xBF(b1$1))
             /*<<bytes.ml:634:55>>*/ return  /*<<bytes.ml:634:55>>*/ caml_call1
-                   (dec_invalid, 1);
+                   (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
            /*<<bytes.ml:635:6>>*/  /*<<bytes.ml:635:6>>*/ var
            i$8 = i$7 + 1 | 0;
           if(max < i$8)
             /*<<bytes.ml:635:39>>*/ return  /*<<bytes.ml:635:39>>*/ caml_call1
-                   (dec_invalid, 2);
+                   (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
           var b2$0 = caml_bytes_unsafe_get(b, i$8);
            /*<<bytes.ml:636:29>>*/ if(not_in_x80_to_xBF(b2$0))
             /*<<bytes.ml:636:55>>*/ return  /*<<bytes.ml:636:55>>*/ caml_call1
-                   (dec_invalid, 2);
+                   (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
            /*<<bytes.ml:637:6>>*/  /*<<bytes.ml:637:6>>*/ var
            i$9 = i$8 + 1 | 0;
           if(max < i$9)
             /*<<bytes.ml:637:39>>*/ return  /*<<bytes.ml:637:39>>*/ caml_call1
-                   (dec_invalid, 3);
+                   (dec_invalid, 3) /*<<bytes.ml:648:22>>*/ ;
           var b3$0 = caml_bytes_unsafe_get(b, i$9);
            /*<<bytes.ml:638:29>>*/ return not_in_x80_to_xBF(b3$0)
                   ?  /*<<bytes.ml:638:55>>*/ caml_call1(dec_invalid, 3)
-                  : dec_ret(4, utf_8_uchar_4(b0, b1$1, b2$0, b3$0));
+                  : dec_ret(4, utf_8_uchar_4(b0, b1$1, b2$0, b3$0)) /*<<bytes.ml:648:22>>*/ ;
        }
       }
       else if(225 > b0){
         /*<<bytes.ml:607:6>>*/  /*<<bytes.ml:607:6>>*/ var i$13 = i + 1 | 0;
        if(max < i$13)
          /*<<bytes.ml:607:39>>*/ return  /*<<bytes.ml:607:39>>*/ caml_call1
-                (dec_invalid, 1);
+                (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
        var b1$5 = caml_bytes_unsafe_get(b, i$13);
         /*<<bytes.ml:608:29>>*/ if(not_in_xA0_to_xBF(b1$5))
          /*<<bytes.ml:608:55>>*/ return  /*<<bytes.ml:608:55>>*/ caml_call1
-                (dec_invalid, 1);
+                (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
         /*<<bytes.ml:609:6>>*/  /*<<bytes.ml:609:6>>*/ var
         i$14 = i$13 + 1 | 0;
        if(max < i$14)
          /*<<bytes.ml:609:39>>*/ return  /*<<bytes.ml:609:39>>*/ caml_call1
-                (dec_invalid, 2);
+                (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
        var b2$4 = caml_bytes_unsafe_get(b, i$14);
         /*<<bytes.ml:610:29>>*/ return not_in_x80_to_xBF(b2$4)
                ?  /*<<bytes.ml:610:55>>*/ caml_call1(dec_invalid, 2)
-               : dec_ret(3, utf_8_uchar_3(b0, b1$5, b2$4));
+               : dec_ret(3, utf_8_uchar_3(b0, b1$5, b2$4)) /*<<bytes.ml:648:22>>*/ ;
       }
        /*<<bytes.ml:613:6>>*/  /*<<bytes.ml:613:6>>*/ var i$2 = i + 1 | 0;
       if(max < i$2)
         /*<<bytes.ml:613:39>>*/ return  /*<<bytes.ml:613:39>>*/ caml_call1
-               (dec_invalid, 1);
+               (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
       var b1$3 = caml_bytes_unsafe_get(b, i$2);
        /*<<bytes.ml:614:29>>*/ if(not_in_x80_to_xBF(b1$3))
         /*<<bytes.ml:614:55>>*/ return  /*<<bytes.ml:614:55>>*/ caml_call1
-               (dec_invalid, 1);
+               (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
        /*<<bytes.ml:615:6>>*/  /*<<bytes.ml:615:6>>*/ var i$3 = i$2 + 1 | 0;
       if(max < i$3)
         /*<<bytes.ml:615:39>>*/ return  /*<<bytes.ml:615:39>>*/ caml_call1
-               (dec_invalid, 2);
+               (dec_invalid, 2) /*<<bytes.ml:648:22>>*/ ;
       var b2$2 = caml_bytes_unsafe_get(b, i$3);
        /*<<bytes.ml:616:29>>*/ return not_in_x80_to_xBF(b2$2)
               ?  /*<<bytes.ml:616:55>>*/ caml_call1(dec_invalid, 2)
-              : dec_ret(3, utf_8_uchar_3(b0, b1$3, b2$2));
+              : dec_ret(3, utf_8_uchar_3(b0, b1$3, b2$2)) /*<<bytes.ml:648:22>>*/ ;
      }
-     if(128 > b0)  /*<<bytes.ml:601:24>>*/ return dec_ret(1, b0);
+     if(128 > b0)
+       /*<<bytes.ml:601:24>>*/ return dec_ret(1, b0) /*<<bytes.ml:648:22>>*/ ;
      if(194 <= b0){
        /*<<bytes.ml:603:6>>*/  /*<<bytes.ml:603:6>>*/ var i$15 = i + 1 | 0;
       if(max < i$15)
         /*<<bytes.ml:603:39>>*/ return  /*<<bytes.ml:603:39>>*/ caml_call1
-               (dec_invalid, 1);
+               (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
       var b1 = caml_bytes_unsafe_get(b, i$15);
        /*<<bytes.ml:604:29>>*/ return not_in_x80_to_xBF(b1)
               ?  /*<<bytes.ml:604:55>>*/ caml_call1(dec_invalid, 1)
-              : dec_ret(2, (b0 & 31) << 6 | b1 & 63);
+              : dec_ret(2, (b0 & 31) << 6 | b1 & 63) /*<<bytes.ml:648:22>>*/ ;
      }
     }
      /*<<bytes.ml:648:9>>*/ return  /*<<bytes.ml:648:9>>*/ caml_call1
-            (dec_invalid, 1);
+            (dec_invalid, 1) /*<<bytes.ml:648:22>>*/ ;
     /*<<bytes.ml:648:22>>*/ }
    function set_utf_8_uchar(b, i, u){
      /*<<bytes.ml:651:2>>*/ function set(_i_, _h_, _g_){
@@ -5984,7 +6091,7 @@
             ([0, Assert_failure, _b_], 1);
      /*<<bytes.ml:655:11>>*/ if(127 >= u$0){
      caml_bytes_set(b, i, u$0);
-      /*<<bytes.ml:656:6>>*/ return 1;
+      /*<<bytes.ml:656:6>>*/ return 1 /*<<bytes.ml:656:6>>*/ ;
     }
      /*<<bytes.ml:658:11>>*/ if(2047 >= u$0){
       /*<<bytes.ml:659:6>>*/  /*<<bytes.ml:659:6>>*/ var last$1 = i + 1 | 0;
@@ -5993,7 +6100,7 @@
              : (caml_bytes_set
                 (b, i, 192 | u$0 >>> 6 | 0),
                set(b, last$1, 128 | u$0 & 63),
-               2);
+               2) /*<<bytes.ml:679:21>>*/ ;
     }
      /*<<bytes.ml:664:11>>*/ if(65535 >= u$0){
       /*<<bytes.ml:665:6>>*/  /*<<bytes.ml:665:6>>*/ var last$0 = i + 2 | 0;
@@ -6003,7 +6110,7 @@
                 (b, i, 224 | u$0 >>> 12 | 0),
                set(b, i + 1 | 0, 128 | (u$0 >>> 6 | 0) & 63),
                set(b, last$0, 128 | u$0 & 63),
-               3);
+               3) /*<<bytes.ml:679:21>>*/ ;
     }
      /*<<bytes.ml:671:11>>*/ if(1114111 < u$0)
       /*<<bytes.ml:679:9>>*/ throw  /*<<bytes.ml:679:9>>*/ caml_maybe_attach_backtrace
@@ -6016,12 +6123,12 @@
               set(b, i + 1 | 0, 128 | (u$0 >>> 12 | 0) & 63),
               set(b, i + 2 | 0, 128 | (u$0 >>> 6 | 0) & 63),
               set(b, last, 128 | u$0 & 63),
-              4);
+              4) /*<<bytes.ml:679:21>>*/ ;
     /*<<bytes.ml:679:21>>*/ }
    function is_valid_utf_8(b){
      /*<<bytes.ml:682:2>>*/ var max = caml_ml_bytes_length(b) - 1 | 0, i = 0;
      /*<<bytes.ml:683:4>>*/ for(;;){
-     if(max < i)  /*<<bytes.ml:683:20>>*/ return 1;
+     if(max < i)  /*<<bytes.ml:683:20>>*/ return 1 /*<<bytes.ml:683:20>>*/ ;
      var match = caml_bytes_unsafe_get(b, i);
      a:
      {
@@ -6043,7 +6150,7 @@
             i = i$0;
             continue;
            }
-            /*<<bytes.ml:712:13>>*/ return 0;
+            /*<<bytes.ml:712:13>>*/ return 0 /*<<bytes.ml:712:13>>*/ ;
           case 3:
             /*<<bytes.ml:715:8>>*/  /*<<bytes.ml:715:8>>*/ var
             last$1 = i + 3 | 0;
@@ -6061,7 +6168,7 @@
             i = i$2;
             continue;
            }
-            /*<<bytes.ml:720:13>>*/ return 0;
+            /*<<bytes.ml:720:13>>*/ return 0 /*<<bytes.ml:720:13>>*/ ;
           case 7:
             /*<<bytes.ml:731:8>>*/  /*<<bytes.ml:731:8>>*/ var
             last$3 = i + 3 | 0;
@@ -6079,7 +6186,7 @@
             i = i$4;
             continue;
            }
-            /*<<bytes.ml:736:13>>*/ return 0;
+            /*<<bytes.ml:736:13>>*/ return 0 /*<<bytes.ml:736:13>>*/ ;
           case 1:
           case 2: break;
           default:
@@ -6099,7 +6206,7 @@
             i = i$3;
             continue;
            }
-            /*<<bytes.ml:728:13>>*/ return 0;
+            /*<<bytes.ml:728:13>>*/ return 0 /*<<bytes.ml:728:13>>*/ ;
         }
        }
        else if(225 > match){
@@ -6116,7 +6223,7 @@
          i = i$5;
          continue;
         }
-         /*<<bytes.ml:698:13>>*/ return 0;
+         /*<<bytes.ml:698:13>>*/ return 0 /*<<bytes.ml:698:13>>*/ ;
        }
         /*<<bytes.ml:701:8>>*/  /*<<bytes.ml:701:8>>*/ var last$0 = i + 2 | 0;
        if
@@ -6130,7 +6237,7 @@
         i = i$1;
         continue;
        }
-        /*<<bytes.ml:705:13>>*/ return 0;
+        /*<<bytes.ml:705:13>>*/ return 0 /*<<bytes.ml:705:13>>*/ ;
       }
       if(128 > match){
         /*<<bytes.ml:686:26>>*/  /*<<bytes.ml:686:26>>*/ var i$7 = i + 1 | 0;
@@ -6147,10 +6254,10 @@
         i = i$6;
         continue;
        }
-        /*<<bytes.ml:691:13>>*/ return 0;
+        /*<<bytes.ml:691:13>>*/ return 0 /*<<bytes.ml:691:13>>*/ ;
       }
      }
-      /*<<bytes.ml:738:11>>*/ return 0;
+      /*<<bytes.ml:738:11>>*/ return 0 /*<<bytes.ml:738:11>>*/ ;
     }
     /*<<bytes.ml:740:25>>*/ }
    function get_utf_16be_uchar(b, i){
@@ -6159,28 +6266,29 @@
      /*<<bytes.ml:747:2>>*/ if(0 <= i && max >= i){
      if(i === max)
        /*<<bytes.ml:748:18>>*/ return  /*<<bytes.ml:748:18>>*/ caml_call1
-              (dec_invalid, 1);
+              (dec_invalid, 1) /*<<bytes.ml:759:21>>*/ ;
       /*<<bytes.ml:749:8>>*/  /*<<bytes.ml:749:8>>*/ var
       hi = unsafe_get_uint16_be(b, i);
       /*<<bytes.ml:750:11>>*/ if(55296 <= hi && 57343 >= hi){
        /*<<bytes.ml:751:11>>*/ if(56319 < hi)
         /*<<bytes.ml:751:25>>*/ return  /*<<bytes.ml:751:25>>*/ caml_call1
-               (dec_invalid, 2);
+               (dec_invalid, 2) /*<<bytes.ml:759:21>>*/ ;
        /*<<bytes.ml:753:6>>*/  /*<<bytes.ml:753:6>>*/ var last = i + 3 | 0;
-      if(max < last) return caml_call1(dec_invalid, (max - i | 0) + 1 | 0);
+      if(max < last)
+       return caml_call1(dec_invalid, (max - i | 0) + 1 | 0) /*<<bytes.ml:759:21>>*/ ;
        /*<<bytes.ml:755:12>>*/  /*<<bytes.ml:755:12>>*/ var
        lo = unsafe_get_uint16_be(b, i + 2 | 0);
        /*<<bytes.ml:756:15>>*/ if(56320 <= lo && 57343 >= lo){
        var u = ((hi & 1023) << 10 | lo & 1023) + 65536 | 0;
-        /*<<bytes.ml:759:10>>*/ return dec_ret(4, u);
+        /*<<bytes.ml:759:10>>*/ return dec_ret(4, u) /*<<bytes.ml:759:21>>*/ ;
       }
        /*<<bytes.ml:756:43>>*/ return  /*<<bytes.ml:756:43>>*/ caml_call1
-              (dec_invalid, 2);
+              (dec_invalid, 2) /*<<bytes.ml:759:21>>*/ ;
      }
-      /*<<bytes.ml:750:39>>*/ return dec_ret(2, hi);
+      /*<<bytes.ml:750:39>>*/ return dec_ret(2, hi) /*<<bytes.ml:759:21>>*/ ;
     }
      /*<<bytes.ml:747:27>>*/ return  /*<<bytes.ml:747:27>>*/ caml_call1
-            (Stdlib[1], cst_index_out_of_bounds);
+            (Stdlib[1], cst_index_out_of_bounds) /*<<bytes.ml:759:21>>*/ ;
     /*<<bytes.ml:759:21>>*/ }
    function set_utf_16be_uchar(b, i, u){
      /*<<bytes.ml:762:2>>*/  /*<<bytes.ml:763:2>>*/ var
@@ -6193,36 +6301,38 @@
              ([0, Assert_failure, _d_], 1);
       /*<<bytes.ml:767:11>>*/ if(65535 >= u$0){
        /*<<bytes.ml:768:6>>*/  /*<<bytes.ml:768:6>>*/ var last$0 = i + 1 | 0;
-      return max < last$0 ? 0 : (unsafe_set_uint16_be(b, i, u$0), 2);
+      return max < last$0 ? 0 : (unsafe_set_uint16_be(b, i, u$0), 2) /*<<bytes.ml:777:21>>*/ ;
      }
       /*<<bytes.ml:770:11>>*/ if(1114111 < u$0)
        /*<<bytes.ml:777:9>>*/ throw  /*<<bytes.ml:777:9>>*/ caml_maybe_attach_backtrace
              ([0, Assert_failure, _c_], 1);
       /*<<bytes.ml:771:6>>*/  /*<<bytes.ml:771:6>>*/ var last = i + 3 | 0;
-     if(max < last)  /*<<bytes.ml:772:25>>*/ return 0;
+     if(max < last)
+       /*<<bytes.ml:772:25>>*/ return 0 /*<<bytes.ml:772:25>>*/ ;
       /*<<bytes.ml:773:6>>*/ var
        /*<<bytes.ml:773:6>>*/ u$1 = u$0 - 65536 | 0,
       hi = 55296 | u$1 >>> 10 | 0,
       lo = 56320 | u$1 & 1023;
       /*<<bytes.ml:776:6>>*/ unsafe_set_uint16_be(b, i, hi);
       /*<<bytes.ml:776:18>>*/ unsafe_set_uint16_be(b, i + 2 | 0, lo);
-      /*<<bytes.ml:776:18>>*/ return 4;
+      /*<<bytes.ml:776:18>>*/ return 4 /*<<bytes.ml:776:18>>*/ ;
     }
      /*<<bytes.ml:764:27>>*/ return  /*<<bytes.ml:764:27>>*/ caml_call1
-            (Stdlib[1], cst_index_out_of_bounds$0);
+            (Stdlib[1], cst_index_out_of_bounds$0) /*<<bytes.ml:777:21>>*/ ;
     /*<<bytes.ml:777:21>>*/ }
    function is_valid_utf_16be(b){
      /*<<bytes.ml:780:2>>*/ var max = caml_ml_bytes_length(b) - 1 | 0, i = 0;
      /*<<bytes.ml:781:4>>*/ for(;;){
-     if(max < i)  /*<<bytes.ml:782:20>>*/ return 1;
-     if(i === max)  /*<<bytes.ml:783:20>>*/ return 0;
+     if(max < i)  /*<<bytes.ml:782:20>>*/ return 1 /*<<bytes.ml:782:20>>*/ ;
+     if(i === max)  /*<<bytes.ml:783:20>>*/ return 0 /*<<bytes.ml:783:20>>*/ ;
       /*<<bytes.ml:784:10>>*/  /*<<bytes.ml:784:10>>*/ var
       u = unsafe_get_uint16_be(b, i);
       /*<<bytes.ml:785:13>>*/ if(55296 <= u && 57343 >= u){
        /*<<bytes.ml:786:13>>*/ if(56319 < u)
-        /*<<bytes.ml:786:27>>*/ return 0;
+        /*<<bytes.ml:786:27>>*/ return 0 /*<<bytes.ml:786:27>>*/ ;
        /*<<bytes.ml:788:8>>*/  /*<<bytes.ml:788:8>>*/ var last = i + 3 | 0;
-      if(max < last)  /*<<bytes.ml:789:27>>*/ return 0;
+      if(max < last)
+        /*<<bytes.ml:789:27>>*/ return 0 /*<<bytes.ml:789:27>>*/ ;
        /*<<bytes.ml:790:14>>*/  /*<<bytes.ml:790:14>>*/ var
        u$0 = unsafe_get_uint16_be(b, i + 2 | 0);
        /*<<bytes.ml:791:17>>*/ if(56320 <= u$0 && 57343 >= u$0){
@@ -6230,7 +6340,7 @@
        i = i$1;
        continue;
       }
-       /*<<bytes.ml:791:45>>*/ return 0;
+       /*<<bytes.ml:791:45>>*/ return 0 /*<<bytes.ml:791:45>>*/ ;
      }
       /*<<bytes.ml:785:41>>*/  /*<<bytes.ml:785:41>>*/ var i$0 = i + 2 | 0;
      i = i$0;
@@ -6242,28 +6352,29 @@
      /*<<bytes.ml:801:2>>*/ if(0 <= i && max >= i){
      if(i === max)
        /*<<bytes.ml:802:18>>*/ return  /*<<bytes.ml:802:18>>*/ caml_call1
-              (dec_invalid, 1);
+              (dec_invalid, 1) /*<<bytes.ml:813:21>>*/ ;
       /*<<bytes.ml:803:8>>*/  /*<<bytes.ml:803:8>>*/ var
       hi = unsafe_get_uint16_le(b, i);
       /*<<bytes.ml:804:11>>*/ if(55296 <= hi && 57343 >= hi){
        /*<<bytes.ml:805:11>>*/ if(56319 < hi)
         /*<<bytes.ml:805:25>>*/ return  /*<<bytes.ml:805:25>>*/ caml_call1
-               (dec_invalid, 2);
+               (dec_invalid, 2) /*<<bytes.ml:813:21>>*/ ;
        /*<<bytes.ml:807:6>>*/  /*<<bytes.ml:807:6>>*/ var last = i + 3 | 0;
-      if(max < last) return caml_call1(dec_invalid, (max - i | 0) + 1 | 0);
+      if(max < last)
+       return caml_call1(dec_invalid, (max - i | 0) + 1 | 0) /*<<bytes.ml:813:21>>*/ ;
        /*<<bytes.ml:809:12>>*/  /*<<bytes.ml:809:12>>*/ var
        lo = unsafe_get_uint16_le(b, i + 2 | 0);
        /*<<bytes.ml:810:15>>*/ if(56320 <= lo && 57343 >= lo){
        var u = ((hi & 1023) << 10 | lo & 1023) + 65536 | 0;
-        /*<<bytes.ml:813:10>>*/ return dec_ret(4, u);
+        /*<<bytes.ml:813:10>>*/ return dec_ret(4, u) /*<<bytes.ml:813:21>>*/ ;
       }
        /*<<bytes.ml:810:43>>*/ return  /*<<bytes.ml:810:43>>*/ caml_call1
-              (dec_invalid, 2);
+              (dec_invalid, 2) /*<<bytes.ml:813:21>>*/ ;
      }
-      /*<<bytes.ml:804:39>>*/ return dec_ret(2, hi);
+      /*<<bytes.ml:804:39>>*/ return dec_ret(2, hi) /*<<bytes.ml:813:21>>*/ ;
     }
      /*<<bytes.ml:801:27>>*/ return  /*<<bytes.ml:801:27>>*/ caml_call1
-            (Stdlib[1], cst_index_out_of_bounds$1);
+            (Stdlib[1], cst_index_out_of_bounds$1) /*<<bytes.ml:813:21>>*/ ;
     /*<<bytes.ml:813:21>>*/ }
    function set_utf_16le_uchar(b, i, u){
      /*<<bytes.ml:816:2>>*/  /*<<bytes.ml:817:2>>*/ var
@@ -6276,36 +6387,38 @@
              ([0, Assert_failure, _f_], 1);
       /*<<bytes.ml:821:11>>*/ if(65535 >= u$0){
        /*<<bytes.ml:822:6>>*/  /*<<bytes.ml:822:6>>*/ var last$0 = i + 1 | 0;
-      return max < last$0 ? 0 : (unsafe_set_uint16_le(b, i, u$0), 2);
+      return max < last$0 ? 0 : (unsafe_set_uint16_le(b, i, u$0), 2) /*<<bytes.ml:831:21>>*/ ;
      }
       /*<<bytes.ml:824:11>>*/ if(1114111 < u$0)
        /*<<bytes.ml:831:9>>*/ throw  /*<<bytes.ml:831:9>>*/ caml_maybe_attach_backtrace
              ([0, Assert_failure, _e_], 1);
       /*<<bytes.ml:825:6>>*/  /*<<bytes.ml:825:6>>*/ var last = i + 3 | 0;
-     if(max < last)  /*<<bytes.ml:826:25>>*/ return 0;
+     if(max < last)
+       /*<<bytes.ml:826:25>>*/ return 0 /*<<bytes.ml:826:25>>*/ ;
       /*<<bytes.ml:827:6>>*/ var
        /*<<bytes.ml:827:6>>*/ u$1 = u$0 - 65536 | 0,
       hi = 55296 | u$1 >>> 10 | 0,
       lo = 56320 | u$1 & 1023;
       /*<<bytes.ml:830:6>>*/ unsafe_set_uint16_le(b, i, hi);
       /*<<bytes.ml:830:18>>*/ unsafe_set_uint16_le(b, i + 2 | 0, lo);
-      /*<<bytes.ml:830:18>>*/ return 4;
+      /*<<bytes.ml:830:18>>*/ return 4 /*<<bytes.ml:830:18>>*/ ;
     }
      /*<<bytes.ml:818:27>>*/ return  /*<<bytes.ml:818:27>>*/ caml_call1
-            (Stdlib[1], cst_index_out_of_bounds$2);
+            (Stdlib[1], cst_index_out_of_bounds$2) /*<<bytes.ml:831:21>>*/ ;
     /*<<bytes.ml:831:21>>*/ }
    function is_valid_utf_16le(b){
      /*<<bytes.ml:834:2>>*/ var max = caml_ml_bytes_length(b) - 1 | 0, i = 0;
      /*<<bytes.ml:835:4>>*/ for(;;){
-     if(max < i)  /*<<bytes.ml:836:20>>*/ return 1;
-     if(i === max)  /*<<bytes.ml:837:20>>*/ return 0;
+     if(max < i)  /*<<bytes.ml:836:20>>*/ return 1 /*<<bytes.ml:836:20>>*/ ;
+     if(i === max)  /*<<bytes.ml:837:20>>*/ return 0 /*<<bytes.ml:837:20>>*/ ;
       /*<<bytes.ml:838:10>>*/  /*<<bytes.ml:838:10>>*/ var
       u = unsafe_get_uint16_le(b, i);
       /*<<bytes.ml:839:13>>*/ if(55296 <= u && 57343 >= u){
        /*<<bytes.ml:840:13>>*/ if(56319 < u)
-        /*<<bytes.ml:840:27>>*/ return 0;
+        /*<<bytes.ml:840:27>>*/ return 0 /*<<bytes.ml:840:27>>*/ ;
        /*<<bytes.ml:842:8>>*/  /*<<bytes.ml:842:8>>*/ var last = i + 3 | 0;
-      if(max < last)  /*<<bytes.ml:843:27>>*/ return 0;
+      if(max < last)
+        /*<<bytes.ml:843:27>>*/ return 0 /*<<bytes.ml:843:27>>*/ ;
        /*<<bytes.ml:844:14>>*/  /*<<bytes.ml:844:14>>*/ var
        u$0 = unsafe_get_uint16_le(b, i + 2 | 0);
        /*<<bytes.ml:845:17>>*/ if(56320 <= u$0 && 57343 >= u$0){
@@ -6313,7 +6426,7 @@
        i = i$1;
        continue;
       }
-       /*<<bytes.ml:845:45>>*/ return 0;
+       /*<<bytes.ml:845:45>>*/ return 0 /*<<bytes.ml:845:45>>*/ ;
      }
       /*<<bytes.ml:839:41>>*/  /*<<bytes.ml:839:41>>*/ var i$0 = i + 2 | 0;
      i = i$0;
@@ -6454,11 +6567,11 @@
     bos = Stdlib_Bytes[45];
    function make(n, c){
      /*<<string.ml:36:2>>*/ return  /*<<string.ml:36:2>>*/ caml_call1
-            (bts,  /*<<string.ml:36:2>>*/ caml_call2(Stdlib_Bytes[1], n, c));
+            (bts,  /*<<string.ml:36:2>>*/ caml_call2(Stdlib_Bytes[1], n, c)) /*<<string.ml:36:19>>*/ ;
     /*<<string.ml:36:19>>*/ }
    function init(n, f){
      /*<<string.ml:38:2>>*/ return  /*<<string.ml:38:2>>*/ caml_call1
-            (bts,  /*<<string.ml:38:2>>*/ caml_call2(Stdlib_Bytes[2], n, f));
+            (bts,  /*<<string.ml:38:2>>*/ caml_call2(Stdlib_Bytes[2], n, f)) /*<<string.ml:38:19>>*/ ;
     /*<<string.ml:38:19>>*/ }
    var of_bytes = Stdlib_Bytes[6], to_bytes = Stdlib_Bytes[5];
    function sub(s, ofs, len){
@@ -6467,11 +6580,12 @@
      /*<<string.ml:43:2>>*/ return  /*<<string.ml:43:2>>*/ caml_call1
             (bts,
               /*<<string.ml:43:2>>*/ caml_call3
-              (Stdlib_Bytes[7], _X_, ofs, len));
+              (Stdlib_Bytes[7], _X_, ofs, len)) /*<<string.ml:43:30>>*/ ;
     /*<<string.ml:43:30>>*/ }
    var blit = Stdlib_Bytes[12], cst_String_concat = "String.concat";
    function concat(sep, l){
-     /*<<?>>*/ if(! l)  /*<<string.ml:64:10>>*/ return cst;
+     /*<<?>>*/ if(! l)
+      /*<<string.ml:64:10>>*/ return cst /*<<string.ml:64:10>>*/ ;
     var seplen = caml_ml_string_length(sep);
     a:
     {
@@ -6524,7 +6638,7 @@
        (hd$0, 0, dst, pos, caml_ml_string_length(hd$0));
      }
       /*<<string.ml:66:10>>*/ return  /*<<string.ml:66:10>>*/ caml_call1
-             (bts, dst);
+             (bts, dst) /*<<string.ml:66:10>>*/ ;
     }
    }
    var
@@ -6576,68 +6690,68 @@
      _P_ =  /*<<string.ml:81:10>>*/ caml_call1(bos, s);
      /*<<string.ml:81:2>>*/ return  /*<<string.ml:81:2>>*/ caml_call1
             (bts,
-              /*<<string.ml:81:2>>*/ caml_call2(Stdlib_Bytes[17], f, _P_));
+              /*<<string.ml:81:2>>*/ caml_call2(Stdlib_Bytes[17], f, _P_)) /*<<string.ml:81:24>>*/ ;
     /*<<string.ml:81:24>>*/ }
    function mapi(f, s){
      /*<<string.ml:83:2>>*/  /*<<string.ml:83:11>>*/ var
      _O_ =  /*<<string.ml:83:11>>*/ caml_call1(bos, s);
      /*<<string.ml:83:2>>*/ return  /*<<string.ml:83:2>>*/ caml_call1
             (bts,
-              /*<<string.ml:83:2>>*/ caml_call2(Stdlib_Bytes[18], f, _O_));
+              /*<<string.ml:83:2>>*/ caml_call2(Stdlib_Bytes[18], f, _O_)) /*<<string.ml:83:25>>*/ ;
     /*<<string.ml:83:25>>*/ }
    function fold_right(f, x, a){
      /*<<string.ml:85:2>>*/  /*<<string.ml:85:17>>*/ var
      _N_ =  /*<<string.ml:85:17>>*/ caml_call1(bos, x);
      /*<<string.ml:85:2>>*/ return  /*<<string.ml:85:2>>*/ caml_call3
-            (Stdlib_Bytes[20], f, _N_, a);
+            (Stdlib_Bytes[20], f, _N_, a) /*<<string.ml:85:26>>*/ ;
     /*<<string.ml:85:26>>*/ }
    function fold_left(f, a, x){
      /*<<string.ml:87:2>>*/  /*<<string.ml:87:18>>*/ var
      _M_ =  /*<<string.ml:87:18>>*/ caml_call1(bos, x);
      /*<<string.ml:87:18>>*/ return  /*<<string.ml:87:18>>*/ caml_call3
-            (Stdlib_Bytes[19], f, a, _M_);
+            (Stdlib_Bytes[19], f, a, _M_) /*<<string.ml:87:25>>*/ ;
     /*<<string.ml:87:25>>*/ }
    function exists(f, s){
      /*<<string.ml:89:2>>*/  /*<<string.ml:89:13>>*/ var
      _L_ =  /*<<string.ml:89:13>>*/ caml_call1(bos, s);
      /*<<string.ml:89:13>>*/ return  /*<<string.ml:89:13>>*/ caml_call2
-            (Stdlib_Bytes[22], f, _L_);
+            (Stdlib_Bytes[22], f, _L_) /*<<string.ml:89:20>>*/ ;
     /*<<string.ml:89:20>>*/ }
    function for_all(f, s){
      /*<<string.ml:91:2>>*/  /*<<string.ml:91:14>>*/ var
      _K_ =  /*<<string.ml:91:14>>*/ caml_call1(bos, s);
      /*<<string.ml:91:14>>*/ return  /*<<string.ml:91:14>>*/ caml_call2
-            (Stdlib_Bytes[21], f, _K_);
+            (Stdlib_Bytes[21], f, _K_) /*<<string.ml:91:21>>*/ ;
     /*<<string.ml:91:21>>*/ }
    function is_space(param){
      /*<<string.ml:97:15>>*/  /*<<string.ml:97:15>>*/ var _J_ = param - 9 | 0;
     a:
     {
      if(4 < _J_ >>> 0){if(23 !== _J_) break a;} else if(2 === _J_) break a;
-      /*<<string.ml:98:41>>*/ return 1;
+      /*<<string.ml:98:41>>*/ return 1 /*<<string.ml:98:41>>*/ ;
     }
-     /*<<string.ml:99:9>>*/ return 0;
+     /*<<string.ml:99:9>>*/ return 0 /*<<string.ml:99:9>>*/ ;
     /*<<string.ml:99:14>>*/ }
    function trim(s){
      /*<<string.ml:102:2>>*/ if(s == cst$0)
-      /*<<string.ml:102:17>>*/ return s;
+      /*<<string.ml:102:17>>*/ return s /*<<string.ml:102:17>>*/ ;
      /*<<string.ml:103:10>>*/ if
      (!
       is_space(caml_string_unsafe_get(s, 0))
       &&
        !
        is_space(caml_string_unsafe_get(s, caml_ml_string_length(s) - 1 | 0)))
-      /*<<string.ml:105:7>>*/ return s;
+      /*<<string.ml:105:7>>*/ return s /*<<string.ml:105:7>>*/ ;
      /*<<string.ml:104:21>>*/  /*<<string.ml:104:21>>*/ var
      _I_ =  /*<<string.ml:104:21>>*/ caml_call1(bos, s);
      /*<<string.ml:104:13>>*/ return  /*<<string.ml:104:13>>*/ caml_call1
-            (bts,  /*<<string.ml:104:13>>*/ caml_call1(Stdlib_Bytes[23], _I_));
+            (bts,  /*<<string.ml:104:13>>*/ caml_call1(Stdlib_Bytes[23], _I_)) /*<<string.ml:105:8>>*/ ;
     /*<<string.ml:105:8>>*/ }
    function escaped(s){
      /*<<string.ml:108:2>>*/  /*<<string.ml:108:10>>*/ var
      b =  /*<<string.ml:108:10>>*/ caml_call1(bos, s);
      /*<<string.ml:111:6>>*/ return  /*<<string.ml:111:6>>*/ caml_call1
-            (bts,  /*<<string.ml:111:6>>*/ caml_call1(Stdlib_Bytes[87], b));
+            (bts,  /*<<string.ml:111:6>>*/ caml_call1(Stdlib_Bytes[87], b)) /*<<string.ml:111:25>>*/ ;
     /*<<string.ml:111:25>>*/ }
    function index_rec(s, lim, i, c){
      /*<<string.ml:115:2>>*/ var i$0 = i;
@@ -6646,42 +6760,43 @@
        /*<<string.ml:115:19>>*/ throw  /*<<string.ml:115:19>>*/ caml_maybe_attach_backtrace
              (Stdlib[8], 1);
      if(caml_string_unsafe_get(s, i$0) === c)
-       /*<<string.ml:116:29>>*/ return i$0;
+       /*<<string.ml:116:29>>*/ return i$0 /*<<string.ml:116:29>>*/ ;
      var i$1 = i$0 + 1 | 0;
      i$0 = i$1;
     }
     /*<<string.ml:116:61>>*/ }
    function index(s, c){
      /*<<string.ml:119:16>>*/ return index_rec
-            (s, caml_ml_string_length(s), 0, c);
+            (s, caml_ml_string_length(s), 0, c) /*<<string.ml:119:42>>*/ ;
     /*<<string.ml:119:42>>*/ }
    function index_rec_opt(s, lim, i, c){
      /*<<string.ml:123:2>>*/ var i$0 = i;
      /*<<string.ml:123:2>>*/ for(;;){
-     if(lim <= i$0)  /*<<string.ml:123:19>>*/ return 0;
+     if(lim <= i$0)
+       /*<<string.ml:123:19>>*/ return 0 /*<<string.ml:123:19>>*/ ;
      if(caml_string_unsafe_get(s, i$0) === c)
-       /*<<string.ml:124:29>>*/ return [0, i$0];
+       /*<<string.ml:124:29>>*/ return [0, i$0] /*<<string.ml:124:29>>*/ ;
      var i$1 = i$0 + 1 | 0;
      i$0 = i$1;
     }
     /*<<string.ml:124:70>>*/ }
    function index_opt(s, c){
      /*<<string.ml:127:20>>*/ return index_rec_opt
-            (s, caml_ml_string_length(s), 0, c);
+            (s, caml_ml_string_length(s), 0, c) /*<<string.ml:127:50>>*/ ;
     /*<<string.ml:127:50>>*/ }
    function index_from(s, i, c){
      /*<<string.ml:131:2>>*/ var l = caml_ml_string_length(s);
      /*<<string.ml:132:2>>*/ if(0 <= i && l >= i)
-      /*<<string.ml:133:4>>*/ return index_rec(s, l, i, c);
+      /*<<string.ml:133:4>>*/ return index_rec(s, l, i, c) /*<<string.ml:133:21>>*/ ;
      /*<<string.ml:132:25>>*/ return  /*<<string.ml:132:25>>*/ caml_call1
-            (Stdlib[1], cst_String_index_from_Bytes_in);
+            (Stdlib[1], cst_String_index_from_Bytes_in) /*<<string.ml:133:21>>*/ ;
     /*<<string.ml:133:21>>*/ }
    function index_from_opt(s, i, c){
      /*<<string.ml:137:2>>*/ var l = caml_ml_string_length(s);
      /*<<string.ml:138:2>>*/ if(0 <= i && l >= i)
-      /*<<string.ml:141:4>>*/ return index_rec_opt(s, l, i, c);
+      /*<<string.ml:141:4>>*/ return index_rec_opt(s, l, i, c) /*<<string.ml:141:25>>*/ ;
      /*<<string.ml:139:4>>*/ return  /*<<string.ml:139:4>>*/ caml_call1
-            (Stdlib[1], cst_String_index_from_opt_Byte);
+            (Stdlib[1], cst_String_index_from_opt_Byte) /*<<string.ml:141:25>>*/ ;
     /*<<string.ml:141:25>>*/ }
    function rindex_rec(s, i, c){
      /*<<string.ml:145:2>>*/ var i$0 = i;
@@ -6690,40 +6805,40 @@
        /*<<string.ml:145:16>>*/ throw  /*<<string.ml:145:16>>*/ caml_maybe_attach_backtrace
              (Stdlib[8], 1);
      if(caml_string_unsafe_get(s, i$0) === c)
-       /*<<string.ml:146:29>>*/ return i$0;
+       /*<<string.ml:146:29>>*/ return i$0 /*<<string.ml:146:29>>*/ ;
      var i$1 = i$0 - 1 | 0;
      i$0 = i$1;
     }
     /*<<string.ml:146:58>>*/ }
    function rindex(s, c){
      /*<<string.ml:149:17>>*/ return rindex_rec
-            (s, caml_ml_string_length(s) - 1 | 0, c);
+            (s, caml_ml_string_length(s) - 1 | 0, c) /*<<string.ml:149:46>>*/ ;
     /*<<string.ml:149:46>>*/ }
    function rindex_from(s, i, c){
      /*<<string.ml:153:2>>*/ if(-1 <= i && caml_ml_string_length(s) > i)
-      /*<<string.ml:156:4>>*/ return rindex_rec(s, i, c);
+      /*<<string.ml:156:4>>*/ return rindex_rec(s, i, c) /*<<string.ml:156:20>>*/ ;
      /*<<string.ml:154:4>>*/ return  /*<<string.ml:154:4>>*/ caml_call1
-            (Stdlib[1], cst_String_rindex_from_Bytes_r);
+            (Stdlib[1], cst_String_rindex_from_Bytes_r) /*<<string.ml:156:20>>*/ ;
     /*<<string.ml:156:20>>*/ }
    function rindex_rec_opt(s, i, c){
      /*<<string.ml:160:2>>*/ var i$0 = i;
      /*<<string.ml:160:2>>*/ for(;;){
-     if(0 > i$0)  /*<<string.ml:160:16>>*/ return 0;
+     if(0 > i$0)  /*<<string.ml:160:16>>*/ return 0 /*<<string.ml:160:16>>*/ ;
      if(caml_string_unsafe_get(s, i$0) === c)
-       /*<<string.ml:161:29>>*/ return [0, i$0];
+       /*<<string.ml:161:29>>*/ return [0, i$0] /*<<string.ml:161:29>>*/ ;
      var i$1 = i$0 - 1 | 0;
      i$0 = i$1;
     }
     /*<<string.ml:161:67>>*/ }
    function rindex_opt(s, c){
      /*<<string.ml:164:21>>*/ return rindex_rec_opt
-            (s, caml_ml_string_length(s) - 1 | 0, c);
+            (s, caml_ml_string_length(s) - 1 | 0, c) /*<<string.ml:164:54>>*/ ;
     /*<<string.ml:164:54>>*/ }
    function rindex_from_opt(s, i, c){
      /*<<string.ml:168:2>>*/ if(-1 <= i && caml_ml_string_length(s) > i)
-      /*<<string.ml:171:4>>*/ return rindex_rec_opt(s, i, c);
+      /*<<string.ml:171:4>>*/ return rindex_rec_opt(s, i, c) /*<<string.ml:171:24>>*/ ;
      /*<<string.ml:169:4>>*/ return  /*<<string.ml:169:4>>*/ caml_call1
-            (Stdlib[1], cst_String_rindex_from_opt_Byt);
+            (Stdlib[1], cst_String_rindex_from_opt_Byt) /*<<string.ml:171:24>>*/ ;
     /*<<string.ml:171:24>>*/ }
    function contains_from(s, i, c){
      /*<<string.ml:175:2>>*/ var l = caml_ml_string_length(s);
@@ -6731,57 +6846,59 @@
       /*<<string.ml:179:4>>*/ try{
        /*<<string.ml:179:15>>*/ index_rec(s, l, i, c);
        /*<<string.ml:179:36>>*/  /*<<string.ml:179:36>>*/ var _G_ = 1;
-       /*<<string.ml:179:36>>*/ return _G_;
+       /*<<string.ml:179:36>>*/ return _G_ /*<<string.ml:179:36>>*/ ;
      }
      catch(_H_){
       var _F_ = caml_wrap_exception(_H_);
-      if(_F_ === Stdlib[8])  /*<<string.ml:179:59>>*/ return 0;
+      if(_F_ === Stdlib[8])
+        /*<<string.ml:179:59>>*/ return 0 /*<<string.ml:179:59>>*/ ;
       throw caml_maybe_attach_backtrace(_F_, 0);
      }
      /*<<string.ml:177:4>>*/ return  /*<<string.ml:177:4>>*/ caml_call1
-            (Stdlib[1], cst_String_contains_from_Bytes);
+            (Stdlib[1], cst_String_contains_from_Bytes) /*<<string.ml:179:64>>*/ ;
     /*<<string.ml:179:64>>*/ }
    function contains(s, c){
-     /*<<string.ml:182:19>>*/ return contains_from(s, 0, c);
+     /*<<string.ml:182:19>>*/ return contains_from(s, 0, c) /*<<string.ml:182:38>>*/ ;
     /*<<string.ml:182:38>>*/ }
    function rcontains_from(s, i, c){
      /*<<string.ml:186:2>>*/ if(0 <= i && caml_ml_string_length(s) > i)
       /*<<string.ml:189:4>>*/ try{
        /*<<string.ml:189:15>>*/ rindex_rec(s, i, c);
        /*<<string.ml:189:35>>*/  /*<<string.ml:189:35>>*/ var _D_ = 1;
-       /*<<string.ml:189:35>>*/ return _D_;
+       /*<<string.ml:189:35>>*/ return _D_ /*<<string.ml:189:35>>*/ ;
      }
      catch(_E_){
       var _C_ = caml_wrap_exception(_E_);
-      if(_C_ === Stdlib[8])  /*<<string.ml:189:58>>*/ return 0;
+      if(_C_ === Stdlib[8])
+        /*<<string.ml:189:58>>*/ return 0 /*<<string.ml:189:58>>*/ ;
       throw caml_maybe_attach_backtrace(_C_, 0);
      }
      /*<<string.ml:187:4>>*/ return  /*<<string.ml:187:4>>*/ caml_call1
-            (Stdlib[1], cst_String_rcontains_from_Byte);
+            (Stdlib[1], cst_String_rcontains_from_Byte) /*<<string.ml:189:63>>*/ ;
     /*<<string.ml:189:63>>*/ }
    function uppercase_ascii(s){
      /*<<string.ml:192:2>>*/  /*<<string.ml:192:20>>*/ var
      _B_ =  /*<<string.ml:192:20>>*/ caml_call1(bos, s);
      /*<<string.ml:192:2>>*/ return  /*<<string.ml:192:2>>*/ caml_call1
-            (bts,  /*<<string.ml:192:2>>*/ caml_call1(Stdlib_Bytes[36], _B_));
+            (bts,  /*<<string.ml:192:2>>*/ caml_call1(Stdlib_Bytes[36], _B_)) /*<<string.ml:192:34>>*/ ;
     /*<<string.ml:192:34>>*/ }
    function lowercase_ascii(s){
      /*<<string.ml:194:2>>*/  /*<<string.ml:194:20>>*/ var
      _A_ =  /*<<string.ml:194:20>>*/ caml_call1(bos, s);
      /*<<string.ml:194:2>>*/ return  /*<<string.ml:194:2>>*/ caml_call1
-            (bts,  /*<<string.ml:194:2>>*/ caml_call1(Stdlib_Bytes[37], _A_));
+            (bts,  /*<<string.ml:194:2>>*/ caml_call1(Stdlib_Bytes[37], _A_)) /*<<string.ml:194:34>>*/ ;
     /*<<string.ml:194:34>>*/ }
    function capitalize_ascii(s){
      /*<<string.ml:196:2>>*/  /*<<string.ml:196:21>>*/ var
      _z_ =  /*<<string.ml:196:21>>*/ caml_call1(bos, s);
      /*<<string.ml:196:2>>*/ return  /*<<string.ml:196:2>>*/ caml_call1
-            (bts,  /*<<string.ml:196:2>>*/ caml_call1(Stdlib_Bytes[38], _z_));
+            (bts,  /*<<string.ml:196:2>>*/ caml_call1(Stdlib_Bytes[38], _z_)) /*<<string.ml:196:35>>*/ ;
     /*<<string.ml:196:35>>*/ }
    function uncapitalize_ascii(s){
      /*<<string.ml:198:2>>*/  /*<<string.ml:198:23>>*/ var
      _y_ =  /*<<string.ml:198:23>>*/ caml_call1(bos, s);
      /*<<string.ml:198:2>>*/ return  /*<<string.ml:198:2>>*/ caml_call1
-            (bts,  /*<<string.ml:198:2>>*/ caml_call1(Stdlib_Bytes[39], _y_));
+            (bts,  /*<<string.ml:198:2>>*/ caml_call1(Stdlib_Bytes[39], _y_)) /*<<string.ml:198:37>>*/ ;
     /*<<string.ml:198:37>>*/ }
    function starts_with(prefix, s){
      /*<<string.ml:202:2>>*/ var
@@ -6791,9 +6908,10 @@
     if(! _x_) return _x_;
     var i = 0;
      /*<<string.ml:205:4>>*/ for(;;){
-     if(i === len_pre)  /*<<string.ml:205:24>>*/ return 1;
+     if(i === len_pre)
+       /*<<string.ml:205:24>>*/ return 1 /*<<string.ml:205:24>>*/ ;
      if(caml_string_unsafe_get(s, i) !== caml_string_unsafe_get(prefix, i))
-       /*<<string.ml:206:55>>*/ return 0;
+       /*<<string.ml:206:55>>*/ return 0 /*<<string.ml:206:55>>*/ ;
       /*<<string.ml:207:9>>*/  /*<<string.ml:207:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -6807,18 +6925,19 @@
     if(! _w_) return _w_;
     var i = 0;
      /*<<string.ml:216:4>>*/ for(;;){
-     if(i === len_suf)  /*<<string.ml:216:24>>*/ return 1;
+     if(i === len_suf)
+       /*<<string.ml:216:24>>*/ return 1 /*<<string.ml:216:24>>*/ ;
      if
       (caml_string_unsafe_get(s, diff + i | 0)
        !== caml_string_unsafe_get(suffix, i))
-       /*<<string.ml:217:64>>*/ return 0;
+       /*<<string.ml:217:64>>*/ return 0 /*<<string.ml:217:64>>*/ ;
       /*<<string.ml:218:9>>*/  /*<<string.ml:218:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
     /*<<string.ml:219:23>>*/ }
    function hash(x){
      /*<<string.ml:222:13>>*/ return  /*<<string.ml:222:13>>*/ caml_string_hash
-            (0, x);
+            (0, x) /*<<string.ml:222:28>>*/ ;
     /*<<string.ml:222:28>>*/ }
    function split_on_char(sep, s){
      /*<<string.ml:226:2>>*/ var
@@ -6841,120 +6960,120 @@
      }
     }
     var _t_ = r[1];
-     /*<<string.ml:234:2>>*/ return [0, sub(s, 0, j[1]), _t_];
+     /*<<string.ml:234:2>>*/ return [0, sub(s, 0, j[1]), _t_] /*<<string.ml:234:2>>*/ ;
     /*<<string.ml:234:18>>*/ }
    var compare = runtime.caml_string_compare;
    function to_seq(s){
      /*<<string.ml:243:15>>*/  /*<<string.ml:243:15>>*/ var
      _r_ =  /*<<string.ml:243:15>>*/ caml_call1(bos, s);
      /*<<string.ml:243:15>>*/ return  /*<<string.ml:243:15>>*/ caml_call1
-            (Stdlib_Bytes[47], _r_);
+            (Stdlib_Bytes[47], _r_) /*<<string.ml:243:32>>*/ ;
     /*<<string.ml:243:32>>*/ }
    function to_seqi(s){
      /*<<string.ml:245:16>>*/  /*<<string.ml:245:16>>*/ var
      _q_ =  /*<<string.ml:245:16>>*/ caml_call1(bos, s);
      /*<<string.ml:245:16>>*/ return  /*<<string.ml:245:16>>*/ caml_call1
-            (Stdlib_Bytes[48], _q_);
+            (Stdlib_Bytes[48], _q_) /*<<string.ml:245:34>>*/ ;
     /*<<string.ml:245:34>>*/ }
    function of_seq(g){
      /*<<string.ml:247:15>>*/ return  /*<<string.ml:247:15>>*/ caml_call1
-            (bts,  /*<<string.ml:247:15>>*/ caml_call1(Stdlib_Bytes[49], g));
+            (bts,  /*<<string.ml:247:15>>*/ caml_call1(Stdlib_Bytes[49], g)) /*<<string.ml:247:32>>*/ ;
     /*<<string.ml:247:32>>*/ }
    function get_utf_8_uchar(s, i){
      /*<<string.ml:251:26>>*/  /*<<string.ml:251:44>>*/ var
      _p_ =  /*<<string.ml:251:44>>*/ caml_call1(bos, s);
      /*<<string.ml:251:26>>*/ return  /*<<string.ml:251:26>>*/ caml_call2
-            (Stdlib_Bytes[50], _p_, i);
+            (Stdlib_Bytes[50], _p_, i) /*<<string.ml:251:53>>*/ ;
     /*<<string.ml:251:53>>*/ }
    function is_valid_utf_8(s){
      /*<<string.ml:252:23>>*/  /*<<string.ml:252:40>>*/ var
      _o_ =  /*<<string.ml:252:40>>*/ caml_call1(bos, s);
      /*<<string.ml:252:40>>*/ return  /*<<string.ml:252:40>>*/ caml_call1
-            (Stdlib_Bytes[52], _o_);
+            (Stdlib_Bytes[52], _o_) /*<<string.ml:252:47>>*/ ;
     /*<<string.ml:252:47>>*/ }
    function get_utf_16be_uchar(s, i){
      /*<<string.ml:254:29>>*/  /*<<string.ml:254:50>>*/ var
      _n_ =  /*<<string.ml:254:50>>*/ caml_call1(bos, s);
      /*<<string.ml:254:29>>*/ return  /*<<string.ml:254:29>>*/ caml_call2
-            (Stdlib_Bytes[53], _n_, i);
+            (Stdlib_Bytes[53], _n_, i) /*<<string.ml:254:59>>*/ ;
     /*<<string.ml:254:59>>*/ }
    function is_valid_utf_16be(s){
      /*<<string.ml:255:26>>*/  /*<<string.ml:255:46>>*/ var
      _m_ =  /*<<string.ml:255:46>>*/ caml_call1(bos, s);
      /*<<string.ml:255:46>>*/ return  /*<<string.ml:255:46>>*/ caml_call1
-            (Stdlib_Bytes[55], _m_);
+            (Stdlib_Bytes[55], _m_) /*<<string.ml:255:53>>*/ ;
     /*<<string.ml:255:53>>*/ }
    function get_utf_16le_uchar(s, i){
      /*<<string.ml:257:29>>*/  /*<<string.ml:257:50>>*/ var
      _l_ =  /*<<string.ml:257:50>>*/ caml_call1(bos, s);
      /*<<string.ml:257:29>>*/ return  /*<<string.ml:257:29>>*/ caml_call2
-            (Stdlib_Bytes[56], _l_, i);
+            (Stdlib_Bytes[56], _l_, i) /*<<string.ml:257:59>>*/ ;
     /*<<string.ml:257:59>>*/ }
    function is_valid_utf_16le(s){
      /*<<string.ml:258:26>>*/  /*<<string.ml:258:46>>*/ var
      _k_ =  /*<<string.ml:258:46>>*/ caml_call1(bos, s);
      /*<<string.ml:258:46>>*/ return  /*<<string.ml:258:46>>*/ caml_call1
-            (Stdlib_Bytes[58], _k_);
+            (Stdlib_Bytes[58], _k_) /*<<string.ml:258:53>>*/ ;
     /*<<string.ml:258:53>>*/ }
    function get_int8(s, i){
      /*<<string.ml:267:19>>*/  /*<<string.ml:267:30>>*/ var
      _j_ =  /*<<string.ml:267:30>>*/ caml_call1(bos, s);
      /*<<string.ml:267:19>>*/ return  /*<<string.ml:267:19>>*/ caml_call2
-            (Stdlib_Bytes[60], _j_, i);
+            (Stdlib_Bytes[60], _j_, i) /*<<string.ml:267:39>>*/ ;
     /*<<string.ml:267:39>>*/ }
    function get_uint16_le(s, i){
      /*<<string.ml:268:24>>*/  /*<<string.ml:268:40>>*/ var
      _i_ =  /*<<string.ml:268:40>>*/ caml_call1(bos, s);
      /*<<string.ml:268:24>>*/ return  /*<<string.ml:268:24>>*/ caml_call2
-            (Stdlib_Bytes[63], _i_, i);
+            (Stdlib_Bytes[63], _i_, i) /*<<string.ml:268:49>>*/ ;
     /*<<string.ml:268:49>>*/ }
    function get_uint16_be(s, i){
      /*<<string.ml:269:24>>*/  /*<<string.ml:269:40>>*/ var
      _h_ =  /*<<string.ml:269:40>>*/ caml_call1(bos, s);
      /*<<string.ml:269:24>>*/ return  /*<<string.ml:269:24>>*/ caml_call2
-            (Stdlib_Bytes[62], _h_, i);
+            (Stdlib_Bytes[62], _h_, i) /*<<string.ml:269:49>>*/ ;
     /*<<string.ml:269:49>>*/ }
    function get_int16_ne(s, i){
      /*<<string.ml:270:23>>*/  /*<<string.ml:270:38>>*/ var
      _g_ =  /*<<string.ml:270:38>>*/ caml_call1(bos, s);
      /*<<string.ml:270:23>>*/ return  /*<<string.ml:270:23>>*/ caml_call2
-            (Stdlib_Bytes[64], _g_, i);
+            (Stdlib_Bytes[64], _g_, i) /*<<string.ml:270:47>>*/ ;
     /*<<string.ml:270:47>>*/ }
    function get_int16_le(s, i){
      /*<<string.ml:271:23>>*/  /*<<string.ml:271:38>>*/ var
      _f_ =  /*<<string.ml:271:38>>*/ caml_call1(bos, s);
      /*<<string.ml:271:23>>*/ return  /*<<string.ml:271:23>>*/ caml_call2
-            (Stdlib_Bytes[66], _f_, i);
+            (Stdlib_Bytes[66], _f_, i) /*<<string.ml:271:47>>*/ ;
     /*<<string.ml:271:47>>*/ }
    function get_int16_be(s, i){
      /*<<string.ml:272:23>>*/  /*<<string.ml:272:38>>*/ var
      _e_ =  /*<<string.ml:272:38>>*/ caml_call1(bos, s);
      /*<<string.ml:272:23>>*/ return  /*<<string.ml:272:23>>*/ caml_call2
-            (Stdlib_Bytes[65], _e_, i);
+            (Stdlib_Bytes[65], _e_, i) /*<<string.ml:272:47>>*/ ;
     /*<<string.ml:272:47>>*/ }
    function get_int32_le(s, i){
      /*<<string.ml:273:23>>*/  /*<<string.ml:273:38>>*/ var
      _d_ =  /*<<string.ml:273:38>>*/ caml_call1(bos, s);
      /*<<string.ml:273:23>>*/ return  /*<<string.ml:273:23>>*/ caml_call2
-            (Stdlib_Bytes[69], _d_, i);
+            (Stdlib_Bytes[69], _d_, i) /*<<string.ml:273:47>>*/ ;
     /*<<string.ml:273:47>>*/ }
    function get_int32_be(s, i){
      /*<<string.ml:274:23>>*/  /*<<string.ml:274:38>>*/ var
      _c_ =  /*<<string.ml:274:38>>*/ caml_call1(bos, s);
      /*<<string.ml:274:23>>*/ return  /*<<string.ml:274:23>>*/ caml_call2
-            (Stdlib_Bytes[68], _c_, i);
+            (Stdlib_Bytes[68], _c_, i) /*<<string.ml:274:47>>*/ ;
     /*<<string.ml:274:47>>*/ }
    function get_int64_le(s, i){
      /*<<string.ml:275:23>>*/  /*<<string.ml:275:38>>*/ var
      _b_ =  /*<<string.ml:275:38>>*/ caml_call1(bos, s);
      /*<<string.ml:275:23>>*/ return  /*<<string.ml:275:23>>*/ caml_call2
-            (Stdlib_Bytes[72], _b_, i);
+            (Stdlib_Bytes[72], _b_, i) /*<<string.ml:275:47>>*/ ;
     /*<<string.ml:275:47>>*/ }
    function get_int64_be(s, i){
      /*<<string.ml:276:23>>*/  /*<<string.ml:276:38>>*/ var
      _a_ =  /*<<string.ml:276:38>>*/ caml_call1(bos, s);
      /*<<string.ml:276:23>>*/ return  /*<<string.ml:276:23>>*/ caml_call2
-            (Stdlib_Bytes[71], _a_, i);
+            (Stdlib_Bytes[71], _a_, i) /*<<string.ml:276:47>>*/ ;
     /*<<string.ml:276:47>>*/ }
    var
     Stdlib_String =
@@ -7033,13 +7152,13 @@
    "use strict";
    var runtime = globalThis.jsoo_runtime, cst = "()";
    function equal(_b_, param){
-     /*<<unit.ml:18:18>>*/ return 1;
+     /*<<unit.ml:18:18>>*/ return 1 /*<<unit.ml:18:18>>*/ ;
     /*<<unit.ml:18:22>>*/ }
    function compare(_a_, param){
-     /*<<unit.ml:19:20>>*/ return 0;
+     /*<<unit.ml:19:20>>*/ return 0 /*<<unit.ml:19:20>>*/ ;
     /*<<unit.ml:19:21>>*/ }
    function to_string(param){
-     /*<<unit.ml:20:19>>*/ return cst;
+     /*<<unit.ml:20:19>>*/ return cst /*<<unit.ml:20:19>>*/ ;
     /*<<unit.ml:20:23>>*/ }
    var Stdlib_Unit = [0, equal, compare, to_string];
    runtime.caml_register_global(1, Stdlib_Unit, "Stdlib__Unit");
@@ -7072,9 +7191,9 @@
      /*<<marshal.ml:34:2>>*/ if
      (0 <= ofs && 0 <= len && (caml_ml_bytes_length(buff) - len | 0) >= ofs)
       /*<<marshal.ml:36:7>>*/ return  /*<<marshal.ml:36:7>>*/ runtime.caml_output_value_to_buffer
-             (buff, ofs, len, v, flags);
+             (buff, ofs, len, v, flags) /*<<marshal.ml:36:44>>*/ ;
      /*<<marshal.ml:35:7>>*/ return  /*<<marshal.ml:35:7>>*/ caml_call1
-            (Stdlib[1], cst_Marshal_to_buffer_substrin);
+            (Stdlib[1], cst_Marshal_to_buffer_substrin) /*<<marshal.ml:36:44>>*/ ;
     /*<<marshal.ml:36:44>>*/ }
    var
     cst_Marshal_data_size = "Marshal.data_size",
@@ -7084,9 +7203,9 @@
      /*<<marshal.ml:50:2>>*/ if
      (0 <= ofs && (caml_ml_bytes_length(buff) - 16 | 0) >= ofs)
       /*<<marshal.ml:52:7>>*/ return  /*<<marshal.ml:52:7>>*/ caml_marshal_data_size
-             (buff, ofs);
+             (buff, ofs) /*<<marshal.ml:52:32>>*/ ;
      /*<<marshal.ml:51:7>>*/ return  /*<<marshal.ml:51:7>>*/ caml_call1
-            (Stdlib[1], cst_Marshal_data_size);
+            (Stdlib[1], cst_Marshal_data_size) /*<<marshal.ml:52:32>>*/ ;
     /*<<marshal.ml:52:32>>*/ }
    function total_size(buff, ofs){
      /*<<marshal.ml:53:26>>*/ return 16 + data_size(buff, ofs) | 0;
@@ -7100,15 +7219,15 @@
              ?  /*<<marshal.ml:61:9>>*/ caml_call1
                (Stdlib[1], cst_Marshal_from_bytes$0)
              :  /*<<marshal.ml:62:9>>*/ runtime.caml_input_value_from_bytes
-               (buff, ofs);
+               (buff, ofs) /*<<marshal.ml:63:5>>*/ ;
     }
      /*<<marshal.ml:57:7>>*/ return  /*<<marshal.ml:57:7>>*/ caml_call1
-            (Stdlib[1], cst_Marshal_from_bytes);
+            (Stdlib[1], cst_Marshal_from_bytes) /*<<marshal.ml:63:5>>*/ ;
     /*<<marshal.ml:63:5>>*/ }
    function from_string(buff, ofs){
      /*<<marshal.ml:68:2>>*/ return from_bytes
             ( /*<<marshal.ml:68:13>>*/ caml_call1(Stdlib_Bytes[45], buff),
-             ofs);
+             ofs) /*<<marshal.ml:68:46>>*/ ;
     /*<<marshal.ml:68:46>>*/ }
    var
     Stdlib_Marshal =
@@ -7173,10 +7292,11 @@
     cst_Array_exists2 = "Array.exists2",
     cst_Array_combine = "Array.combine";
    function init(l, f){
-     /*<<array.ml:48:2>>*/ if(0 === l)  /*<<array.ml:48:16>>*/ return [0];
+     /*<<array.ml:48:2>>*/ if(0 === l)
+      /*<<array.ml:48:16>>*/ return [0] /*<<array.ml:48:16>>*/ ;
     if(0 > l)
       /*<<array.ml:49:16>>*/ return  /*<<array.ml:49:16>>*/ caml_call1
-             (Stdlib[1], cst_Array_init);
+             (Stdlib[1], cst_Array_init) /*<<array.ml:58:6>>*/ ;
      /*<<array.ml:54:13>>*/ var
       /*<<array.ml:54:13>>*/ res =
         /*<<array.ml:54:13>>*/ caml_make_vect
@@ -7193,7 +7313,7 @@
       i = _aF_;
      }
     }
-     /*<<array.ml:58:3>>*/ return res;
+     /*<<array.ml:58:3>>*/ return res /*<<array.ml:58:3>>*/ ;
     /*<<array.ml:58:6>>*/ }
    function make_matrix(sx, sy, init){
      /*<<array.ml:62:2>>*/ if(sy < 0)
@@ -7215,7 +7335,7 @@
       }
      }
     }
-     /*<<array.ml:69:2>>*/ return res;
+     /*<<array.ml:69:2>>*/ return res /*<<array.ml:69:2>>*/ ;
     /*<<array.ml:69:5>>*/ }
    function init_matrix(sx, sy, f){
      /*<<array.ml:73:2>>*/ if(sy < 0)
@@ -7253,13 +7373,13 @@
       }
      }
     }
-     /*<<array.ml:85:2>>*/ return res;
+     /*<<array.ml:85:2>>*/ return res /*<<array.ml:85:2>>*/ ;
     /*<<array.ml:85:5>>*/ }
    function copy(a){
      /*<<array.ml:88:2>>*/ var l = a.length - 1;
      /*<<array.ml:88:22>>*/ return 0 === l
             ? [0]
-            :  /*<<array.ml:88:46>>*/ caml_array_sub(a, 0, l);
+            :  /*<<array.ml:88:46>>*/ caml_array_sub(a, 0, l) /*<<array.ml:88:62>>*/ ;
     /*<<array.ml:88:62>>*/ }
    function append(a1, a2){
      /*<<array.ml:91:2>>*/ var l1 = a1.length - 1;
@@ -7268,23 +7388,23 @@
             : 0
               === a2.length - 1
               ?  /*<<array.ml:93:29>>*/ caml_array_sub(a1, 0, l1)
-              :  /*<<array.ml:94:7>>*/ runtime.caml_array_append(a1, a2);
+              :  /*<<array.ml:94:7>>*/ runtime.caml_array_append(a1, a2) /*<<array.ml:94:24>>*/ ;
     /*<<array.ml:94:24>>*/ }
    function sub(a, ofs, len){
      /*<<array.ml:97:2>>*/ if
      (0 <= ofs && 0 <= len && (a.length - 1 - len | 0) >= ofs)
       /*<<array.ml:99:7>>*/ return  /*<<array.ml:99:7>>*/ caml_array_sub
-             (a, ofs, len);
+             (a, ofs, len) /*<<array.ml:99:27>>*/ ;
      /*<<array.ml:98:7>>*/ return  /*<<array.ml:98:7>>*/ caml_call1
-            (Stdlib[1], cst_Array_sub);
+            (Stdlib[1], cst_Array_sub) /*<<array.ml:99:27>>*/ ;
     /*<<array.ml:99:27>>*/ }
    function fill(a, ofs, len, v){
      /*<<array.ml:102:2>>*/ if
      (0 <= ofs && 0 <= len && (a.length - 1 - len | 0) >= ofs)
       /*<<array.ml:104:7>>*/ return  /*<<array.ml:104:7>>*/ runtime.caml_array_fill
-             (a, ofs, len, v);
+             (a, ofs, len, v) /*<<array.ml:104:30>>*/ ;
      /*<<array.ml:103:7>>*/ return  /*<<array.ml:103:7>>*/ caml_call1
-            (Stdlib[1], cst_Array_fill);
+            (Stdlib[1], cst_Array_fill) /*<<array.ml:104:30>>*/ ;
     /*<<array.ml:104:30>>*/ }
    function blit(a1, ofs1, a2, ofs2, len){
      /*<<array.ml:107:2>>*/ if
@@ -7295,9 +7415,9 @@
         (a1.length - 1 - len | 0) >= ofs1
         && 0 <= ofs2 && (a2.length - 1 - len | 0) >= ofs2)
       /*<<array.ml:110:7>>*/ return  /*<<array.ml:110:7>>*/ runtime.caml_array_blit
-             (a1, ofs1, a2, ofs2, len);
+             (a1, ofs1, a2, ofs2, len) /*<<array.ml:110:38>>*/ ;
      /*<<array.ml:109:7>>*/ return  /*<<array.ml:109:7>>*/ caml_call1
-            (Stdlib[1], cst_Array_blit);
+            (Stdlib[1], cst_Array_blit) /*<<array.ml:110:38>>*/ ;
     /*<<array.ml:110:38>>*/ }
    function iter(f, a){
      /*<<array.ml:113:2>>*/ var
@@ -7318,7 +7438,7 @@
    function iter2(f, a, b){
      /*<<array.ml:116:2>>*/ if(a.length - 1 !== b.length - 1)
       /*<<array.ml:117:4>>*/ return  /*<<array.ml:117:4>>*/ caml_call1
-             (Stdlib[1], cst_Array_iter2_arrays_must_ha);
+             (Stdlib[1], cst_Array_iter2_arrays_must_ha) /*<<array.ml:119:73>>*/ ;
      /*<<array.ml:119:4>>*/ var
      _ap_ = a.length - 2 | 0,
       /*<<array.ml:119:4>>*/ _ao_ = 0;
@@ -7336,7 +7456,8 @@
     /*<<array.ml:119:73>>*/ }
    function map(f, a){
      /*<<array.ml:122:2>>*/ var l = a.length - 1;
-     /*<<array.ml:123:2>>*/ if(0 === l)  /*<<array.ml:123:16>>*/ return [0];
+     /*<<array.ml:123:2>>*/ if(0 === l)
+      /*<<array.ml:123:16>>*/ return [0] /*<<array.ml:123:16>>*/ ;
      /*<<array.ml:124:12>>*/ var
       /*<<array.ml:124:12>>*/ r =
         /*<<array.ml:124:12>>*/ caml_make_vect
@@ -7353,7 +7474,7 @@
       i = _an_;
      }
     }
-     /*<<array.ml:128:4>>*/ return r;
+     /*<<array.ml:128:4>>*/ return r /*<<array.ml:128:4>>*/ ;
     /*<<array.ml:129:5>>*/ }
    function map_inplace(f, a){
      /*<<array.ml:132:2>>*/ var
@@ -7393,8 +7514,8 @@
       /*<<array.ml:143:2>>*/ lb = b.length - 1;
     if(la !== lb)
       /*<<array.ml:145:4>>*/ return  /*<<array.ml:145:4>>*/ caml_call1
-             (Stdlib[1], cst_Array_map2_arrays_must_hav);
-    if(0 === la)  /*<<array.ml:147:19>>*/ return [0];
+             (Stdlib[1], cst_Array_map2_arrays_must_hav) /*<<array.ml:154:5>>*/ ;
+    if(0 === la)  /*<<array.ml:147:19>>*/ return [0] /*<<array.ml:147:19>>*/ ;
      /*<<array.ml:148:14>>*/ var
       /*<<array.ml:148:14>>*/ r =
         /*<<array.ml:148:14>>*/ caml_make_vect
@@ -7411,7 +7532,7 @@
       i = _ae_;
      }
     }
-     /*<<array.ml:152:6>>*/ return r;
+     /*<<array.ml:152:6>>*/ return r /*<<array.ml:152:6>>*/ ;
     /*<<array.ml:154:5>>*/ }
    function iteri(f, a){
      /*<<array.ml:157:2>>*/ var
@@ -7431,7 +7552,8 @@
     /*<<array.ml:157:56>>*/ }
    function mapi(f, a){
      /*<<array.ml:160:2>>*/ var l = a.length - 1;
-     /*<<array.ml:161:2>>*/ if(0 === l)  /*<<array.ml:161:16>>*/ return [0];
+     /*<<array.ml:161:2>>*/ if(0 === l)
+      /*<<array.ml:161:16>>*/ return [0] /*<<array.ml:161:16>>*/ ;
      /*<<array.ml:162:12>>*/ var
       /*<<array.ml:162:12>>*/ r =
         /*<<array.ml:162:12>>*/ caml_make_vect
@@ -7448,12 +7570,12 @@
       i = ___;
      }
     }
-     /*<<array.ml:166:4>>*/ return r;
+     /*<<array.ml:166:4>>*/ return r /*<<array.ml:166:4>>*/ ;
     /*<<array.ml:167:5>>*/ }
    function to_list(a){
      /*<<array.ml:170:2>>*/ var i$1 = a.length - 2 | 0, i = i$1, res = 0;
      /*<<array.ml:171:4>>*/ for(;;){
-     if(0 > i)  /*<<array.ml:171:18>>*/ return res;
+     if(0 > i)  /*<<array.ml:171:18>>*/ return res /*<<array.ml:171:18>>*/ ;
       /*<<array.ml:171:42>>*/ var
        /*<<array.ml:171:42>>*/ res$0 = [0, a[1 + i], res],
        /*<<array.ml:171:42>>*/ i$0 = i - 1 | 0;
@@ -7464,7 +7586,8 @@
    function list_length(accu, param){
     var accu$0 = accu, param$0 = param;
     for(;;){
-     if(! param$0)  /*<<array.ml:176:10>>*/ return accu$0;
+     if(! param$0)
+       /*<<array.ml:176:10>>*/ return accu$0 /*<<array.ml:176:10>>*/ ;
       /*<<array.ml:177:12>>*/ var
       t = param$0[2],
        /*<<array.ml:177:12>>*/ accu$1 = accu$0 + 1 | 0;
@@ -7473,7 +7596,8 @@
     }
    }
    function of_list(l){
-     /*<<array.ml:179:14>>*/ if(! l)  /*<<array.ml:180:10>>*/ return [0];
+     /*<<array.ml:179:14>>*/ if(! l)
+      /*<<array.ml:180:10>>*/ return [0] /*<<array.ml:180:10>>*/ ;
      /*<<array.ml:182:14>>*/ var
      tl = l[2],
      hd = l[1],
@@ -7482,7 +7606,7 @@
      i = 1,
      param = tl;
     for(;;){
-     if(! param)  /*<<array.ml:183:6>>*/ return a;
+     if(! param)  /*<<array.ml:183:6>>*/ return a /*<<array.ml:183:6>>*/ ;
      var tl$0 = param[2], hd$0 = param[1];
       /*<<array.ml:185:20>>*/ a[1 + i] = hd$0;
       /*<<array.ml:183:6>>*/  /*<<array.ml:183:6>>*/ var i$0 = i + 1 | 0;
@@ -7509,7 +7633,7 @@
    function fold_left_map(f, acc, input_array){
      /*<<array.ml:196:2>>*/ var len = input_array.length - 1;
      /*<<array.ml:197:2>>*/ if(0 === len)
-      /*<<array.ml:197:18>>*/ return [0, acc, [0]];
+      /*<<array.ml:197:18>>*/ return [0, acc, [0]] /*<<array.ml:197:18>>*/ ;
      /*<<array.ml:198:19>>*/ var
       /*<<array.ml:198:19>>*/ match =
         /*<<array.ml:198:19>>*/ caml_call2(f, acc, input_array[1]),
@@ -7535,7 +7659,7 @@
       i = _U_;
      }
     }
-     /*<<array.ml:206:4>>*/ return [0, acc$1[1], output_array];
+     /*<<array.ml:206:4>>*/ return [0, acc$1[1], output_array] /*<<array.ml:206:4>>*/ ;
     /*<<array.ml:207:5>>*/ }
    function fold_right(f, a, x){
      /*<<array.ml:210:2>>*/ var
@@ -7555,10 +7679,10 @@
    function exists(p, a){
      /*<<array.ml:217:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:219:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:219:18>>*/ return 0;
+     if(i === n)  /*<<array.ml:219:18>>*/ return 0 /*<<array.ml:219:18>>*/ ;
       /*<<array.ml:220:12>>*/ if
       ( /*<<array.ml:220:12>>*/ caml_call1(p, a[1 + i]))
-       /*<<array.ml:220:36>>*/ return 1;
+       /*<<array.ml:220:36>>*/ return 1 /*<<array.ml:220:36>>*/ ;
       /*<<array.ml:221:9>>*/  /*<<array.ml:221:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7566,10 +7690,10 @@
    function for_all(p, a){
      /*<<array.ml:225:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:227:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:227:18>>*/ return 1;
+     if(i === n)  /*<<array.ml:227:18>>*/ return 1 /*<<array.ml:227:18>>*/ ;
       /*<<array.ml:228:12>>*/ if
       (!  /*<<array.ml:228:12>>*/ caml_call1(p, a[1 + i]))
-       /*<<array.ml:229:9>>*/ return 0;
+       /*<<array.ml:229:9>>*/ return 0 /*<<array.ml:229:9>>*/ ;
       /*<<array.ml:228:36>>*/  /*<<array.ml:228:36>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7578,13 +7702,13 @@
      /*<<array.ml:233:2>>*/ var n1 = l1.length - 1, n2 = l2.length - 1;
     if(n1 !== n2)
       /*<<array.ml:235:19>>*/ return  /*<<array.ml:235:19>>*/ caml_call1
-             (Stdlib[1], cst_Array_for_all2);
+             (Stdlib[1], cst_Array_for_all2) /*<<array.ml:240:8>>*/ ;
     var i = 0;
      /*<<array.ml:237:4>>*/ for(;;){
-     if(i === n1)  /*<<array.ml:237:19>>*/ return 1;
+     if(i === n1)  /*<<array.ml:237:19>>*/ return 1 /*<<array.ml:237:19>>*/ ;
       /*<<array.ml:238:12>>*/ if
       (!  /*<<array.ml:238:12>>*/ caml_call2(p, l1[1 + i], l2[1 + i]))
-       /*<<array.ml:239:9>>*/ return 0;
+       /*<<array.ml:239:9>>*/ return 0 /*<<array.ml:239:9>>*/ ;
       /*<<array.ml:238:55>>*/  /*<<array.ml:238:55>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7593,13 +7717,13 @@
      /*<<array.ml:243:2>>*/ var n1 = l1.length - 1, n2 = l2.length - 1;
     if(n1 !== n2)
       /*<<array.ml:245:19>>*/ return  /*<<array.ml:245:19>>*/ caml_call1
-             (Stdlib[1], cst_Array_exists2);
+             (Stdlib[1], cst_Array_exists2) /*<<array.ml:250:8>>*/ ;
     var i = 0;
      /*<<array.ml:247:4>>*/ for(;;){
-     if(i === n1)  /*<<array.ml:247:19>>*/ return 0;
+     if(i === n1)  /*<<array.ml:247:19>>*/ return 0 /*<<array.ml:247:19>>*/ ;
       /*<<array.ml:248:12>>*/ if
       ( /*<<array.ml:248:12>>*/ caml_call2(p, l1[1 + i], l2[1 + i]))
-       /*<<array.ml:248:55>>*/ return 1;
+       /*<<array.ml:248:55>>*/ return 1 /*<<array.ml:248:55>>*/ ;
       /*<<array.ml:249:9>>*/  /*<<array.ml:249:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7607,10 +7731,10 @@
    function mem(x, a){
      /*<<array.ml:253:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:255:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:255:18>>*/ return 0;
+     if(i === n)  /*<<array.ml:255:18>>*/ return 0 /*<<array.ml:255:18>>*/ ;
       /*<<array.ml:256:12>>*/ if
       (0 ===  /*<<array.ml:256:12>>*/ runtime.caml_compare(a[1 + i], x))
-       /*<<array.ml:256:48>>*/ return 1;
+       /*<<array.ml:256:48>>*/ return 1 /*<<array.ml:256:48>>*/ ;
       /*<<array.ml:257:9>>*/  /*<<array.ml:257:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7618,8 +7742,9 @@
    function memq(x, a){
      /*<<array.ml:261:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:263:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:263:18>>*/ return 0;
-     if(x === a[1 + i])  /*<<array.ml:264:39>>*/ return 1;
+     if(i === n)  /*<<array.ml:263:18>>*/ return 0 /*<<array.ml:263:18>>*/ ;
+     if(x === a[1 + i])
+       /*<<array.ml:264:39>>*/ return 1 /*<<array.ml:264:39>>*/ ;
       /*<<array.ml:265:9>>*/  /*<<array.ml:265:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7627,10 +7752,10 @@
    function find_opt(p, a){
      /*<<array.ml:269:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:271:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:271:18>>*/ return 0;
+     if(i === n)  /*<<array.ml:271:18>>*/ return 0 /*<<array.ml:271:18>>*/ ;
       /*<<array.ml:273:14>>*/  /*<<array.ml:273:14>>*/ var x = a[1 + i];
       /*<<array.ml:274:9>>*/ if( /*<<array.ml:274:9>>*/ caml_call1(p, x))
-       /*<<array.ml:274:18>>*/ return [0, x];
+       /*<<array.ml:274:18>>*/ return [0, x] /*<<array.ml:274:18>>*/ ;
       /*<<array.ml:275:11>>*/  /*<<array.ml:275:11>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7638,10 +7763,10 @@
    function find_index(p, a){
      /*<<array.ml:280:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:282:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:282:18>>*/ return 0;
+     if(i === n)  /*<<array.ml:282:18>>*/ return 0 /*<<array.ml:282:18>>*/ ;
       /*<<array.ml:283:12>>*/ if
       ( /*<<array.ml:283:12>>*/ caml_call1(p, a[1 + i]))
-       /*<<array.ml:283:36>>*/ return [0, i];
+       /*<<array.ml:283:36>>*/ return [0, i] /*<<array.ml:283:36>>*/ ;
       /*<<array.ml:284:9>>*/  /*<<array.ml:284:9>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7649,10 +7774,10 @@
    function find_map(f, a){
      /*<<array.ml:288:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:290:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:290:18>>*/ return 0;
+     if(i === n)  /*<<array.ml:290:18>>*/ return 0 /*<<array.ml:290:18>>*/ ;
       /*<<array.ml:292:12>>*/  /*<<array.ml:292:12>>*/ var
       r =  /*<<array.ml:292:12>>*/ caml_call1(f, a[1 + i]);
-     if(r)  /*<<array.ml:294:23>>*/ return r;
+     if(r)  /*<<array.ml:294:23>>*/ return r /*<<array.ml:294:23>>*/ ;
       /*<<array.ml:293:16>>*/  /*<<array.ml:293:16>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7660,10 +7785,10 @@
    function find_mapi(f, a){
      /*<<array.ml:299:2>>*/ var n = a.length - 1, i = 0;
      /*<<array.ml:301:4>>*/ for(;;){
-     if(i === n)  /*<<array.ml:301:18>>*/ return 0;
+     if(i === n)  /*<<array.ml:301:18>>*/ return 0 /*<<array.ml:301:18>>*/ ;
       /*<<array.ml:303:12>>*/  /*<<array.ml:303:12>>*/ var
       r =  /*<<array.ml:303:12>>*/ caml_call2(f, i, a[1 + i]);
-     if(r)  /*<<array.ml:305:23>>*/ return r;
+     if(r)  /*<<array.ml:305:23>>*/ return r /*<<array.ml:305:23>>*/ ;
       /*<<array.ml:304:16>>*/  /*<<array.ml:304:16>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -7671,7 +7796,7 @@
    function split(x){
      /*<<array.ml:310:2>>*/ if
      ( /*<<array.ml:310:5>>*/ runtime.caml_equal(x, [0]))
-      /*<<array.ml:310:19>>*/ return [0, [0], [0]];
+      /*<<array.ml:310:19>>*/ return [0, [0], [0]] /*<<array.ml:310:19>>*/ ;
      /*<<array.ml:313:4>>*/ var
      match = x[1],
      b0 = match[2],
@@ -7694,7 +7819,7 @@
       i = _P_;
      }
     }
-     /*<<array.ml:321:4>>*/ return [0, a, b];
+     /*<<array.ml:321:4>>*/ return [0, a, b] /*<<array.ml:321:4>>*/ ;
     /*<<array.ml:322:5>>*/ }
    function combine(a, b){
      /*<<array.ml:325:2>>*/ var
@@ -7703,7 +7828,7 @@
     if(na !== nb)
       /*<<array.ml:327:19>>*/  /*<<array.ml:327:19>>*/ caml_call1
       (Stdlib[1], cst_Array_combine);
-    if(0 === na)  /*<<array.ml:328:17>>*/ return [0];
+    if(0 === na)  /*<<array.ml:328:17>>*/ return [0] /*<<array.ml:328:17>>*/ ;
      /*<<array.ml:330:12>>*/ var
       /*<<array.ml:330:12>>*/ x =
         /*<<array.ml:330:12>>*/ caml_make_vect(na, [0, a[1], b[1]]),
@@ -7718,7 +7843,7 @@
       i = _M_;
      }
     }
-     /*<<array.ml:334:4>>*/ return x;
+     /*<<array.ml:334:4>>*/ return x /*<<array.ml:334:4>>*/ ;
     /*<<array.ml:335:5>>*/ }
     /*<<array.ml:337:0>>*/ var
      /*<<array.ml:337:0>>*/ Bottom =
@@ -7758,9 +7883,9 @@
         >
           /*<<array.ml:347:22>>*/ caml_call2
           (cmp, caml_check_bound(a, i31)[1 + i31], _J_))
-        /*<<array.ml:348:11>>*/ return i31 + 1 | 0;
+        /*<<array.ml:348:11>>*/ return i31 + 1 | 0 /*<<array.ml:348:11>>*/ ;
      }
-     if(i31 < l)  /*<<array.ml:349:27>>*/ return i31;
+     if(i31 < l)  /*<<array.ml:349:27>>*/ return i31 /*<<array.ml:349:27>>*/ ;
       /*<<array.ml:349:36>>*/ throw  /*<<array.ml:349:36>>*/ caml_maybe_attach_backtrace
             ([0, Bottom, i], 1);
      /*<<array.ml:349:52>>*/ }
@@ -7864,7 +7989,7 @@
     }
     else
      var _A_ = _z_;
-     /*<<array.ml:384:57>>*/ return _A_;
+     /*<<array.ml:384:57>>*/ return _A_ /*<<array.ml:384:57>>*/ ;
     /*<<array.ml:384:67>>*/ }
    function stable_sort(cmp, a){
     function merge(src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs){
@@ -7885,7 +8010,8 @@
        (0 <  /*<<array.ml:392:9>>*/ caml_call2(cmp, s1, s2)){
         /*<<array.ml:400:8>>*/ caml_check_bound(dst, d)[1 + d] = s2;
         /*<<array.ml:400:8>>*/  /*<<array.ml:400:8>>*/ var i2$0 = i2 + 1 | 0;
-       if(i2$0 >= src2r) return blit(a, i1, dst, d + 1 | 0, src1r - i1 | 0);
+       if(i2$0 >= src2r)
+        return blit(a, i1, dst, d + 1 | 0, src1r - i1 | 0) /*<<array.ml:407:70>>*/ ;
         /*<<array.ml:403:10>>*/ var
          /*<<array.ml:403:10>>*/ d$0 = d + 1 | 0,
          /*<<array.ml:403:24>>*/ s2$0 = caml_check_bound(src2, i2$0)[1 + i2$0];
@@ -7897,7 +8023,7 @@
         /*<<array.ml:393:8>>*/ caml_check_bound(dst, d)[1 + d] = s1;
         /*<<array.ml:393:8>>*/  /*<<array.ml:393:8>>*/ var i1$0 = i1 + 1 | 0;
        if(i1$0 >= src1r)
-        return blit(src2, i2, dst, d + 1 | 0, src2r - i2 | 0);
+        return blit(src2, i2, dst, d + 1 | 0, src2r - i2 | 0) /*<<array.ml:407:70>>*/ ;
         /*<<array.ml:396:10>>*/ var
          /*<<array.ml:396:10>>*/ d$1 = d + 1 | 0,
          /*<<array.ml:396:18>>*/ s1$0 = caml_check_bound(a, i1$0)[1 + i1$0];
@@ -7944,15 +8070,16 @@
      /*<<array.ml:418:8>>*/ }
     function sortto(srcofs, dst, dstofs, len){
       /*<<array.ml:421:4>>*/ if(len <= 5)
-       /*<<array.ml:421:26>>*/ return isortto(srcofs, dst, dstofs, len);
+       /*<<array.ml:421:26>>*/ return isortto(srcofs, dst, dstofs, len) /*<<array.ml:427:7>>*/ ;
      var l1 = len / 2 | 0, l2 = len - l1 | 0;
       /*<<array.ml:424:6>>*/ sortto(srcofs + l1 | 0, dst, dstofs + l1 | 0, l2);
       /*<<array.ml:425:6>>*/ sortto(srcofs, a, srcofs + l2 | 0, l1);
       /*<<array.ml:425:6>>*/ return merge
-             (srcofs + l2 | 0, l1, dst, dstofs + l1 | 0, l2, dst, dstofs);
+             (srcofs + l2 | 0, l1, dst, dstofs + l1 | 0, l2, dst, dstofs) /*<<array.ml:427:7>>*/ ;
      /*<<array.ml:427:7>>*/ }
     var l = a.length - 1;
-    if(l <= 5)  /*<<array.ml:430:22>>*/ return isortto(0, a, 0, l);
+    if(l <= 5)
+      /*<<array.ml:430:22>>*/ return isortto(0, a, 0, l) /*<<array.ml:437:5>>*/ ;
      /*<<array.ml:433:12>>*/ var
      l1 = l / 2 | 0,
      l2 = l - l1 | 0,
@@ -7960,7 +8087,7 @@
         /*<<array.ml:433:12>>*/ caml_make_vect(l2, caml_check_bound(a, 0)[1]);
      /*<<array.ml:434:4>>*/ sortto(l1, t, 0, l2);
      /*<<array.ml:435:4>>*/ sortto(0, a, l2, l1);
-     /*<<array.ml:435:4>>*/ return merge(l2, l1, t, 0, l2, a, 0);
+     /*<<array.ml:435:4>>*/ return merge(l2, l1, t, 0, l2, a, 0) /*<<array.ml:437:5>>*/ ;
     /*<<array.ml:437:5>>*/ }
    function shuffle(rand, a){
      /*<<array.ml:443:2>>*/ var _j_ = a.length - 2 | 0;
@@ -7983,32 +8110,32 @@
    function to_seq(a){
     function aux(i, param){
       /*<<array.ml:454:4>>*/ if(i >= a.length - 1)
-       /*<<array.ml:458:9>>*/ return 0;
+       /*<<array.ml:458:9>>*/ return 0 /*<<array.ml:458:9>>*/ ;
       /*<<array.ml:456:14>>*/ var
        /*<<array.ml:456:14>>*/ x = a[1 + i],
        /*<<array.ml:456:14>>*/ _h_ = i + 1 | 0;
       /*<<array.ml:457:6>>*/ return [0,
              x,
-             function(_i_){ /*<<?>>*/ return aux(_h_, _i_);}];
+             function(_i_){ /*<<?>>*/ return aux(_h_, _i_);}] /*<<array.ml:457:6>>*/ ;
      /*<<array.ml:458:16>>*/ }
      /*<<array.ml:460:2>>*/ var _f_ = 0;
      /*<<array.ml:460:2>>*/ return function(_g_){
-      /*<<?>>*/ return aux(_f_, _g_);};
+      /*<<?>>*/ return aux(_f_, _g_);} /*<<array.ml:460:2>>*/ ;
     /*<<array.ml:460:7>>*/ }
    function to_seqi(a){
     function aux(i, param){
       /*<<array.ml:464:4>>*/ if(i >= a.length - 1)
-       /*<<array.ml:468:9>>*/ return 0;
+       /*<<array.ml:468:9>>*/ return 0 /*<<array.ml:468:9>>*/ ;
       /*<<array.ml:466:14>>*/ var
        /*<<array.ml:466:14>>*/ x = a[1 + i],
        /*<<array.ml:466:14>>*/ _d_ = i + 1 | 0;
       /*<<array.ml:467:6>>*/ return [0,
              [0, i, x],
-             function(_e_){ /*<<?>>*/ return aux(_d_, _e_);}];
+             function(_e_){ /*<<?>>*/ return aux(_d_, _e_);}] /*<<array.ml:467:6>>*/ ;
      /*<<array.ml:468:16>>*/ }
      /*<<array.ml:470:2>>*/ var _b_ = 0;
      /*<<array.ml:470:2>>*/ return function(_c_){
-      /*<<?>>*/ return aux(_b_, _c_);};
+      /*<<?>>*/ return aux(_b_, _c_);} /*<<array.ml:470:2>>*/ ;
     /*<<array.ml:470:7>>*/ }
    function of_seq(i$2){
      /*<<array.ml:484:2>>*/  /*<<array.ml:484:10>>*/ var
@@ -8016,11 +8143,11 @@
         /*<<array.ml:484:10>>*/ caml_call3
         (Stdlib_Seq[5],
          function(acc, x){
-           /*<<array.ml:484:38>>*/ return [0, x, acc];
+           /*<<array.ml:484:38>>*/ return [0, x, acc] /*<<array.ml:484:38>>*/ ;
           /*<<array.ml:484:44>>*/ },
          0,
          i$2);
-    if(! l)  /*<<array.ml:473:10>>*/ return [0];
+    if(! l)  /*<<array.ml:473:10>>*/ return [0] /*<<array.ml:473:10>>*/ ;
      /*<<array.ml:475:16>>*/ var
      tl = l[2],
      hd = l[1],
@@ -8031,7 +8158,7 @@
      i = i$1,
      param = tl;
     for(;;){
-     if(! param)  /*<<array.ml:477:6>>*/ return a;
+     if(! param)  /*<<array.ml:477:6>>*/ return a /*<<array.ml:477:6>>*/ ;
      var tl$0 = param[2], hd$0 = param[1];
       /*<<array.ml:479:20>>*/ a[1 + i] = hd$0;
       /*<<array.ml:477:6>>*/  /*<<array.ml:477:6>>*/ var i$0 = i - 1 | 0;
@@ -8136,10 +8263,10 @@
        /*<<float.ml:38:20>>*/ runtime.caml_int64_float_of_bits
        (runtime.caml_int64_create_lo_mi_hi(1, 0, 32752));
    function is_finite(x){
-     /*<<float.ml:39:27>>*/ return x - x == 0. ? 1 : 0;
+     /*<<float.ml:39:27>>*/ return x - x == 0. ? 1 : 0 /*<<float.ml:39:27>>*/ ;
     /*<<float.ml:39:38>>*/ }
    function is_infinite(x){
-     /*<<float.ml:40:29>>*/ return 1. / x == 0. ? 1 : 0;
+     /*<<float.ml:40:29>>*/ return 1. / x == 0. ? 1 : 0 /*<<float.ml:40:29>>*/ ;
     /*<<float.ml:40:41>>*/ }
    function is_nan(x){
      /*<<float.ml:41:24>>*/ return x != x ? 1 : 0;
@@ -8166,15 +8293,15 @@
    function is_integer(x){
      /*<<float.ml:116:19>>*/ var
      _aX_ = x ==  /*<<float.ml:116:23>>*/ runtime.caml_trunc_float(x) ? 1 : 0;
-    return _aX_ ? is_finite(x) : _aX_;
+    return _aX_ ? is_finite(x) : _aX_ /*<<float.ml:116:45>>*/ ;
     /*<<float.ml:116:45>>*/ }
    function succ(x){
      /*<<float.ml:121:13>>*/ return  /*<<float.ml:121:13>>*/ caml_nextafter_float
-            (x, infinity);
+            (x, infinity) /*<<float.ml:121:34>>*/ ;
     /*<<float.ml:121:34>>*/ }
    function pred(x){
      /*<<float.ml:122:13>>*/ return  /*<<float.ml:122:13>>*/ caml_nextafter_float
-            (x, neg_infinity);
+            (x, neg_infinity) /*<<float.ml:122:38>>*/ ;
     /*<<float.ml:122:38>>*/ }
    function equal(x, y){
      /*<<float.ml:136:16>>*/ return 0 === caml_float_compare(x, y) ? 1 : 0;
@@ -8187,9 +8314,9 @@
         /*<<float.ml:139:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:139:34>>*/ caml_signbit_float(x))
       break a;
-      /*<<float.ml:141:10>>*/ return x != x ? x : y;
+      /*<<float.ml:141:10>>*/ return x != x ? x : y /*<<float.ml:141:32>>*/ ;
     }
-     /*<<float.ml:140:7>>*/ return y != y ? y : x;
+     /*<<float.ml:140:7>>*/ return y != y ? y : x /*<<float.ml:141:32>>*/ ;
     /*<<float.ml:141:32>>*/ }
    function max(x, y){
      /*<<float.ml:144:2>>*/ a:
@@ -8199,9 +8326,9 @@
         /*<<float.ml:144:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:144:34>>*/ caml_signbit_float(x))
       break a;
-      /*<<float.ml:146:10>>*/ return y != y ? y : x;
+      /*<<float.ml:146:10>>*/ return y != y ? y : x /*<<float.ml:146:32>>*/ ;
     }
-     /*<<float.ml:145:7>>*/ return x != x ? x : y;
+     /*<<float.ml:145:7>>*/ return x != x ? x : y /*<<float.ml:146:32>>*/ ;
     /*<<float.ml:146:32>>*/ }
    function min_max(x, y){
      /*<<float.ml:149:2>>*/ if(x == x && y == y){
@@ -8212,11 +8339,11 @@
          /*<<float.ml:150:23>>*/ caml_signbit_float(y)
         &&  /*<<float.ml:150:39>>*/ caml_signbit_float(x))
        break a;
-       /*<<float.ml:150:68>>*/ return [0, y, x];
+       /*<<float.ml:150:68>>*/ return [0, y, x] /*<<float.ml:150:68>>*/ ;
      }
-      /*<<float.ml:150:56>>*/ return [0, x, y];
+      /*<<float.ml:150:56>>*/ return [0, x, y] /*<<float.ml:150:56>>*/ ;
     }
-     /*<<float.ml:149:31>>*/ return [0, nan, nan];
+     /*<<float.ml:149:31>>*/ return [0, nan, nan] /*<<float.ml:149:31>>*/ ;
     /*<<float.ml:150:74>>*/ }
    function min_num(x, y){
      /*<<float.ml:153:2>>*/ a:
@@ -8226,9 +8353,9 @@
         /*<<float.ml:153:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:153:34>>*/ caml_signbit_float(x))
       break a;
-      /*<<float.ml:155:10>>*/ return y != y ? x : y;
+      /*<<float.ml:155:10>>*/ return y != y ? x : y /*<<float.ml:155:32>>*/ ;
     }
-     /*<<float.ml:154:7>>*/ return x != x ? y : x;
+     /*<<float.ml:154:7>>*/ return x != x ? y : x /*<<float.ml:155:32>>*/ ;
     /*<<float.ml:155:32>>*/ }
    function max_num(x, y){
      /*<<float.ml:158:2>>*/ a:
@@ -8238,15 +8365,15 @@
         /*<<float.ml:158:18>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:158:34>>*/ caml_signbit_float(x))
       break a;
-      /*<<float.ml:160:10>>*/ return x != x ? y : x;
+      /*<<float.ml:160:10>>*/ return x != x ? y : x /*<<float.ml:160:32>>*/ ;
     }
-     /*<<float.ml:159:7>>*/ return y != y ? x : y;
+     /*<<float.ml:159:7>>*/ return y != y ? x : y /*<<float.ml:160:32>>*/ ;
     /*<<float.ml:160:32>>*/ }
    function min_max_num(x, y){
      /*<<float.ml:163:2>>*/ if(x != x)
-      /*<<float.ml:163:19>>*/ return [0, y, y];
+      /*<<float.ml:163:19>>*/ return [0, y, y] /*<<float.ml:163:19>>*/ ;
      /*<<float.ml:164:10>>*/ if(y != y)
-      /*<<float.ml:164:24>>*/ return [0, x, x];
+      /*<<float.ml:164:24>>*/ return [0, x, x] /*<<float.ml:164:24>>*/ ;
     a:
     if(! (x < y)){
       /*<<float.ml:165:23>>*/ if
@@ -8254,17 +8381,17 @@
         /*<<float.ml:165:23>>*/ caml_signbit_float(y)
        &&  /*<<float.ml:165:39>>*/ caml_signbit_float(x))
       break a;
-      /*<<float.ml:165:67>>*/ return [0, y, x];
+      /*<<float.ml:165:67>>*/ return [0, y, x] /*<<float.ml:165:67>>*/ ;
     }
-     /*<<float.ml:165:56>>*/ return [0, x, y];
+     /*<<float.ml:165:56>>*/ return [0, x, y] /*<<float.ml:165:56>>*/ ;
     /*<<float.ml:165:72>>*/ }
    function seeded_hash(seed, x){
      /*<<float.ml:169:25>>*/ return  /*<<float.ml:169:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<float.ml:169:56>>*/ ;
     /*<<float.ml:169:56>>*/ }
    function hash(x){
      /*<<float.ml:170:13>>*/ return  /*<<float.ml:170:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<float.ml:170:41>>*/ ;
     /*<<float.ml:170:41>>*/ }
    function unsafe_fill(a, ofs, len, v){
      /*<<float.ml:184:4>>*/ var _aV_ = (ofs + len | 0) - 1 | 0;
@@ -8292,18 +8419,18 @@
        _aU_ = (ofs + len | 0) < 0 ? 1 : 0,
        _aS_ = _aU_ || (a.length - 1 < (ofs + len | 0) ? 1 : 0);
     }
-    return _aS_ ?  /*<<float.ml:191:6>>*/ caml_call1(Stdlib[1], msg) : _aS_;
+    return _aS_ ?  /*<<float.ml:191:6>>*/ caml_call1(Stdlib[1], msg) : _aS_ /*<<float.ml:191:21>>*/ ;
     /*<<float.ml:191:21>>*/ }
    function make(n, v){
      /*<<float.ml:194:4>>*/  /*<<float.ml:194:17>>*/ var
      result =  /*<<float.ml:194:17>>*/ caml_floatarray_create(n);
      /*<<float.ml:195:4>>*/ unsafe_fill(result, 0, n, v);
-     /*<<float.ml:195:4>>*/ return result;
+     /*<<float.ml:195:4>>*/ return result /*<<float.ml:195:4>>*/ ;
     /*<<float.ml:196:10>>*/ }
    function init(l, f){
      /*<<float.ml:199:4>>*/ if(0 > l)
       /*<<float.ml:199:18>>*/ return  /*<<float.ml:199:18>>*/ caml_call1
-             (Stdlib[1], cst_Float_Array_init);
+             (Stdlib[1], cst_Float_Array_init) /*<<float.ml:205:9>>*/ ;
      /*<<float.ml:201:16>>*/ var
       /*<<float.ml:201:16>>*/ res =
         /*<<float.ml:201:16>>*/ caml_floatarray_create(l),
@@ -8319,7 +8446,7 @@
       i = _aQ_;
      }
     }
-     /*<<float.ml:205:6>>*/ return res;
+     /*<<float.ml:205:6>>*/ return res /*<<float.ml:205:6>>*/ ;
     /*<<float.ml:205:9>>*/ }
    function make_matrix(sx, sy, v){
      /*<<float.ml:209:4>>*/ if(sy < 0)
@@ -8343,7 +8470,7 @@
       }
      }
     }
-     /*<<float.ml:216:4>>*/ return res;
+     /*<<float.ml:216:4>>*/ return res /*<<float.ml:216:4>>*/ ;
     /*<<float.ml:216:7>>*/ }
    function init_matrix(sx, sy, f){
      /*<<float.ml:220:4>>*/ if(sy < 0)
@@ -8383,7 +8510,7 @@
       }
      }
     }
-     /*<<float.ml:231:4>>*/ return res;
+     /*<<float.ml:231:4>>*/ return res /*<<float.ml:231:4>>*/ ;
     /*<<float.ml:231:7>>*/ }
    function append(a1, a2){
      /*<<float.ml:234:4>>*/ var
@@ -8395,7 +8522,7 @@
      (a1, 0, result, 0, l1);
      /*<<float.ml:238:4>>*/  /*<<float.ml:238:4>>*/ caml_floatarray_blit
      (a2, 0, result, l1, l2);
-     /*<<float.ml:238:4>>*/ return result;
+     /*<<float.ml:238:4>>*/ return result /*<<float.ml:238:4>>*/ ;
     /*<<float.ml:239:10>>*/ }
    function concat(l){
      /*<<float.ml:250:4>>*/ var acc = 0, param = l;
@@ -8420,7 +8547,8 @@
      i = 0;
      /*<<float.ml:253:6>>*/ for(;;){
      if(! l$0){
-      if(i === acc)  /*<<float.ml:260:4>>*/ return result;
+      if(i === acc)
+        /*<<float.ml:260:4>>*/ return result /*<<float.ml:260:4>>*/ ;
        /*<<float.ml:254:14>>*/ throw  /*<<float.ml:254:14>>*/ caml_maybe_attach_backtrace
              ([0, Assert_failure, _a_], 1);
      }
@@ -8441,7 +8569,7 @@
      result =  /*<<float.ml:265:17>>*/ caml_floatarray_create(len);
      /*<<float.ml:266:4>>*/  /*<<float.ml:266:4>>*/ caml_floatarray_blit
      (a, ofs, result, 0, len);
-     /*<<float.ml:266:4>>*/ return result;
+     /*<<float.ml:266:4>>*/ return result /*<<float.ml:266:4>>*/ ;
     /*<<float.ml:267:10>>*/ }
    function copy(a){
      /*<<float.ml:270:4>>*/ var
@@ -8450,23 +8578,23 @@
         /*<<float.ml:271:17>>*/ caml_floatarray_create(l);
      /*<<float.ml:272:4>>*/  /*<<float.ml:272:4>>*/ caml_floatarray_blit
      (a, 0, result, 0, l);
-     /*<<float.ml:272:4>>*/ return result;
+     /*<<float.ml:272:4>>*/ return result /*<<float.ml:272:4>>*/ ;
     /*<<float.ml:273:10>>*/ }
    function fill(a, ofs, len, v){
      /*<<float.ml:276:4>>*/ check(a, ofs, len, cst_Float_Array_fill);
-     /*<<float.ml:276:4>>*/ return unsafe_fill(a, ofs, len, v);
+     /*<<float.ml:276:4>>*/ return unsafe_fill(a, ofs, len, v) /*<<float.ml:277:27>>*/ ;
     /*<<float.ml:277:27>>*/ }
    function blit(src, sofs, dst, dofs, len){
      /*<<float.ml:280:4>>*/ check(src, sofs, len, cst_Float_array_blit);
      /*<<float.ml:281:4>>*/ check(dst, dofs, len, cst_Float_array_blit$0);
      /*<<float.ml:282:4>>*/ return  /*<<float.ml:282:4>>*/ caml_floatarray_blit
-            (src, sofs, dst, dofs, len);
+            (src, sofs, dst, dofs, len) /*<<float.ml:282:37>>*/ ;
     /*<<float.ml:282:37>>*/ }
    function to_list(a){
      /*<<float.ml:285:4>>*/ return  /*<<float.ml:285:25>>*/ caml_call2
             (Stdlib_List[11],
              a.length - 1,
-             function(_aE_){ /*<<?>>*/ return a[1 + _aE_];});
+             function(_aE_){ /*<<?>>*/ return a[1 + _aE_];}) /*<<float.ml:285:39>>*/ ;
     /*<<float.ml:285:39>>*/ }
    function of_list(l){
      /*<<float.ml:288:4>>*/ var
@@ -8476,7 +8604,7 @@
      i = 0,
      l$0 = l;
      /*<<float.ml:290:6>>*/ for(;;){
-     if(! l$0)  /*<<float.ml:289:4>>*/ return result;
+     if(! l$0)  /*<<float.ml:289:4>>*/ return result /*<<float.ml:289:4>>*/ ;
      var t = l$0[2], h = l$0[1];
       /*<<float.ml:292:18>>*/ result[1 + i] = h;
       /*<<float.ml:289:4>>*/  /*<<float.ml:289:4>>*/ var i$0 = i + 1 | 0;
@@ -8503,7 +8631,7 @@
    function iter2(f, a, b){
      /*<<float.ml:302:4>>*/ if(a.length - 1 !== b.length - 1)
       /*<<float.ml:303:6>>*/ return  /*<<float.ml:303:6>>*/ caml_call1
-             (Stdlib[1], cst_Float_Array_iter2_arrays_m);
+             (Stdlib[1], cst_Float_Array_iter2_arrays_m) /*<<float.ml:305:75>>*/ ;
      /*<<float.ml:305:6>>*/ var
      _az_ = a.length - 2 | 0,
       /*<<float.ml:305:6>>*/ _ay_ = 0;
@@ -8536,7 +8664,7 @@
       i = _ax_;
      }
     }
-     /*<<float.ml:313:4>>*/ return r;
+     /*<<float.ml:313:4>>*/ return r /*<<float.ml:313:4>>*/ ;
     /*<<float.ml:313:5>>*/ }
    function map_inplace(f, a){
      /*<<float.ml:317:4>>*/ var
@@ -8560,7 +8688,7 @@
       /*<<float.ml:323:4>>*/ lb = b.length - 1;
     if(la !== lb)
       /*<<float.ml:325:6>>*/ return  /*<<float.ml:325:6>>*/ caml_call1
-             (Stdlib[1], cst_Float_Array_map2_arrays_mu);
+             (Stdlib[1], cst_Float_Array_map2_arrays_mu) /*<<float.ml:332:7>>*/ ;
      /*<<float.ml:327:14>>*/ var
       /*<<float.ml:327:14>>*/ r =
         /*<<float.ml:327:14>>*/ caml_floatarray_create(la),
@@ -8576,7 +8704,7 @@
       i = _ar_;
      }
     }
-     /*<<float.ml:331:6>>*/ return r;
+     /*<<float.ml:331:6>>*/ return r /*<<float.ml:331:6>>*/ ;
     /*<<float.ml:332:7>>*/ }
    function iteri(f, a){
      /*<<float.ml:336:4>>*/ var
@@ -8611,7 +8739,7 @@
       i = _al_;
      }
     }
-     /*<<float.ml:344:4>>*/ return r;
+     /*<<float.ml:344:4>>*/ return r /*<<float.ml:344:4>>*/ ;
     /*<<float.ml:344:5>>*/ }
    function mapi_inplace(f, a){
      /*<<float.ml:348:4>>*/ var
@@ -8663,10 +8791,10 @@
    function exists(p, a){
      /*<<float.ml:370:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:372:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:372:20>>*/ return 0;
+     if(i === n)  /*<<float.ml:372:20>>*/ return 0 /*<<float.ml:372:20>>*/ ;
       /*<<float.ml:373:14>>*/ if
       ( /*<<float.ml:373:14>>*/ caml_call1(p, a[1 + i]))
-       /*<<float.ml:373:38>>*/ return 1;
+       /*<<float.ml:373:38>>*/ return 1 /*<<float.ml:373:38>>*/ ;
       /*<<float.ml:374:11>>*/  /*<<float.ml:374:11>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8674,10 +8802,10 @@
    function for_all(p, a){
      /*<<float.ml:379:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:381:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:381:20>>*/ return 1;
+     if(i === n)  /*<<float.ml:381:20>>*/ return 1 /*<<float.ml:381:20>>*/ ;
       /*<<float.ml:382:14>>*/ if
       (!  /*<<float.ml:382:14>>*/ caml_call1(p, a[1 + i]))
-       /*<<float.ml:383:11>>*/ return 0;
+       /*<<float.ml:383:11>>*/ return 0 /*<<float.ml:383:11>>*/ ;
       /*<<float.ml:382:38>>*/  /*<<float.ml:382:38>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8685,9 +8813,9 @@
    function mem(x, a){
      /*<<float.ml:388:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:390:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:390:20>>*/ return 0;
+     if(i === n)  /*<<float.ml:390:20>>*/ return 0 /*<<float.ml:390:20>>*/ ;
      if(0 ===  /*<<float.ml:391:22>>*/ caml_float_compare(a[1 + i], x))
-       /*<<float.ml:391:50>>*/ return 1;
+       /*<<float.ml:391:50>>*/ return 1 /*<<float.ml:391:50>>*/ ;
       /*<<float.ml:392:11>>*/  /*<<float.ml:392:11>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8695,8 +8823,9 @@
    function mem_ieee(x, a){
      /*<<float.ml:398:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:400:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:400:20>>*/ return 0;
-     if(x == a[1 + i])  /*<<float.ml:401:40>>*/ return 1;
+     if(i === n)  /*<<float.ml:400:20>>*/ return 0 /*<<float.ml:400:20>>*/ ;
+     if(x == a[1 + i])
+       /*<<float.ml:401:40>>*/ return 1 /*<<float.ml:401:40>>*/ ;
       /*<<float.ml:402:11>>*/  /*<<float.ml:402:11>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8704,10 +8833,10 @@
    function find_opt(p, a){
      /*<<float.ml:408:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:410:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:410:20>>*/ return 0;
+     if(i === n)  /*<<float.ml:410:20>>*/ return 0 /*<<float.ml:410:20>>*/ ;
       /*<<float.ml:412:16>>*/  /*<<float.ml:412:16>>*/ var x = a[1 + i];
       /*<<float.ml:413:11>>*/ if( /*<<float.ml:413:11>>*/ caml_call1(p, x))
-       /*<<float.ml:413:20>>*/ return [0, x];
+       /*<<float.ml:413:20>>*/ return [0, x] /*<<float.ml:413:20>>*/ ;
       /*<<float.ml:414:13>>*/  /*<<float.ml:414:13>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8715,10 +8844,10 @@
    function find_index(p, a){
      /*<<float.ml:420:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:422:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:422:20>>*/ return 0;
+     if(i === n)  /*<<float.ml:422:20>>*/ return 0 /*<<float.ml:422:20>>*/ ;
       /*<<float.ml:423:14>>*/ if
       ( /*<<float.ml:423:14>>*/ caml_call1(p, a[1 + i]))
-       /*<<float.ml:423:38>>*/ return [0, i];
+       /*<<float.ml:423:38>>*/ return [0, i] /*<<float.ml:423:38>>*/ ;
       /*<<float.ml:424:11>>*/  /*<<float.ml:424:11>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8726,10 +8855,10 @@
    function find_map(f, a){
      /*<<float.ml:429:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:431:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:431:20>>*/ return 0;
+     if(i === n)  /*<<float.ml:431:20>>*/ return 0 /*<<float.ml:431:20>>*/ ;
       /*<<float.ml:433:14>>*/  /*<<float.ml:433:14>>*/ var
       r =  /*<<float.ml:433:14>>*/ caml_call1(f, a[1 + i]);
-     if(r)  /*<<float.ml:435:25>>*/ return r;
+     if(r)  /*<<float.ml:435:25>>*/ return r /*<<float.ml:435:25>>*/ ;
       /*<<float.ml:434:18>>*/  /*<<float.ml:434:18>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8737,10 +8866,10 @@
    function find_mapi(f, a){
      /*<<float.ml:441:4>>*/ var n = a.length - 1, i = 0;
      /*<<float.ml:443:6>>*/ for(;;){
-     if(i === n)  /*<<float.ml:443:20>>*/ return 0;
+     if(i === n)  /*<<float.ml:443:20>>*/ return 0 /*<<float.ml:443:20>>*/ ;
       /*<<float.ml:445:14>>*/  /*<<float.ml:445:14>>*/ var
       r =  /*<<float.ml:445:14>>*/ caml_call2(f, i, a[1 + i]);
-     if(r)  /*<<float.ml:447:25>>*/ return r;
+     if(r)  /*<<float.ml:447:25>>*/ return r /*<<float.ml:447:25>>*/ ;
       /*<<float.ml:446:18>>*/  /*<<float.ml:446:18>>*/ var i$0 = i + 1 | 0;
      i = i$0;
     }
@@ -8783,9 +8912,9 @@
         >
           /*<<float.ml:462:24>>*/ caml_call2
           (cmp, caml_check_bound(a, i31)[1 + i31], _aa_))
-        /*<<float.ml:463:13>>*/ return i31 + 1 | 0;
+        /*<<float.ml:463:13>>*/ return i31 + 1 | 0 /*<<float.ml:463:13>>*/ ;
      }
-     if(i31 < l)  /*<<float.ml:464:29>>*/ return i31;
+     if(i31 < l)  /*<<float.ml:464:29>>*/ return i31 /*<<float.ml:464:29>>*/ ;
       /*<<float.ml:464:38>>*/ throw  /*<<float.ml:464:38>>*/ caml_maybe_attach_backtrace
             ([0, Bottom, i], 1);
      /*<<float.ml:464:54>>*/ }
@@ -8889,7 +9018,7 @@
     }
     else
      var _T_ = _S_;
-     /*<<float.ml:499:59>>*/ return _T_;
+     /*<<float.ml:499:59>>*/ return _T_ /*<<float.ml:499:59>>*/ ;
     /*<<float.ml:499:69>>*/ }
    function stable_sort(cmp, a){
     function merge(src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs){
@@ -8911,7 +9040,8 @@
         /*<<float.ml:515:10>>*/ caml_check_bound(dst, d)[1 + d] = s2;
         /*<<float.ml:515:10>>*/  /*<<float.ml:515:10>>*/ var
         i2$0 = i2 + 1 | 0;
-       if(i2$0 >= src2r) return blit(a, i1, dst, d + 1 | 0, src1r - i1 | 0);
+       if(i2$0 >= src2r)
+        return blit(a, i1, dst, d + 1 | 0, src1r - i1 | 0) /*<<float.ml:522:72>>*/ ;
         /*<<float.ml:518:12>>*/ var
          /*<<float.ml:518:12>>*/ d$0 = d + 1 | 0,
          /*<<float.ml:518:26>>*/ s2$0 = caml_check_bound(src2, i2$0)[1 + i2$0];
@@ -8924,7 +9054,7 @@
         /*<<float.ml:508:10>>*/  /*<<float.ml:508:10>>*/ var
         i1$0 = i1 + 1 | 0;
        if(i1$0 >= src1r)
-        return blit(src2, i2, dst, d + 1 | 0, src2r - i2 | 0);
+        return blit(src2, i2, dst, d + 1 | 0, src2r - i2 | 0) /*<<float.ml:522:72>>*/ ;
         /*<<float.ml:511:12>>*/ var
          /*<<float.ml:511:12>>*/ d$1 = d + 1 | 0,
          /*<<float.ml:511:20>>*/ s1$0 = caml_check_bound(a, i1$0)[1 + i1$0];
@@ -8971,15 +9101,16 @@
      /*<<float.ml:533:10>>*/ }
     function sortto(srcofs, dst, dstofs, len){
       /*<<float.ml:536:6>>*/ if(len <= 5)
-       /*<<float.ml:536:28>>*/ return isortto(srcofs, dst, dstofs, len);
+       /*<<float.ml:536:28>>*/ return isortto(srcofs, dst, dstofs, len) /*<<float.ml:542:9>>*/ ;
      var l1 = len / 2 | 0, l2 = len - l1 | 0;
       /*<<float.ml:539:8>>*/ sortto(srcofs + l1 | 0, dst, dstofs + l1 | 0, l2);
       /*<<float.ml:540:8>>*/ sortto(srcofs, a, srcofs + l2 | 0, l1);
       /*<<float.ml:540:8>>*/ return merge
-             (srcofs + l2 | 0, l1, dst, dstofs + l1 | 0, l2, dst, dstofs);
+             (srcofs + l2 | 0, l1, dst, dstofs + l1 | 0, l2, dst, dstofs) /*<<float.ml:542:9>>*/ ;
      /*<<float.ml:542:9>>*/ }
     var l = a.length - 1;
-    if(l <= 5)  /*<<float.ml:545:24>>*/ return isortto(0, a, 0, l);
+    if(l <= 5)
+      /*<<float.ml:545:24>>*/ return isortto(0, a, 0, l) /*<<float.ml:552:7>>*/ ;
      /*<<float.ml:548:14>>*/ var
      l1 = l / 2 | 0,
      l2 = l - l1 | 0,
@@ -8987,7 +9118,7 @@
         /*<<float.ml:548:14>>*/ caml_floatarray_create(l2);
      /*<<float.ml:549:6>>*/ sortto(l1, t, 0, l2);
      /*<<float.ml:550:6>>*/ sortto(0, a, l2, l1);
-     /*<<float.ml:550:6>>*/ return merge(l2, l1, t, 0, l2, a, 0);
+     /*<<float.ml:550:6>>*/ return merge(l2, l1, t, 0, l2, a, 0) /*<<float.ml:552:7>>*/ ;
     /*<<float.ml:552:7>>*/ }
    function shuffle(rand, a){
      /*<<float.ml:558:4>>*/ var _C_ = a.length - 2 | 0;
@@ -9010,32 +9141,32 @@
    function to_seq(a){
     function aux(i, param){
       /*<<float.ml:568:6>>*/ if(i >= a.length - 1)
-       /*<<float.ml:572:11>>*/ return 0;
+       /*<<float.ml:572:11>>*/ return 0 /*<<float.ml:572:11>>*/ ;
       /*<<float.ml:570:16>>*/ var
        /*<<float.ml:570:16>>*/ x = a[1 + i],
        /*<<float.ml:570:16>>*/ _A_ = i + 1 | 0;
       /*<<float.ml:571:8>>*/ return [0,
              x,
-             function(_B_){ /*<<?>>*/ return aux(_A_, _B_);}];
+             function(_B_){ /*<<?>>*/ return aux(_A_, _B_);}] /*<<float.ml:571:8>>*/ ;
      /*<<float.ml:572:18>>*/ }
      /*<<float.ml:574:4>>*/ var _y_ = 0;
      /*<<float.ml:574:4>>*/ return function(_z_){
-      /*<<?>>*/ return aux(_y_, _z_);};
+      /*<<?>>*/ return aux(_y_, _z_);} /*<<float.ml:574:4>>*/ ;
     /*<<float.ml:574:9>>*/ }
    function to_seqi(a){
     function aux(i, param){
       /*<<float.ml:579:6>>*/ if(i >= a.length - 1)
-       /*<<float.ml:583:11>>*/ return 0;
+       /*<<float.ml:583:11>>*/ return 0 /*<<float.ml:583:11>>*/ ;
       /*<<float.ml:581:16>>*/ var
        /*<<float.ml:581:16>>*/ x = a[1 + i],
        /*<<float.ml:581:16>>*/ _w_ = i + 1 | 0;
       /*<<float.ml:582:8>>*/ return [0,
              [0, i, x],
-             function(_x_){ /*<<?>>*/ return aux(_w_, _x_);}];
+             function(_x_){ /*<<?>>*/ return aux(_w_, _x_);}] /*<<float.ml:582:8>>*/ ;
      /*<<float.ml:583:18>>*/ }
      /*<<float.ml:585:4>>*/ var _u_ = 0;
      /*<<float.ml:585:4>>*/ return function(_v_){
-      /*<<?>>*/ return aux(_u_, _v_);};
+      /*<<?>>*/ return aux(_u_, _v_);} /*<<float.ml:585:4>>*/ ;
     /*<<float.ml:585:9>>*/ }
    function of_seq(i$2){
      /*<<float.ml:599:4>>*/ var
@@ -9043,7 +9174,7 @@
         /*<<float.ml:599:12>>*/ caml_call3
         (Stdlib_Seq[5],
          function(acc, x){
-           /*<<float.ml:599:40>>*/ return [0, x, acc];
+           /*<<float.ml:599:40>>*/ return [0, x, acc] /*<<float.ml:599:40>>*/ ;
           /*<<float.ml:599:46>>*/ },
          0,
          i$2),
@@ -9055,7 +9186,7 @@
      i = i$1,
      param = l;
     for(;;){
-     if(! param)  /*<<float.ml:591:4>>*/ return a;
+     if(! param)  /*<<float.ml:591:4>>*/ return a /*<<float.ml:591:4>>*/ ;
      var tl = param[2], hd = param[1];
       /*<<float.ml:593:18>>*/ a[1 + i] = hd;
       /*<<float.ml:591:4>>*/  /*<<float.ml:591:4>>*/ var i$0 = i - 1 | 0;
@@ -9065,7 +9196,8 @@
     /*<<float.ml:600:17>>*/ }
    function map_to_array(f, a){
      /*<<float.ml:604:4>>*/ var l = a.length - 1;
-     /*<<float.ml:605:4>>*/ if(0 === l)  /*<<float.ml:605:18>>*/ return [0];
+     /*<<float.ml:605:4>>*/ if(0 === l)
+      /*<<float.ml:605:18>>*/ return [0] /*<<float.ml:605:18>>*/ ;
      /*<<float.ml:606:14>>*/ var
       /*<<float.ml:606:14>>*/ r =
         /*<<float.ml:606:14>>*/ caml_make_vect
@@ -9082,7 +9214,7 @@
       i = _t_;
      }
     }
-     /*<<float.ml:610:6>>*/ return r;
+     /*<<float.ml:610:6>>*/ return r /*<<float.ml:610:6>>*/ ;
     /*<<float.ml:611:7>>*/ }
    function map_from_array(f, a){
      /*<<float.ml:614:4>>*/ var
@@ -9101,7 +9233,7 @@
       i = _q_;
      }
     }
-     /*<<float.ml:619:4>>*/ return r;
+     /*<<float.ml:619:4>>*/ return r /*<<float.ml:619:4>>*/ ;
     /*<<float.ml:619:5>>*/ }
    var
     Stdlib_Float =
@@ -9261,19 +9393,19 @@
     zero = 0,
     one = 1;
    function succ(n){
-     /*<<int32.ml:48:13>>*/ return n + 1 | 0;
+     /*<<int32.ml:48:13>>*/ return n + 1 | 0 /*<<int32.ml:48:13>>*/ ;
     /*<<int32.ml:48:21>>*/ }
    function pred(n){
-     /*<<int32.ml:49:13>>*/ return n - 1 | 0;
+     /*<<int32.ml:49:13>>*/ return n - 1 | 0 /*<<int32.ml:49:13>>*/ ;
     /*<<int32.ml:49:21>>*/ }
    function abs(n){
      /*<<int32.ml:50:12>>*/ return  /*<<int32.ml:50:15>>*/ caml_greaterequal
              (n, 0)
             ? n
-            : - n | 0;
+            : - n | 0 /*<<int32.ml:50:40>>*/ ;
     /*<<int32.ml:50:40>>*/ }
    function lognot(n){
-     /*<<int32.ml:53:15>>*/ return n ^ -1;
+     /*<<int32.ml:53:15>>*/ return n ^ -1 /*<<int32.ml:53:15>>*/ ;
     /*<<int32.ml:53:29>>*/ }
    var
     _a_ = Stdlib_Sys[9],
@@ -9289,8 +9421,8 @@
          /*<<int32.ml:60:8>>*/ if
          ( /*<<int32.ml:60:11>>*/ caml_greaterequal(n, 0)
           &&  /*<<int32.ml:60:22>>*/ caml_lessequal(n, max_int$0))
-          /*<<int32.ml:61:10>>*/ return [0, n];
-         /*<<int32.ml:63:10>>*/ return 0;
+          /*<<int32.ml:61:10>>*/ return [0, n] /*<<int32.ml:61:10>>*/ ;
+         /*<<int32.ml:63:10>>*/ return 0 /*<<int32.ml:63:10>>*/ ;
         /*<<int32.ml:63:14>>*/ };
    else{
     if(64 !== _a_)
@@ -9299,22 +9431,23 @@
     var
      unsigned_to_int =
        function(n){
-         /*<<int32.ml:67:15>>*/ return [0, n & -1];
+         /*<<int32.ml:67:15>>*/ return [0, n & -1] /*<<int32.ml:67:15>>*/ ;
         /*<<int32.ml:67:40>>*/ };
    }
    function to_string(n){
      /*<<int32.ml:72:18>>*/ return  /*<<int32.ml:72:18>>*/ runtime.caml_format_int
-            ("%d", n);
+            ("%d", n) /*<<int32.ml:72:31>>*/ ;
     /*<<int32.ml:72:31>>*/ }
    function of_string_opt(s){
      /*<<int32.ml:77:2>>*/ try{
       /*<<int32.ml:77:6>>*/  /*<<int32.ml:77:6>>*/ var
       _d_ = [0,  /*<<int32.ml:77:11>>*/ runtime.caml_int_of_string(s)];
-      /*<<int32.ml:77:6>>*/ return _d_;
+      /*<<int32.ml:77:6>>*/ return _d_ /*<<int32.ml:77:6>>*/ ;
     }
     catch(_e_){
      var _c_ = caml_wrap_exception(_e_);
-     if(_c_[1] === Stdlib[7])  /*<<int32.ml:78:20>>*/ return 0;
+     if(_c_[1] === Stdlib[7])
+       /*<<int32.ml:78:20>>*/ return 0 /*<<int32.ml:78:20>>*/ ;
      throw caml_maybe_attach_backtrace(_c_, 0);
     }
     /*<<int32.ml:78:24>>*/ }
@@ -9324,46 +9457,46 @@
       /*<<int32.ml:86:26>>*/ y = m + 2147483648 | 0,
       /*<<int32.ml:86:10>>*/ x = n + 2147483648 | 0;
      /*<<int32.ml:82:28>>*/ return  /*<<int32.ml:82:28>>*/ caml_int_compare
-            (x, y);
+            (x, y) /*<<int32.ml:86:41>>*/ ;
     /*<<int32.ml:86:41>>*/ }
    function unsigned_lt(n, m){
      /*<<int32.ml:89:2>>*/ return  /*<<int32.ml:89:2>>*/ caml_lessthan
-            (n + 2147483648 | 0, m + 2147483648 | 0);
+            (n + 2147483648 | 0, m + 2147483648 | 0) /*<<int32.ml:89:31>>*/ ;
     /*<<int32.ml:89:31>>*/ }
    function min(x, y){
      /*<<int32.ml:91:18>>*/ return  /*<<int32.ml:91:21>>*/ caml_lessequal
              (x, y)
             ? x
-            : y;
+            : y /*<<int32.ml:91:41>>*/ ;
     /*<<int32.ml:91:41>>*/ }
    function max(x, y){
      /*<<int32.ml:92:18>>*/ return  /*<<int32.ml:92:21>>*/ caml_greaterequal
              (x, y)
             ? x
-            : y;
+            : y /*<<int32.ml:92:41>>*/ ;
     /*<<int32.ml:92:41>>*/ }
    function unsigned_div(n, d){
      /*<<int32.ml:98:2>>*/ if( /*<<int32.ml:98:5>>*/ caml_lessthan(d, 0))
-      /*<<int32.ml:99:7>>*/ return unsigned_lt(n, d) ? zero : one;
+      /*<<int32.ml:99:7>>*/ return unsigned_lt(n, d) ? zero : one /*<<int32.ml:103:41>>*/ ;
      /*<<int32.ml:101:12>>*/ var
       /*<<int32.ml:101:12>>*/ q =
         /*<<int32.ml:101:23>>*/ runtime.caml_div(n >>> 1 | 0, d) << 1,
       /*<<int32.ml:102:12>>*/ r =
        n -  /*<<int32.ml:102:18>>*/ caml_mul(q, d) | 0;
-     /*<<int32.ml:103:7>>*/ return unsigned_lt(r, d) ? q : q + 1 | 0;
+     /*<<int32.ml:103:7>>*/ return unsigned_lt(r, d) ? q : q + 1 | 0 /*<<int32.ml:103:41>>*/ ;
     /*<<int32.ml:103:41>>*/ }
    function unsigned_rem(n, d){
      /*<<int32.ml:106:2>>*/ return n
            -  /*<<int32.ml:106:8>>*/ caml_mul(unsigned_div(n, d), d)
-           | 0;
+           | 0 /*<<int32.ml:106:2>>*/ ;
     /*<<int32.ml:106:34>>*/ }
    function seeded_hash(seed, x){
      /*<<int32.ml:110:25>>*/ return  /*<<int32.ml:110:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<int32.ml:110:56>>*/ ;
     /*<<int32.ml:110:56>>*/ }
    function hash(x){
      /*<<int32.ml:111:13>>*/ return  /*<<int32.ml:111:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<int32.ml:111:41>>*/ ;
     /*<<int32.ml:111:41>>*/ }
    var
     Stdlib_Int32 =
@@ -9424,21 +9557,21 @@
     _d_ = runtime.caml_int64_create_lo_mi_hi(16777215, 16777215, 65535);
    function succ(n){
      /*<<int64.ml:46:13>>*/ return  /*<<int64.ml:46:13>>*/ caml_int64_add
-            (n, _a_);
+            (n, _a_) /*<<int64.ml:46:21>>*/ ;
     /*<<int64.ml:46:21>>*/ }
    function pred(n){
      /*<<int64.ml:47:13>>*/ return  /*<<int64.ml:47:13>>*/ caml_int64_sub
-            (n, _b_);
+            (n, _b_) /*<<int64.ml:47:21>>*/ ;
     /*<<int64.ml:47:21>>*/ }
    function abs(n){
      /*<<int64.ml:48:12>>*/ return  /*<<int64.ml:48:15>>*/ caml_greaterequal
              (n, _c_)
             ? n
-            :  /*<<int64.ml:48:35>>*/ runtime.caml_int64_neg(n);
+            :  /*<<int64.ml:48:35>>*/ runtime.caml_int64_neg(n) /*<<int64.ml:48:40>>*/ ;
     /*<<int64.ml:48:40>>*/ }
    function lognot(n){
      /*<<int64.ml:51:15>>*/ return  /*<<int64.ml:51:15>>*/ runtime.caml_int64_xor
-            (n, _d_);
+            (n, _d_) /*<<int64.ml:51:29>>*/ ;
     /*<<int64.ml:51:29>>*/ }
     /*<<int64.ml:54:16>>*/ var
      /*<<int64.ml:54:16>>*/ max_int$0 =
@@ -9448,28 +9581,29 @@
      /*<<int64.ml:56:4>>*/ if
      ( /*<<int64.ml:56:7>>*/ caml_greaterequal(n, _e_)
       &&  /*<<int64.ml:56:18>>*/ caml_lessequal(n, max_int$0))
-      /*<<int64.ml:57:6>>*/ return [0, runtime.caml_int64_to_int32(n)];
-     /*<<int64.ml:59:6>>*/ return 0;
+      /*<<int64.ml:57:6>>*/ return [0, runtime.caml_int64_to_int32(n)] /*<<int64.ml:57:6>>*/ ;
+     /*<<int64.ml:59:6>>*/ return 0 /*<<int64.ml:59:6>>*/ ;
     /*<<int64.ml:59:10>>*/ }
    function to_string(n){
      /*<<int64.ml:62:18>>*/ return  /*<<int64.ml:62:18>>*/ runtime.caml_int64_format
-            ("%d", n);
+            ("%d", n) /*<<int64.ml:62:31>>*/ ;
     /*<<int64.ml:62:31>>*/ }
    function of_string_opt(s){
      /*<<int64.ml:67:2>>*/ try{
       /*<<int64.ml:67:6>>*/  /*<<int64.ml:67:6>>*/ var
       _g_ = [0,  /*<<int64.ml:67:11>>*/ runtime.caml_int64_of_string(s)];
-      /*<<int64.ml:67:6>>*/ return _g_;
+      /*<<int64.ml:67:6>>*/ return _g_ /*<<int64.ml:67:6>>*/ ;
     }
     catch(_h_){
      var _f_ = caml_wrap_exception(_h_);
-     if(_f_[1] === Stdlib[7])  /*<<int64.ml:68:20>>*/ return 0;
+     if(_f_[1] === Stdlib[7])
+       /*<<int64.ml:68:20>>*/ return 0 /*<<int64.ml:68:20>>*/ ;
      throw caml_maybe_attach_backtrace(_f_, 0);
     }
     /*<<int64.ml:68:24>>*/ }
    function compare(x, y){
      /*<<int64.ml:79:28>>*/ return  /*<<int64.ml:79:28>>*/ caml_int64_compare
-            (x, y);
+            (x, y) /*<<int64.ml:79:46>>*/ ;
     /*<<int64.ml:79:46>>*/ }
    var equal = runtime.caml_equal;
    function unsigned_compare(n, m){
@@ -9479,28 +9613,28 @@
       /*<<int64.ml:83:10>>*/ x =
         /*<<int64.ml:83:10>>*/ caml_int64_sub(n, min_int);
      /*<<int64.ml:79:28>>*/ return  /*<<int64.ml:79:28>>*/ caml_int64_compare
-            (x, y);
+            (x, y) /*<<int64.ml:83:41>>*/ ;
     /*<<int64.ml:83:41>>*/ }
    function unsigned_lt(n, m){
      /*<<int64.ml:86:2>>*/ return  /*<<int64.ml:86:2>>*/ caml_lessthan
             ( /*<<int64.ml:86:2>>*/ caml_int64_sub(n, min_int),
-              /*<<int64.ml:86:18>>*/ caml_int64_sub(m, min_int));
+              /*<<int64.ml:86:18>>*/ caml_int64_sub(m, min_int)) /*<<int64.ml:86:31>>*/ ;
     /*<<int64.ml:86:31>>*/ }
    function min(x, y){
      /*<<int64.ml:88:18>>*/ return  /*<<int64.ml:88:21>>*/ caml_lessequal
              (x, y)
             ? x
-            : y;
+            : y /*<<int64.ml:88:41>>*/ ;
     /*<<int64.ml:88:41>>*/ }
    function max(x, y){
      /*<<int64.ml:89:18>>*/ return  /*<<int64.ml:89:21>>*/ caml_greaterequal
              (x, y)
             ? x
-            : y;
+            : y /*<<int64.ml:89:41>>*/ ;
     /*<<int64.ml:89:41>>*/ }
    function unsigned_div(n, d){
      /*<<int64.ml:95:2>>*/ if( /*<<int64.ml:95:5>>*/ caml_lessthan(d, zero))
-      /*<<int64.ml:96:7>>*/ return unsigned_lt(n, d) ? zero : one;
+      /*<<int64.ml:96:7>>*/ return unsigned_lt(n, d) ? zero : one /*<<int64.ml:100:41>>*/ ;
      /*<<int64.ml:98:12>>*/ var
       /*<<int64.ml:98:12>>*/ q =
         /*<<int64.ml:98:12>>*/ runtime.caml_int64_shift_left
@@ -9514,19 +9648,19 @@
         (n,  /*<<int64.ml:99:18>>*/ caml_int64_mul(q, d));
      /*<<int64.ml:100:7>>*/ return unsigned_lt(r, d)
             ? q
-            :  /*<<int64.ml:46:13>>*/ caml_int64_add(q, _a_);
+            :  /*<<int64.ml:46:13>>*/ caml_int64_add(q, _a_) /*<<int64.ml:100:41>>*/ ;
     /*<<int64.ml:100:41>>*/ }
    function unsigned_rem(n, d){
      /*<<int64.ml:103:2>>*/ return  /*<<int64.ml:103:2>>*/ caml_int64_sub
-            (n,  /*<<int64.ml:103:8>>*/ caml_int64_mul(unsigned_div(n, d), d));
+            (n,  /*<<int64.ml:103:8>>*/ caml_int64_mul(unsigned_div(n, d), d)) /*<<int64.ml:103:34>>*/ ;
     /*<<int64.ml:103:34>>*/ }
    function seeded_hash(seed, x){
      /*<<int64.ml:107:25>>*/ return  /*<<int64.ml:107:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<int64.ml:107:56>>*/ ;
     /*<<int64.ml:107:56>>*/ }
    function hash(x){
      /*<<int64.ml:108:13>>*/ return  /*<<int64.ml:108:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<int64.ml:108:41>>*/ ;
     /*<<int64.ml:108:41>>*/ }
    var
     Stdlib_Int64 =
@@ -9578,45 +9712,46 @@
     zero = 0,
     one = 1;
    function succ(n){
-     /*<<nativeint.ml:44:13>>*/ return n + 1 | 0;
+     /*<<nativeint.ml:44:13>>*/ return n + 1 | 0 /*<<nativeint.ml:44:13>>*/ ;
     /*<<nativeint.ml:44:21>>*/ }
    function pred(n){
-     /*<<nativeint.ml:45:13>>*/ return n - 1 | 0;
+     /*<<nativeint.ml:45:13>>*/ return n - 1 | 0 /*<<nativeint.ml:45:13>>*/ ;
     /*<<nativeint.ml:45:21>>*/ }
    function abs(n){
      /*<<nativeint.ml:46:12>>*/ return  /*<<nativeint.ml:46:15>>*/ caml_greaterequal
              (n, 0)
             ? n
-            : - n | 0;
+            : - n | 0 /*<<nativeint.ml:46:40>>*/ ;
     /*<<nativeint.ml:46:40>>*/ }
     /*<<nativeint.ml:48:14>>*/ var
     size = Stdlib_Sys[9],
      /*<<nativeint.ml:48:14>>*/ min_int = 1 << (size - 1 | 0),
      /*<<nativeint.ml:49:14>>*/ max_int = min_int - 1 | 0;
    function lognot(n){
-     /*<<nativeint.ml:50:15>>*/ return n ^ -1;
+     /*<<nativeint.ml:50:15>>*/ return n ^ -1 /*<<nativeint.ml:50:15>>*/ ;
     /*<<nativeint.ml:50:29>>*/ }
    var max_int$0 = Stdlib[19];
     /*<<nativeint.ml:54:2>>*/ function unsigned_to_int(n){
      /*<<nativeint.ml:55:4>>*/ if
      ( /*<<nativeint.ml:55:7>>*/ caml_greaterequal(n, 0)
       &&  /*<<nativeint.ml:55:18>>*/ caml_lessequal(n, max_int$0))
-      /*<<nativeint.ml:56:6>>*/ return [0, n];
-     /*<<nativeint.ml:58:6>>*/ return 0;
+      /*<<nativeint.ml:56:6>>*/ return [0, n] /*<<nativeint.ml:56:6>>*/ ;
+     /*<<nativeint.ml:58:6>>*/ return 0 /*<<nativeint.ml:58:6>>*/ ;
     /*<<nativeint.ml:58:10>>*/ }
    function to_string(n){
      /*<<nativeint.ml:61:18>>*/ return  /*<<nativeint.ml:61:18>>*/ runtime.caml_format_int
-            ("%d", n);
+            ("%d", n) /*<<nativeint.ml:61:31>>*/ ;
     /*<<nativeint.ml:61:31>>*/ }
    function of_string_opt(s){
      /*<<nativeint.ml:66:2>>*/ try{
       /*<<nativeint.ml:66:6>>*/  /*<<nativeint.ml:66:6>>*/ var
       _b_ = [0,  /*<<nativeint.ml:66:11>>*/ runtime.caml_int_of_string(s)];
-      /*<<nativeint.ml:66:6>>*/ return _b_;
+      /*<<nativeint.ml:66:6>>*/ return _b_ /*<<nativeint.ml:66:6>>*/ ;
     }
     catch(_c_){
      var _a_ = caml_wrap_exception(_c_);
-     if(_a_[1] === Stdlib[7])  /*<<nativeint.ml:67:20>>*/ return 0;
+     if(_a_[1] === Stdlib[7])
+       /*<<nativeint.ml:67:20>>*/ return 0 /*<<nativeint.ml:67:20>>*/ ;
      throw caml_maybe_attach_backtrace(_a_, 0);
     }
     /*<<nativeint.ml:67:24>>*/ }
@@ -9632,47 +9767,47 @@
       /*<<nativeint.ml:75:26>>*/ y = m - min_int | 0,
       /*<<nativeint.ml:75:10>>*/ x = n - min_int | 0;
      /*<<nativeint.ml:71:28>>*/ return  /*<<nativeint.ml:71:28>>*/ caml_int_compare
-            (x, y);
+            (x, y) /*<<nativeint.ml:75:41>>*/ ;
     /*<<nativeint.ml:75:41>>*/ }
    function unsigned_lt(n, m){
      /*<<nativeint.ml:78:2>>*/ return  /*<<nativeint.ml:78:2>>*/ caml_lessthan
-            (n - min_int | 0, m - min_int | 0);
+            (n - min_int | 0, m - min_int | 0) /*<<nativeint.ml:78:31>>*/ ;
     /*<<nativeint.ml:78:31>>*/ }
    function min(x, y){
      /*<<nativeint.ml:80:18>>*/ return  /*<<nativeint.ml:80:21>>*/ caml_lessequal
              (x, y)
             ? x
-            : y;
+            : y /*<<nativeint.ml:80:41>>*/ ;
     /*<<nativeint.ml:80:41>>*/ }
    function max(x, y){
      /*<<nativeint.ml:81:18>>*/ return  /*<<nativeint.ml:81:21>>*/ caml_greaterequal
              (x, y)
             ? x
-            : y;
+            : y /*<<nativeint.ml:81:41>>*/ ;
     /*<<nativeint.ml:81:41>>*/ }
    function unsigned_div(n, d){
      /*<<nativeint.ml:87:2>>*/ if
      ( /*<<nativeint.ml:87:5>>*/ caml_lessthan(d, 0))
-      /*<<nativeint.ml:88:7>>*/ return unsigned_lt(n, d) ? zero : one;
+      /*<<nativeint.ml:88:7>>*/ return unsigned_lt(n, d) ? zero : one /*<<nativeint.ml:92:41>>*/ ;
      /*<<nativeint.ml:90:12>>*/ var
       /*<<nativeint.ml:90:12>>*/ q =
         /*<<nativeint.ml:90:23>>*/ runtime.caml_div(n >>> 1 | 0, d) << 1,
       /*<<nativeint.ml:91:12>>*/ r =
        n -  /*<<nativeint.ml:91:18>>*/ caml_mul(q, d) | 0;
-     /*<<nativeint.ml:92:7>>*/ return unsigned_lt(r, d) ? q : q + 1 | 0;
+     /*<<nativeint.ml:92:7>>*/ return unsigned_lt(r, d) ? q : q + 1 | 0 /*<<nativeint.ml:92:41>>*/ ;
     /*<<nativeint.ml:92:41>>*/ }
    function unsigned_rem(n, d){
      /*<<nativeint.ml:95:2>>*/ return n
            -  /*<<nativeint.ml:95:8>>*/ caml_mul(unsigned_div(n, d), d)
-           | 0;
+           | 0 /*<<nativeint.ml:95:2>>*/ ;
     /*<<nativeint.ml:95:34>>*/ }
    function seeded_hash(seed, x){
      /*<<nativeint.ml:99:25>>*/ return  /*<<nativeint.ml:99:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<nativeint.ml:99:56>>*/ ;
     /*<<nativeint.ml:99:56>>*/ }
    function hash(x){
      /*<<nativeint.ml:100:13>>*/ return  /*<<nativeint.ml:100:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<nativeint.ml:100:41>>*/ ;
     /*<<nativeint.ml:100:41>>*/ }
    var
     Stdlib_Nativeint =
@@ -9761,7 +9896,7 @@
      var _p_ = buf[12];
      buf[12] = [0, _p_[1], _p_[2], _p_[3], buf[4] + buf[6] | 0];
     }
-     /*<<lexing.ml:71:2>>*/ return result;
+     /*<<lexing.ml:71:2>>*/ return result /*<<lexing.ml:71:2>>*/ ;
     /*<<lexing.ml:71:8>>*/ }
    function new_engine(tbl, state, buf){
      /*<<lexing.ml:75:2>>*/ var
@@ -9774,7 +9909,7 @@
      var _m_ = buf[12];
      buf[12] = [0, _m_[1], _m_[2], _m_[3], buf[4] + buf[6] | 0];
     }
-     /*<<lexing.ml:81:2>>*/ return result;
+     /*<<lexing.ml:81:2>>*/ return result /*<<lexing.ml:81:2>>*/ ;
     /*<<lexing.ml:81:8>>*/ }
    function from_function(opt, read_fun){
      /*<<lexing.ml:148:2>>*/ var
@@ -9858,15 +9993,15 @@
             0,
             [0],
             _g_,
-            _f_];
+            _f_] /*<<lexing.ml:148:2>>*/ ;
    }
    function from_channel(with_positions, ic){
      /*<<lexing.ml:163:2>>*/ return from_function
             (with_positions,
              function(buf, n){
                /*<<lexing.ml:163:46>>*/ return  /*<<lexing.ml:163:46>>*/ caml_call4
-                      (Stdlib[84], ic, buf, 0, n);
-              /*<<lexing.ml:163:62>>*/ });
+                      (Stdlib[84], ic, buf, 0, n) /*<<lexing.ml:163:62>>*/ ;
+              /*<<lexing.ml:163:62>>*/ }) /*<<lexing.ml:163:63>>*/ ;
     /*<<lexing.ml:163:63>>*/ }
    function from_string(opt, s){
      /*<<lexing.ml:166:2>>*/ var
@@ -9888,7 +10023,7 @@
             1,
             [0],
             _e_,
-            _d_];
+            _d_] /*<<lexing.ml:166:2>>*/ ;
    }
    function set_position(lexbuf, position){
      /*<<lexing.ml:182:2>>*/ lexbuf[12] =
@@ -9907,32 +10042,33 @@
    function lexeme(lexbuf){
      /*<<lexing.ml:191:2>>*/ var len = lexbuf[6] - lexbuf[5] | 0;
      /*<<lexing.ml:192:2>>*/ return  /*<<lexing.ml:192:2>>*/ caml_call3
-            (Stdlib_Bytes[8], lexbuf[2], lexbuf[5], len);
+            (Stdlib_Bytes[8], lexbuf[2], lexbuf[5], len) /*<<lexing.ml:192:61>>*/ ;
     /*<<lexing.ml:192:61>>*/ }
    function sub_lexeme(lexbuf, i1, i2){
      /*<<lexing.ml:195:2>>*/ var len = i2 - i1 | 0;
      /*<<lexing.ml:196:2>>*/ return  /*<<lexing.ml:196:2>>*/ caml_call3
-            (Stdlib_Bytes[8], lexbuf[2], i1, len);
+            (Stdlib_Bytes[8], lexbuf[2], i1, len) /*<<lexing.ml:196:43>>*/ ;
     /*<<lexing.ml:196:43>>*/ }
    function sub_lexeme_opt(lexbuf, i1, i2){
-     /*<<lexing.ml:199:2>>*/ if(0 > i1)  /*<<lexing.ml:202:11>>*/ return 0;
+     /*<<lexing.ml:199:2>>*/ if(0 > i1)
+      /*<<lexing.ml:202:11>>*/ return 0 /*<<lexing.ml:202:11>>*/ ;
     var len = i2 - i1 | 0;
      /*<<lexing.ml:201:4>>*/ return [0,
              /*<<lexing.ml:201:9>>*/ caml_call3
-             (Stdlib_Bytes[8], lexbuf[2], i1, len)];
+             (Stdlib_Bytes[8], lexbuf[2], i1, len)] /*<<lexing.ml:201:4>>*/ ;
     /*<<lexing.ml:204:5>>*/ }
    function sub_lexeme_char(lexbuf, i){
      /*<<lexing.ml:206:31>>*/ return  /*<<lexing.ml:206:31>>*/ caml_bytes_get
-            (lexbuf[2], i);
+            (lexbuf[2], i) /*<<lexing.ml:206:60>>*/ ;
     /*<<lexing.ml:206:60>>*/ }
    function sub_lexeme_char_opt(lexbuf, i){
      /*<<lexing.ml:209:2>>*/ return 0 <= i
             ? [0,  /*<<lexing.ml:210:9>>*/ caml_bytes_get(lexbuf[2], i)]
-            : 0;
+            : 0 /*<<lexing.ml:212:8>>*/ ;
     /*<<lexing.ml:212:8>>*/ }
    function lexeme_char(lexbuf, i){
      /*<<lexing.ml:216:2>>*/ return  /*<<lexing.ml:216:2>>*/ caml_bytes_get
-            (lexbuf[2], lexbuf[5] + i | 0);
+            (lexbuf[2], lexbuf[5] + i | 0) /*<<lexing.ml:216:56>>*/ ;
     /*<<lexing.ml:216:56>>*/ }
    function lexeme_start(lexbuf){
      /*<<lexing.ml:218:26>>*/ return lexbuf[11][4];
@@ -10085,7 +10221,7 @@
      /*<<parsing.ml:128:28>>*/ current_lookahead_fun =
       [0,
        function(param){
-         /*<<parsing.ml:128:52>>*/ return 0;
+         /*<<parsing.ml:128:52>>*/ return 0 /*<<parsing.ml:128:52>>*/ ;
         /*<<parsing.ml:128:57>>*/ }],
     cst_syntax_error = "syntax error";
    function yyparse(tables, start, lexer, lexbuf){
@@ -10160,7 +10296,7 @@
      env[16] = init_errflag;
      if(exn[1] === YYexit){
       var v = exn[2];
-       /*<<parsing.ml:177:8>>*/ return v;
+       /*<<parsing.ml:177:8>>*/ return v /*<<parsing.ml:177:8>>*/ ;
      }
      current_lookahead_fun[1] =
       function(tok){
@@ -10170,14 +10306,14 @@
                  [1 + tok]
                 === curr_char
                 ? 1
-                : 0;
+                : 0 /*<<parsing.ml:183:17>>*/ ;
         /*<<parsing.ml:182:38>>*/  /*<<parsing.ml:182:38>>*/ var
         _l_ =  /*<<parsing.ml:182:38>>*/ runtime.caml_obj_tag(tok);
         /*<<parsing.ml:182:17>>*/ return caml_check_bound(tables[3], _l_)
                 [1 + _l_]
                === curr_char
                ? 1
-               : 0;
+               : 0 /*<<parsing.ml:182:17>>*/ ;
        /*<<parsing.ml:183:64>>*/ };
       /*<<parsing.ml:184:8>>*/ throw  /*<<parsing.ml:184:8>>*/ caml_maybe_attach_backtrace
             (exn, 0);
@@ -10185,14 +10321,14 @@
     /*<<parsing.ml:184:17>>*/ }
    function peek_val(env, n){
      /*<<parsing.ml:187:2>>*/ var _g_ = env[11] - n | 0;
-     /*<<parsing.ml:187:12>>*/ return caml_check_bound(env[2], _g_)[1 + _g_];
+     /*<<parsing.ml:187:12>>*/ return caml_check_bound(env[2], _g_)[1 + _g_] /*<<parsing.ml:187:12>>*/ ;
     /*<<parsing.ml:187:37>>*/ }
    function symbol_start_pos(param){
      /*<<parsing.ml:190:2>>*/ var i$1 = env[12], i = i$1;
      /*<<parsing.ml:191:4>>*/ for(;;){
      if(0 >= i){
       var _f_ = env[11];
-       /*<<parsing.ml:191:19>>*/ return caml_check_bound(env[4], _f_)[1 + _f_];
+       /*<<parsing.ml:191:19>>*/ return caml_check_bound(env[4], _f_)[1 + _f_] /*<<parsing.ml:191:19>>*/ ;
      }
       /*<<parsing.ml:193:15>>*/ var
       _d_ = (env[11] - i | 0) + 1 | 0,
@@ -10201,7 +10337,7 @@
        /*<<parsing.ml:194:15>>*/ en = caml_check_bound(env[4], _e_)[1 + _e_];
       /*<<parsing.ml:195:9>>*/ if
       ( /*<<parsing.ml:195:9>>*/ runtime.caml_notequal(st, en))
-       /*<<parsing.ml:195:23>>*/ return st;
+       /*<<parsing.ml:195:23>>*/ return st /*<<parsing.ml:195:23>>*/ ;
       /*<<parsing.ml:195:31>>*/  /*<<parsing.ml:195:31>>*/ var
       i$0 = i - 1 | 0;
      i = i$0;
@@ -10209,34 +10345,34 @@
     /*<<parsing.ml:198:19>>*/ }
    function symbol_end_pos(param){
      /*<<parsing.ml:200:24>>*/ var _c_ = env[11];
-     /*<<parsing.ml:200:24>>*/ return caml_check_bound(env[4], _c_)[1 + _c_];
+     /*<<parsing.ml:200:24>>*/ return caml_check_bound(env[4], _c_)[1 + _c_] /*<<parsing.ml:200:24>>*/ ;
     /*<<parsing.ml:200:52>>*/ }
    function rhs_start_pos(n){
      /*<<parsing.ml:201:22>>*/ var _b_ = env[11] - (env[12] - n | 0) | 0;
-     /*<<parsing.ml:201:22>>*/ return caml_check_bound(env[3], _b_)[1 + _b_];
+     /*<<parsing.ml:201:22>>*/ return caml_check_bound(env[3], _b_)[1 + _b_] /*<<parsing.ml:201:22>>*/ ;
     /*<<parsing.ml:201:73>>*/ }
    function rhs_end_pos(n){
      /*<<parsing.ml:202:20>>*/ var _a_ = env[11] - (env[12] - n | 0) | 0;
-     /*<<parsing.ml:202:20>>*/ return caml_check_bound(env[4], _a_)[1 + _a_];
+     /*<<parsing.ml:202:20>>*/ return caml_check_bound(env[4], _a_)[1 + _a_] /*<<parsing.ml:202:20>>*/ ;
     /*<<parsing.ml:202:69>>*/ }
    function symbol_start(param){
-     /*<<parsing.ml:204:22>>*/ return symbol_start_pos(0)[4];
+     /*<<parsing.ml:204:22>>*/ return symbol_start_pos(0)[4] /*<<parsing.ml:204:22>>*/ ;
     /*<<parsing.ml:204:52>>*/ }
    function symbol_end(param){
-     /*<<parsing.ml:205:20>>*/ return symbol_end_pos(0)[4];
+     /*<<parsing.ml:205:20>>*/ return symbol_end_pos(0)[4] /*<<parsing.ml:205:20>>*/ ;
     /*<<parsing.ml:205:48>>*/ }
    function rhs_start(n){
-     /*<<parsing.ml:206:18>>*/ return rhs_start_pos(n)[4];
+     /*<<parsing.ml:206:18>>*/ return rhs_start_pos(n)[4] /*<<parsing.ml:206:18>>*/ ;
     /*<<parsing.ml:206:44>>*/ }
    function rhs_end(n){
-     /*<<parsing.ml:207:16>>*/ return rhs_end_pos(n)[4];
+     /*<<parsing.ml:207:16>>*/ return rhs_end_pos(n)[4] /*<<parsing.ml:207:16>>*/ ;
     /*<<parsing.ml:207:40>>*/ }
    function is_current_lookahead(tok){
      /*<<parsing.ml:210:2>>*/ return  /*<<parsing.ml:210:2>>*/ caml_call1
-            (current_lookahead_fun[1], tok);
+            (current_lookahead_fun[1], tok) /*<<parsing.ml:210:40>>*/ ;
     /*<<parsing.ml:210:40>>*/ }
    function parse_error(param){
-     /*<<parsing.ml:212:31>>*/ return 0;
+     /*<<parsing.ml:212:31>>*/ return 0 /*<<parsing.ml:212:31>>*/ ;
     /*<<parsing.ml:212:33>>*/ }
    var
     Stdlib_Parsing =
@@ -10304,15 +10440,16 @@
       [0,
        function(Ord){
         function height(param){
-          /*<<set.ml:81:17>>*/ if(! param)  /*<<set.ml:82:17>>*/ return 0;
+          /*<<set.ml:81:17>>*/ if(! param)
+           /*<<set.ml:82:17>>*/ return 0 /*<<set.ml:82:17>>*/ ;
          var h = param[4];
-          /*<<set.ml:83:20>>*/ return h;
+          /*<<set.ml:83:20>>*/ return h /*<<set.ml:83:20>>*/ ;
          /*<<set.ml:83:21>>*/ }
         function create(l, v, r){
           /*<<set.ml:91:6>>*/ if(l) var h = l[4], hl = h; else var hl = 0;
           /*<<set.ml:92:6>>*/ if(r) var h$0 = r[4], hr = h$0; else var hr = 0;
          var _Y_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
-          /*<<set.ml:93:10>>*/ return [0, l, v, r, _Y_];
+          /*<<set.ml:93:10>>*/ return [0, l, v, r, _Y_] /*<<set.ml:93:10>>*/ ;
          /*<<set.ml:93:60>>*/ }
         function bal(l, v, r){
           /*<<set.ml:101:6>>*/ if(l) var h = l[4], hl = h; else var hl = 0;
@@ -10323,57 +10460,59 @@
          if((hr + 2 | 0) < hl){
           if(! l)
             /*<<set.ml:105:19>>*/ return  /*<<set.ml:105:19>>*/ caml_call1
-                   (Stdlib[1], cst_Set_bal$0);
+                   (Stdlib[1], cst_Set_bal$0) /*<<set.ml:128:62>>*/ ;
            /*<<set.ml:107:28>>*/ var
            lr = l[3],
            lv = l[2],
            ll = l[1],
             /*<<set.ml:107:28>>*/ _T_ = height(lr);
           if(_T_ <= height(ll))
-            /*<<set.ml:108:27>>*/ return create(ll, lv, create(lr, v, r));
+            /*<<set.ml:108:27>>*/ return create(ll, lv, create(lr, v, r)) /*<<set.ml:128:62>>*/ ;
           if(! lr)
             /*<<set.ml:111:25>>*/ return  /*<<set.ml:111:25>>*/ caml_call1
-                   (Stdlib[1], cst_Set_bal);
+                   (Stdlib[1], cst_Set_bal) /*<<set.ml:128:62>>*/ ;
            /*<<set.ml:113:48>>*/ var
            lrr = lr[3],
            lrv = lr[2],
            lrl = lr[1],
             /*<<set.ml:113:48>>*/ _U_ = create(lrr, v, r);
-           /*<<set.ml:113:48>>*/ return create(create(ll, lv, lrl), lrv, _U_);
+           /*<<set.ml:113:48>>*/ return create(create(ll, lv, lrl), lrv, _U_) /*<<set.ml:128:62>>*/ ;
          }
          if((hl + 2 | 0) >= hr){
           var _X_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
-           /*<<set.ml:128:12>>*/ return [0, l, v, r, _X_];
+           /*<<set.ml:128:12>>*/ return [0, l, v, r, _X_] /*<<set.ml:128:12>>*/ ;
          }
          if(! r)
            /*<<set.ml:117:19>>*/ return  /*<<set.ml:117:19>>*/ caml_call1
-                  (Stdlib[1], cst_Set_bal$2);
+                  (Stdlib[1], cst_Set_bal$2) /*<<set.ml:128:62>>*/ ;
           /*<<set.ml:119:28>>*/ var
           rr = r[3],
           rv = r[2],
           rl = r[1],
            /*<<set.ml:119:28>>*/ _V_ = height(rl);
          if(_V_ <= height(rr))
-           /*<<set.ml:120:14>>*/ return create(create(l, v, rl), rv, rr);
+           /*<<set.ml:120:14>>*/ return create(create(l, v, rl), rv, rr) /*<<set.ml:128:62>>*/ ;
          if(! rl)
            /*<<set.ml:123:25>>*/ return  /*<<set.ml:123:25>>*/ caml_call1
-                  (Stdlib[1], cst_Set_bal$1);
+                  (Stdlib[1], cst_Set_bal$1) /*<<set.ml:128:62>>*/ ;
           /*<<set.ml:125:46>>*/ var
           rlr = rl[3],
           rlv = rl[2],
           rll = rl[1],
            /*<<set.ml:125:46>>*/ _W_ = create(rlr, rv, rr);
-          /*<<set.ml:125:46>>*/ return create(create(l, v, rll), rlv, _W_);
+          /*<<set.ml:125:46>>*/ return create(create(l, v, rll), rlv, _W_) /*<<set.ml:128:62>>*/ ;
          /*<<set.ml:128:62>>*/ }
         function add(x, t){
-          /*<<?>>*/ if(! t)  /*<<set.ml:133:21>>*/ return [0, 0, x, 0, 1];
+          /*<<?>>*/ if(! t)
+           /*<<set.ml:133:21>>*/ return [0, 0, x, 0, 1] /*<<set.ml:133:21>>*/ ;
           /*<<set.ml:135:18>>*/ var
           r = t[3],
           v = t[2],
           l = t[1],
            /*<<set.ml:135:18>>*/ c =
              /*<<set.ml:135:18>>*/ caml_call2(Ord[1], x, v);
-          /*<<set.ml:136:10>>*/ if(0 === c)  /*<<set.ml:136:24>>*/ return t;
+          /*<<set.ml:136:10>>*/ if(0 === c)
+           /*<<set.ml:136:24>>*/ return t /*<<set.ml:136:24>>*/ ;
          if(0 <= c){
            /*<<set.ml:141:21>>*/  /*<<set.ml:141:21>>*/ var rr = add(x, r);
           return r === rr ? t : bal(l, v, rr);
@@ -10382,22 +10521,25 @@
          return l === ll ? t : bal(ll, v, r);
         }
         function singleton(x){
-          /*<<set.ml:144:22>>*/ return [0, 0, x, 0, 1];
+          /*<<set.ml:144:22>>*/ return [0, 0, x, 0, 1] /*<<set.ml:144:26>>*/ ;
          /*<<set.ml:144:54>>*/ }
         function add_min_element(x, param){
-          /*<<?>>*/ if(! param)  /*<<set.ml:154:17>>*/ return singleton(x);
+          /*<<?>>*/ if(! param)
+           /*<<set.ml:154:17>>*/ return singleton(x) /*<<set.ml:154:17>>*/ ;
          var r = param[3], v = param[2], l = param[1];
-          /*<<set.ml:156:8>>*/ return bal(add_min_element(x, l), v, r);
+          /*<<set.ml:156:8>>*/ return bal(add_min_element(x, l), v, r) /*<<set.ml:156:8>>*/ ;
         }
         function add_max_element(x, param){
-          /*<<?>>*/ if(! param)  /*<<set.ml:159:17>>*/ return singleton(x);
+          /*<<?>>*/ if(! param)
+           /*<<set.ml:159:17>>*/ return singleton(x) /*<<set.ml:159:17>>*/ ;
          var r = param[3], v = param[2], l = param[1];
-          /*<<set.ml:161:16>>*/ return bal(l, v, add_max_element(x, r));
+          /*<<set.ml:161:16>>*/ return bal(l, v, add_max_element(x, r)) /*<<set.ml:161:16>>*/ ;
         }
         function join(l, v, r){
           /*<<set.ml:167:6>>*/ if(! l)
-           /*<<set.ml:168:22>>*/ return add_min_element(v, r);
-         if(! r)  /*<<set.ml:169:22>>*/ return add_max_element(v, l);
+           /*<<set.ml:168:22>>*/ return add_min_element(v, r) /*<<set.ml:173:22>>*/ ;
+         if(! r)
+           /*<<set.ml:169:22>>*/ return add_max_element(v, l) /*<<set.ml:173:22>>*/ ;
          var
           rh = r[4],
           rr = r[3],
@@ -10414,7 +10556,7 @@
                    | 0)
                    < rh
                    ? bal(join(l, v, rl), rv, rr)
-                   : create(l, v, r);
+                   : create(l, v, r) /*<<set.ml:173:22>>*/ ;
          /*<<set.ml:173:22>>*/ }
         function min_elt(param){
           /*<<set.ml:177:22>>*/ var param$0 = param;
@@ -10423,16 +10565,23 @@
             /*<<set.ml:178:17>>*/ throw  /*<<set.ml:178:17>>*/ caml_maybe_attach_backtrace
                   (Stdlib[8], 1);
           var l = param$0[1];
-          if(! l){var v = param$0[2];  /*<<set.ml:179:28>>*/ return v;}
+          if(! l){
+           var v = param$0[2];
+            /*<<set.ml:179:28>>*/ return v /*<<set.ml:179:28>>*/ ;
+          }
           param$0 = l;
          }
          /*<<set.ml:180:28>>*/ }
         function min_elt_opt(param){
           /*<<set.ml:182:26>>*/ var param$0 = param;
           /*<<set.ml:182:26>>*/ for(;;){
-          if(! param$0)  /*<<set.ml:183:17>>*/ return 0;
+          if(! param$0)
+            /*<<set.ml:183:17>>*/ return 0 /*<<set.ml:183:17>>*/ ;
           var l = param$0[1];
-          if(! l){var v = param$0[2];  /*<<set.ml:184:28>>*/ return [0, v];}
+          if(! l){
+           var v = param$0[2];
+            /*<<set.ml:184:28>>*/ return [0, v] /*<<set.ml:184:28>>*/ ;
+          }
           param$0 = l;
          }
          /*<<set.ml:185:32>>*/ }
@@ -10444,7 +10593,7 @@
                   (Stdlib[8], 1);
           if(! param$0[3]){
            var v = param$0[2];
-            /*<<set.ml:189:28>>*/ return v;
+            /*<<set.ml:189:28>>*/ return v /*<<set.ml:189:28>>*/ ;
           }
           var r = param$0[3];
           param$0 = r;
@@ -10453,10 +10602,11 @@
         function max_elt_opt(param){
           /*<<set.ml:192:26>>*/ var param$0 = param;
           /*<<set.ml:192:26>>*/ for(;;){
-          if(! param$0)  /*<<set.ml:193:17>>*/ return 0;
+          if(! param$0)
+            /*<<set.ml:193:17>>*/ return 0 /*<<set.ml:193:17>>*/ ;
           if(! param$0[3]){
            var v = param$0[2];
-            /*<<set.ml:194:28>>*/ return [0, v];
+            /*<<set.ml:194:28>>*/ return [0, v] /*<<set.ml:194:28>>*/ ;
           }
           var r = param$0[3];
           param$0 = r;
@@ -10465,24 +10615,26 @@
         function remove_min_elt(param){
           /*<<set.ml:199:29>>*/ if(! param)
            /*<<set.ml:200:17>>*/ return  /*<<set.ml:200:17>>*/ caml_call1
-                  (Stdlib[1], cst_Set_remove_min_elt);
+                  (Stdlib[1], cst_Set_remove_min_elt) /*<<set.ml:202:51>>*/ ;
          var l = param[1];
          if(l){
           var r = param[3], v = param[2];
-           /*<<set.ml:202:25>>*/ return bal(remove_min_elt(l), v, r);
+           /*<<set.ml:202:25>>*/ return bal(remove_min_elt(l), v, r) /*<<set.ml:202:51>>*/ ;
          }
          var r$0 = param[3];
-          /*<<set.ml:201:28>>*/ return r$0;
+          /*<<set.ml:201:28>>*/ return r$0 /*<<set.ml:201:28>>*/ ;
          /*<<set.ml:202:51>>*/ }
         function concat(t1, t2){
-          /*<<set.ml:219:6>>*/ if(! t1)  /*<<set.ml:220:22>>*/ return t2;
-         if(! t2)  /*<<set.ml:221:22>>*/ return t1;
+          /*<<set.ml:219:6>>*/ if(! t1)
+           /*<<set.ml:220:22>>*/ return t2 /*<<set.ml:220:22>>*/ ;
+         if(! t2)  /*<<set.ml:221:22>>*/ return t1 /*<<set.ml:221:22>>*/ ;
           /*<<set.ml:222:39>>*/  /*<<set.ml:222:39>>*/ var
           _S_ = remove_min_elt(t2);
-          /*<<set.ml:222:39>>*/ return join(t1, min_elt(t2), _S_);
+          /*<<set.ml:222:39>>*/ return join(t1, min_elt(t2), _S_) /*<<set.ml:222:58>>*/ ;
          /*<<set.ml:222:58>>*/ }
         function split(x, param){
-          /*<<?>>*/ if(! param)  /*<<set.ml:232:10>>*/ return _a_;
+          /*<<?>>*/ if(! param)
+           /*<<set.ml:232:10>>*/ return _a_ /*<<set.ml:232:10>>*/ ;
           /*<<set.ml:234:18>>*/ var
           r = param[3],
           v = param[2],
@@ -10490,30 +10642,31 @@
            /*<<set.ml:234:18>>*/ c =
              /*<<set.ml:234:18>>*/ caml_call2(Ord[1], x, v);
           /*<<set.ml:235:10>>*/ if(0 === c)
-           /*<<set.ml:235:24>>*/ return [0, l, 1, r];
+           /*<<set.ml:235:24>>*/ return [0, l, 1, r] /*<<set.ml:235:24>>*/ ;
          if(0 <= c){
            /*<<set.ml:239:33>>*/ var
             /*<<set.ml:239:33>>*/ match = split(x, r),
            rr = match[3],
            pres = match[2],
            lr = match[1];
-           /*<<set.ml:239:46>>*/ return [0, join(l, v, lr), pres, rr];
+           /*<<set.ml:239:46>>*/ return [0, join(l, v, lr), pres, rr] /*<<set.ml:239:46>>*/ ;
          }
           /*<<set.ml:237:33>>*/ var
            /*<<set.ml:237:33>>*/ match$0 = split(x, l),
           rl = match$0[3],
           pres$0 = match$0[2],
           ll = match$0[1];
-          /*<<set.ml:237:46>>*/ return [0, ll, pres$0, join(rl, v, r)];
+          /*<<set.ml:237:46>>*/ return [0, ll, pres$0, join(rl, v, r)] /*<<set.ml:237:46>>*/ ;
         }
         var empty = 0;
         function is_empty(param){
-          /*<<set.ml:245:19>>*/ return param ? 0 : 1;
+          /*<<set.ml:245:19>>*/ return param ? 0 : 1 /*<<set.ml:245:54>>*/ ;
          /*<<set.ml:245:54>>*/ }
         function mem(x, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<set.ml:248:17>>*/ return 0;
+          if(! param$0)
+            /*<<set.ml:248:17>>*/ return 0 /*<<set.ml:248:17>>*/ ;
            /*<<set.ml:250:18>>*/ var
            r = param$0[3],
            v = param$0[2],
@@ -10527,7 +10680,8 @@
          }
         }
         function remove(x, t){
-          /*<<?>>*/ if(! t)  /*<<set.ml:254:17>>*/ return 0;
+          /*<<?>>*/ if(! t)
+           /*<<set.ml:254:17>>*/ return 0 /*<<set.ml:254:17>>*/ ;
           /*<<set.ml:256:18>>*/ var
           t2 = t[3],
           v = t[2],
@@ -10535,11 +10689,11 @@
            /*<<set.ml:256:18>>*/ c =
              /*<<set.ml:256:18>>*/ caml_call2(Ord[1], x, v);
           /*<<set.ml:257:10>>*/ if(0 === c){
-          if(! t1)  /*<<set.ml:210:22>>*/ return t2;
-          if(! t2)  /*<<set.ml:211:22>>*/ return t1;
+          if(! t1)  /*<<set.ml:210:22>>*/ return t2 /*<<set.ml:210:22>>*/ ;
+          if(! t2)  /*<<set.ml:211:22>>*/ return t1 /*<<set.ml:211:22>>*/ ;
            /*<<set.ml:212:38>>*/  /*<<set.ml:212:38>>*/ var
            _Q_ = remove_min_elt(t2);
-           /*<<set.ml:212:38>>*/ return bal(t1, min_elt(t2), _Q_);
+           /*<<set.ml:212:38>>*/ return bal(t1, min_elt(t2), _Q_) /*<<set.ml:212:38>>*/ ;
          }
          if(0 <= c){
            /*<<set.ml:264:23>>*/  /*<<set.ml:264:23>>*/ var
@@ -10550,8 +10704,9 @@
          return t1 === ll ? t : bal(ll, v, t2);
         }
         function union(s1, s2){
-          /*<<set.ml:269:6>>*/ if(! s1)  /*<<set.ml:270:23>>*/ return s2;
-         if(! s2)  /*<<set.ml:271:23>>*/ return s1;
+          /*<<set.ml:269:6>>*/ if(! s1)
+           /*<<set.ml:270:23>>*/ return s2 /*<<set.ml:270:23>>*/ ;
+         if(! s2)  /*<<set.ml:271:23>>*/ return s1 /*<<set.ml:271:23>>*/ ;
          var
           h2 = s2[4],
           r2 = s2[3],
@@ -10562,25 +10717,28 @@
           v1 = s1[2],
           l1 = s1[1];
          if(h2 <= h1){
-          if(1 === h2)  /*<<set.ml:274:27>>*/ return add(v2, s1);
+          if(1 === h2)
+            /*<<set.ml:274:27>>*/ return add(v2, s1) /*<<set.ml:282:15>>*/ ;
            /*<<set.ml:275:32>>*/ var
             /*<<set.ml:275:32>>*/ match = split(v1, s2),
            r2$0 = match[3],
            l2$0 = match[1],
             /*<<set.ml:276:36>>*/ _O_ = union(r1, r2$0);
-           /*<<set.ml:276:36>>*/ return join(union(l1, l2$0), v1, _O_);
+           /*<<set.ml:276:36>>*/ return join(union(l1, l2$0), v1, _O_) /*<<set.ml:282:15>>*/ ;
          }
-         if(1 === h1)  /*<<set.ml:279:27>>*/ return add(v1, s2);
+         if(1 === h1)
+           /*<<set.ml:279:27>>*/ return add(v1, s2) /*<<set.ml:282:15>>*/ ;
           /*<<set.ml:280:32>>*/ var
            /*<<set.ml:280:32>>*/ match$0 = split(v2, s1),
           r1$0 = match$0[3],
           l1$0 = match$0[1],
            /*<<set.ml:281:36>>*/ _P_ = union(r1$0, r2);
-          /*<<set.ml:281:36>>*/ return join(union(l1$0, l2), v2, _P_);
+          /*<<set.ml:281:36>>*/ return join(union(l1$0, l2), v2, _P_) /*<<set.ml:282:15>>*/ ;
          /*<<set.ml:282:15>>*/ }
         function inter(s1, s2){
-          /*<<set.ml:285:6>>*/ if(! s1)  /*<<set.ml:286:22>>*/ return 0;
-         if(! s2)  /*<<set.ml:287:22>>*/ return 0;
+          /*<<set.ml:285:6>>*/ if(! s1)
+           /*<<set.ml:286:22>>*/ return 0 /*<<set.ml:286:22>>*/ ;
+         if(! s2)  /*<<set.ml:287:22>>*/ return 0 /*<<set.ml:287:22>>*/ ;
           /*<<set.ml:289:16>>*/ var
           r1 = s1[3],
           v1 = s1[2],
@@ -10591,69 +10749,73 @@
            /*<<set.ml:293:36>>*/ var
            r2 = _L_[3],
             /*<<set.ml:293:36>>*/ _M_ = inter(r1, r2);
-           /*<<set.ml:293:36>>*/ return join(inter(l1, l2), v1, _M_);
+           /*<<set.ml:293:36>>*/ return join(inter(l1, l2), v1, _M_) /*<<set.ml:293:49>>*/ ;
          }
           /*<<set.ml:291:35>>*/ var
           r2$0 = _L_[3],
            /*<<set.ml:291:35>>*/ _N_ = inter(r1, r2$0);
-          /*<<set.ml:291:35>>*/ return concat(inter(l1, l2), _N_);
+          /*<<set.ml:291:35>>*/ return concat(inter(l1, l2), _N_) /*<<set.ml:293:49>>*/ ;
          /*<<set.ml:293:49>>*/ }
         function split_bis(x, param){
           /*<<?>>*/ if(! param)
            /*<<set.ml:305:10>>*/ return [0,
                   0,
                   function(param){
-                    /*<<set.ml:305:38>>*/ return 0;
-                   /*<<set.ml:305:43>>*/ }];
+                    /*<<set.ml:305:38>>*/ return 0 /*<<set.ml:305:38>>*/ ;
+                   /*<<set.ml:305:43>>*/ }] /*<<set.ml:305:10>>*/ ;
           /*<<set.ml:307:18>>*/ var
           r = param[3],
           v = param[2],
           l = param[1],
            /*<<set.ml:307:18>>*/ c =
              /*<<set.ml:307:18>>*/ caml_call2(Ord[1], x, v);
-          /*<<set.ml:308:10>>*/ if(0 === c)  /*<<set.ml:308:24>>*/ return 0;
+          /*<<set.ml:308:10>>*/ if(0 === c)
+           /*<<set.ml:308:24>>*/ return 0 /*<<set.ml:308:24>>*/ ;
          if(0 <= c){
            /*<<set.ml:314:18>>*/  /*<<set.ml:314:18>>*/ var
            match = split_bis(x, r);
-          if(! match)  /*<<set.ml:315:23>>*/ return 0;
+          if(! match)  /*<<set.ml:315:23>>*/ return 0 /*<<set.ml:315:23>>*/ ;
           var rr = match[2], lr = match[1];
-           /*<<set.ml:316:35>>*/ return [0, join(l, v, lr), rr];
+           /*<<set.ml:316:35>>*/ return [0, join(l, v, lr), rr] /*<<set.ml:316:35>>*/ ;
          }
           /*<<set.ml:310:18>>*/  /*<<set.ml:310:18>>*/ var
           match$0 = split_bis(x, l);
-         if(! match$0)  /*<<set.ml:311:23>>*/ return 0;
+         if(! match$0)  /*<<set.ml:311:23>>*/ return 0 /*<<set.ml:311:23>>*/ ;
          var rl = match$0[2], ll = match$0[1];
           /*<<set.ml:312:35>>*/ return [0,
                  ll,
                  function(param){
-                   /*<<set.ml:312:60>>*/ return join(rl(0), v, r);
-                  /*<<set.ml:312:76>>*/ }];
+                   /*<<set.ml:312:60>>*/ return join(rl(0), v, r) /*<<set.ml:312:76>>*/ ;
+                  /*<<set.ml:312:76>>*/ }] /*<<set.ml:312:35>>*/ ;
         }
         function disjoint(s1, s2){
           /*<<set.ml:319:6>>*/ var s1$0 = s1, s2$0 = s2;
           /*<<set.ml:319:6>>*/ for(;;){
           if(s1$0 && s2$0){
            var r1 = s1$0[3], v1 = s1$0[2], l1 = s1$0[1];
-           if(s1$0 === s2$0)  /*<<set.ml:322:27>>*/ return 0;
+           if(s1$0 === s2$0)
+             /*<<set.ml:322:27>>*/ return 0 /*<<set.ml:322:27>>*/ ;
             /*<<set.ml:323:21>>*/  /*<<set.ml:323:21>>*/ var
             match = split_bis(v1, s2$0);
-           if(! match)  /*<<set.ml:325:23>>*/ return 0;
+           if(! match)  /*<<set.ml:325:23>>*/ return 0 /*<<set.ml:325:23>>*/ ;
             /*<<set.ml:324:34>>*/ var
             r2 = match[2],
             l2 = match[1],
              /*<<set.ml:324:34>>*/ _K_ = disjoint(l1, l2);
-            /*<<set.ml:324:34>>*/ if(! _K_)  /*<<set.ml:324:34>>*/ return _K_;
+            /*<<set.ml:324:34>>*/ if(! _K_)
+             /*<<set.ml:324:34>>*/ return _K_ /*<<set.ml:324:34>>*/ ;
             /*<<set.ml:324:64>>*/  /*<<set.ml:324:64>>*/ var s2$1 = r2(0);
            s1$0 = r1;
            s2$0 = s2$1;
            continue;
           }
-           /*<<set.ml:320:35>>*/ return 1;
+           /*<<set.ml:320:35>>*/ return 1 /*<<set.ml:320:35>>*/ ;
          }
          /*<<set.ml:325:28>>*/ }
         function diff(s1, s2){
-          /*<<set.ml:328:6>>*/ if(! s1)  /*<<set.ml:329:22>>*/ return 0;
-         if(! s2)  /*<<set.ml:330:23>>*/ return s1;
+          /*<<set.ml:328:6>>*/ if(! s1)
+           /*<<set.ml:329:22>>*/ return 0 /*<<set.ml:329:22>>*/ ;
+         if(! s2)  /*<<set.ml:330:23>>*/ return s1 /*<<set.ml:330:23>>*/ ;
           /*<<set.ml:332:16>>*/ var
           r1 = s1[3],
           v1 = s1[2],
@@ -10664,17 +10826,17 @@
            /*<<set.ml:336:34>>*/ var
            r2 = _H_[3],
             /*<<set.ml:336:34>>*/ _I_ = diff(r1, r2);
-           /*<<set.ml:336:34>>*/ return concat(diff(l1, l2), _I_);
+           /*<<set.ml:336:34>>*/ return concat(diff(l1, l2), _I_) /*<<set.ml:336:46>>*/ ;
          }
           /*<<set.ml:334:35>>*/ var
           r2$0 = _H_[3],
            /*<<set.ml:334:35>>*/ _J_ = diff(r1, r2$0);
-          /*<<set.ml:334:35>>*/ return join(diff(l1, l2), v1, _J_);
+          /*<<set.ml:334:35>>*/ return join(diff(l1, l2), v1, _J_) /*<<set.ml:336:46>>*/ ;
          /*<<set.ml:336:46>>*/ }
         function cons_enum(s, e){
           /*<<set.ml:341:6>>*/ var s$0 = s, e$0 = e;
           /*<<set.ml:341:6>>*/ for(;;){
-          if(! s$0)  /*<<set.ml:342:17>>*/ return e$0;
+          if(! s$0)  /*<<set.ml:342:17>>*/ return e$0 /*<<set.ml:342:17>>*/ ;
            /*<<set.ml:343:37>>*/ var
            r = s$0[3],
            v = s$0[2],
@@ -10691,8 +10853,8 @@
           e1 = e1$2,
           e2 = e2$2;
           /*<<set.ml:346:8>>*/ for(;;){
-          if(! e1) return e2 ? -1 : 0;
-          if(! e2)  /*<<set.ml:349:20>>*/ return 1;
+          if(! e1) return e2 ? -1 : 0 /*<<set.ml:357:55>>*/ ;
+          if(! e2)  /*<<set.ml:349:20>>*/ return 1 /*<<set.ml:349:20>>*/ ;
            /*<<set.ml:351:18>>*/ var
            e2$0 = e2[3],
            r2 = e2[2],
@@ -10702,7 +10864,8 @@
            v1 = e1[1],
             /*<<set.ml:351:18>>*/ c =
               /*<<set.ml:351:18>>*/ caml_call2(Ord[1], v1, v2);
-           /*<<set.ml:352:10>>*/ if(0 !== c)  /*<<set.ml:353:15>>*/ return c;
+           /*<<set.ml:352:10>>*/ if(0 !== c)
+            /*<<set.ml:353:15>>*/ return c /*<<set.ml:353:15>>*/ ;
            /*<<set.ml:354:45>>*/ var
             /*<<set.ml:354:45>>*/ e2$1 = cons_enum(r2, e2$0),
             /*<<set.ml:354:27>>*/ e1$1 = cons_enum(r1, e1$0);
@@ -10716,8 +10879,8 @@
         function subset(s1, s2){
           /*<<set.ml:363:6>>*/ var s1$0 = s1, s2$0 = s2;
           /*<<set.ml:363:6>>*/ for(;;){
-          if(! s1$0)  /*<<set.ml:365:10>>*/ return 1;
-          if(! s2$0)  /*<<set.ml:367:10>>*/ return 0;
+          if(! s1$0)  /*<<set.ml:365:10>>*/ return 1 /*<<set.ml:365:10>>*/ ;
+          if(! s2$0)  /*<<set.ml:367:10>>*/ return 0 /*<<set.ml:367:10>>*/ ;
            /*<<set.ml:369:18>>*/ var
            r2 = s2$0[3],
            v2 = s2$0[2],
@@ -10730,20 +10893,23 @@
            /*<<set.ml:370:10>>*/ if(0 === c){
             /*<<set.ml:371:12>>*/  /*<<set.ml:371:12>>*/ var
             _E_ = subset(l1, l2);
-            /*<<set.ml:371:12>>*/ if(! _E_)  /*<<set.ml:371:12>>*/ return _E_;
+            /*<<set.ml:371:12>>*/ if(! _E_)
+             /*<<set.ml:371:12>>*/ return _E_ /*<<set.ml:371:12>>*/ ;
            s1$0 = r1;
            s2$0 = r2;
           }
           else if(0 <= c){
             /*<<set.ml:375:12>>*/  /*<<set.ml:375:12>>*/ var
             _F_ = subset([0, 0, v1, r1, 0], r2);
-            /*<<set.ml:375:12>>*/ if(! _F_)  /*<<set.ml:375:12>>*/ return _F_;
+            /*<<set.ml:375:12>>*/ if(! _F_)
+             /*<<set.ml:375:12>>*/ return _F_ /*<<set.ml:375:12>>*/ ;
            s1$0 = l1;
           }
           else{
             /*<<set.ml:373:12>>*/  /*<<set.ml:373:12>>*/ var
             _G_ = subset([0, l1, v1, 0, 0], l2);
-            /*<<set.ml:373:12>>*/ if(! _G_)  /*<<set.ml:373:12>>*/ return _G_;
+            /*<<set.ml:373:12>>*/ if(! _G_)
+             /*<<set.ml:373:12>>*/ return _G_ /*<<set.ml:373:12>>*/ ;
            s1$0 = r1;
           }
          }
@@ -10751,7 +10917,8 @@
         function iter(f, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<set.ml:378:17>>*/ return 0;
+          if(! param$0)
+            /*<<set.ml:378:17>>*/ return 0 /*<<set.ml:378:17>>*/ ;
           var r = param$0[3], v = param$0[2], l = param$0[1];
            /*<<set.ml:379:25>>*/ iter(f, l);
            /*<<set.ml:379:35>>*/  /*<<set.ml:379:35>>*/ caml_call1(f, v);
@@ -10761,7 +10928,8 @@
         function fold(f, s, accu){
           /*<<set.ml:382:6>>*/ var s$0 = s, accu$0 = accu;
           /*<<set.ml:382:6>>*/ for(;;){
-          if(! s$0)  /*<<set.ml:383:17>>*/ return accu$0;
+          if(! s$0)
+            /*<<set.ml:383:17>>*/ return accu$0 /*<<set.ml:383:17>>*/ ;
            /*<<set.ml:384:34>>*/ var
            r = s$0[3],
            v = s$0[2],
@@ -10775,7 +10943,8 @@
         function for_all(p, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<set.ml:387:17>>*/ return 1;
+          if(! param$0)
+            /*<<set.ml:387:17>>*/ return 1 /*<<set.ml:387:17>>*/ ;
            /*<<set.ml:388:25>>*/ var
            r = param$0[3],
            v = param$0[2],
@@ -10790,13 +10959,14 @@
           }
           else
            var _D_ = _B_;
-           /*<<set.ml:388:32>>*/ return _D_;
+           /*<<set.ml:388:32>>*/ return _D_ /*<<set.ml:388:32>>*/ ;
          }
         }
         function exists(p, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<set.ml:391:17>>*/ return 0;
+          if(! param$0)
+            /*<<set.ml:391:17>>*/ return 0 /*<<set.ml:391:17>>*/ ;
            /*<<set.ml:392:25>>*/ var
            r = param$0[3],
            v = param$0[2],
@@ -10811,11 +10981,12 @@
             /*<<set.ml:392:32>>*/ if(! _A_){param$0 = r; continue;}
            var _z_ = _A_;
           }
-           /*<<set.ml:392:25>>*/ return _z_;
+           /*<<set.ml:392:25>>*/ return _z_ /*<<set.ml:392:25>>*/ ;
          }
         }
         function filter(p, t){
-          /*<<?>>*/ if(! t)  /*<<set.ml:395:17>>*/ return 0;
+          /*<<?>>*/ if(! t)
+           /*<<set.ml:395:17>>*/ return 0 /*<<set.ml:395:17>>*/ ;
           /*<<set.ml:398:19>>*/ var
           r = t[3],
           v = t[2],
@@ -10824,12 +10995,14 @@
            /*<<set.ml:399:19>>*/ pv =  /*<<set.ml:399:19>>*/ caml_call1(p, v),
            /*<<set.ml:400:19>>*/ r$0 = filter(p, r);
           /*<<set.ml:401:10>>*/ if(! pv)
-           /*<<set.ml:403:15>>*/ return concat(l$0, r$0);
-         if(l === l$0 && r === r$0)  /*<<set.ml:402:35>>*/ return t;
-          /*<<set.ml:402:42>>*/ return join(l$0, v, r$0);
+           /*<<set.ml:403:15>>*/ return concat(l$0, r$0) /*<<set.ml:403:15>>*/ ;
+         if(l === l$0 && r === r$0)
+           /*<<set.ml:402:35>>*/ return t /*<<set.ml:402:35>>*/ ;
+          /*<<set.ml:402:42>>*/ return join(l$0, v, r$0) /*<<set.ml:402:42>>*/ ;
         }
         function partition(p, param){
-          /*<<?>>*/ if(! param)  /*<<set.ml:406:17>>*/ return _b_;
+          /*<<?>>*/ if(! param)
+           /*<<set.ml:406:17>>*/ return _b_ /*<<set.ml:406:17>>*/ ;
           /*<<set.ml:409:25>>*/ var
           r = param[3],
           v = param[2],
@@ -10844,14 +11017,15 @@
           /*<<set.ml:412:10>>*/ if(pv){
            /*<<set.ml:413:30>>*/  /*<<set.ml:413:30>>*/ var
            _w_ = concat(lf, rf);
-           /*<<set.ml:413:15>>*/ return [0, join(lt, v, rt), _w_];
+           /*<<set.ml:413:15>>*/ return [0, join(lt, v, rt), _w_] /*<<set.ml:413:15>>*/ ;
          }
           /*<<set.ml:414:30>>*/  /*<<set.ml:414:30>>*/ var
           _x_ = join(lf, v, rf);
-          /*<<set.ml:414:15>>*/ return [0, concat(lt, rt), _x_];
+          /*<<set.ml:414:15>>*/ return [0, concat(lt, rt), _x_] /*<<set.ml:414:15>>*/ ;
         }
         function cardinal(param){
-          /*<<set.ml:416:23>>*/ if(! param)  /*<<set.ml:417:17>>*/ return 0;
+          /*<<set.ml:416:23>>*/ if(! param)
+           /*<<set.ml:417:17>>*/ return 0 /*<<set.ml:417:17>>*/ ;
           /*<<set.ml:418:39>>*/ var
           r = param[3],
           l = param[1],
@@ -10861,7 +11035,8 @@
         function elements_aux(accu, param){
          var accu$0 = accu, param$0 = param;
          for(;;){
-          if(! param$0)  /*<<set.ml:421:17>>*/ return accu$0;
+          if(! param$0)
+            /*<<set.ml:421:17>>*/ return accu$0 /*<<set.ml:421:17>>*/ ;
            /*<<set.ml:422:38>>*/ var
            r = param$0[3],
            v = param$0[2],
@@ -10872,7 +11047,7 @@
          }
         }
         function elements(s){
-          /*<<set.ml:425:6>>*/ return elements_aux(0, s);
+          /*<<set.ml:425:6>>*/ return elements_aux(0, s) /*<<set.ml:425:23>>*/ ;
          /*<<set.ml:425:23>>*/ }
         function find(x, param){
          var param$0 = param;
@@ -10886,7 +11061,8 @@
            l = param$0[1],
             /*<<set.ml:434:18>>*/ c =
               /*<<set.ml:434:18>>*/ caml_call2(Ord[1], x, v);
-           /*<<set.ml:435:10>>*/ if(0 === c)  /*<<set.ml:435:24>>*/ return v;
+           /*<<set.ml:435:10>>*/ if(0 === c)
+            /*<<set.ml:435:24>>*/ return v /*<<set.ml:435:24>>*/ ;
           var r$0 = 0 <= c ? r : l;
           param$0 = r$0;
          }
@@ -10902,7 +11078,8 @@
            ( /*<<set.ml:451:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, param = l$0;
            for(;;){
-            if(! param)  /*<<set.ml:440:10>>*/ return v0;
+            if(! param)
+              /*<<set.ml:440:10>>*/ return v0 /*<<set.ml:440:10>>*/ ;
             var r = param[3], v0$0 = param[2], l = param[1];
              /*<<set.ml:442:13>>*/ if
              ( /*<<set.ml:442:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; param = l;}
@@ -10917,13 +11094,15 @@
         function find_first_opt(f, param$0){
          var param$1 = param$0;
          for(;;){
-          if(! param$1)  /*<<set.ml:467:10>>*/ return 0;
+          if(! param$1)
+            /*<<set.ml:467:10>>*/ return 0 /*<<set.ml:467:10>>*/ ;
           var r$0 = param$1[3], v0$1 = param$1[2], l$0 = param$1[1];
            /*<<set.ml:469:13>>*/ if
            ( /*<<set.ml:469:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, param = l$0;
            for(;;){
-            if(! param)  /*<<set.ml:458:10>>*/ return [0, v0];
+            if(! param)
+              /*<<set.ml:458:10>>*/ return [0, v0] /*<<set.ml:458:10>>*/ ;
             var r = param[3], v0$0 = param[2], l = param[1];
              /*<<set.ml:460:13>>*/ if
              ( /*<<set.ml:460:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; param = l;}
@@ -10946,7 +11125,8 @@
            ( /*<<set.ml:487:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, param = r$0;
            for(;;){
-            if(! param)  /*<<set.ml:476:10>>*/ return v0;
+            if(! param)
+              /*<<set.ml:476:10>>*/ return v0 /*<<set.ml:476:10>>*/ ;
             var r = param[3], v0$0 = param[2], l = param[1];
              /*<<set.ml:478:13>>*/ if
              ( /*<<set.ml:478:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; param = r;}
@@ -10961,13 +11141,15 @@
         function find_last_opt(f, param$0){
          var param$1 = param$0;
          for(;;){
-          if(! param$1)  /*<<set.ml:503:10>>*/ return 0;
+          if(! param$1)
+            /*<<set.ml:503:10>>*/ return 0 /*<<set.ml:503:10>>*/ ;
           var r$0 = param$1[3], v0$1 = param$1[2], l$0 = param$1[1];
            /*<<set.ml:505:13>>*/ if
            ( /*<<set.ml:505:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, param = r$0;
            for(;;){
-            if(! param)  /*<<set.ml:494:10>>*/ return [0, v0];
+            if(! param)
+              /*<<set.ml:494:10>>*/ return [0, v0] /*<<set.ml:494:10>>*/ ;
             var r = param[3], v0$0 = param[2], l = param[1];
              /*<<set.ml:496:13>>*/ if
              ( /*<<set.ml:496:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; param = r;}
@@ -10982,7 +11164,8 @@
         function find_opt(x, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<set.ml:511:17>>*/ return 0;
+          if(! param$0)
+            /*<<set.ml:511:17>>*/ return 0 /*<<set.ml:511:17>>*/ ;
            /*<<set.ml:513:18>>*/ var
            r = param$0[3],
            v = param$0[2],
@@ -10990,7 +11173,7 @@
             /*<<set.ml:513:18>>*/ c =
               /*<<set.ml:513:18>>*/ caml_call2(Ord[1], x, v);
            /*<<set.ml:514:10>>*/ if(0 === c)
-            /*<<set.ml:514:24>>*/ return [0, v];
+            /*<<set.ml:514:24>>*/ return [0, v] /*<<set.ml:514:24>>*/ ;
           var r$0 = 0 <= c ? r : l;
           param$0 = r$0;
          }
@@ -11010,12 +11193,13 @@
             (0 <=  /*<<set.ml:522:23>>*/ caml_call2(Ord[1], v, _t_))
             break a;
           }
-           /*<<set.ml:523:11>>*/ return join(l, v, r);
+           /*<<set.ml:523:11>>*/ return join(l, v, r) /*<<set.ml:524:28>>*/ ;
          }
-          /*<<set.ml:524:19>>*/ return union(l, add(v, r));
+          /*<<set.ml:524:19>>*/ return union(l, add(v, r)) /*<<set.ml:524:28>>*/ ;
          /*<<set.ml:524:28>>*/ }
         function map(f, t){
-          /*<<?>>*/ if(! t)  /*<<set.ml:527:17>>*/ return 0;
+          /*<<?>>*/ if(! t)
+           /*<<set.ml:527:17>>*/ return 0 /*<<set.ml:527:17>>*/ ;
           /*<<set.ml:530:18>>*/ var
           r = t[3],
           v = t[2],
@@ -11024,11 +11208,12 @@
            /*<<set.ml:531:18>>*/ v$0 =  /*<<set.ml:531:18>>*/ caml_call1(f, v),
            /*<<set.ml:532:18>>*/ r$0 = map(f, r);
          if(l === l$0 && v === v$0 && r === r$0)
-           /*<<set.ml:533:47>>*/ return t;
-          /*<<set.ml:534:14>>*/ return try_join(l$0, v$0, r$0);
+           /*<<set.ml:533:47>>*/ return t /*<<set.ml:533:47>>*/ ;
+          /*<<set.ml:534:14>>*/ return try_join(l$0, v$0, r$0) /*<<set.ml:534:14>>*/ ;
         }
         function filter_map(f, t){
-          /*<<?>>*/ if(! t)  /*<<set.ml:543:17>>*/ return 0;
+          /*<<?>>*/ if(! t)
+           /*<<set.ml:543:17>>*/ return 0 /*<<set.ml:543:17>>*/ ;
           /*<<set.ml:546:18>>*/ var
           r = t[3],
           v = t[2],
@@ -11039,28 +11224,30 @@
           /*<<set.ml:549:9>>*/ if(v$0){
           var v$1 = v$0[1];
           if(l === t1 && v === v$1 && r === t2)
-            /*<<set.ml:551:52>>*/ return t;
-           /*<<set.ml:552:19>>*/ return try_join(t1, v$1, t2);
+            /*<<set.ml:551:52>>*/ return t /*<<set.ml:551:52>>*/ ;
+           /*<<set.ml:552:19>>*/ return try_join(t1, v$1, t2) /*<<set.ml:552:19>>*/ ;
          }
-         if(! t1)  /*<<set.ml:538:22>>*/ return t2;
-         if(! t2)  /*<<set.ml:539:22>>*/ return t1;
+         if(! t1)  /*<<set.ml:538:22>>*/ return t2 /*<<set.ml:538:22>>*/ ;
+         if(! t2)  /*<<set.ml:539:22>>*/ return t1 /*<<set.ml:539:22>>*/ ;
           /*<<set.ml:540:43>>*/  /*<<set.ml:540:43>>*/ var
           _s_ = remove_min_elt(t2);
-          /*<<set.ml:540:43>>*/ return try_join(t1, min_elt(t2), _s_);
+          /*<<set.ml:540:43>>*/ return try_join(t1, min_elt(t2), _s_) /*<<set.ml:540:43>>*/ ;
         }
         function of_list(l){
           /*<<set.ml:581:6>>*/ if(! l) return empty;
          var _n_ = l[2], x0 = l[1];
-         if(! _n_)  /*<<set.ml:583:16>>*/ return singleton(x0);
+         if(! _n_)
+           /*<<set.ml:583:16>>*/ return singleton(x0) /*<<set.ml:588:58>>*/ ;
          var _o_ = _n_[2], x1 = _n_[1];
-         if(! _o_)  /*<<set.ml:584:27>>*/ return add(x1, singleton(x0));
+         if(! _o_)
+           /*<<set.ml:584:27>>*/ return add(x1, singleton(x0)) /*<<set.ml:588:58>>*/ ;
          var _p_ = _o_[2], x2 = _o_[1];
          if(! _p_)
-           /*<<set.ml:585:31>>*/ return add(x2, add(x1, singleton(x0)));
+           /*<<set.ml:585:31>>*/ return add(x2, add(x1, singleton(x0))) /*<<set.ml:588:58>>*/ ;
          var _q_ = _p_[2], x3 = _p_[1];
          if(! _q_)
            /*<<set.ml:586:35>>*/ return add
-                  (x3, add(x2, add(x1, singleton(x0))));
+                  (x3, add(x2, add(x1, singleton(x0)))) /*<<set.ml:588:58>>*/ ;
          if(_q_[2]){
            /*<<set.ml:588:28>>*/ var
             /*<<set.ml:588:28>>*/ l$0 =
@@ -11070,11 +11257,11 @@
                /*<<set.ml:559:8>>*/ if(3 >= n >>> 0)
                switch(n){
                  case 0:
-                   /*<<set.ml:560:18>>*/ return [0, 0, l];
+                   /*<<set.ml:560:18>>*/ return [0, 0, l] /*<<set.ml:560:18>>*/ ;
                  case 1:
                   if(l){
                    var l$3 = l[2], x0 = l[1];
-                    /*<<set.ml:561:24>>*/ return [0, [0, 0, x0, 0, 1], l$3];
+                    /*<<set.ml:561:24>>*/ return [0, [0, 0, x0, 0, 1], l$3] /*<<set.ml:561:24>>*/ ;
                   }
                   break;
                  case 2:
@@ -11084,7 +11271,7 @@
                     var l$4 = match$1[2], x1 = match$1[1], x0$0 = l[1];
                      /*<<set.ml:563:12>>*/ return [0,
                             [0, [0, 0, x0$0, 0, 1], x1, 0, 2],
-                            l$4];
+                            l$4] /*<<set.ml:563:12>>*/ ;
                    }
                   }
                   break;
@@ -11101,7 +11288,7 @@
                       x0$1 = l[1];
                       /*<<set.ml:565:12>>*/ return [0,
                              [0, [0, 0, x0$1, 0, 1], x1$0, [0, 0, x2, 0, 1], 2],
-                             l$5];
+                             l$5] /*<<set.ml:565:12>>*/ ;
                     }
                    }
                   }
@@ -11120,31 +11307,32 @@
                 /*<<set.ml:573:27>>*/ match$0 = sub((n - nl | 0) - 1 | 0, l$1),
                l$2 = match$0[2],
                right = match$0[1];
-               /*<<set.ml:574:12>>*/ return [0, create(left, mid, right), l$2];
+               /*<<set.ml:574:12>>*/ return [0, create(left, mid, right), l$2] /*<<set.ml:574:12>>*/ ;
               /*<<set.ml:574:36>>*/ };
            /*<<set.ml:576:10>>*/ return sub
                    ( /*<<set.ml:576:15>>*/ caml_call1(Stdlib_List[1], l$0),
                     l$0)
-                  [1];
+                  [1] /*<<set.ml:576:10>>*/ ;
          }
          var x4 = _q_[1];
           /*<<set.ml:587:39>>*/ return add
-                 (x4, add(x3, add(x2, add(x1, singleton(x0)))));
+                 (x4, add(x3, add(x2, add(x1, singleton(x0))))) /*<<set.ml:588:58>>*/ ;
          /*<<set.ml:588:58>>*/ }
         function add_seq(i, m){
           /*<<set.ml:591:6>>*/ return  /*<<set.ml:591:6>>*/ caml_call3
                  (Stdlib_Seq[5],
                   function(s, x){
-                    /*<<set.ml:591:32>>*/ return add(x, s);
+                    /*<<set.ml:591:32>>*/ return add(x, s) /*<<set.ml:591:39>>*/ ;
                    /*<<set.ml:591:39>>*/ },
                   m,
-                  i);
+                  i) /*<<set.ml:591:44>>*/ ;
          /*<<set.ml:591:44>>*/ }
         function of_seq(i){
-          /*<<set.ml:593:19>>*/ return add_seq(i, empty);
+          /*<<set.ml:593:19>>*/ return add_seq(i, empty) /*<<set.ml:593:34>>*/ ;
          /*<<set.ml:593:34>>*/ }
         function seq_of_enum(c, param){
-          /*<<set.ml:595:32>>*/ if(! c)  /*<<set.ml:596:15>>*/ return 0;
+          /*<<set.ml:595:32>>*/ if(! c)
+           /*<<set.ml:596:15>>*/ return 0 /*<<set.ml:596:15>>*/ ;
          var
           rest = c[3],
           t = c[2],
@@ -11152,18 +11340,18 @@
            /*<<set.ml:597:55>>*/ _l_ = cons_enum(t, rest);
           /*<<set.ml:597:29>>*/ return [0,
                  x,
-                 function(_m_){ /*<<?>>*/ return seq_of_enum(_l_, _m_);}];
+                 function(_m_){ /*<<?>>*/ return seq_of_enum(_l_, _m_);}] /*<<set.ml:597:29>>*/ ;
          /*<<set.ml:597:74>>*/ }
         function to_seq(c){
           /*<<set.ml:599:19>>*/  /*<<set.ml:599:32>>*/ var
           _j_ = cons_enum(c, 0);
           /*<<set.ml:599:32>>*/ return function(_k_){
-           /*<<?>>*/ return seq_of_enum(_j_, _k_);};
+           /*<<?>>*/ return seq_of_enum(_j_, _k_);} /*<<set.ml:599:32>>*/ ;
          /*<<set.ml:599:49>>*/ }
         function snoc_enum(s, e){
           /*<<set.ml:602:6>>*/ var s$0 = s, e$0 = e;
           /*<<set.ml:602:6>>*/ for(;;){
-          if(! s$0)  /*<<set.ml:603:17>>*/ return e$0;
+          if(! s$0)  /*<<set.ml:603:17>>*/ return e$0 /*<<set.ml:603:17>>*/ ;
            /*<<set.ml:604:37>>*/ var
            r = s$0[3],
            v = s$0[2],
@@ -11174,7 +11362,8 @@
          }
          /*<<set.ml:604:52>>*/ }
         function rev_seq_of_enum(c, param){
-          /*<<set.ml:606:36>>*/ if(! c)  /*<<set.ml:607:15>>*/ return 0;
+          /*<<set.ml:606:36>>*/ if(! c)
+           /*<<set.ml:607:15>>*/ return 0 /*<<set.ml:607:15>>*/ ;
          var
           rest = c[3],
           t = c[2],
@@ -11182,13 +11371,13 @@
            /*<<set.ml:608:59>>*/ _h_ = snoc_enum(t, rest);
           /*<<set.ml:608:29>>*/ return [0,
                  x,
-                 function(_i_){ /*<<?>>*/ return rev_seq_of_enum(_h_, _i_);}];
+                 function(_i_){ /*<<?>>*/ return rev_seq_of_enum(_h_, _i_);}] /*<<set.ml:608:29>>*/ ;
          /*<<set.ml:608:78>>*/ }
         function to_rev_seq(c){
           /*<<set.ml:610:23>>*/  /*<<set.ml:610:40>>*/ var
           _f_ = snoc_enum(c, 0);
           /*<<set.ml:610:40>>*/ return function(_g_){
-           /*<<?>>*/ return rev_seq_of_enum(_f_, _g_);};
+           /*<<?>>*/ return rev_seq_of_enum(_f_, _g_);} /*<<set.ml:610:40>>*/ ;
          /*<<set.ml:610:57>>*/ }
         function to_seq_from(low, s){
           /*<<set.ml:613:6>>*/ a:
@@ -11220,7 +11409,7 @@
           var _d_ = [0, v, r, c];
          }
           /*<<set.ml:622:19>>*/ return function(_e_){
-           /*<<?>>*/ return seq_of_enum(_d_, _e_);};
+           /*<<?>>*/ return seq_of_enum(_d_, _e_);} /*<<set.ml:622:19>>*/ ;
          /*<<set.ml:622:34>>*/ }
         return [0,
                 empty,
@@ -11314,19 +11503,20 @@
       [0,
        function(Ord){
         function height(param){
-          /*<<map.ml:81:17>>*/ if(! param)  /*<<map.ml:82:17>>*/ return 0;
+          /*<<map.ml:81:17>>*/ if(! param)
+           /*<<map.ml:82:17>>*/ return 0 /*<<map.ml:82:17>>*/ ;
          var h = param[5];
-          /*<<map.ml:83:20>>*/ return h;
+          /*<<map.ml:83:20>>*/ return h /*<<map.ml:83:20>>*/ ;
          /*<<map.ml:83:21>>*/ }
         function create(l, x, d, r){
           /*<<map.ml:86:6>>*/ var
            /*<<map.ml:86:15>>*/ hl = height(l),
            /*<<map.ml:86:33>>*/ hr = height(r),
           _K_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
-          /*<<map.ml:87:10>>*/ return [0, l, x, d, r, _K_];
+          /*<<map.ml:87:10>>*/ return [0, l, x, d, r, _K_] /*<<map.ml:87:10>>*/ ;
          /*<<map.ml:87:65>>*/ }
         function singleton(x, d){
-          /*<<map.ml:89:24>>*/ return [0, 0, x, d, 0, 1];
+          /*<<map.ml:89:24>>*/ return [0, 0, x, d, 0, 1] /*<<map.ml:89:28>>*/ ;
          /*<<map.ml:89:59>>*/ }
         function bal(l, x, d, r){
           /*<<map.ml:92:6>>*/ if(l) var h = l[5], hl = h; else var hl = 0;
@@ -11334,7 +11524,7 @@
          if((hr + 2 | 0) < hl){
           if(! l)
             /*<<map.ml:96:19>>*/ return  /*<<map.ml:96:19>>*/ caml_call1
-                   (Stdlib[1], cst_Map_bal$0);
+                   (Stdlib[1], cst_Map_bal$0) /*<<map.ml:119:67>>*/ ;
            /*<<map.ml:98:28>>*/ var
            lr = l[4],
            ld = l[3],
@@ -11343,10 +11533,10 @@
             /*<<map.ml:98:28>>*/ _F_ = height(lr);
           if(_F_ <= height(ll))
             /*<<map.ml:99:30>>*/ return create
-                   (ll, lv, ld, create(lr, x, d, r));
+                   (ll, lv, ld, create(lr, x, d, r)) /*<<map.ml:119:67>>*/ ;
           if(! lr)
             /*<<map.ml:102:25>>*/ return  /*<<map.ml:102:25>>*/ caml_call1
-                   (Stdlib[1], cst_Map_bal);
+                   (Stdlib[1], cst_Map_bal) /*<<map.ml:119:67>>*/ ;
            /*<<map.ml:104:55>>*/ var
            lrr = lr[4],
            lrd = lr[3],
@@ -11354,15 +11544,15 @@
            lrl = lr[1],
             /*<<map.ml:104:55>>*/ _G_ = create(lrr, x, d, r);
            /*<<map.ml:104:55>>*/ return create
-                  (create(ll, lv, ld, lrl), lrv, lrd, _G_);
+                  (create(ll, lv, ld, lrl), lrv, lrd, _G_) /*<<map.ml:119:67>>*/ ;
          }
          if((hl + 2 | 0) >= hr){
           var _J_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
-           /*<<map.ml:119:12>>*/ return [0, l, x, d, r, _J_];
+           /*<<map.ml:119:12>>*/ return [0, l, x, d, r, _J_] /*<<map.ml:119:12>>*/ ;
          }
          if(! r)
            /*<<map.ml:108:19>>*/ return  /*<<map.ml:108:19>>*/ caml_call1
-                  (Stdlib[1], cst_Map_bal$2);
+                  (Stdlib[1], cst_Map_bal$2) /*<<map.ml:119:67>>*/ ;
           /*<<map.ml:110:28>>*/ var
           rr = r[4],
           rd = r[3],
@@ -11371,10 +11561,10 @@
            /*<<map.ml:110:28>>*/ _H_ = height(rl);
          if(_H_ <= height(rr))
            /*<<map.ml:111:14>>*/ return create
-                  (create(l, x, d, rl), rv, rd, rr);
+                  (create(l, x, d, rl), rv, rd, rr) /*<<map.ml:119:67>>*/ ;
          if(! rl)
            /*<<map.ml:114:25>>*/ return  /*<<map.ml:114:25>>*/ caml_call1
-                  (Stdlib[1], cst_Map_bal$1);
+                  (Stdlib[1], cst_Map_bal$1) /*<<map.ml:119:67>>*/ ;
           /*<<map.ml:116:52>>*/ var
           rlr = rl[4],
           rld = rl[3],
@@ -11382,15 +11572,15 @@
           rll = rl[1],
            /*<<map.ml:116:52>>*/ _I_ = create(rlr, rv, rd, rr);
           /*<<map.ml:116:52>>*/ return create
-                 (create(l, x, d, rll), rlv, rld, _I_);
+                 (create(l, x, d, rll), rlv, rld, _I_) /*<<map.ml:119:67>>*/ ;
          /*<<map.ml:119:67>>*/ }
         var empty = 0;
         function is_empty(param){
-          /*<<map.ml:123:19>>*/ return param ? 0 : 1;
+          /*<<map.ml:123:19>>*/ return param ? 0 : 1 /*<<map.ml:123:54>>*/ ;
          /*<<map.ml:123:54>>*/ }
         function add(x, data, m){
           /*<<?>>*/ if(! m)
-           /*<<map.ml:127:14>>*/ return [0, 0, x, data, 0, 1];
+           /*<<map.ml:127:14>>*/ return [0, 0, x, data, 0, 1] /*<<map.ml:127:14>>*/ ;
           /*<<map.ml:129:18>>*/ var
           h = m[5],
           r = m[4],
@@ -11423,7 +11613,8 @@
            l = param$0[1],
             /*<<map.ml:143:18>>*/ c =
               /*<<map.ml:143:18>>*/ caml_call2(Ord[1], x, v);
-           /*<<map.ml:144:10>>*/ if(0 === c)  /*<<map.ml:144:24>>*/ return d;
+           /*<<map.ml:144:10>>*/ if(0 === c)
+            /*<<map.ml:144:24>>*/ return d /*<<map.ml:144:24>>*/ ;
           var r$0 = 0 <= c ? r : l;
           param$0 = r$0;
          }
@@ -11443,7 +11634,8 @@
            ( /*<<map.ml:160:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, d0 = d0$1, param = l$0;
            for(;;){
-            if(! param)  /*<<map.ml:149:10>>*/ return [0, v0, d0];
+            if(! param)
+              /*<<map.ml:149:10>>*/ return [0, v0, d0] /*<<map.ml:149:10>>*/ ;
             var r = param[4], d0$0 = param[3], v0$0 = param[2], l = param[1];
              /*<<map.ml:151:13>>*/ if
              ( /*<<map.ml:151:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; d0 = d0$0; param = l;}
@@ -11458,7 +11650,8 @@
         function find_first_opt(f, param$0){
          var param$1 = param$0;
          for(;;){
-          if(! param$1)  /*<<map.ml:176:10>>*/ return 0;
+          if(! param$1)
+            /*<<map.ml:176:10>>*/ return 0 /*<<map.ml:176:10>>*/ ;
           var
            r$0 = param$1[4],
            d0$1 = param$1[3],
@@ -11468,7 +11661,8 @@
            ( /*<<map.ml:178:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, d0 = d0$1, param = l$0;
            for(;;){
-            if(! param)  /*<<map.ml:167:10>>*/ return [0, [0, v0, d0]];
+            if(! param)
+              /*<<map.ml:167:10>>*/ return [0, [0, v0, d0]] /*<<map.ml:167:10>>*/ ;
             var r = param[4], d0$0 = param[3], v0$0 = param[2], l = param[1];
              /*<<map.ml:169:13>>*/ if
              ( /*<<map.ml:169:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; d0 = d0$0; param = l;}
@@ -11495,7 +11689,8 @@
            ( /*<<map.ml:196:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, d0 = d0$1, param = r$0;
            for(;;){
-            if(! param)  /*<<map.ml:185:10>>*/ return [0, v0, d0];
+            if(! param)
+              /*<<map.ml:185:10>>*/ return [0, v0, d0] /*<<map.ml:185:10>>*/ ;
             var r = param[4], d0$0 = param[3], v0$0 = param[2], l = param[1];
              /*<<map.ml:187:13>>*/ if
              ( /*<<map.ml:187:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; d0 = d0$0; param = r;}
@@ -11510,7 +11705,8 @@
         function find_last_opt(f, param$0){
          var param$1 = param$0;
          for(;;){
-          if(! param$1)  /*<<map.ml:212:10>>*/ return 0;
+          if(! param$1)
+            /*<<map.ml:212:10>>*/ return 0 /*<<map.ml:212:10>>*/ ;
           var
            r$0 = param$1[4],
            d0$1 = param$1[3],
@@ -11520,7 +11716,8 @@
            ( /*<<map.ml:214:13>>*/ caml_call1(f, v0$1)){
            var v0 = v0$1, d0 = d0$1, param = r$0;
            for(;;){
-            if(! param)  /*<<map.ml:203:10>>*/ return [0, [0, v0, d0]];
+            if(! param)
+              /*<<map.ml:203:10>>*/ return [0, [0, v0, d0]] /*<<map.ml:203:10>>*/ ;
             var r = param[4], d0$0 = param[3], v0$0 = param[2], l = param[1];
              /*<<map.ml:205:13>>*/ if
              ( /*<<map.ml:205:13>>*/ caml_call1(f, v0$0)){v0 = v0$0; d0 = d0$0; param = r;}
@@ -11535,7 +11732,8 @@
         function find_opt(x, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<map.ml:221:10>>*/ return 0;
+          if(! param$0)
+            /*<<map.ml:221:10>>*/ return 0 /*<<map.ml:221:10>>*/ ;
            /*<<map.ml:223:18>>*/ var
            r = param$0[4],
            d = param$0[3],
@@ -11544,7 +11742,7 @@
             /*<<map.ml:223:18>>*/ c =
               /*<<map.ml:223:18>>*/ caml_call2(Ord[1], x, v);
            /*<<map.ml:224:10>>*/ if(0 === c)
-            /*<<map.ml:224:24>>*/ return [0, d];
+            /*<<map.ml:224:24>>*/ return [0, d] /*<<map.ml:224:24>>*/ ;
           var r$0 = 0 <= c ? r : l;
           param$0 = r$0;
          }
@@ -11552,7 +11750,8 @@
         function mem(x, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<map.ml:229:10>>*/ return 0;
+          if(! param$0)
+            /*<<map.ml:229:10>>*/ return 0 /*<<map.ml:229:10>>*/ ;
            /*<<map.ml:231:18>>*/ var
            r = param$0[4],
            v = param$0[2],
@@ -11574,7 +11773,7 @@
           var l = param$0[1];
           if(! l){
            var d = param$0[3], v = param$0[2];
-            /*<<map.ml:236:32>>*/ return [0, v, d];
+            /*<<map.ml:236:32>>*/ return [0, v, d] /*<<map.ml:236:32>>*/ ;
           }
           param$0 = l;
          }
@@ -11582,11 +11781,12 @@
         function min_binding_opt(param){
           /*<<map.ml:239:30>>*/ var param$0 = param;
           /*<<map.ml:239:30>>*/ for(;;){
-          if(! param$0)  /*<<map.ml:240:17>>*/ return 0;
+          if(! param$0)
+            /*<<map.ml:240:17>>*/ return 0 /*<<map.ml:240:17>>*/ ;
           var l = param$0[1];
           if(! l){
            var d = param$0[3], v = param$0[2];
-            /*<<map.ml:241:32>>*/ return [0, [0, v, d]];
+            /*<<map.ml:241:32>>*/ return [0, [0, v, d]] /*<<map.ml:241:32>>*/ ;
           }
           param$0 = l;
          }
@@ -11599,7 +11799,7 @@
                   (Stdlib[8], 1);
           if(! param$0[4]){
            var d = param$0[3], v = param$0[2];
-            /*<<map.ml:246:32>>*/ return [0, v, d];
+            /*<<map.ml:246:32>>*/ return [0, v, d] /*<<map.ml:246:32>>*/ ;
           }
           var r = param$0[4];
           param$0 = r;
@@ -11608,10 +11808,11 @@
         function max_binding_opt(param){
           /*<<map.ml:249:30>>*/ var param$0 = param;
           /*<<map.ml:249:30>>*/ for(;;){
-          if(! param$0)  /*<<map.ml:250:17>>*/ return 0;
+          if(! param$0)
+            /*<<map.ml:250:17>>*/ return 0 /*<<map.ml:250:17>>*/ ;
           if(! param$0[4]){
            var d = param$0[3], v = param$0[2];
-            /*<<map.ml:251:32>>*/ return [0, [0, v, d]];
+            /*<<map.ml:251:32>>*/ return [0, [0, v, d]] /*<<map.ml:251:32>>*/ ;
           }
           var r = param$0[4];
           param$0 = r;
@@ -11620,26 +11821,28 @@
         function remove_min_binding(param){
           /*<<map.ml:254:33>>*/ if(! param)
            /*<<map.ml:255:17>>*/ return  /*<<map.ml:255:17>>*/ caml_call1
-                  (Stdlib[1], cst_Map_remove_min_elt);
+                  (Stdlib[1], cst_Map_remove_min_elt) /*<<map.ml:257:61>>*/ ;
          var l = param[1];
          if(l){
           var r = param[4], d = param[3], v = param[2];
-           /*<<map.ml:257:29>>*/ return bal(remove_min_binding(l), v, d, r);
+           /*<<map.ml:257:29>>*/ return bal(remove_min_binding(l), v, d, r) /*<<map.ml:257:61>>*/ ;
          }
          var r$0 = param[4];
-          /*<<map.ml:256:29>>*/ return r$0;
+          /*<<map.ml:256:29>>*/ return r$0 /*<<map.ml:256:29>>*/ ;
          /*<<map.ml:257:61>>*/ }
         function _d_(t1, t2){
-          /*<<map.ml:260:6>>*/ if(! t1)  /*<<map.ml:261:22>>*/ return t2;
-         if(! t2)  /*<<map.ml:262:22>>*/ return t1;
+          /*<<map.ml:260:6>>*/ if(! t1)
+           /*<<map.ml:261:22>>*/ return t2 /*<<map.ml:261:22>>*/ ;
+         if(! t2)  /*<<map.ml:262:22>>*/ return t1 /*<<map.ml:262:22>>*/ ;
           /*<<map.ml:264:23>>*/ var
            /*<<map.ml:264:23>>*/ match = min_binding(t2),
           d = match[2],
           x = match[1];
-          /*<<map.ml:265:21>>*/ return bal(t1, x, d, remove_min_binding(t2));
+          /*<<map.ml:265:21>>*/ return bal(t1, x, d, remove_min_binding(t2)) /*<<map.ml:265:44>>*/ ;
          /*<<map.ml:265:44>>*/ }
         function remove(x, m){
-          /*<<?>>*/ if(! m)  /*<<map.ml:269:10>>*/ return 0;
+          /*<<?>>*/ if(! m)
+           /*<<map.ml:269:10>>*/ return 0 /*<<map.ml:269:10>>*/ ;
           /*<<map.ml:271:18>>*/ var
           r = m[4],
           d = m[3],
@@ -11648,7 +11851,7 @@
            /*<<map.ml:271:18>>*/ c =
              /*<<map.ml:271:18>>*/ caml_call2(Ord[1], x, v);
           /*<<map.ml:272:10>>*/ if(0 === c)
-           /*<<map.ml:272:24>>*/ return _d_(l, r);
+           /*<<map.ml:272:24>>*/ return _d_(l, r) /*<<map.ml:272:24>>*/ ;
          if(0 <= c){
            /*<<map.ml:276:21>>*/  /*<<map.ml:276:21>>*/ var rr = remove(x, r);
           return r === rr ? m : bal(l, v, d, rr);
@@ -11660,9 +11863,10 @@
           /*<<?>>*/ if(! m){
            /*<<map.ml:280:22>>*/  /*<<map.ml:280:22>>*/ var
            match$0 =  /*<<map.ml:280:22>>*/ caml_call1(f, 0);
-          if(! match$0)  /*<<map.ml:281:20>>*/ return 0;
+          if(! match$0)
+            /*<<map.ml:281:20>>*/ return 0 /*<<map.ml:281:20>>*/ ;
           var data$0 = match$0[1];
-           /*<<map.ml:282:29>>*/ return [0, 0, x, data$0, 0, 1];
+           /*<<map.ml:282:29>>*/ return [0, 0, x, data$0, 0, 1] /*<<map.ml:282:29>>*/ ;
          }
           /*<<map.ml:285:18>>*/ var
           h = m[5],
@@ -11675,7 +11879,8 @@
           /*<<map.ml:286:10>>*/ if(0 === c){
            /*<<map.ml:287:18>>*/  /*<<map.ml:287:18>>*/ var
            match =  /*<<map.ml:287:18>>*/ caml_call1(f, [0, d]);
-          if(! match)  /*<<map.ml:288:22>>*/ return _d_(l, r);
+          if(! match)
+            /*<<map.ml:288:22>>*/ return _d_(l, r) /*<<map.ml:288:22>>*/ ;
           var data = match[1];
           return d === data ? m : [0, l, x, data, r, h];
          }
@@ -11691,16 +11896,17 @@
         function add_to_list(x, data, m){
          function add(param){
            /*<<map.ml:299:16>>*/ if(! param)
-            /*<<map.ml:299:33>>*/ return [0, [0, data, 0]];
+            /*<<map.ml:299:33>>*/ return [0, [0, data, 0]] /*<<map.ml:299:33>>*/ ;
           var l = param[1];
-           /*<<map.ml:299:57>>*/ return [0, [0, data, l]];
+           /*<<map.ml:299:57>>*/ return [0, [0, data, l]] /*<<map.ml:299:57>>*/ ;
           /*<<map.ml:299:73>>*/ }
-          /*<<map.ml:300:6>>*/ return update(x, add, m);
+          /*<<map.ml:300:6>>*/ return update(x, add, m) /*<<map.ml:300:20>>*/ ;
          /*<<map.ml:300:20>>*/ }
         function iter(f, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<map.ml:303:17>>*/ return 0;
+          if(! param$0)
+            /*<<map.ml:303:17>>*/ return 0 /*<<map.ml:303:17>>*/ ;
           var r = param$0[4], d = param$0[3], v = param$0[2], l = param$0[1];
            /*<<map.ml:305:10>>*/ iter(f, l);
            /*<<map.ml:305:20>>*/  /*<<map.ml:305:20>>*/ caml_call2(f, v, d);
@@ -11708,7 +11914,8 @@
          }
         }
         function map(f, param){
-          /*<<?>>*/ if(! param)  /*<<map.ml:309:10>>*/ return 0;
+          /*<<?>>*/ if(! param)
+           /*<<map.ml:309:10>>*/ return 0 /*<<map.ml:309:10>>*/ ;
           /*<<map.ml:311:19>>*/ var
           h = param[5],
           r = param[4],
@@ -11718,10 +11925,11 @@
            /*<<map.ml:311:19>>*/ l$0 = map(f, l),
            /*<<map.ml:312:19>>*/ d$0 =  /*<<map.ml:312:19>>*/ caml_call1(f, d),
            /*<<map.ml:313:19>>*/ r$0 = map(f, r);
-          /*<<map.ml:314:14>>*/ return [0, l$0, v, d$0, r$0, h];
+          /*<<map.ml:314:14>>*/ return [0, l$0, v, d$0, r$0, h] /*<<map.ml:314:14>>*/ ;
         }
         function mapi(f, param){
-          /*<<?>>*/ if(! param)  /*<<map.ml:318:10>>*/ return 0;
+          /*<<?>>*/ if(! param)
+           /*<<map.ml:318:10>>*/ return 0 /*<<map.ml:318:10>>*/ ;
           /*<<map.ml:320:19>>*/ var
           h = param[5],
           r = param[4],
@@ -11732,12 +11940,13 @@
            /*<<map.ml:321:19>>*/ d$0 =
              /*<<map.ml:321:19>>*/ caml_call2(f, v, d),
            /*<<map.ml:322:19>>*/ r$0 = mapi(f, r);
-          /*<<map.ml:323:14>>*/ return [0, l$0, v, d$0, r$0, h];
+          /*<<map.ml:323:14>>*/ return [0, l$0, v, d$0, r$0, h] /*<<map.ml:323:14>>*/ ;
         }
         function fold(f, m, accu){
           /*<<map.ml:326:6>>*/ var m$0 = m, accu$0 = accu;
           /*<<map.ml:326:6>>*/ for(;;){
-          if(! m$0)  /*<<map.ml:327:17>>*/ return accu$0;
+          if(! m$0)
+            /*<<map.ml:327:17>>*/ return accu$0 /*<<map.ml:327:17>>*/ ;
            /*<<map.ml:329:19>>*/ var
            r = m$0[4],
            d = m$0[3],
@@ -11752,7 +11961,8 @@
         function for_all(p, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<map.ml:332:17>>*/ return 1;
+          if(! param$0)
+            /*<<map.ml:332:17>>*/ return 1 /*<<map.ml:332:17>>*/ ;
            /*<<map.ml:333:29>>*/ var
            r = param$0[4],
            d = param$0[3],
@@ -11768,13 +11978,14 @@
           }
           else
            var _D_ = _B_;
-           /*<<map.ml:333:38>>*/ return _D_;
+           /*<<map.ml:333:38>>*/ return _D_ /*<<map.ml:333:38>>*/ ;
          }
         }
         function exists(p, param){
          var param$0 = param;
          for(;;){
-          if(! param$0)  /*<<map.ml:336:17>>*/ return 0;
+          if(! param$0)
+            /*<<map.ml:336:17>>*/ return 0 /*<<map.ml:336:17>>*/ ;
            /*<<map.ml:337:29>>*/ var
            r = param$0[4],
            d = param$0[3],
@@ -11790,23 +12001,26 @@
             /*<<map.ml:337:38>>*/ if(! _A_){param$0 = r; continue;}
            var _z_ = _A_;
           }
-           /*<<map.ml:337:29>>*/ return _z_;
+           /*<<map.ml:337:29>>*/ return _z_ /*<<map.ml:337:29>>*/ ;
          }
         }
         function add_min_binding(k, x, param){
-          /*<<?>>*/ if(! param)  /*<<map.ml:348:17>>*/ return singleton(k, x);
+          /*<<?>>*/ if(! param)
+           /*<<map.ml:348:17>>*/ return singleton(k, x) /*<<map.ml:348:17>>*/ ;
          var r = param[4], d = param[3], v = param[2], l = param[1];
-          /*<<map.ml:350:8>>*/ return bal(add_min_binding(k, x, l), v, d, r);
+          /*<<map.ml:350:8>>*/ return bal(add_min_binding(k, x, l), v, d, r) /*<<map.ml:350:8>>*/ ;
         }
         function add_max_binding(k, x, param){
-          /*<<?>>*/ if(! param)  /*<<map.ml:353:17>>*/ return singleton(k, x);
+          /*<<?>>*/ if(! param)
+           /*<<map.ml:353:17>>*/ return singleton(k, x) /*<<map.ml:353:17>>*/ ;
          var r = param[4], d = param[3], v = param[2], l = param[1];
-          /*<<map.ml:355:18>>*/ return bal(l, v, d, add_max_binding(k, x, r));
+          /*<<map.ml:355:18>>*/ return bal(l, v, d, add_max_binding(k, x, r)) /*<<map.ml:355:18>>*/ ;
         }
         function join(l, v, d, r){
           /*<<map.ml:361:6>>*/ if(! l)
-           /*<<map.ml:362:22>>*/ return add_min_binding(v, d, r);
-         if(! r)  /*<<map.ml:363:22>>*/ return add_max_binding(v, d, l);
+           /*<<map.ml:362:22>>*/ return add_min_binding(v, d, r) /*<<map.ml:368:24>>*/ ;
+         if(! r)
+           /*<<map.ml:363:22>>*/ return add_max_binding(v, d, l) /*<<map.ml:368:24>>*/ ;
          var
           rh = r[5],
           rr = r[4],
@@ -11825,25 +12039,27 @@
                    | 0)
                    < rh
                    ? bal(join(l, v, d, rl), rv, rd, rr)
-                   : create(l, v, d, r);
+                   : create(l, v, d, r) /*<<map.ml:368:24>>*/ ;
          /*<<map.ml:368:24>>*/ }
         function concat(t1, t2){
-          /*<<map.ml:375:6>>*/ if(! t1)  /*<<map.ml:376:22>>*/ return t2;
-         if(! t2)  /*<<map.ml:377:22>>*/ return t1;
+          /*<<map.ml:375:6>>*/ if(! t1)
+           /*<<map.ml:376:22>>*/ return t2 /*<<map.ml:376:22>>*/ ;
+         if(! t2)  /*<<map.ml:377:22>>*/ return t1 /*<<map.ml:377:22>>*/ ;
           /*<<map.ml:379:23>>*/ var
            /*<<map.ml:379:23>>*/ match = min_binding(t2),
           d = match[2],
           x = match[1];
-          /*<<map.ml:380:22>>*/ return join(t1, x, d, remove_min_binding(t2));
+          /*<<map.ml:380:22>>*/ return join(t1, x, d, remove_min_binding(t2)) /*<<map.ml:380:45>>*/ ;
          /*<<map.ml:380:45>>*/ }
         function concat_or_join(t1, v, d, t2){
           /*<<map.ml:383:6>>*/ if(! d)
-           /*<<map.ml:385:16>>*/ return concat(t1, t2);
+           /*<<map.ml:385:16>>*/ return concat(t1, t2) /*<<map.ml:385:28>>*/ ;
          var d$0 = d[1];
-          /*<<map.ml:384:18>>*/ return join(t1, v, d$0, t2);
+          /*<<map.ml:384:18>>*/ return join(t1, v, d$0, t2) /*<<map.ml:385:28>>*/ ;
          /*<<map.ml:385:28>>*/ }
         function split(x, param){
-          /*<<?>>*/ if(! param)  /*<<map.ml:389:10>>*/ return _a_;
+          /*<<?>>*/ if(! param)
+           /*<<map.ml:389:10>>*/ return _a_ /*<<map.ml:389:10>>*/ ;
           /*<<map.ml:391:18>>*/ var
           r = param[4],
           d = param[3],
@@ -11852,21 +12068,21 @@
            /*<<map.ml:391:18>>*/ c =
              /*<<map.ml:391:18>>*/ caml_call2(Ord[1], x, v);
           /*<<map.ml:392:10>>*/ if(0 === c)
-           /*<<map.ml:392:24>>*/ return [0, l, [0, d], r];
+           /*<<map.ml:392:24>>*/ return [0, l, [0, d], r] /*<<map.ml:392:24>>*/ ;
          if(0 <= c){
            /*<<map.ml:396:33>>*/ var
             /*<<map.ml:396:33>>*/ match = split(x, r),
            rr = match[3],
            pres = match[2],
            lr = match[1];
-           /*<<map.ml:396:46>>*/ return [0, join(l, v, d, lr), pres, rr];
+           /*<<map.ml:396:46>>*/ return [0, join(l, v, d, lr), pres, rr] /*<<map.ml:396:46>>*/ ;
          }
           /*<<map.ml:394:33>>*/ var
            /*<<map.ml:394:33>>*/ match$0 = split(x, l),
           rl = match$0[3],
           pres$0 = match$0[2],
           ll = match$0[1];
-          /*<<map.ml:394:46>>*/ return [0, ll, pres$0, join(rl, v, d, r)];
+          /*<<map.ml:394:46>>*/ return [0, ll, pres$0, join(rl, v, d, r)] /*<<map.ml:394:46>>*/ ;
         }
         function merge(f, s1, s2){
           /*<<map.ml:399:6>>*/ if(s1){
@@ -11881,10 +12097,10 @@
              /*<<map.ml:403:44>>*/ _v_ =
                /*<<map.ml:403:44>>*/ caml_call3(f, v1, [0, d1], d2);
             /*<<map.ml:403:64>>*/ return concat_or_join
-                   (merge(f, l1, l2), v1, _v_, _u_);
+                   (merge(f, l1, l2), v1, _v_, _u_) /*<<map.ml:408:22>>*/ ;
           }
          }
-         else if(! s2)  /*<<map.ml:400:26>>*/ return 0;
+         else if(! s2)  /*<<map.ml:400:26>>*/ return 0 /*<<map.ml:400:26>>*/ ;
          if(! s2)
            /*<<map.ml:408:10>>*/ throw  /*<<map.ml:408:10>>*/ caml_maybe_attach_backtrace
                  ([0, Assert_failure, _b_], 1);
@@ -11901,7 +12117,7 @@
            /*<<map.ml:406:44>>*/ _x_ =
              /*<<map.ml:406:44>>*/ caml_call3(f, v2, d1$0, [0, d2$0]);
           /*<<map.ml:406:64>>*/ return concat_or_join
-                 (merge(f, l1$0, l2$0), v2, _x_, _w_);
+                 (merge(f, l1$0, l2$0), v2, _x_, _w_) /*<<map.ml:408:22>>*/ ;
          /*<<map.ml:408:22>>*/ }
         function union(f, s1, s2){
           /*<<map.ml:411:6>>*/ if(s1){
@@ -11926,13 +12142,13 @@
               /*<<map.ml:417:20>>*/ l = union(f, l1, l2$0),
               /*<<map.ml:417:42>>*/ r = union(f, r1, r2$0);
              /*<<map.ml:418:12>>*/ if(! d2$0)
-              /*<<map.ml:419:22>>*/ return join(l, v1, d1, r);
+              /*<<map.ml:419:22>>*/ return join(l, v1, d1, r) /*<<map.ml:426:59>>*/ ;
             var d2$1 = d2$0[1];
              /*<<map.ml:420:25>>*/ return concat_or_join
                     (l,
                      v1,
                       /*<<map.ml:420:45>>*/ caml_call3(f, v1, d1, d2$1),
-                     r);
+                     r) /*<<map.ml:426:59>>*/ ;
            }
             /*<<map.ml:422:31>>*/ var
              /*<<map.ml:422:31>>*/ match$0 = split(v2, s1),
@@ -11942,22 +12158,23 @@
              /*<<map.ml:423:20>>*/ l$0 = union(f, l1$0, l2),
              /*<<map.ml:423:42>>*/ r$0 = union(f, r1$0, r2);
             /*<<map.ml:424:12>>*/ if(! d1$0)
-             /*<<map.ml:425:22>>*/ return join(l$0, v2, d2, r$0);
+             /*<<map.ml:425:22>>*/ return join(l$0, v2, d2, r$0) /*<<map.ml:426:59>>*/ ;
            var d1$1 = d1$0[1];
             /*<<map.ml:426:25>>*/ return concat_or_join
                    (l$0,
                     v2,
                      /*<<map.ml:426:45>>*/ caml_call3(f, v2, d1$1, d2),
-                    r$0);
+                    r$0) /*<<map.ml:426:59>>*/ ;
           }
           var s = s1;
          }
          else
           var s = s2;
-          /*<<map.ml:412:35>>*/ return s;
+          /*<<map.ml:412:35>>*/ return s /*<<map.ml:412:35>>*/ ;
          /*<<map.ml:426:59>>*/ }
         function filter(p, m){
-          /*<<?>>*/ if(! m)  /*<<map.ml:429:17>>*/ return 0;
+          /*<<?>>*/ if(! m)
+           /*<<map.ml:429:17>>*/ return 0 /*<<map.ml:429:17>>*/ ;
           /*<<map.ml:432:19>>*/ var
           r = m[4],
           d = m[3],
@@ -11968,12 +12185,14 @@
              /*<<map.ml:433:20>>*/ caml_call2(p, v, d),
            /*<<map.ml:434:19>>*/ r$0 = filter(p, r);
           /*<<map.ml:435:10>>*/ if(! pvd)
-           /*<<map.ml:436:15>>*/ return concat(l$0, r$0);
-         if(l === l$0 && r === r$0)  /*<<map.ml:435:45>>*/ return m;
-          /*<<map.ml:435:52>>*/ return join(l$0, v, d, r$0);
+           /*<<map.ml:436:15>>*/ return concat(l$0, r$0) /*<<map.ml:436:15>>*/ ;
+         if(l === l$0 && r === r$0)
+           /*<<map.ml:435:45>>*/ return m /*<<map.ml:435:45>>*/ ;
+          /*<<map.ml:435:52>>*/ return join(l$0, v, d, r$0) /*<<map.ml:435:52>>*/ ;
         }
         function filter_map(f, param){
-          /*<<?>>*/ if(! param)  /*<<map.ml:439:17>>*/ return 0;
+          /*<<?>>*/ if(! param)
+           /*<<map.ml:439:17>>*/ return 0 /*<<map.ml:439:17>>*/ ;
           /*<<map.ml:442:19>>*/ var
           r = param[4],
           d = param[3],
@@ -11984,12 +12203,13 @@
              /*<<map.ml:443:20>>*/ caml_call2(f, v, d),
            /*<<map.ml:444:19>>*/ r$0 = filter_map(f, r);
           /*<<map.ml:445:10>>*/ if(! fvd)
-           /*<<map.ml:447:22>>*/ return concat(l$0, r$0);
+           /*<<map.ml:447:22>>*/ return concat(l$0, r$0) /*<<map.ml:447:22>>*/ ;
          var d$0 = fvd[1];
-          /*<<map.ml:446:25>>*/ return join(l$0, v, d$0, r$0);
+          /*<<map.ml:446:25>>*/ return join(l$0, v, d$0, r$0) /*<<map.ml:446:25>>*/ ;
         }
         function partition(p, param){
-          /*<<?>>*/ if(! param)  /*<<map.ml:451:17>>*/ return _c_;
+          /*<<?>>*/ if(! param)
+           /*<<map.ml:451:17>>*/ return _c_ /*<<map.ml:451:17>>*/ ;
           /*<<map.ml:454:25>>*/ var
           r = param[4],
           d = param[3],
@@ -12006,16 +12226,16 @@
           /*<<map.ml:457:10>>*/ if(pvd){
            /*<<map.ml:458:32>>*/  /*<<map.ml:458:32>>*/ var
            _s_ = concat(lf, rf);
-           /*<<map.ml:458:15>>*/ return [0, join(lt, v, d, rt), _s_];
+           /*<<map.ml:458:15>>*/ return [0, join(lt, v, d, rt), _s_] /*<<map.ml:458:15>>*/ ;
          }
           /*<<map.ml:459:30>>*/  /*<<map.ml:459:30>>*/ var
           _t_ = join(lf, v, d, rf);
-          /*<<map.ml:459:15>>*/ return [0, concat(lt, rt), _t_];
+          /*<<map.ml:459:15>>*/ return [0, concat(lt, rt), _t_] /*<<map.ml:459:15>>*/ ;
         }
         function cons_enum(m, e){
           /*<<map.ml:464:6>>*/ var m$0 = m, e$0 = e;
           /*<<map.ml:464:6>>*/ for(;;){
-          if(! m$0)  /*<<map.ml:465:17>>*/ return e$0;
+          if(! m$0)  /*<<map.ml:465:17>>*/ return e$0 /*<<map.ml:465:17>>*/ ;
            /*<<map.ml:466:41>>*/ var
            r = m$0[4],
            d = m$0[3],
@@ -12033,8 +12253,8 @@
           e1 = e1$2,
           e2 = e2$2;
           /*<<map.ml:470:10>>*/ for(;;){
-          if(! e1) return e2 ? -1 : 0;
-          if(! e2)  /*<<map.ml:473:22>>*/ return 1;
+          if(! e1) return e2 ? -1 : 0 /*<<map.ml:480:58>>*/ ;
+          if(! e2)  /*<<map.ml:473:22>>*/ return 1 /*<<map.ml:473:22>>*/ ;
            /*<<map.ml:475:20>>*/ var
            e2$0 = e2[4],
            r2 = e2[3],
@@ -12046,11 +12266,12 @@
            v1 = e1[1],
             /*<<map.ml:475:20>>*/ c =
               /*<<map.ml:475:20>>*/ caml_call2(Ord[1], v1, v2);
-           /*<<map.ml:476:12>>*/ if(0 !== c)  /*<<map.ml:476:27>>*/ return c;
+           /*<<map.ml:476:12>>*/ if(0 !== c)
+            /*<<map.ml:476:27>>*/ return c /*<<map.ml:476:27>>*/ ;
            /*<<map.ml:477:20>>*/  /*<<map.ml:477:20>>*/ var
            c$0 =  /*<<map.ml:477:20>>*/ caml_call2(cmp, d1, d2);
            /*<<map.ml:478:12>>*/ if(0 !== c$0)
-            /*<<map.ml:478:27>>*/ return c$0;
+            /*<<map.ml:478:27>>*/ return c$0 /*<<map.ml:478:27>>*/ ;
            /*<<map.ml:479:42>>*/ var
             /*<<map.ml:479:42>>*/ e2$1 = cons_enum(r2, e2$0),
             /*<<map.ml:479:24>>*/ e1$1 = cons_enum(r1, e1$0);
@@ -12065,8 +12286,8 @@
           e1 = e1$2,
           e2 = e2$2;
           /*<<map.ml:484:10>>*/ for(;;){
-          if(! e1) return e2 ? 0 : 1;
-          if(! e2)  /*<<map.ml:487:22>>*/ return 0;
+          if(! e1) return e2 ? 0 : 1 /*<<map.ml:491:56>>*/ ;
+          if(! e2)  /*<<map.ml:487:22>>*/ return 0 /*<<map.ml:487:22>>*/ ;
           var
            e2$0 = e2[4],
            r2 = e2[3],
@@ -12093,11 +12314,12 @@
           }
           else
            var _r_ = _p_;
-           /*<<map.ml:489:37>>*/ return _r_;
+           /*<<map.ml:489:37>>*/ return _r_ /*<<map.ml:489:37>>*/ ;
          }
          /*<<map.ml:491:56>>*/ }
         function cardinal(param){
-          /*<<map.ml:493:23>>*/ if(! param)  /*<<map.ml:494:17>>*/ return 0;
+          /*<<map.ml:493:23>>*/ if(! param)
+           /*<<map.ml:494:17>>*/ return 0 /*<<map.ml:494:17>>*/ ;
           /*<<map.ml:495:40>>*/ var
           r = param[4],
           l = param[1],
@@ -12107,7 +12329,8 @@
         function bindings_aux(accu, param){
          var accu$0 = accu, param$0 = param;
          for(;;){
-          if(! param$0)  /*<<map.ml:498:17>>*/ return accu$0;
+          if(! param$0)
+            /*<<map.ml:498:17>>*/ return accu$0 /*<<map.ml:498:17>>*/ ;
            /*<<map.ml:499:42>>*/ var
            r = param$0[4],
            d = param$0[3],
@@ -12120,33 +12343,34 @@
          }
         }
         function bindings(s){
-          /*<<map.ml:502:6>>*/ return bindings_aux(0, s);
+          /*<<map.ml:502:6>>*/ return bindings_aux(0, s) /*<<map.ml:502:23>>*/ ;
          /*<<map.ml:502:23>>*/ }
         function of_list(bs){
           /*<<map.ml:509:21>>*/ return  /*<<map.ml:509:21>>*/ caml_call3
                  (Stdlib_List[26],
                   function(m, param){
                     /*<<map.ml:509:36>>*/ var v = param[2], k = param[1];
-                    /*<<map.ml:509:53>>*/ return add(k, v, m);
+                    /*<<map.ml:509:53>>*/ return add(k, v, m) /*<<map.ml:509:63>>*/ ;
                    /*<<map.ml:509:63>>*/ },
                   empty,
-                  bs);
+                  bs) /*<<map.ml:509:72>>*/ ;
          /*<<map.ml:509:72>>*/ }
         function add_seq(i, m){
           /*<<map.ml:512:6>>*/ return  /*<<map.ml:512:6>>*/ caml_call3
                  (Stdlib_Seq[5],
                   function(m, param){
                     /*<<map.ml:512:20>>*/ var v = param[2], k = param[1];
-                    /*<<map.ml:512:36>>*/ return add(k, v, m);
+                    /*<<map.ml:512:36>>*/ return add(k, v, m) /*<<map.ml:512:46>>*/ ;
                    /*<<map.ml:512:46>>*/ },
                   m,
-                  i);
+                  i) /*<<map.ml:512:50>>*/ ;
          /*<<map.ml:512:50>>*/ }
         function of_seq(i){
-          /*<<map.ml:514:19>>*/ return add_seq(i, empty);
+          /*<<map.ml:514:19>>*/ return add_seq(i, empty) /*<<map.ml:514:34>>*/ ;
          /*<<map.ml:514:34>>*/ }
         function seq_of_enum(c, param){
-          /*<<map.ml:516:32>>*/ if(! c)  /*<<map.ml:517:15>>*/ return 0;
+          /*<<map.ml:516:32>>*/ if(! c)
+           /*<<map.ml:517:15>>*/ return 0 /*<<map.ml:517:15>>*/ ;
          var
           rest = c[4],
           t = c[3],
@@ -12155,18 +12379,18 @@
            /*<<map.ml:518:59>>*/ _m_ = cons_enum(t, rest);
           /*<<map.ml:518:29>>*/ return [0,
                  [0, k, v],
-                 function(_n_){ /*<<?>>*/ return seq_of_enum(_m_, _n_);}];
+                 function(_n_){ /*<<?>>*/ return seq_of_enum(_m_, _n_);}] /*<<map.ml:518:29>>*/ ;
          /*<<map.ml:518:78>>*/ }
         function to_seq(m){
           /*<<map.ml:521:6>>*/  /*<<map.ml:521:19>>*/ var
           _k_ = cons_enum(m, 0);
           /*<<map.ml:521:19>>*/ return function(_l_){
-           /*<<?>>*/ return seq_of_enum(_k_, _l_);};
+           /*<<?>>*/ return seq_of_enum(_k_, _l_);} /*<<map.ml:521:19>>*/ ;
          /*<<map.ml:521:36>>*/ }
         function snoc_enum(s, e){
           /*<<map.ml:524:6>>*/ var s$0 = s, e$0 = e;
           /*<<map.ml:524:6>>*/ for(;;){
-          if(! s$0)  /*<<map.ml:525:17>>*/ return e$0;
+          if(! s$0)  /*<<map.ml:525:17>>*/ return e$0 /*<<map.ml:525:17>>*/ ;
            /*<<map.ml:526:40>>*/ var
            r = s$0[4],
            d = s$0[3],
@@ -12178,7 +12402,8 @@
          }
          /*<<map.ml:526:58>>*/ }
         function rev_seq_of_enum(c, param){
-          /*<<map.ml:528:36>>*/ if(! c)  /*<<map.ml:529:15>>*/ return 0;
+          /*<<map.ml:528:36>>*/ if(! c)
+           /*<<map.ml:529:15>>*/ return 0 /*<<map.ml:529:15>>*/ ;
          var
           rest = c[4],
           t = c[3],
@@ -12187,13 +12412,13 @@
            /*<<map.ml:531:44>>*/ _i_ = snoc_enum(t, rest);
           /*<<map.ml:531:10>>*/ return [0,
                  [0, k, v],
-                 function(_j_){ /*<<?>>*/ return rev_seq_of_enum(_i_, _j_);}];
+                 function(_j_){ /*<<?>>*/ return rev_seq_of_enum(_i_, _j_);}] /*<<map.ml:531:10>>*/ ;
          /*<<map.ml:531:63>>*/ }
         function to_rev_seq(c){
           /*<<map.ml:534:6>>*/  /*<<map.ml:534:23>>*/ var
           _g_ = snoc_enum(c, 0);
           /*<<map.ml:534:23>>*/ return function(_h_){
-           /*<<?>>*/ return rev_seq_of_enum(_g_, _h_);};
+           /*<<?>>*/ return rev_seq_of_enum(_g_, _h_);} /*<<map.ml:534:23>>*/ ;
          /*<<map.ml:534:40>>*/ }
         function to_seq_from(low, m){
           /*<<map.ml:537:6>>*/ a:
@@ -12226,7 +12451,7 @@
           var _e_ = [0, v, d, r, c];
          }
           /*<<map.ml:546:19>>*/ return function(_f_){
-           /*<<?>>*/ return seq_of_enum(_e_, _f_);};
+           /*<<?>>*/ return seq_of_enum(_e_, _f_);} /*<<map.ml:546:19>>*/ ;
          /*<<map.ml:546:34>>*/ }
         return [0,
                 empty,
@@ -12308,7 +12533,7 @@
      /*<<stack.ml:18:0>>*/ Empty =
       [248, "Stdlib.Stack.Empty", runtime.caml_fresh_oo_id(0)];
    function create(param){
-     /*<<stack.ml:20:16>>*/ return [0, 0, 0];
+     /*<<stack.ml:20:16>>*/ return [0, 0, 0] /*<<stack.ml:20:16>>*/ ;
     /*<<stack.ml:20:36>>*/ }
    function clear(s){
      /*<<stack.ml:22:14>>*/ s[1] = 0;
@@ -12316,7 +12541,7 @@
     return 0;
     /*<<stack.ml:22:35>>*/ }
    function copy(s){
-     /*<<stack.ml:24:13>>*/ return [0, s[1], s[2]];
+     /*<<stack.ml:24:13>>*/ return [0, s[1], s[2]] /*<<stack.ml:24:13>>*/ ;
     /*<<stack.ml:24:38>>*/ }
    function push(x, s){
      /*<<stack.ml:26:15>>*/ s[1] = [0, x, s[1]];
@@ -12331,15 +12556,15 @@
     var tl = match[2], hd = match[1];
     s[1] = tl;
     s[2] = s[2] - 1 | 0;
-     /*<<stack.ml:30:45>>*/ return hd;
+     /*<<stack.ml:30:45>>*/ return hd /*<<stack.ml:30:45>>*/ ;
     /*<<stack.ml:31:25>>*/ }
    function pop_opt(s){
      /*<<stack.ml:34:2>>*/ var match = s[1];
-    if(! match)  /*<<stack.ml:36:14>>*/ return 0;
+    if(! match)  /*<<stack.ml:36:14>>*/ return 0 /*<<stack.ml:36:14>>*/ ;
     var tl = match[2], hd = match[1];
     s[1] = tl;
     s[2] = s[2] - 1 | 0;
-     /*<<stack.ml:35:45>>*/ return [0, hd];
+     /*<<stack.ml:35:45>>*/ return [0, hd] /*<<stack.ml:35:45>>*/ ;
     /*<<stack.ml:36:18>>*/ }
    function drop(s){
      /*<<stack.ml:39:2>>*/ var match = s[1];
@@ -12357,13 +12582,13 @@
       /*<<stack.ml:46:13>>*/ throw  /*<<stack.ml:46:13>>*/ caml_maybe_attach_backtrace
             (Empty, 1);
     var hd = match[1];
-     /*<<stack.ml:45:13>>*/ return hd;
+     /*<<stack.ml:45:13>>*/ return hd /*<<stack.ml:45:13>>*/ ;
     /*<<stack.ml:46:24>>*/ }
    function top_opt(s){
      /*<<stack.ml:49:2>>*/ var match = s[1];
-    if(! match)  /*<<stack.ml:51:13>>*/ return 0;
+    if(! match)  /*<<stack.ml:51:13>>*/ return 0 /*<<stack.ml:51:13>>*/ ;
     var hd = match[1];
-     /*<<stack.ml:50:13>>*/ return [0, hd];
+     /*<<stack.ml:50:13>>*/ return [0, hd] /*<<stack.ml:50:13>>*/ ;
     /*<<stack.ml:51:17>>*/ }
    function is_empty(s){
      /*<<stack.ml:53:17>>*/ return 0 === s[1] ? 1 : 0;
@@ -12372,26 +12597,26 @@
      /*<<stack.ml:55:15>>*/ return s[2];
     /*<<stack.ml:55:20>>*/ }
    function iter(f, s){
-     /*<<stack.ml:57:15>>*/ return caml_call2(Stdlib_List[18], f, s[1]);
+     /*<<stack.ml:57:15>>*/ return caml_call2(Stdlib_List[18], f, s[1]) /*<<stack.ml:57:30>>*/ ;
     /*<<stack.ml:57:30>>*/ }
    function fold(f, acc, s){
-     /*<<stack.ml:59:19>>*/ return caml_call3(Stdlib_List[26], f, acc, s[1]);
+     /*<<stack.ml:59:19>>*/ return caml_call3(Stdlib_List[26], f, acc, s[1]) /*<<stack.ml:59:43>>*/ ;
     /*<<stack.ml:59:43>>*/ }
    function to_seq(s){
-     /*<<stack.ml:63:15>>*/ return caml_call1(Stdlib_List[64], s[1]);
+     /*<<stack.ml:63:15>>*/ return caml_call1(Stdlib_List[64], s[1]) /*<<stack.ml:63:30>>*/ ;
     /*<<stack.ml:63:30>>*/ }
    function add_seq(q, i){
      /*<<stack.ml:65:18>>*/ return  /*<<stack.ml:65:18>>*/ caml_call2
             (Stdlib_Seq[4],
              function(x){
-               /*<<stack.ml:65:37>>*/ return push(x, q);
+               /*<<stack.ml:65:37>>*/ return push(x, q) /*<<stack.ml:65:45>>*/ ;
               /*<<stack.ml:65:45>>*/ },
-             i);
+             i) /*<<stack.ml:65:48>>*/ ;
     /*<<stack.ml:65:48>>*/ }
    function of_seq(g){
      /*<<stack.ml:68:2>>*/  /*<<stack.ml:68:10>>*/ var s = create(0);
      /*<<stack.ml:69:2>>*/ add_seq(s, g);
-     /*<<stack.ml:69:2>>*/ return s;
+     /*<<stack.ml:69:2>>*/ return s /*<<stack.ml:69:2>>*/ ;
     /*<<stack.ml:70:3>>*/ }
    var
     Stdlib_Stack =
@@ -12442,7 +12667,7 @@
      /*<<queue.ml:17:0>>*/ Empty =
       [248, "Stdlib.Queue.Empty", runtime.caml_fresh_oo_id(0)];
    function create(param){
-     /*<<queue.ml:29:16>>*/ return [0, 0, 0, 0];
+     /*<<queue.ml:29:16>>*/ return [0, 0, 0, 0] /*<<queue.ml:29:16>>*/ ;
     /*<<queue.ml:33:1>>*/ }
    function clear(q){
      /*<<queue.ml:36:2>>*/ q[1] = 0;
@@ -12456,7 +12681,7 @@
       /*<<queue.ml:45:2>>*/ match = q[3];
     return match
             ? (q[1] = q[1] + 1 | 0, match[2] = cell, q[3] = cell, 0)
-            : (q[1] = 1, q[2] = cell, q[3] = cell, 0);
+            : (q[1] = 1, q[2] = cell, q[3] = cell, 0) /*<<queue.ml:53:18>>*/ ;
     /*<<queue.ml:53:18>>*/ }
    function peek(q){
      /*<<queue.ml:59:2>>*/ var match = q[2];
@@ -12464,13 +12689,13 @@
       /*<<queue.ml:60:11>>*/ throw  /*<<queue.ml:60:11>>*/ caml_maybe_attach_backtrace
             (Empty, 1);
     var content = match[1];
-     /*<<queue.ml:61:24>>*/ return content;
+     /*<<queue.ml:61:24>>*/ return content /*<<queue.ml:61:24>>*/ ;
     /*<<queue.ml:61:31>>*/ }
    function peek_opt(q){
      /*<<queue.ml:64:2>>*/ var match = q[2];
-    if(! match)  /*<<queue.ml:65:11>>*/ return 0;
+    if(! match)  /*<<queue.ml:65:11>>*/ return 0 /*<<queue.ml:65:11>>*/ ;
     var content = match[1];
-     /*<<queue.ml:66:24>>*/ return [0, content];
+     /*<<queue.ml:66:24>>*/ return [0, content] /*<<queue.ml:66:24>>*/ ;
     /*<<queue.ml:66:36>>*/ }
    function take(q){
      /*<<queue.ml:72:2>>*/ var _f_ = q[2];
@@ -12482,23 +12707,23 @@
      var next = _f_[2];
      q[1] = q[1] - 1 | 0;
      q[2] = next;
-      /*<<queue.ml:80:4>>*/ return content;
+      /*<<queue.ml:80:4>>*/ return content /*<<queue.ml:80:4>>*/ ;
     }
      /*<<queue.ml:75:4>>*/ clear(q);
-     /*<<queue.ml:75:4>>*/ return content;
+     /*<<queue.ml:75:4>>*/ return content /*<<queue.ml:75:4>>*/ ;
     /*<<queue.ml:80:11>>*/ }
    function take_opt(q){
      /*<<queue.ml:83:2>>*/ var _e_ = q[2];
-    if(! _e_)  /*<<queue.ml:84:11>>*/ return 0;
+    if(! _e_)  /*<<queue.ml:84:11>>*/ return 0 /*<<queue.ml:84:11>>*/ ;
     var content = _e_[1];
     if(_e_[2]){
      var next = _e_[2];
      q[1] = q[1] - 1 | 0;
      q[2] = next;
-      /*<<queue.ml:91:4>>*/ return [0, content];
+      /*<<queue.ml:91:4>>*/ return [0, content] /*<<queue.ml:91:4>>*/ ;
     }
      /*<<queue.ml:86:4>>*/ clear(q);
-     /*<<queue.ml:87:4>>*/ return [0, content];
+     /*<<queue.ml:87:4>>*/ return [0, content] /*<<queue.ml:87:4>>*/ ;
     /*<<queue.ml:91:16>>*/ }
    function copy(q){
      /*<<queue.ml:108:11>>*/ var
@@ -12507,7 +12732,10 @@
      prev = 0,
      cell = cell$0;
      /*<<queue.ml:98:4>>*/ for(;;){
-     if(! cell){q_res[3] = prev;  /*<<queue.ml:99:33>>*/ return q_res;}
+     if(! cell){
+      q_res[3] = prev;
+       /*<<queue.ml:99:33>>*/ return q_res /*<<queue.ml:99:33>>*/ ;
+     }
       /*<<queue.ml:101:21>>*/ var
       content = cell[1],
       next = cell[2],
@@ -12529,7 +12757,7 @@
    function iter(f, q){
      /*<<queue.ml:124:13>>*/ var cell$0 = q[2], cell = cell$0;
      /*<<queue.ml:118:4>>*/ for(;;){
-     if(! cell)  /*<<queue.ml:119:13>>*/ return 0;
+     if(! cell)  /*<<queue.ml:119:13>>*/ return 0 /*<<queue.ml:119:13>>*/ ;
      var content = cell[1], next = cell[2];
       /*<<queue.ml:121:6>>*/  /*<<queue.ml:121:6>>*/ caml_call1(f, content);
      cell = next;
@@ -12538,7 +12766,7 @@
    function fold(f, accu$1, q){
      /*<<queue.ml:134:18>>*/ var cell$0 = q[2], accu = accu$1, cell = cell$0;
      /*<<queue.ml:128:4>>*/ for(;;){
-     if(! cell)  /*<<queue.ml:129:13>>*/ return accu;
+     if(! cell)  /*<<queue.ml:129:13>>*/ return accu /*<<queue.ml:129:13>>*/ ;
       /*<<queue.ml:131:17>>*/ var
       content = cell[1],
       next = cell[2],
@@ -12559,32 +12787,33 @@
               match[2] = q1[2],
               q2[3] = q1[3],
               clear(q1))
-            : (q2[1] = q1[1], q2[2] = q1[2], q2[3] = q1[3], clear(q1));
+            : (q2[1] = q1[1], q2[2] = q1[2], q2[3] = q1[3], clear(q1)) /*<<queue.ml:148:14>>*/ ;
     /*<<queue.ml:148:14>>*/ }
    function to_seq(q){
      /*<<queue.ml:153:2>>*/ function aux(c, param){
-      /*<<queue.ml:153:21>>*/ if(! c)  /*<<queue.ml:154:13>>*/ return 0;
+      /*<<queue.ml:153:21>>*/ if(! c)
+       /*<<queue.ml:154:13>>*/ return 0 /*<<queue.ml:154:13>>*/ ;
      var x = c[1], next = c[2];
       /*<<queue.ml:155:35>>*/ return [0,
              x,
-             function(_c_){ /*<<?>>*/ return aux(next, _c_);}];
+             function(_c_){ /*<<?>>*/ return aux(next, _c_);}] /*<<queue.ml:155:35>>*/ ;
      /*<<queue.ml:155:57>>*/ }
     var _a_ = q[2];
      /*<<queue.ml:153:2>>*/ return function(_b_){
-      /*<<?>>*/ return aux(_a_, _b_);};
+      /*<<?>>*/ return aux(_a_, _b_);} /*<<queue.ml:153:2>>*/ ;
     /*<<queue.ml:157:13>>*/ }
    function add_seq(q, i){
      /*<<queue.ml:159:18>>*/ return  /*<<queue.ml:159:18>>*/ caml_call2
             (Stdlib_Seq[4],
              function(x){
-               /*<<queue.ml:159:37>>*/ return add(x, q);
+               /*<<queue.ml:159:37>>*/ return add(x, q) /*<<queue.ml:159:45>>*/ ;
               /*<<queue.ml:159:45>>*/ },
-             i);
+             i) /*<<queue.ml:159:48>>*/ ;
     /*<<queue.ml:159:48>>*/ }
    function of_seq(g){
      /*<<queue.ml:162:2>>*/  /*<<queue.ml:162:10>>*/ var q = create(0);
      /*<<queue.ml:163:2>>*/ add_seq(q, g);
-     /*<<queue.ml:163:2>>*/ return q;
+     /*<<queue.ml:163:2>>*/ return q /*<<queue.ml:163:2>>*/ ;
     /*<<queue.ml:164:3>>*/ }
    var
     Stdlib_Queue =
@@ -12681,23 +12910,23 @@
      n$1 = Stdlib_Sys[12] < n$0 ? Stdlib_Sys[12] : n$0,
       /*<<buffer.ml:43:9>>*/ s =
         /*<<buffer.ml:43:9>>*/ caml_create_bytes(n$1);
-     /*<<buffer.ml:44:1>>*/ return [0, [0, s, n$1], 0, s];
+     /*<<buffer.ml:44:1>>*/ return [0, [0, s, n$1], 0, s] /*<<buffer.ml:44:1>>*/ ;
     /*<<buffer.ml:44:71>>*/ }
    function contents(b){
      /*<<buffer.ml:46:17>>*/ return caml_call3
-            (Stdlib_Bytes[8], b[1][1], 0, b[2]);
+            (Stdlib_Bytes[8], b[1][1], 0, b[2]) /*<<buffer.ml:46:61>>*/ ;
     /*<<buffer.ml:46:61>>*/ }
    function to_bytes(b){
      /*<<buffer.ml:47:17>>*/ return caml_call3
-            (Stdlib_Bytes[7], b[1][1], 0, b[2]);
+            (Stdlib_Bytes[7], b[1][1], 0, b[2]) /*<<buffer.ml:47:54>>*/ ;
     /*<<buffer.ml:47:54>>*/ }
    function sub(b, ofs, len){
      /*<<buffer.ml:50:2>>*/ if
      (0 <= ofs && 0 <= len && (b[2] - len | 0) >= ofs)
       /*<<buffer.ml:52:7>>*/ return  /*<<buffer.ml:52:7>>*/ caml_call3
-             (Stdlib_Bytes[8], b[1][1], ofs, len);
+             (Stdlib_Bytes[8], b[1][1], ofs, len) /*<<buffer.ml:52:46>>*/ ;
      /*<<buffer.ml:51:7>>*/ return  /*<<buffer.ml:51:7>>*/ caml_call1
-            (Stdlib[1], cst_Buffer_sub);
+            (Stdlib[1], cst_Buffer_sub) /*<<buffer.ml:52:46>>*/ ;
     /*<<buffer.ml:52:46>>*/ }
    function blit(src, srcoff, dst, dstoff, len){
      /*<<buffer.ml:56:2>>*/ if
@@ -12708,9 +12937,9 @@
         (src[2] - len | 0) >= srcoff
         && 0 <= dstoff && (caml_ml_bytes_length(dst) - len | 0) >= dstoff)
       /*<<buffer.ml:60:4>>*/ return  /*<<buffer.ml:60:4>>*/ caml_call5
-             (Stdlib_Bytes[11], src[1][1], srcoff, dst, dstoff, len);
+             (Stdlib_Bytes[11], src[1][1], srcoff, dst, dstoff, len) /*<<buffer.ml:60:53>>*/ ;
      /*<<buffer.ml:58:7>>*/ return  /*<<buffer.ml:58:7>>*/ caml_call1
-            (Stdlib[1], cst_Buffer_blit);
+            (Stdlib[1], cst_Buffer_blit) /*<<buffer.ml:60:53>>*/ ;
     /*<<buffer.ml:60:53>>*/ }
    function nth(b, ofs){
      /*<<buffer.ml:64:2>>*/ var
@@ -12720,9 +12949,9 @@
      buffer = match[1];
      /*<<buffer.ml:66:2>>*/ if
      (0 <= ofs && position > ofs && length >= position)
-     return runtime.caml_bytes_unsafe_get(buffer, ofs);
+     return runtime.caml_bytes_unsafe_get(buffer, ofs) /*<<buffer.ml:68:34>>*/ ;
      /*<<buffer.ml:67:3>>*/ return  /*<<buffer.ml:67:3>>*/ caml_call1
-            (Stdlib[1], cst_Buffer_nth);
+            (Stdlib[1], cst_Buffer_nth) /*<<buffer.ml:68:34>>*/ ;
     /*<<buffer.ml:68:34>>*/ }
    function length(b){
      /*<<buffer.ml:71:15>>*/ return b[2];
@@ -12854,7 +13083,7 @@
             (b,
               /*<<buffer.ml:163:18>>*/ caml_call1(Stdlib_Bytes[44], s),
              offset,
-             len);
+             len) /*<<buffer.ml:163:55>>*/ ;
     /*<<buffer.ml:163:55>>*/ }
    function add_string(b, s){
      /*<<buffer.ml:166:2>>*/ var
@@ -12877,10 +13106,10 @@
     /*<<buffer.ml:175:28>>*/ }
    function add_bytes(b, s){
      /*<<buffer.ml:177:20>>*/ return add_string
-            (b,  /*<<buffer.ml:177:33>>*/ caml_call1(Stdlib_Bytes[44], s));
+            (b,  /*<<buffer.ml:177:33>>*/ caml_call1(Stdlib_Bytes[44], s)) /*<<buffer.ml:177:59>>*/ ;
     /*<<buffer.ml:177:59>>*/ }
    function add_buffer(b, bs){
-     /*<<buffer.ml:180:2>>*/ return add_subbytes(b, bs[1][1], 0, bs[2]);
+     /*<<buffer.ml:180:2>>*/ return add_subbytes(b, bs[1][1], 0, bs[2]) /*<<buffer.ml:180:46>>*/ ;
     /*<<buffer.ml:180:46>>*/ }
    function add_channel(b, ic, to_read$1){
      /*<<buffer.ml:206:2>>*/ var
@@ -12918,12 +13147,12 @@
      if(already_read < to_read$1)
        /*<<buffer.ml:211:18>>*/ throw  /*<<buffer.ml:211:18>>*/ caml_maybe_attach_backtrace
              (Stdlib[12], 1);
-      /*<<buffer.ml:212:2>>*/ return 0;
+      /*<<buffer.ml:212:2>>*/ return 0 /*<<buffer.ml:212:2>>*/ ;
     }
     /*<<buffer.ml:212:4>>*/ }
    function output_buffer(oc, b){
      /*<<buffer.ml:215:2>>*/ return caml_call4
-            (Stdlib[68], oc, b[1][1], 0, b[2]);
+            (Stdlib[68], oc, b[1][1], 0, b[2]) /*<<buffer.ml:215:39>>*/ ;
     /*<<buffer.ml:215:39>>*/ }
    function add_substitute(b, f, s){
      /*<<buffer.ml:261:2>>*/ var
@@ -12933,7 +13162,7 @@
      /*<<buffer.ml:263:4>>*/ for(;;){
      if(i$4 >= lim$1){
       var _o_ = 92 === previous ? 1 : 0;
-      return _o_ ? add_char(b, previous) : _o_;
+      return _o_ ? add_char(b, previous) : _o_ /*<<buffer.ml:284:13>>*/ ;
      }
       /*<<buffer.ml:264:12>>*/  /*<<buffer.ml:264:12>>*/ var
       previous$0 =  /*<<buffer.ml:264:12>>*/ caml_string_get(s, i$4);
@@ -13061,50 +13290,50 @@
    function truncate(b, len){
      /*<<buffer.ml:287:4>>*/ if(0 <= len && b[2] >= len){b[2] = len; return 0;}
      /*<<buffer.ml:288:6>>*/ return  /*<<buffer.ml:288:6>>*/ caml_call1
-            (Stdlib[1], cst_Buffer_truncate);
+            (Stdlib[1], cst_Buffer_truncate) /*<<buffer.ml:290:23>>*/ ;
     /*<<buffer.ml:290:23>>*/ }
    function to_seq(b){
     function aux(i, param){
       /*<<buffer.ml:297:4>>*/ if(b[2] <= i)
-       /*<<buffer.ml:297:28>>*/ return 0;
+       /*<<buffer.ml:297:28>>*/ return 0 /*<<buffer.ml:297:28>>*/ ;
       /*<<buffer.ml:299:14>>*/ var
        /*<<buffer.ml:299:14>>*/ x =
          /*<<buffer.ml:299:14>>*/ caml_bytes_get(b[1][1], i),
        /*<<buffer.ml:299:14>>*/ _l_ = i + 1 | 0;
       /*<<buffer.ml:300:6>>*/ return [0,
              x,
-             function(_m_){ /*<<?>>*/ return aux(_l_, _m_);}];
+             function(_m_){ /*<<?>>*/ return aux(_l_, _m_);}] /*<<buffer.ml:300:6>>*/ ;
      /*<<buffer.ml:300:29>>*/ }
      /*<<buffer.ml:302:2>>*/ var _j_ = 0;
      /*<<buffer.ml:302:2>>*/ return function(_k_){
-      /*<<?>>*/ return aux(_j_, _k_);};
+      /*<<?>>*/ return aux(_j_, _k_);} /*<<buffer.ml:302:2>>*/ ;
     /*<<buffer.ml:302:7>>*/ }
    function to_seqi(b){
     function aux(i, param){
       /*<<buffer.ml:307:4>>*/ if(b[2] <= i)
-       /*<<buffer.ml:307:28>>*/ return 0;
+       /*<<buffer.ml:307:28>>*/ return 0 /*<<buffer.ml:307:28>>*/ ;
       /*<<buffer.ml:309:14>>*/ var
        /*<<buffer.ml:309:14>>*/ x =
          /*<<buffer.ml:309:14>>*/ caml_bytes_get(b[1][1], i),
        /*<<buffer.ml:309:14>>*/ _h_ = i + 1 | 0;
       /*<<buffer.ml:310:6>>*/ return [0,
              [0, i, x],
-             function(_i_){ /*<<?>>*/ return aux(_h_, _i_);}];
+             function(_i_){ /*<<?>>*/ return aux(_h_, _i_);}] /*<<buffer.ml:310:6>>*/ ;
      /*<<buffer.ml:310:33>>*/ }
      /*<<buffer.ml:312:2>>*/ var _f_ = 0;
      /*<<buffer.ml:312:2>>*/ return function(_g_){
-      /*<<?>>*/ return aux(_f_, _g_);};
+      /*<<?>>*/ return aux(_f_, _g_);} /*<<buffer.ml:312:2>>*/ ;
     /*<<buffer.ml:312:7>>*/ }
    function add_seq(b, seq){
      /*<<buffer.ml:314:20>>*/ return  /*<<buffer.ml:314:20>>*/ caml_call2
             (Stdlib_Seq[4],
              function(_e_){ /*<<?>>*/ return add_char(b, _e_);},
-             seq);
+             seq) /*<<buffer.ml:314:45>>*/ ;
     /*<<buffer.ml:314:45>>*/ }
    function of_seq(i){
      /*<<buffer.ml:317:2>>*/  /*<<buffer.ml:317:10>>*/ var b = create(32);
      /*<<buffer.ml:318:2>>*/ add_seq(b, i);
-     /*<<buffer.ml:318:2>>*/ return b;
+     /*<<buffer.ml:318:2>>*/ return b /*<<buffer.ml:318:2>>*/ ;
     /*<<buffer.ml:319:3>>*/ }
    function add_int8(b, x){
      /*<<buffer.ml:338:2>>*/ var
@@ -13179,31 +13408,31 @@
     /*<<buffer.ml:379:28>>*/ }
    function add_int16_le(b, x){
      /*<<buffer.ml:382:2>>*/ var _d_ = Stdlib_Sys[11] ? caml_bswap16(x) : x;
-    return add_int16_ne(b, _d_);
+    return add_int16_ne(b, _d_) /*<<buffer.ml:382:57>>*/ ;
     /*<<buffer.ml:382:57>>*/ }
    function add_int16_be(b, x){
      /*<<buffer.ml:385:2>>*/ var x$0 = Stdlib_Sys[11] ? x : caml_bswap16(x);
-     /*<<buffer.ml:385:41>>*/ return add_int16_ne(b, x$0);
+     /*<<buffer.ml:385:41>>*/ return add_int16_ne(b, x$0) /*<<buffer.ml:385:57>>*/ ;
     /*<<buffer.ml:385:57>>*/ }
    function add_int32_le(b, x){
      /*<<buffer.ml:388:2>>*/ var
      _c_ = Stdlib_Sys[11] ?  /*<<buffer.ml:388:41>>*/ caml_int32_bswap(x) : x;
-     /*<<buffer.ml:388:41>>*/ return add_int32_ne(b, _c_);
+     /*<<buffer.ml:388:41>>*/ return add_int32_ne(b, _c_) /*<<buffer.ml:388:57>>*/ ;
     /*<<buffer.ml:388:57>>*/ }
    function add_int32_be(b, x){
      /*<<buffer.ml:391:2>>*/ var
      x$0 = Stdlib_Sys[11] ? x :  /*<<buffer.ml:391:48>>*/ caml_int32_bswap(x);
-     /*<<buffer.ml:391:48>>*/ return add_int32_ne(b, x$0);
+     /*<<buffer.ml:391:48>>*/ return add_int32_ne(b, x$0) /*<<buffer.ml:391:57>>*/ ;
     /*<<buffer.ml:391:57>>*/ }
    function add_int64_le(b, x){
      /*<<buffer.ml:394:2>>*/ var
      _b_ = Stdlib_Sys[11] ?  /*<<buffer.ml:394:41>>*/ caml_int64_bswap(x) : x;
-     /*<<buffer.ml:394:41>>*/ return add_int64_ne(b, _b_);
+     /*<<buffer.ml:394:41>>*/ return add_int64_ne(b, _b_) /*<<buffer.ml:394:57>>*/ ;
     /*<<buffer.ml:394:57>>*/ }
    function add_int64_be(b, x){
      /*<<buffer.ml:397:2>>*/ var
      x$0 = Stdlib_Sys[11] ? x :  /*<<buffer.ml:397:48>>*/ caml_int64_bswap(x);
-     /*<<buffer.ml:397:48>>*/ return add_int64_ne(b, x$0);
+     /*<<buffer.ml:397:48>>*/ return add_int64_ne(b, x$0) /*<<buffer.ml:397:57>>*/ ;
     /*<<buffer.ml:397:57>>*/ }
    var
     Stdlib_Buffer =
@@ -13280,7 +13509,7 @@
             (e, 0);
     }
      /*<<mutex.ml:30:4>>*/  /*<<mutex.ml:30:4>>*/ caml_ml_mutex_unlock(m);
-     /*<<mutex.ml:30:4>>*/ return x;
+     /*<<mutex.ml:30:4>>*/ return x /*<<mutex.ml:30:4>>*/ ;
     /*<<mutex.ml:34:13>>*/ }
    var
     Stdlib_Mutex =
@@ -13346,7 +13575,7 @@
      /*<<semaphore.ml:30:2>>*/ return [0,
              /*<<semaphore.ml:30:10>>*/ caml_call1(Stdlib_Mutex[1], 0),
             v,
-            _c_];
+            _c_] /*<<semaphore.ml:30:2>>*/ ;
     /*<<semaphore.ml:30:59>>*/ }
    function release(s){
      /*<<semaphore.ml:33:2>>*/  /*<<semaphore.ml:33:2>>*/ caml_call1
@@ -13355,7 +13584,7 @@
      s[2] = s[2] + 1 | 0;
       /*<<semaphore.ml:36:4>>*/  /*<<semaphore.ml:36:4>>*/ caml_call1
       (Stdlib_Condition[3], s[3]);
-     return caml_call1(Stdlib_Mutex[4], s[1]);
+     return caml_call1(Stdlib_Mutex[4], s[1]) /*<<semaphore.ml:41:5>>*/ ;
     }
      /*<<semaphore.ml:39:4>>*/  /*<<semaphore.ml:39:4>>*/ caml_call1
      (Stdlib_Mutex[4], s[1]);
@@ -13368,7 +13597,7 @@
      /*<<semaphore.ml:45:19>>*/ for(;;){
      if(0 !== s[2]){
       s[2] = s[2] - 1 | 0;
-      return caml_call1(Stdlib_Mutex[4], s[1]);
+      return caml_call1(Stdlib_Mutex[4], s[1]) /*<<semaphore.ml:47:20>>*/ ;
      }
       /*<<semaphore.ml:45:19>>*/  /*<<semaphore.ml:45:19>>*/ caml_call2
       (Stdlib_Condition[2], s[3], s[1]);
@@ -13380,7 +13609,7 @@
     var ret = 0 === s[2] ? 0 : (s[2] = s[2] - 1 | 0, 1);
      /*<<semaphore.ml:52:2>>*/  /*<<semaphore.ml:52:2>>*/ caml_call1
      (Stdlib_Mutex[4], s[1]);
-     /*<<semaphore.ml:52:2>>*/ return ret;
+     /*<<semaphore.ml:52:2>>*/ return ret /*<<semaphore.ml:52:2>>*/ ;
     /*<<semaphore.ml:53:5>>*/ }
    function get_value(s){
      /*<<semaphore.ml:55:18>>*/ return s[2];
@@ -13395,7 +13624,7 @@
      /*<<semaphore.ml:64:2>>*/ return [0,
              /*<<semaphore.ml:64:10>>*/ caml_call1(Stdlib_Mutex[1], 0),
             _b_,
-            _a_];
+            _a_] /*<<semaphore.ml:64:2>>*/ ;
     /*<<semaphore.ml:66:34>>*/ }
    function release$0(s){
      /*<<semaphore.ml:69:2>>*/  /*<<semaphore.ml:69:2>>*/ caml_call1
@@ -13403,13 +13632,16 @@
     s[2] = 1;
      /*<<semaphore.ml:71:2>>*/  /*<<semaphore.ml:71:2>>*/ caml_call1
      (Stdlib_Condition[3], s[3]);
-    return caml_call1(Stdlib_Mutex[4], s[1]);
+    return caml_call1(Stdlib_Mutex[4], s[1]) /*<<semaphore.ml:72:20>>*/ ;
     /*<<semaphore.ml:72:20>>*/ }
    function acquire$0(s){
      /*<<semaphore.ml:75:2>>*/  /*<<semaphore.ml:75:2>>*/ caml_call1
      (Stdlib_Mutex[2], s[1]);
      /*<<semaphore.ml:76:19>>*/ for(;;){
-     if(0 !== s[2]){s[2] = 0; return caml_call1(Stdlib_Mutex[4], s[1]);}
+     if(0 !== s[2]){
+      s[2] = 0;
+      return caml_call1(Stdlib_Mutex[4], s[1]) /*<<semaphore.ml:78:20>>*/ ;
+     }
       /*<<semaphore.ml:76:19>>*/  /*<<semaphore.ml:76:19>>*/ caml_call2
       (Stdlib_Condition[2], s[3], s[1]);
     }
@@ -13420,7 +13652,7 @@
     var ret = 0 === s[2] ? 0 : (s[2] = 0, 1);
      /*<<semaphore.ml:83:2>>*/  /*<<semaphore.ml:83:2>>*/ caml_call1
      (Stdlib_Mutex[4], s[1]);
-     /*<<semaphore.ml:83:2>>*/ return ret;
+     /*<<semaphore.ml:83:2>>*/ return ret /*<<semaphore.ml:83:2>>*/ ;
     /*<<semaphore.ml:84:5>>*/ }
     /*<<semaphore.ml:59:16>>*/ var
      /*<<semaphore.ml:59:16>>*/ Binary =
@@ -13476,7 +13708,7 @@
     Assert_failure = global_data.Assert_failure;
    function cpu_relax(param){
      /*<<domain.ml:47:19>>*/ return  /*<<domain.ml:47:19>>*/ runtime.caml_ml_domain_cpu_relax
-            (0);
+            (0) /*<<domain.ml:47:35>>*/ ;
     /*<<domain.ml:47:35>>*/ }
     /*<<domain.ml:72:24>>*/  /*<<domain.ml:72:24>>*/ var none = [0, 0];
    function create_dls(param){
@@ -13513,14 +13745,15 @@
        break;
      }
     }
-     /*<<domain.ml:115:4>>*/ return k;
+     /*<<domain.ml:115:4>>*/ return k /*<<domain.ml:115:4>>*/ ;
     /*<<domain.ml:115:5>>*/ }
    function maybe_grow(idx){
      /*<<domain.ml:120:4>>*/ for(;;){
       /*<<domain.ml:121:4>>*/ var
       st = caml_domain_dls_get(0),
        /*<<domain.ml:121:4>>*/ sz = st.length - 1;
-     if(idx < sz)  /*<<domain.ml:122:21>>*/ return st;
+     if(idx < sz)
+       /*<<domain.ml:122:21>>*/ return st /*<<domain.ml:122:21>>*/ ;
      var new_sz = sz;
       /*<<domain.ml:125:8>>*/ for(;;){
       if(idx < new_sz) break;
@@ -13534,7 +13767,7 @@
       /*<<domain.ml:136:9>>*/ if
       ( /*<<domain.ml:136:9>>*/ runtime.caml_domain_dls_compare_and_set
         (st, new_st))
-       /*<<domain.ml:137:11>>*/ return new_st;
+       /*<<domain.ml:137:11>>*/ return new_st /*<<domain.ml:137:11>>*/ ;
     }
     /*<<domain.ml:139:7>>*/ }
    function set(param, x){
@@ -13542,7 +13775,7 @@
      idx = param[1],
       /*<<domain.ml:142:13>>*/ st = maybe_grow(idx);
      /*<<domain.ml:146:4>>*/ caml_check_bound(st, idx)[1 + idx] = x;
-     /*<<domain.ml:146:4>>*/ return 0;
+     /*<<domain.ml:146:4>>*/ return 0 /*<<domain.ml:146:4>>*/ ;
    }
    function get(param){
      /*<<domain.ml:159:13>>*/ var
@@ -13551,7 +13784,7 @@
       /*<<domain.ml:159:13>>*/ st = maybe_grow(idx),
       /*<<domain.ml:160:14>>*/ oldval = caml_check_bound(st, idx)[1 + idx];
      /*<<domain.ml:161:7>>*/ if(oldval !== none)
-      /*<<domain.ml:75:25>>*/ return oldval;
+      /*<<domain.ml:75:25>>*/ return oldval /*<<domain.ml:75:25>>*/ ;
      /*<<domain.ml:164:18>>*/ var
       /*<<domain.ml:164:18>>*/ new_obj =
         /*<<domain.ml:164:18>>*/ caml_call1(init, 0),
@@ -13559,21 +13792,22 @@
         /*<<domain.ml:175:6>>*/ caml_domain_dls_get(0),
       /*<<domain.ml:152:17>>*/ curval = caml_check_bound(st$0, idx)[1 + idx],
      _e_ = curval === oldval ? (st$0[1 + idx] = new_obj, 1) : 0;
-     /*<<domain.ml:176:9>>*/ if(_e_)  /*<<domain.ml:177:11>>*/ return new_obj;
+     /*<<domain.ml:176:9>>*/ if(_e_)
+      /*<<domain.ml:177:11>>*/ return new_obj /*<<domain.ml:177:11>>*/ ;
      /*<<domain.ml:181:26>>*/  /*<<domain.ml:181:26>>*/ var
      updated_obj = caml_check_bound(st$0, idx)[1 + idx];
      /*<<domain.ml:182:11>>*/ if(updated_obj !== none)
-      /*<<domain.ml:75:25>>*/ return updated_obj;
+      /*<<domain.ml:75:25>>*/ return updated_obj /*<<domain.ml:75:25>>*/ ;
      /*<<domain.ml:184:13>>*/ throw  /*<<domain.ml:184:13>>*/ caml_maybe_attach_backtrace
            ([0, Assert_failure, _a_], 1);
    }
    function get_id(param){
     var domain = param[1];
-     /*<<domain.ml:201:27>>*/ return domain;
+     /*<<domain.ml:201:27>>*/ return domain /*<<domain.ml:201:27>>*/ ;
    }
    function self(param){
      /*<<domain.ml:203:14>>*/ return  /*<<domain.ml:203:14>>*/ caml_ml_domain_id
-            (0);
+            (0) /*<<domain.ml:203:25>>*/ ;
     /*<<domain.ml:203:25>>*/ }
    function is_main_domain(param){
      /*<<domain.ml:205:24>>*/ return 0
@@ -13597,7 +13831,7 @@
     function new_f(param){
       /*<<domain.ml:219:19>>*/  /*<<domain.ml:219:19>>*/ caml_call1(old_f, 0);
       /*<<domain.ml:219:19>>*/ return  /*<<domain.ml:219:19>>*/ caml_call1
-             (f, 0);
+             (f, 0) /*<<domain.ml:219:33>>*/ ;
      /*<<domain.ml:219:33>>*/ }
     first_spawn_function[1] = new_f;
     return 0;
@@ -13608,7 +13842,7 @@
        (0,
         function(param){
           /*<<domain.ml:231:41>>*/ return function(param){
-           /*<<domain.ml:231:52>>*/ return 0; /*<<domain.ml:231:54>>*/ };
+           /*<<domain.ml:231:52>>*/ return 0 /*<<domain.ml:231:52>>*/ ; /*<<domain.ml:231:54>>*/ } /*<<domain.ml:231:41>>*/ ;
          /*<<domain.ml:231:55>>*/ });
    function at_exit(f){
      /*<<domain.ml:234:2>>*/  /*<<domain.ml:234:32>>*/ var
@@ -13616,14 +13850,14 @@
     function new_exit(param){
       /*<<domain.ml:236:4>>*/  /*<<domain.ml:236:4>>*/ caml_call1(f, 0);
       /*<<domain.ml:236:4>>*/ return  /*<<domain.ml:236:4>>*/ caml_call1
-             (old_exit, 0);
+             (old_exit, 0) /*<<domain.ml:236:21>>*/ ;
      /*<<domain.ml:236:21>>*/ }
-     /*<<domain.ml:238:2>>*/ return set(at_exit_key, new_exit);
+     /*<<domain.ml:238:2>>*/ return set(at_exit_key, new_exit) /*<<domain.ml:238:30>>*/ ;
     /*<<domain.ml:238:30>>*/ }
    function do_at_exit(param){
      /*<<domain.ml:241:2>>*/  /*<<domain.ml:241:25>>*/ var
      f = get(at_exit_key);
-     /*<<domain.ml:242:2>>*/ return  /*<<domain.ml:242:2>>*/ caml_call1(f, 0);
+     /*<<domain.ml:242:2>>*/ return  /*<<domain.ml:242:2>>*/ caml_call1(f, 0) /*<<domain.ml:242:6>>*/ ;
     /*<<domain.ml:242:6>>*/ }
    Stdlib[104][1] = do_at_exit;
    function spawn(f){
@@ -13638,7 +13872,7 @@
       (first_spawn_function[1], 0);
      first_spawn_function[1] =
       function(param){
-        /*<<domain.ml:228:39>>*/ return 0;
+        /*<<domain.ml:228:39>>*/ return 0 /*<<domain.ml:228:39>>*/ ;
        /*<<domain.ml:228:41>>*/ };
     }
      /*<<domain.ml:193:6>>*/ var
@@ -13651,7 +13885,7 @@
            /*<<domain.ml:192:6>>*/ var split = param[2], k = param[1];
            /*<<domain.ml:192:30>>*/ return [0,
                   k,
-                   /*<<domain.ml:192:37>>*/ caml_call1(split, get(k))];
+                   /*<<domain.ml:192:37>>*/ caml_call1(split, get(k))] /*<<domain.ml:192:30>>*/ ;
           /*<<domain.ml:192:54>>*/ },
          _b_),
       /*<<domain.ml:256:17>>*/ _c_ =
@@ -13665,7 +13899,7 @@
        (Stdlib_List[18],
         function(param){
           /*<<domain.ml:196:14>>*/ var v = param[2], k = param[1];
-          /*<<domain.ml:196:34>>*/ return set(k, v);
+          /*<<domain.ml:196:34>>*/ return set(k, v) /*<<domain.ml:196:42>>*/ ;
          /*<<domain.ml:196:42>>*/ },
         pk);
        /*<<domain.ml:263:16>>*/  /*<<domain.ml:263:16>>*/ var
@@ -13679,19 +13913,22 @@
              (exn, 0);
      }
       /*<<domain.ml:272:8>>*/ do_at_exit(0);
-      /*<<domain.ml:272:8>>*/ return res;
+      /*<<domain.ml:272:8>>*/ return res /*<<domain.ml:272:8>>*/ ;
      /*<<domain.ml:279:17>>*/ }
      /*<<domain.ml:281:15>>*/  /*<<domain.ml:281:15>>*/ var
      domain =
         /*<<domain.ml:281:15>>*/ runtime.caml_domain_spawn(body, term_sync);
-     /*<<domain.ml:282:2>>*/ return [0, domain, term_sync];
+     /*<<domain.ml:282:2>>*/ return [0, domain, term_sync] /*<<domain.ml:282:2>>*/ ;
     /*<<domain.ml:282:24>>*/ }
    function join(param){
     var term_sync = param[2];
      /*<<domain.ml:285:2>>*/ function loop(param){
       /*<<domain.ml:287:4>>*/ for(;;){
       var match = term_sync[1];
-      if(match){var res = match[1];  /*<<domain.ml:292:8>>*/ return res;}
+      if(match){
+       var res = match[1];
+        /*<<domain.ml:292:8>>*/ return res /*<<domain.ml:292:8>>*/ ;
+      }
        /*<<domain.ml:289:8>>*/  /*<<domain.ml:289:8>>*/ caml_call2
        (Stdlib_Condition[2], term_sync[3], term_sync[2]);
      }
@@ -13700,7 +13937,10 @@
      match =
         /*<<domain.ml:294:8>>*/ caml_call2
         (Stdlib_Mutex[5], term_sync[2], loop);
-    if(0 === match[0]){var x = match[1];  /*<<domain.ml:295:12>>*/ return x;}
+    if(0 === match[0]){
+     var x = match[1];
+      /*<<domain.ml:295:12>>*/ return x /*<<domain.ml:295:12>>*/ ;
+    }
     var ex = match[1];
      /*<<domain.ml:296:16>>*/ throw  /*<<domain.ml:296:16>>*/ caml_maybe_attach_backtrace
            (ex, 1);
@@ -13877,7 +14117,7 @@
     _q_ = [0, cst_camlinternalFormat_ml, 831, 30];
    function create_char_set(param){
      /*<<camlinternalFormat.ml:24:25>>*/ return  /*<<camlinternalFormat.ml:24:25>>*/ caml_call2
-            (Stdlib_Bytes[1], 32, 0);
+            (Stdlib_Bytes[1], 32, 0) /*<<camlinternalFormat.ml:24:45>>*/ ;
     /*<<camlinternalFormat.ml:24:45>>*/ }
    function add_in_char_set(char_set, c){
      /*<<camlinternalFormat.ml:28:2>>*/ var
@@ -13890,11 +14130,11 @@
      /*<<camlinternalFormat.ml:30:2>>*/ return  /*<<camlinternalFormat.ml:30:2>>*/ caml_bytes_set
             (char_set,
              str_ind,
-              /*<<camlinternalFormat.ml:31:4>>*/ caml_call1(Stdlib[29], _cU_));
+              /*<<camlinternalFormat.ml:31:4>>*/ caml_call1(Stdlib[29], _cU_)) /*<<camlinternalFormat.ml:31:69>>*/ ;
     /*<<camlinternalFormat.ml:31:69>>*/ }
    function freeze_char_set(char_set){
      /*<<camlinternalFormat.ml:34:2>>*/ return  /*<<camlinternalFormat.ml:34:2>>*/ caml_call1
-            (Stdlib_Bytes[6], char_set);
+            (Stdlib_Bytes[6], char_set) /*<<camlinternalFormat.ml:34:26>>*/ ;
     /*<<camlinternalFormat.ml:34:26>>*/ }
    function rev_char_set(char_set){
      /*<<camlinternalFormat.ml:38:2>>*/ var
@@ -13913,7 +14153,7 @@
       _cT_ = i + 1 | 0;
      if(31 === i)
        /*<<camlinternalFormat.ml:43:2>>*/ return  /*<<camlinternalFormat.ml:43:2>>*/ caml_call1
-              (Stdlib_Bytes[44], char_set$0);
+              (Stdlib_Bytes[44], char_set$0) /*<<camlinternalFormat.ml:43:34>>*/ ;
      i = _cT_;
     }
     /*<<camlinternalFormat.ml:43:34>>*/ }
@@ -13931,46 +14171,47 @@
     /*<<camlinternalFormat.ml:49:60>>*/ }
    function pad_of_pad_opt(pad_opt){
      /*<<camlinternalFormat.ml:62:29>>*/ if(! pad_opt)
-      /*<<camlinternalFormat.ml:63:12>>*/ return 0;
+      /*<<camlinternalFormat.ml:63:12>>*/ return 0 /*<<camlinternalFormat.ml:63:12>>*/ ;
     var width = pad_opt[1];
-     /*<<camlinternalFormat.ml:64:18>>*/ return [0, 1, width];
+     /*<<camlinternalFormat.ml:64:18>>*/ return [0, 1, width] /*<<camlinternalFormat.ml:64:18>>*/ ;
     /*<<camlinternalFormat.ml:64:44>>*/ }
    function param_format_of_ignored_format(ign, fmt){
      /*<<camlinternalFormat.ml:76:15>>*/ if(typeof ign === "number")
      switch(ign){
        case 0:
-         /*<<camlinternalFormat.ml:78:4>>*/ return [0, [0, fmt]];
+         /*<<camlinternalFormat.ml:78:4>>*/ return [0, [0, fmt]] /*<<camlinternalFormat.ml:78:4>>*/ ;
        case 1:
-         /*<<camlinternalFormat.ml:80:4>>*/ return [0, [1, fmt]];
+         /*<<camlinternalFormat.ml:80:4>>*/ return [0, [1, fmt]] /*<<camlinternalFormat.ml:80:4>>*/ ;
        case 2:
-         /*<<camlinternalFormat.ml:108:4>>*/ return [0, [19, fmt]];
-       default:  /*<<camlinternalFormat.ml:114:4>>*/ return [0, [22, fmt]];
+         /*<<camlinternalFormat.ml:108:4>>*/ return [0, [19, fmt]] /*<<camlinternalFormat.ml:108:4>>*/ ;
+       default:
+         /*<<camlinternalFormat.ml:114:4>>*/ return [0, [22, fmt]] /*<<camlinternalFormat.ml:114:4>>*/ ;
      }
     switch(ign[0]){
       case 0:
        var pad_opt = ign[1];
         /*<<camlinternalFormat.ml:82:4>>*/ return [0,
-               [2, pad_of_pad_opt(pad_opt), fmt]];
+               [2, pad_of_pad_opt(pad_opt), fmt]] /*<<camlinternalFormat.ml:82:4>>*/ ;
       case 1:
        var pad_opt$0 = ign[1];
         /*<<camlinternalFormat.ml:84:4>>*/ return [0,
-               [3, pad_of_pad_opt(pad_opt$0), fmt]];
+               [3, pad_of_pad_opt(pad_opt$0), fmt]] /*<<camlinternalFormat.ml:84:4>>*/ ;
       case 2:
        var pad_opt$1 = ign[2], iconv = ign[1];
         /*<<camlinternalFormat.ml:86:4>>*/ return [0,
-               [4, iconv, pad_of_pad_opt(pad_opt$1), 0, fmt]];
+               [4, iconv, pad_of_pad_opt(pad_opt$1), 0, fmt]] /*<<camlinternalFormat.ml:86:4>>*/ ;
       case 3:
        var pad_opt$2 = ign[2], iconv$0 = ign[1];
         /*<<camlinternalFormat.ml:88:4>>*/ return [0,
-               [5, iconv$0, pad_of_pad_opt(pad_opt$2), 0, fmt]];
+               [5, iconv$0, pad_of_pad_opt(pad_opt$2), 0, fmt]] /*<<camlinternalFormat.ml:88:4>>*/ ;
       case 4:
        var pad_opt$3 = ign[2], iconv$1 = ign[1];
         /*<<camlinternalFormat.ml:91:4>>*/ return [0,
-               [6, iconv$1, pad_of_pad_opt(pad_opt$3), 0, fmt]];
+               [6, iconv$1, pad_of_pad_opt(pad_opt$3), 0, fmt]] /*<<camlinternalFormat.ml:91:4>>*/ ;
       case 5:
        var pad_opt$4 = ign[2], iconv$2 = ign[1];
         /*<<camlinternalFormat.ml:94:4>>*/ return [0,
-               [7, iconv$2, pad_of_pad_opt(pad_opt$4), 0, fmt]];
+               [7, iconv$2, pad_of_pad_opt(pad_opt$4), 0, fmt]] /*<<camlinternalFormat.ml:94:4>>*/ ;
       case 6:
        var prec_opt = ign[2], pad_opt$5 = ign[1];
        if(prec_opt)
@@ -13978,35 +14219,35 @@
        else
         var _cR_ = 0;
         /*<<camlinternalFormat.ml:97:4>>*/ return [0,
-               [8, _a_, pad_of_pad_opt(pad_opt$5), _cR_, fmt]];
+               [8, _a_, pad_of_pad_opt(pad_opt$5), _cR_, fmt]] /*<<camlinternalFormat.ml:97:4>>*/ ;
       case 7:
        var pad_opt$6 = ign[1];
         /*<<camlinternalFormat.ml:101:4>>*/ return [0,
-               [9, pad_of_pad_opt(pad_opt$6), fmt]];
+               [9, pad_of_pad_opt(pad_opt$6), fmt]] /*<<camlinternalFormat.ml:101:4>>*/ ;
       case 8:
        var fmtty = ign[2], pad_opt$7 = ign[1];
         /*<<camlinternalFormat.ml:103:4>>*/ return [0,
-               [13, pad_opt$7, fmtty, fmt]];
+               [13, pad_opt$7, fmtty, fmt]] /*<<camlinternalFormat.ml:103:4>>*/ ;
       case 9:
        var fmtty$0 = ign[2], pad_opt$8 = ign[1];
         /*<<camlinternalFormat.ml:105:4>>*/ return [0,
-               [14, pad_opt$8, fmtty$0, fmt]];
+               [14, pad_opt$8, fmtty$0, fmt]] /*<<camlinternalFormat.ml:105:4>>*/ ;
       case 10:
        var char_set = ign[2], width_opt = ign[1];
         /*<<camlinternalFormat.ml:110:4>>*/ return [0,
-               [20, width_opt, char_set, fmt]];
+               [20, width_opt, char_set, fmt]] /*<<camlinternalFormat.ml:110:4>>*/ ;
       default:
        var counter = ign[1];
-        /*<<camlinternalFormat.ml:112:4>>*/ return [0, [21, counter, fmt]];
+        /*<<camlinternalFormat.ml:112:4>>*/ return [0, [21, counter, fmt]] /*<<camlinternalFormat.ml:112:4>>*/ ;
     }
     /*<<camlinternalFormat.ml:114:41>>*/ }
    function default_float_precision(fconv){
-     /*<<camlinternalFormat.ml:221:2>>*/ return 5 === fconv[2] ? 12 : -6;
+     /*<<camlinternalFormat.ml:221:2>>*/ return 5 === fconv[2] ? 12 : -6 /*<<camlinternalFormat.ml:227:17>>*/ ;
     /*<<camlinternalFormat.ml:227:17>>*/ }
    function buffer_create(init_size){
      /*<<camlinternalFormat.ml:256:30>>*/ return [0,
             0,
-             /*<<camlinternalFormat.ml:256:49>>*/ caml_create_bytes(init_size)];
+             /*<<camlinternalFormat.ml:256:49>>*/ caml_create_bytes(init_size)] /*<<camlinternalFormat.ml:256:30>>*/ ;
     /*<<camlinternalFormat.ml:256:73>>*/ }
    function buffer_check_size(buf, overhead){
      /*<<camlinternalFormat.ml:260:2>>*/ var
@@ -14040,90 +14281,92 @@
     /*<<camlinternalFormat.ml:280:30>>*/ }
    function buffer_contents(buf){
      /*<<camlinternalFormat.ml:284:2>>*/ return caml_call3
-            (Stdlib_Bytes[8], buf[2], 0, buf[1]);
+            (Stdlib_Bytes[8], buf[2], 0, buf[1]) /*<<camlinternalFormat.ml:284:38>>*/ ;
     /*<<camlinternalFormat.ml:284:38>>*/ }
    function char_of_iconv(iconv){
      /*<<camlinternalFormat.ml:289:26>>*/ switch(iconv){
       case 6:
       case 7:
-        /*<<camlinternalFormat.ml:291:38>>*/ return 120;
+        /*<<camlinternalFormat.ml:291:38>>*/ return 120 /*<<camlinternalFormat.ml:291:38>>*/ ;
       case 8:
       case 9:
-        /*<<camlinternalFormat.ml:291:62>>*/ return 88;
+        /*<<camlinternalFormat.ml:291:62>>*/ return 88 /*<<camlinternalFormat.ml:291:62>>*/ ;
       case 10:
       case 11:
-        /*<<camlinternalFormat.ml:292:14>>*/ return 111;
+        /*<<camlinternalFormat.ml:292:14>>*/ return 111 /*<<camlinternalFormat.ml:292:14>>*/ ;
       case 12:
       case 15:
-        /*<<camlinternalFormat.ml:292:38>>*/ return 117;
+        /*<<camlinternalFormat.ml:292:38>>*/ return 117 /*<<camlinternalFormat.ml:292:38>>*/ ;
       case 0:
       case 1:
       case 2:
       case 13:
-        /*<<camlinternalFormat.ml:290:40>>*/ return 100;
-      default:  /*<<camlinternalFormat.ml:291:14>>*/ return 105;
+        /*<<camlinternalFormat.ml:290:40>>*/ return 100 /*<<camlinternalFormat.ml:290:40>>*/ ;
+      default:
+        /*<<camlinternalFormat.ml:291:14>>*/ return 105 /*<<camlinternalFormat.ml:291:14>>*/ ;
     }
     /*<<camlinternalFormat.ml:292:41>>*/ }
    function char_of_fconv(opt, fconv){
     var cF = opt ? opt[1] : 70;
     switch(fconv[2]){
       case 0:
-        /*<<camlinternalFormat.ml:297:15>>*/ return 102;
+        /*<<camlinternalFormat.ml:297:15>>*/ return 102 /*<<camlinternalFormat.ml:297:15>>*/ ;
       case 1:
-        /*<<camlinternalFormat.ml:297:32>>*/ return 101;
+        /*<<camlinternalFormat.ml:297:32>>*/ return 101 /*<<camlinternalFormat.ml:297:32>>*/ ;
       case 2:
-        /*<<camlinternalFormat.ml:298:15>>*/ return 69;
+        /*<<camlinternalFormat.ml:298:15>>*/ return 69 /*<<camlinternalFormat.ml:298:15>>*/ ;
       case 3:
-        /*<<camlinternalFormat.ml:298:32>>*/ return 103;
+        /*<<camlinternalFormat.ml:298:32>>*/ return 103 /*<<camlinternalFormat.ml:298:32>>*/ ;
       case 4:
-        /*<<camlinternalFormat.ml:299:15>>*/ return 71;
+        /*<<camlinternalFormat.ml:299:15>>*/ return 71 /*<<camlinternalFormat.ml:299:15>>*/ ;
       case 5:
-        /*<<camlinternalFormat.ml:299:32>>*/ return cF;
+        /*<<camlinternalFormat.ml:299:32>>*/ return cF /*<<camlinternalFormat.ml:299:32>>*/ ;
       case 6:
-        /*<<camlinternalFormat.ml:300:15>>*/ return 104;
+        /*<<camlinternalFormat.ml:300:15>>*/ return 104 /*<<camlinternalFormat.ml:300:15>>*/ ;
       case 7:
-        /*<<camlinternalFormat.ml:300:32>>*/ return 72;
-      default:  /*<<camlinternalFormat.ml:301:16>>*/ return 70;
+        /*<<camlinternalFormat.ml:300:32>>*/ return 72 /*<<camlinternalFormat.ml:300:32>>*/ ;
+      default:
+        /*<<camlinternalFormat.ml:301:16>>*/ return 70 /*<<camlinternalFormat.ml:301:16>>*/ ;
     }
    }
    function bprint_padty(buf, padty){
      /*<<camlinternalFormat.ml:374:29>>*/ switch(padty){
       case 0:
-        /*<<camlinternalFormat.ml:375:13>>*/ return buffer_add_char(buf, 45);
+        /*<<camlinternalFormat.ml:375:13>>*/ return buffer_add_char(buf, 45) /*<<camlinternalFormat.ml:377:36>>*/ ;
       case 1:
-        /*<<camlinternalFormat.ml:376:13>>*/ return;
+        /*<<camlinternalFormat.ml:376:13>>*/ return /*<<camlinternalFormat.ml:376:13>>*/ ;
       default:
-        /*<<camlinternalFormat.ml:377:13>>*/ return buffer_add_char(buf, 48);
+        /*<<camlinternalFormat.ml:377:13>>*/ return buffer_add_char(buf, 48) /*<<camlinternalFormat.ml:377:36>>*/ ;
     }
     /*<<camlinternalFormat.ml:377:36>>*/ }
    function bprint_ignored_flag(buf, ign_flag){
      /*<<camlinternalFormat.ml:381:2>>*/ return ign_flag
             ? buffer_add_char(buf, 95)
-            : ign_flag;
+            : ign_flag /*<<camlinternalFormat.ml:381:42>>*/ ;
     /*<<camlinternalFormat.ml:381:42>>*/ }
    function bprint_pad_opt(buf, pad_opt){
      /*<<camlinternalFormat.ml:385:33>>*/ if(! pad_opt)
-      /*<<camlinternalFormat.ml:386:12>>*/ return;
+      /*<<camlinternalFormat.ml:386:12>>*/ return /*<<camlinternalFormat.ml:386:12>>*/ ;
     var width = pad_opt[1];
      /*<<camlinternalFormat.ml:387:40>>*/ return buffer_add_string
             (buf,
               /*<<camlinternalFormat.ml:387:40>>*/ caml_call1
-              (Stdlib_Int[12], width));
+              (Stdlib_Int[12], width)) /*<<camlinternalFormat.ml:387:61>>*/ ;
     /*<<camlinternalFormat.ml:387:61>>*/ }
    function bprint_padding(buf, pad){
      /*<<camlinternalFormat.ml:393:15>>*/ if(typeof pad === "number")
-      /*<<camlinternalFormat.ml:394:18>>*/ return;
+      /*<<camlinternalFormat.ml:394:18>>*/ return /*<<camlinternalFormat.ml:394:18>>*/ ;
     if(0 === pad[0]){
      var n = pad[2], padty = pad[1];
       /*<<camlinternalFormat.ml:396:4>>*/ bprint_padty(buf, padty);
       /*<<camlinternalFormat.ml:397:26>>*/ return buffer_add_string
              (buf,
                /*<<camlinternalFormat.ml:397:26>>*/ caml_call1
-               (Stdlib_Int[12], n));
+               (Stdlib_Int[12], n)) /*<<camlinternalFormat.ml:400:27>>*/ ;
     }
     var padty$0 = pad[1];
      /*<<camlinternalFormat.ml:399:4>>*/ bprint_padty(buf, padty$0);
-     /*<<camlinternalFormat.ml:399:4>>*/ return buffer_add_char(buf, 42);
+     /*<<camlinternalFormat.ml:399:4>>*/ return buffer_add_char(buf, 42) /*<<camlinternalFormat.ml:400:27>>*/ ;
     /*<<camlinternalFormat.ml:400:27>>*/ }
    function bprint_precision(buf, prec){
      /*<<camlinternalFormat.ml:404:18>>*/ if(typeof prec !== "number"){
@@ -14132,27 +14375,28 @@
       /*<<camlinternalFormat.ml:408:26>>*/ return buffer_add_string
              (buf,
                /*<<camlinternalFormat.ml:408:26>>*/ caml_call1
-               (Stdlib_Int[12], n));
+               (Stdlib_Int[12], n)) /*<<camlinternalFormat.ml:410:30>>*/ ;
     }
     if(prec)
-      /*<<camlinternalFormat.ml:410:4>>*/ return buffer_add_string(buf, cst);
+      /*<<camlinternalFormat.ml:410:4>>*/ return buffer_add_string(buf, cst) /*<<camlinternalFormat.ml:410:30>>*/ ;
     /*<<camlinternalFormat.ml:410:30>>*/ }
    function bprint_iconv_flag(buf, iconv){
      /*<<camlinternalFormat.ml:415:34>>*/ switch(iconv){
       case 1:
       case 4:
-        /*<<camlinternalFormat.ml:416:23>>*/ return buffer_add_char(buf, 43);
+        /*<<camlinternalFormat.ml:416:23>>*/ return buffer_add_char(buf, 43) /*<<camlinternalFormat.ml:420:55>>*/ ;
       case 2:
       case 5:
-        /*<<camlinternalFormat.ml:417:23>>*/ return buffer_add_char(buf, 32);
+        /*<<camlinternalFormat.ml:417:23>>*/ return buffer_add_char(buf, 32) /*<<camlinternalFormat.ml:420:55>>*/ ;
       case 7:
       case 9:
       case 11:
       case 13:
       case 14:
       case 15:
-        /*<<camlinternalFormat.ml:419:6>>*/ return buffer_add_char(buf, 35);
-      default:  /*<<camlinternalFormat.ml:420:53>>*/ return;
+        /*<<camlinternalFormat.ml:419:6>>*/ return buffer_add_char(buf, 35) /*<<camlinternalFormat.ml:420:55>>*/ ;
+      default:
+        /*<<camlinternalFormat.ml:420:53>>*/ return /*<<camlinternalFormat.ml:420:53>>*/ ;
     }
     /*<<camlinternalFormat.ml:420:55>>*/ }
    function bprint_altint_fmt(buf, ign_flag, iconv, pad, prec, c){
@@ -14163,7 +14407,7 @@
      /*<<camlinternalFormat.ml:437:2>>*/ bprint_precision(buf, prec);
      /*<<camlinternalFormat.ml:438:2>>*/ buffer_add_char(buf, c);
      /*<<camlinternalFormat.ml:439:22>>*/ return buffer_add_char
-            (buf, char_of_iconv(iconv));
+            (buf, char_of_iconv(iconv)) /*<<camlinternalFormat.ml:439:43>>*/ ;
     /*<<camlinternalFormat.ml:439:43>>*/ }
    function bprint_fconv_flag(buf, fconv){
      /*<<camlinternalFormat.ml:445:2>>*/ switch(fconv[1]){
@@ -14173,33 +14417,34 @@
       default:  /*<<camlinternalFormat.ml:447:20>>*/ buffer_add_char(buf, 32);
     }
     if(8 <= fconv[2])
-      /*<<camlinternalFormat.ml:450:16>>*/ return buffer_add_char(buf, 35);
+      /*<<camlinternalFormat.ml:450:16>>*/ return buffer_add_char(buf, 35) /*<<camlinternalFormat.ml:452:37>>*/ ;
     /*<<camlinternalFormat.ml:452:37>>*/ }
    function string_of_formatting_lit(formatting_lit){
      /*<<camlinternalFormat.ml:465:46>>*/ if
      (typeof formatting_lit === "number")
      switch(formatting_lit){
        case 0:
-         /*<<camlinternalFormat.ml:466:28>>*/ return cst$0;
+         /*<<camlinternalFormat.ml:466:28>>*/ return cst$0 /*<<camlinternalFormat.ml:466:28>>*/ ;
        case 1:
-         /*<<camlinternalFormat.ml:467:28>>*/ return cst$1;
+         /*<<camlinternalFormat.ml:467:28>>*/ return cst$1 /*<<camlinternalFormat.ml:467:28>>*/ ;
        case 2:
-         /*<<camlinternalFormat.ml:469:28>>*/ return cst$2;
+         /*<<camlinternalFormat.ml:469:28>>*/ return cst$2 /*<<camlinternalFormat.ml:469:28>>*/ ;
        case 3:
-         /*<<camlinternalFormat.ml:470:28>>*/ return cst$3;
+         /*<<camlinternalFormat.ml:470:28>>*/ return cst$3 /*<<camlinternalFormat.ml:470:28>>*/ ;
        case 4:
-         /*<<camlinternalFormat.ml:471:28>>*/ return cst$4;
+         /*<<camlinternalFormat.ml:471:28>>*/ return cst$4 /*<<camlinternalFormat.ml:471:28>>*/ ;
        case 5:
-         /*<<camlinternalFormat.ml:473:28>>*/ return cst$5;
-       default:  /*<<camlinternalFormat.ml:474:28>>*/ return cst$6;
+         /*<<camlinternalFormat.ml:473:28>>*/ return cst$5 /*<<camlinternalFormat.ml:473:28>>*/ ;
+       default:
+         /*<<camlinternalFormat.ml:474:28>>*/ return cst$6 /*<<camlinternalFormat.ml:474:28>>*/ ;
      }
     switch(formatting_lit[0]){
       case 0:
        var str = formatting_lit[1];
-        /*<<camlinternalFormat.ml:468:28>>*/ return str;
+        /*<<camlinternalFormat.ml:468:28>>*/ return str /*<<camlinternalFormat.ml:468:28>>*/ ;
       case 1:
        var str$0 = formatting_lit[1];
-        /*<<camlinternalFormat.ml:472:28>>*/ return str$0;
+        /*<<camlinternalFormat.ml:472:28>>*/ return str$0 /*<<camlinternalFormat.ml:472:28>>*/ ;
       default:
         /*<<camlinternalFormat.ml:475:26>>*/ var
         c = formatting_lit[1],
@@ -14207,13 +14452,13 @@
            /*<<camlinternalFormat.ml:475:26>>*/ caml_call2
            (Stdlib_String[1], 1, c);
         /*<<camlinternalFormat.ml:475:26>>*/ return  /*<<camlinternalFormat.ml:475:26>>*/ caml_call2
-               (Stdlib[28], cst$7, _cQ_);
+               (Stdlib[28], cst$7, _cQ_) /*<<camlinternalFormat.ml:475:43>>*/ ;
     }
     /*<<camlinternalFormat.ml:475:43>>*/ }
    function bprint_char_literal(buf, chr){
      /*<<camlinternalFormat.ml:480:34>>*/ return 37 === chr
             ? buffer_add_string(buf, cst$8)
-            : buffer_add_char(buf, chr);
+            : buffer_add_char(buf, chr) /*<<camlinternalFormat.ml:482:32>>*/ ;
     /*<<camlinternalFormat.ml:482:32>>*/ }
    function bprint_string_literal(buf, str){
      /*<<camlinternalFormat.ml:486:2>>*/ var
@@ -14235,7 +14480,7 @@
      /*<<camlinternalFormat.ml:496:17>>*/ var fmtty$0 = fmtty;
      /*<<camlinternalFormat.ml:496:17>>*/ for(;;){
      if(typeof fmtty$0 === "number")
-       /*<<camlinternalFormat.ml:521:20>>*/ return;
+       /*<<camlinternalFormat.ml:521:20>>*/ return /*<<camlinternalFormat.ml:521:20>>*/ ;
      switch(fmtty$0[0]){
        case 0:
         var fmtty$1 = fmtty$0[1];
@@ -14319,7 +14564,8 @@
     }
     /*<<camlinternalFormat.ml:521:22>>*/ }
    function int_of_custom_arity(param){
-     /*<<?>>*/ if(! param)  /*<<camlinternalFormat.ml:528:19>>*/ return 0;
+     /*<<?>>*/ if(! param)
+      /*<<camlinternalFormat.ml:528:19>>*/ return 0 /*<<camlinternalFormat.ml:528:19>>*/ ;
     var x = param[1];
     return 1 + int_of_custom_arity(x) | 0;
    }
@@ -14332,7 +14578,7 @@
       ign_flag$0 = ign_flag;
       /*<<camlinternalFormat.ml:535:22>>*/ for(;;){
       if(typeof fmt$0 === "number")
-        /*<<camlinternalFormat.ml:636:23>>*/ return;
+        /*<<camlinternalFormat.ml:636:23>>*/ return /*<<camlinternalFormat.ml:636:23>>*/ ;
       switch(fmt$0[0]){
         case 0:
          var rest = fmt$0[1];
@@ -14555,7 +14801,7 @@
                      : 64
                        === c
                        ? (buffer_add_char(buf, 37), buffer_add_char(buf, 64))
-                       : buffer_add_char(buf, c);
+                       : buffer_add_char(buf, c) /*<<camlinternalFormat.ml:361:35>>*/ ;
              /*<<camlinternalFormat.ml:361:35>>*/ };
           /*<<camlinternalFormat.ml:363:2>>*/ buffer_add_char(buf, 91);
           /*<<camlinternalFormat.ml:365:7>>*/  /*<<camlinternalFormat.ml:365:7>>*/ var
@@ -14585,7 +14831,7 @@
                _cM_ = 1 - _cL_;
              else
               var _cM_ = _cJ_;
-              /*<<camlinternalFormat.ml:318:43>>*/ return _cM_;
+              /*<<camlinternalFormat.ml:318:43>>*/ return _cM_ /*<<camlinternalFormat.ml:318:43>>*/ ;
              /*<<camlinternalFormat.ml:318:68>>*/ };
           /*<<camlinternalFormat.ml:319:7>>*/ if(is_alone(93))
            /*<<camlinternalFormat.ml:319:25>>*/ buffer_add_char(buf, 93);
@@ -14779,57 +15025,57 @@
      }
      /*<<camlinternalFormat.ml:636:25>>*/ }
      /*<<camlinternalFormat.ml:638:5>>*/ fmtiter(fmt, 0);
-     /*<<camlinternalFormat.ml:645:2>>*/ return buffer_contents(buf);
+     /*<<camlinternalFormat.ml:645:2>>*/ return buffer_contents(buf) /*<<camlinternalFormat.ml:646:21>>*/ ;
     /*<<camlinternalFormat.ml:646:21>>*/ }
    function symm(param){
      /*<<?>>*/ if(typeof param === "number")
-      /*<<camlinternalFormat.ml:680:20>>*/ return 0;
+      /*<<camlinternalFormat.ml:680:20>>*/ return 0 /*<<camlinternalFormat.ml:680:20>>*/ ;
     switch(param[0]){
       case 0:
        var rest = param[1];
-        /*<<camlinternalFormat.ml:663:20>>*/ return [0, symm(rest)];
+        /*<<camlinternalFormat.ml:663:20>>*/ return [0, symm(rest)] /*<<camlinternalFormat.ml:663:20>>*/ ;
       case 1:
        var rest$0 = param[1];
-        /*<<camlinternalFormat.ml:670:22>>*/ return [1, symm(rest$0)];
+        /*<<camlinternalFormat.ml:670:22>>*/ return [1, symm(rest$0)] /*<<camlinternalFormat.ml:670:22>>*/ ;
       case 2:
        var rest$1 = param[1];
-        /*<<camlinternalFormat.ml:664:19>>*/ return [2, symm(rest$1)];
+        /*<<camlinternalFormat.ml:664:19>>*/ return [2, symm(rest$1)] /*<<camlinternalFormat.ml:664:19>>*/ ;
       case 3:
        var rest$2 = param[1];
-        /*<<camlinternalFormat.ml:665:21>>*/ return [3, symm(rest$2)];
+        /*<<camlinternalFormat.ml:665:21>>*/ return [3, symm(rest$2)] /*<<camlinternalFormat.ml:665:21>>*/ ;
       case 4:
        var rest$3 = param[1];
-        /*<<camlinternalFormat.ml:667:25>>*/ return [4, symm(rest$3)];
+        /*<<camlinternalFormat.ml:667:25>>*/ return [4, symm(rest$3)] /*<<camlinternalFormat.ml:667:25>>*/ ;
       case 5:
        var rest$4 = param[1];
-        /*<<camlinternalFormat.ml:666:21>>*/ return [5, symm(rest$4)];
+        /*<<camlinternalFormat.ml:666:21>>*/ return [5, symm(rest$4)] /*<<camlinternalFormat.ml:666:21>>*/ ;
       case 6:
        var rest$5 = param[1];
-        /*<<camlinternalFormat.ml:668:21>>*/ return [6, symm(rest$5)];
+        /*<<camlinternalFormat.ml:668:21>>*/ return [6, symm(rest$5)] /*<<camlinternalFormat.ml:668:21>>*/ ;
       case 7:
        var rest$6 = param[1];
-        /*<<camlinternalFormat.ml:669:20>>*/ return [7, symm(rest$6)];
+        /*<<camlinternalFormat.ml:669:20>>*/ return [7, symm(rest$6)] /*<<camlinternalFormat.ml:669:20>>*/ ;
       case 8:
        var rest$7 = param[2], ty = param[1];
-        /*<<camlinternalFormat.ml:677:4>>*/ return [8, ty, symm(rest$7)];
+        /*<<camlinternalFormat.ml:677:4>>*/ return [8, ty, symm(rest$7)] /*<<camlinternalFormat.ml:677:4>>*/ ;
       case 9:
        var rest$8 = param[3], ty2 = param[2], ty1 = param[1];
-        /*<<camlinternalFormat.ml:679:4>>*/ return [9, ty2, ty1, symm(rest$8)];
+        /*<<camlinternalFormat.ml:679:4>>*/ return [9, ty2, ty1, symm(rest$8)] /*<<camlinternalFormat.ml:679:4>>*/ ;
       case 10:
        var rest$9 = param[1];
-        /*<<camlinternalFormat.ml:672:21>>*/ return [10, symm(rest$9)];
+        /*<<camlinternalFormat.ml:672:21>>*/ return [10, symm(rest$9)] /*<<camlinternalFormat.ml:672:21>>*/ ;
       case 11:
        var rest$10 = param[1];
-        /*<<camlinternalFormat.ml:671:21>>*/ return [11, symm(rest$10)];
+        /*<<camlinternalFormat.ml:671:21>>*/ return [11, symm(rest$10)] /*<<camlinternalFormat.ml:671:21>>*/ ;
       case 12:
        var rest$11 = param[1];
-        /*<<camlinternalFormat.ml:673:19>>*/ return [12, symm(rest$11)];
+        /*<<camlinternalFormat.ml:673:19>>*/ return [12, symm(rest$11)] /*<<camlinternalFormat.ml:673:19>>*/ ;
       case 13:
        var rest$12 = param[1];
-        /*<<camlinternalFormat.ml:674:22>>*/ return [13, symm(rest$12)];
+        /*<<camlinternalFormat.ml:674:22>>*/ return [13, symm(rest$12)] /*<<camlinternalFormat.ml:674:22>>*/ ;
       default:
        var rest$13 = param[1];
-        /*<<camlinternalFormat.ml:675:30>>*/ return [14, symm(rest$13)];
+        /*<<camlinternalFormat.ml:675:30>>*/ return [14, symm(rest$13)] /*<<camlinternalFormat.ml:675:30>>*/ ;
     }
    }
    function fmtty_rel_det(param){
@@ -14838,7 +15084,7 @@
              ,
              function(param){ /*<<camlinternalFormat.ml:692:21>>*/ },
              ,
-             function(param){ /*<<camlinternalFormat.ml:694:21>>*/ }];
+             function(param){ /*<<camlinternalFormat.ml:694:21>>*/ }] /*<<camlinternalFormat.ml:691:4>>*/ ;
     switch(param[0]){
       case 0:
         /*<<camlinternalFormat.ml:696:25>>*/ var
@@ -14852,7 +15098,7 @@
                  /*<<camlinternalFormat.ml:698:17>>*/ af(0);
                 /*<<camlinternalFormat.ml:698:43>>*/ },
                ,
-               de];
+               de] /*<<camlinternalFormat.ml:697:4>>*/ ;
       case 1:
         /*<<camlinternalFormat.ml:701:25>>*/ var
         rest$0 = param[1],
@@ -14865,7 +15111,7 @@
                  /*<<camlinternalFormat.ml:703:17>>*/ af$0(0);
                 /*<<camlinternalFormat.ml:703:43>>*/ },
                ,
-               de$0];
+               de$0] /*<<camlinternalFormat.ml:702:4>>*/ ;
       case 2:
         /*<<camlinternalFormat.ml:706:25>>*/ var
         rest$1 = param[1],
@@ -14878,7 +15124,7 @@
                  /*<<camlinternalFormat.ml:708:17>>*/ af$1(0);
                 /*<<camlinternalFormat.ml:708:43>>*/ },
                ,
-               de$1];
+               de$1] /*<<camlinternalFormat.ml:707:4>>*/ ;
       case 3:
         /*<<camlinternalFormat.ml:711:25>>*/ var
         rest$2 = param[1],
@@ -14891,7 +15137,7 @@
                  /*<<camlinternalFormat.ml:713:17>>*/ af$2(0);
                 /*<<camlinternalFormat.ml:713:43>>*/ },
                ,
-               de$2];
+               de$2] /*<<camlinternalFormat.ml:712:4>>*/ ;
       case 4:
         /*<<camlinternalFormat.ml:721:25>>*/ var
         rest$3 = param[1],
@@ -14904,7 +15150,7 @@
                  /*<<camlinternalFormat.ml:723:17>>*/ af$3(0);
                 /*<<camlinternalFormat.ml:723:43>>*/ },
                ,
-               de$3];
+               de$3] /*<<camlinternalFormat.ml:722:4>>*/ ;
       case 5:
         /*<<camlinternalFormat.ml:716:25>>*/ var
         rest$4 = param[1],
@@ -14917,7 +15163,7 @@
                  /*<<camlinternalFormat.ml:718:17>>*/ af$4(0);
                 /*<<camlinternalFormat.ml:718:43>>*/ },
                ,
-               de$4];
+               de$4] /*<<camlinternalFormat.ml:717:4>>*/ ;
       case 6:
         /*<<camlinternalFormat.ml:726:25>>*/ var
         rest$5 = param[1],
@@ -14930,7 +15176,7 @@
                  /*<<camlinternalFormat.ml:728:17>>*/ af$5(0);
                 /*<<camlinternalFormat.ml:728:43>>*/ },
                ,
-               de$5];
+               de$5] /*<<camlinternalFormat.ml:727:4>>*/ ;
       case 7:
         /*<<camlinternalFormat.ml:731:25>>*/ var
         rest$6 = param[1],
@@ -14943,7 +15189,7 @@
                  /*<<camlinternalFormat.ml:733:17>>*/ af$6(0);
                 /*<<camlinternalFormat.ml:733:43>>*/ },
                ,
-               de$6];
+               de$6] /*<<camlinternalFormat.ml:732:4>>*/ ;
       case 8:
         /*<<camlinternalFormat.ml:764:25>>*/ var
         rest$7 = param[2],
@@ -14956,7 +15202,7 @@
                  /*<<camlinternalFormat.ml:766:17>>*/ af$7(0);
                 /*<<camlinternalFormat.ml:766:43>>*/ },
                ,
-               de$7];
+               de$7] /*<<camlinternalFormat.ml:765:4>>*/ ;
       case 9:
         /*<<camlinternalFormat.ml:769:25>>*/ var
         rest$8 = param[3],
@@ -14979,7 +15225,7 @@
                function(param){
                  /*<<camlinternalFormat.ml:775:17>>*/ jd(0);
                  /*<<camlinternalFormat.ml:775:50>>*/ de$8(0);
-                /*<<camlinternalFormat.ml:775:65>>*/ }];
+                /*<<camlinternalFormat.ml:775:65>>*/ }] /*<<camlinternalFormat.ml:772:4>>*/ ;
       case 10:
         /*<<camlinternalFormat.ml:742:25>>*/ var
         rest$9 = param[1],
@@ -14992,7 +15238,7 @@
                  /*<<camlinternalFormat.ml:744:17>>*/ af$9(0);
                 /*<<camlinternalFormat.ml:744:43>>*/ },
                ,
-               de$9];
+               de$9] /*<<camlinternalFormat.ml:743:4>>*/ ;
       case 11:
         /*<<camlinternalFormat.ml:737:25>>*/ var
         rest$10 = param[1],
@@ -15006,7 +15252,7 @@
                  /*<<camlinternalFormat.ml:739:17>>*/ af$10(0);
                 /*<<camlinternalFormat.ml:739:43>>*/ },
                ,
-               de$10];
+               de$10] /*<<camlinternalFormat.ml:738:4>>*/ ;
       case 12:
         /*<<camlinternalFormat.ml:747:25>>*/ var
         rest$11 = param[1],
@@ -15020,7 +15266,7 @@
                  /*<<camlinternalFormat.ml:749:17>>*/ af$11(0);
                 /*<<camlinternalFormat.ml:749:43>>*/ },
                ,
-               de$11];
+               de$11] /*<<camlinternalFormat.ml:748:4>>*/ ;
       case 13:
         /*<<camlinternalFormat.ml:752:25>>*/ var
         rest$12 = param[1],
@@ -15036,7 +15282,7 @@
                ,
                function(param){
                  /*<<camlinternalFormat.ml:756:17>>*/ de$12(0);
-                /*<<camlinternalFormat.ml:756:43>>*/ }];
+                /*<<camlinternalFormat.ml:756:43>>*/ }] /*<<camlinternalFormat.ml:753:4>>*/ ;
       default:
         /*<<camlinternalFormat.ml:758:25>>*/ var
         rest$13 = param[1],
@@ -15052,7 +15298,7 @@
                ,
                function(param){
                  /*<<camlinternalFormat.ml:762:17>>*/ de$13(0);
-                /*<<camlinternalFormat.ml:762:43>>*/ }];
+                /*<<camlinternalFormat.ml:762:43>>*/ }] /*<<camlinternalFormat.ml:759:4>>*/ ;
     }
    }
    function trans(ty1, ty2){
@@ -15079,7 +15325,7 @@
                   case 0:
                    var rest2 = ty2[1];
                     /*<<camlinternalFormat.ml:804:36>>*/ return [0,
-                           trans(rest1, rest2)];
+                           trans(rest1, rest2)] /*<<camlinternalFormat.ml:804:36>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15103,7 +15349,7 @@
                   case 1:
                    var rest2$0 = ty2[1];
                     /*<<camlinternalFormat.ml:805:40>>*/ return [1,
-                           trans(rest1$0, rest2$0)];
+                           trans(rest1$0, rest2$0)] /*<<camlinternalFormat.ml:805:40>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15127,7 +15373,7 @@
                   case 2:
                    var rest2$1 = ty2[1];
                     /*<<camlinternalFormat.ml:807:34>>*/ return [2,
-                           trans(rest1$1, rest2$1)];
+                           trans(rest1$1, rest2$1)] /*<<camlinternalFormat.ml:807:34>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15151,7 +15397,7 @@
                   case 3:
                    var rest2$2 = ty2[1];
                     /*<<camlinternalFormat.ml:808:38>>*/ return [3,
-                           trans(rest1$2, rest2$2)];
+                           trans(rest1$2, rest2$2)] /*<<camlinternalFormat.ml:808:38>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15175,7 +15421,7 @@
                   case 4:
                    var rest2$3 = ty2[1];
                     /*<<camlinternalFormat.ml:810:46>>*/ return [4,
-                           trans(rest1$3, rest2$3)];
+                           trans(rest1$3, rest2$3)] /*<<camlinternalFormat.ml:810:46>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15199,7 +15445,7 @@
                   case 5:
                    var rest2$4 = ty2[1];
                     /*<<camlinternalFormat.ml:809:38>>*/ return [5,
-                           trans(rest1$4, rest2$4)];
+                           trans(rest1$4, rest2$4)] /*<<camlinternalFormat.ml:809:38>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15223,7 +15469,7 @@
                   case 6:
                    var rest2$5 = ty2[1];
                     /*<<camlinternalFormat.ml:811:38>>*/ return [6,
-                           trans(rest1$5, rest2$5)];
+                           trans(rest1$5, rest2$5)] /*<<camlinternalFormat.ml:811:38>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15247,7 +15493,7 @@
                   case 7:
                    var rest2$6 = ty2[1];
                     /*<<camlinternalFormat.ml:806:36>>*/ return [7,
-                           trans(rest1$6, rest2$6)];
+                           trans(rest1$6, rest2$6)] /*<<camlinternalFormat.ml:806:36>>*/ ;
                   case 8:
                    break f;
                   case 9:
@@ -15276,7 +15522,7 @@
                       trans(rest1$7, rest2$7);
                     /*<<camlinternalFormat.ml:835:4>>*/ return [8,
                            trans(ty1$0, ty2$0),
-                           _cE_];
+                           _cE_] /*<<camlinternalFormat.ml:835:4>>*/ ;
                   case 10:
                    break a;
                   case 11:
@@ -15312,7 +15558,7 @@
                     /*<<camlinternalFormat.ml:845:4>>*/ return [9,
                            ty11,
                            ty22,
-                           trans(rest1$8, rest2$8)];
+                           trans(rest1$8, rest2$8)] /*<<camlinternalFormat.ml:845:4>>*/ ;
                   case 10:
                    break a;
                   case 11:
@@ -15331,7 +15577,7 @@
                if(typeof ty2 !== "number" && 10 === ty2[0]){
                 var rest2$9 = ty2[1];
                  /*<<camlinternalFormat.ml:813:38>>*/ return [10,
-                        trans(rest1$9, rest2$9)];
+                        trans(rest1$9, rest2$9)] /*<<camlinternalFormat.ml:813:38>>*/ ;
                }
                 /*<<camlinternalFormat.ml:814:21>>*/ throw  /*<<camlinternalFormat.ml:814:21>>*/ caml_maybe_attach_backtrace
                       ([0, Assert_failure, _m_], 1);
@@ -15344,7 +15590,7 @@
                   case 11:
                    var rest2$10 = ty2[1];
                     /*<<camlinternalFormat.ml:817:38>>*/ return [11,
-                           trans(rest1$10, rest2$10)];
+                           trans(rest1$10, rest2$10)] /*<<camlinternalFormat.ml:817:38>>*/ ;
                 }
                 /*<<camlinternalFormat.ml:818:21>>*/ throw  /*<<camlinternalFormat.ml:818:21>>*/ caml_maybe_attach_backtrace
                       ([0, Assert_failure, _n_], 1);
@@ -15359,7 +15605,7 @@
                   case 12:
                    var rest2$11 = ty2[1];
                     /*<<camlinternalFormat.ml:821:34>>*/ return [12,
-                           trans(rest1$11, rest2$11)];
+                           trans(rest1$11, rest2$11)] /*<<camlinternalFormat.ml:821:34>>*/ ;
                 }
                 /*<<camlinternalFormat.ml:822:19>>*/ throw  /*<<camlinternalFormat.ml:822:19>>*/ caml_maybe_attach_backtrace
                       ([0, Assert_failure, _o_], 1);
@@ -15376,7 +15622,7 @@
                   case 13:
                    var rest2$12 = ty2[1];
                     /*<<camlinternalFormat.ml:825:40>>*/ return [13,
-                           trans(rest1$12, rest2$12)];
+                           trans(rest1$12, rest2$12)] /*<<camlinternalFormat.ml:825:40>>*/ ;
                 }
                 /*<<camlinternalFormat.ml:826:22>>*/ throw  /*<<camlinternalFormat.ml:826:22>>*/ caml_maybe_attach_backtrace
                       ([0, Assert_failure, _p_], 1);
@@ -15395,7 +15641,7 @@
                   case 14:
                    var rest2$13 = ty2[1];
                     /*<<camlinternalFormat.ml:830:4>>*/ return [14,
-                           trans(rest1$13, rest2$13)];
+                           trans(rest1$13, rest2$13)] /*<<camlinternalFormat.ml:830:4>>*/ ;
                 }
                 /*<<camlinternalFormat.ml:831:30>>*/ throw  /*<<camlinternalFormat.ml:831:30>>*/ caml_maybe_attach_backtrace
                       ([0, Assert_failure, _q_], 1);
@@ -15404,7 +15650,7 @@
                    ([0, Assert_failure, _j_], 1);
            }
            if(typeof ty2 === "number")
-             /*<<camlinternalFormat.ml:849:34>>*/ return 0;
+             /*<<camlinternalFormat.ml:849:34>>*/ return 0 /*<<camlinternalFormat.ml:849:34>>*/ ;
            switch(ty2[0]){
              case 10:
               break a;
@@ -15449,22 +15695,22 @@
      /*<<camlinternalFormat.ml:863:13>>*/ var fmtty$0 = fmtty;
      /*<<camlinternalFormat.ml:863:13>>*/ for(;;){
      if(typeof fmtty$0 === "number")
-       /*<<camlinternalFormat.ml:916:34>>*/ return 0;
+       /*<<camlinternalFormat.ml:916:34>>*/ return 0 /*<<camlinternalFormat.ml:916:34>>*/ ;
      switch(fmtty$0[0]){
        case 0:
         var rest = fmtty$0[1];
-         /*<<camlinternalFormat.ml:890:34>>*/ return [0, fmtty_of_fmt(rest)];
+         /*<<camlinternalFormat.ml:890:34>>*/ return [0, fmtty_of_fmt(rest)] /*<<camlinternalFormat.ml:890:34>>*/ ;
        case 1:
         var rest$0 = fmtty$0[1];
-         /*<<camlinternalFormat.ml:891:34>>*/ return [0, fmtty_of_fmt(rest$0)];
+         /*<<camlinternalFormat.ml:891:34>>*/ return [0, fmtty_of_fmt(rest$0)] /*<<camlinternalFormat.ml:891:34>>*/ ;
        case 2:
         var rest$1 = fmtty$0[2], pad = fmtty$0[1];
          /*<<camlinternalFormat.ml:865:31>>*/ return fmtty_of_padding_fmtty
-                (pad, [1, fmtty_of_fmt(rest$1)]);
+                (pad, [1, fmtty_of_fmt(rest$1)]) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 3:
         var rest$2 = fmtty$0[2], pad$0 = fmtty$0[1];
          /*<<camlinternalFormat.ml:867:31>>*/ return fmtty_of_padding_fmtty
-                (pad$0, [1, fmtty_of_fmt(rest$2)]);
+                (pad$0, [1, fmtty_of_fmt(rest$2)]) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 4:
          /*<<camlinternalFormat.ml:870:18>>*/ var
          rest$3 = fmtty$0[4],
@@ -15474,7 +15720,7 @@
           /*<<camlinternalFormat.ml:871:18>>*/ prec_ty =
            fmtty_of_precision_fmtty(prec, [2, ty_rest]);
          /*<<camlinternalFormat.ml:872:4>>*/ return fmtty_of_padding_fmtty
-                (pad$1, prec_ty);
+                (pad$1, prec_ty) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 5:
          /*<<camlinternalFormat.ml:874:18>>*/ var
          rest$4 = fmtty$0[4],
@@ -15485,7 +15731,7 @@
           /*<<camlinternalFormat.ml:875:18>>*/ prec_ty$0 =
            fmtty_of_precision_fmtty(prec$0, [3, ty_rest$0]);
          /*<<camlinternalFormat.ml:876:4>>*/ return fmtty_of_padding_fmtty
-                (pad$2, prec_ty$0);
+                (pad$2, prec_ty$0) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 6:
          /*<<camlinternalFormat.ml:878:18>>*/ var
          rest$5 = fmtty$0[4],
@@ -15496,7 +15742,7 @@
           /*<<camlinternalFormat.ml:879:18>>*/ prec_ty$1 =
            fmtty_of_precision_fmtty(prec$1, [4, ty_rest$1]);
          /*<<camlinternalFormat.ml:880:4>>*/ return fmtty_of_padding_fmtty
-                (pad$3, prec_ty$1);
+                (pad$3, prec_ty$1) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 7:
          /*<<camlinternalFormat.ml:882:18>>*/ var
          rest$6 = fmtty$0[4],
@@ -15507,7 +15753,7 @@
           /*<<camlinternalFormat.ml:883:18>>*/ prec_ty$2 =
            fmtty_of_precision_fmtty(prec$2, [5, ty_rest$2]);
          /*<<camlinternalFormat.ml:884:4>>*/ return fmtty_of_padding_fmtty
-                (pad$4, prec_ty$2);
+                (pad$4, prec_ty$2) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 8:
          /*<<camlinternalFormat.ml:886:18>>*/ var
          rest$7 = fmtty$0[4],
@@ -15518,11 +15764,11 @@
           /*<<camlinternalFormat.ml:887:18>>*/ prec_ty$3 =
            fmtty_of_precision_fmtty(prec$3, [6, ty_rest$3]);
          /*<<camlinternalFormat.ml:888:4>>*/ return fmtty_of_padding_fmtty
-                (pad$5, prec_ty$3);
+                (pad$5, prec_ty$3) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 9:
         var rest$8 = fmtty$0[2], pad$6 = fmtty$0[1];
          /*<<camlinternalFormat.ml:893:33>>*/ return fmtty_of_padding_fmtty
-                (pad$6, [7, fmtty_of_fmt(rest$8)]);
+                (pad$6, [7, fmtty_of_fmt(rest$8)]) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 10:
         var fmtty$1 = fmtty$0[1]; fmtty$0 = fmtty$1; break;
        case 11:
@@ -15533,21 +15779,21 @@
         var rest$9 = fmtty$0[3], ty = fmtty$0[2];
          /*<<camlinternalFormat.ml:900:4>>*/ return [8,
                 ty,
-                fmtty_of_fmt(rest$9)];
+                fmtty_of_fmt(rest$9)] /*<<camlinternalFormat.ml:900:4>>*/ ;
        case 14:
         var rest$10 = fmtty$0[3], ty$0 = fmtty$0[2];
          /*<<camlinternalFormat.ml:902:4>>*/ return [9,
                 ty$0,
                 ty$0,
-                fmtty_of_fmt(rest$10)];
+                fmtty_of_fmt(rest$10)] /*<<camlinternalFormat.ml:902:4>>*/ ;
        case 15:
         var rest$11 = fmtty$0[1];
          /*<<camlinternalFormat.ml:894:34>>*/ return [10,
-                fmtty_of_fmt(rest$11)];
+                fmtty_of_fmt(rest$11)] /*<<camlinternalFormat.ml:894:34>>*/ ;
        case 16:
         var rest$12 = fmtty$0[1];
          /*<<camlinternalFormat.ml:895:34>>*/ return [11,
-                fmtty_of_fmt(rest$12)];
+                fmtty_of_fmt(rest$12)] /*<<camlinternalFormat.ml:895:34>>*/ ;
        case 17:
         var fmtty$4 = fmtty$0[2]; fmtty$0 = fmtty$4; break;
        case 18:
@@ -15560,23 +15806,23 @@
         else
          var fmt$0 = formatting_gen[1][1], _cC_ = fmtty_of_fmt(fmt$0);
          /*<<camlinternalFormat.ml:914:54>>*/ return  /*<<camlinternalFormat.ml:914:54>>*/ caml_call2
-                (CamlinternalFormatBasics[1], _cC_, _cB_);
+                (CamlinternalFormatBasics[1], _cC_, _cB_) /*<<camlinternalFormat.ml:916:46>>*/ ;
        case 19:
         var rest$14 = fmtty$0[1];
          /*<<camlinternalFormat.ml:897:34>>*/ return [13,
-                fmtty_of_fmt(rest$14)];
+                fmtty_of_fmt(rest$14)] /*<<camlinternalFormat.ml:897:34>>*/ ;
        case 20:
         var rest$15 = fmtty$0[3];
          /*<<camlinternalFormat.ml:908:34>>*/ return [1,
-                fmtty_of_fmt(rest$15)];
+                fmtty_of_fmt(rest$15)] /*<<camlinternalFormat.ml:908:34>>*/ ;
        case 21:
         var rest$16 = fmtty$0[2];
          /*<<camlinternalFormat.ml:909:34>>*/ return [2,
-                fmtty_of_fmt(rest$16)];
+                fmtty_of_fmt(rest$16)] /*<<camlinternalFormat.ml:909:34>>*/ ;
        case 22:
         var rest$17 = fmtty$0[1];
          /*<<camlinternalFormat.ml:910:34>>*/ return [0,
-                fmtty_of_fmt(rest$17)];
+                fmtty_of_fmt(rest$17)] /*<<camlinternalFormat.ml:910:34>>*/ ;
        case 23:
         var fmtty$5 = fmtty$0[2], ign = fmtty$0[1];
         if(typeof ign === "number")
@@ -15587,7 +15833,7 @@
             fmtty$0 = fmtty$5; break;
            case 2:
              /*<<camlinternalFormat.ml:944:39>>*/ return [14,
-                    fmtty_of_fmt(fmtty$5)];
+                    fmtty_of_fmt(fmtty$5)] /*<<camlinternalFormat.ml:944:39>>*/ ;
            default: fmtty$0 = fmtty$5;
          }
         else
@@ -15616,7 +15862,7 @@
               /*<<camlinternalFormat.ml:943:58>>*/ _cD_ =
                fmtty_of_fmt(fmtty$5);
              /*<<camlinternalFormat.ml:943:58>>*/ return  /*<<camlinternalFormat.ml:943:58>>*/ caml_call2
-                    (CamlinternalFormatBasics[1], fmtty$6, _cD_);
+                    (CamlinternalFormatBasics[1], fmtty$6, _cD_) /*<<camlinternalFormat.ml:916:46>>*/ ;
            case 10:
             fmtty$0 = fmtty$5; break;
            default: fmtty$0 = fmtty$5;
@@ -15625,26 +15871,26 @@
        default:
         var rest$18 = fmtty$0[3], arity = fmtty$0[1];
          /*<<camlinternalFormat.ml:896:56>>*/ return fmtty_of_custom
-                (arity, fmtty_of_fmt(rest$18));
+                (arity, fmtty_of_fmt(rest$18)) /*<<camlinternalFormat.ml:916:46>>*/ ;
      }
     }
     /*<<camlinternalFormat.ml:916:46>>*/ }
    function fmtty_of_custom(arity, fmtty){
      /*<<camlinternalFormat.ml:921:19>>*/ if(! arity)
-      /*<<camlinternalFormat.ml:922:19>>*/ return fmtty;
+      /*<<camlinternalFormat.ml:922:19>>*/ return fmtty /*<<camlinternalFormat.ml:922:19>>*/ ;
     var arity$0 = arity[1];
      /*<<camlinternalFormat.ml:923:25>>*/ return [12,
-            fmtty_of_custom(arity$0, fmtty)];
+            fmtty_of_custom(arity$0, fmtty)] /*<<camlinternalFormat.ml:923:25>>*/ ;
     /*<<camlinternalFormat.ml:923:61>>*/ }
    function fmtty_of_padding_fmtty(pad, fmtty){
      /*<<camlinternalFormat.ml:952:19>>*/ return typeof pad === "number"
             ? fmtty
-            : 0 === pad[0] ? fmtty : [2, fmtty];
+            : 0 === pad[0] ? fmtty : [2, fmtty] /*<<camlinternalFormat.ml:955:35>>*/ ;
     /*<<camlinternalFormat.ml:955:35>>*/ }
    function fmtty_of_precision_fmtty(prec, fmtty){
      /*<<camlinternalFormat.ml:960:20>>*/ return typeof prec === "number"
             ? prec ? [2, fmtty] : fmtty
-            : fmtty;
+            : fmtty /*<<camlinternalFormat.ml:963:37>>*/ ;
     /*<<camlinternalFormat.ml:963:37>>*/ }
     /*<<camlinternalFormat.ml:969:0>>*/ var
      /*<<camlinternalFormat.ml:969:0>>*/ Type_mismatch =
@@ -15887,14 +16133,14 @@
        cst_bad_input_format_type_mism$0];
    function type_padding(pad, fmtty){
      /*<<camlinternalFormat.ml:977:17>>*/ if(typeof pad === "number")
-      /*<<camlinternalFormat.ml:978:21>>*/ return [0, 0, fmtty];
+      /*<<camlinternalFormat.ml:978:21>>*/ return [0, 0, fmtty] /*<<camlinternalFormat.ml:978:21>>*/ ;
     if(0 === pad[0]){
      var w = pad[2], padty = pad[1];
-      /*<<camlinternalFormat.ml:979:33>>*/ return [0, [0, padty, w], fmtty];
+      /*<<camlinternalFormat.ml:979:33>>*/ return [0, [0, padty, w], fmtty] /*<<camlinternalFormat.ml:979:33>>*/ ;
     }
     if(typeof fmtty !== "number" && 2 === fmtty[0]){
      var rest = fmtty[1], padty$0 = pad[1];
-      /*<<camlinternalFormat.ml:980:38>>*/ return [0, [1, padty$0], rest];
+      /*<<camlinternalFormat.ml:980:38>>*/ return [0, [1, padty$0], rest] /*<<camlinternalFormat.ml:980:38>>*/ ;
     }
      /*<<camlinternalFormat.ml:981:9>>*/ throw  /*<<camlinternalFormat.ml:981:9>>*/ caml_maybe_attach_backtrace
            (Type_mismatch, 1);
@@ -15904,16 +16150,16 @@
      match = type_padding(pad, fmtty);
     if(typeof prec !== "number"){
      var rest$1 = match[2], pad$2 = match[1], p = prec[1];
-      /*<<camlinternalFormat.ml:993:4>>*/ return [0, pad$2, [0, p], rest$1];
+      /*<<camlinternalFormat.ml:993:4>>*/ return [0, pad$2, [0, p], rest$1] /*<<camlinternalFormat.ml:993:4>>*/ ;
     }
     if(! prec){
      var rest$0 = match[2], pad$1 = match[1];
-      /*<<camlinternalFormat.ml:991:4>>*/ return [0, pad$1, 0, rest$0];
+      /*<<camlinternalFormat.ml:991:4>>*/ return [0, pad$1, 0, rest$0] /*<<camlinternalFormat.ml:991:4>>*/ ;
     }
     var match$0 = match[2];
     if(typeof match$0 !== "number" && 2 === match$0[0]){
      var rest = match$0[1], pad$0 = match[1];
-      /*<<camlinternalFormat.ml:995:4>>*/ return [0, pad$0, 1, rest];
+      /*<<camlinternalFormat.ml:995:4>>*/ return [0, pad$0, 1, rest] /*<<camlinternalFormat.ml:995:4>>*/ ;
     }
      /*<<camlinternalFormat.ml:996:35>>*/ throw  /*<<camlinternalFormat.ml:996:35>>*/ caml_maybe_attach_backtrace
            (Type_mismatch, 1);
@@ -15925,11 +16171,11 @@
       /*<<camlinternalFormat.ml:1010:9>>*/ throw  /*<<camlinternalFormat.ml:1010:9>>*/ caml_maybe_attach_backtrace
             (Type_mismatch, 1);
     var fmt$0 = _cA_[1];
-     /*<<camlinternalFormat.ml:1009:42>>*/ return fmt$0;
+     /*<<camlinternalFormat.ml:1009:42>>*/ return fmt$0 /*<<camlinternalFormat.ml:1009:42>>*/ ;
     /*<<camlinternalFormat.ml:1010:28>>*/ }
    function type_format_gen(fmt, fmtty0){
      /*<<camlinternalFormat.ml:1018:19>>*/ if(typeof fmt === "number")
-      /*<<camlinternalFormat.ml:1133:33>>*/ return [0, 0, fmtty0];
+      /*<<camlinternalFormat.ml:1133:33>>*/ return [0, 0, fmtty0] /*<<camlinternalFormat.ml:1133:33>>*/ ;
     switch(fmt[0]){
       case 0:
        if(typeof fmtty0 !== "number" && 0 === fmtty0[0]){
@@ -15940,7 +16186,7 @@
            type_format_gen(fmt_rest, fmtty_rest),
          fmtty = match[2],
          fmt$0 = match[1];
-         /*<<camlinternalFormat.ml:1021:4>>*/ return [0, [0, fmt$0], fmtty];
+         /*<<camlinternalFormat.ml:1021:4>>*/ return [0, [0, fmt$0], fmtty] /*<<camlinternalFormat.ml:1021:4>>*/ ;
        }
        break;
       case 1:
@@ -15952,7 +16198,7 @@
            type_format_gen(fmt_rest$0, fmtty_rest$0),
          fmtty$0 = match$0[2],
          fmt$1 = match$0[1];
-         /*<<camlinternalFormat.ml:1024:4>>*/ return [0, [1, fmt$1], fmtty$0];
+         /*<<camlinternalFormat.ml:1024:4>>*/ return [0, [1, fmt$1], fmtty$0] /*<<camlinternalFormat.ml:1024:4>>*/ ;
        }
        break;
       case 2:
@@ -15972,7 +16218,7 @@
          fmt$2 = match$3[1];
          /*<<camlinternalFormat.ml:1029:6>>*/ return [0,
                 [2, pad$0, fmt$2],
-                fmtty$1];
+                fmtty$1] /*<<camlinternalFormat.ml:1029:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1030:34>>*/ throw  /*<<camlinternalFormat.ml:1030:34>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -15993,7 +16239,7 @@
          fmt$3 = match$6[1];
          /*<<camlinternalFormat.ml:1036:6>>*/ return [0,
                 [3, pad$2, fmt$3],
-                fmtty$2];
+                fmtty$2] /*<<camlinternalFormat.ml:1036:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1037:34>>*/ throw  /*<<camlinternalFormat.ml:1037:34>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -16017,7 +16263,7 @@
          fmt$4 = match$9[1];
          /*<<camlinternalFormat.ml:1043:6>>*/ return [0,
                 [4, iconv, pad$4, prec$0, fmt$4],
-                fmtty$3];
+                fmtty$3] /*<<camlinternalFormat.ml:1043:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1044:37>>*/ throw  /*<<camlinternalFormat.ml:1044:37>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -16041,7 +16287,7 @@
          fmt$5 = match$12[1];
          /*<<camlinternalFormat.ml:1050:6>>*/ return [0,
                 [5, iconv$0, pad$6, prec$2, fmt$5],
-                fmtty$4];
+                fmtty$4] /*<<camlinternalFormat.ml:1050:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1051:37>>*/ throw  /*<<camlinternalFormat.ml:1051:37>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -16065,7 +16311,7 @@
          fmt$6 = match$15[1];
          /*<<camlinternalFormat.ml:1057:6>>*/ return [0,
                 [6, iconv$1, pad$8, prec$4, fmt$6],
-                fmtty$5];
+                fmtty$5] /*<<camlinternalFormat.ml:1057:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1058:37>>*/ throw  /*<<camlinternalFormat.ml:1058:37>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -16089,7 +16335,7 @@
          fmt$7 = match$18[1];
          /*<<camlinternalFormat.ml:1064:6>>*/ return [0,
                 [7, iconv$2, pad$10, prec$6, fmt$7],
-                fmtty$6];
+                fmtty$6] /*<<camlinternalFormat.ml:1064:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1065:37>>*/ throw  /*<<camlinternalFormat.ml:1065:37>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -16113,7 +16359,7 @@
          fmt$8 = match$21[1];
          /*<<camlinternalFormat.ml:1071:6>>*/ return [0,
                 [8, fconv, pad$12, prec$8, fmt$8],
-                fmtty$7];
+                fmtty$7] /*<<camlinternalFormat.ml:1071:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1072:37>>*/ throw  /*<<camlinternalFormat.ml:1072:37>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -16134,7 +16380,7 @@
          fmt$9 = match$24[1];
          /*<<camlinternalFormat.ml:1078:6>>*/ return [0,
                 [9, pad$14, fmt$9],
-                fmtty$8];
+                fmtty$8] /*<<camlinternalFormat.ml:1078:6>>*/ ;
        }
         /*<<camlinternalFormat.ml:1079:34>>*/ throw  /*<<camlinternalFormat.ml:1079:34>>*/ caml_maybe_attach_backtrace
               (Type_mismatch, 1);
@@ -16145,7 +16391,7 @@
           type_format_gen(fmt_rest$9, fmtty0),
         fmtty$9 = match$25[2],
         fmt$10 = match$25[1];
-        /*<<camlinternalFormat.ml:1083:4>>*/ return [0, [10, fmt$10], fmtty$9];
+        /*<<camlinternalFormat.ml:1083:4>>*/ return [0, [10, fmt$10], fmtty$9] /*<<camlinternalFormat.ml:1083:4>>*/ ;
       case 11:
         /*<<camlinternalFormat.ml:1086:39>>*/ var
         fmt_rest$10 = fmt[2],
@@ -16156,7 +16402,7 @@
         fmt$11 = match$26[1];
         /*<<camlinternalFormat.ml:1087:4>>*/ return [0,
                [11, str, fmt$11],
-               fmtty$10];
+               fmtty$10] /*<<camlinternalFormat.ml:1087:4>>*/ ;
       case 12:
         /*<<camlinternalFormat.ml:1089:39>>*/ var
         fmt_rest$11 = fmt[2],
@@ -16167,7 +16413,7 @@
         fmt$12 = match$27[1];
         /*<<camlinternalFormat.ml:1090:4>>*/ return [0,
                [12, chr, fmt$12],
-               fmtty$11];
+               fmtty$11] /*<<camlinternalFormat.ml:1090:4>>*/ ;
       case 13:
        if(typeof fmtty0 !== "number" && 8 === fmtty0[0]){
         var
@@ -16188,7 +16434,7 @@
          fmt$13 = match$28[1];
          /*<<camlinternalFormat.ml:1096:4>>*/ return [0,
                 [13, pad_opt, sub_fmtty, fmt$13],
-                fmtty$12];
+                fmtty$12] /*<<camlinternalFormat.ml:1096:4>>*/ ;
        }
        break;
       case 14:
@@ -16221,7 +16467,7 @@
          fmt$14 = match$29[1];
          /*<<camlinternalFormat.ml:1104:4>>*/ return [0,
                 [14, pad_opt$0, sub_fmtty1, fmt$14],
-                fmtty$13];
+                fmtty$13] /*<<camlinternalFormat.ml:1104:4>>*/ ;
        }
        break;
       case 15:
@@ -16235,7 +16481,7 @@
          fmt$15 = match$30[1];
          /*<<camlinternalFormat.ml:1108:4>>*/ return [0,
                 [15, fmt$15],
-                fmtty$14];
+                fmtty$14] /*<<camlinternalFormat.ml:1108:4>>*/ ;
        }
        break;
       case 16:
@@ -16249,7 +16495,7 @@
          fmt$16 = match$31[1];
          /*<<camlinternalFormat.ml:1111:4>>*/ return [0,
                 [16, fmt$16],
-                fmtty$15];
+                fmtty$15] /*<<camlinternalFormat.ml:1111:4>>*/ ;
        }
        break;
       case 17:
@@ -16262,7 +16508,7 @@
         fmt$17 = match$32[1];
         /*<<camlinternalFormat.ml:1116:4>>*/ return [0,
                [17, formatting_lit, fmt$17],
-               fmtty$16];
+               fmtty$16] /*<<camlinternalFormat.ml:1116:4>>*/ ;
       case 18:
        var fmt_rest$17 = fmt[2], formatting_gen = fmt[1];
        if(0 === formatting_gen[0]){
@@ -16280,7 +16526,7 @@
          fmt3 = match$38[1];
          /*<<camlinternalFormat.ml:1146:4>>*/ return [0,
                 [18, [0, [0, fmt2, str$0]], fmt3],
-                fmtty3];
+                fmtty3] /*<<camlinternalFormat.ml:1146:4>>*/ ;
        }
         /*<<camlinternalFormat.ml:1148:39>>*/ var
         match$39 = formatting_gen[1],
@@ -16296,7 +16542,7 @@
         fmt3$0 = match$41[1];
         /*<<camlinternalFormat.ml:1150:4>>*/ return [0,
                [18, [1, [0, fmt2$0, str$1]], fmt3$0],
-               fmtty3$0];
+               fmtty3$0] /*<<camlinternalFormat.ml:1150:4>>*/ ;
       case 19:
        if(typeof fmtty0 !== "number" && 13 === fmtty0[0]){
          /*<<camlinternalFormat.ml:1122:39>>*/ var
@@ -16308,7 +16554,7 @@
          fmt$18 = match$33[1];
          /*<<camlinternalFormat.ml:1123:4>>*/ return [0,
                 [19, fmt$18],
-                fmtty$17];
+                fmtty$17] /*<<camlinternalFormat.ml:1123:4>>*/ ;
        }
        break;
       case 20:
@@ -16324,7 +16570,7 @@
          fmt$19 = match$34[1];
          /*<<camlinternalFormat.ml:1126:4>>*/ return [0,
                 [20, width_opt, char_set, fmt$19],
-                fmtty$18];
+                fmtty$18] /*<<camlinternalFormat.ml:1126:4>>*/ ;
        }
        break;
       case 21:
@@ -16339,7 +16585,7 @@
          fmt$20 = match$35[1];
          /*<<camlinternalFormat.ml:1129:4>>*/ return [0,
                 [21, counter, fmt$20],
-                fmtty$19];
+                fmtty$19] /*<<camlinternalFormat.ml:1129:4>>*/ ;
        }
        break;
       case 23:
@@ -16348,32 +16594,32 @@
         switch(ign[0]){
           case 0:
             /*<<camlinternalFormat.ml:1161:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 1:
             /*<<camlinternalFormat.ml:1162:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 2:
             /*<<camlinternalFormat.ml:1163:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 3:
             /*<<camlinternalFormat.ml:1164:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 4:
             /*<<camlinternalFormat.ml:1165:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 5:
             /*<<camlinternalFormat.ml:1166:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 6:
             /*<<camlinternalFormat.ml:1167:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 7:
             /*<<camlinternalFormat.ml:1168:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 8:
            var sub_fmtty$2 = ign[2], pad_opt$1 = ign[1];
             /*<<camlinternalFormat.ml:1173:4>>*/ return type_ignored_param_one
-                   ([8, pad_opt$1, sub_fmtty$2], rest, fmtty0);
+                   ([8, pad_opt$1, sub_fmtty$2], rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           case 9:
             /*<<camlinternalFormat.ml:1176:6>>*/ var
             sub_fmtty$3 = ign[2],
@@ -16386,21 +16632,21 @@
             sub_fmtty$4 = _cz_[1];
             /*<<camlinternalFormat.ml:1177:4>>*/ return [0,
                    [23, [9, pad_opt$2, sub_fmtty$4], fmt$22],
-                   fmtty$21];
+                   fmtty$21] /*<<camlinternalFormat.ml:1177:4>>*/ ;
           case 10:
             /*<<camlinternalFormat.ml:1169:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
           default:
             /*<<camlinternalFormat.ml:1170:42>>*/ return type_ignored_param_one
-                   (ign, rest, fmtty0);
+                   (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
         }
        switch(ign){
          case 0:
            /*<<camlinternalFormat.ml:1159:42>>*/ return type_ignored_param_one
-                  (ign, rest, fmtty0);
+                  (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
          case 1:
            /*<<camlinternalFormat.ml:1160:42>>*/ return type_ignored_param_one
-                  (ign, rest, fmtty0);
+                  (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
          case 2:
           if(typeof fmtty0 !== "number" && 14 === fmtty0[0]){
             /*<<camlinternalFormat.ml:1183:41>>*/ var
@@ -16411,13 +16657,13 @@
             fmt$21 = match$42[1];
             /*<<camlinternalFormat.ml:1184:6>>*/ return [0,
                    [23, 2, fmt$21],
-                   fmtty$20];
+                   fmtty$20] /*<<camlinternalFormat.ml:1184:6>>*/ ;
           }
            /*<<camlinternalFormat.ml:1185:11>>*/ throw  /*<<camlinternalFormat.ml:1185:11>>*/ caml_maybe_attach_backtrace
                  (Type_mismatch, 1);
          default:
            /*<<camlinternalFormat.ml:1171:42>>*/ return type_ignored_param_one
-                  (ign, rest, fmtty0);
+                  (ign, rest, fmtty0) /*<<camlinternalFormat.ml:1135:28>>*/ ;
        }
     }
      /*<<camlinternalFormat.ml:1135:9>>*/ throw  /*<<camlinternalFormat.ml:1135:9>>*/ caml_maybe_attach_backtrace
@@ -16431,13 +16677,13 @@
      fmt$0 = match[1];
      /*<<camlinternalFormat.ml:1195:2>>*/ return [0,
             [23, ign, fmt$0],
-            fmtty$0];
+            fmtty$0] /*<<camlinternalFormat.ml:1195:2>>*/ ;
     /*<<camlinternalFormat.ml:1195:51>>*/ }
    function type_ignored_format_substituti(sub_fmtty, fmt, fmtty){
      /*<<camlinternalFormat.ml:1202:27>>*/ if(typeof sub_fmtty === "number")
       /*<<camlinternalFormat.ml:1276:4>>*/ return [0,
              0,
-             type_format_gen(fmt, fmtty)];
+             type_format_gen(fmt, fmtty)] /*<<camlinternalFormat.ml:1276:4>>*/ ;
     switch(sub_fmtty[0]){
       case 0:
        if(typeof fmtty !== "number" && 0 === fmtty[0]){
@@ -16450,7 +16696,7 @@
          sub_fmtty_rest$0 = match[1];
          /*<<camlinternalFormat.ml:1206:4>>*/ return [0,
                 [0, sub_fmtty_rest$0],
-                fmt$0];
+                fmt$0] /*<<camlinternalFormat.ml:1206:4>>*/ ;
        }
        break;
       case 1:
@@ -16464,7 +16710,7 @@
          sub_fmtty_rest$2 = match$0[1];
          /*<<camlinternalFormat.ml:1210:4>>*/ return [0,
                 [1, sub_fmtty_rest$2],
-                fmt$1];
+                fmt$1] /*<<camlinternalFormat.ml:1210:4>>*/ ;
        }
        break;
       case 2:
@@ -16478,7 +16724,7 @@
          sub_fmtty_rest$4 = match$1[1];
          /*<<camlinternalFormat.ml:1214:4>>*/ return [0,
                 [2, sub_fmtty_rest$4],
-                fmt$2];
+                fmt$2] /*<<camlinternalFormat.ml:1214:4>>*/ ;
        }
        break;
       case 3:
@@ -16492,7 +16738,7 @@
          sub_fmtty_rest$6 = match$2[1];
          /*<<camlinternalFormat.ml:1218:4>>*/ return [0,
                 [3, sub_fmtty_rest$6],
-                fmt$3];
+                fmt$3] /*<<camlinternalFormat.ml:1218:4>>*/ ;
        }
        break;
       case 4:
@@ -16506,7 +16752,7 @@
          sub_fmtty_rest$8 = match$3[1];
          /*<<camlinternalFormat.ml:1222:4>>*/ return [0,
                 [4, sub_fmtty_rest$8],
-                fmt$4];
+                fmt$4] /*<<camlinternalFormat.ml:1222:4>>*/ ;
        }
        break;
       case 5:
@@ -16520,7 +16766,7 @@
          sub_fmtty_rest$10 = match$4[1];
          /*<<camlinternalFormat.ml:1226:4>>*/ return [0,
                 [5, sub_fmtty_rest$10],
-                fmt$5];
+                fmt$5] /*<<camlinternalFormat.ml:1226:4>>*/ ;
        }
        break;
       case 6:
@@ -16535,7 +16781,7 @@
          sub_fmtty_rest$12 = match$5[1];
          /*<<camlinternalFormat.ml:1230:4>>*/ return [0,
                 [6, sub_fmtty_rest$12],
-                fmt$6];
+                fmt$6] /*<<camlinternalFormat.ml:1230:4>>*/ ;
        }
        break;
       case 7:
@@ -16550,7 +16796,7 @@
          sub_fmtty_rest$14 = match$6[1];
          /*<<camlinternalFormat.ml:1234:4>>*/ return [0,
                 [7, sub_fmtty_rest$14],
-                fmt$7];
+                fmt$7] /*<<camlinternalFormat.ml:1234:4>>*/ ;
        }
        break;
       case 8:
@@ -16573,7 +16819,7 @@
          sub_fmtty_rest$16 = match$7[1];
          /*<<camlinternalFormat.ml:1257:4>>*/ return [0,
                 [8, sub2_fmtty, sub_fmtty_rest$16],
-                fmt$8];
+                fmt$8] /*<<camlinternalFormat.ml:1257:4>>*/ ;
        }
        break;
       case 9:
@@ -16630,7 +16876,7 @@
          sub_fmtty_rest$18 = match$9[1];
          /*<<camlinternalFormat.ml:1272:4>>*/ return [0,
                 [9, sub1_fmtty, sub2_fmtty$1, symm(sub_fmtty_rest$18)],
-                fmt$9];
+                fmt$9] /*<<camlinternalFormat.ml:1272:4>>*/ ;
        }
        break;
       case 10:
@@ -16645,7 +16891,7 @@
          sub_fmtty_rest$20 = match$10[1];
          /*<<camlinternalFormat.ml:1238:4>>*/ return [0,
                 [10, sub_fmtty_rest$20],
-                fmt$10];
+                fmt$10] /*<<camlinternalFormat.ml:1238:4>>*/ ;
        }
        break;
       case 11:
@@ -16660,7 +16906,7 @@
          sub_fmtty_rest$22 = match$11[1];
          /*<<camlinternalFormat.ml:1242:4>>*/ return [0,
                 [11, sub_fmtty_rest$22],
-                fmt$11];
+                fmt$11] /*<<camlinternalFormat.ml:1242:4>>*/ ;
        }
        break;
       case 13:
@@ -16675,7 +16921,7 @@
          sub_fmtty_rest$24 = match$12[1];
          /*<<camlinternalFormat.ml:1246:4>>*/ return [0,
                 [13, sub_fmtty_rest$24],
-                fmt$12];
+                fmt$12] /*<<camlinternalFormat.ml:1246:4>>*/ ;
        }
        break;
       case 14:
@@ -16690,7 +16936,7 @@
          sub_fmtty_rest$26 = match$13[1];
          /*<<camlinternalFormat.ml:1250:4>>*/ return [0,
                 [14, sub_fmtty_rest$26],
-                fmt$13];
+                fmt$13] /*<<camlinternalFormat.ml:1250:4>>*/ ;
        }
        break;
     }
@@ -16703,7 +16949,7 @@
      /*<<camlinternalFormat.ml:1312:18>>*/ return type_format
             (fmt,
               /*<<camlinternalFormat.ml:1312:18>>*/ caml_call1
-              (CamlinternalFormatBasics[2], _cv_));
+              (CamlinternalFormatBasics[2], _cv_)) /*<<camlinternalFormat.ml:1312:42>>*/ ;
     /*<<camlinternalFormat.ml:1312:42>>*/ }
    function fix_padding(padty, width, str){
      /*<<camlinternalFormat.ml:1319:2>>*/ var
@@ -16711,7 +16957,8 @@
       /*<<camlinternalFormat.ml:1320:2>>*/ padty$0 = 0 <= width ? padty : 0,
       /*<<camlinternalFormat.ml:1321:4>>*/ width$0 =
         /*<<camlinternalFormat.ml:1321:4>>*/ caml_call1(Stdlib[18], width);
-    if(width$0 <= len)  /*<<camlinternalFormat.ml:1332:23>>*/ return str;
+    if(width$0 <= len)
+      /*<<camlinternalFormat.ml:1332:23>>*/ return str /*<<camlinternalFormat.ml:1332:23>>*/ ;
      /*<<camlinternalFormat.ml:1333:14>>*/ var
      _cu_ = 2 === padty$0 ? 48 : 32,
       /*<<camlinternalFormat.ml:1333:14>>*/ res =
@@ -16782,7 +17029,7 @@
         (Stdlib_String[6], str, 0, res, width$0 - len | 0, len);
     }
      /*<<camlinternalFormat.ml:1346:4>>*/ return  /*<<camlinternalFormat.ml:1346:4>>*/ caml_call1
-            (Stdlib_Bytes[44], res);
+            (Stdlib_Bytes[44], res) /*<<camlinternalFormat.ml:1346:30>>*/ ;
     /*<<camlinternalFormat.ml:1346:30>>*/ }
    function fix_int_precision(prec, str){
      /*<<camlinternalFormat.ml:1350:2>>*/ var
@@ -16828,7 +17075,7 @@
               (prec$0 - len | 0) + 4 | 0,
               len - 2 | 0);
              /*<<camlinternalFormat.ml:1361:4>>*/ return  /*<<camlinternalFormat.ml:1361:4>>*/ caml_call1
-                    (Stdlib_Bytes[44], res$1);
+                    (Stdlib_Bytes[44], res$1) /*<<camlinternalFormat.ml:1368:7>>*/ ;
            }
            break b;
           case 0:
@@ -16855,7 +17102,7 @@
          (prec$0 - len | 0) + 2 | 0,
          len - 1 | 0);
         /*<<camlinternalFormat.ml:1356:4>>*/ return  /*<<camlinternalFormat.ml:1356:4>>*/ caml_call1
-               (Stdlib_Bytes[44], res$0);
+               (Stdlib_Bytes[44], res$0) /*<<camlinternalFormat.ml:1368:7>>*/ ;
       }
       if(71 <= c){if(5 < c - 97 >>> 0) break a;} else if(65 > c) break a;
      }
@@ -16867,10 +17114,10 @@
        /*<<camlinternalFormat.ml:1365:4>>*/  /*<<camlinternalFormat.ml:1365:4>>*/ caml_call5
        (Stdlib_String[6], str, 0, res, prec$0 - len | 0, len);
        /*<<camlinternalFormat.ml:1365:4>>*/ return  /*<<camlinternalFormat.ml:1365:4>>*/ caml_call1
-              (Stdlib_Bytes[44], res);
+              (Stdlib_Bytes[44], res) /*<<camlinternalFormat.ml:1368:7>>*/ ;
      }
     }
-     /*<<camlinternalFormat.ml:1368:4>>*/ return str;
+     /*<<camlinternalFormat.ml:1368:4>>*/ return str /*<<camlinternalFormat.ml:1368:4>>*/ ;
     /*<<camlinternalFormat.ml:1368:7>>*/ }
    function string_to_caml_string(str){
      /*<<camlinternalFormat.ml:1372:2>>*/ var
@@ -16885,7 +17132,7 @@
      /*<<camlinternalFormat.ml:1375:2>>*/  /*<<camlinternalFormat.ml:1375:2>>*/ caml_blit_string
      (str$0, 0, res, 1, l);
      /*<<camlinternalFormat.ml:1375:2>>*/ return  /*<<camlinternalFormat.ml:1375:2>>*/ caml_call1
-            (Stdlib_Bytes[44], res);
+            (Stdlib_Bytes[44], res) /*<<camlinternalFormat.ml:1376:28>>*/ ;
     /*<<camlinternalFormat.ml:1376:28>>*/ }
    function format_of_fconv(fconv, prec){
      /*<<camlinternalFormat.ml:1414:4>>*/ var
@@ -16901,11 +17148,11 @@
        /*<<camlinternalFormat.ml:1420:26>>*/ caml_call1
        (Stdlib_Int[12], prec$0));
      /*<<camlinternalFormat.ml:1421:4>>*/ buffer_add_char(buf, symb);
-     /*<<camlinternalFormat.ml:1421:4>>*/ return buffer_contents(buf);
+     /*<<camlinternalFormat.ml:1421:4>>*/ return buffer_contents(buf) /*<<camlinternalFormat.ml:1422:23>>*/ ;
     /*<<camlinternalFormat.ml:1422:23>>*/ }
    function transform_int_alt(iconv, s){
      /*<<camlinternalFormat.ml:1425:2>>*/ if(13 > iconv)
-      /*<<camlinternalFormat.ml:1447:9>>*/ return s;
+      /*<<camlinternalFormat.ml:1447:9>>*/ return s /*<<camlinternalFormat.ml:1447:9>>*/ ;
      /*<<camlinternalFormat.ml:1428:14>>*/ var
       /*<<camlinternalFormat.ml:1428:14>>*/ n = [0, 0],
      _cp_ = caml_ml_string_length(s) - 1 | 0,
@@ -16957,7 +17204,7 @@
      }
     }
      /*<<camlinternalFormat.ml:1446:4>>*/ return  /*<<camlinternalFormat.ml:1446:4>>*/ caml_call1
-            (Stdlib_Bytes[44], buf);
+            (Stdlib_Bytes[44], buf) /*<<camlinternalFormat.ml:1447:10>>*/ ;
     /*<<camlinternalFormat.ml:1447:10>>*/ }
    function convert_int(iconv, n){
      /*<<camlinternalFormat.ml:1451:2>>*/ switch(iconv){
@@ -16991,7 +17238,7 @@
     }
      /*<<camlinternalFormat.ml:1451:26>>*/ return transform_int_alt
             (iconv,
-              /*<<camlinternalFormat.ml:1451:26>>*/ caml_format_int(_cn_, n));
+              /*<<camlinternalFormat.ml:1451:26>>*/ caml_format_int(_cn_, n)) /*<<camlinternalFormat.ml:1451:64>>*/ ;
     /*<<camlinternalFormat.ml:1451:64>>*/ }
    function convert_int32(iconv, n){
      /*<<camlinternalFormat.ml:1453:2>>*/ switch(iconv){
@@ -17025,7 +17272,7 @@
     }
      /*<<camlinternalFormat.ml:1453:26>>*/ return transform_int_alt
             (iconv,
-              /*<<camlinternalFormat.ml:1453:26>>*/ caml_format_int(_cm_, n));
+              /*<<camlinternalFormat.ml:1453:26>>*/ caml_format_int(_cm_, n)) /*<<camlinternalFormat.ml:1453:67>>*/ ;
     /*<<camlinternalFormat.ml:1453:67>>*/ }
    function convert_nativeint(iconv, n){
      /*<<camlinternalFormat.ml:1455:2>>*/ switch(iconv){
@@ -17059,7 +17306,7 @@
     }
      /*<<camlinternalFormat.ml:1455:26>>*/ return transform_int_alt
             (iconv,
-              /*<<camlinternalFormat.ml:1455:26>>*/ caml_format_int(_cl_, n));
+              /*<<camlinternalFormat.ml:1455:26>>*/ caml_format_int(_cl_, n)) /*<<camlinternalFormat.ml:1455:71>>*/ ;
     /*<<camlinternalFormat.ml:1455:71>>*/ }
    function convert_int64(iconv, n){
      /*<<camlinternalFormat.ml:1457:2>>*/ switch(iconv){
@@ -17094,7 +17341,7 @@
      /*<<camlinternalFormat.ml:1457:26>>*/ return transform_int_alt
             (iconv,
               /*<<camlinternalFormat.ml:1457:26>>*/ runtime.caml_int64_format
-              (_ck_, n));
+              (_ck_, n)) /*<<camlinternalFormat.ml:1457:67>>*/ ;
     /*<<camlinternalFormat.ml:1457:67>>*/ }
    function convert_float(fconv, prec, x){
     function hex(param){
@@ -17106,7 +17353,7 @@
        default: var sign = 32;
      }
       /*<<camlinternalFormat.ml:1468:4>>*/ return  /*<<camlinternalFormat.ml:1468:4>>*/ runtime.caml_hexstring_of_float
-             (x, prec, sign);
+             (x, prec, sign) /*<<camlinternalFormat.ml:1468:34>>*/ ;
      /*<<camlinternalFormat.ml:1468:34>>*/ }
      /*<<camlinternalFormat.ml:1477:2>>*/ function caml_special_val(str){
       /*<<camlinternalFormat.ml:1477:29>>*/  /*<<camlinternalFormat.ml:1477:35>>*/ var
@@ -17114,7 +17361,7 @@
          /*<<camlinternalFormat.ml:1477:35>>*/ runtime.caml_classify_float(x);
      return 3 === match
              ? x < 0. ? cst_neg_infinity : cst_infinity
-             : 4 <= match ? cst_nan : str;
+             : 4 <= match ? cst_nan : str /*<<camlinternalFormat.ml:1480:21>>*/ ;
      /*<<camlinternalFormat.ml:1480:21>>*/ }
     switch(fconv[2]){
       case 5:
@@ -17152,27 +17399,27 @@
             ? str
             :  /*<<camlinternalFormat.ml:1476:32>>*/ caml_call2
               (Stdlib[28], str, cst$17);
-         /*<<camlinternalFormat.ml:1487:21>>*/ return caml_special_val(_ci_);
+         /*<<camlinternalFormat.ml:1487:21>>*/ return caml_special_val(_ci_) /*<<camlinternalFormat.ml:1489:47>>*/ ;
        }
       case 6:
-        /*<<camlinternalFormat.ml:1482:15>>*/ return hex(0);
+        /*<<camlinternalFormat.ml:1482:15>>*/ return hex(0) /*<<camlinternalFormat.ml:1489:47>>*/ ;
       case 7:
         /*<<camlinternalFormat.ml:1483:38>>*/  /*<<camlinternalFormat.ml:1483:38>>*/ var
         _cj_ = hex(0);
         /*<<camlinternalFormat.ml:1483:38>>*/ return  /*<<camlinternalFormat.ml:1483:38>>*/ caml_call1
-               (Stdlib_String[26], _cj_);
+               (Stdlib_String[26], _cj_) /*<<camlinternalFormat.ml:1489:47>>*/ ;
       case 8:
-        /*<<camlinternalFormat.ml:1484:33>>*/ return caml_special_val(hex(0));
+        /*<<camlinternalFormat.ml:1484:33>>*/ return caml_special_val(hex(0)) /*<<camlinternalFormat.ml:1489:47>>*/ ;
       default:
         /*<<camlinternalFormat.ml:1489:4>>*/ return  /*<<camlinternalFormat.ml:1489:4>>*/ caml_format_float
-               (format_of_fconv(fconv, prec), x);
+               (format_of_fconv(fconv, prec), x) /*<<camlinternalFormat.ml:1489:47>>*/ ;
     }
     /*<<camlinternalFormat.ml:1489:47>>*/ }
    function string_of_fmtty(fmtty){
      /*<<camlinternalFormat.ml:1501:2>>*/  /*<<camlinternalFormat.ml:1501:12>>*/ var
      buf = buffer_create(16);
      /*<<camlinternalFormat.ml:1502:2>>*/ bprint_fmtty(buf, fmtty);
-     /*<<camlinternalFormat.ml:1502:2>>*/ return buffer_contents(buf);
+     /*<<camlinternalFormat.ml:1502:2>>*/ return buffer_contents(buf) /*<<camlinternalFormat.ml:1503:21>>*/ ;
     /*<<camlinternalFormat.ml:1503:21>>*/ }
    function make_printf$0(counter, k, acc, fmt){
      /*<<camlinternalFormat.ml:1518:17>>*/ var
@@ -17182,7 +17429,7 @@
      /*<<camlinternalFormat.ml:1518:17>>*/ for(;;){
      if(typeof fmt$0 === "number")
        /*<<camlinternalFormat.ml:1605:4>>*/ return  /*<<camlinternalFormat.ml:1605:4>>*/ caml_call1
-              (k$0, acc$0);
+              (k$0, acc$0) /*<<camlinternalFormat.ml:1605:9>>*/ ;
      switch(fmt$0[0]){
        case 0:
         var rest = fmt$0[1];
@@ -17190,7 +17437,7 @@
           /*<<camlinternalFormat.ml:1521:6>>*/  /*<<camlinternalFormat.ml:1521:20>>*/ var
           new_acc = [5, acc$0, c];
           /*<<camlinternalFormat.ml:1522:6>>*/ return make_printf
-                 (k$0, new_acc, rest); /*<<camlinternalFormat.ml:1522:32>>*/ };
+                 (k$0, new_acc, rest) /*<<camlinternalFormat.ml:1522:32>>*/ ; /*<<camlinternalFormat.ml:1522:32>>*/ } /*<<camlinternalFormat.ml:1520:4>>*/ ;
        case 1:
         var rest$0 = fmt$0[1];
          /*<<camlinternalFormat.ml:1524:4>>*/ return function(c){
@@ -17212,7 +17459,7 @@
               /*<<camlinternalFormat.ml:1496:2>>*/ caml_call1
               (Stdlib_Bytes[44], res)];
           /*<<camlinternalFormat.ml:1526:6>>*/ return make_printf
-                 (k$0, new_acc, rest$0); /*<<camlinternalFormat.ml:1526:32>>*/ };
+                 (k$0, new_acc, rest$0) /*<<camlinternalFormat.ml:1526:32>>*/ ; /*<<camlinternalFormat.ml:1526:32>>*/ } /*<<camlinternalFormat.ml:1524:4>>*/ ;
        case 2:
         var rest$1 = fmt$0[2], pad = fmt$0[1];
          /*<<camlinternalFormat.ml:1528:32>>*/ return make_padding
@@ -17221,12 +17468,12 @@
                  rest$1,
                  pad,
                  function(str){
-                   /*<<camlinternalFormat.ml:1528:44>>*/ return str;
-                  /*<<camlinternalFormat.ml:1528:47>>*/ });
+                   /*<<camlinternalFormat.ml:1528:44>>*/ return str /*<<camlinternalFormat.ml:1528:44>>*/ ;
+                  /*<<camlinternalFormat.ml:1528:47>>*/ }) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        case 3:
         var rest$2 = fmt$0[2], pad$0 = fmt$0[1];
          /*<<camlinternalFormat.ml:1530:4>>*/ return make_padding
-                (k$0, acc$0, rest$2, pad$0, string_to_caml_string);
+                (k$0, acc$0, rest$2, pad$0, string_to_caml_string) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        case 4:
         var
          rest$3 = fmt$0[4],
@@ -17234,7 +17481,7 @@
          pad$1 = fmt$0[2],
          iconv = fmt$0[1];
          /*<<camlinternalFormat.ml:1532:4>>*/ return make_int_padding_precision
-                (k$0, acc$0, rest$3, pad$1, prec, convert_int, iconv);
+                (k$0, acc$0, rest$3, pad$1, prec, convert_int, iconv) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        case 5:
         var
          rest$4 = fmt$0[4],
@@ -17242,7 +17489,7 @@
          pad$2 = fmt$0[2],
          iconv$0 = fmt$0[1];
          /*<<camlinternalFormat.ml:1534:4>>*/ return make_int_padding_precision
-                (k$0, acc$0, rest$4, pad$2, prec$0, convert_int32, iconv$0);
+                (k$0, acc$0, rest$4, pad$2, prec$0, convert_int32, iconv$0) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        case 6:
         var
          rest$5 = fmt$0[4],
@@ -17256,7 +17503,7 @@
                  pad$3,
                  prec$1,
                  convert_nativeint,
-                 iconv$1);
+                 iconv$1) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        case 7:
         var
          rest$6 = fmt$0[4],
@@ -17264,7 +17511,7 @@
          pad$4 = fmt$0[2],
          iconv$2 = fmt$0[1];
          /*<<camlinternalFormat.ml:1538:4>>*/ return make_int_padding_precision
-                (k$0, acc$0, rest$6, pad$4, prec$2, convert_int64, iconv$2);
+                (k$0, acc$0, rest$6, pad$4, prec$2, convert_int64, iconv$2) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        case 8:
         var
          rest$7 = fmt$0[4],
@@ -17279,7 +17526,7 @@
                      /*<<camlinternalFormat.ml:1746:6>>*/  /*<<camlinternalFormat.ml:1746:16>>*/ var
                      str = convert_float(fconv, p, x);
                      /*<<camlinternalFormat.ml:1747:6>>*/ return make_printf
-                            (k$0, [4, acc$0, str], rest$7);
+                            (k$0, [4, acc$0, str], rest$7) /*<<camlinternalFormat.ml:1747:52>>*/ ;
                     /*<<camlinternalFormat.ml:1747:52>>*/ }
                   : function
                    (x){
@@ -17287,14 +17534,14 @@
                      str =
                        convert_float(fconv, default_float_precision(fconv), x);
                      /*<<camlinternalFormat.ml:1739:6>>*/ return make_printf
-                            (k$0, [4, acc$0, str], rest$7);
-                    /*<<camlinternalFormat.ml:1739:52>>*/ };
+                            (k$0, [4, acc$0, str], rest$7) /*<<camlinternalFormat.ml:1739:52>>*/ ;
+                    /*<<camlinternalFormat.ml:1739:52>>*/ } /*<<camlinternalFormat.ml:1605:9>>*/ ;
          var p = prec$3[1];
           /*<<camlinternalFormat.ml:1741:4>>*/ return function(x){
            /*<<camlinternalFormat.ml:1742:6>>*/  /*<<camlinternalFormat.ml:1742:16>>*/ var
            str = convert_float(fconv, p, x);
            /*<<camlinternalFormat.ml:1743:6>>*/ return make_printf
-                  (k$0, [4, acc$0, str], rest$7); /*<<camlinternalFormat.ml:1743:52>>*/ };
+                  (k$0, [4, acc$0, str], rest$7) /*<<camlinternalFormat.ml:1743:52>>*/ ; /*<<camlinternalFormat.ml:1743:52>>*/ } /*<<camlinternalFormat.ml:1741:4>>*/ ;
         }
         if(0 === pad$5[0]){
          var w = pad$5[2], padty = pad$5[1];
@@ -17305,7 +17552,7 @@
                      /*<<camlinternalFormat.ml:1759:6>>*/  /*<<camlinternalFormat.ml:1759:16>>*/ var
                      str = fix_padding(padty, w, convert_float(fconv, p, x));
                      /*<<camlinternalFormat.ml:1760:6>>*/ return make_printf
-                            (k$0, [4, acc$0, str], rest$7);
+                            (k$0, [4, acc$0, str], rest$7) /*<<camlinternalFormat.ml:1760:52>>*/ ;
                     /*<<camlinternalFormat.ml:1760:52>>*/ }
                   : function
                    (x){
@@ -17315,14 +17562,14 @@
                       /*<<camlinternalFormat.ml:1751:17>>*/ str$0 =
                        fix_padding(padty, w, str);
                      /*<<camlinternalFormat.ml:1752:6>>*/ return make_printf
-                            (k$0, [4, acc$0, str$0], rest$7);
-                    /*<<camlinternalFormat.ml:1752:53>>*/ };
+                            (k$0, [4, acc$0, str$0], rest$7) /*<<camlinternalFormat.ml:1752:53>>*/ ;
+                    /*<<camlinternalFormat.ml:1752:53>>*/ } /*<<camlinternalFormat.ml:1605:9>>*/ ;
          var p$0 = prec$3[1];
           /*<<camlinternalFormat.ml:1754:4>>*/ return function(x){
            /*<<camlinternalFormat.ml:1755:6>>*/  /*<<camlinternalFormat.ml:1755:16>>*/ var
            str = fix_padding(padty, w, convert_float(fconv, p$0, x));
            /*<<camlinternalFormat.ml:1756:6>>*/ return make_printf
-                  (k$0, [4, acc$0, str], rest$7); /*<<camlinternalFormat.ml:1756:52>>*/ };
+                  (k$0, [4, acc$0, str], rest$7) /*<<camlinternalFormat.ml:1756:52>>*/ ; /*<<camlinternalFormat.ml:1756:52>>*/ } /*<<camlinternalFormat.ml:1754:4>>*/ ;
         }
         var padty$0 = pad$5[1];
         if(typeof prec$3 === "number")
@@ -17332,7 +17579,7 @@
                     /*<<camlinternalFormat.ml:1772:6>>*/  /*<<camlinternalFormat.ml:1772:16>>*/ var
                     str = fix_padding(padty$0, w, convert_float(fconv, p, x));
                     /*<<camlinternalFormat.ml:1773:6>>*/ return make_printf
-                           (k$0, [4, acc$0, str], rest$7);
+                           (k$0, [4, acc$0, str], rest$7) /*<<camlinternalFormat.ml:1773:52>>*/ ;
                    /*<<camlinternalFormat.ml:1773:52>>*/ }
                  : function
                   (w, x){
@@ -17342,18 +17589,18 @@
                      /*<<camlinternalFormat.ml:1764:17>>*/ str$0 =
                       fix_padding(padty$0, w, str);
                     /*<<camlinternalFormat.ml:1765:6>>*/ return make_printf
-                           (k$0, [4, acc$0, str$0], rest$7);
-                   /*<<camlinternalFormat.ml:1765:53>>*/ };
+                           (k$0, [4, acc$0, str$0], rest$7) /*<<camlinternalFormat.ml:1765:53>>*/ ;
+                   /*<<camlinternalFormat.ml:1765:53>>*/ } /*<<camlinternalFormat.ml:1605:9>>*/ ;
         var p$1 = prec$3[1];
          /*<<camlinternalFormat.ml:1767:4>>*/ return function(w, x){
           /*<<camlinternalFormat.ml:1768:6>>*/  /*<<camlinternalFormat.ml:1768:16>>*/ var
           str = fix_padding(padty$0, w, convert_float(fconv, p$1, x));
           /*<<camlinternalFormat.ml:1769:6>>*/ return make_printf
-                 (k$0, [4, acc$0, str], rest$7); /*<<camlinternalFormat.ml:1769:52>>*/ };
+                 (k$0, [4, acc$0, str], rest$7) /*<<camlinternalFormat.ml:1769:52>>*/ ; /*<<camlinternalFormat.ml:1769:52>>*/ } /*<<camlinternalFormat.ml:1767:4>>*/ ;
        case 9:
         var rest$8 = fmt$0[2], pad$6 = fmt$0[1];
          /*<<camlinternalFormat.ml:1542:4>>*/ return make_padding
-                (k$0, acc$0, rest$8, pad$6, Stdlib[30]);
+                (k$0, acc$0, rest$8, pad$6, Stdlib[30]) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        case 10:
          /*<<camlinternalFormat.ml:1560:18>>*/ var
          rest$9 = fmt$0[1],
@@ -17385,7 +17632,7 @@
            string_of_fmtty(sub_fmtty);
          /*<<camlinternalFormat.ml:1569:4>>*/ return function(str){
           /*<<camlinternalFormat.ml:1570:6>>*/ return make_printf
-                 (k$0, [4, acc$0, ty], rest$12); /*<<camlinternalFormat.ml:1571:52>>*/ };
+                 (k$0, [4, acc$0, ty], rest$12) /*<<camlinternalFormat.ml:1571:52>>*/ ; /*<<camlinternalFormat.ml:1571:52>>*/ } /*<<camlinternalFormat.ml:1569:4>>*/ ;
        case 14:
         var rest$13 = fmt$0[3], fmtty = fmt$0[2];
          /*<<camlinternalFormat.ml:1573:4>>*/ return function(param){
@@ -17396,7 +17643,7 @@
                  (k$0,
                   acc$0,
                    /*<<camlinternalFormat.ml:1574:6>>*/ caml_call2
-                   (CamlinternalFormatBasics[3], _cf_, rest$13)); /*<<camlinternalFormat.ml:1574:42>>*/ };
+                   (CamlinternalFormatBasics[3], _cf_, rest$13)) /*<<camlinternalFormat.ml:1574:42>>*/ ; /*<<camlinternalFormat.ml:1574:42>>*/ } /*<<camlinternalFormat.ml:1573:4>>*/ ;
        case 15:
         var rest$14 = fmt$0[1];
          /*<<camlinternalFormat.ml:1544:4>>*/ return function(f, x){
@@ -17406,14 +17653,14 @@
                    acc$0,
                    function(o){
                      /*<<camlinternalFormat.ml:1544:55>>*/ return caml_call2
-                            (f, o, x);
+                            (f, o, x) /*<<camlinternalFormat.ml:1544:60>>*/ ;
                     /*<<camlinternalFormat.ml:1544:60>>*/ }],
-                  rest$14); /*<<camlinternalFormat.ml:1544:67>>*/ };
+                  rest$14) /*<<camlinternalFormat.ml:1544:67>>*/ ; /*<<camlinternalFormat.ml:1544:67>>*/ } /*<<camlinternalFormat.ml:1544:4>>*/ ;
        case 16:
         var rest$15 = fmt$0[1];
          /*<<camlinternalFormat.ml:1546:4>>*/ return function(f){
           /*<<camlinternalFormat.ml:1546:13>>*/ return make_printf
-                 (k$0, [6, acc$0, f], rest$15); /*<<camlinternalFormat.ml:1546:52>>*/ };
+                 (k$0, [6, acc$0, f], rest$15) /*<<camlinternalFormat.ml:1546:52>>*/ ; /*<<camlinternalFormat.ml:1546:52>>*/ } /*<<camlinternalFormat.ml:1546:4>>*/ ;
        case 17:
          /*<<camlinternalFormat.ml:1594:18>>*/ var
          rest$16 = fmt$0[2],
@@ -17431,7 +17678,7 @@
           k$1 =
             function(kacc){
               /*<<camlinternalFormat.ml:1597:6>>*/ return make_printf
-                     (k, [1, acc, [0, kacc]], rest);
+                     (k, [1, acc, [0, kacc]], rest) /*<<camlinternalFormat.ml:1597:70>>*/ ;
              /*<<camlinternalFormat.ml:1597:70>>*/ };
          k$0 = k$1;
          acc$0 = 0;
@@ -17444,7 +17691,7 @@
           k$2 =
             function(kacc){
               /*<<camlinternalFormat.ml:1601:6>>*/ return make_printf
-                     (k, [1, acc, [1, kacc]], rest);
+                     (k, [1, acc, [1, kacc]], rest) /*<<camlinternalFormat.ml:1601:70>>*/ ;
              /*<<camlinternalFormat.ml:1601:70>>*/ };
          k$0 = k$2;
          acc$0 = 0;
@@ -17461,7 +17708,7 @@
            [8, acc$0, cst_Printf_bad_conversion];
          /*<<camlinternalFormat.ml:1578:4>>*/ return function(param){
           /*<<camlinternalFormat.ml:1578:13>>*/ return make_printf
-                 (k$0, new_acc, rest$19); /*<<camlinternalFormat.ml:1578:39>>*/ };
+                 (k$0, new_acc, rest$19) /*<<camlinternalFormat.ml:1578:39>>*/ ; /*<<camlinternalFormat.ml:1578:39>>*/ } /*<<camlinternalFormat.ml:1578:4>>*/ ;
        case 21:
         var rest$20 = fmt$0[2];
          /*<<camlinternalFormat.ml:1583:4>>*/ return function(n){
@@ -17472,22 +17719,22 @@
               /*<<camlinternalFormat.ml:1584:42>>*/ caml_format_int
               (cst_u$0, n)];
           /*<<camlinternalFormat.ml:1585:6>>*/ return make_printf
-                 (k$0, new_acc, rest$20); /*<<camlinternalFormat.ml:1585:32>>*/ };
+                 (k$0, new_acc, rest$20) /*<<camlinternalFormat.ml:1585:32>>*/ ; /*<<camlinternalFormat.ml:1585:32>>*/ } /*<<camlinternalFormat.ml:1583:4>>*/ ;
        case 22:
         var rest$21 = fmt$0[1];
          /*<<camlinternalFormat.ml:1587:4>>*/ return function(c){
           /*<<camlinternalFormat.ml:1588:6>>*/  /*<<camlinternalFormat.ml:1588:20>>*/ var
           new_acc = [5, acc$0, c];
           /*<<camlinternalFormat.ml:1589:6>>*/ return make_printf
-                 (k$0, new_acc, rest$21); /*<<camlinternalFormat.ml:1589:32>>*/ };
+                 (k$0, new_acc, rest$21) /*<<camlinternalFormat.ml:1589:32>>*/ ; /*<<camlinternalFormat.ml:1589:32>>*/ } /*<<camlinternalFormat.ml:1587:4>>*/ ;
        case 23:
         var rest$22 = fmt$0[2], ign = fmt$0[1];
          /*<<camlinternalFormat.ml:1591:4>>*/ if(counter >= 50)
           /*<<camlinternalFormat.ml:1591:4>>*/ return  /*<<camlinternalFormat.ml:1591:4>>*/ caml_trampoline_return
-                 (make_ignored_param$0, [0, k$0, acc$0, ign, rest$22]);
+                 (make_ignored_param$0, [0, k$0, acc$0, ign, rest$22]) /*<<camlinternalFormat.ml:1605:9>>*/ ;
         var counter$1 = counter + 1 | 0;
          /*<<camlinternalFormat.ml:1591:4>>*/ return make_ignored_param$0
-                (counter$1, k$0, acc$0, ign, rest$22);
+                (counter$1, k$0, acc$0, ign, rest$22) /*<<camlinternalFormat.ml:1605:9>>*/ ;
        default:
          /*<<camlinternalFormat.ml:1548:33>>*/ var
          rest$23 = fmt$0[3],
@@ -17497,10 +17744,10 @@
             /*<<camlinternalFormat.ml:1548:33>>*/ caml_call1(f, 0);
          /*<<camlinternalFormat.ml:1548:33>>*/ if(counter >= 50)
           /*<<camlinternalFormat.ml:1548:33>>*/ return  /*<<camlinternalFormat.ml:1548:33>>*/ caml_trampoline_return
-                 (make_custom$0, [0, k$0, acc$0, rest$23, arity, _ce_]);
+                 (make_custom$0, [0, k$0, acc$0, rest$23, arity, _ce_]) /*<<camlinternalFormat.ml:1605:9>>*/ ;
         var counter$0 = counter + 1 | 0;
          /*<<camlinternalFormat.ml:1548:33>>*/ return make_custom$0
-                (counter$0, k$0, acc$0, rest$23, arity, _ce_);
+                (counter$0, k$0, acc$0, rest$23, arity, _ce_) /*<<camlinternalFormat.ml:1605:9>>*/ ;
      }
     }
     /*<<camlinternalFormat.ml:1605:9>>*/ }
@@ -17513,114 +17760,114 @@
        case 0:
          /*<<camlinternalFormat.ml:1614:39>>*/ if(counter >= 50)
           /*<<camlinternalFormat.ml:1614:39>>*/ return  /*<<camlinternalFormat.ml:1614:39>>*/ caml_trampoline_return
-                 (make_invalid_arg, [0, k, acc, fmt]);
+                 (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
         var counter$0 = counter + 1 | 0;
          /*<<camlinternalFormat.ml:1614:39>>*/ return make_invalid_arg
-                (counter$0, k, acc, fmt);
+                (counter$0, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        case 1:
          /*<<camlinternalFormat.ml:1615:39>>*/ if(counter >= 50)
           /*<<camlinternalFormat.ml:1615:39>>*/ return  /*<<camlinternalFormat.ml:1615:39>>*/ caml_trampoline_return
-                 (make_invalid_arg, [0, k, acc, fmt]);
+                 (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
         var counter$1 = counter + 1 | 0;
          /*<<camlinternalFormat.ml:1615:39>>*/ return make_invalid_arg
-                (counter$1, k, acc, fmt);
+                (counter$1, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        case 2:
          /*<<camlinternalFormat.ml:1626:39>>*/ throw  /*<<camlinternalFormat.ml:1626:39>>*/ caml_maybe_attach_backtrace
                ([0, Assert_failure, _t_], 1);
        default:
          /*<<camlinternalFormat.ml:1629:39>>*/ if(counter >= 50)
           /*<<camlinternalFormat.ml:1629:39>>*/ return  /*<<camlinternalFormat.ml:1629:39>>*/ caml_trampoline_return
-                 (make_invalid_arg, [0, k, acc, fmt]);
+                 (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
         var counter$2 = counter + 1 | 0;
          /*<<camlinternalFormat.ml:1629:39>>*/ return make_invalid_arg
-                (counter$2, k, acc, fmt);
+                (counter$2, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
      }
     switch(ign[0]){
       case 0:
         /*<<camlinternalFormat.ml:1616:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1616:39>>*/ return  /*<<camlinternalFormat.ml:1616:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$3 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1616:39>>*/ return make_invalid_arg
-               (counter$3, k, acc, fmt);
+               (counter$3, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 1:
         /*<<camlinternalFormat.ml:1617:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1617:39>>*/ return  /*<<camlinternalFormat.ml:1617:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$4 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1617:39>>*/ return make_invalid_arg
-               (counter$4, k, acc, fmt);
+               (counter$4, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 2:
         /*<<camlinternalFormat.ml:1618:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1618:39>>*/ return  /*<<camlinternalFormat.ml:1618:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$5 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1618:39>>*/ return make_invalid_arg
-               (counter$5, k, acc, fmt);
+               (counter$5, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 3:
         /*<<camlinternalFormat.ml:1619:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1619:39>>*/ return  /*<<camlinternalFormat.ml:1619:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$6 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1619:39>>*/ return make_invalid_arg
-               (counter$6, k, acc, fmt);
+               (counter$6, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 4:
         /*<<camlinternalFormat.ml:1620:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1620:39>>*/ return  /*<<camlinternalFormat.ml:1620:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$7 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1620:39>>*/ return make_invalid_arg
-               (counter$7, k, acc, fmt);
+               (counter$7, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 5:
         /*<<camlinternalFormat.ml:1621:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1621:39>>*/ return  /*<<camlinternalFormat.ml:1621:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$8 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1621:39>>*/ return make_invalid_arg
-               (counter$8, k, acc, fmt);
+               (counter$8, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 6:
         /*<<camlinternalFormat.ml:1622:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1622:39>>*/ return  /*<<camlinternalFormat.ml:1622:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$9 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1622:39>>*/ return make_invalid_arg
-               (counter$9, k, acc, fmt);
+               (counter$9, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 7:
         /*<<camlinternalFormat.ml:1623:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1623:39>>*/ return  /*<<camlinternalFormat.ml:1623:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$10 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1623:39>>*/ return make_invalid_arg
-               (counter$10, k, acc, fmt);
+               (counter$10, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 8:
         /*<<camlinternalFormat.ml:1624:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1624:39>>*/ return  /*<<camlinternalFormat.ml:1624:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$11 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1624:39>>*/ return make_invalid_arg
-               (counter$11, k, acc, fmt);
+               (counter$11, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 9:
        var fmtty = ign[2];
         /*<<camlinternalFormat.ml:1625:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1625:39>>*/ return  /*<<camlinternalFormat.ml:1625:39>>*/ caml_trampoline_return
-                (make_from_fmtty$0, [0, k, acc, fmtty, fmt]);
+                (make_from_fmtty$0, [0, k, acc, fmtty, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$14 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1625:39>>*/ return make_from_fmtty$0
-               (counter$14, k, acc, fmtty, fmt);
+               (counter$14, k, acc, fmtty, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       case 10:
         /*<<camlinternalFormat.ml:1627:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1627:39>>*/ return  /*<<camlinternalFormat.ml:1627:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$12 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1627:39>>*/ return make_invalid_arg
-               (counter$12, k, acc, fmt);
+               (counter$12, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
       default:
         /*<<camlinternalFormat.ml:1628:39>>*/ if(counter >= 50)
          /*<<camlinternalFormat.ml:1628:39>>*/ return  /*<<camlinternalFormat.ml:1628:39>>*/ caml_trampoline_return
-                (make_invalid_arg, [0, k, acc, fmt]);
+                (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1629:65>>*/ ;
        var counter$13 = counter + 1 | 0;
         /*<<camlinternalFormat.ml:1628:39>>*/ return make_invalid_arg
-               (counter$13, k, acc, fmt);
+               (counter$13, k, acc, fmt) /*<<camlinternalFormat.ml:1629:65>>*/ ;
     }
     /*<<camlinternalFormat.ml:1629:65>>*/ }
    function make_ignored_param(k, acc, ign, fmt){
@@ -17634,47 +17881,47 @@
         var rest = fmtty[1];
          /*<<camlinternalFormat.ml:1638:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1638:40>>*/ return make_from_fmtty
-                 (k, acc, rest, fmt); /*<<camlinternalFormat.ml:1638:70>>*/ };
+                 (k, acc, rest, fmt) /*<<camlinternalFormat.ml:1638:70>>*/ ; /*<<camlinternalFormat.ml:1638:70>>*/ } /*<<camlinternalFormat.ml:1638:31>>*/ ;
        case 1:
         var rest$0 = fmtty[1];
          /*<<camlinternalFormat.ml:1639:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1639:40>>*/ return make_from_fmtty
-                 (k, acc, rest$0, fmt); /*<<camlinternalFormat.ml:1639:70>>*/ };
+                 (k, acc, rest$0, fmt) /*<<camlinternalFormat.ml:1639:70>>*/ ; /*<<camlinternalFormat.ml:1639:70>>*/ } /*<<camlinternalFormat.ml:1639:31>>*/ ;
        case 2:
         var rest$1 = fmtty[1];
          /*<<camlinternalFormat.ml:1640:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1640:40>>*/ return make_from_fmtty
-                 (k, acc, rest$1, fmt); /*<<camlinternalFormat.ml:1640:70>>*/ };
+                 (k, acc, rest$1, fmt) /*<<camlinternalFormat.ml:1640:70>>*/ ; /*<<camlinternalFormat.ml:1640:70>>*/ } /*<<camlinternalFormat.ml:1640:31>>*/ ;
        case 3:
         var rest$2 = fmtty[1];
          /*<<camlinternalFormat.ml:1641:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1641:40>>*/ return make_from_fmtty
-                 (k, acc, rest$2, fmt); /*<<camlinternalFormat.ml:1641:70>>*/ };
+                 (k, acc, rest$2, fmt) /*<<camlinternalFormat.ml:1641:70>>*/ ; /*<<camlinternalFormat.ml:1641:70>>*/ } /*<<camlinternalFormat.ml:1641:31>>*/ ;
        case 4:
         var rest$3 = fmtty[1];
          /*<<camlinternalFormat.ml:1642:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1642:40>>*/ return make_from_fmtty
-                 (k, acc, rest$3, fmt); /*<<camlinternalFormat.ml:1642:70>>*/ };
+                 (k, acc, rest$3, fmt) /*<<camlinternalFormat.ml:1642:70>>*/ ; /*<<camlinternalFormat.ml:1642:70>>*/ } /*<<camlinternalFormat.ml:1642:31>>*/ ;
        case 5:
         var rest$4 = fmtty[1];
          /*<<camlinternalFormat.ml:1643:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1643:40>>*/ return make_from_fmtty
-                 (k, acc, rest$4, fmt); /*<<camlinternalFormat.ml:1643:70>>*/ };
+                 (k, acc, rest$4, fmt) /*<<camlinternalFormat.ml:1643:70>>*/ ; /*<<camlinternalFormat.ml:1643:70>>*/ } /*<<camlinternalFormat.ml:1643:31>>*/ ;
        case 6:
         var rest$5 = fmtty[1];
          /*<<camlinternalFormat.ml:1644:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1644:40>>*/ return make_from_fmtty
-                 (k, acc, rest$5, fmt); /*<<camlinternalFormat.ml:1644:70>>*/ };
+                 (k, acc, rest$5, fmt) /*<<camlinternalFormat.ml:1644:70>>*/ ; /*<<camlinternalFormat.ml:1644:70>>*/ } /*<<camlinternalFormat.ml:1644:31>>*/ ;
        case 7:
         var rest$6 = fmtty[1];
          /*<<camlinternalFormat.ml:1645:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1645:40>>*/ return make_from_fmtty
-                 (k, acc, rest$6, fmt); /*<<camlinternalFormat.ml:1645:70>>*/ };
+                 (k, acc, rest$6, fmt) /*<<camlinternalFormat.ml:1645:70>>*/ ; /*<<camlinternalFormat.ml:1645:70>>*/ } /*<<camlinternalFormat.ml:1645:31>>*/ ;
        case 8:
         var rest$7 = fmtty[2];
          /*<<camlinternalFormat.ml:1651:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1651:40>>*/ return make_from_fmtty
-                 (k, acc, rest$7, fmt); /*<<camlinternalFormat.ml:1651:70>>*/ };
+                 (k, acc, rest$7, fmt) /*<<camlinternalFormat.ml:1651:70>>*/ ; /*<<camlinternalFormat.ml:1651:70>>*/ } /*<<camlinternalFormat.ml:1651:31>>*/ ;
        case 9:
          /*<<camlinternalFormat.ml:1654:13>>*/ var
          rest$8 = fmtty[3],
@@ -17687,22 +17934,22 @@
                   acc,
                    /*<<camlinternalFormat.ml:1655:35>>*/ caml_call2
                    (CamlinternalFormatBasics[1], ty, rest$8),
-                  fmt); /*<<camlinternalFormat.ml:1655:61>>*/ };
+                  fmt) /*<<camlinternalFormat.ml:1655:61>>*/ ; /*<<camlinternalFormat.ml:1655:61>>*/ } /*<<camlinternalFormat.ml:1655:4>>*/ ;
        case 10:
         var rest$9 = fmtty[1];
          /*<<camlinternalFormat.ml:1646:31>>*/ return function(_cc_, param){
           /*<<camlinternalFormat.ml:1646:42>>*/ return make_from_fmtty
-                 (k, acc, rest$9, fmt); /*<<camlinternalFormat.ml:1646:72>>*/ };
+                 (k, acc, rest$9, fmt) /*<<camlinternalFormat.ml:1646:72>>*/ ; /*<<camlinternalFormat.ml:1646:72>>*/ } /*<<camlinternalFormat.ml:1646:31>>*/ ;
        case 11:
         var rest$10 = fmtty[1];
          /*<<camlinternalFormat.ml:1647:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1647:40>>*/ return make_from_fmtty
-                 (k, acc, rest$10, fmt); /*<<camlinternalFormat.ml:1647:70>>*/ };
+                 (k, acc, rest$10, fmt) /*<<camlinternalFormat.ml:1647:70>>*/ ; /*<<camlinternalFormat.ml:1647:70>>*/ } /*<<camlinternalFormat.ml:1647:31>>*/ ;
        case 12:
         var rest$11 = fmtty[1];
          /*<<camlinternalFormat.ml:1648:31>>*/ return function(param){
           /*<<camlinternalFormat.ml:1648:40>>*/ return make_from_fmtty
-                 (k, acc, rest$11, fmt); /*<<camlinternalFormat.ml:1648:70>>*/ };
+                 (k, acc, rest$11, fmt) /*<<camlinternalFormat.ml:1648:70>>*/ ; /*<<camlinternalFormat.ml:1648:70>>*/ } /*<<camlinternalFormat.ml:1648:31>>*/ ;
        case 13:
          /*<<camlinternalFormat.ml:1649:31>>*/ throw  /*<<camlinternalFormat.ml:1649:31>>*/ caml_maybe_attach_backtrace
                ([0, Assert_failure, _u_], 1);
@@ -17712,10 +17959,10 @@
      }
      /*<<camlinternalFormat.ml:1652:31>>*/ if(counter >= 50)
       /*<<camlinternalFormat.ml:1652:31>>*/ return  /*<<camlinternalFormat.ml:1652:31>>*/ caml_trampoline_return
-             (make_invalid_arg, [0, k, acc, fmt]);
+             (make_invalid_arg, [0, k, acc, fmt]) /*<<camlinternalFormat.ml:1655:61>>*/ ;
     var counter$0 = counter + 1 | 0;
      /*<<camlinternalFormat.ml:1652:31>>*/ return make_invalid_arg
-            (counter$0, k, acc, fmt);
+            (counter$0, k, acc, fmt) /*<<camlinternalFormat.ml:1655:61>>*/ ;
     /*<<camlinternalFormat.ml:1655:61>>*/ }
    function make_from_fmtty(k, acc, fmtty, fmt){
      /*<<?>>*/ return caml_trampoline
@@ -17726,10 +17973,10 @@
      _cb_ = [8, acc, cst_Printf_bad_conversion$0];
      /*<<camlinternalFormat.ml:1663:2>>*/ if(counter >= 50)
       /*<<camlinternalFormat.ml:1663:2>>*/ return  /*<<camlinternalFormat.ml:1663:2>>*/ caml_trampoline_return
-             (make_printf$0, [0, k, _cb_, fmt]);
+             (make_printf$0, [0, k, _cb_, fmt]) /*<<camlinternalFormat.ml:1663:72>>*/ ;
     var counter$0 = counter + 1 | 0;
      /*<<camlinternalFormat.ml:1663:2>>*/ return make_printf$0
-            (counter$0, k, _cb_, fmt);
+            (counter$0, k, _cb_, fmt) /*<<camlinternalFormat.ml:1663:72>>*/ ;
     /*<<camlinternalFormat.ml:1663:72>>*/ }
    function make_padding(k, acc, fmt, pad, trans){
      /*<<camlinternalFormat.ml:1670:29>>*/ if(typeof pad === "number")
@@ -17738,7 +17985,7 @@
        new_acc =
          [4, acc,  /*<<camlinternalFormat.ml:1673:42>>*/ caml_call1(trans, x)];
        /*<<camlinternalFormat.ml:1674:6>>*/ return make_printf
-              (k, new_acc, fmt); /*<<camlinternalFormat.ml:1674:31>>*/ };
+              (k, new_acc, fmt) /*<<camlinternalFormat.ml:1674:31>>*/ ; /*<<camlinternalFormat.ml:1674:31>>*/ } /*<<camlinternalFormat.ml:1672:4>>*/ ;
     if(0 === pad[0]){
      var width = pad[2], padty = pad[1];
       /*<<camlinternalFormat.ml:1676:4>>*/ return function(x){
@@ -17751,7 +17998,7 @@
             width,
              /*<<camlinternalFormat.ml:1677:66>>*/ caml_call1(trans, x))];
        /*<<camlinternalFormat.ml:1678:6>>*/ return make_printf
-              (k, new_acc, fmt); /*<<camlinternalFormat.ml:1678:31>>*/ };
+              (k, new_acc, fmt) /*<<camlinternalFormat.ml:1678:31>>*/ ; /*<<camlinternalFormat.ml:1678:31>>*/ } /*<<camlinternalFormat.ml:1676:4>>*/ ;
     }
     var padty$0 = pad[1];
      /*<<camlinternalFormat.ml:1680:4>>*/ return function(w, x){
@@ -17763,7 +18010,7 @@
           (padty$0,
            w,
             /*<<camlinternalFormat.ml:1681:62>>*/ caml_call1(trans, x))];
-      /*<<camlinternalFormat.ml:1682:6>>*/ return make_printf(k, new_acc, fmt); /*<<camlinternalFormat.ml:1682:31>>*/ };
+      /*<<camlinternalFormat.ml:1682:6>>*/ return make_printf(k, new_acc, fmt) /*<<camlinternalFormat.ml:1682:31>>*/ ; /*<<camlinternalFormat.ml:1682:31>>*/ } /*<<camlinternalFormat.ml:1680:4>>*/ ;
     /*<<camlinternalFormat.ml:1682:31>>*/ }
    function make_int_padding_precision(k, acc, fmt, pad, prec, trans, iconv){
      /*<<camlinternalFormat.ml:1691:40>>*/ if(typeof pad === "number"){
@@ -17778,7 +18025,7 @@
                       /*<<camlinternalFormat.ml:1702:36>>*/ caml_call2
                       (trans, iconv, x));
                  /*<<camlinternalFormat.ml:1703:6>>*/ return make_printf
-                        (k, [4, acc, str], fmt);
+                        (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1703:52>>*/ ;
                 /*<<camlinternalFormat.ml:1703:52>>*/ }
               : function
                (x){
@@ -17787,8 +18034,8 @@
                     /*<<camlinternalFormat.ml:1694:16>>*/ caml_call2
                     (trans, iconv, x);
                  /*<<camlinternalFormat.ml:1695:6>>*/ return make_printf
-                        (k, [4, acc, str], fmt);
-                /*<<camlinternalFormat.ml:1695:52>>*/ };
+                        (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1695:52>>*/ ;
+                /*<<camlinternalFormat.ml:1695:52>>*/ } /*<<camlinternalFormat.ml:1727:52>>*/ ;
      var p = prec[1];
       /*<<camlinternalFormat.ml:1697:4>>*/ return function(x){
        /*<<camlinternalFormat.ml:1698:6>>*/  /*<<camlinternalFormat.ml:1698:16>>*/ var
@@ -17797,7 +18044,7 @@
           (p,
             /*<<camlinternalFormat.ml:1698:36>>*/ caml_call2(trans, iconv, x));
        /*<<camlinternalFormat.ml:1699:6>>*/ return make_printf
-              (k, [4, acc, str], fmt); /*<<camlinternalFormat.ml:1699:52>>*/ };
+              (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1699:52>>*/ ; /*<<camlinternalFormat.ml:1699:52>>*/ } /*<<camlinternalFormat.ml:1697:4>>*/ ;
     }
     if(0 === pad[0]){
      var w = pad[2], padty = pad[1];
@@ -17815,7 +18062,7 @@
                         /*<<camlinternalFormat.ml:1714:57>>*/ caml_call2
                         (trans, iconv, x)));
                  /*<<camlinternalFormat.ml:1715:6>>*/ return make_printf
-                        (k, [4, acc, str], fmt);
+                        (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1715:52>>*/ ;
                 /*<<camlinternalFormat.ml:1715:52>>*/ }
               : function
                (x){
@@ -17827,8 +18074,8 @@
                       /*<<camlinternalFormat.ml:1706:36>>*/ caml_call2
                       (trans, iconv, x));
                  /*<<camlinternalFormat.ml:1707:6>>*/ return make_printf
-                        (k, [4, acc, str], fmt);
-                /*<<camlinternalFormat.ml:1707:52>>*/ };
+                        (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1707:52>>*/ ;
+                /*<<camlinternalFormat.ml:1707:52>>*/ } /*<<camlinternalFormat.ml:1727:52>>*/ ;
      var p$0 = prec[1];
       /*<<camlinternalFormat.ml:1709:4>>*/ return function(x){
        /*<<camlinternalFormat.ml:1710:6>>*/  /*<<camlinternalFormat.ml:1710:16>>*/ var
@@ -17841,7 +18088,7 @@
               /*<<camlinternalFormat.ml:1710:57>>*/ caml_call2
               (trans, iconv, x)));
        /*<<camlinternalFormat.ml:1711:6>>*/ return make_printf
-              (k, [4, acc, str], fmt); /*<<camlinternalFormat.ml:1711:52>>*/ };
+              (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1711:52>>*/ ; /*<<camlinternalFormat.ml:1711:52>>*/ } /*<<camlinternalFormat.ml:1709:4>>*/ ;
     }
     var padty$0 = pad[1];
     if(typeof prec === "number")
@@ -17858,7 +18105,7 @@
                        /*<<camlinternalFormat.ml:1726:57>>*/ caml_call2
                        (trans, iconv, x)));
                 /*<<camlinternalFormat.ml:1727:6>>*/ return make_printf
-                       (k, [4, acc, str], fmt);
+                       (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1727:52>>*/ ;
                /*<<camlinternalFormat.ml:1727:52>>*/ }
              : function
               (w, x){
@@ -17870,8 +18117,8 @@
                      /*<<camlinternalFormat.ml:1718:36>>*/ caml_call2
                      (trans, iconv, x));
                 /*<<camlinternalFormat.ml:1719:6>>*/ return make_printf
-                       (k, [4, acc, str], fmt);
-               /*<<camlinternalFormat.ml:1719:52>>*/ };
+                       (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1719:52>>*/ ;
+               /*<<camlinternalFormat.ml:1719:52>>*/ } /*<<camlinternalFormat.ml:1727:52>>*/ ;
     var p$1 = prec[1];
      /*<<camlinternalFormat.ml:1721:4>>*/ return function(w, x){
       /*<<camlinternalFormat.ml:1722:6>>*/  /*<<camlinternalFormat.ml:1722:16>>*/ var
@@ -17883,7 +18130,7 @@
            (p$1,
              /*<<camlinternalFormat.ml:1722:57>>*/ caml_call2(trans, iconv, x)));
       /*<<camlinternalFormat.ml:1723:6>>*/ return make_printf
-             (k, [4, acc, str], fmt); /*<<camlinternalFormat.ml:1723:52>>*/ };
+             (k, [4, acc, str], fmt) /*<<camlinternalFormat.ml:1723:52>>*/ ; /*<<camlinternalFormat.ml:1723:52>>*/ } /*<<camlinternalFormat.ml:1721:4>>*/ ;
     /*<<camlinternalFormat.ml:1727:52>>*/ }
    function make_custom$0(counter, k, acc, rest, arity, f){
      /*<<camlinternalFormat.ml:1778:28>>*/ if(arity){
@@ -17894,16 +18141,16 @@
                acc,
                rest,
                arity$0,
-                /*<<camlinternalFormat.ml:1782:35>>*/ caml_call1(f, x)); /*<<camlinternalFormat.ml:1782:40>>*/ };
+                /*<<camlinternalFormat.ml:1782:35>>*/ caml_call1(f, x)) /*<<camlinternalFormat.ml:1782:40>>*/ ; /*<<camlinternalFormat.ml:1782:40>>*/ } /*<<camlinternalFormat.ml:1781:4>>*/ ;
     }
      /*<<camlinternalFormat.ml:1779:33>>*/  /*<<camlinternalFormat.ml:1779:33>>*/ var
      _ca_ = [4, acc, f];
      /*<<camlinternalFormat.ml:1779:19>>*/ if(counter >= 50)
       /*<<camlinternalFormat.ml:1779:19>>*/ return  /*<<camlinternalFormat.ml:1779:19>>*/ caml_trampoline_return
-             (make_printf$0, [0, k, _ca_, rest]);
+             (make_printf$0, [0, k, _ca_, rest]) /*<<camlinternalFormat.ml:1782:40>>*/ ;
     var counter$0 = counter + 1 | 0;
      /*<<camlinternalFormat.ml:1779:19>>*/ return make_printf$0
-            (counter$0, k, _ca_, rest);
+            (counter$0, k, _ca_, rest) /*<<camlinternalFormat.ml:1782:40>>*/ ;
     /*<<camlinternalFormat.ml:1782:40>>*/ }
    function make_custom(k, acc, rest, arity, f){
      /*<<?>>*/ return caml_trampoline
@@ -17914,21 +18161,21 @@
      /*<<camlinternalFormat.ml:1788:17>>*/ for(;;){
      if(typeof fmt$0 === "number")
        /*<<camlinternalFormat.ml:1858:8>>*/ return  /*<<camlinternalFormat.ml:1858:8>>*/ caml_call1
-              (k$0, o);
+              (k$0, o) /*<<camlinternalFormat.ml:1858:11>>*/ ;
      switch(fmt$0[0]){
        case 0:
          /*<<camlinternalFormat.ml:1790:14>>*/ var
          rest = fmt$0[1],
           /*<<camlinternalFormat.ml:1790:14>>*/ x = make_iprintf(k$0, o, rest);
          /*<<camlinternalFormat.ml:1790:14>>*/ return function(_b$_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1790:14>>*/ ;
        case 1:
          /*<<camlinternalFormat.ml:1792:14>>*/ var
          rest$0 = fmt$0[1],
           /*<<camlinternalFormat.ml:1792:14>>*/ x$0 =
            make_iprintf(k$0, o, rest$0);
          /*<<camlinternalFormat.ml:1792:14>>*/ return function(_b__){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$0;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$0 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1792:14>>*/ ;
        case 2:
         var _bM_ = fmt$0[1];
         if(typeof _bM_ === "number"){
@@ -17937,7 +18184,7 @@
            /*<<camlinternalFormat.ml:1794:14>>*/ x$1 =
             make_iprintf(k$0, o, rest$1);
           /*<<camlinternalFormat.ml:1794:14>>*/ return function(_b9_){
-           /*<<camlinternalFormat.ml:1784:16>>*/ return x$1;};
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x$1 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1794:14>>*/ ;
         }
         if(0 === _bM_[0]){
           /*<<camlinternalFormat.ml:1796:14>>*/ var
@@ -17945,16 +18192,18 @@
            /*<<camlinternalFormat.ml:1796:14>>*/ x$2 =
             make_iprintf(k$0, o, rest$2);
           /*<<camlinternalFormat.ml:1796:14>>*/ return function(_b8_){
-           /*<<camlinternalFormat.ml:1784:16>>*/ return x$2;};
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x$2 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1796:14>>*/ ;
         }
          /*<<camlinternalFormat.ml:1798:21>>*/ var
          rest$3 = fmt$0[2],
           /*<<camlinternalFormat.ml:1798:21>>*/ x$3 =
            make_iprintf(k$0, o, rest$3),
           /*<<camlinternalFormat.ml:1798:14>>*/ x$4 =
-           function(_b7_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$3;};
+           function(_b7_){
+             /*<<camlinternalFormat.ml:1784:16>>*/ return x$3 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+           };
          /*<<camlinternalFormat.ml:1798:14>>*/ return function(_b6_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$4;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$4 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1798:14>>*/ ;
        case 3:
         var _bN_ = fmt$0[1];
         if(typeof _bN_ === "number"){
@@ -17963,7 +18212,7 @@
            /*<<camlinternalFormat.ml:1800:14>>*/ x$5 =
             make_iprintf(k$0, o, rest$4);
           /*<<camlinternalFormat.ml:1800:14>>*/ return function(_b5_){
-           /*<<camlinternalFormat.ml:1784:16>>*/ return x$5;};
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x$5 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1800:14>>*/ ;
         }
         if(0 === _bN_[0]){
           /*<<camlinternalFormat.ml:1802:14>>*/ var
@@ -17971,36 +18220,38 @@
            /*<<camlinternalFormat.ml:1802:14>>*/ x$6 =
             make_iprintf(k$0, o, rest$5);
           /*<<camlinternalFormat.ml:1802:14>>*/ return function(_b4_){
-           /*<<camlinternalFormat.ml:1784:16>>*/ return x$6;};
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x$6 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1802:14>>*/ ;
         }
          /*<<camlinternalFormat.ml:1804:21>>*/ var
          rest$6 = fmt$0[2],
           /*<<camlinternalFormat.ml:1804:21>>*/ x$7 =
            make_iprintf(k$0, o, rest$6),
           /*<<camlinternalFormat.ml:1804:14>>*/ x$8 =
-           function(_b3_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$7;};
+           function(_b3_){
+             /*<<camlinternalFormat.ml:1784:16>>*/ return x$7 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+           };
          /*<<camlinternalFormat.ml:1804:14>>*/ return function(_b2_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$8;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$8 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1804:14>>*/ ;
        case 4:
         var rest$7 = fmt$0[4], prec = fmt$0[3], pad = fmt$0[2];
          /*<<camlinternalFormat.ml:1806:8>>*/ return fn_of_padding_precision
-                (k$0, o, rest$7, pad, prec);
+                (k$0, o, rest$7, pad, prec) /*<<camlinternalFormat.ml:1858:11>>*/ ;
        case 5:
         var rest$8 = fmt$0[4], prec$0 = fmt$0[3], pad$0 = fmt$0[2];
          /*<<camlinternalFormat.ml:1808:8>>*/ return fn_of_padding_precision
-                (k$0, o, rest$8, pad$0, prec$0);
+                (k$0, o, rest$8, pad$0, prec$0) /*<<camlinternalFormat.ml:1858:11>>*/ ;
        case 6:
         var rest$9 = fmt$0[4], prec$1 = fmt$0[3], pad$1 = fmt$0[2];
          /*<<camlinternalFormat.ml:1810:8>>*/ return fn_of_padding_precision
-                (k$0, o, rest$9, pad$1, prec$1);
+                (k$0, o, rest$9, pad$1, prec$1) /*<<camlinternalFormat.ml:1858:11>>*/ ;
        case 7:
         var rest$10 = fmt$0[4], prec$2 = fmt$0[3], pad$2 = fmt$0[2];
          /*<<camlinternalFormat.ml:1812:8>>*/ return fn_of_padding_precision
-                (k$0, o, rest$10, pad$2, prec$2);
+                (k$0, o, rest$10, pad$2, prec$2) /*<<camlinternalFormat.ml:1858:11>>*/ ;
        case 8:
         var rest$11 = fmt$0[4], prec$3 = fmt$0[3], pad$3 = fmt$0[2];
          /*<<camlinternalFormat.ml:1814:8>>*/ return fn_of_padding_precision
-                (k$0, o, rest$11, pad$3, prec$3);
+                (k$0, o, rest$11, pad$3, prec$3) /*<<camlinternalFormat.ml:1858:11>>*/ ;
        case 9:
         var _bO_ = fmt$0[1];
         if(typeof _bO_ === "number"){
@@ -18009,7 +18260,7 @@
            /*<<camlinternalFormat.ml:1816:14>>*/ x$9 =
             make_iprintf(k$0, o, rest$12);
           /*<<camlinternalFormat.ml:1816:14>>*/ return function(_b1_){
-           /*<<camlinternalFormat.ml:1784:16>>*/ return x$9;};
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x$9 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1816:14>>*/ ;
         }
         if(0 === _bO_[0]){
           /*<<camlinternalFormat.ml:1818:14>>*/ var
@@ -18017,16 +18268,18 @@
            /*<<camlinternalFormat.ml:1818:14>>*/ x$10 =
             make_iprintf(k$0, o, rest$13);
           /*<<camlinternalFormat.ml:1818:14>>*/ return function(_b0_){
-           /*<<camlinternalFormat.ml:1784:16>>*/ return x$10;};
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x$10 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1818:14>>*/ ;
         }
          /*<<camlinternalFormat.ml:1820:21>>*/ var
          rest$14 = fmt$0[2],
           /*<<camlinternalFormat.ml:1820:21>>*/ x$11 =
            make_iprintf(k$0, o, rest$14),
           /*<<camlinternalFormat.ml:1820:14>>*/ x$12 =
-           function(_bZ_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$11;};
+           function(_bZ_){
+             /*<<camlinternalFormat.ml:1784:16>>*/ return x$11 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+           };
          /*<<camlinternalFormat.ml:1820:14>>*/ return function(_bY_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$12;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$12 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1820:14>>*/ ;
        case 10:
         var rest$15 = fmt$0[1]; fmt$0 = rest$15; break;
        case 11:
@@ -18039,7 +18292,7 @@
           /*<<camlinternalFormat.ml:1838:14>>*/ x$13 =
            make_iprintf(k$0, o, rest$18);
          /*<<camlinternalFormat.ml:1838:14>>*/ return function(_bX_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$13;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$13 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1838:14>>*/ ;
        case 14:
         var rest$19 = fmt$0[3], fmtty = fmt$0[2];
          /*<<camlinternalFormat.ml:1840:8>>*/ return function(param){
@@ -18050,23 +18303,25 @@
                  (k$0,
                   o,
                    /*<<camlinternalFormat.ml:1842:12>>*/ caml_call2
-                   (CamlinternalFormatBasics[3], _bW_, rest$19)); /*<<camlinternalFormat.ml:1842:48>>*/ };
+                   (CamlinternalFormatBasics[3], _bW_, rest$19)) /*<<camlinternalFormat.ml:1842:48>>*/ ; /*<<camlinternalFormat.ml:1842:48>>*/ } /*<<camlinternalFormat.ml:1840:8>>*/ ;
        case 15:
          /*<<camlinternalFormat.ml:1822:21>>*/ var
          rest$20 = fmt$0[1],
           /*<<camlinternalFormat.ml:1822:21>>*/ x$14 =
            make_iprintf(k$0, o, rest$20),
           /*<<camlinternalFormat.ml:1822:14>>*/ x$15 =
-           function(_bV_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$14;};
+           function(_bV_){
+             /*<<camlinternalFormat.ml:1784:16>>*/ return x$14 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+           };
          /*<<camlinternalFormat.ml:1822:14>>*/ return function(_bU_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$15;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$15 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1822:14>>*/ ;
        case 16:
          /*<<camlinternalFormat.ml:1824:14>>*/ var
          rest$21 = fmt$0[1],
           /*<<camlinternalFormat.ml:1824:14>>*/ x$16 =
            make_iprintf(k$0, o, rest$21);
          /*<<camlinternalFormat.ml:1824:14>>*/ return function(_bT_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$16;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$16 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1824:14>>*/ ;
        case 17:
         var rest$22 = fmt$0[2]; fmt$0 = rest$22; break;
        case 18:
@@ -18078,7 +18333,7 @@
           k$1 =
             function(koc){
               /*<<camlinternalFormat.ml:1854:33>>*/ return make_iprintf
-                     (k, koc, rest);
+                     (k, koc, rest) /*<<camlinternalFormat.ml:1854:56>>*/ ;
              /*<<camlinternalFormat.ml:1854:56>>*/ };
          k$0 = k$1;
          fmt$0 = fmt$1;
@@ -18090,7 +18345,7 @@
           k$2 =
             function(koc){
               /*<<camlinternalFormat.ml:1856:33>>*/ return make_iprintf
-                     (k, koc, rest);
+                     (k, koc, rest) /*<<camlinternalFormat.ml:1856:56>>*/ ;
              /*<<camlinternalFormat.ml:1856:56>>*/ };
          k$0 = k$2;
          fmt$0 = fmt$2;
@@ -18105,39 +18360,39 @@
           /*<<camlinternalFormat.ml:1844:14>>*/ x$17 =
            make_iprintf(k$0, o, rest$25);
          /*<<camlinternalFormat.ml:1844:14>>*/ return function(_bS_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$17;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$17 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1844:14>>*/ ;
        case 21:
          /*<<camlinternalFormat.ml:1846:14>>*/ var
          rest$26 = fmt$0[2],
           /*<<camlinternalFormat.ml:1846:14>>*/ x$18 =
            make_iprintf(k$0, o, rest$26);
          /*<<camlinternalFormat.ml:1846:14>>*/ return function(_bR_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$18;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$18 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1846:14>>*/ ;
        case 22:
          /*<<camlinternalFormat.ml:1848:14>>*/ var
          rest$27 = fmt$0[1],
           /*<<camlinternalFormat.ml:1848:14>>*/ x$19 =
            make_iprintf(k$0, o, rest$27);
          /*<<camlinternalFormat.ml:1848:14>>*/ return function(_bQ_){
-          /*<<camlinternalFormat.ml:1784:16>>*/ return x$19;};
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$19 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1848:14>>*/ ;
        case 23:
         var rest$28 = fmt$0[2], ign = fmt$0[1];
          /*<<camlinternalFormat.ml:1850:8>>*/ return make_ignored_param
                 (function(param){
                    /*<<camlinternalFormat.ml:1850:37>>*/ return caml_call1
-                          (k$0, o);
+                          (k$0, o) /*<<camlinternalFormat.ml:1850:40>>*/ ;
                   /*<<camlinternalFormat.ml:1850:40>>*/ },
                  0,
                  ign,
-                 rest$28);
+                 rest$28) /*<<camlinternalFormat.ml:1858:11>>*/ ;
        default:
         var rest$29 = fmt$0[3], arity = fmt$0[1];
          /*<<camlinternalFormat.ml:1826:8>>*/ if(counter >= 50)
           /*<<camlinternalFormat.ml:1826:8>>*/ return  /*<<camlinternalFormat.ml:1826:8>>*/ caml_trampoline_return
-                 (fn_of_custom_arity$0, [0, k$0, o, rest$29, arity]);
+                 (fn_of_custom_arity$0, [0, k$0, o, rest$29, arity]) /*<<camlinternalFormat.ml:1858:11>>*/ ;
         var counter$0 = counter + 1 | 0;
          /*<<camlinternalFormat.ml:1826:8>>*/ return fn_of_custom_arity$0
-                (counter$0, k$0, o, rest$29, arity);
+                (counter$0, k$0, o, rest$29, arity) /*<<camlinternalFormat.ml:1858:11>>*/ ;
      }
     }
     /*<<camlinternalFormat.ml:1858:11>>*/ }
@@ -18150,66 +18405,76 @@
        /*<<camlinternalFormat.ml:1867:14>>*/  /*<<camlinternalFormat.ml:1867:14>>*/ var
        x$2 = make_iprintf(k, o, fmt);
        /*<<camlinternalFormat.ml:1867:14>>*/ return function(_bL_){
-        /*<<camlinternalFormat.ml:1784:16>>*/ return x$2;};
+        /*<<camlinternalFormat.ml:1784:16>>*/ return x$2 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1867:14>>*/ ;
      }
      if(prec){
        /*<<camlinternalFormat.ml:1869:21>>*/ var
         /*<<camlinternalFormat.ml:1869:21>>*/ x = make_iprintf(k, o, fmt),
         /*<<camlinternalFormat.ml:1869:14>>*/ x$0 =
-         function(_bK_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x;};
+         function(_bK_){
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x /*<<camlinternalFormat.ml:1784:16>>*/ ;
+         };
        /*<<camlinternalFormat.ml:1869:14>>*/ return function(_bJ_){
-        /*<<camlinternalFormat.ml:1784:16>>*/ return x$0;};
+        /*<<camlinternalFormat.ml:1784:16>>*/ return x$0 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1869:14>>*/ ;
      }
       /*<<camlinternalFormat.ml:1865:14>>*/  /*<<camlinternalFormat.ml:1865:14>>*/ var
       x$1 = make_iprintf(k, o, fmt);
       /*<<camlinternalFormat.ml:1865:14>>*/ return function(_bI_){
-       /*<<camlinternalFormat.ml:1784:16>>*/ return x$1;};
+       /*<<camlinternalFormat.ml:1784:16>>*/ return x$1 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1865:14>>*/ ;
     }
     if(0 === pad[0]){
      if(typeof prec !== "number"){
        /*<<camlinternalFormat.ml:1873:14>>*/  /*<<camlinternalFormat.ml:1873:14>>*/ var
        x$6 = make_iprintf(k, o, fmt);
        /*<<camlinternalFormat.ml:1873:14>>*/ return function(_bH_){
-        /*<<camlinternalFormat.ml:1784:16>>*/ return x$6;};
+        /*<<camlinternalFormat.ml:1784:16>>*/ return x$6 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1873:14>>*/ ;
      }
      if(prec){
        /*<<camlinternalFormat.ml:1875:21>>*/ var
         /*<<camlinternalFormat.ml:1875:21>>*/ x$3 = make_iprintf(k, o, fmt),
         /*<<camlinternalFormat.ml:1875:14>>*/ x$4 =
-         function(_bG_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$3;};
+         function(_bG_){
+           /*<<camlinternalFormat.ml:1784:16>>*/ return x$3 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+         };
        /*<<camlinternalFormat.ml:1875:14>>*/ return function(_bF_){
-        /*<<camlinternalFormat.ml:1784:16>>*/ return x$4;};
+        /*<<camlinternalFormat.ml:1784:16>>*/ return x$4 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1875:14>>*/ ;
      }
       /*<<camlinternalFormat.ml:1871:14>>*/  /*<<camlinternalFormat.ml:1871:14>>*/ var
       x$5 = make_iprintf(k, o, fmt);
       /*<<camlinternalFormat.ml:1871:14>>*/ return function(_bE_){
-       /*<<camlinternalFormat.ml:1784:16>>*/ return x$5;};
+       /*<<camlinternalFormat.ml:1784:16>>*/ return x$5 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1871:14>>*/ ;
     }
     if(typeof prec !== "number"){
       /*<<camlinternalFormat.ml:1879:21>>*/ var
        /*<<camlinternalFormat.ml:1879:21>>*/ x$12 = make_iprintf(k, o, fmt),
        /*<<camlinternalFormat.ml:1879:14>>*/ x$13 =
-        function(_bD_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$12;};
+        function(_bD_){
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$12 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+        };
       /*<<camlinternalFormat.ml:1879:14>>*/ return function(_bC_){
-       /*<<camlinternalFormat.ml:1784:16>>*/ return x$13;};
+       /*<<camlinternalFormat.ml:1784:16>>*/ return x$13 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1879:14>>*/ ;
     }
     if(prec){
       /*<<camlinternalFormat.ml:1881:28>>*/ var
        /*<<camlinternalFormat.ml:1881:28>>*/ x$7 = make_iprintf(k, o, fmt),
        /*<<camlinternalFormat.ml:1881:21>>*/ x$8 =
-        function(_bB_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$7;},
+        function(_bB_){
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$7 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+        },
        /*<<camlinternalFormat.ml:1881:14>>*/ x$9 =
-        function(_bA_){ /*<<camlinternalFormat.ml:1784:16>>*/ return x$8;};
+        function(_bA_){
+          /*<<camlinternalFormat.ml:1784:16>>*/ return x$8 /*<<camlinternalFormat.ml:1784:16>>*/ ;
+        };
       /*<<camlinternalFormat.ml:1881:14>>*/ return function(_bz_){
-       /*<<camlinternalFormat.ml:1784:16>>*/ return x$9;};
+       /*<<camlinternalFormat.ml:1784:16>>*/ return x$9 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1881:14>>*/ ;
     }
      /*<<camlinternalFormat.ml:1877:21>>*/  /*<<camlinternalFormat.ml:1877:21>>*/ var
      x$10 = make_iprintf(k, o, fmt);
      /*<<camlinternalFormat.ml:1877:14>>*/ function x$11(_by_){
-      /*<<camlinternalFormat.ml:1784:16>>*/ return x$10;
+      /*<<camlinternalFormat.ml:1784:16>>*/ return x$10 /*<<camlinternalFormat.ml:1784:16>>*/ ;
     }
      /*<<camlinternalFormat.ml:1877:14>>*/ return function(_bx_){
-      /*<<camlinternalFormat.ml:1784:16>>*/ return x$11;};
+      /*<<camlinternalFormat.ml:1784:16>>*/ return x$11 /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1877:14>>*/ ;
     /*<<camlinternalFormat.ml:1881:52>>*/ }
    function fn_of_custom_arity$0(counter, k, o, fmt, param){
      /*<<?>>*/ if(param){
@@ -18218,14 +18483,14 @@
        /*<<camlinternalFormat.ml:1889:14>>*/ x =
         fn_of_custom_arity(k, o, fmt, arity);
       /*<<camlinternalFormat.ml:1889:14>>*/ return function(_bw_){
-       /*<<camlinternalFormat.ml:1784:16>>*/ return x;};
+       /*<<camlinternalFormat.ml:1784:16>>*/ return x /*<<camlinternalFormat.ml:1784:16>>*/ ;} /*<<camlinternalFormat.ml:1889:14>>*/ ;
     }
      /*<<camlinternalFormat.ml:1887:8>>*/ if(counter >= 50)
       /*<<camlinternalFormat.ml:1887:8>>*/ return  /*<<camlinternalFormat.ml:1887:8>>*/ caml_trampoline_return
-             (make_iprintf$0, [0, k, o, fmt]);
+             (make_iprintf$0, [0, k, o, fmt]) /*<<camlinternalFormat.ml:1887:8>>*/ ;
     var counter$0 = counter + 1 | 0;
      /*<<camlinternalFormat.ml:1887:8>>*/ return make_iprintf$0
-            (counter$0, k, o, fmt);
+            (counter$0, k, o, fmt) /*<<camlinternalFormat.ml:1887:8>>*/ ;
    }
    function fn_of_custom_arity(k, o, fmt, param){
      /*<<?>>*/ return caml_trampoline
@@ -18235,7 +18500,7 @@
      /*<<camlinternalFormat.ml:1897:27>>*/ var acc$0 = acc;
      /*<<camlinternalFormat.ml:1897:27>>*/ for(;;){
      if(typeof acc$0 === "number")
-       /*<<camlinternalFormat.ml:1912:32>>*/ return 0;
+       /*<<camlinternalFormat.ml:1912:32>>*/ return 0 /*<<camlinternalFormat.ml:1912:32>>*/ ;
      switch(acc$0[0]){
        case 0:
          /*<<camlinternalFormat.ml:1899:12>>*/ var
@@ -18245,7 +18510,7 @@
            string_of_formatting_lit(fmting_lit);
          /*<<camlinternalFormat.ml:1900:4>>*/ output_acc(o, p);
          /*<<camlinternalFormat.ml:1900:4>>*/ return  /*<<camlinternalFormat.ml:1900:4>>*/ caml_call2
-                (Stdlib[66], o, s);
+                (Stdlib[66], o, s) /*<<camlinternalFormat.ml:1912:34>>*/ ;
        case 1:
         var match = acc$0[2], p$0 = acc$0[1];
         if(0 === match[0]){
@@ -18267,28 +18532,28 @@
         var f = acc$0[2], p$3 = acc$0[1];
          /*<<camlinternalFormat.ml:1909:32>>*/ output_acc(o, p$3);
          /*<<camlinternalFormat.ml:1909:32>>*/ return  /*<<camlinternalFormat.ml:1909:32>>*/ caml_call1
-                (f, o);
+                (f, o) /*<<camlinternalFormat.ml:1912:34>>*/ ;
        case 7:
         var p$4 = acc$0[1];
          /*<<camlinternalFormat.ml:1910:32>>*/ output_acc(o, p$4);
          /*<<camlinternalFormat.ml:1910:32>>*/ return  /*<<camlinternalFormat.ml:1910:32>>*/ caml_call1
-                (Stdlib[63], o);
+                (Stdlib[63], o) /*<<camlinternalFormat.ml:1912:34>>*/ ;
        case 8:
         var msg = acc$0[2], p$5 = acc$0[1];
          /*<<camlinternalFormat.ml:1911:32>>*/ output_acc(o, p$5);
          /*<<camlinternalFormat.ml:1911:32>>*/ return  /*<<camlinternalFormat.ml:1911:32>>*/ caml_call1
-                (Stdlib[1], msg);
+                (Stdlib[1], msg) /*<<camlinternalFormat.ml:1912:34>>*/ ;
        case 2:
        case 4:
         var s$0 = acc$0[2], p$1 = acc$0[1];
          /*<<camlinternalFormat.ml:1906:32>>*/ output_acc(o, p$1);
          /*<<camlinternalFormat.ml:1906:32>>*/ return  /*<<camlinternalFormat.ml:1906:32>>*/ caml_call2
-                (Stdlib[66], o, s$0);
+                (Stdlib[66], o, s$0) /*<<camlinternalFormat.ml:1912:34>>*/ ;
        default:
         var c = acc$0[2], p$2 = acc$0[1];
          /*<<camlinternalFormat.ml:1908:32>>*/ output_acc(o, p$2);
          /*<<camlinternalFormat.ml:1908:32>>*/ return  /*<<camlinternalFormat.ml:1908:32>>*/ caml_call2
-                (Stdlib[65], o, c);
+                (Stdlib[65], o, c) /*<<camlinternalFormat.ml:1912:34>>*/ ;
      }
     }
     /*<<camlinternalFormat.ml:1912:34>>*/ }
@@ -18296,7 +18561,7 @@
      /*<<camlinternalFormat.ml:1917:27>>*/ var acc$0 = acc;
      /*<<camlinternalFormat.ml:1917:27>>*/ for(;;){
      if(typeof acc$0 === "number")
-       /*<<camlinternalFormat.ml:1932:32>>*/ return 0;
+       /*<<camlinternalFormat.ml:1932:32>>*/ return 0 /*<<camlinternalFormat.ml:1932:32>>*/ ;
      switch(acc$0[0]){
        case 0:
          /*<<camlinternalFormat.ml:1919:12>>*/ var
@@ -18306,7 +18571,7 @@
            string_of_formatting_lit(fmting_lit);
          /*<<camlinternalFormat.ml:1920:4>>*/ bufput_acc(b, p);
          /*<<camlinternalFormat.ml:1920:4>>*/ return  /*<<camlinternalFormat.ml:1920:4>>*/ caml_call2
-                (Stdlib_Buffer[16], b, s);
+                (Stdlib_Buffer[16], b, s) /*<<camlinternalFormat.ml:1932:34>>*/ ;
        case 1:
         var match = acc$0[2], p$0 = acc$0[1];
         if(0 === match[0]){
@@ -18328,25 +18593,25 @@
         var f = acc$0[2], p$3 = acc$0[1];
          /*<<camlinternalFormat.ml:1929:32>>*/ bufput_acc(b, p$3);
          /*<<camlinternalFormat.ml:1929:32>>*/ return  /*<<camlinternalFormat.ml:1929:32>>*/ caml_call1
-                (f, b);
+                (f, b) /*<<camlinternalFormat.ml:1932:34>>*/ ;
        case 7:
         var acc$3 = acc$0[1]; acc$0 = acc$3; break;
        case 8:
         var msg = acc$0[2], p$4 = acc$0[1];
          /*<<camlinternalFormat.ml:1931:32>>*/ bufput_acc(b, p$4);
          /*<<camlinternalFormat.ml:1931:32>>*/ return  /*<<camlinternalFormat.ml:1931:32>>*/ caml_call1
-                (Stdlib[1], msg);
+                (Stdlib[1], msg) /*<<camlinternalFormat.ml:1932:34>>*/ ;
        case 2:
        case 4:
         var s$0 = acc$0[2], p$1 = acc$0[1];
          /*<<camlinternalFormat.ml:1926:32>>*/ bufput_acc(b, p$1);
          /*<<camlinternalFormat.ml:1926:32>>*/ return  /*<<camlinternalFormat.ml:1926:32>>*/ caml_call2
-                (Stdlib_Buffer[16], b, s$0);
+                (Stdlib_Buffer[16], b, s$0) /*<<camlinternalFormat.ml:1932:34>>*/ ;
        default:
         var c = acc$0[2], p$2 = acc$0[1];
          /*<<camlinternalFormat.ml:1928:32>>*/ bufput_acc(b, p$2);
          /*<<camlinternalFormat.ml:1928:32>>*/ return  /*<<camlinternalFormat.ml:1928:32>>*/ caml_call2
-                (Stdlib_Buffer[12], b, c);
+                (Stdlib_Buffer[12], b, c) /*<<camlinternalFormat.ml:1932:34>>*/ ;
      }
     }
     /*<<camlinternalFormat.ml:1932:34>>*/ }
@@ -18354,7 +18619,7 @@
      /*<<camlinternalFormat.ml:1938:27>>*/ var acc$0 = acc;
      /*<<camlinternalFormat.ml:1938:27>>*/ for(;;){
      if(typeof acc$0 === "number")
-       /*<<camlinternalFormat.ml:1953:32>>*/ return 0;
+       /*<<camlinternalFormat.ml:1953:32>>*/ return 0 /*<<camlinternalFormat.ml:1953:32>>*/ ;
      switch(acc$0[0]){
        case 0:
          /*<<camlinternalFormat.ml:1940:12>>*/ var
@@ -18364,7 +18629,7 @@
            string_of_formatting_lit(fmting_lit);
          /*<<camlinternalFormat.ml:1941:4>>*/ strput_acc(b, p);
          /*<<camlinternalFormat.ml:1941:4>>*/ return  /*<<camlinternalFormat.ml:1941:4>>*/ caml_call2
-                (Stdlib_Buffer[16], b, s);
+                (Stdlib_Buffer[16], b, s) /*<<camlinternalFormat.ml:1953:34>>*/ ;
        case 1:
         var match = acc$0[2], p$0 = acc$0[1];
         if(0 === match[0]){
@@ -18388,25 +18653,25 @@
          /*<<camlinternalFormat.ml:1950:68>>*/  /*<<camlinternalFormat.ml:1950:68>>*/ var
          _bv_ =  /*<<camlinternalFormat.ml:1950:68>>*/ caml_call1(f, 0);
          /*<<camlinternalFormat.ml:1950:68>>*/ return  /*<<camlinternalFormat.ml:1950:68>>*/ caml_call2
-                (Stdlib_Buffer[16], b, _bv_);
+                (Stdlib_Buffer[16], b, _bv_) /*<<camlinternalFormat.ml:1953:34>>*/ ;
        case 7:
         var acc$3 = acc$0[1]; acc$0 = acc$3; break;
        case 8:
         var msg = acc$0[2], p$4 = acc$0[1];
          /*<<camlinternalFormat.ml:1952:32>>*/ strput_acc(b, p$4);
          /*<<camlinternalFormat.ml:1952:32>>*/ return  /*<<camlinternalFormat.ml:1952:32>>*/ caml_call1
-                (Stdlib[1], msg);
+                (Stdlib[1], msg) /*<<camlinternalFormat.ml:1953:34>>*/ ;
        case 2:
        case 4:
         var s$0 = acc$0[2], p$1 = acc$0[1];
          /*<<camlinternalFormat.ml:1947:32>>*/ strput_acc(b, p$1);
          /*<<camlinternalFormat.ml:1947:32>>*/ return  /*<<camlinternalFormat.ml:1947:32>>*/ caml_call2
-                (Stdlib_Buffer[16], b, s$0);
+                (Stdlib_Buffer[16], b, s$0) /*<<camlinternalFormat.ml:1953:34>>*/ ;
        default:
         var c = acc$0[2], p$2 = acc$0[1];
          /*<<camlinternalFormat.ml:1949:32>>*/ strput_acc(b, p$2);
          /*<<camlinternalFormat.ml:1949:32>>*/ return  /*<<camlinternalFormat.ml:1949:32>>*/ caml_call2
-                (Stdlib_Buffer[12], b, c);
+                (Stdlib_Buffer[12], b, c) /*<<camlinternalFormat.ml:1953:34>>*/ ;
      }
     }
     /*<<camlinternalFormat.ml:1953:34>>*/ }
@@ -18423,27 +18688,28 @@
          /*<<camlinternalFormat.ml:1961:43>>*/ caml_call1
          (Stdlib_Buffer[2], buf);
       /*<<camlinternalFormat.ml:1961:43>>*/ return  /*<<camlinternalFormat.ml:1961:43>>*/ caml_call1
-             (Stdlib[2], _bu_);
+             (Stdlib[2], _bu_) /*<<camlinternalFormat.ml:1961:64>>*/ ;
      /*<<camlinternalFormat.ml:1961:64>>*/ }
-     /*<<camlinternalFormat.ml:1962:2>>*/ return make_printf(k, 0, fmt);
+     /*<<camlinternalFormat.ml:1962:2>>*/ return make_printf(k, 0, fmt) /*<<camlinternalFormat.ml:1962:2>>*/ ;
    }
    function open_box_of_string(str){
      /*<<camlinternalFormat.ml:1969:2>>*/ if(str == cst$43)
-      /*<<camlinternalFormat.ml:1969:19>>*/ return _x_;
+      /*<<camlinternalFormat.ml:1969:19>>*/ return _x_ /*<<camlinternalFormat.ml:1969:19>>*/ ;
     var len = caml_ml_string_length(str);
     function invalid_box(param){
       /*<<camlinternalFormat.ml:1971:25>>*/ return  /*<<camlinternalFormat.ml:1971:4>>*/ caml_call1
-             (failwith_message(_y_), str);
+             (failwith_message(_y_), str) /*<<camlinternalFormat.ml:1971:74>>*/ ;
      /*<<camlinternalFormat.ml:1971:74>>*/ }
     function parse_spaces(i){
       /*<<camlinternalFormat.ml:1973:6>>*/ var i$0 = i;
       /*<<camlinternalFormat.ml:1973:6>>*/ for(;;){
-      if(i$0 === len)  /*<<camlinternalFormat.ml:1973:22>>*/ return i$0;
+      if(i$0 === len)
+        /*<<camlinternalFormat.ml:1973:22>>*/ return i$0 /*<<camlinternalFormat.ml:1973:22>>*/ ;
        /*<<camlinternalFormat.ml:1974:14>>*/  /*<<camlinternalFormat.ml:1974:14>>*/ var
        match =
           /*<<camlinternalFormat.ml:1974:14>>*/ caml_string_get(str, i$0);
       if(9 !== match && 32 !== match)
-        /*<<camlinternalFormat.ml:1976:15>>*/ return i$0;
+        /*<<camlinternalFormat.ml:1976:15>>*/ return i$0 /*<<camlinternalFormat.ml:1976:15>>*/ ;
        /*<<camlinternalFormat.ml:1975:24>>*/  /*<<camlinternalFormat.ml:1975:24>>*/ var
        i$1 = i$0 + 1 | 0;
       i$0 = i$1;
@@ -18522,17 +18788,17 @@
      }
      var box_type = 4;
     }
-     /*<<camlinternalFormat.ml:2005:4>>*/ return [0, indent, box_type];
+     /*<<camlinternalFormat.ml:2005:4>>*/ return [0, indent, box_type] /*<<camlinternalFormat.ml:2005:4>>*/ ;
     /*<<camlinternalFormat.ml:2005:22>>*/ }
    function make_padding_fmt_ebb(pad, fmt){
      /*<<camlinternalFormat.ml:2015:15>>*/ if(typeof pad === "number")
-      /*<<camlinternalFormat.ml:2016:26>>*/ return [0, 0, fmt];
+      /*<<camlinternalFormat.ml:2016:26>>*/ return [0, 0, fmt] /*<<camlinternalFormat.ml:2016:26>>*/ ;
     if(0 === pad[0]){
      var w = pad[2], s = pad[1];
-      /*<<camlinternalFormat.ml:2017:26>>*/ return [0, [0, s, w], fmt];
+      /*<<camlinternalFormat.ml:2017:26>>*/ return [0, [0, s, w], fmt] /*<<camlinternalFormat.ml:2017:26>>*/ ;
     }
     var s$0 = pad[1];
-     /*<<camlinternalFormat.ml:2018:26>>*/ return [0, [1, s$0], fmt];
+     /*<<camlinternalFormat.ml:2018:26>>*/ return [0, [1, s$0], fmt] /*<<camlinternalFormat.ml:2018:26>>*/ ;
     /*<<camlinternalFormat.ml:2018:62>>*/ }
    function make_padprec_fmt_ebb(pad, prec, fmt){
      /*<<camlinternalFormat.ml:2038:2>>*/ if(typeof prec === "number")
@@ -18541,13 +18807,13 @@
      var p = prec[1], match = [0, [0, p]];
     var prec$0 = match[1];
      /*<<camlinternalFormat.ml:2039:2>>*/ if(typeof pad === "number")
-      /*<<camlinternalFormat.ml:2040:26>>*/ return [0, 0, prec$0, fmt];
+      /*<<camlinternalFormat.ml:2040:26>>*/ return [0, 0, prec$0, fmt] /*<<camlinternalFormat.ml:2040:26>>*/ ;
      /*<<camlinternalFormat.ml:2039:2>>*/ if(0 === pad[0]){
      var w = pad[2], s = pad[1];
-      /*<<camlinternalFormat.ml:2041:26>>*/ return [0, [0, s, w], prec$0, fmt];
+      /*<<camlinternalFormat.ml:2041:26>>*/ return [0, [0, s, w], prec$0, fmt] /*<<camlinternalFormat.ml:2041:26>>*/ ;
     }
     var s$0 = pad[1];
-     /*<<camlinternalFormat.ml:2042:26>>*/ return [0, [1, s$0], prec$0, fmt];
+     /*<<camlinternalFormat.ml:2042:26>>*/ return [0, [1, s$0], prec$0, fmt] /*<<camlinternalFormat.ml:2042:26>>*/ ;
     /*<<camlinternalFormat.ml:2042:69>>*/ }
    function fmt_ebb_of_string(legacy_behavior, str){
      /*<<?>>*/ if(legacy_behavior)
@@ -18556,15 +18822,15 @@
      var legacy_behavior$0 = 1;
     function invalid_format_message(str_ind, msg){
       /*<<camlinternalFormat.ml:2084:4>>*/ return  /*<<camlinternalFormat.ml:2084:4>>*/ caml_call3
-             (failwith_message(_z_), str, str_ind, msg);
+             (failwith_message(_z_), str, str_ind, msg) /*<<camlinternalFormat.ml:2086:21>>*/ ;
      /*<<camlinternalFormat.ml:2086:21>>*/ }
     function invalid_format_without(str_ind, c, s){
       /*<<camlinternalFormat.ml:2104:4>>*/ return  /*<<camlinternalFormat.ml:2104:4>>*/ caml_call4
-             (failwith_message(_A_), str, str_ind, c, s);
+             (failwith_message(_A_), str, str_ind, c, s) /*<<camlinternalFormat.ml:2106:21>>*/ ;
      /*<<camlinternalFormat.ml:2106:21>>*/ }
     function expected_character(str_ind, expected, read){
       /*<<camlinternalFormat.ml:2112:4>>*/ return  /*<<camlinternalFormat.ml:2112:4>>*/ caml_call4
-             (failwith_message(_B_), str, str_ind, expected, read);
+             (failwith_message(_B_), str, str_ind, expected, read) /*<<camlinternalFormat.ml:2114:31>>*/ ;
      /*<<camlinternalFormat.ml:2114:31>>*/ }
     function parse(lit_start, end_ind){
       /*<<camlinternalFormat.ml:2119:25>>*/ a:
@@ -18573,7 +18839,7 @@
        /*<<camlinternalFormat.ml:2124:4>>*/ for(;;){
        if(str_ind === end_ind)
          /*<<camlinternalFormat.ml:2124:30>>*/ return add_literal
-                (lit_start, str_ind, 0);
+                (lit_start, str_ind, 0) /*<<camlinternalFormat.ml:2119:62>>*/ ;
         /*<<camlinternalFormat.ml:2125:12>>*/  /*<<camlinternalFormat.ml:2125:12>>*/ var
         match =
            /*<<camlinternalFormat.ml:2125:12>>*/ caml_string_get(str, str_ind);
@@ -18596,7 +18862,7 @@
           : parse_flags(str_ind, str_ind$2, end_ind, 0),
        fmt_rest = match$1[1];
        /*<<camlinternalFormat.ml:2128:8>>*/ return add_literal
-              (lit_start, str_ind, fmt_rest);
+              (lit_start, str_ind, fmt_rest) /*<<camlinternalFormat.ml:2119:62>>*/ ;
      }
      var str_ind$0 = str_ind + 1 | 0;
      a:
@@ -18861,7 +19127,7 @@
      }
      var fmt_rest$0 = match$0[1];
       /*<<camlinternalFormat.ml:2131:8>>*/ return add_literal
-             (lit_start, str_ind, fmt_rest$0);
+             (lit_start, str_ind, fmt_rest$0) /*<<camlinternalFormat.ml:2119:62>>*/ ;
      /*<<camlinternalFormat.ml:2119:62>>*/ }
     function parse_flags(pct_ind, str_ind, end_ind, ign){
       /*<<camlinternalFormat.ml:2149:4>>*/ var
@@ -18971,7 +19237,7 @@
                 hash$0,
                 space$0,
                 ign,
-                [0, padty, width]);
+                [0, padty, width]) /*<<camlinternalFormat.ml:2173:22>>*/ ;
       }
      }
      else if(42 === match)
@@ -18984,7 +19250,7 @@
                hash$0,
                space$0,
                ign,
-               [1, padty]);
+               [1, padty]) /*<<camlinternalFormat.ml:2173:22>>*/ ;
      switch(padty){
        case 0:
         if(1 - legacy_behavior$0)
@@ -18999,7 +19265,7 @@
                  hash$0,
                  space$0,
                  ign,
-                 0);
+                 0) /*<<camlinternalFormat.ml:2173:22>>*/ ;
        case 1:
          /*<<camlinternalFormat.ml:2210:8>>*/ return parse_after_padding
                 (pct_ind,
@@ -19010,7 +19276,7 @@
                  hash$0,
                  space$0,
                  ign,
-                 0);
+                 0) /*<<camlinternalFormat.ml:2173:22>>*/ ;
        default:
          /*<<camlinternalFormat.ml:2207:8>>*/ return parse_after_padding
                 (pct_ind,
@@ -19021,7 +19287,7 @@
                  hash$0,
                  space$0,
                  ign,
-                 _D_);
+                 _D_) /*<<camlinternalFormat.ml:2173:22>>*/ ;
      }
      /*<<camlinternalFormat.ml:2173:22>>*/ }
     function parse_after_padding
@@ -19044,7 +19310,7 @@
                pad,
                0,
                pad,
-               symb);
+               symb) /*<<camlinternalFormat.ml:2226:29>>*/ ;
      var str_ind$0 = str_ind + 1 | 0;
      if(str_ind$0 === end_ind)
        /*<<camlinternalFormat.ml:2092:4>>*/ invalid_format_message
@@ -19065,7 +19331,7 @@
                space,
                ign,
                pad,
-               [0, prec]);
+               [0, prec]) /*<<camlinternalFormat.ml:2237:32>>*/ ;
       /*<<camlinternalFormat.ml:2237:32>>*/ }
       /*<<camlinternalFormat.ml:2238:10>>*/  /*<<camlinternalFormat.ml:2238:10>>*/ var
       symb$0 =
@@ -19073,7 +19339,7 @@
      if(48 <= symb$0){
       if(58 > symb$0)
         /*<<camlinternalFormat.ml:2239:20>>*/ return parse_literal
-               (minus, str_ind$0);
+               (minus, str_ind$0) /*<<camlinternalFormat.ml:2226:29>>*/ ;
      }
      else if(42 <= symb$0)
       switch(symb$0 - 42 | 0){
@@ -19088,7 +19354,7 @@
                   space,
                   ign,
                   pad,
-                  1);
+                  1) /*<<camlinternalFormat.ml:2226:29>>*/ ;
         case 1:
         case 3:
          if(legacy_behavior$0){
@@ -19096,7 +19362,7 @@
             /*<<camlinternalFormat.ml:2249:6>>*/ _ba_ = str_ind$0 + 1 | 0,
            minus$0 = minus || (45 === symb$0 ? 1 : 0);
            /*<<camlinternalFormat.ml:2249:6>>*/ return parse_literal
-                  (minus$0, _ba_);
+                  (minus$0, _ba_) /*<<camlinternalFormat.ml:2226:29>>*/ ;
          }
          break;
       }
@@ -19112,7 +19378,7 @@
                 ign,
                 pad,
                 _E_)
-             : invalid_format_without(str_ind$0 - 1 | 0, 46, cst_precision);
+             : invalid_format_without(str_ind$0 - 1 | 0, 46, cst_precision) /*<<camlinternalFormat.ml:2226:29>>*/ ;
      /*<<camlinternalFormat.ml:2226:29>>*/ }
     function parse_after_precision
     (pct_ind, str_ind, end_ind, minus, plus, hash, space, ign, pad, prec){
@@ -19132,22 +19398,22 @@
                prec,
                padprec,
                 /*<<camlinternalFormat.ml:2271:21>>*/ caml_string_get
-                (str, str_ind));
+                (str, str_ind)) /*<<camlinternalFormat.ml:2271:34>>*/ ;
       /*<<camlinternalFormat.ml:2271:34>>*/ }
      if(typeof pad !== "number")
-       /*<<camlinternalFormat.ml:2287:13>>*/ return parse_conv(pad);
+       /*<<camlinternalFormat.ml:2287:13>>*/ return parse_conv(pad) /*<<camlinternalFormat.ml:2287:27>>*/ ;
      if(typeof prec === "number" && ! prec)
-       /*<<camlinternalFormat.ml:2281:29>>*/ return parse_conv(0);
+       /*<<camlinternalFormat.ml:2281:29>>*/ return parse_conv(0) /*<<camlinternalFormat.ml:2287:27>>*/ ;
      if(minus){
       if(typeof prec === "number")
-        /*<<camlinternalFormat.ml:2285:33>>*/ return parse_conv(_F_);
+        /*<<camlinternalFormat.ml:2285:33>>*/ return parse_conv(_F_) /*<<camlinternalFormat.ml:2287:27>>*/ ;
       var n = prec[1];
-       /*<<camlinternalFormat.ml:2283:46>>*/ return parse_conv([0, 0, n]);
+       /*<<camlinternalFormat.ml:2283:46>>*/ return parse_conv([0, 0, n]) /*<<camlinternalFormat.ml:2287:27>>*/ ;
      }
      if(typeof prec === "number")
-       /*<<camlinternalFormat.ml:2284:34>>*/ return parse_conv(_G_);
+       /*<<camlinternalFormat.ml:2284:34>>*/ return parse_conv(_G_) /*<<camlinternalFormat.ml:2287:27>>*/ ;
      var n$0 = prec[1];
-      /*<<camlinternalFormat.ml:2282:47>>*/ return parse_conv([0, 1, n$0]);
+      /*<<camlinternalFormat.ml:2282:47>>*/ return parse_conv([0, 1, n$0]) /*<<camlinternalFormat.ml:2287:27>>*/ ;
      /*<<camlinternalFormat.ml:2287:27>>*/ }
     function parse_conversion
     (pct_ind,
@@ -19170,7 +19436,7 @@
        /*<<camlinternalFormat.ml:2297:48>>*/ prec_used = [0, 0];
      function get_plus(param){
        /*<<camlinternalFormat.ml:2300:25>>*/ plus_used[1] = 1;
-       /*<<camlinternalFormat.ml:2300:4>>*/ return plus;
+       /*<<camlinternalFormat.ml:2300:4>>*/ return plus /*<<camlinternalFormat.ml:2300:4>>*/ ;
       /*<<camlinternalFormat.ml:2300:49>>*/ }
      function get_hash(param){
        /*<<camlinternalFormat.ml:2301:24>>*/ hash_used[1] = 1;
@@ -19201,64 +19467,66 @@
         /*<<camlinternalFormat.ml:2320:13>>*/ pad = get_pad(0),
         /*<<camlinternalFormat.ml:2320:25>>*/ match = get_prec(0);
       if(typeof match === "number" && ! match)
-        /*<<camlinternalFormat.ml:2321:32>>*/ return pad;
+        /*<<camlinternalFormat.ml:2321:32>>*/ return pad /*<<camlinternalFormat.ml:2321:32>>*/ ;
       if(typeof pad === "number")
-        /*<<camlinternalFormat.ml:2322:32>>*/ return 0;
+        /*<<camlinternalFormat.ml:2322:32>>*/ return 0 /*<<camlinternalFormat.ml:2322:32>>*/ ;
       if(0 !== pad[0])
        return 2 <= pad[1]
                ? legacy_behavior$0
                  ? _H_
                  : incompatible_flag(pct_ind, str_ind, 48, cst_precision$1)
-               : pad;
-      if(2 > pad[1])  /*<<camlinternalFormat.ml:2329:38>>*/ return pad;
+               : pad /*<<camlinternalFormat.ml:2330:41>>*/ ;
+      if(2 > pad[1])
+        /*<<camlinternalFormat.ml:2329:38>>*/ return pad /*<<camlinternalFormat.ml:2329:38>>*/ ;
       var n = pad[2];
        /*<<camlinternalFormat.ml:2324:11>>*/ return legacy_behavior$0
               ? [0, 1, n]
-              : incompatible_flag(pct_ind, str_ind, 48, cst_precision$0);
+              : incompatible_flag(pct_ind, str_ind, 48, cst_precision$0) /*<<camlinternalFormat.ml:2330:41>>*/ ;
       /*<<camlinternalFormat.ml:2330:41>>*/ }
      function check_no_0(symb, pad){
        /*<<camlinternalFormat.ml:2334:6>>*/ if(typeof pad === "number")
-        /*<<camlinternalFormat.ml:2335:22>>*/ return pad;
+        /*<<camlinternalFormat.ml:2335:22>>*/ return pad /*<<camlinternalFormat.ml:2335:22>>*/ ;
       if(0 !== pad[0])
        return 2 <= pad[1]
                ? legacy_behavior$0
                  ? _I_
                  : incompatible_flag(pct_ind, str_ind, symb, cst_0$1)
-               : pad;
-      if(2 > pad[1])  /*<<camlinternalFormat.ml:2336:43>>*/ return pad;
+               : pad /*<<camlinternalFormat.ml:2343:55>>*/ ;
+      if(2 > pad[1])
+        /*<<camlinternalFormat.ml:2336:43>>*/ return pad /*<<camlinternalFormat.ml:2336:43>>*/ ;
       var width = pad[2];
        /*<<camlinternalFormat.ml:2339:8>>*/ return legacy_behavior$0
               ? [0, 1, width]
-              : incompatible_flag(pct_ind, str_ind, symb, cst_0$0);
+              : incompatible_flag(pct_ind, str_ind, symb, cst_0$0) /*<<camlinternalFormat.ml:2343:55>>*/ ;
       /*<<camlinternalFormat.ml:2343:55>>*/ }
      function opt_of_pad(c, pad){
        /*<<camlinternalFormat.ml:2349:64>>*/ if(typeof pad === "number")
-        /*<<camlinternalFormat.ml:2350:22>>*/ return 0;
+        /*<<camlinternalFormat.ml:2350:22>>*/ return 0 /*<<camlinternalFormat.ml:2350:22>>*/ ;
       if(0 === pad[0])
        switch(pad[1]){
          case 0:
           var width = pad[2];
            /*<<camlinternalFormat.ml:2356:8>>*/ return legacy_behavior$0
                   ? [0, width]
-                  : incompatible_flag(pct_ind, str_ind, c, cst$24);
+                  : incompatible_flag(pct_ind, str_ind, c, cst$24) /*<<camlinternalFormat.ml:2358:66>>*/ ;
          case 1:
           var width$0 = pad[2];
-           /*<<camlinternalFormat.ml:2351:38>>*/ return [0, width$0];
+           /*<<camlinternalFormat.ml:2351:38>>*/ return [0, width$0] /*<<camlinternalFormat.ml:2351:38>>*/ ;
          default:
           var width$1 = pad[2];
            /*<<camlinternalFormat.ml:2353:8>>*/ return legacy_behavior$0
                   ? [0, width$1]
-                  : incompatible_flag(pct_ind, str_ind, c, cst_0$2);
+                  : incompatible_flag(pct_ind, str_ind, c, cst_0$2) /*<<camlinternalFormat.ml:2358:66>>*/ ;
        }
        /*<<camlinternalFormat.ml:2358:25>>*/ return incompatible_flag
-              (pct_ind, str_ind, c, cst$25);
+              (pct_ind, str_ind, c, cst$25) /*<<camlinternalFormat.ml:2358:66>>*/ ;
       /*<<camlinternalFormat.ml:2358:66>>*/ }
      function get_pad_opt(c){
-       /*<<camlinternalFormat.ml:2360:24>>*/ return opt_of_pad(c, get_pad(0));
+       /*<<camlinternalFormat.ml:2360:24>>*/ return opt_of_pad(c, get_pad(0)) /*<<camlinternalFormat.ml:2360:49>>*/ ;
       /*<<camlinternalFormat.ml:2360:49>>*/ }
      function get_padprec_opt(c){
        /*<<camlinternalFormat.ml:2361:28>>*/ return opt_of_pad
-              (c, get_padprec(0));
+              (c, get_padprec(0)) /*<<camlinternalFormat.ml:2361:57>>*/ ;
       /*<<camlinternalFormat.ml:2361:57>>*/ }
      a:
      {
@@ -19350,7 +19618,7 @@
            fail_single_percent =
              function(str_ind){
                /*<<camlinternalFormat.ml:2730:6>>*/ return  /*<<camlinternalFormat.ml:2730:6>>*/ caml_call2
-                      (failwith_message(_R_), str, str_ind);
+                      (failwith_message(_R_), str, str_ind) /*<<camlinternalFormat.ml:2732:54>>*/ ;
               /*<<camlinternalFormat.ml:2732:54>>*/ },
            parse_char_set_content =
              function(counter, str_ind, end_ind){
@@ -19366,14 +19634,14 @@
                if(45 !== c){
                 if(93 === c)
                   /*<<camlinternalFormat.ml:2746:8>>*/ return str_ind$0 + 1
-                        | 0;
+                        | 0 /*<<camlinternalFormat.ml:2746:8>>*/ ;
                 var _a__ = str_ind$0 + 1 | 0;
                  /*<<camlinternalFormat.ml:2751:8>>*/ if(counter >= 50)
                   /*<<camlinternalFormat.ml:2751:8>>*/ return  /*<<camlinternalFormat.ml:2751:8>>*/ caml_trampoline_return
-                         (parse_char_set_after_char$0, [0, _a__, end_ind, c]);
+                         (parse_char_set_after_char$0, [0, _a__, end_ind, c]) /*<<camlinternalFormat.ml:2751:57>>*/ ;
                 var counter$0 = counter + 1 | 0;
                  /*<<camlinternalFormat.ml:2751:8>>*/ return parse_char_set_after_char$0
-                        (counter$0, _a__, end_ind, c);
+                        (counter$0, _a__, end_ind, c) /*<<camlinternalFormat.ml:2751:57>>*/ ;
                }
                 /*<<camlinternalFormat.ml:2721:6>>*/ add_in_char_set
                 (char_set, 45);
@@ -19402,7 +19670,7 @@
                    /*<<camlinternalFormat.ml:2721:6>>*/ add_in_char_set
                    (char_set, c$0);
                    /*<<camlinternalFormat.ml:2758:8>>*/ return str_ind$0 + 1
-                         | 0;
+                         | 0 /*<<camlinternalFormat.ml:2758:8>>*/ ;
                  }
                 }
                 else if(37 !== c$1){
@@ -19425,15 +19693,15 @@
                       (str, str_ind$2 + 1 | 0);
                   if(37 !== c$3 && 64 !== c$3)
                     /*<<camlinternalFormat.ml:2787:17>>*/ return fail_single_percent
-                           (str_ind$2);
+                           (str_ind$2) /*<<camlinternalFormat.ml:2771:58>>*/ ;
                    /*<<camlinternalFormat.ml:2785:12>>*/ add_range(c$0, c$3);
                   var _a8_ = str_ind$2 + 2 | 0;
                    /*<<camlinternalFormat.ml:2785:12>>*/ if(counter >= 50)
                     /*<<camlinternalFormat.ml:2785:12>>*/ return  /*<<camlinternalFormat.ml:2785:12>>*/ caml_trampoline_return
-                           (parse_char_set_content, [0, _a8_, end_ind]);
+                           (parse_char_set_content, [0, _a8_, end_ind]) /*<<camlinternalFormat.ml:2771:58>>*/ ;
                   var counter$1 = counter + 1 | 0;
                    /*<<camlinternalFormat.ml:2785:12>>*/ return parse_char_set_content
-                          (counter$1, _a8_, end_ind);
+                          (counter$1, _a8_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
                  }
                  if(93 === c$2){
                    /*<<camlinternalFormat.ml:2721:6>>*/ add_in_char_set
@@ -19441,16 +19709,16 @@
                    /*<<camlinternalFormat.ml:2721:6>>*/ add_in_char_set
                    (char_set, 45);
                    /*<<camlinternalFormat.ml:2779:8>>*/ return str_ind$2 + 1
-                         | 0;
+                         | 0 /*<<camlinternalFormat.ml:2779:8>>*/ ;
                  }
                   /*<<camlinternalFormat.ml:2790:8>>*/ add_range(c$0, c$2);
                  var _a9_ = str_ind$2 + 1 | 0;
                   /*<<camlinternalFormat.ml:2790:8>>*/ if(counter >= 50)
                    /*<<camlinternalFormat.ml:2790:8>>*/ return  /*<<camlinternalFormat.ml:2790:8>>*/ caml_trampoline_return
-                          (parse_char_set_content, [0, _a9_, end_ind]);
+                          (parse_char_set_content, [0, _a9_, end_ind]) /*<<camlinternalFormat.ml:2771:58>>*/ ;
                  var counter$0 = counter + 1 | 0;
                   /*<<camlinternalFormat.ml:2790:8>>*/ return parse_char_set_content
-                         (counter$0, _a9_, end_ind);
+                         (counter$0, _a9_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
                 }
                 if(37 === c$0){
                   /*<<camlinternalFormat.ml:2721:6>>*/ add_in_char_set
@@ -19458,10 +19726,10 @@
                  var _a7_ = str_ind$0 + 1 | 0;
                   /*<<camlinternalFormat.ml:2763:8>>*/ if(counter >= 50)
                    /*<<camlinternalFormat.ml:2763:8>>*/ return  /*<<camlinternalFormat.ml:2763:8>>*/ caml_trampoline_return
-                          (parse_char_set_content, [0, _a7_, end_ind]);
+                          (parse_char_set_content, [0, _a7_, end_ind]) /*<<camlinternalFormat.ml:2771:58>>*/ ;
                  var counter$2 = counter + 1 | 0;
                   /*<<camlinternalFormat.ml:2763:8>>*/ return parse_char_set_content
-                         (counter$2, _a7_, end_ind);
+                         (counter$2, _a7_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
                 }
                }
                if(37 === c$0)
@@ -19527,7 +19795,7 @@
              function(fmt_rest){
                /*<<camlinternalFormat.ml:2377:8>>*/ return get_ign(0)
                       ? [0, [23, 0, fmt_rest]]
-                      : [0, [0, fmt_rest]];
+                      : [0, [0, fmt_rest]] /*<<camlinternalFormat.ml:2379:36>>*/ ;
               /*<<camlinternalFormat.ml:2379:36>>*/ },
            fmt_rest$21 = parse(str_ind, end_ind)[1],
             /*<<camlinternalFormat.ml:2387:18>>*/ match$7 = get_pad_opt(99);
@@ -19949,7 +20217,7 @@
        /*<<camlinternalFormat.ml:2584:10>>*/ incompatible_flag
        (pct_ind, str_ind, symb, cst$31);
      }
-      /*<<camlinternalFormat.ml:2584:10>>*/ return fmt_result;
+      /*<<camlinternalFormat.ml:2584:10>>*/ return fmt_result /*<<camlinternalFormat.ml:2584:10>>*/ ;
     }
     function parse_tag(is_open_tag, str_ind, end_ind){
       /*<<camlinternalFormat.ml:2639:4>>*/ try{
@@ -19981,7 +20249,7 @@
          is_open_tag ? [0, sub_format$0] : [1, sub_format$0],
         /*<<camlinternalFormat.ml:2651:8>>*/ _ai_ =
          [0, [18, formatting$0, fmt_rest$0]];
-       /*<<camlinternalFormat.ml:2651:8>>*/ return _ai_;
+       /*<<camlinternalFormat.ml:2651:8>>*/ return _ai_ /*<<camlinternalFormat.ml:2651:8>>*/ ;
      }
      catch(_aj_){
       var _ah_ = caml_wrap_exception(_aj_);
@@ -19991,7 +20259,7 @@
         /*<<camlinternalFormat.ml:2657:6>>*/ formatting =
          is_open_tag ? [0, sub_format] : [1, sub_format];
        /*<<camlinternalFormat.ml:2659:6>>*/ return [0,
-              [18, formatting, fmt_rest]];
+              [18, formatting, fmt_rest]] /*<<camlinternalFormat.ml:2659:6>>*/ ;
      }
      /*<<camlinternalFormat.ml:2659:53>>*/ }
     function parse_spaces(str_ind, end_ind){
@@ -20004,7 +20272,7 @@
        (32
         !==
           /*<<camlinternalFormat.ml:2805:7>>*/ caml_string_get(str, str_ind$0))
-        /*<<camlinternalFormat.ml:2805:72>>*/ return str_ind$0;
+        /*<<camlinternalFormat.ml:2805:72>>*/ return str_ind$0 /*<<camlinternalFormat.ml:2805:72>>*/ ;
       var str_ind$1 = str_ind$0 + 1 | 0;
       str_ind$0 = str_ind$1;
      }
@@ -20022,13 +20290,13 @@
           /*<<camlinternalFormat.ml:2811:10>>*/ caml_string_get
           (str, str_ind$0);
       if(9 < c - 48 >>> 0)
-        /*<<camlinternalFormat.ml:2820:11>>*/ return [0, str_ind$0, acc$0];
+        /*<<camlinternalFormat.ml:2820:11>>*/ return [0, str_ind$0, acc$0] /*<<camlinternalFormat.ml:2820:11>>*/ ;
       var new_acc = (acc$0 * 10 | 0) + (c - 48 | 0) | 0;
       if(Stdlib_Sys[12] < new_acc){
         /*<<camlinternalFormat.ml:2815:8>>*/  /*<<camlinternalFormat.ml:2815:8>>*/ var
         _ag_ = Stdlib_Sys[12];
         /*<<camlinternalFormat.ml:2815:8>>*/ return  /*<<camlinternalFormat.ml:2815:8>>*/ caml_call3
-               (failwith_message(_S_), str, new_acc, _ag_);
+               (failwith_message(_S_), str, new_acc, _ag_) /*<<camlinternalFormat.ml:2820:23>>*/ ;
       }
       var str_ind$1 = str_ind$0 + 1 | 0;
       str_ind$0 = str_ind$1;
@@ -20045,7 +20313,7 @@
      if(48 <= match){
       if(58 > match)
         /*<<camlinternalFormat.ml:2827:20>>*/ return parse_positive
-               (str_ind, end_ind, 0);
+               (str_ind, end_ind, 0) /*<<camlinternalFormat.ml:2837:23>>*/ ;
      }
      else if(45 === match){
       if((str_ind + 1 | 0) === end_ind)
@@ -20057,13 +20325,13 @@
           (str, str_ind + 1 | 0);
       if(9 < c - 48 >>> 0)
         /*<<camlinternalFormat.ml:2835:8>>*/ return expected_character
-               (str_ind + 1 | 0, cst_digit, c);
+               (str_ind + 1 | 0, cst_digit, c) /*<<camlinternalFormat.ml:2837:23>>*/ ;
        /*<<camlinternalFormat.ml:2832:26>>*/ var
         /*<<camlinternalFormat.ml:2832:26>>*/ match$0 =
          parse_positive(str_ind + 1 | 0, end_ind, 0),
        n = match$0[2],
        next_ind = match$0[1];
-       /*<<camlinternalFormat.ml:2833:8>>*/ return [0, next_ind, - n | 0];
+       /*<<camlinternalFormat.ml:2833:8>>*/ return [0, next_ind, - n | 0] /*<<camlinternalFormat.ml:2833:8>>*/ ;
      }
       /*<<camlinternalFormat.ml:2837:11>>*/ throw  /*<<camlinternalFormat.ml:2837:11>>*/ caml_maybe_attach_backtrace
             ([0, Assert_failure, _T_], 1);
@@ -20084,7 +20352,7 @@
                  [11,
                    /*<<camlinternalFormat.ml:2846:39>>*/ caml_call3
                    (Stdlib_String[16], str, lit_start, size),
-                  fmt]];
+                  fmt]] /*<<camlinternalFormat.ml:2846:75>>*/ ;
      /*<<camlinternalFormat.ml:2846:75>>*/ }
     function search_subformat_end(str_ind, end_ind, c){
       /*<<camlinternalFormat.ml:2851:4>>*/ var str_ind$0 = str_ind;
@@ -20104,7 +20372,7 @@
         ( /*<<camlinternalFormat.ml:2858:9>>*/ caml_string_get
           (str, str_ind$0 + 1 | 0)
          === c)
-         /*<<camlinternalFormat.ml:2858:62>>*/ return str_ind$0;
+         /*<<camlinternalFormat.ml:2858:62>>*/ return str_ind$0 /*<<camlinternalFormat.ml:2858:62>>*/ ;
         /*<<camlinternalFormat.ml:2859:20>>*/  /*<<camlinternalFormat.ml:2859:20>>*/ var
         match =
            /*<<camlinternalFormat.ml:2859:20>>*/ caml_string_get
@@ -20124,7 +20392,7 @@
             case 1: break;
             default:
               /*<<camlinternalFormat.ml:2882:10>>*/ return expected_character
-                     (str_ind$0 + 1 | 0, cst_character, 125);
+                     (str_ind$0 + 1 | 0, cst_character, 125) /*<<camlinternalFormat.ml:2889:55>>*/ ;
           }
         }
         else if(96 > match){
@@ -20169,7 +20437,7 @@
         }
         if(41 === match)
           /*<<camlinternalFormat.ml:2885:10>>*/ return expected_character
-                 (str_ind$0 + 1 | 0, cst_character$0, 41);
+                 (str_ind$0 + 1 | 0, cst_character$0, 41) /*<<camlinternalFormat.ml:2889:55>>*/ ;
        }
        var str_ind$1 = str_ind$0 + 2 | 0;
        str_ind$0 = str_ind$1;
@@ -20188,33 +20456,37 @@
        if(plus$0){
         if(! hash$0){
          if(space$0) break a;
-         if(100 === symb)  /*<<camlinternalFormat.ml:2906:34>>*/ return 1;
-         if(105 === symb)  /*<<camlinternalFormat.ml:2906:71>>*/ return 4;
+         if(100 === symb)
+           /*<<camlinternalFormat.ml:2906:34>>*/ return 1 /*<<camlinternalFormat.ml:2906:34>>*/ ;
+         if(105 === symb)
+           /*<<camlinternalFormat.ml:2906:71>>*/ return 4 /*<<camlinternalFormat.ml:2906:71>>*/ ;
          break a;
         }
        }
        else{
         if(! hash$0){
          if(space$0){
-          if(100 === symb)  /*<<camlinternalFormat.ml:2905:34>>*/ return 2;
-          if(105 === symb)  /*<<camlinternalFormat.ml:2905:71>>*/ return 5;
+          if(100 === symb)
+            /*<<camlinternalFormat.ml:2905:34>>*/ return 2 /*<<camlinternalFormat.ml:2905:34>>*/ ;
+          if(105 === symb)
+            /*<<camlinternalFormat.ml:2905:71>>*/ return 5 /*<<camlinternalFormat.ml:2905:71>>*/ ;
           break a;
          }
          var switcher$1 = symb - 88 | 0;
          if(32 < switcher$1 >>> 0) break a;
          switch(switcher$1){
            case 0:
-             /*<<camlinternalFormat.ml:2907:71>>*/ return 8;
+             /*<<camlinternalFormat.ml:2907:71>>*/ return 8 /*<<camlinternalFormat.ml:2907:71>>*/ ;
            case 12:
-             /*<<camlinternalFormat.ml:2904:34>>*/ return 0;
+             /*<<camlinternalFormat.ml:2904:34>>*/ return 0 /*<<camlinternalFormat.ml:2904:34>>*/ ;
            case 17:
-             /*<<camlinternalFormat.ml:2904:71>>*/ return 3;
+             /*<<camlinternalFormat.ml:2904:71>>*/ return 3 /*<<camlinternalFormat.ml:2904:71>>*/ ;
            case 23:
-             /*<<camlinternalFormat.ml:2909:34>>*/ return 10;
+             /*<<camlinternalFormat.ml:2909:34>>*/ return 10 /*<<camlinternalFormat.ml:2909:34>>*/ ;
            case 29:
-             /*<<camlinternalFormat.ml:2911:34>>*/ return 12;
+             /*<<camlinternalFormat.ml:2911:34>>*/ return 12 /*<<camlinternalFormat.ml:2911:34>>*/ ;
            case 32:
-             /*<<camlinternalFormat.ml:2907:34>>*/ return 6;
+             /*<<camlinternalFormat.ml:2907:34>>*/ return 6 /*<<camlinternalFormat.ml:2907:34>>*/ ;
            default: break a;
          }
         }
@@ -20223,17 +20495,17 @@
          if(32 >= switcher$0 >>> 0)
           switch(switcher$0){
             case 0:
-              /*<<camlinternalFormat.ml:2908:71>>*/ return 9;
+              /*<<camlinternalFormat.ml:2908:71>>*/ return 9 /*<<camlinternalFormat.ml:2908:71>>*/ ;
             case 12:
-              /*<<camlinternalFormat.ml:2912:34>>*/ return 13;
+              /*<<camlinternalFormat.ml:2912:34>>*/ return 13 /*<<camlinternalFormat.ml:2912:34>>*/ ;
             case 17:
-              /*<<camlinternalFormat.ml:2913:34>>*/ return 14;
+              /*<<camlinternalFormat.ml:2913:34>>*/ return 14 /*<<camlinternalFormat.ml:2913:34>>*/ ;
             case 23:
-              /*<<camlinternalFormat.ml:2910:34>>*/ return 11;
+              /*<<camlinternalFormat.ml:2910:34>>*/ return 11 /*<<camlinternalFormat.ml:2910:34>>*/ ;
             case 29:
-              /*<<camlinternalFormat.ml:2914:34>>*/ return 15;
+              /*<<camlinternalFormat.ml:2914:34>>*/ return 15 /*<<camlinternalFormat.ml:2914:34>>*/ ;
             case 32:
-              /*<<camlinternalFormat.ml:2908:34>>*/ return 7;
+              /*<<camlinternalFormat.ml:2908:34>>*/ return 7 /*<<camlinternalFormat.ml:2908:34>>*/ ;
           }
         }
        }
@@ -20242,22 +20514,22 @@
         switch(switcher){
           case 0:
            if(legacy_behavior$0)
-             /*<<camlinternalFormat.ml:2916:46>>*/ return 9;
+             /*<<camlinternalFormat.ml:2916:46>>*/ return 9 /*<<camlinternalFormat.ml:2916:46>>*/ ;
            break;
           case 23:
            if(legacy_behavior$0)
-             /*<<camlinternalFormat.ml:2917:46>>*/ return 11;
+             /*<<camlinternalFormat.ml:2917:46>>*/ return 11 /*<<camlinternalFormat.ml:2917:46>>*/ ;
            break;
           case 32:
            if(legacy_behavior$0)
-             /*<<camlinternalFormat.ml:2915:46>>*/ return 7;
+             /*<<camlinternalFormat.ml:2915:46>>*/ return 7 /*<<camlinternalFormat.ml:2915:46>>*/ ;
            break;
           case 12:
           case 17:
           case 29:
            if(! legacy_behavior$0)
              /*<<camlinternalFormat.ml:2921:11>>*/ return incompatible_flag
-                    (pct_ind, str_ind, symb, cst$35);
+                    (pct_ind, str_ind, symb, cst$35) /*<<camlinternalFormat.ml:2935:40>>*/ ;
            hash$0 = 0;
            continue;
         }
@@ -20266,13 +20538,13 @@
        if(space$0){
         if(! legacy_behavior$0)
           /*<<camlinternalFormat.ml:2926:11>>*/ return incompatible_flag
-                 (pct_ind, str_ind, 32, cst$32);
+                 (pct_ind, str_ind, 32, cst$32) /*<<camlinternalFormat.ml:2935:40>>*/ ;
         space$0 = 0;
        }
        else{
         if(! legacy_behavior$0)
           /*<<camlinternalFormat.ml:2934:11>>*/ return incompatible_flag
-                 (pct_ind, str_ind, symb, cst$33);
+                 (pct_ind, str_ind, symb, cst$33) /*<<camlinternalFormat.ml:2935:40>>*/ ;
         plus$0 = 0;
        }
       else{
@@ -20281,7 +20553,7 @@
                ([0, Assert_failure, _W_], 1);
        if(! legacy_behavior$0)
          /*<<camlinternalFormat.ml:2930:11>>*/ return incompatible_flag
-                (pct_ind, str_ind, symb, cst$34);
+                (pct_ind, str_ind, symb, cst$34) /*<<camlinternalFormat.ml:2935:40>>*/ ;
        space$0 = 0;
       }
      }
@@ -20292,7 +20564,7 @@
          /*<<camlinternalFormat.ml:2963:19>>*/ caml_call3
          (Stdlib_String[16], str, pct_ind, str_ind - pct_ind | 0);
       /*<<camlinternalFormat.ml:2964:6>>*/ return  /*<<camlinternalFormat.ml:2964:6>>*/ caml_call5
-             (failwith_message(_Y_), str, pct_ind, option, symb, subfmt);
+             (failwith_message(_Y_), str, pct_ind, option, symb, subfmt) /*<<camlinternalFormat.ml:2967:38>>*/ ;
      /*<<camlinternalFormat.ml:2967:38>>*/ }
     return parse(0, caml_ml_string_length(str));
    }
@@ -20302,7 +20574,7 @@
      /*<<camlinternalFormat.ml:2978:2>>*/ try{
       /*<<camlinternalFormat.ml:2978:6>>*/  /*<<camlinternalFormat.ml:2978:6>>*/ var
       _ae_ = [0, type_format(fmt, fmtty), str];
-      /*<<camlinternalFormat.ml:2978:6>>*/ return _ae_;
+      /*<<camlinternalFormat.ml:2978:6>>*/ return _ae_ /*<<camlinternalFormat.ml:2978:6>>*/ ;
     }
     catch(_af_){
      var _ac_ = caml_wrap_exception(_af_);
@@ -20310,7 +20582,7 @@
       /*<<camlinternalFormat.ml:2982:10>>*/  /*<<camlinternalFormat.ml:2982:10>>*/ var
       _ad_ = string_of_fmtty(fmtty);
       /*<<camlinternalFormat.ml:2982:10>>*/ return  /*<<camlinternalFormat.ml:2982:10>>*/ caml_call2
-             (failwith_message(_Z_), str, _ad_);
+             (failwith_message(_Z_), str, _ad_) /*<<camlinternalFormat.ml:2982:33>>*/ ;
     }
     /*<<camlinternalFormat.ml:2982:33>>*/ }
    function format_of_string_format(str, param){
@@ -20321,13 +20593,13 @@
      /*<<camlinternalFormat.ml:2988:2>>*/ try{
       /*<<camlinternalFormat.ml:2988:6>>*/  /*<<camlinternalFormat.ml:2988:6>>*/ var
       _aa_ = [0, type_format(fmt$0, fmtty_of_fmt(fmt)), str];
-      /*<<camlinternalFormat.ml:2988:6>>*/ return _aa_;
+      /*<<camlinternalFormat.ml:2988:6>>*/ return _aa_ /*<<camlinternalFormat.ml:2988:6>>*/ ;
     }
     catch(_ab_){
      var _$_ = caml_wrap_exception(_ab_);
      if(_$_ === Type_mismatch)
        /*<<camlinternalFormat.ml:2990:4>>*/ return  /*<<camlinternalFormat.ml:2990:4>>*/ caml_call2
-              (failwith_message(___), str, str$0);
+              (failwith_message(___), str, str$0) /*<<camlinternalFormat.ml:2990:4>>*/ ;
      throw caml_maybe_attach_backtrace(_$_, 0);
     }
    }
@@ -20395,10 +20667,10 @@
              function(acc){
                /*<<printf.ml:20:26>>*/  /*<<printf.ml:20:26>>*/ caml_call2
                (CamlinternalFormat[9], o, acc);
-              return caml_call1(k, o);
+              return caml_call1(k, o) /*<<printf.ml:20:47>>*/ ;
               /*<<printf.ml:20:47>>*/ },
              0,
-             fmt);
+             fmt) /*<<printf.ml:20:2>>*/ ;
    }
    function kbprintf(k, b, param){
     var fmt = param[1];
@@ -20407,37 +20679,37 @@
              function(acc){
                /*<<printf.ml:22:26>>*/  /*<<printf.ml:22:26>>*/ caml_call2
                (CamlinternalFormat[10], b, acc);
-              return caml_call1(k, b);
+              return caml_call1(k, b) /*<<printf.ml:22:47>>*/ ;
               /*<<printf.ml:22:47>>*/ },
              0,
-             fmt);
+             fmt) /*<<printf.ml:22:2>>*/ ;
    }
    function ikfprintf(k, oc, param){
     var fmt = param[1];
      /*<<printf.ml:24:2>>*/ return  /*<<printf.ml:24:2>>*/ caml_call3
-            (CamlinternalFormat[8], k, oc, fmt);
+            (CamlinternalFormat[8], k, oc, fmt) /*<<printf.ml:24:2>>*/ ;
    }
    function fprintf(oc, fmt){
      /*<<printf.ml:27:21>>*/ return kfprintf
-            (function(_d_){ /*<<?>>*/ return 0;}, oc, fmt);
+            (function(_d_){ /*<<?>>*/ return 0;}, oc, fmt) /*<<printf.ml:27:43>>*/ ;
     /*<<printf.ml:27:43>>*/ }
    function bprintf(b, fmt){
      /*<<printf.ml:28:20>>*/ return kbprintf
-            (function(_c_){ /*<<?>>*/ return 0;}, b, fmt);
+            (function(_c_){ /*<<?>>*/ return 0;}, b, fmt) /*<<printf.ml:28:41>>*/ ;
     /*<<printf.ml:28:41>>*/ }
    function ifprintf(oc, fmt){
      /*<<printf.ml:29:22>>*/ return ikfprintf
-            (function(_b_){ /*<<?>>*/ return 0;}, oc, fmt);
+            (function(_b_){ /*<<?>>*/ return 0;}, oc, fmt) /*<<printf.ml:29:45>>*/ ;
     /*<<printf.ml:29:45>>*/ }
    function ibprintf(b, fmt){
      /*<<printf.ml:30:21>>*/ return ikfprintf
-            (function(_a_){ /*<<?>>*/ return 0;}, b, fmt);
+            (function(_a_){ /*<<?>>*/ return 0;}, b, fmt) /*<<printf.ml:30:43>>*/ ;
     /*<<printf.ml:30:43>>*/ }
    function printf(fmt){
-     /*<<printf.ml:31:17>>*/ return fprintf(Stdlib[39], fmt);
+     /*<<printf.ml:31:17>>*/ return fprintf(Stdlib[39], fmt) /*<<printf.ml:31:35>>*/ ;
     /*<<printf.ml:31:35>>*/ }
    function eprintf(fmt){
-     /*<<printf.ml:32:18>>*/ return fprintf(Stdlib[40], fmt);
+     /*<<printf.ml:32:18>>*/ return fprintf(Stdlib[40], fmt) /*<<printf.ml:32:36>>*/ ;
     /*<<printf.ml:32:36>>*/ }
    function ksprintf(k, param){
     var fmt = param[1];
@@ -20447,17 +20719,17 @@
       /*<<printf.ml:37:4>>*/  /*<<printf.ml:37:4>>*/ caml_call2
       (CamlinternalFormat[11], buf, acc);
       /*<<printf.ml:38:6>>*/ return  /*<<printf.ml:38:6>>*/ caml_call1
-             (k,  /*<<printf.ml:38:6>>*/ caml_call1(Stdlib_Buffer[2], buf));
+             (k,  /*<<printf.ml:38:6>>*/ caml_call1(Stdlib_Buffer[2], buf)) /*<<printf.ml:38:27>>*/ ;
      /*<<printf.ml:38:27>>*/ }
      /*<<printf.ml:39:2>>*/ return  /*<<printf.ml:39:2>>*/ caml_call3
-            (CamlinternalFormat[7], k$0, 0, fmt);
+            (CamlinternalFormat[7], k$0, 0, fmt) /*<<printf.ml:39:2>>*/ ;
    }
    function sprintf(fmt){
      /*<<printf.ml:41:18>>*/ return ksprintf
             (function(s){
-               /*<<printf.ml:41:37>>*/ return s;
+               /*<<printf.ml:41:37>>*/ return s /*<<printf.ml:41:37>>*/ ;
               /*<<printf.ml:41:38>>*/ },
-             fmt);
+             fmt) /*<<printf.ml:41:43>>*/ ;
     /*<<printf.ml:41:43>>*/ }
    var
     Stdlib_Printf =
@@ -20644,11 +20916,11 @@
     cst_to_seq_rev = "to_seq_rev";
    function negative_length_requested(f, n){
      /*<<dynarray.ml:128:4>>*/ return  /*<<dynarray.ml:128:4>>*/ caml_call4
-            (Stdlib_Printf[10], Stdlib[1], _c_, f, n);
+            (Stdlib_Printf[10], Stdlib[1], _c_, f, n) /*<<dynarray.ml:130:9>>*/ ;
     /*<<dynarray.ml:130:9>>*/ }
    function negative_capacity_requested(f, n){
      /*<<dynarray.ml:133:4>>*/ return  /*<<dynarray.ml:133:4>>*/ caml_call4
-            (Stdlib_Printf[10], Stdlib[1], _d_, f, n);
+            (Stdlib_Printf[10], Stdlib[1], _d_, f, n) /*<<dynarray.ml:135:9>>*/ ;
     /*<<dynarray.ml:135:9>>*/ }
    function missing_element(i, length){
      /*<<dynarray.ml:152:4>>*/ return  /*<<dynarray.ml:152:4>>*/ caml_call5
@@ -20657,7 +20929,7 @@
              _f_,
              invalid_state_description,
              i,
-             length);
+             length) /*<<dynarray.ml:155:14>>*/ ;
     /*<<dynarray.ml:155:14>>*/ }
    function unexpected_empty_element(f, i, length){
      /*<<dynarray.ml:172:4>>*/ return i < length
@@ -20667,7 +20939,7 @@
               ?  /*<<dynarray.ml:119:6>>*/ caml_call4
                 (Stdlib_Printf[10], Stdlib[1], _a_, f, i)
               :  /*<<dynarray.ml:123:6>>*/ caml_call5
-                (Stdlib_Printf[10], Stdlib[1], _b_, f, i, length - 1 | 0);
+                (Stdlib_Printf[10], Stdlib[1], _b_, f, i, length - 1 | 0) /*<<dynarray.ml:175:38>>*/ ;
     /*<<dynarray.ml:175:38>>*/ }
    function check_same_length(f, a, expected){
      /*<<dynarray.ml:187:2>>*/ var
@@ -20676,7 +20948,7 @@
     return _W_
             ?  /*<<dynarray.ml:164:4>>*/ caml_call5
               (Stdlib_Printf[10], Stdlib[1], _h_, f, expected, length_a)
-            : _W_;
+            : _W_ /*<<dynarray.ml:190:41>>*/ ;
     /*<<dynarray.ml:190:41>>*/ }
    function check_valid_length(length, arr){
      /*<<dynarray.ml:197:2>>*/ var
@@ -20690,16 +20962,17 @@
                invalid_state_description,
                length,
                capacity)
-            : _V_;
+            : _V_ /*<<dynarray.ml:199:42>>*/ ;
     /*<<dynarray.ml:199:42>>*/ }
    function unsafe_get(arr, i, length){
      /*<<dynarray.ml:206:2>>*/ var match = arr[1 + i];
-    if(! match)  /*<<dynarray.ml:207:13>>*/ return missing_element(i, length);
+    if(! match)
+      /*<<dynarray.ml:207:13>>*/ return missing_element(i, length) /*<<dynarray.ml:208:17>>*/ ;
     var v = match[1];
-     /*<<dynarray.ml:208:16>>*/ return v;
+     /*<<dynarray.ml:208:16>>*/ return v /*<<dynarray.ml:208:16>>*/ ;
     /*<<dynarray.ml:208:17>>*/ }
    function create(param){
-     /*<<dynarray.ml:213:16>>*/ return [0, 0, [0]];
+     /*<<dynarray.ml:213:16>>*/ return [0, 0, [0]] /*<<dynarray.ml:213:16>>*/ ;
     /*<<dynarray.ml:216:1>>*/ }
    function make(n, x){
      /*<<dynarray.ml:219:2>>*/ if(n < 0)
@@ -20710,8 +20983,8 @@
              (Stdlib_Array[1],
               n,
               function(param){
-                /*<<dynarray.ml:222:33>>*/ return [0, x];
-               /*<<dynarray.ml:222:45>>*/ })];
+                /*<<dynarray.ml:222:33>>*/ return [0, x] /*<<dynarray.ml:222:38>>*/ ;
+               /*<<dynarray.ml:222:45>>*/ })] /*<<dynarray.ml:220:2>>*/ ;
     /*<<dynarray.ml:223:3>>*/ }
    function init(n, f){
      /*<<dynarray.ml:226:2>>*/ if(n < 0)
@@ -20723,20 +20996,20 @@
               n,
               function(i){
                 /*<<dynarray.ml:229:33>>*/ return [0,
-                        /*<<dynarray.ml:229:43>>*/ caml_call1(f, i)];
-               /*<<dynarray.ml:229:47>>*/ })];
+                        /*<<dynarray.ml:229:43>>*/ caml_call1(f, i)] /*<<dynarray.ml:229:38>>*/ ;
+               /*<<dynarray.ml:229:47>>*/ })] /*<<dynarray.ml:227:2>>*/ ;
     /*<<dynarray.ml:230:3>>*/ }
    function get(a, i){
      /*<<dynarray.ml:238:2>>*/  /*<<dynarray.ml:238:8>>*/ var
      match = caml_check_bound(a[2], i)[1 + i];
-    return match ? match[1] : unexpected_empty_element(cst_get, i, a[1]);
+    return match ? match[1] : unexpected_empty_element(cst_get, i, a[1]) /*<<dynarray.ml:241:62>>*/ ;
     /*<<dynarray.ml:241:62>>*/ }
    function set(a, i, x){
      /*<<dynarray.ml:246:2>>*/  /*<<dynarray.ml:246:8>>*/ var
      match = caml_check_bound(a[2], i)[1 + i];
     return match
             ? (match[1] = x, 0)
-            : unexpected_empty_element(cst_set, i, a[1]);
+            : unexpected_empty_element(cst_set, i, a[1]) /*<<dynarray.ml:249:62>>*/ ;
     /*<<dynarray.ml:249:62>>*/ }
    function length(a){
      /*<<dynarray.ml:251:15>>*/ return a[1];
@@ -20755,8 +21028,8 @@
               function(i){
                 /*<<dynarray.ml:262:6>>*/  /*<<dynarray.ml:262:14>>*/ var
                 v = unsafe_get(arr, i, length);
-                /*<<dynarray.ml:263:11>>*/ return [0, v];
-               /*<<dynarray.ml:263:14>>*/ })];
+                /*<<dynarray.ml:263:11>>*/ return [0, v] /*<<dynarray.ml:263:11>>*/ ;
+               /*<<dynarray.ml:263:14>>*/ })] /*<<dynarray.ml:259:2>>*/ ;
    }
    function get_last(a){
      /*<<dynarray.ml:268:2>>*/ var length = a[1], arr = a[2];
@@ -20764,12 +21037,12 @@
     if(0 === length)
       /*<<dynarray.ml:178:4>>*/  /*<<dynarray.ml:178:4>>*/ caml_call3
       (Stdlib_Printf[10], Stdlib[1], _i_, f);
-     /*<<dynarray.ml:271:21>>*/ return unsafe_get(arr, length - 1 | 0, length);
+     /*<<dynarray.ml:271:21>>*/ return unsafe_get(arr, length - 1 | 0, length) /*<<dynarray.ml:273:40>>*/ ;
     /*<<dynarray.ml:273:40>>*/ }
    function find_last(a){
      /*<<dynarray.ml:276:2>>*/ var length = a[1], arr = a[2];
      /*<<dynarray.ml:277:2>>*/ check_valid_length(length, arr);
-    return 0 === length ? 0 : [0, unsafe_get(arr, length - 1 | 0, length)];
+    return 0 === length ? 0 : [0, unsafe_get(arr, length - 1 | 0, length)] /*<<dynarray.ml:282:49>>*/ ;
     /*<<dynarray.ml:282:49>>*/ }
    function pop_last(a){
      /*<<dynarray.ml:287:2>>*/ var length = a[1], arr = a[2];
@@ -20782,7 +21055,7 @@
      match = arr[1 + last];
     return match
             ? (arr[1 + last] = 0, a[1] = last, match[1])
-            : missing_element(last, length);
+            : missing_element(last, length) /*<<dynarray.ml:299:9>>*/ ;
     /*<<dynarray.ml:299:9>>*/ }
    function pop_last_opt(a){
      /*<<dynarray.ml:302:2>>*/ try{
@@ -20791,10 +21064,11 @@
     }
     catch(_U_){
      var _T_ = caml_wrap_exception(_U_);
-     if(_T_ === Stdlib[8])  /*<<dynarray.ml:303:27>>*/ return 0;
+     if(_T_ === Stdlib[8])
+       /*<<dynarray.ml:303:27>>*/ return 0 /*<<dynarray.ml:303:27>>*/ ;
      throw caml_maybe_attach_backtrace(_T_, 0);
     }
-     /*<<dynarray.ml:304:9>>*/ return [0, x];
+     /*<<dynarray.ml:304:9>>*/ return [0, x] /*<<dynarray.ml:304:9>>*/ ;
     /*<<dynarray.ml:304:15>>*/ }
    function remove_last(a){
      /*<<dynarray.ml:307:2>>*/ var
@@ -20804,7 +21078,7 @@
        _R_
         ? (a[1] = last, caml_check_bound(a[2], last)[1 + last] = 0, 0)
         : _R_;
-     /*<<dynarray.ml:310:4>>*/ return _S_;
+     /*<<dynarray.ml:310:4>>*/ return _S_ /*<<dynarray.ml:310:4>>*/ ;
     /*<<dynarray.ml:311:5>>*/ }
    function truncate(a, n){
      /*<<dynarray.ml:314:2>>*/ if(n < 0)
@@ -20816,10 +21090,10 @@
                [1]
               = n,
                /*<<dynarray.ml:319:4>>*/ caml_call4
-               (Stdlib_Array[8], arr, n, length - n | 0, 0));
+               (Stdlib_Array[8], arr, n, length - n | 0, 0)) /*<<dynarray.ml:320:5>>*/ ;
     /*<<dynarray.ml:320:5>>*/ }
    function clear(a){
-     /*<<dynarray.ml:322:14>>*/ return truncate(a, 0);
+     /*<<dynarray.ml:322:14>>*/ return truncate(a, 0) /*<<dynarray.ml:322:26>>*/ ;
     /*<<dynarray.ml:322:26>>*/ }
    function capacity(a){
      /*<<dynarray.ml:327:17>>*/ return a[2].length - 1;
@@ -20830,8 +21104,9 @@
       /*<<dynarray.ml:349:2>>*/ cur_capacity = arr.length - 1;
      /*<<dynarray.ml:350:2>>*/ if(0 > capacity_request)
       /*<<dynarray.ml:351:4>>*/ return negative_capacity_requested
-             (cst_ensure_capacity, capacity_request);
-    if(capacity_request <= cur_capacity)  /*<<dynarray.ml:356:4>>*/ return 0;
+             (cst_ensure_capacity, capacity_request) /*<<dynarray.ml:382:5>>*/ ;
+    if(capacity_request <= cur_capacity)
+      /*<<dynarray.ml:356:4>>*/ return 0 /*<<dynarray.ml:356:4>>*/ ;
     if(Stdlib_Sys[13] < capacity_request)
       /*<<dynarray.ml:138:4>>*/  /*<<dynarray.ml:138:4>>*/ caml_call5
       (Stdlib_Printf[10],
@@ -20867,7 +21142,7 @@
     /*<<dynarray.ml:382:5>>*/ }
    function ensure_extra_capacity(a, extra_capacity_request){
      /*<<dynarray.ml:385:2>>*/ return ensure_capacity
-            (a, a[1] + extra_capacity_request | 0);
+            (a, a[1] + extra_capacity_request | 0) /*<<dynarray.ml:385:55>>*/ ;
     /*<<dynarray.ml:385:55>>*/ }
    function fit_capacity(a){
      /*<<dynarray.ml:388:2>>*/ var _N_ = a[1];
@@ -20878,7 +21153,7 @@
               =
                 /*<<dynarray.ml:390:16>>*/ caml_call3
                 (Stdlib_Array[6], a[2], 0, a[1]),
-              0);
+              0) /*<<dynarray.ml:390:42>>*/ ;
     /*<<dynarray.ml:390:42>>*/ }
    function set_capacity(a, n){
      /*<<dynarray.ml:393:2>>*/ if(n < 0)
@@ -20914,23 +21189,25 @@
      /*<<dynarray.ml:427:2>>*/ var length = a[1], arr = a[2];
     return arr.length - 1 <= length
             ? 0
-            : (a[1] = length + 1 | 0, arr[1 + length] = elem, 1);
+            : (a[1] = length + 1 | 0, arr[1 + length] = elem, 1) /*<<dynarray.ml:435:5>>*/ ;
     /*<<dynarray.ml:435:5>>*/ }
    function add_last(a, x){
      /*<<dynarray.ml:438:2>>*/  /*<<dynarray.ml:438:18>>*/ var elem = [0, x];
      /*<<dynarray.ml:439:5>>*/ if(add_last_if_room(a, elem))
-      /*<<dynarray.ml:439:34>>*/ return 0;
+      /*<<dynarray.ml:439:34>>*/ return 0 /*<<dynarray.ml:439:34>>*/ ;
      /*<<dynarray.ml:443:6>>*/ for(;;){
       /*<<dynarray.ml:443:6>>*/ ensure_extra_capacity(a, 1);
       /*<<dynarray.ml:444:13>>*/  /*<<dynarray.ml:444:13>>*/ var
       _K_ = 1 - add_last_if_room(a, elem);
-     if(! _K_)  /*<<dynarray.ml:444:13>>*/ return _K_;
+     if(! _K_)
+       /*<<dynarray.ml:444:13>>*/ return _K_ /*<<dynarray.ml:444:13>>*/ ;
     }
     /*<<dynarray.ml:447:5>>*/ }
    function append_list(a, li){
      /*<<dynarray.ml:450:2>>*/ var li$0 = li;
      /*<<dynarray.ml:450:2>>*/ for(;;){
-     if(! li$0)  /*<<dynarray.ml:451:10>>*/ return 0;
+     if(! li$0)
+       /*<<dynarray.ml:451:10>>*/ return 0 /*<<dynarray.ml:451:10>>*/ ;
      var xs = li$0[2], x = li$0[1];
       /*<<dynarray.ml:452:15>>*/ add_last(a, x);
      li$0 = xs;
@@ -20940,17 +21217,17 @@
      /*<<dynarray.ml:455:2>>*/ return  /*<<dynarray.ml:455:2>>*/ caml_call2
             (iter,
              function(x){
-               /*<<dynarray.ml:455:17>>*/ return add_last(a, x);
+               /*<<dynarray.ml:455:17>>*/ return add_last(a, x) /*<<dynarray.ml:455:29>>*/ ;
               /*<<dynarray.ml:455:29>>*/ },
-             b);
+             b) /*<<dynarray.ml:455:32>>*/ ;
     /*<<dynarray.ml:455:32>>*/ }
    function append_seq(a, seq){
      /*<<dynarray.ml:458:2>>*/ return  /*<<dynarray.ml:458:2>>*/ caml_call2
             (Stdlib_Seq[4],
              function(x){
-               /*<<dynarray.ml:458:21>>*/ return add_last(a, x);
+               /*<<dynarray.ml:458:21>>*/ return add_last(a, x) /*<<dynarray.ml:458:33>>*/ ;
               /*<<dynarray.ml:458:33>>*/ },
-             seq);
+             seq) /*<<dynarray.ml:458:38>>*/ ;
     /*<<dynarray.ml:458:38>>*/ }
    function append_array_if_room(a, b){
      /*<<dynarray.ml:463:2>>*/ var
@@ -20958,7 +21235,7 @@
      arr = a[2],
       /*<<dynarray.ml:464:2>>*/ length_b = b.length - 1;
     if(arr.length - 1 < (length_a + length_b | 0))
-      /*<<dynarray.ml:465:49>>*/ return 0;
+      /*<<dynarray.ml:465:49>>*/ return 0 /*<<dynarray.ml:465:49>>*/ ;
     a[1] = length_a + length_b | 0;
      /*<<dynarray.ml:464:2>>*/ var
       /*<<dynarray.ml:464:2>>*/ _I_ = length_b - 1 | 0,
@@ -20975,22 +21252,23 @@
       i = _J_;
      }
     }
-     /*<<dynarray.ml:499:4>>*/ return 1;
+     /*<<dynarray.ml:499:4>>*/ return 1 /*<<dynarray.ml:499:4>>*/ ;
     /*<<dynarray.ml:500:5>>*/ }
    function append_array(a, b){
      /*<<dynarray.ml:503:2>>*/ if(append_array_if_room(a, b))
-      /*<<dynarray.ml:503:35>>*/ return 0;
+      /*<<dynarray.ml:503:35>>*/ return 0 /*<<dynarray.ml:503:35>>*/ ;
      /*<<dynarray.ml:507:6>>*/ for(;;){
       /*<<dynarray.ml:507:6>>*/ ensure_extra_capacity(a, b.length - 1);
       /*<<dynarray.ml:508:13>>*/  /*<<dynarray.ml:508:13>>*/ var
       _G_ = 1 - append_array_if_room(a, b);
-     if(! _G_)  /*<<dynarray.ml:508:13>>*/ return _G_;
+     if(! _G_)
+       /*<<dynarray.ml:508:13>>*/ return _G_ /*<<dynarray.ml:508:13>>*/ ;
     }
     /*<<dynarray.ml:510:31>>*/ }
    function append_if_room(a, b, length_b){
      /*<<dynarray.ml:521:2>>*/ var length_a = a[1], arr_a = a[2];
     if(arr_a.length - 1 < (length_a + length_b | 0))
-      /*<<dynarray.ml:522:51>>*/ return 0;
+      /*<<dynarray.ml:522:51>>*/ return 0 /*<<dynarray.ml:522:51>>*/ ;
     a[1] = length_a + length_b | 0;
     var arr_b = b[2];
      /*<<dynarray.ml:526:4>>*/ check_valid_length(length_b, arr_b);
@@ -21010,18 +21288,19 @@
      }
     }
      /*<<dynarray.ml:531:4>>*/ check_same_length(cst_append, b, length_b);
-     /*<<dynarray.ml:531:4>>*/ return 1;
+     /*<<dynarray.ml:531:4>>*/ return 1 /*<<dynarray.ml:531:4>>*/ ;
     /*<<dynarray.ml:533:5>>*/ }
    function append(a, b){
      /*<<dynarray.ml:536:2>>*/ var length_b = b[1];
      /*<<dynarray.ml:537:5>>*/ if(append_if_room(a, b, length_b))
-      /*<<dynarray.ml:537:39>>*/ return 0;
+      /*<<dynarray.ml:537:39>>*/ return 0 /*<<dynarray.ml:537:39>>*/ ;
      /*<<dynarray.ml:541:6>>*/ for(;;){
       /*<<dynarray.ml:541:6>>*/ ensure_extra_capacity(a, length_b);
       /*<<dynarray.ml:548:6>>*/ check_same_length(cst_append$0, b, length_b);
       /*<<dynarray.ml:549:13>>*/  /*<<dynarray.ml:549:13>>*/ var
       _C_ = 1 - append_if_room(a, b, length_b);
-     if(! _C_)  /*<<dynarray.ml:549:13>>*/ return _C_;
+     if(! _C_)
+       /*<<dynarray.ml:549:13>>*/ return _C_ /*<<dynarray.ml:549:13>>*/ ;
     }
     /*<<dynarray.ml:552:5>>*/ }
    function iter(f, k, a){
@@ -21041,10 +21320,10 @@
       i = _B_;
      }
     }
-     /*<<dynarray.ml:600:2>>*/ return check_same_length(f, a, length);
+     /*<<dynarray.ml:600:2>>*/ return check_same_length(f, a, length) /*<<dynarray.ml:600:31>>*/ ;
     /*<<dynarray.ml:600:31>>*/ }
    function iter$0(k, a){
-     /*<<dynarray.ml:603:2>>*/ return iter(cst_iter, k, a);
+     /*<<dynarray.ml:603:2>>*/ return iter(cst_iter, k, a) /*<<dynarray.ml:603:18>>*/ ;
     /*<<dynarray.ml:603:18>>*/ }
    function iteri(k, a){
      /*<<dynarray.ml:606:2>>*/ var length = a[1], arr = a[2];
@@ -21063,7 +21342,7 @@
       i = _y_;
      }
     }
-     /*<<dynarray.ml:611:2>>*/ return check_same_length(cst_iteri, a, length);
+     /*<<dynarray.ml:611:2>>*/ return check_same_length(cst_iteri, a, length) /*<<dynarray.ml:611:37>>*/ ;
     /*<<dynarray.ml:611:37>>*/ }
    function map(f, a){
      /*<<dynarray.ml:614:2>>*/ var length = a[1], arr = a[2];
@@ -21078,10 +21357,10 @@
           function(i){
             /*<<dynarray.ml:619:6>>*/ return [0,
                     /*<<dynarray.ml:619:16>>*/ caml_call1
-                    (f, unsafe_get(arr, i, length))];
+                    (f, unsafe_get(arr, i, length))] /*<<dynarray.ml:619:11>>*/ ;
            /*<<dynarray.ml:619:46>>*/ })];
      /*<<dynarray.ml:621:2>>*/ check_same_length(cst_map, a, length);
-     /*<<dynarray.ml:621:2>>*/ return res;
+     /*<<dynarray.ml:621:2>>*/ return res /*<<dynarray.ml:621:2>>*/ ;
     /*<<dynarray.ml:622:5>>*/ }
    function mapi(f, a){
      /*<<dynarray.ml:626:2>>*/ var length = a[1], arr = a[2];
@@ -21096,10 +21375,10 @@
           function(i){
             /*<<dynarray.ml:631:6>>*/ return [0,
                     /*<<dynarray.ml:631:16>>*/ caml_call2
-                    (f, i, unsafe_get(arr, i, length))];
+                    (f, i, unsafe_get(arr, i, length))] /*<<dynarray.ml:631:11>>*/ ;
            /*<<dynarray.ml:631:48>>*/ })];
      /*<<dynarray.ml:633:2>>*/ check_same_length(cst_mapi, a, length);
-     /*<<dynarray.ml:633:2>>*/ return res;
+     /*<<dynarray.ml:633:2>>*/ return res /*<<dynarray.ml:633:2>>*/ ;
     /*<<dynarray.ml:634:5>>*/ }
    function fold_left(f, acc, a){
      /*<<dynarray.ml:637:2>>*/ var length = a[1], arr = a[2];
@@ -21163,7 +21442,7 @@
       var res = _q_;
      }
       /*<<dynarray.ml:668:2>>*/ check_same_length(cst_exists, a, length);
-      /*<<dynarray.ml:668:2>>*/ return res;
+      /*<<dynarray.ml:668:2>>*/ return res /*<<dynarray.ml:668:2>>*/ ;
     }
     /*<<dynarray.ml:669:5>>*/ }
    function for_all(p, a){
@@ -21185,7 +21464,7 @@
       var res = _p_;
      }
       /*<<dynarray.ml:681:2>>*/ check_same_length(cst_for_all, a, length);
-      /*<<dynarray.ml:681:2>>*/ return res;
+      /*<<dynarray.ml:681:2>>*/ return res /*<<dynarray.ml:681:2>>*/ ;
     }
     /*<<dynarray.ml:682:5>>*/ }
    function filter(f, a){
@@ -21195,10 +21474,10 @@
       function(x){
         /*<<dynarray.ml:686:27>>*/  /*<<dynarray.ml:686:30>>*/ var
         _o_ =  /*<<dynarray.ml:686:30>>*/ caml_call1(f, x);
-        /*<<dynarray.ml:686:30>>*/ return _o_ ? add_last(b, x) : _o_;
+        /*<<dynarray.ml:686:30>>*/ return _o_ ? add_last(b, x) : _o_ /*<<dynarray.ml:686:51>>*/ ;
        /*<<dynarray.ml:686:51>>*/ },
       a);
-     /*<<dynarray.ml:686:2>>*/ return b;
+     /*<<dynarray.ml:686:2>>*/ return b /*<<dynarray.ml:686:2>>*/ ;
     /*<<dynarray.ml:687:3>>*/ }
    function filter_map(f, a){
      /*<<dynarray.ml:690:2>>*/  /*<<dynarray.ml:690:10>>*/ var b = create(0);
@@ -21207,12 +21486,13 @@
       function(x){
         /*<<dynarray.ml:692:4>>*/  /*<<dynarray.ml:692:10>>*/ var
         match =  /*<<dynarray.ml:692:10>>*/ caml_call1(f, x);
-       if(! match)  /*<<dynarray.ml:693:14>>*/ return 0;
+       if(! match)
+         /*<<dynarray.ml:693:14>>*/ return 0 /*<<dynarray.ml:693:14>>*/ ;
        var y = match[1];
-        /*<<dynarray.ml:694:16>>*/ return add_last(b, y);
+        /*<<dynarray.ml:694:16>>*/ return add_last(b, y) /*<<dynarray.ml:694:28>>*/ ;
        /*<<dynarray.ml:694:28>>*/ },
       a);
-     /*<<dynarray.ml:691:2>>*/ return b;
+     /*<<dynarray.ml:691:2>>*/ return b /*<<dynarray.ml:691:2>>*/ ;
     /*<<dynarray.ml:696:3>>*/ }
    function of_array(a){
      /*<<dynarray.ml:707:2>>*/ var length = a.length - 1;
@@ -21222,8 +21502,8 @@
              (Stdlib_Array[1],
               length,
               function(i){
-                /*<<dynarray.ml:710:38>>*/ return [0, a[1 + i]];
-               /*<<dynarray.ml:710:69>>*/ })];
+                /*<<dynarray.ml:710:38>>*/ return [0, a[1 + i]] /*<<dynarray.ml:710:43>>*/ ;
+               /*<<dynarray.ml:710:69>>*/ })] /*<<dynarray.ml:708:2>>*/ ;
     /*<<dynarray.ml:711:3>>*/ }
    function to_array(a){
      /*<<dynarray.ml:714:2>>*/ var length = a[1], arr = a[2];
@@ -21234,20 +21514,20 @@
         (Stdlib_Array[1],
          length,
          function(i){
-           /*<<dynarray.ml:717:4>>*/ return unsafe_get(arr, i, length);
+           /*<<dynarray.ml:717:4>>*/ return unsafe_get(arr, i, length) /*<<dynarray.ml:717:29>>*/ ;
           /*<<dynarray.ml:717:29>>*/ });
      /*<<dynarray.ml:719:2>>*/ check_same_length(cst_to_array, a, length);
-     /*<<dynarray.ml:719:2>>*/ return res;
+     /*<<dynarray.ml:719:2>>*/ return res /*<<dynarray.ml:719:2>>*/ ;
     /*<<dynarray.ml:720:5>>*/ }
    function of_list(li){
      /*<<dynarray.ml:723:2>>*/  /*<<dynarray.ml:723:10>>*/ var a = create(0);
      /*<<dynarray.ml:724:2>>*/  /*<<dynarray.ml:724:2>>*/ caml_call2
      (Stdlib_List[18],
       function(x){
-        /*<<dynarray.ml:724:22>>*/ return add_last(a, x);
+        /*<<dynarray.ml:724:22>>*/ return add_last(a, x) /*<<dynarray.ml:724:34>>*/ ;
        /*<<dynarray.ml:724:34>>*/ },
       li);
-     /*<<dynarray.ml:724:2>>*/ return a;
+     /*<<dynarray.ml:724:2>>*/ return a /*<<dynarray.ml:724:2>>*/ ;
     /*<<dynarray.ml:725:3>>*/ }
    function to_list(a){
      /*<<dynarray.ml:728:2>>*/ var length = a[1], arr = a[2];
@@ -21273,7 +21553,7 @@
      /*<<dynarray.ml:738:2>>*/  /*<<dynarray.ml:738:13>>*/ var
      init = create(0);
      /*<<dynarray.ml:739:2>>*/ append_seq(init, seq);
-     /*<<dynarray.ml:739:2>>*/ return init;
+     /*<<dynarray.ml:739:2>>*/ return init /*<<dynarray.ml:739:2>>*/ ;
     /*<<dynarray.ml:740:6>>*/ }
    function to_seq(a){
      /*<<dynarray.ml:743:2>>*/ var length = a[1], arr = a[2];
@@ -21281,23 +21561,24 @@
     function aux(i){
       /*<<dynarray.ml:745:18>>*/ return function(param){
        /*<<dynarray.ml:746:4>>*/ check_same_length(cst_to_seq, a, length);
-      if(length <= i)  /*<<dynarray.ml:747:24>>*/ return 0;
+      if(length <= i)
+        /*<<dynarray.ml:747:24>>*/ return 0 /*<<dynarray.ml:747:24>>*/ ;
        /*<<dynarray.ml:749:14>>*/  /*<<dynarray.ml:749:14>>*/ var
        v = unsafe_get(arr, i, length);
-       /*<<dynarray.ml:750:6>>*/ return [0, v, aux(i + 1 | 0)]; /*<<dynarray.ml:751:7>>*/ };
+       /*<<dynarray.ml:750:6>>*/ return [0, v, aux(i + 1 | 0)] /*<<dynarray.ml:750:6>>*/ ; /*<<dynarray.ml:751:7>>*/ } /*<<dynarray.ml:745:18>>*/ ;
      /*<<dynarray.ml:751:7>>*/ }
-     /*<<dynarray.ml:753:2>>*/ return aux(0);
+     /*<<dynarray.ml:753:2>>*/ return aux(0) /*<<dynarray.ml:753:7>>*/ ;
     /*<<dynarray.ml:753:7>>*/ }
    function to_seq_reentrant(a){
     function aux(i){
       /*<<dynarray.ml:756:18>>*/ return function(param){
        /*<<dynarray.ml:757:4>>*/ if(a[1] <= i)
-        /*<<dynarray.ml:757:26>>*/ return 0;
+        /*<<dynarray.ml:757:26>>*/ return 0 /*<<dynarray.ml:757:26>>*/ ;
        /*<<dynarray.ml:759:14>>*/  /*<<dynarray.ml:759:14>>*/ var
        v = get(a, i);
-       /*<<dynarray.ml:760:6>>*/ return [0, v, aux(i + 1 | 0)]; /*<<dynarray.ml:761:7>>*/ };
+       /*<<dynarray.ml:760:6>>*/ return [0, v, aux(i + 1 | 0)] /*<<dynarray.ml:760:6>>*/ ; /*<<dynarray.ml:761:7>>*/ } /*<<dynarray.ml:756:18>>*/ ;
      /*<<dynarray.ml:761:7>>*/ }
-     /*<<dynarray.ml:763:2>>*/ return aux(0);
+     /*<<dynarray.ml:763:2>>*/ return aux(0) /*<<dynarray.ml:763:7>>*/ ;
     /*<<dynarray.ml:763:7>>*/ }
    function to_seq_rev(a){
      /*<<dynarray.ml:766:2>>*/ var length = a[1], arr = a[2];
@@ -21305,24 +21586,26 @@
     function aux(i){
       /*<<dynarray.ml:768:18>>*/ return function(param){
        /*<<dynarray.ml:769:4>>*/ check_same_length(cst_to_seq_rev, a, length);
-      if(0 > i)  /*<<dynarray.ml:770:18>>*/ return 0;
+      if(0 > i)
+        /*<<dynarray.ml:770:18>>*/ return 0 /*<<dynarray.ml:770:18>>*/ ;
        /*<<dynarray.ml:772:14>>*/  /*<<dynarray.ml:772:14>>*/ var
        v = unsafe_get(arr, i, length);
-       /*<<dynarray.ml:773:6>>*/ return [0, v, aux(i - 1 | 0)]; /*<<dynarray.ml:774:7>>*/ };
+       /*<<dynarray.ml:773:6>>*/ return [0, v, aux(i - 1 | 0)] /*<<dynarray.ml:773:6>>*/ ; /*<<dynarray.ml:774:7>>*/ } /*<<dynarray.ml:768:18>>*/ ;
      /*<<dynarray.ml:774:7>>*/ }
-     /*<<dynarray.ml:776:2>>*/ return aux(length - 1 | 0);
+     /*<<dynarray.ml:776:2>>*/ return aux(length - 1 | 0) /*<<dynarray.ml:776:18>>*/ ;
     /*<<dynarray.ml:776:18>>*/ }
    function to_seq_rev_reentrant(a){
     function aux(i){
       /*<<dynarray.ml:779:18>>*/ return function(param){
        /*<<dynarray.ml:780:4>>*/ if(0 > i)
-        /*<<dynarray.ml:780:18>>*/ return 0;
-      if(a[1] <= i)  /*<<dynarray.ml:784:6>>*/ return aux(a[1] - 1 | 0)(0);
+        /*<<dynarray.ml:780:18>>*/ return 0 /*<<dynarray.ml:780:18>>*/ ;
+      if(a[1] <= i)
+        /*<<dynarray.ml:784:6>>*/ return aux(a[1] - 1 | 0)(0) /*<<dynarray.ml:788:7>>*/ ;
        /*<<dynarray.ml:786:14>>*/  /*<<dynarray.ml:786:14>>*/ var
        v = get(a, i);
-       /*<<dynarray.ml:787:6>>*/ return [0, v, aux(i - 1 | 0)]; /*<<dynarray.ml:788:7>>*/ };
+       /*<<dynarray.ml:787:6>>*/ return [0, v, aux(i - 1 | 0)] /*<<dynarray.ml:787:6>>*/ ; /*<<dynarray.ml:788:7>>*/ } /*<<dynarray.ml:779:18>>*/ ;
      /*<<dynarray.ml:788:7>>*/ }
-     /*<<dynarray.ml:790:7>>*/ return aux(a[1] - 1 | 0);
+     /*<<dynarray.ml:790:7>>*/ return aux(a[1] - 1 | 0) /*<<dynarray.ml:790:20>>*/ ;
     /*<<dynarray.ml:790:20>>*/ }
    var
     Stdlib_Dynarray =
@@ -21477,13 +21760,14 @@
              (Stdlib[8], 1);
      var match = l$0[1], y2 = match[2], y1 = match[1];
       /*<<arg.ml:66:26>>*/ if( /*<<arg.ml:66:26>>*/ caml_equal(y1, x))
-       /*<<arg.ml:66:36>>*/ return y2;
+       /*<<arg.ml:66:36>>*/ return y2 /*<<arg.ml:66:36>>*/ ;
      var t = l$0[2];
      l$0 = t;
     }
     /*<<arg.ml:67:24>>*/ }
    function make_symlist(prefix, sep, suffix, l){
-     /*<<arg.ml:77:2>>*/ if(! l)  /*<<arg.ml:78:10>>*/ return cst_none;
+     /*<<arg.ml:77:2>>*/ if(! l)
+      /*<<arg.ml:78:10>>*/ return cst_none /*<<arg.ml:78:10>>*/ ;
      /*<<arg.ml:79:53>>*/ var
      t = l[2],
      h = l[1],
@@ -21496,12 +21780,12 @@
            /*<<arg.ml:79:40>>*/  /*<<arg.ml:79:44>>*/ var
            _aB_ =  /*<<arg.ml:79:44>>*/ caml_call2(Stdlib[28], sep, y);
            /*<<arg.ml:79:44>>*/ return  /*<<arg.ml:79:44>>*/ caml_call2
-                  (Stdlib[28], x, _aB_);
+                  (Stdlib[28], x, _aB_) /*<<arg.ml:79:51>>*/ ;
           /*<<arg.ml:79:51>>*/ },
          _az_,
          t);
      /*<<arg.ml:79:12>>*/ return  /*<<arg.ml:79:12>>*/ caml_call2
-            (Stdlib[28], _aA_, suffix);
+            (Stdlib[28], _aA_, suffix) /*<<arg.ml:79:77>>*/ ;
     /*<<arg.ml:79:77>>*/ }
    function help_action(param){
      /*<<arg.ml:91:21>>*/ throw  /*<<arg.ml:91:21>>*/ caml_maybe_attach_backtrace
@@ -21537,7 +21821,7 @@
      /*<<arg.ml:103:13>>*/  /*<<arg.ml:103:13>>*/ var
      _au_ =  /*<<arg.ml:103:13>>*/ caml_call2(Stdlib[37], add1, add2);
      /*<<arg.ml:103:13>>*/ return  /*<<arg.ml:103:13>>*/ caml_call2
-            (Stdlib[37], speclist, _au_);
+            (Stdlib[37], speclist, _au_) /*<<arg.ml:103:26>>*/ ;
     /*<<arg.ml:103:26>>*/ }
    function usage_b(buf, speclist, errmsg){
      /*<<arg.ml:107:2>>*/  /*<<arg.ml:107:2>>*/ caml_call3
@@ -21556,27 +21840,27 @@
               if(! _aq_) return _aq_;
               if(11 !== spec[0])
                 /*<<arg.ml:88:8>>*/ return  /*<<arg.ml:88:8>>*/ caml_call4
-                       (Stdlib_Printf[5], buf, _a_, key, doc);
+                       (Stdlib_Printf[5], buf, _a_, key, doc) /*<<arg.ml:88:8>>*/ ;
                /*<<arg.ml:86:38>>*/ var
                l = spec[1],
                 /*<<arg.ml:86:38>>*/ _ar_ = make_symlist(cst$1, cst$0, cst, l);
                /*<<arg.ml:86:8>>*/ return  /*<<arg.ml:86:8>>*/ caml_call5
-                      (Stdlib_Printf[5], buf, _b_, key, _ar_, doc);
+                      (Stdlib_Printf[5], buf, _b_, key, _ar_, doc) /*<<arg.ml:86:8>>*/ ;
              },
-             _ap_);
+             _ap_) /*<<arg.ml:108:48>>*/ ;
     /*<<arg.ml:108:48>>*/ }
    function usage_string(speclist, errmsg){
      /*<<arg.ml:112:2>>*/  /*<<arg.ml:112:10>>*/ var
      b =  /*<<arg.ml:112:10>>*/ caml_call1(Stdlib_Buffer[1], 200);
      /*<<arg.ml:113:2>>*/ usage_b(b, speclist, errmsg);
      /*<<arg.ml:113:2>>*/ return  /*<<arg.ml:113:2>>*/ caml_call1
-            (Stdlib_Buffer[2], b);
+            (Stdlib_Buffer[2], b) /*<<arg.ml:114:19>>*/ ;
     /*<<arg.ml:114:19>>*/ }
    function usage(speclist, errmsg){
      /*<<arg.ml:118:2>>*/  /*<<arg.ml:118:15>>*/ var
      _ao_ = usage_string(speclist, errmsg);
      /*<<arg.ml:118:15>>*/ return  /*<<arg.ml:118:15>>*/ caml_call2
-            (Stdlib_Printf[3], _e_, _ao_);
+            (Stdlib_Printf[3], _e_, _ao_) /*<<arg.ml:118:45>>*/ ;
     /*<<arg.ml:118:45>>*/ }
     /*<<arg.ml:121:14>>*/ var
      /*<<arg.ml:121:14>>*/ current = [0, 0],
@@ -21623,11 +21907,12 @@
      /*<<arg.ml:128:2>>*/ try{
       /*<<arg.ml:128:6>>*/  /*<<arg.ml:128:6>>*/ var
       _am_ = [0,  /*<<arg.ml:128:11>>*/ runtime.caml_int_of_string(x)];
-      /*<<arg.ml:128:6>>*/ return _am_;
+      /*<<arg.ml:128:6>>*/ return _am_ /*<<arg.ml:128:6>>*/ ;
     }
     catch(_an_){
      var _al_ = caml_wrap_exception(_an_);
-     if(_al_[1] === Stdlib[7])  /*<<arg.ml:129:20>>*/ return 0;
+     if(_al_[1] === Stdlib[7])
+       /*<<arg.ml:129:20>>*/ return 0 /*<<arg.ml:129:20>>*/ ;
      throw caml_maybe_attach_backtrace(_al_, 0);
     }
     /*<<arg.ml:129:24>>*/ }
@@ -21635,11 +21920,12 @@
      /*<<arg.ml:132:2>>*/ try{
       /*<<arg.ml:132:6>>*/  /*<<arg.ml:132:6>>*/ var
       _aj_ = [0,  /*<<arg.ml:132:11>>*/ runtime.caml_float_of_string(x)];
-      /*<<arg.ml:132:6>>*/ return _aj_;
+      /*<<arg.ml:132:6>>*/ return _aj_ /*<<arg.ml:132:6>>*/ ;
     }
     catch(_ak_){
      var _ai_ = caml_wrap_exception(_ak_);
-     if(_ai_[1] === Stdlib[7])  /*<<arg.ml:133:20>>*/ return 0;
+     if(_ai_[1] === Stdlib[7])
+       /*<<arg.ml:133:20>>*/ return 0 /*<<arg.ml:133:20>>*/ ;
      throw caml_maybe_attach_backtrace(_ai_, 0);
     }
     /*<<arg.ml:133:24>>*/ }
@@ -21683,10 +21969,10 @@
        && !  /*<<arg.ml:160:34>>*/ caml_equal(error, _h_))
        /*<<arg.ml:162:9>>*/ return [0,
               Bad,
-               /*<<arg.ml:162:13>>*/ caml_call1(Stdlib_Buffer[2], b)];
+               /*<<arg.ml:162:13>>*/ caml_call1(Stdlib_Buffer[2], b)] /*<<arg.ml:162:9>>*/ ;
       /*<<arg.ml:161:9>>*/ return [0,
              Help,
-              /*<<arg.ml:161:14>>*/ caml_call1(Stdlib_Buffer[2], b)];
+              /*<<arg.ml:161:14>>*/ caml_call1(Stdlib_Buffer[2], b)] /*<<arg.ml:161:9>>*/ ;
      /*<<arg.ml:162:32>>*/ }
      /*<<arg.ml:164:2>>*/ current[1]++;
     for(;;){
@@ -21736,7 +22022,7 @@
         no_arg =
           function(param){
             /*<<arg.ml:178:10>>*/ if(! follow$2)
-             /*<<arg.ml:179:20>>*/ return;
+             /*<<arg.ml:179:20>>*/ return /*<<arg.ml:179:20>>*/ ;
            var arg = follow$2[1];
             /*<<arg.ml:180:24>>*/ throw  /*<<arg.ml:180:24>>*/ caml_maybe_attach_backtrace
                   ([0, Stop, [1, s$0, arg, cst_no_argument]], 1);
@@ -21745,18 +22031,18 @@
           function(param){
             /*<<arg.ml:182:10>>*/ if(follow$2){
             var arg = follow$2[1];
-             /*<<arg.ml:186:24>>*/ return arg;
+             /*<<arg.ml:186:24>>*/ return arg /*<<arg.ml:186:24>>*/ ;
            }
            if((current[1] + 1 | 0) >= argv[1].length - 1)
              /*<<arg.ml:185:19>>*/ throw  /*<<arg.ml:185:19>>*/ caml_maybe_attach_backtrace
                    ([0, Stop, [2, s$0]], 1);
            var _af_ = current[1] + 1 | 0;
             /*<<arg.ml:184:58>>*/ return caml_check_bound(argv[1], _af_)
-                   [1 + _af_];
+                   [1 + _af_] /*<<arg.ml:184:58>>*/ ;
            /*<<arg.ml:186:27>>*/ },
         consume_arg =
           function(param){
-            /*<<arg.ml:189:10>>*/ return follow$2 ? 0 : (current[1]++, 0);
+            /*<<arg.ml:189:10>>*/ return follow$2 ? 0 : (current[1]++, 0) /*<<arg.ml:191:24>>*/ ;
            /*<<arg.ml:191:24>>*/ },
         treat_action =
           function(param){
@@ -21765,7 +22051,7 @@
               var f = param[1];
                /*<<arg.ml:194:20>>*/ no_arg$0(0);
                /*<<arg.ml:194:20>>*/ return  /*<<arg.ml:194:20>>*/ caml_call1
-                      (f, 0);
+                      (f, 0) /*<<arg.ml:276:54>>*/ ;
              case 1:
                /*<<arg.ml:196:22>>*/ var
                f$0 = param[1],
@@ -21787,7 +22073,7 @@
                       ([0, Stop, [1, s$0, arg, cst_a_boolean]], 1);
               var s = match[1];
                /*<<arg.ml:199:24>>*/  /*<<arg.ml:199:24>>*/ caml_call1(f$0, s);
-               /*<<arg.ml:201:12>>*/ return consume_arg$0(0);
+               /*<<arg.ml:201:12>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
              case 2:
               var r = param[1];
                /*<<arg.ml:202:19>>*/ no_arg$0(0);
@@ -21804,11 +22090,11 @@
                 /*<<arg.ml:205:22>>*/ arg$0 = get_arg$0(0);
                /*<<arg.ml:206:12>>*/  /*<<arg.ml:206:12>>*/ caml_call1
                (f$1, arg$0);
-               /*<<arg.ml:206:12>>*/ return consume_arg$0(0);
+               /*<<arg.ml:206:12>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
              case 5:
               var r$1 = param[1];
               r$1[1] = get_arg$0(0);
-               /*<<arg.ml:219:12>>*/ return consume_arg$0(0);
+               /*<<arg.ml:219:12>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
              case 6:
                /*<<arg.ml:221:22>>*/ var
                f$2 = param[1],
@@ -21819,7 +22105,7 @@
                       ([0, Stop, [1, s$0, arg$1, cst_an_integer]], 1);
               var x = match$0[1];
                /*<<arg.ml:224:24>>*/  /*<<arg.ml:224:24>>*/ caml_call1(f$2, x);
-               /*<<arg.ml:226:12>>*/ return consume_arg$0(0);
+               /*<<arg.ml:226:12>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
              case 7:
                /*<<arg.ml:228:22>>*/ var
                r$2 = param[1],
@@ -21830,7 +22116,7 @@
                       ([0, Stop, [1, s$0, arg$2, cst_an_integer$0]], 1);
               var x$0 = match$1[1];
               r$2[1] = x$0;
-               /*<<arg.ml:233:12>>*/ return consume_arg$0(0);
+               /*<<arg.ml:233:12>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
              case 8:
                /*<<arg.ml:235:22>>*/ var
                f$3 = param[1],
@@ -21842,7 +22128,7 @@
               var x$1 = match$2[1];
                /*<<arg.ml:238:24>>*/  /*<<arg.ml:238:24>>*/ caml_call1
                (f$3, x$1);
-               /*<<arg.ml:240:12>>*/ return consume_arg$0(0);
+               /*<<arg.ml:240:12>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
              case 9:
                /*<<arg.ml:242:22>>*/ var
                r$3 = param[1],
@@ -21853,12 +22139,12 @@
                       ([0, Stop, [1, s$0, arg$4, cst_a_float$0]], 1);
               var x$2 = match$3[1];
               r$3[1] = x$2;
-               /*<<arg.ml:247:12>>*/ return consume_arg$0(0);
+               /*<<arg.ml:247:12>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
              case 10:
               var specs = param[1];
                /*<<arg.ml:249:12>>*/ no_arg$0(0);
                /*<<arg.ml:249:12>>*/ return  /*<<arg.ml:249:12>>*/ caml_call2
-                      (Stdlib_List[18], treat_action$0, specs);
+                      (Stdlib_List[18], treat_action$0, specs) /*<<arg.ml:276:54>>*/ ;
              case 11:
                /*<<arg.ml:209:22>>*/ var
                f$4 = param[2],
@@ -21869,7 +22155,7 @@
                  (Stdlib_List[37], arg$5, symb)){
                 /*<<arg.ml:211:14>>*/  /*<<arg.ml:211:14>>*/ caml_call1
                 (f$4, arg$5);
-                /*<<arg.ml:211:14>>*/ return consume_arg$0(0);
+                /*<<arg.ml:211:14>>*/ return consume_arg$0(0) /*<<arg.ml:276:54>>*/ ;
               }
                /*<<arg.ml:215:44>>*/  /*<<arg.ml:215:44>>*/ var
                _aa_ = make_symlist(cst$6, cst$5, cst$4, symb);
@@ -21901,7 +22187,7 @@
                if(current[1] >= (argv[1].length - 2 | 0))
                  /*<<arg.ml:264:14>>*/ return  /*<<arg.ml:264:14>>*/ caml_call1
                         (f$6,
-                          /*<<arg.ml:264:14>>*/ caml_call1(Stdlib_List[10], acc[1]));
+                          /*<<arg.ml:264:14>>*/ caml_call1(Stdlib_List[10], acc[1])) /*<<arg.ml:276:54>>*/ ;
                var _ad_ = current[1] + 1 | 0, _ac_ = acc[1];
                acc[1] = [0, caml_check_bound(argv[1], _ad_)[1 + _ad_], _ac_];
                 /*<<arg.ml:262:14>>*/ consume_arg$0(0);
@@ -21961,23 +22247,23 @@
    function parse_and_expand_argv_dynamic
    (current, argv, speclist, anonfun, errmsg){
      /*<<arg.ml:287:2>>*/ return parse_and_expand_argv_dynamic_
-            (1, current, argv, speclist, anonfun, errmsg);
+            (1, current, argv, speclist, anonfun, errmsg) /*<<arg.ml:287:77>>*/ ;
     /*<<arg.ml:287:77>>*/ }
    function parse_argv_dynamic(opt, argv, speclist, anonfun, errmsg){
     var current$0 = opt ? opt[1] : current;
      /*<<arg.ml:290:2>>*/ return parse_and_expand_argv_dynamic_
-            (0, current$0, [0, argv], speclist, anonfun, errmsg);
+            (0, current$0, [0, argv], speclist, anonfun, errmsg) /*<<arg.ml:290:2>>*/ ;
    }
    function parse_argv(opt, argv, speclist, anonfun, errmsg){
     var current$0 = opt ? opt[1] : current;
      /*<<arg.ml:295:2>>*/ return parse_argv_dynamic
-            ([0, current$0], argv, [0, speclist], anonfun, errmsg);
+            ([0, current$0], argv, [0, speclist], anonfun, errmsg) /*<<arg.ml:295:2>>*/ ;
    }
    function parse(l, f, msg){
      /*<<arg.ml:299:2>>*/ try{
       /*<<arg.ml:300:4>>*/  /*<<arg.ml:300:4>>*/ var
       _U_ = parse_argv(0, caml_sys_argv(0), l, f, msg);
-      /*<<arg.ml:300:4>>*/ return _U_;
+      /*<<arg.ml:300:4>>*/ return _U_ /*<<arg.ml:300:4>>*/ ;
     }
     catch(exn$0){
      var exn = caml_wrap_exception(exn$0);
@@ -21986,21 +22272,21 @@
        /*<<arg.ml:302:15>>*/  /*<<arg.ml:302:15>>*/ caml_call2
        (Stdlib_Printf[3], _l_, msg$0);
        /*<<arg.ml:302:15>>*/ return  /*<<arg.ml:302:15>>*/ caml_call1
-              (Stdlib[99], 2);
+              (Stdlib[99], 2) /*<<arg.ml:303:39>>*/ ;
      }
      if(exn[1] !== Help) throw caml_maybe_attach_backtrace(exn, 0);
      var msg$1 = exn[2];
       /*<<arg.ml:303:16>>*/  /*<<arg.ml:303:16>>*/ caml_call2
       (Stdlib_Printf[2], _m_, msg$1);
       /*<<arg.ml:303:16>>*/ return  /*<<arg.ml:303:16>>*/ caml_call1
-             (Stdlib[99], 0);
+             (Stdlib[99], 0) /*<<arg.ml:303:39>>*/ ;
     }
     /*<<arg.ml:303:39>>*/ }
    function parse_dynamic(l, f, msg){
      /*<<arg.ml:307:2>>*/ try{
       /*<<arg.ml:308:4>>*/  /*<<arg.ml:308:4>>*/ var
       _T_ = parse_argv_dynamic(0, caml_sys_argv(0), l, f, msg);
-      /*<<arg.ml:308:4>>*/ return _T_;
+      /*<<arg.ml:308:4>>*/ return _T_ /*<<arg.ml:308:4>>*/ ;
     }
     catch(exn$0){
      var exn = caml_wrap_exception(exn$0);
@@ -22009,14 +22295,14 @@
        /*<<arg.ml:310:15>>*/  /*<<arg.ml:310:15>>*/ caml_call2
        (Stdlib_Printf[3], _n_, msg$0);
        /*<<arg.ml:310:15>>*/ return  /*<<arg.ml:310:15>>*/ caml_call1
-              (Stdlib[99], 2);
+              (Stdlib[99], 2) /*<<arg.ml:311:39>>*/ ;
      }
      if(exn[1] !== Help) throw caml_maybe_attach_backtrace(exn, 0);
      var msg$1 = exn[2];
       /*<<arg.ml:311:16>>*/  /*<<arg.ml:311:16>>*/ caml_call2
       (Stdlib_Printf[2], _o_, msg$1);
       /*<<arg.ml:311:16>>*/ return  /*<<arg.ml:311:16>>*/ caml_call1
-             (Stdlib[99], 0);
+             (Stdlib[99], 0) /*<<arg.ml:311:39>>*/ ;
     }
     /*<<arg.ml:311:39>>*/ }
    function parse_expand(l, f, msg){
@@ -22027,7 +22313,7 @@
        /*<<arg.ml:317:18>>*/ current$0 = [0, current[1]],
        /*<<arg.ml:318:4>>*/ _S_ =
         parse_and_expand_argv_dynamic(current$0, argv, spec, f, msg);
-      /*<<arg.ml:318:4>>*/ return _S_;
+      /*<<arg.ml:318:4>>*/ return _S_ /*<<arg.ml:318:4>>*/ ;
     }
     catch(exn$0){
      var exn = caml_wrap_exception(exn$0);
@@ -22036,14 +22322,14 @@
        /*<<arg.ml:320:15>>*/  /*<<arg.ml:320:15>>*/ caml_call2
        (Stdlib_Printf[3], _p_, msg$0);
        /*<<arg.ml:320:15>>*/ return  /*<<arg.ml:320:15>>*/ caml_call1
-              (Stdlib[99], 2);
+              (Stdlib[99], 2) /*<<arg.ml:321:39>>*/ ;
      }
      if(exn[1] !== Help) throw caml_maybe_attach_backtrace(exn, 0);
      var msg$1 = exn[2];
       /*<<arg.ml:321:16>>*/  /*<<arg.ml:321:16>>*/ caml_call2
       (Stdlib_Printf[2], _q_, msg$1);
       /*<<arg.ml:321:16>>*/ return  /*<<arg.ml:321:16>>*/ caml_call1
-             (Stdlib[99], 0);
+             (Stdlib[99], 0) /*<<arg.ml:321:39>>*/ ;
     }
     /*<<arg.ml:321:39>>*/ }
    function second_word(s){
@@ -22051,10 +22337,10 @@
     function loop(n){
       /*<<arg.ml:327:4>>*/ var n$0 = n;
       /*<<arg.ml:327:4>>*/ for(;;){
-      if(len <= n$0)  /*<<arg.ml:326:2>>*/ return len;
+      if(len <= n$0)  /*<<arg.ml:326:2>>*/ return len /*<<arg.ml:326:2>>*/ ;
        /*<<arg.ml:328:12>>*/ if
        (32 !==  /*<<arg.ml:328:12>>*/ caml_string_get(s, n$0))
-        /*<<arg.ml:329:9>>*/ return n$0;
+        /*<<arg.ml:329:9>>*/ return n$0 /*<<arg.ml:329:9>>*/ ;
        /*<<arg.ml:328:29>>*/  /*<<arg.ml:328:29>>*/ var n$1 = n$0 + 1 | 0;
       n$0 = n$1;
      }
@@ -22072,12 +22358,13 @@
      }
      catch(_R_){
       var _P_ = caml_wrap_exception(_R_);
-      if(_P_ === Stdlib[8])  /*<<arg.ml:336:31>>*/ return len;
+      if(_P_ === Stdlib[8])
+        /*<<arg.ml:336:31>>*/ return len /*<<arg.ml:336:31>>*/ ;
       throw caml_maybe_attach_backtrace(_P_, 0);
      }
-      /*<<arg.ml:334:18>>*/ return loop(n + 1 | 0);
+      /*<<arg.ml:334:18>>*/ return loop(n + 1 | 0) /*<<arg.ml:337:9>>*/ ;
     }
-     /*<<arg.ml:331:8>>*/ return loop(n$0 + 1 | 0);
+     /*<<arg.ml:331:8>>*/ return loop(n$0 + 1 | 0) /*<<arg.ml:337:9>>*/ ;
     /*<<arg.ml:337:9>>*/ }
    function max_arg_len(cur, param){
     var doc = param[3], spec = param[2], kwd = param[1];
@@ -22093,11 +22380,11 @@
              function(c){
                /*<<arg.ml:348:13>>*/ if(9 === c && ! seen[1]){
                seen[1] = 1;
-                /*<<arg.ml:348:60>>*/ return 32;
+                /*<<arg.ml:348:60>>*/ return 32 /*<<arg.ml:348:60>>*/ ;
               }
-               /*<<arg.ml:348:71>>*/ return c;
+               /*<<arg.ml:348:71>>*/ return c /*<<arg.ml:348:71>>*/ ;
               /*<<arg.ml:348:73>>*/ },
-             s);
+             s) /*<<arg.ml:348:75>>*/ ;
     /*<<arg.ml:348:75>>*/ }
    function align(opt, speclist){
      /*<<arg.ml:374:18>>*/ var
@@ -22112,7 +22399,8 @@
             (Stdlib_List[20],
              function(ksd){
               var kwd = ksd[1], spec = ksd[2];
-              if(ksd[3] === cst$8)  /*<<arg.ml:355:6>>*/ return ksd;
+              if(ksd[3] === cst$8)
+                /*<<arg.ml:355:6>>*/ return ksd /*<<arg.ml:355:6>>*/ ;
               if(11 === spec[0]){
                 /*<<arg.ml:357:19>>*/ var
                 msg$0 = ksd[3],
@@ -22130,7 +22418,7 @@
                 /*<<arg.ml:359:6>>*/ return [0,
                        kwd,
                        spec,
-                        /*<<arg.ml:359:18>>*/ caml_call2(Stdlib[28], cst$7, _M_)];
+                        /*<<arg.ml:359:18>>*/ caml_call2(Stdlib[28], cst$7, _M_)] /*<<arg.ml:359:6>>*/ ;
               }
                /*<<arg.ml:361:19>>*/ var
                msg = ksd[3],
@@ -22143,7 +22431,7 @@
                 /*<<arg.ml:365:8>>*/ return [0,
                        kwd,
                        spec$0,
-                       replace_leading_tab(msg)];
+                       replace_leading_tab(msg)] /*<<arg.ml:365:8>>*/ ;
                /*<<arg.ml:367:21>>*/ var
                 /*<<arg.ml:367:21>>*/ spaces =
                   /*<<arg.ml:367:21>>*/ caml_call2(Stdlib_String[1], diff, 32),
@@ -22162,9 +22450,9 @@
                /*<<arg.ml:370:8>>*/ return [0,
                       kwd,
                       spec$0,
-                       /*<<arg.ml:370:20>>*/ caml_call2(Stdlib[28], prefix, _J_)];
+                       /*<<arg.ml:370:20>>*/ caml_call2(Stdlib[28], prefix, _J_)] /*<<arg.ml:370:8>>*/ ;
              },
-             completed);
+             completed) /*<<arg.ml:377:2>>*/ ;
    }
    function read_aux(trim, sep, file){
      /*<<arg.ml:387:2>>*/ var
@@ -22197,7 +22485,7 @@
       var word$0 = word;
      words[1] = [0, word$0, words[1]];
       /*<<arg.ml:390:2>>*/ return  /*<<arg.ml:390:2>>*/ caml_call1
-             (Stdlib_Buffer[8], buf);
+             (Stdlib_Buffer[8], buf) /*<<arg.ml:394:20>>*/ ;
      /*<<arg.ml:394:20>>*/ }
      /*<<arg.ml:396:2>>*/ try{
      for(;;){
@@ -22219,7 +22507,7 @@
       /*<<arg.ml:405:16>>*/  /*<<arg.ml:405:16>>*/ var
       _F_ =  /*<<arg.ml:405:16>>*/ caml_call1(Stdlib_List[10], words[1]);
       /*<<arg.ml:405:16>>*/ return  /*<<arg.ml:405:16>>*/ caml_call1
-             (Stdlib_Array[11], _F_);
+             (Stdlib_Array[11], _F_) /*<<arg.ml:405:33>>*/ ;
     }
     /*<<arg.ml:405:33>>*/ }
    var _r_ = 10, _s_ = 1;
@@ -22240,11 +22528,11 @@
      (Stdlib_Array[12],
       function(s){
         /*<<arg.ml:413:23>>*/ return caml_call4
-               (Stdlib_Printf[1], oc, _v_, s, sep);
+               (Stdlib_Printf[1], oc, _v_, s, sep) /*<<arg.ml:413:46>>*/ ;
        /*<<arg.ml:413:46>>*/ },
       args);
      /*<<arg.ml:413:2>>*/ return  /*<<arg.ml:413:2>>*/ caml_call1
-            (Stdlib[76], oc);
+            (Stdlib[76], oc) /*<<arg.ml:414:14>>*/ ;
     /*<<arg.ml:414:14>>*/ }
    var _w_ = 10;
     /*<<arg.ml:416:16>>*/ function write_arg(_A_, _B_){
@@ -22409,32 +22697,33 @@
      /*<<printexc.ml:26:9>>*/ if
      (!  /*<<printexc.ml:26:9>>*/ caml_call1(Stdlib_Obj[1], f))
       /*<<printexc.ml:27:4>>*/ return  /*<<printexc.ml:27:4>>*/ caml_call2
-             (Stdlib_Printf[4], _b_, f);
+             (Stdlib_Printf[4], _b_, f) /*<<printexc.ml:33:7>>*/ ;
      /*<<printexc.ml:28:7>>*/  /*<<printexc.ml:28:7>>*/ var
      _ah_ = Stdlib_Obj[15];
     if( /*<<printexc.ml:28:10>>*/ caml_obj_tag(f) === _ah_)
       /*<<printexc.ml:29:4>>*/ return  /*<<printexc.ml:29:4>>*/ caml_call2
-             (Stdlib_Printf[4], _a_, f);
+             (Stdlib_Printf[4], _a_, f) /*<<printexc.ml:33:7>>*/ ;
      /*<<printexc.ml:30:7>>*/  /*<<printexc.ml:30:7>>*/ var
      _ai_ = Stdlib_Obj[16];
     return  /*<<printexc.ml:30:10>>*/ caml_obj_tag(f) === _ai_
             ?  /*<<printexc.ml:31:4>>*/ caml_call1(Stdlib[35], f)
-            : cst;
+            : cst /*<<printexc.ml:33:7>>*/ ;
     /*<<printexc.ml:33:7>>*/ }
    function other_fields(x, i){
      /*<<printexc.ml:36:2>>*/ if(x.length - 1 <= i)
-      /*<<printexc.ml:36:26>>*/ return cst$0;
+      /*<<printexc.ml:36:26>>*/ return cst$0 /*<<printexc.ml:36:26>>*/ ;
      /*<<printexc.ml:37:36>>*/ var
       /*<<printexc.ml:37:36>>*/ _af_ = other_fields(x, i + 1 | 0),
       /*<<printexc.ml:37:24>>*/ _ag_ = field(x, i);
      /*<<printexc.ml:37:36>>*/ return  /*<<printexc.ml:37:36>>*/ caml_call3
-            (Stdlib_Printf[4], _c_, _ag_, _af_);
+            (Stdlib_Printf[4], _c_, _ag_, _af_) /*<<printexc.ml:37:58>>*/ ;
     /*<<printexc.ml:37:58>>*/ }
    function use_printers(x){
      /*<<printexc.ml:47:2>>*/ var
      param =  /*<<printexc.ml:53:7>>*/ caml_call1(Stdlib_Atomic[3], printers);
      /*<<printexc.ml:47:17>>*/ for(;;){
-     if(! param)  /*<<printexc.ml:52:12>>*/ return 0;
+     if(! param)
+       /*<<printexc.ml:52:12>>*/ return 0 /*<<printexc.ml:52:12>>*/ ;
      var tl = param[2], hd = param[1];
      a:
      {
@@ -22443,7 +22732,10 @@
         val =  /*<<printexc.ml:49:15>>*/ caml_call1(hd, x);
       }
       catch(_ae_){break a;}
-      if(val){var s = val[1];  /*<<printexc.ml:51:21>>*/ return [0, s];}
+      if(val){
+       var s = val[1];
+        /*<<printexc.ml:51:21>>*/ return [0, s] /*<<printexc.ml:51:21>>*/ ;
+      }
      }
      param = tl;
     }
@@ -22479,15 +22771,16 @@
      var match$0 = [0, t[1], 0];
     var fields_opt = match$0[2], constructor$0 = match$0[1];
      /*<<printexc.ml:65:2>>*/ if(! fields_opt)
-      /*<<printexc.ml:66:12>>*/ return constructor$0;
+      /*<<printexc.ml:66:12>>*/ return constructor$0 /*<<printexc.ml:66:12>>*/ ;
     var f = fields_opt[1];
      /*<<printexc.ml:67:14>>*/ return  /*<<printexc.ml:67:14>>*/ caml_call2
-            (Stdlib[28], constructor$0, f);
+            (Stdlib[28], constructor$0, f) /*<<printexc.ml:67:29>>*/ ;
     /*<<printexc.ml:67:29>>*/ }
    function to_string_default(x){
      /*<<printexc.ml:69:24>>*/ if(x === Stdlib[9])
-      /*<<printexc.ml:70:21>>*/ return cst_Out_of_memory;
-    if(x === Stdlib[10])  /*<<printexc.ml:71:22>>*/ return cst_Stack_overflow;
+      /*<<printexc.ml:70:21>>*/ return cst_Out_of_memory /*<<printexc.ml:70:21>>*/ ;
+    if(x === Stdlib[10])
+      /*<<printexc.ml:71:22>>*/ return cst_Stack_overflow /*<<printexc.ml:71:22>>*/ ;
     if(x[1] === Stdlib[4]){
      var match = x[2], char$0 = match[3], line = match[2], file = match[1];
       /*<<printexc.ml:73:6>>*/ return  /*<<printexc.ml:73:6>>*/ caml_call6
@@ -22497,7 +22790,7 @@
               line,
               char$0,
               char$0 + 5 | 0,
-              cst_Pattern_matching_failed);
+              cst_Pattern_matching_failed) /*<<printexc.ml:79:50>>*/ ;
     }
     if(x[1] === Stdlib[5]){
      var
@@ -22512,10 +22805,10 @@
               line$0,
               char$1,
               char$1 + 6 | 0,
-              cst_Assertion_failed);
+              cst_Assertion_failed) /*<<printexc.ml:79:50>>*/ ;
     }
     if(x[1] !== Stdlib[15])
-      /*<<printexc.ml:79:6>>*/ return string_of_extension_constructo(x);
+      /*<<printexc.ml:79:6>>*/ return string_of_extension_constructo(x) /*<<printexc.ml:79:50>>*/ ;
     var
      match$1 = x[2],
      char$2 = match$1[3],
@@ -22528,20 +22821,21 @@
              line$1,
              char$2,
              char$2 + 6 | 0,
-             cst_Undefined_recursive_module);
+             cst_Undefined_recursive_module) /*<<printexc.ml:79:50>>*/ ;
     /*<<printexc.ml:79:50>>*/ }
    function to_string(e){
      /*<<printexc.ml:82:2>>*/  /*<<printexc.ml:82:8>>*/ var
      match = use_printers(e);
-    if(! match)  /*<<printexc.ml:84:12>>*/ return to_string_default(e);
+    if(! match)
+      /*<<printexc.ml:84:12>>*/ return to_string_default(e) /*<<printexc.ml:84:31>>*/ ;
     var s = match[1];
-     /*<<printexc.ml:83:14>>*/ return s;
+     /*<<printexc.ml:83:14>>*/ return s /*<<printexc.ml:83:14>>*/ ;
     /*<<printexc.ml:84:31>>*/ }
    function print(fct, arg){
      /*<<printexc.ml:87:2>>*/ try{
       /*<<printexc.ml:88:4>>*/  /*<<printexc.ml:88:4>>*/ var
       _$_ =  /*<<printexc.ml:88:4>>*/ caml_call1(fct, arg);
-      /*<<printexc.ml:88:4>>*/ return _$_;
+      /*<<printexc.ml:88:4>>*/ return _$_ /*<<printexc.ml:88:4>>*/ ;
     }
     catch(x$0){
       /*<<printexc.ml:90:39>>*/ var
@@ -22559,7 +22853,7 @@
      /*<<printexc.ml:95:2>>*/ try{
       /*<<printexc.ml:96:4>>*/  /*<<printexc.ml:96:4>>*/ var
       _Z_ =  /*<<printexc.ml:96:4>>*/ caml_call1(fct, arg);
-      /*<<printexc.ml:96:4>>*/ return _Z_;
+      /*<<printexc.ml:96:4>>*/ return _Z_ /*<<printexc.ml:96:4>>*/ ;
     }
     catch(x$0){
      var x = caml_wrap_exception(x$0);
@@ -22570,21 +22864,21 @@
       /*<<printexc.ml:99:4>>*/  /*<<printexc.ml:99:4>>*/ caml_call2
       (Stdlib_Printf[3], _g_, _Y_);
       /*<<printexc.ml:99:4>>*/ return  /*<<printexc.ml:99:4>>*/ caml_call1
-             (Stdlib[99], 2);
+             (Stdlib[99], 2) /*<<printexc.ml:100:10>>*/ ;
     }
     /*<<printexc.ml:100:10>>*/ }
    function raw_backtrace_entries(bt){
-     /*<<printexc.ml:106:31>>*/ return bt;
+     /*<<printexc.ml:106:31>>*/ return bt /*<<printexc.ml:106:31>>*/ ;
     /*<<printexc.ml:106:33>>*/ }
    function convert_raw_backtrace(bt){
      /*<<printexc.ml:138:2>>*/ return [0,
-             /*<<printexc.ml:138:11>>*/ runtime.caml_convert_raw_backtrace(bt)];
+             /*<<printexc.ml:138:11>>*/ runtime.caml_convert_raw_backtrace(bt)] /*<<printexc.ml:138:6>>*/ ;
     /*<<printexc.ml:139:24>>*/ }
    function format_backtrace_slot(pos, slot){
     function info(is_raise){
       /*<<printexc.ml:143:4>>*/ return is_raise
              ? 0 === pos ? cst_Raised_at : cst_Re_raised_at
-             : 0 === pos ? cst_Raised_by_primitive_operat : cst_Called_from;
+             : 0 === pos ? cst_Raised_by_primitive_operat : cst_Called_from /*<<printexc.ml:146:75>>*/ ;
      /*<<printexc.ml:146:75>>*/ }
      /*<<printexc.ml:148:2>>*/ if(0 === slot[0]){
       /*<<printexc.ml:162:14>>*/ var
@@ -22602,19 +22896,20 @@
        /*<<printexc.ml:162:14>>*/ _W_ = info(slot[1]);
       /*<<printexc.ml:161:6>>*/ return [0,
               /*<<printexc.ml:161:11>>*/ caml_call8
-              (Stdlib_Printf[4], _i_, _W_, _V_, _U_, _T_, lines, _S_, _R_)];
+              (Stdlib_Printf[4], _i_, _W_, _V_, _U_, _T_, lines, _S_, _R_)] /*<<printexc.ml:161:6>>*/ ;
     }
-    if(slot[1])  /*<<printexc.ml:151:50>>*/ return 0;
+    if(slot[1])
+      /*<<printexc.ml:151:50>>*/ return 0 /*<<printexc.ml:151:50>>*/ ;
      /*<<printexc.ml:153:44>>*/  /*<<printexc.ml:153:44>>*/ var _X_ = info(0);
      /*<<printexc.ml:153:8>>*/ return [0,
-             /*<<printexc.ml:153:13>>*/ caml_call2(Stdlib_Printf[4], _k_, _X_)];
+             /*<<printexc.ml:153:13>>*/ caml_call2(Stdlib_Printf[4], _k_, _X_)] /*<<printexc.ml:153:8>>*/ ;
     /*<<printexc.ml:164:44>>*/ }
    function print_raw_backtrace(outchan, raw_backtrace){
      /*<<printexc.ml:179:2>>*/  /*<<printexc.ml:179:36>>*/ var
      backtrace = convert_raw_backtrace(raw_backtrace);
     if(! backtrace)
       /*<<printexc.ml:169:6>>*/ return  /*<<printexc.ml:169:6>>*/ caml_call2
-             (Stdlib_Printf[1], outchan, _m_);
+             (Stdlib_Printf[1], outchan, _m_) /*<<printexc.ml:179:73>>*/ ;
     var a = backtrace[1], _P_ = a.length - 2 | 0, _O_ = 0;
     if(_P_ >= 0){
      var i = _O_;
@@ -22637,13 +22932,13 @@
    function print_backtrace(outchan){
      /*<<printexc.ml:183:2>>*/ return print_raw_backtrace
             (outchan,
-              /*<<printexc.ml:183:30>>*/ caml_get_exception_raw_backtra(0));
+              /*<<printexc.ml:183:30>>*/ caml_get_exception_raw_backtra(0)) /*<<printexc.ml:183:52>>*/ ;
     /*<<printexc.ml:183:52>>*/ }
    function raw_backtrace_to_string(raw_backtrace){
      /*<<printexc.ml:199:2>>*/  /*<<printexc.ml:199:22>>*/ var
      backtrace = convert_raw_backtrace(raw_backtrace);
     if(! backtrace)
-      /*<<printexc.ml:188:5>>*/ return cst_Program_not_linked_with_g_;
+      /*<<printexc.ml:188:5>>*/ return cst_Program_not_linked_with_g_ /*<<printexc.ml:188:5>>*/ ;
      /*<<printexc.ml:190:14>>*/ var
      a = backtrace[1],
       /*<<printexc.ml:190:14>>*/ b =
@@ -22667,29 +22962,30 @@
      }
     }
      /*<<printexc.ml:196:6>>*/ return  /*<<printexc.ml:196:6>>*/ caml_call1
-            (Stdlib_Buffer[2], b);
+            (Stdlib_Buffer[2], b) /*<<printexc.ml:199:59>>*/ ;
     /*<<printexc.ml:199:59>>*/ }
    function backtrace_slot_is_raise(param){
-     /*<<printexc.ml:201:30>>*/ return 0 === param[0] ? param[1] : param[1];
+     /*<<printexc.ml:201:30>>*/ return 0 === param[0] ? param[1] : param[1] /*<<printexc.ml:203:36>>*/ ;
     /*<<printexc.ml:203:36>>*/ }
    function backtrace_slot_is_inline(param){
-     /*<<printexc.ml:205:31>>*/ return 0 === param[0] ? param[8] : 0;
+     /*<<printexc.ml:205:31>>*/ return 0 === param[0] ? param[8] : 0 /*<<printexc.ml:207:31>>*/ ;
     /*<<printexc.ml:207:31>>*/ }
    function backtrace_slot_location(param){
      /*<<printexc.ml:218:30>>*/ return 0 === param[0]
             ? [0,
               [0, param[2], param[3], param[4], param[5], param[6], param[7]]]
-            : 0;
+            : 0 /*<<printexc.ml:228:5>>*/ ;
     /*<<printexc.ml:228:5>>*/ }
    function backtrace_slot_defname(param){
      /*<<printexc.ml:230:29>>*/ if(0 === param[0] && param[9] !== cst$4)
-      /*<<printexc.ml:233:24>>*/ return [0, param[9]];
-     /*<<printexc.ml:232:39>>*/ return 0;
+      /*<<printexc.ml:233:24>>*/ return [0, param[9]] /*<<printexc.ml:233:24>>*/ ;
+     /*<<printexc.ml:232:39>>*/ return 0 /*<<printexc.ml:232:39>>*/ ;
     /*<<printexc.ml:233:38>>*/ }
    function backtrace_slots(raw_backtrace){
      /*<<printexc.ml:242:2>>*/  /*<<printexc.ml:242:8>>*/ var
      match = convert_raw_backtrace(raw_backtrace);
-    if(! match)  /*<<printexc.ml:243:14>>*/ return 0;
+    if(! match)
+      /*<<printexc.ml:243:14>>*/ return 0 /*<<printexc.ml:243:14>>*/ ;
     var backtrace = match[1], i$1 = backtrace.length - 2 | 0, i = i$1;
      /*<<printexc.ml:248:30>>*/ for(;;){
      if(-1 === i)
@@ -22703,18 +22999,18 @@
       }
       var _K_ = _J_;
      }
-      /*<<printexc.ml:251:9>>*/ return _K_ ? [0, backtrace] : 0;
+      /*<<printexc.ml:251:9>>*/ return _K_ ? [0, backtrace] : 0 /*<<printexc.ml:253:15>>*/ ;
     }
     /*<<printexc.ml:253:15>>*/ }
    function backtrace_slots_of_raw_entry(entry){
-     /*<<printexc.ml:256:2>>*/ return backtrace_slots([0, entry]);
+     /*<<printexc.ml:256:2>>*/ return backtrace_slots([0, entry]) /*<<printexc.ml:256:29>>*/ ;
     /*<<printexc.ml:256:29>>*/ }
    function raw_backtrace_length(bt){
      /*<<printexc.ml:267:30>>*/ return bt.length - 1;
     /*<<printexc.ml:267:45>>*/ }
    function get_backtrace(param){
      /*<<printexc.ml:278:23>>*/ return raw_backtrace_to_string
-            ( /*<<printexc.ml:278:47>>*/ caml_get_exception_raw_backtra(0));
+            ( /*<<printexc.ml:278:47>>*/ caml_get_exception_raw_backtra(0)) /*<<printexc.ml:278:69>>*/ ;
     /*<<printexc.ml:278:69>>*/ }
    function register_printer(fn){
      /*<<printexc.ml:284:2>>*/ for(;;){
@@ -22726,24 +23022,25 @@
          /*<<printexc.ml:286:16>>*/ caml_call3
          (Stdlib_Atomic[6], printers, old_printers, new_printers),
        /*<<printexc.ml:287:2>>*/ _I_ = 1 - success;
-     if(! _I_)  /*<<printexc.ml:287:2>>*/ return _I_;
+     if(! _I_)
+       /*<<printexc.ml:287:2>>*/ return _I_ /*<<printexc.ml:287:2>>*/ ;
     }
     /*<<printexc.ml:287:41>>*/ }
    function exn_slot(x){
      /*<<printexc.ml:292:2>>*/ return 0
             ===  /*<<printexc.ml:293:5>>*/ caml_obj_tag(x)
             ? x[1]
-            : x;
+            : x /*<<printexc.ml:293:44>>*/ ;
     /*<<printexc.ml:293:44>>*/ }
    function exn_slot_id(x){
      /*<<printexc.ml:296:2>>*/  /*<<printexc.ml:296:13>>*/ var
      slot = exn_slot(x);
-     /*<<printexc.ml:297:11>>*/ return slot[2];
+     /*<<printexc.ml:297:11>>*/ return slot[2] /*<<printexc.ml:297:11>>*/ ;
     /*<<printexc.ml:297:36>>*/ }
    function exn_slot_name(x){
      /*<<printexc.ml:300:2>>*/  /*<<printexc.ml:300:13>>*/ var
      slot = exn_slot(x);
-     /*<<printexc.ml:301:11>>*/ return slot[1];
+     /*<<printexc.ml:301:11>>*/ return slot[1] /*<<printexc.ml:301:11>>*/ ;
     /*<<printexc.ml:301:39>>*/ }
    var
     errors =
@@ -22775,7 +23072,7 @@
       (Stdlib[53], _H_);
     }
      /*<<printexc.ml:327:4>>*/ return  /*<<printexc.ml:327:4>>*/ caml_call1
-            (Stdlib[63], Stdlib[40]);
+            (Stdlib[63], Stdlib[40]) /*<<printexc.ml:328:14>>*/ ;
     /*<<printexc.ml:328:14>>*/ }
     /*<<printexc.ml:330:33>>*/  /*<<printexc.ml:330:33>>*/ var
     uncaught_exception_handler = [0, default_uncaught_exception_han];
@@ -22846,9 +23143,10 @@
           /*<<printexc.ml:365:8>>*/ caml_call1
           (Stdlib[53], cst_Fatal_error_out_of_memory_);
      }
-      /*<<printexc.ml:372:4>>*/ return _B_;
+      /*<<printexc.ml:372:4>>*/ return _B_ /*<<printexc.ml:372:4>>*/ ;
+    }
+    catch(_C_){ /*<<printexc.ml:375:4>>*/ return 0 /*<<printexc.ml:375:4>>*/ ;
     }
-    catch(_C_){ /*<<printexc.ml:375:4>>*/ return 0;}
     /*<<printexc.ml:375:6>>*/ }
     /*<<printexc.ml:381:2>>*/  /*<<printexc.ml:381:2>>*/ runtime.caml_register_named_value
     ("Printexc.handle_uncaught_exception", handle_uncaught_exception);
@@ -22922,17 +23220,17 @@
     Stdlib_Printexc = global_data.Stdlib__Printexc,
     Stdlib = global_data.Stdlib;
    function const$0(c, param){
-     /*<<fun.ml:17:16>>*/ return c;
+     /*<<fun.ml:17:16>>*/ return c /*<<fun.ml:17:16>>*/ ;
     /*<<fun.ml:17:17>>*/ }
    function compose(f, g, x){
      /*<<fun.ml:18:20>>*/ return  /*<<fun.ml:18:22>>*/ caml_call1
-            (f,  /*<<fun.ml:18:22>>*/ caml_call1(g, x));
+            (f,  /*<<fun.ml:18:22>>*/ caml_call1(g, x)) /*<<fun.ml:18:27>>*/ ;
     /*<<fun.ml:18:27>>*/ }
    function flip(f, x, y){
-     /*<<fun.ml:19:17>>*/ return  /*<<fun.ml:19:17>>*/ caml_call2(f, y, x);
+     /*<<fun.ml:19:17>>*/ return  /*<<fun.ml:19:17>>*/ caml_call2(f, y, x) /*<<fun.ml:19:22>>*/ ;
     /*<<fun.ml:19:22>>*/ }
    function negate(p, v){
-     /*<<fun.ml:20:17>>*/ return 1 -  /*<<fun.ml:20:21>>*/ caml_call1(p, v);
+     /*<<fun.ml:20:17>>*/ return 1 -  /*<<fun.ml:20:21>>*/ caml_call1(p, v) /*<<fun.ml:20:21>>*/ ;
     /*<<fun.ml:20:26>>*/ }
     /*<<fun.ml:22:0>>*/ var
      /*<<fun.ml:22:0>>*/ Finally_raised =
@@ -22942,21 +23240,21 @@
     (Stdlib_Printexc[9],
      function(param){
        /*<<fun.ml:24:38>>*/ if(param[1] !== Finally_raised)
-        /*<<fun.ml:26:7>>*/ return 0;
+        /*<<fun.ml:26:7>>*/ return 0 /*<<fun.ml:26:7>>*/ ;
        /*<<fun.ml:25:55>>*/ var
        exn = param[2],
         /*<<fun.ml:25:55>>*/ _a_ =
           /*<<fun.ml:25:55>>*/ caml_call1(Stdlib_Printexc[1], exn);
        /*<<fun.ml:25:24>>*/ return [0,
                /*<<fun.ml:25:29>>*/ caml_call2
-               (Stdlib[28], cst_Fun_Finally_raised, _a_)];
+               (Stdlib[28], cst_Fun_Finally_raised, _a_)] /*<<fun.ml:25:24>>*/ ;
       /*<<fun.ml:26:11>>*/ });
    var dummy = 0;
    function protect(finally$0, work){
     function finally_no_exn(param){
       /*<<fun.ml:30:4>>*/ try{
        /*<<fun.ml:30:8>>*/  /*<<fun.ml:30:8>>*/ caml_call1(finally$0, 0);
-       /*<<fun.ml:30:8>>*/ return;
+       /*<<fun.ml:30:8>>*/ return /*<<fun.ml:30:8>>*/ ;
      }
      catch(e$0){
        /*<<fun.ml:31:15>>*/ var
@@ -22984,7 +23282,7 @@
             (work_exn, 0);
     }
      /*<<fun.ml:35:14>>*/ finally_no_exn(0);
-     /*<<fun.ml:35:14>>*/ return result;
+     /*<<fun.ml:35:14>>*/ return result /*<<fun.ml:35:14>>*/ ;
     /*<<fun.ml:39:52>>*/ }
    var
     Stdlib_Fun = [0, const$0, compose, flip, negate, protect, Finally_raised];
@@ -23101,9 +23399,10 @@
        [11, "heap_chunks: ", [4, 0, 0, 0, [12, 10, 0]]],
        "heap_chunks: %d\n"];
    function eventlog_pause(param){
-     /*<<gc.ml:65:24>>*/ return 0;
+     /*<<gc.ml:65:24>>*/ return 0 /*<<gc.ml:65:24>>*/ ;
     /*<<gc.ml:65:26>>*/ }
-   function eventlog_resume(param){ /*<<gc.ml:66:25>>*/ return 0;
+   function eventlog_resume(param){
+     /*<<gc.ml:66:25>>*/ return 0 /*<<gc.ml:66:25>>*/ ;
     /*<<gc.ml:66:27>>*/ }
    function print_stat(c){
      /*<<gc.ml:71:2>>*/  /*<<gc.ml:71:11>>*/ var
@@ -23152,7 +23451,7 @@
      (Stdlib_Printf[1], c, _s_, st[9]);
      /*<<gc.ml:91:2>>*/  /*<<gc.ml:91:2>>*/ caml_call3
      (Stdlib_Printf[1], c, _t_, st[11]);
-    return caml_call3(Stdlib_Printf[1], c, _u_, st[7]);
+    return caml_call3(Stdlib_Printf[1], c, _u_, st[7]) /*<<gc.ml:92:46>>*/ ;
     /*<<gc.ml:92:46>>*/ }
    function allocated_bytes(param){
      /*<<gc.ml:96:2>>*/ var
@@ -23161,11 +23460,11 @@
      ma = match[3],
      pro = match[2],
      mi = match[1];
-     /*<<gc.ml:97:2>>*/ return (mi + ma - pro) * (Stdlib_Sys[9] / 8 | 0);
+     /*<<gc.ml:97:2>>*/ return (mi + ma - pro) * (Stdlib_Sys[9] / 8 | 0) /*<<gc.ml:97:2>>*/ ;
     /*<<gc.ml:97:55>>*/ }
    function delete_alarm(a){
      /*<<gc.ml:115:21>>*/ return  /*<<gc.ml:115:21>>*/ caml_call2
-            (Stdlib_Atomic[4], a, 0);
+            (Stdlib_Atomic[4], a, 0) /*<<gc.ml:115:39>>*/ ;
     /*<<gc.ml:115:39>>*/ }
    function create_alarm(f){
      /*<<gc.ml:118:2>>*/  /*<<gc.ml:118:24>>*/ var
@@ -23173,22 +23472,32 @@
      /*<<gc.ml:119:2>>*/  /*<<gc.ml:119:2>>*/ caml_call1
      (Stdlib_Domain[6],
       function(param){
-        /*<<gc.ml:119:28>>*/ return delete_alarm(_y_);
+        /*<<gc.ml:119:28>>*/ return delete_alarm(_y_) /*<<gc.ml:119:52>>*/ ;
        /*<<gc.ml:119:52>>*/ });
     return _y_;
     /*<<gc.ml:121:13>>*/ }
     /*<<gc.ml:142:23>>*/  /*<<gc.ml:142:23>>*/ var
     null_tracker =
       [0,
-       function(param){ /*<<gc.ml:143:30>>*/ return 0; /*<<gc.ml:143:34>>*/ },
-       function(param){ /*<<gc.ml:144:30>>*/ return 0; /*<<gc.ml:144:34>>*/ },
-       function(param){ /*<<gc.ml:145:26>>*/ return 0; /*<<gc.ml:145:30>>*/ },
-       function(param){ /*<<gc.ml:146:32>>*/ return 0; /*<<gc.ml:146:34>>*/ },
-       function(param){ /*<<gc.ml:147:32>>*/ return 0; /*<<gc.ml:147:34>>*/ }];
+       function(param){
+         /*<<gc.ml:143:30>>*/ return 0 /*<<gc.ml:143:30>>*/ ;
+        /*<<gc.ml:143:34>>*/ },
+       function(param){
+         /*<<gc.ml:144:30>>*/ return 0 /*<<gc.ml:144:30>>*/ ;
+        /*<<gc.ml:144:34>>*/ },
+       function(param){
+         /*<<gc.ml:145:26>>*/ return 0 /*<<gc.ml:145:26>>*/ ;
+        /*<<gc.ml:145:30>>*/ },
+       function(param){
+         /*<<gc.ml:146:32>>*/ return 0 /*<<gc.ml:146:32>>*/ ;
+        /*<<gc.ml:146:34>>*/ },
+       function(param){
+         /*<<gc.ml:147:32>>*/ return 0 /*<<gc.ml:147:32>>*/ ;
+        /*<<gc.ml:147:34>>*/ }];
    function start(sampling_rate, opt, tracker){
     var callstack_size = opt ? opt[1] : Stdlib[19];
      /*<<gc.ml:158:6>>*/ return  /*<<gc.ml:158:6>>*/ runtime.caml_memprof_start
-            (sampling_rate, callstack_size, tracker);
+            (sampling_rate, callstack_size, tracker) /*<<gc.ml:158:6>>*/ ;
    }
    var
     Stdlib_Gc =
@@ -23269,24 +23578,24 @@
             (Stdlib_Fun[5],
              function(param){
                /*<<in_channel.ml:36:34>>*/ return  /*<<in_channel.ml:37:4>>*/ caml_call1
-                      (Stdlib[94], ic);
+                      (Stdlib[94], ic) /*<<in_channel.ml:36:58>>*/ ;
               /*<<in_channel.ml:36:58>>*/ },
              function(param){
                /*<<in_channel.ml:37:15>>*/ return  /*<<in_channel.ml:36:2>>*/ caml_call1
-                      (f, ic);
-              /*<<in_channel.ml:37:19>>*/ });
+                      (f, ic) /*<<in_channel.ml:37:19>>*/ ;
+              /*<<in_channel.ml:37:19>>*/ }) /*<<in_channel.ml:37:20>>*/ ;
     /*<<in_channel.ml:37:20>>*/ }
    function with_open_bin(s, f){
-     /*<<in_channel.ml:40:2>>*/ return with_open(Stdlib[80], s, f);
+     /*<<in_channel.ml:40:2>>*/ return with_open(Stdlib[80], s, f) /*<<in_channel.ml:40:34>>*/ ;
     /*<<in_channel.ml:40:34>>*/ }
    function with_open_text(s, f){
-     /*<<in_channel.ml:43:2>>*/ return with_open(Stdlib[79], s, f);
+     /*<<in_channel.ml:43:2>>*/ return with_open(Stdlib[79], s, f) /*<<in_channel.ml:43:30>>*/ ;
     /*<<in_channel.ml:43:30>>*/ }
    function with_open_gen(flags, perm, s, f){
      /*<<in_channel.ml:46:2>>*/ return with_open
             ( /*<<in_channel.ml:46:12>>*/ caml_call2(Stdlib[81], flags, perm),
              s,
-             f);
+             f) /*<<in_channel.ml:46:47>>*/ ;
     /*<<in_channel.ml:46:47>>*/ }
    var
     seek = Stdlib[96][4],
@@ -23301,10 +23610,11 @@
     }
     catch(_x_){
      var _w_ = caml_wrap_exception(_x_);
-     if(_w_ === Stdlib[12])  /*<<in_channel.ml:57:29>>*/ return 0;
+     if(_w_ === Stdlib[12])
+       /*<<in_channel.ml:57:29>>*/ return 0 /*<<in_channel.ml:57:29>>*/ ;
      throw caml_maybe_attach_backtrace(_w_, 0);
     }
-     /*<<in_channel.ml:56:9>>*/ return [0, c];
+     /*<<in_channel.ml:56:9>>*/ return [0, c] /*<<in_channel.ml:56:9>>*/ ;
     /*<<in_channel.ml:57:33>>*/ }
    function input_byte(ic){
      /*<<in_channel.ml:60:2>>*/ try{
@@ -23313,10 +23623,11 @@
     }
     catch(_v_){
      var _u_ = caml_wrap_exception(_v_);
-     if(_u_ === Stdlib[12])  /*<<in_channel.ml:62:29>>*/ return 0;
+     if(_u_ === Stdlib[12])
+       /*<<in_channel.ml:62:29>>*/ return 0 /*<<in_channel.ml:62:29>>*/ ;
      throw caml_maybe_attach_backtrace(_u_, 0);
     }
-     /*<<in_channel.ml:61:9>>*/ return [0, n];
+     /*<<in_channel.ml:61:9>>*/ return [0, n] /*<<in_channel.ml:61:9>>*/ ;
     /*<<in_channel.ml:62:33>>*/ }
    function input_line(ic){
      /*<<in_channel.ml:65:2>>*/ try{
@@ -23325,10 +23636,11 @@
     }
     catch(_t_){
      var _s_ = caml_wrap_exception(_t_);
-     if(_s_ === Stdlib[12])  /*<<in_channel.ml:67:29>>*/ return 0;
+     if(_s_ === Stdlib[12])
+       /*<<in_channel.ml:67:29>>*/ return 0 /*<<in_channel.ml:67:29>>*/ ;
      throw caml_maybe_attach_backtrace(_s_, 0);
     }
-     /*<<in_channel.ml:66:9>>*/ return [0, s];
+     /*<<in_channel.ml:66:9>>*/ return [0, s] /*<<in_channel.ml:66:9>>*/ ;
     /*<<in_channel.ml:67:33>>*/ }
    var
     input = Stdlib[84],
@@ -23345,19 +23657,20 @@
        0 <= len
        && ( /*<<in_channel.ml:76:33>>*/ caml_ba_dim_1(buf) - len | 0) >= ofs)
       /*<<in_channel.ml:78:7>>*/ return  /*<<in_channel.ml:78:7>>*/ caml_ml_input_bigarray
-             (ic, buf, ofs, len);
+             (ic, buf, ofs, len) /*<<in_channel.ml:78:43>>*/ ;
      /*<<in_channel.ml:77:7>>*/ return  /*<<in_channel.ml:77:7>>*/ caml_call1
-            (Stdlib[1], cst_input_bigarray);
+            (Stdlib[1], cst_input_bigarray) /*<<in_channel.ml:78:43>>*/ ;
     /*<<in_channel.ml:78:43>>*/ }
    function really_input(ic, buf, pos, len){
      /*<<in_channel.ml:81:2>>*/ try{
       /*<<in_channel.ml:81:8>>*/  /*<<in_channel.ml:81:8>>*/ caml_call4
       (Stdlib[85], ic, buf, pos, len);
-      /*<<in_channel.ml:82:10>>*/ return _a_;
+      /*<<in_channel.ml:82:10>>*/ return _a_ /*<<in_channel.ml:82:10>>*/ ;
     }
     catch(_r_){
      var _q_ = caml_wrap_exception(_r_);
-     if(_q_ === Stdlib[12])  /*<<in_channel.ml:83:29>>*/ return 0;
+     if(_q_ === Stdlib[12])
+       /*<<in_channel.ml:83:29>>*/ return 0 /*<<in_channel.ml:83:29>>*/ ;
      throw caml_maybe_attach_backtrace(_q_, 0);
     }
     /*<<in_channel.ml:83:33>>*/ }
@@ -23370,20 +23683,21 @@
         ( /*<<in_channel.ml:94:33>>*/ caml_ba_dim_1(buf) - len$1 | 0) >= ofs$1){
      var ofs = ofs$1, len = len$1;
       /*<<in_channel.ml:86:2>>*/ for(;;){
-      if(0 >= len)  /*<<in_channel.ml:86:19>>*/ return _b_;
+      if(0 >= len)
+        /*<<in_channel.ml:86:19>>*/ return _b_ /*<<in_channel.ml:86:19>>*/ ;
        /*<<in_channel.ml:87:12>>*/  /*<<in_channel.ml:87:12>>*/ var
        r =
           /*<<in_channel.ml:87:12>>*/ caml_ml_input_bigarray
           (ic, buf, ofs, len);
        /*<<in_channel.ml:88:4>>*/ if(0 === r)
-        /*<<in_channel.ml:89:9>>*/ return 0;
+        /*<<in_channel.ml:89:9>>*/ return 0 /*<<in_channel.ml:89:9>>*/ ;
       var len$0 = len - r | 0, ofs$0 = ofs + r | 0;
       ofs = ofs$0;
       len = len$0;
      }
     }
      /*<<in_channel.ml:95:7>>*/ return  /*<<in_channel.ml:95:7>>*/ caml_call1
-            (Stdlib[1], cst_really_input_bigarray);
+            (Stdlib[1], cst_really_input_bigarray) /*<<in_channel.ml:96:50>>*/ ;
     /*<<in_channel.ml:96:50>>*/ }
    function really_input_string(ic, len){
      /*<<in_channel.ml:99:2>>*/ try{
@@ -23392,10 +23706,11 @@
     }
     catch(_p_){
      var _o_ = caml_wrap_exception(_p_);
-     if(_o_ === Stdlib[12])  /*<<in_channel.ml:101:29>>*/ return 0;
+     if(_o_ === Stdlib[12])
+       /*<<in_channel.ml:101:29>>*/ return 0 /*<<in_channel.ml:101:29>>*/ ;
      throw caml_maybe_attach_backtrace(_o_, 0);
     }
-     /*<<in_channel.ml:100:9>>*/ return [0, s];
+     /*<<in_channel.ml:100:9>>*/ return [0, s] /*<<in_channel.ml:100:9>>*/ ;
     /*<<in_channel.ml:101:33>>*/ }
    function read_upto(ic, buf, ofs, len){
      /*<<in_channel.ml:106:2>>*/ var ofs$0 = ofs, len$0 = len;
@@ -23412,12 +23727,13 @@
        continue;
       }
      }
-      /*<<in_channel.ml:116:2>>*/ return ofs$0 - ofs | 0;
+      /*<<in_channel.ml:116:2>>*/ return ofs$0 - ofs | 0 /*<<in_channel.ml:116:2>>*/ ;
     }
     /*<<in_channel.ml:116:20>>*/ }
    function ensure(buf, ofs, n){
      /*<<in_channel.ml:131:2>>*/ var len = caml_ml_bytes_length(buf);
-    if((ofs + n | 0) <= len)  /*<<in_channel.ml:132:25>>*/ return buf;
+    if((ofs + n | 0) <= len)
+      /*<<in_channel.ml:132:25>>*/ return buf /*<<in_channel.ml:132:25>>*/ ;
      /*<<in_channel.ml:134:18>>*/  /*<<in_channel.ml:134:18>>*/ var
      new_len = [0, len];
     for(;;){
@@ -23438,7 +23754,7 @@
         /*<<in_channel.ml:148:18>>*/ caml_create_bytes(new_len$1);
      /*<<in_channel.ml:149:4>>*/  /*<<in_channel.ml:149:4>>*/ caml_call5
      (Stdlib_Bytes[11], buf, 0, new_buf, 0, ofs);
-     /*<<in_channel.ml:149:4>>*/ return new_buf;
+     /*<<in_channel.ml:149:4>>*/ return new_buf /*<<in_channel.ml:149:4>>*/ ;
     /*<<in_channel.ml:151:5>>*/ }
    function input_all(ic){
      /*<<in_channel.ml:154:2>>*/  /*<<in_channel.ml:154:2>>*/ var
@@ -23467,7 +23783,7 @@
        read_upto(ic, buf, 0, initial_size$1);
     if(nread < initial_size$1)
       /*<<in_channel.ml:171:4>>*/ return  /*<<in_channel.ml:171:4>>*/ caml_call3
-             (Stdlib_Bytes[8], buf, 0, nread);
+             (Stdlib_Bytes[8], buf, 0, nread) /*<<in_channel.ml:193:5>>*/ ;
      /*<<in_channel.ml:172:7>>*/ try{
       /*<<in_channel.ml:173:10>>*/  /*<<in_channel.ml:173:10>>*/ var
       c =  /*<<in_channel.ml:173:10>>*/ caml_call1(Stdlib[82], ic);
@@ -23476,7 +23792,7 @@
      var _j_ = caml_wrap_exception(_m_);
      if(_j_ === Stdlib[12])
        /*<<in_channel.ml:176:8>>*/ return  /*<<in_channel.ml:176:8>>*/ caml_call1
-              (Stdlib_Bytes[44], buf);
+              (Stdlib_Bytes[44], buf) /*<<in_channel.ml:193:5>>*/ ;
      throw caml_maybe_attach_backtrace(_j_, 0);
     }
      /*<<in_channel.ml:190:18>>*/  /*<<in_channel.ml:190:18>>*/ var
@@ -23494,7 +23810,7 @@
        /*<<in_channel.ml:184:18>>*/ r = read_upto(ic, buf$1, ofs, rem);
      if(r < rem)
        /*<<in_channel.ml:180:20>>*/ return  /*<<in_channel.ml:180:20>>*/ caml_call3
-              (Stdlib_Bytes[8], buf$1, 0, ofs + r | 0);
+              (Stdlib_Bytes[8], buf$1, 0, ofs + r | 0) /*<<in_channel.ml:193:5>>*/ ;
      var ofs$0 = ofs + rem | 0;
      buf$0 = buf$1;
      ofs = ofs$0;
@@ -23507,7 +23823,8 @@
     }
     catch(_h_){
      var _e_ = caml_wrap_exception(_h_);
-     if(_e_ === Stdlib[12])  /*<<in_channel.ml:198:29>>*/ return 0;
+     if(_e_ === Stdlib[12])
+       /*<<in_channel.ml:198:29>>*/ return 0 /*<<in_channel.ml:198:29>>*/ ;
      throw caml_maybe_attach_backtrace(_e_, 0);
     }
      /*<<in_channel.ml:197:12>>*/ var
@@ -23523,7 +23840,7 @@
       var _f_ = caml_wrap_exception(_g_);
       if(_f_ !== Stdlib[12]) throw caml_maybe_attach_backtrace(_f_, 0);
       dst[1 + offset] = 0;
-       /*<<in_channel.ml:197:20>>*/ return block;
+       /*<<in_channel.ml:197:20>>*/ return block /*<<in_channel.ml:197:20>>*/ ;
      }
       /*<<in_channel.ml:197:12>>*/  /*<<in_channel.ml:197:12>>*/ var
       dst$0 = [0, line$0, 24029];
@@ -23541,7 +23858,8 @@
      }
      catch(_d_){
       var _c_ = caml_wrap_exception(_d_);
-      if(_c_ === Stdlib[12])  /*<<in_channel.ml:203:29>>*/ return accu$0;
+      if(_c_ === Stdlib[12])
+        /*<<in_channel.ml:203:29>>*/ return accu$0 /*<<in_channel.ml:203:29>>*/ ;
       throw caml_maybe_attach_backtrace(_c_, 0);
      }
       /*<<in_channel.ml:202:25>>*/  /*<<in_channel.ml:202:25>>*/ var
@@ -23616,24 +23934,24 @@
             (Stdlib_Fun[5],
              function(param){
                /*<<out_channel.ml:37:34>>*/ return  /*<<out_channel.ml:38:4>>*/ caml_call1
-                      (Stdlib[77], oc);
+                      (Stdlib[77], oc) /*<<out_channel.ml:37:59>>*/ ;
               /*<<out_channel.ml:37:59>>*/ },
              function(param){
                /*<<out_channel.ml:38:15>>*/ return  /*<<out_channel.ml:37:2>>*/ caml_call1
-                      (f, oc);
-              /*<<out_channel.ml:38:19>>*/ });
+                      (f, oc) /*<<out_channel.ml:38:19>>*/ ;
+              /*<<out_channel.ml:38:19>>*/ }) /*<<out_channel.ml:38:20>>*/ ;
     /*<<out_channel.ml:38:20>>*/ }
    function with_open_bin(s, f){
-     /*<<out_channel.ml:41:2>>*/ return with_open(Stdlib[61], s, f);
+     /*<<out_channel.ml:41:2>>*/ return with_open(Stdlib[61], s, f) /*<<out_channel.ml:41:35>>*/ ;
     /*<<out_channel.ml:41:35>>*/ }
    function with_open_text(s, f){
-     /*<<out_channel.ml:44:2>>*/ return with_open(Stdlib[60], s, f);
+     /*<<out_channel.ml:44:2>>*/ return with_open(Stdlib[60], s, f) /*<<out_channel.ml:44:31>>*/ ;
     /*<<out_channel.ml:44:31>>*/ }
    function with_open_gen(flags, perm, s, f){
      /*<<out_channel.ml:47:2>>*/ return with_open
             ( /*<<out_channel.ml:47:12>>*/ caml_call2(Stdlib[62], flags, perm),
              s,
-             f);
+             f) /*<<out_channel.ml:47:48>>*/ ;
     /*<<out_channel.ml:47:48>>*/ }
    var
     seek = Stdlib[96][1],
@@ -23659,9 +23977,9 @@
         ( /*<<out_channel.ml:67:33>>*/ runtime.caml_ba_dim_1(buf) - len | 0)
         >= ofs)
       /*<<out_channel.ml:69:7>>*/ return  /*<<out_channel.ml:69:7>>*/ runtime.caml_ml_output_bigarray
-             (oc, buf, ofs, len);
+             (oc, buf, ofs, len) /*<<out_channel.ml:69:44>>*/ ;
      /*<<out_channel.ml:68:7>>*/ return  /*<<out_channel.ml:68:7>>*/ caml_call1
-            (Stdlib[1], cst_output_bigarray);
+            (Stdlib[1], cst_output_bigarray) /*<<out_channel.ml:69:44>>*/ ;
     /*<<out_channel.ml:69:44>>*/ }
    var
     set_binary_mode = Stdlib[78],
@@ -23752,7 +24070,7 @@
      /*<<digest.ml:19:2>>*/ function char_hex(n){
       /*<<digest.ml:20:4>>*/ var
       _l_ = 10 <= n ? (97 + n | 0) - 10 | 0 : 48 + n | 0;
-     return caml_call1(Stdlib_Char[1], _l_);
+     return caml_call1(Stdlib_Char[1], _l_) /*<<digest.ml:21:52>>*/ ;
      /*<<digest.ml:21:52>>*/ }
      /*<<digest.ml:22:2>>*/ var
       /*<<digest.ml:22:2>>*/ len =
@@ -23774,7 +24092,7 @@
      }
     }
      /*<<digest.ml:29:2>>*/ return  /*<<digest.ml:29:2>>*/ caml_call1
-            (Stdlib_Bytes[44], result);
+            (Stdlib_Bytes[44], result) /*<<digest.ml:29:31>>*/ ;
     /*<<digest.ml:29:31>>*/ }
    function string_of_hex(s){
      /*<<digest.ml:32:2>>*/ function digit(c){
@@ -23786,7 +24104,7 @@
      }
      else if(9 >= c - 48 >>> 0) return c - 48 | 0;
       /*<<digest.ml:37:11>>*/ return  /*<<digest.ml:37:11>>*/ caml_call1
-             (Stdlib[1], cst_Digest_of_hex);
+             (Stdlib[1], cst_Digest_of_hex) /*<<digest.ml:37:38>>*/ ;
      /*<<digest.ml:37:38>>*/ }
      /*<<digest.ml:39:36>>*/ return  /*<<digest.ml:39:36>>*/ caml_call2
             (Stdlib_String[2],
@@ -23803,8 +24121,8 @@
                  + _g_
                  | 0;
                /*<<digest.ml:39:55>>*/ return  /*<<digest.ml:39:55>>*/ caml_call1
-                      (Stdlib_Char[1], _h_);
-              /*<<digest.ml:39:69>>*/ });
+                      (Stdlib_Char[1], _h_) /*<<digest.ml:39:69>>*/ ;
+              /*<<digest.ml:39:69>>*/ }) /*<<digest.ml:39:70>>*/ ;
     /*<<digest.ml:39:70>>*/ }
    function BLAKE2(X){
     var _a_ = X[1] < 1 ? 1 : 0, _b_ = _a_ || (64 < X[1] ? 1 : 0);
@@ -23817,11 +24135,11 @@
      equal = Stdlib_String[9];
     function string(str){
       /*<<digest.ml:85:4>>*/ return  /*<<digest.ml:85:4>>*/ caml_blake2_string
-             (hash_length, cst, str, 0, caml_ml_string_length(str));
+             (hash_length, cst, str, 0, caml_ml_string_length(str)) /*<<digest.ml:85:58>>*/ ;
      /*<<digest.ml:85:58>>*/ }
     function bytes(b){
       /*<<digest.ml:88:4>>*/ return string
-             ( /*<<digest.ml:88:11>>*/ caml_call1(Stdlib_Bytes[44], b));
+             ( /*<<digest.ml:88:11>>*/ caml_call1(Stdlib_Bytes[44], b)) /*<<digest.ml:88:37>>*/ ;
      /*<<digest.ml:88:37>>*/ }
     function substring(str, ofs, len){
       /*<<digest.ml:91:4>>*/ var _d_ = ofs < 0 ? 1 : 0;
@@ -23835,13 +24153,13 @@
        /*<<digest.ml:92:9>>*/  /*<<digest.ml:92:9>>*/ caml_call1
        (Stdlib[1], cst_Digest_substring);
       /*<<digest.ml:93:4>>*/ return  /*<<digest.ml:93:4>>*/ caml_blake2_string
-             (hash_length, cst, str, ofs, len);
+             (hash_length, cst, str, ofs, len) /*<<digest.ml:93:44>>*/ ;
      /*<<digest.ml:93:44>>*/ }
     function subbytes(b, ofs, len){
       /*<<digest.ml:96:4>>*/ return substring
              ( /*<<digest.ml:96:14>>*/ caml_call1(Stdlib_Bytes[44], b),
               ofs,
-              len);
+              len) /*<<digest.ml:96:48>>*/ ;
      /*<<digest.ml:96:48>>*/ }
     function channel(ic, toread){
       /*<<digest.ml:99:4>>*/ var
@@ -23855,7 +24173,7 @@
        /*<<digest.ml:111:8>>*/ for(;;){
        if(0 === toread$0)
          /*<<digest.ml:111:27>>*/ return  /*<<digest.ml:111:27>>*/ caml_blake2_final
-                (ctx, hash_length);
+                (ctx, hash_length) /*<<digest.ml:121:7>>*/ ;
         /*<<digest.ml:112:44>>*/ var
          /*<<digest.ml:112:44>>*/ _c_ =
            /*<<digest.ml:112:44>>*/ caml_call2
@@ -23883,7 +24201,7 @@
            (Stdlib_In_channel[16], ic, buf, 0, buf_size);
         /*<<digest.ml:105:8>>*/ if(0 === n$0)
          /*<<digest.ml:106:13>>*/ return  /*<<digest.ml:106:13>>*/ caml_blake2_final
-                (ctx, hash_length);
+                (ctx, hash_length) /*<<digest.ml:121:7>>*/ ;
         /*<<digest.ml:107:14>>*/  /*<<digest.ml:107:14>>*/ caml_blake2_update
         (ctx,
           /*<<digest.ml:107:25>>*/ caml_call1(Stdlib_Bytes[44], buf),
@@ -23896,29 +24214,29 @@
              (Stdlib_In_channel[5],
               filename,
               function(ic){
-                /*<<digest.ml:124:49>>*/ return channel(ic, -1);
-               /*<<digest.ml:124:64>>*/ });
+                /*<<digest.ml:124:49>>*/ return channel(ic, -1) /*<<digest.ml:124:64>>*/ ;
+               /*<<digest.ml:124:64>>*/ }) /*<<digest.ml:124:65>>*/ ;
      /*<<digest.ml:124:65>>*/ }
     function output(chan, digest){
       /*<<digest.ml:126:27>>*/ return  /*<<digest.ml:126:27>>*/ caml_call2
-             (Stdlib[66], chan, digest);
+             (Stdlib[66], chan, digest) /*<<digest.ml:126:52>>*/ ;
      /*<<digest.ml:126:52>>*/ }
     function input(chan){
       /*<<digest.ml:128:19>>*/ return caml_call2
-             (Stdlib[86], chan, hash_length);
+             (Stdlib[86], chan, hash_length) /*<<digest.ml:128:55>>*/ ;
      /*<<digest.ml:128:55>>*/ }
     function to_hex(d){
       /*<<digest.ml:131:4>>*/ if(caml_ml_string_length(d) !== hash_length)
        /*<<digest.ml:131:43>>*/  /*<<digest.ml:131:43>>*/ caml_call1
        (Stdlib[1], cst_Digest_to_hex);
-      /*<<digest.ml:131:43>>*/ return hex_of_string(d);
+      /*<<digest.ml:131:43>>*/ return hex_of_string(d) /*<<digest.ml:132:19>>*/ ;
      /*<<digest.ml:132:19>>*/ }
     function of_hex(s){
       /*<<digest.ml:135:4>>*/ if
       (caml_ml_string_length(s) !== (hash_length * 2 | 0))
        /*<<digest.ml:135:47>>*/  /*<<digest.ml:135:47>>*/ caml_call1
        (Stdlib[1], cst_Digest_of_hex$0);
-      /*<<digest.ml:135:47>>*/ return string_of_hex(s);
+      /*<<digest.ml:135:47>>*/ return string_of_hex(s) /*<<digest.ml:136:19>>*/ ;
      /*<<digest.ml:136:19>>*/ }
      /*<<digest.ml:62:55>>*/ return [0,
             hash_length,
@@ -23933,7 +24251,7 @@
             output,
             input,
             to_hex,
-            of_hex];
+            of_hex] /*<<digest.ml:62:55>>*/ ;
    }
    var
     BLAKE128 = BLAKE2([0, 16]),
@@ -23946,25 +24264,25 @@
     cst_Digest_from_hex = "Digest.from_hex";
    function string(str){
      /*<<digest.ml:159:4>>*/ return  /*<<digest.ml:159:4>>*/ caml_md5_string
-            (str, 0, caml_ml_string_length(str));
+            (str, 0, caml_ml_string_length(str)) /*<<digest.ml:159:43>>*/ ;
     /*<<digest.ml:159:43>>*/ }
    function bytes(b){
      /*<<digest.ml:161:16>>*/ return string
-            ( /*<<digest.ml:161:23>>*/ caml_call1(Stdlib_Bytes[44], b));
+            ( /*<<digest.ml:161:23>>*/ caml_call1(Stdlib_Bytes[44], b)) /*<<digest.ml:161:49>>*/ ;
     /*<<digest.ml:161:49>>*/ }
    function substring(str, ofs, len){
      /*<<digest.ml:164:4>>*/ if
      (0 <= ofs && 0 <= len && (caml_ml_string_length(str) - len | 0) >= ofs)
       /*<<digest.ml:166:9>>*/ return  /*<<digest.ml:166:9>>*/ caml_md5_string
-             (str, ofs, len);
+             (str, ofs, len) /*<<digest.ml:166:34>>*/ ;
      /*<<digest.ml:165:9>>*/ return  /*<<digest.ml:165:9>>*/ caml_call1
-            (Stdlib[1], cst_Digest_substring$0);
+            (Stdlib[1], cst_Digest_substring$0) /*<<digest.ml:166:34>>*/ ;
     /*<<digest.ml:166:34>>*/ }
    function subbytes(b, ofs, len){
      /*<<digest.ml:168:27>>*/ return substring
             ( /*<<digest.ml:168:37>>*/ caml_call1(Stdlib_Bytes[44], b),
              ofs,
-             len);
+             len) /*<<digest.ml:168:71>>*/ ;
     /*<<digest.ml:168:71>>*/ }
    function file(filename){
      /*<<digest.ml:171:4>>*/ return  /*<<digest.ml:171:38>>*/ caml_call2
@@ -23972,28 +24290,28 @@
              filename,
              function(ic){
                /*<<digest.ml:171:49>>*/ return  /*<<digest.ml:171:49>>*/ caml_md5_chan
-                      (ic, -1);
-              /*<<digest.ml:171:64>>*/ });
+                      (ic, -1) /*<<digest.ml:171:64>>*/ ;
+              /*<<digest.ml:171:64>>*/ }) /*<<digest.ml:171:65>>*/ ;
     /*<<digest.ml:171:65>>*/ }
    function output(chan, digest){
      /*<<digest.ml:173:27>>*/ return  /*<<digest.ml:173:27>>*/ caml_call2
-            (Stdlib[66], chan, digest);
+            (Stdlib[66], chan, digest) /*<<digest.ml:173:52>>*/ ;
     /*<<digest.ml:173:52>>*/ }
    function input(chan){
      /*<<digest.ml:175:19>>*/ return  /*<<digest.ml:175:19>>*/ caml_call2
-            (Stdlib[86], chan, 16);
+            (Stdlib[86], chan, 16) /*<<digest.ml:175:46>>*/ ;
     /*<<digest.ml:175:46>>*/ }
    function to_hex(d){
      /*<<digest.ml:178:4>>*/ if(16 !== caml_ml_string_length(d))
       /*<<digest.ml:178:34>>*/  /*<<digest.ml:178:34>>*/ caml_call1
       (Stdlib[1], cst_Digest_to_hex$0);
-     /*<<digest.ml:178:34>>*/ return hex_of_string(d);
+     /*<<digest.ml:178:34>>*/ return hex_of_string(d) /*<<digest.ml:179:19>>*/ ;
     /*<<digest.ml:179:19>>*/ }
    function of_hex(s){
      /*<<digest.ml:182:4>>*/ if(32 !== caml_ml_string_length(s))
       /*<<digest.ml:182:34>>*/  /*<<digest.ml:182:34>>*/ caml_call1
       (Stdlib[1], cst_Digest_from_hex);
-     /*<<digest.ml:182:34>>*/ return string_of_hex(s);
+     /*<<digest.ml:182:34>>*/ return string_of_hex(s) /*<<digest.ml:183:19>>*/ ;
     /*<<digest.ml:183:19>>*/ }
    var
     Stdlib_Digest =
@@ -24081,32 +24399,32 @@
    function kind_size_in_bytes(param){
      /*<<?>>*/ switch(param){
       case 0:
-        /*<<bigarray.ml:78:15>>*/ return 4;
+        /*<<bigarray.ml:78:15>>*/ return 4 /*<<bigarray.ml:78:15>>*/ ;
       case 1:
-        /*<<bigarray.ml:79:15>>*/ return 8;
+        /*<<bigarray.ml:79:15>>*/ return 8 /*<<bigarray.ml:79:15>>*/ ;
       case 2:
-        /*<<bigarray.ml:80:19>>*/ return 1;
+        /*<<bigarray.ml:80:19>>*/ return 1 /*<<bigarray.ml:80:19>>*/ ;
       case 3:
-        /*<<bigarray.ml:81:21>>*/ return 1;
+        /*<<bigarray.ml:81:21>>*/ return 1 /*<<bigarray.ml:81:21>>*/ ;
       case 4:
-        /*<<bigarray.ml:82:20>>*/ return 2;
+        /*<<bigarray.ml:82:20>>*/ return 2 /*<<bigarray.ml:82:20>>*/ ;
       case 5:
-        /*<<bigarray.ml:83:22>>*/ return 2;
+        /*<<bigarray.ml:83:22>>*/ return 2 /*<<bigarray.ml:83:22>>*/ ;
       case 6:
-        /*<<bigarray.ml:84:13>>*/ return 4;
+        /*<<bigarray.ml:84:13>>*/ return 4 /*<<bigarray.ml:84:13>>*/ ;
       case 7:
-        /*<<bigarray.ml:85:13>>*/ return 8;
+        /*<<bigarray.ml:85:13>>*/ return 8 /*<<bigarray.ml:85:13>>*/ ;
       case 8:
        return Stdlib_Sys[9] / 8 | 0;
       case 9:
        return Stdlib_Sys[9] / 8 | 0;
       case 10:
-        /*<<bigarray.ml:88:17>>*/ return 8;
+        /*<<bigarray.ml:88:17>>*/ return 8 /*<<bigarray.ml:88:17>>*/ ;
       case 11:
-        /*<<bigarray.ml:89:17>>*/ return 16;
+        /*<<bigarray.ml:89:17>>*/ return 16 /*<<bigarray.ml:89:17>>*/ ;
       case 12:
-        /*<<bigarray.ml:90:12>>*/ return 1;
-      default:  /*<<bigarray.ml:77:15>>*/ return 2;
+        /*<<bigarray.ml:90:12>>*/ return 1 /*<<bigarray.ml:90:12>>*/ ;
+      default:  /*<<bigarray.ml:77:15>>*/ return 2 /*<<bigarray.ml:77:15>>*/ ;
     }
    }
    var
@@ -24122,7 +24440,7 @@
      /*<<bigarray.ml:108:4>>*/ if(col === idx.length - 1){
       /*<<bigarray.ml:108:35>>*/  /*<<bigarray.ml:108:35>>*/ caml_ba_set_generic
       (arr, idx,  /*<<bigarray.ml:108:47>>*/ caml_call1(f, idx));
-      /*<<bigarray.ml:108:35>>*/ return;
+      /*<<bigarray.ml:108:35>>*/ return /*<<bigarray.ml:108:35>>*/ ;
     }
      /*<<bigarray.ml:109:27>>*/ var
       /*<<bigarray.ml:109:27>>*/ _am_ =
@@ -24144,7 +24462,7 @@
      /*<<bigarray.ml:114:4>>*/ if(0 > col){
       /*<<bigarray.ml:114:20>>*/  /*<<bigarray.ml:114:20>>*/ caml_ba_set_generic
       (arr, idx,  /*<<bigarray.ml:114:32>>*/ caml_call1(f, idx));
-      /*<<bigarray.ml:114:20>>*/ return;
+      /*<<bigarray.ml:114:20>>*/ return /*<<bigarray.ml:114:20>>*/ ;
     }
      /*<<bigarray.ml:115:22>>*/ var
       /*<<bigarray.ml:115:22>>*/ _aj_ = caml_check_bound(max, col)[1 + col],
@@ -24180,7 +24498,7 @@
                 f,
                 0,
                 dims),
-              arr);
+              arr) /*<<bigarray.ml:124:77>>*/ ;
     /*<<bigarray.ml:124:77>>*/ }
    function dims(a){
      /*<<bigarray.ml:129:4>>*/ var
@@ -24202,7 +24520,7 @@
       i = _ah_;
      }
     }
-     /*<<bigarray.ml:132:4>>*/ return d;
+     /*<<bigarray.ml:132:4>>*/ return d /*<<bigarray.ml:132:4>>*/ ;
     /*<<bigarray.ml:132:5>>*/ }
    function size_in_bytes(arr){
      /*<<bigarray.ml:140:4>>*/ var
@@ -24212,47 +24530,47 @@
         (Stdlib_Array[18], caml_mul, 1, _ac_);
      /*<<bigarray.ml:140:4>>*/ return  /*<<bigarray.ml:140:4>>*/ caml_mul
             (kind_size_in_bytes( /*<<bigarray.ml:140:24>>*/ caml_ba_kind(arr)),
-             _ad_);
+             _ad_) /*<<bigarray.ml:140:74>>*/ ;
     /*<<bigarray.ml:140:74>>*/ }
    function create(kind, layout){
      /*<<bigarray.ml:161:4>>*/ return  /*<<bigarray.ml:161:4>>*/ caml_ba_create
-            (kind, layout, [0]);
+            (kind, layout, [0]) /*<<bigarray.ml:161:36>>*/ ;
     /*<<bigarray.ml:161:36>>*/ }
    function get(arr){
      /*<<bigarray.ml:162:16>>*/ return  /*<<bigarray.ml:162:16>>*/ runtime.caml_ba_get_generic
-            (arr, [0]);
+            (arr, [0]) /*<<bigarray.ml:162:37>>*/ ;
     /*<<bigarray.ml:162:37>>*/ }
    function set(arr){
      /*<<bigarray.ml:163:16>>*/  /*<<bigarray.ml:163:16>>*/ var _aa_ = [0];
      /*<<bigarray.ml:163:33>>*/ return function(_ab_){
-      /*<<?>>*/ return caml_ba_set_generic(arr, _aa_, _ab_);};
+      /*<<?>>*/ return caml_ba_set_generic(arr, _aa_, _ab_);} /*<<bigarray.ml:163:33>>*/ ;
     /*<<bigarray.ml:163:37>>*/ }
    function size_in_bytes$0(arr){
      /*<<bigarray.ml:170:26>>*/ return kind_size_in_bytes
-            ( /*<<bigarray.ml:170:45>>*/ caml_ba_kind(arr));
+            ( /*<<bigarray.ml:170:45>>*/ caml_ba_kind(arr)) /*<<bigarray.ml:170:55>>*/ ;
     /*<<bigarray.ml:170:55>>*/ }
    function of_value(kind, layout, v){
      /*<<bigarray.ml:176:4>>*/  /*<<bigarray.ml:176:12>>*/ var
      a = create(kind, layout);
      /*<<bigarray.ml:177:4>>*/ set(a)(v);
-     /*<<bigarray.ml:177:4>>*/ return a;
+     /*<<bigarray.ml:177:4>>*/ return a /*<<bigarray.ml:177:4>>*/ ;
     /*<<bigarray.ml:178:5>>*/ }
    function create$0(kind, layout, dim){
      /*<<bigarray.ml:185:4>>*/ return  /*<<bigarray.ml:185:4>>*/ caml_ba_create
-            (kind, layout, [0, dim]);
+            (kind, layout, [0, dim]) /*<<bigarray.ml:185:39>>*/ ;
     /*<<bigarray.ml:185:39>>*/ }
    function size_in_bytes$1(arr){
      /*<<bigarray.ml:199:4>>*/  /*<<bigarray.ml:199:38>>*/ var
      _$_ =  /*<<bigarray.ml:199:38>>*/ caml_ba_dim_1(arr);
      /*<<bigarray.ml:199:4>>*/ return  /*<<bigarray.ml:199:4>>*/ caml_mul
             (kind_size_in_bytes( /*<<bigarray.ml:199:24>>*/ caml_ba_kind(arr)),
-             _$_);
+             _$_) /*<<bigarray.ml:199:47>>*/ ;
     /*<<bigarray.ml:199:47>>*/ }
    function slice(a, n){
      /*<<bigarray.ml:203:4>>*/ return  /*<<bigarray.ml:203:10>>*/ runtime.caml_ba_layout
              (a)
             ?  /*<<bigarray.ml:205:25>>*/ caml_ba_slice(a, [0, n])
-            :  /*<<bigarray.ml:204:19>>*/ caml_ba_slice(a, [0, n]);
+            :  /*<<bigarray.ml:204:19>>*/ caml_ba_slice(a, [0, n]) /*<<bigarray.ml:205:76>>*/ ;
     /*<<bigarray.ml:205:76>>*/ }
    function init$0(kind, layout, dim, f){
      /*<<bigarray.ml:213:4>>*/  /*<<bigarray.ml:213:14>>*/ var
@@ -24270,7 +24588,7 @@
        i$0 = ___;
       }
      }
-      /*<<bigarray.ml:216:24>>*/ return arr;
+      /*<<bigarray.ml:216:24>>*/ return arr /*<<bigarray.ml:216:24>>*/ ;
     }
      /*<<bigarray.ml:209:4>>*/ var
      _X_ = dim - 1 | 0,
@@ -24286,7 +24604,7 @@
       i = _Y_;
      }
     }
-     /*<<bigarray.ml:215:18>>*/ return arr;
+     /*<<bigarray.ml:215:18>>*/ return arr /*<<bigarray.ml:215:18>>*/ ;
     /*<<bigarray.ml:216:51>>*/ }
    function of_array(kind, layout, data){
      /*<<bigarray.ml:218:4>>*/ var
@@ -24305,11 +24623,11 @@
       i = _V_;
      }
     }
-     /*<<bigarray.ml:225:4>>*/ return ba;
+     /*<<bigarray.ml:225:4>>*/ return ba /*<<bigarray.ml:225:4>>*/ ;
     /*<<bigarray.ml:225:6>>*/ }
    function create$1(kind, layout, dim1, dim2){
      /*<<bigarray.ml:231:4>>*/ return  /*<<bigarray.ml:231:4>>*/ caml_ba_create
-            (kind, layout, [0, dim1, dim2]);
+            (kind, layout, [0, dim1, dim2]) /*<<bigarray.ml:231:46>>*/ ;
     /*<<bigarray.ml:231:46>>*/ }
    function size_in_bytes$2(arr){
      /*<<bigarray.ml:247:4>>*/ var
@@ -24322,15 +24640,15 @@
               (kind_size_in_bytes
                 ( /*<<bigarray.ml:247:24>>*/ caml_ba_kind(arr)),
                _S_),
-             _R_);
+             _R_) /*<<bigarray.ml:247:61>>*/ ;
     /*<<bigarray.ml:247:61>>*/ }
    function slice_left(a, n){
      /*<<bigarray.ml:254:23>>*/ return  /*<<bigarray.ml:254:23>>*/ caml_ba_slice
-            (a, [0, n]);
+            (a, [0, n]) /*<<bigarray.ml:254:50>>*/ ;
     /*<<bigarray.ml:254:50>>*/ }
    function slice_right(a, n){
      /*<<bigarray.ml:255:24>>*/ return  /*<<bigarray.ml:255:24>>*/ caml_ba_slice
-            (a, [0, n]);
+            (a, [0, n]) /*<<bigarray.ml:255:52>>*/ ;
     /*<<bigarray.ml:255:52>>*/ }
    function init$1(kind, layout, dim1, dim2, f){
      /*<<bigarray.ml:271:4>>*/  /*<<bigarray.ml:271:14>>*/ var
@@ -24358,7 +24676,7 @@
        j$0 = _P_;
       }
      }
-      /*<<bigarray.ml:274:24>>*/ return arr;
+      /*<<bigarray.ml:274:24>>*/ return arr /*<<bigarray.ml:274:24>>*/ ;
     }
      /*<<bigarray.ml:259:4>>*/ var
      _I_ = dim1 - 1 | 0,
@@ -24386,7 +24704,7 @@
       i = _L_;
      }
     }
-     /*<<bigarray.ml:273:18>>*/ return arr;
+     /*<<bigarray.ml:273:18>>*/ return arr /*<<bigarray.ml:273:18>>*/ ;
     /*<<bigarray.ml:274:57>>*/ }
    function of_array$0(kind, layout, data){
      /*<<bigarray.ml:276:4>>*/ var
@@ -24425,11 +24743,11 @@
       i = _F_;
      }
     }
-     /*<<bigarray.ml:292:4>>*/ return ba;
+     /*<<bigarray.ml:292:4>>*/ return ba /*<<bigarray.ml:292:4>>*/ ;
     /*<<bigarray.ml:292:6>>*/ }
    function create$2(kind, layout, dim1, dim2, dim3){
      /*<<bigarray.ml:298:4>>*/ return  /*<<bigarray.ml:298:4>>*/ caml_ba_create
-            (kind, layout, [0, dim1, dim2, dim3]);
+            (kind, layout, [0, dim1, dim2, dim3]) /*<<bigarray.ml:298:52>>*/ ;
     /*<<bigarray.ml:298:52>>*/ }
    function size_in_bytes$3(arr){
      /*<<bigarray.ml:316:4>>*/ var
@@ -24446,23 +24764,23 @@
                   ( /*<<bigarray.ml:316:24>>*/ caml_ba_kind(arr)),
                  _A_),
                _z_),
-             _y_);
+             _y_) /*<<bigarray.ml:316:74>>*/ ;
     /*<<bigarray.ml:316:74>>*/ }
    function slice_left_1(a, n, m){
      /*<<bigarray.ml:323:27>>*/ return  /*<<bigarray.ml:323:27>>*/ caml_ba_slice
-            (a, [0, n, m]);
+            (a, [0, n, m]) /*<<bigarray.ml:323:57>>*/ ;
     /*<<bigarray.ml:323:57>>*/ }
    function slice_right_1(a, n, m){
      /*<<bigarray.ml:324:28>>*/ return  /*<<bigarray.ml:324:28>>*/ caml_ba_slice
-            (a, [0, n, m]);
+            (a, [0, n, m]) /*<<bigarray.ml:324:59>>*/ ;
     /*<<bigarray.ml:324:59>>*/ }
    function slice_left_2(a, n){
      /*<<bigarray.ml:325:25>>*/ return  /*<<bigarray.ml:325:25>>*/ caml_ba_slice
-            (a, [0, n]);
+            (a, [0, n]) /*<<bigarray.ml:325:52>>*/ ;
     /*<<bigarray.ml:325:52>>*/ }
    function slice_right_2(a, n){
      /*<<bigarray.ml:326:26>>*/ return  /*<<bigarray.ml:326:26>>*/ caml_ba_slice
-            (a, [0, n]);
+            (a, [0, n]) /*<<bigarray.ml:326:54>>*/ ;
     /*<<bigarray.ml:326:54>>*/ }
    function init$2(kind, layout, dim1, dim2, dim3, f){
      /*<<bigarray.ml:346:4>>*/  /*<<bigarray.ml:346:14>>*/ var
@@ -24504,7 +24822,7 @@
        k$0 = _u_;
       }
      }
-      /*<<bigarray.ml:349:24>>*/ return arr;
+      /*<<bigarray.ml:349:24>>*/ return arr /*<<bigarray.ml:349:24>>*/ ;
     }
      /*<<bigarray.ml:330:4>>*/ var
      _k_ = dim1 - 1 | 0,
@@ -24544,7 +24862,7 @@
       i = _n_;
      }
     }
-     /*<<bigarray.ml:348:18>>*/ return arr;
+     /*<<bigarray.ml:348:18>>*/ return arr /*<<bigarray.ml:348:18>>*/ ;
     /*<<bigarray.ml:349:62>>*/ }
    function of_array$1(kind, layout, data){
      /*<<bigarray.ml:351:4>>*/ var
@@ -24608,51 +24926,51 @@
       i = _e_;
      }
     }
-     /*<<bigarray.ml:373:4>>*/ return ba;
+     /*<<bigarray.ml:373:4>>*/ return ba /*<<bigarray.ml:373:4>>*/ ;
     /*<<bigarray.ml:373:6>>*/ }
    function array0_of_genarray(a){
      /*<<bigarray.ml:385:2>>*/ return 0
             ===  /*<<bigarray.ml:385:5>>*/ caml_ba_num_dims(a)
             ? a
             :  /*<<bigarray.ml:386:7>>*/ caml_call1
-              (Stdlib[1], cst_Bigarray_array0_of_genarra);
+              (Stdlib[1], cst_Bigarray_array0_of_genarra) /*<<bigarray.ml:386:48>>*/ ;
     /*<<bigarray.ml:386:48>>*/ }
    function array1_of_genarray(a){
      /*<<bigarray.ml:388:2>>*/ return 1
             ===  /*<<bigarray.ml:388:5>>*/ caml_ba_num_dims(a)
             ? a
             :  /*<<bigarray.ml:389:7>>*/ caml_call1
-              (Stdlib[1], cst_Bigarray_array1_of_genarra);
+              (Stdlib[1], cst_Bigarray_array1_of_genarra) /*<<bigarray.ml:389:48>>*/ ;
     /*<<bigarray.ml:389:48>>*/ }
    function array2_of_genarray(a){
      /*<<bigarray.ml:391:2>>*/ return 2
             ===  /*<<bigarray.ml:391:5>>*/ caml_ba_num_dims(a)
             ? a
             :  /*<<bigarray.ml:392:7>>*/ caml_call1
-              (Stdlib[1], cst_Bigarray_array2_of_genarra);
+              (Stdlib[1], cst_Bigarray_array2_of_genarra) /*<<bigarray.ml:392:48>>*/ ;
     /*<<bigarray.ml:392:48>>*/ }
    function array3_of_genarray(a){
      /*<<bigarray.ml:394:2>>*/ return 3
             ===  /*<<bigarray.ml:394:5>>*/ caml_ba_num_dims(a)
             ? a
             :  /*<<bigarray.ml:395:7>>*/ caml_call1
-              (Stdlib[1], cst_Bigarray_array3_of_genarra);
+              (Stdlib[1], cst_Bigarray_array3_of_genarra) /*<<bigarray.ml:395:48>>*/ ;
     /*<<bigarray.ml:395:48>>*/ }
    function reshape_0(a){
      /*<<bigarray.ml:400:18>>*/ return  /*<<bigarray.ml:400:18>>*/ caml_ba_reshape
-            (a, [0]);
+            (a, [0]) /*<<bigarray.ml:400:32>>*/ ;
     /*<<bigarray.ml:400:32>>*/ }
    function reshape_1(a, dim1){
      /*<<bigarray.ml:401:23>>*/ return  /*<<bigarray.ml:401:23>>*/ caml_ba_reshape
-            (a, [0, dim1]);
+            (a, [0, dim1]) /*<<bigarray.ml:401:41>>*/ ;
     /*<<bigarray.ml:401:41>>*/ }
    function reshape_2(a, dim1, dim2){
      /*<<bigarray.ml:402:28>>*/ return  /*<<bigarray.ml:402:28>>*/ caml_ba_reshape
-            (a, [0, dim1, dim2]);
+            (a, [0, dim1, dim2]) /*<<bigarray.ml:402:51>>*/ ;
     /*<<bigarray.ml:402:51>>*/ }
    function reshape_3(a, dim1, dim2, dim3){
      /*<<bigarray.ml:403:33>>*/ return  /*<<bigarray.ml:403:33>>*/ caml_ba_reshape
-            (a, [0, dim1, dim2, dim3]);
+            (a, [0, dim1, dim2, dim3]) /*<<bigarray.ml:403:61>>*/ ;
     /*<<bigarray.ml:403:61>>*/ }
    var
     Stdlib_Bigarray =
@@ -24785,7 +25103,7 @@
     _e_ = runtime.caml_int64_create_lo_mi_hi(1, 0, 0);
    function create(param){
      /*<<random.ml:31:4>>*/ return  /*<<random.ml:31:4>>*/ caml_call3
-            (Stdlib_Bigarray[20][1], 7, 0, 4);
+            (Stdlib_Bigarray[20][1], 7, 0, 4) /*<<random.ml:31:34>>*/ ;
     /*<<random.ml:31:34>>*/ }
    function set(s, i1, i2, i3, i4){
      /*<<random.ml:34:4>>*/  /*<<random.ml:34:4>>*/ caml_ba_set_1
@@ -24797,12 +25115,12 @@
      /*<<random.ml:37:30>>*/  /*<<random.ml:37:30>>*/ var
      i4$0 =  /*<<random.ml:37:30>>*/ caml_notequal(i4, _c_) ? i4 : _d_;
      /*<<random.ml:37:4>>*/ return  /*<<random.ml:37:4>>*/ caml_ba_set_1
-            (s, 3, i4$0);
+            (s, 3, i4$0) /*<<random.ml:37:55>>*/ ;
     /*<<random.ml:37:55>>*/ }
    function mk(i1, i2, i3, i4){
      /*<<random.ml:40:4>>*/  /*<<random.ml:40:12>>*/ var s = create(0);
      /*<<random.ml:41:4>>*/ set(s, i1, i2, i3, i4);
-     /*<<random.ml:41:4>>*/ return s;
+     /*<<random.ml:41:4>>*/ return s /*<<random.ml:41:4>>*/ ;
     /*<<random.ml:41:24>>*/ }
    var
     serialization_prefix_len = 5,
@@ -24827,7 +25145,7 @@
       /*<<random.ml:66:6>>*/  /*<<random.ml:66:6>>*/ var _z_ = i + 1 | 0;
      if(3 === i)
        /*<<random.ml:68:4>>*/ return  /*<<random.ml:68:4>>*/ caml_call1
-              (Stdlib_Bytes[44], buf);
+              (Stdlib_Bytes[44], buf) /*<<random.ml:68:30>>*/ ;
      i = _z_;
     }
     /*<<random.ml:68:30>>*/ }
@@ -24858,12 +25176,12 @@
         /*<<random.ml:81:13>>*/ caml_call2(Stdlib_String[64], buf, 21),
       /*<<random.ml:82:13>>*/ i4 =
         /*<<random.ml:82:13>>*/ caml_call2(Stdlib_String[64], buf, 29);
-     /*<<random.ml:83:4>>*/ return mk(i1, i2, i3, i4);
+     /*<<random.ml:83:4>>*/ return mk(i1, i2, i3, i4) /*<<random.ml:83:18>>*/ ;
     /*<<random.ml:83:18>>*/ }
    function copy(src){
      /*<<random.ml:89:4>>*/  /*<<random.ml:89:13>>*/ var dst = create(0);
      /*<<random.ml:86:4>>*/  /*<<random.ml:86:4>>*/ caml_ba_blit(src, dst);
-     /*<<random.ml:89:25>>*/ return dst;
+     /*<<random.ml:89:25>>*/ return dst /*<<random.ml:89:25>>*/ ;
     /*<<random.ml:89:40>>*/ }
    function reinit(s, seed){
      /*<<random.ml:97:4>>*/ var
@@ -24906,16 +25224,16 @@
               /*<<random.ml:106:10>>*/ caml_call2(Stdlib_String[64], d1, 0),
              _s_,
              _r_,
-             _q_);
+             _q_) /*<<random.ml:109:36>>*/ ;
     /*<<random.ml:109:36>>*/ }
    function make(seed){
      /*<<random.ml:112:4>>*/  /*<<random.ml:112:12>>*/ var s = create(0);
      /*<<random.ml:112:24>>*/ reinit(s, seed);
-     /*<<random.ml:112:24>>*/ return s;
+     /*<<random.ml:112:24>>*/ return s /*<<random.ml:112:24>>*/ ;
     /*<<random.ml:112:40>>*/ }
    function make_self_init(param){
      /*<<random.ml:115:4>>*/ return make
-            ( /*<<random.ml:115:9>>*/ caml_sys_random_seed(0));
+            ( /*<<random.ml:115:9>>*/ caml_sys_random_seed(0)) /*<<random.ml:115:25>>*/ ;
     /*<<random.ml:115:25>>*/ }
    var
     max_int31 = 1073741823,
@@ -24939,25 +25257,25 @@
         & mask,
       v = caml_mod(r, n);
      if(((mask - n | 0) + 1 | 0) >= (r - v | 0))
-       /*<<random.ml:148:55>>*/ return v;
+       /*<<random.ml:148:55>>*/ return v /*<<random.ml:148:55>>*/ ;
     }
     /*<<random.ml:148:56>>*/ }
    function int$0(s, bound){
      /*<<random.ml:154:4>>*/ if(1073741823 >= bound && 0 < bound)
-     return int_aux(s, bound, max_int31);
+     return int_aux(s, bound, max_int31) /*<<random.ml:156:34>>*/ ;
      /*<<random.ml:155:9>>*/ return  /*<<random.ml:155:9>>*/ caml_call1
-            (Stdlib[1], cst_Random_int);
+            (Stdlib[1], cst_Random_int) /*<<random.ml:156:34>>*/ ;
     /*<<random.ml:156:34>>*/ }
    function full_int(s, bound){
      /*<<random.ml:161:4>>*/ if(0 >= bound)
       /*<<random.ml:162:6>>*/ return  /*<<random.ml:162:6>>*/ caml_call1
-             (Stdlib[1], cst_Random_full_int);
+             (Stdlib[1], cst_Random_full_int) /*<<random.ml:173:22>>*/ ;
     var
      _n_ =
        bound <= 1073741823
         ? max_int31
         : bound <= 2147483647 ? max_int32 : Stdlib[19];
-    return int_aux(s, bound, _n_);
+    return int_aux(s, bound, _n_) /*<<random.ml:173:22>>*/ ;
     /*<<random.ml:173:22>>*/ }
    function int_in_range_aux(s, min, max, mask, nbits){
      /*<<random.ml:193:4>>*/ var span = (max - min | 0) + 1 | 0;
@@ -24970,7 +25288,8 @@
          ( /*<<random.ml:186:27>>*/ caml_lxm_next(s))
         << drop
         >> drop;
-     if(r >= min && max >= r)  /*<<random.ml:187:74>>*/ return r;
+     if(r >= min && max >= r)
+       /*<<random.ml:187:74>>*/ return r /*<<random.ml:187:74>>*/ ;
     }
     /*<<random.ml:201:43>>*/ }
    function int_in_range(s, min, max){
@@ -24979,16 +25298,16 @@
       (Stdlib[1], cst_Random_int_in_range);
     if(-1073741824 <= min && max <= 1073741823)
       /*<<random.ml:215:6>>*/ return int_in_range_aux
-             (s, min, max, max_int31, 31);
+             (s, min, max, max_int31, 31) /*<<random.ml:219:68>>*/ ;
     if(-2147483648 <= min && max <= 2147483647)
       /*<<random.ml:217:6>>*/ return int_in_range_aux
-             (s, min, max, max_int32, 32);
+             (s, min, max, max_int32, 32) /*<<random.ml:219:68>>*/ ;
      /*<<random.ml:219:6>>*/ return int_in_range_aux
-            (s, min, max, Stdlib[19], Stdlib_Sys[10]);
+            (s, min, max, Stdlib[19], Stdlib_Sys[10]) /*<<random.ml:219:68>>*/ ;
     /*<<random.ml:219:68>>*/ }
    function bits32(s){
      /*<<random.ml:223:4>>*/ return  /*<<random.ml:223:4>>*/ caml_int64_to_int32
-            ( /*<<random.ml:223:19>>*/ caml_lxm_next(s));
+            ( /*<<random.ml:223:19>>*/ caml_lxm_next(s)) /*<<random.ml:223:27>>*/ ;
     /*<<random.ml:223:27>>*/ }
    function int32aux(s, n){
      /*<<random.ml:227:4>>*/ for(;;){
@@ -24999,26 +25318,26 @@
       (!
         /*<<random.ml:230:14>>*/ caml_greaterthan
         (r - v | 0, (Stdlib_Int32[9] - n | 0) + 1 | 0))
-       /*<<random.ml:232:9>>*/ return v;
+       /*<<random.ml:232:9>>*/ return v /*<<random.ml:232:9>>*/ ;
     }
     /*<<random.ml:232:10>>*/ }
    function int32(s, bound){
      /*<<random.ml:235:4>>*/ return  /*<<random.ml:235:7>>*/ caml_lessequal
              (bound, 0)
             ?  /*<<random.ml:236:9>>*/ caml_call1(Stdlib[1], cst_Random_int32)
-            : int32aux(s, bound);
+            : int32aux(s, bound) /*<<random.ml:237:25>>*/ ;
     /*<<random.ml:237:25>>*/ }
    function int32_in_range(s, min, max){
      /*<<random.ml:246:4>>*/ if
      ( /*<<random.ml:246:7>>*/ caml_greaterthan(min, max))
       /*<<random.ml:247:6>>*/ return  /*<<random.ml:247:6>>*/ caml_call1
-             (Stdlib[1], cst_Random_int32_in_range);
+             (Stdlib[1], cst_Random_int32_in_range) /*<<random.ml:254:39>>*/ ;
      /*<<random.ml:249:17>>*/  /*<<random.ml:249:17>>*/ var
      span =
         /*<<random.ml:249:17>>*/ caml_call1(Stdlib_Int32[6], max - min | 0);
      /*<<random.ml:251:9>>*/ if
      (!  /*<<random.ml:251:9>>*/ caml_lessequal(span, Stdlib_Int32[1]))
-      /*<<random.ml:254:8>>*/ return min + int32aux(s, span) | 0;
+      /*<<random.ml:254:8>>*/ return min + int32aux(s, span) | 0 /*<<random.ml:254:8>>*/ ;
      /*<<random.ml:242:4>>*/ for(;;){
       /*<<random.ml:242:12>>*/  /*<<random.ml:242:12>>*/ var
       r =
@@ -25028,7 +25347,7 @@
       (!
         /*<<random.ml:243:7>>*/ caml_lessthan(r, min)
        && !  /*<<random.ml:243:18>>*/ caml_greaterthan(r, max))
-       /*<<random.ml:243:67>>*/ return r;
+       /*<<random.ml:243:67>>*/ return r /*<<random.ml:243:67>>*/ ;
     }
     /*<<random.ml:254:39>>*/ }
    var
@@ -25051,20 +25370,20 @@
         ( /*<<random.ml:265:14>>*/ caml_int64_sub(r, v),
           /*<<random.ml:265:24>>*/ caml_int64_add
           ( /*<<random.ml:265:28>>*/ caml_int64_sub(Stdlib_Int64[9], n), _f_)))
-       /*<<random.ml:267:9>>*/ return v;
+       /*<<random.ml:267:9>>*/ return v /*<<random.ml:267:9>>*/ ;
     }
     /*<<random.ml:267:10>>*/ }
    function int64(s, bound){
      /*<<random.ml:270:4>>*/ return  /*<<random.ml:270:7>>*/ caml_lessequal
              (bound, _g_)
             ?  /*<<random.ml:271:9>>*/ caml_call1(Stdlib[1], cst_Random_int64)
-            : int64aux(s, bound);
+            : int64aux(s, bound) /*<<random.ml:272:25>>*/ ;
     /*<<random.ml:272:25>>*/ }
    function int64_in_range(s, min, max){
      /*<<random.ml:281:4>>*/ if
      ( /*<<random.ml:281:7>>*/ caml_greaterthan(min, max))
       /*<<random.ml:282:6>>*/ return  /*<<random.ml:282:6>>*/ caml_call1
-             (Stdlib[1], cst_Random_int64_in_range);
+             (Stdlib[1], cst_Random_int64_in_range) /*<<random.ml:289:39>>*/ ;
      /*<<random.ml:284:17>>*/  /*<<random.ml:284:17>>*/ var
      span =
         /*<<random.ml:284:17>>*/ caml_call1
@@ -25072,7 +25391,7 @@
      /*<<random.ml:286:9>>*/ if
      (!  /*<<random.ml:286:9>>*/ caml_lessequal(span, Stdlib_Int64[1]))
       /*<<random.ml:289:8>>*/ return  /*<<random.ml:289:8>>*/ caml_int64_add
-             (min, int64aux(s, span));
+             (min, int64aux(s, span)) /*<<random.ml:289:39>>*/ ;
      /*<<random.ml:277:4>>*/ for(;;){
       /*<<random.ml:277:12>>*/  /*<<random.ml:277:12>>*/ var
       r =  /*<<random.ml:277:12>>*/ caml_lxm_next(s);
@@ -25080,7 +25399,7 @@
       (!
         /*<<random.ml:278:7>>*/ caml_lessthan(r, min)
        && !  /*<<random.ml:278:18>>*/ caml_greaterthan(r, max))
-       /*<<random.ml:278:67>>*/ return r;
+       /*<<random.ml:278:67>>*/ return r /*<<random.ml:278:67>>*/ ;
     }
     /*<<random.ml:289:39>>*/ }
    var
@@ -25094,30 +25413,30 @@
       32 === Stdlib_Nativeint[9]
        ? function
         (s){
-          /*<<random.ml:294:18>>*/ return bits32(s);
+          /*<<random.ml:294:18>>*/ return bits32(s) /*<<random.ml:294:47>>*/ ;
          /*<<random.ml:294:47>>*/ }
        : function
         (s){
           /*<<random.ml:295:18>>*/ return  /*<<random.ml:295:18>>*/ caml_int64_to_int32
-                 ( /*<<random.ml:258:4>>*/ caml_lxm_next(s));
+                 ( /*<<random.ml:258:4>>*/ caml_lxm_next(s)) /*<<random.ml:295:47>>*/ ;
          /*<<random.ml:295:47>>*/ },
     nativeint =
       32 === Stdlib_Nativeint[9]
        ? function
         (s, bound){
-          /*<<random.ml:300:24>>*/ return int32(s, bound);
+          /*<<random.ml:300:24>>*/ return int32(s, bound) /*<<random.ml:300:79>>*/ ;
          /*<<random.ml:300:79>>*/ }
        : function
         (s, bound){
           /*<<random.ml:301:24>>*/ return  /*<<random.ml:301:24>>*/ caml_int64_to_int32
                  (int64
-                   (s,  /*<<random.ml:301:52>>*/ caml_int64_of_int32(bound)));
+                   (s,  /*<<random.ml:301:52>>*/ caml_int64_of_int32(bound))) /*<<random.ml:301:79>>*/ ;
          /*<<random.ml:301:79>>*/ },
     nativeint_in_range =
       32 === Stdlib_Nativeint[9]
        ? function
         (s, min, max){
-          /*<<random.ml:307:6>>*/ return int32_in_range(s, min, max);
+          /*<<random.ml:307:6>>*/ return int32_in_range(s, min, max) /*<<random.ml:308:68>>*/ ;
          /*<<random.ml:308:68>>*/ }
        : function
         (s, min, max){
@@ -25125,7 +25444,7 @@
                  (int64_in_range
                    (s,
                      /*<<random.ml:311:13>>*/ caml_int64_of_int32(min),
-                     /*<<random.ml:311:43>>*/ caml_int64_of_int32(max)));
+                     /*<<random.ml:311:43>>*/ caml_int64_of_int32(max))) /*<<random.ml:311:68>>*/ ;
          /*<<random.ml:311:68>>*/ };
    function float$0(s, bound){
      /*<<random.ml:321:22>>*/ for(;;){
@@ -25138,12 +25457,12 @@
        /*<<random.ml:321:22>>*/ return  /*<<random.ml:318:20>>*/ runtime.caml_int64_to_float
               (n)
              * 1.1102230246251565e-16
-             * bound;
+             * bound /*<<random.ml:321:22>>*/ ;
     }
     /*<<random.ml:321:41>>*/ }
    function bool(s){
      /*<<random.ml:324:15>>*/ return  /*<<random.ml:324:15>>*/ caml_lessthan
-            ( /*<<random.ml:324:15>>*/ caml_lxm_next(s), _i_);
+            ( /*<<random.ml:324:15>>*/ caml_lxm_next(s), _i_) /*<<random.ml:324:26>>*/ ;
     /*<<random.ml:324:26>>*/ }
    function split(s){
      /*<<random.ml:328:4>>*/ var
@@ -25151,10 +25470,10 @@
       /*<<random.ml:258:4>>*/ i2 =  /*<<random.ml:258:4>>*/ caml_lxm_next(s),
       /*<<random.ml:258:4>>*/ i3 =  /*<<random.ml:258:4>>*/ caml_lxm_next(s),
       /*<<random.ml:258:4>>*/ i4 =  /*<<random.ml:258:4>>*/ caml_lxm_next(s);
-     /*<<random.ml:330:4>>*/ return mk(i1, i2, i3, i4);
+     /*<<random.ml:330:4>>*/ return mk(i1, i2, i3, i4) /*<<random.ml:330:18>>*/ ;
     /*<<random.ml:330:18>>*/ }
    function mk_default(param){
-     /*<<random.ml:335:2>>*/ return mk(_m_, _l_, _k_, _j_);
+     /*<<random.ml:335:2>>*/ return mk(_m_, _l_, _k_, _j_) /*<<random.ml:338:31>>*/ ;
     /*<<random.ml:338:31>>*/ }
     /*<<random.ml:341:2>>*/  /*<<random.ml:341:2>>*/ var
     random_key =
@@ -25163,122 +25482,122 @@
    function bits$0(param){
      /*<<random.ml:343:14>>*/ return bits
             ( /*<<random.ml:343:25>>*/ caml_call1
-              (Stdlib_Domain[10][2], random_key));
+              (Stdlib_Domain[10][2], random_key)) /*<<random.ml:343:52>>*/ ;
     /*<<random.ml:343:52>>*/ }
    function int$1(bound){
      /*<<random.ml:344:16>>*/ return int$0
             ( /*<<random.ml:344:26>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
-             bound);
+             bound) /*<<random.ml:344:59>>*/ ;
     /*<<random.ml:344:59>>*/ }
    function full_int$0(bound){
      /*<<random.ml:345:21>>*/ return full_int
             ( /*<<random.ml:345:36>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
-             bound);
+             bound) /*<<random.ml:345:69>>*/ ;
     /*<<random.ml:345:69>>*/ }
    function int_in_range$0(min, max){
      /*<<random.ml:347:2>>*/ return int_in_range
             ( /*<<random.ml:347:21>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
              min,
-             max);
+             max) /*<<random.ml:347:58>>*/ ;
     /*<<random.ml:347:58>>*/ }
    function int32$0(bound){
      /*<<random.ml:348:18>>*/ return int32
             ( /*<<random.ml:348:30>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
-             bound);
+             bound) /*<<random.ml:348:63>>*/ ;
     /*<<random.ml:348:63>>*/ }
    function int32_in_range$0(min, max){
      /*<<random.ml:350:2>>*/ return int32_in_range
             ( /*<<random.ml:350:23>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
              min,
-             max);
+             max) /*<<random.ml:350:60>>*/ ;
     /*<<random.ml:350:60>>*/ }
    function nativeint$0(bound){
      /*<<random.ml:351:22>>*/ return nativeint
             ( /*<<random.ml:351:38>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
-             bound);
+             bound) /*<<random.ml:351:71>>*/ ;
     /*<<random.ml:351:71>>*/ }
    function nativeint_in_range$0(min, max){
      /*<<random.ml:353:2>>*/ return nativeint_in_range
             ( /*<<random.ml:353:27>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
              min,
-             max);
+             max) /*<<random.ml:353:64>>*/ ;
     /*<<random.ml:353:64>>*/ }
    function int64$0(bound){
      /*<<random.ml:354:18>>*/ return int64
             ( /*<<random.ml:354:30>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
-             bound);
+             bound) /*<<random.ml:354:63>>*/ ;
     /*<<random.ml:354:63>>*/ }
    function int64_in_range$0(min, max){
      /*<<random.ml:356:2>>*/ return int64_in_range
             ( /*<<random.ml:356:23>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
              min,
-             max);
+             max) /*<<random.ml:356:60>>*/ ;
     /*<<random.ml:356:60>>*/ }
    function float$1(scale){
      /*<<random.ml:357:18>>*/ return float$0
             ( /*<<random.ml:357:30>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
-             scale);
+             scale) /*<<random.ml:357:63>>*/ ;
     /*<<random.ml:357:63>>*/ }
    function bool$0(param){
      /*<<random.ml:358:14>>*/ return bool
             ( /*<<random.ml:358:25>>*/ caml_call1
-              (Stdlib_Domain[10][2], random_key));
+              (Stdlib_Domain[10][2], random_key)) /*<<random.ml:358:52>>*/ ;
     /*<<random.ml:358:52>>*/ }
    function bits32$0(param){
      /*<<random.ml:359:16>>*/ return bits32
             ( /*<<random.ml:359:29>>*/ caml_call1
-              (Stdlib_Domain[10][2], random_key));
+              (Stdlib_Domain[10][2], random_key)) /*<<random.ml:359:56>>*/ ;
     /*<<random.ml:359:56>>*/ }
    function bits64$0(param){
      /*<<random.ml:360:16>>*/  /*<<random.ml:360:29>>*/ var
      s =
         /*<<random.ml:360:29>>*/ caml_call1(Stdlib_Domain[10][2], random_key);
-     /*<<random.ml:258:4>>*/ return  /*<<random.ml:258:4>>*/ caml_lxm_next(s);
+     /*<<random.ml:258:4>>*/ return  /*<<random.ml:258:4>>*/ caml_lxm_next(s) /*<<random.ml:360:56>>*/ ;
     /*<<random.ml:360:56>>*/ }
    function nativebits$0(param){
      /*<<random.ml:361:20>>*/ return nativebits
             ( /*<<random.ml:361:37>>*/ caml_call1
-              (Stdlib_Domain[10][2], random_key));
+              (Stdlib_Domain[10][2], random_key)) /*<<random.ml:361:64>>*/ ;
     /*<<random.ml:361:64>>*/ }
    function full_init(seed){
      /*<<random.ml:363:21>>*/ return reinit
             ( /*<<random.ml:363:34>>*/ caml_call1
               (Stdlib_Domain[10][2], random_key),
-             seed);
+             seed) /*<<random.ml:363:66>>*/ ;
     /*<<random.ml:363:66>>*/ }
    function init(seed){
-     /*<<random.ml:364:16>>*/ return full_init([0, seed]);
+     /*<<random.ml:364:16>>*/ return full_init([0, seed]) /*<<random.ml:364:36>>*/ ;
     /*<<random.ml:364:36>>*/ }
    function self_init(param){
      /*<<random.ml:365:19>>*/ return full_init
-            ( /*<<random.ml:365:29>>*/ caml_sys_random_seed(0));
+            ( /*<<random.ml:365:29>>*/ caml_sys_random_seed(0)) /*<<random.ml:365:44>>*/ ;
     /*<<random.ml:365:44>>*/ }
    function split$0(param){
      /*<<random.ml:369:15>>*/ return split
             ( /*<<random.ml:369:27>>*/ caml_call1
-              (Stdlib_Domain[10][2], random_key));
+              (Stdlib_Domain[10][2], random_key)) /*<<random.ml:369:54>>*/ ;
     /*<<random.ml:369:54>>*/ }
    function get_state(param){
      /*<<random.ml:373:19>>*/ return copy
             ( /*<<random.ml:373:30>>*/ caml_call1
-              (Stdlib_Domain[10][2], random_key));
+              (Stdlib_Domain[10][2], random_key)) /*<<random.ml:373:57>>*/ ;
     /*<<random.ml:373:57>>*/ }
    function set_state(src){
      /*<<random.ml:374:18>>*/  /*<<random.ml:374:31>>*/ var
      dst =
         /*<<random.ml:374:31>>*/ caml_call1(Stdlib_Domain[10][2], random_key);
      /*<<random.ml:86:4>>*/ return  /*<<random.ml:86:4>>*/ caml_ba_blit
-            (src, dst);
+            (src, dst) /*<<random.ml:374:60>>*/ ;
     /*<<random.ml:374:60>>*/ }
    var
     Stdlib_Random =
@@ -25421,10 +25740,10 @@
        (Stdlib_Atomic[1], randomized_default);
    function randomize(param){
      /*<<hashtbl.ml:57:19>>*/ return  /*<<hashtbl.ml:57:19>>*/ caml_call2
-            (Stdlib_Atomic[4], randomized, 1);
+            (Stdlib_Atomic[4], randomized, 1) /*<<hashtbl.ml:57:45>>*/ ;
     /*<<hashtbl.ml:57:45>>*/ }
    function is_randomized(param){
-     /*<<hashtbl.ml:58:23>>*/ return caml_call1(Stdlib_Atomic[3], randomized);
+     /*<<hashtbl.ml:58:23>>*/ return caml_call1(Stdlib_Atomic[3], randomized) /*<<hashtbl.ml:58:44>>*/ ;
     /*<<hashtbl.ml:58:44>>*/ }
     /*<<hashtbl.ml:60:15>>*/  /*<<hashtbl.ml:60:15>>*/ var
     prng_key =
@@ -25433,8 +25752,10 @@
    function power_2_above(x, n){
      /*<<hashtbl.ml:69:2>>*/ var x$0 = x;
      /*<<hashtbl.ml:69:2>>*/ for(;;){
-     if(n <= x$0)  /*<<hashtbl.ml:69:17>>*/ return x$0;
-     if(Stdlib_Sys[13] < (x$0 * 2 | 0))  /*<<hashtbl.ml:70:44>>*/ return x$0;
+     if(n <= x$0)
+       /*<<hashtbl.ml:69:17>>*/ return x$0 /*<<hashtbl.ml:69:17>>*/ ;
+     if(Stdlib_Sys[13] < (x$0 * 2 | 0))
+       /*<<hashtbl.ml:70:44>>*/ return x$0 /*<<hashtbl.ml:70:44>>*/ ;
      var x$1 = x$0 * 2 | 0;
      x$0 = x$1;
     }
@@ -25457,7 +25778,7 @@
             0,
              /*<<hashtbl.ml:78:52>>*/ caml_make_vect(s, 0),
             seed,
-            s];
+            s] /*<<hashtbl.ml:78:2>>*/ ;
    }
    function clear(h){
      /*<<hashtbl.ml:81:2>>*/ var _aj_ = 0 < h[1] ? 1 : 0;
@@ -25467,7 +25788,7 @@
               = 0,
                /*<<hashtbl.ml:83:4>>*/ caml_call4
                (Stdlib_Array[8], h[2], 0, h[2].length - 1, 0))
-            : _aj_;
+            : _aj_ /*<<hashtbl.ml:84:5>>*/ ;
     /*<<hashtbl.ml:84:5>>*/ }
    function reset(h){
      /*<<hashtbl.ml:87:2>>*/ var len = h[2].length - 1;
@@ -25480,10 +25801,11 @@
        ( /*<<hashtbl.ml:93:25>>*/ caml_call1(Stdlib[18], h[4]), 0);
      return 0;
     }
-     /*<<hashtbl.ml:90:4>>*/ return clear(h);
+     /*<<hashtbl.ml:90:4>>*/ return clear(h) /*<<hashtbl.ml:94:5>>*/ ;
     /*<<hashtbl.ml:94:5>>*/ }
    function copy_bucketlist(param){
-     /*<<hashtbl.ml:96:22>>*/ if(! param)  /*<<hashtbl.ml:97:13>>*/ return 0;
+     /*<<hashtbl.ml:96:22>>*/ if(! param)
+      /*<<hashtbl.ml:97:13>>*/ return 0 /*<<hashtbl.ml:97:13>>*/ ;
      /*<<hashtbl.ml:109:19>>*/ var
      key = param[1],
      data = param[2],
@@ -25492,7 +25814,8 @@
      prec = prec$1,
      param$0 = next;
     for(;;){
-     if(! param$0)  /*<<hashtbl.ml:110:6>>*/ return prec$1;
+     if(! param$0)
+       /*<<hashtbl.ml:110:6>>*/ return prec$1 /*<<hashtbl.ml:110:6>>*/ ;
       /*<<hashtbl.ml:102:25>>*/ var
       key$0 = param$0[1],
       data$0 = param$0[2],
@@ -25510,7 +25833,7 @@
       /*<<hashtbl.ml:113:29>>*/ _ai_ =
         /*<<hashtbl.ml:113:29>>*/ caml_call2
         (Stdlib_Array[14], copy_bucketlist, h[2]);
-     /*<<hashtbl.ml:113:13>>*/ return [0, h[1], _ai_, _ah_, _ag_];
+     /*<<hashtbl.ml:113:13>>*/ return [0, h[1], _ai_, _ah_, _ag_] /*<<hashtbl.ml:113:13>>*/ ;
     /*<<hashtbl.ml:113:63>>*/ }
    function length(h){
      /*<<hashtbl.ml:115:15>>*/ return h[1];
@@ -25592,7 +25915,7 @@
             ( /*<<hashtbl.ml:153:23>>*/ caml_call1(indexfun, h),
              inplace,
              odata,
-             ndata);
+             ndata) /*<<hashtbl.ml:154:5>>*/ ;
     /*<<hashtbl.ml:154:5>>*/ }
    function iter(f, h){
      /*<<hashtbl.ml:157:2>>*/  /*<<hashtbl.ml:162:17>>*/ var
@@ -25618,7 +25941,7 @@
       }
      }
      var _X_ = 1 - old_trav, _Y_ = _X_ ? flip_ongoing_traversal(h) : _X_;
-      /*<<hashtbl.ml:169:25>>*/ return _Y_;
+      /*<<hashtbl.ml:169:25>>*/ return _Y_ /*<<hashtbl.ml:169:25>>*/ ;
     }
     catch(exn$0){
      var exn = caml_wrap_exception(exn$0);
@@ -25674,7 +25997,7 @@
       }
      }
      var _S_ = 1 - old_trav, _T_ = _S_ ? flip_ongoing_traversal(h) : _S_;
-      /*<<hashtbl.ml:202:25>>*/ return _T_;
+      /*<<hashtbl.ml:202:25>>*/ return _T_ /*<<hashtbl.ml:202:25>>*/ ;
     }
     catch(exn$0){
      var exn = caml_wrap_exception(exn$0);
@@ -25737,7 +26060,8 @@
    function bucket_length(accu, param){
     var accu$0 = accu, param$0 = param;
     for(;;){
-     if(! param$0)  /*<<hashtbl.ml:236:13>>*/ return accu$0;
+     if(! param$0)
+       /*<<hashtbl.ml:236:13>>*/ return accu$0 /*<<hashtbl.ml:236:13>>*/ ;
       /*<<hashtbl.ml:237:18>>*/ var
       next = param$0[3],
        /*<<hashtbl.ml:237:18>>*/ accu$1 = accu$0 + 1 | 0;
@@ -25754,7 +26078,7 @@
            /*<<hashtbl.ml:241:32>>*/  /*<<hashtbl.ml:241:42>>*/ var
            _L_ = bucket_length(0, b);
            /*<<hashtbl.ml:241:42>>*/ return  /*<<hashtbl.ml:241:42>>*/ caml_call2
-                  (Stdlib_Int[11], m, _L_);
+                  (Stdlib_Int[11], m, _L_) /*<<hashtbl.ml:241:61>>*/ ;
           /*<<hashtbl.ml:241:61>>*/ },
          0,
          h[2]),
@@ -25767,10 +26091,10 @@
         l = bucket_length(0, b);
         /*<<hashtbl.ml:246:6>>*/ histo[1 + l] =
         caml_check_bound(histo, l)[1 + l] + 1 | 0;
-        /*<<hashtbl.ml:246:6>>*/ return 0;
+        /*<<hashtbl.ml:246:6>>*/ return 0 /*<<hashtbl.ml:246:6>>*/ ;
        /*<<hashtbl.ml:246:32>>*/ },
       h[2]);
-     /*<<hashtbl.ml:248:2>>*/ return [0, h[1], h[2].length - 1, mbl, histo];
+     /*<<hashtbl.ml:248:2>>*/ return [0, h[1], h[2].length - 1, mbl, histo] /*<<hashtbl.ml:248:2>>*/ ;
     /*<<hashtbl.ml:251:30>>*/ }
    function to_seq(tbl){
      /*<<hashtbl.ml:258:2>>*/ var tbl_data = tbl[2];
@@ -25781,9 +26105,10 @@
        var key = buck$0[1], data = buck$0[2], next = buck$0[3];
         /*<<hashtbl.ml:266:8>>*/ return [0,
                [0, key, data],
-               function(_K_){ /*<<?>>*/ return aux(i$0, next, _K_);}];
+               function(_K_){ /*<<?>>*/ return aux(i$0, next, _K_);}] /*<<hashtbl.ml:266:8>>*/ ;
       }
-      if(i$0 === tbl_data.length - 1)  /*<<hashtbl.ml:263:13>>*/ return 0;
+      if(i$0 === tbl_data.length - 1)
+        /*<<hashtbl.ml:263:13>>*/ return 0 /*<<hashtbl.ml:263:13>>*/ ;
        /*<<hashtbl.ml:264:22>>*/ var
         /*<<hashtbl.ml:264:22>>*/ buck$1 =
          caml_check_bound(tbl_data, i$0)[1 + i$0],
@@ -25794,24 +26119,24 @@
      /*<<hashtbl.ml:266:42>>*/ }
     var  /*<<hashtbl.ml:268:2>>*/ _H_ = 0, _I_ = 0;
      /*<<hashtbl.ml:268:2>>*/ return function(_J_){
-      /*<<?>>*/ return aux(_I_, _H_, _J_);};
+      /*<<?>>*/ return aux(_I_, _H_, _J_);} /*<<hashtbl.ml:268:2>>*/ ;
     /*<<hashtbl.ml:268:13>>*/ }
    function to_seq_keys(m){
      /*<<hashtbl.ml:270:20>>*/  /*<<hashtbl.ml:270:32>>*/ var _F_ = to_seq(m);
      /*<<hashtbl.ml:270:32>>*/ return  /*<<hashtbl.ml:270:32>>*/ caml_call2
-            (Stdlib_Seq[29], function(_G_){ /*<<?>>*/ return _G_[1];}, _F_);
+            (Stdlib_Seq[29], function(_G_){ /*<<?>>*/ return _G_[1];}, _F_) /*<<hashtbl.ml:270:42>>*/ ;
     /*<<hashtbl.ml:270:42>>*/ }
    function to_seq_values(m){
      /*<<hashtbl.ml:272:22>>*/  /*<<hashtbl.ml:272:34>>*/ var _D_ = to_seq(m);
      /*<<hashtbl.ml:272:34>>*/ return  /*<<hashtbl.ml:272:34>>*/ caml_call2
-            (Stdlib_Seq[29], function(_E_){ /*<<?>>*/ return _E_[2];}, _D_);
+            (Stdlib_Seq[29], function(_E_){ /*<<?>>*/ return _E_[2];}, _D_) /*<<hashtbl.ml:272:44>>*/ ;
     /*<<hashtbl.ml:272:44>>*/ }
    function MakeSeeded(H){
     function key_index(h, key){
       /*<<hashtbl.ml:357:6>>*/ var _C_ = h[2].length - 2 | 0;
       /*<<hashtbl.ml:357:6>>*/ return  /*<<hashtbl.ml:357:6>>*/ caml_call2
              (H[2], h[3], key)
-            & _C_;
+            & _C_ /*<<hashtbl.ml:357:6>>*/ ;
      /*<<hashtbl.ml:357:63>>*/ }
     function add(h, key, data){
       /*<<hashtbl.ml:360:6>>*/ var
@@ -25821,7 +26146,7 @@
       /*<<hashtbl.ml:362:6>>*/ caml_check_bound(h[2], i)[1 + i] = bucket;
      h[1] = h[1] + 1 | 0;
      var _B_ = h[2].length - 1 << 1 < h[1] ? 1 : 0;
-     return _B_ ? resize(key_index, h) : _B_;
+     return _B_ ? resize(key_index, h) : _B_ /*<<hashtbl.ml:364:67>>*/ ;
      /*<<hashtbl.ml:364:67>>*/ }
     function remove(h, key){
       /*<<hashtbl.ml:380:6>>*/ var
@@ -25830,14 +26155,15 @@
       prec$0 = 0,
       prec = c;
      for(;;){
-      if(! prec)  /*<<hashtbl.ml:368:10>>*/ return 0;
+      if(! prec)
+        /*<<hashtbl.ml:368:10>>*/ return 0 /*<<hashtbl.ml:368:10>>*/ ;
       var k = prec[1], next = prec[3];
        /*<<hashtbl.ml:370:13>>*/ if
        ( /*<<hashtbl.ml:370:13>>*/ caml_call2(H[1], k, key)){
        h[1] = h[1] - 1 | 0;
        return prec$0
                ? (prec$0[3] = next, 0)
-               : (caml_check_bound(h[2], i)[1 + i] = next, 0);
+               : (caml_check_bound(h[2], i)[1 + i] = next, 0) /*<<hashtbl.ml:381:44>>*/ ;
       }
       prec$0 = prec;
       prec = next;
@@ -25853,21 +26179,21 @@
      var k1 = match[1], d1 = match[2], next1 = match[3];
       /*<<hashtbl.ml:393:13>>*/ if
       ( /*<<hashtbl.ml:393:13>>*/ caml_call2(H[1], key, k1))
-       /*<<hashtbl.ml:393:33>>*/ return d1;
+       /*<<hashtbl.ml:393:33>>*/ return d1 /*<<hashtbl.ml:393:33>>*/ ;
      if(! next1)
        /*<<hashtbl.ml:395:21>>*/ throw  /*<<hashtbl.ml:395:21>>*/ caml_maybe_attach_backtrace
              (Stdlib[8], 1);
      var k2 = next1[1], d2 = next1[2], next2 = next1[3];
       /*<<hashtbl.ml:397:17>>*/ if
       ( /*<<hashtbl.ml:397:17>>*/ caml_call2(H[1], key, k2))
-       /*<<hashtbl.ml:397:37>>*/ return d2;
+       /*<<hashtbl.ml:397:37>>*/ return d2 /*<<hashtbl.ml:397:37>>*/ ;
      if(! next2)
        /*<<hashtbl.ml:399:25>>*/ throw  /*<<hashtbl.ml:399:25>>*/ caml_maybe_attach_backtrace
              (Stdlib[8], 1);
      var k3 = next2[1], d3 = next2[2], next3 = next2[3];
       /*<<hashtbl.ml:401:21>>*/ if
       ( /*<<hashtbl.ml:401:21>>*/ caml_call2(H[1], key, k3))
-       /*<<hashtbl.ml:401:41>>*/ return d3;
+       /*<<hashtbl.ml:401:41>>*/ return d3 /*<<hashtbl.ml:401:41>>*/ ;
      var param = next3;
      for(;;){
       if(! param)
@@ -25876,7 +26202,7 @@
       var k = param[1], data = param[2], next = param[3];
        /*<<hashtbl.ml:387:13>>*/ if
        ( /*<<hashtbl.ml:387:13>>*/ caml_call2(H[1], key, k))
-        /*<<hashtbl.ml:387:32>>*/ return data;
+        /*<<hashtbl.ml:387:32>>*/ return data /*<<hashtbl.ml:387:32>>*/ ;
       param = next;
      }
      /*<<hashtbl.ml:401:67>>*/ }
@@ -25884,28 +26210,32 @@
       /*<<hashtbl.ml:410:6>>*/ var
        /*<<hashtbl.ml:410:20>>*/ _z_ = key_index(h, key),
        /*<<hashtbl.ml:410:12>>*/ match = caml_check_bound(h[2], _z_)[1 + _z_];
-     if(! match)  /*<<hashtbl.ml:411:17>>*/ return 0;
+     if(! match)
+       /*<<hashtbl.ml:411:17>>*/ return 0 /*<<hashtbl.ml:411:17>>*/ ;
      var k1 = match[1], d1 = match[2], next1 = match[3];
       /*<<hashtbl.ml:413:13>>*/ if
       ( /*<<hashtbl.ml:413:13>>*/ caml_call2(H[1], key, k1))
-       /*<<hashtbl.ml:413:33>>*/ return [0, d1];
-     if(! next1)  /*<<hashtbl.ml:415:21>>*/ return 0;
+       /*<<hashtbl.ml:413:33>>*/ return [0, d1] /*<<hashtbl.ml:413:33>>*/ ;
+     if(! next1)
+       /*<<hashtbl.ml:415:21>>*/ return 0 /*<<hashtbl.ml:415:21>>*/ ;
      var k2 = next1[1], d2 = next1[2], next2 = next1[3];
       /*<<hashtbl.ml:417:17>>*/ if
       ( /*<<hashtbl.ml:417:17>>*/ caml_call2(H[1], key, k2))
-       /*<<hashtbl.ml:417:37>>*/ return [0, d2];
-     if(! next2)  /*<<hashtbl.ml:419:25>>*/ return 0;
+       /*<<hashtbl.ml:417:37>>*/ return [0, d2] /*<<hashtbl.ml:417:37>>*/ ;
+     if(! next2)
+       /*<<hashtbl.ml:419:25>>*/ return 0 /*<<hashtbl.ml:419:25>>*/ ;
      var k3 = next2[1], d3 = next2[2], next3 = next2[3];
       /*<<hashtbl.ml:421:21>>*/ if
       ( /*<<hashtbl.ml:421:21>>*/ caml_call2(H[1], key, k3))
-       /*<<hashtbl.ml:421:41>>*/ return [0, d3];
+       /*<<hashtbl.ml:421:41>>*/ return [0, d3] /*<<hashtbl.ml:421:41>>*/ ;
      var param = next3;
      for(;;){
-      if(! param)  /*<<hashtbl.ml:405:10>>*/ return 0;
+      if(! param)
+        /*<<hashtbl.ml:405:10>>*/ return 0 /*<<hashtbl.ml:405:10>>*/ ;
       var k = param[1], data = param[2], next = param[3];
        /*<<hashtbl.ml:407:13>>*/ if
        ( /*<<hashtbl.ml:407:13>>*/ caml_call2(H[1], key, k))
-        /*<<hashtbl.ml:407:32>>*/ return [0, data];
+        /*<<hashtbl.ml:407:32>>*/ return [0, data] /*<<hashtbl.ml:407:32>>*/ ;
       param = next;
      }
      /*<<hashtbl.ml:421:76>>*/ }
@@ -25914,7 +26244,8 @@
        /*<<hashtbl.ml:431:29>>*/ _y_ = key_index(h, key),
       param = caml_check_bound(h[2], _y_)[1 + _y_];
       /*<<hashtbl.ml:424:47>>*/ for(;;){
-      if(! param)  /*<<hashtbl.ml:426:10>>*/ return 0;
+      if(! param)
+        /*<<hashtbl.ml:426:10>>*/ return 0 /*<<hashtbl.ml:426:10>>*/ ;
       var k = param[1], d = param[2], next = param[3];
        /*<<hashtbl.ml:428:13>>*/ if
        ( /*<<hashtbl.ml:428:13>>*/ caml_call2(H[1], k, key))
@@ -25929,7 +26260,7 @@
       /*<<hashtbl.ml:424:47>>*/ for(;;){
       if(! param$0){
        dst[1 + offset] = 0;
-        /*<<hashtbl.ml:429:20>>*/ return block;
+        /*<<hashtbl.ml:429:20>>*/ return block /*<<hashtbl.ml:429:20>>*/ ;
       }
       var k$0 = param$0[1], d$0 = param$0[2], next$0 = param$0[3];
        /*<<hashtbl.ml:428:13>>*/ if
@@ -25965,7 +26296,8 @@
         /*<<hashtbl.ml:445:8>>*/ caml_check_bound(h[2], i)[1 + i] = [0, key, data, l];
        h[1] = h[1] + 1 | 0;
        var _w_ = h[2].length - 1 << 1 < h[1] ? 1 : 0;
-       if(_w_)  /*<<hashtbl.ml:447:51>>*/ return resize(key_index, h);
+       if(_w_)
+         /*<<hashtbl.ml:447:51>>*/ return resize(key_index, h) /*<<hashtbl.ml:448:9>>*/ ;
        var _x_ = _w_;
       }
       else
@@ -25978,14 +26310,15 @@
        /*<<hashtbl.ml:457:32>>*/ _u_ = key_index(h, key),
       param = caml_check_bound(h[2], _u_)[1 + _u_];
      for(;;){
-      if(! param)  /*<<hashtbl.ml:452:10>>*/ return 0;
+      if(! param)
+        /*<<hashtbl.ml:452:10>>*/ return 0 /*<<hashtbl.ml:452:10>>*/ ;
        /*<<hashtbl.ml:454:10>>*/ var
        k = param[1],
        next = param[3],
         /*<<hashtbl.ml:454:10>>*/ _t_ =
           /*<<hashtbl.ml:454:10>>*/ caml_call2(H[1], k, key);
        /*<<hashtbl.ml:454:10>>*/ if(_t_)
-        /*<<hashtbl.ml:454:10>>*/ return _t_;
+        /*<<hashtbl.ml:454:10>>*/ return _t_ /*<<hashtbl.ml:454:10>>*/ ;
       param = next;
      }
      /*<<hashtbl.ml:457:48>>*/ }
@@ -25994,24 +26327,24 @@
              (Stdlib_Seq[4],
               function(param){
                 /*<<hashtbl.ml:460:15>>*/ var v = param[2], k = param[1];
-                /*<<hashtbl.ml:460:29>>*/ return add(tbl, k, v);
+                /*<<hashtbl.ml:460:29>>*/ return add(tbl, k, v) /*<<hashtbl.ml:460:41>>*/ ;
                /*<<hashtbl.ml:460:41>>*/ },
-              i);
+              i) /*<<hashtbl.ml:460:43>>*/ ;
      /*<<hashtbl.ml:460:43>>*/ }
     function replace_seq(tbl, i){
       /*<<hashtbl.ml:463:6>>*/ return  /*<<hashtbl.ml:463:6>>*/ caml_call2
              (Stdlib_Seq[4],
               function(param){
                 /*<<hashtbl.ml:463:15>>*/ var v = param[2], k = param[1];
-                /*<<hashtbl.ml:463:29>>*/ return replace(tbl, k, v);
+                /*<<hashtbl.ml:463:29>>*/ return replace(tbl, k, v) /*<<hashtbl.ml:463:45>>*/ ;
                /*<<hashtbl.ml:463:45>>*/ },
-              i);
+              i) /*<<hashtbl.ml:463:47>>*/ ;
      /*<<hashtbl.ml:463:47>>*/ }
     function of_seq(i){
       /*<<hashtbl.ml:466:6>>*/  /*<<hashtbl.ml:466:16>>*/ var
       tbl = create(0, 16);
       /*<<hashtbl.ml:467:6>>*/ replace_seq(tbl, i);
-      /*<<hashtbl.ml:467:6>>*/ return tbl;
+      /*<<hashtbl.ml:467:6>>*/ return tbl /*<<hashtbl.ml:467:6>>*/ ;
      /*<<hashtbl.ml:468:9>>*/ }
      /*<<hashtbl.ml:347:2>>*/ return [0,
             create,
@@ -26035,13 +26368,13 @@
             to_seq_values,
             add_seq,
             replace_seq,
-            of_seq];
+            of_seq] /*<<hashtbl.ml:347:2>>*/ ;
    }
    function Make(H){
     var equal = H[1];
     function seeded_hash(seed, x){
       /*<<hashtbl.ml:485:41>>*/ return  /*<<hashtbl.ml:485:41>>*/ caml_call1
-             (H[2], x);
+             (H[2], x) /*<<hashtbl.ml:485:49>>*/ ;
      /*<<hashtbl.ml:485:49>>*/ }
     var
      include = MakeSeeded([0, equal, seeded_hash]),
@@ -26068,14 +26401,14 @@
      replace_seq = include[21];
     function create(sz){
       /*<<hashtbl.ml:487:20>>*/ return  /*<<hashtbl.ml:487:20>>*/ caml_call2
-             (_s_, _d_, sz);
+             (_s_, _d_, sz) /*<<hashtbl.ml:487:43>>*/ ;
      /*<<hashtbl.ml:487:43>>*/ }
     function of_seq(i){
       /*<<hashtbl.ml:489:6>>*/  /*<<hashtbl.ml:487:20>>*/ var
       tbl =  /*<<hashtbl.ml:487:20>>*/ caml_call2(_s_, _d_, 16);
       /*<<hashtbl.ml:490:6>>*/  /*<<hashtbl.ml:490:6>>*/ caml_call2
       (replace_seq, tbl, i);
-      /*<<hashtbl.ml:490:6>>*/ return tbl;
+      /*<<hashtbl.ml:490:6>>*/ return tbl /*<<hashtbl.ml:490:6>>*/ ;
      /*<<hashtbl.ml:491:9>>*/ }
      /*<<hashtbl.ml:481:2>>*/ return [0,
             create,
@@ -26099,19 +26432,19 @@
             to_seq_values,
             add_seq,
             replace_seq,
-            of_seq];
+            of_seq] /*<<hashtbl.ml:481:2>>*/ ;
    }
    function hash(x){
      /*<<hashtbl.ml:501:13>>*/ return  /*<<hashtbl.ml:501:13>>*/ caml_hash
-            (10, 100, 0, x);
+            (10, 100, 0, x) /*<<hashtbl.ml:501:41>>*/ ;
     /*<<hashtbl.ml:501:41>>*/ }
    function hash_param(n1, n2, x){
      /*<<hashtbl.ml:502:25>>*/ return  /*<<hashtbl.ml:502:25>>*/ caml_hash
-            (n1, n2, 0, x);
+            (n1, n2, 0, x) /*<<hashtbl.ml:502:52>>*/ ;
     /*<<hashtbl.ml:502:52>>*/ }
    function seeded_hash(seed, x){
      /*<<hashtbl.ml:503:25>>*/ return  /*<<hashtbl.ml:503:25>>*/ caml_hash
-            (10, 100, seed, x);
+            (10, 100, seed, x) /*<<hashtbl.ml:503:56>>*/ ;
     /*<<hashtbl.ml:503:56>>*/ }
    function key_index(h, key){
      /*<<hashtbl.ml:506:2>>*/ return 4 <= h.length - 1
@@ -26119,7 +26452,7 @@
               (10, 100, h[3], key)
              & (h[2].length - 2 | 0)
             :  /*<<hashtbl.ml:508:7>>*/ caml_call1
-              (Stdlib[1], cst_Hashtbl_unsupported_hash_t);
+              (Stdlib[1], cst_Hashtbl_unsupported_hash_t) /*<<hashtbl.ml:508:59>>*/ ;
     /*<<hashtbl.ml:508:59>>*/ }
    function add(h, key, data){
      /*<<hashtbl.ml:511:2>>*/ var
@@ -26129,7 +26462,7 @@
      /*<<hashtbl.ml:513:2>>*/ caml_check_bound(h[2], i)[1 + i] = bucket;
     h[1] = h[1] + 1 | 0;
     var _r_ = h[2].length - 1 << 1 < h[1] ? 1 : 0;
-    return _r_ ? resize(key_index, h) : _r_;
+    return _r_ ? resize(key_index, h) : _r_ /*<<hashtbl.ml:515:63>>*/ ;
     /*<<hashtbl.ml:515:63>>*/ }
    function remove(h, key){
      /*<<hashtbl.ml:531:2>>*/ var
@@ -26138,14 +26471,14 @@
      prec$0 = 0,
      prec = c;
     for(;;){
-     if(! prec)  /*<<hashtbl.ml:519:6>>*/ return 0;
+     if(! prec)  /*<<hashtbl.ml:519:6>>*/ return 0 /*<<hashtbl.ml:519:6>>*/ ;
      var k = prec[1], next = prec[3];
       /*<<hashtbl.ml:521:9>>*/ if
       (0 ===  /*<<hashtbl.ml:521:9>>*/ caml_compare(k, key)){
       h[1] = h[1] - 1 | 0;
       return prec$0
               ? (prec$0[3] = next, 0)
-              : (caml_check_bound(h[2], i)[1 + i] = next, 0);
+              : (caml_check_bound(h[2], i)[1 + i] = next, 0) /*<<hashtbl.ml:532:40>>*/ ;
      }
      prec$0 = prec;
      prec = next;
@@ -26161,21 +26494,21 @@
     var k1 = match[1], d1 = match[2], next1 = match[3];
      /*<<hashtbl.ml:544:9>>*/ if
      (0 ===  /*<<hashtbl.ml:544:9>>*/ caml_compare(key, k1))
-      /*<<hashtbl.ml:544:33>>*/ return d1;
+      /*<<hashtbl.ml:544:33>>*/ return d1 /*<<hashtbl.ml:544:33>>*/ ;
     if(! next1)
       /*<<hashtbl.ml:546:17>>*/ throw  /*<<hashtbl.ml:546:17>>*/ caml_maybe_attach_backtrace
             (Stdlib[8], 1);
     var k2 = next1[1], d2 = next1[2], next2 = next1[3];
      /*<<hashtbl.ml:548:13>>*/ if
      (0 ===  /*<<hashtbl.ml:548:13>>*/ caml_compare(key, k2))
-      /*<<hashtbl.ml:548:37>>*/ return d2;
+      /*<<hashtbl.ml:548:37>>*/ return d2 /*<<hashtbl.ml:548:37>>*/ ;
     if(! next2)
       /*<<hashtbl.ml:550:21>>*/ throw  /*<<hashtbl.ml:550:21>>*/ caml_maybe_attach_backtrace
             (Stdlib[8], 1);
     var k3 = next2[1], d3 = next2[2], next3 = next2[3];
      /*<<hashtbl.ml:552:17>>*/ if
      (0 ===  /*<<hashtbl.ml:552:17>>*/ caml_compare(key, k3))
-      /*<<hashtbl.ml:552:41>>*/ return d3;
+      /*<<hashtbl.ml:552:41>>*/ return d3 /*<<hashtbl.ml:552:41>>*/ ;
     var param = next3;
     for(;;){
      if(! param)
@@ -26184,7 +26517,7 @@
      var k = param[1], data = param[2], next = param[3];
       /*<<hashtbl.ml:538:9>>*/ if
       (0 ===  /*<<hashtbl.ml:538:9>>*/ caml_compare(key, k))
-       /*<<hashtbl.ml:538:32>>*/ return data;
+       /*<<hashtbl.ml:538:32>>*/ return data /*<<hashtbl.ml:538:32>>*/ ;
      param = next;
     }
     /*<<hashtbl.ml:552:67>>*/ }
@@ -26192,28 +26525,31 @@
      /*<<hashtbl.ml:561:2>>*/ var
       /*<<hashtbl.ml:561:16>>*/ _p_ = key_index(h, key),
       /*<<hashtbl.ml:561:8>>*/ match = caml_check_bound(h[2], _p_)[1 + _p_];
-    if(! match)  /*<<hashtbl.ml:562:13>>*/ return 0;
+    if(! match)
+      /*<<hashtbl.ml:562:13>>*/ return 0 /*<<hashtbl.ml:562:13>>*/ ;
     var k1 = match[1], d1 = match[2], next1 = match[3];
      /*<<hashtbl.ml:564:9>>*/ if
      (0 ===  /*<<hashtbl.ml:564:9>>*/ caml_compare(key, k1))
-      /*<<hashtbl.ml:564:33>>*/ return [0, d1];
-    if(! next1)  /*<<hashtbl.ml:566:17>>*/ return 0;
+      /*<<hashtbl.ml:564:33>>*/ return [0, d1] /*<<hashtbl.ml:564:33>>*/ ;
+    if(! next1)
+      /*<<hashtbl.ml:566:17>>*/ return 0 /*<<hashtbl.ml:566:17>>*/ ;
     var k2 = next1[1], d2 = next1[2], next2 = next1[3];
      /*<<hashtbl.ml:568:13>>*/ if
      (0 ===  /*<<hashtbl.ml:568:13>>*/ caml_compare(key, k2))
-      /*<<hashtbl.ml:568:37>>*/ return [0, d2];
-    if(! next2)  /*<<hashtbl.ml:570:21>>*/ return 0;
+      /*<<hashtbl.ml:568:37>>*/ return [0, d2] /*<<hashtbl.ml:568:37>>*/ ;
+    if(! next2)
+      /*<<hashtbl.ml:570:21>>*/ return 0 /*<<hashtbl.ml:570:21>>*/ ;
     var k3 = next2[1], d3 = next2[2], next3 = next2[3];
      /*<<hashtbl.ml:572:17>>*/ if
      (0 ===  /*<<hashtbl.ml:572:17>>*/ caml_compare(key, k3))
-      /*<<hashtbl.ml:572:41>>*/ return [0, d3];
+      /*<<hashtbl.ml:572:41>>*/ return [0, d3] /*<<hashtbl.ml:572:41>>*/ ;
     var param = next3;
     for(;;){
-     if(! param)  /*<<hashtbl.ml:556:6>>*/ return 0;
+     if(! param)  /*<<hashtbl.ml:556:6>>*/ return 0 /*<<hashtbl.ml:556:6>>*/ ;
      var k = param[1], data = param[2], next = param[3];
       /*<<hashtbl.ml:558:9>>*/ if
       (0 ===  /*<<hashtbl.ml:558:9>>*/ caml_compare(key, k))
-       /*<<hashtbl.ml:558:32>>*/ return [0, data];
+       /*<<hashtbl.ml:558:32>>*/ return [0, data] /*<<hashtbl.ml:558:32>>*/ ;
      param = next;
     }
     /*<<hashtbl.ml:572:76>>*/ }
@@ -26222,7 +26558,7 @@
       /*<<hashtbl.ml:582:25>>*/ _o_ = key_index(h, key),
      param = caml_check_bound(h[2], _o_)[1 + _o_];
      /*<<hashtbl.ml:575:43>>*/ for(;;){
-     if(! param)  /*<<hashtbl.ml:577:6>>*/ return 0;
+     if(! param)  /*<<hashtbl.ml:577:6>>*/ return 0 /*<<hashtbl.ml:577:6>>*/ ;
      var k = param[1], data = param[2], next = param[3];
       /*<<hashtbl.ml:579:9>>*/ if
       (0 ===  /*<<hashtbl.ml:579:9>>*/ caml_compare(k, key))
@@ -26237,7 +26573,7 @@
      /*<<hashtbl.ml:575:43>>*/ for(;;){
      if(! param$0){
       dst[1 + offset] = 0;
-       /*<<hashtbl.ml:580:19>>*/ return block;
+       /*<<hashtbl.ml:580:19>>*/ return block /*<<hashtbl.ml:580:19>>*/ ;
      }
      var k$0 = param$0[1], data$0 = param$0[2], next$0 = param$0[3];
       /*<<hashtbl.ml:579:9>>*/ if
@@ -26273,7 +26609,8 @@
        /*<<hashtbl.ml:596:4>>*/ caml_check_bound(h[2], i)[1 + i] = [0, key, data, l];
       h[1] = h[1] + 1 | 0;
       var _m_ = h[2].length - 1 << 1 < h[1] ? 1 : 0;
-      if(_m_)  /*<<hashtbl.ml:598:47>>*/ return resize(key_index, h);
+      if(_m_)
+        /*<<hashtbl.ml:598:47>>*/ return resize(key_index, h) /*<<hashtbl.ml:599:5>>*/ ;
       var _n_ = _m_;
      }
      else
@@ -26286,7 +26623,7 @@
       /*<<hashtbl.ml:608:28>>*/ _k_ = key_index(h, key),
      param = caml_check_bound(h[2], _k_)[1 + _k_];
     for(;;){
-     if(! param)  /*<<hashtbl.ml:603:6>>*/ return 0;
+     if(! param)  /*<<hashtbl.ml:603:6>>*/ return 0 /*<<hashtbl.ml:603:6>>*/ ;
      var
       k = param[1],
       next = param[3],
@@ -26300,24 +26637,24 @@
             (Stdlib_Seq[4],
              function(param){
                /*<<hashtbl.ml:611:11>>*/ var v = param[2], k = param[1];
-               /*<<hashtbl.ml:611:25>>*/ return add(tbl, k, v);
+               /*<<hashtbl.ml:611:25>>*/ return add(tbl, k, v) /*<<hashtbl.ml:611:37>>*/ ;
               /*<<hashtbl.ml:611:37>>*/ },
-             i);
+             i) /*<<hashtbl.ml:611:39>>*/ ;
     /*<<hashtbl.ml:611:39>>*/ }
    function replace_seq(tbl, i){
      /*<<hashtbl.ml:614:2>>*/ return  /*<<hashtbl.ml:614:2>>*/ caml_call2
             (Stdlib_Seq[4],
              function(param){
                /*<<hashtbl.ml:614:11>>*/ var v = param[2], k = param[1];
-               /*<<hashtbl.ml:614:25>>*/ return replace(tbl, k, v);
+               /*<<hashtbl.ml:614:25>>*/ return replace(tbl, k, v) /*<<hashtbl.ml:614:41>>*/ ;
               /*<<hashtbl.ml:614:41>>*/ },
-             i);
+             i) /*<<hashtbl.ml:614:43>>*/ ;
     /*<<hashtbl.ml:614:43>>*/ }
    function of_seq(i){
      /*<<hashtbl.ml:617:2>>*/  /*<<hashtbl.ml:617:12>>*/ var
      tbl = create(0, 16);
      /*<<hashtbl.ml:618:2>>*/ replace_seq(tbl, i);
-     /*<<hashtbl.ml:618:2>>*/ return tbl;
+     /*<<hashtbl.ml:618:2>>*/ return tbl /*<<hashtbl.ml:618:2>>*/ ;
     /*<<hashtbl.ml:619:5>>*/ }
    function rebuild(opt, h){
      /*<<hashtbl.ml:622:10>>*/ var
@@ -26339,7 +26676,7 @@
        [0, h[1],  /*<<hashtbl.ml:629:11>>*/ caml_make_vect(s, 0), seed, _h_];
      /*<<hashtbl.ml:633:2>>*/ insert_all_buckets
      (function(_i_){ /*<<?>>*/ return key_index(h$0, _i_);}, 0, h[2], h$0[2]);
-     /*<<hashtbl.ml:633:2>>*/ return h$0;
+     /*<<hashtbl.ml:633:2>>*/ return h$0 /*<<hashtbl.ml:633:2>>*/ ;
    }
    var
     Stdlib_Hashtbl =
@@ -26439,7 +26776,7 @@
       /*<<weak.ml:29:4>>*/  /*<<weak.ml:29:4>>*/ caml_call1
       (Stdlib[1], cst_Weak_create);
      /*<<weak.ml:30:2>>*/ return  /*<<weak.ml:30:2>>*/ runtime.caml_weak_create
-            (l);
+            (l) /*<<weak.ml:30:10>>*/ ;
     /*<<weak.ml:30:10>>*/ }
    function length(x){
      /*<<weak.ml:33:15>>*/ return x.length - 3 | 0;
@@ -26449,31 +26786,31 @@
      _G_ = 0 <= o ? 1 : 0,
      _H_ = _G_ ? o < length(e) ? 1 : 0 : _G_,
      _I_ = 1 - _H_;
-    return _I_ ?  /*<<weak.ml:37:4>>*/ caml_call1(Stdlib[1], msg) : _I_;
+    return _I_ ?  /*<<weak.ml:37:4>>*/ caml_call1(Stdlib[1], msg) : _I_ /*<<weak.ml:37:20>>*/ ;
     /*<<weak.ml:37:20>>*/ }
    function set(e, o, x){
      /*<<weak.ml:42:2>>*/ raise_if_invalid_offset(e, o, cst_Weak_set);
     if(! x)
       /*<<weak.ml:44:12>>*/ return  /*<<weak.ml:44:12>>*/ runtime.caml_ephe_unset_key
-             (e, o);
+             (e, o) /*<<weak.ml:45:24>>*/ ;
     var x$0 = x[1];
      /*<<weak.ml:45:14>>*/ return  /*<<weak.ml:45:14>>*/ runtime.caml_ephe_set_key
-            (e, o, x$0);
+            (e, o, x$0) /*<<weak.ml:45:24>>*/ ;
     /*<<weak.ml:45:24>>*/ }
    function get(e, o){
      /*<<weak.ml:49:2>>*/ raise_if_invalid_offset(e, o, cst_Weak_get);
      /*<<weak.ml:50:2>>*/ return  /*<<weak.ml:50:2>>*/ runtime.caml_ephe_get_key
-            (e, o);
+            (e, o) /*<<weak.ml:50:9>>*/ ;
     /*<<weak.ml:50:9>>*/ }
    function get_copy(e, o){
      /*<<weak.ml:54:2>>*/ raise_if_invalid_offset(e, o, cst_Weak_get_copy);
      /*<<weak.ml:55:2>>*/ return  /*<<weak.ml:55:2>>*/ runtime.caml_ephe_get_key_copy
-            (e, o);
+            (e, o) /*<<weak.ml:55:14>>*/ ;
     /*<<weak.ml:55:14>>*/ }
    function check(e, o){
      /*<<weak.ml:59:2>>*/ raise_if_invalid_offset(e, o, cst_Weak_check);
      /*<<weak.ml:60:2>>*/ return  /*<<weak.ml:60:2>>*/ runtime.caml_ephe_check_key
-            (e, o);
+            (e, o) /*<<weak.ml:60:11>>*/ ;
     /*<<weak.ml:60:11>>*/ }
    function blit(e1, o1, e2, o2, l){
      /*<<weak.ml:66:2>>*/ if
@@ -26488,10 +26825,10 @@
          ?  /*<<weak.ml:69:22>>*/ runtime.caml_ephe_blit_key
            (e1, o1, e2, o2, l)
          : _E_;
-      /*<<weak.ml:69:22>>*/ return _F_;
+      /*<<weak.ml:69:22>>*/ return _F_ /*<<weak.ml:69:22>>*/ ;
     }
      /*<<weak.ml:68:7>>*/ return  /*<<weak.ml:68:7>>*/ caml_call1
-            (Stdlib[1], cst_Weak_blit);
+            (Stdlib[1], cst_Weak_blit) /*<<weak.ml:69:40>>*/ ;
     /*<<weak.ml:69:40>>*/ }
    function fill(ar, ofs, len, x){
      /*<<weak.ml:72:2>>*/ if
@@ -26515,7 +26852,7 @@
      /*<<weak.ml:105:20>>*/  /*<<weak.ml:105:20>>*/ var
      emptybucket = create(0);
     function get_index(t, h){
-      /*<<weak.ml:117:22>>*/ return caml_mod(h & Stdlib[19], t[1].length - 1);
+      /*<<weak.ml:117:22>>*/ return caml_mod(h & Stdlib[19], t[1].length - 1) /*<<weak.ml:117:65>>*/ ;
      /*<<weak.ml:117:65>>*/ }
     var limit = 7;
     function create$0(sz){
@@ -26527,7 +26864,7 @@
               /*<<weak.ml:127:15>>*/ caml_make_vect(sz$1, [0]),
              limit,
              0,
-             0];
+             0] /*<<weak.ml:125:4>>*/ ;
      /*<<weak.ml:131:5>>*/ }
     function clear(t){
       /*<<weak.ml:134:4>>*/ var
@@ -26554,7 +26891,8 @@
               function(b, accu$1){
                var i$0 = i, accu = accu$1;
                 /*<<weak.ml:144:6>>*/ for(;;){
-                if(length(b) <= i$0)  /*<<weak.ml:144:28>>*/ return accu;
+                if(length(b) <= i$0)
+                  /*<<weak.ml:144:28>>*/ return accu /*<<weak.ml:144:28>>*/ ;
                  /*<<weak.ml:145:12>>*/  /*<<weak.ml:145:12>>*/ var
                  match = get(b, i$0);
                 if(match){
@@ -26570,7 +26908,7 @@
                }
               },
               t[1],
-              init);
+              init) /*<<weak.ml:149:49>>*/ ;
      /*<<weak.ml:149:49>>*/ }
     function iter(f, t){
       /*<<weak.ml:153:4>>*/ var i = 0;
@@ -26579,7 +26917,8 @@
               function(b){
                var i$0 = i;
                 /*<<weak.ml:154:6>>*/ for(;;){
-                if(length(b) <= i$0)  /*<<weak.ml:154:28>>*/ return 0;
+                if(length(b) <= i$0)
+                  /*<<weak.ml:154:28>>*/ return 0 /*<<weak.ml:154:28>>*/ ;
                  /*<<weak.ml:155:12>>*/  /*<<weak.ml:155:12>>*/ var
                  match = get(b, i$0);
                 if(match){
@@ -26592,12 +26931,13 @@
                 else{var i$2 = i$0 + 1 | 0; i$0 = i$2;}
                }
               },
-              t[1]);
+              t[1]) /*<<weak.ml:159:38>>*/ ;
      /*<<weak.ml:159:38>>*/ }
     function count_bucket(i, b, accu){
       /*<<weak.ml:173:4>>*/ var i$0 = i, accu$0 = accu;
       /*<<weak.ml:173:4>>*/ for(;;){
-      if(length(b) <= i$0)  /*<<weak.ml:173:26>>*/ return accu$0;
+      if(length(b) <= i$0)
+        /*<<weak.ml:173:26>>*/ return accu$0 /*<<weak.ml:173:26>>*/ ;
        /*<<weak.ml:174:37>>*/ var
         /*<<weak.ml:174:37>>*/ _y_ = check(b, i$0) ? 1 : 0,
        accu$1 = accu$0 + _y_ | 0,
@@ -26614,7 +26954,7 @@
                 /*<<?>>*/ return count_bucket(_v_, _w_, _x_);
               },
               t[1],
-              0);
+              0) /*<<weak.ml:178:47>>*/ ;
      /*<<weak.ml:178:47>>*/ }
     function add_aux(t, setter, d, h, index){
       /*<<weak.ml:238:4>>*/ var
@@ -26630,7 +26970,7 @@
         /*<<weak.ml:263:8>>*/  /*<<weak.ml:263:8>>*/ caml_call3
         (setter, bucket$0, i$3, d);
         /*<<weak.ml:264:8>>*/ caml_check_bound(hashes, i$3)[1 + i$3] = h;
-        /*<<weak.ml:264:8>>*/ return 0;
+        /*<<weak.ml:264:8>>*/ return 0 /*<<weak.ml:264:8>>*/ ;
       }
        /*<<weak.ml:260:38>>*/  /*<<weak.ml:260:38>>*/ var i$5 = i$3 + 1 | 0;
       i$3 = i$5;
@@ -26742,7 +27082,8 @@
         function(j, ob){
          var oi = i;
           /*<<weak.ml:164:6>>*/ for(;;){
-          if(length(ob) <= oi)  /*<<weak.ml:164:28>>*/ return 0;
+          if(length(ob) <= oi)
+            /*<<weak.ml:164:28>>*/ return 0 /*<<weak.ml:164:28>>*/ ;
           if(check(ob, oi)){
             /*<<weak.ml:166:20>>*/  /*<<weak.ml:166:20>>*/ var
             oh = caml_check_bound(t[2], j)[1 + j];
@@ -26750,7 +27091,7 @@
             /*<<weak.ml:223:16>>*/ var
             setter =
               function(nb, ni, param){
-                /*<<weak.ml:222:29>>*/ return blit(ob, oi$0, nb, ni, 1);
+                /*<<weak.ml:222:29>>*/ return blit(ob, oi$0, nb, ni, 1) /*<<weak.ml:222:47>>*/ ;
                /*<<weak.ml:222:47>>*/ },
              /*<<weak.ml:223:16>>*/ h = caml_check_bound(oh, oi)[1 + oi];
             /*<<weak.ml:224:35>>*/ add_aux
@@ -26777,7 +27118,7 @@
       /*<<weak.ml:271:4>>*/  /*<<weak.ml:271:12>>*/ var
       h =  /*<<weak.ml:271:12>>*/ caml_call1(H[2], d);
       /*<<weak.ml:272:29>>*/ return add_aux
-             (t, set, [0, d], h, get_index(t, h));
+             (t, set, [0, d], h, get_index(t, h)) /*<<weak.ml:272:44>>*/ ;
      /*<<weak.ml:272:44>>*/ }
     function find_aux(t, d, found, notfound){
       /*<<weak.ml:278:4>>*/ var
@@ -26792,7 +27133,7 @@
       /*<<weak.ml:284:6>>*/ for(;;){
       if(sz <= i)
         /*<<weak.ml:279:16>>*/ return  /*<<weak.ml:279:16>>*/ caml_call2
-               (notfound, h, index);
+               (notfound, h, index) /*<<weak.ml:291:10>>*/ ;
       if(h === caml_check_bound(hashes, i)[1 + i]){
         /*<<weak.ml:286:14>>*/  /*<<weak.ml:286:14>>*/ var
         opt = get(bucket, i);
@@ -26801,7 +27142,7 @@
          /*<<weak.ml:287:29>>*/ if
          ( /*<<weak.ml:287:29>>*/ caml_call2(H[1], v, d))
           /*<<weak.ml:287:44>>*/ return  /*<<weak.ml:287:44>>*/ caml_call4
-                 (found, bucket, i, opt, v);
+                 (found, bucket, i, opt, v) /*<<weak.ml:291:10>>*/ ;
        }
         /*<<weak.ml:288:15>>*/  /*<<weak.ml:288:15>>*/ var i$0 = i + 1 | 0;
        i = i$0;
@@ -26817,57 +27158,57 @@
              (t,
               d,
               function(b, i, o, v){
-                /*<<weak.ml:293:54>>*/ return o;
+                /*<<weak.ml:293:54>>*/ return o /*<<weak.ml:293:54>>*/ ;
                /*<<weak.ml:293:55>>*/ },
               function(h, i){
-                /*<<weak.ml:294:48>>*/ return 0;
-               /*<<weak.ml:294:52>>*/ });
+                /*<<weak.ml:294:48>>*/ return 0 /*<<weak.ml:294:48>>*/ ;
+               /*<<weak.ml:294:52>>*/ }) /*<<weak.ml:294:53>>*/ ;
      /*<<weak.ml:294:53>>*/ }
     function merge(t, d){
       /*<<weak.ml:296:21>>*/ return find_aux
              (t,
               d,
               function(b, i, o, v){
-                /*<<weak.ml:296:54>>*/ return v;
+                /*<<weak.ml:296:54>>*/ return v /*<<weak.ml:296:54>>*/ ;
                /*<<weak.ml:296:55>>*/ },
               function(h, i){
                 /*<<weak.ml:298:40>>*/ add_aux(t, set, [0, d], h, i);
-                /*<<weak.ml:296:21>>*/ return d;
-               /*<<weak.ml:298:69>>*/ });
+                /*<<weak.ml:296:21>>*/ return d /*<<weak.ml:296:21>>*/ ;
+               /*<<weak.ml:298:69>>*/ }) /*<<weak.ml:298:70>>*/ ;
      /*<<weak.ml:298:70>>*/ }
     function find(t, d){
       /*<<weak.ml:300:21>>*/ return find_aux
              (t,
               d,
               function(b, i, o, v){
-                /*<<weak.ml:300:54>>*/ return v;
+                /*<<weak.ml:300:54>>*/ return v /*<<weak.ml:300:54>>*/ ;
                /*<<weak.ml:300:55>>*/ },
               function(h, i){
                 /*<<weak.ml:301:48>>*/ throw  /*<<weak.ml:301:48>>*/ caml_maybe_attach_backtrace
                       (Stdlib[8], 1);
-               /*<<weak.ml:301:63>>*/ });
+               /*<<weak.ml:301:63>>*/ }) /*<<weak.ml:301:64>>*/ ;
      /*<<weak.ml:301:64>>*/ }
     function remove(t, d){
       /*<<weak.ml:303:21>>*/ return find_aux
              (t,
               d,
               function(b, i, o, v){
-                /*<<weak.ml:303:54>>*/ return set(b, i, 0);
+                /*<<weak.ml:303:54>>*/ return set(b, i, 0) /*<<weak.ml:303:66>>*/ ;
                /*<<weak.ml:303:66>>*/ },
               function(h, i){
-                /*<<weak.ml:304:48>>*/ return 0;
-               /*<<weak.ml:304:50>>*/ });
+                /*<<weak.ml:304:48>>*/ return 0 /*<<weak.ml:304:48>>*/ ;
+               /*<<weak.ml:304:50>>*/ }) /*<<weak.ml:304:51>>*/ ;
      /*<<weak.ml:304:51>>*/ }
     function mem(t, d){
       /*<<weak.ml:306:21>>*/ return find_aux
              (t,
               d,
               function(b, i, o, v){
-                /*<<weak.ml:306:54>>*/ return 1;
+                /*<<weak.ml:306:54>>*/ return 1 /*<<weak.ml:306:54>>*/ ;
                /*<<weak.ml:306:58>>*/ },
               function(h, i){
-                /*<<weak.ml:307:48>>*/ return 0;
-               /*<<weak.ml:307:53>>*/ });
+                /*<<weak.ml:307:48>>*/ return 0 /*<<weak.ml:307:48>>*/ ;
+               /*<<weak.ml:307:53>>*/ }) /*<<weak.ml:307:54>>*/ ;
      /*<<weak.ml:307:54>>*/ }
     function find_all(t, d){
       /*<<weak.ml:310:4>>*/ var
@@ -26881,7 +27222,7 @@
       i = 0,
       accu = 0;
       /*<<weak.ml:316:6>>*/ for(;;){
-      if(sz <= i)  /*<<weak.ml:316:22>>*/ return accu;
+      if(sz <= i)  /*<<weak.ml:316:22>>*/ return accu /*<<weak.ml:316:22>>*/ ;
       if(h === caml_check_bound(hashes, i)[1 + i]){
         /*<<weak.ml:318:14>>*/  /*<<weak.ml:318:14>>*/ var
         match = get(bucket, i);
@@ -26922,7 +27263,7 @@
        /*<<weak.ml:330:51>>*/ _b_ = caml_check_bound(lens, _a_)[1 + _a_],
        /*<<weak.ml:330:37>>*/ _d_ = caml_check_bound(lens, _c_)[1 + _c_],
        /*<<weak.ml:330:27>>*/ _e_ = caml_check_bound(lens, 0)[1];
-      /*<<weak.ml:330:4>>*/ return [0, len, count(t), totlen, _e_, _d_, _b_];
+      /*<<weak.ml:330:4>>*/ return [0, len, count(t), totlen, _e_, _d_, _b_] /*<<weak.ml:330:4>>*/ ;
      /*<<weak.ml:330:64>>*/ }
      /*<<weak.ml:101:66>>*/ return [0,
             create$0,
@@ -26937,7 +27278,7 @@
             iter,
             fold,
             count,
-            stats];
+            stats] /*<<weak.ml:101:66>>*/ ;
    }
    var
     Stdlib_Weak =
@@ -27010,7 +27351,9 @@
     Stdlib_Stack = global_data.Stdlib__Stack,
     Stdlib_Int = global_data.Stdlib__Int,
     Stdlib_Bytes = global_data.Stdlib__Bytes;
-   function id(x){ /*<<format.ml:23:11>>*/ return x; /*<<format.ml:23:12>>*/ }
+   function id(x){
+     /*<<format.ml:23:11>>*/ return x /*<<format.ml:23:11>>*/ ;
+    /*<<format.ml:23:12>>*/ }
     /*<<format.ml:91:13>>*/ var
     zero = 0,
     unknown = -1,
@@ -27018,7 +27361,7 @@
       [248, "Stdlib.Format.String_tag", runtime.caml_fresh_oo_id(0)];
    function pp_enqueue(state, token){
      /*<<format.ml:219:2>>*/ state[13] = state[13] + token[3] | 0;
-    return caml_call2(Stdlib_Queue[3], token, state[28]);
+    return caml_call2(Stdlib_Queue[3], token, state[28]) /*<<format.ml:220:32>>*/ ;
     /*<<format.ml:220:32>>*/ }
    var
     pp_infinity = 1000000010,
@@ -27030,11 +27373,11 @@
     cst_Format_pp_set_geometry = "Format.pp_set_geometry: ";
    function pp_output_string(state, s){
      /*<<format.ml:251:31>>*/ return caml_call3
-            (state[17], s, 0, caml_ml_string_length(s));
+            (state[17], s, 0, caml_ml_string_length(s)) /*<<format.ml:251:72>>*/ ;
     /*<<format.ml:251:72>>*/ }
    function pp_output_newline(state){
      /*<<format.ml:252:30>>*/ return  /*<<format.ml:252:30>>*/ caml_call1
-            (state[19], 0);
+            (state[19], 0) /*<<format.ml:252:53>>*/ ;
     /*<<format.ml:252:53>>*/ }
    function format_pp_text(state, size, text){
      /*<<format.ml:258:2>>*/ state[9] = state[9] - size | 0;
@@ -27046,7 +27389,7 @@
      _a__ = s !== cst$16 ? 1 : 0;
      /*<<format.ml:264:5>>*/ return _a__
             ? format_pp_text(state, caml_ml_string_length(s), s)
-            : _a__;
+            : _a__ /*<<format.ml:264:58>>*/ ;
     /*<<format.ml:264:58>>*/ }
    function break_new_line(state, param, width){
     var after = param[3], offset = param[2], before = param[1];
@@ -27062,7 +27405,7 @@
     var n = state[10];
      /*<<format.ml:254:31>>*/  /*<<format.ml:254:31>>*/ caml_call1
      (state[21], n);
-     /*<<format.ml:276:2>>*/ return format_string(state, after);
+     /*<<format.ml:276:2>>*/ return format_string(state, after) /*<<format.ml:276:2>>*/ ;
    }
    function break_same_line(state, param){
     var after = param[3], width = param[2], before = param[1];
@@ -27070,7 +27413,7 @@
     state[9] = state[9] - width | 0;
      /*<<format.ml:253:31>>*/  /*<<format.ml:253:31>>*/ caml_call1
      (state[20], width);
-     /*<<format.ml:287:2>>*/ return format_string(state, after);
+     /*<<format.ml:287:2>>*/ return format_string(state, after) /*<<format.ml:287:2>>*/ ;
    }
    function format_pp_token(state, size$0, param){
      /*<<?>>*/ if(typeof param === "number")
@@ -27079,12 +27422,14 @@
          /*<<format.ml:348:16>>*/  /*<<format.ml:348:16>>*/ var
          match$3 =
             /*<<format.ml:348:16>>*/ caml_call1(Stdlib_Stack[8], state[3]);
-        if(! match$3)  /*<<format.ml:349:14>>*/ return;
+        if(! match$3)
+          /*<<format.ml:349:14>>*/ return /*<<format.ml:349:14>>*/ ;
          /*<<format.ml:351:6>>*/ var
          tabs = match$3[1][1],
           /*<<format.ml:351:6>>*/ add_tab =
            function(n, ls){
-             /*<<?>>*/ if(! ls)  /*<<format.ml:352:16>>*/ return [0, n, 0];
+             /*<<?>>*/ if(! ls)
+              /*<<format.ml:352:16>>*/ return [0, n, 0] /*<<format.ml:352:16>>*/ ;
             var l = ls[2], x = ls[1];
              /*<<format.ml:353:29>>*/ return  /*<<format.ml:353:29>>*/ runtime.caml_lessthan
                      (n, x)
@@ -27096,26 +27441,27 @@
        case 1:
          /*<<format.ml:339:4>>*/  /*<<format.ml:339:4>>*/ caml_call1
          (Stdlib_Stack[5], state[2]);
-         /*<<format.ml:339:4>>*/ return;
+         /*<<format.ml:339:4>>*/ return /*<<format.ml:339:4>>*/ ;
        case 2:
          /*<<format.ml:345:4>>*/  /*<<format.ml:345:4>>*/ caml_call1
          (Stdlib_Stack[5], state[3]);
-         /*<<format.ml:345:4>>*/ return;
+         /*<<format.ml:345:4>>*/ return /*<<format.ml:345:4>>*/ ;
        case 3:
          /*<<format.ml:378:16>>*/  /*<<format.ml:378:16>>*/ var
          match$4 =
             /*<<format.ml:378:16>>*/ caml_call1(Stdlib_Stack[8], state[2]);
         if(! match$4)
-          /*<<format.ml:379:14>>*/ return pp_output_newline(state);
+          /*<<format.ml:379:14>>*/ return pp_output_newline(state) /*<<format.ml:379:14>>*/ ;
         var width$0 = match$4[1][2];
-         /*<<format.ml:281:29>>*/ return break_new_line(state, _a_, width$0);
+         /*<<format.ml:281:29>>*/ return break_new_line(state, _a_, width$0) /*<<format.ml:281:29>>*/ ;
        case 4:
         var _a8_ = state[10] !== (state[6] - state[9] | 0) ? 1 : 0;
         if(! _a8_) return _a8_;
          /*<<format.ml:306:8>>*/  /*<<format.ml:306:8>>*/ var
          match$1 =
             /*<<format.ml:306:8>>*/ caml_call1(Stdlib_Queue[6], state[28]);
-        if(! match$1)  /*<<format.ml:307:12>>*/ return;
+        if(! match$1)
+          /*<<format.ml:307:12>>*/ return /*<<format.ml:307:12>>*/ ;
         var match$2 = match$1[1], size = match$2[1], length = match$2[3];
         state[12] = state[12] - length | 0;
         state[9] = state[9] + size | 0;
@@ -27124,17 +27470,18 @@
          /*<<format.ml:419:17>>*/  /*<<format.ml:419:17>>*/ var
          match$5 =
             /*<<format.ml:419:17>>*/ caml_call1(Stdlib_Stack[5], state[5]);
-        if(! match$5)  /*<<format.ml:420:15>>*/ return;
+        if(! match$5)
+          /*<<format.ml:420:15>>*/ return /*<<format.ml:420:15>>*/ ;
          /*<<format.ml:422:20>>*/ var
          tag_name = match$5[1],
           /*<<format.ml:422:20>>*/ marker =
             /*<<format.ml:422:20>>*/ caml_call1(state[25], tag_name);
-         /*<<format.ml:423:7>>*/ return pp_output_string(state, marker);
+         /*<<format.ml:423:7>>*/ return pp_output_string(state, marker) /*<<format.ml:423:7>>*/ ;
      }
     switch(param[0]){
       case 0:
        var s = param[1];
-        /*<<format.ml:323:4>>*/ return format_pp_text(state, size$0, s);
+        /*<<format.ml:323:4>>*/ return format_pp_text(state, size$0, s) /*<<format.ml:323:4>>*/ ;
       case 1:
         /*<<format.ml:388:4>>*/ var
         breaks = param[2],
@@ -27143,20 +27490,21 @@
         before = breaks[1],
          /*<<format.ml:389:16>>*/ match$6 =
            /*<<format.ml:389:16>>*/ caml_call1(Stdlib_Stack[8], state[2]);
-       if(! match$6)  /*<<format.ml:390:14>>*/ return;
+       if(! match$6)
+         /*<<format.ml:390:14>>*/ return /*<<format.ml:390:14>>*/ ;
        var
         match$7 = match$6[1],
         width$1 = match$7[2],
         box_type$0 = match$7[1];
         /*<<format.ml:392:6>>*/ switch(box_type$0){
          case 0:
-           /*<<format.ml:409:19>>*/ return break_same_line(state, fits);
+           /*<<format.ml:409:19>>*/ return break_same_line(state, fits) /*<<format.ml:409:19>>*/ ;
          case 1:
            /*<<format.ml:408:19>>*/ return break_new_line
-                  (state, breaks, width$1);
+                  (state, breaks, width$1) /*<<format.ml:408:19>>*/ ;
          case 2:
            /*<<format.ml:406:20>>*/ return break_new_line
-                  (state, breaks, width$1);
+                  (state, breaks, width$1) /*<<format.ml:406:20>>*/ ;
          case 3:
           return state[9] < (size$0 + caml_ml_string_length(before) | 0)
                   ? break_new_line(state, breaks, width$1)
@@ -27178,7 +27526,7 @@
                       ? break_new_line(state, breaks, width$1)
                       : break_same_line(state, fits);
          default:
-           /*<<format.ml:407:19>>*/ return break_same_line(state, fits);
+           /*<<format.ml:407:19>>*/ return break_same_line(state, fits) /*<<format.ml:407:19>>*/ ;
        }
       case 2:
         /*<<format.ml:359:16>>*/ var
@@ -27187,7 +27535,8 @@
         insertion_point = state[6] - state[9] | 0,
          /*<<format.ml:359:16>>*/ match$8 =
            /*<<format.ml:359:16>>*/ caml_call1(Stdlib_Stack[8], state[3]);
-       if(! match$8)  /*<<format.ml:360:14>>*/ return;
+       if(! match$8)
+         /*<<format.ml:360:14>>*/ return /*<<format.ml:360:14>>*/ ;
         /*<<format.ml:362:6>>*/ var
         tabs$0 = match$8[1][1],
          /*<<format.ml:362:6>>*/ match$9 = tabs$0[1];
@@ -27234,11 +27583,11 @@
          /*<<format.ml:331:4>>*/ box_type$1 =
           1 === ty ? 1 : state[9] < size$0 ? ty : 5;
         /*<<format.ml:336:4>>*/ return  /*<<format.ml:336:4>>*/ caml_call2
-               (Stdlib_Stack[3], [0, box_type$1, width$2], state[2]);
+               (Stdlib_Stack[3], [0, box_type$1, width$2], state[2]) /*<<format.ml:336:4>>*/ ;
       case 4:
        var tbox = param[1];
         /*<<format.ml:342:4>>*/ return  /*<<format.ml:342:4>>*/ caml_call2
-               (Stdlib_Stack[3], tbox, state[3]);
+               (Stdlib_Stack[3], tbox, state[3]) /*<<format.ml:342:4>>*/ ;
       default:
         /*<<format.ml:414:18>>*/ var
         tag_name$0 = param[1],
@@ -27252,7 +27601,7 @@
      /*<<format.ml:431:2>>*/ for(;;){
       /*<<format.ml:431:8>>*/  /*<<format.ml:431:8>>*/ var
       match =  /*<<format.ml:431:8>>*/ caml_call1(Stdlib_Queue[9], state[28]);
-     if(! match)  /*<<format.ml:432:12>>*/ return 0;
+     if(! match)  /*<<format.ml:432:12>>*/ return 0 /*<<format.ml:432:12>>*/ ;
       /*<<format.ml:435:7>>*/ var
       match$0 = match[1],
       size = match$0[1],
@@ -27262,7 +27611,7 @@
       _a6_ = 0 <= size ? 1 : 0,
        /*<<format.ml:435:7>>*/ _a7_ =
         _a6_ || (state[9] <= pending_count ? 1 : 0);
-     if(! _a7_)  /*<<format.ml:435:7>>*/ return _a7_;
+     if(! _a7_)  /*<<format.ml:435:7>>*/ return _a7_ /*<<format.ml:435:7>>*/ ;
       /*<<format.ml:436:6>>*/  /*<<format.ml:436:6>>*/ caml_call1
       (Stdlib_Queue[5], state[28]);
       /*<<format.ml:437:20>>*/  /*<<format.ml:437:20>>*/ var
@@ -27273,11 +27622,11 @@
     /*<<format.ml:441:7>>*/ }
    function enqueue_advance(state, tok){
      /*<<format.ml:445:32>>*/ pp_enqueue(state, tok);
-     /*<<format.ml:445:32>>*/ return advance_left(state);
+     /*<<format.ml:445:32>>*/ return advance_left(state) /*<<format.ml:445:72>>*/ ;
     /*<<format.ml:445:72>>*/ }
    function enqueue_string_as(state, size, s){
      /*<<format.ml:450:2>>*/ return enqueue_advance
-            (state, [0, size, [0, s], size]);
+            (state, [0, size, [0, s], size]) /*<<format.ml:450:78>>*/ ;
     /*<<format.ml:450:78>>*/ }
    function initialize_scan_stack(stack){
      /*<<format.ml:462:2>>*/  /*<<format.ml:462:2>>*/ caml_call1
@@ -27285,18 +27634,19 @@
      /*<<format.ml:463:19>>*/  /*<<format.ml:463:19>>*/ var
      queue_elem = [0, unknown, _b_, 0];
      /*<<format.ml:464:2>>*/ return  /*<<format.ml:464:2>>*/ caml_call2
-            (Stdlib_Stack[3], [0, -1, queue_elem], stack);
+            (Stdlib_Stack[3], [0, -1, queue_elem], stack) /*<<format.ml:464:50>>*/ ;
     /*<<format.ml:464:50>>*/ }
    function set_size(state, ty){
      /*<<format.ml:476:2>>*/  /*<<format.ml:476:8>>*/ var
      match =  /*<<format.ml:476:8>>*/ caml_call1(Stdlib_Stack[8], state[1]);
-    if(! match)  /*<<format.ml:477:12>>*/ return;
+    if(! match)  /*<<format.ml:477:12>>*/ return /*<<format.ml:477:12>>*/ ;
      /*<<format.ml:479:4>>*/ var
      match$0 = match[1],
      queue_elem = match$0[2],
      left_total = match$0[1],
       /*<<format.ml:479:4>>*/ size = queue_elem[1];
-    if(left_total < state[12]) return initialize_scan_stack(state[1]);
+    if(left_total < state[12])
+     return initialize_scan_stack(state[1]) /*<<format.ml:497:10>>*/ ;
     var _a5_ = queue_elem[2];
     if(typeof _a5_ !== "number")
      switch(_a5_[0]){
@@ -27307,7 +27657,7 @@
           /*<<format.ml:493:10>>*/  /*<<format.ml:493:10>>*/ caml_call1
           (Stdlib_Stack[5], state[1]);
         }
-         /*<<format.ml:493:10>>*/ return;
+         /*<<format.ml:493:10>>*/ return /*<<format.ml:493:10>>*/ ;
        case 1:
        case 2:
         if(ty){
@@ -27316,7 +27666,7 @@
           /*<<format.ml:488:10>>*/  /*<<format.ml:488:10>>*/ caml_call1
           (Stdlib_Stack[5], state[1]);
         }
-         /*<<format.ml:488:10>>*/ return;
+         /*<<format.ml:488:10>>*/ return /*<<format.ml:488:10>>*/ ;
      }
     /*<<format.ml:497:10>>*/ }
    function scan_push(state, b, token){
@@ -27325,7 +27675,7 @@
      /*<<format.ml:505:13>>*/  /*<<format.ml:505:13>>*/ var
      elem = [0, state[13], token];
      /*<<format.ml:506:2>>*/ return  /*<<format.ml:506:2>>*/ caml_call2
-            (Stdlib_Stack[3], elem, state[1]);
+            (Stdlib_Stack[3], elem, state[1]) /*<<format.ml:506:37>>*/ ;
     /*<<format.ml:506:37>>*/ }
    function pp_open_box_gen(state, indent, br_ty){
      /*<<format.ml:513:2>>*/ state[14] = state[14] + 1 | 0;
@@ -27333,12 +27683,12 @@
       /*<<format.ml:516:15>>*/ var
       size = - state[13] | 0,
        /*<<format.ml:516:15>>*/ elem = [0, size, [3, indent, br_ty], 0];
-      /*<<format.ml:517:4>>*/ return scan_push(state, 0, elem);
+      /*<<format.ml:517:4>>*/ return scan_push(state, 0, elem) /*<<format.ml:519:45>>*/ ;
     }
     var _a4_ = state[14] === state[15] ? 1 : 0;
     if(! _a4_) return _a4_;
     var s = state[16], x = caml_ml_string_length(s);
-     /*<<format.ml:454:2>>*/ return enqueue_string_as(state, x, s);
+     /*<<format.ml:454:2>>*/ return enqueue_string_as(state, x, s) /*<<format.ml:519:45>>*/ ;
     /*<<format.ml:519:45>>*/ }
    function pp_close_box(state, param){
      /*<<format.ml:527:2>>*/ var _a2_ = 1 < state[14] ? 1 : 0;
@@ -27366,7 +27716,7 @@
     if(! _a1_) return _a1_;
      /*<<format.ml:546:16>>*/  /*<<format.ml:546:16>>*/ var
      token = [5, tag_name];
-     /*<<format.ml:547:21>>*/ return pp_enqueue(state, [0, zero, token, 0]);
+     /*<<format.ml:547:21>>*/ return pp_enqueue(state, [0, zero, token, 0]) /*<<format.ml:547:60>>*/ ;
     /*<<format.ml:547:60>>*/ }
    function pp_close_stag(state, param){
      /*<<format.ml:552:2>>*/ if(state[23])
@@ -27378,13 +27728,13 @@
      if(match){
       var tag_name = match[1];
        /*<<format.ml:558:6>>*/ return  /*<<format.ml:558:6>>*/ caml_call1
-              (state[27], tag_name);
+              (state[27], tag_name) /*<<format.ml:558:39>>*/ ;
      }
      var _a0_ = 0;
     }
     else
      var _a0_ = _aZ_;
-     /*<<format.ml:556:14>>*/ return _a0_;
+     /*<<format.ml:556:14>>*/ return _a0_ /*<<format.ml:556:14>>*/ ;
     /*<<format.ml:558:39>>*/ }
    function pp_set_print_tags(state, b){
      /*<<format.ml:560:32>>*/ state[22] = b;
@@ -27402,14 +27752,14 @@
     /*<<format.ml:563:50>>*/ }
    function pp_set_tags(state, b){
      /*<<format.ml:565:2>>*/ pp_set_print_tags(state, b);
-     /*<<format.ml:565:2>>*/ return pp_set_mark_tags(state, b);
+     /*<<format.ml:565:2>>*/ return pp_set_mark_tags(state, b) /*<<format.ml:565:53>>*/ ;
     /*<<format.ml:565:53>>*/ }
    function pp_get_formatter_stag_function(state, param){
      /*<<format.ml:569:47>>*/ return [0,
             state[24],
             state[25],
             state[26],
-            state[27]];
+            state[27]] /*<<format.ml:569:47>>*/ ;
     /*<<format.ml:574:1>>*/ }
    function pp_set_formatter_stag_function(state, param){
     var pct = param[4], pot = param[3], mct = param[2], mot = param[1];
@@ -27435,13 +27785,13 @@
     state[10] = 0;
     state[14] = 0;
     state[9] = state[6];
-     /*<<format.ml:523:28>>*/ return pp_open_box_gen(state, 0, 3);
+     /*<<format.ml:523:28>>*/ return pp_open_box_gen(state, 0, 3) /*<<format.ml:600:23>>*/ ;
     /*<<format.ml:600:23>>*/ }
    function pp_flush_queue(state, end_with_newline){
      /*<<format.ml:608:2>>*/  /*<<format.ml:603:13>>*/ caml_call2
      (Stdlib_Stack[13],
       function(param){
-        /*<<format.ml:603:23>>*/ return pp_close_stag(state, 0);
+        /*<<format.ml:603:23>>*/ return pp_close_stag(state, 0) /*<<format.ml:603:45>>*/ ;
        /*<<format.ml:603:45>>*/ },
       state[4]);
      /*<<format.ml:610:4>>*/ for(;;){
@@ -27449,80 +27799,81 @@
       state[13] = pp_infinity;
        /*<<format.ml:613:2>>*/ advance_left(state);
       if(end_with_newline)  /*<<format.ml:614:27>>*/ pp_output_newline(state);
-       /*<<format.ml:614:27>>*/ return pp_rinit(state);
+       /*<<format.ml:614:27>>*/ return pp_rinit(state) /*<<format.ml:615:16>>*/ ;
      }
       /*<<format.ml:610:4>>*/ pp_close_box(state, 0);
     }
     /*<<format.ml:615:16>>*/ }
    function pp_print_as_size(state, size, s){
      /*<<format.ml:625:2>>*/ var _aY_ = state[14] < state[15] ? 1 : 0;
-    return _aY_ ? enqueue_string_as(state, size, s) : _aY_;
+    return _aY_ ? enqueue_string_as(state, size, s) : _aY_ /*<<format.ml:626:37>>*/ ;
     /*<<format.ml:626:37>>*/ }
    function pp_print_as(state, isize, s){
-     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, s);
+     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, s) /*<<format.ml:630:46>>*/ ;
     /*<<format.ml:630:46>>*/ }
    function pp_print_string(state, s){
      /*<<format.ml:634:2>>*/ var isize = caml_ml_string_length(s);
-     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, s);
+     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, s) /*<<format.ml:634:39>>*/ ;
     /*<<format.ml:634:39>>*/ }
    function pp_print_bytes(state, s){
      /*<<format.ml:637:2>>*/ var
       /*<<format.ml:637:37>>*/ s$0 =
         /*<<format.ml:637:37>>*/ caml_call1(Stdlib_Bytes[6], s),
      isize = runtime.caml_ml_bytes_length(s);
-     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, s$0);
+     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, s$0) /*<<format.ml:637:56>>*/ ;
     /*<<format.ml:637:56>>*/ }
    function pp_print_int(state, i){
      /*<<format.ml:640:27>>*/ return pp_print_string
-            (state,  /*<<format.ml:640:49>>*/ caml_call1(Stdlib_Int[12], i));
+            (state,  /*<<format.ml:640:49>>*/ caml_call1(Stdlib_Int[12], i)) /*<<format.ml:640:66>>*/ ;
     /*<<format.ml:640:66>>*/ }
    function pp_print_float(state, f){
      /*<<format.ml:643:29>>*/ return pp_print_string
-            (state,  /*<<format.ml:643:51>>*/ caml_call1(Stdlib[35], f));
+            (state,  /*<<format.ml:643:51>>*/ caml_call1(Stdlib[35], f)) /*<<format.ml:643:70>>*/ ;
     /*<<format.ml:643:70>>*/ }
    function pp_print_bool(state, b){
      /*<<format.ml:646:28>>*/ return pp_print_string
-            (state,  /*<<format.ml:646:50>>*/ caml_call1(Stdlib[30], b));
+            (state,  /*<<format.ml:646:50>>*/ caml_call1(Stdlib[30], b)) /*<<format.ml:646:68>>*/ ;
     /*<<format.ml:646:68>>*/ }
    function pp_print_char(state, c){
      /*<<format.ml:650:2>>*/  /*<<format.ml:650:22>>*/ var
      s =  /*<<format.ml:650:22>>*/ caml_call2(Stdlib_String[1], 1, c);
-     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, 1, s);
+     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, 1, s) /*<<format.ml:650:39>>*/ ;
     /*<<format.ml:650:39>>*/ }
-   function pp_print_nothing(state, param){ /*<<format.ml:652:33>>*/ return 0;
+   function pp_print_nothing(state, param){
+     /*<<format.ml:652:33>>*/ return 0 /*<<format.ml:652:33>>*/ ;
     /*<<format.ml:652:35>>*/ }
    function pp_open_hbox(state, param){
-     /*<<format.ml:656:28>>*/ return pp_open_box_gen(state, 0, 0);
+     /*<<format.ml:656:28>>*/ return pp_open_box_gen(state, 0, 0) /*<<format.ml:656:59>>*/ ;
     /*<<format.ml:656:59>>*/ }
    function pp_open_vbox(state, indent){
-     /*<<format.ml:657:32>>*/ return pp_open_box_gen(state, indent, 1);
+     /*<<format.ml:657:32>>*/ return pp_open_box_gen(state, indent, 1) /*<<format.ml:657:68>>*/ ;
     /*<<format.ml:657:68>>*/ }
    function pp_open_hvbox(state, indent){
-     /*<<format.ml:659:33>>*/ return pp_open_box_gen(state, indent, 2);
+     /*<<format.ml:659:33>>*/ return pp_open_box_gen(state, indent, 2) /*<<format.ml:659:70>>*/ ;
     /*<<format.ml:659:70>>*/ }
    function pp_open_hovbox(state, indent){
-     /*<<format.ml:660:34>>*/ return pp_open_box_gen(state, indent, 3);
+     /*<<format.ml:660:34>>*/ return pp_open_box_gen(state, indent, 3) /*<<format.ml:660:72>>*/ ;
     /*<<format.ml:660:72>>*/ }
    function pp_open_box(state, indent){
-     /*<<format.ml:661:31>>*/ return pp_open_box_gen(state, indent, 4);
+     /*<<format.ml:661:31>>*/ return pp_open_box_gen(state, indent, 4) /*<<format.ml:661:66>>*/ ;
     /*<<format.ml:661:66>>*/ }
    function pp_print_newline(state, param){
      /*<<format.ml:673:2>>*/ pp_flush_queue(state, 1);
      /*<<format.ml:673:2>>*/ return  /*<<format.ml:673:2>>*/ caml_call1
-            (state[18], 0);
+            (state[18], 0) /*<<format.ml:673:68>>*/ ;
     /*<<format.ml:673:68>>*/ }
    function pp_print_flush(state, param){
      /*<<format.ml:675:2>>*/ pp_flush_queue(state, 0);
      /*<<format.ml:675:2>>*/ return  /*<<format.ml:675:2>>*/ caml_call1
-            (state[18], 0);
+            (state[18], 0) /*<<format.ml:675:69>>*/ ;
     /*<<format.ml:675:69>>*/ }
    function pp_force_newline(state, param){
      /*<<format.ml:680:2>>*/ var _aX_ = state[14] < state[15] ? 1 : 0;
-    return _aX_ ? enqueue_advance(state, [0, zero, 3, 0]) : _aX_;
+    return _aX_ ? enqueue_advance(state, [0, zero, 3, 0]) : _aX_ /*<<format.ml:681:78>>*/ ;
     /*<<format.ml:681:78>>*/ }
    function pp_print_if_newline(state, param){
      /*<<format.ml:686:2>>*/ var _aW_ = state[14] < state[15] ? 1 : 0;
-    return _aW_ ? enqueue_advance(state, [0, zero, 4, 0]) : _aW_;
+    return _aW_ ? enqueue_advance(state, [0, zero, 4, 0]) : _aW_ /*<<format.ml:688:61>>*/ ;
     /*<<format.ml:688:61>>*/ }
    function pp_print_custom_break(state, fits, breaks){
      /*<<format.ml:694:2>>*/ var
@@ -27539,17 +27890,17 @@
        +  /*<<format.ml:698:4>>*/ caml_ml_string_length(after)
        | 0,
       /*<<format.ml:699:15>>*/ elem = [0, size, token, length];
-     /*<<format.ml:700:4>>*/ return scan_push(state, 1, elem);
+     /*<<format.ml:700:4>>*/ return scan_push(state, 1, elem) /*<<format.ml:700:29>>*/ ;
     /*<<format.ml:700:29>>*/ }
    function pp_print_break(state, width, offset){
      /*<<format.ml:707:2>>*/ return pp_print_custom_break
-            (state, [0, cst$6, width, cst$5], [0, cst$4, offset, cst$3]);
+            (state, [0, cst$6, width, cst$5], [0, cst$4, offset, cst$3]) /*<<format.ml:708:50>>*/ ;
     /*<<format.ml:708:50>>*/ }
    function pp_print_space(state, param){
-     /*<<format.ml:716:30>>*/ return pp_print_break(state, 1, 0);
+     /*<<format.ml:716:30>>*/ return pp_print_break(state, 1, 0) /*<<format.ml:716:54>>*/ ;
     /*<<format.ml:716:54>>*/ }
    function pp_print_cut(state, param){
-     /*<<format.ml:717:28>>*/ return pp_print_break(state, 0, 0);
+     /*<<format.ml:717:28>>*/ return pp_print_break(state, 0, 0) /*<<format.ml:717:52>>*/ ;
     /*<<format.ml:717:52>>*/ }
    function pp_open_tbox(state, param){
      /*<<format.ml:722:2>>*/ state[14] = state[14] + 1 | 0;
@@ -27557,7 +27908,7 @@
     if(! _aU_) return _aU_;
      /*<<format.ml:725:15>>*/  /*<<format.ml:725:15>>*/ var
      elem = [0, zero, [4, [0, [0, 0]]], 0];
-     /*<<format.ml:726:4>>*/ return enqueue_advance(state, elem);
+     /*<<format.ml:726:4>>*/ return enqueue_advance(state, elem) /*<<format.ml:726:30>>*/ ;
     /*<<format.ml:726:30>>*/ }
    function pp_close_tbox(state, param){
      /*<<format.ml:731:2>>*/ var _aR_ = 1 < state[14] ? 1 : 0;
@@ -27583,17 +27934,17 @@
      /*<<format.ml:744:15>>*/ var
      size = - state[13] | 0,
       /*<<format.ml:744:15>>*/ elem = [0, size, [2, width, offset], width];
-     /*<<format.ml:745:4>>*/ return scan_push(state, 1, elem);
+     /*<<format.ml:745:4>>*/ return scan_push(state, 1, elem) /*<<format.ml:745:29>>*/ ;
     /*<<format.ml:745:29>>*/ }
    function pp_print_tab(state, param){
-     /*<<format.ml:748:28>>*/ return pp_print_tbreak(state, 0, 0);
+     /*<<format.ml:748:28>>*/ return pp_print_tbreak(state, 0, 0) /*<<format.ml:748:53>>*/ ;
     /*<<format.ml:748:53>>*/ }
    function pp_set_tab(state, param){
      /*<<format.ml:751:2>>*/ var _aP_ = state[14] < state[15] ? 1 : 0;
     if(! _aP_) return _aP_;
      /*<<format.ml:752:15>>*/  /*<<format.ml:752:15>>*/ var
      elem = [0, zero, 0, 0];
-     /*<<format.ml:753:4>>*/ return enqueue_advance(state, elem);
+     /*<<format.ml:753:4>>*/ return enqueue_advance(state, elem) /*<<format.ml:753:30>>*/ ;
     /*<<format.ml:753:30>>*/ }
    function pp_set_max_boxes(state, n){
      /*<<format.ml:763:31>>*/ var
@@ -27615,7 +27966,7 @@
      /*<<format.ml:772:36>>*/ return state[16];
     /*<<format.ml:772:53>>*/ }
    function pp_limit(n){
-     /*<<format.ml:777:2>>*/ return n < 1000000010 ? n : 1000000009;
+     /*<<format.ml:777:2>>*/ return n < 1000000010 ? n : 1000000009 /*<<format.ml:777:49>>*/ ;
     /*<<format.ml:777:49>>*/ }
    function pp_set_max_indent(state, n$0){
      /*<<format.ml:793:2>>*/ var _aM_ = 1 < n$0 ? 1 : 0;
@@ -27625,7 +27976,7 @@
      /*<<format.ml:783:12>>*/  /*<<format.ml:783:12>>*/ var n = pp_limit(n$1);
     state[7] = n;
     state[8] = state[6] - state[7] | 0;
-     /*<<format.ml:786:4>>*/ return pp_rinit(state);
+     /*<<format.ml:786:4>>*/ return pp_rinit(state) /*<<format.ml:794:53>>*/ ;
     /*<<format.ml:794:53>>*/ }
    function pp_get_max_indent(state, param){
      /*<<format.ml:797:33>>*/ return state[8];
@@ -27644,7 +27995,7 @@
          (Stdlib_Int[11], state[6] - state[7] | 0, state[6] / 2 | 0),
       new_max_indent =
          /*<<format.ml:810:7>>*/ caml_call2(Stdlib_Int[11], _aK_, 1);
-     /*<<format.ml:813:4>>*/ return pp_set_max_indent(state, new_max_indent);
+     /*<<format.ml:813:4>>*/ return pp_set_max_indent(state, new_max_indent) /*<<format.ml:813:42>>*/ ;
     /*<<format.ml:813:42>>*/ }
    function validate_geometry(param){
     var margin = param[2], max_indent = param[1];
@@ -27655,7 +28006,7 @@
    function check_geometry(geometry){
      /*<<format.ml:829:2>>*/ return 0 === validate_geometry(geometry)[0]
             ? 1
-            : 0;
+            : 0 /*<<format.ml:831:20>>*/ ;
     /*<<format.ml:831:20>>*/ }
    function pp_get_margin(state, param){
      /*<<format.ml:833:29>>*/ return state[6];
@@ -27664,14 +28015,14 @@
     var margin = param[2], max_indent = param[1];
      /*<<format.ml:836:2>>*/ pp_set_margin(state, margin);
      /*<<format.ml:837:2>>*/ pp_set_max_indent(state, max_indent);
-     /*<<format.ml:837:2>>*/ return 0;
+     /*<<format.ml:837:2>>*/ return 0 /*<<format.ml:837:2>>*/ ;
    }
    function pp_set_geometry(state, max_indent, margin){
      /*<<format.ml:841:2>>*/ var
       /*<<format.ml:841:17>>*/ geometry = [0, max_indent, margin],
       /*<<format.ml:842:8>>*/ match = validate_geometry(geometry);
     if(0 === match[0])
-      /*<<format.ml:846:4>>*/ return pp_set_full_geometry(state, geometry);
+      /*<<format.ml:846:4>>*/ return pp_set_full_geometry(state, geometry) /*<<format.ml:846:39>>*/ ;
      /*<<format.ml:844:28>>*/ var
      msg = match[1],
       /*<<format.ml:844:28>>*/ _aI_ =
@@ -27685,16 +28036,16 @@
      geometry = [0, max_indent, margin];
     return 0 === validate_geometry(geometry)[0]
             ? pp_set_full_geometry(state, geometry)
-            : 0;
+            : 0 /*<<format.ml:854:39>>*/ ;
     /*<<format.ml:854:39>>*/ }
    function pp_get_geometry(state, param){
-     /*<<format.ml:857:2>>*/ return [0, state[8], state[6]];
+     /*<<format.ml:857:2>>*/ return [0, state[8], state[6]] /*<<format.ml:857:2>>*/ ;
     /*<<format.ml:857:78>>*/ }
    function pp_update_geometry(state, update){
      /*<<format.ml:860:2>>*/  /*<<format.ml:860:17>>*/ var
      geometry = pp_get_geometry(state, 0);
      /*<<format.ml:861:29>>*/ return pp_set_full_geometry
-            (state,  /*<<format.ml:861:29>>*/ caml_call1(update, geometry));
+            (state,  /*<<format.ml:861:29>>*/ caml_call1(update, geometry)) /*<<format.ml:861:46>>*/ ;
     /*<<format.ml:861:46>>*/ }
    function pp_set_formatter_out_functions(state, param){
     var j = param[5], i = param[4], h = param[3], g = param[2], f = param[1];
@@ -27711,7 +28062,7 @@
             state[18],
             state[19],
             state[20],
-            state[21]];
+            state[21]] /*<<format.ml:877:46>>*/ ;
     /*<<format.ml:883:1>>*/ }
    function pp_set_formatter_output_functi(state, f, g){
      /*<<format.ml:888:2>>*/ state[17] = f;
@@ -27719,11 +28070,11 @@
     return 0;
     /*<<format.ml:888:51>>*/ }
    function pp_get_formatter_output_functi(state, param){
-     /*<<format.ml:891:2>>*/ return [0, state[17], state[18]];
+     /*<<format.ml:891:2>>*/ return [0, state[17], state[18]] /*<<format.ml:891:2>>*/ ;
     /*<<format.ml:891:43>>*/ }
    function display_newline(state, param){
      /*<<format.ml:895:31>>*/ return  /*<<format.ml:895:31>>*/ caml_call3
-            (state[17], cst$7, 0, 1);
+            (state[17], cst$7, 0, 1) /*<<format.ml:895:60>>*/ ;
     /*<<format.ml:895:60>>*/ }
     /*<<format.ml:898:17>>*/ var
      /*<<format.ml:898:17>>*/ blank_line =
@@ -27736,7 +28087,7 @@
      if(! _aH_) return _aH_;
      if(80 >= n$0)
        /*<<format.ml:901:18>>*/ return  /*<<format.ml:901:18>>*/ caml_call3
-              (state[17], blank_line, 0, n$0);
+              (state[17], blank_line, 0, n$0) /*<<format.ml:905:5>>*/ ;
       /*<<format.ml:903:4>>*/  /*<<format.ml:903:4>>*/ caml_call3
       (state[17], blank_line, 0, 80);
       /*<<format.ml:903:4>>*/  /*<<format.ml:903:4>>*/ var n$1 = n$0 - 80 | 0;
@@ -27749,7 +28100,7 @@
     state[18] =
      function(param){
        /*<<format.ml:915:35>>*/ return  /*<<format.ml:915:2>>*/ caml_call1
-              (Stdlib[63], oc);
+              (Stdlib[63], oc) /*<<format.ml:915:43>>*/ ;
       /*<<format.ml:915:43>>*/ };
     state[19] =
      function(_aG_){ /*<<?>>*/ return display_newline(state, _aG_);};
@@ -27759,23 +28110,23 @@
     /*<<format.ml:918:45>>*/ }
    function default_pp_mark_open_tag(param){
      /*<<format.ml:926:31>>*/ if(param[1] !== String_tag)
-      /*<<format.ml:928:9>>*/ return cst$10;
+      /*<<format.ml:928:9>>*/ return cst$10 /*<<format.ml:928:9>>*/ ;
      /*<<format.ml:927:26>>*/ var
      s = param[2],
       /*<<format.ml:927:26>>*/ _aD_ =
         /*<<format.ml:927:26>>*/ caml_call2(Stdlib[28], s, cst$8);
      /*<<format.ml:927:26>>*/ return  /*<<format.ml:927:26>>*/ caml_call2
-            (Stdlib[28], cst$9, _aD_);
+            (Stdlib[28], cst$9, _aD_) /*<<format.ml:928:11>>*/ ;
     /*<<format.ml:928:11>>*/ }
    function default_pp_mark_close_tag(param){
      /*<<format.ml:929:32>>*/ if(param[1] !== String_tag)
-      /*<<format.ml:931:9>>*/ return cst$13;
+      /*<<format.ml:931:9>>*/ return cst$13 /*<<format.ml:931:9>>*/ ;
      /*<<format.ml:930:27>>*/ var
      s = param[2],
       /*<<format.ml:930:27>>*/ _aC_ =
         /*<<format.ml:930:27>>*/ caml_call2(Stdlib[28], s, cst$11);
      /*<<format.ml:930:27>>*/ return  /*<<format.ml:930:27>>*/ caml_call2
-            (Stdlib[28], cst$12, _aC_);
+            (Stdlib[28], cst$12, _aC_) /*<<format.ml:931:11>>*/ ;
     /*<<format.ml:931:11>>*/ }
    function default_pp_print_open_tag(_aB_){ /*<<?>>*/ return 0;}
    function default_pp_print_close_tag(_aA_){ /*<<?>>*/ return 0;}
@@ -27828,11 +28179,11 @@
             default_pp_mark_close_tag,
             default_pp_print_open_tag,
             default_pp_print_close_tag,
-            pp_queue];
+            pp_queue] /*<<format.ml:949:2>>*/ ;
    }
    function formatter_of_out_functions(out_funs){
      /*<<format.ml:983:2>>*/ return pp_make_formatter
-            (out_funs[1], out_funs[2], out_funs[3], out_funs[4], out_funs[5]);
+            (out_funs[1], out_funs[2], out_funs[3], out_funs[4], out_funs[5]) /*<<format.ml:988:23>>*/ ;
     /*<<format.ml:988:23>>*/ }
    function make_formatter(output, flush){
      /*<<format.ml:994:2>>*/  /*<<format.ml:994:12>>*/ var
@@ -27846,25 +28197,25 @@
     ppf[19] = function(_as_){ /*<<?>>*/ return display_newline(ppf, _as_);};
     ppf[20] = function(_ar_){ /*<<?>>*/ return display_blanks(ppf, _ar_);};
     ppf[21] = function(_aq_){ /*<<?>>*/ return display_blanks(ppf, _aq_);};
-     /*<<format.ml:998:2>>*/ return ppf;
+     /*<<format.ml:998:2>>*/ return ppf /*<<format.ml:998:2>>*/ ;
     /*<<format.ml:998:5>>*/ }
    function formatter_of_out_channel(oc){
      /*<<format.ml:1003:2>>*/ return make_formatter
             ( /*<<format.ml:1003:17>>*/ caml_call1(Stdlib[69], oc),
              function(param){
                /*<<format.ml:1003:50>>*/ return  /*<<format.ml:1003:2>>*/ caml_call1
-                      (Stdlib[63], oc);
-              /*<<format.ml:1003:58>>*/ });
+                      (Stdlib[63], oc) /*<<format.ml:1003:58>>*/ ;
+              /*<<format.ml:1003:58>>*/ }) /*<<format.ml:1003:59>>*/ ;
     /*<<format.ml:1003:59>>*/ }
    function formatter_of_buffer(b){
      /*<<format.ml:1008:2>>*/ return make_formatter
             ( /*<<format.ml:1008:17>>*/ caml_call1(Stdlib_Buffer[18], b),
-             function(_ap_){ /*<<?>>*/ return 0;});
+             function(_ap_){ /*<<?>>*/ return 0;}) /*<<format.ml:1008:48>>*/ ;
     /*<<format.ml:1008:48>>*/ }
    var pp_buffer_size = 512;
    function pp_make_buffer(param){
      /*<<format.ml:1015:24>>*/ return caml_call1
-            (Stdlib_Buffer[1], pp_buffer_size);
+            (Stdlib_Buffer[1], pp_buffer_size) /*<<format.ml:1015:52>>*/ ;
     /*<<format.ml:1015:52>>*/ }
     /*<<format.ml:1018:13>>*/ var
      /*<<format.ml:1018:13>>*/ stdbuf = pp_make_buffer(0),
@@ -27886,7 +28237,7 @@
         function(param){
           /*<<format.ml:1033:2>>*/ return formatter_of_buffer
                  ( /*<<format.ml:1033:22>>*/ caml_call1
-                   (Stdlib_Domain[10][2], stdbuf_key));
+                   (Stdlib_Domain[10][2], stdbuf_key)) /*<<format.ml:1033:42>>*/ ;
          /*<<format.ml:1033:42>>*/ });
     /*<<format.ml:1034:8>>*/  /*<<format.ml:1034:8>>*/ caml_call2
     (Stdlib_Domain[10][3], str_formatter_key, str_formatter);
@@ -27894,7 +28245,7 @@
      /*<<format.ml:1037:2>>*/  /*<<format.ml:1037:23>>*/ var
      _ao_ =  /*<<format.ml:1037:23>>*/ caml_call1(Stdlib_Domain[10][2], key);
      /*<<format.ml:1037:2>>*/ return  /*<<format.ml:1037:2>>*/ caml_call4
-            (Stdlib_Buffer[18], _ao_, str, ofs, len);
+            (Stdlib_Buffer[18], _ao_, str, ofs, len) /*<<format.ml:1037:55>>*/ ;
     /*<<format.ml:1037:55>>*/ }
    function buffered_out_flush(oc, key, param){
      /*<<format.ml:1040:2>>*/ var
@@ -27909,7 +28260,7 @@
      /*<<format.ml:1044:2>>*/  /*<<format.ml:1044:2>>*/ caml_call1
      (Stdlib[63], oc);
      /*<<format.ml:1044:2>>*/ return  /*<<format.ml:1044:2>>*/ caml_call1
-            (Stdlib_Buffer[8], buf);
+            (Stdlib_Buffer[8], buf) /*<<format.ml:1045:18>>*/ ;
     /*<<format.ml:1045:18>>*/ }
     /*<<format.ml:1047:18>>*/ var
      /*<<format.ml:1047:18>>*/ std_buf_key =
@@ -27918,7 +28269,7 @@
         0,
         function(param){
           /*<<format.ml:1047:48>>*/ return caml_call1
-                 (Stdlib_Buffer[1], pp_buffer_size);
+                 (Stdlib_Buffer[1], pp_buffer_size) /*<<format.ml:1047:76>>*/ ;
          /*<<format.ml:1047:76>>*/ }),
      /*<<format.ml:1048:18>>*/ err_buf_key =
        /*<<format.ml:1048:18>>*/ caml_call2
@@ -27926,7 +28277,7 @@
         0,
         function(param){
           /*<<format.ml:1048:48>>*/ return  /*<<format.ml:1047:18>>*/ caml_call1
-                 (Stdlib_Buffer[1], pp_buffer_size);
+                 (Stdlib_Buffer[1], pp_buffer_size) /*<<format.ml:1048:76>>*/ ;
          /*<<format.ml:1048:76>>*/ }),
      /*<<format.ml:1050:24>>*/ std_formatter_key =
        /*<<format.ml:1050:24>>*/ caml_call2
@@ -27956,7 +28307,7 @@
           /*<<format.ml:1058:2>>*/  /*<<format.ml:1058:2>>*/ caml_call1
           (Stdlib_Domain[6],
            function(_ad_){ /*<<?>>*/ return pp_print_flush(ppf, _ad_);});
-          /*<<format.ml:1058:2>>*/ return ppf;
+          /*<<format.ml:1058:2>>*/ return ppf /*<<format.ml:1058:2>>*/ ;
          /*<<format.ml:1059:5>>*/ });
     /*<<format.ml:1060:8>>*/  /*<<format.ml:1060:8>>*/ caml_call2
     (Stdlib_Domain[10][3], std_formatter_key, std_formatter);
@@ -27986,25 +28337,25 @@
           /*<<format.ml:1070:2>>*/  /*<<format.ml:1070:2>>*/ caml_call1
           (Stdlib_Domain[6],
            function(_T_){ /*<<?>>*/ return pp_print_flush(ppf, _T_);});
-          /*<<format.ml:1070:2>>*/ return ppf;
+          /*<<format.ml:1070:2>>*/ return ppf /*<<format.ml:1070:2>>*/ ;
          /*<<format.ml:1071:5>>*/ });
     /*<<format.ml:1072:8>>*/  /*<<format.ml:1072:8>>*/ caml_call2
     (Stdlib_Domain[10][3], err_formatter_key, err_formatter);
    function get_std_formatter(param){
      /*<<format.ml:1074:27>>*/ return  /*<<format.ml:1072:8>>*/ caml_call1
-            (Stdlib_Domain[10][2], std_formatter_key);
+            (Stdlib_Domain[10][2], std_formatter_key) /*<<format.ml:1074:52>>*/ ;
     /*<<format.ml:1074:52>>*/ }
    function get_err_formatter(param){
      /*<<format.ml:1075:27>>*/ return caml_call1
-            (Stdlib_Domain[10][2], err_formatter_key);
+            (Stdlib_Domain[10][2], err_formatter_key) /*<<format.ml:1075:52>>*/ ;
     /*<<format.ml:1075:52>>*/ }
    function get_str_formatter(param){
      /*<<format.ml:1076:27>>*/ return caml_call1
-            (Stdlib_Domain[10][2], str_formatter_key);
+            (Stdlib_Domain[10][2], str_formatter_key) /*<<format.ml:1076:52>>*/ ;
     /*<<format.ml:1076:52>>*/ }
    function get_stdbuf(param){
      /*<<format.ml:1077:20>>*/ return caml_call1
-            (Stdlib_Domain[10][2], stdbuf_key);
+            (Stdlib_Domain[10][2], stdbuf_key) /*<<format.ml:1077:38>>*/ ;
     /*<<format.ml:1077:38>>*/ }
    function flush_buffer_formatter(buf, ppf){
      /*<<format.ml:1084:2>>*/ pp_flush_queue(ppf, 0);
@@ -28012,7 +28363,7 @@
      s =  /*<<format.ml:1085:10>>*/ caml_call1(Stdlib_Buffer[2], buf);
      /*<<format.ml:1086:2>>*/  /*<<format.ml:1086:2>>*/ caml_call1
      (Stdlib_Buffer[9], buf);
-     /*<<format.ml:1086:2>>*/ return s;
+     /*<<format.ml:1086:2>>*/ return s /*<<format.ml:1086:2>>*/ ;
     /*<<format.ml:1087:3>>*/ }
    function flush_str_formatter(param){
      /*<<format.ml:1091:2>>*/ var
@@ -28022,7 +28373,7 @@
         /*<<format.ml:1092:22>>*/ caml_call1
         (Stdlib_Domain[10][2], str_formatter_key);
      /*<<format.ml:1093:2>>*/ return flush_buffer_formatter
-            (stdbuf, str_formatter);
+            (stdbuf, str_formatter) /*<<format.ml:1093:45>>*/ ;
     /*<<format.ml:1093:45>>*/ }
    function make_synchronized_formatter(output, flush){
      /*<<format.ml:1096:2>>*/ return  /*<<format.ml:1096:14>>*/ caml_call2
@@ -28047,34 +28398,35 @@
                 /*<<format.ml:1101:6>>*/  /*<<format.ml:1101:6>>*/ caml_call1
                 (Stdlib_Buffer[8], buf);
                 /*<<format.ml:1101:6>>*/ return  /*<<format.ml:1101:6>>*/ caml_call1
-                       (flush, 0);
+                       (flush, 0) /*<<format.ml:1102:14>>*/ ;
                /*<<format.ml:1102:14>>*/ }
                /*<<format.ml:1104:4>>*/ return make_formatter
-                      (output$0, flush$0);
-              /*<<format.ml:1104:33>>*/ });
+                      (output$0, flush$0) /*<<format.ml:1104:33>>*/ ;
+              /*<<format.ml:1104:33>>*/ }) /*<<format.ml:1104:34>>*/ ;
     /*<<format.ml:1104:34>>*/ }
    function synchronized_formatter_of_out_(oc){
      /*<<format.ml:1107:2>>*/ return make_synchronized_formatter
             ( /*<<format.ml:1107:30>>*/ caml_call1(Stdlib[69], oc),
              function(param){
                /*<<format.ml:1107:63>>*/ return  /*<<format.ml:1107:2>>*/ caml_call1
-                      (Stdlib[63], oc);
-              /*<<format.ml:1107:71>>*/ });
+                      (Stdlib[63], oc) /*<<format.ml:1107:71>>*/ ;
+              /*<<format.ml:1107:71>>*/ }) /*<<format.ml:1107:72>>*/ ;
     /*<<format.ml:1107:72>>*/ }
-   function make_symbolic_output_buffer(param){ /*<<format.ml:1134:2>>*/ return [0, 0];
+   function make_symbolic_output_buffer(param){
+     /*<<format.ml:1134:2>>*/ return [0, 0] /*<<format.ml:1134:2>>*/ ;
     /*<<format.ml:1134:35>>*/ }
    function clear_symbolic_output_buffer(sob){
      /*<<format.ml:1137:2>>*/ sob[1] = 0;
     return 0;
     /*<<format.ml:1137:36>>*/ }
    function get_symbolic_output_buffer(sob){
-     /*<<format.ml:1140:2>>*/ return caml_call1(Stdlib_List[10], sob[1]);
+     /*<<format.ml:1140:2>>*/ return caml_call1(Stdlib_List[10], sob[1]) /*<<format.ml:1140:39>>*/ ;
     /*<<format.ml:1140:39>>*/ }
    function flush_symbolic_output_buffer(sob){
      /*<<format.ml:1143:2>>*/  /*<<format.ml:1143:14>>*/ var
      items = get_symbolic_output_buffer(sob);
      /*<<format.ml:1144:2>>*/ clear_symbolic_output_buffer(sob);
-     /*<<format.ml:1144:2>>*/ return items;
+     /*<<format.ml:1144:2>>*/ return items /*<<format.ml:1144:2>>*/ ;
     /*<<format.ml:1145:7>>*/ }
    function add_symbolic_output_item(sob, item){
      /*<<format.ml:1148:2>>*/ sob[1] = [0, item, sob[1]];
@@ -28086,192 +28438,192 @@
              (sob,
               [0,
                 /*<<format.ml:1156:48>>*/ caml_call3
-                (Stdlib_String[16], s, i, n)]);
+                (Stdlib_String[16], s, i, n)]) /*<<format.ml:1156:33>>*/ ;
     }
      /*<<format.ml:1163:10>>*/ function g(_Q_){
-      /*<<format.ml:1152:4>>*/ return add_symbolic_output_item(sob, 0);
+      /*<<format.ml:1152:4>>*/ return add_symbolic_output_item(sob, 0) /*<<format.ml:1152:4>>*/ ;
     }
      /*<<format.ml:1164:10>>*/ function h(_P_){
-      /*<<format.ml:1154:4>>*/ return add_symbolic_output_item(sob, 1);
+      /*<<format.ml:1154:4>>*/ return add_symbolic_output_item(sob, 1) /*<<format.ml:1154:4>>*/ ;
     }
      /*<<format.ml:1165:10>>*/ function i(n){
-      /*<<format.ml:1158:33>>*/ return add_symbolic_output_item(sob, [1, n]);
+      /*<<format.ml:1158:33>>*/ return add_symbolic_output_item(sob, [1, n]) /*<<format.ml:1158:33>>*/ ;
     }
      /*<<format.ml:1166:10>>*/ function j(n){
-      /*<<format.ml:1160:33>>*/ return add_symbolic_output_item(sob, [2, n]);
+      /*<<format.ml:1160:33>>*/ return add_symbolic_output_item(sob, [2, n]) /*<<format.ml:1160:33>>*/ ;
     }
-     /*<<format.ml:1167:2>>*/ return pp_make_formatter(f, g, h, i, j);
+     /*<<format.ml:1167:2>>*/ return pp_make_formatter(f, g, h, i, j) /*<<format.ml:1167:29>>*/ ;
     /*<<format.ml:1167:29>>*/ }
    function open_hbox(v){
      /*<<format.ml:1176:18>>*/ return pp_open_hbox
             ( /*<<format.ml:1176:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1176:60>>*/ ;
     /*<<format.ml:1176:60>>*/ }
    function open_vbox(v){
      /*<<format.ml:1177:18>>*/ return pp_open_vbox
             ( /*<<format.ml:1177:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1177:60>>*/ ;
     /*<<format.ml:1177:60>>*/ }
    function open_hvbox(v){
      /*<<format.ml:1178:19>>*/ return pp_open_hvbox
             ( /*<<format.ml:1178:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1178:62>>*/ ;
     /*<<format.ml:1178:62>>*/ }
    function open_hovbox(v){
      /*<<format.ml:1179:20>>*/ return pp_open_hovbox
             ( /*<<format.ml:1179:35>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1179:64>>*/ ;
     /*<<format.ml:1179:64>>*/ }
    function open_box(v){
      /*<<format.ml:1180:17>>*/ return pp_open_box
             ( /*<<format.ml:1180:29>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1180:58>>*/ ;
     /*<<format.ml:1180:58>>*/ }
    function close_box(v){
      /*<<format.ml:1181:18>>*/ return pp_close_box
             ( /*<<format.ml:1181:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1181:60>>*/ ;
     /*<<format.ml:1181:60>>*/ }
    function open_stag(v){
      /*<<format.ml:1182:18>>*/ return pp_open_stag
             ( /*<<format.ml:1182:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1182:60>>*/ ;
     /*<<format.ml:1182:60>>*/ }
    function close_stag(v){
      /*<<format.ml:1183:19>>*/ return pp_close_stag
             ( /*<<format.ml:1183:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1183:62>>*/ ;
     /*<<format.ml:1183:62>>*/ }
    function print_as(isize, w){
      /*<<format.ml:1184:19>>*/  /*<<format.ml:1184:31>>*/ var
      state =
         /*<<format.ml:1184:31>>*/ caml_call1
         (Stdlib_Domain[10][2], std_formatter_key);
-     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, w);
+     /*<<format.ml:630:2>>*/ return pp_print_as_size(state, isize, w) /*<<format.ml:1184:62>>*/ ;
     /*<<format.ml:1184:62>>*/ }
    function print_string(v){
      /*<<format.ml:1185:21>>*/ return pp_print_string
             ( /*<<format.ml:1185:37>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1185:66>>*/ ;
     /*<<format.ml:1185:66>>*/ }
    function print_bytes(v){
      /*<<format.ml:1186:20>>*/ return pp_print_bytes
             ( /*<<format.ml:1186:35>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1186:64>>*/ ;
     /*<<format.ml:1186:64>>*/ }
    function print_int(v){
      /*<<format.ml:1187:18>>*/ return pp_print_int
             ( /*<<format.ml:1187:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1187:60>>*/ ;
     /*<<format.ml:1187:60>>*/ }
    function print_float(v){
      /*<<format.ml:1188:20>>*/ return pp_print_float
             ( /*<<format.ml:1188:35>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1188:64>>*/ ;
     /*<<format.ml:1188:64>>*/ }
    function print_char(v){
      /*<<format.ml:1189:19>>*/ return pp_print_char
             ( /*<<format.ml:1189:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1189:62>>*/ ;
     /*<<format.ml:1189:62>>*/ }
    function print_bool(v){
      /*<<format.ml:1190:19>>*/ return pp_print_bool
             ( /*<<format.ml:1190:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1190:62>>*/ ;
     /*<<format.ml:1190:62>>*/ }
    function print_break(v, w){
      /*<<format.ml:1191:22>>*/ return pp_print_break
             ( /*<<format.ml:1191:37>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
              v,
-             w);
+             w) /*<<format.ml:1191:68>>*/ ;
     /*<<format.ml:1191:68>>*/ }
    function print_cut(v){
      /*<<format.ml:1192:18>>*/ return pp_print_cut
             ( /*<<format.ml:1192:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1192:60>>*/ ;
     /*<<format.ml:1192:60>>*/ }
    function print_space(v){
      /*<<format.ml:1193:20>>*/ return pp_print_space
             ( /*<<format.ml:1193:35>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1193:64>>*/ ;
     /*<<format.ml:1193:64>>*/ }
    function force_newline(v){
      /*<<format.ml:1194:22>>*/ return pp_force_newline
             ( /*<<format.ml:1194:39>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1194:68>>*/ ;
     /*<<format.ml:1194:68>>*/ }
    function print_flush(v){
      /*<<format.ml:1195:20>>*/ return pp_print_flush
             ( /*<<format.ml:1195:35>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1195:64>>*/ ;
     /*<<format.ml:1195:64>>*/ }
    function print_newline(v){
      /*<<format.ml:1196:22>>*/ return pp_print_newline
             ( /*<<format.ml:1196:39>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1196:68>>*/ ;
     /*<<format.ml:1196:68>>*/ }
    function print_if_newline(v){
      /*<<format.ml:1197:25>>*/ return pp_print_if_newline
             ( /*<<format.ml:1197:45>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1197:74>>*/ ;
     /*<<format.ml:1197:74>>*/ }
    function open_tbox(v){
      /*<<format.ml:1199:18>>*/ return pp_open_tbox
             ( /*<<format.ml:1199:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1199:60>>*/ ;
     /*<<format.ml:1199:60>>*/ }
    function close_tbox(v){
      /*<<format.ml:1200:19>>*/ return pp_close_tbox
             ( /*<<format.ml:1200:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1200:62>>*/ ;
     /*<<format.ml:1200:62>>*/ }
    function print_tbreak(v, w){
      /*<<format.ml:1201:23>>*/ return pp_print_tbreak
             ( /*<<format.ml:1201:39>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
              v,
-             w);
+             w) /*<<format.ml:1201:70>>*/ ;
     /*<<format.ml:1201:70>>*/ }
    function set_tab(v){
      /*<<format.ml:1203:16>>*/ return pp_set_tab
             ( /*<<format.ml:1203:27>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1203:56>>*/ ;
     /*<<format.ml:1203:56>>*/ }
    function print_tab(v){
      /*<<format.ml:1204:18>>*/ return pp_print_tab
             ( /*<<format.ml:1204:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1204:60>>*/ ;
     /*<<format.ml:1204:60>>*/ }
    function set_margin(v){
      /*<<format.ml:1206:19>>*/ return pp_set_margin
             ( /*<<format.ml:1206:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1206:62>>*/ ;
     /*<<format.ml:1206:62>>*/ }
    function get_margin(v){
      /*<<format.ml:1207:19>>*/  /*<<format.ml:1207:33>>*/ var
@@ -28284,7 +28636,7 @@
      /*<<format.ml:1209:23>>*/ return pp_set_max_indent
             ( /*<<format.ml:1209:41>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1209:70>>*/ ;
     /*<<format.ml:1209:70>>*/ }
    function get_max_indent(v){
      /*<<format.ml:1210:23>>*/  /*<<format.ml:1210:41>>*/ var
@@ -28298,32 +28650,32 @@
             ( /*<<format.ml:1213:18>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
              max_indent,
-             margin);
+             margin) /*<<format.ml:1213:65>>*/ ;
     /*<<format.ml:1213:65>>*/ }
    function safe_set_geometry(max_indent, margin){
      /*<<format.ml:1215:2>>*/ return pp_safe_set_geometry
             ( /*<<format.ml:1215:23>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
              max_indent,
-             margin);
+             margin) /*<<format.ml:1215:70>>*/ ;
     /*<<format.ml:1215:70>>*/ }
    function get_geometry(v){
      /*<<format.ml:1216:21>>*/ return pp_get_geometry
             ( /*<<format.ml:1216:37>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1216:66>>*/ ;
     /*<<format.ml:1216:66>>*/ }
    function update_geometry(v){
      /*<<format.ml:1217:24>>*/ return pp_update_geometry
             ( /*<<format.ml:1217:43>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1217:72>>*/ ;
     /*<<format.ml:1217:72>>*/ }
    function set_max_boxes(v){
      /*<<format.ml:1219:22>>*/ return pp_set_max_boxes
             ( /*<<format.ml:1219:39>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1219:68>>*/ ;
     /*<<format.ml:1219:68>>*/ }
    function get_max_boxes(v){
      /*<<format.ml:1220:22>>*/  /*<<format.ml:1220:39>>*/ var
@@ -28336,13 +28688,13 @@
      /*<<format.ml:1221:23>>*/ return pp_over_max_boxes
             ( /*<<format.ml:1221:41>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1221:70>>*/ ;
     /*<<format.ml:1221:70>>*/ }
    function set_ellipsis_text(v){
      /*<<format.ml:1223:26>>*/ return pp_set_ellipsis_text
             ( /*<<format.ml:1223:47>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1223:76>>*/ ;
     /*<<format.ml:1223:76>>*/ }
    function get_ellipsis_text(v){
      /*<<format.ml:1224:26>>*/  /*<<format.ml:1224:47>>*/ var
@@ -28355,50 +28707,50 @@
      /*<<format.ml:1227:2>>*/ return pp_set_formatter_out_channel
             ( /*<<format.ml:1227:31>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1227:60>>*/ ;
     /*<<format.ml:1227:60>>*/ }
    function set_formatter_out_functions(v){
      /*<<format.ml:1230:2>>*/ return pp_set_formatter_out_functions
             ( /*<<format.ml:1230:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1230:62>>*/ ;
     /*<<format.ml:1230:62>>*/ }
    function get_formatter_out_functions(v){
      /*<<format.ml:1232:2>>*/ return pp_get_formatter_out_functions
             ( /*<<format.ml:1232:33>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1232:62>>*/ ;
     /*<<format.ml:1232:62>>*/ }
    function set_formatter_output_functions(v, w){
      /*<<format.ml:1235:2>>*/ return pp_set_formatter_output_functi
             ( /*<<format.ml:1235:36>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
              v,
-             w);
+             w) /*<<format.ml:1235:67>>*/ ;
     /*<<format.ml:1235:67>>*/ }
    function get_formatter_output_functions(v){
      /*<<format.ml:1237:2>>*/ return pp_get_formatter_output_functi
             ( /*<<format.ml:1237:36>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1237:65>>*/ ;
     /*<<format.ml:1237:65>>*/ }
    function set_formatter_stag_functions(v){
      /*<<format.ml:1240:2>>*/ return pp_set_formatter_stag_function
             ( /*<<format.ml:1240:34>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1240:63>>*/ ;
     /*<<format.ml:1240:63>>*/ }
    function get_formatter_stag_functions(v){
      /*<<format.ml:1242:2>>*/ return pp_get_formatter_stag_function
             ( /*<<format.ml:1242:34>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1242:63>>*/ ;
     /*<<format.ml:1242:63>>*/ }
    function set_print_tags(v){
      /*<<format.ml:1244:2>>*/ return pp_set_print_tags
             ( /*<<format.ml:1244:20>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1244:49>>*/ ;
     /*<<format.ml:1244:49>>*/ }
    function get_print_tags(v){
      /*<<format.ml:1246:2>>*/  /*<<format.ml:1246:20>>*/ var
@@ -28411,7 +28763,7 @@
      /*<<format.ml:1248:2>>*/ return pp_set_mark_tags
             ( /*<<format.ml:1248:19>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1248:48>>*/ ;
     /*<<format.ml:1248:48>>*/ }
    function get_mark_tags(v){
      /*<<format.ml:1250:2>>*/  /*<<format.ml:1250:19>>*/ var
@@ -28424,7 +28776,7 @@
      /*<<format.ml:1252:2>>*/ return pp_set_tags
             ( /*<<format.ml:1252:14>>*/ caml_call1
               (Stdlib_Domain[10][2], std_formatter_key),
-             v);
+             v) /*<<format.ml:1252:43>>*/ ;
     /*<<format.ml:1252:43>>*/ }
    function pp_print_iter(opt, iter, pp_v, ppf, v){
      /*<<format.ml:1258:17>>*/ var
@@ -28437,25 +28789,25 @@
        /*<<format.ml:1260:45>>*/  /*<<format.ml:1260:45>>*/ caml_call2
        (pp_sep, ppf, 0);
       /*<<format.ml:1260:45>>*/ return  /*<<format.ml:1260:45>>*/ caml_call2
-             (pp_v, ppf, v);
+             (pp_v, ppf, v) /*<<format.ml:1261:14>>*/ ;
      /*<<format.ml:1261:14>>*/ }
      /*<<format.ml:1263:2>>*/ return  /*<<format.ml:1263:2>>*/ caml_call2
-            (iter, pp_v$0, v);
+            (iter, pp_v$0, v) /*<<format.ml:1263:2>>*/ ;
    }
    function pp_print_list(opt, pp_v, ppf, v){
     var pp_sep = opt ? opt[1] : pp_print_cut;
      /*<<format.ml:1267:2>>*/ return pp_print_iter
-            ([0, pp_sep], Stdlib_List[18], pp_v, ppf, v);
+            ([0, pp_sep], Stdlib_List[18], pp_v, ppf, v) /*<<format.ml:1267:2>>*/ ;
    }
    function pp_print_array(opt, pp_v, ppf, v){
     var pp_sep = opt ? opt[1] : pp_print_cut;
      /*<<format.ml:1271:2>>*/ return pp_print_iter
-            ([0, pp_sep], Stdlib_Array[12], pp_v, ppf, v);
+            ([0, pp_sep], Stdlib_Array[12], pp_v, ppf, v) /*<<format.ml:1271:2>>*/ ;
    }
    function pp_print_seq(opt, pp_v, ppf, seq){
     var pp_sep = opt ? opt[1] : pp_print_cut;
      /*<<format.ml:1275:2>>*/ return pp_print_iter
-            ([0, pp_sep], Stdlib_Seq[4], pp_v, ppf, seq);
+            ([0, pp_sep], Stdlib_Seq[4], pp_v, ppf, seq) /*<<format.ml:1275:2>>*/ ;
    }
    function pp_print_text(ppf, s){
      /*<<format.ml:1279:2>>*/ var
@@ -28474,7 +28826,7 @@
     for(;;){
      if(right[1] === len){
       var _O_ = left[1] !== len ? 1 : 0;
-      return _O_ ? flush(0) : _O_;
+      return _O_ ? flush(0) : _O_ /*<<format.ml:1297:31>>*/ ;
      }
       /*<<format.ml:1287:10>>*/  /*<<format.ml:1287:10>>*/ var
       match =  /*<<format.ml:1287:10>>*/ runtime.caml_string_get(s, right[1]);
@@ -28497,34 +28849,34 @@
         ? opt[1]
         : function
          (_N_, param){
-           /*<<format.ml:1299:41>>*/ return 0;
+           /*<<format.ml:1299:41>>*/ return 0 /*<<format.ml:1299:41>>*/ ;
           /*<<format.ml:1299:43>>*/ };
     if(! param)
       /*<<format.ml:1300:10>>*/ return  /*<<format.ml:1300:10>>*/ caml_call2
-             (none, ppf, 0);
+             (none, ppf, 0) /*<<format.ml:1300:10>>*/ ;
     var v = param[1];
      /*<<format.ml:1301:12>>*/ return  /*<<format.ml:1301:12>>*/ caml_call2
-            (pp_v, ppf, v);
+            (pp_v, ppf, v) /*<<format.ml:1301:12>>*/ ;
    }
    function pp_print_result(ok, error, ppf, param){
      /*<<?>>*/ if(0 === param[0]){
      var v = param[1];
       /*<<format.ml:1304:10>>*/ return  /*<<format.ml:1304:10>>*/ caml_call2
-             (ok, ppf, v);
+             (ok, ppf, v) /*<<format.ml:1304:10>>*/ ;
     }
     var e = param[1];
      /*<<format.ml:1305:13>>*/ return  /*<<format.ml:1305:13>>*/ caml_call2
-            (error, ppf, e);
+            (error, ppf, e) /*<<format.ml:1305:13>>*/ ;
    }
    function pp_print_either(left, right, ppf, param){
      /*<<?>>*/ if(0 === param[0]){
      var l = param[1];
       /*<<format.ml:1308:19>>*/ return  /*<<format.ml:1308:19>>*/ caml_call2
-             (left, ppf, l);
+             (left, ppf, l) /*<<format.ml:1308:19>>*/ ;
     }
     var r = param[1];
      /*<<format.ml:1309:20>>*/ return  /*<<format.ml:1309:20>>*/ caml_call2
-            (right, ppf, r);
+            (right, ppf, r) /*<<format.ml:1309:20>>*/ ;
    }
    function compute_tag(output, tag_acc){
      /*<<format.ml:1314:2>>*/ var
@@ -28539,40 +28891,41 @@
      /*<<format.ml:1319:2>>*/ return 2 <= len
             ?  /*<<format.ml:1320:7>>*/ caml_call3
               (Stdlib_Buffer[4], buf, 1, len - 2 | 0)
-            :  /*<<format.ml:1319:18>>*/ caml_call1(Stdlib_Buffer[2], buf);
+            :  /*<<format.ml:1319:18>>*/ caml_call1(Stdlib_Buffer[2], buf) /*<<format.ml:1320:33>>*/ ;
     /*<<format.ml:1320:33>>*/ }
    function output_formatting_lit(ppf, fmting_lit){
      /*<<format.ml:1333:43>>*/ if(typeof fmting_lit === "number")
      switch(fmting_lit){
        case 0:
-         /*<<format.ml:1334:33>>*/ return pp_close_box(ppf, 0);
+         /*<<format.ml:1334:33>>*/ return pp_close_box(ppf, 0) /*<<format.ml:1343:75>>*/ ;
        case 1:
-         /*<<format.ml:1335:33>>*/ return pp_close_stag(ppf, 0);
+         /*<<format.ml:1335:33>>*/ return pp_close_stag(ppf, 0) /*<<format.ml:1343:75>>*/ ;
        case 2:
-         /*<<format.ml:1337:33>>*/ return pp_print_flush(ppf, 0);
+         /*<<format.ml:1337:33>>*/ return pp_print_flush(ppf, 0) /*<<format.ml:1343:75>>*/ ;
        case 3:
-         /*<<format.ml:1338:33>>*/ return pp_force_newline(ppf, 0);
+         /*<<format.ml:1338:33>>*/ return pp_force_newline(ppf, 0) /*<<format.ml:1343:75>>*/ ;
        case 4:
-         /*<<format.ml:1339:33>>*/ return pp_print_newline(ppf, 0);
+         /*<<format.ml:1339:33>>*/ return pp_print_newline(ppf, 0) /*<<format.ml:1343:75>>*/ ;
        case 5:
-         /*<<format.ml:1341:33>>*/ return pp_print_char(ppf, 64);
-       default:  /*<<format.ml:1342:33>>*/ return pp_print_char(ppf, 37);
+         /*<<format.ml:1341:33>>*/ return pp_print_char(ppf, 64) /*<<format.ml:1343:75>>*/ ;
+       default:
+         /*<<format.ml:1342:33>>*/ return pp_print_char(ppf, 37) /*<<format.ml:1343:75>>*/ ;
      }
     switch(fmting_lit[0]){
       case 0:
        var offset = fmting_lit[3], width = fmting_lit[2];
-        /*<<format.ml:1336:33>>*/ return pp_print_break(ppf, width, offset);
+        /*<<format.ml:1336:33>>*/ return pp_print_break(ppf, width, offset) /*<<format.ml:1343:75>>*/ ;
       case 1:
-        /*<<format.ml:1340:33>>*/ return 0;
+        /*<<format.ml:1340:33>>*/ return 0 /*<<format.ml:1340:33>>*/ ;
       default:
        var c = fmting_lit[1];
         /*<<format.ml:1343:33>>*/ pp_print_char(ppf, 64);
-        /*<<format.ml:1343:33>>*/ return pp_print_char(ppf, c);
+        /*<<format.ml:1343:33>>*/ return pp_print_char(ppf, c) /*<<format.ml:1343:75>>*/ ;
     }
     /*<<format.ml:1343:75>>*/ }
    function output_acc(ppf, acc){
      /*<<format.ml:1349:29>>*/ if(typeof acc === "number")
-      /*<<format.ml:1375:32>>*/ return 0;
+      /*<<format.ml:1375:32>>*/ return 0 /*<<format.ml:1375:32>>*/ ;
     a:
     {
      b:
@@ -28583,14 +28936,14 @@
          case 0:
           var f = acc[2], p = acc[1];
            /*<<format.ml:1359:4>>*/ output_acc(ppf, p);
-           /*<<format.ml:1359:4>>*/ return output_formatting_lit(ppf, f);
+           /*<<format.ml:1359:4>>*/ return output_formatting_lit(ppf, f) /*<<format.ml:1375:34>>*/ ;
          case 1:
           var match = acc[2], p$0 = acc[1];
           if(0 === match[0]){
            var acc$0 = match[1];
             /*<<format.ml:1362:4>>*/ output_acc(ppf, p$0);
             /*<<format.ml:1363:21>>*/ return pp_open_stag
-                   (ppf, [0, String_tag, compute_tag(output_acc, acc$0)]);
+                   (ppf, [0, String_tag, compute_tag(output_acc, acc$0)]) /*<<format.ml:1375:34>>*/ ;
           }
           var acc$1 = match[1];
            /*<<format.ml:1365:4>>*/ output_acc(ppf, p$0);
@@ -28601,7 +28954,7 @@
               (CamlinternalFormat[20], _E_),
            bty = match$0[2],
            indent = match$0[1];
-           /*<<format.ml:1367:4>>*/ return pp_open_box_gen(ppf, indent, bty);
+           /*<<format.ml:1367:4>>*/ return pp_open_box_gen(ppf, indent, bty) /*<<format.ml:1375:34>>*/ ;
          case 2:
           var _F_ = acc[1];
           if(typeof _F_ !== "number" && 0 === _F_[0]){
@@ -28650,36 +29003,36 @@
           var f$0 = acc[2], p$5 = acc[1];
            /*<<format.ml:1372:32>>*/ output_acc(ppf, p$5);
            /*<<format.ml:1372:32>>*/ return  /*<<format.ml:1372:32>>*/ caml_call1
-                  (f$0, ppf);
+                  (f$0, ppf) /*<<format.ml:1375:34>>*/ ;
          case 7:
           var p$6 = acc[1];
            /*<<format.ml:1373:32>>*/ output_acc(ppf, p$6);
-           /*<<format.ml:1373:32>>*/ return pp_print_flush(ppf, 0);
+           /*<<format.ml:1373:32>>*/ return pp_print_flush(ppf, 0) /*<<format.ml:1375:34>>*/ ;
          default:
           var msg = acc[2], p$7 = acc[1];
            /*<<format.ml:1374:32>>*/ output_acc(ppf, p$7);
            /*<<format.ml:1374:32>>*/ return  /*<<format.ml:1374:32>>*/ caml_call1
-                  (Stdlib[1], msg);
+                  (Stdlib[1], msg) /*<<format.ml:1375:34>>*/ ;
        }
         /*<<format.ml:1356:4>>*/ output_acc(ppf, p$4);
         /*<<format.ml:1357:44>>*/ return pp_print_as_size
                (ppf,
                 size$0,
                  /*<<format.ml:1357:44>>*/ caml_call2
-                 (Stdlib_String[1], 1, c$0));
+                 (Stdlib_String[1], 1, c$0)) /*<<format.ml:1375:34>>*/ ;
       }
        /*<<format.ml:1371:32>>*/ output_acc(ppf, p$3);
-       /*<<format.ml:1371:32>>*/ return pp_print_char(ppf, c);
+       /*<<format.ml:1371:32>>*/ return pp_print_char(ppf, c) /*<<format.ml:1375:34>>*/ ;
      }
       /*<<format.ml:1352:4>>*/ output_acc(ppf, p$2);
-      /*<<format.ml:1352:4>>*/ return pp_print_as_size(ppf, size, s$0);
+      /*<<format.ml:1352:4>>*/ return pp_print_as_size(ppf, size, s$0) /*<<format.ml:1375:34>>*/ ;
     }
      /*<<format.ml:1369:32>>*/ output_acc(ppf, p$1);
-     /*<<format.ml:1369:32>>*/ return pp_print_string(ppf, s);
+     /*<<format.ml:1369:32>>*/ return pp_print_string(ppf, s) /*<<format.ml:1375:34>>*/ ;
     /*<<format.ml:1375:34>>*/ }
    function strput_acc(ppf, acc){
      /*<<format.ml:1381:29>>*/ if(typeof acc === "number")
-      /*<<format.ml:1410:32>>*/ return 0;
+      /*<<format.ml:1410:32>>*/ return 0 /*<<format.ml:1410:32>>*/ ;
     a:
     {
      b:
@@ -28690,14 +29043,14 @@
          case 0:
           var f = acc[2], p = acc[1];
            /*<<format.ml:1394:4>>*/ strput_acc(ppf, p);
-           /*<<format.ml:1394:4>>*/ return output_formatting_lit(ppf, f);
+           /*<<format.ml:1394:4>>*/ return output_formatting_lit(ppf, f) /*<<format.ml:1410:34>>*/ ;
          case 1:
           var match = acc[2], p$0 = acc[1];
           if(0 === match[0]){
            var acc$0 = match[1];
             /*<<format.ml:1397:4>>*/ strput_acc(ppf, p$0);
             /*<<format.ml:1398:21>>*/ return pp_open_stag
-                   (ppf, [0, String_tag, compute_tag(strput_acc, acc$0)]);
+                   (ppf, [0, String_tag, compute_tag(strput_acc, acc$0)]) /*<<format.ml:1410:34>>*/ ;
           }
           var acc$1 = match[1];
            /*<<format.ml:1400:4>>*/ strput_acc(ppf, p$0);
@@ -28708,7 +29061,7 @@
               (CamlinternalFormat[20], _v_),
            bty = match$0[2],
            indent = match$0[1];
-           /*<<format.ml:1402:4>>*/ return pp_open_box_gen(ppf, indent, bty);
+           /*<<format.ml:1402:4>>*/ return pp_open_box_gen(ppf, indent, bty) /*<<format.ml:1410:34>>*/ ;
          case 2:
           var _w_ = acc[1];
           if(typeof _w_ !== "number" && 0 === _w_[0]){
@@ -28761,38 +29114,38 @@
             var f$1 = acc[2], size$1 = match$1[2], p$6 = p$5[1];
              /*<<format.ml:1391:4>>*/ strput_acc(ppf, p$6);
              /*<<format.ml:1392:44>>*/ return pp_print_as_size
-                    (ppf, size$1,  /*<<format.ml:1392:44>>*/ caml_call1(f$1, 0));
+                    (ppf, size$1,  /*<<format.ml:1392:44>>*/ caml_call1(f$1, 0)) /*<<format.ml:1410:34>>*/ ;
            }
           }
           var f$0 = acc[2];
            /*<<format.ml:1407:32>>*/ strput_acc(ppf, p$5);
            /*<<format.ml:1407:70>>*/ return pp_print_string
-                  (ppf,  /*<<format.ml:1407:70>>*/ caml_call1(f$0, 0));
+                  (ppf,  /*<<format.ml:1407:70>>*/ caml_call1(f$0, 0)) /*<<format.ml:1410:34>>*/ ;
          case 7:
           var p$7 = acc[1];
            /*<<format.ml:1408:32>>*/ strput_acc(ppf, p$7);
-           /*<<format.ml:1408:32>>*/ return pp_print_flush(ppf, 0);
+           /*<<format.ml:1408:32>>*/ return pp_print_flush(ppf, 0) /*<<format.ml:1410:34>>*/ ;
          default:
           var msg = acc[2], p$8 = acc[1];
            /*<<format.ml:1409:32>>*/ strput_acc(ppf, p$8);
            /*<<format.ml:1409:32>>*/ return  /*<<format.ml:1409:32>>*/ caml_call1
-                  (Stdlib[1], msg);
+                  (Stdlib[1], msg) /*<<format.ml:1410:34>>*/ ;
        }
         /*<<format.ml:1388:4>>*/ strput_acc(ppf, p$4);
         /*<<format.ml:1389:44>>*/ return pp_print_as_size
                (ppf,
                 size$0,
                  /*<<format.ml:1389:44>>*/ caml_call2
-                 (Stdlib_String[1], 1, c$0));
+                 (Stdlib_String[1], 1, c$0)) /*<<format.ml:1410:34>>*/ ;
       }
        /*<<format.ml:1406:32>>*/ strput_acc(ppf, p$3);
-       /*<<format.ml:1406:32>>*/ return pp_print_char(ppf, c);
+       /*<<format.ml:1406:32>>*/ return pp_print_char(ppf, c) /*<<format.ml:1410:34>>*/ ;
      }
       /*<<format.ml:1384:4>>*/ strput_acc(ppf, p$2);
-      /*<<format.ml:1384:4>>*/ return pp_print_as_size(ppf, size, s$0);
+      /*<<format.ml:1384:4>>*/ return pp_print_as_size(ppf, size, s$0) /*<<format.ml:1410:34>>*/ ;
     }
      /*<<format.ml:1404:32>>*/ strput_acc(ppf, p$1);
-     /*<<format.ml:1404:32>>*/ return pp_print_string(ppf, s);
+     /*<<format.ml:1404:32>>*/ return pp_print_string(ppf, s) /*<<format.ml:1410:34>>*/ ;
     /*<<format.ml:1410:34>>*/ }
    function kfprintf(k, ppf, param){
     var fmt = param[1];
@@ -28800,15 +29153,15 @@
             (CamlinternalFormat[7],
              function(acc){
                /*<<format.ml:1420:16>>*/ output_acc(ppf, acc);
-              return caml_call1(k, ppf);
+              return caml_call1(k, ppf) /*<<format.ml:1420:41>>*/ ;
               /*<<format.ml:1420:41>>*/ },
              0,
-             fmt);
+             fmt) /*<<format.ml:1419:2>>*/ ;
    }
    function ikfprintf(k, ppf, param){
     var fmt = param[1];
      /*<<format.ml:1424:2>>*/ return  /*<<format.ml:1424:2>>*/ caml_call3
-            (CamlinternalFormat[8], k, ppf, fmt);
+            (CamlinternalFormat[8], k, ppf, fmt) /*<<format.ml:1424:2>>*/ ;
    }
    function ifprintf(ppf, param){
     var fmt = param[1];
@@ -28816,12 +29169,12 @@
             (CamlinternalFormat[8],
              function(_u_){ /*<<?>>*/ return 0;},
              0,
-             fmt);
+             fmt) /*<<format.ml:1427:2>>*/ ;
    }
    function fprintf(ppf){
     function _r_(_t_){ /*<<?>>*/ return 0;}
      /*<<format.ml:1429:18>>*/ return function(_s_){
-      /*<<?>>*/ return kfprintf(_r_, ppf, _s_);};
+      /*<<?>>*/ return kfprintf(_r_, ppf, _s_);} /*<<format.ml:1429:18>>*/ ;
     /*<<format.ml:1429:37>>*/ }
    function printf(param){
     var fmt = param[1];
@@ -28831,10 +29184,10 @@
                /*<<format.ml:1433:16>>*/ return output_acc
                       ( /*<<format.ml:1433:27>>*/ caml_call1
                         (Stdlib_Domain[10][2], std_formatter_key),
-                       acc);
+                       acc) /*<<format.ml:1433:58>>*/ ;
               /*<<format.ml:1433:58>>*/ },
              0,
-             fmt);
+             fmt) /*<<format.ml:1432:2>>*/ ;
    }
    function eprintf(param){
     var fmt = param[1];
@@ -28844,10 +29197,10 @@
                /*<<format.ml:1438:16>>*/ return output_acc
                       ( /*<<format.ml:1438:27>>*/ caml_call1
                         (Stdlib_Domain[10][2], err_formatter_key),
-                       acc);
+                       acc) /*<<format.ml:1438:58>>*/ ;
               /*<<format.ml:1438:58>>*/ },
              0,
-             fmt);
+             fmt) /*<<format.ml:1437:2>>*/ ;
    }
    function kdprintf(k, param){
     var fmt = param[1];
@@ -28857,18 +29210,18 @@
                /*<<format.ml:1443:16>>*/ return  /*<<format.ml:1443:18>>*/ caml_call1
                       (k,
                        function(ppf){
-                         /*<<format.ml:1443:30>>*/ return output_acc(ppf, acc);
-                        /*<<format.ml:1443:48>>*/ });
+                         /*<<format.ml:1443:30>>*/ return output_acc(ppf, acc) /*<<format.ml:1443:48>>*/ ;
+                        /*<<format.ml:1443:48>>*/ }) /*<<format.ml:1443:49>>*/ ;
               /*<<format.ml:1443:49>>*/ },
              0,
-             fmt);
+             fmt) /*<<format.ml:1442:2>>*/ ;
    }
    function dprintf(fmt){
      /*<<format.ml:1446:18>>*/ return kdprintf
             (function(i){
-               /*<<format.ml:1446:37>>*/ return i;
+               /*<<format.ml:1446:37>>*/ return i /*<<format.ml:1446:37>>*/ ;
               /*<<format.ml:1446:38>>*/ },
-             fmt);
+             fmt) /*<<format.ml:1446:43>>*/ ;
     /*<<format.ml:1446:43>>*/ }
    function ksprintf(k, param){
      /*<<format.ml:1449:10>>*/ var
@@ -28878,13 +29231,13 @@
     function k$0(acc){
       /*<<format.ml:1452:4>>*/ strput_acc(ppf, acc);
       /*<<format.ml:1453:6>>*/ return  /*<<format.ml:1453:6>>*/ caml_call1
-             (k, flush_buffer_formatter(b, ppf));
+             (k, flush_buffer_formatter(b, ppf)) /*<<format.ml:1453:36>>*/ ;
      /*<<format.ml:1453:36>>*/ }
      /*<<format.ml:1454:2>>*/ return  /*<<format.ml:1454:2>>*/ caml_call3
-            (CamlinternalFormat[7], k$0, 0, fmt);
+            (CamlinternalFormat[7], k$0, 0, fmt) /*<<format.ml:1454:2>>*/ ;
    }
    function sprintf(fmt){
-     /*<<format.ml:1457:18>>*/ return ksprintf(id, fmt);
+     /*<<format.ml:1457:18>>*/ return ksprintf(id, fmt) /*<<format.ml:1457:33>>*/ ;
     /*<<format.ml:1457:33>>*/ }
    function kasprintf(k, param){
      /*<<format.ml:1460:10>>*/ var
@@ -28894,13 +29247,13 @@
     function k$0(acc){
       /*<<format.ml:1463:4>>*/ output_acc(ppf, acc);
       /*<<format.ml:1464:6>>*/ return  /*<<format.ml:1464:6>>*/ caml_call1
-             (k, flush_buffer_formatter(b, ppf));
+             (k, flush_buffer_formatter(b, ppf)) /*<<format.ml:1464:36>>*/ ;
      /*<<format.ml:1464:36>>*/ }
      /*<<format.ml:1465:2>>*/ return  /*<<format.ml:1465:2>>*/ caml_call3
-            (CamlinternalFormat[7], k$0, 0, fmt);
+            (CamlinternalFormat[7], k$0, 0, fmt) /*<<format.ml:1465:2>>*/ ;
    }
    function asprintf(fmt){
-     /*<<format.ml:1468:19>>*/ return kasprintf(id, fmt);
+     /*<<format.ml:1468:19>>*/ return kasprintf(id, fmt) /*<<format.ml:1468:35>>*/ ;
     /*<<format.ml:1468:35>>*/ }
    function flush_standard_formatters(param){
      /*<<format.ml:1473:2>>*/ pp_print_flush
@@ -28910,7 +29263,7 @@
      /*<<format.ml:1473:2>>*/ return pp_print_flush
             ( /*<<format.ml:1474:17>>*/ caml_call1
               (Stdlib_Domain[10][2], err_formatter_key),
-             0);
+             0) /*<<format.ml:1474:47>>*/ ;
     /*<<format.ml:1474:47>>*/ }
     /*<<format.ml:1476:9>>*/  /*<<format.ml:1476:9>>*/ caml_call1
     (Stdlib[100], flush_standard_formatters);
@@ -28950,7 +29303,7 @@
                 },
                 fs$0[3],
                 fs$0[4],
-                fs$0[5]]);
+                fs$0[5]]) /*<<format.ml:1488:71>>*/ ;
       /*<<format.ml:1488:71>>*/ });
    var
     Stdlib_Format =
@@ -29188,7 +29541,7 @@
      ib[3] = 1;
      ib[4] = ib[4] + 1 | 0;
      if(10 === c) ib[5] = ib[5] + 1 | 0;
-      /*<<scanf.ml:171:6>>*/ return c;
+      /*<<scanf.ml:171:6>>*/ return c /*<<scanf.ml:171:6>>*/ ;
     }
     catch(_aY_){
      var _aX_ = caml_wrap_exception(_aY_);
@@ -29196,18 +29549,18 @@
      ib[2] = null_char;
      ib[3] = 0;
      ib[1] = 1;
-      /*<<scanf.ml:177:6>>*/ return null_char;
+      /*<<scanf.ml:177:6>>*/ return null_char /*<<scanf.ml:177:6>>*/ ;
     }
     /*<<scanf.ml:177:7>>*/ }
    function peek_char(ib){
-     /*<<scanf.ml:181:4>>*/ return ib[3] ? ib[2] : next_char(ib);
+     /*<<scanf.ml:181:4>>*/ return ib[3] ? ib[2] : next_char(ib) /*<<scanf.ml:183:21>>*/ ;
     /*<<scanf.ml:183:21>>*/ }
    function checked_peek_char(ib){
      /*<<scanf.ml:192:4>>*/  /*<<scanf.ml:192:12>>*/ var c = peek_char(ib);
     if(ib[1])
       /*<<scanf.ml:193:22>>*/ throw  /*<<scanf.ml:193:22>>*/ caml_maybe_attach_backtrace
             (Stdlib[12], 1);
-     /*<<scanf.ml:194:4>>*/ return c;
+     /*<<scanf.ml:194:4>>*/ return c /*<<scanf.ml:194:4>>*/ ;
     /*<<scanf.ml:194:5>>*/ }
    function end_of_input(ib){
      /*<<scanf.ml:198:4>>*/ peek_char(ib);
@@ -29219,14 +29572,14 @@
    function name_of_input(ib){
      /*<<scanf.ml:207:4>>*/ var match = ib[9];
     if(typeof match === "number")
-     return 0 === match ? cst_unnamed_function : cst_unnamed_character_string;
+     return 0 === match ? cst_unnamed_function : cst_unnamed_character_string /*<<scanf.ml:211:47>>*/ ;
     if(0 === match[0])
-      /*<<scanf.ml:208:26>>*/ return cst_unnamed_Stdlib_input_chann;
+      /*<<scanf.ml:208:26>>*/ return cst_unnamed_Stdlib_input_chann /*<<scanf.ml:208:26>>*/ ;
     var fname = match[1];
-     /*<<scanf.ml:209:32>>*/ return fname;
+     /*<<scanf.ml:209:32>>*/ return fname /*<<scanf.ml:209:32>>*/ ;
     /*<<scanf.ml:211:47>>*/ }
    function char_count(ib){
-     /*<<scanf.ml:215:4>>*/ return ib[3] ? ib[4] - 1 | 0 : ib[4];
+     /*<<scanf.ml:215:4>>*/ return ib[3] ? ib[4] - 1 | 0 : ib[4] /*<<scanf.ml:217:25>>*/ ;
     /*<<scanf.ml:217:25>>*/ }
    function invalidate_current_char(ib){
      /*<<scanf.ml:224:35>>*/ ib[3] = 0;
@@ -29240,17 +29593,17 @@
      /*<<scanf.ml:229:4>>*/  /*<<scanf.ml:229:4>>*/ caml_call1
      (Stdlib_Buffer[8], token_buffer);
     ib[6] = ib[6] + 1 | 0;
-     /*<<scanf.ml:231:4>>*/ return tok;
+     /*<<scanf.ml:231:4>>*/ return tok /*<<scanf.ml:231:4>>*/ ;
     /*<<scanf.ml:231:7>>*/ }
    function ignore_char(width, ib){
      /*<<scanf.ml:241:29>>*/ var width$0 = width - 1 | 0;
      /*<<scanf.ml:237:4>>*/ invalidate_current_char(ib);
-     /*<<scanf.ml:237:4>>*/ return width$0;
+     /*<<scanf.ml:237:4>>*/ return width$0 /*<<scanf.ml:237:4>>*/ ;
     /*<<scanf.ml:241:53>>*/ }
    function store_char(width, ib, c){
      /*<<scanf.ml:244:4>>*/  /*<<scanf.ml:244:4>>*/ caml_call2
      (Stdlib_Buffer[12], ib[8], c);
-     /*<<scanf.ml:244:4>>*/ return ignore_char(width, ib);
+     /*<<scanf.ml:244:4>>*/ return ignore_char(width, ib) /*<<scanf.ml:245:24>>*/ ;
     /*<<scanf.ml:245:24>>*/ }
    var default_token_buffer_size = 1024;
    function create(iname, next){
@@ -29264,7 +29617,7 @@
             next,
              /*<<scanf.ml:258:22>>*/ caml_call1
              (Stdlib_Buffer[1], default_token_buffer_size),
-            iname];
+            iname] /*<<scanf.ml:250:26>>*/ ;
     /*<<scanf.ml:260:3>>*/ }
    function from_string(s){
      /*<<scanf.ml:264:4>>*/ var
@@ -29278,9 +29631,9 @@
       /*<<scanf.ml:268:14>>*/  /*<<scanf.ml:268:14>>*/ var
       c =  /*<<scanf.ml:268:14>>*/ caml_string_get(s, i[1]);
       /*<<scanf.ml:269:6>>*/ i[1]++;
-      /*<<scanf.ml:270:6>>*/ return c;
+      /*<<scanf.ml:270:6>>*/ return c /*<<scanf.ml:270:6>>*/ ;
      /*<<scanf.ml:270:7>>*/ }
-     /*<<scanf.ml:271:4>>*/ return create(1, next);
+     /*<<scanf.ml:271:4>>*/ return create(1, next) /*<<scanf.ml:271:27>>*/ ;
     /*<<scanf.ml:271:27>>*/ }
    var _a_ = 0;
     /*<<scanf.ml:274:22>>*/ function from_function(_aW_){
@@ -29309,7 +29662,7 @@
        /*<<scanf.ml:333:38>>*/  /*<<scanf.ml:333:38>>*/ var
        c =  /*<<scanf.ml:333:38>>*/ caml_bytes_get(buf, i[1]);
        /*<<scanf.ml:333:58>>*/ i[1]++;
-       /*<<scanf.ml:333:66>>*/ return c;
+       /*<<scanf.ml:333:66>>*/ return c /*<<scanf.ml:333:66>>*/ ;
      }
      if(eof[1])
        /*<<scanf.ml:334:19>>*/ throw  /*<<scanf.ml:334:19>>*/ caml_maybe_attach_backtrace
@@ -29317,18 +29670,18 @@
      lim[1] =  /*<<scanf.ml:335:15>>*/ caml_call4(Stdlib[84], ic, buf, 0, len);
      return 0 === lim[1]
              ? (eof[1] = 1, caml_call1(scan_close_ic, ic))
-             : (i[1] = 1,  /*<<scanf.ml:338:10>>*/ caml_bytes_get(buf, 0));
+             : (i[1] = 1,  /*<<scanf.ml:338:10>>*/ caml_bytes_get(buf, 0)) /*<<scanf.ml:340:9>>*/ ;
      /*<<scanf.ml:340:9>>*/ }
-     /*<<scanf.ml:341:4>>*/ return create(iname, next);
+     /*<<scanf.ml:341:4>>*/ return create(iname, next) /*<<scanf.ml:341:21>>*/ ;
     /*<<scanf.ml:341:21>>*/ }
     /*<<scanf.ml:363:4>>*/  /*<<scanf.ml:363:4>>*/ var
     stdin = from_ic(scan_raise_at_end, [1, cst, Stdlib[38]], Stdlib[38]);
    function open_in_file(open_in, fname){
      /*<<scanf.ml:367:4>>*/ if(fname === cst$6)
-      /*<<scanf.ml:363:4>>*/ return stdin;
+      /*<<scanf.ml:363:4>>*/ return stdin /*<<scanf.ml:363:4>>*/ ;
      /*<<scanf.ml:370:15>>*/  /*<<scanf.ml:370:15>>*/ var
      ic =  /*<<scanf.ml:370:15>>*/ caml_call1(open_in, fname);
-    return from_ic(scan_close_at_end, [1, fname, ic], ic);
+    return from_ic(scan_close_at_end, [1, fname, ic], ic) /*<<scanf.ml:371:53>>*/ ;
     /*<<scanf.ml:371:53>>*/ }
    var _b_ = Stdlib[79];
     /*<<scanf.ml:374:16>>*/ function open_in(_aV_){
@@ -29339,19 +29692,20 @@
      /*<<?>>*/ return open_in_file(_c_, _aU_);
    }
    function from_channel(ic){
-     /*<<scanf.ml:381:4>>*/ return from_ic(scan_raise_at_end, [0, ic], ic);
+     /*<<scanf.ml:381:4>>*/ return from_ic(scan_raise_at_end, [0, ic], ic) /*<<scanf.ml:381:45>>*/ ;
     /*<<scanf.ml:381:45>>*/ }
    function close_in(ib){
      /*<<scanf.ml:385:4>>*/ var match = ib[9];
-    if(typeof match === "number")  /*<<scanf.ml:389:37>>*/ return 0;
+    if(typeof match === "number")
+      /*<<scanf.ml:389:37>>*/ return 0 /*<<scanf.ml:389:37>>*/ ;
     if(0 === match[0]){
      var ic = match[1];
       /*<<scanf.ml:387:6>>*/ return  /*<<scanf.ml:387:6>>*/ caml_call1
-             (Stdlib[93], ic);
+             (Stdlib[93], ic) /*<<scanf.ml:389:39>>*/ ;
     }
     var ic$0 = match[2];
      /*<<scanf.ml:388:32>>*/ return  /*<<scanf.ml:388:32>>*/ caml_call1
-            (Stdlib[93], ic$0);
+            (Stdlib[93], ic$0) /*<<scanf.ml:389:39>>*/ ;
     /*<<scanf.ml:389:39>>*/ }
     /*<<scanf.ml:403:0>>*/ var
      /*<<scanf.ml:403:0>>*/ Scan_failure =
@@ -29446,19 +29800,19 @@
     /*<<scanf.ml:405:40>>*/ }
    function bad_input_escape(c){
      /*<<scanf.ml:408:2>>*/ return bad_input
-            ( /*<<scanf.ml:408:12>>*/ caml_call2(Stdlib_Printf[4], _d_, c));
+            ( /*<<scanf.ml:408:12>>*/ caml_call2(Stdlib_Printf[4], _d_, c)) /*<<scanf.ml:408:60>>*/ ;
     /*<<scanf.ml:408:60>>*/ }
    function bad_token_length(message){
      /*<<scanf.ml:412:2>>*/ return bad_input
             ( /*<<scanf.ml:413:4>>*/ caml_call2
-              (Stdlib_Printf[4], _e_, message));
+              (Stdlib_Printf[4], _e_, message)) /*<<scanf.ml:416:15>>*/ ;
     /*<<scanf.ml:416:15>>*/ }
    function bad_hex_float(param){
-     /*<<scanf.ml:432:2>>*/ return bad_input(cst_not_a_valid_float_in_hexad);
+     /*<<scanf.ml:432:2>>*/ return bad_input(cst_not_a_valid_float_in_hexad) /*<<scanf.ml:432:55>>*/ ;
     /*<<scanf.ml:432:55>>*/ }
    function character_mismatch(c, ci){
      /*<<scanf.ml:440:2>>*/ return bad_input
-            ( /*<<scanf.ml:436:2>>*/ caml_call3(Stdlib_Printf[4], _g_, c, ci));
+            ( /*<<scanf.ml:436:2>>*/ caml_call3(Stdlib_Printf[4], _g_, c, ci)) /*<<scanf.ml:440:41>>*/ ;
     /*<<scanf.ml:440:41>>*/ }
    function check_char(ib, c$0){
      /*<<scanf.ml:468:2>>*/ if(10 === c$0){
@@ -29469,14 +29823,15 @@
              : 13
                === ci
                ? (invalidate_current_char(ib), check_this_char(ib, 10))
-               : character_mismatch(10, ci);
+               : character_mismatch(10, ci) /*<<scanf.ml:471:29>>*/ ;
     }
-    if(32 !== c$0)  /*<<scanf.ml:471:9>>*/ return check_this_char(ib, c$0);
+    if(32 !== c$0)
+      /*<<scanf.ml:471:9>>*/ return check_this_char(ib, c$0) /*<<scanf.ml:471:29>>*/ ;
      /*<<scanf.ml:444:2>>*/ for(;;){
       /*<<scanf.ml:444:10>>*/ var
        /*<<scanf.ml:444:10>>*/ c = peek_char(ib),
        /*<<scanf.ml:445:9>>*/ _aS_ = 1 - ib[1];
-     if(! _aS_)  /*<<scanf.ml:445:9>>*/ return _aS_;
+     if(! _aS_)  /*<<scanf.ml:445:9>>*/ return _aS_ /*<<scanf.ml:445:9>>*/ ;
       /*<<scanf.ml:445:32>>*/  /*<<scanf.ml:445:32>>*/ var _aT_ = c - 9 | 0;
      a:
      {
@@ -29484,7 +29839,7 @@
        if(23 === _aT_) break a;
       }
       else if(1 < _aT_ - 2 >>> 0) break a;
-       /*<<scanf.ml:449:11>>*/ return 0;
+       /*<<scanf.ml:449:11>>*/ return 0 /*<<scanf.ml:449:11>>*/ ;
      }
       /*<<scanf.ml:448:6>>*/ invalidate_current_char(ib);
     }
@@ -29492,11 +29847,11 @@
    function check_this_char(ib, c){
      /*<<scanf.ml:474:2>>*/  /*<<scanf.ml:474:11>>*/ var
      ci = checked_peek_char(ib);
-    return ci === c ? invalidate_current_char(ib) : character_mismatch(c, ci);
+    return ci === c ? invalidate_current_char(ib) : character_mismatch(c, ci) /*<<scanf.ml:476:25>>*/ ;
     /*<<scanf.ml:476:25>>*/ }
    function token_char(ib){
      /*<<scanf.ml:488:20>>*/ return  /*<<scanf.ml:488:20>>*/ caml_string_get
-            (token_string(ib), 0);
+            (token_string(ib), 0) /*<<scanf.ml:488:43>>*/ ;
     /*<<scanf.ml:488:43>>*/ }
    function token_bool(ib){
      /*<<scanf.ml:493:2>>*/  /*<<scanf.ml:493:8>>*/ var s = token_string(ib);
@@ -29506,7 +29861,7 @@
               ? bad_input
                 ( /*<<scanf.ml:496:19>>*/ caml_call2(Stdlib_Printf[4], _h_, s))
               : 1
-            : 0;
+            : 0 /*<<scanf.ml:496:60>>*/ ;
     /*<<scanf.ml:496:60>>*/ }
    function integer_conversion_of_char(param){
      /*<<scanf.ml:509:33>>*/  /*<<scanf.ml:509:33>>*/ var
@@ -29514,18 +29869,18 @@
     if(32 >= switcher >>> 0)
      switch(switcher){
        case 10:
-         /*<<scanf.ml:510:11>>*/ return 0;
+         /*<<scanf.ml:510:11>>*/ return 0 /*<<scanf.ml:510:11>>*/ ;
        case 12:
-         /*<<scanf.ml:511:11>>*/ return 1;
+         /*<<scanf.ml:511:11>>*/ return 1 /*<<scanf.ml:511:11>>*/ ;
        case 17:
-         /*<<scanf.ml:512:11>>*/ return 2;
+         /*<<scanf.ml:512:11>>*/ return 2 /*<<scanf.ml:512:11>>*/ ;
        case 23:
-         /*<<scanf.ml:513:11>>*/ return 3;
+         /*<<scanf.ml:513:11>>*/ return 3 /*<<scanf.ml:513:11>>*/ ;
        case 29:
-         /*<<scanf.ml:514:11>>*/ return 4;
+         /*<<scanf.ml:514:11>>*/ return 4 /*<<scanf.ml:514:11>>*/ ;
        case 0:
        case 32:
-         /*<<scanf.ml:515:17>>*/ return 5;
+         /*<<scanf.ml:515:17>>*/ return 5 /*<<scanf.ml:515:17>>*/ ;
      }
      /*<<scanf.ml:516:9>>*/ throw  /*<<scanf.ml:516:9>>*/ caml_maybe_attach_backtrace
            ([0, Assert_failure, _i_], 1);
@@ -29559,20 +29914,21 @@
      /*<<scanf.ml:531:2>>*/ if
      (0 !== l && 43 ===  /*<<scanf.ml:531:14>>*/ caml_string_get(tok, 0))
       /*<<scanf.ml:531:43>>*/ return  /*<<scanf.ml:531:43>>*/ caml_call3
-             (Stdlib_String[16], tok, 1, l - 1 | 0);
-     /*<<scanf.ml:531:34>>*/ return tok;
+             (Stdlib_String[16], tok, 1, l - 1 | 0) /*<<scanf.ml:531:67>>*/ ;
+     /*<<scanf.ml:531:34>>*/ return tok /*<<scanf.ml:531:34>>*/ ;
     /*<<scanf.ml:531:67>>*/ }
    function token_float(ib){
      /*<<scanf.ml:539:21>>*/ return  /*<<scanf.ml:539:21>>*/ runtime.caml_float_of_string
-            (token_string(ib));
+            (token_string(ib)) /*<<scanf.ml:539:56>>*/ ;
     /*<<scanf.ml:539:56>>*/ }
    function scan_decimal_digit_star(width, ib){
      /*<<scanf.ml:575:2>>*/ var width$0 = width;
      /*<<scanf.ml:575:2>>*/ for(;;){
-     if(0 === width$0)  /*<<scanf.ml:575:20>>*/ return width$0;
+     if(0 === width$0)
+       /*<<scanf.ml:575:20>>*/ return width$0 /*<<scanf.ml:575:20>>*/ ;
       /*<<scanf.ml:576:10>>*/  /*<<scanf.ml:576:10>>*/ var c = peek_char(ib);
       /*<<scanf.ml:577:5>>*/ if(ib[1])
-       /*<<scanf.ml:577:26>>*/ return width$0;
+       /*<<scanf.ml:577:26>>*/ return width$0 /*<<scanf.ml:577:26>>*/ ;
      if(58 <= c){
       if(95 === c){
         /*<<scanf.ml:583:16>>*/  /*<<scanf.ml:583:16>>*/ var
@@ -29587,38 +29943,40 @@
       width$0 = width$2;
       continue;
      }
-      /*<<scanf.ml:585:9>>*/ return width$0;
+      /*<<scanf.ml:585:9>>*/ return width$0 /*<<scanf.ml:585:9>>*/ ;
     }
     /*<<scanf.ml:585:14>>*/ }
    function scan_decimal_digit_plus(width, ib){
      /*<<scanf.ml:589:2>>*/ if(0 === width)
-      /*<<scanf.ml:589:20>>*/ return bad_token_length(cst_decimal_digits);
+      /*<<scanf.ml:589:20>>*/ return bad_token_length(cst_decimal_digits) /*<<scanf.ml:596:70>>*/ ;
      /*<<scanf.ml:590:10>>*/  /*<<scanf.ml:590:10>>*/ var
      c = checked_peek_char(ib);
     if(9 < c - 48 >>> 0)
       /*<<scanf.ml:596:14>>*/ return bad_input
-             ( /*<<scanf.ml:596:14>>*/ caml_call2(Stdlib_Printf[4], _j_, c));
+             ( /*<<scanf.ml:596:14>>*/ caml_call2(Stdlib_Printf[4], _j_, c)) /*<<scanf.ml:596:70>>*/ ;
      /*<<scanf.ml:593:16>>*/  /*<<scanf.ml:593:16>>*/ var
      width$0 = store_char(width, ib, c);
-     /*<<scanf.ml:594:4>>*/ return scan_decimal_digit_star(width$0, ib);
+     /*<<scanf.ml:594:4>>*/ return scan_decimal_digit_star(width$0, ib) /*<<scanf.ml:596:70>>*/ ;
     /*<<scanf.ml:596:70>>*/ }
    function scan_digit_plus(basis, digitp, width$2, ib){
      /*<<scanf.ml:620:2>>*/ if(0 === width$2)
-      /*<<scanf.ml:620:20>>*/ return bad_token_length(cst_digits);
+      /*<<scanf.ml:620:20>>*/ return bad_token_length(cst_digits) /*<<scanf.ml:626:77>>*/ ;
      /*<<scanf.ml:621:10>>*/  /*<<scanf.ml:621:10>>*/ var
      c$0 = checked_peek_char(ib);
      /*<<scanf.ml:622:5>>*/ if
      (!  /*<<scanf.ml:622:5>>*/ caml_call1(digitp, c$0))
       /*<<scanf.ml:626:14>>*/ return bad_input
              ( /*<<scanf.ml:626:14>>*/ caml_call3
-               (Stdlib_Printf[4], _k_, c$0, basis));
+               (Stdlib_Printf[4], _k_, c$0, basis)) /*<<scanf.ml:626:77>>*/ ;
      /*<<scanf.ml:623:16>>*/ var
       /*<<scanf.ml:623:16>>*/ width$3 = store_char(width$2, ib, c$0),
      width = width$3;
      /*<<scanf.ml:603:4>>*/ for(;;){
-     if(0 === width)  /*<<scanf.ml:603:22>>*/ return width;
+     if(0 === width)
+       /*<<scanf.ml:603:22>>*/ return width /*<<scanf.ml:603:22>>*/ ;
       /*<<scanf.ml:604:12>>*/  /*<<scanf.ml:604:12>>*/ var c = peek_char(ib);
-      /*<<scanf.ml:605:7>>*/ if(ib[1])  /*<<scanf.ml:605:28>>*/ return width;
+      /*<<scanf.ml:605:7>>*/ if(ib[1])
+       /*<<scanf.ml:605:28>>*/ return width /*<<scanf.ml:605:28>>*/ ;
       /*<<scanf.ml:607:13>>*/ if
       ( /*<<scanf.ml:607:13>>*/ caml_call1(digitp, c)){
        /*<<scanf.ml:608:18>>*/  /*<<scanf.ml:608:18>>*/ var
@@ -29626,7 +29984,8 @@
       width = width$0;
      }
      else{
-      if(95 !== c)  /*<<scanf.ml:613:11>>*/ return width;
+      if(95 !== c)
+        /*<<scanf.ml:613:11>>*/ return width /*<<scanf.ml:613:11>>*/ ;
        /*<<scanf.ml:611:18>>*/  /*<<scanf.ml:611:18>>*/ var
        width$1 = ignore_char(width, ib);
       width = width$1;
@@ -29634,10 +29993,10 @@
     }
     /*<<scanf.ml:626:77>>*/ }
    function is_binary_digit(param){
-     /*<<scanf.ml:629:22>>*/ return 1 < param - 48 >>> 0 ? 0 : 1;
+     /*<<scanf.ml:629:22>>*/ return 1 < param - 48 >>> 0 ? 0 : 1 /*<<scanf.ml:631:14>>*/ ;
     /*<<scanf.ml:631:14>>*/ }
    function is_octal_digit(param){
-     /*<<scanf.ml:636:21>>*/ return 7 < param - 48 >>> 0 ? 0 : 1;
+     /*<<scanf.ml:636:21>>*/ return 7 < param - 48 >>> 0 ? 0 : 1 /*<<scanf.ml:638:14>>*/ ;
     /*<<scanf.ml:638:14>>*/ }
    function is_hexa_digit(param){
      /*<<scanf.ml:643:20>>*/  /*<<scanf.ml:643:20>>*/ var
@@ -29648,9 +30007,9 @@
       if(5 < _aN_ - 49 >>> 0) break a;
      }
      else if(6 >= _aN_ - 10 >>> 0) break a;
-      /*<<scanf.ml:644:44>>*/ return 1;
+      /*<<scanf.ml:644:44>>*/ return 1 /*<<scanf.ml:644:44>>*/ ;
     }
-     /*<<scanf.ml:645:9>>*/ return 0;
+     /*<<scanf.ml:645:9>>*/ return 0 /*<<scanf.ml:645:9>>*/ ;
     /*<<scanf.ml:645:14>>*/ }
    function scan_sign(width, ib){
      /*<<scanf.ml:654:2>>*/ var
@@ -29659,44 +30018,45 @@
     if(2 >= switcher >>> 0)
      switch(switcher){
        case 0:
-         /*<<scanf.ml:656:11>>*/ return store_char(width, ib, c);
+         /*<<scanf.ml:656:11>>*/ return store_char(width, ib, c) /*<<scanf.ml:658:14>>*/ ;
        case 1: break;
-       default:  /*<<scanf.ml:657:11>>*/ return store_char(width, ib, c);
+       default:
+         /*<<scanf.ml:657:11>>*/ return store_char(width, ib, c) /*<<scanf.ml:658:14>>*/ ;
      }
-     /*<<scanf.ml:658:9>>*/ return width;
+     /*<<scanf.ml:658:9>>*/ return width /*<<scanf.ml:658:9>>*/ ;
     /*<<scanf.ml:658:14>>*/ }
    function scan_optionally_signed_decimal(width, ib){
      /*<<scanf.ml:662:2>>*/  /*<<scanf.ml:662:14>>*/ var
      width$0 = scan_sign(width, ib);
-     /*<<scanf.ml:663:2>>*/ return scan_decimal_digit_plus(width$0, ib);
+     /*<<scanf.ml:663:2>>*/ return scan_decimal_digit_plus(width$0, ib) /*<<scanf.ml:663:36>>*/ ;
     /*<<scanf.ml:663:36>>*/ }
    function scan_int_conversion(conv, width$1, ib){
      /*<<scanf.ml:691:2>>*/ switch(conv){
       case 0:
-       return scan_digit_plus(cst_binary, is_binary_digit, width$1, ib);
+       return scan_digit_plus(cst_binary, is_binary_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
       case 1:
         /*<<scanf.ml:693:20>>*/ return scan_optionally_signed_decimal
-               (width$1, ib);
+               (width$1, ib) /*<<scanf.ml:697:49>>*/ ;
       case 2:
         /*<<scanf.ml:686:14>>*/ var
          /*<<scanf.ml:686:14>>*/ width$0 = scan_sign(width$1, ib),
          /*<<scanf.ml:671:8>>*/ c = checked_peek_char(ib);
        if(48 !== c)
-         /*<<scanf.ml:682:9>>*/ return scan_decimal_digit_plus(width$0, ib);
+         /*<<scanf.ml:682:9>>*/ return scan_decimal_digit_plus(width$0, ib) /*<<scanf.ml:697:49>>*/ ;
         /*<<scanf.ml:673:16>>*/  /*<<scanf.ml:673:16>>*/ var
         width = store_char(width$0, ib, c);
         /*<<scanf.ml:674:4>>*/ if(0 === width)
-         /*<<scanf.ml:674:22>>*/ return width;
+         /*<<scanf.ml:674:22>>*/ return width /*<<scanf.ml:674:22>>*/ ;
         /*<<scanf.ml:675:12>>*/  /*<<scanf.ml:675:12>>*/ var
         c$0 = peek_char(ib);
         /*<<scanf.ml:676:7>>*/ if(ib[1])
-         /*<<scanf.ml:676:28>>*/ return width;
+         /*<<scanf.ml:676:28>>*/ return width /*<<scanf.ml:676:28>>*/ ;
        a:
        {
         if(99 <= c$0){
          if(111 === c$0)
           return scan_digit_plus
-                  (cst_octal, is_octal_digit, store_char(width, ib, c$0), ib);
+                  (cst_octal, is_octal_digit, store_char(width, ib, c$0), ib) /*<<scanf.ml:697:49>>*/ ;
          if(120 === c$0) break a;
         }
         else{
@@ -29706,56 +30066,58 @@
                   (cst_binary,
                    is_binary_digit,
                    store_char(width, ib, c$0),
-                   ib);
+                   ib) /*<<scanf.ml:697:49>>*/ ;
         }
-         /*<<scanf.ml:681:11>>*/ return scan_decimal_digit_star(width, ib);
+         /*<<scanf.ml:681:11>>*/ return scan_decimal_digit_star(width, ib) /*<<scanf.ml:697:49>>*/ ;
        }
        return scan_digit_plus
                (cst_hexadecimal,
                 is_hexa_digit,
                 store_char(width, ib, c$0),
-                ib);
+                ib) /*<<scanf.ml:697:49>>*/ ;
       case 3:
-       return scan_digit_plus(cst_octal, is_octal_digit, width$1, ib);
+       return scan_digit_plus(cst_octal, is_octal_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
       case 4:
-        /*<<scanf.ml:696:20>>*/ return scan_decimal_digit_plus(width$1, ib);
+        /*<<scanf.ml:696:20>>*/ return scan_decimal_digit_plus(width$1, ib) /*<<scanf.ml:697:49>>*/ ;
       default:
-       return scan_digit_plus(cst_hexadecimal, is_hexa_digit, width$1, ib);
+       return scan_digit_plus(cst_hexadecimal, is_hexa_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
     }
     /*<<scanf.ml:697:49>>*/ }
    function scan_fractional_part(width, ib){
      /*<<scanf.ml:704:2>>*/ if(0 === width)
-      /*<<scanf.ml:704:20>>*/ return width;
+      /*<<scanf.ml:704:20>>*/ return width /*<<scanf.ml:704:20>>*/ ;
      /*<<scanf.ml:705:10>>*/  /*<<scanf.ml:705:10>>*/ var c = peek_char(ib);
      /*<<scanf.ml:706:5>>*/ return ib[1]
             ? width
             : 9
               < c - 48 >>> 0
               ? width
-              : scan_decimal_digit_star(store_char(width, ib, c), ib);
+              : scan_decimal_digit_star(store_char(width, ib, c), ib) /*<<scanf.ml:710:14>>*/ ;
     /*<<scanf.ml:710:14>>*/ }
    function scan_exponent_part(width, ib){
      /*<<scanf.ml:715:2>>*/ if(0 === width)
-      /*<<scanf.ml:715:20>>*/ return width;
+      /*<<scanf.ml:715:20>>*/ return width /*<<scanf.ml:715:20>>*/ ;
      /*<<scanf.ml:716:10>>*/  /*<<scanf.ml:716:10>>*/ var c = peek_char(ib);
-     /*<<scanf.ml:717:5>>*/ if(ib[1])  /*<<scanf.ml:717:26>>*/ return width;
-    if(69 !== c && 101 !== c)  /*<<scanf.ml:721:9>>*/ return width;
+     /*<<scanf.ml:717:5>>*/ if(ib[1])
+      /*<<scanf.ml:717:26>>*/ return width /*<<scanf.ml:717:26>>*/ ;
+    if(69 !== c && 101 !== c)
+      /*<<scanf.ml:721:9>>*/ return width /*<<scanf.ml:721:9>>*/ ;
      /*<<scanf.ml:720:4>>*/ return scan_optionally_signed_decimal
-            (store_char(width, ib, c), ib);
+            (store_char(width, ib, c), ib) /*<<scanf.ml:721:14>>*/ ;
     /*<<scanf.ml:721:14>>*/ }
    function scan_float(width$1, precision, ib){
      /*<<scanf.ml:765:2>>*/ var
       /*<<scanf.ml:729:14>>*/ width = scan_sign(width$1, ib),
       /*<<scanf.ml:730:2>>*/ width$0 = scan_decimal_digit_star(width, ib);
      /*<<scanf.ml:766:2>>*/ if(0 === width$0)
-      /*<<scanf.ml:766:20>>*/ return [0, width$0, precision];
+      /*<<scanf.ml:766:20>>*/ return [0, width$0, precision] /*<<scanf.ml:766:20>>*/ ;
      /*<<scanf.ml:767:10>>*/  /*<<scanf.ml:767:10>>*/ var c = peek_char(ib);
      /*<<scanf.ml:768:5>>*/ if(ib[1])
-      /*<<scanf.ml:768:26>>*/ return [0, width$0, precision];
+      /*<<scanf.ml:768:26>>*/ return [0, width$0, precision] /*<<scanf.ml:768:26>>*/ ;
     if(46 !== c)
       /*<<scanf.ml:776:4>>*/ return [0,
              scan_exponent_part(width$0, ib),
-             precision];
+             precision] /*<<scanf.ml:776:4>>*/ ;
      /*<<scanf.ml:771:16>>*/ var
       /*<<scanf.ml:771:16>>*/ width$2 = store_char(width$0, ib, c),
       /*<<scanf.ml:772:20>>*/ precision$0 =
@@ -29764,13 +30126,13 @@
        width$2 - (precision$0 - scan_fractional_part(precision$0, ib) | 0) | 0;
      /*<<scanf.ml:774:4>>*/ return [0,
             scan_exponent_part(width$3, ib),
-            precision$0];
+            precision$0] /*<<scanf.ml:774:4>>*/ ;
     /*<<scanf.ml:776:42>>*/ }
    function check_case_insensitive_string(width, ib, error, str){
      /*<<scanf.ml:780:2>>*/ function lowercase(c){
       /*<<scanf.ml:781:4>>*/ return 25 < c - 65 >>> 0
              ? c
-             : caml_call1(Stdlib[29], (c - 65 | 0) + 97 | 0);
+             : caml_call1(Stdlib[29], (c - 65 | 0) + 97 | 0) /*<<scanf.ml:784:12>>*/ ;
      /*<<scanf.ml:784:12>>*/ }
      /*<<scanf.ml:785:2>>*/ var
       /*<<scanf.ml:785:2>>*/ len =
@@ -29824,7 +30186,7 @@
         /*<<scanf.ml:831:20>>*/ if(_aB_)
          /*<<scanf.ml:432:2>>*/ bad_input(cst_not_a_valid_float_in_hexad);
         /*<<scanf.ml:831:50>>*/ return check_case_insensitive_string
-               (width$1, ib, bad_hex_float, cst_an);
+               (width$1, ib, bad_hex_float, cst_an) /*<<scanf.ml:837:25>>*/ ;
       }
       if(26 !== switcher) break a;
      }
@@ -29901,7 +30263,7 @@
            /*<<scanf.ml:822:16>>*/  /*<<scanf.ml:822:16>>*/ var
            c$1 = peek_char(ib);
           if(80 !== c$1 && 112 !== c$1)
-            /*<<scanf.ml:827:17>>*/ return width$8;
+            /*<<scanf.ml:827:17>>*/ return width$8 /*<<scanf.ml:827:17>>*/ ;
            /*<<scanf.ml:824:24>>*/ var
             /*<<scanf.ml:824:24>>*/ width$9 = store_char(width$8, ib, c$1),
            _aH_ = 0 === width$9 ? 1 : 0,
@@ -29909,13 +30271,13 @@
            /*<<scanf.ml:825:28>>*/ if(_aI_)
             /*<<scanf.ml:432:2>>*/ bad_input(cst_not_a_valid_float_in_hexad);
            /*<<scanf.ml:825:58>>*/ return scan_optionally_signed_decimal
-                  (width$9, ib);
+                  (width$9, ib) /*<<scanf.ml:837:25>>*/ ;
          }
-          /*<<scanf.ml:821:54>>*/ return width$8;
+          /*<<scanf.ml:821:54>>*/ return width$8 /*<<scanf.ml:821:54>>*/ ;
         }
-         /*<<scanf.ml:809:52>>*/ return width$5;
+         /*<<scanf.ml:809:52>>*/ return width$5 /*<<scanf.ml:809:52>>*/ ;
        }
-        /*<<scanf.ml:805:50>>*/ return width$4;
+        /*<<scanf.ml:805:50>>*/ return width$4 /*<<scanf.ml:805:50>>*/ ;
       }
       if(73 !== c) break a;
      }
@@ -29926,9 +30288,9 @@
       /*<<scanf.ml:835:20>>*/ if(_aD_)
        /*<<scanf.ml:432:2>>*/ bad_input(cst_not_a_valid_float_in_hexad);
       /*<<scanf.ml:835:50>>*/ return check_case_insensitive_string
-             (width$2, ib, bad_hex_float, cst_nfinity);
+             (width$2, ib, bad_hex_float, cst_nfinity) /*<<scanf.ml:837:25>>*/ ;
     }
-     /*<<scanf.ml:432:2>>*/ return bad_input(cst_not_a_valid_float_in_hexad);
+     /*<<scanf.ml:432:2>>*/ return bad_input(cst_not_a_valid_float_in_hexad) /*<<scanf.ml:837:25>>*/ ;
     /*<<scanf.ml:837:25>>*/ }
    function scan_caml_float_rest(width, precision, ib){
      /*<<scanf.ml:841:2>>*/ var
@@ -29956,12 +30318,12 @@
          scan_fractional_part(precision$0, ib),
        frac_width = precision$0 - width_precision | 0,
        width$2 = width$1 - frac_width | 0;
-       /*<<scanf.ml:859:4>>*/ return scan_exponent_part(width$2, ib);
+       /*<<scanf.ml:859:4>>*/ return scan_exponent_part(width$2, ib) /*<<scanf.ml:862:21>>*/ ;
      }
     }
     else if(30 < switcher - 1 >>> 0)
-      /*<<scanf.ml:861:4>>*/ return scan_exponent_part(width$0, ib);
-     /*<<scanf.ml:428:2>>*/ return bad_input(cst_no_dot_or_exponent_part_fo);
+      /*<<scanf.ml:861:4>>*/ return scan_exponent_part(width$0, ib) /*<<scanf.ml:862:21>>*/ ;
+     /*<<scanf.ml:428:2>>*/ return bad_input(cst_no_dot_or_exponent_part_fo) /*<<scanf.ml:862:21>>*/ ;
     /*<<scanf.ml:862:21>>*/ }
    function scan_caml_float(width, precision, ib){
      /*<<scanf.ml:866:2>>*/ var
@@ -29985,7 +30347,7 @@
        /*<<scanf.ml:904:20>>*/ if(_aj_)
         /*<<scanf.ml:428:2>>*/ bad_input(cst_no_dot_or_exponent_part_fo);
        /*<<scanf.ml:904:50>>*/ return scan_caml_float_rest
-              (width$1, precision, ib);
+              (width$1, precision, ib) /*<<scanf.ml:910:21>>*/ ;
      }
     }
     else if(48 <= c){
@@ -29999,7 +30361,7 @@
       c$0 = peek_char(ib);
      if(88 !== c$0 && 120 !== c$0)
        /*<<scanf.ml:900:6>>*/ return scan_caml_float_rest
-              (width$2, precision, ib);
+              (width$2, precision, ib) /*<<scanf.ml:910:21>>*/ ;
       /*<<scanf.ml:875:18>>*/ var
        /*<<scanf.ml:875:18>>*/ width$3 = store_char(width$2, ib, c$0),
       _am_ = 0 === width$3 ? 1 : 0,
@@ -30066,7 +30428,8 @@
       /*<<scanf.ml:891:6>>*/ if(0 !== width$7 && ! end_of_input(ib)){
        /*<<scanf.ml:892:14>>*/  /*<<scanf.ml:892:14>>*/ var
        c$2 = peek_char(ib);
-      if(80 !== c$2 && 112 !== c$2)  /*<<scanf.ml:897:15>>*/ return width$7;
+      if(80 !== c$2 && 112 !== c$2)
+        /*<<scanf.ml:897:15>>*/ return width$7 /*<<scanf.ml:897:15>>*/ ;
        /*<<scanf.ml:894:22>>*/ var
         /*<<scanf.ml:894:22>>*/ width$8 = store_char(width$7, ib, c$2),
        _aq_ = 0 === width$8 ? 1 : 0,
@@ -30074,19 +30437,20 @@
        /*<<scanf.ml:895:26>>*/ if(_ar_)
         /*<<scanf.ml:432:2>>*/ bad_input(cst_not_a_valid_float_in_hexad);
        /*<<scanf.ml:895:56>>*/ return scan_optionally_signed_decimal
-              (width$8, ib);
+              (width$8, ib) /*<<scanf.ml:910:21>>*/ ;
      }
-      /*<<scanf.ml:891:52>>*/ return width$7;
+      /*<<scanf.ml:891:52>>*/ return width$7 /*<<scanf.ml:891:52>>*/ ;
     }
-     /*<<scanf.ml:428:2>>*/ return bad_input(cst_no_dot_or_exponent_part_fo);
+     /*<<scanf.ml:428:2>>*/ return bad_input(cst_no_dot_or_exponent_part_fo) /*<<scanf.ml:910:21>>*/ ;
     /*<<scanf.ml:910:21>>*/ }
    function scan_string(stp, width, ib){
      /*<<scanf.ml:920:2>>*/ var width$0 = width;
      /*<<scanf.ml:921:4>>*/ for(;;){
-     if(0 === width$0)  /*<<scanf.ml:921:22>>*/ return width$0;
+     if(0 === width$0)
+       /*<<scanf.ml:921:22>>*/ return width$0 /*<<scanf.ml:921:22>>*/ ;
       /*<<scanf.ml:922:12>>*/  /*<<scanf.ml:922:12>>*/ var c = peek_char(ib);
       /*<<scanf.ml:923:7>>*/ if(ib[1])
-       /*<<scanf.ml:923:28>>*/ return width$0;
+       /*<<scanf.ml:923:28>>*/ return width$0 /*<<scanf.ml:923:28>>*/ ;
      if(! stp){
        /*<<scanf.ml:928:8>>*/  /*<<scanf.ml:928:8>>*/ var _ad_ = c - 9 | 0;
       a:
@@ -30100,12 +30464,12 @@
        width$0 = width$2;
        continue;
       }
-       /*<<scanf.ml:929:38>>*/ return width$0;
+       /*<<scanf.ml:929:38>>*/ return width$0 /*<<scanf.ml:929:38>>*/ ;
      }
      var c$0 = stp[1];
      if(c === c$0){
        /*<<scanf.ml:237:4>>*/ invalidate_current_char(ib);
-       /*<<scanf.ml:237:4>>*/ return width$0;
+       /*<<scanf.ml:237:4>>*/ return width$0 /*<<scanf.ml:237:4>>*/ ;
      }
       /*<<scanf.ml:926:23>>*/  /*<<scanf.ml:926:23>>*/ var
       width$1 = store_char(width$0, ib, c);
@@ -30115,17 +30479,17 @@
    function hexadecimal_value_of_char(c){
      /*<<scanf.ml:969:2>>*/ return 97 <= c
             ? c - 87 | 0
-            : 65 <= c ? c - 55 | 0 : c - 48 | 0;
+            : 65 <= c ? c - 55 | 0 : c - 48 | 0 /*<<scanf.ml:979:23>>*/ ;
     /*<<scanf.ml:979:23>>*/ }
    function check_next_char(message, width, ib){
      /*<<scanf.ml:995:2>>*/ if(0 === width)
-      /*<<scanf.ml:995:20>>*/ return bad_token_length(message);
+      /*<<scanf.ml:995:20>>*/ return bad_token_length(message) /*<<scanf.ml:998:3>>*/ ;
      /*<<scanf.ml:996:10>>*/  /*<<scanf.ml:996:10>>*/ var c = peek_char(ib);
      /*<<scanf.ml:997:5>>*/ return ib[1]
             ? bad_input
               ( /*<<scanf.ml:421:4>>*/ caml_call2
                 (Stdlib_Printf[4], _f_, message))
-            : c;
+            : c /*<<scanf.ml:998:3>>*/ ;
     /*<<scanf.ml:998:3>>*/ }
    function scan_backslash_char(width, ib){
      /*<<scanf.ml:1005:2>>*/ var c0 = check_next_char(cst_a_Char, width, ib);
@@ -30139,7 +30503,7 @@
           function(param){
             /*<<scanf.ml:1010:6>>*/  /*<<scanf.ml:1010:14>>*/ var
             c = next_char(ib);
-           return 9 < c - 48 >>> 0 ? bad_input_escape(c) : c;
+           return 9 < c - 48 >>> 0 ? bad_input_escape(c) : c /*<<scanf.ml:1013:31>>*/ ;
            /*<<scanf.ml:1013:31>>*/ },
          /*<<scanf.ml:1015:13>>*/ c1$0 = get_digit$0(0),
          /*<<scanf.ml:1016:13>>*/ c2$0 = get_digit$0(0),
@@ -30159,7 +30523,7 @@
             ( /*<<scanf.ml:961:6>>*/ caml_call4
               (Stdlib_Printf[4], _l_, c0, c1$0, c2$0));
        }
-        /*<<scanf.ml:1017:39>>*/ return store_char(width - 2 | 0, ib, _ab_);
+        /*<<scanf.ml:1017:39>>*/ return store_char(width - 2 | 0, ib, _ab_) /*<<scanf.ml:1028:22>>*/ ;
       }
        /*<<scanf.ml:1005:8>>*/  /*<<scanf.ml:1005:8>>*/ var
        switcher = c0 - 92 | 0;
@@ -30178,9 +30542,9 @@
                if(5 < _ac_ - 49 >>> 0) break a;
               }
               else if(6 >= _ac_ - 10 >>> 0) break a;
-               /*<<scanf.ml:1022:53>>*/ return c;
+               /*<<scanf.ml:1022:53>>*/ return c /*<<scanf.ml:1022:53>>*/ ;
              }
-              /*<<scanf.ml:1023:13>>*/ return bad_input_escape(c);
+              /*<<scanf.ml:1023:13>>*/ return bad_input_escape(c) /*<<scanf.ml:1023:31>>*/ ;
              /*<<scanf.ml:1023:31>>*/ },
            /*<<scanf.ml:1024:13>>*/ c1 = get_digit(0),
            /*<<scanf.ml:1025:13>>*/ c2 = get_digit(0),
@@ -30198,7 +30562,7 @@
               ( /*<<scanf.ml:988:6>>*/ caml_call3
                 (Stdlib_Printf[4], _m_, c1, c2));
          }
-          /*<<scanf.ml:1026:39>>*/ return store_char(width - 2 | 0, ib, _aa_);
+          /*<<scanf.ml:1026:39>>*/ return store_char(width - 2 | 0, ib, _aa_) /*<<scanf.ml:1028:22>>*/ ;
         case 0:
         case 6:
         case 18:
@@ -30224,16 +30588,17 @@
       else if(98 === c0){var _$_ = 8; break b;}
       var _$_ = c0;
      }
-      /*<<scanf.ml:1007:33>>*/ return store_char(width, ib, _$_);
+      /*<<scanf.ml:1007:33>>*/ return store_char(width, ib, _$_) /*<<scanf.ml:1028:22>>*/ ;
     }
-     /*<<scanf.ml:1028:4>>*/ return bad_input_escape(c0);
+     /*<<scanf.ml:1028:4>>*/ return bad_input_escape(c0) /*<<scanf.ml:1028:22>>*/ ;
     /*<<scanf.ml:1028:22>>*/ }
    function scan_caml_string(width, ib){
     function find_stop$0(counter, width){
       /*<<scanf.ml:1063:4>>*/ var width$0 = width;
       /*<<scanf.ml:1063:4>>*/ for(;;){
       var c = check_next_char(cst_a_String, width$0, ib);
-      if(34 === c)  /*<<scanf.ml:1057:2>>*/ return ignore_char(width$0, ib);
+      if(34 === c)
+        /*<<scanf.ml:1057:2>>*/ return ignore_char(width$0, ib) /*<<scanf.ml:1066:53>>*/ ;
       if(92 === c){
         /*<<scanf.ml:1065:29>>*/ var
          /*<<scanf.ml:1065:29>>*/ width$1 = ignore_char(width$0, ib),
@@ -30243,9 +30608,9 @@
          _Y_ = ignore_char(width$1, ib);
          /*<<scanf.ml:1071:26>>*/ if(counter >= 50)
           /*<<scanf.ml:1071:26>>*/ return  /*<<scanf.ml:1071:26>>*/ caml_trampoline_return
-                 (skip_spaces, [0, _Y_]);
+                 (skip_spaces, [0, _Y_]) /*<<scanf.ml:1066:53>>*/ ;
         var counter$0 = counter + 1 | 0;
-         /*<<scanf.ml:1071:26>>*/ return skip_spaces(counter$0, _Y_);
+         /*<<scanf.ml:1071:26>>*/ return skip_spaces(counter$0, _Y_) /*<<scanf.ml:1066:53>>*/ ;
        }
        if(13 === match){
          /*<<scanf.ml:1070:27>>*/  /*<<scanf.ml:1070:27>>*/ var
@@ -30255,9 +30620,9 @@
           _Z_ = ignore_char(width$3, ib);
           /*<<scanf.ml:1076:26>>*/ if(counter >= 50)
            /*<<scanf.ml:1076:26>>*/ return  /*<<scanf.ml:1076:26>>*/ caml_trampoline_return
-                  (skip_spaces, [0, _Z_]);
+                  (skip_spaces, [0, _Z_]) /*<<scanf.ml:1066:53>>*/ ;
          var counter$1 = counter + 1 | 0;
-          /*<<scanf.ml:1076:26>>*/ return skip_spaces(counter$1, _Z_);
+          /*<<scanf.ml:1076:26>>*/ return skip_spaces(counter$1, _Z_) /*<<scanf.ml:1066:53>>*/ ;
         }
          /*<<scanf.ml:1077:21>>*/  /*<<scanf.ml:1077:21>>*/ var
          width$5 = store_char(width$3, ib, 13);
@@ -30285,9 +30650,9 @@
       if(32 !== check_next_char(cst_a_String, width$0, ib)){
         /*<<scanf.ml:1082:11>>*/ if(counter >= 50)
          /*<<scanf.ml:1082:11>>*/ return  /*<<scanf.ml:1082:11>>*/ caml_trampoline_return
-                (find_stop$0, [0, width$0]);
+                (find_stop$0, [0, width$0]) /*<<scanf.ml:1082:26>>*/ ;
        var counter$0 = counter + 1 | 0;
-        /*<<scanf.ml:1082:11>>*/ return find_stop$0(counter$0, width$0);
+        /*<<scanf.ml:1082:11>>*/ return find_stop$0(counter$0, width$0) /*<<scanf.ml:1082:26>>*/ ;
       }
        /*<<scanf.ml:1081:25>>*/  /*<<scanf.ml:1081:25>>*/ var
        width$1 = ignore_char(width$0, ib);
@@ -30298,7 +30663,7 @@
      c = checked_peek_char(ib);
     return 34 === c
             ? find_stop(ignore_char(width, ib))
-            : character_mismatch(34, c);
+            : character_mismatch(34, c) /*<<scanf.ml:1084:18>>*/ ;
     /*<<scanf.ml:1084:18>>*/ }
    function scan_chars_in_char_set(char_set, scan_indic, width, ib){
     function scan_chars(i, stp){
@@ -30327,14 +30692,15 @@
       i$0 = i$1;
      }
      /*<<scanf.ml:1109:28>>*/ }
-    if(! scan_indic)  /*<<scanf.ml:1111:12>>*/ return scan_chars(width, -1);
+    if(! scan_indic)
+      /*<<scanf.ml:1111:12>>*/ return scan_chars(width, -1) /*<<scanf.ml:1118:34>>*/ ;
     var c = scan_indic[1];
      /*<<scanf.ml:1113:4>>*/ scan_chars(width, c);
      /*<<scanf.ml:1114:11>>*/  /*<<scanf.ml:1114:11>>*/ var _T_ = 1 - ib[1];
-    if(! _T_)  /*<<scanf.ml:1114:11>>*/ return _T_;
+    if(! _T_)  /*<<scanf.ml:1114:11>>*/ return _T_ /*<<scanf.ml:1114:11>>*/ ;
      /*<<scanf.ml:1115:15>>*/  /*<<scanf.ml:1115:15>>*/ var
      ci = peek_char(ib);
-    return c === ci ? invalidate_current_char(ib) : character_mismatch(c, ci);
+    return c === ci ? invalidate_current_char(ib) : character_mismatch(c, ci) /*<<scanf.ml:1118:34>>*/ ;
     /*<<scanf.ml:1118:34>>*/ }
    function scanf_bad_input(ib, x){
      /*<<?>>*/ if(x[1] === Scan_failure)
@@ -30348,17 +30714,17 @@
      /*<<scanf.ml:1124:12>>*/  /*<<scanf.ml:1124:12>>*/ var
      i = char_count(ib);
      /*<<scanf.ml:1125:14>>*/ return bad_input
-            ( /*<<scanf.ml:1125:14>>*/ caml_call3(Stdlib_Printf[4], _o_, i, s));
+            ( /*<<scanf.ml:1125:14>>*/ caml_call3(Stdlib_Printf[4], _o_, i, s)) /*<<scanf.ml:1125:14>>*/ ;
    }
    function width_of_pad_opt(pad_opt){
      /*<<scanf.ml:1138:31>>*/ if(! pad_opt)
-      /*<<scanf.ml:1139:12>>*/ return Stdlib[19];
+      /*<<scanf.ml:1139:12>>*/ return Stdlib[19] /*<<scanf.ml:1139:12>>*/ ;
     var width = pad_opt[1];
-     /*<<scanf.ml:1140:18>>*/ return width;
+     /*<<scanf.ml:1140:18>>*/ return width /*<<scanf.ml:1140:18>>*/ ;
     /*<<scanf.ml:1140:23>>*/ }
    function stopper_of_formatting_lit(fmting){
      /*<<scanf.ml:1144:2>>*/ if(6 === fmting)
-      /*<<scanf.ml:1144:35>>*/ return _p_;
+      /*<<scanf.ml:1144:35>>*/ return _p_ /*<<scanf.ml:1144:35>>*/ ;
      /*<<scanf.ml:1145:14>>*/ var
       /*<<scanf.ml:1145:14>>*/ str =
         /*<<scanf.ml:1145:14>>*/ caml_call1(CamlinternalFormat[17], fmting),
@@ -30370,14 +30736,14 @@
          str,
          2,
           /*<<scanf.ml:1147:4>>*/ caml_ml_string_length(str) - 2 | 0);
-     /*<<scanf.ml:1148:4>>*/ return [0, stp, sub_str];
+     /*<<scanf.ml:1148:4>>*/ return [0, stp, sub_str] /*<<scanf.ml:1148:4>>*/ ;
     /*<<scanf.ml:1148:16>>*/ }
    function take_format_readers$0(counter, k, fmt){
      /*<<scanf.ml:1161:13>>*/ var fmt$0 = fmt;
      /*<<scanf.ml:1161:13>>*/ for(;;){
      if(typeof fmt$0 === "number")
        /*<<scanf.ml:1198:40>>*/ return  /*<<scanf.ml:1198:40>>*/ caml_call1
-              (k, 0);
+              (k, 0) /*<<scanf.ml:1198:45>>*/ ;
      switch(fmt$0[0]){
        case 0:
         var rest = fmt$0[1]; fmt$0 = rest; break;
@@ -30418,10 +30784,10 @@
             (CamlinternalFormatBasics[2], _Q_);
          /*<<scanf.ml:1195:5>>*/ if(counter >= 50)
           /*<<scanf.ml:1195:5>>*/ return  /*<<scanf.ml:1195:5>>*/ caml_trampoline_return
-                 (take_fmtty_format_readers$0, [0, k, _R_, rest$13]);
+                 (take_fmtty_format_readers$0, [0, k, _R_, rest$13]) /*<<scanf.ml:1198:45>>*/ ;
         var counter$0 = counter + 1 | 0;
          /*<<scanf.ml:1195:5>>*/ return take_fmtty_format_readers$0
-                (counter$0, k, _R_, rest$13);
+                (counter$0, k, _R_, rest$13) /*<<scanf.ml:1198:45>>*/ ;
        case 15:
         var rest$14 = fmt$0[1]; fmt$0 = rest$14; break;
        case 16:
@@ -30454,9 +30820,9 @@
          /*<<scanf.ml:1163:4>>*/ return function(reader){
          function new_k(readers_rest){
            /*<<scanf.ml:1164:31>>*/ return  /*<<scanf.ml:1164:33>>*/ caml_call1
-                  (k, [0, reader, readers_rest]);
+                  (k, [0, reader, readers_rest]) /*<<scanf.ml:1164:62>>*/ ;
           /*<<scanf.ml:1164:62>>*/ }
-          /*<<scanf.ml:1165:6>>*/ return take_format_readers(new_k, fmt_rest); /*<<scanf.ml:1165:40>>*/ };
+          /*<<scanf.ml:1165:6>>*/ return take_format_readers(new_k, fmt_rest) /*<<scanf.ml:1165:40>>*/ ; /*<<scanf.ml:1165:40>>*/ } /*<<scanf.ml:1163:4>>*/ ;
        case 20:
         var rest$19 = fmt$0[3]; fmt$0 = rest$19; break;
        case 21:
@@ -30475,10 +30841,10 @@
              /*<<scanf.ml:1236:4>>*/ return function(reader){
              function new_k(readers_rest){
                /*<<scanf.ml:1237:31>>*/ return  /*<<scanf.ml:1237:33>>*/ caml_call1
-                      (k, [0, reader, readers_rest]);
+                      (k, [0, reader, readers_rest]) /*<<scanf.ml:1237:62>>*/ ;
               /*<<scanf.ml:1237:62>>*/ }
               /*<<scanf.ml:1238:6>>*/ return take_format_readers
-                     (new_k, rest$22); /*<<scanf.ml:1238:35>>*/ };
+                     (new_k, rest$22) /*<<scanf.ml:1238:35>>*/ ; /*<<scanf.ml:1238:35>>*/ } /*<<scanf.ml:1236:4>>*/ ;
            default: fmt$0 = rest$22;
          }
         else
@@ -30505,10 +30871,10 @@
             var fmtty$0 = ign[2];
              /*<<scanf.ml:1250:39>>*/ if(counter >= 50)
               /*<<scanf.ml:1250:39>>*/ return  /*<<scanf.ml:1250:39>>*/ caml_trampoline_return
-                     (take_fmtty_format_readers$0, [0, k, fmtty$0, rest$22]);
+                     (take_fmtty_format_readers$0, [0, k, fmtty$0, rest$22]) /*<<scanf.ml:1198:45>>*/ ;
             var counter$1 = counter + 1 | 0;
              /*<<scanf.ml:1250:39>>*/ return take_fmtty_format_readers$0
-                    (counter$1, k, fmtty$0, rest$22);
+                    (counter$1, k, fmtty$0, rest$22) /*<<scanf.ml:1198:45>>*/ ;
            case 10:
             fmt$0 = rest$22; break;
            default: fmt$0 = rest$22;
@@ -30527,10 +30893,10 @@
      if(typeof fmtty$0 === "number"){
        /*<<scanf.ml:1225:35>>*/ if(counter >= 50)
         /*<<scanf.ml:1225:35>>*/ return  /*<<scanf.ml:1225:35>>*/ caml_trampoline_return
-               (take_format_readers$0, [0, k, fmt]);
+               (take_format_readers$0, [0, k, fmt]) /*<<scanf.ml:1228:58>>*/ ;
       var counter$0 = counter + 1 | 0;
        /*<<scanf.ml:1225:35>>*/ return take_format_readers$0
-              (counter$0, k, fmt);
+              (counter$0, k, fmt) /*<<scanf.ml:1228:58>>*/ ;
      }
      switch(fmtty$0[0]){
        case 0:
@@ -30577,19 +30943,19 @@
          /*<<scanf.ml:1206:4>>*/ return function(reader){
          function new_k(readers_rest){
            /*<<scanf.ml:1207:31>>*/ return  /*<<scanf.ml:1207:33>>*/ caml_call1
-                  (k, [0, reader, readers_rest]);
+                  (k, [0, reader, readers_rest]) /*<<scanf.ml:1207:62>>*/ ;
           /*<<scanf.ml:1207:62>>*/ }
           /*<<scanf.ml:1208:6>>*/ return take_fmtty_format_readers
-                 (new_k, fmt_rest, fmt); /*<<scanf.ml:1208:50>>*/ };
+                 (new_k, fmt_rest, fmt) /*<<scanf.ml:1208:50>>*/ ; /*<<scanf.ml:1208:50>>*/ } /*<<scanf.ml:1206:4>>*/ ;
        default:
         var fmt_rest$0 = fmtty$0[1];
          /*<<scanf.ml:1210:4>>*/ return function(reader){
          function new_k(readers_rest){
            /*<<scanf.ml:1211:31>>*/ return  /*<<scanf.ml:1211:33>>*/ caml_call1
-                  (k, [0, reader, readers_rest]);
+                  (k, [0, reader, readers_rest]) /*<<scanf.ml:1211:62>>*/ ;
           /*<<scanf.ml:1211:62>>*/ }
           /*<<scanf.ml:1212:6>>*/ return take_fmtty_format_readers
-                 (new_k, fmt_rest$0, fmt); /*<<scanf.ml:1212:50>>*/ };
+                 (new_k, fmt_rest$0, fmt) /*<<scanf.ml:1212:50>>*/ ; /*<<scanf.ml:1212:50>>*/ } /*<<scanf.ml:1210:4>>*/ ;
      }
     }
     /*<<scanf.ml:1228:58>>*/ }
@@ -30600,7 +30966,8 @@
    function make_scanf(ib, fmt, readers){
      /*<<scanf.ml:1266:22>>*/ var fmt$0 = fmt;
      /*<<scanf.ml:1266:22>>*/ for(;;){
-     if(typeof fmt$0 === "number")  /*<<scanf.ml:1418:4>>*/ return 0;
+     if(typeof fmt$0 === "number")
+       /*<<scanf.ml:1418:4>>*/ return 0 /*<<scanf.ml:1418:4>>*/ ;
      switch(fmt$0[0]){
        case 0:
         var rest = fmt$0[1];
@@ -30609,7 +30976,7 @@
          c$0 = token_char(ib);
          /*<<scanf.ml:1270:4>>*/ return [0,
                 c$0,
-                make_scanf(ib, rest, readers)];
+                make_scanf(ib, rest, readers)] /*<<scanf.ml:1270:4>>*/ ;
        case 1:
          /*<<scanf.ml:1035:10>>*/ var
          rest$0 = fmt$0[1],
@@ -30619,7 +30986,7 @@
              c = check_next_char(cst_a_Char, width, ib);
             return 39 === c
                     ? ignore_char(width, ib)
-                    : character_mismatch(39, c);
+                    : character_mismatch(39, c) /*<<scanf.ml:1049:36>>*/ ;
             /*<<scanf.ml:1049:36>>*/ },
           /*<<scanf.ml:1035:10>>*/ c = checked_peek_char(ib),
           /*<<scanf.ml:1272:4>>*/ width$0 = 0;
@@ -30639,7 +31006,7 @@
          c$1 = token_char(ib);
          /*<<scanf.ml:1274:4>>*/ return [0,
                 c$1,
-                make_scanf(ib, rest$0, readers)];
+                make_scanf(ib, rest$0, readers)] /*<<scanf.ml:1274:4>>*/ ;
        case 2:
         var pad = fmt$0[1], match = fmt$0[2];
         if(typeof match !== "number")
@@ -30655,11 +31022,11 @@
              scan$0 =
                function(width, param, ib){
                  /*<<scanf.ml:1278:26>>*/ return scan_string
-                        ([0, stp], width, ib);
+                        ([0, stp], width, ib) /*<<scanf.ml:1278:57>>*/ ;
                 /*<<scanf.ml:1278:57>>*/ },
               /*<<scanf.ml:1279:19>>*/ str_rest = [11, str, rest$2];
              /*<<scanf.ml:1280:4>>*/ return pad_prec_scanf
-                    (ib, str_rest, readers, pad, 0, scan$0, token_string);
+                    (ib, str_rest, readers, pad, 0, scan$0, token_string) /*<<scanf.ml:1418:7>>*/ ;
            case 18:
             var _D_ = match[1];
             if(0 === _D_[0]){
@@ -30668,7 +31035,7 @@
               fmt$1 = _D_[1][1],
                /*<<scanf.ml:1282:4>>*/ scan$1 =
                 function(width, param, ib){
-                  /*<<scanf.ml:1282:26>>*/ return scan_string(_q_, width, ib);
+                  /*<<scanf.ml:1282:26>>*/ return scan_string(_q_, width, ib) /*<<scanf.ml:1282:57>>*/ ;
                  /*<<scanf.ml:1282:57>>*/ };
               /*<<scanf.ml:1283:4>>*/ return pad_prec_scanf
                      (ib,
@@ -30678,14 +31045,14 @@
                       pad,
                       0,
                       scan$1,
-                      token_string);
+                      token_string) /*<<scanf.ml:1418:7>>*/ ;
             }
              /*<<scanf.ml:1286:4>>*/ var
              rest$4 = match[2],
              fmt$2 = _D_[1][1],
               /*<<scanf.ml:1286:4>>*/ scan$2 =
                function(width, param, ib){
-                 /*<<scanf.ml:1286:26>>*/ return scan_string(_r_, width, ib);
+                 /*<<scanf.ml:1286:26>>*/ return scan_string(_r_, width, ib) /*<<scanf.ml:1286:57>>*/ ;
                 /*<<scanf.ml:1286:57>>*/ };
              /*<<scanf.ml:1287:4>>*/ return pad_prec_scanf
                     (ib,
@@ -30695,26 +31062,26 @@
                      pad,
                      0,
                      scan$2,
-                     token_string);
+                     token_string) /*<<scanf.ml:1418:7>>*/ ;
          }
          /*<<scanf.ml:1290:4>>*/ var
          rest$1 = fmt$0[2],
           /*<<scanf.ml:1290:4>>*/ scan =
            function(width, param, ib){
-             /*<<scanf.ml:1290:26>>*/ return scan_string(0, width, ib);
+             /*<<scanf.ml:1290:26>>*/ return scan_string(0, width, ib) /*<<scanf.ml:1290:51>>*/ ;
             /*<<scanf.ml:1290:51>>*/ };
          /*<<scanf.ml:1291:4>>*/ return pad_prec_scanf
-                (ib, rest$1, readers, pad, 0, scan, token_string);
+                (ib, rest$1, readers, pad, 0, scan, token_string) /*<<scanf.ml:1418:7>>*/ ;
        case 3:
          /*<<scanf.ml:1294:4>>*/ var
          rest$5 = fmt$0[2],
          pad$0 = fmt$0[1],
           /*<<scanf.ml:1294:4>>*/ scan$3 =
            function(width, param, ib){
-             /*<<scanf.ml:1294:26>>*/ return scan_caml_string(width, ib);
+             /*<<scanf.ml:1294:26>>*/ return scan_caml_string(width, ib) /*<<scanf.ml:1294:51>>*/ ;
             /*<<scanf.ml:1294:51>>*/ };
          /*<<scanf.ml:1295:4>>*/ return pad_prec_scanf
-                (ib, rest$5, readers, pad$0, 0, scan$3, token_string);
+                (ib, rest$5, readers, pad$0, 0, scan$3, token_string) /*<<scanf.ml:1418:7>>*/ ;
        case 4:
          /*<<scanf.ml:1297:12>>*/ var
          rest$6 = fmt$0[4],
@@ -30728,7 +31095,7 @@
          scan$4 =
            function(width, param, ib){
              /*<<scanf.ml:1298:26>>*/ return scan_int_conversion
-                    (conv, width, ib);
+                    (conv, width, ib) /*<<scanf.ml:1298:56>>*/ ;
             /*<<scanf.ml:1298:56>>*/ };
          /*<<scanf.ml:1299:49>>*/ return pad_prec_scanf
                 (ib,
@@ -30739,8 +31106,8 @@
                  scan$4,
                  function(ib){
                    /*<<scanf.ml:537:24>>*/ return  /*<<scanf.ml:537:24>>*/ caml_int_of_string
-                          (token_int_literal(conv, ib));
-                 });
+                          (token_int_literal(conv, ib)) /*<<scanf.ml:537:24>>*/ ;
+                 }) /*<<scanf.ml:1418:7>>*/ ;
        case 5:
          /*<<scanf.ml:1301:12>>*/ var
          rest$7 = fmt$0[4],
@@ -30754,7 +31121,7 @@
          scan$5 =
            function(width, param, ib){
              /*<<scanf.ml:1302:26>>*/ return scan_int_conversion
-                    (conv$0, width, ib);
+                    (conv$0, width, ib) /*<<scanf.ml:1302:56>>*/ ;
             /*<<scanf.ml:1302:56>>*/ };
          /*<<scanf.ml:1303:49>>*/ return pad_prec_scanf
                 (ib,
@@ -30765,8 +31132,8 @@
                  scan$5,
                  function(ib){
                    /*<<scanf.ml:558:26>>*/ return  /*<<scanf.ml:558:26>>*/ caml_int_of_string
-                          (token_int_literal(conv$0, ib));
-                 });
+                          (token_int_literal(conv$0, ib)) /*<<scanf.ml:558:26>>*/ ;
+                 }) /*<<scanf.ml:1418:7>>*/ ;
        case 6:
          /*<<scanf.ml:1305:12>>*/ var
          rest$8 = fmt$0[4],
@@ -30780,7 +31147,7 @@
          scan$6 =
            function(width, param, ib){
              /*<<scanf.ml:1306:26>>*/ return scan_int_conversion
-                    (conv$1, width, ib);
+                    (conv$1, width, ib) /*<<scanf.ml:1306:56>>*/ ;
             /*<<scanf.ml:1306:56>>*/ };
          /*<<scanf.ml:1307:49>>*/ return pad_prec_scanf
                 (ib,
@@ -30791,8 +31158,8 @@
                  scan$6,
                  function(ib){
                    /*<<scanf.ml:557:30>>*/ return  /*<<scanf.ml:557:30>>*/ caml_int_of_string
-                          (token_int_literal(conv$1, ib));
-                 });
+                          (token_int_literal(conv$1, ib)) /*<<scanf.ml:557:30>>*/ ;
+                 }) /*<<scanf.ml:1418:7>>*/ ;
        case 7:
          /*<<scanf.ml:1309:12>>*/ var
          rest$9 = fmt$0[4],
@@ -30806,7 +31173,7 @@
          scan$7 =
            function(width, param, ib){
              /*<<scanf.ml:1310:26>>*/ return scan_int_conversion
-                    (conv$2, width, ib);
+                    (conv$2, width, ib) /*<<scanf.ml:1310:56>>*/ ;
             /*<<scanf.ml:1310:56>>*/ };
          /*<<scanf.ml:1311:49>>*/ return pad_prec_scanf
                 (ib,
@@ -30817,8 +31184,8 @@
                  scan$7,
                  function(ib){
                    /*<<scanf.ml:559:26>>*/ return  /*<<scanf.ml:559:26>>*/ runtime.caml_int64_of_string
-                          (token_int_literal(conv$2, ib));
-                 });
+                          (token_int_literal(conv$2, ib)) /*<<scanf.ml:559:26>>*/ ;
+                 }) /*<<scanf.ml:1418:7>>*/ ;
        case 8:
         switch(fmt$0[1][2]){
           case 5:
@@ -30831,7 +31198,7 @@
                     pad$6,
                     prec$4,
                     scan_caml_float,
-                    token_float);
+                    token_float) /*<<scanf.ml:1418:7>>*/ ;
           case 6:
           case 7:
            var rest$12 = fmt$0[4], prec$5 = fmt$0[3], pad$7 = fmt$0[2];
@@ -30842,7 +31209,7 @@
                     pad$7,
                     prec$5,
                     scan_hex_float,
-                    token_float);
+                    token_float) /*<<scanf.ml:1418:7>>*/ ;
           default:
            var rest$10 = fmt$0[4], prec$3 = fmt$0[3], pad$5 = fmt$0[2];
             /*<<scanf.ml:1316:4>>*/ return pad_prec_scanf
@@ -30852,7 +31219,7 @@
                     pad$5,
                     prec$3,
                     scan_float,
-                    token_float);
+                    token_float) /*<<scanf.ml:1418:7>>*/ ;
         }
        case 9:
          /*<<scanf.ml:1320:4>>*/ var
@@ -30871,14 +31238,14 @@
                   : bad_input
                     ( /*<<scanf.ml:1096:8>>*/ caml_call2
                       (Stdlib_Printf[4], _n_, c));
-             /*<<scanf.ml:1097:2>>*/ return scan_string(0, m, ib);
+             /*<<scanf.ml:1097:2>>*/ return scan_string(0, m, ib) /*<<scanf.ml:1320:34>>*/ ;
             /*<<scanf.ml:1320:34>>*/ };
          /*<<scanf.ml:1321:4>>*/ return pad_prec_scanf
-                (ib, rest$13, readers, pad$8, 0, scan$8, token_bool);
+                (ib, rest$13, readers, pad$8, 0, scan$8, token_bool) /*<<scanf.ml:1418:7>>*/ ;
        case 10:
         var rest$14 = fmt$0[1];
          /*<<scanf.ml:1337:7>>*/ if(! end_of_input(ib))
-          /*<<scanf.ml:1338:9>>*/ return bad_input(cst_end_of_input_not_found);
+          /*<<scanf.ml:1338:9>>*/ return bad_input(cst_end_of_input_not_found) /*<<scanf.ml:1418:7>>*/ ;
         fmt$0 = rest$14;
         break;
        case 11:
@@ -30914,7 +31281,7 @@
         }
          /*<<scanf.ml:1354:4>>*/ return [0,
                 fmt$3,
-                make_scanf(ib, rest$17, readers)];
+                make_scanf(ib, rest$17, readers)] /*<<scanf.ml:1354:4>>*/ ;
        case 14:
         var rest$18 = fmt$0[3], fmtty$0 = fmt$0[2], pad_opt$0 = fmt$0[1];
          /*<<scanf.ml:1356:12>>*/ scan_caml_string
@@ -30965,13 +31332,13 @@
                  (ib,
                    /*<<scanf.ml:1379:24>>*/ caml_call2
                    (CamlinternalFormatBasics[3], fmt$5, rest$18),
-                  readers)];
+                  readers)] /*<<scanf.ml:1378:4>>*/ ;
        case 15:
          /*<<scanf.ml:1323:4>>*/ return  /*<<scanf.ml:1323:4>>*/ caml_call1
-                (Stdlib[1], cst_scanf_bad_conversion_a);
+                (Stdlib[1], cst_scanf_bad_conversion_a) /*<<scanf.ml:1418:7>>*/ ;
        case 16:
          /*<<scanf.ml:1325:4>>*/ return  /*<<scanf.ml:1325:4>>*/ caml_call1
-                (Stdlib[1], cst_scanf_bad_conversion_t);
+                (Stdlib[1], cst_scanf_bad_conversion_t) /*<<scanf.ml:1418:7>>*/ ;
        case 17:
          /*<<scanf.ml:1401:32>>*/ var
          rest$19 = fmt$0[2],
@@ -31012,7 +31379,7 @@
         var fmt_rest = fmt$0[1];
          /*<<scanf.ml:1329:4>>*/ if(! readers)
           /*<<scanf.ml:1334:8>>*/ return  /*<<scanf.ml:1334:8>>*/ caml_call1
-                 (Stdlib[1], cst_scanf_missing_reader);
+                 (Stdlib[1], cst_scanf_missing_reader) /*<<scanf.ml:1418:7>>*/ ;
          /*<<scanf.ml:1331:16>>*/ var
          readers_rest = readers[2],
          reader = readers[1],
@@ -31020,7 +31387,7 @@
             /*<<scanf.ml:1331:16>>*/ caml_call1(reader, ib);
          /*<<scanf.ml:1332:8>>*/ return [0,
                 x,
-                make_scanf(ib, fmt_rest, readers_rest)];
+                make_scanf(ib, fmt_rest, readers_rest)] /*<<scanf.ml:1332:8>>*/ ;
        case 20:
         var width_opt = fmt$0[1], match$1 = fmt$0[3];
         if(typeof match$1 !== "number" && 17 === match$1[0]){
@@ -31040,7 +31407,7 @@
            /*<<scanf.ml:1386:19>>*/ str_rest$0 = [11, str$1, rest$23];
           /*<<scanf.ml:1387:4>>*/ return [0,
                  s$2,
-                 make_scanf(ib, str_rest$0, readers)];
+                 make_scanf(ib, str_rest$0, readers)] /*<<scanf.ml:1387:4>>*/ ;
         }
          /*<<scanf.ml:1389:16>>*/ var
          rest$22 = fmt$0[3],
@@ -31052,7 +31419,7 @@
          s$1 = token_string(ib);
          /*<<scanf.ml:1392:4>>*/ return [0,
                 s$1,
-                make_scanf(ib, rest$22, readers)];
+                make_scanf(ib, rest$22, readers)] /*<<scanf.ml:1392:4>>*/ ;
        case 21:
         var rest$24 = fmt$0[2], counter = fmt$0[1];
         switch(counter){
@@ -31064,14 +31431,14 @@
         }
          /*<<scanf.ml:1395:4>>*/ return [0,
                 count,
-                make_scanf(ib, rest$24, readers)];
+                make_scanf(ib, rest$24, readers)] /*<<scanf.ml:1395:4>>*/ ;
        case 22:
          /*<<scanf.ml:1397:12>>*/ var
          rest$25 = fmt$0[1],
           /*<<scanf.ml:1397:12>>*/ c$2 = checked_peek_char(ib);
          /*<<scanf.ml:1398:4>>*/ return [0,
                 c$2,
-                make_scanf(ib, rest$25, readers)];
+                make_scanf(ib, rest$25, readers)] /*<<scanf.ml:1398:4>>*/ ;
        case 23:
          /*<<scanf.ml:1412:16>>*/ var
          rest$26 = fmt$0[2],
@@ -31085,10 +31452,10 @@
           /*<<scanf.ml:1414:13>>*/ throw  /*<<scanf.ml:1414:13>>*/ caml_maybe_attach_backtrace
                 ([0, Assert_failure, _s_], 1);
         var arg_rest = match$3[2];
-         /*<<scanf.ml:1413:28>>*/ return arg_rest;
+         /*<<scanf.ml:1413:28>>*/ return arg_rest /*<<scanf.ml:1413:28>>*/ ;
        default:
          /*<<scanf.ml:1327:4>>*/ return  /*<<scanf.ml:1327:4>>*/ caml_call1
-                (Stdlib[1], cst_scanf_bad_conversion_custo);
+                (Stdlib[1], cst_scanf_bad_conversion_custo) /*<<scanf.ml:1418:7>>*/ ;
      }
     }
     /*<<scanf.ml:1418:7>>*/ }
@@ -31100,23 +31467,23 @@
        (scan, Stdlib[19], p, ib);
        /*<<scanf.ml:1436:12>>*/  /*<<scanf.ml:1436:12>>*/ var
        x$0 =  /*<<scanf.ml:1436:12>>*/ caml_call1(token, ib);
-       /*<<scanf.ml:1437:4>>*/ return [0, x$0, make_scanf(ib, fmt, readers)];
+       /*<<scanf.ml:1437:4>>*/ return [0, x$0, make_scanf(ib, fmt, readers)] /*<<scanf.ml:1437:4>>*/ ;
      }
      if(prec)
        /*<<scanf.ml:1453:4>>*/ return  /*<<scanf.ml:1453:4>>*/ caml_call1
-              (Stdlib[1], cst_scanf_bad_conversion);
+              (Stdlib[1], cst_scanf_bad_conversion) /*<<scanf.ml:1453:46>>*/ ;
       /*<<scanf.ml:1431:12>>*/  /*<<scanf.ml:1431:12>>*/ caml_call3
       (scan, Stdlib[19], Stdlib[19], ib);
       /*<<scanf.ml:1432:12>>*/  /*<<scanf.ml:1432:12>>*/ var
       x =  /*<<scanf.ml:1432:12>>*/ caml_call1(token, ib);
-      /*<<scanf.ml:1433:4>>*/ return [0, x, make_scanf(ib, fmt, readers)];
+      /*<<scanf.ml:1433:4>>*/ return [0, x, make_scanf(ib, fmt, readers)] /*<<scanf.ml:1433:4>>*/ ;
     }
     if(0 !== pad[0])
       /*<<scanf.ml:1451:4>>*/ return  /*<<scanf.ml:1451:4>>*/ caml_call1
-             (Stdlib[1], cst_scanf_bad_conversion$2);
+             (Stdlib[1], cst_scanf_bad_conversion$2) /*<<scanf.ml:1453:46>>*/ ;
     if(! pad[1])
       /*<<scanf.ml:1447:4>>*/ return  /*<<scanf.ml:1447:4>>*/ caml_call1
-             (Stdlib[1], cst_scanf_bad_conversion$1);
+             (Stdlib[1], cst_scanf_bad_conversion$1) /*<<scanf.ml:1453:46>>*/ ;
     var w = pad[2];
     if(typeof prec !== "number"){
      var p$0 = prec[1];
@@ -31124,16 +31491,16 @@
       (scan, w, p$0, ib);
       /*<<scanf.ml:1444:12>>*/  /*<<scanf.ml:1444:12>>*/ var
       x$2 =  /*<<scanf.ml:1444:12>>*/ caml_call1(token, ib);
-      /*<<scanf.ml:1445:4>>*/ return [0, x$2, make_scanf(ib, fmt, readers)];
+      /*<<scanf.ml:1445:4>>*/ return [0, x$2, make_scanf(ib, fmt, readers)] /*<<scanf.ml:1445:4>>*/ ;
     }
     if(prec)
       /*<<scanf.ml:1449:4>>*/ return  /*<<scanf.ml:1449:4>>*/ caml_call1
-             (Stdlib[1], cst_scanf_bad_conversion$0);
+             (Stdlib[1], cst_scanf_bad_conversion$0) /*<<scanf.ml:1453:46>>*/ ;
      /*<<scanf.ml:1439:12>>*/  /*<<scanf.ml:1439:12>>*/ caml_call3
      (scan, w, Stdlib[19], ib);
      /*<<scanf.ml:1440:12>>*/  /*<<scanf.ml:1440:12>>*/ var
      x$1 =  /*<<scanf.ml:1440:12>>*/ caml_call1(token, ib);
-     /*<<scanf.ml:1441:4>>*/ return [0, x$1, make_scanf(ib, fmt, readers)];
+     /*<<scanf.ml:1441:4>>*/ return [0, x$1, make_scanf(ib, fmt, readers)] /*<<scanf.ml:1441:4>>*/ ;
     /*<<scanf.ml:1453:46>>*/ }
    function kscanf_gen(ib, ef, af, param){
     var str = param[2], fmt = param[1];
@@ -31159,16 +31526,16 @@
          /*<<scanf.ml:1470:20>>*/ _C_ =
            /*<<scanf.ml:1470:20>>*/ caml_call2(Stdlib[28], msg, _B_);
         /*<<scanf.ml:1470:20>>*/ return  /*<<scanf.ml:1470:20>>*/ caml_call1
-               (Stdlib[1], _C_);
+               (Stdlib[1], _C_) /*<<scanf.ml:1472:25>>*/ ;
       }
        /*<<scanf.ml:1468:8>>*/ return  /*<<scanf.ml:1468:8>>*/ caml_call2
-              (ef, ib, exc);
+              (ef, ib, exc) /*<<scanf.ml:1472:25>>*/ ;
      }
      var f = f$1, args = args$1;
       /*<<scanf.ml:1460:18>>*/ for(;;){
       if(! args)
         /*<<scanf.ml:1472:11>>*/ return  /*<<scanf.ml:1472:11>>*/ caml_call1
-               (af, f);
+               (af, f) /*<<scanf.ml:1472:25>>*/ ;
        /*<<scanf.ml:1461:27>>*/ var
        args$0 = args[2],
        x = args[1],
@@ -31178,49 +31545,49 @@
       args = args$0;
      }
      /*<<scanf.ml:1472:25>>*/ }
-     /*<<scanf.ml:1474:2>>*/ return take_format_readers(k, fmt);
+     /*<<scanf.ml:1474:2>>*/ return take_format_readers(k, fmt) /*<<scanf.ml:1474:2>>*/ ;
    }
    function kscanf(ib, ef, fmt){
      /*<<scanf.ml:1477:2>>*/ return kscanf_gen
             (ib,
              ef,
              function(x){
-               /*<<scanf.ml:1477:29>>*/ return x;
+               /*<<scanf.ml:1477:29>>*/ return x /*<<scanf.ml:1477:29>>*/ ;
               /*<<scanf.ml:1477:30>>*/ },
-             fmt);
+             fmt) /*<<scanf.ml:1477:35>>*/ ;
     /*<<scanf.ml:1477:35>>*/ }
    function kscanf_opt(ib, fmt){
      /*<<scanf.ml:1480:2>>*/ return kscanf_gen
             (ib,
              function(_y_, param){
-               /*<<scanf.ml:1480:28>>*/ return 0;
+               /*<<scanf.ml:1480:28>>*/ return 0 /*<<scanf.ml:1480:28>>*/ ;
               /*<<scanf.ml:1480:32>>*/ },
              function(x){
-               /*<<scanf.ml:1480:44>>*/ return [0, x];
+               /*<<scanf.ml:1480:44>>*/ return [0, x] /*<<scanf.ml:1480:44>>*/ ;
               /*<<scanf.ml:1480:50>>*/ },
-             fmt);
+             fmt) /*<<scanf.ml:1480:55>>*/ ;
     /*<<scanf.ml:1480:55>>*/ }
    function bscanf(ib, fmt){
-     /*<<scanf.ml:1485:20>>*/ return kscanf(ib, scanf_bad_input, fmt);
+     /*<<scanf.ml:1485:20>>*/ return kscanf(ib, scanf_bad_input, fmt) /*<<scanf.ml:1485:50>>*/ ;
     /*<<scanf.ml:1485:50>>*/ }
    function bscanf_opt(ib, fmt){
-     /*<<scanf.ml:1486:24>>*/ return kscanf_opt(ib, fmt);
+     /*<<scanf.ml:1486:24>>*/ return kscanf_opt(ib, fmt) /*<<scanf.ml:1486:41>>*/ ;
     /*<<scanf.ml:1486:41>>*/ }
    function ksscanf(s, ef, fmt){
-     /*<<scanf.ml:1488:23>>*/ return kscanf(from_string(s), ef, fmt);
+     /*<<scanf.ml:1488:23>>*/ return kscanf(from_string(s), ef, fmt) /*<<scanf.ml:1488:62>>*/ ;
     /*<<scanf.ml:1488:62>>*/ }
    function sscanf(s, fmt){
      /*<<scanf.ml:1489:19>>*/ return kscanf
-            (from_string(s), scanf_bad_input, fmt);
+            (from_string(s), scanf_bad_input, fmt) /*<<scanf.ml:1489:71>>*/ ;
     /*<<scanf.ml:1489:71>>*/ }
    function sscanf_opt(s, fmt){
-     /*<<scanf.ml:1490:23>>*/ return kscanf_opt(from_string(s), fmt);
+     /*<<scanf.ml:1490:23>>*/ return kscanf_opt(from_string(s), fmt) /*<<scanf.ml:1490:62>>*/ ;
     /*<<scanf.ml:1490:62>>*/ }
    function scanf(fmt){
-     /*<<scanf.ml:1492:16>>*/ return kscanf(stdin, scanf_bad_input, fmt);
+     /*<<scanf.ml:1492:16>>*/ return kscanf(stdin, scanf_bad_input, fmt) /*<<scanf.ml:1492:57>>*/ ;
     /*<<scanf.ml:1492:57>>*/ }
    function scanf_opt(fmt){
-     /*<<scanf.ml:1493:20>>*/ return kscanf_opt(stdin, fmt);
+     /*<<scanf.ml:1493:20>>*/ return kscanf_opt(stdin, fmt) /*<<scanf.ml:1493:49>>*/ ;
     /*<<scanf.ml:1493:49>>*/ }
    function bscanf_format(ib, format, f){
      /*<<scanf.ml:1502:4>>*/ scan_caml_string(Stdlib[19], ib);
@@ -31239,10 +31606,10 @@
      var msg = exn[2], fmt = bad_input(msg);
     }
      /*<<scanf.ml:1507:4>>*/ return  /*<<scanf.ml:1507:4>>*/ caml_call1
-            (f, fmt);
+            (f, fmt) /*<<scanf.ml:1507:10>>*/ ;
     /*<<scanf.ml:1507:10>>*/ }
    function sscanf_format(s, format, f){
-     /*<<scanf.ml:1513:20>>*/ return bscanf_format(from_string(s), format, f);
+     /*<<scanf.ml:1513:20>>*/ return bscanf_format(from_string(s), format, f) /*<<scanf.ml:1513:67>>*/ ;
     /*<<scanf.ml:1513:67>>*/ }
    function format_from_string(s, fmt){
      /*<<scanf.ml:1517:2>>*/ var
@@ -31254,8 +31621,8 @@
             ( /*<<scanf.ml:1517:16>>*/ caml_call2(Stdlib[28], cst$2, _w_),
              fmt,
              function(x){
-               /*<<scanf.ml:1517:63>>*/ return x;
-              /*<<scanf.ml:1517:64>>*/ });
+               /*<<scanf.ml:1517:63>>*/ return x /*<<scanf.ml:1517:63>>*/ ;
+              /*<<scanf.ml:1517:64>>*/ }) /*<<scanf.ml:1517:65>>*/ ;
     /*<<scanf.ml:1517:65>>*/ }
    function unescaped(s){
      /*<<scanf.ml:1521:2>>*/  /*<<scanf.ml:1521:17>>*/ var
@@ -31265,8 +31632,8 @@
               ( /*<<scanf.ml:1521:9>>*/ caml_call2(Stdlib[28], cst$4, _u_),
                _t_),
              function(x){
-               /*<<scanf.ml:1521:44>>*/ return x;
-              /*<<scanf.ml:1521:45>>*/ });
+               /*<<scanf.ml:1521:44>>*/ return x /*<<scanf.ml:1521:44>>*/ ;
+              /*<<scanf.ml:1521:45>>*/ }) /*<<scanf.ml:1521:46>>*/ ;
     /*<<scanf.ml:1521:46>>*/ }
    var
     Stdlib_Scanf =
@@ -31321,7 +31688,7 @@
         ? exn
         : exn[1];
      /*<<callback.ml:27:2>>*/ return  /*<<callback.ml:27:2>>*/ caml_register_named_value
-            (name, slot);
+            (name, slot) /*<<callback.ml:27:32>>*/ ;
     /*<<callback.ml:27:32>>*/ }
    var Stdlib_Callback = [0, register, register_exception];
    runtime.caml_register_global(1, Stdlib_Callback, "Stdlib__Callback");
@@ -31379,7 +31746,7 @@
      /*<<camlinternalOO.ml:23:2>>*/  /*<<camlinternalOO.ml:23:19>>*/ var
      o$0 =  /*<<camlinternalOO.ml:23:19>>*/ o.slice();
      /*<<camlinternalOO.ml:24:2>>*/ return  /*<<camlinternalOO.ml:24:2>>*/ caml_set_oo_id
-            (o$0);
+            (o$0) /*<<camlinternalOO.ml:24:10>>*/ ;
     /*<<camlinternalOO.ml:24:10>>*/ }
     /*<<camlinternalOO.ml:36:13>>*/  /*<<camlinternalOO.ml:36:13>>*/ var
     params = [0, 1, 1, 1, 3, 16];
@@ -31402,7 +31769,7 @@
     }
     accu[1] = accu[1] & 2147483647;
     var tag = 1073741823 < accu[1] ? accu[1] + 2147483648 | 0 : accu[1];
-     /*<<camlinternalOO.ml:78:2>>*/ return tag;
+     /*<<camlinternalOO.ml:78:2>>*/ return tag /*<<camlinternalOO.ml:78:2>>*/ ;
     /*<<camlinternalOO.ml:78:15>>*/ }
     /*<<camlinternalOO.ml:107:2>>*/ var
     compare = caml_string_compare,
@@ -31420,7 +31787,7 @@
    function fit_size(n){
      /*<<camlinternalOO.ml:124:2>>*/ return 2 < n
             ? fit_size((n + 1 | 0) / 2 | 0) * 2 | 0
-            : n;
+            : n /*<<camlinternalOO.ml:125:24>>*/ ;
     /*<<camlinternalOO.ml:125:24>>*/ }
    function new_table(pub_labels){
      /*<<camlinternalOO.ml:128:2>>*/ table_count[1]++;
@@ -31467,7 +31834,7 @@
             0,
             0,
             Vars[1],
-            0];
+            0] /*<<camlinternalOO.ml:134:2>>*/ ;
     /*<<camlinternalOO.ml:141:32>>*/ }
    function resize(array, new_size){
      /*<<camlinternalOO.ml:144:2>>*/ var
@@ -31499,14 +31866,14 @@
    function new_method(table){
      /*<<camlinternalOO.ml:164:2>>*/ var index = table[2].length - 1;
      /*<<camlinternalOO.ml:165:2>>*/ resize(table, index + 1 | 0);
-     /*<<camlinternalOO.ml:165:2>>*/ return index;
+     /*<<camlinternalOO.ml:165:2>>*/ return index /*<<camlinternalOO.ml:165:2>>*/ ;
     /*<<camlinternalOO.ml:166:7>>*/ }
    function get_method_label(table, name){
      /*<<camlinternalOO.ml:169:2>>*/ try{
       /*<<camlinternalOO.ml:170:4>>*/  /*<<camlinternalOO.ml:170:4>>*/ var
       _$_ =
          /*<<camlinternalOO.ml:170:4>>*/ caml_call2(Meths[17], name, table[3]);
-      /*<<camlinternalOO.ml:170:4>>*/ return _$_;
+      /*<<camlinternalOO.ml:170:4>>*/ return _$_ /*<<camlinternalOO.ml:170:4>>*/ ;
     }
     catch(_aa_){
      var ___ = caml_wrap_exception(_aa_);
@@ -31519,14 +31886,14 @@
      table[4] =
        /*<<camlinternalOO.ml:174:30>>*/ caml_call3
        (Labs[2], label, 1, table[4]);
-      /*<<camlinternalOO.ml:175:4>>*/ return label;
+      /*<<camlinternalOO.ml:175:4>>*/ return label /*<<camlinternalOO.ml:175:4>>*/ ;
     }
     /*<<camlinternalOO.ml:175:9>>*/ }
    function get_method_labels(table, names){
      /*<<camlinternalOO.ml:178:2>>*/ return  /*<<camlinternalOO.ml:178:2>>*/ caml_call2
             (Stdlib_Array[14],
              function(_Z_){ /*<<?>>*/ return get_method_label(table, _Z_);},
-             names);
+             names) /*<<camlinternalOO.ml:178:42>>*/ ;
     /*<<camlinternalOO.ml:178:42>>*/ }
    function set_method(table, label, element){
      /*<<camlinternalOO.ml:181:2>>*/ method_count[1]++;
@@ -31536,7 +31903,7 @@
                (table, label + 1 | 0),
               caml_check_bound(table[2], label)[1 + label] = element,
               0)
-            : (table[6] = [0, [0, label, element], table[6]], 0);
+            : (table[6] = [0, [0, label, element], table[6]], 0) /*<<camlinternalOO.ml:185:64>>*/ ;
     /*<<camlinternalOO.ml:185:64>>*/ }
    function get_method(table, label){
      /*<<camlinternalOO.ml:188:2>>*/ try{
@@ -31544,14 +31911,14 @@
       _X_ =
          /*<<camlinternalOO.ml:188:6>>*/ caml_call2
          (Stdlib_List[49], label, table[6]);
-      /*<<camlinternalOO.ml:188:6>>*/ return _X_;
+      /*<<camlinternalOO.ml:188:6>>*/ return _X_ /*<<camlinternalOO.ml:188:6>>*/ ;
     }
     catch(_Y_){
      var _W_ = caml_wrap_exception(_Y_);
      if(_W_ === Stdlib[8])
        /*<<camlinternalOO.ml:189:20>>*/ return caml_check_bound
                (table[2], label)
-              [1 + label];
+              [1 + label] /*<<camlinternalOO.ml:189:20>>*/ ;
      throw caml_maybe_attach_backtrace(_W_, 0);
     }
     /*<<camlinternalOO.ml:189:41>>*/ }
@@ -31559,7 +31926,7 @@
      /*<<camlinternalOO.ml:192:2>>*/ return 0 === arr
             ? 0
             :  /*<<camlinternalOO.ml:192:37>>*/ caml_call1
-              (Stdlib_Array[10], arr);
+              (Stdlib_Array[10], arr) /*<<camlinternalOO.ml:192:54>>*/ ;
     /*<<camlinternalOO.ml:192:54>>*/ }
    function narrow(table, vars, virt_meths, concr_meths){
      /*<<camlinternalOO.ml:195:2>>*/ var
@@ -31588,7 +31955,7 @@
                  (Stdlib_List[37], lab, vars$0)
                 ?  /*<<camlinternalOO.ml:207:34>>*/ caml_call3
                   (Vars[2], lab, info, tvars)
-                : tvars;
+                : tvars /*<<camlinternalOO.ml:207:68>>*/ ;
         /*<<camlinternalOO.ml:207:68>>*/ },
        table[7],
        Vars[1]);
@@ -31643,7 +32010,7 @@
          /*<<camlinternalOO.ml:229:13>>*/ return  /*<<camlinternalOO.ml:229:13>>*/ caml_call2
                  (Stdlib_List[37], lab, virt_meth_labs)
                 ? hm
-                : [0, met, hm];
+                : [0, met, hm] /*<<camlinternalOO.ml:229:62>>*/ ;
         /*<<camlinternalOO.ml:229:62>>*/ },
        table[6],
        0);
@@ -31669,7 +32036,7 @@
          _O_ =
             /*<<camlinternalOO.ml:240:30>>*/ caml_call2(Vars[17], v, table[7]);
          /*<<camlinternalOO.ml:240:19>>*/ return  /*<<camlinternalOO.ml:240:19>>*/ caml_call3
-                (Vars[2], v, _O_, s);
+                (Vars[2], v, _O_, s) /*<<camlinternalOO.ml:240:56>>*/ ;
         /*<<camlinternalOO.ml:240:56>>*/ },
        saved_vars,
        vars);
@@ -31683,7 +32050,7 @@
          /*<<camlinternalOO.ml:247:13>>*/ return  /*<<camlinternalOO.ml:247:13>>*/ caml_call2
                  (Stdlib_List[37], lab, virt_meths)
                 ? hm
-                : [0, met, hm];
+                : [0, met, hm] /*<<camlinternalOO.ml:247:58>>*/ ;
         /*<<camlinternalOO.ml:247:58>>*/ },
        table[6],
        saved_hidden_meths);
@@ -31694,7 +32061,7 @@
       /*<<camlinternalOO.ml:257:6>>*/  /*<<camlinternalOO.ml:257:6>>*/ var
       _M_ =
          /*<<camlinternalOO.ml:257:6>>*/ caml_call2(Vars[17], name, table[7]);
-      /*<<camlinternalOO.ml:257:6>>*/ return _M_;
+      /*<<camlinternalOO.ml:257:6>>*/ return _M_ /*<<camlinternalOO.ml:257:6>>*/ ;
     }
     catch(_N_){
      var _L_ = caml_wrap_exception(_N_);
@@ -31705,14 +32072,14 @@
       table[7] =
         /*<<camlinternalOO.ml:260:37>>*/ caml_call3
         (Vars[2], name, index, table[7]);
-      /*<<camlinternalOO.ml:261:4>>*/ return index;
+      /*<<camlinternalOO.ml:261:4>>*/ return index /*<<camlinternalOO.ml:261:4>>*/ ;
     }
     /*<<camlinternalOO.ml:261:9>>*/ }
    function to_array(arr){
      /*<<camlinternalOO.ml:264:2>>*/ return  /*<<camlinternalOO.ml:264:5>>*/ runtime.caml_equal
              (arr, 0)
             ? [0]
-            : arr;
+            : arr /*<<camlinternalOO.ml:264:41>>*/ ;
     /*<<camlinternalOO.ml:264:41>>*/ }
    function new_methods_variables(table, meths, vals){
      /*<<camlinternalOO.ml:267:2>>*/ var
@@ -31752,14 +32119,14 @@
       i = _I_;
      }
     }
-     /*<<camlinternalOO.ml:276:2>>*/ return res;
+     /*<<camlinternalOO.ml:276:2>>*/ return res /*<<camlinternalOO.ml:276:2>>*/ ;
     /*<<camlinternalOO.ml:276:5>>*/ }
    function get_variable(table, name){
      /*<<camlinternalOO.ml:279:2>>*/ try{
       /*<<camlinternalOO.ml:279:6>>*/  /*<<camlinternalOO.ml:279:6>>*/ var
       _A_ =
          /*<<camlinternalOO.ml:279:6>>*/ caml_call2(Vars[17], name, table[7]);
-      /*<<camlinternalOO.ml:279:6>>*/ return _A_;
+      /*<<camlinternalOO.ml:279:6>>*/ return _A_ /*<<camlinternalOO.ml:279:6>>*/ ;
     }
     catch(_B_){
      var _z_ = caml_wrap_exception(_B_);
@@ -31773,7 +32140,7 @@
      /*<<camlinternalOO.ml:282:2>>*/ return  /*<<camlinternalOO.ml:282:2>>*/ caml_call2
             (Stdlib_Array[14],
              function(_y_){ /*<<?>>*/ return get_variable(table, _y_);},
-             names);
+             names) /*<<camlinternalOO.ml:282:38>>*/ ;
     /*<<camlinternalOO.ml:282:38>>*/ }
    function add_initializer(table, f){
      /*<<camlinternalOO.ml:285:2>>*/ table[8] = [0, f, table[8]];
@@ -31781,7 +32148,7 @@
     /*<<camlinternalOO.ml:285:45>>*/ }
    function create_table(public_methods){
      /*<<camlinternalOO.ml:299:2>>*/ if(0 === public_methods)
-      /*<<camlinternalOO.ml:299:50>>*/ return new_table([0]);
+      /*<<camlinternalOO.ml:299:50>>*/ return new_table([0]) /*<<camlinternalOO.ml:309:7>>*/ ;
      /*<<camlinternalOO.ml:301:13>>*/ var
       /*<<camlinternalOO.ml:301:13>>*/ tags =
         /*<<camlinternalOO.ml:301:13>>*/ caml_call2
@@ -31800,7 +32167,7 @@
        return 0;
        /*<<camlinternalOO.ml:307:72>>*/ },
       public_methods);
-     /*<<camlinternalOO.ml:303:2>>*/ return table;
+     /*<<camlinternalOO.ml:303:2>>*/ return table /*<<camlinternalOO.ml:303:2>>*/ ;
     /*<<camlinternalOO.ml:309:7>>*/ }
    function init_class(table){
      /*<<camlinternalOO.ml:312:2>>*/ inst_var_count[1] =
@@ -31811,7 +32178,7 @@
      _x_ = Stdlib_Sys[9];
     return resize
             (table,
-             3 + caml_div(caml_check_bound(table[2], 1)[2] * 16 | 0, _x_) | 0);
+             3 + caml_div(caml_check_bound(table[2], 1)[2] * 16 | 0, _x_) | 0) /*<<camlinternalOO.ml:314:69>>*/ ;
     /*<<camlinternalOO.ml:314:69>>*/ }
    function inherits(cla, vals, virt_meths, concr_meths, param, top){
     var env = param[4], super$0 = param[2];
@@ -31831,7 +32198,7 @@
          (Stdlib_Array[14],
           function(nm){
             /*<<camlinternalOO.ml:325:18>>*/ return get_method
-                   (cla, get_method_label(cla, nm));
+                   (cla, get_method_label(cla, nm)) /*<<camlinternalOO.ml:325:79>>*/ ;
            /*<<camlinternalOO.ml:325:79>>*/ },
           _s_),
         0],
@@ -31846,7 +32213,7 @@
            _u_),
          _t_]];
      /*<<camlinternalOO.ml:322:4>>*/ return  /*<<camlinternalOO.ml:322:4>>*/ caml_call1
-            (Stdlib_Array[5], _v_);
+            (Stdlib_Array[5], _v_) /*<<camlinternalOO.ml:322:4>>*/ ;
    }
    function make_class(pub_meths, class_init){
      /*<<camlinternalOO.ml:329:2>>*/ var
@@ -31858,7 +32225,7 @@
              /*<<camlinternalOO.ml:332:3>>*/ caml_call1(env_init, 0),
             class_init,
             env_init,
-            0];
+            0] /*<<camlinternalOO.ml:332:2>>*/ ;
     /*<<camlinternalOO.ml:332:59>>*/ }
    function make_class_store(pub_meths, class_init, init_table){
      /*<<camlinternalOO.ml:338:2>>*/ var
@@ -31875,7 +32242,7 @@
       /*<<camlinternalOO.ml:345:23>>*/ throw  /*<<camlinternalOO.ml:345:23>>*/ caml_maybe_attach_backtrace
             ([0, Stdlib[15], loc], 1);
      /*<<camlinternalOO.ml:345:61>>*/ }
-     /*<<camlinternalOO.ml:346:2>>*/ return [0, undef, undef, undef, 0];
+     /*<<camlinternalOO.ml:346:2>>*/ return [0, undef, undef, undef, 0] /*<<camlinternalOO.ml:346:2>>*/ ;
     /*<<camlinternalOO.ml:346:45>>*/ }
    function create_object(table){
      /*<<camlinternalOO.ml:352:2>>*/  /*<<camlinternalOO.ml:352:12>>*/ var
@@ -31884,23 +32251,24 @@
         (Stdlib_Obj[10], table[1]);
      /*<<camlinternalOO.ml:354:2>>*/ obj[1] = table[2];
      /*<<camlinternalOO.ml:355:10>>*/ return  /*<<camlinternalOO.ml:355:10>>*/ caml_set_oo_id
-            (obj);
+            (obj) /*<<camlinternalOO.ml:355:22>>*/ ;
     /*<<camlinternalOO.ml:355:22>>*/ }
    function create_object_opt(obj_0, table){
      /*<<camlinternalOO.ml:358:2>>*/ if(obj_0)
-      /*<<camlinternalOO.ml:358:35>>*/ return obj_0;
+      /*<<camlinternalOO.ml:358:35>>*/ return obj_0 /*<<camlinternalOO.ml:358:35>>*/ ;
      /*<<camlinternalOO.ml:360:14>>*/  /*<<camlinternalOO.ml:360:14>>*/ var
      obj =
         /*<<camlinternalOO.ml:360:14>>*/ caml_obj_block
         (Stdlib_Obj[10], table[1]);
      /*<<camlinternalOO.ml:362:4>>*/ obj[1] = table[2];
      /*<<camlinternalOO.ml:363:12>>*/ return  /*<<camlinternalOO.ml:363:12>>*/ caml_set_oo_id
-            (obj);
+            (obj) /*<<camlinternalOO.ml:364:5>>*/ ;
     /*<<camlinternalOO.ml:364:5>>*/ }
    function iter_f(obj, param){
     var param$0 = param;
     for(;;){
-     if(! param$0)  /*<<camlinternalOO.ml:368:12>>*/ return 0;
+     if(! param$0)
+       /*<<camlinternalOO.ml:368:12>>*/ return 0 /*<<camlinternalOO.ml:368:12>>*/ ;
      var l = param$0[2], f = param$0[1];
       /*<<camlinternalOO.ml:369:12>>*/  /*<<camlinternalOO.ml:369:12>>*/ caml_call1
       (f, obj);
@@ -31911,26 +32279,26 @@
      /*<<camlinternalOO.ml:372:2>>*/ var
      inits = table[8],
      _r_ = 0 !== inits ? 1 : 0;
-    return _r_ ? iter_f(obj, inits) : _r_;
+    return _r_ ? iter_f(obj, inits) : _r_ /*<<camlinternalOO.ml:374:20>>*/ ;
     /*<<camlinternalOO.ml:374:20>>*/ }
    function run_initializers_opt(obj_0, obj, table){
      /*<<camlinternalOO.ml:377:2>>*/ if(obj_0)
-      /*<<camlinternalOO.ml:377:35>>*/ return obj;
+      /*<<camlinternalOO.ml:377:35>>*/ return obj /*<<camlinternalOO.ml:377:35>>*/ ;
     var inits = table[8];
     if(0 !== inits)  /*<<camlinternalOO.ml:379:24>>*/ iter_f(obj, inits);
-     /*<<camlinternalOO.ml:379:24>>*/ return obj;
+     /*<<camlinternalOO.ml:379:24>>*/ return obj /*<<camlinternalOO.ml:379:24>>*/ ;
     /*<<camlinternalOO.ml:381:5>>*/ }
    function create_object_and_run_initiali(obj_0, table){
      /*<<camlinternalOO.ml:384:2>>*/ if(obj_0)
-      /*<<camlinternalOO.ml:384:35>>*/ return obj_0;
+      /*<<camlinternalOO.ml:384:35>>*/ return obj_0 /*<<camlinternalOO.ml:384:35>>*/ ;
      /*<<camlinternalOO.ml:385:14>>*/  /*<<camlinternalOO.ml:385:14>>*/ var
      obj = create_object(table);
      /*<<camlinternalOO.ml:386:4>>*/ run_initializers(obj, table);
-     /*<<camlinternalOO.ml:386:4>>*/ return obj;
+     /*<<camlinternalOO.ml:386:4>>*/ return obj /*<<camlinternalOO.ml:386:4>>*/ ;
     /*<<camlinternalOO.ml:388:5>>*/ }
    function get_data(param){
      /*<<camlinternalOO.ml:415:15>>*/ if(param)
-      /*<<camlinternalOO.ml:417:19>>*/ return param[2];
+      /*<<camlinternalOO.ml:417:19>>*/ return param[2] /*<<camlinternalOO.ml:417:19>>*/ ;
      /*<<camlinternalOO.ml:416:13>>*/ throw  /*<<camlinternalOO.ml:416:13>>*/ caml_maybe_attach_backtrace
            ([0, Assert_failure, _e_], 1);
     /*<<camlinternalOO.ml:417:30>>*/ }
@@ -31955,17 +32323,18 @@
       /*<<camlinternalOO.ml:407:13>>*/ throw  /*<<camlinternalOO.ml:407:13>>*/ caml_maybe_attach_backtrace
             ([0, Assert_failure, _b_], 1);
     tables[2] = v;
-     /*<<camlinternalOO.ml:428:2>>*/ return res;
+     /*<<camlinternalOO.ml:428:2>>*/ return res /*<<camlinternalOO.ml:428:2>>*/ ;
     /*<<camlinternalOO.ml:429:5>>*/ }
    function lookup_tables(root, keys){
      /*<<camlinternalOO.ml:451:2>>*/  /*<<camlinternalOO.ml:451:8>>*/ var
      root_data = get_data(root);
     if(! root_data)
       /*<<camlinternalOO.ml:455:4>>*/ return build_path
-             (keys.length - 2 | 0, keys, root);
+             (keys.length - 2 | 0, keys, root) /*<<camlinternalOO.ml:455:48>>*/ ;
     var i$1 = keys.length - 2 | 0, i = i$1, tables$0 = root_data;
      /*<<camlinternalOO.ml:432:2>>*/ for(;;){
-     if(0 > i)  /*<<camlinternalOO.ml:432:16>>*/ return tables$0;
+     if(0 > i)
+       /*<<camlinternalOO.ml:432:16>>*/ return tables$0 /*<<camlinternalOO.ml:432:16>>*/ ;
       /*<<camlinternalOO.ml:433:12>>*/ var
        /*<<camlinternalOO.ml:433:12>>*/ key = caml_check_bound(keys, i)[1 + i],
       tables$1 = tables$0;
@@ -31987,7 +32356,7 @@
                ([0, Assert_failure, _c_], 1);
        tables$1[3] = next;
         /*<<camlinternalOO.ml:445:10>>*/ return build_path
-               (i - 1 | 0, keys, next);
+               (i - 1 | 0, keys, next) /*<<camlinternalOO.ml:455:48>>*/ ;
       }
       tables$1 = tables;
      }
@@ -32019,7 +32388,7 @@
     }
      /*<<camlinternalOO.ml:512:2>>*/ caml_check_bound(table[2], n$0)[1 + n$0]
     = 0;
-     /*<<camlinternalOO.ml:512:2>>*/ return n$0;
+     /*<<camlinternalOO.ml:512:2>>*/ return n$0 /*<<camlinternalOO.ml:512:2>>*/ ;
     /*<<camlinternalOO.ml:513:3>>*/ }
    function set_methods(table, methods){
      /*<<camlinternalOO.ml:598:2>>*/ var
@@ -32037,7 +32406,7 @@
          var _m_ = i[1];
           /*<<camlinternalOO.ml:543:34>>*/ return caml_check_bound
                   (methods, _m_)
-                 [1 + _m_];
+                 [1 + _m_] /*<<camlinternalOO.ml:543:34>>*/ ;
          /*<<camlinternalOO.ml:543:42>>*/ },
        /*<<camlinternalOO.ml:544:8>>*/ clo = next(0);
      if(typeof clo === "number")
@@ -32049,7 +32418,7 @@
          var
           clo$0 =
             function(obj){
-              /*<<camlinternalOO.ml:459:35>>*/ return x$20;
+              /*<<camlinternalOO.ml:459:35>>*/ return x$20 /*<<camlinternalOO.ml:459:18>>*/ ;
              /*<<camlinternalOO.ml:459:36>>*/ };
          break;
         case 1:
@@ -32081,7 +32450,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:464:34>>*/ return  /*<<camlinternalOO.ml:464:34>>*/ caml_call1
-                     (obj[1][1 + n$36], obj);
+                     (obj[1][1 + n$36], obj) /*<<camlinternalOO.ml:464:48>>*/ ;
              /*<<camlinternalOO.ml:464:48>>*/ };
          break;
         case 4:
@@ -32104,7 +32473,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:466:37>>*/ return  /*<<camlinternalOO.ml:466:20>>*/ caml_call1
-                     (f$20, x$19);
+                     (f$20, x$19) /*<<camlinternalOO.ml:466:40>>*/ ;
              /*<<camlinternalOO.ml:466:40>>*/ };
          break;
         case 6:
@@ -32116,7 +32485,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:467:36>>*/ return caml_call1
-                     (f$19, obj[1 + n$34]);
+                     (f$19, obj[1 + n$34]) /*<<camlinternalOO.ml:467:62>>*/ ;
              /*<<camlinternalOO.ml:467:62>>*/ };
          break;
         case 7:
@@ -32129,7 +32498,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:470:4>>*/ return caml_call1
-                     (f$18, obj[1 + e$9][1 + n$33]);
+                     (f$18, obj[1 + e$9][1 + n$33]) /*<<camlinternalOO.ml:470:69>>*/ ;
              /*<<camlinternalOO.ml:470:69>>*/ };
          break;
         case 8:
@@ -32143,7 +32512,7 @@
               /*<<camlinternalOO.ml:471:36>>*/ return  /*<<camlinternalOO.ml:471:38>>*/ caml_call1
                      (f$17,
                        /*<<camlinternalOO.ml:471:38>>*/ caml_call1
-                       (obj[1][1 + n$32], obj));
+                       (obj[1][1 + n$32], obj)) /*<<camlinternalOO.ml:471:54>>*/ ;
              /*<<camlinternalOO.ml:471:54>>*/ };
          break;
         case 9:
@@ -32156,7 +32525,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:472:45>>*/ return  /*<<camlinternalOO.ml:472:28>>*/ caml_call2
-                     (f$16, x$18, y$0);
+                     (f$16, x$18, y$0) /*<<camlinternalOO.ml:472:50>>*/ ;
              /*<<camlinternalOO.ml:472:50>>*/ };
          break;
         case 10:
@@ -32169,7 +32538,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:473:44>>*/ return caml_call2
-                     (f$15, x$17, obj[1 + n$31]);
+                     (f$15, x$17, obj[1 + n$31]) /*<<camlinternalOO.ml:473:72>>*/ ;
              /*<<camlinternalOO.ml:473:72>>*/ };
          break;
         case 11:
@@ -32183,7 +32552,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:479:4>>*/ return caml_call2
-                     (f$14, x$16, obj[1 + e$8][1 + n$30]);
+                     (f$14, x$16, obj[1 + e$8][1 + n$30]) /*<<camlinternalOO.ml:479:71>>*/ ;
              /*<<camlinternalOO.ml:479:71>>*/ };
          break;
         case 12:
@@ -32199,7 +32568,7 @@
                      (f$13,
                       x$15,
                        /*<<camlinternalOO.ml:474:47>>*/ caml_call1
-                       (obj[1][1 + n$29], obj));
+                       (obj[1][1 + n$29], obj)) /*<<camlinternalOO.ml:474:63>>*/ ;
              /*<<camlinternalOO.ml:474:63>>*/ };
          break;
         case 13:
@@ -32212,7 +32581,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:475:42>>*/ return  /*<<camlinternalOO.ml:475:26>>*/ caml_call2
-                     (f$12, obj[1 + n$28], x$14);
+                     (f$12, obj[1 + n$28], x$14) /*<<camlinternalOO.ml:475:70>>*/ ;
              /*<<camlinternalOO.ml:475:70>>*/ };
          break;
         case 14:
@@ -32226,7 +32595,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:482:4>>*/ return  /*<<camlinternalOO.ml:481:2>>*/ caml_call2
-                     (f$11, obj[1 + e$7][1 + n$27], x$13);
+                     (f$11, obj[1 + e$7][1 + n$27], x$13) /*<<camlinternalOO.ml:482:71>>*/ ;
              /*<<camlinternalOO.ml:482:71>>*/ };
          break;
         case 15:
@@ -32242,7 +32611,7 @@
                      (f$10,
                        /*<<camlinternalOO.ml:476:45>>*/ caml_call1
                        (obj[1][1 + n$26], obj),
-                      x$12);
+                      x$12) /*<<camlinternalOO.ml:476:63>>*/ ;
              /*<<camlinternalOO.ml:476:63>>*/ };
          break;
         case 16:
@@ -32254,7 +32623,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:483:41>>*/ return  /*<<camlinternalOO.ml:483:25>>*/ caml_call2
-                     (obj[1][1 + n$25], obj, x$11);
+                     (obj[1][1 + n$25], obj, x$11) /*<<camlinternalOO.ml:483:68>>*/ ;
              /*<<camlinternalOO.ml:483:68>>*/ };
          break;
         case 17:
@@ -32266,7 +32635,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:485:18>>*/ return caml_call2
-                     (obj[1][1 + n$24], obj, obj[1 + m$12]);
+                     (obj[1][1 + n$24], obj, obj[1 + m$12]) /*<<camlinternalOO.ml:485:68>>*/ ;
              /*<<camlinternalOO.ml:485:68>>*/ };
          break;
         case 18:
@@ -32279,7 +32648,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:487:18>>*/ return caml_call2
-                     (obj[1][1 + n$23], obj, obj[1 + e$6][1 + m$11]);
+                     (obj[1][1 + n$23], obj, obj[1 + e$6][1 + m$11]) /*<<camlinternalOO.ml:488:69>>*/ ;
              /*<<camlinternalOO.ml:488:69>>*/ };
          break;
         case 19:
@@ -32295,7 +32664,7 @@
                  /*<<camlinternalOO.ml:490:44>>*/ caml_call1
                  (obj[1][1 + m$10], obj);
               /*<<camlinternalOO.ml:490:44>>*/ return  /*<<camlinternalOO.ml:490:44>>*/ caml_call2
-                     (obj[1][1 + n$22], obj, _l_);
+                     (obj[1][1 + n$22], obj, _l_) /*<<camlinternalOO.ml:490:60>>*/ ;
              /*<<camlinternalOO.ml:490:60>>*/ };
          break;
         case 20:
@@ -32308,7 +32677,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:492:18>>*/ return  /*<<camlinternalOO.ml:492:2>>*/ caml_call1
-                     (caml_get_public_method(x$10, m$9, 0), x$10);
+                     (caml_get_public_method(x$10, m$9, 0), x$10) /*<<camlinternalOO.ml:492:58>>*/ ;
              /*<<camlinternalOO.ml:492:58>>*/ };
          break;
         case 21:
@@ -32321,7 +32690,7 @@
           clo$0 =
             function(obj){
               /*<<camlinternalOO.ml:495:4>>*/ var _k_ = obj[1 + n$21];
-             return caml_call1(caml_get_public_method(_k_, m$8, 0), _k_);
+             return caml_call1(caml_get_public_method(_k_, m$8, 0), _k_) /*<<camlinternalOO.ml:496:32>>*/ ;
              /*<<camlinternalOO.ml:496:32>>*/ };
          break;
         case 22:
@@ -32336,7 +32705,7 @@
             function(obj){
               /*<<camlinternalOO.ml:499:4>>*/ var
               _j_ = obj[1 + e$5][1 + n$20];
-             return caml_call1(caml_get_public_method(_j_, m$7, 0), _j_);
+             return caml_call1(caml_get_public_method(_j_, m$7, 0), _j_) /*<<camlinternalOO.ml:502:34>>*/ ;
              /*<<camlinternalOO.ml:502:34>>*/ };
          break;
         default:
@@ -32353,7 +32722,7 @@
                  /*<<camlinternalOO.ml:505:14>>*/ caml_call1
                  (obj[1][1 + n$19], obj);
               /*<<camlinternalOO.ml:505:14>>*/ return  /*<<camlinternalOO.ml:505:14>>*/ caml_call1
-                     (caml_get_public_method(_i_, m$6, 0), _i_);
+                     (caml_get_public_method(_i_, m$6, 0), _i_) /*<<camlinternalOO.ml:505:59>>*/ ;
              /*<<camlinternalOO.ml:505:59>>*/ };
       }
      else
@@ -32366,7 +32735,7 @@
      /*<<camlinternalOO.ml:611:2>>*/ return [0,
             table_count[1],
             method_count[1],
-            inst_var_count[1]];
+            inst_var_count[1]] /*<<camlinternalOO.ml:611:2>>*/ ;
     /*<<camlinternalOO.ml:612:59>>*/ }
    var
     CamlinternalOO =
@@ -32476,7 +32845,7 @@
                 /*<<camlinternalMod.ml:30:11>>*/ throw  /*<<camlinternalMod.ml:30:11>>*/ caml_maybe_attach_backtrace
                       ([0, Stdlib[15], loc], 1);
                /*<<camlinternalMod.ml:32:11>>*/ return  /*<<camlinternalMod.ml:32:11>>*/ caml_call1
-                      (fn, x);
+                      (fn, x) /*<<camlinternalMod.ml:32:16>>*/ ;
               /*<<camlinternalMod.ml:32:16>>*/ };
           let fn$0 = fn;
           var init = fn;
@@ -32496,9 +32865,9 @@
               var _j_ = caml_obj_tag(l);
               if(250 === _j_) return l[1];
               if(246 !== _j_ && 244 !== _j_)
-                /*<<camlinternalMod.ml:41:13>>*/ return l;
+                /*<<camlinternalMod.ml:41:13>>*/ return l /*<<camlinternalMod.ml:41:13>>*/ ;
                /*<<camlinternalMod.ml:41:13>>*/ return  /*<<camlinternalMod.ml:41:13>>*/ caml_call1
-                      (CamlinternalLazy[2], l);
+                      (CamlinternalLazy[2], l) /*<<camlinternalMod.ml:41:13>>*/ ;
              }]);
           var init = l;
           break;
@@ -32519,16 +32888,16 @@
       i = _i_;
      }
     }
-     /*<<camlinternalMod.ml:57:2>>*/ return modu;
+     /*<<camlinternalMod.ml:57:2>>*/ return modu /*<<camlinternalMod.ml:57:2>>*/ ;
     /*<<camlinternalMod.ml:57:6>>*/ }
    function init_mod(loc, shape){
      /*<<camlinternalMod.ml:60:2>>*/ if
      (typeof shape !== "number" && 0 === shape[0]){
      var comps = shape[1];
-      /*<<camlinternalMod.ml:62:5>>*/ return init_mod_block(loc, comps);
+      /*<<camlinternalMod.ml:62:5>>*/ return init_mod_block(loc, comps) /*<<camlinternalMod.ml:63:58>>*/ ;
     }
      /*<<camlinternalMod.ml:63:9>>*/ return  /*<<camlinternalMod.ml:63:9>>*/ caml_call1
-            (Stdlib[2], cst_CamlinternalMod_init_mod_n);
+            (Stdlib[2], cst_CamlinternalMod_init_mod_n) /*<<camlinternalMod.ml:63:58>>*/ ;
     /*<<camlinternalMod.ml:63:58>>*/ }
    function update_mod_block(comps$0, modu, n){
      /*<<camlinternalMod.ml:81:2>>*/ if
@@ -32587,10 +32956,10 @@
      /*<<camlinternalMod.ml:87:2>>*/ if
      (typeof shape !== "number" && 0 === shape[0]){
      var comps = shape[1];
-      /*<<camlinternalMod.ml:89:5>>*/ return update_mod_block(comps, o, n);
+      /*<<camlinternalMod.ml:89:5>>*/ return update_mod_block(comps, o, n) /*<<camlinternalMod.ml:90:60>>*/ ;
     }
      /*<<camlinternalMod.ml:90:9>>*/ return  /*<<camlinternalMod.ml:90:9>>*/ caml_call1
-            (Stdlib[2], cst_CamlinternalMod_update_mod);
+            (Stdlib[2], cst_CamlinternalMod_update_mod) /*<<camlinternalMod.ml:90:60>>*/ ;
     /*<<camlinternalMod.ml:90:60>>*/ }
    var CamlinternalMod = [0, init_mod, update_mod];
    runtime.caml_register_global(8, CamlinternalMod, "CamlinternalMod");
@@ -32682,7 +33051,7 @@
              0,
               /*<<ephemeron.ml:110:56>>*/ caml_make_vect(x, 0),
              seed,
-             x];
+             x] /*<<ephemeron.ml:110:6>>*/ ;
     }
     function clear(h){
       /*<<ephemeron.ml:113:6>>*/ h[1] = 0;
@@ -32710,7 +33079,7 @@
                 [1]
                = 0,
                h[2] =  /*<<ephemeron.ml:125:18>>*/ caml_make_vect(h[4], 0),
-               0);
+               0) /*<<ephemeron.ml:126:9>>*/ ;
      /*<<ephemeron.ml:126:9>>*/ }
     function copy(h){
       /*<<ephemeron.ml:128:17>>*/ var
@@ -32718,7 +33087,7 @@
       _am_ = h[3],
        /*<<ephemeron.ml:128:33>>*/ _an_ =
          /*<<ephemeron.ml:128:33>>*/ caml_call1(Stdlib_Array[7], h[2]);
-      /*<<ephemeron.ml:128:17>>*/ return [0, h[1], _an_, _am_, _al_];
+      /*<<ephemeron.ml:128:17>>*/ return [0, h[1], _an_, _am_, _al_] /*<<ephemeron.ml:128:17>>*/ ;
      /*<<ephemeron.ml:128:52>>*/ }
     function key_index(h, hkey){
       /*<<ephemeron.ml:131:6>>*/ return hkey & (h[2].length - 2 | 0);
@@ -32727,12 +33096,13 @@
      function do_bucket(param){
        /*<<ephemeron.ml:134:26>>*/ var param$0 = param;
        /*<<ephemeron.ml:134:26>>*/ for(;;){
-       if(! param$0)  /*<<ephemeron.ml:136:12>>*/ return 0;
+       if(! param$0)
+         /*<<ephemeron.ml:136:12>>*/ return 0 /*<<ephemeron.ml:136:12>>*/ ;
        var hkey = param$0[1], rest = param$0[3], c = param$0[2];
         /*<<ephemeron.ml:137:36>>*/ if
         ( /*<<ephemeron.ml:137:36>>*/ caml_call1(H[6], c)){
         var rest$0 = param$0[3], c$0 = param$0[2];
-         /*<<ephemeron.ml:141:12>>*/ return [0, hkey, c$0, do_bucket(rest$0)];
+         /*<<ephemeron.ml:141:12>>*/ return [0, hkey, c$0, do_bucket(rest$0)] /*<<ephemeron.ml:141:12>>*/ ;
        }
        h[1] = h[1] - 1 | 0;
        param$0 = rest;
@@ -32769,7 +33139,7 @@
        insert_bucket =
          function(param){
            /*<<ephemeron.ml:176:32>>*/ if(! param)
-            /*<<ephemeron.ml:177:21>>*/ return;
+            /*<<ephemeron.ml:177:21>>*/ return /*<<ephemeron.ml:177:21>>*/ ;
           var rest = param[3], data = param[2], hkey = param[1];
            /*<<ephemeron.ml:179:14>>*/ insert_bucket(rest);
            /*<<ephemeron.ml:180:25>>*/  /*<<ephemeron.ml:180:25>>*/ var
@@ -32808,7 +33178,7 @@
       /*<<ephemeron.ml:192:6>>*/ caml_check_bound(h[2], i)[1 + i] = bucket;
      h[1] = h[1] + 1 | 0;
      var _ab_ = h[2].length - 1 << 1 < h[1] ? 1 : 0;
-     return _ab_ ? resize(h) : _ab_;
+     return _ab_ ? resize(h) : _ab_ /*<<ephemeron.ml:194:57>>*/ ;
      /*<<ephemeron.ml:194:57>>*/ }
     function remove(h, key){
       /*<<ephemeron.ml:197:6>>*/  /*<<ephemeron.ml:197:17>>*/ var
@@ -32816,20 +33186,22 @@
      function remove_bucket(param){
        /*<<ephemeron.ml:198:30>>*/ var param$0 = param;
        /*<<ephemeron.ml:198:30>>*/ for(;;){
-       if(! param$0)  /*<<ephemeron.ml:199:19>>*/ return 0;
+       if(! param$0)
+         /*<<ephemeron.ml:199:19>>*/ return 0 /*<<ephemeron.ml:199:19>>*/ ;
        var hk = param$0[1], next = param$0[3], c = param$0[2];
        if(hkey !== hk){
         var next$0 = param$0[3], c$0 = param$0[2];
          /*<<ephemeron.ml:210:29>>*/ return [0,
                 hk,
                 c$0,
-                remove_bucket(next$0)];
+                remove_bucket(next$0)] /*<<ephemeron.ml:210:29>>*/ ;
        }
        switch( /*<<ephemeron.ml:201:24>>*/ caml_call2(H[3], c, key)){
          case 0:
-          h[1] = h[1] - 1 | 0;  /*<<ephemeron.ml:202:45>>*/ return next;
+          h[1] = h[1] - 1 | 0;
+           /*<<ephemeron.ml:202:45>>*/ return next /*<<ephemeron.ml:202:45>>*/ ;
          case 1:
-           /*<<ephemeron.ml:203:24>>*/ return [0, hk, c, remove_bucket(next)];
+           /*<<ephemeron.ml:203:24>>*/ return [0, hk, c, remove_bucket(next)] /*<<ephemeron.ml:203:24>>*/ ;
          default: h[1] = h[1] - 1 | 0; param$0 = next;
        }
       }
@@ -32839,7 +33211,7 @@
        /*<<ephemeron.ml:212:20>>*/ _aa_ =
         remove_bucket(caml_check_bound(h[2], i)[1 + i]);
       /*<<ephemeron.ml:212:6>>*/ caml_check_bound(h[2], i)[1 + i] = _aa_;
-      /*<<ephemeron.ml:212:6>>*/ return 0;
+      /*<<ephemeron.ml:212:6>>*/ return 0 /*<<ephemeron.ml:212:6>>*/ ;
      /*<<ephemeron.ml:212:44>>*/ }
     function find(h, key){
       /*<<ephemeron.ml:239:6>>*/ var
@@ -32857,7 +33229,10 @@
          case 0:
            /*<<ephemeron.ml:224:26>>*/  /*<<ephemeron.ml:224:26>>*/ var
            match =  /*<<ephemeron.ml:224:26>>*/ caml_call1(H[4], c);
-          if(match){var d = match[1];  /*<<ephemeron.ml:229:26>>*/ return d;}
+          if(match){
+           var d = match[1];
+            /*<<ephemeron.ml:229:26>>*/ return d /*<<ephemeron.ml:229:26>>*/ ;
+          }
           param = rest;
           break;
          case 1:
@@ -32874,14 +33249,16 @@
        /*<<ephemeron.ml:266:37>>*/ ___ = key_index(h, hkey),
       param = caml_check_bound(h[2], ___)[1 + ___];
      for(;;){
-      if(! param)  /*<<ephemeron.ml:245:10>>*/ return 0;
+      if(! param)
+        /*<<ephemeron.ml:245:10>>*/ return 0 /*<<ephemeron.ml:245:10>>*/ ;
       var hk = param[1], rest = param[3], c = param[2];
       if(hkey === hk)
        switch( /*<<ephemeron.ml:247:22>>*/ caml_call2(H[3], c, key)){
          case 0:
            /*<<ephemeron.ml:249:26>>*/  /*<<ephemeron.ml:249:26>>*/ var
            d =  /*<<ephemeron.ml:249:26>>*/ caml_call1(H[4], c);
-          if(d)  /*<<ephemeron.ml:254:31>>*/ return d;
+          if(d)
+            /*<<ephemeron.ml:254:31>>*/ return d /*<<ephemeron.ml:254:31>>*/ ;
           param = rest;
           break;
          case 1:
@@ -32897,7 +33274,8 @@
      function find_in_bucket(param){
        /*<<ephemeron.ml:270:31>>*/ var param$0 = param;
        /*<<ephemeron.ml:270:31>>*/ for(;;){
-       if(! param$0)  /*<<ephemeron.ml:271:17>>*/ return 0;
+       if(! param$0)
+         /*<<ephemeron.ml:271:17>>*/ return 0 /*<<ephemeron.ml:271:17>>*/ ;
        var hk = param$0[1], rest = param$0[3], c = param$0[2];
        if(hkey === hk)
         switch( /*<<ephemeron.ml:273:22>>*/ caml_call2(H[3], c, key)){
@@ -32906,7 +33284,7 @@
             match =  /*<<ephemeron.ml:274:33>>*/ caml_call1(H[4], c);
            if(match){
             var d = match[1];
-             /*<<ephemeron.ml:277:26>>*/ return [0, d, find_in_bucket(rest)];
+             /*<<ephemeron.ml:277:26>>*/ return [0, d, find_in_bucket(rest)] /*<<ephemeron.ml:277:26>>*/ ;
            }
            param$0 = rest;
            break;
@@ -32920,7 +33298,7 @@
       /*<<ephemeron.ml:285:29>>*/  /*<<ephemeron.ml:285:29>>*/ var
       _Z_ = key_index(h, hkey);
       /*<<ephemeron.ml:285:21>>*/ return find_in_bucket
-             (caml_check_bound(h[2], _Z_)[1 + _Z_]);
+             (caml_check_bound(h[2], _Z_)[1 + _Z_]) /*<<ephemeron.ml:285:46>>*/ ;
      /*<<ephemeron.ml:285:46>>*/ }
     function replace(h, key, info){
       /*<<ephemeron.ml:289:6>>*/ var
@@ -32939,7 +33317,7 @@
         if(!  /*<<ephemeron.ml:293:24>>*/ caml_call2(H[3], c, key)){
           /*<<ephemeron.ml:290:6>>*/  /*<<ephemeron.ml:290:6>>*/ var
           _V_ =  /*<<ephemeron.ml:290:6>>*/ caml_call3(H[5], c, key, info);
-          /*<<ephemeron.ml:302:8>>*/ return _V_;
+          /*<<ephemeron.ml:302:8>>*/ return _V_ /*<<ephemeron.ml:302:8>>*/ ;
         }
         param = next;
        }
@@ -32954,7 +33332,7 @@
        /*<<ephemeron.ml:305:8>>*/ caml_check_bound(h[2], i)[1 + i] = [0, hkey, container, l];
       h[1] = h[1] + 1 | 0;
       var _X_ = h[2].length - 1 << 1 < h[1] ? 1 : 0;
-      return _X_ ? resize(h) : _X_;
+      return _X_ ? resize(h) : _X_ /*<<ephemeron.ml:307:59>>*/ ;
      }
      /*<<ephemeron.ml:307:59>>*/ }
     function mem(h, key){
@@ -32964,11 +33342,12 @@
        /*<<ephemeron.ml:320:28>>*/ _U_ = key_index(h, hkey),
       param = caml_check_bound(h[2], _U_)[1 + _U_];
       /*<<ephemeron.ml:311:30>>*/ for(;;){
-      if(! param)  /*<<ephemeron.ml:313:10>>*/ return 0;
+      if(! param)
+        /*<<ephemeron.ml:313:10>>*/ return 0 /*<<ephemeron.ml:313:10>>*/ ;
       var hk = param[1], rest = param[3], c = param[2];
       if(hk === hkey){
        if(!  /*<<ephemeron.ml:315:22>>*/ caml_call2(H[3], c, key))
-         /*<<ephemeron.ml:316:21>>*/ return 1;
+         /*<<ephemeron.ml:316:21>>*/ return 1 /*<<ephemeron.ml:316:21>>*/ ;
        param = rest;
       }
       else{var rest$0 = param[3]; param = rest$0;}
@@ -32980,7 +33359,8 @@
     function bucket_length(accu, param){
      var accu$0 = accu, param$0 = param;
      for(;;){
-      if(! param$0)  /*<<ephemeron.ml:325:17>>*/ return accu$0;
+      if(! param$0)
+        /*<<ephemeron.ml:325:17>>*/ return accu$0 /*<<ephemeron.ml:325:17>>*/ ;
        /*<<ephemeron.ml:326:28>>*/ var
        rest = param$0[3],
         /*<<ephemeron.ml:326:28>>*/ accu$1 = accu$0 + 1 | 0;
@@ -32997,7 +33377,7 @@
             /*<<ephemeron.ml:330:36>>*/  /*<<ephemeron.ml:330:46>>*/ var
             _T_ = bucket_length(0, b);
             /*<<ephemeron.ml:330:46>>*/ return  /*<<ephemeron.ml:330:46>>*/ caml_call2
-                   (Stdlib_Int[11], m, _T_);
+                   (Stdlib_Int[11], m, _T_) /*<<ephemeron.ml:330:65>>*/ ;
            /*<<ephemeron.ml:330:65>>*/ },
           0,
           h[2]),
@@ -33010,15 +33390,16 @@
          l = bucket_length(0, b);
          /*<<ephemeron.ml:335:11>>*/ histo[1 + l] =
          caml_check_bound(histo, l)[1 + l] + 1 | 0;
-         /*<<ephemeron.ml:335:11>>*/ return 0;
+         /*<<ephemeron.ml:335:11>>*/ return 0 /*<<ephemeron.ml:335:11>>*/ ;
         /*<<ephemeron.ml:335:37>>*/ },
        h[2]);
-      /*<<ephemeron.ml:337:6>>*/ return [0, h[1], h[2].length - 1, mbl, histo];
+      /*<<ephemeron.ml:337:6>>*/ return [0, h[1], h[2].length - 1, mbl, histo] /*<<ephemeron.ml:337:6>>*/ ;
      /*<<ephemeron.ml:340:34>>*/ }
     function bucket_length_alive(accu, param){
      var accu$0 = accu, param$0 = param;
      for(;;){
-      if(! param$0)  /*<<ephemeron.ml:343:17>>*/ return accu$0;
+      if(! param$0)
+        /*<<ephemeron.ml:343:17>>*/ return accu$0 /*<<ephemeron.ml:343:17>>*/ ;
       var rest = param$0[3], c = param$0[2];
        /*<<ephemeron.ml:344:30>>*/ if
        ( /*<<ephemeron.ml:344:30>>*/ caml_call1(H[6], c)){
@@ -33039,7 +33420,7 @@
             /*<<ephemeron.ml:352:22>>*/  /*<<ephemeron.ml:352:32>>*/ var
             _S_ = bucket_length_alive(0, b);
             /*<<ephemeron.ml:352:32>>*/ return  /*<<ephemeron.ml:352:32>>*/ caml_call2
-                   (Stdlib_Int[11], m, _S_);
+                   (Stdlib_Int[11], m, _S_) /*<<ephemeron.ml:352:57>>*/ ;
            /*<<ephemeron.ml:352:57>>*/ },
           0,
           h[2]),
@@ -33053,38 +33434,38 @@
         size[1] = size[1] + l | 0;
          /*<<ephemeron.ml:359:11>>*/ histo[1 + l] =
          caml_check_bound(histo, l)[1 + l] + 1 | 0;
-         /*<<ephemeron.ml:359:11>>*/ return 0;
+         /*<<ephemeron.ml:359:11>>*/ return 0 /*<<ephemeron.ml:359:11>>*/ ;
         /*<<ephemeron.ml:359:37>>*/ },
        h[2]);
       /*<<ephemeron.ml:361:6>>*/ return [0,
              size[1],
              h[2].length - 1,
              mbl,
-             histo];
+             histo] /*<<ephemeron.ml:361:6>>*/ ;
      /*<<ephemeron.ml:364:34>>*/ }
     function add_seq(tbl, i){
       /*<<ephemeron.ml:367:6>>*/ return  /*<<ephemeron.ml:367:6>>*/ caml_call2
              (Stdlib_Seq[4],
               function(param){
                 /*<<ephemeron.ml:367:15>>*/ var v = param[2], k = param[1];
-                /*<<ephemeron.ml:367:29>>*/ return add(tbl, k, v);
+                /*<<ephemeron.ml:367:29>>*/ return add(tbl, k, v) /*<<ephemeron.ml:367:41>>*/ ;
                /*<<ephemeron.ml:367:41>>*/ },
-              i);
+              i) /*<<ephemeron.ml:367:43>>*/ ;
      /*<<ephemeron.ml:367:43>>*/ }
     function replace_seq(tbl, i){
       /*<<ephemeron.ml:370:6>>*/ return  /*<<ephemeron.ml:370:6>>*/ caml_call2
              (Stdlib_Seq[4],
               function(param){
                 /*<<ephemeron.ml:370:15>>*/ var v = param[2], k = param[1];
-                /*<<ephemeron.ml:370:29>>*/ return replace(tbl, k, v);
+                /*<<ephemeron.ml:370:29>>*/ return replace(tbl, k, v) /*<<ephemeron.ml:370:45>>*/ ;
                /*<<ephemeron.ml:370:45>>*/ },
-              i);
+              i) /*<<ephemeron.ml:370:47>>*/ ;
      /*<<ephemeron.ml:370:47>>*/ }
     function of_seq(i){
       /*<<ephemeron.ml:373:6>>*/  /*<<ephemeron.ml:373:16>>*/ var
       tbl = create(0, 16);
       /*<<ephemeron.ml:374:6>>*/ replace_seq(tbl, i);
-      /*<<ephemeron.ml:374:6>>*/ return tbl;
+      /*<<ephemeron.ml:374:6>>*/ return tbl /*<<ephemeron.ml:374:6>>*/ ;
      /*<<ephemeron.ml:375:9>>*/ }
      /*<<ephemeron.ml:82:4>>*/ return [0,
             create,
@@ -33104,47 +33485,48 @@
             replace_seq,
             of_seq,
             clean,
-            stats_alive];
+            stats_alive] /*<<ephemeron.ml:82:4>>*/ ;
    }
    function create(param){
      /*<<ephemeron.ml:394:30>>*/ return  /*<<ephemeron.ml:394:30>>*/ caml_call1
-            (Stdlib_Obj[23][1], 1);
+            (Stdlib_Obj[23][1], 1) /*<<ephemeron.ml:394:45>>*/ ;
     /*<<ephemeron.ml:394:45>>*/ }
    function get_key(t){
      /*<<ephemeron.ml:396:42>>*/  /*<<ephemeron.ml:396:50>>*/ var
      x =  /*<<ephemeron.ml:396:50>>*/ caml_call2(Stdlib_Obj[23][3], t, 0);
-     /*<<ephemeron.ml:388:51>>*/ return x;
+     /*<<ephemeron.ml:388:51>>*/ return x /*<<ephemeron.ml:388:51>>*/ ;
     /*<<ephemeron.ml:396:70>>*/ }
    function set_key(t, k){
      /*<<ephemeron.ml:397:44>>*/ return  /*<<ephemeron.ml:397:44>>*/ caml_call3
-            (Stdlib_Obj[23][5], t, 0, k);
+            (Stdlib_Obj[23][5], t, 0, k) /*<<ephemeron.ml:397:75>>*/ ;
     /*<<ephemeron.ml:397:75>>*/ }
    function check_key(t){
      /*<<ephemeron.ml:398:39>>*/ return  /*<<ephemeron.ml:398:39>>*/ caml_call2
-            (Stdlib_Obj[23][7], t, 0);
+            (Stdlib_Obj[23][7], t, 0) /*<<ephemeron.ml:398:59>>*/ ;
     /*<<ephemeron.ml:398:59>>*/ }
    function get_data(t){
      /*<<ephemeron.ml:400:43>>*/  /*<<ephemeron.ml:400:51>>*/ var
      x =  /*<<ephemeron.ml:400:51>>*/ caml_call1(Stdlib_Obj[23][9], t);
-     /*<<ephemeron.ml:388:51>>*/ return x;
+     /*<<ephemeron.ml:388:51>>*/ return x /*<<ephemeron.ml:388:51>>*/ ;
     /*<<ephemeron.ml:400:70>>*/ }
    function set_data(t, d){
      /*<<ephemeron.ml:401:45>>*/ return  /*<<ephemeron.ml:401:45>>*/ caml_call2
-            (Stdlib_Obj[23][11], t, d);
+            (Stdlib_Obj[23][11], t, d) /*<<ephemeron.ml:401:75>>*/ ;
     /*<<ephemeron.ml:401:75>>*/ }
    function make(key, data){
      /*<<ephemeron.ml:405:4>>*/  /*<<ephemeron.ml:405:14>>*/ var
      eph = create(0);
      /*<<ephemeron.ml:406:4>>*/ set_data(eph, data);
      /*<<ephemeron.ml:407:4>>*/ set_key(eph, key);
-     /*<<ephemeron.ml:407:4>>*/ return eph;
+     /*<<ephemeron.ml:407:4>>*/ return eph /*<<ephemeron.ml:407:4>>*/ ;
     /*<<ephemeron.ml:408:7>>*/ }
    function query(eph, key){
      /*<<ephemeron.ml:411:4>>*/  /*<<ephemeron.ml:411:10>>*/ var
      match = get_key(eph);
-    if(! match)  /*<<ephemeron.ml:412:14>>*/ return 0;
+    if(! match)
+      /*<<ephemeron.ml:412:14>>*/ return 0 /*<<ephemeron.ml:412:14>>*/ ;
     var k = match[1];
-    return k === key ? get_data(eph) : 0;
+    return k === key ? get_data(eph) : 0 /*<<ephemeron.ml:414:20>>*/ ;
     /*<<ephemeron.ml:414:20>>*/ }
    function MakeSeeded$0(H){
     function create$0(k, d){
@@ -33152,24 +33534,25 @@
       c = create(0);
       /*<<ephemeron.ml:422:8>>*/ set_data(c, d);
       /*<<ephemeron.ml:423:8>>*/ set_key(c, k);
-      /*<<ephemeron.ml:423:8>>*/ return c;
+      /*<<ephemeron.ml:423:8>>*/ return c /*<<ephemeron.ml:423:8>>*/ ;
      /*<<ephemeron.ml:424:9>>*/ }
     var seeded_hash = H[2];
     function equal(c, k){
       /*<<ephemeron.ml:429:8>>*/  /*<<ephemeron.ml:429:14>>*/ var
       match = get_key(c);
-     if(! match)  /*<<ephemeron.ml:430:18>>*/ return 2;
+     if(! match)
+       /*<<ephemeron.ml:430:18>>*/ return 2 /*<<ephemeron.ml:430:18>>*/ ;
      var k$0 = match[1];
       /*<<ephemeron.ml:432:15>>*/ return  /*<<ephemeron.ml:432:15>>*/ caml_call2
               (H[1], k, k$0)
              ? 0
-             : 1;
+             : 1 /*<<ephemeron.ml:432:76>>*/ ;
      /*<<ephemeron.ml:432:76>>*/ }
     function set_key_data(c, k, d){
       /*<<ephemeron.ml:435:8>>*/  /*<<ephemeron.ml:402:40>>*/ caml_call1
       (Stdlib_Obj[23][12], c);
       /*<<ephemeron.ml:436:8>>*/ set_key(c, k);
-      /*<<ephemeron.ml:436:8>>*/ return set_data(c, d);
+      /*<<ephemeron.ml:436:8>>*/ return set_data(c, d) /*<<ephemeron.ml:437:20>>*/ ;
      /*<<ephemeron.ml:437:20>>*/ }
      /*<<ephemeron.ml:417:28>>*/ return MakeSeeded
             ([0,
@@ -33178,13 +33561,13 @@
               equal,
               get_data,
               set_key_data,
-              check_key]);
+              check_key]) /*<<ephemeron.ml:417:28>>*/ ;
    }
    function Make(H){
     var equal = H[1];
     function seeded_hash(seed, x){
       /*<<ephemeron.ml:446:41>>*/ return  /*<<ephemeron.ml:446:41>>*/ caml_call1
-             (H[2], x);
+             (H[2], x) /*<<ephemeron.ml:446:49>>*/ ;
      /*<<ephemeron.ml:446:49>>*/ }
     var
      include = MakeSeeded$0([0, equal, seeded_hash]),
@@ -33207,14 +33590,14 @@
      stats_alive = include[18];
     function create(sz){
       /*<<ephemeron.ml:448:20>>*/ return  /*<<ephemeron.ml:448:20>>*/ caml_call2
-             (_R_, _a_, sz);
+             (_R_, _a_, sz) /*<<ephemeron.ml:448:43>>*/ ;
      /*<<ephemeron.ml:448:43>>*/ }
     function of_seq(i){
       /*<<ephemeron.ml:450:6>>*/  /*<<ephemeron.ml:448:20>>*/ var
       tbl =  /*<<ephemeron.ml:448:20>>*/ caml_call2(_R_, _a_, 16);
       /*<<ephemeron.ml:451:6>>*/  /*<<ephemeron.ml:451:6>>*/ caml_call2
       (replace_seq, tbl, i);
-      /*<<ephemeron.ml:451:6>>*/ return tbl;
+      /*<<ephemeron.ml:451:6>>*/ return tbl /*<<ephemeron.ml:451:6>>*/ ;
      /*<<ephemeron.ml:452:9>>*/ }
      /*<<ephemeron.ml:442:2>>*/ return [0,
             create,
@@ -33234,10 +33617,10 @@
             replace_seq,
             of_seq,
             clean,
-            stats_alive];
+            stats_alive] /*<<ephemeron.ml:442:2>>*/ ;
    }
    function make$0(param){
-     /*<<ephemeron.ml:459:18>>*/ return [0, 0];
+     /*<<ephemeron.ml:459:18>>*/ return [0, 0] /*<<ephemeron.ml:459:18>>*/ ;
     /*<<ephemeron.ml:459:24>>*/ }
    function add(b, k, d){
      /*<<ephemeron.ml:460:20>>*/ var _Q_ = b[1];
@@ -33249,14 +33632,16 @@
      match = get_key(e);
     if(match){
      var x = match[1];
-     if(x === k)  /*<<ephemeron.ml:464:30>>*/ return 1;
+     if(x === k)
+       /*<<ephemeron.ml:464:30>>*/ return 1 /*<<ephemeron.ml:464:30>>*/ ;
     }
-     /*<<ephemeron.ml:465:13>>*/ return 0;
+     /*<<ephemeron.ml:465:13>>*/ return 0 /*<<ephemeron.ml:465:13>>*/ ;
     /*<<ephemeron.ml:465:18>>*/ }
    function remove(b, k){
      /*<<ephemeron.ml:468:6>>*/ var l$0 = b[1], l = l$0, acc = 0;
      /*<<ephemeron.ml:469:8>>*/ for(;;){
-     if(! l)  /*<<ephemeron.ml:470:16>>*/ return 0;
+     if(! l)
+       /*<<ephemeron.ml:470:16>>*/ return 0 /*<<ephemeron.ml:470:16>>*/ ;
      var h = l[1], t = l[2];
       /*<<ephemeron.ml:471:22>>*/ if(test_key(k, h)){
       b[1] =  /*<<ephemeron.ml:471:43>>*/ caml_call2(Stdlib_List[13], acc, t);
@@ -33276,12 +33661,13 @@
         (Stdlib_List[40],
          function(_P_){ /*<<?>>*/ return test_key(k, _P_);},
          b[1]);
-    if(! match)  /*<<ephemeron.ml:479:16>>*/ return 0;
+    if(! match)
+      /*<<ephemeron.ml:479:16>>*/ return 0 /*<<ephemeron.ml:479:16>>*/ ;
     var e = match[1];
-     /*<<ephemeron.ml:478:18>>*/ return get_data(e);
+     /*<<ephemeron.ml:478:18>>*/ return get_data(e) /*<<ephemeron.ml:479:20>>*/ ;
     /*<<ephemeron.ml:479:20>>*/ }
    function length(b){
-     /*<<ephemeron.ml:481:19>>*/ return caml_call1(Stdlib_List[1], b[1]);
+     /*<<ephemeron.ml:481:19>>*/ return caml_call1(Stdlib_List[1], b[1]) /*<<ephemeron.ml:481:33>>*/ ;
     /*<<ephemeron.ml:481:33>>*/ }
    function clear(b){
      /*<<ephemeron.ml:482:18>>*/ b[1] = 0;
@@ -33289,34 +33675,34 @@
     /*<<ephemeron.ml:482:25>>*/ }
    function create$0(param){
      /*<<ephemeron.ml:491:35>>*/ return  /*<<ephemeron.ml:491:35>>*/ caml_call1
-            (Stdlib_Obj[23][1], 2);
+            (Stdlib_Obj[23][1], 2) /*<<ephemeron.ml:491:50>>*/ ;
     /*<<ephemeron.ml:491:50>>*/ }
    function get_key1(t){
      /*<<ephemeron.ml:493:49>>*/  /*<<ephemeron.ml:493:57>>*/ var
      x =  /*<<ephemeron.ml:493:57>>*/ caml_call2(Stdlib_Obj[23][3], t, 0);
-     /*<<ephemeron.ml:388:51>>*/ return x;
+     /*<<ephemeron.ml:388:51>>*/ return x /*<<ephemeron.ml:388:51>>*/ ;
     /*<<ephemeron.ml:493:77>>*/ }
    function set_key1(t, k){
      /*<<ephemeron.ml:495:4>>*/ return  /*<<ephemeron.ml:495:4>>*/ caml_call3
-            (Stdlib_Obj[23][5], t, 0, k);
+            (Stdlib_Obj[23][5], t, 0, k) /*<<ephemeron.ml:495:35>>*/ ;
     /*<<ephemeron.ml:495:35>>*/ }
    function get_key2(t){
      /*<<ephemeron.ml:498:49>>*/  /*<<ephemeron.ml:498:57>>*/ var
      x =  /*<<ephemeron.ml:498:57>>*/ caml_call2(Stdlib_Obj[23][3], t, 1);
-     /*<<ephemeron.ml:388:51>>*/ return x;
+     /*<<ephemeron.ml:388:51>>*/ return x /*<<ephemeron.ml:388:51>>*/ ;
     /*<<ephemeron.ml:498:77>>*/ }
    function set_key2(t, k){
      /*<<ephemeron.ml:500:4>>*/ return  /*<<ephemeron.ml:500:4>>*/ caml_call3
-            (Stdlib_Obj[23][5], t, 1, k);
+            (Stdlib_Obj[23][5], t, 1, k) /*<<ephemeron.ml:500:35>>*/ ;
     /*<<ephemeron.ml:500:35>>*/ }
    function get_data$0(t){
      /*<<ephemeron.ml:503:48>>*/  /*<<ephemeron.ml:503:56>>*/ var
      x =  /*<<ephemeron.ml:503:56>>*/ caml_call1(Stdlib_Obj[23][9], t);
-     /*<<ephemeron.ml:388:51>>*/ return x;
+     /*<<ephemeron.ml:388:51>>*/ return x /*<<ephemeron.ml:388:51>>*/ ;
     /*<<ephemeron.ml:503:75>>*/ }
    function set_data$0(t, d){
      /*<<ephemeron.ml:505:4>>*/ return  /*<<ephemeron.ml:505:4>>*/ caml_call2
-            (Stdlib_Obj[23][11], t, d);
+            (Stdlib_Obj[23][11], t, d) /*<<ephemeron.ml:505:34>>*/ ;
     /*<<ephemeron.ml:505:34>>*/ }
    function make$1(key1, key2, data){
      /*<<ephemeron.ml:509:4>>*/  /*<<ephemeron.ml:509:14>>*/ var
@@ -33324,19 +33710,22 @@
      /*<<ephemeron.ml:510:4>>*/ set_data$0(eph, data);
      /*<<ephemeron.ml:511:4>>*/ set_key1(eph, key1);
      /*<<ephemeron.ml:512:4>>*/ set_key2(eph, key2);
-     /*<<ephemeron.ml:514:4>>*/ return eph;
+     /*<<ephemeron.ml:514:4>>*/ return eph /*<<ephemeron.ml:514:4>>*/ ;
     /*<<ephemeron.ml:514:7>>*/ }
    function query$0(eph, key1, key2){
      /*<<ephemeron.ml:517:4>>*/  /*<<ephemeron.ml:517:10>>*/ var
      match = get_key1(eph);
-    if(! match)  /*<<ephemeron.ml:518:14>>*/ return 0;
+    if(! match)
+      /*<<ephemeron.ml:518:14>>*/ return 0 /*<<ephemeron.ml:518:14>>*/ ;
     var k = match[1];
-    if(k !== key1)  /*<<ephemeron.ml:525:16>>*/ return 0;
+    if(k !== key1)
+      /*<<ephemeron.ml:525:16>>*/ return 0 /*<<ephemeron.ml:525:16>>*/ ;
      /*<<ephemeron.ml:520:20>>*/  /*<<ephemeron.ml:520:20>>*/ var
      match$0 = get_key2(eph);
-    if(! match$0)  /*<<ephemeron.ml:521:18>>*/ return 0;
+    if(! match$0)
+      /*<<ephemeron.ml:521:18>>*/ return 0 /*<<ephemeron.ml:521:18>>*/ ;
     var k$0 = match$0[1];
-    return k$0 === key2 ? get_data$0(eph) : 0;
+    return k$0 === key2 ? get_data$0(eph) : 0 /*<<ephemeron.ml:525:20>>*/ ;
     /*<<ephemeron.ml:525:20>>*/ }
    function MakeSeeded$1(H1, H2){
     function create(param, d){
@@ -33347,7 +33736,7 @@
       /*<<ephemeron.ml:535:8>>*/ set_data$0(c, d);
       /*<<ephemeron.ml:536:8>>*/ set_key1(c, k1);
       /*<<ephemeron.ml:536:23>>*/ set_key2(c, k2);
-      /*<<ephemeron.ml:536:23>>*/ return c;
+      /*<<ephemeron.ml:536:23>>*/ return c /*<<ephemeron.ml:536:23>>*/ ;
     }
     function seeded_hash(seed, param){
       /*<<ephemeron.ml:539:33>>*/ var
@@ -33358,7 +33747,7 @@
       /*<<ephemeron.ml:539:8>>*/ return  /*<<ephemeron.ml:539:8>>*/ caml_call2
              (H1[2], seed, k1)
             + _O_
-            | 0;
+            | 0 /*<<ephemeron.ml:539:8>>*/ ;
     }
     function equal(c, param){
       /*<<ephemeron.ml:541:14>>*/ var
@@ -33371,10 +33760,10 @@
        /*<<ephemeron.ml:544:15>>*/ if
        ( /*<<ephemeron.ml:544:15>>*/ caml_call2(H1[1], k1, k1$0)
         &&  /*<<ephemeron.ml:544:34>>*/ caml_call2(H2[1], k2, k2$0))
-        /*<<ephemeron.ml:545:17>>*/ return 0;
-       /*<<ephemeron.ml:545:41>>*/ return 1;
+        /*<<ephemeron.ml:545:17>>*/ return 0 /*<<ephemeron.ml:545:17>>*/ ;
+       /*<<ephemeron.ml:545:41>>*/ return 1 /*<<ephemeron.ml:545:41>>*/ ;
      }
-      /*<<ephemeron.ml:542:32>>*/ return 2;
+      /*<<ephemeron.ml:542:32>>*/ return 2 /*<<ephemeron.ml:542:32>>*/ ;
     }
     function set_key_data(c, param, d){
      var k2 = param[2], k1 = param[1];
@@ -33382,7 +33771,7 @@
       (Stdlib_Obj[23][12], c);
       /*<<ephemeron.ml:549:8>>*/ set_key1(c, k1);
       /*<<ephemeron.ml:549:23>>*/ set_key2(c, k2);
-      /*<<ephemeron.ml:549:23>>*/ return set_data$0(c, d);
+      /*<<ephemeron.ml:549:23>>*/ return set_data$0(c, d) /*<<ephemeron.ml:549:23>>*/ ;
     }
     function check_key(c){
       /*<<ephemeron.ml:551:24>>*/  /*<<ephemeron.ml:496:45>>*/ var
@@ -33390,7 +33779,7 @@
       /*<<ephemeron.ml:551:24>>*/ return _N_
              ?  /*<<ephemeron.ml:501:45>>*/ caml_call2
                (Stdlib_Obj[23][7], c, 1)
-             : _N_;
+             : _N_ /*<<ephemeron.ml:551:52>>*/ ;
      /*<<ephemeron.ml:551:52>>*/ }
      /*<<ephemeron.ml:530:28>>*/ return MakeSeeded
             ([0,
@@ -33399,18 +33788,18 @@
               equal,
               get_data$0,
               set_key_data,
-              check_key]);
+              check_key]) /*<<ephemeron.ml:530:28>>*/ ;
    }
    function Make$0(H1, H2){
     var equal = H2[1];
     function seeded_hash(seed, x){
       /*<<ephemeron.ml:566:43>>*/ return  /*<<ephemeron.ml:566:43>>*/ caml_call1
-             (H2[2], x);
+             (H2[2], x) /*<<ephemeron.ml:566:52>>*/ ;
      /*<<ephemeron.ml:566:52>>*/ }
     var equal$0 = H1[1];
     function seeded_hash$0(seed, x){
       /*<<ephemeron.ml:561:43>>*/ return  /*<<ephemeron.ml:561:43>>*/ caml_call1
-             (H1[2], x);
+             (H1[2], x) /*<<ephemeron.ml:561:52>>*/ ;
      /*<<ephemeron.ml:561:52>>*/ }
     var
      include =
@@ -33434,14 +33823,14 @@
      stats_alive = include[18];
     function create(sz){
       /*<<ephemeron.ml:568:20>>*/ return  /*<<ephemeron.ml:568:20>>*/ caml_call2
-             (_M_, _b_, sz);
+             (_M_, _b_, sz) /*<<ephemeron.ml:568:43>>*/ ;
      /*<<ephemeron.ml:568:43>>*/ }
     function of_seq(i){
       /*<<ephemeron.ml:570:6>>*/  /*<<ephemeron.ml:568:20>>*/ var
       tbl =  /*<<ephemeron.ml:568:20>>*/ caml_call2(_M_, _b_, 16);
       /*<<ephemeron.ml:571:6>>*/  /*<<ephemeron.ml:571:6>>*/ caml_call2
       (replace_seq, tbl, i);
-      /*<<ephemeron.ml:571:6>>*/ return tbl;
+      /*<<ephemeron.ml:571:6>>*/ return tbl /*<<ephemeron.ml:571:6>>*/ ;
      /*<<ephemeron.ml:572:9>>*/ }
      /*<<ephemeron.ml:556:2>>*/ return [0,
             create,
@@ -33461,10 +33850,10 @@
             replace_seq,
             of_seq,
             clean,
-            stats_alive];
+            stats_alive] /*<<ephemeron.ml:556:2>>*/ ;
    }
    function make$2(param){
-     /*<<ephemeron.ml:579:18>>*/ return [0, 0];
+     /*<<ephemeron.ml:579:18>>*/ return [0, 0] /*<<ephemeron.ml:579:18>>*/ ;
     /*<<ephemeron.ml:579:24>>*/ }
    function add$0(b, k1, k2, d){
      /*<<ephemeron.ml:580:24>>*/ var _L_ = b[1];
@@ -33477,14 +33866,16 @@
       /*<<ephemeron.ml:583:24>>*/ match$0 = get_key2(e);
     if(match && match$0){
      var x2 = match$0[1], x1 = match[1];
-     if(x1 === k1 && x2 === k2)  /*<<ephemeron.ml:584:54>>*/ return 1;
+     if(x1 === k1 && x2 === k2)
+       /*<<ephemeron.ml:584:54>>*/ return 1 /*<<ephemeron.ml:584:54>>*/ ;
     }
-     /*<<ephemeron.ml:585:13>>*/ return 0;
+     /*<<ephemeron.ml:585:13>>*/ return 0 /*<<ephemeron.ml:585:13>>*/ ;
     /*<<ephemeron.ml:585:18>>*/ }
    function remove$0(b, k1, k2){
      /*<<ephemeron.ml:588:6>>*/ var l$0 = b[1], l = l$0, acc = 0;
      /*<<ephemeron.ml:589:8>>*/ for(;;){
-     if(! l)  /*<<ephemeron.ml:590:16>>*/ return 0;
+     if(! l)
+       /*<<ephemeron.ml:590:16>>*/ return 0 /*<<ephemeron.ml:590:16>>*/ ;
      var h = l[1], t = l[2];
       /*<<ephemeron.ml:591:22>>*/ if(test_keys(k1, k2, h)){
       b[1] =  /*<<ephemeron.ml:591:48>>*/ caml_call2(Stdlib_List[13], acc, t);
@@ -33504,12 +33895,13 @@
         (Stdlib_List[40],
          function(_K_){ /*<<?>>*/ return test_keys(k1, k2, _K_);},
          b[1]);
-    if(! match)  /*<<ephemeron.ml:599:16>>*/ return 0;
+    if(! match)
+      /*<<ephemeron.ml:599:16>>*/ return 0 /*<<ephemeron.ml:599:16>>*/ ;
     var e = match[1];
-     /*<<ephemeron.ml:598:18>>*/ return get_data$0(e);
+     /*<<ephemeron.ml:598:18>>*/ return get_data$0(e) /*<<ephemeron.ml:599:20>>*/ ;
     /*<<ephemeron.ml:599:20>>*/ }
    function length$0(b){
-     /*<<ephemeron.ml:601:19>>*/ return caml_call1(Stdlib_List[1], b[1]);
+     /*<<ephemeron.ml:601:19>>*/ return caml_call1(Stdlib_List[1], b[1]) /*<<ephemeron.ml:601:33>>*/ ;
     /*<<ephemeron.ml:601:33>>*/ }
    function clear$0(b){
      /*<<ephemeron.ml:602:18>>*/ b[1] = 0;
@@ -33517,29 +33909,29 @@
     /*<<ephemeron.ml:602:25>>*/ }
    function create$1(n){
      /*<<ephemeron.ml:611:29>>*/ return  /*<<ephemeron.ml:611:29>>*/ caml_call1
-            (Stdlib_Obj[23][1], n);
+            (Stdlib_Obj[23][1], n) /*<<ephemeron.ml:611:44>>*/ ;
     /*<<ephemeron.ml:611:44>>*/ }
    function length$1(k){
      /*<<ephemeron.ml:612:35>>*/ return  /*<<ephemeron.ml:612:35>>*/ caml_call1
-            (Stdlib_Obj[23][2], k);
+            (Stdlib_Obj[23][2], k) /*<<ephemeron.ml:612:50>>*/ ;
     /*<<ephemeron.ml:612:50>>*/ }
    function get_key$0(t, n){
      /*<<ephemeron.ml:614:50>>*/  /*<<ephemeron.ml:614:58>>*/ var
      x =  /*<<ephemeron.ml:614:58>>*/ caml_call2(Stdlib_Obj[23][3], t, n);
-     /*<<ephemeron.ml:388:51>>*/ return x;
+     /*<<ephemeron.ml:388:51>>*/ return x /*<<ephemeron.ml:388:51>>*/ ;
     /*<<ephemeron.ml:614:78>>*/ }
    function set_key$0(t, n, k){
      /*<<ephemeron.ml:616:4>>*/ return  /*<<ephemeron.ml:616:4>>*/ caml_call3
-            (Stdlib_Obj[23][5], t, n, k);
+            (Stdlib_Obj[23][5], t, n, k) /*<<ephemeron.ml:616:35>>*/ ;
     /*<<ephemeron.ml:616:35>>*/ }
    function get_data$1(t){
      /*<<ephemeron.ml:619:43>>*/  /*<<ephemeron.ml:619:51>>*/ var
      x =  /*<<ephemeron.ml:619:51>>*/ caml_call1(Stdlib_Obj[23][9], t);
-     /*<<ephemeron.ml:388:51>>*/ return x;
+     /*<<ephemeron.ml:388:51>>*/ return x /*<<ephemeron.ml:388:51>>*/ ;
     /*<<ephemeron.ml:619:70>>*/ }
    function set_data$1(t, d){
      /*<<ephemeron.ml:620:45>>*/ return  /*<<ephemeron.ml:620:45>>*/ caml_call2
-            (Stdlib_Obj[23][11], t, d);
+            (Stdlib_Obj[23][11], t, d) /*<<ephemeron.ml:620:75>>*/ ;
     /*<<ephemeron.ml:620:75>>*/ }
    function make$3(keys, data){
      /*<<ephemeron.ml:624:4>>*/ var
@@ -33560,7 +33952,7 @@
       i = _J_;
      }
     }
-     /*<<ephemeron.ml:628:4>>*/ return eph;
+     /*<<ephemeron.ml:628:4>>*/ return eph /*<<ephemeron.ml:628:4>>*/ ;
     /*<<ephemeron.ml:628:7>>*/ }
    function query$1(eph, keys){
      /*<<ephemeron.ml:631:4>>*/  /*<<ephemeron.ml:631:12>>*/ var
@@ -33592,11 +33984,12 @@
      }
       /*<<ephemeron.ml:640:6>>*/  /*<<ephemeron.ml:640:6>>*/ var
       _E_ = get_data$1(eph);
-      /*<<ephemeron.ml:640:6>>*/ return _E_;
+      /*<<ephemeron.ml:640:6>>*/ return _E_ /*<<ephemeron.ml:640:6>>*/ ;
     }
     catch(_G_){
      var _B_ = caml_wrap_exception(_G_);
-     if(_B_ === Stdlib[3])  /*<<ephemeron.ml:641:17>>*/ return 0;
+     if(_B_ === Stdlib[3])
+       /*<<ephemeron.ml:641:17>>*/ return 0 /*<<ephemeron.ml:641:17>>*/ ;
      throw caml_maybe_attach_backtrace(_B_, 0);
     }
     /*<<ephemeron.ml:641:21>>*/ }
@@ -33619,7 +34012,7 @@
        i = _A_;
       }
      }
-      /*<<ephemeron.ml:653:8>>*/ return c;
+      /*<<ephemeron.ml:653:8>>*/ return c /*<<ephemeron.ml:653:8>>*/ ;
      /*<<ephemeron.ml:653:9>>*/ }
     function seeded_hash(seed, k){
       /*<<ephemeron.ml:655:8>>*/ var
@@ -33648,21 +34041,24 @@
       /*<<ephemeron.ml:661:8>>*/ var
       len = k.length - 1,
        /*<<ephemeron.ml:662:19>>*/ len$0 = length$1(c);
-     if(len !== len$0)  /*<<ephemeron.ml:663:28>>*/ return 1;
+     if(len !== len$0)
+       /*<<ephemeron.ml:663:28>>*/ return 1 /*<<ephemeron.ml:663:28>>*/ ;
       /*<<ephemeron.ml:675:10>>*/ var
        /*<<ephemeron.ml:675:10>>*/ i$1 = len - 1 | 0,
       i = i$1;
       /*<<ephemeron.ml:666:12>>*/ for(;;){
-      if(0 > i)  /*<<ephemeron.ml:666:26>>*/ return 0;
+      if(0 > i)
+        /*<<ephemeron.ml:666:26>>*/ return 0 /*<<ephemeron.ml:666:26>>*/ ;
        /*<<ephemeron.ml:668:20>>*/  /*<<ephemeron.ml:668:20>>*/ var
        match = get_key$0(c, i);
-      if(! match)  /*<<ephemeron.ml:669:24>>*/ return 2;
+      if(! match)
+        /*<<ephemeron.ml:669:24>>*/ return 2 /*<<ephemeron.ml:669:24>>*/ ;
        /*<<ephemeron.ml:671:29>>*/ var
        ki = match[1],
         /*<<ephemeron.ml:671:29>>*/ _s_ = caml_check_bound(k, i)[1 + i];
        /*<<ephemeron.ml:671:21>>*/ if
        (!  /*<<ephemeron.ml:671:21>>*/ caml_call2(H[1], _s_, ki))
-        /*<<ephemeron.ml:673:23>>*/ return 1;
+        /*<<ephemeron.ml:673:23>>*/ return 1 /*<<ephemeron.ml:673:23>>*/ ;
        /*<<ephemeron.ml:672:23>>*/  /*<<ephemeron.ml:672:23>>*/ var
        i$0 = i - 1 | 0;
       i = i$0;
@@ -33685,7 +34081,7 @@
        i = _r_;
       }
      }
-      /*<<ephemeron.ml:682:8>>*/ return set_data$1(c, d);
+      /*<<ephemeron.ml:682:8>>*/ return set_data$1(c, d) /*<<ephemeron.ml:682:20>>*/ ;
      /*<<ephemeron.ml:682:20>>*/ }
     function check_key(c){
       /*<<ephemeron.ml:684:8>>*/ var
@@ -33715,13 +34111,13 @@
               equal,
               get_data$1,
               set_key_data,
-              check_key]);
+              check_key]) /*<<ephemeron.ml:644:28>>*/ ;
    }
    function Make$1(H){
     var equal = H[1];
     function seeded_hash(seed, x){
       /*<<ephemeron.ml:694:41>>*/ return  /*<<ephemeron.ml:694:41>>*/ caml_call1
-             (H[2], x);
+             (H[2], x) /*<<ephemeron.ml:694:49>>*/ ;
      /*<<ephemeron.ml:694:49>>*/ }
     var
      include = MakeSeeded$2([0, equal, seeded_hash]),
@@ -33744,14 +34140,14 @@
      stats_alive = include[18];
     function create(sz){
       /*<<ephemeron.ml:696:20>>*/ return  /*<<ephemeron.ml:696:20>>*/ caml_call2
-             (_l_, _c_, sz);
+             (_l_, _c_, sz) /*<<ephemeron.ml:696:43>>*/ ;
      /*<<ephemeron.ml:696:43>>*/ }
     function of_seq(i){
       /*<<ephemeron.ml:698:6>>*/  /*<<ephemeron.ml:696:20>>*/ var
       tbl =  /*<<ephemeron.ml:696:20>>*/ caml_call2(_l_, _c_, 16);
       /*<<ephemeron.ml:699:6>>*/  /*<<ephemeron.ml:699:6>>*/ caml_call2
       (replace_seq, tbl, i);
-      /*<<ephemeron.ml:699:6>>*/ return tbl;
+      /*<<ephemeron.ml:699:6>>*/ return tbl /*<<ephemeron.ml:699:6>>*/ ;
      /*<<ephemeron.ml:700:9>>*/ }
      /*<<ephemeron.ml:690:2>>*/ return [0,
             create,
@@ -33771,10 +34167,10 @@
             replace_seq,
             of_seq,
             clean,
-            stats_alive];
+            stats_alive] /*<<ephemeron.ml:690:2>>*/ ;
    }
    function make$4(param){
-     /*<<ephemeron.ml:707:18>>*/ return [0, 0];
+     /*<<ephemeron.ml:707:18>>*/ return [0, 0] /*<<ephemeron.ml:707:18>>*/ ;
     /*<<ephemeron.ml:707:24>>*/ }
    function add$1(b, k, d){
      /*<<ephemeron.ml:708:20>>*/ var _k_ = b[1];
@@ -33809,18 +34205,20 @@
       }
      }
       /*<<ephemeron.ml:718:8>>*/  /*<<ephemeron.ml:718:8>>*/ var _h_ = 1;
-      /*<<ephemeron.ml:718:8>>*/ return _h_;
+      /*<<ephemeron.ml:718:8>>*/ return _h_ /*<<ephemeron.ml:718:8>>*/ ;
     }
     catch(_j_){
      var _e_ = caml_wrap_exception(_j_);
-     if(_e_ === Stdlib[3])  /*<<ephemeron.ml:719:19>>*/ return 0;
+     if(_e_ === Stdlib[3])
+       /*<<ephemeron.ml:719:19>>*/ return 0 /*<<ephemeron.ml:719:19>>*/ ;
      throw caml_maybe_attach_backtrace(_e_, 0);
     }
     /*<<ephemeron.ml:719:24>>*/ }
    function remove$1(b, k){
      /*<<ephemeron.ml:722:6>>*/ var l$0 = b[1], l = l$0, acc = 0;
      /*<<ephemeron.ml:723:8>>*/ for(;;){
-     if(! l)  /*<<ephemeron.ml:724:16>>*/ return 0;
+     if(! l)
+       /*<<ephemeron.ml:724:16>>*/ return 0 /*<<ephemeron.ml:724:16>>*/ ;
      var h = l[1], t = l[2];
       /*<<ephemeron.ml:725:22>>*/ if(test_keys$0(k, h)){
       b[1] =  /*<<ephemeron.ml:725:44>>*/ caml_call2(Stdlib_List[13], acc, t);
@@ -33840,12 +34238,13 @@
         (Stdlib_List[40],
          function(_d_){ /*<<?>>*/ return test_keys$0(k, _d_);},
          b[1]);
-    if(! match)  /*<<ephemeron.ml:733:16>>*/ return 0;
+    if(! match)
+      /*<<ephemeron.ml:733:16>>*/ return 0 /*<<ephemeron.ml:733:16>>*/ ;
     var e = match[1];
-     /*<<ephemeron.ml:732:18>>*/ return get_data$1(e);
+     /*<<ephemeron.ml:732:18>>*/ return get_data$1(e) /*<<ephemeron.ml:733:20>>*/ ;
     /*<<ephemeron.ml:733:20>>*/ }
    function length$2(b){
-     /*<<ephemeron.ml:735:19>>*/ return caml_call1(Stdlib_List[1], b[1]);
+     /*<<ephemeron.ml:735:19>>*/ return caml_call1(Stdlib_List[1], b[1]) /*<<ephemeron.ml:735:33>>*/ ;
     /*<<ephemeron.ml:735:33>>*/ }
    function clear$1(b){
      /*<<ephemeron.ml:736:18>>*/ b[1] = 0;
@@ -33970,12 +34369,12 @@
     Stdlib_Sys = global_data.Stdlib__Sys;
    function generic_basename(is_dir_sep, current_dir_name, name){
      /*<<filename.ml:37:2>>*/ if(name == cst$19)
-      /*<<filename.ml:47:7>>*/ return current_dir_name;
+      /*<<filename.ml:47:7>>*/ return current_dir_name /*<<filename.ml:47:7>>*/ ;
     var n$3 = caml_ml_string_length(name) - 1 | 0, n = n$3;
      /*<<filename.ml:38:4>>*/ for(;;){
      if(0 > n)
        /*<<filename.ml:38:18>>*/ return  /*<<filename.ml:38:18>>*/ caml_call3
-              (Stdlib_String[16], name, 0, 1);
+              (Stdlib_String[16], name, 0, 1) /*<<filename.ml:48:40>>*/ ;
       /*<<filename.ml:39:12>>*/ if
       (!  /*<<filename.ml:39:12>>*/ caml_call2(is_dir_sep, name, n))
       break;
@@ -33989,23 +34388,23 @@
      /*<<filename.ml:42:4>>*/ for(;;){
      if(0 > n$1)
        /*<<filename.ml:42:18>>*/ return  /*<<filename.ml:42:18>>*/ caml_call3
-              (Stdlib_String[16], name, 0, p);
+              (Stdlib_String[16], name, 0, p) /*<<filename.ml:48:40>>*/ ;
       /*<<filename.ml:43:12>>*/ if
       ( /*<<filename.ml:43:12>>*/ caml_call2(is_dir_sep, name, n$1))
        /*<<filename.ml:37:2>>*/ return  /*<<filename.ml:37:2>>*/ caml_call3
-              (Stdlib_String[16], name, n$1 + 1 | 0, (p - n$1 | 0) - 1 | 0);
+              (Stdlib_String[16], name, n$1 + 1 | 0, (p - n$1 | 0) - 1 | 0) /*<<filename.ml:48:40>>*/ ;
      var n$2 = n$1 - 1 | 0;
      n$1 = n$2;
     }
     /*<<filename.ml:48:40>>*/ }
    function generic_dirname(is_dir_sep, current_dir_name, name){
      /*<<filename.ml:55:2>>*/ if(name == cst$19)
-      /*<<filename.ml:69:7>>*/ return current_dir_name;
+      /*<<filename.ml:69:7>>*/ return current_dir_name /*<<filename.ml:69:7>>*/ ;
     var n$5 = caml_ml_string_length(name) - 1 | 0, n = n$5;
      /*<<filename.ml:56:4>>*/ for(;;){
      if(0 > n)
        /*<<filename.ml:56:18>>*/ return  /*<<filename.ml:56:18>>*/ caml_call3
-              (Stdlib_String[16], name, 0, 1);
+              (Stdlib_String[16], name, 0, 1) /*<<filename.ml:70:44>>*/ ;
       /*<<filename.ml:57:12>>*/ if
       (!  /*<<filename.ml:57:12>>*/ caml_call2(is_dir_sep, name, n))
       break;
@@ -34027,11 +34426,11 @@
      /*<<filename.ml:64:4>>*/ for(;;){
      if(0 > n$3)
        /*<<filename.ml:64:18>>*/ return  /*<<filename.ml:64:18>>*/ caml_call3
-              (Stdlib_String[16], name, 0, 1);
+              (Stdlib_String[16], name, 0, 1) /*<<filename.ml:70:44>>*/ ;
       /*<<filename.ml:65:12>>*/ if
       (!  /*<<filename.ml:65:12>>*/ caml_call2(is_dir_sep, name, n$3))
        /*<<filename.ml:66:9>>*/ return  /*<<filename.ml:66:9>>*/ caml_call3
-              (Stdlib_String[16], name, 0, n$3 + 1 | 0);
+              (Stdlib_String[16], name, 0, n$3 + 1 | 0) /*<<filename.ml:70:44>>*/ ;
       /*<<filename.ml:65:35>>*/  /*<<filename.ml:65:35>>*/ var
       n$4 = n$3 - 1 | 0;
      n$3 = n$4;
@@ -34079,17 +34478,18 @@
     }
     else
      var _aG_ = _aC_;
-     /*<<filename.ml:101:31>>*/ return _aG_;
+     /*<<filename.ml:101:31>>*/ return _aG_ /*<<filename.ml:101:31>>*/ ;
     /*<<filename.ml:101:57>>*/ }
    function check_suffix(name, suff){
      /*<<filename.ml:103:4>>*/ return  /*<<filename.ml:103:4>>*/ caml_call2
-            (Stdlib_String[12], suff, name);
+            (Stdlib_String[12], suff, name) /*<<filename.ml:103:38>>*/ ;
     /*<<filename.ml:103:38>>*/ }
    function chop_suffix_opt(suffix, filename){
      /*<<filename.ml:106:4>>*/ var
      len_s = caml_ml_string_length(suffix),
      len_f = caml_ml_string_length(filename);
-    if(len_s > len_f)  /*<<filename.ml:114:6>>*/ return 0;
+    if(len_s > len_f)
+      /*<<filename.ml:114:6>>*/ return 0 /*<<filename.ml:114:6>>*/ ;
      /*<<filename.ml:108:14>>*/  /*<<filename.ml:108:14>>*/ var
      r =
         /*<<filename.ml:108:14>>*/ caml_call3
@@ -34098,7 +34498,7 @@
             ? [0,
                /*<<filename.ml:110:13>>*/ caml_call3
                (Stdlib_String[16], filename, 0, len_f - len_s | 0)]
-            : 0;
+            : 0 /*<<filename.ml:114:10>>*/ ;
     /*<<filename.ml:114:10>>*/ }
    var
     dummy = 0,
@@ -34158,7 +34558,7 @@
      /*<<filename.ml:25:2>>*/  /*<<filename.ml:25:2>>*/ caml_call2
      (Stdlib_Buffer[12], b, 39);
      /*<<filename.ml:25:2>>*/ return  /*<<filename.ml:25:2>>*/ caml_call1
-            (Stdlib_Buffer[2], b);
+            (Stdlib_Buffer[2], b) /*<<filename.ml:25:2>>*/ ;
    }
    function quote_command(cmd, stdin, stdout, stderr, args){
      /*<<filename.ml:120:4>>*/ if(stderr){
@@ -34199,7 +34599,7 @@
       /*<<filename.ml:120:4>>*/ _av_ =
         /*<<filename.ml:120:4>>*/ caml_call2(Stdlib_String[7], cst$1, _au_);
      /*<<filename.ml:121:6>>*/ return  /*<<filename.ml:121:6>>*/ caml_call2
-            (Stdlib[28], _av_, _at_);
+            (Stdlib[28], _av_, _at_) /*<<filename.ml:125:69>>*/ ;
     /*<<filename.ml:125:69>>*/ }
     /*<<filename.ml:126:17>>*/ function basename(_al_){
      /*<<?>>*/ return generic_basename(is_dir_sep, current_dir_name, _al_);
@@ -34315,7 +34715,7 @@
     }
     else
      var _aa_ = _U_;
-     /*<<filename.ml:145:31>>*/ return _aa_;
+     /*<<filename.ml:145:31>>*/ return _aa_ /*<<filename.ml:145:31>>*/ ;
     /*<<filename.ml:145:58>>*/ }
    function check_suffix$0(name, suff){
      /*<<filename.ml:147:3>>*/ var
@@ -34336,13 +34736,14 @@
          : 0;
     else
      var _T_ = _R_;
-     /*<<filename.ml:150:4>>*/ return _T_;
+     /*<<filename.ml:150:4>>*/ return _T_ /*<<filename.ml:150:4>>*/ ;
     /*<<filename.ml:150:59>>*/ }
    function chop_suffix_opt$0(suffix, filename){
      /*<<filename.ml:153:4>>*/ var
      len_s = caml_ml_string_length(suffix),
      len_f = caml_ml_string_length(filename);
-    if(len_s > len_f)  /*<<filename.ml:161:6>>*/ return 0;
+    if(len_s > len_f)
+      /*<<filename.ml:161:6>>*/ return 0 /*<<filename.ml:161:6>>*/ ;
      /*<<filename.ml:155:14>>*/ var
       /*<<filename.ml:155:14>>*/ r =
         /*<<filename.ml:155:14>>*/ caml_call3
@@ -34355,7 +34756,7 @@
             ? [0,
                /*<<filename.ml:157:13>>*/ caml_call3
                (Stdlib_String[16], filename, 0, len_f - len_s | 0)]
-            : 0;
+            : 0 /*<<filename.ml:161:10>>*/ ;
     /*<<filename.ml:161:10>>*/ }
    try{
      /*<<filename.ml:165:8>>*/ var
@@ -34380,24 +34781,24 @@
       /*<<filename.ml:171:6>>*/ for(;;){
       if(i$0 === l)
         /*<<filename.ml:171:20>>*/ return  /*<<filename.ml:171:20>>*/ caml_call2
-               (Stdlib_Buffer[12], b, 34);
+               (Stdlib_Buffer[12], b, 34) /*<<filename.ml:175:48>>*/ ;
        /*<<filename.ml:172:12>>*/  /*<<filename.ml:172:12>>*/ var
        c =  /*<<filename.ml:172:12>>*/ caml_string_get(s, i$0);
       if(34 === c){
        var _N_ = 0;
         /*<<filename.ml:173:16>>*/ if(counter >= 50)
          /*<<filename.ml:173:16>>*/ return  /*<<filename.ml:173:16>>*/ caml_trampoline_return
-                (loop_bs, [0, _N_, i$0]);
+                (loop_bs, [0, _N_, i$0]) /*<<filename.ml:175:48>>*/ ;
        var counter$1 = counter + 1 | 0;
-        /*<<filename.ml:173:16>>*/ return loop_bs(counter$1, _N_, i$0);
+        /*<<filename.ml:173:16>>*/ return loop_bs(counter$1, _N_, i$0) /*<<filename.ml:175:48>>*/ ;
       }
       if(92 === c){
        var _O_ = 0;
         /*<<filename.ml:174:16>>*/ if(counter >= 50)
          /*<<filename.ml:174:16>>*/ return  /*<<filename.ml:174:16>>*/ caml_trampoline_return
-                (loop_bs, [0, _O_, i$0]);
+                (loop_bs, [0, _O_, i$0]) /*<<filename.ml:175:48>>*/ ;
        var counter$0 = counter + 1 | 0;
-        /*<<filename.ml:174:16>>*/ return loop_bs(counter$0, _O_, i$0);
+        /*<<filename.ml:174:16>>*/ return loop_bs(counter$0, _O_, i$0) /*<<filename.ml:175:48>>*/ ;
       }
        /*<<filename.ml:175:16>>*/  /*<<filename.ml:175:16>>*/ caml_call2
        (Stdlib_Buffer[12], b, c);
@@ -34413,7 +34814,7 @@
       if(i$0 === l){
         /*<<filename.ml:178:8>>*/  /*<<filename.ml:178:8>>*/ caml_call2
         (Stdlib_Buffer[12], b, 34);
-        /*<<filename.ml:178:8>>*/ return add_bs(n$0);
+        /*<<filename.ml:178:8>>*/ return add_bs(n$0) /*<<filename.ml:185:9>>*/ ;
       }
        /*<<filename.ml:181:14>>*/  /*<<filename.ml:181:14>>*/ var
        match =  /*<<filename.ml:181:14>>*/ caml_string_get(s, i$0);
@@ -34425,17 +34826,17 @@
         _M_ = i$0 + 1 | 0;
         /*<<filename.ml:182:34>>*/ if(counter >= 50)
          /*<<filename.ml:182:34>>*/ return  /*<<filename.ml:182:34>>*/ caml_trampoline_return
-                (loop$0, [0, _M_]);
+                (loop$0, [0, _M_]) /*<<filename.ml:185:9>>*/ ;
        var counter$1 = counter + 1 | 0;
-        /*<<filename.ml:182:34>>*/ return loop$0(counter$1, _M_);
+        /*<<filename.ml:182:34>>*/ return loop$0(counter$1, _M_) /*<<filename.ml:185:9>>*/ ;
       }
       if(92 !== match){
         /*<<filename.ml:184:18>>*/ add_bs(n$0);
         /*<<filename.ml:184:18>>*/ if(counter >= 50)
          /*<<filename.ml:184:18>>*/ return  /*<<filename.ml:184:18>>*/ caml_trampoline_return
-                (loop$0, [0, i$0]);
+                (loop$0, [0, i$0]) /*<<filename.ml:185:9>>*/ ;
        var counter$0 = counter + 1 | 0;
-        /*<<filename.ml:184:18>>*/ return loop$0(counter$0, i$0);
+        /*<<filename.ml:184:18>>*/ return loop$0(counter$0, i$0) /*<<filename.ml:185:9>>*/ ;
       }
        /*<<filename.ml:183:18>>*/ var
         /*<<filename.ml:183:18>>*/ i$1 = i$0 + 1 | 0,
@@ -34460,7 +34861,7 @@
      /*<<filename.ml:186:66>>*/ }
      /*<<filename.ml:188:4>>*/ loop(0);
      /*<<filename.ml:188:4>>*/ return  /*<<filename.ml:188:4>>*/ caml_call1
-            (Stdlib_Buffer[2], b);
+            (Stdlib_Buffer[2], b) /*<<filename.ml:189:21>>*/ ;
     /*<<filename.ml:189:21>>*/ }
    function quote_cmd_filename(f){
      /*<<filename.ml:222:4>>*/ if
@@ -34469,21 +34870,21 @@
        (Stdlib_String[23],
         function(param){
           /*<<filename.ml:222:21>>*/ if(34 !== param && 37 !== param)
-           /*<<filename.ml:222:57>>*/ return 0;
-          /*<<filename.ml:222:45>>*/ return 1;
+           /*<<filename.ml:222:57>>*/ return 0 /*<<filename.ml:222:57>>*/ ;
+          /*<<filename.ml:222:45>>*/ return 1 /*<<filename.ml:222:45>>*/ ;
          /*<<filename.ml:222:63>>*/ },
         f))
       /*<<filename.ml:224:12>>*/ return  /*<<filename.ml:224:12>>*/ caml_call2
               (Stdlib_String[15], f, 32)
              ?  /*<<filename.ml:225:23>>*/ caml_call2
                (Stdlib_String[7], cst$7, [0, cst$6, [0, f, _c_]])
-             : f;
+             : f /*<<filename.ml:227:7>>*/ ;
      /*<<filename.ml:223:15>>*/  /*<<filename.ml:223:15>>*/ var
      _J_ =
         /*<<filename.ml:223:15>>*/ caml_call2
         (Stdlib[28], cst_Filename_quote_command_bad, f);
      /*<<filename.ml:223:15>>*/ return  /*<<filename.ml:223:15>>*/ caml_call1
-            (Stdlib[2], _J_);
+            (Stdlib[2], _J_) /*<<filename.ml:227:7>>*/ ;
     /*<<filename.ml:227:7>>*/ }
    function quote_command$0(cmd, stdin, stdout, stderr, args){
      /*<<filename.ml:232:4>>*/ if(stderr){
@@ -34547,10 +34948,10 @@
          /*<<filename.ml:216:12>>*/  /*<<filename.ml:216:12>>*/ caml_call2
          (Stdlib_Buffer[12], b, 94);
          /*<<filename.ml:216:12>>*/ return  /*<<filename.ml:216:12>>*/ caml_call2
-                (Stdlib_Buffer[12], b, c);
+                (Stdlib_Buffer[12], b, c) /*<<filename.ml:218:31>>*/ ;
        }
         /*<<filename.ml:218:12>>*/ return  /*<<filename.ml:218:12>>*/ caml_call2
-               (Stdlib_Buffer[12], b, c);
+               (Stdlib_Buffer[12], b, c) /*<<filename.ml:218:31>>*/ ;
        /*<<filename.ml:218:31>>*/ },
       s);
      /*<<filename.ml:232:21>>*/ var
@@ -34563,7 +34964,7 @@
       /*<<filename.ml:232:21>>*/ _G_ =
        [0, cst$12, [0, quote_cmd_filename(cmd), _F_]];
      /*<<filename.ml:232:21>>*/ return  /*<<filename.ml:232:21>>*/ caml_call2
-            (Stdlib_String[7], cst$13, _G_);
+            (Stdlib_String[7], cst$13, _G_) /*<<filename.ml:244:5>>*/ ;
     /*<<filename.ml:244:5>>*/ }
    function drive_and_path(s){
      /*<<filename.ml:252:4>>*/ var
@@ -34593,14 +34994,14 @@
     else
      var _u_ = _s_;
      /*<<filename.ml:252:7>>*/ if(! _u_)
-      /*<<filename.ml:254:9>>*/ return [0, cst$17, s];
+      /*<<filename.ml:254:9>>*/ return [0, cst$17, s] /*<<filename.ml:254:9>>*/ ;
      /*<<filename.ml:253:28>>*/  /*<<filename.ml:253:28>>*/ var
      _v_ =
         /*<<filename.ml:253:28>>*/ caml_call3
         (Stdlib_String[16], s, 2, caml_ml_string_length(s) - 2 | 0);
      /*<<filename.ml:253:9>>*/ return [0,
              /*<<filename.ml:253:10>>*/ caml_call3(Stdlib_String[16], s, 0, 2),
-            _v_];
+            _v_] /*<<filename.ml:253:9>>*/ ;
     /*<<filename.ml:254:16>>*/ }
    function dirname$0(s){
      /*<<filename.ml:256:4>>*/ var
@@ -34610,12 +35011,12 @@
       /*<<filename.ml:257:14>>*/ dir =
        generic_dirname(is_dir_sep$0, current_dir_name$0, path);
      /*<<filename.ml:258:4>>*/ return  /*<<filename.ml:258:4>>*/ caml_call2
-            (Stdlib[28], drive, dir);
+            (Stdlib[28], drive, dir) /*<<filename.ml:258:15>>*/ ;
     /*<<filename.ml:258:15>>*/ }
    function basename$0(s){
      /*<<filename.ml:260:4>>*/ var path = drive_and_path(s)[2];
      /*<<filename.ml:261:4>>*/ return generic_basename
-            (is_dir_sep$0, current_dir_name$0, path);
+            (is_dir_sep$0, current_dir_name$0, path) /*<<filename.ml:261:53>>*/ ;
     /*<<filename.ml:261:53>>*/ }
     /*<<filename.ml:130:25>>*/  /*<<filename.ml:130:25>>*/ var
     Win32 =
@@ -34682,10 +35083,10 @@
          /*<<filename.ml:293:17>>*/ caml_call2
          (Stdlib[28], dir_sep$2, filename);
       /*<<filename.ml:293:17>>*/ return  /*<<filename.ml:293:17>>*/ caml_call2
-             (Stdlib[28], dirname, _p_);
+             (Stdlib[28], dirname, _p_) /*<<filename.ml:293:35>>*/ ;
     }
      /*<<filename.ml:292:7>>*/ return  /*<<filename.ml:292:7>>*/ caml_call2
-            (Stdlib[28], dirname, filename);
+            (Stdlib[28], dirname, filename) /*<<filename.ml:293:35>>*/ ;
     /*<<filename.ml:293:35>>*/ }
    function chop_suffix(name, suff){
      /*<<filename.ml:296:2>>*/ return check_suffix$1(name, suff)
@@ -34695,7 +35096,7 @@
                0,
                caml_ml_string_length(name) - caml_ml_string_length(suff) | 0)
             :  /*<<filename.ml:298:7>>*/ caml_call1
-              (Stdlib[1], cst_Filename_chop_suffix);
+              (Stdlib[1], cst_Filename_chop_suffix) /*<<filename.ml:298:41>>*/ ;
     /*<<filename.ml:298:41>>*/ }
    function extension_len(name){
      /*<<filename.ml:301:2>>*/ var
@@ -34711,7 +35112,7 @@
       i0 = i$2;
       continue;
      }
-      /*<<filename.ml:307:39>>*/ return 0;
+      /*<<filename.ml:307:39>>*/ return 0 /*<<filename.ml:307:39>>*/ ;
     }
      /*<<filename.ml:308:32>>*/ var
       /*<<filename.ml:308:32>>*/ i$1 = i0 - 1 | 0,
@@ -34726,7 +35127,7 @@
       i = i$0;
       continue;
      }
-      /*<<filename.ml:302:39>>*/ return 0;
+      /*<<filename.ml:302:39>>*/ return 0 /*<<filename.ml:302:39>>*/ ;
     }
     /*<<filename.ml:311:37>>*/ }
    function extension(name){
@@ -34738,7 +35139,7 @@
               (Stdlib_String[16],
                name,
                caml_ml_string_length(name) - l | 0,
-               l);
+               l) /*<<filename.ml:315:66>>*/ ;
     /*<<filename.ml:315:66>>*/ }
    function chop_extension(name){
      /*<<filename.ml:318:2>>*/  /*<<filename.ml:318:10>>*/ var
@@ -34750,7 +35151,7 @@
               (Stdlib_String[16],
                name,
                0,
-               caml_ml_string_length(name) - l | 0);
+               caml_ml_string_length(name) - l | 0) /*<<filename.ml:320:49>>*/ ;
     /*<<filename.ml:320:49>>*/ }
    function remove_extension(name){
      /*<<filename.ml:323:2>>*/  /*<<filename.ml:323:10>>*/ var
@@ -34761,7 +35162,7 @@
               (Stdlib_String[16],
                name,
                0,
-               caml_ml_string_length(name) - l | 0);
+               caml_ml_string_length(name) - l | 0) /*<<filename.ml:324:68>>*/ ;
     /*<<filename.ml:324:68>>*/ }
     /*<<filename.ml:330:2>>*/  /*<<filename.ml:330:2>>*/ var
     prng_key =
@@ -34778,7 +35179,7 @@
      /*<<filename.ml:335:18>>*/ return concat
             (temp_dir,
               /*<<filename.ml:335:18>>*/ caml_call4
-              (Stdlib_Printf[4], _f_, prefix, rnd, suffix));
+              (Stdlib_Printf[4], _f_, prefix, rnd, suffix)) /*<<filename.ml:335:63>>*/ ;
     /*<<filename.ml:335:63>>*/ }
     /*<<filename.ml:338:2>>*/  /*<<filename.ml:338:2>>*/ var
     current_temp_dir_name =
@@ -34790,11 +35191,11 @@
          /*<<filename.ml:338:71>>*/ });
    function set_temp_dir_name(s){
      /*<<filename.ml:340:26>>*/ return  /*<<filename.ml:340:26>>*/ caml_call2
-            (Stdlib_Domain[10][3], current_temp_dir_name, s);
+            (Stdlib_Domain[10][3], current_temp_dir_name, s) /*<<filename.ml:340:64>>*/ ;
     /*<<filename.ml:340:64>>*/ }
    function get_temp_dir_name(param){
      /*<<filename.ml:341:27>>*/ return caml_call1
-            (Stdlib_Domain[10][2], current_temp_dir_name);
+            (Stdlib_Domain[10][2], current_temp_dir_name) /*<<filename.ml:341:63>>*/ ;
     /*<<filename.ml:341:63>>*/ }
    function temp_file(opt, prefix, suffix){
     var
@@ -34810,7 +35211,7 @@
       /*<<filename.ml:346:4>>*/ try{
        /*<<filename.ml:347:6>>*/  /*<<filename.ml:347:6>>*/ runtime.caml_sys_close
        ( /*<<filename.ml:347:16>>*/ runtime.caml_sys_open(name, _g_, 384));
-       /*<<filename.ml:347:6>>*/ return name;
+       /*<<filename.ml:347:6>>*/ return name /*<<filename.ml:347:6>>*/ ;
      }
      catch(e$0){
       var e = caml_wrap_exception(e$0);
@@ -34844,7 +35245,7 @@
           name,
            /*<<filename.ml:360:7>>*/ caml_call3
            (Stdlib[62], [0, 1, [0, 3, [0, 5, mode]]], perms, name)];
-       /*<<filename.ml:359:6>>*/ return _n_;
+       /*<<filename.ml:359:6>>*/ return _n_ /*<<filename.ml:359:6>>*/ ;
      }
      catch(e$0){
       var e = caml_wrap_exception(e$0);
@@ -34873,7 +35274,7 @@
       /*<<filename.ml:369:4>>*/ try{
        /*<<filename.ml:370:6>>*/  /*<<filename.ml:370:6>>*/ runtime.caml_sys_mkdir
        (name, perms);
-       /*<<filename.ml:370:6>>*/ return name;
+       /*<<filename.ml:370:6>>*/ return name /*<<filename.ml:370:6>>*/ ;
      }
      catch(e$0){
       var e = caml_wrap_exception(e$0);
@@ -34929,21 +35330,21 @@
     i = [254, 0., 1.],
     _a_ = [254, 0., 0.];
    function add(x, y){
-     /*<<complex.ml:24:14>>*/ return [254, x[1] + y[1], x[2] + y[2]];
+     /*<<complex.ml:24:14>>*/ return [254, x[1] + y[1], x[2] + y[2]] /*<<complex.ml:24:14>>*/ ;
     /*<<complex.ml:24:54>>*/ }
    function sub(x, y){
-     /*<<complex.ml:26:14>>*/ return [254, x[1] - y[1], x[2] - y[2]];
+     /*<<complex.ml:26:14>>*/ return [254, x[1] - y[1], x[2] - y[2]] /*<<complex.ml:26:14>>*/ ;
     /*<<complex.ml:26:54>>*/ }
    function neg(x){
-     /*<<complex.ml:28:12>>*/ return [254, - x[1], - x[2]];
+     /*<<complex.ml:28:12>>*/ return [254, - x[1], - x[2]] /*<<complex.ml:28:12>>*/ ;
     /*<<complex.ml:28:42>>*/ }
    function conj(x){
-     /*<<complex.ml:30:13>>*/ return [254, x[1], - x[2]];
+     /*<<complex.ml:30:13>>*/ return [254, x[1], - x[2]] /*<<complex.ml:30:13>>*/ ;
     /*<<complex.ml:30:40>>*/ }
    function mul(x, y){
      /*<<complex.ml:32:14>>*/ return [254,
             x[1] * y[1] - x[2] * y[2],
-            x[1] * y[2] + x[2] * y[1]];
+            x[1] * y[2] + x[2] * y[1]] /*<<complex.ml:32:14>>*/ ;
     /*<<complex.ml:33:51>>*/ }
    function div(x, y){
      /*<<complex.ml:36:2>>*/ if
@@ -34954,37 +35355,37 @@
        /*<<complex.ml:38:12>>*/ d = y[1] + r * y[2];
       /*<<complex.ml:39:4>>*/ return [254,
              (x[1] + r * x[2]) / d,
-             (x[2] - r * x[1]) / d];
+             (x[2] - r * x[1]) / d] /*<<complex.ml:39:4>>*/ ;
     }
      /*<<complex.ml:42:12>>*/ var
       /*<<complex.ml:42:12>>*/ r$0 = y[1] / y[2],
       /*<<complex.ml:43:12>>*/ d$0 = y[2] + r$0 * y[1];
      /*<<complex.ml:44:4>>*/ return [254,
             (r$0 * x[1] + x[2]) / d$0,
-            (r$0 * x[2] - x[1]) / d$0];
+            (r$0 * x[2] - x[1]) / d$0] /*<<complex.ml:44:4>>*/ ;
     /*<<complex.ml:45:37>>*/ }
    function inv(x){
-     /*<<complex.ml:47:12>>*/ return div(one, x);
+     /*<<complex.ml:47:12>>*/ return div(one, x) /*<<complex.ml:47:21>>*/ ;
     /*<<complex.ml:47:21>>*/ }
    function norm2(x){
-     /*<<complex.ml:49:14>>*/ return x[1] * x[1] + x[2] * x[2];
+     /*<<complex.ml:49:14>>*/ return x[1] * x[1] + x[2] * x[2] /*<<complex.ml:49:14>>*/ ;
     /*<<complex.ml:49:42>>*/ }
    function norm(x){
      /*<<complex.ml:51:13>>*/ return  /*<<complex.ml:51:13>>*/ runtime.caml_hypot_float
-            (x[1], x[2]);
+            (x[1], x[2]) /*<<complex.ml:51:34>>*/ ;
     /*<<complex.ml:51:34>>*/ }
    function arg(x){
      /*<<complex.ml:53:12>>*/ return  /*<<complex.ml:53:12>>*/ Math.atan2
-            (x[2], x[1]);
+            (x[2], x[1]) /*<<complex.ml:53:27>>*/ ;
     /*<<complex.ml:53:27>>*/ }
    function polar(n, a){
      /*<<complex.ml:55:16>>*/ return [254,
              /*<<complex.ml:55:23>>*/ Math.cos(a) * n,
-             /*<<complex.ml:55:40>>*/ Math.sin(a) * n];
+             /*<<complex.ml:55:40>>*/ Math.sin(a) * n] /*<<complex.ml:55:16>>*/ ;
     /*<<complex.ml:55:52>>*/ }
    function sqrt(x){
      /*<<complex.ml:58:2>>*/ if(x[1] == 0. && x[2] == 0.)
-      /*<<complex.ml:58:35>>*/ return _a_;
+      /*<<complex.ml:58:35>>*/ return _a_ /*<<complex.ml:58:35>>*/ ;
      /*<<complex.ml:60:12>>*/ var
       /*<<complex.ml:60:12>>*/ r =  /*<<complex.ml:60:12>>*/ Math.abs(x[1]),
       /*<<complex.ml:60:35>>*/ i =  /*<<complex.ml:60:35>>*/ Math.abs(x[2]);
@@ -35004,26 +35405,27 @@
         *
           /*<<complex.ml:67:19>>*/ Math.sqrt
           (0.5 * (q$0 +  /*<<complex.ml:67:37>>*/ Math.sqrt(1. + q$0 * q$0)));
-    if(0. <= x[1])  /*<<complex.ml:70:9>>*/ return [254, w, 0.5 * x[2] / w];
+    if(0. <= x[1])
+      /*<<complex.ml:70:9>>*/ return [254, w, 0.5 * x[2] / w] /*<<complex.ml:70:9>>*/ ;
     var w$0 = 0. <= x[2] ? w : - w;
-     /*<<complex.ml:71:9>>*/ return [254, 0.5 * i / w, w$0];
+     /*<<complex.ml:71:9>>*/ return [254, 0.5 * i / w, w$0] /*<<complex.ml:71:9>>*/ ;
     /*<<complex.ml:72:5>>*/ }
    function exp(x){
      /*<<complex.ml:75:2>>*/  /*<<complex.ml:75:10>>*/ var
      e =  /*<<complex.ml:75:10>>*/ Math.exp(x[1]);
      /*<<complex.ml:75:22>>*/ return [254,
             e *  /*<<complex.ml:75:34>>*/ Math.cos(x[2]),
-            e *  /*<<complex.ml:75:54>>*/ Math.sin(x[2])];
+            e *  /*<<complex.ml:75:54>>*/ Math.sin(x[2])] /*<<complex.ml:75:22>>*/ ;
     /*<<complex.ml:75:64>>*/ }
    function log(x){
      /*<<complex.ml:77:12>>*/  /*<<complex.ml:77:38>>*/ var
      _b_ =  /*<<complex.ml:77:38>>*/ Math.atan2(x[2], x[1]);
      /*<<complex.ml:77:12>>*/ return [254,
              /*<<complex.ml:77:19>>*/ Math.log(norm(x)),
-            _b_];
+            _b_] /*<<complex.ml:77:12>>*/ ;
     /*<<complex.ml:77:55>>*/ }
    function pow(x, y){
-     /*<<complex.ml:79:14>>*/ return exp(mul(y, log(x)));
+     /*<<complex.ml:79:14>>*/ return exp(mul(y, log(x))) /*<<complex.ml:79:33>>*/ ;
     /*<<complex.ml:79:33>>*/ }
    var
     Stdlib_Complex =
@@ -35699,14 +36101,14 @@
        "Stdlib.Effect.Unhandled(%s)"];
    function printer(param){
      /*<<effect.ml:22:16>>*/ if(param[1] !== Unhandled)
-      /*<<effect.ml:28:11>>*/ return 0;
+      /*<<effect.ml:28:11>>*/ return 0 /*<<effect.ml:28:11>>*/ ;
      /*<<effect.ml:25:12>>*/ var
      x = param[2],
       /*<<effect.ml:25:12>>*/ _i_ =
         /*<<effect.ml:25:12>>*/ caml_call1(Stdlib_Printexc[26], x),
       /*<<effect.ml:24:18>>*/ msg =
         /*<<effect.ml:24:18>>*/ caml_call2(Stdlib_Printf[4], _a_, _i_);
-     /*<<effect.ml:27:8>>*/ return [0, msg];
+     /*<<effect.ml:27:8>>*/ return [0, msg] /*<<effect.ml:27:8>>*/ ;
     /*<<effect.ml:28:15>>*/ }
     /*<<effect.ml:30:2>>*/  /*<<effect.ml:30:2>>*/ caml_call1
     (Stdlib_Printexc[9], printer);
@@ -35725,10 +36127,10 @@
      /*<<effect.ml:62:4>>*/  /*<<effect.ml:62:11>>*/ var
      _h_ =  /*<<effect.ml:62:11>>*/ caml_continuation_use_noexc(k);
     function _g_(x){
-      /*<<effect.ml:62:41>>*/ return x;
+      /*<<effect.ml:62:41>>*/ return x /*<<effect.ml:62:41>>*/ ;
      /*<<effect.ml:62:42>>*/ }
      /*<<effect.ml:62:11>>*/ return  /*<<effect.ml:62:11>>*/ jsoo_effect_not_supported
-            ();
+            () /*<<effect.ml:62:65>>*/ ;
     /*<<effect.ml:62:65>>*/ }
    function discontinue(k, e){
      /*<<effect.ml:65:4>>*/  /*<<effect.ml:65:11>>*/ var
@@ -35738,7 +36140,7 @@
             (e, 1);
      /*<<effect.ml:65:48>>*/ }
      /*<<effect.ml:65:11>>*/ return  /*<<effect.ml:65:11>>*/ jsoo_effect_not_supported
-            ();
+            () /*<<effect.ml:65:71>>*/ ;
     /*<<effect.ml:65:71>>*/ }
    function discontinue_with_backtrace(k, e, bt){
      /*<<effect.ml:68:4>>*/  /*<<effect.ml:68:11>>*/ var
@@ -35749,7 +36151,7 @@
             (e, 0);
      /*<<effect.ml:68:75>>*/ }
      /*<<effect.ml:68:11>>*/ return  /*<<effect.ml:68:11>>*/ jsoo_effect_not_supported
-            ();
+            () /*<<effect.ml:69:27>>*/ ;
     /*<<effect.ml:69:27>>*/ }
    function match_with(comp, arg, handler){
     function effc(eff, k, last_fiber){
@@ -35757,16 +36159,16 @@
       match =  /*<<effect.ml:81:12>>*/ caml_call1(handler[3], eff);
      if(! match)
        /*<<effect.ml:85:16>>*/ return  /*<<effect.ml:85:16>>*/ jsoo_effect_not_supported
-              ();
+              () /*<<effect.ml:85:42>>*/ ;
      var f = match[1];
      k[2] = last_fiber;
-      /*<<effect.ml:84:10>>*/ return  /*<<effect.ml:84:10>>*/ caml_call1(f, k);
+      /*<<effect.ml:84:10>>*/ return  /*<<effect.ml:84:10>>*/ caml_call1(f, k) /*<<effect.ml:85:42>>*/ ;
      /*<<effect.ml:85:42>>*/ }
      /*<<effect.ml:87:12>>*/  /*<<effect.ml:87:12>>*/ var
      s =
         /*<<effect.ml:87:12>>*/ caml_alloc_stack(handler[1], handler[2], effc);
      /*<<effect.ml:88:4>>*/ return  /*<<effect.ml:88:4>>*/ jsoo_effect_not_supported
-            ();
+            () /*<<effect.ml:88:23>>*/ ;
     /*<<effect.ml:88:23>>*/ }
    function try_with(comp, arg, handler){
     function effc(eff, k, last_fiber){
@@ -35774,16 +36176,16 @@
       match =  /*<<effect.ml:95:12>>*/ caml_call1(handler[1], eff);
      if(! match)
        /*<<effect.ml:99:16>>*/ return  /*<<effect.ml:99:16>>*/ jsoo_effect_not_supported
-              ();
+              () /*<<effect.ml:99:42>>*/ ;
      var f = match[1];
      k[2] = last_fiber;
-      /*<<effect.ml:98:10>>*/ return  /*<<effect.ml:98:10>>*/ caml_call1(f, k);
+      /*<<effect.ml:98:10>>*/ return  /*<<effect.ml:98:10>>*/ caml_call1(f, k) /*<<effect.ml:99:42>>*/ ;
      /*<<effect.ml:99:42>>*/ }
      /*<<effect.ml:101:12>>*/  /*<<effect.ml:101:12>>*/ var
      s =
         /*<<effect.ml:101:12>>*/ caml_alloc_stack
         (function(x){
-           /*<<effect.ml:101:34>>*/ return x;
+           /*<<effect.ml:101:34>>*/ return x /*<<effect.ml:101:34>>*/ ;
           /*<<effect.ml:101:35>>*/ },
          function(e){
            /*<<effect.ml:101:47>>*/ throw  /*<<effect.ml:101:47>>*/ caml_maybe_attach_backtrace
@@ -35791,7 +36193,7 @@
           /*<<effect.ml:101:54>>*/ },
          effc);
      /*<<effect.ml:102:4>>*/ return  /*<<effect.ml:102:4>>*/ jsoo_effect_not_supported
-            ();
+            () /*<<effect.ml:102:23>>*/ ;
     /*<<effect.ml:102:23>>*/ }
     /*<<effect.ml:46:14>>*/ var
      /*<<effect.ml:46:14>>*/ Deep =
@@ -35811,15 +36213,15 @@
       /*<<effect.ml:125:18>>*/ E = [248, cst_E, caml_fresh_oo_id(0)];
     function f$0(param){
       /*<<effect.ml:126:16>>*/ return  /*<<effect.ml:126:18>>*/ caml_call1
-             (f,  /*<<effect.ml:126:18>>*/ jsoo_effect_not_supported());
+             (f,  /*<<effect.ml:126:18>>*/ jsoo_effect_not_supported()) /*<<effect.ml:126:45>>*/ ;
      /*<<effect.ml:126:45>>*/ }
      /*<<effect.ml:127:4>>*/ function error(param){
       /*<<effect.ml:127:18>>*/ return  /*<<effect.ml:127:18>>*/ caml_call1
-             (Stdlib[2], cst_impossible);
+             (Stdlib[2], cst_impossible) /*<<effect.ml:127:39>>*/ ;
      /*<<effect.ml:127:39>>*/ }
     function effc(eff, k, last_fiber){
       /*<<effect.ml:129:6>>*/ if(eff !== Initial_setup)
-       /*<<effect.ml:133:13>>*/ return error(0);
+       /*<<effect.ml:133:13>>*/ return error(0) /*<<effect.ml:133:21>>*/ ;
      k[2] = last_fiber;
       /*<<effect.ml:132:10>>*/ throw [0, E, k];
      /*<<effect.ml:133:21>>*/ }
@@ -35834,9 +36236,9 @@
      var exn = caml_wrap_exception(exn$0);
      if(exn[1] !== E) throw caml_maybe_attach_backtrace(exn, 0);
      var k = exn[2];
-      /*<<effect.ml:137:23>>*/ return k;
+      /*<<effect.ml:137:23>>*/ return k /*<<effect.ml:137:23>>*/ ;
     }
-     /*<<effect.ml:138:11>>*/ return error(0);
+     /*<<effect.ml:138:11>>*/ return error(0) /*<<effect.ml:138:19>>*/ ;
     /*<<effect.ml:138:19>>*/ }
    function continue_gen(k, resume_fun, v, handler){
     function effc(eff, k, last_fiber){
@@ -35844,27 +36246,27 @@
       match =  /*<<effect.ml:157:12>>*/ caml_call1(handler[3], eff);
      if(! match)
        /*<<effect.ml:161:16>>*/ return  /*<<effect.ml:161:16>>*/ jsoo_effect_not_supported
-              ();
+              () /*<<effect.ml:161:42>>*/ ;
      var f = match[1];
      k[2] = last_fiber;
       /*<<effect.ml:160:10>>*/ return  /*<<effect.ml:160:10>>*/ caml_call1
-             (f, k);
+             (f, k) /*<<effect.ml:161:42>>*/ ;
      /*<<effect.ml:161:42>>*/ }
      /*<<effect.ml:164:16>>*/  /*<<effect.ml:164:16>>*/ var
      stack =
         /*<<effect.ml:164:16>>*/ runtime.caml_continuation_use_and_update_handler_noexc
         (k, handler[1], handler[2], effc);
      /*<<effect.ml:165:4>>*/ return  /*<<effect.ml:165:4>>*/ jsoo_effect_not_supported
-            ();
+            () /*<<effect.ml:165:40>>*/ ;
     /*<<effect.ml:165:40>>*/ }
    function continue_with(k, v, handler){
      /*<<effect.ml:168:4>>*/ return continue_gen
             (k,
              function(x){
-               /*<<effect.ml:168:29>>*/ return x;
+               /*<<effect.ml:168:29>>*/ return x /*<<effect.ml:168:29>>*/ ;
               /*<<effect.ml:168:30>>*/ },
              v,
-             handler);
+             handler) /*<<effect.ml:168:41>>*/ ;
     /*<<effect.ml:168:41>>*/ }
    function discontinue_with(k, v, handler){
      /*<<effect.ml:171:4>>*/ return continue_gen
@@ -35874,7 +36276,7 @@
                      (e, 1);
               /*<<effect.ml:171:36>>*/ },
              v,
-             handler);
+             handler) /*<<effect.ml:171:47>>*/ ;
     /*<<effect.ml:171:47>>*/ }
    function discontinue_with_backtrace$0(k, v, bt, handler){
      /*<<effect.ml:174:4>>*/ return continue_gen
@@ -35885,7 +36287,7 @@
                      (e, 0);
               /*<<effect.ml:174:63>>*/ },
              v,
-             handler);
+             handler) /*<<effect.ml:174:74>>*/ ;
     /*<<effect.ml:174:74>>*/ }
    var
     Stdlib_Effect =
diff --git a/compiler/tests-sourcemap/dump.reference b/compiler/tests-sourcemap/dump.reference
index d9a8cf150c..ff3569b90c 100644
--- a/compiler/tests-sourcemap/dump.reference
+++ b/compiler/tests-sourcemap/dump.reference
@@ -3,5 +3,6 @@ b.ml:1:4 -> 12:   function <>f(x){return x - 1 | 0;}
 b.ml:1:6 -> 14:   function f(<>x){return x - 1 | 0;}
 b.ml:1:10 -> 17:   function f(x){<>return x - 1 | 0;}
 b.ml:1:6 -> 24:   function f(x){return <>x - 1 | 0;}
+b.ml:1:10 -> 33:   function f(x){return x - 1 | 0<>;}
 b.ml:1:15 -> 34:   function f(x){return x - 1 | 0;<>}
 b.ml:1:4 -> 23:   var Testlib_B = [0, <>f];

From d1ecd6b9bd014c64ee15972512dcbb8c21d79da5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 18 Oct 2024 09:55:19 +0200
Subject: [PATCH 404/481] Add location on new expression

---
 compiler/lib/generate.ml          | 2 +-
 compiler/lib/javascript.ml        | 2 +-
 compiler/lib/javascript.mli       | 2 +-
 compiler/lib/js_output.ml         | 6 ++++--
 compiler/lib/js_parser.mly        | 4 ++--
 compiler/lib/js_traverse.ml       | 8 ++++----
 compiler/lib/wasm/wa_gc_target.ml | 3 ++-
 compiler/lib/wasm/wa_link.ml      | 3 ++-
 8 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index cf0e7c4124..fbb8a194e0 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1232,7 +1232,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
                 l
                 ~init:([], mutator_p, queue)
             in
-            ( J.ENew (cc, if List.is_empty args then None else Some args)
+            ( J.ENew (cc, (if List.is_empty args then None else Some args), loc)
             , or_p pc prop
             , queue )
         | Extern "caml_js_get", [ Pv o; Pc (NativeString (Utf f)) ] when J.is_ident' f ->
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index a5a7109240..ca1c8be266 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -280,7 +280,7 @@ and expression =
   | EAccess of expression * access_kind * expression
   | EDot of expression * access_kind * identifier
   | EDotPrivate of expression * access_kind * identifier
-  | ENew of expression * arguments option
+  | ENew of expression * arguments option * location
   | EVar of ident
   | EFun of ident option * function_declaration
   | EClass of ident option * class_declaration
diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli
index 732650be20..499393e3cc 100644
--- a/compiler/lib/javascript.mli
+++ b/compiler/lib/javascript.mli
@@ -197,7 +197,7 @@ and expression =
   | EAccess of expression * access_kind * expression
   | EDot of expression * access_kind * identifier
   | EDotPrivate of expression * access_kind * identifier
-  | ENew of expression * arguments option
+  | ENew of expression * arguments option * location
   | EVar of ident
   | EFun of ident option * function_declaration
   | EClass of ident option * class_declaration
diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml
index 836e43c92e..aa5bb72af0 100644
--- a/compiler/lib/js_output.ml
+++ b/compiler/lib/js_output.ml
@@ -854,12 +854,13 @@ struct
         | ANormal -> PP.string f ".#"
         | ANullish -> PP.string f "?.#");
         PP.string f nm
-    | ENew (e, None) ->
+    | ENew (e, None, loc) ->
         if Prec.(l > NewExpression)
         then (
           PP.start_group f 1;
           PP.string f "(");
         PP.start_group f 1;
+        output_debug_info f loc;
         PP.string f "new";
         PP.space f;
         expression NewExpression f e;
@@ -868,8 +869,9 @@ struct
         then (
           PP.string f ")";
           PP.end_group f)
-    | ENew (e, Some el) ->
+    | ENew (e, Some el, loc) ->
         PP.start_group f 1;
+        output_debug_info f loc;
         PP.string f "new";
         PP.space f;
         expression MemberExpression f e;
diff --git a/compiler/lib/js_parser.mly b/compiler/lib/js_parser.mly
index c433f476cb..014f7f6526 100644
--- a/compiler/lib/js_parser.mly
+++ b/compiler/lib/js_parser.mly
@@ -906,7 +906,7 @@ call_expr(x):
 
 new_expr(x):
  | e=member_expr(x)    { e }
- | T_NEW e=new_expr(d1) { (ENew (e,None)) }
+ | T_NEW e=new_expr(d1) { (ENew (e,None, p $symbolstartpos)) }
 
 access:
   | "." { ANormal }
@@ -924,7 +924,7 @@ member_expr(x):
  | e1=member_expr(x) ak=access i=field_name
      { (EDot(e1,ak,i)) }
  | T_NEW e1=member_expr(d1) a=arguments
-     { (ENew(e1, Some a)) }
+     { (ENew(e1, Some a, p $symbolstartpos)) }
  | e=member_expr(x) t=template_literal
      { ECallTemplate(e, t, p $symbolstartpos) }
  | T_SUPER "[" e=expr "]"
diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml
index ba65d8968f..4636d70011 100644
--- a/compiler/lib/js_traverse.ml
+++ b/compiler/lib/js_traverse.ml
@@ -314,8 +314,8 @@ class map : mapper =
       | EAccess (e1, ak, e2) -> EAccess (m#expression e1, ak, m#expression e2)
       | EDot (e1, ak, id) -> EDot (m#expression e1, ak, id)
       | EDotPrivate (e1, ak, id) -> EDotPrivate (m#expression e1, ak, id)
-      | ENew (e1, args) ->
-          ENew (m#expression e1, Option.map ~f:(List.map ~f:m#argument) args)
+      | ENew (e1, args, loc) ->
+          ENew (m#expression e1, Option.map ~f:(List.map ~f:m#argument) args, m#loc loc)
       | EVar v -> EVar (m#ident v)
       | EFun (idopt, fun_decl) ->
           let idopt = Option.map ~f:m#ident idopt in
@@ -668,10 +668,10 @@ class iter : iterator =
           m#expression e2
       | EDot (e1, _ak, _) -> m#expression e1
       | EDotPrivate (e1, _, _) -> m#expression e1
-      | ENew (e1, Some args) ->
+      | ENew (e1, Some args, _) ->
           m#expression e1;
           List.iter args ~f:m#argument
-      | ENew (e1, None) -> m#expression e1
+      | ENew (e1, None, _) -> m#expression e1
       | EVar v -> m#ident v
       | EFun (idopt, fun_decl) ->
           (match idopt with
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index ce1b619eee..b54a1a571d 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1559,7 +1559,8 @@ let () =
                                , Some
                                    (List.map
                                       ~f:(fun x -> J.Arg (EVar (J.ident x)))
-                                      params) ))
+                                      params)
+                               , N ))
                         , N )
                     , N )
                   ]
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index 1c945156b7..bca6fced07 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -490,7 +490,8 @@ let build_runtime_arguments
                                         (EStr
                                            (Utf8_string.of_string_exn
                                               (nm ^ " not implemented")))
-                                    ] ))
+                                    ]
+                                , N ))
                          , N )
                        ]
                        N

From eba73eb20d659e011d0fba4e27d09bdf23e3d4b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 22 Oct 2024 17:51:15 +0200
Subject: [PATCH 405/481] Move source code location resolution from code output
 to code generation

---
 compiler/bin-wasm_of_ocaml/compile.ml    |  4 ++--
 compiler/lib/wasm/wa_ast.ml              |  2 +-
 compiler/lib/wasm/wa_code_generation.ml  | 10 +++++-----
 compiler/lib/wasm/wa_code_generation.mli |  2 +-
 compiler/lib/wasm/wa_generate.ml         | 12 ++++++++----
 compiler/lib/wasm/wa_generate.mli        |  6 +-----
 compiler/lib/wasm/wa_wat_output.ml       | 14 +++++---------
 compiler/lib/wasm/wa_wat_output.mli      |  2 +-
 8 files changed, 24 insertions(+), 28 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 1d322b5e5a..247664e726 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -161,7 +161,7 @@ let generate_prelude ~out_file =
       ~debug
       program
   in
-  Wa_generate.output ch ~context ~debug;
+  Wa_generate.output ch ~context;
   uinfo.provides
 
 let build_prelude z =
@@ -324,7 +324,7 @@ let run
         program
     in
     if standalone then Wa_generate.add_start_function ~context toplevel_name;
-    Wa_generate.output ch ~context ~debug;
+    Wa_generate.output ch ~context;
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
     generated_js
   in
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 0d3af3a0c5..5bbc49c8bf 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -191,7 +191,7 @@ and instruction =
   | StructSet of var * int * expression * expression
   | Return_call of var * expression list
   | Return_call_ref of var * expression * expression list
-  | Location of Code.loc * instruction
+  | Location of Parse_info.t option * instruction
       (** Instruction with attached location information *)
 
 type import_desc =
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index d4ca6b355b..5bd4718c9f 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -290,11 +290,11 @@ let with_location loc instrs st =
   ( ()
   , { st with
       instrs =
-        (match st.instrs with
-        | [] -> []
-        | Location _ :: _ when Poly.equal loc No -> st.instrs
-        | Location (_, i) :: rem -> Location (loc, i) :: rem
-        | i :: rem -> Location (loc, i) :: rem)
+        (match loc, st.instrs with
+        | _, [] -> []
+        | None, Location _ :: _ -> st.instrs
+        | Some loc, Location (_, i) :: rem -> Location (loc, i) :: rem
+        | _, i :: rem -> Location (Option.value ~default:None loc, i) :: rem)
     } )
 
 let cast ?(nullable = false) typ e =
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 93f4f22f31..456b128265 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -138,7 +138,7 @@ val is_small_constant : Wa_ast.expression -> bool t
 
 val get_i31_value : Wa_ast.var -> Wa_ast.var option t
 
-val with_location : Code.loc -> unit t -> unit t
+val with_location : Parse_info.t option option -> unit t -> unit t
 
 type type_def =
   { supertype : Wa_ast.var option
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 738a1b8bc7..7321352068 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -676,7 +676,9 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   and translate_instr ctx context (i, loc) =
     with_location
-      loc
+      (match loc with
+      | No -> None
+      | _ -> Some (Parse_bytecode.Debug.find_loc ctx.debug loc))
       (match i with
       | Assign (x, y) -> assign x (load y)
       | Let (x, e) ->
@@ -912,7 +914,9 @@ module Generate (Target : Wa_target_sig.S) = struct
           let* () = translate_instrs ctx context block.body in
           let branch, loc = block.branch in
           with_location
-            loc
+            (match loc with
+            | No -> None
+            | _ -> Some (Parse_bytecode.Debug.find_loc ctx.debug loc))
             (match branch with
             | Branch cont -> translate_branch result_typ fall_through pc cont context
             | Return x -> (
@@ -1223,10 +1227,10 @@ let add_init_function =
   let module G = Generate (Wa_gc_target) in
   G.add_init_function
 
-let output ch ~context ~debug =
+let output ch ~context =
   let module G = Generate (Wa_gc_target) in
   let fields = G.output ~context in
-  Wa_wat_output.f ~debug ch fields
+  Wa_wat_output.f ch fields
 
 let wasm_output ch ~context =
   let module G = Generate (Wa_gc_target) in
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib/wasm/wa_generate.mli
index e376410fb4..07125b139f 100644
--- a/compiler/lib/wasm/wa_generate.mli
+++ b/compiler/lib/wasm/wa_generate.mli
@@ -34,10 +34,6 @@ val add_start_function : context:Wa_code_generation.context -> Wa_ast.var -> uni
 
 val add_init_function : context:Wa_code_generation.context -> to_link:string list -> unit
 
-val output :
-     out_channel
-  -> context:Wa_code_generation.context
-  -> debug:Parse_bytecode.Debug.t
-  -> unit
+val output : out_channel -> context:Wa_code_generation.context -> unit
 
 val wasm_output : out_channel -> context:Wa_code_generation.context -> unit
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index ef157c69e2..5b20b910ae 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -280,10 +280,7 @@ let select i32 i64 f32 f64 op =
   | F32 x -> f32 "32" x
   | F64 x -> f64 "64" x
 
-type ctx =
-  { mutable function_refs : Code.Var.Set.t
-  ; debug : Parse_bytecode.Debug.t
-  }
+type ctx = { mutable function_refs : Code.Var.Set.t }
 
 let reference_function ctx f = ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
 
@@ -523,11 +520,10 @@ let expression_or_instructions ctx st in_function =
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | Location (loc, i) -> (
-        let loc = Generate.source_location ctx.debug loc in
         match loc with
-        | Javascript.N | U | Pi Parse_info.{ src = None; _ } ->
+        | None | Some Parse_info.{ src = None | Some ""; _ } ->
             Comment "@" :: instruction i
-        | Pi Parse_info.{ src = Some src; col; line; _ } ->
+        | Some Parse_info.{ src = Some src; col; line; _ } ->
             let loc = Format.sprintf "%s:%d:%d" src line col in
             Comment ("@ " ^ loc) :: instruction i)
   and instructions l = List.concat (List.map ~f:instruction l) in
@@ -630,9 +626,9 @@ let field ctx st f =
   | Type [ t ] -> [ type_field st t ]
   | Type l -> [ List (Atom "rec" :: List.map ~f:(type_field st) l) ]
 
-let f ~debug ch fields =
+let f ch fields =
   let st = build_name_tables fields in
-  let ctx = { function_refs = Code.Var.Set.empty; debug } in
+  let ctx = { function_refs = Code.Var.Set.empty } in
   let other_fields = List.concat (List.map ~f:(fun f -> field ctx st f) fields) in
   let funct_decl =
     let functions = Code.Var.Set.elements ctx.function_refs in
diff --git a/compiler/lib/wasm/wa_wat_output.mli b/compiler/lib/wasm/wa_wat_output.mli
index b589af12b2..3a2fc50a10 100644
--- a/compiler/lib/wasm/wa_wat_output.mli
+++ b/compiler/lib/wasm/wa_wat_output.mli
@@ -16,4 +16,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : debug:Parse_bytecode.Debug.t -> out_channel -> Wa_ast.module_field list -> unit
+val f : out_channel -> Wa_ast.module_field list -> unit

From fdbc151cda8ec3239cbf8eb7d500ea7aaeee6cbb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 24 Oct 2024 17:12:35 +0200
Subject: [PATCH 406/481] Test: miscompilation of float array creation

---
 compiler/tests-wasm_of_ocaml/dune     | 12 +++++++++++-
 compiler/tests-wasm_of_ocaml/gh112.ml |  5 +++++
 2 files changed, 16 insertions(+), 1 deletion(-)
 create mode 100644 compiler/tests-wasm_of_ocaml/gh112.ml

diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune
index c75ed2d21d..de7b646467 100644
--- a/compiler/tests-wasm_of_ocaml/dune
+++ b/compiler/tests-wasm_of_ocaml/dune
@@ -1,5 +1,5 @@
 (executables
- (names gh38 gh46 gh107)
+ (names gh38 gh46 gh107 gh112)
  (modes js)
  (js_of_ocaml
   (flags :standard --disable optcall --no-inline)))
@@ -33,3 +33,13 @@
   (with-outputs-to
    %{target}
    (run node %{dep:gh107.bc.js}))))
+
+(rule
+ (target gh112.actual)
+ (enabled_if
+  (= %{profile} wasm))
+ (alias runtest)
+ (action
+  (with-outputs-to
+   %{target}
+   (run node %{dep:gh112.bc.js}))))
diff --git a/compiler/tests-wasm_of_ocaml/gh112.ml b/compiler/tests-wasm_of_ocaml/gh112.ml
new file mode 100644
index 0000000000..4a24f47130
--- /dev/null
+++ b/compiler/tests-wasm_of_ocaml/gh112.ml
@@ -0,0 +1,5 @@
+let construct x = [| x |]
+
+let project (x : float array) = x.(0)
+
+let _ = project (construct 4.0)

From 65e727a5c726fc47a3d53ebc9b3cdad224dc083c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 24 Oct 2024 17:13:24 +0200
Subject: [PATCH 407/481] Fix creation of float arrays

---
 compiler/lib/wasm/wa_generate.ml |  5 +----
 runtime/wasm/array.wat           | 24 ++++++++++++++++++++++++
 2 files changed, 25 insertions(+), 4 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 738a1b8bc7..125f9fbfd6 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -1159,10 +1159,7 @@ end
 
 let init () =
   let l =
-    [ "caml_make_array", "%identity"
-    ; "caml_ensure_stack_capacity", "%identity"
-    ; "caml_callback", "caml_trampoline"
-    ]
+    [ "caml_ensure_stack_capacity", "%identity"; "caml_callback", "caml_trampoline" ]
   in
 
   let l =
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index b33396f5b4..52daa53268 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -64,6 +64,30 @@
       (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array))))
       (array.new $float_array (f64.const 0) (local.get $sz)))
 
+   (func (export "caml_make_array") (param $vinit (ref eq)) (result (ref eq))
+      (local $init (ref $block)) (local $res (ref $float_array))
+      (local $size i32) (local $i i32)
+      (local.set $init (ref.cast (ref $block) (local.get $vinit)))
+      (local.set $size (array.len (local.get $init)))
+      (if (i32.ne (local.get $size) (i32.const 1))
+         (then
+            (if (ref.test (ref $float)
+                   (array.get $block (local.get $init) (i32.const 1)))
+               (then
+                  (local.set $size (i32.sub (local.get $size) (i32.const 1)))
+                  (local.set $res
+                     (array.new $float_array (f64.const 0) (local.get $size)))
+                  (loop $loop
+                     (array.set $float_array (local.get $res) (local.get $i)
+                        (struct.get $float 0
+                           (ref.cast (ref $float)
+                              (array.get $block (local.get $init)
+                                 (i32.add (local.get $i) (i32.const 1))))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br_if $loop (i32.lt_u (local.get $i) (local.get $size))))
+                  (return (local.get $res))))))
+      (return (local.get $init)))
+
    (func (export "caml_floatarray_unsafe_get")
       (param $a (ref eq)) (param $i (ref eq)) (result (ref eq))
       (struct.new $float

From 0310c5cea5e9b5c0868233f011c63bc9ec90ca51 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 24 Oct 2024 19:50:07 +0200
Subject: [PATCH 408/481] Add more tests of caml_make_array

---
 compiler/tests-wasm_of_ocaml/gh112.ml | 48 +++++++++++++++++++++++++--
 1 file changed, 46 insertions(+), 2 deletions(-)

diff --git a/compiler/tests-wasm_of_ocaml/gh112.ml b/compiler/tests-wasm_of_ocaml/gh112.ml
index 4a24f47130..d2fc1d2b8f 100644
--- a/compiler/tests-wasm_of_ocaml/gh112.ml
+++ b/compiler/tests-wasm_of_ocaml/gh112.ml
@@ -1,5 +1,49 @@
 let construct x = [| x |]
 
-let project (x : float array) = x.(0)
+let get (x : float array) = x.(0)
 
-let _ = project (construct 4.0)
+let get_ (x : _ array) = x.(0)
+
+let set (x : float array) e = x.(0) <- e
+
+let set_ (x : _ array) e = x.(0) <- e
+
+let a = construct 1.0
+
+let _ = set a 2.0
+
+let _ = assert (Float.equal (get a) 2.0)
+
+let _ = assert (Float.equal (get_ a) 2.0)
+
+let _ = set_ a 3.0
+
+let _ = assert (Float.equal (get a) 3.0)
+
+let _ = assert (Float.equal (get_ a) 3.0)
+
+let b = [| 1.0 |]
+
+let _ = set b 2.0
+
+let _ = assert (Float.equal (get b) 2.0)
+
+let _ = assert (Float.equal (get_ b) 2.0)
+
+let _ = set_ b 3.0
+
+let _ = assert (Float.equal (get b) 3.0)
+
+let _ = assert (Float.equal (get_ b) 3.0)
+
+let construct2 x = [| x; x |]
+
+let c = construct2 1.
+
+let _ = assert (Float.equal c.(0) 1. && Float.equal c.(1) 1.)
+
+let _ = c.(1) <- 2.
+
+let _ = assert (Array.length c = 2)
+
+let _ = assert (Float.equal c.(0) 1. && Float.equal c.(1) 2.)

From 9293f3f19300b59e60a14682834d9b624d513767 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 24 Oct 2024 23:25:14 +0200
Subject: [PATCH 409/481] Wasm linker fixes

When the size of a piece of code changes, report that its end position
changes, rather than its start position.
---
 compiler/lib/wasm/wa_wasm_link.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/compiler/lib/wasm/wa_wasm_link.ml b/compiler/lib/wasm/wa_wasm_link.ml
index bf1b7fe09b..87f06e047b 100644
--- a/compiler/lib/wasm/wa_wasm_link.ml
+++ b/compiler/lib/wasm/wa_wasm_link.ml
@@ -947,7 +947,7 @@ module Scan = struct
         let p' = Buffer.length buf in
         let dp = p' - p in
         let dpos = pos' - pos in
-        if dp <> dpos then report pos (dp - dpos));
+        if dp <> dpos then report pos' (dp - dpos));
       pos'
     in
     let rewrite_signed map pos =
@@ -2232,9 +2232,9 @@ let f files ~output_file ~opt_output_sourcemap_file =
         let code (ch : Read.ch) =
           let pos = ch.pos in
           let i = resize_data.i in
-          Scan.push_resize resize_data pos 0;
           let size = Read.uint ch in
           let pos' = ch.pos in
+          Scan.push_resize resize_data pos' 0;
           scan_func ch.pos;
           ch.pos <- ch.pos + size;
           let p = Buffer.length code_pieces in

From ea93a5234c03289ea369b69d8f1c4e3583bff766 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 24 Oct 2024 15:07:55 +0200
Subject: [PATCH 410/481] Sourcemap improvements

- Wasm AST: use a standalone event instruction to indicate code locations
- Add location at end of functions
- Hide code with no location
---
 compiler/bin-wasm_of_ocaml/compile.ml     |   9 +-
 compiler/lib/wasm/wa_ast.ml               |   3 +-
 compiler/lib/wasm/wa_code_generation.ml   |  29 ++--
 compiler/lib/wasm/wa_code_generation.mli  |   4 +-
 compiler/lib/wasm/wa_curry.ml             |   7 +
 compiler/lib/wasm/wa_gc_target.ml         |   8 +-
 compiler/lib/wasm/wa_generate.ml          | 182 +++++++++++-----------
 compiler/lib/wasm/wa_initialize_locals.ml |   3 +-
 compiler/lib/wasm/wa_source_map.ml        |  29 ++--
 compiler/lib/wasm/wa_source_map.mli       |   4 +
 compiler/lib/wasm/wa_tail_call.ml         |  26 ++--
 compiler/lib/wasm/wa_wasm_output.ml       |   4 +-
 compiler/lib/wasm/wa_wat_output.ml        |  31 ++--
 13 files changed, 196 insertions(+), 143 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 1d0e5917a6..0d57e6ff82 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -43,7 +43,10 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
       else
         Some
           (List.map source_map.sources ~f:(fun file ->
-               if Sys.file_exists file && not (Sys.is_directory file)
+               if String.equal file Wa_source_map.blackbox_filename
+               then
+                 Some (Source_map.Source_content.create Wa_source_map.blackbox_contents)
+               else if Sys.file_exists file && not (Sys.is_directory file)
                then Some (Source_map.Source_content.create (Fs.read_file file))
                else None))
     in
@@ -52,6 +55,10 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
         sources_content
       ; sourceroot =
           (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot)
+      ; ignore_list =
+          (if List.mem Wa_source_map.blackbox_filename ~set:source_map.sources
+           then [ Wa_source_map.blackbox_filename ]
+           else [])
       }
     in
     Source_map.to_file (Standard source_map) sourcemap_file)
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib/wasm/wa_ast.ml
index 5bbc49c8bf..0552f87a7c 100644
--- a/compiler/lib/wasm/wa_ast.ml
+++ b/compiler/lib/wasm/wa_ast.ml
@@ -191,8 +191,7 @@ and instruction =
   | StructSet of var * int * expression * expression
   | Return_call of var * expression list
   | Return_call_ref of var * expression * expression list
-  | Location of Parse_info.t option * instruction
-      (** Instruction with attached location information *)
+  | Event of Parse_info.t  (** Location information *)
 
 type import_desc =
   | Fun of func_type
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib/wasm/wa_code_generation.ml
index 50293bf3db..761de78b5c 100644
--- a/compiler/lib/wasm/wa_code_generation.ml
+++ b/compiler/lib/wasm/wa_code_generation.ml
@@ -285,16 +285,21 @@ let blk l st =
   let (), st = l { st with instrs = [] } in
   List.rev st.instrs, { st with instrs }
 
-let with_location loc instrs st =
-  let (), st = instrs st in
+let event loc : unit t =
+ fun st ->
   ( ()
-  , { st with
-      instrs =
-        (match st.instrs with
-        | [] -> []
-        | Location (_, i) :: rem -> Location (loc, i) :: rem
-        | i :: rem -> Location (loc, i) :: rem)
-    } )
+  , match st.instrs with
+    | Event _ :: instrs | instrs -> { st with instrs = Event loc :: instrs } )
+
+let hidden_location =
+  { Parse_info.src = Some Wa_source_map.blackbox_filename
+  ; name = None
+  ; col = 0
+  ; line = 1
+  ; idx = 0
+  }
+
+let no_event = event hidden_location
 
 let cast ?(nullable = false) typ e =
   let* e = e in
@@ -457,13 +462,11 @@ let get_i31_value x st =
       let x = Var.fresh () in
       let x, st = add_var ~typ:I32 x st in
       Some x, { st with instrs = LocalSet (x', RefI31 (LocalTee (x, e))) :: rem }
-  | Location (loc, LocalSet (x', RefI31 e)) :: rem when Code.Var.equal x x' && is_smi e ->
+  | Event loc :: LocalSet (x', RefI31 e) :: rem when Code.Var.equal x x' && is_smi e ->
       let x = Var.fresh () in
       let x, st = add_var ~typ:I32 x st in
       ( Some x
-      , { st with
-          instrs = Location (loc, LocalSet (x', RefI31 (LocalTee (x, e)))) :: rem
-        } )
+      , { st with instrs = Event loc :: LocalSet (x', RefI31 (LocalTee (x, e))) :: rem } )
   | _ -> None, st
 
 let load x =
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib/wasm/wa_code_generation.mli
index 3b099d7e8e..3a084b6aea 100644
--- a/compiler/lib/wasm/wa_code_generation.mli
+++ b/compiler/lib/wasm/wa_code_generation.mli
@@ -138,7 +138,9 @@ val is_small_constant : Wa_ast.expression -> bool t
 
 val get_i31_value : Wa_ast.var -> Wa_ast.var option t
 
-val with_location : Parse_info.t option -> unit t -> unit t
+val event : Parse_info.t -> unit t
+
+val no_event : unit t
 
 type type_def =
   { supertype : Wa_ast.var option
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib/wasm/wa_curry.ml
index 1224b37a97..8df798110d 100644
--- a/compiler/lib/wasm/wa_curry.ml
+++ b/compiler/lib/wasm/wa_curry.ml
@@ -71,6 +71,7 @@ module Make (Target : Wa_target_sig.S) = struct
     in
     let f = Code.Var.fresh_n "f" in
     let body =
+      let* () = no_event in
       let* () = bind_parameters args in
       let* _ = add_var f in
       let* args' = expression_list load args in
@@ -121,6 +122,7 @@ module Make (Target : Wa_target_sig.S) = struct
     let x = Code.Var.fresh_n "x" in
     let f = Code.Var.fresh_n "f" in
     let body =
+      let* () = no_event in
       let* _ = add_var x in
       let* _ = add_var f in
       push (Closure.curry_allocate ~cps:false ~arity m ~f:name' ~closure:f ~arg:x)
@@ -141,6 +143,7 @@ module Make (Target : Wa_target_sig.S) = struct
     in
     let f = Code.Var.fresh_n "f" in
     let body =
+      let* () = no_event in
       let* () = bind_parameters args in
       let* _ = add_var f in
       let* args' = expression_list load args in
@@ -192,6 +195,7 @@ module Make (Target : Wa_target_sig.S) = struct
     let cont = Code.Var.fresh_n "cont" in
     let f = Code.Var.fresh_n "f" in
     let body =
+      let* () = no_event in
       let* _ = add_var x in
       let* _ = add_var cont in
       let* _ = add_var f in
@@ -215,6 +219,7 @@ module Make (Target : Wa_target_sig.S) = struct
     in
     let f = Code.Var.fresh_n "f" in
     let body =
+      let* () = no_event in
       let* () = bind_parameters l in
       let* _ = add_var f in
       Memory.check_function_arity
@@ -248,6 +253,7 @@ module Make (Target : Wa_target_sig.S) = struct
     in
     let f = Code.Var.fresh_n "f" in
     let body =
+      let* () = no_event in
       let* () = bind_parameters l in
       let* _ = add_var f in
       Memory.check_function_arity
@@ -287,6 +293,7 @@ module Make (Target : Wa_target_sig.S) = struct
     in
     let f = Code.Var.fresh_n "f" in
     let body =
+      let* () = no_event in
       let* () = bind_parameters l in
       let* _ = add_var f in
       let* typ, closure = Memory.load_real_closure ~cps ~arity (load f) in
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index b54a1a571d..d72747d5e0 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1679,14 +1679,18 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
        try_
          { params = []; result = [] }
          (body ~result_typ:[] ~fall_through:(`Block (-1)) ~context:(`Skip :: context))
-         [ ocaml_tag, store ~always:true x (return (W.Pop Value.value))
+         [ ( ocaml_tag
+           , let* () = no_event in
+             store ~always:true x (return (W.Pop Value.value)) )
          ; ( js_tag
-           , let exn = Code.Var.fresh () in
+           , let* () = no_event in
+             let exn = Code.Var.fresh () in
              let* () = store ~always:true ~typ:externref exn (return (W.Pop externref)) in
              let* exn = load exn in
              store ~always:true x (return (W.Call (f, [ exn ]))) )
          ]
      in
+     let* () = no_event in
      exn_handler ~result_typ ~fall_through ~context)
 
 let post_process_function_body = Wa_initialize_locals.f
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 6edb30efba..427905ded3 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -38,7 +38,6 @@ module Generate (Target : Wa_target_sig.S) = struct
     ; global_context : Wa_code_generation.context
     ; debug : Parse_bytecode.Debug.t
     }
-  [@@warning "-69"]
 
   type repr =
     | Value
@@ -675,37 +674,34 @@ module Generate (Target : Wa_target_sig.S) = struct
             | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->
                 assert false))
 
-  and translate_instr ctx context loc i =
-    with_location
-      loc
-      (match i with
-      | Assign (x, y) -> assign x (load y)
-      | Let (x, e) ->
-          if ctx.live.(Var.idx x) = 0
-          then drop (translate_expr ctx context x e)
-          else store x (translate_expr ctx context x e)
-      | Set_field (x, n, Non_float, y) -> Memory.set_field (load x) n (load y)
-      | Set_field (x, n, Float, y) ->
-          Memory.float_array_set
-            (load x)
-            (Constant.translate (Int (Targetint.of_int_warning_on_overflow n)))
-            (load y)
-      | Offset_ref (x, n) ->
-          Memory.set_field
-            (load x)
-            0
-            (Value.val_int
-               Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
-      | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
-      | Event _ -> assert false)
+  and translate_instr ctx context i =
+    match i with
+    | Assign (x, y) -> assign x (load y)
+    | Let (x, e) ->
+        if ctx.live.(Var.idx x) = 0
+        then drop (translate_expr ctx context x e)
+        else store x (translate_expr ctx context x e)
+    | Set_field (x, n, Non_float, y) -> Memory.set_field (load x) n (load y)
+    | Set_field (x, n, Float, y) ->
+        Memory.float_array_set
+          (load x)
+          (Constant.translate (Int (Targetint.of_int_warning_on_overflow n)))
+          (load y)
+    | Offset_ref (x, n) ->
+        Memory.set_field
+          (load x)
+          0
+          (Value.val_int
+             Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n)))
+    | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z)
+    | Event loc -> event loc
 
-  and translate_instrs ctx context loc l =
+  and translate_instrs ctx context l =
     match l with
-    | [] -> return loc
-    | Event loc :: rem -> translate_instrs ctx context (Some loc) rem
+    | [] -> return ()
     | i :: rem ->
-        let* () = translate_instr ctx context loc i in
-        translate_instrs ctx context loc rem
+        let* () = translate_instr ctx context i in
+        translate_instrs ctx context rem
 
   let parallel_renaming params args =
     let rec visit visited prev s m x l =
@@ -896,58 +892,56 @@ module Generate (Target : Wa_target_sig.S) = struct
             else code ~context
           in
           translate_tree result_typ fall_through pc' context
-      | [] ->
+      | [] -> (
           let block = Addr.Map.find pc ctx.blocks in
-          let* loc = translate_instrs ctx context None block.body in
+          let* () = translate_instrs ctx context block.body in
           let branch = block.branch in
-          with_location
-            loc
-            (match branch with
-            | Branch cont -> translate_branch result_typ fall_through pc cont context
-            | Return x -> (
-                let* e = load x in
-                match fall_through with
-                | `Return -> instr (Push e)
-                | `Block _ -> instr (Return (Some e)))
-            | Cond (x, cont1, cont2) ->
-                let context' = extend_context fall_through context in
-                if_
-                  { params = []; result = result_typ }
-                  (Value.check_is_not_zero (load x))
-                  (translate_branch result_typ fall_through pc cont1 context')
-                  (translate_branch result_typ fall_through pc cont2 context')
-            | Stop -> (
-                let* e = Value.unit in
-                match fall_through with
-                | `Return -> instr (Push e)
-                | `Block _ -> instr (Return (Some e)))
-            | Switch (x, a) ->
-                let len = Array.length a in
-                let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
-                let dest (pc, args) =
-                  assert (List.is_empty args);
-                  label_index context pc
-                in
-                let* e = Value.int_val (load x) in
-                instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
-            | Raise (x, _) ->
-                let* e = load x in
-                let* tag = register_import ~name:exception_name (Tag Value.value) in
-                instr (Throw (tag, e))
-            | Pushtrap (cont, x, cont') ->
-                handle_exceptions
-                  ~result_typ
-                  ~fall_through
-                  ~context:(extend_context fall_through context)
-                  (wrap_with_handlers
-                     p
-                     (fst cont)
-                     (fun ~result_typ ~fall_through ~context ->
-                       translate_branch result_typ fall_through pc cont context))
-                  x
-                  (fun ~result_typ ~fall_through ~context ->
-                    translate_branch result_typ fall_through pc cont' context)
-            | Poptrap cont -> translate_branch result_typ fall_through pc cont context)
+          match branch with
+          | Branch cont -> translate_branch result_typ fall_through pc cont context
+          | Return x -> (
+              let* e = load x in
+              match fall_through with
+              | `Return -> instr (Push e)
+              | `Block _ -> instr (Return (Some e)))
+          | Cond (x, cont1, cont2) ->
+              let context' = extend_context fall_through context in
+              if_
+                { params = []; result = result_typ }
+                (Value.check_is_not_zero (load x))
+                (translate_branch result_typ fall_through pc cont1 context')
+                (translate_branch result_typ fall_through pc cont2 context')
+          | Stop -> (
+              let* e = Value.unit in
+              match fall_through with
+              | `Return -> instr (Push e)
+              | `Block _ -> instr (Return (Some e)))
+          | Switch (x, a) ->
+              let len = Array.length a in
+              let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
+              let dest (pc, args) =
+                assert (List.is_empty args);
+                label_index context pc
+              in
+              let* e = Value.int_val (load x) in
+              instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
+          | Raise (x, _) ->
+              let* e = load x in
+              let* tag = register_import ~name:exception_name (Tag Value.value) in
+              instr (Throw (tag, e))
+          | Pushtrap (cont, x, cont') ->
+              handle_exceptions
+                ~result_typ
+                ~fall_through
+                ~context:(extend_context fall_through context)
+                (wrap_with_handlers
+                   p
+                   (fst cont)
+                   (fun ~result_typ ~fall_through ~context ->
+                     translate_branch result_typ fall_through pc cont context))
+                x
+                (fun ~result_typ ~fall_through ~context ->
+                  translate_branch result_typ fall_through pc cont' context)
+          | Poptrap cont -> translate_branch result_typ fall_through pc cont context)
     and translate_branch result_typ fall_through src (dst, args) context =
       let* () =
         if List.is_empty args
@@ -1001,15 +995,27 @@ module Generate (Target : Wa_target_sig.S) = struct
         ~context:ctx.global_context
         ~param_names
         ~body:
-          (let* () = build_initial_env in
-           wrap_with_handlers
-             p
-             pc
-             ~result_typ:[ Value.value ]
-             ~fall_through:`Return
-             ~context:[]
-             (fun ~result_typ ~fall_through ~context ->
-               translate_branch result_typ fall_through (-1) cont context))
+          (let* () =
+             let block = Addr.Map.find pc ctx.blocks in
+             match block.body with
+             | Event start_loc :: _ -> event start_loc
+             | _ -> no_event
+           in
+           let* () = build_initial_env in
+           let* () =
+             wrap_with_handlers
+               p
+               pc
+               ~result_typ:[ Value.value ]
+               ~fall_through:`Return
+               ~context:[]
+               (fun ~result_typ ~fall_through ~context ->
+                 translate_branch result_typ fall_through (-1) cont context)
+           in
+           let end_loc = Parse_bytecode.Debug.find_loc ctx.debug ~position:After pc in
+           match end_loc with
+           | Some loc -> event loc
+           | None -> return ())
     in
     let body = post_process_function_body ~param_names ~locals body in
     W.Function
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib/wasm/wa_initialize_locals.ml
index acbec8649c..50b8712f64 100644
--- a/compiler/lib/wasm/wa_initialize_locals.ml
+++ b/compiler/lib/wasm/wa_initialize_locals.ml
@@ -97,7 +97,7 @@ and scan_instruction ctx i =
       List.iter ~f:(fun (_, l) -> scan_instructions ctx l) catches;
       Option.iter ~f:(fun l -> scan_instructions ctx l) catch_all
   | CallInstr (_, l) | Return_call (_, l) -> scan_expressions ctx l
-  | Br (_, None) | Return None | Rethrow _ | Nop -> ()
+  | Br (_, None) | Return None | Rethrow _ | Nop | Event _ -> ()
   | ArraySet (_, e, e', e'') ->
       scan_expression ctx e;
       scan_expression ctx e';
@@ -105,7 +105,6 @@ and scan_instruction ctx i =
   | Return_call_ref (_, e', l) ->
       scan_expressions ctx l;
       scan_expression ctx e'
-  | Location (_, i) -> scan_instruction ctx i
 
 and scan_instructions ctx l =
   let ctx = fork_context ctx in
diff --git a/compiler/lib/wasm/wa_source_map.ml b/compiler/lib/wasm/wa_source_map.ml
index 7356be983b..5cbb51f748 100644
--- a/compiler/lib/wasm/wa_source_map.ml
+++ b/compiler/lib/wasm/wa_source_map.ml
@@ -189,6 +189,10 @@ let iter_sources sm f =
           iter_sources' (member "map" entry) (if single_map then None else Some i) f)
         l
 
+let blackbox_filename = "/builtin/blackbox.ml"
+
+let blackbox_contents = "(* generated code *)"
+
 let insert_source_contents' ~rewrite_path sm i f =
   let rewrite_path path =
     raw_string_from_string (rewrite_path (string_from_raw_string path))
@@ -196,20 +200,27 @@ let insert_source_contents' ~rewrite_path sm i f =
   let open Yojson.Raw.Util in
   let l = sm |> member "sources" |> to_option to_list |> Option.value ~default:[] in
   let single = List.length l = 1 in
+  let ignored = ref (-1) in
   let contents =
     List.mapi
-      ~f:(fun j nm ->
-        match
-          f
-            i
-            (if single then None else Some j)
-            (string_from_raw_string (to_raw_string nm))
-        with
-        | Some c -> `Stringlit c
-        | None -> `Null)
+      ~f:(fun j name ->
+        let name = string_from_raw_string (to_raw_string name) in
+        if String.equal name blackbox_filename
+        then (
+          ignored := j;
+          `Stringlit (raw_string_from_string blackbox_contents))
+        else
+          match f i (if single then None else Some j) name with
+          | Some c -> `Stringlit c
+          | None -> `Null)
       l
   in
   let sm = replace_member sm "sourcesContent" (`List contents) in
+  let sm =
+    if !ignored >= 0
+    then replace_member sm "ignoreList" (`List [ `Intlit (string_of_int !ignored) ])
+    else sm
+  in
   let sm =
     replace_member
       sm
diff --git a/compiler/lib/wasm/wa_source_map.mli b/compiler/lib/wasm/wa_source_map.mli
index a088539755..6845260ed7 100644
--- a/compiler/lib/wasm/wa_source_map.mli
+++ b/compiler/lib/wasm/wa_source_map.mli
@@ -25,3 +25,7 @@ val insert_source_contents :
   -> t
   -> (int option -> int option -> string -> string option)
   -> t
+
+val blackbox_filename : string
+
+val blackbox_contents : string
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib/wasm/wa_tail_call.ml
index 8b71358fe0..62c19ece26 100644
--- a/compiler/lib/wasm/wa_tail_call.ml
+++ b/compiler/lib/wasm/wa_tail_call.ml
@@ -18,18 +18,16 @@
 
 open! Stdlib
 
-let rec get_return ~tail i =
+let get_return ~tail i =
   match i with
-  | Wa_ast.Location (_, i') -> get_return ~tail i'
-  | Return (Some (LocalGet y)) -> Some y
+  | Wa_ast.Return (Some (LocalGet y)) -> Some y
   | Push (LocalGet y) when tail -> Some y
   | _ -> None
 
-let rec rewrite_tail_call ~y i =
+let rewrite_tail_call ~y i =
   match i with
-  | Wa_ast.Location (loc, i') ->
-      Option.map ~f:(fun i -> Wa_ast.Location (loc, i)) (rewrite_tail_call ~y i')
-  | LocalSet (x, Call (symb, l)) when Code.Var.equal x y -> Some (Return_call (symb, l))
+  | Wa_ast.LocalSet (x, Call (symb, l)) when Code.Var.equal x y ->
+      Some (Wa_ast.Return_call (symb, l))
   | LocalSet (x, Call_ref (ty, e, l)) when Code.Var.equal x y ->
       Some (Return_call_ref (ty, e, l))
   | _ -> None
@@ -49,7 +47,6 @@ let rec instruction ~tail i =
   | Return (Some (Call_ref (ty, e, l))) -> Return_call_ref (ty, e, l)
   | Push (Call (symb, l)) when tail -> Return_call (symb, l)
   | Push (Call_ref (ty, e, l)) when tail -> Return_call_ref (ty, e, l)
-  | Location (loc, i) -> Location (loc, instruction ~tail i)
   | Push (Call_ref _) -> i
   | Drop (BlockExpr (typ, l)) -> Drop (BlockExpr (typ, instructions ~tail:false l))
   | Drop _
@@ -67,7 +64,8 @@ let rec instruction ~tail i =
   | ArraySet _
   | StructSet _
   | Return_call _
-  | Return_call_ref _ -> i
+  | Return_call_ref _
+  | Event _ -> i
 
 and instructions ~tail l =
   match l with
@@ -75,13 +73,15 @@ and instructions ~tail l =
   | [ i ] -> [ instruction ~tail i ]
   | i :: Nop :: rem -> instructions ~tail (i :: rem)
   | i :: i' :: Nop :: rem -> instructions ~tail (i :: i' :: rem)
-  | [ i; i' ] -> (
+  | i :: i' :: (([] | [ Event _ ]) as event_opt) -> (
+      (* There can be an event at the end of the function, which we
+         should keep. *)
       match get_return ~tail i' with
-      | None -> [ instruction ~tail:false i; instruction ~tail i' ]
+      | None -> instruction ~tail:false i :: instruction ~tail i' :: event_opt
       | Some y -> (
           match rewrite_tail_call ~y i with
-          | None -> [ instruction ~tail:false i; instruction ~tail i' ]
-          | Some i'' -> [ i'' ]))
+          | None -> instruction ~tail:false i :: instruction ~tail i' :: event_opt
+          | Some i'' -> i'' :: event_opt))
   | i :: rem -> instruction ~tail:false i :: instructions ~tail rem
 
 let f l = instructions ~tail:true l
diff --git a/compiler/lib/wasm/wa_wasm_output.ml b/compiler/lib/wasm/wa_wasm_output.ml
index 68c6018c9d..38eb0a5999 100644
--- a/compiler/lib/wasm/wa_wasm_output.ml
+++ b/compiler/lib/wasm/wa_wasm_output.ml
@@ -741,7 +741,7 @@ end = struct
         output_expression st ch e';
         output_byte ch 0x15;
         output_uint ch (Hashtbl.find st.type_names typ)
-    | Location (_, i') -> output_instruction st ch i'
+    | Event _ -> ()
 
   let output_globals ch (st, global_idx, fields) =
     let count =
@@ -937,7 +937,7 @@ end = struct
           ~f:(fun set i -> expr_function_references i set)
           ~init:(expr_function_references e' set)
           l
-    | Location (_, i') -> instr_function_references i' set
+    | Event _ -> set
 
   let function_references fields set =
     List.fold_left
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib/wasm/wa_wat_output.ml
index 5b20b910ae..01d69b5365 100644
--- a/compiler/lib/wasm/wa_wat_output.ml
+++ b/compiler/lib/wasm/wa_wat_output.ml
@@ -117,13 +117,27 @@ let rec format_sexp f s =
   match s with
   | Atom s -> Format.fprintf f "%s" s
   | List l ->
-      if List.exists l ~f:(function
-             | Comment _ -> true
-             | _ -> false)
+      let has_comment =
+        List.exists l ~f:(function
+            | Comment _ -> true
+            | _ -> false)
+      in
+      if has_comment
       then (* Ensure comments are on their own line *)
         Format.fprintf f "@[<v 2>("
       else Format.fprintf f "@[<2>(";
       Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f "@ ") format_sexp f l;
+      if has_comment
+         && List.fold_left
+              ~f:(fun _ i ->
+                match i with
+                | Comment _ -> true
+                | _ -> false)
+              ~init:false
+              l
+      then
+        (* Make sure there is a newline when a comment is at the very end. *)
+        Format.fprintf f "@ ";
       Format.fprintf f ")@]"
   | Comment s -> Format.fprintf f ";;%s" s
 
@@ -519,13 +533,10 @@ let expression_or_instructions ctx st in_function =
             :: index st.type_names typ
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
-    | Location (loc, i) -> (
-        match loc with
-        | None | Some Parse_info.{ src = None | Some ""; _ } ->
-            Comment "@" :: instruction i
-        | Some Parse_info.{ src = Some src; col; line; _ } ->
-            let loc = Format.sprintf "%s:%d:%d" src line col in
-            Comment ("@ " ^ loc) :: instruction i)
+    | Event Parse_info.{ src = None | Some ""; _ } -> [ Comment "@" ]
+    | Event Parse_info.{ src = Some src; col; line; _ } ->
+        let loc = Format.sprintf "%s:%d:%d" src line col in
+        [ Comment ("@ " ^ loc) ]
   and instructions l = List.concat (List.map ~f:instruction l) in
   expression, instructions
 

From b37c665266dd57334b552a9fb0232198ec92e655 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Oct 2024 11:09:11 +0100
Subject: [PATCH 411/481] Compile a raise within a try as a branch to the
 exception handler

---
 compiler/lib/wasm/wa_gc_target.ml  |  2 +-
 compiler/lib/wasm/wa_generate.ml   | 28 ++++++++++++++++++++++------
 compiler/lib/wasm/wa_target_sig.ml |  4 ++--
 3 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib/wasm/wa_gc_target.ml
index d72747d5e0..ee0f1c496b 100644
--- a/compiler/lib/wasm/wa_gc_target.ml
+++ b/compiler/lib/wasm/wa_gc_target.ml
@@ -1678,7 +1678,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
     (let* () =
        try_
          { params = []; result = [] }
-         (body ~result_typ:[] ~fall_through:(`Block (-1)) ~context:(`Skip :: context))
+         (body ~result_typ:[] ~fall_through:(`Catch x) ~context:(`Catch x :: context))
          [ ( ocaml_tag
            , let* () = no_event in
              store ~always:true x (return (W.Pop Value.value)) )
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 427905ded3..48e0f0875e 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -160,11 +160,20 @@ module Generate (Target : Wa_target_sig.S) = struct
     let rec index_rec context pc i =
       match context with
       | `Block pc' :: _ when pc = pc' -> i
-      | (`Block _ | `Skip) :: rem -> index_rec rem pc (i + 1)
+      | (`Block _ | `Skip | `Catch _) :: rem -> index_rec rem pc (i + 1)
       | [] -> assert false
     in
     index_rec context pc 0
 
+  let catch_index context =
+    let rec index_rec context i =
+      match context with
+      | `Catch x :: _ -> Some (x, i)
+      | (`Block _ | `Skip | `Return) :: rem -> index_rec rem (i + 1)
+      | [] -> None
+    in
+    index_rec context 0
+
   let bound_error_pc = -1
 
   let zero_divide_pc = -2
@@ -750,7 +759,7 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   let extend_context fall_through context =
     match fall_through with
-    | `Block _ as b -> b :: context
+    | (`Block _ | `Catch _) as b -> b :: context
     | `Return -> `Skip :: context
 
   let needed_handlers (p : program) pc =
@@ -902,7 +911,7 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* e = load x in
               match fall_through with
               | `Return -> instr (Push e)
-              | `Block _ -> instr (Return (Some e)))
+              | `Block _ | `Catch _ -> instr (Return (Some e)))
           | Cond (x, cont1, cont2) ->
               let context' = extend_context fall_through context in
               if_
@@ -914,7 +923,7 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* e = Value.unit in
               match fall_through with
               | `Return -> instr (Push e)
-              | `Block _ -> instr (Return (Some e)))
+              | `Block _ | `Catch _ -> instr (Return (Some e)))
           | Switch (x, a) ->
               let len = Array.length a in
               let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
@@ -924,10 +933,17 @@ module Generate (Target : Wa_target_sig.S) = struct
               in
               let* e = Value.int_val (load x) in
               instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1)))
-          | Raise (x, _) ->
+          | Raise (x, _) -> (
               let* e = load x in
               let* tag = register_import ~name:exception_name (Tag Value.value) in
-              instr (Throw (tag, e))
+              match fall_through with
+              | `Catch x -> store ~always:true x (return e)
+              | `Block _ | `Return -> (
+                  match catch_index context with
+                  | Some (x, i) ->
+                      let* () = store ~always:true x (return e) in
+                      instr (Br (i, None))
+                  | None -> instr (Throw (tag, e))))
           | Pushtrap (cont, x, cont') ->
               handle_exceptions
                 ~result_typ
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib/wasm/wa_target_sig.ml
index 83ece707c3..152c843da3 100644
--- a/compiler/lib/wasm/wa_target_sig.ml
+++ b/compiler/lib/wasm/wa_target_sig.ml
@@ -252,9 +252,9 @@ module type S = sig
   val handle_exceptions :
        result_typ:Wa_ast.value_type list
     -> fall_through:'a
-    -> context:([> `Skip ] as 'b) list
+    -> context:([> `Catch of Code.Var.t ] as 'b) list
     -> (   result_typ:Wa_ast.value_type list
-        -> fall_through:[> `Block of int ]
+        -> fall_through:[> `Catch of Code.Var.t ]
         -> context:'b list
         -> unit Wa_code_generation.t)
     -> Wa_ast.var

From dea31d2042935fb269ce22d42ca1288ccaa03fad Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Oct 2024 11:52:05 +0100
Subject: [PATCH 412/481] Delete asset directory if it already exists

---
 compiler/bin-wasm_of_ocaml/compile.ml |  2 +-
 compiler/lib/wasm/wa_link.ml          | 25 ++++++++++++++++++++++++-
 compiler/lib/wasm/wa_link.mli         |  2 ++
 3 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 0d57e6ff82..314254adc8 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -425,7 +425,7 @@ let run
          Fs.gen_file (Filename.chop_extension output_file ^ ".wat")
          @@ fun wat_file ->
          let dir = Filename.chop_extension output_file ^ ".assets" in
-         Fs.gen_file dir
+         Wa_link.gen_dir dir
          @@ fun tmp_dir ->
          Sys.mkdir tmp_dir 0o777;
          let opt_sourcemap =
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index bca6fced07..ef9526ab1e 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -680,6 +680,29 @@ let load_information files =
                in
                file, (build_info, unit_data)) )
 
+let remove_directory path =
+  try
+    let files = Sys.readdir path in
+    Array.iter ~f:(fun file -> Sys.remove (Filename.concat path file)) files;
+    Sys.rmdir path (* Since OCaml 4.12, so we cannot put this in fs.ml *)
+  with Sys_error _ -> ()
+
+let gen_dir dir f =
+  let d_tmp =
+    Filename.temp_file_name
+      ~temp_dir:(Filename.dirname dir)
+      (Filename.basename dir)
+      ".tmp"
+  in
+  try
+    let res = f d_tmp in
+    remove_directory dir;
+    Sys.rename d_tmp dir;
+    res
+  with exc ->
+    remove_directory d_tmp;
+    raise exc
+
 let link ~output_file ~linkall ~enable_source_maps ~files =
   if times () then Format.eprintf "linking@.";
   let t = Timer.make () in
@@ -770,7 +793,7 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
   let t = Timer.make () in
   let interfaces, wasm_dir, link_spec =
     let dir = Filename.chop_extension output_file ^ ".assets" in
-    Fs.gen_file dir
+    gen_dir dir
     @@ fun tmp_dir ->
     Sys.mkdir tmp_dir 0o777;
     let start_module =
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib/wasm/wa_link.mli
index c9bf6e5d9b..9ad39a4244 100644
--- a/compiler/lib/wasm/wa_link.mli
+++ b/compiler/lib/wasm/wa_link.mli
@@ -65,3 +65,5 @@ val link :
   -> unit
 
 val source_name : int option -> int option -> string -> string
+
+val gen_dir : string -> (string -> 'a) -> 'a

From f428e0ef6a388ef894fe7c79d30f0ed2e1a4e1ee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 10 Oct 2024 20:45:05 +0200
Subject: [PATCH 413/481] Github action: automatically merge with js_of_ocaml

---
 .github/workflows/merge.yml | 39 +++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)
 create mode 100644 .github/workflows/merge.yml

diff --git a/.github/workflows/merge.yml b/.github/workflows/merge.yml
new file mode 100644
index 0000000000..89d4c15abc
--- /dev/null
+++ b/.github/workflows/merge.yml
@@ -0,0 +1,39 @@
+name: Automatic Merge with Js_of_ocaml
+
+on:
+  schedule:
+    - cron: '0 0 * * *'  # Executes daily at midnight UTC
+  workflow_dispatch:  # Allows manual triggering of the workflow
+
+permissions:
+  contents: write
+
+jobs:
+  merge:
+    runs-on: ubuntu-latest
+
+    steps:
+      - name: Checkout this repository
+        uses: actions/checkout@v3
+        with:
+          ref: main
+          fetch-depth: 1000
+
+      - name: Set Git committer identity
+        run: |
+          git config user.name github-actions
+          git config user.email github-actions@github.com
+
+      - name: Fetch js_of_ocaml master
+        run: git fetch https://github.com/ocsigen/js_of_ocaml.git master
+
+      - name: Merge js_of_ocaml master into current repository
+        run: git merge FETCH_HEAD
+
+      - name: Push merged changes to 'jsoo-merged' branch
+        run: |
+          if git show-ref --verify --quiet refs/heads/jsoo-merged; then
+            git branch -D jsoo-merged
+          fi
+          git checkout -b jsoo-merged
+          git push --force origin jsoo-merged

From f33288a5f61c40c5153695ee0155adf3640f63b3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Oct 2024 17:12:20 +0100
Subject: [PATCH 414/481] Update README.md

---
 README.md | 9 ---------
 1 file changed, 9 deletions(-)

diff --git a/README.md b/README.md
index 711ec239c3..ef6ed187da 100644
--- a/README.md
+++ b/README.md
@@ -2,10 +2,6 @@
 
 Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssembly.
 
-## Requirements
-
-Wasm_of_ocaml relies on the Binaryen toolchain; currently, only versions [118](https://github.com/WebAssembly/binaryen/releases/tag/version_118) or greater are supported. Binaryen commands must be in the PATH for wasm_of_ocaml to function.
-
 ## Supported engines
 
 The generated code works with Chrome 11.9, Node.js 22 and Firefox 122 (or more recent versions of these applications).
@@ -71,8 +67,3 @@ A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_
 Since the value representation is different, some adaptations are necessary.
 
 The most notable change is that, except for integers, OCaml numbers are no longer mapped to JavaScript numbers. So, explicit conversions `Js.to_float` and `Js.float` are now necessary to convert between OCaml floats and JavaScript numbers. The typing of JavaScript Typed Arrays has also been changed to deal with this.
-
-Additionally, OCaml physical equality will not work properly on JavaScript objects (it compares boxed values instead of values themselves). You should use `Js.string_equals` instead.
-
-Some forked versions of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm) and
-[Gen_js_api](https://github.com/ocaml-wasm/gen_js_api/tree/wasm) are compatible with Wasm_of_ocaml.

From ba4437300350104070ebffc7c6e1405d92e10036 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 29 Oct 2024 17:13:35 +0100
Subject: [PATCH 415/481] Source map: align with Js_of_ocaml

---
 compiler/lib/source_map.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index 3919a08007..64576d89dd 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -730,7 +730,7 @@ let of_json = function
 
 let of_string s = of_json (Yojson.Raw.from_string s)
 
-let of_file filename = of_json (Yojson.Raw.from_file filename)
+let of_file f = of_json (Yojson.Raw.from_file f)
 
 let to_string = function
   | Standard m -> Standard.to_string m

From d6b458db7f66d254f9fedabe06350d06f95f8c65 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 30 Oct 2024 17:21:30 +0100
Subject: [PATCH 416/481] Run Bonsai test with profile release as well

So that we test whole-program compilation a bit.
---
 .github/workflows/build-wasm_of_ocaml.yml | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 2bf59ab4a9..9e1d559f51 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -221,3 +221,8 @@ jobs:
         if: ${{ matrix.ocaml-compiler < '5.' }}
         working-directory: ./jane-street/lib/bonsai
         run: opam exec -- dune runtest
+
+      - name: Run Bonsai tests (release profile)
+        if: ${{ matrix.ocaml-compiler < '5.' }}
+        working-directory: ./jane-street/lib/bonsai
+        run: opam exec -- dune runtest --profile release

From 5cf44d52489d514f3c577f45c3f35797b00b8a0c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 31 Oct 2024 09:48:27 +0100
Subject: [PATCH 417/481] Make sure we open files in binary mode

---
 compiler/lib/wasm/wa_wasm_link.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/wasm/wa_wasm_link.ml b/compiler/lib/wasm/wa_wasm_link.ml
index 87f06e047b..8b4c2005c6 100644
--- a/compiler/lib/wasm/wa_wasm_link.ml
+++ b/compiler/lib/wasm/wa_wasm_link.ml
@@ -1884,7 +1884,7 @@ let f files ~output_file ~opt_output_sourcemap_file =
       (Array.of_list files)
   in
 
-  let out_ch = open_out output_file in
+  let out_ch = open_out_bin output_file in
   output_string out_ch Read.header;
   let buf = Buffer.create 100000 in
 

From 93d7e837c0887c456daa26d36e97b72409e7deb4 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Mon, 4 Nov 2024 16:50:19 +0100
Subject: [PATCH 418/481] Remove dead comments, use better exceptions

---
 compiler/lib/wasm/sexp.ml                  | 23 ++++++++--------------
 compiler/lib/wasm/wa_closure_conversion.ml |  7 -------
 2 files changed, 8 insertions(+), 22 deletions(-)

diff --git a/compiler/lib/wasm/sexp.ml b/compiler/lib/wasm/sexp.ml
index 046e6d67f5..ccf1f7199d 100644
--- a/compiler/lib/wasm/sexp.ml
+++ b/compiler/lib/wasm/sexp.ml
@@ -111,27 +111,28 @@ module Util = struct
   let single f v =
     match v with
     | [ v ] -> f v
-    | _ -> assert false
+    | _ -> invalid_arg "Sexp.Util.single"
 
   let string v =
     match v with
     | Atom s -> s
-    | _ -> assert false
+    | _ -> invalid_arg "Sexp.Util.string"
 
   let assoc v =
+    let invalid_arg () = invalid_arg "Sexp.Util.assoc" in
     match v with
     | List l ->
         List.map
           ~f:(fun p ->
             match p with
             | List (Atom k :: v) -> k, v
-            | _ -> assert false)
+            | _ -> invalid_arg ())
           l
-    | Atom _ -> assert false
+    | Atom _ -> invalid_arg ()
 
   let member nm v =
     match v with
-    | Atom _ -> assert false
+    | Atom _ -> invalid_arg "Sexp.Util.member"
     | List l ->
         List.find_map
           ~f:(fun p ->
@@ -144,18 +145,10 @@ module Util = struct
     match v with
     | Atom "true" -> true
     | Atom "false" -> false
-    | _ -> assert false
+    | _ -> invalid_arg "Sexp.Util.bool"
 
   let mandatory f v =
     match v with
     | Some v -> f v
-    | None -> assert false
+    | None -> invalid_arg "Sexp.Util.mandatory"
 end
-(*
-parse
-  (to_string
-     (List
-        [ List [ Atom "provides"; Atom "toto" ]
-        ; List [ Atom "requires"; Atom "foo"; Atom "bar"; Atom "foo\n bar" ]
-        ]))
-*)
diff --git a/compiler/lib/wasm/wa_closure_conversion.ml b/compiler/lib/wasm/wa_closure_conversion.ml
index 38bb7fc9b3..4d77c6de68 100644
--- a/compiler/lib/wasm/wa_closure_conversion.ml
+++ b/compiler/lib/wasm/wa_closure_conversion.ml
@@ -142,13 +142,6 @@ let rec traverse var_depth closures program pc depth =
                     in
                     List.map ~f:(fun f -> f, Var.Map.find f arities) fun_lst
                   in
-                  (*
-                  Format.eprintf "AAA";
-                  List.iter
-                    ~f:(fun (f, _) -> Format.eprintf " %a" Code.Var.print f)
-                    functions;
-                  Format.eprintf "@.";
-*)
                   List.iter
                     ~f:(fun (f, _) ->
                       closures := Var.Map.add f { functions; free_variables } !closures)

From eca029fa1627560fc2073148d4e4222c7f6dd03b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Nov 2024 17:00:45 +0100
Subject: [PATCH 419/481] Source maps: possibility to reuse a temporary buffer
 when parsing

---
 compiler/lib/source_map.ml  | 28 +++++++++++++++-------------
 compiler/lib/source_map.mli |  6 ++++--
 2 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index 64576d89dd..bb29b0506c 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -289,8 +289,8 @@ let rewrite_path path =
 
 let invalid () = invalid_arg "Source_map.of_json"
 
-let string_of_stringlit (`Stringlit s) =
-  match Yojson.Safe.from_string s with
+let string_of_stringlit ?tmp_buf (`Stringlit s) =
+  match Yojson.Safe.from_string ?buf:tmp_buf s with
   | `String s -> s
   | _ -> invalid ()
 
@@ -507,11 +507,13 @@ module Standard = struct
                            t.sources))) )
          ])
 
-  let of_json (json : Yojson.Raw.t) =
+  let of_json ?tmp_buf (json : Yojson.Raw.t) =
     match json with
     | `Assoc (("version", `Intlit version) :: rest)
       when version_is_valid (int_of_string version) ->
-        let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in
+        let string name json =
+          Option.map ~f:(fun s -> string_of_stringlit ?tmp_buf s) (stringlit name json)
+        in
         let file = string "file" rest in
         let sourceroot = string "sourceRoot" rest in
         let names =
@@ -641,7 +643,7 @@ module Index = struct
     | _ -> invalid_arg errmsg
     | exception Not_found -> invalid_arg errmsg
 
-  let section_of_json : Yojson.Raw.t -> section = function
+  let section_of_json ?tmp_buf : Yojson.Raw.t -> section = function
     | `Assoc json ->
         let offset =
           match List.assoc "offset" json with
@@ -671,7 +673,7 @@ module Index = struct
               "Source_map.Index.of_json: URLs in index maps are not currently supported"
         | exception Not_found -> ());
         let map =
-          try Standard.of_json (List.assoc "map" json) with
+          try Standard.of_json ?tmp_buf (List.assoc "map" json) with
           | Not_found -> invalid_arg "Source_map.Index.of_json: field 'map' absent"
           | Invalid_argument _ ->
               invalid_arg "Source_map.Index.of_json: invalid sub-map object"
@@ -679,14 +681,14 @@ module Index = struct
         { offset; map }
     | _ -> invalid_arg "Source_map.Index.of_json: section of unexpected type"
 
-  let of_json = function
+  let of_json ?tmp_buf = function
     | `Assoc (("version", `Intlit version) :: fields)
       when version_is_valid (int_of_string version) -> (
         let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in
         let file = string "file" fields in
         match List.assoc "sections" fields with
         | `List sections ->
-            let sections = List.map ~f:section_of_json sections in
+            let sections = List.map ~f:(section_of_json ?tmp_buf) sections in
             { version = int_of_string version; file; sections }
         | _ -> invalid_arg "Source_map.Index.of_json: `sections` is not an array"
         | exception Not_found ->
@@ -721,16 +723,16 @@ type t =
   | Standard of Standard.t
   | Index of Index.t
 
-let of_json = function
+let of_json ?tmp_buf = function
   | `Assoc fields as json -> (
       match List.assoc "sections" fields with
-      | _ -> Index (Index.of_json json)
-      | exception Not_found -> Standard (Standard.of_json json))
+      | _ -> Index (Index.of_json ?tmp_buf json)
+      | exception Not_found -> Standard (Standard.of_json ?tmp_buf json))
   | _ -> invalid_arg "Source_map.of_json: map is not an object"
 
-let of_string s = of_json (Yojson.Raw.from_string s)
+let of_string ?tmp_buf s = of_json ?tmp_buf (Yojson.Raw.from_string ?buf:tmp_buf s)
 
-let of_file f = of_json (Yojson.Raw.from_file f)
+let of_file ?tmp_buf f = of_json ?tmp_buf (Yojson.Raw.from_file ?buf:tmp_buf f)
 
 let to_string = function
   | Standard m -> Standard.to_string m
diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli
index 64954d0fd5..5a4791e105 100644
--- a/compiler/lib/source_map.mli
+++ b/compiler/lib/source_map.mli
@@ -21,6 +21,8 @@ module Source_content : sig
   type t
 
   val create : string -> t
+
+  val of_stringlit : [ `Stringlit of string ] -> t
 end
 
 type map =
@@ -134,9 +136,9 @@ val to_string : t -> string
 
 val to_file : t -> string -> unit
 
-val of_string : string -> t
+val of_string : ?tmp_buf:Buffer.t -> string -> t
 
-val of_file : string -> t
+val of_file : ?tmp_buf:Buffer.t -> string -> t
 
 val invariant : t -> unit
 

From 065f0963845b571487b647ce98c358673f996257 Mon Sep 17 00:00:00 2001
From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com>
Date: Mon, 4 Nov 2024 16:31:32 +0000
Subject: [PATCH 420/481] Bump actions/checkout from 3 to 4

Bumps [actions/checkout](https://github.com/actions/checkout) from 3 to 4.
- [Release notes](https://github.com/actions/checkout/releases)
- [Changelog](https://github.com/actions/checkout/blob/main/CHANGELOG.md)
- [Commits](https://github.com/actions/checkout/compare/v3...v4)

---
updated-dependencies:
- dependency-name: actions/checkout
  dependency-type: direct:production
  update-type: version-update:semver-major
...

Signed-off-by: dependabot[bot] <support@github.com>
---
 .github/workflows/merge.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/merge.yml b/.github/workflows/merge.yml
index 89d4c15abc..480f72088d 100644
--- a/.github/workflows/merge.yml
+++ b/.github/workflows/merge.yml
@@ -14,7 +14,7 @@ jobs:
 
     steps:
       - name: Checkout this repository
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           ref: main
           fetch-depth: 1000

From 5072ad2050b6d505158b449c944b61ca6ac9a3c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 26 Jun 2024 15:56:47 +0200
Subject: [PATCH 421/481] Use dune tests

---
 compiler/tests-env/dune                       |  44 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-linkall/dune                   |  14 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-num/dune                       |  31 +-
 compiler/tests-ocaml/basic-modules/dune       |  16 +-
 ...ference => recursive_module_init.expected} |   0
 compiler/tests-ocaml/lib-atomic/dune          |  11 +-
 ...bigarrays.reference => bigarrays.expected} |   0
 ...ayout.reference => change_layout.expected} |   0
 compiler/tests-ocaml/lib-bigarray/dune        |  72 +--
 .../{fftba.reference => fftba.expected}       |   0
 .../{pr5115.reference => pr5115.expected}     |   0
 ...array.reference => weak_bigarray.expected} |   0
 compiler/tests-ocaml/lib-bool/dune            |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-buffer/dune          |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-bytes-utf/dune       |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-bytes/dune           |  28 +-
 ...st_bytes.reference => test_bytes.expected} |   0
 compiler/tests-ocaml/lib-digest/dune          |  31 +-
 .../{md5.reference => md5.expected}           |   0
 .../{cmphash.reference => cmphash.expected}   |   0
 compiler/tests-ocaml/lib-effects/dune         | 416 +-----------------
 .../{effects.reference => effects.expected}   |   0
 .../{evenodd.reference => evenodd.expected}   |   0
 .../{manylive.reference => manylive.expected} |   0
 .../{marshal.reference => marshal.expected}   |   0
 .../{overflow.reference => overflow.expected} |   0
 .../{partial.reference => partial.expected}   |   0
 ...reperform.reference => reperform.expected} |   0
 .../{sched.reference => sched.expected}       |   0
 ...state.reference => shallow_state.expected} |   0
 ...io.reference => shallow_state_io.expected} |   0
 .../{test1.reference => test1.expected}       |   0
 .../{test10.reference => test10.expected}     |   0
 .../{test11.reference => test11.expected}     |   0
 .../{test2.reference => test2.expected}       |   0
 .../{test3.reference => test3.expected}       |   0
 .../{test4.reference => test4.expected}       |   0
 .../{test5.reference => test5.expected}       |   0
 .../{test6.reference => test6.expected}       |   0
 ...test_lazy.reference => test_lazy.expected} |   0
 ....reference => unhandled_unlinked.expected} |   0
 ...used_cont.reference => used_cont.expected} |   0
 compiler/tests-ocaml/lib-filename/dune        |  30 +-
 ...extension.reference => extension.expected} |   0
 .../{suffix.reference => suffix.expected}     |   0
 compiler/tests-ocaml/lib-float/dune           |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-floatarray/dune      |  14 +-
 compiler/tests-ocaml/lib-format/dune          |  72 +--
 ...ference => pp_print_custom_break.expected} |   0
 .../{pr6824.reference => pr6824.expected}     |   0
 ...ne.reference => print_if_newline.expected} |   0
 ...print_seq.reference => print_seq.expected} |   0
 .../{tformat.reference => tformat.expected}   |   0
 compiler/tests-ocaml/lib-fun/dune             |  16 +-
 .../lib-fun/{test.reference => test.expected} |   0
 compiler/tests-ocaml/lib-gc/dune              |   8 +-
 compiler/tests-ocaml/lib-hashtbl/dune         |  48 +-
 .../{hfun.reference => hfun.expected-js}      |   0
 ...hfun.reference-wasm => hfun.expected-wasm} |   0
 .../{htbl.reference => htbl.expected}         |   0
 compiler/tests-ocaml/lib-int/dune             |  16 +-
 .../lib-int/{test.reference => test.expected} |   0
 compiler/tests-ocaml/lib-int64/dune           |  30 +-
 ...issue9460.reference => issue9460.expected} |   0
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-list/dune            |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-option/dune          |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-printf/dune          |  44 +-
 .../{pr6534.reference => pr6534.expected}     |   0
 .../{pr6938.reference => pr6938.expected}     |   0
 .../{tprintf.reference => tprintf.expected}   |   0
 compiler/tests-ocaml/lib-queue/dune           |  16 +-
 .../{test.reference => test.expected}         |   0
 ...ultinit.reference => defaultinit.expected} |   0
 compiler/tests-ocaml/lib-random/dune          |  48 +-
 .../{selfinit.reference => selfinit.expected} |   0
 ...vectors.reference => testvectors.expected} |   0
 compiler/tests-ocaml/lib-result/dune          |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-seq/dune             |  16 +-
 .../lib-seq/{test.reference => test.expected} |   0
 compiler/tests-ocaml/lib-set/dune             |  30 +-
 .../{testmap.reference => testmap.expected}   |   0
 .../{testset.reference => testset.expected}   |   0
 compiler/tests-ocaml/lib-stack/dune           |  16 +-
 .../{test.reference => test.expected}         |   0
 compiler/tests-ocaml/lib-str/dune             |  16 +-
 .../lib-str/{t01.reference => t01.expected}   |   0
 compiler/tests-ocaml/lib-string/dune          |  30 +-
 ..._string.reference => test_string.expected} |   0
 compiler/tests-ocaml/lib-uchar/dune           |  16 +-
 .../{test.reference => test.expected}         |   0
 ...ss.reference => bigstring_access.expected} |   0
 compiler/tests-ocaml/prim-bigstring/dune      |  30 +-
 ...ccess.reference => string_access.expected} |   0
 .../{bswap.reference => bswap.expected}       |   0
 compiler/tests-ocaml/prim-bswap/dune          |  16 +-
 .../{apply.reference => apply.expected}       |   0
 compiler/tests-ocaml/prim-revapply/dune       |  30 +-
 .../{revapply.reference => revapply.expected} |   0
 compiler/tests-re/dune                        |   8 +-
 compiler/tests-runtime-events/dune            |  12 +-
 ...dump.reference => dump_sourcemap.expected} |   0
 compiler/tests-sourcemap/dune                 |  19 +-
 compiler/tests-toplevel/dune                  |  27 +-
 ...level.reference => test_toplevel.expected} |   0
 compiler/tests-wasm_of_ocaml/dune             |  42 +-
 compiler/tests-wasm_of_ocaml/gh107.expected   |   1 +
 compiler/tests-wasm_of_ocaml/gh107.ml         |   2 +-
 .../{bin.reference => bin.expected}           |   0
 examples/separate_compilation/dune            |   5 +-
 toplevel/test/dune                            |   5 +-
 ...level.reference => test_toplevel.expected} |   0
 121 files changed, 96 insertions(+), 1342 deletions(-)
 rename compiler/tests-env/{test.reference => test.expected} (100%)
 rename compiler/tests-linkall/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/basic-modules/{recursive_module_init.reference => recursive_module_init.expected} (100%)
 rename compiler/tests-ocaml/lib-bigarray/{bigarrays.reference => bigarrays.expected} (100%)
 rename compiler/tests-ocaml/lib-bigarray/{change_layout.reference => change_layout.expected} (100%)
 rename compiler/tests-ocaml/lib-bigarray/{fftba.reference => fftba.expected} (100%)
 rename compiler/tests-ocaml/lib-bigarray/{pr5115.reference => pr5115.expected} (100%)
 rename compiler/tests-ocaml/lib-bigarray/{weak_bigarray.reference => weak_bigarray.expected} (100%)
 rename compiler/tests-ocaml/lib-bool/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-buffer/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-bytes-utf/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-bytes/{test_bytes.reference => test_bytes.expected} (100%)
 rename compiler/tests-ocaml/lib-digest/{md5.reference => md5.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{cmphash.reference => cmphash.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{effects.reference => effects.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{evenodd.reference => evenodd.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{manylive.reference => manylive.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{marshal.reference => marshal.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{overflow.reference => overflow.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{partial.reference => partial.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{reperform.reference => reperform.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{sched.reference => sched.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{shallow_state.reference => shallow_state.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{shallow_state_io.reference => shallow_state_io.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test1.reference => test1.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test10.reference => test10.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test11.reference => test11.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test2.reference => test2.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test3.reference => test3.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test4.reference => test4.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test5.reference => test5.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test6.reference => test6.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{test_lazy.reference => test_lazy.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{unhandled_unlinked.reference => unhandled_unlinked.expected} (100%)
 rename compiler/tests-ocaml/lib-effects/{used_cont.reference => used_cont.expected} (100%)
 rename compiler/tests-ocaml/lib-filename/{extension.reference => extension.expected} (100%)
 rename compiler/tests-ocaml/lib-filename/{suffix.reference => suffix.expected} (100%)
 rename compiler/tests-ocaml/lib-float/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-format/{pp_print_custom_break.reference => pp_print_custom_break.expected} (100%)
 rename compiler/tests-ocaml/lib-format/{pr6824.reference => pr6824.expected} (100%)
 rename compiler/tests-ocaml/lib-format/{print_if_newline.reference => print_if_newline.expected} (100%)
 rename compiler/tests-ocaml/lib-format/{print_seq.reference => print_seq.expected} (100%)
 rename compiler/tests-ocaml/lib-format/{tformat.reference => tformat.expected} (100%)
 rename compiler/tests-ocaml/lib-fun/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-hashtbl/{hfun.reference => hfun.expected-js} (100%)
 rename compiler/tests-ocaml/lib-hashtbl/{hfun.reference-wasm => hfun.expected-wasm} (100%)
 rename compiler/tests-ocaml/lib-hashtbl/{htbl.reference => htbl.expected} (100%)
 rename compiler/tests-ocaml/lib-int/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-int64/{issue9460.reference => issue9460.expected} (100%)
 rename compiler/tests-ocaml/lib-int64/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-list/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-option/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-printf/{pr6534.reference => pr6534.expected} (100%)
 rename compiler/tests-ocaml/lib-printf/{pr6938.reference => pr6938.expected} (100%)
 rename compiler/tests-ocaml/lib-printf/{tprintf.reference => tprintf.expected} (100%)
 rename compiler/tests-ocaml/lib-queue/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-random/{defaultinit.reference => defaultinit.expected} (100%)
 rename compiler/tests-ocaml/lib-random/{selfinit.reference => selfinit.expected} (100%)
 rename compiler/tests-ocaml/lib-random/{testvectors.reference => testvectors.expected} (100%)
 rename compiler/tests-ocaml/lib-result/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-seq/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-set/{testmap.reference => testmap.expected} (100%)
 rename compiler/tests-ocaml/lib-set/{testset.reference => testset.expected} (100%)
 rename compiler/tests-ocaml/lib-stack/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/lib-str/{t01.reference => t01.expected} (100%)
 rename compiler/tests-ocaml/lib-string/{test_string.reference => test_string.expected} (100%)
 rename compiler/tests-ocaml/lib-uchar/{test.reference => test.expected} (100%)
 rename compiler/tests-ocaml/prim-bigstring/{bigstring_access.reference => bigstring_access.expected} (100%)
 rename compiler/tests-ocaml/prim-bigstring/{string_access.reference => string_access.expected} (100%)
 rename compiler/tests-ocaml/prim-bswap/{bswap.reference => bswap.expected} (100%)
 rename compiler/tests-ocaml/prim-revapply/{apply.reference => apply.expected} (100%)
 rename compiler/tests-ocaml/prim-revapply/{revapply.reference => revapply.expected} (100%)
 rename compiler/tests-sourcemap/{dump.reference => dump_sourcemap.expected} (100%)
 rename compiler/tests-toplevel/{test_toplevel.reference => test_toplevel.expected} (100%)
 create mode 100644 compiler/tests-wasm_of_ocaml/gh107.expected
 rename examples/separate_compilation/{bin.reference => bin.expected} (100%)
 rename toplevel/test/{test_toplevel.reference => test_toplevel.expected} (100%)

diff --git a/compiler/tests-env/dune b/compiler/tests-env/dune
index 7df162e300..5975060fa9 100644
--- a/compiler/tests-env/dune
+++ b/compiler/tests-env/dune
@@ -1,43 +1,15 @@
-(executable
+(test
  (modes js)
- (enabled_if
+ (build_if
   (and
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
  (js_of_ocaml
+  (javascript_files setup.js)
   (flags :standard --setenv JSOO_C=from-jsoo-args))
- (name test))
-
-(rule
- (target test.js)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
  (action
-  (with-outputs-to
-   %{target}
-   (cat %{dep:setup.js} %{dep:./test.bc.js}))))
-
-(rule
- (target test.output)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
- (action
-  (with-outputs-to
-   %{target}
-   (setenv
-    JSOO_B
-    from-env
-    (run node %{dep:./test.js})))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
- (action
-  (diff test.reference test.output)))
+  (setenv
+   JSOO_B
+   from-env
+   (run node %{test})))
+ (name test))
diff --git a/compiler/tests-env/test.reference b/compiler/tests-env/test.expected
similarity index 100%
rename from compiler/tests-env/test.reference
rename to compiler/tests-env/test.expected
diff --git a/compiler/tests-linkall/dune b/compiler/tests-linkall/dune
index 23747dc90f..4b1df9f693 100644
--- a/compiler/tests-linkall/dune
+++ b/compiler/tests-linkall/dune
@@ -5,7 +5,7 @@
   (js_of_ocaml
    (compilation_mode separate))))
 
-(executable
+(test
  (name test)
  (modes byte js)
  (libraries dynlink)
@@ -15,15 +15,3 @@
  ;; Let's use it for the test
  (link_flags
   (:standard -linkall)))
-
-(rule
- (target test.output)
- (action
-  (with-stdout-to
-   %{target}
-   (run node %{dep:test.bc.js}))))
-
-(rule
- (alias runtest)
- (action
-  (diff test.reference test.output)))
diff --git a/compiler/tests-linkall/test.reference b/compiler/tests-linkall/test.expected
similarity index 100%
rename from compiler/tests-linkall/test.reference
rename to compiler/tests-linkall/test.expected
diff --git a/compiler/tests-num/dune b/compiler/tests-num/dune
index 92beab39eb..25a756b92c 100644
--- a/compiler/tests-num/dune
+++ b/compiler/tests-num/dune
@@ -1,7 +1,11 @@
-(executable
+(test
  (name main)
  (modules main test_nats test test_big_ints test_ratios test_nums test_io)
  (libraries num)
+ (enabled_if
+  (and
+   (<> %{profile} wasm)
+   (<> %{profile} wasm-effects)))
  (modes
   js
   (best exe))
@@ -9,32 +13,9 @@
   (:standard -linkall -w -3-7-33-35-37 -safe-string -no-strict-sequence)))
 
 (rule
- (target main.referencejs)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
- (deps main.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./main.bc.js))))
-
-(rule
- (target main.reference)
+ (target main.expected)
  (deps main.exe)
  (action
   (with-stdout-to
    %{target}
    (run ./main.exe))))
-
-(rule
- (alias runtest)
- ;; ZZZ Need to modify the num library
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
- (deps main.reference main.referencejs)
- (action
-  (diff main.reference main.referencejs)))
diff --git a/compiler/tests-ocaml/basic-modules/dune b/compiler/tests-ocaml/basic-modules/dune
index 26aa2a5ffe..d5bfb9f8a9 100644
--- a/compiler/tests-ocaml/basic-modules/dune
+++ b/compiler/tests-ocaml/basic-modules/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names recursive_module_init)
  (libraries)
  (modes js))
-
-(rule
- (target recursive_module_init.referencejs)
- (deps recursive_module_init.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./recursive_module_init.bc.js))))
-
-(rule
- (alias runtest)
- (deps recursive_module_init.reference recursive_module_init.referencejs)
- (action
-  (diff recursive_module_init.reference recursive_module_init.referencejs)))
diff --git a/compiler/tests-ocaml/basic-modules/recursive_module_init.reference b/compiler/tests-ocaml/basic-modules/recursive_module_init.expected
similarity index 100%
rename from compiler/tests-ocaml/basic-modules/recursive_module_init.reference
rename to compiler/tests-ocaml/basic-modules/recursive_module_init.expected
diff --git a/compiler/tests-ocaml/lib-atomic/dune b/compiler/tests-ocaml/lib-atomic/dune
index b523fca818..ca4c49b456 100644
--- a/compiler/tests-ocaml/lib-atomic/dune
+++ b/compiler/tests-ocaml/lib-atomic/dune
@@ -1,10 +1,3 @@
-(executables
- (names test_atomic)
- (libraries)
+(test
+ (name test_atomic)
  (modes js))
-
-(rule
- (alias runtest)
- (deps test_atomic.bc.js)
- (action
-  (run node test_atomic.bc.js)))
diff --git a/compiler/tests-ocaml/lib-bigarray/bigarrays.reference b/compiler/tests-ocaml/lib-bigarray/bigarrays.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bigarray/bigarrays.reference
rename to compiler/tests-ocaml/lib-bigarray/bigarrays.expected
diff --git a/compiler/tests-ocaml/lib-bigarray/change_layout.reference b/compiler/tests-ocaml/lib-bigarray/change_layout.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bigarray/change_layout.reference
rename to compiler/tests-ocaml/lib-bigarray/change_layout.expected
diff --git a/compiler/tests-ocaml/lib-bigarray/dune b/compiler/tests-ocaml/lib-bigarray/dune
index 3fc4e421c1..38ac683d5e 100644
--- a/compiler/tests-ocaml/lib-bigarray/dune
+++ b/compiler/tests-ocaml/lib-bigarray/dune
@@ -1,74 +1,4 @@
-(executables
+(tests
  (names bigarrays change_layout fftba pr5115 weak_bigarray)
  (libraries)
  (modes js))
-
-(rule
- (target bigarrays.referencejs)
- (deps bigarrays.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./bigarrays.bc.js))))
-
-(rule
- (alias runtest)
- (deps bigarrays.reference bigarrays.referencejs)
- (action
-  (diff bigarrays.reference bigarrays.referencejs)))
-
-(rule
- (target change_layout.referencejs)
- (deps change_layout.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./change_layout.bc.js))))
-
-(rule
- (alias runtest)
- (deps change_layout.reference change_layout.referencejs)
- (action
-  (diff change_layout.reference change_layout.referencejs)))
-
-(rule
- (target fftba.referencejs)
- (deps fftba.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./fftba.bc.js))))
-
-(rule
- (alias runtest)
- (deps fftba.reference fftba.referencejs)
- (action
-  (diff fftba.reference fftba.referencejs)))
-
-(rule
- (target pr5115.referencejs)
- (deps pr5115.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./pr5115.bc.js))))
-
-(rule
- (alias runtest)
- (deps pr5115.reference pr5115.referencejs)
- (action
-  (diff pr5115.reference pr5115.referencejs)))
-
-(rule
- (target weak_bigarray.referencejs)
- (deps weak_bigarray.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./weak_bigarray.bc.js))))
-
-(rule
- (alias runtest)
- (deps weak_bigarray.reference weak_bigarray.referencejs)
- (action
-  (diff weak_bigarray.reference weak_bigarray.referencejs)))
diff --git a/compiler/tests-ocaml/lib-bigarray/fftba.reference b/compiler/tests-ocaml/lib-bigarray/fftba.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bigarray/fftba.reference
rename to compiler/tests-ocaml/lib-bigarray/fftba.expected
diff --git a/compiler/tests-ocaml/lib-bigarray/pr5115.reference b/compiler/tests-ocaml/lib-bigarray/pr5115.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bigarray/pr5115.reference
rename to compiler/tests-ocaml/lib-bigarray/pr5115.expected
diff --git a/compiler/tests-ocaml/lib-bigarray/weak_bigarray.reference b/compiler/tests-ocaml/lib-bigarray/weak_bigarray.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bigarray/weak_bigarray.reference
rename to compiler/tests-ocaml/lib-bigarray/weak_bigarray.expected
diff --git a/compiler/tests-ocaml/lib-bool/dune b/compiler/tests-ocaml/lib-bool/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-bool/dune
+++ b/compiler/tests-ocaml/lib-bool/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-bool/test.reference b/compiler/tests-ocaml/lib-bool/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bool/test.reference
rename to compiler/tests-ocaml/lib-bool/test.expected
diff --git a/compiler/tests-ocaml/lib-buffer/dune b/compiler/tests-ocaml/lib-buffer/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-buffer/dune
+++ b/compiler/tests-ocaml/lib-buffer/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-buffer/test.reference b/compiler/tests-ocaml/lib-buffer/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-buffer/test.reference
rename to compiler/tests-ocaml/lib-buffer/test.expected
diff --git a/compiler/tests-ocaml/lib-bytes-utf/dune b/compiler/tests-ocaml/lib-bytes-utf/dune
index d3706ba020..9b2db1c33a 100644
--- a/compiler/tests-ocaml/lib-bytes-utf/dune
+++ b/compiler/tests-ocaml/lib-bytes-utf/dune
@@ -1,4 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (flags
@@ -6,17 +6,3 @@
  (modes
   js
   (best exe)))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-bytes-utf/test.reference b/compiler/tests-ocaml/lib-bytes-utf/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bytes-utf/test.reference
rename to compiler/tests-ocaml/lib-bytes-utf/test.expected
diff --git a/compiler/tests-ocaml/lib-bytes/dune b/compiler/tests-ocaml/lib-bytes/dune
index ae78ccf96a..10725957d6 100644
--- a/compiler/tests-ocaml/lib-bytes/dune
+++ b/compiler/tests-ocaml/lib-bytes/dune
@@ -1,30 +1,4 @@
-(executables
+(tests
  (names test_bytes binary)
  (libraries)
  (modes js))
-
-(rule
- (target test_bytes.referencejs)
- (deps test_bytes.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test_bytes.bc.js))))
-
-(rule
- (alias runtest)
- (deps test_bytes.reference test_bytes.referencejs)
- (action
-  (diff test_bytes.reference test_bytes.referencejs)))
-
-(rule
- (target binary.referencejs)
- (deps binary.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./binary.bc.js))))
-
-(alias
- (name runtest)
- (deps binary.referencejs))
diff --git a/compiler/tests-ocaml/lib-bytes/test_bytes.reference b/compiler/tests-ocaml/lib-bytes/test_bytes.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-bytes/test_bytes.reference
rename to compiler/tests-ocaml/lib-bytes/test_bytes.expected
diff --git a/compiler/tests-ocaml/lib-digest/dune b/compiler/tests-ocaml/lib-digest/dune
index 253e0bac42..ebf76eddba 100644
--- a/compiler/tests-ocaml/lib-digest/dune
+++ b/compiler/tests-ocaml/lib-digest/dune
@@ -1,41 +1,16 @@
-(executables
+(tests
  (names md5)
  (libraries)
  (modules md5)
  (modes js))
 
-(rule
- (target md5.referencejs)
- (deps md5.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./md5.bc.js))))
-
-(rule
- (alias runtest)
- (deps md5.reference md5.referencejs)
- (action
-  (diff md5.reference md5.referencejs)))
-
-(executables
+(tests
  (names digests)
  (libraries)
- (enabled_if
+ (build_if
   (and
    (>= %{ocaml_version} 5.2)
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
  (modules digests)
  (modes js))
-
-(rule
- (alias runtest)
- (deps digests.bc.js)
- (enabled_if
-  (and
-   (>= %{ocaml_version} 5.2)
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
- (action
-  (run node ./digests.bc.js)))
diff --git a/compiler/tests-ocaml/lib-digest/md5.reference b/compiler/tests-ocaml/lib-digest/md5.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-digest/md5.reference
rename to compiler/tests-ocaml/lib-digest/md5.expected
diff --git a/compiler/tests-ocaml/lib-effects/cmphash.reference b/compiler/tests-ocaml/lib-effects/cmphash.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/cmphash.reference
rename to compiler/tests-ocaml/lib-effects/cmphash.expected
diff --git a/compiler/tests-ocaml/lib-effects/dune b/compiler/tests-ocaml/lib-effects/dune
index d7e7ecc5c0..48f8e239ed 100644
--- a/compiler/tests-ocaml/lib-effects/dune
+++ b/compiler/tests-ocaml/lib-effects/dune
@@ -20,8 +20,8 @@
    ;; multiple versions of the dependencies
    (compilation_mode whole_program))))
 
-(executables
- (enabled_if
+(tests
+ (build_if
   (>= %{ocaml_version} 5))
  (names
   cmphash
@@ -49,411 +49,15 @@
   (:standard \ unhandled_unlinked))
  (modes js))
 
-(executables
- (enabled_if
+(tests
+ (build_if
   (>= %{ocaml_version} 5))
  (names unhandled_unlinked)
  (modules unhandled_unlinked)
- (modes js))
-
-(rule
- (target effects.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps effects.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./effects.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps effects.reference effects.referencejs)
- (action
-  (diff effects.reference effects.referencejs)))
-
-(rule
- (target evenodd.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps evenodd.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./evenodd.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps evenodd.reference evenodd.referencejs)
- (action
-  (diff evenodd.reference evenodd.referencejs)))
-
-(rule
- (target manylive.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps manylive.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./manylive.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps manylive.reference manylive.referencejs)
- (action
-  (diff manylive.reference manylive.referencejs)))
-
-(rule
- (target overflow.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps overflow.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./overflow.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps overflow.reference overflow.referencejs)
- (action
-  (diff overflow.reference overflow.referencejs)))
-
-(rule
- (target partial.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps partial.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./partial.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps partial.reference partial.referencejs)
- (action
-  (diff partial.reference partial.referencejs)))
-
-(rule
- (target reperform.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps reperform.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./reperform.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps reperform.reference reperform.referencejs)
- (action
-  (diff reperform.reference reperform.referencejs)))
-
-(rule
- (target sched.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps sched.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./sched.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps sched.reference sched.referencejs)
- (action
-  (diff sched.reference sched.referencejs)))
-
-(rule
- (target shallow_state_io.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps shallow_state_io.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./shallow_state_io.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps shallow_state_io.reference shallow_state_io.referencejs)
- (action
-  (diff shallow_state_io.reference shallow_state_io.referencejs)))
-
-(rule
- (target shallow_state.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps shallow_state.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./shallow_state.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps shallow_state.reference shallow_state.referencejs)
- (action
-  (diff shallow_state.reference shallow_state.referencejs)))
-
-(rule
- (target test10.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test10.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test10.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test10.reference test10.referencejs)
- (action
-  (diff test10.reference test10.referencejs)))
-
-(rule
- (target test11.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test11.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test11.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test11.reference test11.referencejs)
  (action
-  (diff test11.reference test11.referencejs)))
-
-(rule
- (target test1.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test1.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test1.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test1.reference test1.referencejs)
- (action
-  (diff test1.reference test1.referencejs)))
-
-(rule
- (target test2.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test2.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test2.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test2.reference test2.referencejs)
- (action
-  (diff test2.reference test2.referencejs)))
-
-(rule
- (target test3.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test3.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test3.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test3.reference test3.referencejs)
- (action
-  (diff test3.reference test3.referencejs)))
-
-(rule
- (target test4.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test4.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test4.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test4.reference test4.referencejs)
- (action
-  (diff test4.reference test4.referencejs)))
-
-(rule
- (target test5.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test5.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test5.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test5.reference test5.referencejs)
- (action
-  (diff test5.reference test5.referencejs)))
-
-(rule
- (target test6.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test6.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test6.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test6.reference test6.referencejs)
- (action
-  (diff test6.reference test6.referencejs)))
-
-(rule
- (target test_lazy.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test_lazy.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test_lazy.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test_lazy.reference test_lazy.referencejs)
- (action
-  (diff test_lazy.reference test_lazy.referencejs)))
-
-(rule
- (target unhandled_unlinked.referencejs)
- (enabled_if
-  (and
-   (>= %{ocaml_version} 5)
-   (<> %{profile} using-effects)))
- (deps unhandled_unlinked.bc.js)
- (action
-  (with-accepted-exit-codes
-   2
-   (with-outputs-to
-    %{target}
-    (run node ./unhandled_unlinked.bc.js)))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (and
-   (>= %{ocaml_version} 5)
-   (<> %{profile} using-effects)))
- (deps unhandled_unlinked.reference unhandled_unlinked.referencejs)
- (action
-  (diff unhandled_unlinked.reference unhandled_unlinked.referencejs)))
-
-(rule
- (target used_cont.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps used_cont.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./used_cont.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps used_cont.reference used_cont.referencejs)
- (action
-  (diff used_cont.reference used_cont.referencejs)))
-
-(rule
- (target cmphash.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps cmphash.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./cmphash.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps cmphash.reference cmphash.referencejs)
- (action
-  (diff cmphash.reference cmphash.referencejs)))
-
-(rule
- (target marshal.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps marshal.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./marshal.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps marshal.reference marshal.referencejs)
- (action
-  (diff marshal.reference marshal.referencejs)))
+  (pipe-outputs
+   (with-accepted-exit-codes
+    2
+    (run node %{test}))
+   (run cat)))
+ (modes js))
diff --git a/compiler/tests-ocaml/lib-effects/effects.reference b/compiler/tests-ocaml/lib-effects/effects.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/effects.reference
rename to compiler/tests-ocaml/lib-effects/effects.expected
diff --git a/compiler/tests-ocaml/lib-effects/evenodd.reference b/compiler/tests-ocaml/lib-effects/evenodd.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/evenodd.reference
rename to compiler/tests-ocaml/lib-effects/evenodd.expected
diff --git a/compiler/tests-ocaml/lib-effects/manylive.reference b/compiler/tests-ocaml/lib-effects/manylive.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/manylive.reference
rename to compiler/tests-ocaml/lib-effects/manylive.expected
diff --git a/compiler/tests-ocaml/lib-effects/marshal.reference b/compiler/tests-ocaml/lib-effects/marshal.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/marshal.reference
rename to compiler/tests-ocaml/lib-effects/marshal.expected
diff --git a/compiler/tests-ocaml/lib-effects/overflow.reference b/compiler/tests-ocaml/lib-effects/overflow.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/overflow.reference
rename to compiler/tests-ocaml/lib-effects/overflow.expected
diff --git a/compiler/tests-ocaml/lib-effects/partial.reference b/compiler/tests-ocaml/lib-effects/partial.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/partial.reference
rename to compiler/tests-ocaml/lib-effects/partial.expected
diff --git a/compiler/tests-ocaml/lib-effects/reperform.reference b/compiler/tests-ocaml/lib-effects/reperform.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/reperform.reference
rename to compiler/tests-ocaml/lib-effects/reperform.expected
diff --git a/compiler/tests-ocaml/lib-effects/sched.reference b/compiler/tests-ocaml/lib-effects/sched.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/sched.reference
rename to compiler/tests-ocaml/lib-effects/sched.expected
diff --git a/compiler/tests-ocaml/lib-effects/shallow_state.reference b/compiler/tests-ocaml/lib-effects/shallow_state.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/shallow_state.reference
rename to compiler/tests-ocaml/lib-effects/shallow_state.expected
diff --git a/compiler/tests-ocaml/lib-effects/shallow_state_io.reference b/compiler/tests-ocaml/lib-effects/shallow_state_io.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/shallow_state_io.reference
rename to compiler/tests-ocaml/lib-effects/shallow_state_io.expected
diff --git a/compiler/tests-ocaml/lib-effects/test1.reference b/compiler/tests-ocaml/lib-effects/test1.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test1.reference
rename to compiler/tests-ocaml/lib-effects/test1.expected
diff --git a/compiler/tests-ocaml/lib-effects/test10.reference b/compiler/tests-ocaml/lib-effects/test10.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test10.reference
rename to compiler/tests-ocaml/lib-effects/test10.expected
diff --git a/compiler/tests-ocaml/lib-effects/test11.reference b/compiler/tests-ocaml/lib-effects/test11.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test11.reference
rename to compiler/tests-ocaml/lib-effects/test11.expected
diff --git a/compiler/tests-ocaml/lib-effects/test2.reference b/compiler/tests-ocaml/lib-effects/test2.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test2.reference
rename to compiler/tests-ocaml/lib-effects/test2.expected
diff --git a/compiler/tests-ocaml/lib-effects/test3.reference b/compiler/tests-ocaml/lib-effects/test3.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test3.reference
rename to compiler/tests-ocaml/lib-effects/test3.expected
diff --git a/compiler/tests-ocaml/lib-effects/test4.reference b/compiler/tests-ocaml/lib-effects/test4.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test4.reference
rename to compiler/tests-ocaml/lib-effects/test4.expected
diff --git a/compiler/tests-ocaml/lib-effects/test5.reference b/compiler/tests-ocaml/lib-effects/test5.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test5.reference
rename to compiler/tests-ocaml/lib-effects/test5.expected
diff --git a/compiler/tests-ocaml/lib-effects/test6.reference b/compiler/tests-ocaml/lib-effects/test6.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test6.reference
rename to compiler/tests-ocaml/lib-effects/test6.expected
diff --git a/compiler/tests-ocaml/lib-effects/test_lazy.reference b/compiler/tests-ocaml/lib-effects/test_lazy.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/test_lazy.reference
rename to compiler/tests-ocaml/lib-effects/test_lazy.expected
diff --git a/compiler/tests-ocaml/lib-effects/unhandled_unlinked.reference b/compiler/tests-ocaml/lib-effects/unhandled_unlinked.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/unhandled_unlinked.reference
rename to compiler/tests-ocaml/lib-effects/unhandled_unlinked.expected
diff --git a/compiler/tests-ocaml/lib-effects/used_cont.reference b/compiler/tests-ocaml/lib-effects/used_cont.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-effects/used_cont.reference
rename to compiler/tests-ocaml/lib-effects/used_cont.expected
diff --git a/compiler/tests-ocaml/lib-filename/dune b/compiler/tests-ocaml/lib-filename/dune
index ea24f8524d..407a53e557 100644
--- a/compiler/tests-ocaml/lib-filename/dune
+++ b/compiler/tests-ocaml/lib-filename/dune
@@ -1,32 +1,4 @@
-(executables
+(tests
  (names suffix extension)
  (libraries)
  (modes js))
-
-(rule
- (target suffix.referencejs)
- (deps suffix.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./suffix.bc.js))))
-
-(rule
- (alias runtest)
- (deps suffix.reference suffix.referencejs)
- (action
-  (diff suffix.reference suffix.referencejs)))
-
-(rule
- (target extension.referencejs)
- (deps extension.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./extension.bc.js))))
-
-(rule
- (alias runtest)
- (deps extension.reference extension.referencejs)
- (action
-  (diff extension.reference extension.referencejs)))
diff --git a/compiler/tests-ocaml/lib-filename/extension.reference b/compiler/tests-ocaml/lib-filename/extension.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-filename/extension.reference
rename to compiler/tests-ocaml/lib-filename/extension.expected
diff --git a/compiler/tests-ocaml/lib-filename/suffix.reference b/compiler/tests-ocaml/lib-filename/suffix.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-filename/suffix.reference
rename to compiler/tests-ocaml/lib-filename/suffix.expected
diff --git a/compiler/tests-ocaml/lib-float/dune b/compiler/tests-ocaml/lib-float/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-float/dune
+++ b/compiler/tests-ocaml/lib-float/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-float/test.reference b/compiler/tests-ocaml/lib-float/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-float/test.reference
rename to compiler/tests-ocaml/lib-float/test.expected
diff --git a/compiler/tests-ocaml/lib-floatarray/dune b/compiler/tests-ocaml/lib-floatarray/dune
index 15a2441d44..b3af4c6d57 100644
--- a/compiler/tests-ocaml/lib-floatarray/dune
+++ b/compiler/tests-ocaml/lib-floatarray/dune
@@ -1,16 +1,4 @@
-(executables
+(tests
  (names floatarray)
  (libraries)
  (modes js))
-
-(rule
- (target floatarray.referencejs)
- (deps floatarray.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./floatarray.bc.js))))
-
-(alias
- (name runtest)
- (deps floatarray.referencejs))
diff --git a/compiler/tests-ocaml/lib-format/dune b/compiler/tests-ocaml/lib-format/dune
index cd96782a03..94c4cfe76f 100644
--- a/compiler/tests-ocaml/lib-format/dune
+++ b/compiler/tests-ocaml/lib-format/dune
@@ -1,76 +1,6 @@
-(executables
+(tests
  (names pr6824 print_if_newline pp_print_custom_break print_seq tformat)
  (libraries)
  (flags
   (:standard -no-strict-formats \ -strict-formats))
  (modes js))
-
-(rule
- (target pr6824.referencejs)
- (deps pr6824.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./pr6824.bc.js))))
-
-(rule
- (alias runtest)
- (deps pr6824.reference pr6824.referencejs)
- (action
-  (diff pr6824.reference pr6824.referencejs)))
-
-(rule
- (target print_if_newline.referencejs)
- (deps print_if_newline.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./print_if_newline.bc.js))))
-
-(rule
- (alias runtest)
- (deps print_if_newline.reference print_if_newline.referencejs)
- (action
-  (diff print_if_newline.reference print_if_newline.referencejs)))
-
-(rule
- (target pp_print_custom_break.referencejs)
- (deps pp_print_custom_break.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./pp_print_custom_break.bc.js))))
-
-(rule
- (alias runtest)
- (deps pp_print_custom_break.reference pp_print_custom_break.referencejs)
- (action
-  (diff pp_print_custom_break.reference pp_print_custom_break.referencejs)))
-
-(rule
- (target print_seq.referencejs)
- (deps print_seq.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./print_seq.bc.js))))
-
-(rule
- (alias runtest)
- (deps print_seq.reference print_seq.referencejs)
- (action
-  (diff print_seq.reference print_seq.referencejs)))
-
-(rule
- (target tformat.referencejs)
- (deps tformat.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./tformat.bc.js))))
-
-(rule
- (alias runtest)
- (deps tformat.reference tformat.referencejs)
- (action
-  (diff tformat.reference tformat.referencejs)))
diff --git a/compiler/tests-ocaml/lib-format/pp_print_custom_break.reference b/compiler/tests-ocaml/lib-format/pp_print_custom_break.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-format/pp_print_custom_break.reference
rename to compiler/tests-ocaml/lib-format/pp_print_custom_break.expected
diff --git a/compiler/tests-ocaml/lib-format/pr6824.reference b/compiler/tests-ocaml/lib-format/pr6824.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-format/pr6824.reference
rename to compiler/tests-ocaml/lib-format/pr6824.expected
diff --git a/compiler/tests-ocaml/lib-format/print_if_newline.reference b/compiler/tests-ocaml/lib-format/print_if_newline.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-format/print_if_newline.reference
rename to compiler/tests-ocaml/lib-format/print_if_newline.expected
diff --git a/compiler/tests-ocaml/lib-format/print_seq.reference b/compiler/tests-ocaml/lib-format/print_seq.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-format/print_seq.reference
rename to compiler/tests-ocaml/lib-format/print_seq.expected
diff --git a/compiler/tests-ocaml/lib-format/tformat.reference b/compiler/tests-ocaml/lib-format/tformat.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-format/tformat.reference
rename to compiler/tests-ocaml/lib-format/tformat.expected
diff --git a/compiler/tests-ocaml/lib-fun/dune b/compiler/tests-ocaml/lib-fun/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-fun/dune
+++ b/compiler/tests-ocaml/lib-fun/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-fun/test.reference b/compiler/tests-ocaml/lib-fun/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-fun/test.reference
rename to compiler/tests-ocaml/lib-fun/test.expected
diff --git a/compiler/tests-ocaml/lib-gc/dune b/compiler/tests-ocaml/lib-gc/dune
index fab49e8243..13e636f3e2 100644
--- a/compiler/tests-ocaml/lib-gc/dune
+++ b/compiler/tests-ocaml/lib-gc/dune
@@ -1,11 +1,5 @@
-(executables
+(tests
  (names test_gc)
  (libraries)
  (flags -w -69)
  (modes js))
-
-(rule
- (alias runtest)
- (deps test_gc.bc.js)
- (action
-  (run node test_gc.bc.js)))
diff --git a/compiler/tests-ocaml/lib-hashtbl/dune b/compiler/tests-ocaml/lib-hashtbl/dune
index f167976635..2a260ec2f8 100644
--- a/compiler/tests-ocaml/lib-hashtbl/dune
+++ b/compiler/tests-ocaml/lib-hashtbl/dune
@@ -1,59 +1,31 @@
-(executables
+(tests
  (names hfun)
+ (deps ../../../LICENSE)
  (modules hfun)
  (libraries)
  (modes js))
 
-(executables
+(tests
  (names htbl)
+ (deps ../../../LICENSE)
  (modules htbl)
- (enabled_if
+ (build_if
   (>= %{ocaml_version} 5))
  (libraries)
  (modes js))
 
 (rule
- (target hfun.referencejs)
- (deps hfun.bc.js ../../../LICENSE)
  (action
-  (with-stdout-to
-   %{target}
-   (run node ./hfun.bc.js))))
-
-(rule
- (alias runtest)
+  (copy hfun.expected-js hfun.expected))
  (enabled_if
   (and
    (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
- (deps hfun.referencejs hfun.reference)
- (action
-  (diff hfun.referencejs hfun.reference)))
+   (<> %{profile} wasm-effects))))
 
 (rule
- (alias runtest)
+ (action
+  (copy hfun.expected-wasm hfun.expected))
  (enabled_if
   (or
    (= %{profile} wasm)
-   (= %{profile} wasm-effects)))
- (deps hfun.referencejs hfun.reference-wasm)
- (action
-  (diff hfun.referencejs hfun.reference-wasm)))
-
-(rule
- (target htbl.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps htbl.bc.js ../../../LICENSE)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./htbl.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps htbl.reference htbl.referencejs)
- (action
-  (diff htbl.reference htbl.referencejs)))
+   (= %{profile} wasm-effects))))
diff --git a/compiler/tests-ocaml/lib-hashtbl/hfun.reference b/compiler/tests-ocaml/lib-hashtbl/hfun.expected-js
similarity index 100%
rename from compiler/tests-ocaml/lib-hashtbl/hfun.reference
rename to compiler/tests-ocaml/lib-hashtbl/hfun.expected-js
diff --git a/compiler/tests-ocaml/lib-hashtbl/hfun.reference-wasm b/compiler/tests-ocaml/lib-hashtbl/hfun.expected-wasm
similarity index 100%
rename from compiler/tests-ocaml/lib-hashtbl/hfun.reference-wasm
rename to compiler/tests-ocaml/lib-hashtbl/hfun.expected-wasm
diff --git a/compiler/tests-ocaml/lib-hashtbl/htbl.reference b/compiler/tests-ocaml/lib-hashtbl/htbl.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-hashtbl/htbl.reference
rename to compiler/tests-ocaml/lib-hashtbl/htbl.expected
diff --git a/compiler/tests-ocaml/lib-int/dune b/compiler/tests-ocaml/lib-int/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-int/dune
+++ b/compiler/tests-ocaml/lib-int/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-int/test.reference b/compiler/tests-ocaml/lib-int/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-int/test.reference
rename to compiler/tests-ocaml/lib-int/test.expected
diff --git a/compiler/tests-ocaml/lib-int64/dune b/compiler/tests-ocaml/lib-int64/dune
index 78550bb5e3..4ff01bc02f 100644
--- a/compiler/tests-ocaml/lib-int64/dune
+++ b/compiler/tests-ocaml/lib-int64/dune
@@ -1,32 +1,4 @@
-(executables
+(tests
  (names test issue9460)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
-
-(rule
- (target issue9460.referencejs)
- (deps issue9460.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./issue9460.bc.js))))
-
-(rule
- (alias runtest)
- (deps issue9460.reference issue9460.referencejs)
- (action
-  (diff issue9460.reference issue9460.referencejs)))
diff --git a/compiler/tests-ocaml/lib-int64/issue9460.reference b/compiler/tests-ocaml/lib-int64/issue9460.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-int64/issue9460.reference
rename to compiler/tests-ocaml/lib-int64/issue9460.expected
diff --git a/compiler/tests-ocaml/lib-int64/test.reference b/compiler/tests-ocaml/lib-int64/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-int64/test.reference
rename to compiler/tests-ocaml/lib-int64/test.expected
diff --git a/compiler/tests-ocaml/lib-list/dune b/compiler/tests-ocaml/lib-list/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-list/dune
+++ b/compiler/tests-ocaml/lib-list/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-list/test.reference b/compiler/tests-ocaml/lib-list/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-list/test.reference
rename to compiler/tests-ocaml/lib-list/test.expected
diff --git a/compiler/tests-ocaml/lib-option/dune b/compiler/tests-ocaml/lib-option/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-option/dune
+++ b/compiler/tests-ocaml/lib-option/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-option/test.reference b/compiler/tests-ocaml/lib-option/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-option/test.reference
rename to compiler/tests-ocaml/lib-option/test.expected
diff --git a/compiler/tests-ocaml/lib-printf/dune b/compiler/tests-ocaml/lib-printf/dune
index 766ae6ff86..69defbd4e8 100644
--- a/compiler/tests-ocaml/lib-printf/dune
+++ b/compiler/tests-ocaml/lib-printf/dune
@@ -1,4 +1,4 @@
-(executables
+(tests
  (names pr6534 pr6938 tprintf)
  (libraries)
  (flags
@@ -6,45 +6,3 @@
  (modes
   js
   (best exe)))
-
-(rule
- (target pr6534.referencejs)
- (deps pr6534.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./pr6534.bc.js))))
-
-(rule
- (alias runtest)
- (deps pr6534.reference pr6534.referencejs)
- (action
-  (diff pr6534.reference pr6534.referencejs)))
-
-(rule
- (target pr6938.referencejs)
- (deps pr6938.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./pr6938.bc.js))))
-
-(rule
- (alias runtest)
- (deps pr6938.reference pr6938.referencejs)
- (action
-  (diff pr6938.reference pr6938.referencejs)))
-
-(rule
- (target tprintf.referencejs)
- (deps tprintf.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./tprintf.bc.js))))
-
-(rule
- (alias runtest)
- (deps tprintf.reference tprintf.referencejs)
- (action
-  (diff tprintf.reference tprintf.referencejs)))
diff --git a/compiler/tests-ocaml/lib-printf/pr6534.reference b/compiler/tests-ocaml/lib-printf/pr6534.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-printf/pr6534.reference
rename to compiler/tests-ocaml/lib-printf/pr6534.expected
diff --git a/compiler/tests-ocaml/lib-printf/pr6938.reference b/compiler/tests-ocaml/lib-printf/pr6938.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-printf/pr6938.reference
rename to compiler/tests-ocaml/lib-printf/pr6938.expected
diff --git a/compiler/tests-ocaml/lib-printf/tprintf.reference b/compiler/tests-ocaml/lib-printf/tprintf.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-printf/tprintf.reference
rename to compiler/tests-ocaml/lib-printf/tprintf.expected
diff --git a/compiler/tests-ocaml/lib-queue/dune b/compiler/tests-ocaml/lib-queue/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-queue/dune
+++ b/compiler/tests-ocaml/lib-queue/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-queue/test.reference b/compiler/tests-ocaml/lib-queue/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-queue/test.reference
rename to compiler/tests-ocaml/lib-queue/test.expected
diff --git a/compiler/tests-ocaml/lib-random/defaultinit.reference b/compiler/tests-ocaml/lib-random/defaultinit.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-random/defaultinit.reference
rename to compiler/tests-ocaml/lib-random/defaultinit.expected
diff --git a/compiler/tests-ocaml/lib-random/dune b/compiler/tests-ocaml/lib-random/dune
index 8669046443..840bec2a7f 100644
--- a/compiler/tests-ocaml/lib-random/dune
+++ b/compiler/tests-ocaml/lib-random/dune
@@ -1,52 +1,8 @@
-(executables
+(tests
  (names chi2 selfinit testvectors)
- (enabled_if
+ (build_if
   (>= %{ocaml_version} 5))
  (libraries)
  (modes
   js
   (best exe)))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps chi2.bc.js)
- (action
-  (run node chi2.bc.js)))
-
-(rule
- (target selfinit.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps selfinit.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./selfinit.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps selfinit.reference selfinit.referencejs)
- (action
-  (diff selfinit.reference selfinit.referencejs)))
-
-(rule
- (target testvectors.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps testvectors.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./testvectors.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps testvectors.reference testvectors.referencejs)
- (action
-  (diff testvectors.reference testvectors.referencejs)))
diff --git a/compiler/tests-ocaml/lib-random/selfinit.reference b/compiler/tests-ocaml/lib-random/selfinit.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-random/selfinit.reference
rename to compiler/tests-ocaml/lib-random/selfinit.expected
diff --git a/compiler/tests-ocaml/lib-random/testvectors.reference b/compiler/tests-ocaml/lib-random/testvectors.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-random/testvectors.reference
rename to compiler/tests-ocaml/lib-random/testvectors.expected
diff --git a/compiler/tests-ocaml/lib-result/dune b/compiler/tests-ocaml/lib-result/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-result/dune
+++ b/compiler/tests-ocaml/lib-result/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-result/test.reference b/compiler/tests-ocaml/lib-result/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-result/test.reference
rename to compiler/tests-ocaml/lib-result/test.expected
diff --git a/compiler/tests-ocaml/lib-seq/dune b/compiler/tests-ocaml/lib-seq/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-seq/dune
+++ b/compiler/tests-ocaml/lib-seq/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-seq/test.reference b/compiler/tests-ocaml/lib-seq/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-seq/test.reference
rename to compiler/tests-ocaml/lib-seq/test.expected
diff --git a/compiler/tests-ocaml/lib-set/dune b/compiler/tests-ocaml/lib-set/dune
index 3c850fd441..9e8fed86d5 100644
--- a/compiler/tests-ocaml/lib-set/dune
+++ b/compiler/tests-ocaml/lib-set/dune
@@ -1,32 +1,4 @@
-(executables
+(tests
  (names testmap testset)
  (libraries)
  (modes js))
-
-(rule
- (target testmap.referencejs)
- (deps testmap.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./testmap.bc.js))))
-
-(rule
- (alias runtest)
- (deps testmap.reference testmap.referencejs)
- (action
-  (diff testmap.reference testmap.referencejs)))
-
-(rule
- (target testset.referencejs)
- (deps testset.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./testset.bc.js))))
-
-(rule
- (alias runtest)
- (deps testset.reference testset.referencejs)
- (action
-  (diff testset.reference testset.referencejs)))
diff --git a/compiler/tests-ocaml/lib-set/testmap.reference b/compiler/tests-ocaml/lib-set/testmap.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-set/testmap.reference
rename to compiler/tests-ocaml/lib-set/testmap.expected
diff --git a/compiler/tests-ocaml/lib-set/testset.reference b/compiler/tests-ocaml/lib-set/testset.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-set/testset.reference
rename to compiler/tests-ocaml/lib-set/testset.expected
diff --git a/compiler/tests-ocaml/lib-stack/dune b/compiler/tests-ocaml/lib-stack/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-stack/dune
+++ b/compiler/tests-ocaml/lib-stack/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-stack/test.reference b/compiler/tests-ocaml/lib-stack/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-stack/test.reference
rename to compiler/tests-ocaml/lib-stack/test.expected
diff --git a/compiler/tests-ocaml/lib-str/dune b/compiler/tests-ocaml/lib-str/dune
index bfd1aeb60c..18b732190a 100644
--- a/compiler/tests-ocaml/lib-str/dune
+++ b/compiler/tests-ocaml/lib-str/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names t01)
  (libraries str)
  (modes js))
-
-(rule
- (target t01.referencejs)
- (deps t01.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./t01.bc.js))))
-
-(rule
- (alias runtest)
- (deps t01.reference t01.referencejs)
- (action
-  (diff t01.reference t01.referencejs)))
diff --git a/compiler/tests-ocaml/lib-str/t01.reference b/compiler/tests-ocaml/lib-str/t01.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-str/t01.reference
rename to compiler/tests-ocaml/lib-str/t01.expected
diff --git a/compiler/tests-ocaml/lib-string/dune b/compiler/tests-ocaml/lib-string/dune
index 03cbf02fd4..f1b08d6ad0 100644
--- a/compiler/tests-ocaml/lib-string/dune
+++ b/compiler/tests-ocaml/lib-string/dune
@@ -1,32 +1,6 @@
-(executables
+(tests
  (names test_string binary)
- (enabled_if
+ (build_if
   (>= %{ocaml_version} 5))
  (libraries)
  (modes js))
-
-(rule
- (target test_string.referencejs)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test_string.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test_string.bc.js))))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps test_string.reference test_string.referencejs)
- (action
-  (diff test_string.reference test_string.referencejs)))
-
-(rule
- (alias runtest)
- (enabled_if
-  (>= %{ocaml_version} 5))
- (deps binary.bc.js)
- (action
-  (run node binary.bc.js)))
diff --git a/compiler/tests-ocaml/lib-string/test_string.reference b/compiler/tests-ocaml/lib-string/test_string.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-string/test_string.reference
rename to compiler/tests-ocaml/lib-string/test_string.expected
diff --git a/compiler/tests-ocaml/lib-uchar/dune b/compiler/tests-ocaml/lib-uchar/dune
index cbf1c10306..9047167ba4 100644
--- a/compiler/tests-ocaml/lib-uchar/dune
+++ b/compiler/tests-ocaml/lib-uchar/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names test)
  (libraries)
  (modes js))
-
-(rule
- (target test.referencejs)
- (deps test.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./test.bc.js))))
-
-(rule
- (alias runtest)
- (deps test.reference test.referencejs)
- (action
-  (diff test.reference test.referencejs)))
diff --git a/compiler/tests-ocaml/lib-uchar/test.reference b/compiler/tests-ocaml/lib-uchar/test.expected
similarity index 100%
rename from compiler/tests-ocaml/lib-uchar/test.reference
rename to compiler/tests-ocaml/lib-uchar/test.expected
diff --git a/compiler/tests-ocaml/prim-bigstring/bigstring_access.reference b/compiler/tests-ocaml/prim-bigstring/bigstring_access.expected
similarity index 100%
rename from compiler/tests-ocaml/prim-bigstring/bigstring_access.reference
rename to compiler/tests-ocaml/prim-bigstring/bigstring_access.expected
diff --git a/compiler/tests-ocaml/prim-bigstring/dune b/compiler/tests-ocaml/prim-bigstring/dune
index 7c85997d5e..2e162bd45a 100644
--- a/compiler/tests-ocaml/prim-bigstring/dune
+++ b/compiler/tests-ocaml/prim-bigstring/dune
@@ -1,32 +1,4 @@
-(executables
+(tests
  (names bigstring_access string_access)
  (libraries)
  (modes js))
-
-(rule
- (target bigstring_access.referencejs)
- (deps bigstring_access.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./bigstring_access.bc.js))))
-
-(rule
- (alias runtest)
- (deps bigstring_access.reference bigstring_access.referencejs)
- (action
-  (diff bigstring_access.reference bigstring_access.referencejs)))
-
-(rule
- (target string_access.referencejs)
- (deps string_access.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./string_access.bc.js))))
-
-(rule
- (alias runtest)
- (deps string_access.reference string_access.referencejs)
- (action
-  (diff string_access.reference string_access.referencejs)))
diff --git a/compiler/tests-ocaml/prim-bigstring/string_access.reference b/compiler/tests-ocaml/prim-bigstring/string_access.expected
similarity index 100%
rename from compiler/tests-ocaml/prim-bigstring/string_access.reference
rename to compiler/tests-ocaml/prim-bigstring/string_access.expected
diff --git a/compiler/tests-ocaml/prim-bswap/bswap.reference b/compiler/tests-ocaml/prim-bswap/bswap.expected
similarity index 100%
rename from compiler/tests-ocaml/prim-bswap/bswap.reference
rename to compiler/tests-ocaml/prim-bswap/bswap.expected
diff --git a/compiler/tests-ocaml/prim-bswap/dune b/compiler/tests-ocaml/prim-bswap/dune
index 5fa32da796..36c5b217b1 100644
--- a/compiler/tests-ocaml/prim-bswap/dune
+++ b/compiler/tests-ocaml/prim-bswap/dune
@@ -1,18 +1,4 @@
-(executables
+(tests
  (names bswap)
  (libraries)
  (modes js))
-
-(rule
- (target bswap.referencejs)
- (deps bswap.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./bswap.bc.js))))
-
-(rule
- (alias runtest)
- (deps bswap.reference bswap.referencejs)
- (action
-  (diff bswap.reference bswap.referencejs)))
diff --git a/compiler/tests-ocaml/prim-revapply/apply.reference b/compiler/tests-ocaml/prim-revapply/apply.expected
similarity index 100%
rename from compiler/tests-ocaml/prim-revapply/apply.reference
rename to compiler/tests-ocaml/prim-revapply/apply.expected
diff --git a/compiler/tests-ocaml/prim-revapply/dune b/compiler/tests-ocaml/prim-revapply/dune
index bddaf61921..bf4e90bb65 100644
--- a/compiler/tests-ocaml/prim-revapply/dune
+++ b/compiler/tests-ocaml/prim-revapply/dune
@@ -1,32 +1,4 @@
-(executables
+(tests
  (names apply revapply)
  (libraries)
  (modes js))
-
-(rule
- (target apply.referencejs)
- (deps apply.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./apply.bc.js))))
-
-(rule
- (alias runtest)
- (deps apply.reference apply.referencejs)
- (action
-  (diff apply.reference apply.referencejs)))
-
-(rule
- (target revapply.referencejs)
- (deps revapply.bc.js)
- (action
-  (with-stdout-to
-   %{target}
-   (run node ./revapply.bc.js))))
-
-(rule
- (alias runtest)
- (deps revapply.reference revapply.referencejs)
- (action
-  (diff revapply.reference revapply.referencejs)))
diff --git a/compiler/tests-ocaml/prim-revapply/revapply.reference b/compiler/tests-ocaml/prim-revapply/revapply.expected
similarity index 100%
rename from compiler/tests-ocaml/prim-revapply/revapply.reference
rename to compiler/tests-ocaml/prim-revapply/revapply.expected
diff --git a/compiler/tests-re/dune b/compiler/tests-re/dune
index cc867c42a2..10c45d2c5b 100644
--- a/compiler/tests-re/dune
+++ b/compiler/tests-re/dune
@@ -3,13 +3,7 @@
   (flags
    (:standard -w -32-69))))
 
-(executables
+(tests
  (names test_str)
  (libraries str re)
  (modes js))
-
-(rule
- (alias runtest)
- (deps test_str.bc.js)
- (action
-  (run node ./test_str.bc.js)))
diff --git a/compiler/tests-runtime-events/dune b/compiler/tests-runtime-events/dune
index 15083cc9e0..f387de95eb 100644
--- a/compiler/tests-runtime-events/dune
+++ b/compiler/tests-runtime-events/dune
@@ -3,17 +3,9 @@
   (flags
    (:standard -w -32-69))))
 
-(executables
+(tests
  (names test_runtime_events)
- (enabled_if
+ (build_if
   (>= %{ocaml_version} 5.1.0))
  (libraries runtime_events)
  (modes js))
-
-(rule
- (alias runtest)
- (deps test_runtime_events.bc.js)
- (enabled_if
-  (>= %{ocaml_version} 5.1.0))
- (action
-  (run node ./test_runtime_events.bc.js)))
diff --git a/compiler/tests-sourcemap/dump.reference b/compiler/tests-sourcemap/dump_sourcemap.expected
similarity index 100%
rename from compiler/tests-sourcemap/dump.reference
rename to compiler/tests-sourcemap/dump_sourcemap.expected
diff --git a/compiler/tests-sourcemap/dune b/compiler/tests-sourcemap/dune
index ad82cf400c..22b4488094 100644
--- a/compiler/tests-sourcemap/dune
+++ b/compiler/tests-sourcemap/dune
@@ -24,24 +24,11 @@
    (<> %{profile} wasm-effects)))
  (modules a b c d))
 
-(executable
+(test
  (name dump_sourcemap)
  (modules dump_sourcemap)
- (libraries js_of_ocaml-compiler))
-
-(rule
- (target dump)
- (enabled_if
-  (= %{profile} dev))
  (action
-  (with-stdout-to
-   %{target}
-   (run ./dump_sourcemap.exe %{dep:test.bc.js}))))
-
-(rule
- (alias runtest)
+  (run %{test} %{dep:test.bc.js}))
  (enabled_if
   (= %{profile} dev))
- (deps dump.reference dump)
- (action
-  (diff dump.reference dump)))
+ (libraries js_of_ocaml-compiler))
diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune
index 2e541eec64..48bd189995 100644
--- a/compiler/tests-toplevel/dune
+++ b/compiler/tests-toplevel/dune
@@ -21,40 +21,37 @@
   (run %{bin:js_of_ocaml} --toplevel %{dep:test_toplevel.bc} -o %{targets})))
 
 (rule
- (target test_toplevel.referencejs)
- (deps test_toplevel.js)
+ (target test_toplevel.bc.js.actual)
  (enabled_if
   (and
+   (>= %{ocaml_version} 5.2)
    (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)
-   (>= %{ocaml_version} 5.2)))
+   (<> %{profile} wasm-effects)))
  (action
   (with-stdout-to
    %{target}
-   (run node ./test_toplevel.js))))
+   (run node %{dep:test_toplevel.bc.js}))))
 
 (rule
- (target test_toplevel.referencebcjs)
- (deps test_toplevel.bc.js)
+ (target test_toplevel.js.actual)
  (enabled_if
   (and
+   (>= %{ocaml_version} 5.2)
    (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)
-   (>= %{ocaml_version} 5.2)))
+   (<> %{profile} wasm-effects)))
  (action
   (with-stdout-to
    %{target}
-   (run node ./test_toplevel.bc.js))))
+   (run node %{dep:test_toplevel.js}))))
 
 (rule
  (alias runtest)
  (enabled_if
   (and
+   (>= %{ocaml_version} 5.2)
    (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)
-   (>= %{ocaml_version} 5.2)))
- (deps test_toplevel.reference test_toplevel.referencejs)
+   (<> %{profile} wasm-effects)))
  (action
   (progn
-   (diff test_toplevel.reference test_toplevel.referencebcjs)
-   (diff test_toplevel.reference test_toplevel.referencejs))))
+   (diff test_toplevel.expected test_toplevel.bc.js.actual)
+   (diff test_toplevel.expected test_toplevel.js.actual))))
diff --git a/compiler/tests-toplevel/test_toplevel.reference b/compiler/tests-toplevel/test_toplevel.expected
similarity index 100%
rename from compiler/tests-toplevel/test_toplevel.reference
rename to compiler/tests-toplevel/test_toplevel.expected
diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune
index de7b646467..fc33f16583 100644
--- a/compiler/tests-wasm_of_ocaml/dune
+++ b/compiler/tests-wasm_of_ocaml/dune
@@ -1,45 +1,5 @@
-(executables
+(tests
  (names gh38 gh46 gh107 gh112)
  (modes js)
  (js_of_ocaml
   (flags :standard --disable optcall --no-inline)))
-
-(rule
- (target gh38.actual)
- (enabled_if
-  (= %{profile} wasm))
- (alias runtest)
- (action
-  (with-outputs-to
-   %{target}
-   (run node %{dep:gh38.bc.js}))))
-
-(rule
- (target gh46.actual)
- (enabled_if
-  (= %{profile} wasm))
- (alias runtest)
- (action
-  (with-outputs-to
-   %{target}
-   (run node %{dep:gh46.bc.js}))))
-
-(rule
- (target gh107.actual)
- (enabled_if
-  (= %{profile} wasm))
- (alias runtest)
- (action
-  (with-outputs-to
-   %{target}
-   (run node %{dep:gh107.bc.js}))))
-
-(rule
- (target gh112.actual)
- (enabled_if
-  (= %{profile} wasm))
- (alias runtest)
- (action
-  (with-outputs-to
-   %{target}
-   (run node %{dep:gh112.bc.js}))))
diff --git a/compiler/tests-wasm_of_ocaml/gh107.expected b/compiler/tests-wasm_of_ocaml/gh107.expected
new file mode 100644
index 0000000000..cf2650d57b
--- /dev/null
+++ b/compiler/tests-wasm_of_ocaml/gh107.expected
@@ -0,0 +1 @@
+2.000000
diff --git a/compiler/tests-wasm_of_ocaml/gh107.ml b/compiler/tests-wasm_of_ocaml/gh107.ml
index 21f42c725d..ca4202d7f8 100644
--- a/compiler/tests-wasm_of_ocaml/gh107.ml
+++ b/compiler/tests-wasm_of_ocaml/gh107.ml
@@ -8,4 +8,4 @@ type t =
 let () =
   let f x = { x; y = 2. } in
   let x = f 1. in
-  Format.eprintf "%f@." x.y
+  Format.printf "%f@." x.y
diff --git a/examples/separate_compilation/bin.reference b/examples/separate_compilation/bin.expected
similarity index 100%
rename from examples/separate_compilation/bin.reference
rename to examples/separate_compilation/bin.expected
diff --git a/examples/separate_compilation/dune b/examples/separate_compilation/dune
index 39b4261aef..110be78325 100644
--- a/examples/separate_compilation/dune
+++ b/examples/separate_compilation/dune
@@ -101,7 +101,7 @@
    %{targets})))
 
 (rule
- (target bin.referencejs)
+ (target bin.actual)
  (deps bin.js)
  (action
   (with-stdout-to
@@ -114,9 +114,8 @@
   (and
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
- (deps bin.reference bin.referencejs)
  (action
-  (diff bin.reference bin.referencejs)))
+  (diff bin.expected bin.actual)))
 
 (alias
  (name default)
diff --git a/toplevel/test/dune b/toplevel/test/dune
index 4acf6aa48b..27d0388029 100644
--- a/toplevel/test/dune
+++ b/toplevel/test/dune
@@ -27,7 +27,7 @@
    %{targets})))
 
 (rule
- (target test_toplevel.referencejs)
+ (target test_toplevel.actual)
  (deps test_toplevel.js)
  (action
   (with-stdout-to
@@ -40,6 +40,5 @@
   (and
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
- (deps test_toplevel.reference test_toplevel.referencejs)
  (action
-  (diff test_toplevel.reference test_toplevel.referencejs)))
+  (diff test_toplevel.expected test_toplevel.actual)))
diff --git a/toplevel/test/test_toplevel.reference b/toplevel/test/test_toplevel.expected
similarity index 100%
rename from toplevel/test/test_toplevel.reference
rename to toplevel/test/test_toplevel.expected

From cfba5c3735ed7722532a0c16add24e8e1688855d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 2 Nov 2024 19:00:14 +0100
Subject: [PATCH 422/481] Compiler tests: lighter conditions

---
 compiler/tests-compiler/dune.inc         | 220 +++++++++++------------
 compiler/tests-compiler/gen-rules/gen.ml |   9 +-
 2 files changed, 114 insertions(+), 115 deletions(-)

diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index dc6917b7c1..e10abfd48d 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -2,11 +2,11 @@
 (library
  ;; compiler/tests-compiler/array_access.ml
  (name array_access_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules array_access)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -17,11 +17,11 @@
 (library
  ;; compiler/tests-compiler/build_path_prefix_map.ml
  (name build_path_prefix_map_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules build_path_prefix_map)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -32,11 +32,11 @@
 (library
  ;; compiler/tests-compiler/call_gen.ml
  (name call_gen_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules call_gen)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -47,11 +47,11 @@
 (library
  ;; compiler/tests-compiler/compact.ml
  (name compact_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules compact)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -62,11 +62,11 @@
 (library
  ;; compiler/tests-compiler/cond.ml
  (name cond_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules cond)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -77,11 +77,11 @@
 (library
  ;; compiler/tests-compiler/direct_calls.ml
  (name direct_calls_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules direct_calls)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -92,11 +92,11 @@
 (library
  ;; compiler/tests-compiler/effects.ml
  (name effects_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
+ (enabled_if (and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules effects)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -107,11 +107,11 @@
 (library
  ;; compiler/tests-compiler/effects_continuations.ml
  (name effects_continuations_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules effects_continuations)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -122,11 +122,11 @@
 (library
  ;; compiler/tests-compiler/effects_exceptions.ml
  (name effects_exceptions_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules effects_exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -137,11 +137,11 @@
 (library
  ;; compiler/tests-compiler/effects_toplevel.ml
  (name effects_toplevel_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules effects_toplevel)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -152,11 +152,11 @@
 (library
  ;; compiler/tests-compiler/eliminate_exception_handler.ml
  (name eliminate_exception_handler_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules eliminate_exception_handler)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -167,11 +167,11 @@
 (library
  ;; compiler/tests-compiler/empty_cma.ml
  (name empty_cma_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules empty_cma)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -182,11 +182,11 @@
 (library
  ;; compiler/tests-compiler/end_to_end.ml
  (name end_to_end_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules end_to_end)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -197,11 +197,11 @@
 (library
  ;; compiler/tests-compiler/error.ml
  (name error_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules error)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -212,11 +212,11 @@
 (library
  ;; compiler/tests-compiler/es6.ml
  (name es6_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules es6)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -227,11 +227,11 @@
 (library
  ;; compiler/tests-compiler/exceptions.ml
  (name exceptions_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -242,11 +242,11 @@
 (library
  ;; compiler/tests-compiler/exports.ml
  (name exports_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules exports)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -257,11 +257,11 @@
 (library
  ;; compiler/tests-compiler/getenv.ml
  (name getenv_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules getenv)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -272,11 +272,11 @@
 (library
  ;; compiler/tests-compiler/gh1007.ml
  (name gh1007_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1007)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -287,11 +287,11 @@
 (library
  ;; compiler/tests-compiler/gh1051.ml
  (name gh1051_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) %{arch_sixtyfour}))
+ (enabled_if (and %{arch_sixtyfour} (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1051)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) %{arch_sixtyfour}))
+  (enabled_if %{arch_sixtyfour})
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -302,11 +302,11 @@
 (library
  ;; compiler/tests-compiler/gh1320.ml
  (name gh1320_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1320)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -317,11 +317,11 @@
 (library
  ;; compiler/tests-compiler/gh1349.ml
  (name gh1349_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1349)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -332,11 +332,11 @@
 (library
  ;; compiler/tests-compiler/gh1354.ml
  (name gh1354_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1354)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -347,11 +347,11 @@
 (library
  ;; compiler/tests-compiler/gh1390.ml
  (name gh1390_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1390)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -362,11 +362,11 @@
 (library
  ;; compiler/tests-compiler/gh1481.ml
  (name gh1481_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1481)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -377,11 +377,11 @@
 (library
  ;; compiler/tests-compiler/gh1494.ml
  (name gh1494_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1494)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -392,11 +392,11 @@
 (library
  ;; compiler/tests-compiler/gh1559.ml
  (name gh1559_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1559)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -407,11 +407,11 @@
 (library
  ;; compiler/tests-compiler/gh1599.ml
  (name gh1599_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1599)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -422,11 +422,11 @@
 (library
  ;; compiler/tests-compiler/gh1659.ml
  (name gh1659_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh1659)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -437,11 +437,11 @@
 (library
  ;; compiler/tests-compiler/gh747.ml
  (name gh747_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gh747)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -452,11 +452,11 @@
 (library
  ;; compiler/tests-compiler/gl507.ml
  (name gl507_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules gl507)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -467,11 +467,11 @@
 (library
  ;; compiler/tests-compiler/global_deadcode.ml
  (name global_deadcode_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules global_deadcode)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -482,11 +482,11 @@
 (library
  ;; compiler/tests-compiler/inlining.ml
  (name inlining_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules inlining)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -497,11 +497,11 @@
 (library
  ;; compiler/tests-compiler/js_parser_printer.ml
  (name js_parser_printer_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules js_parser_printer)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -512,11 +512,11 @@
 (library
  ;; compiler/tests-compiler/jsopt.ml
  (name jsopt_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules jsopt)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -527,11 +527,11 @@
 (library
  ;; compiler/tests-compiler/lambda_lifting.ml
  (name lambda_lifting_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules lambda_lifting)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -542,11 +542,11 @@
 (library
  ;; compiler/tests-compiler/lazy.ml
  (name lazy_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules lazy)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
+  (enabled_if (>= %{ocaml_version} 5))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -557,11 +557,11 @@
 (library
  ;; compiler/tests-compiler/loops.ml
  (name loops_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules loops)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -572,11 +572,11 @@
 (library
  ;; compiler/tests-compiler/macro.ml
  (name macro_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules macro)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -587,11 +587,11 @@
 (library
  ;; compiler/tests-compiler/match_with_exn.ml
  (name match_with_exn_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules match_with_exn)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -602,11 +602,11 @@
 (library
  ;; compiler/tests-compiler/minify.ml
  (name minify_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules minify)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -617,11 +617,11 @@
 (library
  ;; compiler/tests-compiler/mutable_closure.ml
  (name mutable_closure_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules mutable_closure)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -632,11 +632,11 @@
 (library
  ;; compiler/tests-compiler/obj.ml
  (name obj_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
+ (enabled_if (and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules obj)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5)))
+  (enabled_if (>= %{ocaml_version} 5))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -647,11 +647,11 @@
 (library
  ;; compiler/tests-compiler/obj_dup.ml
  (name obj_dup_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules obj_dup)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -662,11 +662,11 @@
 (library
  ;; compiler/tests-compiler/scopes.ml
  (name scopes_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules scopes)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -677,11 +677,11 @@
 (library
  ;; compiler/tests-compiler/side_effect.ml
  (name side_effect_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules side_effect)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -692,11 +692,11 @@
 (library
  ;; compiler/tests-compiler/sourcemap.ml
  (name sourcemap_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules sourcemap)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -707,11 +707,11 @@
 (library
  ;; compiler/tests-compiler/static_eval.ml
  (name static_eval_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules static_eval)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -722,11 +722,11 @@
 (library
  ;; compiler/tests-compiler/sys_command.ml
  (name sys_command_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules sys_command)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -737,11 +737,11 @@
 (library
  ;; compiler/tests-compiler/sys_fs.ml
  (name sys_fs_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules sys_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -752,11 +752,11 @@
 (library
  ;; compiler/tests-compiler/tailcall.ml
  (name tailcall_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules tailcall)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -767,11 +767,11 @@
 (library
  ;; compiler/tests-compiler/target_env.ml
  (name target_env_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules target_env)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -782,11 +782,11 @@
 (library
  ;; compiler/tests-compiler/test_string.ml
  (name test_string_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_string)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -797,11 +797,11 @@
 (library
  ;; compiler/tests-compiler/unix_fs.ml
  (name unix_fs_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules unix_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
@@ -812,11 +812,11 @@
 (library
  ;; compiler/tests-compiler/variable_declaration_output.ml
  (name variable_declaration_output_15)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules variable_declaration_output)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+  (enabled_if true)
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml
index 03866594ce..4ddd9fb34f 100644
--- a/compiler/tests-compiler/gen-rules/gen.ml
+++ b/compiler/tests-compiler/gen-rules/gen.ml
@@ -62,10 +62,9 @@ let test_enabled_if = function
 
 let enabled_if cond =
   match cond with
-  | Any -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))"
-  | GE5 ->
-      "(and (<> %{profile} wasm) (<> %{profile} wasm-effects) (>= %{ocaml_version} 5))"
-  | B64 -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects) %{arch_sixtyfour})"
+  | Any -> "true"
+  | GE5 -> "(>= %{ocaml_version} 5)"
+  | B64 -> "%{arch_sixtyfour}"
 
 let () =
   Array.to_list (Sys.readdir ".")
@@ -78,7 +77,7 @@ let () =
 (library
  ;; %s%s.ml
  (name %s_%d)
- (enabled_if %s)
+ (enabled_if (and %s (<> %%{profile} wasm) (<> %%{profile} wasm-effects)))
  (modules %s)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests

From a84940da5b710dac6ccfb3b28d06e5094efdbd38 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Nov 2024 17:16:51 +0100
Subject: [PATCH 423/481] Quiet biome warning regarding "use strict".

---
 biome.json              | 3 +--
 runtime/wasm/runtime.js | 1 +
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/biome.json b/biome.json
index 5dfa12b02b..5de4567ff7 100644
--- a/biome.json
+++ b/biome.json
@@ -37,8 +37,7 @@
       },
       "suspicious": {
         "noAssignInExpressions": "off",
-        "noRedeclare": "off",
-        "noRedundantUseStrict": "off"
+        "noRedeclare": "off"
       }
     }
   },
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 3048c7f0ae..46c9e9a0c3 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -16,6 +16,7 @@
 // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (js) => async (args) => {
+  // biome-ignore lint/suspicious/noRedundantUseStrict:
   "use strict";
   const { link, src, generated } = args;
 

From 04db0cc055009ce069fab6bea3c257718283f6ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Nov 2024 15:38:28 +0100
Subject: [PATCH 424/481] Source maps: avoid some code duplication

---
 compiler/bin-wasm_of_ocaml/compile.ml |   2 +-
 compiler/lib/source_map.ml            |   2 +
 compiler/lib/source_map.mli           |   3 +
 compiler/lib/vlq64.ml                 |  20 ++-
 compiler/lib/vlq64.mli                |  10 ++
 compiler/lib/wasm/wa_link.ml          |   8 +-
 compiler/lib/wasm/wa_source_map.ml    | 239 +++++++++-----------------
 compiler/lib/wasm/wa_source_map.mli   |  18 +-
 compiler/lib/wasm/wa_wasm_link.ml     |  12 +-
 9 files changed, 130 insertions(+), 184 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 314254adc8..80a03443f6 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -240,7 +240,7 @@ let add_source_map sourcemap_don't_inline_content z opt_source_map_file =
       Zip.add_file z ~name:"source_map.map" ~file;
       if not sourcemap_don't_inline_content
       then
-        let sm = Wa_source_map.load file in
+        let sm = Source_map.of_file file in
         Wa_source_map.iter_sources sm (fun i j file ->
             if Sys.file_exists file && not (Sys.is_directory file)
             then
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index bb29b0506c..e2733a5219 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -71,6 +71,8 @@ module Mappings = struct
 
   let empty = Uninterpreted ""
 
+  let is_empty (Uninterpreted s) = String.equal s ""
+
   let of_string_unsafe : string -> t = fun s -> Uninterpreted s
 
   let to_string : t -> string = fun (Uninterpreted s) -> s
diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli
index 5a4791e105..f8d01c2072 100644
--- a/compiler/lib/source_map.mli
+++ b/compiler/lib/source_map.mli
@@ -62,6 +62,9 @@ module Mappings : sig
   val empty : t
   (** The empty mapping. *)
 
+  val is_empty : t -> bool
+  (** Test whether the mapping is empty. *)
+
   val of_string_unsafe : string -> t
   (** [of_string_unsafe] does not perform any
       validation of its argument, unlike {!val:decode}. It is guaranteed that
diff --git a/compiler/lib/vlq64.ml b/compiler/lib/vlq64.ml
index 22f71ce5fc..4f38940f55 100644
--- a/compiler/lib/vlq64.ml
+++ b/compiler/lib/vlq64.ml
@@ -22,7 +22,7 @@ open! Stdlib
 let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
 
 let code_rev =
-  let a = Array.make 255 (-1) in
+  let a = Array.make 256 (-1) in
   for i = 0 to String.length alphabet - 1 do
     a.(Char.code alphabet.[i]) <- i
   done;
@@ -99,3 +99,21 @@ let decode_l s ~pos ~len =
       aux i (d :: acc) len
   in
   aux pos [] len
+
+type input =
+  { string : string
+  ; mutable pos : int
+  ; len : int
+  }
+
+let rec decode' src s pos offset i =
+  let digit = Array.unsafe_get code_rev (Char.code s.[pos]) in
+  if digit = -1 then invalid_arg "Vql64.decode'";
+  let i = i + ((digit land vlq_base_mask) lsl offset) in
+  if digit >= vlq_continuation_bit
+  then decode' src s (pos + 1) (offset + vlq_base_shift) i
+  else (
+    src.pos <- pos + 1;
+    i)
+
+let decode src = fromVLQSigned (decode' src src.string src.pos 0 0)
diff --git a/compiler/lib/vlq64.mli b/compiler/lib/vlq64.mli
index c3accf5215..fb4d19f1fb 100644
--- a/compiler/lib/vlq64.mli
+++ b/compiler/lib/vlq64.mli
@@ -19,6 +19,16 @@
 
 val in_alphabet : char -> bool
 
+type input =
+  { string : string
+  ; mutable pos : int
+  ; len : int
+  }
+
+val encode : Buffer.t -> int -> unit
+
 val encode_l : Buffer.t -> int list -> unit
 
+val decode : input -> int
+
 val decode_l : string -> pos:int -> len:int -> int list
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml
index ef9526ab1e..b5ed051305 100644
--- a/compiler/lib/wasm/wa_link.ml
+++ b/compiler/lib/wasm/wa_link.ml
@@ -575,7 +575,7 @@ let source_name i j file =
 let extract_source_map ~dir ~name z =
   if Zip.has_entry z ~name:"source_map.map"
   then (
-    let sm = Wa_source_map.parse (Zip.read_entry z ~name:"source_map.map") in
+    let sm = Source_map.of_string (Zip.read_entry z ~name:"source_map.map") in
     let sm =
       let rewrite_path path =
         if Filename.is_relative path
@@ -590,7 +590,7 @@ let extract_source_map ~dir ~name z =
           if Zip.has_entry z ~name then Some (Zip.read_entry z ~name) else None)
     in
     let map_name = name ^ ".wasm.map" in
-    Wa_source_map.write (Filename.concat dir map_name) sm;
+    Source_map.to_file sm (Filename.concat dir map_name);
     Wasm_binary.append_source_map_section
       ~file:(Filename.concat dir (name ^ ".wasm"))
       ~url:map_name)
@@ -860,7 +860,7 @@ let rec get_source_map_files files src_index =
   if Zip.has_entry z ~name:"source_map.map"
   then
     let data = Zip.read_entry z ~name:"source_map.map" in
-    let sm = Wa_source_map.parse data in
+    let sm = Source_map.of_string data in
     if not (Wa_source_map.is_empty sm)
     then (
       let l = ref [] in
@@ -879,7 +879,7 @@ let add_source_map files z opt_source_map_file =
   Option.iter
     ~f:(fun file ->
       Zip.add_file z ~name:"source_map.map" ~file;
-      let sm = Wa_source_map.load file in
+      let sm = Source_map.of_file file in
       let files = Array.of_list files in
       let src_index = ref 0 in
       let st = ref None in
diff --git a/compiler/lib/wasm/wa_source_map.ml b/compiler/lib/wasm/wa_source_map.ml
index 5cbb51f748..06f9b6cad8 100644
--- a/compiler/lib/wasm/wa_source_map.ml
+++ b/compiler/lib/wasm/wa_source_map.ml
@@ -8,84 +8,35 @@ type resize_data =
 
 type t = Yojson.Raw.t
 
-type u =
-  { mappings : string
+type input = Vlq64.input =
+  { string : string
   ; mutable pos : int
+  ; len : int
   }
 
-module Vlq = struct
-  let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
-
-  let code_rev =
-    let a = Array.make 255 (-1) in
-    for i = 0 to String.length code - 1 do
-      a.(Char.code code.[i]) <- i
-    done;
-    a
-
-  let vlq_base_shift = 5
-
-  let vlq_base = 1 lsl vlq_base_shift
-
-  let vlq_base_mask = vlq_base - 1
-
-  let vlq_continuation_bit = vlq_base
-
-  let rec decode' src s pos offset i =
-    let digit = Array.unsafe_get code_rev (Char.code s.[pos]) in
-    if digit = -1 then invalid_arg "Vql64.decode'";
-    let i = i + ((digit land vlq_base_mask) lsl offset) in
-    if digit >= vlq_continuation_bit
-    then decode' src s (pos + 1) (offset + vlq_base_shift) i
-    else (
-      src.pos <- pos + 1;
-      i)
-
-  let fromVLQSigned v =
-    let is_neg = v land 1 = 1 in
-    let shift = v lsr 1 in
-    if is_neg then -shift else shift
-
-  let toVLQSigned v = if v < 0 then (-v lsl 1) + 1 else v lsl 1
-
-  let decode src = fromVLQSigned (decode' src src.mappings src.pos 0 0)
-
-  let rec encode' buf i =
-    let digit = i land vlq_base_mask in
-    let i = i lsr vlq_base_shift in
-    if i = 0
-    then Buffer.add_char buf (String.unsafe_get code digit)
-    else (
-      Buffer.add_char buf (String.unsafe_get code (digit lor vlq_continuation_bit));
-      encode' buf i)
-
-  let encode buf i = encode' buf (toVLQSigned i)
-end
-
 let rec next' src mappings pos =
+  pos < src.len
+  &&
   match mappings.[pos] with
-  | '"' ->
-      src.pos <- pos + 1;
-      false
   | ',' ->
       src.pos <- pos + 1;
       true
   | _ -> next' src mappings (pos + 1)
 
-let next src = next' src src.mappings src.pos
+let next src = next' src src.string src.pos
 
 let flush buf src start pos =
-  if start < pos then Buffer.add_substring buf src.mappings start (pos - start)
+  if start < pos then Buffer.add_substring buf src.string start (pos - start)
 
 let rec resize_rec buf start src resize_data i col0 delta0 col =
   let pos = src.pos in
-  let delta = Vlq.decode src in
+  let delta = Vlq64.decode src in
   let col = col + delta in
   if col < col0
   then
     if next src
     then resize_rec buf start src resize_data i col0 delta0 col
-    else flush buf src start (String.length src.mappings)
+    else flush buf src start (String.length src.string)
   else
     let delta = delta + delta0 in
     adjust buf start src resize_data i col delta pos
@@ -99,157 +50,125 @@ and adjust buf start src (resize_data : resize_data) i col delta pos =
     if col < col0
     then (
       flush buf src start pos;
-      Vlq.encode buf delta;
+      Vlq64.encode buf delta;
       let start = src.pos in
       if next src
       then resize_rec buf start src resize_data (i + 1) col0 delta0 col
-      else flush buf src start (String.length src.mappings))
+      else flush buf src start (String.length src.string))
     else
       let delta = delta + delta0 in
       adjust buf start src resize_data (i + 1) col delta pos
   else (
     flush buf src start pos;
-    Vlq.encode buf delta;
+    Vlq64.encode buf delta;
     let start = src.pos in
-    flush buf src start (String.length src.mappings))
+    flush buf src start (String.length src.string))
 
 let resize_mappings (resize_data : resize_data) mappings =
-  if String.equal mappings "\"\"" || resize_data.i = 0
+  if String.equal mappings "" || resize_data.i = 0
   then mappings
   else
     let col0 = resize_data.pos.(0) in
     let delta0 = resize_data.delta.(0) in
     let buf = Buffer.create (String.length mappings) in
-    resize_rec buf 0 { mappings; pos = 1 } resize_data 1 col0 delta0 0;
+    resize_rec
+      buf
+      0
+      { Vlq64.string = mappings; pos = 0; len = String.length mappings }
+      resize_data
+      1
+      col0
+      delta0
+      0;
     Buffer.contents buf
 
-let to_raw_string v =
-  match v with
-  | `Stringlit s -> s
-  | _ -> assert false
-
-let replace_member assoc m v =
-  `Assoc ((m, v) :: List.remove_assoc m (Yojson.Raw.Util.to_assoc assoc))
-
 let resize resize_data sm =
-  let open Yojson.Raw.Util in
-  let mappings = to_raw_string (member "mappings" sm) in
-  let mappings = resize_mappings resize_data mappings in
-  replace_member sm "mappings" (`Stringlit mappings)
+  match sm with
+  | Source_map.Index _ -> assert false
+  | Standard sm ->
+      let mappings = Source_map.Mappings.to_string sm.mappings in
+      let mappings = resize_mappings resize_data mappings in
+      Source_map.Standard
+        { sm with mappings = Source_map.Mappings.of_string_unsafe mappings }
 
 let is_empty sm =
-  let open Yojson.Raw.Util in
-  match member "mappings" sm with
-  | `Stringlit "\"\"" -> true
-  | _ -> false
+  match sm with
+  | Source_map.Standard { mappings; _ } -> Source_map.Mappings.is_empty mappings
+  | _ -> assert false
 
 let concatenate l =
-  `Assoc
-    [ "version", `Intlit "3"
-    ; ( "sections"
-      , `List
-          (List.map
-             ~f:(fun (ofs, sm) ->
-               `Assoc
-                 [ ( "offset"
-                   , `Assoc [ "line", `Intlit "0"; "column", `Intlit (string_of_int ofs) ]
-                   )
-                 ; "map", sm
-                 ])
-             l) )
-    ]
-
-let parse ?tmp_buf s = Yojson.Raw.from_string ?buf:tmp_buf s
-
-let load ?tmp_buf name = parse ?tmp_buf (Fs.read_file name)
-
-let write name sm = Yojson.Raw.to_file name sm
-
-let string_from_raw_string s = Yojson.Basic.Util.to_string (Yojson.Basic.from_string s)
-
-let raw_string_from_string s = Yojson.Basic.to_string (`String s)
-
-let iter_sources' sm i f =
-  let open Yojson.Raw.Util in
-  let l = sm |> member "sources" |> to_option to_list |> Option.value ~default:[] in
+  Source_map.Index
+    { version = 3
+    ; file = None
+    ; sections =
+        List.map
+          ~f:(fun (ofs, sm) ->
+            match sm with
+            | Source_map.Index _ -> assert false
+            | Standard map ->
+                { Source_map.Index.offset = { gen_line = 0; gen_column = ofs }; map })
+          l
+    }
+
+let iter_sources' (sm : Source_map.Standard.t) i f =
+  let l = sm.sources in
   let single = List.length l = 1 in
-  List.iteri
-    ~f:(fun j nm ->
-      f i (if single then None else Some j) (string_from_raw_string (to_raw_string nm)))
-    l
+  List.iteri ~f:(fun j nm -> f i (if single then None else Some j) nm) l
 
 let iter_sources sm f =
-  let open Yojson.Raw.Util in
-  match to_option to_list (member "sections" sm) with
-  | None -> iter_sources' sm None f
-  | Some l ->
-      let single_map = List.length l = 1 in
+  match sm with
+  | Source_map.Standard sm -> iter_sources' sm None f
+  | Index { sections; _ } ->
+      let single_map = List.length sections = 1 in
       List.iteri
         ~f:(fun i entry ->
-          iter_sources' (member "map" entry) (if single_map then None else Some i) f)
-        l
+          iter_sources' entry.Source_map.Index.map (if single_map then None else Some i) f)
+        sections
 
 let blackbox_filename = "/builtin/blackbox.ml"
 
 let blackbox_contents = "(* generated code *)"
 
-let insert_source_contents' ~rewrite_path sm i f =
-  let rewrite_path path =
-    raw_string_from_string (rewrite_path (string_from_raw_string path))
-  in
-  let open Yojson.Raw.Util in
-  let l = sm |> member "sources" |> to_option to_list |> Option.value ~default:[] in
+let insert_source_contents' ~rewrite_path (sm : Source_map.Standard.t) i f =
+  let l = sm.sources in
   let single = List.length l = 1 in
-  let ignored = ref (-1) in
   let contents =
     List.mapi
       ~f:(fun j name ->
-        let name = string_from_raw_string (to_raw_string name) in
         if String.equal name blackbox_filename
-        then (
-          ignored := j;
-          `Stringlit (raw_string_from_string blackbox_contents))
+        then Some (Source_map.Source_content.create blackbox_contents)
         else
           match f i (if single then None else Some j) name with
-          | Some c -> `Stringlit c
-          | None -> `Null)
+          | Some c -> Some (Source_map.Source_content.of_stringlit (`Stringlit c))
+          | None -> None)
       l
   in
-  let sm = replace_member sm "sourcesContent" (`List contents) in
+  let sm = { sm with sources_content = Some contents } in
   let sm =
-    if !ignored >= 0
-    then replace_member sm "ignoreList" (`List [ `Intlit (string_of_int !ignored) ])
+    if List.mem blackbox_filename ~set:sm.sources
+    then { sm with ignore_list = [ blackbox_filename ] }
     else sm
   in
-  let sm =
-    replace_member
-      sm
-      "sources"
-      (match member "sources" sm with
-      | `Null -> `Null
-      | `List l ->
-          `List (List.map ~f:(fun s -> `Stringlit (rewrite_path (to_raw_string s))) l)
-      | _ -> assert false)
-  in
+  let sm = { sm with sources = List.map ~f:rewrite_path sm.sources } in
   sm
 
 let insert_source_contents ~rewrite_path sm f =
-  let open Yojson.Raw.Util in
-  match to_option to_list (member "sections" sm) with
-  | None -> insert_source_contents' ~rewrite_path sm None f
-  | Some l ->
-      let single_map = List.length l = 1 in
+  match sm with
+  | Source_map.Standard sm ->
+      Source_map.Standard (insert_source_contents' ~rewrite_path sm None f)
+  | Index ({ sections; _ } as sm) ->
+      let single_map = List.length sections = 1 in
       let sections =
         List.mapi
           ~f:(fun i entry ->
-            replace_member
-              entry
-              "map"
-              (insert_source_contents'
-                 ~rewrite_path
-                 (member "map" entry)
-                 (if single_map then None else Some i)
-                 f))
-          l
+            { entry with
+              Source_map.Index.map =
+                insert_source_contents'
+                  ~rewrite_path
+                  entry.Source_map.Index.map
+                  (if single_map then None else Some i)
+                  f
+            })
+          sections
       in
-      replace_member sm "sections" (`List sections)
+      Index { sm with sections }
diff --git a/compiler/lib/wasm/wa_source_map.mli b/compiler/lib/wasm/wa_source_map.mli
index 6845260ed7..65ab1f97ff 100644
--- a/compiler/lib/wasm/wa_source_map.mli
+++ b/compiler/lib/wasm/wa_source_map.mli
@@ -1,12 +1,6 @@
 type t
 
-val load : ?tmp_buf:Buffer.t -> string -> t
-
-val parse : ?tmp_buf:Buffer.t -> string -> t
-
-val write : string -> t -> unit
-
-val is_empty : t -> bool
+val is_empty : Source_map.t -> bool
 
 type resize_data =
   { mutable i : int
@@ -14,17 +8,17 @@ type resize_data =
   ; mutable delta : int array
   }
 
-val resize : resize_data -> t -> t
+val resize : resize_data -> Source_map.t -> Source_map.t
 
-val concatenate : (int * t) list -> t
+val concatenate : (int * Source_map.t) list -> Source_map.t
 
-val iter_sources : t -> (int option -> int option -> string -> unit) -> unit
+val iter_sources : Source_map.t -> (int option -> int option -> string -> unit) -> unit
 
 val insert_source_contents :
      rewrite_path:(string -> string)
-  -> t
+  -> Source_map.t
   -> (int option -> int option -> string -> string option)
-  -> t
+  -> Source_map.t
 
 val blackbox_filename : string
 
diff --git a/compiler/lib/wasm/wa_wasm_link.ml b/compiler/lib/wasm/wa_wasm_link.ml
index 8b4c2005c6..ac11566f58 100644
--- a/compiler/lib/wasm/wa_wasm_link.ml
+++ b/compiler/lib/wasm/wa_wasm_link.ml
@@ -1497,7 +1497,7 @@ type t =
   { module_name : string
   ; file : string
   ; contents : Read.t
-  ; source_map_contents : Wa_source_map.t option
+  ; source_map_contents : Source_map.t option
   }
 
 type import_status =
@@ -1877,8 +1877,8 @@ let f files ~output_file ~opt_output_sourcemap_file =
             Option.map
               ~f:(fun src ->
                 match src with
-                | `File file -> Wa_source_map.load ~tmp_buf file
-                | `Data data -> Wa_source_map.parse ~tmp_buf data)
+                | `File file -> Source_map.of_file ~tmp_buf file
+                | `Data data -> Source_map.of_string ~tmp_buf data)
               opt_source_map
         })
       (Array.of_list files)
@@ -2275,12 +2275,12 @@ let f files ~output_file ~opt_output_sourcemap_file =
   add_section out_ch ~id:10 code_pieces;
   Option.iter
     ~f:(fun file ->
-      Wa_source_map.write
-        file
+      Source_map.to_file
         (Wa_source_map.concatenate
            (List.map
               ~f:(fun (pos, sm) -> pos + code_section_offset, sm)
-              (List.rev !source_maps))))
+              (List.rev !source_maps)))
+        file)
     opt_output_sourcemap_file;
 
   (* 11: data *)

From 1d6036f33ad189e5eaee9b85d8d1586fe12d2cc3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Nov 2024 18:25:23 +0100
Subject: [PATCH 425/481] Move compiler/lib/wasm to compiler/lib-wasm

---
 compiler/{lib/wasm => lib-wasm}/dune                      | 0
 compiler/{lib/wasm => lib-wasm}/sexp.ml                   | 0
 compiler/{lib/wasm => lib-wasm}/sexp.mli                  | 0
 compiler/{lib/wasm => lib-wasm}/wa_ast.ml                 | 0
 compiler/{lib/wasm => lib-wasm}/wa_binaryen.ml            | 0
 compiler/{lib/wasm => lib-wasm}/wa_binaryen.mli           | 0
 compiler/{lib/wasm => lib-wasm}/wa_closure_conversion.ml  | 0
 compiler/{lib/wasm => lib-wasm}/wa_closure_conversion.mli | 0
 compiler/{lib/wasm => lib-wasm}/wa_code_generation.ml     | 0
 compiler/{lib/wasm => lib-wasm}/wa_code_generation.mli    | 0
 compiler/{lib/wasm => lib-wasm}/wa_curry.ml               | 0
 compiler/{lib/wasm => lib-wasm}/wa_curry.mli              | 0
 compiler/{lib/wasm => lib-wasm}/wa_gc_target.ml           | 0
 compiler/{lib/wasm => lib-wasm}/wa_gc_target.mli          | 0
 compiler/{lib/wasm => lib-wasm}/wa_generate.ml            | 0
 compiler/{lib/wasm => lib-wasm}/wa_generate.mli           | 0
 compiler/{lib/wasm => lib-wasm}/wa_globalize.ml           | 0
 compiler/{lib/wasm => lib-wasm}/wa_globalize.mli          | 0
 compiler/{lib/wasm => lib-wasm}/wa_initialize_locals.ml   | 0
 compiler/{lib/wasm => lib-wasm}/wa_initialize_locals.mli  | 0
 compiler/{lib/wasm => lib-wasm}/wa_link.ml                | 0
 compiler/{lib/wasm => lib-wasm}/wa_link.mli               | 0
 compiler/{lib/wasm => lib-wasm}/wa_source_map.ml          | 0
 compiler/{lib/wasm => lib-wasm}/wa_source_map.mli         | 0
 compiler/{lib/wasm => lib-wasm}/wa_tail_call.ml           | 0
 compiler/{lib/wasm => lib-wasm}/wa_tail_call.mli          | 0
 compiler/{lib/wasm => lib-wasm}/wa_target_sig.ml          | 0
 compiler/{lib/wasm => lib-wasm}/wa_wasm_link.ml           | 0
 compiler/{lib/wasm => lib-wasm}/wa_wasm_link.mli          | 0
 compiler/{lib/wasm => lib-wasm}/wa_wasm_output.ml         | 0
 compiler/{lib/wasm => lib-wasm}/wa_wasm_output.mli        | 0
 compiler/{lib/wasm => lib-wasm}/wa_wat_output.ml          | 0
 compiler/{lib/wasm => lib-wasm}/wa_wat_output.mli         | 0
 compiler/{lib/wasm => lib-wasm}/zip.ml                    | 0
 compiler/{lib/wasm => lib-wasm}/zip.mli                   | 0
 35 files changed, 0 insertions(+), 0 deletions(-)
 rename compiler/{lib/wasm => lib-wasm}/dune (100%)
 rename compiler/{lib/wasm => lib-wasm}/sexp.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/sexp.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_ast.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_binaryen.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_binaryen.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_closure_conversion.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_closure_conversion.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_code_generation.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_code_generation.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_curry.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_curry.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_gc_target.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_gc_target.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_generate.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_generate.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_globalize.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_globalize.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_initialize_locals.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_initialize_locals.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_link.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_link.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_source_map.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_source_map.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_tail_call.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_tail_call.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_target_sig.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_wasm_link.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_wasm_link.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_wasm_output.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_wasm_output.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_wat_output.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/wa_wat_output.mli (100%)
 rename compiler/{lib/wasm => lib-wasm}/zip.ml (100%)
 rename compiler/{lib/wasm => lib-wasm}/zip.mli (100%)

diff --git a/compiler/lib/wasm/dune b/compiler/lib-wasm/dune
similarity index 100%
rename from compiler/lib/wasm/dune
rename to compiler/lib-wasm/dune
diff --git a/compiler/lib/wasm/sexp.ml b/compiler/lib-wasm/sexp.ml
similarity index 100%
rename from compiler/lib/wasm/sexp.ml
rename to compiler/lib-wasm/sexp.ml
diff --git a/compiler/lib/wasm/sexp.mli b/compiler/lib-wasm/sexp.mli
similarity index 100%
rename from compiler/lib/wasm/sexp.mli
rename to compiler/lib-wasm/sexp.mli
diff --git a/compiler/lib/wasm/wa_ast.ml b/compiler/lib-wasm/wa_ast.ml
similarity index 100%
rename from compiler/lib/wasm/wa_ast.ml
rename to compiler/lib-wasm/wa_ast.ml
diff --git a/compiler/lib/wasm/wa_binaryen.ml b/compiler/lib-wasm/wa_binaryen.ml
similarity index 100%
rename from compiler/lib/wasm/wa_binaryen.ml
rename to compiler/lib-wasm/wa_binaryen.ml
diff --git a/compiler/lib/wasm/wa_binaryen.mli b/compiler/lib-wasm/wa_binaryen.mli
similarity index 100%
rename from compiler/lib/wasm/wa_binaryen.mli
rename to compiler/lib-wasm/wa_binaryen.mli
diff --git a/compiler/lib/wasm/wa_closure_conversion.ml b/compiler/lib-wasm/wa_closure_conversion.ml
similarity index 100%
rename from compiler/lib/wasm/wa_closure_conversion.ml
rename to compiler/lib-wasm/wa_closure_conversion.ml
diff --git a/compiler/lib/wasm/wa_closure_conversion.mli b/compiler/lib-wasm/wa_closure_conversion.mli
similarity index 100%
rename from compiler/lib/wasm/wa_closure_conversion.mli
rename to compiler/lib-wasm/wa_closure_conversion.mli
diff --git a/compiler/lib/wasm/wa_code_generation.ml b/compiler/lib-wasm/wa_code_generation.ml
similarity index 100%
rename from compiler/lib/wasm/wa_code_generation.ml
rename to compiler/lib-wasm/wa_code_generation.ml
diff --git a/compiler/lib/wasm/wa_code_generation.mli b/compiler/lib-wasm/wa_code_generation.mli
similarity index 100%
rename from compiler/lib/wasm/wa_code_generation.mli
rename to compiler/lib-wasm/wa_code_generation.mli
diff --git a/compiler/lib/wasm/wa_curry.ml b/compiler/lib-wasm/wa_curry.ml
similarity index 100%
rename from compiler/lib/wasm/wa_curry.ml
rename to compiler/lib-wasm/wa_curry.ml
diff --git a/compiler/lib/wasm/wa_curry.mli b/compiler/lib-wasm/wa_curry.mli
similarity index 100%
rename from compiler/lib/wasm/wa_curry.mli
rename to compiler/lib-wasm/wa_curry.mli
diff --git a/compiler/lib/wasm/wa_gc_target.ml b/compiler/lib-wasm/wa_gc_target.ml
similarity index 100%
rename from compiler/lib/wasm/wa_gc_target.ml
rename to compiler/lib-wasm/wa_gc_target.ml
diff --git a/compiler/lib/wasm/wa_gc_target.mli b/compiler/lib-wasm/wa_gc_target.mli
similarity index 100%
rename from compiler/lib/wasm/wa_gc_target.mli
rename to compiler/lib-wasm/wa_gc_target.mli
diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib-wasm/wa_generate.ml
similarity index 100%
rename from compiler/lib/wasm/wa_generate.ml
rename to compiler/lib-wasm/wa_generate.ml
diff --git a/compiler/lib/wasm/wa_generate.mli b/compiler/lib-wasm/wa_generate.mli
similarity index 100%
rename from compiler/lib/wasm/wa_generate.mli
rename to compiler/lib-wasm/wa_generate.mli
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib-wasm/wa_globalize.ml
similarity index 100%
rename from compiler/lib/wasm/wa_globalize.ml
rename to compiler/lib-wasm/wa_globalize.ml
diff --git a/compiler/lib/wasm/wa_globalize.mli b/compiler/lib-wasm/wa_globalize.mli
similarity index 100%
rename from compiler/lib/wasm/wa_globalize.mli
rename to compiler/lib-wasm/wa_globalize.mli
diff --git a/compiler/lib/wasm/wa_initialize_locals.ml b/compiler/lib-wasm/wa_initialize_locals.ml
similarity index 100%
rename from compiler/lib/wasm/wa_initialize_locals.ml
rename to compiler/lib-wasm/wa_initialize_locals.ml
diff --git a/compiler/lib/wasm/wa_initialize_locals.mli b/compiler/lib-wasm/wa_initialize_locals.mli
similarity index 100%
rename from compiler/lib/wasm/wa_initialize_locals.mli
rename to compiler/lib-wasm/wa_initialize_locals.mli
diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib-wasm/wa_link.ml
similarity index 100%
rename from compiler/lib/wasm/wa_link.ml
rename to compiler/lib-wasm/wa_link.ml
diff --git a/compiler/lib/wasm/wa_link.mli b/compiler/lib-wasm/wa_link.mli
similarity index 100%
rename from compiler/lib/wasm/wa_link.mli
rename to compiler/lib-wasm/wa_link.mli
diff --git a/compiler/lib/wasm/wa_source_map.ml b/compiler/lib-wasm/wa_source_map.ml
similarity index 100%
rename from compiler/lib/wasm/wa_source_map.ml
rename to compiler/lib-wasm/wa_source_map.ml
diff --git a/compiler/lib/wasm/wa_source_map.mli b/compiler/lib-wasm/wa_source_map.mli
similarity index 100%
rename from compiler/lib/wasm/wa_source_map.mli
rename to compiler/lib-wasm/wa_source_map.mli
diff --git a/compiler/lib/wasm/wa_tail_call.ml b/compiler/lib-wasm/wa_tail_call.ml
similarity index 100%
rename from compiler/lib/wasm/wa_tail_call.ml
rename to compiler/lib-wasm/wa_tail_call.ml
diff --git a/compiler/lib/wasm/wa_tail_call.mli b/compiler/lib-wasm/wa_tail_call.mli
similarity index 100%
rename from compiler/lib/wasm/wa_tail_call.mli
rename to compiler/lib-wasm/wa_tail_call.mli
diff --git a/compiler/lib/wasm/wa_target_sig.ml b/compiler/lib-wasm/wa_target_sig.ml
similarity index 100%
rename from compiler/lib/wasm/wa_target_sig.ml
rename to compiler/lib-wasm/wa_target_sig.ml
diff --git a/compiler/lib/wasm/wa_wasm_link.ml b/compiler/lib-wasm/wa_wasm_link.ml
similarity index 100%
rename from compiler/lib/wasm/wa_wasm_link.ml
rename to compiler/lib-wasm/wa_wasm_link.ml
diff --git a/compiler/lib/wasm/wa_wasm_link.mli b/compiler/lib-wasm/wa_wasm_link.mli
similarity index 100%
rename from compiler/lib/wasm/wa_wasm_link.mli
rename to compiler/lib-wasm/wa_wasm_link.mli
diff --git a/compiler/lib/wasm/wa_wasm_output.ml b/compiler/lib-wasm/wa_wasm_output.ml
similarity index 100%
rename from compiler/lib/wasm/wa_wasm_output.ml
rename to compiler/lib-wasm/wa_wasm_output.ml
diff --git a/compiler/lib/wasm/wa_wasm_output.mli b/compiler/lib-wasm/wa_wasm_output.mli
similarity index 100%
rename from compiler/lib/wasm/wa_wasm_output.mli
rename to compiler/lib-wasm/wa_wasm_output.mli
diff --git a/compiler/lib/wasm/wa_wat_output.ml b/compiler/lib-wasm/wa_wat_output.ml
similarity index 100%
rename from compiler/lib/wasm/wa_wat_output.ml
rename to compiler/lib-wasm/wa_wat_output.ml
diff --git a/compiler/lib/wasm/wa_wat_output.mli b/compiler/lib-wasm/wa_wat_output.mli
similarity index 100%
rename from compiler/lib/wasm/wa_wat_output.mli
rename to compiler/lib-wasm/wa_wat_output.mli
diff --git a/compiler/lib/wasm/zip.ml b/compiler/lib-wasm/zip.ml
similarity index 100%
rename from compiler/lib/wasm/zip.ml
rename to compiler/lib-wasm/zip.ml
diff --git a/compiler/lib/wasm/zip.mli b/compiler/lib-wasm/zip.mli
similarity index 100%
rename from compiler/lib/wasm/zip.mli
rename to compiler/lib-wasm/zip.mli

From d323e666455e1643a4bd6b29c1089f06a13c365b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Nov 2024 23:12:36 +0100
Subject: [PATCH 426/481] Dune file formatting changes

---
 benchmarks/sources/ml/dune            | 49 +++-------------
 compiler/bin-js_of_ocaml/dune         |  5 +-
 compiler/bin-wasm_of_ocaml/dune       |  7 +--
 compiler/lib-dynlink/dune             |  4 +-
 compiler/lib/dune                     | 24 ++------
 compiler/tests-dynlink-js/dune        | 24 ++------
 compiler/tests-dynlink/dune           |  9 +--
 compiler/tests-full/dune              | 14 +----
 compiler/tests-jsoo/dune              | 10 +---
 compiler/tests-ocaml/lib-effects/dune | 25 +-------
 dune                                  |  4 +-
 examples/boulderdash/dune             | 13 +----
 examples/cubes/dune                   |  7 +--
 examples/graph_viewer/dune            | 21 +------
 examples/hyperbolic/dune              | 14 +----
 examples/namespace/dune               | 34 ++---------
 examples/planet/dune                  |  7 +--
 examples/separate_compilation/dune    | 58 +++----------------
 examples/webgl/dune                   | 11 +---
 ppx/ppx_deriving_json/tests/dune      |  5 +-
 runtime/dune                          | 32 ++---------
 runtime/wasm/dune                     | 33 ++---------
 tools/sourcemap/dune                  |  4 +-
 toplevel/bin/dune                     |  4 +-
 toplevel/examples/eval/dune           | 11 +---
 toplevel/examples/lwt_toplevel/dune   | 82 ++++++---------------------
 toplevel/lib/dune                     |  7 +--
 toplevel/test/dune                    | 12 +---
 28 files changed, 89 insertions(+), 441 deletions(-)

diff --git a/benchmarks/sources/ml/dune b/benchmarks/sources/ml/dune
index 31b138c56f..86d08b50ce 100644
--- a/benchmarks/sources/ml/dune
+++ b/benchmarks/sources/ml/dune
@@ -1,49 +1,14 @@
 (executables
- (names
-  almabench
-  bdd
-  binary_trees
-  boyer
-  boyer_no_exc
-  fannkuch_redux_2
-  fannkuch_redux
-  fft
-  fib
-  hamming
-  kb
-  kb_no_exc
-  loop
-  nucleic
-  quicksort
-  raytrace
-  soli
-  splay
-  takc
-  taku))
+ (names almabench bdd binary_trees boyer boyer_no_exc fannkuch_redux_2
+  fannkuch_redux fft fib hamming kb kb_no_exc loop nucleic quicksort raytrace
+  soli splay takc taku))
 
 (alias
  (name benchmark)
- (deps
-  almabench.exe
-  bdd.exe
-  binary_trees.exe
-  boyer.exe
-  boyer_no_exc.exe
-  fannkuch_redux_2.exe
-  fannkuch_redux.exe
-  fft.exe
-  fib.exe
-  hamming.exe
-  kb.exe
-  kb_no_exc.exe
-  loop.exe
-  nucleic.exe
-  quicksort.exe
-  raytrace.exe
-  soli.exe
-  splay.exe
-  takc.exe
-  taku.exe))
+ (deps almabench.exe bdd.exe binary_trees.exe boyer.exe boyer_no_exc.exe
+  fannkuch_redux_2.exe fannkuch_redux.exe fft.exe fib.exe hamming.exe kb.exe
+  kb_no_exc.exe loop.exe nucleic.exe quicksort.exe raytrace.exe soli.exe
+  splay.exe takc.exe taku.exe))
 
 (env
  (_
diff --git a/compiler/bin-js_of_ocaml/dune b/compiler/bin-js_of_ocaml/dune
index f246e9d57d..772ff23d72 100644
--- a/compiler/bin-js_of_ocaml/dune
+++ b/compiler/bin-js_of_ocaml/dune
@@ -51,10 +51,7 @@
 (install
  (section man)
  (package js_of_ocaml-compiler)
- (files
-  js_of_ocaml.1
-  js_of_ocaml-link.1
-  js_of_ocaml-build-fs.1
+ (files js_of_ocaml.1 js_of_ocaml-link.1 js_of_ocaml-build-fs.1
   js_of_ocaml-build-runtime.1))
 
 ;; Generate and install runtime.js for compatibility reasons
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index cd5f1a468a..ea5833d695 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -23,11 +23,8 @@
 
 (rule
  (target wa_runtime.ml)
- (deps
-  gen/gen.exe
-  ../../runtime/wasm/runtime.wasm
-  ../../runtime/wasm/runtime.js
-  ../../runtime/wasm/deps.json)
+ (deps gen/gen.exe ../../runtime/wasm/runtime.wasm
+  ../../runtime/wasm/runtime.js ../../runtime/wasm/deps.json)
  (action
   (with-stdout-to
    %{target}
diff --git a/compiler/lib-dynlink/dune b/compiler/lib-dynlink/dune
index 84788e7681..0f96313efb 100644
--- a/compiler/lib-dynlink/dune
+++ b/compiler/lib-dynlink/dune
@@ -6,7 +6,5 @@
  (foreign_stubs
   (language c)
   (names stubs))
- (libraries
-  js_of_ocaml-compiler
-  js_of_ocaml-compiler.runtime
+ (libraries js_of_ocaml-compiler js_of_ocaml-compiler.runtime
   compiler-libs.bytecomp))
diff --git a/compiler/lib/dune b/compiler/lib/dune
index 075e086433..29c37de04a 100644
--- a/compiler/lib/dune
+++ b/compiler/lib/dune
@@ -2,11 +2,7 @@
  (name js_of_ocaml_compiler)
  (public_name js_of_ocaml-compiler)
  (synopsis "Js_of_ocaml compiler library")
- (libraries
-  compiler-libs.common
-  compiler-libs.bytecomp
-  menhirLib
-  sedlex
+ (libraries compiler-libs.common compiler-libs.bytecomp menhirLib sedlex
   yojson)
  (flags
   (:standard -w -7-37 -safe-string))
@@ -17,21 +13,9 @@
 
 (menhir
  (modules js_parser)
- (flags
-  --table
-  --external-tokens
-  Js_token
-  --explain
-  --unused-token
-  TAnnot
-  --unused-token
-  TComment
-  --unused-token
-  TCommentLineDirective
-  --unused-token
-  T_ERROR
-  --unused-token
-  T_AT))
+ (flags --table --external-tokens Js_token --explain --unused-token TAnnot
+  --unused-token TComment --unused-token TCommentLineDirective --unused-token
+  T_ERROR --unused-token T_AT))
 
 (menhir
  (modules annot_parser)
diff --git a/compiler/tests-dynlink-js/dune b/compiler/tests-dynlink-js/dune
index 016c2a2f53..c9d5ca8862 100644
--- a/compiler/tests-dynlink-js/dune
+++ b/compiler/tests-dynlink-js/dune
@@ -45,13 +45,8 @@
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --linkall
-   %{read-strings:effects_flags.txt}
-   -o
-   %{target}
-   %{dep:main.bc})))
+  (run %{bin:js_of_ocaml} --linkall %{read-strings:effects_flags.txt} -o
+   %{target} %{dep:main.bc})))
 
 (rule
  (target plugin.cmo)
@@ -61,28 +56,19 @@
 (rule
  (target plugin.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   %{read-strings:effects_flags.txt}
+  (run %{bin:js_of_ocaml} %{read-strings:effects_flags.txt}
    %{dep:./plugin.cmo})))
 
 (rule
  (target plugin2.cma)
  (action
-  (run
-   %{bin:ocamlc}
-   -a
-   %{dep:./plugin2a.ml}
-   %{dep:./plugin2b.ml}
-   -o
+  (run %{bin:ocamlc} -a %{dep:./plugin2a.ml} %{dep:./plugin2b.ml} -o
    plugin2.cma)))
 
 (rule
  (target plugin2.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   %{read-strings:effects_flags.txt}
+  (run %{bin:js_of_ocaml} %{read-strings:effects_flags.txt}
    %{dep:./plugin2.cma})))
 
 (rule
diff --git a/compiler/tests-dynlink/dune b/compiler/tests-dynlink/dune
index 6722682903..15b17c2d2e 100644
--- a/compiler/tests-dynlink/dune
+++ b/compiler/tests-dynlink/dune
@@ -16,14 +16,7 @@
    (<> %{profile} wasm-effects)))
  (deps plugin.cmo export)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --dynlink
-   --export
-   export
-   --pretty
-   -o
-   %{target}
+  (run %{bin:js_of_ocaml} --dynlink --export export --pretty -o %{target}
    %{dep:main.bc})))
 
 (rule
diff --git a/compiler/tests-full/dune b/compiler/tests-full/dune
index 5effacad3b..17668b782d 100644
--- a/compiler/tests-full/dune
+++ b/compiler/tests-full/dune
@@ -3,12 +3,7 @@
  (enabled_if
   (= %{ocaml_version} "5.2.0"))
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --debuginfo
-   %{lib:stdlib:stdlib.cma}
-   -o
+  (run %{bin:js_of_ocaml} --pretty --debuginfo %{lib:stdlib:stdlib.cma} -o
    %{targets})))
 
 (rule
@@ -31,12 +26,7 @@
  (targets fs.output.js)
  (deps file1 file2)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   build-fs
-   -o
-   %{targets}
-   file1:/static/file1
+  (run %{bin:js_of_ocaml} build-fs -o %{targets} file1:/static/file1
    file2:/static/dir/file2)))
 
 (rule
diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune
index ca6f45862f..38594fa368 100644
--- a/compiler/tests-jsoo/dune
+++ b/compiler/tests-jsoo/dune
@@ -34,14 +34,8 @@
 (library
  (name jsoo_testsuite)
  (modules
-  (:standard
-   \
-   test_io
-   test_floats
-   test_marshal_compressed
-   test_parsing
-   calc_parser
-   calc_lexer))
+  (:standard \ test_io test_floats test_marshal_compressed test_parsing
+   calc_parser calc_lexer))
  (libraries unix compiler-libs.common js_of_ocaml-compiler)
  (foreign_stubs
   (language c)
diff --git a/compiler/tests-ocaml/lib-effects/dune b/compiler/tests-ocaml/lib-effects/dune
index 48f8e239ed..95fe01b0ae 100644
--- a/compiler/tests-ocaml/lib-effects/dune
+++ b/compiler/tests-ocaml/lib-effects/dune
@@ -23,28 +23,9 @@
 (tests
  (build_if
   (>= %{ocaml_version} 5))
- (names
-  cmphash
-  marshal
-  effects
-  evenodd
-  manylive
-  overflow
-  partial
-  reperform
-  sched
-  shallow_state_io
-  shallow_state
-  test10
-  test11
-  test1
-  test2
-  test3
-  test4
-  test5
-  test6
-  test_lazy
-  used_cont)
+ (names cmphash marshal effects evenodd manylive overflow partial reperform
+  sched shallow_state_io shallow_state test10 test11 test1 test2 test3 test4
+  test5 test6 test_lazy used_cont)
  (modules
   (:standard \ unhandled_unlinked))
  (modes js))
diff --git a/dune b/dune
index cb16ed5816..85596593f4 100644
--- a/dune
+++ b/dune
@@ -36,9 +36,7 @@
  (action
   (with-stdout-to
    %{targets}
-   (run
-    %{dep:tools/version/gen/gen.exe}
-    %{dep:VERSION}
+   (run %{dep:tools/version/gen/gen.exe} %{dep:VERSION}
     %{dep:tools/version/GIT-VERSION}))))
 
 (data_only_dirs _wikidoc doc-dev)
diff --git a/examples/boulderdash/dune b/examples/boulderdash/dune
index 952ee49396..64ff9f3c76 100644
--- a/examples/boulderdash/dune
+++ b/examples/boulderdash/dune
@@ -10,17 +10,8 @@
  (deps
   (glob_files maps/*.map))
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:boulderdash.bc}
-   -o
-   %{targets}
-   --pretty
-   --file
-   %{dep:maps.txt}
-   --file
-   maps)))
+  (run %{bin:js_of_ocaml} --source-map %{dep:boulderdash.bc} -o %{targets}
+   --pretty --file %{dep:maps.txt} --file maps)))
 
 (alias
  (name default)
diff --git a/examples/cubes/dune b/examples/cubes/dune
index 56d43c509d..970d3f0b41 100644
--- a/examples/cubes/dune
+++ b/examples/cubes/dune
@@ -8,12 +8,7 @@
 (rule
  (targets cubes.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:cubes.bc}
-   -o
-   %{targets}
+  (run %{bin:js_of_ocaml} --source-map %{dep:cubes.bc} -o %{targets}
    --pretty)))
 
 (alias
diff --git a/examples/graph_viewer/dune b/examples/graph_viewer/dune
index b22b3d62c2..86f8d8edde 100644
--- a/examples/graph_viewer/dune
+++ b/examples/graph_viewer/dune
@@ -3,15 +3,7 @@
  (libraries js_of_ocaml-lwt)
  (modes byte)
  (modules
-  (:standard
-   \
-   scene_extents
-   svg
-   main
-   viewer
-   converter
-   dot_lexer
-   dot_graph
+  (:standard \ scene_extents svg main viewer converter dot_lexer dot_graph
    dot_render))
  (preprocess
   (pps js_of_ocaml-ppx)))
@@ -21,15 +13,8 @@
 (rule
  (targets viewer_js.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:viewer_js.bc}
-   -o
-   %{targets}
-   --pretty
-   --file
-   %{dep:scene.json})))
+  (run %{bin:js_of_ocaml} --source-map %{dep:viewer_js.bc} -o %{targets}
+   --pretty --file %{dep:scene.json})))
 
 (alias
  (name default)
diff --git a/examples/hyperbolic/dune b/examples/hyperbolic/dune
index f1fb55f990..732e15c390 100644
--- a/examples/hyperbolic/dune
+++ b/examples/hyperbolic/dune
@@ -8,18 +8,8 @@
 (rule
  (targets hypertree.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:hypertree.bc}
-   -o
-   %{targets}
-   --pretty
-   --file
-   %{dep:image_info.json}
-   --file
-   %{dep:messages.json}
-   --file
+  (run %{bin:js_of_ocaml} --source-map %{dep:hypertree.bc} -o %{targets}
+   --pretty --file %{dep:image_info.json} --file %{dep:messages.json} --file
    %{dep:tree.json})))
 
 (alias
diff --git a/examples/namespace/dune b/examples/namespace/dune
index addb88684b..51423b25d7 100644
--- a/examples/namespace/dune
+++ b/examples/namespace/dune
@@ -6,44 +6,20 @@
 (rule
  (target a.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   %{dep:./a.bc}
-   --wrap-with-fun
-   implemA
-   -o
-   a.js
-   --pretty
-   --target-env
-   browser
-   --no-extern-fs)))
+  (run %{bin:js_of_ocaml} %{dep:./a.bc} --wrap-with-fun implemA -o a.js
+   --pretty --target-env browser --no-extern-fs)))
 
 (rule
  (target a-iife.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   %{dep:./a.bc}
-   -o
-   a-iife.js
-   --target-env
-   browser
+  (run %{bin:js_of_ocaml} %{dep:./a.bc} -o a-iife.js --target-env browser
    --no-extern-fs)))
 
 (rule
  (target b.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   %{dep:./b.bc}
-   --wrap-with-fun
-   implemB
-   -o
-   b.js
-   --pretty
-   --target-env
-   browser
-   --no-extern-fs)))
+  (run %{bin:js_of_ocaml} %{dep:./b.bc} --wrap-with-fun implemB -o b.js
+   --pretty --target-env browser --no-extern-fs)))
 
 (alias
  (name default)
diff --git a/examples/planet/dune b/examples/planet/dune
index 30e0388841..108465e9ee 100644
--- a/examples/planet/dune
+++ b/examples/planet/dune
@@ -8,12 +8,7 @@
 (rule
  (targets planet.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:planet.bc}
-   -o
-   %{targets}
+  (run %{bin:js_of_ocaml} --source-map %{dep:planet.bc} -o %{targets}
    --pretty)))
 
 (alias
diff --git a/examples/separate_compilation/dune b/examples/separate_compilation/dune
index 110be78325..495e869117 100644
--- a/examples/separate_compilation/dune
+++ b/examples/separate_compilation/dune
@@ -27,56 +27,31 @@
 (rule
  (targets lib1.cma.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --source-map
-   %{dep:lib1.cma}
-   -o
+  (run %{bin:js_of_ocaml} --pretty --source-map %{dep:lib1.cma} -o
    %{targets})))
 
 (rule
  (targets module1.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --source-map
-   %{dep:module1.cmo}
-   -o
+  (run %{bin:js_of_ocaml} --pretty --source-map %{dep:module1.cmo} -o
    %{targets})))
 
 (rule
  (targets module2.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --source-map
-   %{dep:module2.cmo}
-   -o
+  (run %{bin:js_of_ocaml} --pretty --source-map %{dep:module2.cmo} -o
    %{targets})))
 
 (rule
  (targets stdlib.cma.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --source-map
-   %{lib:stdlib:stdlib.cma}
-   -o
+  (run %{bin:js_of_ocaml} --pretty --source-map %{lib:stdlib:stdlib.cma} -o
    %{targets})))
 
 (rule
  (targets std_exit.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --source-map
-   %{lib:stdlib:std_exit.cmo}
-   -o
+  (run %{bin:js_of_ocaml} --pretty --source-map %{lib:stdlib:std_exit.cmo} -o
    %{targets})))
 
 (rule
@@ -87,18 +62,9 @@
 (rule
  (targets bin.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   link
-   --pretty
-   %{dep:myruntime.js}
-   %{dep:stdlib.cma.js}
-   %{dep:lib1.cma.js}
-   %{dep:module1.js}
-   %{dep:module2.js}
-   %{dep:std_exit.js}
-   -o
-   %{targets})))
+  (run %{bin:js_of_ocaml} link --pretty %{dep:myruntime.js}
+   %{dep:stdlib.cma.js} %{dep:lib1.cma.js} %{dep:module1.js}
+   %{dep:module2.js} %{dep:std_exit.js} -o %{targets})))
 
 (rule
  (target bin.actual)
@@ -123,11 +89,5 @@
   (and
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
- (deps
-  myruntime.js
-  stdlib.cma.js
-  std_exit.js
-  module2.js
-  module1.js
-  bin.js
+ (deps myruntime.js stdlib.cma.js std_exit.js module2.js module1.js bin.js
   index.html))
diff --git a/examples/webgl/dune b/examples/webgl/dune
index 8025ac85fb..28d4d3b424 100644
--- a/examples/webgl/dune
+++ b/examples/webgl/dune
@@ -8,15 +8,8 @@
 (rule
  (targets webgldemo.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:webgldemo.bc}
-   -o
-   %{targets}
-   --pretty
-   --file
-   %{dep:monkey.model})))
+  (run %{bin:js_of_ocaml} --source-map %{dep:webgldemo.bc} -o %{targets}
+   --pretty --file %{dep:monkey.model})))
 
 (alias
  (name default)
diff --git a/ppx/ppx_deriving_json/tests/dune b/ppx/ppx_deriving_json/tests/dune
index 59ffdaf6d2..9320257337 100644
--- a/ppx/ppx_deriving_json/tests/dune
+++ b/ppx/ppx_deriving_json/tests/dune
@@ -1,9 +1,6 @@
 (executables
  (names main)
- (libraries
-  ppxlib
-  toplevel_expect_test
-  js_of_ocaml.deriving
+ (libraries ppxlib toplevel_expect_test js_of_ocaml.deriving
   js_of_ocaml-ppx_deriving_json)
  (modes byte)
  (link_flags (-linkall)))
diff --git a/runtime/dune b/runtime/dune
index f31ffd1b6a..4984c3f571 100644
--- a/runtime/dune
+++ b/runtime/dune
@@ -1,32 +1,8 @@
 (install
  (section lib)
  (package js_of_ocaml-compiler)
- (files
-  bigarray.js
-  bigstring.js
-  dynlink.js
-  fs.js
-  fs_fake.js
-  fs_node.js
-  gc.js
-  graphics.js
-  ieee_754.js
-  int64.js
-  internalMod.js
-  io.js
-  jslib.js
-  jslib_js_of_ocaml.js
-  lexing.js
-  marshal.js
-  md5.js
-  mlBytes.js
-  nat.js
-  parsing.js
-  stdlib.js
-  toplevel.js
-  unix.js
-  weak.js
-  domain.js
-  prng.js
-  sync.js
+ (files bigarray.js bigstring.js dynlink.js fs.js fs_fake.js fs_node.js gc.js
+  graphics.js ieee_754.js int64.js internalMod.js io.js jslib.js
+  jslib_js_of_ocaml.js lexing.js marshal.js md5.js mlBytes.js nat.js
+  parsing.js stdlib.js toplevel.js unix.js weak.js domain.js prng.js sync.js
   runtime_events.js))
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 90422c0f9d..118546efbe 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -33,20 +33,9 @@
  (target runtime.wasm)
  (deps runtime.merged.wasm)
  (action
-  (run
-   wasm-opt
-   -g
-   --enable-gc
-   --enable-exception-handling
-   --enable-reference-types
-   --enable-tail-call
-   --enable-strings
-   --enable-multivalue
-   --enable-bulk-memory
-   %{deps}
-   -O3
-   -o
-   %{target})))
+  (run wasm-opt -g --enable-gc --enable-exception-handling
+   --enable-reference-types --enable-tail-call --enable-strings
+   --enable-multivalue --enable-bulk-memory %{deps} -O3 -o %{target})))
 
 (rule
  (target runtime.merged.wasm)
@@ -59,19 +48,9 @@
     "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
    (bash
     "wasm-merge --version | grep -q 'version \\(11[89]\\|1[2-9][0-9]\\)' || (echo 'Error: Binaryen version 118 or greater is currently required'; false)")
-   (run
-    wasm-merge
-    -g
-    --enable-gc
-    --enable-exception-handling
-    --enable-reference-types
-    --enable-tail-call
-    --enable-strings
-    --enable-multivalue
-    --enable-bulk-memory
-    %{read-lines:args}
-    -o
-    %{target}))))
+   (run wasm-merge -g --enable-gc --enable-exception-handling
+    --enable-reference-types --enable-tail-call --enable-strings
+    --enable-multivalue --enable-bulk-memory %{read-lines:args} -o %{target}))))
 
 (rule
  (target args)
diff --git a/tools/sourcemap/dune b/tools/sourcemap/dune
index e23b801e40..3fcda6f57f 100644
--- a/tools/sourcemap/dune
+++ b/tools/sourcemap/dune
@@ -1,8 +1,6 @@
 (executables
  (names jsoo_sourcemap)
- (libraries
-  js_of_ocaml-compiler
-  compiler-libs.common
+ (libraries js_of_ocaml-compiler compiler-libs.common
   js_of_ocaml-compiler.findlib-support)
  (flags
   (:standard -safe-string)))
diff --git a/toplevel/bin/dune b/toplevel/bin/dune
index a236488243..ce92827400 100644
--- a/toplevel/bin/dune
+++ b/toplevel/bin/dune
@@ -2,7 +2,5 @@
  (names jsoo_mkcmis jsoo_mktop jsoo_listunits)
  (public_names jsoo_mkcmis jsoo_mktop jsoo_listunits)
  (package js_of_ocaml-toplevel)
- (libraries
-  js_of_ocaml-compiler
-  js_of_ocaml-compiler.findlib-support
+ (libraries js_of_ocaml-compiler js_of_ocaml-compiler.findlib-support
   js_of_ocaml-compiler.runtime-files))
diff --git a/toplevel/examples/eval/dune b/toplevel/examples/eval/dune
index 43a376a6d1..dcaefcb251 100644
--- a/toplevel/examples/eval/dune
+++ b/toplevel/examples/eval/dune
@@ -28,15 +28,8 @@
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --export
-   %{dep:export.txt}
-   --toplevel
-   --pretty
-   %{dep:eval.bc}
-   -o
-   %{targets})))
+  (run %{bin:js_of_ocaml} --export %{dep:export.txt} --toplevel --pretty
+   %{dep:eval.bc} -o %{targets})))
 
 (alias
  (name default)
diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune
index a6284d528f..d97792cf31 100644
--- a/toplevel/examples/lwt_toplevel/dune
+++ b/toplevel/examples/lwt_toplevel/dune
@@ -72,11 +72,7 @@
  (action
   (with-stdout-to
    %{target}
-   (run
-    ocamlfind
-    query
-    tyxml.functor
-    -format
+   (run ocamlfind query tyxml.functor -format
     "%d/html_types.cmi:/static/cmis/"))))
 
 (rule
@@ -87,26 +83,15 @@
 (rule
  (targets test_dynlink.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --toplevel
-   %{read-strings:effects_flags.txt}
-   %{dep:test_dynlink.cmo})))
+  (run %{bin:js_of_ocaml} --pretty --toplevel
+   %{read-strings:effects_flags.txt} %{dep:test_dynlink.cmo})))
 
 (rule
  (target test_lib_jsoo.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --pretty
-   --toplevel
-   --include-runtime
-   %{read-strings:effects_flags.txt}
-   %{dep:test_lib/stubs.js}
-   %{dep:test_lib/test_lib_jsoo.cma}
-   -o
-   %{target})))
+  (run %{bin:js_of_ocaml} --pretty --toplevel --include-runtime
+   %{read-strings:effects_flags.txt} %{dep:test_lib/stubs.js}
+   %{dep:test_lib/test_lib_jsoo.cma} -o %{target})))
 
 (rule
  (targets export.txt)
@@ -118,27 +103,11 @@
   (package js_of_ocaml-tyxml)
   (package js_of_ocaml-toplevel))
  (action
-  (run
-   jsoo_listunits
-   -o
-   %{targets}
-   stdlib
-   graphics
-   str
-   dynlink
-   js_of_ocaml-compiler.runtime
-   js_of_ocaml-lwt.graphics
-   js_of_ocaml-ppx.as-lib
-   js_of_ocaml.deriving
-   lwt
-   tyxml.functor
-   tyxml.functor:html_types.cmi
-   react
-   reactiveData
-   js_of_ocaml
-   js_of_ocaml-lwt
-   js_of_ocaml-tyxml
-   js_of_ocaml-toplevel)))
+  (run jsoo_listunits -o %{targets} stdlib graphics str dynlink
+   js_of_ocaml-compiler.runtime js_of_ocaml-lwt.graphics
+   js_of_ocaml-ppx.as-lib js_of_ocaml.deriving lwt tyxml.functor
+   tyxml.functor:html_types.cmi react reactiveData js_of_ocaml
+   js_of_ocaml-lwt js_of_ocaml-tyxml js_of_ocaml-toplevel)))
 
 (executable
  (name effects_flags)
@@ -165,30 +134,11 @@
    (<> %{profile} wasm)
    (<> %{profile} wasm-effects)))
  (action
-  (run
-   %{bin:js_of_ocaml}
-   compile
-   --pretty
-   %{read-strings:effects_flags.txt}
-   --Werror
-   --target-env
-   browser
-   --file
-   %{dep:examples.ml}
-   --file
-   %{dep:test_dynlink.cmo}
-   --file
-   %{dep:test_dynlink.js}
-   --file
-   %{dep:test_lib_jsoo.js}
-   --export
-   %{dep:export.txt}
-   --toplevel
-   --disable
-   shortvar
-   %{dep:toplevel.bc}
-   -o
-   %{targets})))
+  (run %{bin:js_of_ocaml} compile --pretty %{read-strings:effects_flags.txt}
+   --Werror --target-env browser --file %{dep:examples.ml} --file
+   %{dep:test_dynlink.cmo} --file %{dep:test_dynlink.js} --file
+   %{dep:test_lib_jsoo.js} --export %{dep:export.txt} --toplevel --disable
+   shortvar %{dep:toplevel.bc} -o %{targets})))
 
 (alias
  (name default)
diff --git a/toplevel/lib/dune b/toplevel/lib/dune
index 8a9d23c492..e5946b4948 100644
--- a/toplevel/lib/dune
+++ b/toplevel/lib/dune
@@ -2,10 +2,7 @@
  (name js_of_ocaml_toplevel)
  (public_name js_of_ocaml-toplevel)
  (synopsis "Js_of_ocaml toplevel library")
- (libraries
-  js_of_ocaml-compiler
-  js_of_ocaml-compiler.dynlink
-  compiler-libs.bytecomp
-  compiler-libs.toplevel)
+ (libraries js_of_ocaml-compiler js_of_ocaml-compiler.dynlink
+  compiler-libs.bytecomp compiler-libs.toplevel)
  (preprocess
   (pps ppx_optcomp_light)))
diff --git a/toplevel/test/dune b/toplevel/test/dune
index 27d0388029..ae7976114f 100644
--- a/toplevel/test/dune
+++ b/toplevel/test/dune
@@ -15,16 +15,8 @@
 (rule
  (targets test_toplevel.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --export
-   %{dep:export.txt}
-   --toplevel
-   --disable
-   shortvar
-   %{dep:test_toplevel.bc}
-   -o
-   %{targets})))
+  (run %{bin:js_of_ocaml} --export %{dep:export.txt} --toplevel --disable
+   shortvar %{dep:test_toplevel.bc} -o %{targets})))
 
 (rule
  (target test_toplevel.actual)

From 9e5006fcaa7a609af3facfb1fe3b7c848ad0cb91 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 31 Oct 2024 17:46:08 +0100
Subject: [PATCH 427/481] Revised dune support

---
 compiler/tests-env/dune                  |  6 +----
 compiler/tests-io/dune                   | 17 ++++++++++++++
 compiler/tests-jsoo/bin/dune             | 18 ++++++++++++++-
 compiler/tests-jsoo/dune                 |  8 +++----
 compiler/tests-jsoo/lib-effects/dune     |  2 +-
 compiler/tests-linkall/dune              |  4 +++-
 compiler/tests-ocaml/basic-modules/dune  |  2 +-
 compiler/tests-ocaml/lib-atomic/dune     |  2 +-
 compiler/tests-ocaml/lib-bigarray/dune   |  2 +-
 compiler/tests-ocaml/lib-bool/dune       |  2 +-
 compiler/tests-ocaml/lib-buffer/dune     |  2 +-
 compiler/tests-ocaml/lib-bytes-utf/dune  |  1 +
 compiler/tests-ocaml/lib-bytes/dune      |  2 +-
 compiler/tests-ocaml/lib-digest/dune     |  8 +++----
 compiler/tests-ocaml/lib-effects/dune    |  4 ++--
 compiler/tests-ocaml/lib-filename/dune   |  2 +-
 compiler/tests-ocaml/lib-float/dune      |  2 +-
 compiler/tests-ocaml/lib-floatarray/dune |  2 +-
 compiler/tests-ocaml/lib-format/dune     |  2 +-
 compiler/tests-ocaml/lib-fun/dune        |  2 +-
 compiler/tests-ocaml/lib-gc/dune         |  2 +-
 compiler/tests-ocaml/lib-hashtbl/dune    |  4 ++--
 compiler/tests-ocaml/lib-int/dune        |  2 +-
 compiler/tests-ocaml/lib-int64/dune      |  2 +-
 compiler/tests-ocaml/lib-list/dune       |  2 +-
 compiler/tests-ocaml/lib-option/dune     |  2 +-
 compiler/tests-ocaml/lib-printf/dune     |  1 +
 compiler/tests-ocaml/lib-queue/dune      |  2 +-
 compiler/tests-ocaml/lib-random/dune     |  1 +
 compiler/tests-ocaml/lib-result/dune     |  2 +-
 compiler/tests-ocaml/lib-seq/dune        |  2 +-
 compiler/tests-ocaml/lib-set/dune        |  2 +-
 compiler/tests-ocaml/lib-stack/dune      |  2 +-
 compiler/tests-ocaml/lib-str/dune        |  2 +-
 compiler/tests-ocaml/lib-string/dune     |  2 +-
 compiler/tests-ocaml/lib-uchar/dune      |  2 +-
 compiler/tests-ocaml/prim-bigstring/dune |  2 +-
 compiler/tests-ocaml/prim-bswap/dune     |  2 +-
 compiler/tests-ocaml/prim-revapply/dune  |  2 +-
 compiler/tests-re/dune                   |  2 +-
 compiler/tests-runtime-events/dune       |  2 +-
 compiler/tests-sourcemap/dune            |  8 -------
 compiler/tests-wasm_of_ocaml/dune        |  4 +++-
 dune                                     | 14 ++++++++----
 examples/graphics/dune                   |  2 +-
 examples/test_wheel/dune                 |  2 +-
 lib/deriving_json/tests/dune             |  2 +-
 lib/tests/dune.inc                       | 28 ++++++++++++------------
 lib/tests/gen-rules/gen.ml               |  2 +-
 tools/ci_setup.ml                        | 13 +++++++++--
 50 files changed, 124 insertions(+), 83 deletions(-)

diff --git a/compiler/tests-env/dune b/compiler/tests-env/dune
index 5975060fa9..0ec8080c7c 100644
--- a/compiler/tests-env/dune
+++ b/compiler/tests-env/dune
@@ -1,9 +1,5 @@
 (test
- (modes js)
- (build_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (modes js) ; No env support in wasm_of_ocaml yet
  (js_of_ocaml
   (javascript_files setup.js)
   (flags :standard --setenv JSOO_C=from-jsoo-args))
diff --git a/compiler/tests-io/dune b/compiler/tests-io/dune
index a2dcef1a3f..fb661ce376 100644
--- a/compiler/tests-io/dune
+++ b/compiler/tests-io/dune
@@ -2,6 +2,7 @@
  (names cat md5)
  (modes
   js
+  wasm
   (best exe)))
 
 (rule
@@ -27,6 +28,14 @@
  (action
   (diff cat-js.stdout cat-native.stdout)))
 
+(rule
+ (action
+  (copy cat.bc.wasm.js cat.bc.js))
+ (enabled_if
+  (or
+   (= %{profile} wasm)
+   (= %{profile} wasm-effects))))
+
 (rule
  (target md5-native.stdout)
  (action
@@ -69,3 +78,11 @@
  (alias runtest)
  (action
   (diff md5-js.stdout md5-native.stdout)))
+
+(rule
+ (action
+  (copy md5.bc.wasm.js md5.bc.js))
+ (enabled_if
+  (or
+   (= %{profile} wasm)
+   (= %{profile} wasm-effects))))
diff --git a/compiler/tests-jsoo/bin/dune b/compiler/tests-jsoo/bin/dune
index 3cadcdb3ed..04ffca1b8c 100644
--- a/compiler/tests-jsoo/bin/dune
+++ b/compiler/tests-jsoo/bin/dune
@@ -1,6 +1,6 @@
 (executables
  (names error1 error2)
- (modes exe js)
+ (modes exe js wasm)
  (foreign_stubs
   (language c)
   (names named_value_stubs))
@@ -55,6 +55,14 @@
  (action
   (diff %{dep:error1-unregister.expected} %{dep:error1-unregister.js.actual})))
 
+(rule
+ (action
+  (copy error1.bc.wasm.js error1.bc.js))
+ (enabled_if
+  (or
+   (= %{profile} wasm)
+   (= %{profile} wasm-effects))))
+
 (rule
  (target error2.js.actual)
  (deps error2.html)
@@ -105,3 +113,11 @@
  (alias runtest)
  (action
   (diff %{dep:error2-unregister.expected} %{dep:error2-unregister.js.actual})))
+
+(rule
+ (action
+  (copy error2.bc.wasm.js error2.bc.js))
+ (enabled_if
+  (or
+   (= %{profile} wasm)
+   (= %{profile} wasm-effects))))
diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune
index 38594fa368..ab6d5dfd47 100644
--- a/compiler/tests-jsoo/dune
+++ b/compiler/tests-jsoo/dune
@@ -5,7 +5,7 @@
  (enabled_if
   (>= %{ocaml_version} 4.14))
  (inline_tests
-  (modes js best))
+  (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
 
@@ -16,7 +16,7 @@
  (enabled_if
   (>= %{ocaml_version} 5.1.1))
  (inline_tests
-  (modes js best))
+  (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
 
@@ -27,7 +27,7 @@
  (enabled_if
   (>= %{ocaml_version} 5.1.1))
  (inline_tests
-  (modes js best))
+  (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
 
@@ -41,7 +41,7 @@
   (language c)
   (names bigarray_stubs))
  (inline_tests
-  (modes js best))
+  (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
 
diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune
index 0ac00bf21e..db1dba7b43 100644
--- a/compiler/tests-jsoo/lib-effects/dune
+++ b/compiler/tests-jsoo/lib-effects/dune
@@ -9,6 +9,6 @@
  (inline_tests
   ;; This requires the unreleased dune 3.7 to work
   (enabled_if true)
-  (modes js best))
+  (modes js wasm best))
  (preprocess
   (pps ppx_expect)))
diff --git a/compiler/tests-linkall/dune b/compiler/tests-linkall/dune
index 4b1df9f693..5d1fd7d45f 100644
--- a/compiler/tests-linkall/dune
+++ b/compiler/tests-linkall/dune
@@ -3,11 +3,13 @@
 (env
  (_
   (js_of_ocaml
+   (compilation_mode separate))
+  (wasm_of_ocaml
    (compilation_mode separate))))
 
 (test
  (name test)
- (modes byte js)
+ (modes byte js wasm)
  (libraries dynlink)
  ;; It doesn't seem possible to create a pack-ed module with dune.
  ;; However, dynlink uses pack to embed a copy
diff --git a/compiler/tests-ocaml/basic-modules/dune b/compiler/tests-ocaml/basic-modules/dune
index d5bfb9f8a9..f0add07495 100644
--- a/compiler/tests-ocaml/basic-modules/dune
+++ b/compiler/tests-ocaml/basic-modules/dune
@@ -1,4 +1,4 @@
 (tests
  (names recursive_module_init)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-atomic/dune b/compiler/tests-ocaml/lib-atomic/dune
index ca4c49b456..2976592d37 100644
--- a/compiler/tests-ocaml/lib-atomic/dune
+++ b/compiler/tests-ocaml/lib-atomic/dune
@@ -1,3 +1,3 @@
 (test
  (name test_atomic)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-bigarray/dune b/compiler/tests-ocaml/lib-bigarray/dune
index 38ac683d5e..559c82ecd1 100644
--- a/compiler/tests-ocaml/lib-bigarray/dune
+++ b/compiler/tests-ocaml/lib-bigarray/dune
@@ -1,4 +1,4 @@
 (tests
  (names bigarrays change_layout fftba pr5115 weak_bigarray)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-bool/dune b/compiler/tests-ocaml/lib-bool/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-bool/dune
+++ b/compiler/tests-ocaml/lib-bool/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-buffer/dune b/compiler/tests-ocaml/lib-buffer/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-buffer/dune
+++ b/compiler/tests-ocaml/lib-buffer/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-bytes-utf/dune b/compiler/tests-ocaml/lib-bytes-utf/dune
index 9b2db1c33a..717f83e0e5 100644
--- a/compiler/tests-ocaml/lib-bytes-utf/dune
+++ b/compiler/tests-ocaml/lib-bytes-utf/dune
@@ -5,4 +5,5 @@
   (:standard \ -strict-sequence))
  (modes
   js
+  wasm
   (best exe)))
diff --git a/compiler/tests-ocaml/lib-bytes/dune b/compiler/tests-ocaml/lib-bytes/dune
index 10725957d6..4af2ae612c 100644
--- a/compiler/tests-ocaml/lib-bytes/dune
+++ b/compiler/tests-ocaml/lib-bytes/dune
@@ -1,4 +1,4 @@
 (tests
  (names test_bytes binary)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-digest/dune b/compiler/tests-ocaml/lib-digest/dune
index ebf76eddba..550ca10463 100644
--- a/compiler/tests-ocaml/lib-digest/dune
+++ b/compiler/tests-ocaml/lib-digest/dune
@@ -2,15 +2,13 @@
  (names md5)
  (libraries)
  (modules md5)
- (modes js))
+ (modes js wasm))
 
 (tests
  (names digests)
  (libraries)
  (build_if
-  (and
-   (>= %{ocaml_version} 5.2)
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+  (>= %{ocaml_version} 5.2))
  (modules digests)
+ ; blake2b not supported by wasm_of_ocaml yet
  (modes js))
diff --git a/compiler/tests-ocaml/lib-effects/dune b/compiler/tests-ocaml/lib-effects/dune
index 95fe01b0ae..9f9a1dc985 100644
--- a/compiler/tests-ocaml/lib-effects/dune
+++ b/compiler/tests-ocaml/lib-effects/dune
@@ -28,7 +28,7 @@
   test5 test6 test_lazy used_cont)
  (modules
   (:standard \ unhandled_unlinked))
- (modes js))
+ (modes js wasm))
 
 (tests
  (build_if
@@ -41,4 +41,4 @@
     2
     (run node %{test}))
    (run cat)))
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-filename/dune b/compiler/tests-ocaml/lib-filename/dune
index 407a53e557..1f8a908a98 100644
--- a/compiler/tests-ocaml/lib-filename/dune
+++ b/compiler/tests-ocaml/lib-filename/dune
@@ -1,4 +1,4 @@
 (tests
  (names suffix extension)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-float/dune b/compiler/tests-ocaml/lib-float/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-float/dune
+++ b/compiler/tests-ocaml/lib-float/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-floatarray/dune b/compiler/tests-ocaml/lib-floatarray/dune
index b3af4c6d57..de31de0d28 100644
--- a/compiler/tests-ocaml/lib-floatarray/dune
+++ b/compiler/tests-ocaml/lib-floatarray/dune
@@ -1,4 +1,4 @@
 (tests
  (names floatarray)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-format/dune b/compiler/tests-ocaml/lib-format/dune
index 94c4cfe76f..a5860c3846 100644
--- a/compiler/tests-ocaml/lib-format/dune
+++ b/compiler/tests-ocaml/lib-format/dune
@@ -3,4 +3,4 @@
  (libraries)
  (flags
   (:standard -no-strict-formats \ -strict-formats))
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-fun/dune b/compiler/tests-ocaml/lib-fun/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-fun/dune
+++ b/compiler/tests-ocaml/lib-fun/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-gc/dune b/compiler/tests-ocaml/lib-gc/dune
index 13e636f3e2..0237c30eb0 100644
--- a/compiler/tests-ocaml/lib-gc/dune
+++ b/compiler/tests-ocaml/lib-gc/dune
@@ -2,4 +2,4 @@
  (names test_gc)
  (libraries)
  (flags -w -69)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-hashtbl/dune b/compiler/tests-ocaml/lib-hashtbl/dune
index 2a260ec2f8..01bbb96b6a 100644
--- a/compiler/tests-ocaml/lib-hashtbl/dune
+++ b/compiler/tests-ocaml/lib-hashtbl/dune
@@ -3,7 +3,7 @@
  (deps ../../../LICENSE)
  (modules hfun)
  (libraries)
- (modes js))
+ (modes js wasm))
 
 (tests
  (names htbl)
@@ -12,7 +12,7 @@
  (build_if
   (>= %{ocaml_version} 5))
  (libraries)
- (modes js))
+ (modes js wasm))
 
 (rule
  (action
diff --git a/compiler/tests-ocaml/lib-int/dune b/compiler/tests-ocaml/lib-int/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-int/dune
+++ b/compiler/tests-ocaml/lib-int/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-int64/dune b/compiler/tests-ocaml/lib-int64/dune
index 4ff01bc02f..6987384f87 100644
--- a/compiler/tests-ocaml/lib-int64/dune
+++ b/compiler/tests-ocaml/lib-int64/dune
@@ -1,4 +1,4 @@
 (tests
  (names test issue9460)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-list/dune b/compiler/tests-ocaml/lib-list/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-list/dune
+++ b/compiler/tests-ocaml/lib-list/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-option/dune b/compiler/tests-ocaml/lib-option/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-option/dune
+++ b/compiler/tests-ocaml/lib-option/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-printf/dune b/compiler/tests-ocaml/lib-printf/dune
index 69defbd4e8..2a15a0ace3 100644
--- a/compiler/tests-ocaml/lib-printf/dune
+++ b/compiler/tests-ocaml/lib-printf/dune
@@ -5,4 +5,5 @@
   (:standard -no-strict-formats \ -strict-formats))
  (modes
   js
+  wasm
   (best exe)))
diff --git a/compiler/tests-ocaml/lib-queue/dune b/compiler/tests-ocaml/lib-queue/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-queue/dune
+++ b/compiler/tests-ocaml/lib-queue/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-random/dune b/compiler/tests-ocaml/lib-random/dune
index 840bec2a7f..6c1c5e29e1 100644
--- a/compiler/tests-ocaml/lib-random/dune
+++ b/compiler/tests-ocaml/lib-random/dune
@@ -5,4 +5,5 @@
  (libraries)
  (modes
   js
+  wasm
   (best exe)))
diff --git a/compiler/tests-ocaml/lib-result/dune b/compiler/tests-ocaml/lib-result/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-result/dune
+++ b/compiler/tests-ocaml/lib-result/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-seq/dune b/compiler/tests-ocaml/lib-seq/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-seq/dune
+++ b/compiler/tests-ocaml/lib-seq/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-set/dune b/compiler/tests-ocaml/lib-set/dune
index 9e8fed86d5..c0602be25e 100644
--- a/compiler/tests-ocaml/lib-set/dune
+++ b/compiler/tests-ocaml/lib-set/dune
@@ -1,4 +1,4 @@
 (tests
  (names testmap testset)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-stack/dune b/compiler/tests-ocaml/lib-stack/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-stack/dune
+++ b/compiler/tests-ocaml/lib-stack/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-str/dune b/compiler/tests-ocaml/lib-str/dune
index 18b732190a..fe1e7b18c4 100644
--- a/compiler/tests-ocaml/lib-str/dune
+++ b/compiler/tests-ocaml/lib-str/dune
@@ -1,4 +1,4 @@
 (tests
  (names t01)
  (libraries str)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-string/dune b/compiler/tests-ocaml/lib-string/dune
index f1b08d6ad0..e3f41537b8 100644
--- a/compiler/tests-ocaml/lib-string/dune
+++ b/compiler/tests-ocaml/lib-string/dune
@@ -3,4 +3,4 @@
  (build_if
   (>= %{ocaml_version} 5))
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/lib-uchar/dune b/compiler/tests-ocaml/lib-uchar/dune
index 9047167ba4..16342d6417 100644
--- a/compiler/tests-ocaml/lib-uchar/dune
+++ b/compiler/tests-ocaml/lib-uchar/dune
@@ -1,4 +1,4 @@
 (tests
  (names test)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/prim-bigstring/dune b/compiler/tests-ocaml/prim-bigstring/dune
index 2e162bd45a..880fb9cd70 100644
--- a/compiler/tests-ocaml/prim-bigstring/dune
+++ b/compiler/tests-ocaml/prim-bigstring/dune
@@ -1,4 +1,4 @@
 (tests
  (names bigstring_access string_access)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/prim-bswap/dune b/compiler/tests-ocaml/prim-bswap/dune
index 36c5b217b1..a0328d664c 100644
--- a/compiler/tests-ocaml/prim-bswap/dune
+++ b/compiler/tests-ocaml/prim-bswap/dune
@@ -1,4 +1,4 @@
 (tests
  (names bswap)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-ocaml/prim-revapply/dune b/compiler/tests-ocaml/prim-revapply/dune
index bf4e90bb65..017e60f37c 100644
--- a/compiler/tests-ocaml/prim-revapply/dune
+++ b/compiler/tests-ocaml/prim-revapply/dune
@@ -1,4 +1,4 @@
 (tests
  (names apply revapply)
  (libraries)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-re/dune b/compiler/tests-re/dune
index 10c45d2c5b..e86d9c9347 100644
--- a/compiler/tests-re/dune
+++ b/compiler/tests-re/dune
@@ -6,4 +6,4 @@
 (tests
  (names test_str)
  (libraries str re)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-runtime-events/dune b/compiler/tests-runtime-events/dune
index f387de95eb..a8a208145f 100644
--- a/compiler/tests-runtime-events/dune
+++ b/compiler/tests-runtime-events/dune
@@ -8,4 +8,4 @@
  (build_if
   (>= %{ocaml_version} 5.1.0))
  (libraries runtime_events)
- (modes js))
+ (modes js wasm))
diff --git a/compiler/tests-sourcemap/dune b/compiler/tests-sourcemap/dune
index 22b4488094..76618354b5 100644
--- a/compiler/tests-sourcemap/dune
+++ b/compiler/tests-sourcemap/dune
@@ -7,10 +7,6 @@
  (name test)
  (modules test)
  (modes js)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
  (js_of_ocaml
   (link_flags
    (:standard --source-map-root /my/sourceRoot)))
@@ -18,10 +14,6 @@
 
 (library
  (name testlib)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
  (modules a b c d))
 
 (test
diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune
index fc33f16583..0ae81f7992 100644
--- a/compiler/tests-wasm_of_ocaml/dune
+++ b/compiler/tests-wasm_of_ocaml/dune
@@ -1,5 +1,7 @@
 (tests
  (names gh38 gh46 gh107 gh112)
- (modes js)
+ (modes js wasm)
  (js_of_ocaml
+  (flags :standard --disable optcall --no-inline))
+ (wasm_of_ocaml
   (flags :standard --disable optcall --no-inline)))
diff --git a/dune b/dune
index 85596593f4..01946378d0 100644
--- a/dune
+++ b/dune
@@ -1,8 +1,12 @@
 (env
  (dev
+  (wasm_of_ocaml
+   (enabled_if false))
   (flags
    (:standard -w +a-4-40-41-42-44-48-58-66-70)))
  (using-effects
+  (wasm_of_ocaml
+   (enabled_if false))
   (js_of_ocaml
    (compilation_mode separate)
    (flags
@@ -13,16 +17,18 @@
   (binaries
    (tools/node_wrapper.sh as node))
   (js_of_ocaml
-   (compilation_mode separate)
-   (submodes wasm)))
+   (enabled_if false))
+  (wasm_of_ocaml
+   (compilation_mode separate)))
  (wasm-effects
   (binaries
    (tools/node_wrapper.sh as node))
   (js_of_ocaml
+   (enabled_if false))
+  (wasm_of_ocaml
    (compilation_mode separate)
    (flags
-    (:standard --enable effects))
-   (submodes wasm)))
+    (:standard --enable effects))))
  (bench_no_debug
   (flags
    (:standard \ -g))
diff --git a/examples/graphics/dune b/examples/graphics/dune
index a563ee7739..cecdf24620 100644
--- a/examples/graphics/dune
+++ b/examples/graphics/dune
@@ -1,6 +1,6 @@
 (executable
  (name main)
- (modes js)
+ (modes js wasm)
  (libraries js_of_ocaml-lwt.graphics)
  (preprocess
   (pps js_of_ocaml-ppx)))
diff --git a/examples/test_wheel/dune b/examples/test_wheel/dune
index cd729978bc..ba4be3c0a9 100644
--- a/examples/test_wheel/dune
+++ b/examples/test_wheel/dune
@@ -1,6 +1,6 @@
 (executables
  (names test_wheel)
  (libraries js_of_ocaml)
- (modes js)
+ (modes js wasm)
  (preprocess
   (pps js_of_ocaml-ppx)))
diff --git a/lib/deriving_json/tests/dune b/lib/deriving_json/tests/dune
index 8834c59137..c1e0147b3d 100644
--- a/lib/deriving_json/tests/dune
+++ b/lib/deriving_json/tests/dune
@@ -2,6 +2,6 @@
  (name deriving_expect_tests)
  (libraries unix js_of_ocaml js_of_ocaml.deriving)
  (inline_tests
-  (modes js))
+  (modes js wasm))
  (preprocess
   (pps ppx_expect ppx_deriving_json)))
diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc
index b16a266b6d..c944536e87 100644
--- a/lib/tests/dune.inc
+++ b/lib/tests/dune.inc
@@ -5,7 +5,7 @@
  (enabled_if true)
  (modules test_css_angle)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -15,7 +15,7 @@
  (enabled_if true)
  (modules test_css_color)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -25,7 +25,7 @@
  (enabled_if true)
  (modules test_css_length)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -35,7 +35,7 @@
  (enabled_if (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_fun_call)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -45,7 +45,7 @@
  (enabled_if true)
  (modules test_fun_call_2)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -55,7 +55,7 @@
  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_json)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -65,7 +65,7 @@
  (enabled_if true)
  (modules test_nodejs_filesystem_errors)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -75,7 +75,7 @@
  (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_poly_compare)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -85,7 +85,7 @@
  (enabled_if true)
  (modules test_poly_equal)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -95,7 +95,7 @@
  (enabled_if true)
  (modules test_regexp)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -105,7 +105,7 @@
  (enabled_if (and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
  (modules test_sys)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -115,7 +115,7 @@
  (enabled_if true)
  (modules test_typed_array)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -125,7 +125,7 @@
  (enabled_if true)
  (modules test_unsafe_set_get)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -135,6 +135,6 @@
  (enabled_if true)
  (modules test_url)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml
index eda5eea71a..257fecc0dd 100644
--- a/lib/tests/gen-rules/gen.ml
+++ b/lib/tests/gen-rules/gen.ml
@@ -71,7 +71,7 @@ let () =
  (enabled_if %s)
  (modules %s)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js))
+ (inline_tests (modes js wasm))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 |}
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index dc94596a4d..d3a08f6c1e 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -29,7 +29,7 @@ let dune_workspace =
 (env
  (_
   (env-vars (TESTING_FRAMEWORK inline-test))
-  (js_of_ocaml (submodes wasm))
+  (js_of_ocaml (enabled_if false))
   (flags :standard -warn-error -8-32-34-49-52-55 -w -67-69)))
 |}
 
@@ -54,6 +54,15 @@ index 91933ec..849e4d7 100644
     )
   ; ( "bignum"
     , {bignum|
+diff --git a/dune-project b/dune-project
+index e563d7e..b87e356 100644
+--- a/dune-project
++++ b/dune-project
+@@ -1,3 +1,3 @@
+-(lang dune 2.0)
++(lang dune 3.17)
+ 
+ (formatting disabled)
 diff --git a/test/src/dune b/test/src/dune
 index f93ae3f..3f00557 100644
 --- a/test/src/dune
@@ -62,7 +71,7 @@ index f93ae3f..3f00557 100644
   (name bignum_test)
   (libraries bigint bignum core expect_test_helpers_core
     sexp_grammar_validation)
-+ (inline_tests (flags -drop-tag no-js -drop-tag no-wasm -drop-tag 64-bits-only) (modes js))
++ (inline_tests (flags -drop-tag no-js -drop-tag no-wasm -drop-tag 64-bits-only) (modes js wasm))
   (preprocess
    (pps ppx_jane)))
 diff --git a/test/src/test_bignum.ml b/test/src/test_bignum.ml

From 47f0707ee2ba8ca1ad6e543771ee416753cc2968 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 4 Nov 2024 17:32:47 +0100
Subject: [PATCH 428/481] Library tests: lighter conditions

---
 lib/tests/dune.inc         | 16 ++++++++--------
 lib/tests/gen-rules/gen.ml | 20 +++++++++-----------
 2 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc
index c944536e87..b7f107eb24 100644
--- a/lib/tests/dune.inc
+++ b/lib/tests/dune.inc
@@ -32,10 +32,10 @@
 (library
  ;; lib/tests/test_fun_call.ml
  (name test_fun_call_75)
- (enabled_if (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (<> %{profile} using-effects))
  (modules test_fun_call)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js wasm))
+ (inline_tests (modes js))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -52,10 +52,10 @@
 (library
  ;; lib/tests/test_json.ml
  (name test_json_75)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if true)
  (modules test_json)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js wasm))
+ (inline_tests (modes js))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -72,10 +72,10 @@
 (library
  ;; lib/tests/test_poly_compare.ml
  (name test_poly_compare_75)
- (enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if true)
  (modules test_poly_compare)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js wasm))
+ (inline_tests (modes js))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
@@ -102,10 +102,10 @@
 (library
  ;; lib/tests/test_sys.ml
  (name test_sys_75)
- (enabled_if (and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (>= %{ocaml_version} 5))
  (modules test_sys)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js wasm))
+ (inline_tests (modes js))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 
diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml
index 257fecc0dd..ef2ec73e53 100644
--- a/lib/tests/gen-rules/gen.ml
+++ b/lib/tests/gen-rules/gen.ml
@@ -71,7 +71,7 @@ let () =
  (enabled_if %s)
  (modules %s)
  (libraries js_of_ocaml unix)
- (inline_tests (modes js wasm))
+ (inline_tests (modes js%s))
  (preprocess
   (pps ppx_js_internal ppx_expect)))
 |}
@@ -80,13 +80,11 @@ let () =
            basename
            (Hashtbl.hash prefix mod 100)
            (match enabled_if basename with
-           | Any -> "true"
-           | GE5 ->
-               (* ZZZ /static not yet implemented *)
-               "(and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} \
-                wasm-effects))"
-           | Not_wasm -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))"
-           | No_effects_not_wasm ->
-               "(and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} \
-                wasm-effects))")
-           basename)
+           | Any | Not_wasm -> "true"
+           | GE5 -> "(>= %{ocaml_version} 5)"
+           | No_effects_not_wasm -> "(<> %{profile} using-effects)")
+           basename
+           (match enabled_if basename with
+           | Any -> " wasm"
+           | GE5 -> "" (* ZZZ /static not yet implemented *)
+           | Not_wasm | No_effects_not_wasm -> ""))

From b0c7c993fd61a7156a250806f8b1c0fb17fece17 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 5 Nov 2024 16:02:08 +0100
Subject: [PATCH 429/481] Update Yojson dependency

---
 dune-project                | 2 +-
 wasm_of_ocaml-compiler.opam | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/dune-project b/dune-project
index 2f54a94764..9a564c6bbd 100644
--- a/dune-project
+++ b/dune-project
@@ -150,7 +150,7 @@
   menhir
   menhirLib
   menhirSdk
-  yojson
+  (yojson (>= 2.1))
   binaryen-bin)
  (depopts
   ocamlfind)
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
index 3d1a938bfd..b8a5d217ad 100644
--- a/wasm_of_ocaml-compiler.opam
+++ b/wasm_of_ocaml-compiler.opam
@@ -24,7 +24,7 @@ depends: [
   "menhir"
   "menhirLib"
   "menhirSdk"
-  "yojson"
+  "yojson" {>= "2.1"}
   "binaryen-bin"
   "odoc" {with-doc}
 ]

From bd01184bb5a4357a76f201f6b5db02f569453e70 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 4 Jul 2024 10:25:32 +0200
Subject: [PATCH 430/481] Use a try_table like instruction internally

We will need to switch to the new exception handling proposal at some
point, when it will be enabled by default in Chrome and Firefox.
---
 compiler/lib-wasm/wa_ast.ml               |  6 +--
 compiler/lib-wasm/wa_code_generation.ml   |  9 ++---
 compiler/lib-wasm/wa_code_generation.mli  |  5 ++-
 compiler/lib-wasm/wa_gc_target.ml         | 35 +++++++++-------
 compiler/lib-wasm/wa_generate.ml          | 18 ++++-----
 compiler/lib-wasm/wa_initialize_locals.ml |  5 +--
 compiler/lib-wasm/wa_tail_call.ml         |  6 ---
 compiler/lib-wasm/wa_target_sig.ml        |  4 +-
 compiler/lib-wasm/wa_wasm_output.ml       | 49 +++++++----------------
 compiler/lib-wasm/wa_wat_output.ml        | 29 +++++++-------
 10 files changed, 70 insertions(+), 96 deletions(-)

diff --git a/compiler/lib-wasm/wa_ast.ml b/compiler/lib-wasm/wa_ast.ml
index 0552f87a7c..a23addc4a2 100644
--- a/compiler/lib-wasm/wa_ast.ml
+++ b/compiler/lib-wasm/wa_ast.ml
@@ -165,6 +165,7 @@ type expression =
   | Br_on_cast of int * ref_type * ref_type * expression
   | Br_on_cast_fail of int * ref_type * ref_type * expression
   | IfExpr of value_type * expression * expression * expression
+  | Try of func_type * instruction list * (var * int * value_type) list
 
 and instruction =
   | Drop of expression
@@ -180,11 +181,6 @@ and instruction =
   | CallInstr of var * expression list
   | Nop
   | Push of expression
-  | Try of
-      func_type
-      * instruction list
-      * (var * instruction list) list
-      * instruction list option
   | Throw of var * expression
   | Rethrow of int
   | ArraySet of var * expression * expression * expression
diff --git a/compiler/lib-wasm/wa_code_generation.ml b/compiler/lib-wasm/wa_code_generation.ml
index 761de78b5c..69217ae1ee 100644
--- a/compiler/lib-wasm/wa_code_generation.ml
+++ b/compiler/lib-wasm/wa_code_generation.ml
@@ -452,7 +452,8 @@ let rec is_smi e =
   | RefCast _
   | RefNull _
   | Br_on_cast _
-  | Br_on_cast_fail _ -> false
+  | Br_on_cast_fail _
+  | Try _ -> false
   | BinOp ((F32 _ | F64 _), _, _) | RefTest _ | RefEq _ -> true
   | IfExpr (_, _, ift, iff) -> is_smi ift && is_smi iff
 
@@ -575,11 +576,9 @@ let if_ ty e l1 l2 =
   | W.UnOp (I32 Eqz, e') -> instr (If (ty, e', instrs2, instrs1))
   | _ -> instr (If (ty, e, instrs1, instrs2))
 
-let try_ ty body handlers =
+let try_expr ty body handlers =
   let* body = blk body in
-  let tags = List.map ~f:fst handlers in
-  let* handler_bodies = expression_list blk (List.map ~f:snd handlers) in
-  instr (Try (ty, body, List.combine tags handler_bodies, None))
+  return (W.Try (ty, body, handlers))
 
 let need_apply_fun ~cps ~arity st =
   let ctx = st.context in
diff --git a/compiler/lib-wasm/wa_code_generation.mli b/compiler/lib-wasm/wa_code_generation.mli
index 3a084b6aea..e505d2a3b2 100644
--- a/compiler/lib-wasm/wa_code_generation.mli
+++ b/compiler/lib-wasm/wa_code_generation.mli
@@ -128,7 +128,8 @@ val block_expr : Wa_ast.func_type -> unit t -> expression
 
 val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
 
-val try_ : Wa_ast.func_type -> unit t -> (Code.Var.t * unit t) list -> unit t
+val try_expr :
+  Wa_ast.func_type -> unit t -> (Code.Var.t * int * Wa_ast.value_type) list -> expression
 
 val add_var : ?typ:Wa_ast.value_type -> Wa_ast.var -> Wa_ast.var t
 
@@ -142,6 +143,8 @@ val event : Parse_info.t -> unit t
 
 val no_event : unit t
 
+val hidden_location : Parse_info.t
+
 type type_def =
   { supertype : Wa_ast.var option
   ; final : bool
diff --git a/compiler/lib-wasm/wa_gc_target.ml b/compiler/lib-wasm/wa_gc_target.ml
index ee0f1c496b..a6f138110a 100644
--- a/compiler/lib-wasm/wa_gc_target.ml
+++ b/compiler/lib-wasm/wa_gc_target.ml
@@ -526,7 +526,8 @@ module Value = struct
     | Pop _
     | Call_ref _
     | Br_on_cast _
-    | Br_on_cast_fail _ -> false
+    | Br_on_cast_fail _
+    | Try _ -> false
     | IfExpr (_, e1, e2, e3) -> effect_free e1 && effect_free e2 && effect_free e3
     | ArrayNewFixed (_, l) | StructNew (_, l) -> List.for_all ~f:effect_free l
 
@@ -1676,19 +1677,25 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
   block
     { params = []; result = result_typ }
     (let* () =
-       try_
-         { params = []; result = [] }
-         (body ~result_typ:[] ~fall_through:(`Catch x) ~context:(`Catch x :: context))
-         [ ( ocaml_tag
-           , let* () = no_event in
-             store ~always:true x (return (W.Pop Value.value)) )
-         ; ( js_tag
-           , let* () = no_event in
-             let exn = Code.Var.fresh () in
-             let* () = store ~always:true ~typ:externref exn (return (W.Pop externref)) in
-             let* exn = load exn in
-             store ~always:true x (return (W.Call (f, [ exn ]))) )
-         ]
+       store
+         x
+         (block_expr
+            { params = []; result = [ Value.value ] }
+            (let* exn =
+               block_expr
+                 { params = []; result = [ externref ] }
+                 (let* e =
+                    try_expr
+                      { params = []; result = [ externref ] }
+                      (body
+                         ~result_typ:[ externref ]
+                         ~fall_through:`Skip
+                         ~context:(`Skip :: `Skip :: `Catch :: context))
+                      [ ocaml_tag, 1, Value.value; js_tag, 0, externref ]
+                  in
+                  instr (W.Push e))
+             in
+             instr (W.CallInstr (f, [ exn ]))))
      in
      let* () = no_event in
      exn_handler ~result_typ ~fall_through ~context)
diff --git a/compiler/lib-wasm/wa_generate.ml b/compiler/lib-wasm/wa_generate.ml
index 48e0f0875e..6e8b8643de 100644
--- a/compiler/lib-wasm/wa_generate.ml
+++ b/compiler/lib-wasm/wa_generate.ml
@@ -160,7 +160,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     let rec index_rec context pc i =
       match context with
       | `Block pc' :: _ when pc = pc' -> i
-      | (`Block _ | `Skip | `Catch _) :: rem -> index_rec rem pc (i + 1)
+      | (`Block _ | `Skip | `Catch) :: rem -> index_rec rem pc (i + 1)
       | [] -> assert false
     in
     index_rec context pc 0
@@ -168,7 +168,7 @@ module Generate (Target : Wa_target_sig.S) = struct
   let catch_index context =
     let rec index_rec context i =
       match context with
-      | `Catch x :: _ -> Some (x, i)
+      | `Catch :: _ -> Some i
       | (`Block _ | `Skip | `Return) :: rem -> index_rec rem (i + 1)
       | [] -> None
     in
@@ -759,7 +759,7 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   let extend_context fall_through context =
     match fall_through with
-    | (`Block _ | `Catch _) as b -> b :: context
+    | (`Block _ | `Catch | `Skip) as b -> b :: context
     | `Return -> `Skip :: context
 
   let needed_handlers (p : program) pc =
@@ -911,7 +911,7 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* e = load x in
               match fall_through with
               | `Return -> instr (Push e)
-              | `Block _ | `Catch _ -> instr (Return (Some e)))
+              | `Block _ | `Catch | `Skip -> instr (Return (Some e)))
           | Cond (x, cont1, cont2) ->
               let context' = extend_context fall_through context in
               if_
@@ -923,7 +923,7 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* e = Value.unit in
               match fall_through with
               | `Return -> instr (Push e)
-              | `Block _ | `Catch _ -> instr (Return (Some e)))
+              | `Block _ | `Catch | `Skip -> instr (Return (Some e)))
           | Switch (x, a) ->
               let len = Array.length a in
               let l = Array.to_list (Array.sub a ~pos:0 ~len:(len - 1)) in
@@ -937,12 +937,10 @@ module Generate (Target : Wa_target_sig.S) = struct
               let* e = load x in
               let* tag = register_import ~name:exception_name (Tag Value.value) in
               match fall_through with
-              | `Catch x -> store ~always:true x (return e)
-              | `Block _ | `Return -> (
+              | `Catch -> instr (Push e)
+              | `Block _ | `Return | `Skip -> (
                   match catch_index context with
-                  | Some (x, i) ->
-                      let* () = store ~always:true x (return e) in
-                      instr (Br (i, None))
+                  | Some i -> instr (Br (i, Some e))
                   | None -> instr (Throw (tag, e))))
           | Pushtrap (cont, x, cont') ->
               handle_exceptions
diff --git a/compiler/lib-wasm/wa_initialize_locals.ml b/compiler/lib-wasm/wa_initialize_locals.ml
index 50b8712f64..5e20732def 100644
--- a/compiler/lib-wasm/wa_initialize_locals.ml
+++ b/compiler/lib-wasm/wa_initialize_locals.ml
@@ -68,6 +68,7 @@ let rec scan_expression ctx e =
       scan_expression ctx cond;
       scan_expression (fork_context ctx) e1;
       scan_expression (fork_context ctx) e2
+  | Try (_, body, _) -> scan_instructions ctx body
 
 and scan_expressions ctx l = List.iter ~f:(fun e -> scan_expression ctx e) l
 
@@ -92,10 +93,6 @@ and scan_instruction ctx i =
       scan_expression ctx e;
       scan_instructions ctx l;
       scan_instructions ctx l'
-  | Try (_, body, catches, catch_all) ->
-      scan_instructions ctx body;
-      List.iter ~f:(fun (_, l) -> scan_instructions ctx l) catches;
-      Option.iter ~f:(fun l -> scan_instructions ctx l) catch_all
   | CallInstr (_, l) | Return_call (_, l) -> scan_expressions ctx l
   | Br (_, None) | Return None | Rethrow _ | Nop | Event _ -> ()
   | ArraySet (_, e, e', e'') ->
diff --git a/compiler/lib-wasm/wa_tail_call.ml b/compiler/lib-wasm/wa_tail_call.ml
index 62c19ece26..1557f4bee2 100644
--- a/compiler/lib-wasm/wa_tail_call.ml
+++ b/compiler/lib-wasm/wa_tail_call.ml
@@ -37,12 +37,6 @@ let rec instruction ~tail i =
   | Wa_ast.Loop (ty, l) -> Wa_ast.Loop (ty, instructions ~tail l)
   | Block (ty, l) -> Block (ty, instructions ~tail l)
   | If (ty, e, l1, l2) -> If (ty, e, instructions ~tail l1, instructions ~tail l2)
-  | Try (ty, l, catches, catch_all) ->
-      Try
-        ( ty
-        , l
-        , List.map ~f:(fun (tag, l) -> tag, instructions ~tail l) catches
-        , Option.map ~f:(fun l -> instructions ~tail l) catch_all )
   | Return (Some (Call (symb, l))) -> Return_call (symb, l)
   | Return (Some (Call_ref (ty, e, l))) -> Return_call_ref (ty, e, l)
   | Push (Call (symb, l)) when tail -> Return_call (symb, l)
diff --git a/compiler/lib-wasm/wa_target_sig.ml b/compiler/lib-wasm/wa_target_sig.ml
index 152c843da3..02b89e80a1 100644
--- a/compiler/lib-wasm/wa_target_sig.ml
+++ b/compiler/lib-wasm/wa_target_sig.ml
@@ -252,9 +252,9 @@ module type S = sig
   val handle_exceptions :
        result_typ:Wa_ast.value_type list
     -> fall_through:'a
-    -> context:([> `Catch of Code.Var.t ] as 'b) list
+    -> context:([> `Catch | `Skip ] as 'b) list
     -> (   result_typ:Wa_ast.value_type list
-        -> fall_through:[> `Catch of Code.Var.t ]
+        -> fall_through:[> `Skip ]
         -> context:'b list
         -> unit Wa_code_generation.t)
     -> Wa_ast.var
diff --git a/compiler/lib-wasm/wa_wasm_output.ml b/compiler/lib-wasm/wa_wasm_output.ml
index 38eb0a5999..a9980a2456 100644
--- a/compiler/lib-wasm/wa_wasm_output.ml
+++ b/compiler/lib-wasm/wa_wasm_output.ml
@@ -628,6 +628,18 @@ end = struct
         output_byte ch 0x05;
         output_expression st ch e3;
         output_byte ch 0x0B
+    | Try (typ, l, catches) ->
+        Feature.require exception_handling;
+        output_byte ch 0x06;
+        output_blocktype st.type_names ch typ;
+        List.iter ~f:(fun i' -> output_instruction st ch i') l;
+        List.iter
+          ~f:(fun (tag, l, ty) ->
+            output_byte ch 0x07;
+            output_uint ch (Hashtbl.find st.tag_names tag);
+            output_instruction st ch (Br (l + 1, Some (Pop ty))))
+          catches;
+        output_byte ch 0X0B
 
   and output_instruction st ch i =
     match i with
@@ -688,23 +700,6 @@ end = struct
         output_uint ch (Hashtbl.find st.func_names f)
     | Nop -> ()
     | Push e -> output_expression st ch e
-    | Try (typ, l, catches, catchall) ->
-        Feature.require exception_handling;
-        output_byte ch 0x06;
-        output_blocktype st.type_names ch typ;
-        List.iter ~f:(fun i' -> output_instruction st ch i') l;
-        List.iter
-          ~f:(fun (tag, l) ->
-            output_byte ch 0x07;
-            output_uint ch (Hashtbl.find st.tag_names tag);
-            List.iter ~f:(fun i' -> output_instruction st ch i') l)
-          catches;
-        (match catchall with
-        | Some l ->
-            output_byte ch 0x05;
-            List.iter ~f:(fun i' -> output_instruction st ch i') l
-        | None -> ());
-        output_byte ch 0X0B
     | Throw (tag, e) ->
         Feature.require exception_handling;
         output_expression st ch e;
@@ -881,6 +876,8 @@ end = struct
           ~f:(fun set i -> expr_function_references i set)
           ~init:(expr_function_references e' set)
           l
+    | Try (_, l, _) ->
+        List.fold_left ~f:(fun set i -> instr_function_references i set) ~init:set l
 
   and instr_function_references i set =
     match i with
@@ -905,24 +902,6 @@ end = struct
     | Br (_, None) | Return None | Nop | Rethrow _ -> set
     | CallInstr (_, l) ->
         List.fold_left ~f:(fun set i -> expr_function_references i set) ~init:set l
-    | Try (_, l, catches, catchall) ->
-        List.fold_left ~f:(fun set i -> instr_function_references i set) ~init:set l
-        |> (fun init ->
-             List.fold_left
-               ~f:(fun set (_, l) ->
-                 List.fold_left
-                   ~f:(fun set i -> instr_function_references i set)
-                   ~init:set
-                   l)
-               ~init
-               catches)
-        |> fun init ->
-        List.fold_left
-          ~f:(fun set i -> instr_function_references i set)
-          ~init
-          (match catchall with
-          | Some l -> l
-          | None -> [])
     | ArraySet (_, e1, e2, e3) ->
         set
         |> expr_function_references e1
diff --git a/compiler/lib-wasm/wa_wat_output.ml b/compiler/lib-wasm/wa_wat_output.ml
index 01d69b5365..e921d23ec2 100644
--- a/compiler/lib-wasm/wa_wat_output.ml
+++ b/compiler/lib-wasm/wa_wat_output.ml
@@ -442,6 +442,21 @@ let expression_or_instructions ctx st in_function =
             @ [ List (Atom "then" :: expression ift) ]
             @ [ List (Atom "else" :: expression iff) ])
         ]
+    | Try (ty, body, catches) ->
+        [ List
+            (Atom "try"
+            :: (block_type st ty
+               @ List (Atom "do" :: instructions body)
+                 :: List.map
+                      ~f:(fun (tag, i, ty) ->
+                        List
+                          (Atom "catch"
+                          :: index st.tag_names tag
+                          :: (instruction
+                                (Wa_ast.Event Wa_code_generation.hidden_location)
+                             @ instruction (Wa_ast.Br (i + 1, Some (Pop ty))))))
+                      catches))
+        ]
   and instruction i =
     match i with
     | Drop e -> [ List (Atom "drop" :: expression e) ]
@@ -460,20 +475,6 @@ let expression_or_instructions ctx st in_function =
                @ list ~always:true "then" instructions (remove_nops l1)
                @ list "else" instructions (remove_nops l2)))
         ]
-    | Try (ty, body, catches, catch_all) ->
-        [ List
-            (Atom "try"
-            :: (block_type st ty
-               @ List (Atom "do" :: instructions body)
-                 :: (List.map
-                       ~f:(fun (tag, l) ->
-                         List (Atom "catch" :: index st.tag_names tag :: instructions l))
-                       catches
-                    @
-                    match catch_all with
-                    | None -> []
-                    | Some l -> [ List (Atom "catch_all" :: instructions l) ])))
-        ]
     | Br_table (e, l, i) ->
         [ List
             (Atom "br_table"

From bdf5c00673b6d1f315f85946adab272e351020a8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 5 Nov 2024 11:33:36 +0100
Subject: [PATCH 431/481] CI: pin main branch of dune

---
 .github/workflows/build-wasm_of_ocaml.yml | 2 +-
 .github/workflows/build.yml               | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 9e1d559f51..bdac08d974 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -148,7 +148,7 @@ jobs:
 
       - name: Pin dune
         run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml-incremental
+          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
 
       - name: Pin wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 9a48c267f8..5d4917a71a 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -114,7 +114,7 @@ jobs:
 
       - name: Pin dune
         run: |
-          opam pin add dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+          opam pin add dune.3.17 https://github.com/ocaml/dune.git
 
       - run: opam install conf-pkg-config
         if: runner.os == 'Windows'
@@ -178,7 +178,7 @@ jobs:
           dune-cache: true
       - name: Pin dune
         run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
       - uses: ocaml/setup-ocaml/lint-opam@v3
 
   lint-fmt:
@@ -193,7 +193,7 @@ jobs:
           dune-cache: true
       - name: Pin dune
         run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
+          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
       - uses: ocaml/setup-ocaml/lint-fmt@v3
 
   lint-runtime:

From ee358637991c085e923cc97b424a713407b8ada6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 14:39:52 +0100
Subject: [PATCH 432/481] Update README.md

---
 README.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/README.md b/README.md
index ef6ed187da..35e78b4317 100644
--- a/README.md
+++ b/README.md
@@ -24,8 +24,8 @@ The following commands will perform a minimal installation:
 ```
 git clone https://github.com/ocaml-wasm/wasm_of_ocaml
 cd wasm_of_ocaml
-opam pin add -n --with-version 3.17 https://github.com/ocaml-wasm/dune.git#wasm_of_ocaml
-opam pin add -n --with-version 5.3.0-wasm .
+opam pin add -n --with-version 3.17 https://github.com/ocaml/dune.git
+opam pin add -n --with-version 5.8.2-wasm .
 opam install wasm_of_ocaml-compiler
 ```
 You may want to install additional packages. For instance:

From a1d6554ea9d055f817edea5d32e485d836001cb3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 14:43:24 +0100
Subject: [PATCH 433/481] Renamed Wa_ast into Wasm_ast

---
 compiler/lib-wasm/wa_code_generation.ml      | 14 ++--
 compiler/lib-wasm/wa_code_generation.mli     | 72 +++++++++++---------
 compiler/lib-wasm/wa_curry.ml                |  2 +-
 compiler/lib-wasm/wa_gc_target.ml            |  4 +-
 compiler/lib-wasm/wa_generate.ml             |  2 +-
 compiler/lib-wasm/wa_generate.mli            |  4 +-
 compiler/lib-wasm/wa_initialize_locals.ml    |  8 +--
 compiler/lib-wasm/wa_initialize_locals.mli   |  8 +--
 compiler/lib-wasm/wa_tail_call.ml            |  8 +--
 compiler/lib-wasm/wa_tail_call.mli           |  2 +-
 compiler/lib-wasm/wa_target_sig.ml           | 38 +++++------
 compiler/lib-wasm/wa_wasm_output.ml          |  2 +-
 compiler/lib-wasm/wa_wasm_output.mli         |  2 +-
 compiler/lib-wasm/wa_wat_output.ml           |  8 +--
 compiler/lib-wasm/wa_wat_output.mli          |  2 +-
 compiler/lib-wasm/{wa_ast.ml => wasm_ast.ml} |  0
 16 files changed, 90 insertions(+), 86 deletions(-)
 rename compiler/lib-wasm/{wa_ast.ml => wasm_ast.ml} (100%)

diff --git a/compiler/lib-wasm/wa_code_generation.ml b/compiler/lib-wasm/wa_code_generation.ml
index 69217ae1ee..aac5047546 100644
--- a/compiler/lib-wasm/wa_code_generation.ml
+++ b/compiler/lib-wasm/wa_code_generation.ml
@@ -18,7 +18,7 @@
 
 open! Stdlib
 open Code
-module W = Wa_ast
+module W = Wasm_ast
 
 (*
 LLVM type checker does not work well. It does not handle 'br', and
@@ -41,9 +41,9 @@ type context =
   ; mutable data_segments : string Var.Map.t
   ; mutable constant_globals : constant_global Var.Map.t
   ; mutable other_fields : W.module_field list
-  ; mutable imports : (Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
+  ; mutable imports : (Var.t * Wasm_ast.import_desc) StringMap.t StringMap.t
   ; type_names : (string, Var.t) Hashtbl.t
-  ; types : (Var.t, Wa_ast.type_field) Hashtbl.t
+  ; types : (Var.t, Wasm_ast.type_field) Hashtbl.t
   ; mutable closure_envs : Var.t Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Var.t IntMap.t
@@ -100,7 +100,7 @@ and state =
 
 and 'a t = state -> 'a * state
 
-type expression = Wa_ast.expression t
+type expression = Wasm_ast.expression t
 
 let ( let* ) (type a b) (e : a t) (f : a -> b t) : b t =
  fun st ->
@@ -130,9 +130,9 @@ let register_constant x e st =
   (), st
 
 type type_def =
-  { supertype : Wa_ast.var option
+  { supertype : Wasm_ast.var option
   ; final : bool
-  ; typ : Wa_ast.str_type
+  ; typ : Wasm_ast.str_type
   }
 
 let register_type nm gen_typ st =
@@ -141,7 +141,7 @@ let register_type nm gen_typ st =
   ( (try Hashtbl.find context.type_names nm
      with Not_found ->
        let name = Var.fresh_n nm in
-       let type_field = { Wa_ast.name; typ; supertype; final } in
+       let type_field = { Wasm_ast.name; typ; supertype; final } in
        context.other_fields <- Type [ type_field ] :: context.other_fields;
        Hashtbl.add context.type_names nm name;
        Hashtbl.add context.types name type_field;
diff --git a/compiler/lib-wasm/wa_code_generation.mli b/compiler/lib-wasm/wa_code_generation.mli
index e505d2a3b2..f03af255a1 100644
--- a/compiler/lib-wasm/wa_code_generation.mli
+++ b/compiler/lib-wasm/wa_code_generation.mli
@@ -21,13 +21,13 @@ open Stdlib
 type constant_global
 
 type context =
-  { constants : (Code.Var.t, Wa_ast.expression) Hashtbl.t
+  { constants : (Code.Var.t, Wasm_ast.expression) Hashtbl.t
   ; mutable data_segments : string Code.Var.Map.t
   ; mutable constant_globals : constant_global Code.Var.Map.t
-  ; mutable other_fields : Wa_ast.module_field list
-  ; mutable imports : (Code.Var.t * Wa_ast.import_desc) StringMap.t StringMap.t
+  ; mutable other_fields : Wasm_ast.module_field list
+  ; mutable imports : (Code.Var.t * Wasm_ast.import_desc) StringMap.t StringMap.t
   ; type_names : (string, Code.Var.t) Hashtbl.t
-  ; types : (Code.Var.t, Wa_ast.type_field) Hashtbl.t
+  ; types : (Code.Var.t, Wasm_ast.type_field) Hashtbl.t
   ; mutable closure_envs : Code.Var.t Code.Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t
@@ -36,31 +36,31 @@ type context =
   ; mutable cps_curry_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable dummy_funs : Code.Var.t Stdlib.IntMap.t
   ; mutable cps_dummy_funs : Code.Var.t Stdlib.IntMap.t
-  ; mutable init_code : Wa_ast.instruction list
+  ; mutable init_code : Wasm_ast.instruction list
   ; mutable string_count : int
   ; mutable strings : string list
   ; mutable string_index : int StringMap.t
   ; mutable fragments : Javascript.expression StringMap.t
   ; mutable globalized_variables : Code.Var.Set.t
-  ; value_type : Wa_ast.value_type
+  ; value_type : Wasm_ast.value_type
   ; mutable unit_name : string option
   }
 
-val make_context : value_type:Wa_ast.value_type -> context
+val make_context : value_type:Wasm_ast.value_type -> context
 
 type 'a t
 
-type expression = Wa_ast.expression t
+type expression = Wasm_ast.expression t
 
 val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
 
 val return : 'a -> 'a t
 
-val instr : Wa_ast.instruction -> unit t
+val instr : Wasm_ast.instruction -> unit t
 
 val seq : unit t -> expression -> expression
 
-val expression_list : ('a -> expression) -> 'a list -> Wa_ast.expression list t
+val expression_list : ('a -> expression) -> 'a list -> Wasm_ast.expression list t
 
 module Arith : sig
   val const : int32 -> expression
@@ -106,38 +106,42 @@ module Arith : sig
   val eqz : expression -> expression
 end
 
-val cast : ?nullable:bool -> Wa_ast.heap_type -> expression -> expression
+val cast : ?nullable:bool -> Wasm_ast.heap_type -> expression -> expression
 
-val load : Wa_ast.var -> expression
+val load : Wasm_ast.var -> expression
 
-val tee : ?typ:Wa_ast.value_type -> Wa_ast.var -> expression -> expression
+val tee : ?typ:Wasm_ast.value_type -> Wasm_ast.var -> expression -> expression
 
-val store : ?always:bool -> ?typ:Wa_ast.value_type -> Wa_ast.var -> expression -> unit t
+val store :
+  ?always:bool -> ?typ:Wasm_ast.value_type -> Wasm_ast.var -> expression -> unit t
 
-val assign : Wa_ast.var -> expression -> unit t
+val assign : Wasm_ast.var -> expression -> unit t
 
 val drop : expression -> unit t
 
 val push : expression -> unit t
 
-val loop : Wa_ast.func_type -> unit t -> unit t
+val loop : Wasm_ast.func_type -> unit t -> unit t
 
-val block : Wa_ast.func_type -> unit t -> unit t
+val block : Wasm_ast.func_type -> unit t -> unit t
 
-val block_expr : Wa_ast.func_type -> unit t -> expression
+val block_expr : Wasm_ast.func_type -> unit t -> expression
 
-val if_ : Wa_ast.func_type -> expression -> unit t -> unit t -> unit t
+val if_ : Wasm_ast.func_type -> expression -> unit t -> unit t -> unit t
 
 val try_expr :
-  Wa_ast.func_type -> unit t -> (Code.Var.t * int * Wa_ast.value_type) list -> expression
+     Wasm_ast.func_type
+  -> unit t
+  -> (Code.Var.t * int * Wasm_ast.value_type) list
+  -> expression
 
-val add_var : ?typ:Wa_ast.value_type -> Wa_ast.var -> Wa_ast.var t
+val add_var : ?typ:Wasm_ast.value_type -> Wasm_ast.var -> Wasm_ast.var t
 
-val define_var : Wa_ast.var -> expression -> unit t
+val define_var : Wasm_ast.var -> expression -> unit t
 
-val is_small_constant : Wa_ast.expression -> bool t
+val is_small_constant : Wasm_ast.expression -> bool t
 
-val get_i31_value : Wa_ast.var -> Wa_ast.var option t
+val get_i31_value : Wasm_ast.var -> Wasm_ast.var option t
 
 val event : Parse_info.t -> unit t
 
@@ -146,27 +150,27 @@ val no_event : unit t
 val hidden_location : Parse_info.t
 
 type type_def =
-  { supertype : Wa_ast.var option
+  { supertype : Wasm_ast.var option
   ; final : bool
-  ; typ : Wa_ast.str_type
+  ; typ : Wasm_ast.str_type
   }
 
-val register_type : string -> (unit -> type_def t) -> Wa_ast.var t
+val register_type : string -> (unit -> type_def t) -> Wasm_ast.var t
 
-val heap_type_sub : Wa_ast.heap_type -> Wa_ast.heap_type -> bool t
+val heap_type_sub : Wasm_ast.heap_type -> Wasm_ast.heap_type -> bool t
 
 val register_import :
-  ?import_module:string -> name:string -> Wa_ast.import_desc -> Wa_ast.var t
+  ?import_module:string -> name:string -> Wasm_ast.import_desc -> Wasm_ast.var t
 
 val register_global :
-     Wa_ast.var
+     Wasm_ast.var
   -> ?exported_name:string
   -> ?constant:bool
-  -> Wa_ast.global_type
-  -> Wa_ast.expression
+  -> Wasm_ast.global_type
+  -> Wasm_ast.expression
   -> unit t
 
-val get_global : Code.Var.t -> Wa_ast.expression option t
+val get_global : Code.Var.t -> Wasm_ast.expression option t
 
 val register_data_segment : Code.Var.t -> string -> unit t
 
@@ -198,4 +202,4 @@ val function_body :
      context:context
   -> param_names:Code.Var.t list
   -> body:unit t
-  -> (Wa_ast.var * Wa_ast.value_type) list * Wa_ast.instruction list
+  -> (Wasm_ast.var * Wasm_ast.value_type) list * Wasm_ast.instruction list
diff --git a/compiler/lib-wasm/wa_curry.ml b/compiler/lib-wasm/wa_curry.ml
index 8df798110d..191fdd029a 100644
--- a/compiler/lib-wasm/wa_curry.ml
+++ b/compiler/lib-wasm/wa_curry.ml
@@ -18,7 +18,7 @@
 
 open! Stdlib
 open Code
-module W = Wa_ast
+module W = Wasm_ast
 open Wa_code_generation
 
 module Make (Target : Wa_target_sig.S) = struct
diff --git a/compiler/lib-wasm/wa_gc_target.ml b/compiler/lib-wasm/wa_gc_target.ml
index a6f138110a..2c09eb432c 100644
--- a/compiler/lib-wasm/wa_gc_target.ml
+++ b/compiler/lib-wasm/wa_gc_target.ml
@@ -17,10 +17,10 @@
  *)
 
 open! Stdlib
-module W = Wa_ast
+module W = Wasm_ast
 open Wa_code_generation
 
-type expression = Wa_ast.expression Wa_code_generation.t
+type expression = Wasm_ast.expression Wa_code_generation.t
 
 let include_closure_arity = false
 
diff --git a/compiler/lib-wasm/wa_generate.ml b/compiler/lib-wasm/wa_generate.ml
index 6e8b8643de..445cf06326 100644
--- a/compiler/lib-wasm/wa_generate.ml
+++ b/compiler/lib-wasm/wa_generate.ml
@@ -18,7 +18,7 @@
 
 open! Stdlib
 open Code
-module W = Wa_ast
+module W = Wasm_ast
 open Wa_code_generation
 
 module Generate (Target : Wa_target_sig.S) = struct
diff --git a/compiler/lib-wasm/wa_generate.mli b/compiler/lib-wasm/wa_generate.mli
index 07125b139f..28aa7e09ff 100644
--- a/compiler/lib-wasm/wa_generate.mli
+++ b/compiler/lib-wasm/wa_generate.mli
@@ -28,9 +28,9 @@ val f :
   -> in_cps:Effects.in_cps
   -> deadcode_sentinal:Code.Var.t
   -> debug:Parse_bytecode.Debug.t
-  -> Wa_ast.var * (string list * (string * Javascript.expression) list)
+  -> Wasm_ast.var * (string list * (string * Javascript.expression) list)
 
-val add_start_function : context:Wa_code_generation.context -> Wa_ast.var -> unit
+val add_start_function : context:Wa_code_generation.context -> Wasm_ast.var -> unit
 
 val add_init_function : context:Wa_code_generation.context -> to_link:string list -> unit
 
diff --git a/compiler/lib-wasm/wa_initialize_locals.ml b/compiler/lib-wasm/wa_initialize_locals.ml
index 5e20732def..5e15235725 100644
--- a/compiler/lib-wasm/wa_initialize_locals.ml
+++ b/compiler/lib-wasm/wa_initialize_locals.ml
@@ -33,7 +33,7 @@ let check_initialized ctx i =
 
 let rec scan_expression ctx e =
   match e with
-  | Wa_ast.Const _ | GlobalGet _ | Pop _ | RefFunc _ | RefNull _ -> ()
+  | Wasm_ast.Const _ | GlobalGet _ | Pop _ | RefFunc _ | RefNull _ -> ()
   | UnOp (_, e')
   | I32WrapI64 e'
   | I64ExtendI32 (_, e')
@@ -74,7 +74,7 @@ and scan_expressions ctx l = List.iter ~f:(fun e -> scan_expression ctx e) l
 
 and scan_instruction ctx i =
   match i with
-  | Wa_ast.Drop e
+  | Wasm_ast.Drop e
   | GlobalSet (_, e)
   | Br (_, Some e)
   | Br_if (_, e)
@@ -114,12 +114,12 @@ let f ~param_names ~locals instrs =
   List.iter ~f:(fun x -> mark_initialized ctx x) param_names;
   List.iter
     ~f:(fun (var, typ) ->
-      match (typ : Wa_ast.value_type) with
+      match (typ : Wasm_ast.value_type) with
       | I32 | I64 | F32 | F64 | Ref { nullable = true; _ } -> mark_initialized ctx var
       | Ref { nullable = false; _ } -> ())
     locals;
   scan_instructions ctx instrs;
   List.map
-    ~f:(fun i -> Wa_ast.LocalSet (i, RefI31 (Const (I32 0l))))
+    ~f:(fun i -> Wasm_ast.LocalSet (i, RefI31 (Const (I32 0l))))
     (Code.Var.Set.elements !(ctx.uninitialized))
   @ instrs
diff --git a/compiler/lib-wasm/wa_initialize_locals.mli b/compiler/lib-wasm/wa_initialize_locals.mli
index 3d464e4dfc..d43869795d 100644
--- a/compiler/lib-wasm/wa_initialize_locals.mli
+++ b/compiler/lib-wasm/wa_initialize_locals.mli
@@ -17,7 +17,7 @@
  *)
 
 val f :
-     param_names:Wa_ast.var list
-  -> locals:(Wa_ast.var * Wa_ast.value_type) list
-  -> Wa_ast.instruction list
-  -> Wa_ast.instruction list
+     param_names:Wasm_ast.var list
+  -> locals:(Wasm_ast.var * Wasm_ast.value_type) list
+  -> Wasm_ast.instruction list
+  -> Wasm_ast.instruction list
diff --git a/compiler/lib-wasm/wa_tail_call.ml b/compiler/lib-wasm/wa_tail_call.ml
index 1557f4bee2..dfaadad9da 100644
--- a/compiler/lib-wasm/wa_tail_call.ml
+++ b/compiler/lib-wasm/wa_tail_call.ml
@@ -20,21 +20,21 @@ open! Stdlib
 
 let get_return ~tail i =
   match i with
-  | Wa_ast.Return (Some (LocalGet y)) -> Some y
+  | Wasm_ast.Return (Some (LocalGet y)) -> Some y
   | Push (LocalGet y) when tail -> Some y
   | _ -> None
 
 let rewrite_tail_call ~y i =
   match i with
-  | Wa_ast.LocalSet (x, Call (symb, l)) when Code.Var.equal x y ->
-      Some (Wa_ast.Return_call (symb, l))
+  | Wasm_ast.LocalSet (x, Call (symb, l)) when Code.Var.equal x y ->
+      Some (Wasm_ast.Return_call (symb, l))
   | LocalSet (x, Call_ref (ty, e, l)) when Code.Var.equal x y ->
       Some (Return_call_ref (ty, e, l))
   | _ -> None
 
 let rec instruction ~tail i =
   match i with
-  | Wa_ast.Loop (ty, l) -> Wa_ast.Loop (ty, instructions ~tail l)
+  | Wasm_ast.Loop (ty, l) -> Wasm_ast.Loop (ty, instructions ~tail l)
   | Block (ty, l) -> Block (ty, instructions ~tail l)
   | If (ty, e, l1, l2) -> If (ty, e, instructions ~tail l1, instructions ~tail l2)
   | Return (Some (Call (symb, l))) -> Return_call (symb, l)
diff --git a/compiler/lib-wasm/wa_tail_call.mli b/compiler/lib-wasm/wa_tail_call.mli
index 61143cb283..2bcf526ae2 100644
--- a/compiler/lib-wasm/wa_tail_call.mli
+++ b/compiler/lib-wasm/wa_tail_call.mli
@@ -16,4 +16,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : Wa_ast.instruction list -> Wa_ast.instruction list
+val f : Wasm_ast.instruction list -> Wasm_ast.instruction list
diff --git a/compiler/lib-wasm/wa_target_sig.ml b/compiler/lib-wasm/wa_target_sig.ml
index 02b89e80a1..8be3509211 100644
--- a/compiler/lib-wasm/wa_target_sig.ml
+++ b/compiler/lib-wasm/wa_target_sig.ml
@@ -23,7 +23,7 @@ module type S = sig
     val allocate :
          tag:int
       -> deadcode_sentinal:Code.Var.t
-      -> [ `Expr of Wa_ast.expression | `Var of Wa_ast.var ] list
+      -> [ `Expr of Wasm_ast.expression | `Var of Wasm_ast.var ] list
       -> expression
 
     val load_function_pointer :
@@ -31,19 +31,19 @@ module type S = sig
       -> arity:int
       -> ?skip_cast:bool
       -> expression
-      -> (Wa_ast.var * Wa_ast.expression) Wa_code_generation.t
+      -> (Wasm_ast.var * Wasm_ast.expression) Wa_code_generation.t
 
     val load_real_closure :
          cps:bool
       -> arity:int
       -> expression
-      -> (Wa_ast.var * Wa_ast.expression) Wa_code_generation.t
+      -> (Wasm_ast.var * Wasm_ast.expression) Wa_code_generation.t
 
     val check_function_arity :
          Code.Var.t
       -> cps:bool
       -> arity:int
-      -> (typ:Wa_ast.value_type option -> expression -> expression)
+      -> (typ:Wasm_ast.value_type option -> expression -> expression)
       -> unit Wa_code_generation.t
       -> unit Wa_code_generation.t
 
@@ -97,7 +97,7 @@ module type S = sig
   end
 
   module Value : sig
-    val value : Wa_ast.value_type
+    val value : Wasm_ast.value_type
 
     val unit : expression
 
@@ -149,7 +149,7 @@ module type S = sig
 
     val int_asr : expression -> expression -> expression
 
-    val block_type : Wa_ast.value_type Wa_code_generation.t
+    val block_type : Wasm_ast.value_type Wa_code_generation.t
 
     val dummy_block : expression
 
@@ -182,16 +182,16 @@ module type S = sig
       -> f:Code.Var.t
       -> closure:Code.Var.t
       -> arg:Code.Var.t
-      -> Wa_ast.expression Wa_code_generation.t
+      -> Wasm_ast.expression Wa_code_generation.t
 
     val curry_load :
          cps:bool
       -> arity:int
       -> int
       -> Code.Var.t
-      -> (expression * expression * Wa_ast.value_type option) Wa_code_generation.t
+      -> (expression * expression * Wasm_ast.value_type option) Wa_code_generation.t
 
-    val dummy : cps:bool -> arity:int -> Wa_ast.expression Wa_code_generation.t
+    val dummy : cps:bool -> arity:int -> Wasm_ast.expression Wa_code_generation.t
   end
 
   module Math : sig
@@ -250,27 +250,27 @@ module type S = sig
     (string, (Code.prim_arg -> expression) -> Code.prim_arg list -> expression) Hashtbl.t
 
   val handle_exceptions :
-       result_typ:Wa_ast.value_type list
+       result_typ:Wasm_ast.value_type list
     -> fall_through:'a
     -> context:([> `Catch | `Skip ] as 'b) list
-    -> (   result_typ:Wa_ast.value_type list
+    -> (   result_typ:Wasm_ast.value_type list
         -> fall_through:[> `Skip ]
         -> context:'b list
         -> unit Wa_code_generation.t)
-    -> Wa_ast.var
-    -> (   result_typ:Wa_ast.value_type list
+    -> Wasm_ast.var
+    -> (   result_typ:Wasm_ast.value_type list
         -> fall_through:'a
         -> context:'b list
         -> unit Wa_code_generation.t)
     -> unit Wa_code_generation.t
 
   val post_process_function_body :
-       param_names:Wa_ast.var list
-    -> locals:(Wa_ast.var * Wa_ast.value_type) list
-    -> Wa_ast.instruction list
-    -> Wa_ast.instruction list
+       param_names:Wasm_ast.var list
+    -> locals:(Wasm_ast.var * Wasm_ast.value_type) list
+    -> Wasm_ast.instruction list
+    -> Wasm_ast.instruction list
 
   val entry_point :
-       toplevel_fun:Wa_ast.var
-    -> Wa_ast.func_type * Wa_ast.var list * unit Wa_code_generation.t
+       toplevel_fun:Wasm_ast.var
+    -> Wasm_ast.func_type * Wasm_ast.var list * unit Wa_code_generation.t
 end
diff --git a/compiler/lib-wasm/wa_wasm_output.ml b/compiler/lib-wasm/wa_wasm_output.ml
index a9980a2456..542499721a 100644
--- a/compiler/lib-wasm/wa_wasm_output.ml
+++ b/compiler/lib-wasm/wa_wasm_output.ml
@@ -1,5 +1,5 @@
 open! Stdlib
-open Wa_ast
+open Wasm_ast
 
 module Feature : sig
   type set
diff --git a/compiler/lib-wasm/wa_wasm_output.mli b/compiler/lib-wasm/wa_wasm_output.mli
index 59f2b93d9a..80de3da658 100644
--- a/compiler/lib-wasm/wa_wasm_output.mli
+++ b/compiler/lib-wasm/wa_wasm_output.mli
@@ -1 +1 @@
-val f : out_channel -> Wa_ast.module_field list -> unit
+val f : out_channel -> Wasm_ast.module_field list -> unit
diff --git a/compiler/lib-wasm/wa_wat_output.ml b/compiler/lib-wasm/wa_wat_output.ml
index e921d23ec2..9959974892 100644
--- a/compiler/lib-wasm/wa_wat_output.ml
+++ b/compiler/lib-wasm/wa_wat_output.ml
@@ -17,7 +17,7 @@
  *)
 
 open! Stdlib
-open Wa_ast
+open Wasm_ast
 
 let assign_names ?(reversed = true) f names =
   let used = ref StringSet.empty in
@@ -221,7 +221,7 @@ let type_prefix op nm =
   | F64 _ -> "f64.")
   ^ nm
 
-let signage op (s : Wa_ast.signage) =
+let signage op (s : Wasm_ast.signage) =
   op
   ^
   match s with
@@ -453,8 +453,8 @@ let expression_or_instructions ctx st in_function =
                           (Atom "catch"
                           :: index st.tag_names tag
                           :: (instruction
-                                (Wa_ast.Event Wa_code_generation.hidden_location)
-                             @ instruction (Wa_ast.Br (i + 1, Some (Pop ty))))))
+                                (Wasm_ast.Event Wa_code_generation.hidden_location)
+                             @ instruction (Wasm_ast.Br (i + 1, Some (Pop ty))))))
                       catches))
         ]
   and instruction i =
diff --git a/compiler/lib-wasm/wa_wat_output.mli b/compiler/lib-wasm/wa_wat_output.mli
index 3a2fc50a10..9e01eb96a6 100644
--- a/compiler/lib-wasm/wa_wat_output.mli
+++ b/compiler/lib-wasm/wa_wat_output.mli
@@ -16,4 +16,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : out_channel -> Wa_ast.module_field list -> unit
+val f : out_channel -> Wasm_ast.module_field list -> unit
diff --git a/compiler/lib-wasm/wa_ast.ml b/compiler/lib-wasm/wasm_ast.ml
similarity index 100%
rename from compiler/lib-wasm/wa_ast.ml
rename to compiler/lib-wasm/wasm_ast.ml

From 40f4d4e4034d8fd21e28d74e5ff127dcd3fec37d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 14:59:53 +0100
Subject: [PATCH 434/481] Renamed more files

---
 compiler/bin-wasm_of_ocaml/compile.ml          | 18 +++++++++---------
 .../lib-wasm/{wa_binaryen.ml => binaryen.ml}   |  0
 .../lib-wasm/{wa_binaryen.mli => binaryen.mli} |  0
 ...ure_conversion.ml => closure_conversion.ml} |  0
 ...e_conversion.mli => closure_conversion.mli} |  0
 compiler/lib-wasm/{wa_curry.ml => curry.ml}    |  0
 compiler/lib-wasm/{wa_curry.mli => curry.mli}  |  0
 ...itialize_locals.ml => initialize_locals.ml} |  0
 ...ialize_locals.mli => initialize_locals.mli} |  0
 .../lib-wasm/{wa_tail_call.ml => tail_call.ml} |  0
 .../{wa_tail_call.mli => tail_call.mli}        |  0
 compiler/lib-wasm/wa_code_generation.ml        |  2 +-
 compiler/lib-wasm/wa_gc_target.ml              |  8 ++++----
 compiler/lib-wasm/wa_generate.ml               | 10 +++++-----
 compiler/lib-wasm/wa_globalize.ml              |  4 ++--
 compiler/lib-wasm/wa_globalize.mli             |  2 +-
 compiler/lib-wasm/wa_link.ml                   |  4 ++--
 compiler/lib-wasm/wa_target_sig.ml             |  4 ++--
 .../lib-wasm/{wa_wasm_link.ml => wasm_link.ml} |  0
 .../{wa_wasm_link.mli => wasm_link.mli}        |  0
 .../{wa_wasm_output.ml => wasm_output.ml}      |  0
 .../{wa_wasm_output.mli => wasm_output.mli}    |  0
 .../{wa_wat_output.ml => wat_output.ml}        |  0
 .../{wa_wat_output.mli => wat_output.mli}      |  0
 24 files changed, 26 insertions(+), 26 deletions(-)
 rename compiler/lib-wasm/{wa_binaryen.ml => binaryen.ml} (100%)
 rename compiler/lib-wasm/{wa_binaryen.mli => binaryen.mli} (100%)
 rename compiler/lib-wasm/{wa_closure_conversion.ml => closure_conversion.ml} (100%)
 rename compiler/lib-wasm/{wa_closure_conversion.mli => closure_conversion.mli} (100%)
 rename compiler/lib-wasm/{wa_curry.ml => curry.ml} (100%)
 rename compiler/lib-wasm/{wa_curry.mli => curry.mli} (100%)
 rename compiler/lib-wasm/{wa_initialize_locals.ml => initialize_locals.ml} (100%)
 rename compiler/lib-wasm/{wa_initialize_locals.mli => initialize_locals.mli} (100%)
 rename compiler/lib-wasm/{wa_tail_call.ml => tail_call.ml} (100%)
 rename compiler/lib-wasm/{wa_tail_call.mli => tail_call.mli} (100%)
 rename compiler/lib-wasm/{wa_wasm_link.ml => wasm_link.ml} (100%)
 rename compiler/lib-wasm/{wa_wasm_link.mli => wasm_link.mli} (100%)
 rename compiler/lib-wasm/{wa_wasm_output.ml => wasm_output.ml} (100%)
 rename compiler/lib-wasm/{wa_wasm_output.mli => wasm_output.mli} (100%)
 rename compiler/lib-wasm/{wa_wat_output.ml => wat_output.ml} (100%)
 rename compiler/lib-wasm/{wa_wat_output.mli => wat_output.mli} (100%)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 80a03443f6..41e9ad1816 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -100,7 +100,7 @@ let link_and_optimize
      then Some (Filename.temp_file "wasm-merged" ".wasm.map")
      else None)
   @@ fun opt_temp_sourcemap ->
-  Wa_binaryen.link
+  Binaryen.link
     ~runtime_files:(runtime_file :: runtime_wasm_files)
     ~input_files:wat_files
     ~opt_output_sourcemap:opt_temp_sourcemap
@@ -112,14 +112,14 @@ let link_and_optimize
     (if enable_source_maps then Some (Filename.temp_file "wasm-dce" ".wasm.map") else None)
   @@ fun opt_temp_sourcemap' ->
   let primitives =
-    Wa_binaryen.dead_code_elimination
+    Binaryen.dead_code_elimination
       ~dependencies:Wa_runtime.dependencies
       ~opt_input_sourcemap:opt_temp_sourcemap
       ~opt_output_sourcemap:opt_temp_sourcemap'
       ~input_file:temp_file
       ~output_file:temp_file'
   in
-  Wa_binaryen.optimize
+  Binaryen.optimize
     ~profile
     ~opt_input_sourcemap:opt_temp_sourcemap'
     ~opt_output_sourcemap:opt_sourcemap
@@ -136,12 +136,12 @@ let link_runtime ~profile runtime_wasm_files output_file =
   Fs.write_file ~name:runtime_file ~contents:Wa_runtime.wasm_runtime;
   Fs.with_intermediate_file (Filename.temp_file "wasm-merged" ".wasm")
   @@ fun temp_file ->
-  Wa_binaryen.link
+  Binaryen.link
     ~opt_output_sourcemap:None
     ~runtime_files:(runtime_file :: runtime_wasm_files)
     ~input_files:[]
     ~output_file:temp_file;
-  Wa_binaryen.optimize
+  Binaryen.optimize
     ~profile
     ~opt_input_sourcemap:None
     ~opt_output_sourcemap:None
@@ -181,7 +181,7 @@ let build_prelude z =
   Fs.with_intermediate_file (Filename.temp_file "prelude_file" ".wasm")
   @@ fun tmp_prelude_file ->
   let predefined_exceptions = generate_prelude ~out_file:prelude_file in
-  Wa_binaryen.optimize
+  Binaryen.optimize
     ~profile:(Driver.profile 1)
     ~input_file:prelude_file
     ~output_file:tmp_prelude_file
@@ -399,7 +399,7 @@ let run
          let strings, fragments =
            output_gen wat_file (output code ~unit_name:(Some unit_name))
          in
-         Wa_binaryen.optimize
+         Binaryen.optimize
            ~profile
            ~opt_input_sourcemap:None
            ~opt_output_sourcemap:opt_tmp_map_file
@@ -515,10 +515,10 @@ let run
                   else None)
                @@ fun opt_output_sourcemap_file ->
                let l = List.rev l in
-               Wa_wasm_link.f
+               Wasm_link.f
                  (List.map
                     ~f:(fun (_, _, file, opt_source_map) ->
-                      { Wa_wasm_link.module_name = "OCaml"
+                      { Wasm_link.module_name = "OCaml"
                       ; file
                       ; code = None
                       ; opt_source_map = Option.map ~f:(fun f -> `File f) opt_source_map
diff --git a/compiler/lib-wasm/wa_binaryen.ml b/compiler/lib-wasm/binaryen.ml
similarity index 100%
rename from compiler/lib-wasm/wa_binaryen.ml
rename to compiler/lib-wasm/binaryen.ml
diff --git a/compiler/lib-wasm/wa_binaryen.mli b/compiler/lib-wasm/binaryen.mli
similarity index 100%
rename from compiler/lib-wasm/wa_binaryen.mli
rename to compiler/lib-wasm/binaryen.mli
diff --git a/compiler/lib-wasm/wa_closure_conversion.ml b/compiler/lib-wasm/closure_conversion.ml
similarity index 100%
rename from compiler/lib-wasm/wa_closure_conversion.ml
rename to compiler/lib-wasm/closure_conversion.ml
diff --git a/compiler/lib-wasm/wa_closure_conversion.mli b/compiler/lib-wasm/closure_conversion.mli
similarity index 100%
rename from compiler/lib-wasm/wa_closure_conversion.mli
rename to compiler/lib-wasm/closure_conversion.mli
diff --git a/compiler/lib-wasm/wa_curry.ml b/compiler/lib-wasm/curry.ml
similarity index 100%
rename from compiler/lib-wasm/wa_curry.ml
rename to compiler/lib-wasm/curry.ml
diff --git a/compiler/lib-wasm/wa_curry.mli b/compiler/lib-wasm/curry.mli
similarity index 100%
rename from compiler/lib-wasm/wa_curry.mli
rename to compiler/lib-wasm/curry.mli
diff --git a/compiler/lib-wasm/wa_initialize_locals.ml b/compiler/lib-wasm/initialize_locals.ml
similarity index 100%
rename from compiler/lib-wasm/wa_initialize_locals.ml
rename to compiler/lib-wasm/initialize_locals.ml
diff --git a/compiler/lib-wasm/wa_initialize_locals.mli b/compiler/lib-wasm/initialize_locals.mli
similarity index 100%
rename from compiler/lib-wasm/wa_initialize_locals.mli
rename to compiler/lib-wasm/initialize_locals.mli
diff --git a/compiler/lib-wasm/wa_tail_call.ml b/compiler/lib-wasm/tail_call.ml
similarity index 100%
rename from compiler/lib-wasm/wa_tail_call.ml
rename to compiler/lib-wasm/tail_call.ml
diff --git a/compiler/lib-wasm/wa_tail_call.mli b/compiler/lib-wasm/tail_call.mli
similarity index 100%
rename from compiler/lib-wasm/wa_tail_call.mli
rename to compiler/lib-wasm/tail_call.mli
diff --git a/compiler/lib-wasm/wa_code_generation.ml b/compiler/lib-wasm/wa_code_generation.ml
index aac5047546..eed927a073 100644
--- a/compiler/lib-wasm/wa_code_generation.ml
+++ b/compiler/lib-wasm/wa_code_generation.ml
@@ -645,7 +645,7 @@ let function_body ~context ~param_names ~body =
       | Local (i, x, typ) -> local_types.(i) <- x, typ
       | Expr _ -> ())
     st.vars;
-  let body = Wa_tail_call.f body in
+  let body = Tail_call.f body in
   let param_count = List.length param_names in
   let locals =
     local_types
diff --git a/compiler/lib-wasm/wa_gc_target.ml b/compiler/lib-wasm/wa_gc_target.ml
index 2c09eb432c..9d2395b6b4 100644
--- a/compiler/lib-wasm/wa_gc_target.ml
+++ b/compiler/lib-wasm/wa_gc_target.ml
@@ -1059,7 +1059,7 @@ module Closure = struct
   let get_free_variables ~context info =
     List.filter
       ~f:(fun x -> not (Hashtbl.mem context.constants x))
-      info.Wa_closure_conversion.free_variables
+      info.Closure_conversion.free_variables
 
   let rec is_last_fun l f =
     match l with
@@ -1101,7 +1101,7 @@ module Closure = struct
       return (W.GlobalGet name)
     else
       let free_variable_count = List.length free_variables in
-      match info.Wa_closure_conversion.functions with
+      match info.Closure_conversion.functions with
       | [] -> assert false
       | [ _ ] ->
           let* typ = Type.env_type ~cps ~arity free_variable_count in
@@ -1193,7 +1193,7 @@ module Closure = struct
       let arity = List.assoc f info.functions in
       let arity = if cps then arity - 1 else arity in
       let offset = Memory.env_start arity in
-      match info.Wa_closure_conversion.functions with
+      match info.Closure_conversion.functions with
       | [ _ ] ->
           let* typ = Type.env_type ~cps ~arity free_variable_count in
           let* _ = add_var f in
@@ -1700,7 +1700,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
      let* () = no_event in
      exn_handler ~result_typ ~fall_through ~context)
 
-let post_process_function_body = Wa_initialize_locals.f
+let post_process_function_body = Initialize_locals.f
 
 let entry_point ~toplevel_fun =
   let suspender = Code.Var.fresh () in
diff --git a/compiler/lib-wasm/wa_generate.ml b/compiler/lib-wasm/wa_generate.ml
index 445cf06326..8037aa1f6b 100644
--- a/compiler/lib-wasm/wa_generate.ml
+++ b/compiler/lib-wasm/wa_generate.ml
@@ -34,7 +34,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     ; in_cps : Effects.in_cps
     ; deadcode_sentinal : Var.t
     ; blocks : block Addr.Map.t
-    ; closures : Wa_closure_conversion.closure Var.Map.t
+    ; closures : Closure_conversion.closure Var.Map.t
     ; global_context : Wa_code_generation.context
     ; debug : Parse_bytecode.Debug.t
     }
@@ -1083,7 +1083,7 @@ module Generate (Target : Wa_target_sig.S) = struct
       ; body
       }
 
-  module Curry = Wa_curry.Make (Target)
+  module Curry = Curry.Make (Target)
 
   let add_start_function ~context toplevel_name =
     context.other_fields <-
@@ -1104,7 +1104,7 @@ module Generate (Target : Wa_target_sig.S) = struct
       ~deadcode_sentinal
       ~debug =
     global_context.unit_name <- unit_name;
-    let p, closures = Wa_closure_conversion.f p in
+    let p, closures = Closure_conversion.f p in
     (*
   Code.Print.program (fun _ _ -> "") p;
 *)
@@ -1232,9 +1232,9 @@ let add_init_function =
 let output ch ~context =
   let module G = Generate (Wa_gc_target) in
   let fields = G.output ~context in
-  Wa_wat_output.f ch fields
+  Wat_output.f ch fields
 
 let wasm_output ch ~context =
   let module G = Generate (Wa_gc_target) in
   let fields = G.output ~context in
-  Wa_wasm_output.f ch fields
+  Wasm_output.f ch fields
diff --git a/compiler/lib-wasm/wa_globalize.ml b/compiler/lib-wasm/wa_globalize.ml
index 683cc5214d..c4bd6c8ca6 100644
--- a/compiler/lib-wasm/wa_globalize.ml
+++ b/compiler/lib-wasm/wa_globalize.ml
@@ -36,7 +36,7 @@ type st =
   { pos : int
   ; visited_variables : int Code.Var.Map.t
   ; globals : Code.Var.Set.t
-  ; closures : Wa_closure_conversion.closure Code.Var.Map.t
+  ; closures : Closure_conversion.closure Code.Var.Map.t
   }
 
 let threshold = 1000
@@ -79,7 +79,7 @@ let traverse_expression x e st =
       List.fold_left
         ~f:(fun st x -> use x st)
         ~init:st
-        (Code.Var.Map.find x st.closures).Wa_closure_conversion.free_variables
+        (Code.Var.Map.find x st.closures).Closure_conversion.free_variables
   | Constant _ | Special _ -> st
   | Prim (_, args) ->
       List.fold_left
diff --git a/compiler/lib-wasm/wa_globalize.mli b/compiler/lib-wasm/wa_globalize.mli
index efbc79aa77..e62874ed0b 100644
--- a/compiler/lib-wasm/wa_globalize.mli
+++ b/compiler/lib-wasm/wa_globalize.mli
@@ -19,5 +19,5 @@
 val f :
      Code.program
   -> Structure.t
-  -> Wa_closure_conversion.closure Code.Var.Map.t
+  -> Closure_conversion.closure Code.Var.Map.t
   -> Code.Var.Set.t
diff --git a/compiler/lib-wasm/wa_link.ml b/compiler/lib-wasm/wa_link.ml
index b5ed051305..9367f29364 100644
--- a/compiler/lib-wasm/wa_link.ml
+++ b/compiler/lib-wasm/wa_link.ml
@@ -945,11 +945,11 @@ let make_library ~output_file ~enable_source_maps ~files =
     Fs.with_intermediate_file
     (if enable_source_maps then Some (Filename.temp_file "wasm" ".map") else None)
   @@ fun opt_output_sourcemap_file ->
-  Wa_wasm_link.f
+  Wasm_link.f
     (List.map
        ~f:(fun file ->
          let z' = Zip.open_in file in
-         { Wa_wasm_link.module_name = "OCaml"
+         { Wasm_link.module_name = "OCaml"
          ; file
          ; code = Some (Zip.read_entry z' ~name:"code.wasm")
          ; opt_source_map =
diff --git a/compiler/lib-wasm/wa_target_sig.ml b/compiler/lib-wasm/wa_target_sig.ml
index 8be3509211..09ee3c57fb 100644
--- a/compiler/lib-wasm/wa_target_sig.ml
+++ b/compiler/lib-wasm/wa_target_sig.ml
@@ -163,14 +163,14 @@ module type S = sig
   module Closure : sig
     val translate :
          context:Wa_code_generation.context
-      -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+      -> closures:Closure_conversion.closure Code.Var.Map.t
       -> cps:bool
       -> Code.Var.t
       -> expression
 
     val bind_environment :
          context:Wa_code_generation.context
-      -> closures:Wa_closure_conversion.closure Code.Var.Map.t
+      -> closures:Closure_conversion.closure Code.Var.Map.t
       -> cps:bool
       -> Code.Var.t
       -> unit Wa_code_generation.t
diff --git a/compiler/lib-wasm/wa_wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
similarity index 100%
rename from compiler/lib-wasm/wa_wasm_link.ml
rename to compiler/lib-wasm/wasm_link.ml
diff --git a/compiler/lib-wasm/wa_wasm_link.mli b/compiler/lib-wasm/wasm_link.mli
similarity index 100%
rename from compiler/lib-wasm/wa_wasm_link.mli
rename to compiler/lib-wasm/wasm_link.mli
diff --git a/compiler/lib-wasm/wa_wasm_output.ml b/compiler/lib-wasm/wasm_output.ml
similarity index 100%
rename from compiler/lib-wasm/wa_wasm_output.ml
rename to compiler/lib-wasm/wasm_output.ml
diff --git a/compiler/lib-wasm/wa_wasm_output.mli b/compiler/lib-wasm/wasm_output.mli
similarity index 100%
rename from compiler/lib-wasm/wa_wasm_output.mli
rename to compiler/lib-wasm/wasm_output.mli
diff --git a/compiler/lib-wasm/wa_wat_output.ml b/compiler/lib-wasm/wat_output.ml
similarity index 100%
rename from compiler/lib-wasm/wa_wat_output.ml
rename to compiler/lib-wasm/wat_output.ml
diff --git a/compiler/lib-wasm/wa_wat_output.mli b/compiler/lib-wasm/wat_output.mli
similarity index 100%
rename from compiler/lib-wasm/wa_wat_output.mli
rename to compiler/lib-wasm/wat_output.mli

From f51c956d4294c55b45a05fa6520cb5cdc9e2ade3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 15:04:46 +0100
Subject: [PATCH 435/481] Renamed more files

---
 compiler/bin-wasm_of_ocaml/compile.ml         | 38 ++++++++--------
 compiler/bin-wasm_of_ocaml/link.ml            |  2 +-
 ..._code_generation.ml => code_generation.ml} |  2 +-
 ...ode_generation.mli => code_generation.mli} |  0
 compiler/lib-wasm/curry.ml                    |  2 +-
 compiler/lib-wasm/curry.mli                   |  2 +-
 .../{wa_globalize.ml => globalize.ml}         |  0
 .../{wa_globalize.mli => globalize.mli}       |  0
 compiler/lib-wasm/{wa_link.ml => link.ml}     |  8 ++--
 compiler/lib-wasm/{wa_link.mli => link.mli}   |  0
 compiler/lib-wasm/wa_gc_target.ml             |  4 +-
 compiler/lib-wasm/wa_generate.ml              |  6 +--
 compiler/lib-wasm/wa_generate.mli             | 12 ++---
 compiler/lib-wasm/wa_target_sig.ml            | 44 +++++++++----------
 compiler/lib-wasm/wasm_link.ml                |  9 ++--
 .../{wa_source_map.ml => wasm_source_map.ml}  |  0
 ...{wa_source_map.mli => wasm_source_map.mli} |  0
 compiler/lib-wasm/wat_output.ml               |  3 +-
 18 files changed, 65 insertions(+), 67 deletions(-)
 rename compiler/lib-wasm/{wa_code_generation.ml => code_generation.ml} (99%)
 rename compiler/lib-wasm/{wa_code_generation.mli => code_generation.mli} (100%)
 rename compiler/lib-wasm/{wa_globalize.ml => globalize.ml} (100%)
 rename compiler/lib-wasm/{wa_globalize.mli => globalize.mli} (100%)
 rename compiler/lib-wasm/{wa_link.ml => link.ml} (99%)
 rename compiler/lib-wasm/{wa_link.mli => link.mli} (100%)
 rename compiler/lib-wasm/{wa_source_map.ml => wasm_source_map.ml} (100%)
 rename compiler/lib-wasm/{wa_source_map.mli => wasm_source_map.mli} (100%)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 41e9ad1816..1320c7b89e 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -43,9 +43,9 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
       else
         Some
           (List.map source_map.sources ~f:(fun file ->
-               if String.equal file Wa_source_map.blackbox_filename
+               if String.equal file Wasm_source_map.blackbox_filename
                then
-                 Some (Source_map.Source_content.create Wa_source_map.blackbox_contents)
+                 Some (Source_map.Source_content.create Wasm_source_map.blackbox_contents)
                else if Sys.file_exists file && not (Sys.is_directory file)
                then Some (Source_map.Source_content.create (Fs.read_file file))
                else None))
@@ -56,8 +56,8 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
       ; sourceroot =
           (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot)
       ; ignore_list =
-          (if List.mem Wa_source_map.blackbox_filename ~set:source_map.sources
-           then [ Wa_source_map.blackbox_filename ]
+          (if List.mem Wasm_source_map.blackbox_filename ~set:source_map.sources
+           then [ Wasm_source_map.blackbox_filename ]
            else [])
       }
     in
@@ -214,7 +214,7 @@ let build_js_runtime ~primitives ?runtime_arguments () =
     | Javascript.Expression_statement e, N -> e
     | _ -> assert false
   in
-  let prelude = Wa_link.output_js always_required_js in
+  let prelude = Link.output_js always_required_js in
   let init_fun =
     match Parse_js.parse (Parse_js.Lexer.of_string Wa_runtime.js_runtime) with
     | [ (Expression_statement f, _) ] -> f
@@ -230,7 +230,7 @@ let build_js_runtime ~primitives ?runtime_arguments () =
       in
       [ Javascript.Expression_statement js, Javascript.N ]
     in
-    Wa_link.output_js js
+    Link.output_js js
   in
   prelude ^ launcher
 
@@ -241,13 +241,13 @@ let add_source_map sourcemap_don't_inline_content z opt_source_map_file =
       if not sourcemap_don't_inline_content
       then
         let sm = Source_map.of_file file in
-        Wa_source_map.iter_sources sm (fun i j file ->
+        Wasm_source_map.iter_sources sm (fun i j file ->
             if Sys.file_exists file && not (Sys.is_directory file)
             then
               let sm = Fs.read_file file in
               Zip.add_entry
                 z
-                ~name:(Wa_link.source_name i j file)
+                ~name:(Link.source_name i j file)
                 ~contents:(Yojson.Basic.to_string (`String sm))))
     opt_source_map_file
 
@@ -348,8 +348,8 @@ let run
      link_runtime ~profile runtime_wasm_files tmp_wasm_file;
      let primitives =
        tmp_wasm_file
-       |> (fun file -> Wa_link.Wasm_binary.read_imports ~file)
-       |> List.filter_map ~f:(fun { Wa_link.Wasm_binary.module_; name; _ } ->
+       |> (fun file -> Link.Wasm_binary.read_imports ~file)
+       |> List.filter_map ~f:(fun { Link.Wasm_binary.module_; name; _ } ->
               if String.equal module_ "js" then Some name else None)
        |> StringSet.of_list
      in
@@ -358,7 +358,7 @@ let run
      Zip.add_file z ~name:"runtime.wasm" ~file:tmp_wasm_file;
      Zip.add_entry z ~name:"runtime.js" ~contents:js_runtime;
      let predefined_exceptions = build_prelude z in
-     Wa_link.add_info
+     Link.add_info
        z
        ~predefined_exceptions
        ~build_info:(Build_info.create `Runtime)
@@ -405,7 +405,7 @@ let run
            ~opt_output_sourcemap:opt_tmp_map_file
            ~input_file:wat_file
            ~output_file:tmp_wasm_file;
-         { Wa_link.unit_name; unit_info; strings; fragments }
+         { Link.unit_name; unit_info; strings; fragments }
        in
        cont unit_data unit_name tmp_wasm_file opt_tmp_map_file
      in
@@ -425,7 +425,7 @@ let run
          Fs.gen_file (Filename.chop_extension output_file ^ ".wat")
          @@ fun wat_file ->
          let dir = Filename.chop_extension output_file ^ ".assets" in
-         Wa_link.gen_dir dir
+         Link.gen_dir dir
          @@ fun tmp_dir ->
          Sys.mkdir tmp_dir 0o777;
          let opt_sourcemap =
@@ -455,21 +455,21 @@ let run
          if enable_source_maps
          then (
            Sys.rename (Filename.concat tmp_dir "code.wasm.map") (tmp_wasm_file' ^ ".map");
-           Wa_link.Wasm_binary.append_source_map_section
+           Link.Wasm_binary.append_source_map_section
              ~file:tmp_wasm_file'
              ~url:(wasm_name ^ ".wasm.map"));
          let js_runtime =
            let missing_primitives =
-             let l = Wa_link.Wasm_binary.read_imports ~file:tmp_wasm_file' in
+             let l = Link.Wasm_binary.read_imports ~file:tmp_wasm_file' in
              List.filter_map
-               ~f:(fun { Wa_link.Wasm_binary.module_; name; _ } ->
+               ~f:(fun { Link.Wasm_binary.module_; name; _ } ->
                  if String.equal module_ "env" then Some name else None)
                l
            in
            build_js_runtime
              ~primitives
              ~runtime_arguments:
-               (Wa_link.build_runtime_arguments
+               (Link.build_runtime_arguments
                   ~missing_primitives
                   ~wasm_dir:dir
                   ~link_spec:[ wasm_name, None ]
@@ -492,7 +492,7 @@ let run
                unit_data)
          in
          let unit_data = [ compile_cmo' z cmo ] in
-         Wa_link.add_info z ~build_info:(Build_info.create `Cmo) ~unit_data ();
+         Link.add_info z ~build_info:(Build_info.create `Cmo) ~unit_data ();
          Zip.close_out z
      | `Cma cma ->
          Fs.gen_file output_file
@@ -531,7 +531,7 @@ let run
                List.map ~f:(fun (unit_data, _, _, _) -> unit_data) l)
              []
          in
-         Wa_link.add_info z ~build_info:(Build_info.create `Cma) ~unit_data ();
+         Link.add_info z ~build_info:(Build_info.create `Cma) ~unit_data ();
          Zip.close_out z);
      close_ic ());
   Debug.stop_profiling ()
diff --git a/compiler/bin-wasm_of_ocaml/link.ml b/compiler/bin-wasm_of_ocaml/link.ml
index 7bd65d9e4d..48cd0bc103 100644
--- a/compiler/bin-wasm_of_ocaml/link.ml
+++ b/compiler/bin-wasm_of_ocaml/link.ml
@@ -81,7 +81,7 @@ let options =
 let f { common; output_file; files; linkall; enable_source_maps; mklib } =
   Js_of_ocaml_compiler.Config.set_target `Wasm;
   Jsoo_cmdline.Arg.eval common;
-  Wa_link.link ~output_file ~linkall ~mklib ~enable_source_maps ~files
+  Link.link ~output_file ~linkall ~mklib ~enable_source_maps ~files
 
 let info =
   Info.make
diff --git a/compiler/lib-wasm/wa_code_generation.ml b/compiler/lib-wasm/code_generation.ml
similarity index 99%
rename from compiler/lib-wasm/wa_code_generation.ml
rename to compiler/lib-wasm/code_generation.ml
index eed927a073..cd23a3db7e 100644
--- a/compiler/lib-wasm/wa_code_generation.ml
+++ b/compiler/lib-wasm/code_generation.ml
@@ -292,7 +292,7 @@ let event loc : unit t =
     | Event _ :: instrs | instrs -> { st with instrs = Event loc :: instrs } )
 
 let hidden_location =
-  { Parse_info.src = Some Wa_source_map.blackbox_filename
+  { Parse_info.src = Some Wasm_source_map.blackbox_filename
   ; name = None
   ; col = 0
   ; line = 1
diff --git a/compiler/lib-wasm/wa_code_generation.mli b/compiler/lib-wasm/code_generation.mli
similarity index 100%
rename from compiler/lib-wasm/wa_code_generation.mli
rename to compiler/lib-wasm/code_generation.mli
diff --git a/compiler/lib-wasm/curry.ml b/compiler/lib-wasm/curry.ml
index 191fdd029a..164e38a29a 100644
--- a/compiler/lib-wasm/curry.ml
+++ b/compiler/lib-wasm/curry.ml
@@ -19,7 +19,7 @@
 open! Stdlib
 open Code
 module W = Wasm_ast
-open Wa_code_generation
+open Code_generation
 
 module Make (Target : Wa_target_sig.S) = struct
   open Target
diff --git a/compiler/lib-wasm/curry.mli b/compiler/lib-wasm/curry.mli
index 35fa39b1d3..203e0f9881 100644
--- a/compiler/lib-wasm/curry.mli
+++ b/compiler/lib-wasm/curry.mli
@@ -17,5 +17,5 @@
  *)
 
 module Make (_ : Wa_target_sig.S) : sig
-  val f : context:Wa_code_generation.context -> unit
+  val f : context:Code_generation.context -> unit
 end
diff --git a/compiler/lib-wasm/wa_globalize.ml b/compiler/lib-wasm/globalize.ml
similarity index 100%
rename from compiler/lib-wasm/wa_globalize.ml
rename to compiler/lib-wasm/globalize.ml
diff --git a/compiler/lib-wasm/wa_globalize.mli b/compiler/lib-wasm/globalize.mli
similarity index 100%
rename from compiler/lib-wasm/wa_globalize.mli
rename to compiler/lib-wasm/globalize.mli
diff --git a/compiler/lib-wasm/wa_link.ml b/compiler/lib-wasm/link.ml
similarity index 99%
rename from compiler/lib-wasm/wa_link.ml
rename to compiler/lib-wasm/link.ml
index 9367f29364..8050a2de42 100644
--- a/compiler/lib-wasm/wa_link.ml
+++ b/compiler/lib-wasm/link.ml
@@ -585,7 +585,7 @@ let extract_source_map ~dir ~name z =
           | Some map -> Build_path_prefix_map.rewrite map path
           | None -> path
       in
-      Wa_source_map.insert_source_contents ~rewrite_path sm (fun i j file ->
+      Wasm_source_map.insert_source_contents ~rewrite_path sm (fun i j file ->
           let name = source_name i j file in
           if Zip.has_entry z ~name then Some (Zip.read_entry z ~name) else None)
     in
@@ -861,10 +861,10 @@ let rec get_source_map_files files src_index =
   then
     let data = Zip.read_entry z ~name:"source_map.map" in
     let sm = Source_map.of_string data in
-    if not (Wa_source_map.is_empty sm)
+    if not (Wasm_source_map.is_empty sm)
     then (
       let l = ref [] in
-      Wa_source_map.iter_sources sm (fun i j file -> l := source_name i j file :: !l);
+      Wasm_source_map.iter_sources sm (fun i j file -> l := source_name i j file :: !l);
       if not (List.is_empty !l)
       then z, Array.of_list (List.rev !l)
       else (
@@ -888,7 +888,7 @@ let add_source_map files z opt_source_map_file =
         | Some (_, (z', _)) -> Zip.close_in z'
         | None -> ()
       in
-      Wa_source_map.iter_sources sm (fun i j file ->
+      Wasm_source_map.iter_sources sm (fun i j file ->
           let z', files =
             match !st with
             | Some (i', st) when Poly.equal i i' -> st
diff --git a/compiler/lib-wasm/wa_link.mli b/compiler/lib-wasm/link.mli
similarity index 100%
rename from compiler/lib-wasm/wa_link.mli
rename to compiler/lib-wasm/link.mli
diff --git a/compiler/lib-wasm/wa_gc_target.ml b/compiler/lib-wasm/wa_gc_target.ml
index 9d2395b6b4..bf8845a2bb 100644
--- a/compiler/lib-wasm/wa_gc_target.ml
+++ b/compiler/lib-wasm/wa_gc_target.ml
@@ -18,9 +18,9 @@
 
 open! Stdlib
 module W = Wasm_ast
-open Wa_code_generation
+open Code_generation
 
-type expression = Wasm_ast.expression Wa_code_generation.t
+type expression = Wasm_ast.expression Code_generation.t
 
 let include_closure_arity = false
 
diff --git a/compiler/lib-wasm/wa_generate.ml b/compiler/lib-wasm/wa_generate.ml
index 8037aa1f6b..1f10389757 100644
--- a/compiler/lib-wasm/wa_generate.ml
+++ b/compiler/lib-wasm/wa_generate.ml
@@ -19,7 +19,7 @@
 open! Stdlib
 open Code
 module W = Wasm_ast
-open Wa_code_generation
+open Code_generation
 
 module Generate (Target : Wa_target_sig.S) = struct
   open Target
@@ -35,7 +35,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     ; deadcode_sentinal : Var.t
     ; blocks : block Addr.Map.t
     ; closures : Closure_conversion.closure Var.Map.t
-    ; global_context : Wa_code_generation.context
+    ; global_context : Code_generation.context
     ; debug : Parse_bytecode.Debug.t
     }
 
@@ -1002,7 +1002,7 @@ module Generate (Target : Wa_target_sig.S) = struct
     in
     let param_count = List.length param_names in
     (match name_opt with
-    | None -> ctx.global_context.globalized_variables <- Wa_globalize.f p g ctx.closures
+    | None -> ctx.global_context.globalized_variables <- Globalize.f p g ctx.closures
     | Some _ -> ());
     let locals, body =
       function_body
diff --git a/compiler/lib-wasm/wa_generate.mli b/compiler/lib-wasm/wa_generate.mli
index 28aa7e09ff..773917310b 100644
--- a/compiler/lib-wasm/wa_generate.mli
+++ b/compiler/lib-wasm/wa_generate.mli
@@ -18,10 +18,10 @@
 
 val init : unit -> unit
 
-val start : unit -> Wa_code_generation.context
+val start : unit -> Code_generation.context
 
 val f :
-     context:Wa_code_generation.context
+     context:Code_generation.context
   -> unit_name:string option
   -> Code.program
   -> live_vars:int array
@@ -30,10 +30,10 @@ val f :
   -> debug:Parse_bytecode.Debug.t
   -> Wasm_ast.var * (string list * (string * Javascript.expression) list)
 
-val add_start_function : context:Wa_code_generation.context -> Wasm_ast.var -> unit
+val add_start_function : context:Code_generation.context -> Wasm_ast.var -> unit
 
-val add_init_function : context:Wa_code_generation.context -> to_link:string list -> unit
+val add_init_function : context:Code_generation.context -> to_link:string list -> unit
 
-val output : out_channel -> context:Wa_code_generation.context -> unit
+val output : out_channel -> context:Code_generation.context -> unit
 
-val wasm_output : out_channel -> context:Wa_code_generation.context -> unit
+val wasm_output : out_channel -> context:Code_generation.context -> unit
diff --git a/compiler/lib-wasm/wa_target_sig.ml b/compiler/lib-wasm/wa_target_sig.ml
index 09ee3c57fb..227da6d972 100644
--- a/compiler/lib-wasm/wa_target_sig.ml
+++ b/compiler/lib-wasm/wa_target_sig.ml
@@ -17,7 +17,7 @@
  *)
 
 module type S = sig
-  type expression = Wa_code_generation.expression
+  type expression = Code_generation.expression
 
   module Memory : sig
     val allocate :
@@ -31,41 +31,39 @@ module type S = sig
       -> arity:int
       -> ?skip_cast:bool
       -> expression
-      -> (Wasm_ast.var * Wasm_ast.expression) Wa_code_generation.t
+      -> (Wasm_ast.var * Wasm_ast.expression) Code_generation.t
 
     val load_real_closure :
          cps:bool
       -> arity:int
       -> expression
-      -> (Wasm_ast.var * Wasm_ast.expression) Wa_code_generation.t
+      -> (Wasm_ast.var * Wasm_ast.expression) Code_generation.t
 
     val check_function_arity :
          Code.Var.t
       -> cps:bool
       -> arity:int
       -> (typ:Wasm_ast.value_type option -> expression -> expression)
-      -> unit Wa_code_generation.t
-      -> unit Wa_code_generation.t
+      -> unit Code_generation.t
+      -> unit Code_generation.t
 
     val tag : expression -> expression
 
     val field : expression -> int -> expression
 
-    val set_field : expression -> int -> expression -> unit Wa_code_generation.t
+    val set_field : expression -> int -> expression -> unit Code_generation.t
 
     val array_get : expression -> expression -> expression
 
-    val array_set : expression -> expression -> expression -> unit Wa_code_generation.t
+    val array_set : expression -> expression -> expression -> unit Code_generation.t
 
     val float_array_get : expression -> expression -> expression
 
-    val float_array_set :
-      expression -> expression -> expression -> unit Wa_code_generation.t
+    val float_array_set : expression -> expression -> expression -> unit Code_generation.t
 
     val gen_array_get : expression -> expression -> expression
 
-    val gen_array_set :
-      expression -> expression -> expression -> unit Wa_code_generation.t
+    val gen_array_set : expression -> expression -> expression -> unit Code_generation.t
 
     val array_length : expression -> expression
 
@@ -77,7 +75,7 @@ module type S = sig
 
     val bytes_get : expression -> expression -> expression
 
-    val bytes_set : expression -> expression -> expression -> unit Wa_code_generation.t
+    val bytes_set : expression -> expression -> expression -> unit Code_generation.t
 
     val box_float : expression -> expression
 
@@ -149,7 +147,7 @@ module type S = sig
 
     val int_asr : expression -> expression -> expression
 
-    val block_type : Wasm_ast.value_type Wa_code_generation.t
+    val block_type : Wasm_ast.value_type Code_generation.t
 
     val dummy_block : expression
 
@@ -162,18 +160,18 @@ module type S = sig
 
   module Closure : sig
     val translate :
-         context:Wa_code_generation.context
+         context:Code_generation.context
       -> closures:Closure_conversion.closure Code.Var.Map.t
       -> cps:bool
       -> Code.Var.t
       -> expression
 
     val bind_environment :
-         context:Wa_code_generation.context
+         context:Code_generation.context
       -> closures:Closure_conversion.closure Code.Var.Map.t
       -> cps:bool
       -> Code.Var.t
-      -> unit Wa_code_generation.t
+      -> unit Code_generation.t
 
     val curry_allocate :
          cps:bool
@@ -182,16 +180,16 @@ module type S = sig
       -> f:Code.Var.t
       -> closure:Code.Var.t
       -> arg:Code.Var.t
-      -> Wasm_ast.expression Wa_code_generation.t
+      -> Wasm_ast.expression Code_generation.t
 
     val curry_load :
          cps:bool
       -> arity:int
       -> int
       -> Code.Var.t
-      -> (expression * expression * Wasm_ast.value_type option) Wa_code_generation.t
+      -> (expression * expression * Wasm_ast.value_type option) Code_generation.t
 
-    val dummy : cps:bool -> arity:int -> Wasm_ast.expression Wa_code_generation.t
+    val dummy : cps:bool -> arity:int -> Wasm_ast.expression Code_generation.t
   end
 
   module Math : sig
@@ -256,13 +254,13 @@ module type S = sig
     -> (   result_typ:Wasm_ast.value_type list
         -> fall_through:[> `Skip ]
         -> context:'b list
-        -> unit Wa_code_generation.t)
+        -> unit Code_generation.t)
     -> Wasm_ast.var
     -> (   result_typ:Wasm_ast.value_type list
         -> fall_through:'a
         -> context:'b list
-        -> unit Wa_code_generation.t)
-    -> unit Wa_code_generation.t
+        -> unit Code_generation.t)
+    -> unit Code_generation.t
 
   val post_process_function_body :
        param_names:Wasm_ast.var list
@@ -272,5 +270,5 @@ module type S = sig
 
   val entry_point :
        toplevel_fun:Wasm_ast.var
-    -> Wasm_ast.func_type * Wasm_ast.var list * unit Wa_code_generation.t
+    -> Wasm_ast.func_type * Wasm_ast.var list * unit Code_generation.t
 end
diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
index ac11566f58..62ab8a9b24 100644
--- a/compiler/lib-wasm/wasm_link.ml
+++ b/compiler/lib-wasm/wasm_link.ml
@@ -819,7 +819,7 @@ module Scan = struct
     ; tag = [||]
     }
 
-  type resize_data = Wa_source_map.resize_data =
+  type resize_data = Wasm_source_map.resize_data =
     { mutable i : int
     ; mutable pos : int array
     ; mutable delta : int array
@@ -2251,8 +2251,9 @@ let f files ~output_file ~opt_output_sourcemap_file =
         Read.repeat' count code contents.ch;
         Option.iter
           ~f:(fun sm ->
-            if not (Wa_source_map.is_empty sm)
-            then source_maps := (pos, Wa_source_map.resize resize_data sm) :: !source_maps)
+            if not (Wasm_source_map.is_empty sm)
+            then
+              source_maps := (pos, Wasm_source_map.resize resize_data sm) :: !source_maps)
           source_map_contents))
     files;
   if start_count > 1
@@ -2276,7 +2277,7 @@ let f files ~output_file ~opt_output_sourcemap_file =
   Option.iter
     ~f:(fun file ->
       Source_map.to_file
-        (Wa_source_map.concatenate
+        (Wasm_source_map.concatenate
            (List.map
               ~f:(fun (pos, sm) -> pos + code_section_offset, sm)
               (List.rev !source_maps)))
diff --git a/compiler/lib-wasm/wa_source_map.ml b/compiler/lib-wasm/wasm_source_map.ml
similarity index 100%
rename from compiler/lib-wasm/wa_source_map.ml
rename to compiler/lib-wasm/wasm_source_map.ml
diff --git a/compiler/lib-wasm/wa_source_map.mli b/compiler/lib-wasm/wasm_source_map.mli
similarity index 100%
rename from compiler/lib-wasm/wa_source_map.mli
rename to compiler/lib-wasm/wasm_source_map.mli
diff --git a/compiler/lib-wasm/wat_output.ml b/compiler/lib-wasm/wat_output.ml
index 9959974892..7f15a6b82e 100644
--- a/compiler/lib-wasm/wat_output.ml
+++ b/compiler/lib-wasm/wat_output.ml
@@ -452,8 +452,7 @@ let expression_or_instructions ctx st in_function =
                         List
                           (Atom "catch"
                           :: index st.tag_names tag
-                          :: (instruction
-                                (Wasm_ast.Event Wa_code_generation.hidden_location)
+                          :: (instruction (Wasm_ast.Event Code_generation.hidden_location)
                              @ instruction (Wasm_ast.Br (i + 1, Some (Pop ty))))))
                       catches))
         ]

From 02b848f0dae1924326aceb5e2b689eb4870b9e0c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 15:08:48 +0100
Subject: [PATCH 436/481] Renamed remaining files

---
 compiler/bin-wasm_of_ocaml/compile.ml            | 16 ++++++++--------
 compiler/lib-wasm/curry.ml                       |  2 +-
 compiler/lib-wasm/curry.mli                      |  2 +-
 .../lib-wasm/{wa_gc_target.ml => gc_target.ml}   |  0
 .../lib-wasm/{wa_gc_target.mli => gc_target.mli} |  2 +-
 .../lib-wasm/{wa_generate.ml => generate.ml}     | 14 +++++++-------
 .../lib-wasm/{wa_generate.mli => generate.mli}   |  0
 compiler/lib-wasm/link.ml                        |  6 +++---
 .../lib-wasm/{wa_target_sig.ml => target_sig.ml} |  0
 9 files changed, 21 insertions(+), 21 deletions(-)
 rename compiler/lib-wasm/{wa_gc_target.ml => gc_target.ml} (100%)
 rename compiler/lib-wasm/{wa_gc_target.mli => gc_target.mli} (97%)
 rename compiler/lib-wasm/{wa_generate.ml => generate.ml} (99%)
 rename compiler/lib-wasm/{wa_generate.mli => generate.mli} (100%)
 rename compiler/lib-wasm/{wa_target_sig.ml => target_sig.ml} (100%)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 1320c7b89e..50681c0206 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -160,10 +160,10 @@ let generate_prelude ~out_file =
   let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
     Driver.optimize ~profile code
   in
-  let context = Wa_generate.start () in
+  let context = Generate.start () in
   let debug = Parse_bytecode.Debug.create ~include_cmis:false false in
   let _ =
-    Wa_generate.f
+    Generate.f
       ~context
       ~unit_name:(Some "prelude")
       ~live_vars:variable_uses
@@ -172,7 +172,7 @@ let generate_prelude ~out_file =
       ~debug
       program
   in
-  Wa_generate.output ch ~context;
+  Generate.output ch ~context;
   uinfo.provides
 
 let build_prelude z =
@@ -266,7 +266,7 @@ let run
     } =
   Config.set_target `Wasm;
   Jsoo_cmdline.Arg.eval common;
-  Wa_generate.init ();
+  Generate.init ();
   let output_file = fst output_file in
   if debug_mem () then Debug.start_profiling output_file;
   List.iter params ~f:(fun (s, v) -> Config.Param.set s v);
@@ -322,10 +322,10 @@ let run
     let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } =
       Driver.optimize ~profile code
     in
-    let context = Wa_generate.start () in
+    let context = Generate.start () in
     let debug = one.debug in
     let toplevel_name, generated_js =
-      Wa_generate.f
+      Generate.f
         ~context
         ~unit_name
         ~live_vars:variable_uses
@@ -334,8 +334,8 @@ let run
         ~debug
         program
     in
-    if standalone then Wa_generate.add_start_function ~context toplevel_name;
-    Wa_generate.output ch ~context;
+    if standalone then Generate.add_start_function ~context toplevel_name;
+    Generate.output ch ~context;
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
     generated_js
   in
diff --git a/compiler/lib-wasm/curry.ml b/compiler/lib-wasm/curry.ml
index 164e38a29a..0d96ad5cb9 100644
--- a/compiler/lib-wasm/curry.ml
+++ b/compiler/lib-wasm/curry.ml
@@ -21,7 +21,7 @@ open Code
 module W = Wasm_ast
 open Code_generation
 
-module Make (Target : Wa_target_sig.S) = struct
+module Make (Target : Target_sig.S) = struct
   open Target
 
   let func_type n =
diff --git a/compiler/lib-wasm/curry.mli b/compiler/lib-wasm/curry.mli
index 203e0f9881..efb4dc225c 100644
--- a/compiler/lib-wasm/curry.mli
+++ b/compiler/lib-wasm/curry.mli
@@ -16,6 +16,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-module Make (_ : Wa_target_sig.S) : sig
+module Make (_ : Target_sig.S) : sig
   val f : context:Code_generation.context -> unit
 end
diff --git a/compiler/lib-wasm/wa_gc_target.ml b/compiler/lib-wasm/gc_target.ml
similarity index 100%
rename from compiler/lib-wasm/wa_gc_target.ml
rename to compiler/lib-wasm/gc_target.ml
diff --git a/compiler/lib-wasm/wa_gc_target.mli b/compiler/lib-wasm/gc_target.mli
similarity index 97%
rename from compiler/lib-wasm/wa_gc_target.mli
rename to compiler/lib-wasm/gc_target.mli
index e44faa1a1f..fdb5b9cd29 100644
--- a/compiler/lib-wasm/wa_gc_target.mli
+++ b/compiler/lib-wasm/gc_target.mli
@@ -16,4 +16,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-include Wa_target_sig.S
+include Target_sig.S
diff --git a/compiler/lib-wasm/wa_generate.ml b/compiler/lib-wasm/generate.ml
similarity index 99%
rename from compiler/lib-wasm/wa_generate.ml
rename to compiler/lib-wasm/generate.ml
index 1f10389757..2e191cafb3 100644
--- a/compiler/lib-wasm/wa_generate.ml
+++ b/compiler/lib-wasm/generate.ml
@@ -21,7 +21,7 @@ open Code
 module W = Wasm_ast
 open Code_generation
 
-module Generate (Target : Wa_target_sig.S) = struct
+module Generate (Target : Target_sig.S) = struct
   open Target
 
   let transl_prim_arg x =
@@ -1214,27 +1214,27 @@ let fix_switch_branches p =
     p.blocks;
   !p'
 
-let start () = make_context ~value_type:Wa_gc_target.Value.value
+let start () = make_context ~value_type:Gc_target.Value.value
 
 let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~debug =
   let p = if Config.Flag.effects () then fix_switch_branches p else p in
-  let module G = Generate (Wa_gc_target) in
+  let module G = Generate (Gc_target) in
   G.f ~context ~unit_name ~live_vars ~in_cps ~deadcode_sentinal ~debug p
 
 let add_start_function =
-  let module G = Generate (Wa_gc_target) in
+  let module G = Generate (Gc_target) in
   G.add_start_function
 
 let add_init_function =
-  let module G = Generate (Wa_gc_target) in
+  let module G = Generate (Gc_target) in
   G.add_init_function
 
 let output ch ~context =
-  let module G = Generate (Wa_gc_target) in
+  let module G = Generate (Gc_target) in
   let fields = G.output ~context in
   Wat_output.f ch fields
 
 let wasm_output ch ~context =
-  let module G = Generate (Wa_gc_target) in
+  let module G = Generate (Gc_target) in
   let fields = G.output ~context in
   Wasm_output.f ch fields
diff --git a/compiler/lib-wasm/wa_generate.mli b/compiler/lib-wasm/generate.mli
similarity index 100%
rename from compiler/lib-wasm/wa_generate.mli
rename to compiler/lib-wasm/generate.mli
diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml
index 8050a2de42..3505488067 100644
--- a/compiler/lib-wasm/link.ml
+++ b/compiler/lib-wasm/link.ml
@@ -387,9 +387,9 @@ let generate_start_function ~to_link ~out_file =
   let t1 = Timer.make () in
   Filename.gen_file out_file
   @@ fun ch ->
-  let context = Wa_generate.start () in
-  Wa_generate.add_init_function ~context ~to_link:("prelude" :: to_link);
-  Wa_generate.wasm_output ch ~context;
+  let context = Generate.start () in
+  Generate.add_init_function ~context ~to_link:("prelude" :: to_link);
+  Generate.wasm_output ch ~context;
   if times () then Format.eprintf "    generate start: %a@." Timer.print t1
 
 let output_js js =
diff --git a/compiler/lib-wasm/wa_target_sig.ml b/compiler/lib-wasm/target_sig.ml
similarity index 100%
rename from compiler/lib-wasm/wa_target_sig.ml
rename to compiler/lib-wasm/target_sig.ml

From 34bfa2ad23388a77b620eb5a2c43328ae45330e9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 15:18:59 +0100
Subject: [PATCH 437/481] Update .git-blame-ignore-revs

---
 .git-blame-ignore-revs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs
index ac1dc77c40..503897a820 100644
--- a/.git-blame-ignore-revs
+++ b/.git-blame-ignore-revs
@@ -4,3 +4,8 @@
 7de742a776fcdad4b098695617b9e7afab822c82
 # Biome
 5a78e2466221c91fc3607be5b6549797551de4d1
+# Wasm_of_ocaml: renamed files
+02b848f0dae1924326aceb5e2b689eb4870b9e0c
+f51c956d4294c55b45a05fa6520cb5cdc9e2ade3
+40f4d4e4034d8fd21e28d74e5ff127dcd3fec37d
+a1d6554ea9d055f817edea5d32e485d836001cb3

From e6607258fac04970a43180b88ad74defc498b048 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 15:24:21 +0100
Subject: [PATCH 438/481] Always enable tests-jsoo/lib-effects tests for OCaml
 >= 5.0

---
 compiler/tests-jsoo/lib-effects/dune | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune
index db1dba7b43..98993e01cb 100644
--- a/compiler/tests-jsoo/lib-effects/dune
+++ b/compiler/tests-jsoo/lib-effects/dune
@@ -1,14 +1,22 @@
+(env
+ (using-effects)
+ (wasm)
+ (wasm-effects)
+ (_
+  (js_of_ocaml
+   (flags
+    (:standard --enable effects))
+   ;; separate compilation doesn't work when using
+   ;; features such as 'effects' or 'use-js-string'
+   ;; because dune doesn't know that it should compile
+   ;; multiple versions of the dependencies
+   (compilation_mode whole_program))))
+
 (library
  (name jsoo_testsuite_effect)
  (enabled_if
-  (and
-   (>= %{ocaml_version} 5)
-   (or
-    (= %{profile} using-effects)
-    (= %{profile} wasm-effects))))
+  (>= %{ocaml_version} 5))
  (inline_tests
-  ;; This requires the unreleased dune 3.7 to work
-  (enabled_if true)
   (modes js wasm best))
  (preprocess
   (pps ppx_expect)))

From aa1c9c9958c019f684ee60eca5fef820883ef922 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 5 Nov 2024 23:23:04 +0100
Subject: [PATCH 439/481] Tests: use an environment variable to know whether we
 are testing Wasm_of_ocaml

---
 compiler/tests-compiler/dune.inc         | 110 +++++++++++------------
 compiler/tests-compiler/gen-rules/gen.ml |   2 +-
 compiler/tests-dynlink-js/dune           |  30 ++-----
 compiler/tests-dynlink/dune              |  20 +----
 compiler/tests-io/dune                   |   8 +-
 compiler/tests-jsoo/bin/dune             |   8 +-
 compiler/tests-num/dune                  |   5 +-
 compiler/tests-ocaml/lib-hashtbl/dune    |   9 +-
 compiler/tests-toplevel/dune             |  22 ++---
 dune                                     |  23 +++--
 examples/namespace/dune                  |   5 +-
 examples/separate_compilation/dune       |  10 +--
 ppx/ppx_deriving_json/tests/dune         |   6 +-
 toplevel/examples/eval/dune              |  20 +----
 toplevel/examples/lwt_toplevel/dune      |  15 +---
 toplevel/test/dune                       |   5 +-
 16 files changed, 109 insertions(+), 189 deletions(-)

diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index e10abfd48d..b1808ea374 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -2,7 +2,7 @@
 (library
  ;; compiler/tests-compiler/array_access.ml
  (name array_access_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules array_access)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -17,7 +17,7 @@
 (library
  ;; compiler/tests-compiler/build_path_prefix_map.ml
  (name build_path_prefix_map_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules build_path_prefix_map)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -32,7 +32,7 @@
 (library
  ;; compiler/tests-compiler/call_gen.ml
  (name call_gen_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules call_gen)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -47,7 +47,7 @@
 (library
  ;; compiler/tests-compiler/compact.ml
  (name compact_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules compact)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -62,7 +62,7 @@
 (library
  ;; compiler/tests-compiler/cond.ml
  (name cond_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules cond)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -77,7 +77,7 @@
 (library
  ;; compiler/tests-compiler/direct_calls.ml
  (name direct_calls_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules direct_calls)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -92,7 +92,7 @@
 (library
  ;; compiler/tests-compiler/effects.ml
  (name effects_15)
- (enabled_if (and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and (>= %{ocaml_version} 5) %{env:js-enabled=}))
  (modules effects)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -107,7 +107,7 @@
 (library
  ;; compiler/tests-compiler/effects_continuations.ml
  (name effects_continuations_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules effects_continuations)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -122,7 +122,7 @@
 (library
  ;; compiler/tests-compiler/effects_exceptions.ml
  (name effects_exceptions_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules effects_exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -137,7 +137,7 @@
 (library
  ;; compiler/tests-compiler/effects_toplevel.ml
  (name effects_toplevel_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules effects_toplevel)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -152,7 +152,7 @@
 (library
  ;; compiler/tests-compiler/eliminate_exception_handler.ml
  (name eliminate_exception_handler_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules eliminate_exception_handler)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -167,7 +167,7 @@
 (library
  ;; compiler/tests-compiler/empty_cma.ml
  (name empty_cma_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules empty_cma)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -182,7 +182,7 @@
 (library
  ;; compiler/tests-compiler/end_to_end.ml
  (name end_to_end_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules end_to_end)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -197,7 +197,7 @@
 (library
  ;; compiler/tests-compiler/error.ml
  (name error_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules error)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -212,7 +212,7 @@
 (library
  ;; compiler/tests-compiler/es6.ml
  (name es6_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules es6)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -227,7 +227,7 @@
 (library
  ;; compiler/tests-compiler/exceptions.ml
  (name exceptions_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -242,7 +242,7 @@
 (library
  ;; compiler/tests-compiler/exports.ml
  (name exports_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules exports)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -257,7 +257,7 @@
 (library
  ;; compiler/tests-compiler/getenv.ml
  (name getenv_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules getenv)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -272,7 +272,7 @@
 (library
  ;; compiler/tests-compiler/gh1007.ml
  (name gh1007_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1007)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -287,7 +287,7 @@
 (library
  ;; compiler/tests-compiler/gh1051.ml
  (name gh1051_15)
- (enabled_if (and %{arch_sixtyfour} (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and %{arch_sixtyfour} %{env:js-enabled=}))
  (modules gh1051)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -302,7 +302,7 @@
 (library
  ;; compiler/tests-compiler/gh1320.ml
  (name gh1320_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1320)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -317,7 +317,7 @@
 (library
  ;; compiler/tests-compiler/gh1349.ml
  (name gh1349_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1349)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -332,7 +332,7 @@
 (library
  ;; compiler/tests-compiler/gh1354.ml
  (name gh1354_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1354)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -347,7 +347,7 @@
 (library
  ;; compiler/tests-compiler/gh1390.ml
  (name gh1390_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1390)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -362,7 +362,7 @@
 (library
  ;; compiler/tests-compiler/gh1481.ml
  (name gh1481_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1481)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -377,7 +377,7 @@
 (library
  ;; compiler/tests-compiler/gh1494.ml
  (name gh1494_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1494)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -392,7 +392,7 @@
 (library
  ;; compiler/tests-compiler/gh1559.ml
  (name gh1559_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1559)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -407,7 +407,7 @@
 (library
  ;; compiler/tests-compiler/gh1599.ml
  (name gh1599_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1599)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -422,7 +422,7 @@
 (library
  ;; compiler/tests-compiler/gh1659.ml
  (name gh1659_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh1659)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -437,7 +437,7 @@
 (library
  ;; compiler/tests-compiler/gh747.ml
  (name gh747_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gh747)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -452,7 +452,7 @@
 (library
  ;; compiler/tests-compiler/gl507.ml
  (name gl507_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules gl507)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -467,7 +467,7 @@
 (library
  ;; compiler/tests-compiler/global_deadcode.ml
  (name global_deadcode_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules global_deadcode)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -482,7 +482,7 @@
 (library
  ;; compiler/tests-compiler/inlining.ml
  (name inlining_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules inlining)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -497,7 +497,7 @@
 (library
  ;; compiler/tests-compiler/js_parser_printer.ml
  (name js_parser_printer_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules js_parser_printer)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -512,7 +512,7 @@
 (library
  ;; compiler/tests-compiler/jsopt.ml
  (name jsopt_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules jsopt)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -527,7 +527,7 @@
 (library
  ;; compiler/tests-compiler/lambda_lifting.ml
  (name lambda_lifting_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules lambda_lifting)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -542,7 +542,7 @@
 (library
  ;; compiler/tests-compiler/lazy.ml
  (name lazy_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules lazy)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -557,7 +557,7 @@
 (library
  ;; compiler/tests-compiler/loops.ml
  (name loops_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules loops)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -572,7 +572,7 @@
 (library
  ;; compiler/tests-compiler/macro.ml
  (name macro_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules macro)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -587,7 +587,7 @@
 (library
  ;; compiler/tests-compiler/match_with_exn.ml
  (name match_with_exn_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules match_with_exn)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -602,7 +602,7 @@
 (library
  ;; compiler/tests-compiler/minify.ml
  (name minify_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules minify)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -617,7 +617,7 @@
 (library
  ;; compiler/tests-compiler/mutable_closure.ml
  (name mutable_closure_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules mutable_closure)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -632,7 +632,7 @@
 (library
  ;; compiler/tests-compiler/obj.ml
  (name obj_15)
- (enabled_if (and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and (>= %{ocaml_version} 5) %{env:js-enabled=}))
  (modules obj)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -647,7 +647,7 @@
 (library
  ;; compiler/tests-compiler/obj_dup.ml
  (name obj_dup_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules obj_dup)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -662,7 +662,7 @@
 (library
  ;; compiler/tests-compiler/scopes.ml
  (name scopes_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules scopes)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -677,7 +677,7 @@
 (library
  ;; compiler/tests-compiler/side_effect.ml
  (name side_effect_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules side_effect)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -692,7 +692,7 @@
 (library
  ;; compiler/tests-compiler/sourcemap.ml
  (name sourcemap_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules sourcemap)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -707,7 +707,7 @@
 (library
  ;; compiler/tests-compiler/static_eval.ml
  (name static_eval_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules static_eval)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -722,7 +722,7 @@
 (library
  ;; compiler/tests-compiler/sys_command.ml
  (name sys_command_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules sys_command)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -737,7 +737,7 @@
 (library
  ;; compiler/tests-compiler/sys_fs.ml
  (name sys_fs_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules sys_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -752,7 +752,7 @@
 (library
  ;; compiler/tests-compiler/tailcall.ml
  (name tailcall_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules tailcall)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -767,7 +767,7 @@
 (library
  ;; compiler/tests-compiler/target_env.ml
  (name target_env_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules target_env)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -782,7 +782,7 @@
 (library
  ;; compiler/tests-compiler/test_string.ml
  (name test_string_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules test_string)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -797,7 +797,7 @@
 (library
  ;; compiler/tests-compiler/unix_fs.ml
  (name unix_fs_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules unix_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -812,7 +812,7 @@
 (library
  ;; compiler/tests-compiler/variable_declaration_output.ml
  (name variable_declaration_output_15)
- (enabled_if (and true (<> %{profile} wasm) (<> %{profile} wasm-effects)))
+ (enabled_if (and true %{env:js-enabled=}))
  (modules variable_declaration_output)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml
index 4ddd9fb34f..62a019540f 100644
--- a/compiler/tests-compiler/gen-rules/gen.ml
+++ b/compiler/tests-compiler/gen-rules/gen.ml
@@ -77,7 +77,7 @@ let () =
 (library
  ;; %s%s.ml
  (name %s_%d)
- (enabled_if (and %s (<> %%{profile} wasm) (<> %%{profile} wasm-effects)))
+ (enabled_if (and %s %%{env:js-enabled=}))
  (modules %s)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
diff --git a/compiler/tests-dynlink-js/dune b/compiler/tests-dynlink-js/dune
index c9d5ca8862..b21c3df8e9 100644
--- a/compiler/tests-dynlink-js/dune
+++ b/compiler/tests-dynlink-js/dune
@@ -1,9 +1,6 @@
 (executable
  (name main)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (modules main)
  (libraries js_of_ocaml)
  (link_flags
@@ -40,10 +37,7 @@
 
 (rule
  (target main.js)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (run %{bin:js_of_ocaml} --linkall %{read-strings:effects_flags.txt} -o
    %{target} %{dep:main.bc})))
@@ -73,10 +67,7 @@
 
 (rule
  (target main.out)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps plugin.js plugin2.js)
  (action
   (with-outputs-to
@@ -85,10 +76,7 @@
 
 (rule
  (target main.out2)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps plugin.js plugin2.js)
  (action
   (with-outputs-to
@@ -97,18 +85,12 @@
 
 (rule
  (alias runtest)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (diff main.out.expected main.out)))
 
 (rule
  (alias runtest)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (diff main.out.expected main.out2)))
diff --git a/compiler/tests-dynlink/dune b/compiler/tests-dynlink/dune
index 15b17c2d2e..e22a5dcbe3 100644
--- a/compiler/tests-dynlink/dune
+++ b/compiler/tests-dynlink/dune
@@ -1,19 +1,13 @@
 (executable
  (name main)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (modules main)
  (libraries dynlink js_of_ocaml-compiler.dynlink)
  (modes byte))
 
 (rule
  (target main.js)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps plugin.cmo export)
  (action
   (run %{bin:js_of_ocaml} --dynlink --export export --pretty -o %{target}
@@ -26,10 +20,7 @@
 
 (rule
  (target main.out)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps plugin.cmo)
  (action
   (with-outputs-to
@@ -38,9 +29,6 @@
 
 (rule
  (alias runtest)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (diff main.out.expected main.out)))
diff --git a/compiler/tests-io/dune b/compiler/tests-io/dune
index fb661ce376..184846813e 100644
--- a/compiler/tests-io/dune
+++ b/compiler/tests-io/dune
@@ -32,9 +32,7 @@
  (action
   (copy cat.bc.wasm.js cat.bc.js))
  (enabled_if
-  (or
-   (= %{profile} wasm)
-   (= %{profile} wasm-effects))))
+  (not %{env:js-enabled=})))
 
 (rule
  (target md5-native.stdout)
@@ -83,6 +81,4 @@
  (action
   (copy md5.bc.wasm.js md5.bc.js))
  (enabled_if
-  (or
-   (= %{profile} wasm)
-   (= %{profile} wasm-effects))))
+  (not %{env:js-enabled=})))
diff --git a/compiler/tests-jsoo/bin/dune b/compiler/tests-jsoo/bin/dune
index 04ffca1b8c..ed7615c013 100644
--- a/compiler/tests-jsoo/bin/dune
+++ b/compiler/tests-jsoo/bin/dune
@@ -59,9 +59,7 @@
  (action
   (copy error1.bc.wasm.js error1.bc.js))
  (enabled_if
-  (or
-   (= %{profile} wasm)
-   (= %{profile} wasm-effects))))
+  (not %{env:js-enabled=})))
 
 (rule
  (target error2.js.actual)
@@ -118,6 +116,4 @@
  (action
   (copy error2.bc.wasm.js error2.bc.js))
  (enabled_if
-  (or
-   (= %{profile} wasm)
-   (= %{profile} wasm-effects))))
+  (not %{env:js-enabled=})))
diff --git a/compiler/tests-num/dune b/compiler/tests-num/dune
index 25a756b92c..5b48d2af79 100644
--- a/compiler/tests-num/dune
+++ b/compiler/tests-num/dune
@@ -2,10 +2,7 @@
  (name main)
  (modules main test_nats test test_big_ints test_ratios test_nums test_io)
  (libraries num)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (modes
   js
   (best exe))
diff --git a/compiler/tests-ocaml/lib-hashtbl/dune b/compiler/tests-ocaml/lib-hashtbl/dune
index 01bbb96b6a..9ef71618dc 100644
--- a/compiler/tests-ocaml/lib-hashtbl/dune
+++ b/compiler/tests-ocaml/lib-hashtbl/dune
@@ -17,15 +17,10 @@
 (rule
  (action
   (copy hfun.expected-js hfun.expected))
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects))))
+ (enabled_if %{env:js-enabled=}))
 
 (rule
  (action
   (copy hfun.expected-wasm hfun.expected))
  (enabled_if
-  (or
-   (= %{profile} wasm)
-   (= %{profile} wasm-effects))))
+  (not %{env:js-enabled=})))
diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune
index 48bd189995..0fba2cc55f 100644
--- a/compiler/tests-toplevel/dune
+++ b/compiler/tests-toplevel/dune
@@ -1,9 +1,6 @@
 (executables
  (names test_toplevel)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (libraries js_of_ocaml-compiler.dynlink compiler-libs.toplevel)
  (flags
   (:standard -linkall))
@@ -13,20 +10,13 @@
 
 (rule
  (targets test_toplevel.js)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (run %{bin:js_of_ocaml} --toplevel %{dep:test_toplevel.bc} -o %{targets})))
 
 (rule
  (target test_toplevel.bc.js.actual)
- (enabled_if
-  (and
-   (>= %{ocaml_version} 5.2)
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (with-stdout-to
    %{target}
@@ -37,8 +27,7 @@
  (enabled_if
   (and
    (>= %{ocaml_version} 5.2)
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+   %{env:js-enabled=}))
  (action
   (with-stdout-to
    %{target}
@@ -49,8 +38,7 @@
  (enabled_if
   (and
    (>= %{ocaml_version} 5.2)
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+   %{env:js-enabled=}))
  (action
   (progn
    (diff test_toplevel.expected test_toplevel.bc.js.actual)
diff --git a/dune b/dune
index 01946378d0..1aacb7538f 100644
--- a/dune
+++ b/dune
@@ -3,7 +3,9 @@
   (wasm_of_ocaml
    (enabled_if false))
   (flags
-   (:standard -w +a-4-40-41-42-44-48-58-66-70)))
+   (:standard -w +a-4-40-41-42-44-48-58-66-70))
+  (env-vars
+   (js-enabled true)))
  (using-effects
   (wasm_of_ocaml
    (enabled_if false))
@@ -12,14 +14,18 @@
    (flags
     (:standard --enable effects))
    (build_runtime_flags
-    (:standard --enable effects))))
+    (:standard --enable effects)))
+  (env-vars
+   (js-enabled true)))
  (wasm
   (binaries
    (tools/node_wrapper.sh as node))
   (js_of_ocaml
    (enabled_if false))
   (wasm_of_ocaml
-   (compilation_mode separate)))
+   (compilation_mode separate))
+  (env-vars
+   (js-enabled false)))
  (wasm-effects
   (binaries
    (tools/node_wrapper.sh as node))
@@ -28,14 +34,21 @@
   (wasm_of_ocaml
    (compilation_mode separate)
    (flags
-    (:standard --enable effects))))
+    (:standard --enable effects)))
+  (env-vars
+   (js-enabled false)))
  (bench_no_debug
   (flags
    (:standard \ -g))
   (ocamlc_flags
    (:standard \ -g))
   (link_flags
-   (:standard \ -g))))
+   (:standard \ -g))
+  (env-vars
+   (js-enabled true)))
+ (_
+  (env-vars
+   (js-enabled true))))
 
 (rule
  (targets version.ml.in)
diff --git a/examples/namespace/dune b/examples/namespace/dune
index 51423b25d7..310d7102c9 100644
--- a/examples/namespace/dune
+++ b/examples/namespace/dune
@@ -35,9 +35,6 @@
 
 (rule
  (alias runtest)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (diff %{dep:for-node.expected} %{dep:for-node.actual})))
diff --git a/examples/separate_compilation/dune b/examples/separate_compilation/dune
index 495e869117..1cf2ae4606 100644
--- a/examples/separate_compilation/dune
+++ b/examples/separate_compilation/dune
@@ -76,18 +76,12 @@
 
 (rule
  (alias runtest)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (diff bin.expected bin.actual)))
 
 (alias
  (name default)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps myruntime.js stdlib.cma.js std_exit.js module2.js module1.js bin.js
   index.html))
diff --git a/ppx/ppx_deriving_json/tests/dune b/ppx/ppx_deriving_json/tests/dune
index 9320257337..b861e7eb79 100644
--- a/ppx/ppx_deriving_json/tests/dune
+++ b/ppx/ppx_deriving_json/tests/dune
@@ -26,8 +26,7 @@
  (enabled_if
   (and
    (>= %{ocaml_version} 5.1)
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+   %{env:js-enabled=}))
  ;; (package js_of_ocaml-ppx)
  (action
   (diff ppx.mlt ppx.mlt.corrected)))
@@ -37,8 +36,7 @@
  (enabled_if
   (and
    (>= %{ocaml_version} 5.1)
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+   %{env:js-enabled=}))
  ;; (package js_of_ocaml-ppx)
  (action
   (diff gen.mlt gen.mlt.corrected)))
diff --git a/toplevel/examples/eval/dune b/toplevel/examples/eval/dune
index dcaefcb251..899147a9cd 100644
--- a/toplevel/examples/eval/dune
+++ b/toplevel/examples/eval/dune
@@ -1,9 +1,6 @@
 (executables
  (names eval)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (libraries js_of_ocaml-compiler js_of_ocaml-toplevel)
  (link_flags
   (:standard -linkall))
@@ -13,28 +10,19 @@
 
 (rule
  (targets export.txt)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps eval.bc)
  (action
   (run jsoo_listunits -o %{targets} stdlib)))
 
 (rule
  (targets eval.js)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (run %{bin:js_of_ocaml} --export %{dep:export.txt} --toplevel --pretty
    %{dep:eval.bc} -o %{targets})))
 
 (alias
  (name default)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps eval.js index.html))
diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune
index d97792cf31..57dc89684a 100644
--- a/toplevel/examples/lwt_toplevel/dune
+++ b/toplevel/examples/lwt_toplevel/dune
@@ -1,9 +1,6 @@
 (executables
  (names toplevel)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (libraries
   js_of_ocaml-compiler
   js_of_ocaml-tyxml
@@ -129,10 +126,7 @@
 
 (rule
  (targets toplevel.js)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (run %{bin:js_of_ocaml} compile --pretty %{read-strings:effects_flags.txt}
    --Werror --target-env browser --file %{dep:examples.ml} --file
@@ -142,8 +136,5 @@
 
 (alias
  (name default)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (deps toplevel.js toplevel.bc.js index.html))
diff --git a/toplevel/test/dune b/toplevel/test/dune
index ae7976114f..ee4a694766 100644
--- a/toplevel/test/dune
+++ b/toplevel/test/dune
@@ -28,9 +28,6 @@
 
 (rule
  (alias runtest)
- (enabled_if
-  (and
-   (<> %{profile} wasm)
-   (<> %{profile} wasm-effects)))
+ (enabled_if %{env:js-enabled=})
  (action
   (diff test_toplevel.expected test_toplevel.actual)))

From 1d9ac931c0d13644412ed491fef6bce808d1dd3c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Nov 2024 10:46:02 +0100
Subject: [PATCH 440/481] Tests: clean-up lib-effects tests

---
 compiler/tests-jsoo/lib-effects/dune  | 7 +------
 compiler/tests-ocaml/lib-effects/dune | 7 +------
 2 files changed, 2 insertions(+), 12 deletions(-)

diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune
index 98993e01cb..1e61456db8 100644
--- a/compiler/tests-jsoo/lib-effects/dune
+++ b/compiler/tests-jsoo/lib-effects/dune
@@ -5,12 +5,7 @@
  (_
   (js_of_ocaml
    (flags
-    (:standard --enable effects))
-   ;; separate compilation doesn't work when using
-   ;; features such as 'effects' or 'use-js-string'
-   ;; because dune doesn't know that it should compile
-   ;; multiple versions of the dependencies
-   (compilation_mode whole_program))))
+    (:standard --enable effects)))))
 
 (library
  (name jsoo_testsuite_effect)
diff --git a/compiler/tests-ocaml/lib-effects/dune b/compiler/tests-ocaml/lib-effects/dune
index 9f9a1dc985..9d0b782839 100644
--- a/compiler/tests-ocaml/lib-effects/dune
+++ b/compiler/tests-ocaml/lib-effects/dune
@@ -13,12 +13,7 @@
    (:standard -w -38))
   (js_of_ocaml
    (flags
-    (:standard --enable effects))
-   ;; separate compilation doesn't work when using
-   ;; features such as 'effects' or 'use-js-string'
-   ;; because dune doesn't know that it should compile
-   ;; multiple versions of the dependencies
-   (compilation_mode whole_program))))
+    (:standard --enable effects)))))
 
 (tests
  (build_if

From 49eb19fa6c46bb00d6851a3776095d0d65c3d252 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 6 Nov 2024 23:13:05 +0100
Subject: [PATCH 441/481] cleanup

---
 compiler/tests-compiler/dune.inc         | 104 +++++++++++------------
 compiler/tests-compiler/gen-rules/gen.ml |   8 +-
 2 files changed, 58 insertions(+), 54 deletions(-)

diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index b1808ea374..4524092abd 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -2,7 +2,7 @@
 (library
  ;; compiler/tests-compiler/array_access.ml
  (name array_access_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules array_access)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -17,7 +17,7 @@
 (library
  ;; compiler/tests-compiler/build_path_prefix_map.ml
  (name build_path_prefix_map_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules build_path_prefix_map)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -32,7 +32,7 @@
 (library
  ;; compiler/tests-compiler/call_gen.ml
  (name call_gen_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules call_gen)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -47,7 +47,7 @@
 (library
  ;; compiler/tests-compiler/compact.ml
  (name compact_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules compact)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -62,7 +62,7 @@
 (library
  ;; compiler/tests-compiler/cond.ml
  (name cond_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules cond)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -77,7 +77,7 @@
 (library
  ;; compiler/tests-compiler/direct_calls.ml
  (name direct_calls_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules direct_calls)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -107,7 +107,7 @@
 (library
  ;; compiler/tests-compiler/effects_continuations.ml
  (name effects_continuations_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules effects_continuations)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -122,7 +122,7 @@
 (library
  ;; compiler/tests-compiler/effects_exceptions.ml
  (name effects_exceptions_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules effects_exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -137,7 +137,7 @@
 (library
  ;; compiler/tests-compiler/effects_toplevel.ml
  (name effects_toplevel_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules effects_toplevel)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -152,7 +152,7 @@
 (library
  ;; compiler/tests-compiler/eliminate_exception_handler.ml
  (name eliminate_exception_handler_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules eliminate_exception_handler)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -167,7 +167,7 @@
 (library
  ;; compiler/tests-compiler/empty_cma.ml
  (name empty_cma_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules empty_cma)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -182,7 +182,7 @@
 (library
  ;; compiler/tests-compiler/end_to_end.ml
  (name end_to_end_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules end_to_end)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -197,7 +197,7 @@
 (library
  ;; compiler/tests-compiler/error.ml
  (name error_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules error)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -212,7 +212,7 @@
 (library
  ;; compiler/tests-compiler/es6.ml
  (name es6_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules es6)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -227,7 +227,7 @@
 (library
  ;; compiler/tests-compiler/exceptions.ml
  (name exceptions_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules exceptions)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -242,7 +242,7 @@
 (library
  ;; compiler/tests-compiler/exports.ml
  (name exports_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules exports)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -257,7 +257,7 @@
 (library
  ;; compiler/tests-compiler/getenv.ml
  (name getenv_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules getenv)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -272,7 +272,7 @@
 (library
  ;; compiler/tests-compiler/gh1007.ml
  (name gh1007_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1007)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -302,7 +302,7 @@
 (library
  ;; compiler/tests-compiler/gh1320.ml
  (name gh1320_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1320)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -317,7 +317,7 @@
 (library
  ;; compiler/tests-compiler/gh1349.ml
  (name gh1349_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1349)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -332,7 +332,7 @@
 (library
  ;; compiler/tests-compiler/gh1354.ml
  (name gh1354_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1354)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -347,7 +347,7 @@
 (library
  ;; compiler/tests-compiler/gh1390.ml
  (name gh1390_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1390)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -362,7 +362,7 @@
 (library
  ;; compiler/tests-compiler/gh1481.ml
  (name gh1481_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1481)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -377,7 +377,7 @@
 (library
  ;; compiler/tests-compiler/gh1494.ml
  (name gh1494_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1494)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -392,7 +392,7 @@
 (library
  ;; compiler/tests-compiler/gh1559.ml
  (name gh1559_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1559)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -407,7 +407,7 @@
 (library
  ;; compiler/tests-compiler/gh1599.ml
  (name gh1599_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1599)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -422,7 +422,7 @@
 (library
  ;; compiler/tests-compiler/gh1659.ml
  (name gh1659_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh1659)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -437,7 +437,7 @@
 (library
  ;; compiler/tests-compiler/gh747.ml
  (name gh747_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gh747)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -452,7 +452,7 @@
 (library
  ;; compiler/tests-compiler/gl507.ml
  (name gl507_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules gl507)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -467,7 +467,7 @@
 (library
  ;; compiler/tests-compiler/global_deadcode.ml
  (name global_deadcode_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules global_deadcode)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -482,7 +482,7 @@
 (library
  ;; compiler/tests-compiler/inlining.ml
  (name inlining_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules inlining)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -497,7 +497,7 @@
 (library
  ;; compiler/tests-compiler/js_parser_printer.ml
  (name js_parser_printer_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules js_parser_printer)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -512,7 +512,7 @@
 (library
  ;; compiler/tests-compiler/jsopt.ml
  (name jsopt_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules jsopt)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -527,7 +527,7 @@
 (library
  ;; compiler/tests-compiler/lambda_lifting.ml
  (name lambda_lifting_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules lambda_lifting)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -542,7 +542,7 @@
 (library
  ;; compiler/tests-compiler/lazy.ml
  (name lazy_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules lazy)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -557,7 +557,7 @@
 (library
  ;; compiler/tests-compiler/loops.ml
  (name loops_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules loops)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -572,7 +572,7 @@
 (library
  ;; compiler/tests-compiler/macro.ml
  (name macro_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules macro)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -587,7 +587,7 @@
 (library
  ;; compiler/tests-compiler/match_with_exn.ml
  (name match_with_exn_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules match_with_exn)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -602,7 +602,7 @@
 (library
  ;; compiler/tests-compiler/minify.ml
  (name minify_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules minify)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -617,7 +617,7 @@
 (library
  ;; compiler/tests-compiler/mutable_closure.ml
  (name mutable_closure_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules mutable_closure)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -647,7 +647,7 @@
 (library
  ;; compiler/tests-compiler/obj_dup.ml
  (name obj_dup_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules obj_dup)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -662,7 +662,7 @@
 (library
  ;; compiler/tests-compiler/scopes.ml
  (name scopes_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules scopes)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -677,7 +677,7 @@
 (library
  ;; compiler/tests-compiler/side_effect.ml
  (name side_effect_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules side_effect)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -692,7 +692,7 @@
 (library
  ;; compiler/tests-compiler/sourcemap.ml
  (name sourcemap_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules sourcemap)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -707,7 +707,7 @@
 (library
  ;; compiler/tests-compiler/static_eval.ml
  (name static_eval_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules static_eval)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -722,7 +722,7 @@
 (library
  ;; compiler/tests-compiler/sys_command.ml
  (name sys_command_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules sys_command)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -737,7 +737,7 @@
 (library
  ;; compiler/tests-compiler/sys_fs.ml
  (name sys_fs_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules sys_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -752,7 +752,7 @@
 (library
  ;; compiler/tests-compiler/tailcall.ml
  (name tailcall_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules tailcall)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -767,7 +767,7 @@
 (library
  ;; compiler/tests-compiler/target_env.ml
  (name target_env_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules target_env)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -782,7 +782,7 @@
 (library
  ;; compiler/tests-compiler/test_string.ml
  (name test_string_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules test_string)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -797,7 +797,7 @@
 (library
  ;; compiler/tests-compiler/unix_fs.ml
  (name unix_fs_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules unix_fs)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -812,7 +812,7 @@
 (library
  ;; compiler/tests-compiler/variable_declaration_output.ml
  (name variable_declaration_output_15)
- (enabled_if (and true %{env:js-enabled=}))
+ (enabled_if %{env:js-enabled=})
  (modules variable_declaration_output)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml
index 62a019540f..ef0415518c 100644
--- a/compiler/tests-compiler/gen-rules/gen.ml
+++ b/compiler/tests-compiler/gen-rules/gen.ml
@@ -66,6 +66,10 @@ let enabled_if cond =
   | GE5 -> "(>= %{ocaml_version} 5)"
   | B64 -> "%{arch_sixtyfour}"
 
+let js_enabled = function
+  | "true" -> "%{env:js-enabled=}"
+  | x -> Printf.sprintf "(and %s %%{env:js-enabled=})" x
+
 let () =
   Array.to_list (Sys.readdir ".")
   |> List.filter ~f:is_implem
@@ -77,7 +81,7 @@ let () =
 (library
  ;; %s%s.ml
  (name %s_%d)
- (enabled_if (and %s %%{env:js-enabled=}))
+ (enabled_if %s)
  (modules %s)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
@@ -93,6 +97,6 @@ let () =
            basename
            basename
            (Hashtbl.hash prefix mod 100)
-           (enabled_if (lib_enabled_if basename))
+           (js_enabled (enabled_if (lib_enabled_if basename)))
            basename
            (enabled_if (test_enabled_if basename)))

From 1c536c23a2efb64aa8c3a3e473837ffc47e788a8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Nov 2024 14:41:08 +0100
Subject: [PATCH 442/481] Wasm source map resizing: clean-up

---
 compiler/lib-wasm/wasm_source_map.ml | 14 +++++++-------
 compiler/lib/vlq64.ml                |  7 ++++---
 2 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/compiler/lib-wasm/wasm_source_map.ml b/compiler/lib-wasm/wasm_source_map.ml
index 06f9b6cad8..77e7f18eda 100644
--- a/compiler/lib-wasm/wasm_source_map.ml
+++ b/compiler/lib-wasm/wasm_source_map.ml
@@ -14,16 +14,16 @@ type input = Vlq64.input =
   ; len : int
   }
 
-let rec next' src mappings pos =
-  pos < src.len
+let rec next' src mappings pos len =
+  pos < len
   &&
   match mappings.[pos] with
   | ',' ->
       src.pos <- pos + 1;
       true
-  | _ -> next' src mappings (pos + 1)
+  | _ -> next' src mappings (pos + 1) len
 
-let next src = next' src src.string src.pos
+let next src = next' src src.string src.pos src.len
 
 let flush buf src start pos =
   if start < pos then Buffer.add_substring buf src.string start (pos - start)
@@ -36,7 +36,7 @@ let rec resize_rec buf start src resize_data i col0 delta0 col =
   then
     if next src
     then resize_rec buf start src resize_data i col0 delta0 col
-    else flush buf src start (String.length src.string)
+    else flush buf src start src.len
   else
     let delta = delta + delta0 in
     adjust buf start src resize_data i col delta pos
@@ -54,7 +54,7 @@ and adjust buf start src (resize_data : resize_data) i col delta pos =
       let start = src.pos in
       if next src
       then resize_rec buf start src resize_data (i + 1) col0 delta0 col
-      else flush buf src start (String.length src.string))
+      else flush buf src start src.len)
     else
       let delta = delta + delta0 in
       adjust buf start src resize_data (i + 1) col delta pos
@@ -62,7 +62,7 @@ and adjust buf start src (resize_data : resize_data) i col delta pos =
     flush buf src start pos;
     Vlq64.encode buf delta;
     let start = src.pos in
-    flush buf src start (String.length src.string))
+    flush buf src start src.len)
 
 let resize_mappings (resize_data : resize_data) mappings =
   if String.equal mappings "" || resize_data.i = 0
diff --git a/compiler/lib/vlq64.ml b/compiler/lib/vlq64.ml
index 4f38940f55..f32fa6f58e 100644
--- a/compiler/lib/vlq64.ml
+++ b/compiler/lib/vlq64.ml
@@ -106,14 +106,15 @@ type input =
   ; len : int
   }
 
-let rec decode' src s pos offset i =
+let rec decode' src s pos len offset i =
+  if pos = len then invalid_arg "Vql64.decode'";
   let digit = Array.unsafe_get code_rev (Char.code s.[pos]) in
   if digit = -1 then invalid_arg "Vql64.decode'";
   let i = i + ((digit land vlq_base_mask) lsl offset) in
   if digit >= vlq_continuation_bit
-  then decode' src s (pos + 1) (offset + vlq_base_shift) i
+  then decode' src s (pos + 1) len (offset + vlq_base_shift) i
   else (
     src.pos <- pos + 1;
     i)
 
-let decode src = fromVLQSigned (decode' src src.string src.pos 0 0)
+let decode src = fromVLQSigned (decode' src src.string src.pos src.len 0 0)

From 7e071a6cd7e8e2669e0ac9c4e5edaa60694bd7e3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Nov 2024 14:43:03 +0100
Subject: [PATCH 443/481] Make it explicit when we manipulate standard source
 maps

---
 compiler/lib-wasm/link.ml             |  5 +++--
 compiler/lib-wasm/wasm_link.ml        |  6 +++---
 compiler/lib-wasm/wasm_source_map.ml  | 26 ++++++++------------------
 compiler/lib-wasm/wasm_source_map.mli |  6 +++---
 compiler/lib/source_map.ml            |  4 ++++
 compiler/lib/source_map.mli           |  4 ++++
 6 files changed, 25 insertions(+), 26 deletions(-)

diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml
index 3505488067..46c3242717 100644
--- a/compiler/lib-wasm/link.ml
+++ b/compiler/lib-wasm/link.ml
@@ -860,11 +860,12 @@ let rec get_source_map_files files src_index =
   if Zip.has_entry z ~name:"source_map.map"
   then
     let data = Zip.read_entry z ~name:"source_map.map" in
-    let sm = Source_map.of_string data in
+    let sm = Source_map.Standard.of_string data in
     if not (Wasm_source_map.is_empty sm)
     then (
       let l = ref [] in
-      Wasm_source_map.iter_sources sm (fun i j file -> l := source_name i j file :: !l);
+      Wasm_source_map.iter_sources (Standard sm) (fun i j file ->
+          l := source_name i j file :: !l);
       if not (List.is_empty !l)
       then z, Array.of_list (List.rev !l)
       else (
diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
index 62ab8a9b24..6b9951cc8d 100644
--- a/compiler/lib-wasm/wasm_link.ml
+++ b/compiler/lib-wasm/wasm_link.ml
@@ -1497,7 +1497,7 @@ type t =
   { module_name : string
   ; file : string
   ; contents : Read.t
-  ; source_map_contents : Source_map.t option
+  ; source_map_contents : Source_map.Standard.t option
   }
 
 type import_status =
@@ -1877,8 +1877,8 @@ let f files ~output_file ~opt_output_sourcemap_file =
             Option.map
               ~f:(fun src ->
                 match src with
-                | `File file -> Source_map.of_file ~tmp_buf file
-                | `Data data -> Source_map.of_string ~tmp_buf data)
+                | `File file -> Source_map.Standard.of_file ~tmp_buf file
+                | `Data data -> Source_map.Standard.of_string ~tmp_buf data)
               opt_source_map
         })
       (Array.of_list files)
diff --git a/compiler/lib-wasm/wasm_source_map.ml b/compiler/lib-wasm/wasm_source_map.ml
index 77e7f18eda..326140cf91 100644
--- a/compiler/lib-wasm/wasm_source_map.ml
+++ b/compiler/lib-wasm/wasm_source_map.ml
@@ -82,19 +82,12 @@ let resize_mappings (resize_data : resize_data) mappings =
       0;
     Buffer.contents buf
 
-let resize resize_data sm =
-  match sm with
-  | Source_map.Index _ -> assert false
-  | Standard sm ->
-      let mappings = Source_map.Mappings.to_string sm.mappings in
-      let mappings = resize_mappings resize_data mappings in
-      Source_map.Standard
-        { sm with mappings = Source_map.Mappings.of_string_unsafe mappings }
-
-let is_empty sm =
-  match sm with
-  | Source_map.Standard { mappings; _ } -> Source_map.Mappings.is_empty mappings
-  | _ -> assert false
+let resize resize_data (sm : Source_map.Standard.t) =
+  let mappings = Source_map.Mappings.to_string sm.mappings in
+  let mappings = resize_mappings resize_data mappings in
+  { sm with mappings = Source_map.Mappings.of_string_unsafe mappings }
+
+let is_empty { Source_map.Standard.mappings; _ } = Source_map.Mappings.is_empty mappings
 
 let concatenate l =
   Source_map.Index
@@ -102,11 +95,8 @@ let concatenate l =
     ; file = None
     ; sections =
         List.map
-          ~f:(fun (ofs, sm) ->
-            match sm with
-            | Source_map.Index _ -> assert false
-            | Standard map ->
-                { Source_map.Index.offset = { gen_line = 0; gen_column = ofs }; map })
+          ~f:(fun (ofs, map) ->
+            { Source_map.Index.offset = { gen_line = 0; gen_column = ofs }; map })
           l
     }
 
diff --git a/compiler/lib-wasm/wasm_source_map.mli b/compiler/lib-wasm/wasm_source_map.mli
index 65ab1f97ff..5bb885c0d2 100644
--- a/compiler/lib-wasm/wasm_source_map.mli
+++ b/compiler/lib-wasm/wasm_source_map.mli
@@ -1,6 +1,6 @@
 type t
 
-val is_empty : Source_map.t -> bool
+val is_empty : Source_map.Standard.t -> bool
 
 type resize_data =
   { mutable i : int
@@ -8,9 +8,9 @@ type resize_data =
   ; mutable delta : int array
   }
 
-val resize : resize_data -> Source_map.t -> Source_map.t
+val resize : resize_data -> Source_map.Standard.t -> Source_map.Standard.t
 
-val concatenate : (int * Source_map.t) list -> Source_map.t
+val concatenate : (int * Source_map.Standard.t) list -> Source_map.t
 
 val iter_sources : Source_map.t -> (int option -> int option -> string -> unit) -> unit
 
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
index e2733a5219..e6eb2a5c01 100644
--- a/compiler/lib/source_map.ml
+++ b/compiler/lib/source_map.ml
@@ -564,6 +564,10 @@ module Standard = struct
         }
     | _ -> invalid ()
 
+  let of_string ?tmp_buf s = of_json ?tmp_buf (Yojson.Raw.from_string ?buf:tmp_buf s)
+
+  let of_file ?tmp_buf f = of_json ?tmp_buf (Yojson.Raw.from_file ?buf:tmp_buf f)
+
   let to_string m = Yojson.Raw.to_string (json m)
 
   let to_file m file = Yojson.Raw.to_file file (json m)
diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli
index f8d01c2072..217e437e09 100644
--- a/compiler/lib/source_map.mli
+++ b/compiler/lib/source_map.mli
@@ -116,6 +116,10 @@ module Standard : sig
     linear in function of the size of the input mappings. *)
 
   val empty : inline_source_content:bool -> t
+
+  val of_string : ?tmp_buf:Buffer.t -> string -> t
+
+  val of_file : ?tmp_buf:Buffer.t -> string -> t
 end
 
 module Index : sig

From b5ae6af4f9de1128a98c4895b98d5a379578a827 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Nov 2024 16:15:00 +0100
Subject: [PATCH 444/481] Source map related code clean-up

---
 compiler/bin-wasm_of_ocaml/compile.ml |  57 ++++++-----
 compiler/lib-wasm/link.ml             | 140 ++++++++++++--------------
 compiler/lib-wasm/wasm_link.ml        |  36 +++----
 compiler/lib-wasm/wasm_link.mli       |   5 +-
 4 files changed, 109 insertions(+), 129 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 50681c0206..5bb28906c3 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -234,13 +234,20 @@ let build_js_runtime ~primitives ?runtime_arguments () =
   in
   prelude ^ launcher
 
-let add_source_map sourcemap_don't_inline_content z opt_source_map_file =
-  Option.iter
-    ~f:(fun file ->
-      Zip.add_file z ~name:"source_map.map" ~file;
+let add_source_map sourcemap_don't_inline_content z opt_source_map =
+  let sm =
+    match opt_source_map with
+    | `File opt_file ->
+        Option.map opt_file ~f:(fun file ->
+            Zip.add_file z ~name:"source_map.map" ~file;
+            Source_map.of_file file)
+    | `Source_map sm ->
+        Zip.add_entry z ~name:"source_map.map" ~contents:(Source_map.to_string sm);
+        Some sm
+  in
+  Option.iter sm ~f:(fun sm ->
       if not sourcemap_don't_inline_content
       then
-        let sm = Source_map.of_file file in
         Wasm_source_map.iter_sources sm (fun i j file ->
             if Sys.file_exists file && not (Sys.is_directory file)
             then
@@ -249,7 +256,6 @@ let add_source_map sourcemap_don't_inline_content z opt_source_map_file =
                 z
                 ~name:(Link.source_name i j file)
                 ~contents:(Yojson.Basic.to_string (`String sm))))
-    opt_source_map_file
 
 let run
     { Cmd_arg.common
@@ -488,7 +494,7 @@ let run
          let compile_cmo' z cmo =
            compile_cmo cmo (fun unit_data _ tmp_wasm_file opt_tmp_map_file ->
                Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file;
-               add_source_map sourcemap_don't_inline_content z opt_tmp_map_file;
+               add_source_map sourcemap_don't_inline_content z (`File opt_tmp_map_file);
                unit_data)
          in
          let unit_data = [ compile_cmo' z cmo ] in
@@ -499,6 +505,7 @@ let run
          @@ fun tmp_output_file ->
          let z = Zip.open_out tmp_output_file in
          let unit_data =
+           let tmp_buf = Buffer.create 10000 in
            List.fold_right
              ~f:(fun cmo cont l ->
                compile_cmo cmo
@@ -508,26 +515,26 @@ let run
              ~init:(fun l ->
                Fs.with_intermediate_file (Filename.temp_file "wasm" ".wasm")
                @@ fun tmp_wasm_file ->
-               opt_with
-                 Fs.with_intermediate_file
-                 (if enable_source_maps
-                  then Some (Filename.temp_file "wasm" ".map")
-                  else None)
-               @@ fun opt_output_sourcemap_file ->
                let l = List.rev l in
-               Wasm_link.f
-                 (List.map
-                    ~f:(fun (_, _, file, opt_source_map) ->
-                      { Wasm_link.module_name = "OCaml"
-                      ; file
-                      ; code = None
-                      ; opt_source_map = Option.map ~f:(fun f -> `File f) opt_source_map
-                      })
-                    l)
-                 ~output_file:tmp_wasm_file
-                 ~opt_output_sourcemap_file;
+               let source_map =
+                 Wasm_link.f
+                   (List.map
+                      ~f:(fun (_, _, file, opt_source_map) ->
+                        { Wasm_link.module_name = "OCaml"
+                        ; file
+                        ; code = None
+                        ; opt_source_map =
+                            Option.map
+                              ~f:(fun f -> Source_map.Standard.of_file ~tmp_buf f)
+                              opt_source_map
+                        })
+                      l)
+                   ~output_file:tmp_wasm_file
+               in
                Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file;
-               add_source_map sourcemap_don't_inline_content z opt_output_sourcemap_file;
+               if enable_source_maps
+               then
+                 add_source_map sourcemap_don't_inline_content z (`Source_map source_map);
                List.map ~f:(fun (unit_data, _, _, _) -> unit_data) l)
              []
          in
diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml
index 46c3242717..9b7e04a081 100644
--- a/compiler/lib-wasm/link.ml
+++ b/compiler/lib-wasm/link.ml
@@ -849,63 +849,51 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
   if times () then Format.eprintf "    build JS runtime: %a@." Timer.print t1;
   if times () then Format.eprintf "  emit: %a@." Timer.print t
 
-let opt_with action x f =
-  match x with
-  | None -> f None
-  | Some x -> action x (fun y -> f (Some y))
-
-let rec get_source_map_files files src_index =
+let rec get_source_map_files ~tmp_buf files src_index =
   let z = Zip.open_in files.(!src_index) in
   incr src_index;
-  if Zip.has_entry z ~name:"source_map.map"
-  then
-    let data = Zip.read_entry z ~name:"source_map.map" in
-    let sm = Source_map.Standard.of_string data in
-    if not (Wasm_source_map.is_empty sm)
-    then (
-      let l = ref [] in
-      Wasm_source_map.iter_sources (Standard sm) (fun i j file ->
-          l := source_name i j file :: !l);
-      if not (List.is_empty !l)
-      then z, Array.of_list (List.rev !l)
-      else (
-        Zip.close_in z;
-        get_source_map_files files src_index))
-    else (
-      Zip.close_in z;
-      get_source_map_files files src_index)
-  else get_source_map_files files src_index
-
-let add_source_map files z opt_source_map_file =
-  Option.iter
-    ~f:(fun file ->
-      Zip.add_file z ~name:"source_map.map" ~file;
-      let sm = Source_map.of_file file in
-      let files = Array.of_list files in
-      let src_index = ref 0 in
-      let st = ref None in
-      let finalize () =
+  let l = ref [] in
+  (if Zip.has_entry z ~name:"source_map.map"
+   then
+     let data = Zip.read_entry z ~name:"source_map.map" in
+     let sm = Source_map.Standard.of_string ~tmp_buf data in
+     if not (Wasm_source_map.is_empty sm)
+     then
+       Wasm_source_map.iter_sources (Standard sm) (fun i j file ->
+           l := source_name i j file :: !l));
+  if not (List.is_empty !l)
+  then z, Array.of_list (List.rev !l)
+  else (
+    Zip.close_in z;
+    get_source_map_files ~tmp_buf files src_index)
+
+let add_source_map files z sm =
+  let tmp_buf = Buffer.create 10000 in
+  Zip.add_entry z ~name:"source_map.map" ~contents:(Source_map.to_string sm);
+  let files = Array.of_list files in
+  let src_index = ref 0 in
+  let st = ref None in
+  let finalize () =
+    match !st with
+    | Some (_, (z', _)) -> Zip.close_in z'
+    | None -> ()
+  in
+  Wasm_source_map.iter_sources sm (fun i j file ->
+      let z', files =
         match !st with
-        | Some (_, (z', _)) -> Zip.close_in z'
-        | None -> ()
+        | Some (i', st) when Poly.equal i i' -> st
+        | _ ->
+            let st' = get_source_map_files ~tmp_buf files src_index in
+            finalize ();
+            st := Some (i, st');
+            st'
       in
-      Wasm_source_map.iter_sources sm (fun i j file ->
-          let z', files =
-            match !st with
-            | Some (i', st) when Poly.equal i i' -> st
-            | _ ->
-                let st' = get_source_map_files files src_index in
-                finalize ();
-                st := Some (i, st');
-                st'
-          in
-          if Array.length files > 0 (* Source has source map *)
-          then
-            let name = files.(Option.value ~default:0 j) in
-            if Zip.has_entry z' ~name
-            then Zip.copy_file z' z ~src_name:name ~dst_name:(source_name i j file));
-      finalize ())
-    opt_source_map_file
+      if Array.length files > 0 (* Source has source map *)
+      then
+        let name = files.(Option.value ~default:0 j) in
+        if Zip.has_entry z' ~name
+        then Zip.copy_file z' z ~src_name:name ~dst_name:(source_name i j file));
+  finalize ()
 
 let make_library ~output_file ~enable_source_maps ~files =
   let info =
@@ -936,33 +924,31 @@ let make_library ~output_file ~enable_source_maps ~files =
   @@ fun tmp_output_file ->
   let z = Zip.open_out tmp_output_file in
   add_info z ~build_info ~unit_data ();
-  (*
-- Merge all code files into a single code file (gathering source maps)
-- Copy source files
-*)
   Fs.with_intermediate_file (Filename.temp_file "wasm" ".wasm")
   @@ fun tmp_wasm_file ->
-  opt_with
-    Fs.with_intermediate_file
-    (if enable_source_maps then Some (Filename.temp_file "wasm" ".map") else None)
-  @@ fun opt_output_sourcemap_file ->
-  Wasm_link.f
-    (List.map
-       ~f:(fun file ->
-         let z' = Zip.open_in file in
-         { Wasm_link.module_name = "OCaml"
-         ; file
-         ; code = Some (Zip.read_entry z' ~name:"code.wasm")
-         ; opt_source_map =
-             (if Zip.has_entry z' ~name:"source_map.map"
-              then Some (`Data (Zip.read_entry z' ~name:"source_map.map"))
-              else None)
-         })
-       files)
-    ~output_file:tmp_wasm_file
-    ~opt_output_sourcemap_file;
+  let output_sourcemap =
+    Wasm_link.f
+      (let tmp_buf = Buffer.create 10000 in
+       List.map
+         ~f:(fun file ->
+           let z' = Zip.open_in file in
+           { Wasm_link.module_name = "OCaml"
+           ; file
+           ; code = Some (Zip.read_entry z' ~name:"code.wasm")
+           ; opt_source_map =
+               (if enable_source_maps && Zip.has_entry z' ~name:"source_map.map"
+                then
+                  Some
+                    (Source_map.Standard.of_string
+                       ~tmp_buf
+                       (Zip.read_entry z' ~name:"source_map.map"))
+                else None)
+           })
+         files)
+      ~output_file:tmp_wasm_file
+  in
   Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file;
-  add_source_map files z opt_output_sourcemap_file;
+  if enable_source_maps then add_source_map files z output_sourcemap;
   Zip.close_out z
 
 let link ~output_file ~linkall ~mklib ~enable_source_maps ~files =
diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
index 6b9951cc8d..922676880a 100644
--- a/compiler/lib-wasm/wasm_link.ml
+++ b/compiler/lib-wasm/wasm_link.ml
@@ -1856,12 +1856,11 @@ type input =
   { module_name : string
   ; file : string
   ; code : string option
-  ; opt_source_map : [ `File of string | `Data of string ] option
+  ; opt_source_map : Source_map.Standard.t option
   }
 
-let f files ~output_file ~opt_output_sourcemap_file =
+let f files ~output_file =
   let files =
-    let tmp_buf = Buffer.create 10000 in
     Array.map
       ~f:(fun { module_name; file; code; opt_source_map } ->
         let data =
@@ -1870,17 +1869,7 @@ let f files ~output_file ~opt_output_sourcemap_file =
           | Some data -> data
         in
         let contents = Read.open_in file data in
-        { module_name
-        ; file
-        ; contents
-        ; source_map_contents =
-            Option.map
-              ~f:(fun src ->
-                match src with
-                | `File file -> Source_map.Standard.of_file ~tmp_buf file
-                | `Data data -> Source_map.Standard.of_string ~tmp_buf data)
-              opt_source_map
-        })
+        { module_name; file; contents; source_map_contents = opt_source_map })
       (Array.of_list files)
   in
 
@@ -2274,15 +2263,12 @@ let f files ~output_file ~opt_output_sourcemap_file =
     pos_out out_ch + 1 + Buffer.length b
   in
   add_section out_ch ~id:10 code_pieces;
-  Option.iter
-    ~f:(fun file ->
-      Source_map.to_file
-        (Wasm_source_map.concatenate
-           (List.map
-              ~f:(fun (pos, sm) -> pos + code_section_offset, sm)
-              (List.rev !source_maps)))
-        file)
-    opt_output_sourcemap_file;
+  let source_map =
+    Wasm_source_map.concatenate
+      (List.map
+         ~f:(fun (pos, sm) -> pos + code_section_offset, sm)
+         (List.rev !source_maps))
+  in
 
   (* 11: data *)
   ignore
@@ -2429,7 +2415,9 @@ let f files ~output_file ~opt_output_sourcemap_file =
 
   add_section out_ch ~id:0 name_section_buffer;
 
-  close_out out_ch
+  close_out out_ch;
+
+  source_map
 
 (*
 LATER
diff --git a/compiler/lib-wasm/wasm_link.mli b/compiler/lib-wasm/wasm_link.mli
index 96f21db202..f3655f3557 100644
--- a/compiler/lib-wasm/wasm_link.mli
+++ b/compiler/lib-wasm/wasm_link.mli
@@ -2,8 +2,7 @@ type input =
   { module_name : string
   ; file : string
   ; code : string option
-  ; opt_source_map : [ `File of string | `Data of string ] option
+  ; opt_source_map : Source_map.Standard.t option
   }
 
-val f :
-  input list -> output_file:string -> opt_output_sourcemap_file:string option -> unit
+val f : input list -> output_file:string -> Source_map.t

From c04eca53b4dd568c36090d02d64dd2c1d3755755 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Nov 2024 16:34:11 +0100
Subject: [PATCH 445/481] Add missing copyright headers

---
 compiler/lib-wasm/sexp.ml             | 19 ++++++++++++++++++-
 compiler/lib-wasm/sexp.mli            | 18 ++++++++++++++++++
 compiler/lib-wasm/wasm_link.ml        | 18 ++++++++++++++++++
 compiler/lib-wasm/wasm_link.mli       | 18 ++++++++++++++++++
 compiler/lib-wasm/wasm_output.ml      | 18 ++++++++++++++++++
 compiler/lib-wasm/wasm_output.mli     | 18 ++++++++++++++++++
 compiler/lib-wasm/wasm_source_map.ml  | 18 ++++++++++++++++++
 compiler/lib-wasm/wasm_source_map.mli | 18 ++++++++++++++++++
 8 files changed, 144 insertions(+), 1 deletion(-)

diff --git a/compiler/lib-wasm/sexp.ml b/compiler/lib-wasm/sexp.ml
index ccf1f7199d..78d6f5c521 100644
--- a/compiler/lib-wasm/sexp.ml
+++ b/compiler/lib-wasm/sexp.ml
@@ -1,4 +1,21 @@
-(* ()#;"" space <-- reserved *)
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open Stdlib
 
 type t =
diff --git a/compiler/lib-wasm/sexp.mli b/compiler/lib-wasm/sexp.mli
index c0a6cb404b..41d5fd173f 100644
--- a/compiler/lib-wasm/sexp.mli
+++ b/compiler/lib-wasm/sexp.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type t =
   | Atom of string
   | List of t list
diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
index 62ab8a9b24..ca636f5ee3 100644
--- a/compiler/lib-wasm/wasm_link.ml
+++ b/compiler/lib-wasm/wasm_link.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open Stdlib
 
 type heaptype =
diff --git a/compiler/lib-wasm/wasm_link.mli b/compiler/lib-wasm/wasm_link.mli
index 96f21db202..aa9a86255a 100644
--- a/compiler/lib-wasm/wasm_link.mli
+++ b/compiler/lib-wasm/wasm_link.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type input =
   { module_name : string
   ; file : string
diff --git a/compiler/lib-wasm/wasm_output.ml b/compiler/lib-wasm/wasm_output.ml
index 542499721a..02fa6d6ad2 100644
--- a/compiler/lib-wasm/wasm_output.ml
+++ b/compiler/lib-wasm/wasm_output.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open! Stdlib
 open Wasm_ast
 
diff --git a/compiler/lib-wasm/wasm_output.mli b/compiler/lib-wasm/wasm_output.mli
index 80de3da658..9e01eb96a6 100644
--- a/compiler/lib-wasm/wasm_output.mli
+++ b/compiler/lib-wasm/wasm_output.mli
@@ -1 +1,19 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 val f : out_channel -> Wasm_ast.module_field list -> unit
diff --git a/compiler/lib-wasm/wasm_source_map.ml b/compiler/lib-wasm/wasm_source_map.ml
index 06f9b6cad8..720194a79d 100644
--- a/compiler/lib-wasm/wasm_source_map.ml
+++ b/compiler/lib-wasm/wasm_source_map.ml
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
 open Stdlib
 
 type resize_data =
diff --git a/compiler/lib-wasm/wasm_source_map.mli b/compiler/lib-wasm/wasm_source_map.mli
index 65ab1f97ff..711ea3085d 100644
--- a/compiler/lib-wasm/wasm_source_map.mli
+++ b/compiler/lib-wasm/wasm_source_map.mli
@@ -1,3 +1,21 @@
+(* Wasm_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
 type t
 
 val is_empty : Source_map.t -> bool

From a42f3268659ae80e70087cb39e31b4439013edcc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Nov 2024 16:45:20 +0100
Subject: [PATCH 446/481] Cmdliner documentation update

---
 compiler/bin-wasm_of_ocaml/build_runtime.ml |  5 +----
 compiler/bin-wasm_of_ocaml/info.ml          |  2 +-
 compiler/bin-wasm_of_ocaml/link.ml          | 10 +++++-----
 3 files changed, 7 insertions(+), 10 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/build_runtime.ml b/compiler/bin-wasm_of_ocaml/build_runtime.ml
index 774a8ba53d..79762a70b7 100644
--- a/compiler/bin-wasm_of_ocaml/build_runtime.ml
+++ b/compiler/bin-wasm_of_ocaml/build_runtime.ml
@@ -22,10 +22,7 @@ let info =
   Info.make
     ~name:"build-runtime"
     ~doc:"Build standalone runtime. Used for separate compilation."
-    ~description:
-      "Js_of_ocaml is a compiler from OCaml bytecode to Javascript. It makes it possible \
-       to run pure OCaml programs in JavaScript environments like web browsers and \
-       Node.js."
+    ~description:"Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly."
 
 let command =
   let t = Cmdliner.Term.(const Compile.run $ Cmd_arg.options_runtime_only) in
diff --git a/compiler/bin-wasm_of_ocaml/info.ml b/compiler/bin-wasm_of_ocaml/info.ml
index 33cd21e5bc..c297de5b6c 100644
--- a/compiler/bin-wasm_of_ocaml/info.ml
+++ b/compiler/bin-wasm_of_ocaml/info.ml
@@ -32,7 +32,7 @@ let make ~name ~doc ~description =
     ; `S "AUTHORS"
     ; `P "Jerome Vouillon, Hugo Heuzard."
     ; `S "LICENSE"
-    ; `P "Copyright (C) 2010-2020."
+    ; `P "Copyright (C) 2010-2024."
     ; `P
         "js_of_ocaml 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 \
diff --git a/compiler/bin-wasm_of_ocaml/link.ml b/compiler/bin-wasm_of_ocaml/link.ml
index 48cd0bc103..f158abbbfa 100644
--- a/compiler/bin-wasm_of_ocaml/link.ml
+++ b/compiler/bin-wasm_of_ocaml/link.ml
@@ -44,9 +44,9 @@ let options =
   in
   let files =
     let doc =
-      "Link the archive files [$(docv)]. The first archive must be a runtime produced by \
-       $(b,wasm_of_ocaml build-runtime). The other archives can be produced by compiling \
-       .cma or .cmo files."
+      "Link the archive files [$(docv)]. Unless the $(b,-a) option is used, the first \
+       archive must be a runtime produced by $(b,wasm_of_ocaml build-runtime). The other \
+       archives can be produced by compiling .cma or .cmo files."
     in
     Arg.(non_empty & pos_all string [] & info [] ~docv:"FILES" ~doc)
   in
@@ -88,8 +88,8 @@ let info =
     ~name:"link"
     ~doc:"Wasm_of_ocaml linker"
     ~description:
-      "wasm_of_ocaml-link is a JavaScript linker. It can concatenate multiple JavaScript \
-       files keeping sourcemap information."
+      "wasm_of_ocaml-link links together several wasm_of_ocaml intermediate files to \
+       produce either a library or some executable code."
 
 let command =
   let t = Cmdliner.Term.(const f $ options) in

From 370ef420d27d42bb6c96038c24bb39823c54b7f6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Thu, 7 Nov 2024 18:25:22 +0100
Subject: [PATCH 447/481] CI updates

---
 .github/workflows/build-wasm_of_ocaml.yml | 94 +++++++----------------
 tools/ci_setup.ml                         |  8 +-
 2 files changed, 30 insertions(+), 72 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index bdac08d974..eea57fefb0 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -20,9 +20,15 @@ jobs:
           - 5.00.x
           - 5.01.x
           - 5.02.x
+        separate_compilation:
+          - true
         include:
           - os: macos-latest
             ocaml-compiler: 5.02.x
+            separate_compilation: true
+          - os: ubuntu-latest
+            ocaml-compiler: 4.14.x
+            separate_compilation: false
 
     runs-on: ${{ matrix.os }}
 
@@ -80,51 +86,10 @@ jobs:
         run: |
           echo "$GITHUB_WORKSPACE/binaryen/bin" >> $GITHUB_PATH
 
-      - name: Restore cached OCaml
-        id: cache-ocaml
-        uses: actions/cache/restore@v4
-        with:
-          path: |
-            ~/.opam
-            _opam
-            /opt/hostedtoolcache/opam
-            /Users/runner/hostedtoolcache/opam
-          key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
-
       - name: Install OCaml ${{ matrix.ocaml-compiler }}
-        if: steps.cache-ocaml.outputs.cache-hit != 'true'
         uses: ocaml/setup-ocaml@v3
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
-          dune-cache: true
-          opam-depext: true
-          opam-depext-flags: --with-test
-
-      - name: Install packages (Ubuntu)
-        if: matrix.os == 'ubuntu-latest' && steps.cache-ocaml.outputs.cache-hit
-        run: sudo apt-get install bubblewrap
-
-      - name: Install packages (MacOs)
-        if: matrix.os == 'macos-latest' && steps.cache-ocaml.outputs.cache-hit
-        # for graphics
-        run: brew install xquartz
-
-      - name: Set opam path
-        if: steps.cache-ocaml.outputs.cache-hit
-        run: |
-          echo /opt/hostedtoolcache/opam/*/x86_64 >> $GITHUB_PATH
-          echo /Users/runner/hostedtoolcache/opam/*/arm64 >> $GITHUB_PATH
-
-      - name: Cache OCaml
-        if: steps.cache-ocaml.outputs.cache-hit != 'true'
-        uses: actions/cache/save@v4
-        with:
-          path: |
-            ~/.opam
-            _opam
-            /opt/hostedtoolcache/opam
-            /Users/runner/hostedtoolcache/opam
-          key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}
 
       - name: Checkout code
         uses: actions/checkout@v4
@@ -133,11 +98,7 @@ jobs:
 
       - name: Pin faked binaryen-bin package
         # It's faster to use a cached version
-        working-directory: ./binaryen
-        run: |
-          echo opam-version: '"2.0"' > binaryen-bin.opam
-          opam pin -n .
-          rm binaryen-bin.opam
+        run: opam install --fake binaryen-bin
 
       - name: Checkout Jane Street opam repository
         uses: actions/checkout@v4
@@ -147,82 +108,79 @@ jobs:
           path: jane-street/opam-repository
 
       - name: Pin dune
-        run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
+        run: opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
 
       - name: Pin wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
-        run: |
-           for i in *.opam; do opam pin add -n `basename $i .opam`.`< VERSION` .; done
+        run: opam pin -n --with-version `< VERSION` .
 
-      - name: Install opam file parser
-        run: opam install opam-format ocamlfind dune graphics
+      - name: Install some needed packages
+        run: opam install opam-format ocamlfind dune graphics cmdliner sexplib0.v0.16.0
 
       - name: Checkout Jane Street packages
         run: opam exec -- ocaml wasm_of_ocaml/tools/ci_setup.ml
 
-      - name: Update test dependencies
-        run: opam install num cohttp-lwt-unix ppx_expect cstruct
-
-      - name: Install wasm_of_ocaml
+      - name: Install wasm_of_ocaml and its test dependencies
         working-directory: ./wasm_of_ocaml
-        run: opam install `basename -s .opam *.opam`
+        run: |
+          opam install `basename -s .opam *.opam` num cohttp-lwt-unix ppx_expect cstruct
 
       - name: Run tests
+        if: ${{ matrix.separate_compilation }}
         working-directory: ./wasm_of_ocaml
         run: opam exec -- dune build @all @runtest --profile wasm
 
       - name: Run tests with CPS effects
-        if: ${{ matrix.ocaml-compiler >= '5.' }}
+        if: ${{ matrix.ocaml-compiler >= '5.' && matrix.separate_compilation }}
         working-directory: ./wasm_of_ocaml
         run: opam exec -- dune build @all @runtest --profile wasm-effects
 
       - name: Run Base tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/base
         run: opam exec -- dune runtest
 
       - name: Run Base bigstring tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/base_bigstring
         run: opam exec -- dune runtest
 
       - name: Run Core tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/core
         run: opam exec -- dune runtest
 
       - name: Run Bignum tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/bignum
         run: opam exec -- dune runtest
 
       - name: Run Bin_prot tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/bin_prot
         run: opam exec -- dune runtest
 
       - name: Run String_dict tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/string_dict
         run: opam exec -- dune runtest
 
       - name: Run Zarith tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/zarith_stubs_js
         run: opam exec -- dune runtest
 
       - name: Run Virtual_dom tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/virtual_dom
         run: opam exec -- dune runtest
 
       - name: Run Bonsai tests
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ matrix.ocaml-compiler < '5.' && matrix.separate_compilation }}
         working-directory: ./jane-street/lib/bonsai
         run: opam exec -- dune runtest
 
       - name: Run Bonsai tests (release profile)
-        if: ${{ matrix.ocaml-compiler < '5.' }}
+        if: ${{ ! matrix.separate_compilation }}
         working-directory: ./jane-street/lib/bonsai
         run: opam exec -- dune runtest --profile release
diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index d3a08f6c1e..7e6dc4474d 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -18,7 +18,9 @@ let omitted_others = StringSet.of_list [ "cohttp-async"; "cohttp"; "uri"; "uri-s
 
 let omitted_js = StringSet.of_list [ "sexplib0" ]
 
-let do_not_pin = StringSet.of_list [ "wasocaml"; "wasm_of_ocaml"; "dune" ]
+let do_not_pin =
+  StringSet.of_list
+    [ "wasocaml"; "wasm_of_ocaml"; "dune"; "ezjs"; "ezjs_blockies"; "fmlib"; "graphv" ]
 
 let do_pin = StringSet.of_list [ "base"; "ppx_expect"; "ppx_inline_test"; "time_now" ]
 
@@ -141,8 +143,6 @@ index c6d09fb..61b1e5b 100644
 +    ;;
 +
      let%expect_test "bin_io de-serialization V2" =
-       (* Some bignums will have two bin_io representation depending on where their
-          were serialized.  Make sure we're able to parse things back regardless of the
 |bignum}
     )
   ]
@@ -246,7 +246,7 @@ let clone' delay ?branch ?commit nm src =
       let* () = clone delay ?branch ~depth:10 nm src in
       exec_async
         ~delay:0
-        (Printf.sprintf "cd jane-street/lib/%s && git checkout %s" nm commit)
+        (Printf.sprintf "cd jane-street/lib/%s && git checkout -b wasm %s" nm commit)
 
 let () =
   Out_channel.(

From 539390d1ced6414fadb427a7875d2fd72a6c8939 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 8 Nov 2024 14:01:47 +0100
Subject: [PATCH 448/481] Typo

---
 compiler/bin-wasm_of_ocaml/cmd_arg.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
index bb66364437..5b6c86b399 100644
--- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml
+++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -176,7 +176,7 @@ let options_runtime_only =
   in
   let no_sourcemap =
     let doc =
-      "Don't generate source map. All other source map related flags will be be ignored."
+      "Don't generate source map. All other source map related flags will be ignored."
     in
     Arg.(value & flag & info [ "no-sourcemap"; "no-source-map" ] ~doc)
   in

From 73df0b4482751eb7dccafbdd3290d2c5728cbf90 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Nov 2024 16:33:01 +0100
Subject: [PATCH 449/481] Fix CI

---
 tools/ci_setup.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tools/ci_setup.ml b/tools/ci_setup.ml
index 7e6dc4474d..2425ad78f0 100644
--- a/tools/ci_setup.ml
+++ b/tools/ci_setup.ml
@@ -243,7 +243,7 @@ let clone' delay ?branch ?commit nm src =
   match commit with
   | None -> clone delay ?branch nm src
   | Some commit ->
-      let* () = clone delay ?branch ~depth:10 nm src in
+      let* () = clone delay ?branch ~depth:100 nm src in
       exec_async
         ~delay:0
         (Printf.sprintf "cd jane-street/lib/%s && git checkout -b wasm %s" nm commit)

From 416dfd28be207585828d68c14d0d8a89408fbcf7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Nov 2024 15:19:27 +0100
Subject: [PATCH 450/481] Fix optimization of JavaScript interoperability
 primitives

Some optimizations were no longer applied after the array initialization
fix in #113. The following functions from `Js.Unsafe` were affected:
`call`, `fun_call`, `meth_call` and `new_obj`.
---
 compiler/lib-wasm/generate.ml |  2 +-
 compiler/lib/flow.ml          | 16 ++++++++++++++++
 compiler/lib/flow.mli         |  2 ++
 compiler/lib/specialize_js.ml | 18 +++++++++---------
 4 files changed, 28 insertions(+), 10 deletions(-)

diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml
index 2e191cafb3..e766b07b1b 100644
--- a/compiler/lib-wasm/generate.ml
+++ b/compiler/lib-wasm/generate.ml
@@ -1170,7 +1170,7 @@ let init () =
   let l =
     [ "caml_ensure_stack_capacity", "%identity"; "caml_callback", "caml_trampoline" ]
   in
-
+  Primitive.register "caml_make_array" `Mutable None None;
   let l =
     if Config.Flag.effects ()
     then ("caml_alloc_stack", "caml_cps_alloc_stack") :: l
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 21712fd03e..9d4a4b5938 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -198,6 +198,7 @@ let rec block_escape st x =
             | Immutable -> ()
             | Maybe_mutable -> Code.Var.ISet.add st.possibly_mutable y);
             Array.iter l ~f:(fun z -> block_escape st z)
+        | Expr (Prim (Extern "caml_make_array", [ Pv y ])) -> block_escape st y
         | _ -> Code.Var.ISet.add st.possibly_mutable y))
     (Var.Tbl.get st.known_origins x)
 
@@ -207,6 +208,7 @@ let expr_escape st _x e =
   | Apply { args; _ } -> List.iter args ~f:(fun x -> block_escape st x)
   | Prim (Array_get, [ Pv x; _ ]) -> block_escape st x
   | Prim ((Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) -> ()
+  | Prim (Extern "caml_make_array", [ Pv _ ]) -> ()
   | Prim (Extern name, l) ->
       let ka =
         match Primitive.kind_args name with
@@ -231,6 +233,11 @@ let expr_escape st _x e =
                 | Expr (Constant (Tuple _)) -> ()
                 | Expr (Block (_, a, _, _)) ->
                     Array.iter a ~f:(fun x -> block_escape st x)
+                | Expr (Prim (Extern "caml_make_array", [ Pv y ])) -> (
+                    match st.defs.(Var.idx y) with
+                    | Expr (Block (_, a, _, _)) ->
+                        Array.iter a ~f:(fun x -> block_escape st x)
+                    | _ -> assert false)
                 | _ -> block_escape st v)
             | Pv v, `Object_literal -> (
                 match st.defs.(Var.idx v) with
@@ -405,6 +412,15 @@ let the_native_string_of ~target info x =
   | Some (NativeString i) -> Some i
   | _ -> None
 
+let the_block_contents_of info x =
+  match the_def_of info x with
+  | Some (Block (_, a, _, _)) -> Some a
+  | Some (Prim (Extern "caml_make_array", [ x ])) -> (
+      match the_def_of info x with
+      | Some (Block (_, a, _, _)) -> Some a
+      | _ -> None)
+  | _ -> None
+
 (*XXX Maybe we could iterate? *)
 let direct_approx (info : Info.t) x =
   match info.info_defs.(Var.idx x) with
diff --git a/compiler/lib/flow.mli b/compiler/lib/flow.mli
index 20271a4e3f..32801ac301 100644
--- a/compiler/lib/flow.mli
+++ b/compiler/lib/flow.mli
@@ -61,6 +61,8 @@ val the_string_of :
 val the_native_string_of :
   target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.Native_string.t option
 
+val the_block_contents_of : Info.t -> Code.prim_arg -> Code.Var.t array option
+
 val the_int :
   target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Targetint.t option
 
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
index 4fa7c7776c..f1a28ef6a3 100644
--- a/compiler/lib/specialize_js.ml
+++ b/compiler/lib/specialize_js.ml
@@ -55,22 +55,22 @@ let specialize_instr ~target info i =
       | Some _ -> Let (x, Constant (Int Targetint.zero))
       | None -> i)
   | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), _ -> (
-      match the_def_of info a with
-      | Some (Block (_, a, _, _)) ->
+      match the_block_contents_of info a with
+      | Some a ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_call", f :: o :: Array.to_list a))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])), _ -> (
-      match the_def_of info a with
-      | Some (Block (_, a, _, _)) ->
+      match the_block_contents_of info a with
+      | Some a ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), _ -> (
       match the_string_of ~target info m with
       | Some m when Javascript.is_ident m -> (
-          match the_def_of info a with
-          | Some (Block (_, a, _, _)) ->
+          match the_block_contents_of info a with
+          | Some a ->
               let a = Array.map a ~f:(fun x -> Pv x) in
               Let
                 ( x
@@ -79,11 +79,11 @@ let specialize_instr ~target info i =
                     , o
                       :: Pc (NativeString (Native_string.of_string m))
                       :: Array.to_list a ) )
-          | _ -> i)
+          | None -> i)
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_new", [ c; a ])), _ -> (
-      match the_def_of info a with
-      | Some (Block (_, a, _, _)) ->
+      match the_block_contents_of info a with
+      | Some a ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_new", c :: Array.to_list a))
       | _ -> i)

From 59f3462ae6bf9b64b7fbefce67ad6d3f8dd27265 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 22 Nov 2024 15:56:23 +0100
Subject: [PATCH 451/481] Optimized JavaScript property accesses when using an
 OCaml string as a key

The OCaml string is converted to a JavaScript string at compile time.
This make us generate better code for the functions
`Ojs.{get,set,delete}_prop_ascii` from gen_js_api.
---
 compiler/lib/flow.ml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 9d4a4b5938..799027de83 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -410,6 +410,7 @@ let the_string_of ~target info x =
 let the_native_string_of ~target info x =
   match the_const_of ~target info x with
   | Some (NativeString i) -> Some i
+  | Some (String i) -> Some (Native_string.of_bytestring i)
   | _ -> None
 
 let the_block_contents_of info x =

From 6aac8695aa8ca311f7403905005a58d711636b19 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Sat, 20 Apr 2024 00:21:06 +0200
Subject: [PATCH 452/481] Update to new JavaScript-Promise Integration API

---
 .github/workflows/build-wasm_of_ocaml.yml |  2 +-
 compiler/lib-wasm/gc_target.ml            | 25 ++++++++----------
 runtime/wasm/effect.wat                   | 25 +++---------------
 runtime/wasm/runtime.js                   | 31 ++++++-----------------
 4 files changed, 23 insertions(+), 60 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index eea57fefb0..7f5e1eb656 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -42,7 +42,7 @@ jobs:
       - name: Install node
         uses: actions/setup-node@v4
         with:
-          node-version: 22
+          node-version: 23
 
       - name: Restore cached binaryen
         id: cache-binaryen
diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml
index bf8845a2bb..9f51c9486e 100644
--- a/compiler/lib-wasm/gc_target.ml
+++ b/compiler/lib-wasm/gc_target.ml
@@ -1703,19 +1703,18 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler =
 let post_process_function_body = Initialize_locals.f
 
 let entry_point ~toplevel_fun =
-  let suspender = Code.Var.fresh () in
   let code =
-    let* f =
-      register_import
-        ~name:
-          (if Config.Flag.effects ()
-           then "caml_cps_initialize_effects"
-           else "caml_initialize_effects")
-        (Fun { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] })
+    let* () =
+      if Config.Flag.effects ()
+      then
+        let* f =
+          register_import
+            ~name:"caml_cps_initialize_effects"
+            (Fun { W.params = []; result = [] })
+        in
+        instr (W.CallInstr (f, []))
+      else return ()
     in
-    let* _ = add_var suspender in
-    let* s = load suspender in
-    let* () = instr (W.CallInstr (f, [ s ])) in
     let* main =
       register_import
         ~name:"caml_main"
@@ -1723,6 +1722,4 @@ let entry_point ~toplevel_fun =
     in
     instr (W.CallInstr (main, [ RefFunc toplevel_fun ]))
   in
-  ( { W.params = [ W.Ref { nullable = true; typ = Extern } ]; result = [] }
-  , [ suspender ]
-  , code )
+  { W.params = []; result = [] }, [], code
diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat
index 6d17704405..dbc41b3c76 100644
--- a/runtime/wasm/effect.wat
+++ b/runtime/wasm/effect.wat
@@ -33,8 +33,7 @@
    (import "bindings" "start_fiber" (func $start_fiber (param (ref eq))))
    (import "bindings" "suspend_fiber"
       (func $suspend_fiber
-         (param externref) (param $f funcref) (param $env eqref)
-         (result eqref)))
+         (param $f funcref) (param $env eqref) (result anyref)))
    (import "bindings" "resume_fiber"
       (func $resume_fiber (param externref) (param (ref eq))))
 
@@ -60,9 +59,6 @@
 
    ;; Low-level primitives
 
-   (global $current_suspender (export "current_suspender") (mut externref)
-      (ref.null extern))
-
    ;; Capturing the current continuation
 
    (type $cont_func (func (param (ref $pair)) (param (ref eq))))
@@ -102,7 +98,6 @@
       (return_call $apply_pair
          (ref.cast (ref $pair)
             (call $suspend_fiber
-               (global.get $current_suspender)
                (ref.func $apply_continuation)
                (struct.new $thunk (local.get $f) (local.get $v))))))
 
@@ -121,7 +116,6 @@
          (struct
             (field $handlers (mut (ref $handlers)))
             (field $cont (ref $cont))
-            (field $suspender externref)
             (field $next (ref null $fiber)))))
 
    (data $effect_unhandled "Effect.Unhandled")
@@ -178,7 +172,6 @@
                (ref.func $dummy_fun)
                (ref.func $uncaught_effect_handler)))
          (struct.new $cont (ref.func $default_continuation))
-         (ref.null extern)
          (ref.null $fiber)))
 
    ;; Utility functions moving fibers between a continuation and the
@@ -189,8 +182,6 @@
       (local.set $f (ref.as_non_null (global.get $stack)))
       (global.set $stack
          (struct.get $fiber $next (local.get $f)))
-      (global.set $current_suspender
-         (struct.get $fiber $suspender (local.get $f)))
       (struct.get $fiber $cont (local.get $f)))
 
    (func $push_stack
@@ -202,10 +193,7 @@
                (struct.new $fiber
                   (struct.get $fiber $handlers (local.get $stack))
                   (local.get $k)
-                  (global.get $current_suspender)
                   (global.get $stack)))
-            (global.set $current_suspender
-               (struct.get $fiber $suspender (local.get $stack)))
             (local.set $k
                (struct.get $fiber $cont (local.get $stack)))
             (local.set $stack
@@ -292,7 +280,6 @@
          (struct.new $fiber
              (struct.get $fiber $handlers (global.get $stack))
              (local.get $k0)
-             (global.get $current_suspender)
              (if (result (ref null $fiber))
                  (ref.test (ref $fiber) (local.get $next_fiber))
                 (then (ref.cast (ref $fiber) (local.get $next_fiber)))
@@ -331,12 +318,10 @@
          (local.tee $cont (call $pop_fiber))
          (struct.get $cont $cont_func (local.get $cont))))
 
-   (func (export "caml_start_fiber")
-      (param $suspender externref) (param $p eqref)
+   (func (export "caml_start_fiber") (param $p eqref)
       ;; Start executing some code in a new fiber
       (local $exn (ref eq))
       (local $res (ref eq))
-      (global.set $current_suspender (local.get $suspender))
       (local.set $res
          (try (result (ref eq))
             (do
@@ -366,7 +351,6 @@
       (struct.new $fiber
          (struct.new $handlers (local.get $hv) (local.get $hx) (local.get $hf))
          (struct.new $cont (ref.func $initial_cont))
-         (ref.null extern)
          (ref.null $fiber)))
 
    ;; Other functions
@@ -414,9 +398,6 @@
                (ref.i31 (global.get $cont_tag))))))
       (i32.const 0))
 
-   (func (export "caml_initialize_effects") (param $s externref)
-      (global.set $current_suspender (local.get $s)))
-
    ;; Effects through CPS transformation
 
    (type $function_2
@@ -749,6 +730,6 @@
             (local.get $ms)))
       (call $raise_unhandled (local.get $eff) (ref.i31 (i32.const 0))))
 
-   (func (export "caml_cps_initialize_effects") (param externref)
+   (func (export "caml_cps_initialize_effects")
       (global.set $caml_trampoline_ref (ref.func $caml_trampoline)))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 46c9e9a0c3..0e9ecc1170 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -111,14 +111,11 @@
 
   var start_fiber;
 
-  function wrap_fun(t, f, a) {
-    // Don't wrap if js-promise-integration is not enabled
-    // There is no way to check this without calling WebAssembly.Function
-    try {
-      return new WebAssembly.Function(t, f, a);
-    } catch (e) {
-      return f;
-    }
+  function make_suspending(f) {
+    return WebAssembly?.Suspending ? new WebAssembly.Suspending(f) : f;
+  }
+  function make_promising(f) {
+    return WebAssembly?.promising && f ? WebAssembly.promising(f) : f;
   }
 
   const decoder = new TextDecoder("utf-8", { ignoreBOM: 1 });
@@ -445,11 +442,7 @@
       throw e;
     },
     start_fiber: (x) => start_fiber(x),
-    suspend_fiber: wrap_fun(
-      { parameters: ["externref", "funcref", "eqref"], results: ["eqref"] },
-      (f, env) => new Promise((k) => f(k, env)),
-      { suspending: "first" },
-    ),
+    suspend_fiber: make_suspending((f, env) => new Promise((k) => f(k, env))),
     resume_fiber: (k, v) => k(v),
     weak_new: (v) => new WeakRef(v),
     weak_deref: (w) => {
@@ -553,16 +546,8 @@
   var buffer = caml_buffer?.buffer;
   var out_buffer = buffer && new Uint8Array(buffer, 0, buffer.length);
 
-  start_fiber = wrap_fun(
-    { parameters: ["eqref"], results: ["externref"] },
-    caml_start_fiber,
-    { promising: "first" },
-  );
-  var _initialize = wrap_fun(
-    { parameters: [], results: ["externref"] },
-    _initialize,
-    { promising: "first" },
-  );
+  start_fiber = make_promising(caml_start_fiber);
+  var _initialize = make_promising(_initialize);
   var process = globalThis.process;
   if (process && process.on) {
     process.on("uncaughtException", (err, origin) =>

From 1189e53fa3966b0028912c561ebedbc8da2a16ae Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 20 Nov 2024 17:04:41 +0100
Subject: [PATCH 453/481] CI: move

---
 .github/workflows/build.yml | 36 +---------------------------
 .github/workflows/lint.yml  | 48 +++++++++++++++++++++++++++++++++++++
 2 files changed, 49 insertions(+), 35 deletions(-)
 create mode 100644 .github/workflows/lint.yml

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 927e38546b..0c9afe9654 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -154,38 +154,4 @@ jobs:
           branch: wikidoc
           folder: doc-dev
           clean: true
-          target-folder: doc/dev/
-
-  lint-opam:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout tree
-        uses: actions/checkout@v4
-      - name: Set-up OCaml
-        uses: ocaml/setup-ocaml@v3
-        with:
-          ocaml-compiler: "5.2"
-          dune-cache: true
-      - uses: ocaml/setup-ocaml/lint-opam@v3
-
-  lint-fmt:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout tree
-        uses: actions/checkout@v4
-      - name: Set-up OCaml
-        uses: ocaml/setup-ocaml@v3
-        with:
-          ocaml-compiler: "5.2"
-          dune-cache: true
-      - uses: ocaml/setup-ocaml/lint-fmt@v3
-
-  lint-runtime:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout tree
-        uses: actions/checkout@v4
-      - name: Set-up Biome
-        uses: biomejs/setup-biome@v2
-      - name: Run biome
-        run: biome ci
+          target-folder: doc/dev/
\ No newline at end of file
diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml
new file mode 100644
index 0000000000..36f9a8c5e0
--- /dev/null
+++ b/.github/workflows/lint.yml
@@ -0,0 +1,48 @@
+name: lint
+
+on:
+  pull_request:
+  push:
+    branches:
+      - master
+
+jobs:
+  lint-opam:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout tree
+        uses: actions/checkout@v4
+      - name: Set-up OCaml
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: "5.2"
+          dune-cache: true
+      - name: Pin dune
+        run: |
+          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
+      - uses: ocaml/setup-ocaml/lint-opam@v3
+
+  lint-fmt:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout tree
+        uses: actions/checkout@v4
+      - name: Set-up OCaml
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: "5.2"
+          dune-cache: true
+      - name: Pin dune
+        run: |
+          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
+      - uses: ocaml/setup-ocaml/lint-fmt@v3
+
+  lint-runtime:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout tree
+        uses: actions/checkout@v4
+      - name: Set-up Biome
+        uses: biomejs/setup-biome@v2
+      - name: Run biome
+        run: biome ci

From d1566a4d7da377132d839a8863aecff104f6f134 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Fri, 22 Nov 2024 11:28:16 +0100
Subject: [PATCH 454/481] Release 5.9 (#1735)

---
 CHANGES.md | 4 ++--
 VERSION    | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 81d9bd1bbd..e0d314ad2c 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,10 +1,11 @@
-# dev
+# 5.9.0 (2024-11-22) - Lille
 
 ## Features/Changes
 * Misc: update testsuite to OCaml 5.2
 * Misc: CI uses opam.2.2 and no longer use sunset repo
 * Misc: yojson is no longer optional
 * Misc: reduce the diff with the wasm_of_ocaml fork
+* Misc: finalize support for OCaml 5.3
 * Compiler: speedup global_flow/global_deadcode pass on large bytecode
 * Compiler: improved global dead code elimination (#2206)
 * Compiler: speedup json parsing, relying on Yojson.Raw (#1640)
@@ -28,7 +29,6 @@
 * Toplevel: no longer set globals for toplevel initialization
 * Runtime: precompute constants used in `caml_lxm_next` (#1730)
 * Runtime: cleanup runtime
-* Runtime: add support for OCaml 5.3
 
 ## Bug fixes
 * Runtime: fix parsing of unsigned integers (0u2147483648) (#1633, #1666)
diff --git a/VERSION b/VERSION
index 5e21ca5a89..b3d91f9cfc 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-5.8.2
+5.9.0

From 5220982ba0cc1aa3e034226438105684f689ab35 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Sat, 23 Nov 2024 10:59:36 +0100
Subject: [PATCH 455/481] Misc: adjust opam constraint (#1742)

---
 dune-project              | 2 +-
 js_of_ocaml-compiler.opam | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/dune-project b/dune-project
index e82c37fec4..0407b41f34 100644
--- a/dune-project
+++ b/dune-project
@@ -29,7 +29,7 @@
   menhir
   menhirLib
   menhirSdk
-  yojson)
+  (yojson (>= 1.6)))
  (depopts
   ocamlfind)
  (conflicts
diff --git a/js_of_ocaml-compiler.opam b/js_of_ocaml-compiler.opam
index 0a3cf50d9c..131e3e5c12 100644
--- a/js_of_ocaml-compiler.opam
+++ b/js_of_ocaml-compiler.opam
@@ -24,7 +24,7 @@ depends: [
   "menhir"
   "menhirLib"
   "menhirSdk"
-  "yojson"
+  "yojson" {>= "1.6"}
   "odoc" {with-doc}
 ]
 depopts: ["ocamlfind"]

From 3785e99c6b1b38403bb146c91c95c6437225dc90 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Mon, 25 Nov 2024 15:26:24 +0100
Subject: [PATCH 456/481] Lib: small refactoring around js exception printing
 (#1743)

---
 lib/js_of_ocaml/js.ml | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml
index e9972add32..9422def2c2 100644
--- a/lib/js_of_ocaml/js.ml
+++ b/lib/js_of_ocaml/js.ml
@@ -812,15 +812,16 @@ let parseFloat (s : js_string t) : number_t =
   let s = Unsafe.fun_call Unsafe.global##.parseFloat [| Unsafe.inject s |] in
   if isNaN s then failwith "parseFloat" else s
 
-let _ =
-  Printexc.register_printer (function
-      | Js_error.Exn e -> Some (Js_error.to_string e)
-      | _ -> None)
-
 let _ =
   Printexc.register_printer (fun e ->
-      let e : < .. > t = Obj.magic e in
-      if instanceof e array_constructor then None else Some (to_string e##toString))
+      if instanceof (Obj.magic e : < .. > t) error_constr
+      then
+        let e = Js_error.of_error (Obj.magic e : error t) in
+        Some (Js_error.to_string e)
+      else
+        match e with
+        | Js_error.Exn e -> Some (Js_error.to_string e)
+        | _ -> None)
 
 let export_js (field : js_string t) x =
   Unsafe.set

From 3e12e52464b794663e49a109457465a711211ace Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 20 Nov 2024 17:04:41 +0100
Subject: [PATCH 457/481] CI: move

---
 .github/workflows/build.yml | 42 +------------------------------------
 .github/workflows/lint.yml  | 42 +++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+), 41 deletions(-)
 create mode 100644 .github/workflows/lint.yml

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 5d4917a71a..d371f16994 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -164,44 +164,4 @@ jobs:
           branch: wikidoc
           folder: doc-dev
           clean: true
-          target-folder: doc/dev/
-
-  lint-opam:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout tree
-        uses: actions/checkout@v4
-      - name: Set-up OCaml
-        uses: ocaml/setup-ocaml@v3
-        with:
-          ocaml-compiler: "5.2"
-          dune-cache: true
-      - name: Pin dune
-        run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
-      - uses: ocaml/setup-ocaml/lint-opam@v3
-
-  lint-fmt:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout tree
-        uses: actions/checkout@v4
-      - name: Set-up OCaml
-        uses: ocaml/setup-ocaml@v3
-        with:
-          ocaml-compiler: "5.2"
-          dune-cache: true
-      - name: Pin dune
-        run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
-      - uses: ocaml/setup-ocaml/lint-fmt@v3
-
-  lint-runtime:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout tree
-        uses: actions/checkout@v4
-      - name: Set-up Biome
-        uses: biomejs/setup-biome@v2
-      - name: Run biome
-        run: biome ci
+          target-folder: doc/dev/
\ No newline at end of file
diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml
new file mode 100644
index 0000000000..e912e7b979
--- /dev/null
+++ b/.github/workflows/lint.yml
@@ -0,0 +1,42 @@
+name: lint
+
+on:
+  pull_request:
+  push:
+    branches:
+      - master
+
+jobs:
+  lint-opam:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout tree
+        uses: actions/checkout@v4
+      - name: Set-up OCaml
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: "5.2"
+          dune-cache: true
+      - uses: ocaml/setup-ocaml/lint-opam@v3
+
+  lint-fmt:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout tree
+        uses: actions/checkout@v4
+      - name: Set-up OCaml
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: "5.2"
+          dune-cache: true
+      - uses: ocaml/setup-ocaml/lint-fmt@v3
+
+  lint-runtime:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout tree
+        uses: actions/checkout@v4
+      - name: Set-up Biome
+        uses: biomejs/setup-biome@v2
+      - name: Run biome
+        run: biome ci

From ae1284b138ccedb47bdb751fd95383f9f60dacd0 Mon Sep 17 00:00:00 2001
From: hhugo <hugo.heuzard@gmail.com>
Date: Mon, 25 Nov 2024 15:37:20 +0100
Subject: [PATCH 458/481] Fix ci mac (#1744)

---
 .github/workflows/build.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 0c9afe9654..eeab8020b6 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -102,6 +102,7 @@ jobs:
         run: |
           brew update
           brew upgrade
+          brew unlink pkg-config@0.29.2
           brew install pkgconf
           # work around https://github.com/actions/runner-images/issues/10984
 

From 825941b2f87d059ffb9c83ac6fd7611133c59247 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 18 Nov 2024 10:46:15 +0100
Subject: [PATCH 459/481] Tests: recursive value compilation

---
 compiler/tests-compiler/dune.inc | 15 ++++++
 compiler/tests-compiler/rec.ml   | 82 ++++++++++++++++++++++++++++++++
 2 files changed, 97 insertions(+)
 create mode 100644 compiler/tests-compiler/rec.ml

diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index 4524092abd..3bba93cd96 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -659,6 +659,21 @@
  (preprocess
   (pps ppx_expect)))
 
+(library
+ ;; compiler/tests-compiler/rec.ml
+ (name rec_15)
+ (enabled_if %{env:js-enabled=})
+ (modules rec)
+ (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
+ (inline_tests
+  (enabled_if true)
+  (deps
+   (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
+   (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
+ (flags (:standard -open Jsoo_compiler_expect_tests_helper))
+ (preprocess
+  (pps ppx_expect)))
+
 (library
  ;; compiler/tests-compiler/scopes.ml
  (name scopes_15)
diff --git a/compiler/tests-compiler/rec.ml b/compiler/tests-compiler/rec.ml
new file mode 100644
index 0000000000..216bd7c459
--- /dev/null
+++ b/compiler/tests-compiler/rec.ml
@@ -0,0 +1,82 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2024 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open Util
+
+let%expect_test "let rec" =
+  let p =
+    {|
+      let rec a x =
+        (* syntactic function *)
+        b x
+      and b =
+        (* non-syntactic function *)
+        let tbl : (int, int) Hashtbl.t = Hashtbl.create 17 in
+        fun x -> `T (tbl, c, a 0)
+      and c =
+        (* block *)
+        Some (d, default)
+      and d =
+        (* 'dynamic' value (not recursive *)
+        Array.make 5 0
+      and default =
+        (* constant, with (spurious) use
+           of a recursive neighbor *)
+        let _ = a in
+        42
+   |}
+  in
+  let p = compile_and_parse p in
+  print_program p;
+  [%expect
+    {|
+    (function(globalThis){
+       "use strict";
+       var
+        runtime = globalThis.jsoo_runtime,
+        caml_update_dummy = runtime.caml_update_dummy;
+       function caml_call1(f, a0){
+        return (f.l >= 0 ? f.l : f.l = f.length) === 1
+                ? f(a0)
+                : runtime.caml_call_gen(f, [a0]);
+       }
+       function caml_call2(f, a0, a1){
+        return (f.l >= 0 ? f.l : f.l = f.length) === 2
+                ? f(a0, a1)
+                : runtime.caml_call_gen(f, [a0, a1]);
+       }
+       var
+        global_data = runtime.caml_get_global_data(),
+        Stdlib_Hashtbl = global_data.Stdlib__Hashtbl,
+        a = function _d_(_c_){return _d_.fun(_c_);},
+        b = function _b_(_a_){return _b_.fun(_a_);},
+        c = [],
+        d = runtime.caml_make_vect(5, 0),
+        default$0 = 42;
+       caml_update_dummy(a, function(x){return caml_call1(b, x);});
+       var tbl = caml_call2(Stdlib_Hashtbl[1], 0, 17);
+       caml_update_dummy
+        (b, function(x){return [0, 84, [0, tbl, c, caml_call1(a, 0)]];});
+       caml_update_dummy(c, [0, [0, d, default$0]]);
+       var Test = [0, a, b, c, d, default$0];
+       runtime.caml_register_global(1, Test, "Test");
+       return;
+      }
+      (globalThis));
+    //end |}]

From e16f8e3ee670ce4a806a2f90f0734a069f61a42c Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Tue, 26 Nov 2024 14:02:16 +0100
Subject: [PATCH 460/481] Misc: remove macos CI fix

---
 .github/workflows/build.yml | 9 ---------
 1 file changed, 9 deletions(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index eeab8020b6..78ee7afaac 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -97,15 +97,6 @@ jobs:
           # try to install them anyways, so we save an apt-roundtrip.
           sudo aptitude -o Acquire::Retries=30 install gcc-multilib g++-multilib pkg-config libgmp-dev libgmp-dev:i386 libx11-dev:i386 -y
 
-      - name: macos fix
-        if: runner.os == 'Macos'
-        run: |
-          brew update
-          brew upgrade
-          brew unlink pkg-config@0.29.2
-          brew install pkgconf
-          # work around https://github.com/actions/runner-images/issues/10984
-
       - name: Checkout tree
         uses: actions/checkout@v4
 

From 285376a5516b47f10aded71694f325a6d28b8420 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 18 Nov 2024 11:08:59 +0100
Subject: [PATCH 461/481] Tests: promote with new compilation strategy

---
 compiler/tests-compiler/dune.inc         | 17 ++++-
 compiler/tests-compiler/gen-rules/gen.ml |  9 ++-
 compiler/tests-compiler/rec.ml           |  3 +-
 compiler/tests-compiler/rec52.ml         | 80 ++++++++++++++++++++++++
 4 files changed, 105 insertions(+), 4 deletions(-)
 create mode 100644 compiler/tests-compiler/rec52.ml

diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index 3bba93cd96..4a4f76bf43 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -666,7 +666,22 @@
  (modules rec)
  (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
  (inline_tests
-  (enabled_if true)
+  (enabled_if (< %{ocaml_version} 5.2))
+  (deps
+   (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
+   (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
+ (flags (:standard -open Jsoo_compiler_expect_tests_helper))
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ ;; compiler/tests-compiler/rec52.ml
+ (name rec52_15)
+ (enabled_if %{env:js-enabled=})
+ (modules rec52)
+ (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
+ (inline_tests
+  (enabled_if (>= %{ocaml_version} 5.2))
   (deps
    (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
    (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml
index ef0415518c..bee62eb181 100644
--- a/compiler/tests-compiler/gen-rules/gen.ml
+++ b/compiler/tests-compiler/gen-rules/gen.ml
@@ -47,6 +47,8 @@ let prefix : string =
 
 type enabled_if =
   | GE5
+  | GE52
+  | LT52
   | B64
   | Any
 
@@ -58,12 +60,15 @@ let lib_enabled_if = function
 let test_enabled_if = function
   | "obj" | "lazy" -> GE5
   | "gh1051" -> B64
+  | "rec52" -> GE52
+  | "rec" -> LT52
   | _ -> Any
 
-let enabled_if cond =
-  match cond with
+let enabled_if = function
   | Any -> "true"
   | GE5 -> "(>= %{ocaml_version} 5)"
+  | GE52 -> "(>= %{ocaml_version} 5.2)"
+  | LT52 -> "(< %{ocaml_version} 5.2)"
   | B64 -> "%{arch_sixtyfour}"
 
 let js_enabled = function
diff --git a/compiler/tests-compiler/rec.ml b/compiler/tests-compiler/rec.ml
index 216bd7c459..a5085f4ef4 100644
--- a/compiler/tests-compiler/rec.ml
+++ b/compiler/tests-compiler/rec.ml
@@ -79,4 +79,5 @@ let%expect_test "let rec" =
        return;
       }
       (globalThis));
-    //end |}]
+    //end
+    |}]
diff --git a/compiler/tests-compiler/rec52.ml b/compiler/tests-compiler/rec52.ml
new file mode 100644
index 0000000000..18d766eeaf
--- /dev/null
+++ b/compiler/tests-compiler/rec52.ml
@@ -0,0 +1,80 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2024 Hugo Heuzard
+ *
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+open Util
+
+let%expect_test "let rec" =
+  let p =
+    {|
+      let rec a x =
+        (* syntactic function *)
+        b x
+      and b =
+        (* non-syntactic function *)
+        let tbl : (int, int) Hashtbl.t = Hashtbl.create 17 in
+        fun x -> `T (tbl, c, a 0)
+      and c =
+        (* block *)
+        Some (d, default)
+      and d =
+        (* 'dynamic' value (not recursive *)
+        Array.make 5 0
+      and default =
+        (* constant, with (spurious) use
+           of a recursive neighbor *)
+        let _ = a in
+        42
+   |}
+  in
+  let p = compile_and_parse p in
+  print_program p;
+  [%expect
+    {|
+    (function(globalThis){
+       "use strict";
+       var
+        runtime = globalThis.jsoo_runtime,
+        caml_update_dummy = runtime.caml_update_dummy;
+       function caml_call2(f, a0, a1){
+        return (f.l >= 0 ? f.l : f.l = f.length) === 2
+                ? f(a0, a1)
+                : runtime.caml_call_gen(f, [a0, a1]);
+       }
+       var
+        global_data = runtime.caml_get_global_data(),
+        Stdlib_Hashtbl = global_data.Stdlib__Hashtbl,
+        letrec_function_context = [],
+        c = [],
+        d = runtime.caml_make_vect(5, 0),
+        default$0 = 42;
+       function a(x){return b(x);}
+       function b(x){
+        var _a_ = b(0);
+        return [0, 84, [0, letrec_function_context[1], c, _a_]];
+       }
+       var tbl = caml_call2(Stdlib_Hashtbl[1], 0, 17);
+       caml_update_dummy(letrec_function_context, [0, tbl]);
+       caml_update_dummy(c, [0, [0, d, default$0]]);
+       var Test = [0, a, b, c, d, default$0];
+       runtime.caml_register_global(1, Test, "Test");
+       return;
+      }
+      (globalThis));
+    //end
+    |}]

From 5e25815f46487ad42197c4765a99566a03dd358f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Nov 2024 14:55:05 +0100
Subject: [PATCH 462/481] CI: explicitly set version of all jsoo packages

---
 .github/workflows/build.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index d371f16994..580e6e2640 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -122,7 +122,7 @@ jobs:
       - run: opam install . --best-effort
         if: ${{ matrix.skip-test }}
 
-      - run: cat VERSION | xargs opam pin wasm_of_ocaml-compiler . -n --with-version 
+      - run: cat VERSION | xargs opam pin . -n --with-version 
         if: ${{ !matrix.skip-test }}
         shell: bash
 

From 1f11a80561b778752857bdcd3bd2b2b5fe805f5c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 25 Nov 2024 14:53:53 +0100
Subject: [PATCH 463/481] Formatting

---
 compiler/tests-check-prim/dune | 36 ++++++----------------------------
 1 file changed, 6 insertions(+), 30 deletions(-)

diff --git a/compiler/tests-check-prim/dune b/compiler/tests-check-prim/dune
index 5a0767a948..4b786374d5 100644
--- a/compiler/tests-check-prim/dune
+++ b/compiler/tests-check-prim/dune
@@ -23,11 +23,7 @@
  (action
   (with-stdout-to
    %{targets}
-   (run
-    %{bin:js_of_ocaml}
-    check-runtime
-    +dynlink.js
-    +toplevel.js
+   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
     %{dep:main.bc}))))
 
 (rule
@@ -41,11 +37,7 @@
  (action
   (with-stdout-to
    %{targets}
-   (run
-    %{bin:js_of_ocaml}
-    check-runtime
-    +dynlink.js
-    +toplevel.js
+   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
     %{dep:unix.bc}))))
 
 (rule
@@ -59,11 +51,7 @@
  (action
   (with-stdout-to
    %{targets}
-   (run
-    %{bin:js_of_ocaml}
-    check-runtime
-    +dynlink.js
-    +toplevel.js
+   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
     %{dep:unix.bc}))))
 
 (rule
@@ -75,11 +63,7 @@
  (action
   (with-stdout-to
    %{targets}
-   (run
-    %{bin:js_of_ocaml}
-    check-runtime
-    +dynlink.js
-    +toplevel.js
+   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
     %{dep:main.bc}))))
 
 (rule
@@ -93,11 +77,7 @@
  (action
   (with-stdout-to
    %{targets}
-   (run
-    %{bin:js_of_ocaml}
-    check-runtime
-    +dynlink.js
-    +toplevel.js
+   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
     %{dep:unix.bc}))))
 
 (rule
@@ -111,9 +91,5 @@
  (action
   (with-stdout-to
    %{targets}
-   (run
-    %{bin:js_of_ocaml}
-    check-runtime
-    +dynlink.js
-    +toplevel.js
+   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
     %{dep:unix.bc}))))

From ad1676f615285b133adf276b7aeec8c2e003e85a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Nov 2024 16:37:41 +0100
Subject: [PATCH 464/481] No longer pin dune

---
 .github/workflows/build-wasm_of_ocaml.yml | 3 ---
 .github/workflows/build.yml               | 6 +-----
 .github/workflows/lint.yml                | 6 ------
 README.md                                 | 5 ++---
 4 files changed, 3 insertions(+), 17 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 7f5e1eb656..e0f394dc66 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -107,9 +107,6 @@ jobs:
           ref: feaf8f831051fd5f316963b28efd728cf0b0eca1
           path: jane-street/opam-repository
 
-      - name: Pin dune
-        run: opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
-
       - name: Pin wasm_of_ocaml
         working-directory: ./wasm_of_ocaml
         run: opam pin -n --with-version `< VERSION` .
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 580e6e2640..1bf899719e 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -112,10 +112,6 @@ jobs:
           dune-cache: true
           opam-pin: false
 
-      - name: Pin dune
-        run: |
-          opam pin add dune.3.17 https://github.com/ocaml/dune.git
-
       - run: opam install conf-pkg-config
         if: runner.os == 'Windows'
 
@@ -164,4 +160,4 @@ jobs:
           branch: wikidoc
           folder: doc-dev
           clean: true
-          target-folder: doc/dev/
\ No newline at end of file
+          target-folder: doc/dev/
diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml
index 36f9a8c5e0..e912e7b979 100644
--- a/.github/workflows/lint.yml
+++ b/.github/workflows/lint.yml
@@ -17,9 +17,6 @@ jobs:
         with:
           ocaml-compiler: "5.2"
           dune-cache: true
-      - name: Pin dune
-        run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
       - uses: ocaml/setup-ocaml/lint-opam@v3
 
   lint-fmt:
@@ -32,9 +29,6 @@ jobs:
         with:
           ocaml-compiler: "5.2"
           dune-cache: true
-      - name: Pin dune
-        run: |
-          opam pin add -n dune.3.17 https://github.com/ocaml/dune.git
       - uses: ocaml/setup-ocaml/lint-fmt@v3
 
   lint-runtime:
diff --git a/README.md b/README.md
index 35e78b4317..ee5c69df18 100644
--- a/README.md
+++ b/README.md
@@ -24,9 +24,8 @@ The following commands will perform a minimal installation:
 ```
 git clone https://github.com/ocaml-wasm/wasm_of_ocaml
 cd wasm_of_ocaml
-opam pin add -n --with-version 3.17 https://github.com/ocaml/dune.git
-opam pin add -n --with-version 5.8.2-wasm .
-opam install wasm_of_ocaml-compiler
+opam pin add -n --with-version 6.0.0 .
+opam install dune.3.17.0 wasm_of_ocaml-compiler
 ```
 You may want to install additional packages. For instance:
 

From a0b5b8ce10a551f0ddc1005f8065dd7ee26dc81a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Nov 2024 16:38:04 +0100
Subject: [PATCH 465/481] Reformat dune files

---
 benchmarks/sources/ml/dune            | 49 +++++++++++++---
 compiler/bin-js_of_ocaml/dune         |  5 +-
 compiler/bin-wasm_of_ocaml/dune       |  7 ++-
 compiler/lib-dynlink/dune             |  4 +-
 compiler/lib/dune                     | 24 ++++++--
 compiler/tests-check-prim/dune        | 36 ++++++++++--
 compiler/tests-dynlink-js/dune        | 24 ++++++--
 compiler/tests-dynlink/dune           |  9 ++-
 compiler/tests-full/dune              | 14 ++++-
 compiler/tests-jsoo/dune              | 10 +++-
 compiler/tests-ocaml/lib-effects/dune | 25 +++++++-
 dune                                  |  4 +-
 examples/boulderdash/dune             | 13 ++++-
 examples/cubes/dune                   |  7 ++-
 examples/graph_viewer/dune            | 21 ++++++-
 examples/hyperbolic/dune              | 14 ++++-
 examples/namespace/dune               | 34 +++++++++--
 examples/planet/dune                  |  7 ++-
 examples/separate_compilation/dune    | 58 ++++++++++++++++---
 examples/webgl/dune                   | 11 +++-
 ppx/ppx_deriving_json/tests/dune      |  5 +-
 runtime/js/dune                       | 32 +++++++++--
 runtime/wasm/dune                     | 33 +++++++++--
 tools/sourcemap/dune                  |  4 +-
 toplevel/bin/dune                     |  4 +-
 toplevel/examples/eval/dune           | 11 +++-
 toplevel/examples/lwt_toplevel/dune   | 82 +++++++++++++++++++++------
 toplevel/lib/dune                     |  7 ++-
 toplevel/test/dune                    | 12 +++-
 29 files changed, 471 insertions(+), 95 deletions(-)

diff --git a/benchmarks/sources/ml/dune b/benchmarks/sources/ml/dune
index 86d08b50ce..31b138c56f 100644
--- a/benchmarks/sources/ml/dune
+++ b/benchmarks/sources/ml/dune
@@ -1,14 +1,49 @@
 (executables
- (names almabench bdd binary_trees boyer boyer_no_exc fannkuch_redux_2
-  fannkuch_redux fft fib hamming kb kb_no_exc loop nucleic quicksort raytrace
-  soli splay takc taku))
+ (names
+  almabench
+  bdd
+  binary_trees
+  boyer
+  boyer_no_exc
+  fannkuch_redux_2
+  fannkuch_redux
+  fft
+  fib
+  hamming
+  kb
+  kb_no_exc
+  loop
+  nucleic
+  quicksort
+  raytrace
+  soli
+  splay
+  takc
+  taku))
 
 (alias
  (name benchmark)
- (deps almabench.exe bdd.exe binary_trees.exe boyer.exe boyer_no_exc.exe
-  fannkuch_redux_2.exe fannkuch_redux.exe fft.exe fib.exe hamming.exe kb.exe
-  kb_no_exc.exe loop.exe nucleic.exe quicksort.exe raytrace.exe soli.exe
-  splay.exe takc.exe taku.exe))
+ (deps
+  almabench.exe
+  bdd.exe
+  binary_trees.exe
+  boyer.exe
+  boyer_no_exc.exe
+  fannkuch_redux_2.exe
+  fannkuch_redux.exe
+  fft.exe
+  fib.exe
+  hamming.exe
+  kb.exe
+  kb_no_exc.exe
+  loop.exe
+  nucleic.exe
+  quicksort.exe
+  raytrace.exe
+  soli.exe
+  splay.exe
+  takc.exe
+  taku.exe))
 
 (env
  (_
diff --git a/compiler/bin-js_of_ocaml/dune b/compiler/bin-js_of_ocaml/dune
index 772ff23d72..f246e9d57d 100644
--- a/compiler/bin-js_of_ocaml/dune
+++ b/compiler/bin-js_of_ocaml/dune
@@ -51,7 +51,10 @@
 (install
  (section man)
  (package js_of_ocaml-compiler)
- (files js_of_ocaml.1 js_of_ocaml-link.1 js_of_ocaml-build-fs.1
+ (files
+  js_of_ocaml.1
+  js_of_ocaml-link.1
+  js_of_ocaml-build-fs.1
   js_of_ocaml-build-runtime.1))
 
 ;; Generate and install runtime.js for compatibility reasons
diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune
index ea5833d695..cd5f1a468a 100644
--- a/compiler/bin-wasm_of_ocaml/dune
+++ b/compiler/bin-wasm_of_ocaml/dune
@@ -23,8 +23,11 @@
 
 (rule
  (target wa_runtime.ml)
- (deps gen/gen.exe ../../runtime/wasm/runtime.wasm
-  ../../runtime/wasm/runtime.js ../../runtime/wasm/deps.json)
+ (deps
+  gen/gen.exe
+  ../../runtime/wasm/runtime.wasm
+  ../../runtime/wasm/runtime.js
+  ../../runtime/wasm/deps.json)
  (action
   (with-stdout-to
    %{target}
diff --git a/compiler/lib-dynlink/dune b/compiler/lib-dynlink/dune
index 0f96313efb..84788e7681 100644
--- a/compiler/lib-dynlink/dune
+++ b/compiler/lib-dynlink/dune
@@ -6,5 +6,7 @@
  (foreign_stubs
   (language c)
   (names stubs))
- (libraries js_of_ocaml-compiler js_of_ocaml-compiler.runtime
+ (libraries
+  js_of_ocaml-compiler
+  js_of_ocaml-compiler.runtime
   compiler-libs.bytecomp))
diff --git a/compiler/lib/dune b/compiler/lib/dune
index 29c37de04a..075e086433 100644
--- a/compiler/lib/dune
+++ b/compiler/lib/dune
@@ -2,7 +2,11 @@
  (name js_of_ocaml_compiler)
  (public_name js_of_ocaml-compiler)
  (synopsis "Js_of_ocaml compiler library")
- (libraries compiler-libs.common compiler-libs.bytecomp menhirLib sedlex
+ (libraries
+  compiler-libs.common
+  compiler-libs.bytecomp
+  menhirLib
+  sedlex
   yojson)
  (flags
   (:standard -w -7-37 -safe-string))
@@ -13,9 +17,21 @@
 
 (menhir
  (modules js_parser)
- (flags --table --external-tokens Js_token --explain --unused-token TAnnot
-  --unused-token TComment --unused-token TCommentLineDirective --unused-token
-  T_ERROR --unused-token T_AT))
+ (flags
+  --table
+  --external-tokens
+  Js_token
+  --explain
+  --unused-token
+  TAnnot
+  --unused-token
+  TComment
+  --unused-token
+  TCommentLineDirective
+  --unused-token
+  T_ERROR
+  --unused-token
+  T_AT))
 
 (menhir
  (modules annot_parser)
diff --git a/compiler/tests-check-prim/dune b/compiler/tests-check-prim/dune
index 4b786374d5..5a0767a948 100644
--- a/compiler/tests-check-prim/dune
+++ b/compiler/tests-check-prim/dune
@@ -23,7 +23,11 @@
  (action
   (with-stdout-to
    %{targets}
-   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
+   (run
+    %{bin:js_of_ocaml}
+    check-runtime
+    +dynlink.js
+    +toplevel.js
     %{dep:main.bc}))))
 
 (rule
@@ -37,7 +41,11 @@
  (action
   (with-stdout-to
    %{targets}
-   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
+   (run
+    %{bin:js_of_ocaml}
+    check-runtime
+    +dynlink.js
+    +toplevel.js
     %{dep:unix.bc}))))
 
 (rule
@@ -51,7 +59,11 @@
  (action
   (with-stdout-to
    %{targets}
-   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
+   (run
+    %{bin:js_of_ocaml}
+    check-runtime
+    +dynlink.js
+    +toplevel.js
     %{dep:unix.bc}))))
 
 (rule
@@ -63,7 +75,11 @@
  (action
   (with-stdout-to
    %{targets}
-   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
+   (run
+    %{bin:js_of_ocaml}
+    check-runtime
+    +dynlink.js
+    +toplevel.js
     %{dep:main.bc}))))
 
 (rule
@@ -77,7 +93,11 @@
  (action
   (with-stdout-to
    %{targets}
-   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
+   (run
+    %{bin:js_of_ocaml}
+    check-runtime
+    +dynlink.js
+    +toplevel.js
     %{dep:unix.bc}))))
 
 (rule
@@ -91,5 +111,9 @@
  (action
   (with-stdout-to
    %{targets}
-   (run %{bin:js_of_ocaml} check-runtime +dynlink.js +toplevel.js
+   (run
+    %{bin:js_of_ocaml}
+    check-runtime
+    +dynlink.js
+    +toplevel.js
     %{dep:unix.bc}))))
diff --git a/compiler/tests-dynlink-js/dune b/compiler/tests-dynlink-js/dune
index b21c3df8e9..da871999b7 100644
--- a/compiler/tests-dynlink-js/dune
+++ b/compiler/tests-dynlink-js/dune
@@ -39,8 +39,13 @@
  (target main.js)
  (enabled_if %{env:js-enabled=})
  (action
-  (run %{bin:js_of_ocaml} --linkall %{read-strings:effects_flags.txt} -o
-   %{target} %{dep:main.bc})))
+  (run
+   %{bin:js_of_ocaml}
+   --linkall
+   %{read-strings:effects_flags.txt}
+   -o
+   %{target}
+   %{dep:main.bc})))
 
 (rule
  (target plugin.cmo)
@@ -50,19 +55,28 @@
 (rule
  (target plugin.js)
  (action
-  (run %{bin:js_of_ocaml} %{read-strings:effects_flags.txt}
+  (run
+   %{bin:js_of_ocaml}
+   %{read-strings:effects_flags.txt}
    %{dep:./plugin.cmo})))
 
 (rule
  (target plugin2.cma)
  (action
-  (run %{bin:ocamlc} -a %{dep:./plugin2a.ml} %{dep:./plugin2b.ml} -o
+  (run
+   %{bin:ocamlc}
+   -a
+   %{dep:./plugin2a.ml}
+   %{dep:./plugin2b.ml}
+   -o
    plugin2.cma)))
 
 (rule
  (target plugin2.js)
  (action
-  (run %{bin:js_of_ocaml} %{read-strings:effects_flags.txt}
+  (run
+   %{bin:js_of_ocaml}
+   %{read-strings:effects_flags.txt}
    %{dep:./plugin2.cma})))
 
 (rule
diff --git a/compiler/tests-dynlink/dune b/compiler/tests-dynlink/dune
index e22a5dcbe3..37de0cb1cc 100644
--- a/compiler/tests-dynlink/dune
+++ b/compiler/tests-dynlink/dune
@@ -10,7 +10,14 @@
  (enabled_if %{env:js-enabled=})
  (deps plugin.cmo export)
  (action
-  (run %{bin:js_of_ocaml} --dynlink --export export --pretty -o %{target}
+  (run
+   %{bin:js_of_ocaml}
+   --dynlink
+   --export
+   export
+   --pretty
+   -o
+   %{target}
    %{dep:main.bc})))
 
 (rule
diff --git a/compiler/tests-full/dune b/compiler/tests-full/dune
index 17668b782d..5effacad3b 100644
--- a/compiler/tests-full/dune
+++ b/compiler/tests-full/dune
@@ -3,7 +3,12 @@
  (enabled_if
   (= %{ocaml_version} "5.2.0"))
  (action
-  (run %{bin:js_of_ocaml} --pretty --debuginfo %{lib:stdlib:stdlib.cma} -o
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --debuginfo
+   %{lib:stdlib:stdlib.cma}
+   -o
    %{targets})))
 
 (rule
@@ -26,7 +31,12 @@
  (targets fs.output.js)
  (deps file1 file2)
  (action
-  (run %{bin:js_of_ocaml} build-fs -o %{targets} file1:/static/file1
+  (run
+   %{bin:js_of_ocaml}
+   build-fs
+   -o
+   %{targets}
+   file1:/static/file1
    file2:/static/dir/file2)))
 
 (rule
diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune
index ab6d5dfd47..26f79c9284 100644
--- a/compiler/tests-jsoo/dune
+++ b/compiler/tests-jsoo/dune
@@ -34,8 +34,14 @@
 (library
  (name jsoo_testsuite)
  (modules
-  (:standard \ test_io test_floats test_marshal_compressed test_parsing
-   calc_parser calc_lexer))
+  (:standard
+   \
+   test_io
+   test_floats
+   test_marshal_compressed
+   test_parsing
+   calc_parser
+   calc_lexer))
  (libraries unix compiler-libs.common js_of_ocaml-compiler)
  (foreign_stubs
   (language c)
diff --git a/compiler/tests-ocaml/lib-effects/dune b/compiler/tests-ocaml/lib-effects/dune
index 9d0b782839..1025666336 100644
--- a/compiler/tests-ocaml/lib-effects/dune
+++ b/compiler/tests-ocaml/lib-effects/dune
@@ -18,9 +18,28 @@
 (tests
  (build_if
   (>= %{ocaml_version} 5))
- (names cmphash marshal effects evenodd manylive overflow partial reperform
-  sched shallow_state_io shallow_state test10 test11 test1 test2 test3 test4
-  test5 test6 test_lazy used_cont)
+ (names
+  cmphash
+  marshal
+  effects
+  evenodd
+  manylive
+  overflow
+  partial
+  reperform
+  sched
+  shallow_state_io
+  shallow_state
+  test10
+  test11
+  test1
+  test2
+  test3
+  test4
+  test5
+  test6
+  test_lazy
+  used_cont)
  (modules
   (:standard \ unhandled_unlinked))
  (modes js wasm))
diff --git a/dune b/dune
index 1aacb7538f..1bd709e8a8 100644
--- a/dune
+++ b/dune
@@ -55,7 +55,9 @@
  (action
   (with-stdout-to
    %{targets}
-   (run %{dep:tools/version/gen/gen.exe} %{dep:VERSION}
+   (run
+    %{dep:tools/version/gen/gen.exe}
+    %{dep:VERSION}
     %{dep:tools/version/GIT-VERSION}))))
 
 (data_only_dirs _wikidoc doc-dev)
diff --git a/examples/boulderdash/dune b/examples/boulderdash/dune
index 64ff9f3c76..952ee49396 100644
--- a/examples/boulderdash/dune
+++ b/examples/boulderdash/dune
@@ -10,8 +10,17 @@
  (deps
   (glob_files maps/*.map))
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:boulderdash.bc} -o %{targets}
-   --pretty --file %{dep:maps.txt} --file maps)))
+  (run
+   %{bin:js_of_ocaml}
+   --source-map
+   %{dep:boulderdash.bc}
+   -o
+   %{targets}
+   --pretty
+   --file
+   %{dep:maps.txt}
+   --file
+   maps)))
 
 (alias
  (name default)
diff --git a/examples/cubes/dune b/examples/cubes/dune
index 970d3f0b41..56d43c509d 100644
--- a/examples/cubes/dune
+++ b/examples/cubes/dune
@@ -8,7 +8,12 @@
 (rule
  (targets cubes.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:cubes.bc} -o %{targets}
+  (run
+   %{bin:js_of_ocaml}
+   --source-map
+   %{dep:cubes.bc}
+   -o
+   %{targets}
    --pretty)))
 
 (alias
diff --git a/examples/graph_viewer/dune b/examples/graph_viewer/dune
index 86f8d8edde..b22b3d62c2 100644
--- a/examples/graph_viewer/dune
+++ b/examples/graph_viewer/dune
@@ -3,7 +3,15 @@
  (libraries js_of_ocaml-lwt)
  (modes byte)
  (modules
-  (:standard \ scene_extents svg main viewer converter dot_lexer dot_graph
+  (:standard
+   \
+   scene_extents
+   svg
+   main
+   viewer
+   converter
+   dot_lexer
+   dot_graph
    dot_render))
  (preprocess
   (pps js_of_ocaml-ppx)))
@@ -13,8 +21,15 @@
 (rule
  (targets viewer_js.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:viewer_js.bc} -o %{targets}
-   --pretty --file %{dep:scene.json})))
+  (run
+   %{bin:js_of_ocaml}
+   --source-map
+   %{dep:viewer_js.bc}
+   -o
+   %{targets}
+   --pretty
+   --file
+   %{dep:scene.json})))
 
 (alias
  (name default)
diff --git a/examples/hyperbolic/dune b/examples/hyperbolic/dune
index 732e15c390..f1fb55f990 100644
--- a/examples/hyperbolic/dune
+++ b/examples/hyperbolic/dune
@@ -8,8 +8,18 @@
 (rule
  (targets hypertree.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:hypertree.bc} -o %{targets}
-   --pretty --file %{dep:image_info.json} --file %{dep:messages.json} --file
+  (run
+   %{bin:js_of_ocaml}
+   --source-map
+   %{dep:hypertree.bc}
+   -o
+   %{targets}
+   --pretty
+   --file
+   %{dep:image_info.json}
+   --file
+   %{dep:messages.json}
+   --file
    %{dep:tree.json})))
 
 (alias
diff --git a/examples/namespace/dune b/examples/namespace/dune
index 310d7102c9..f616007252 100644
--- a/examples/namespace/dune
+++ b/examples/namespace/dune
@@ -6,20 +6,44 @@
 (rule
  (target a.js)
  (action
-  (run %{bin:js_of_ocaml} %{dep:./a.bc} --wrap-with-fun implemA -o a.js
-   --pretty --target-env browser --no-extern-fs)))
+  (run
+   %{bin:js_of_ocaml}
+   %{dep:./a.bc}
+   --wrap-with-fun
+   implemA
+   -o
+   a.js
+   --pretty
+   --target-env
+   browser
+   --no-extern-fs)))
 
 (rule
  (target a-iife.js)
  (action
-  (run %{bin:js_of_ocaml} %{dep:./a.bc} -o a-iife.js --target-env browser
+  (run
+   %{bin:js_of_ocaml}
+   %{dep:./a.bc}
+   -o
+   a-iife.js
+   --target-env
+   browser
    --no-extern-fs)))
 
 (rule
  (target b.js)
  (action
-  (run %{bin:js_of_ocaml} %{dep:./b.bc} --wrap-with-fun implemB -o b.js
-   --pretty --target-env browser --no-extern-fs)))
+  (run
+   %{bin:js_of_ocaml}
+   %{dep:./b.bc}
+   --wrap-with-fun
+   implemB
+   -o
+   b.js
+   --pretty
+   --target-env
+   browser
+   --no-extern-fs)))
 
 (alias
  (name default)
diff --git a/examples/planet/dune b/examples/planet/dune
index 108465e9ee..30e0388841 100644
--- a/examples/planet/dune
+++ b/examples/planet/dune
@@ -8,7 +8,12 @@
 (rule
  (targets planet.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:planet.bc} -o %{targets}
+  (run
+   %{bin:js_of_ocaml}
+   --source-map
+   %{dep:planet.bc}
+   -o
+   %{targets}
    --pretty)))
 
 (alias
diff --git a/examples/separate_compilation/dune b/examples/separate_compilation/dune
index 1cf2ae4606..8f0cc22b6e 100644
--- a/examples/separate_compilation/dune
+++ b/examples/separate_compilation/dune
@@ -27,31 +27,56 @@
 (rule
  (targets lib1.cma.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --source-map %{dep:lib1.cma} -o
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --source-map
+   %{dep:lib1.cma}
+   -o
    %{targets})))
 
 (rule
  (targets module1.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --source-map %{dep:module1.cmo} -o
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --source-map
+   %{dep:module1.cmo}
+   -o
    %{targets})))
 
 (rule
  (targets module2.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --source-map %{dep:module2.cmo} -o
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --source-map
+   %{dep:module2.cmo}
+   -o
    %{targets})))
 
 (rule
  (targets stdlib.cma.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --source-map %{lib:stdlib:stdlib.cma} -o
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --source-map
+   %{lib:stdlib:stdlib.cma}
+   -o
    %{targets})))
 
 (rule
  (targets std_exit.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --source-map %{lib:stdlib:std_exit.cmo} -o
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --source-map
+   %{lib:stdlib:std_exit.cmo}
+   -o
    %{targets})))
 
 (rule
@@ -62,9 +87,18 @@
 (rule
  (targets bin.js)
  (action
-  (run %{bin:js_of_ocaml} link --pretty %{dep:myruntime.js}
-   %{dep:stdlib.cma.js} %{dep:lib1.cma.js} %{dep:module1.js}
-   %{dep:module2.js} %{dep:std_exit.js} -o %{targets})))
+  (run
+   %{bin:js_of_ocaml}
+   link
+   --pretty
+   %{dep:myruntime.js}
+   %{dep:stdlib.cma.js}
+   %{dep:lib1.cma.js}
+   %{dep:module1.js}
+   %{dep:module2.js}
+   %{dep:std_exit.js}
+   -o
+   %{targets})))
 
 (rule
  (target bin.actual)
@@ -83,5 +117,11 @@
 (alias
  (name default)
  (enabled_if %{env:js-enabled=})
- (deps myruntime.js stdlib.cma.js std_exit.js module2.js module1.js bin.js
+ (deps
+  myruntime.js
+  stdlib.cma.js
+  std_exit.js
+  module2.js
+  module1.js
+  bin.js
   index.html))
diff --git a/examples/webgl/dune b/examples/webgl/dune
index 28d4d3b424..8025ac85fb 100644
--- a/examples/webgl/dune
+++ b/examples/webgl/dune
@@ -8,8 +8,15 @@
 (rule
  (targets webgldemo.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:webgldemo.bc} -o %{targets}
-   --pretty --file %{dep:monkey.model})))
+  (run
+   %{bin:js_of_ocaml}
+   --source-map
+   %{dep:webgldemo.bc}
+   -o
+   %{targets}
+   --pretty
+   --file
+   %{dep:monkey.model})))
 
 (alias
  (name default)
diff --git a/ppx/ppx_deriving_json/tests/dune b/ppx/ppx_deriving_json/tests/dune
index b861e7eb79..2e9ac54928 100644
--- a/ppx/ppx_deriving_json/tests/dune
+++ b/ppx/ppx_deriving_json/tests/dune
@@ -1,6 +1,9 @@
 (executables
  (names main)
- (libraries ppxlib toplevel_expect_test js_of_ocaml.deriving
+ (libraries
+  ppxlib
+  toplevel_expect_test
+  js_of_ocaml.deriving
   js_of_ocaml-ppx_deriving_json)
  (modes byte)
  (link_flags (-linkall)))
diff --git a/runtime/js/dune b/runtime/js/dune
index 4984c3f571..f31ffd1b6a 100644
--- a/runtime/js/dune
+++ b/runtime/js/dune
@@ -1,8 +1,32 @@
 (install
  (section lib)
  (package js_of_ocaml-compiler)
- (files bigarray.js bigstring.js dynlink.js fs.js fs_fake.js fs_node.js gc.js
-  graphics.js ieee_754.js int64.js internalMod.js io.js jslib.js
-  jslib_js_of_ocaml.js lexing.js marshal.js md5.js mlBytes.js nat.js
-  parsing.js stdlib.js toplevel.js unix.js weak.js domain.js prng.js sync.js
+ (files
+  bigarray.js
+  bigstring.js
+  dynlink.js
+  fs.js
+  fs_fake.js
+  fs_node.js
+  gc.js
+  graphics.js
+  ieee_754.js
+  int64.js
+  internalMod.js
+  io.js
+  jslib.js
+  jslib_js_of_ocaml.js
+  lexing.js
+  marshal.js
+  md5.js
+  mlBytes.js
+  nat.js
+  parsing.js
+  stdlib.js
+  toplevel.js
+  unix.js
+  weak.js
+  domain.js
+  prng.js
+  sync.js
   runtime_events.js))
diff --git a/runtime/wasm/dune b/runtime/wasm/dune
index 118546efbe..90422c0f9d 100644
--- a/runtime/wasm/dune
+++ b/runtime/wasm/dune
@@ -33,9 +33,20 @@
  (target runtime.wasm)
  (deps runtime.merged.wasm)
  (action
-  (run wasm-opt -g --enable-gc --enable-exception-handling
-   --enable-reference-types --enable-tail-call --enable-strings
-   --enable-multivalue --enable-bulk-memory %{deps} -O3 -o %{target})))
+  (run
+   wasm-opt
+   -g
+   --enable-gc
+   --enable-exception-handling
+   --enable-reference-types
+   --enable-tail-call
+   --enable-strings
+   --enable-multivalue
+   --enable-bulk-memory
+   %{deps}
+   -O3
+   -o
+   %{target})))
 
 (rule
  (target runtime.merged.wasm)
@@ -48,9 +59,19 @@
     "which wasm-merge > /dev/null || (echo 'Error: Binaryen tools not found in the PATH'; false)")
    (bash
     "wasm-merge --version | grep -q 'version \\(11[89]\\|1[2-9][0-9]\\)' || (echo 'Error: Binaryen version 118 or greater is currently required'; false)")
-   (run wasm-merge -g --enable-gc --enable-exception-handling
-    --enable-reference-types --enable-tail-call --enable-strings
-    --enable-multivalue --enable-bulk-memory %{read-lines:args} -o %{target}))))
+   (run
+    wasm-merge
+    -g
+    --enable-gc
+    --enable-exception-handling
+    --enable-reference-types
+    --enable-tail-call
+    --enable-strings
+    --enable-multivalue
+    --enable-bulk-memory
+    %{read-lines:args}
+    -o
+    %{target}))))
 
 (rule
  (target args)
diff --git a/tools/sourcemap/dune b/tools/sourcemap/dune
index 3fcda6f57f..e23b801e40 100644
--- a/tools/sourcemap/dune
+++ b/tools/sourcemap/dune
@@ -1,6 +1,8 @@
 (executables
  (names jsoo_sourcemap)
- (libraries js_of_ocaml-compiler compiler-libs.common
+ (libraries
+  js_of_ocaml-compiler
+  compiler-libs.common
   js_of_ocaml-compiler.findlib-support)
  (flags
   (:standard -safe-string)))
diff --git a/toplevel/bin/dune b/toplevel/bin/dune
index ce92827400..a236488243 100644
--- a/toplevel/bin/dune
+++ b/toplevel/bin/dune
@@ -2,5 +2,7 @@
  (names jsoo_mkcmis jsoo_mktop jsoo_listunits)
  (public_names jsoo_mkcmis jsoo_mktop jsoo_listunits)
  (package js_of_ocaml-toplevel)
- (libraries js_of_ocaml-compiler js_of_ocaml-compiler.findlib-support
+ (libraries
+  js_of_ocaml-compiler
+  js_of_ocaml-compiler.findlib-support
   js_of_ocaml-compiler.runtime-files))
diff --git a/toplevel/examples/eval/dune b/toplevel/examples/eval/dune
index 899147a9cd..76fc91026c 100644
--- a/toplevel/examples/eval/dune
+++ b/toplevel/examples/eval/dune
@@ -19,8 +19,15 @@
  (targets eval.js)
  (enabled_if %{env:js-enabled=})
  (action
-  (run %{bin:js_of_ocaml} --export %{dep:export.txt} --toplevel --pretty
-   %{dep:eval.bc} -o %{targets})))
+  (run
+   %{bin:js_of_ocaml}
+   --export
+   %{dep:export.txt}
+   --toplevel
+   --pretty
+   %{dep:eval.bc}
+   -o
+   %{targets})))
 
 (alias
  (name default)
diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune
index 57dc89684a..13a6048862 100644
--- a/toplevel/examples/lwt_toplevel/dune
+++ b/toplevel/examples/lwt_toplevel/dune
@@ -69,7 +69,11 @@
  (action
   (with-stdout-to
    %{target}
-   (run ocamlfind query tyxml.functor -format
+   (run
+    ocamlfind
+    query
+    tyxml.functor
+    -format
     "%d/html_types.cmi:/static/cmis/"))))
 
 (rule
@@ -80,15 +84,26 @@
 (rule
  (targets test_dynlink.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --toplevel
-   %{read-strings:effects_flags.txt} %{dep:test_dynlink.cmo})))
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --toplevel
+   %{read-strings:effects_flags.txt}
+   %{dep:test_dynlink.cmo})))
 
 (rule
  (target test_lib_jsoo.js)
  (action
-  (run %{bin:js_of_ocaml} --pretty --toplevel --include-runtime
-   %{read-strings:effects_flags.txt} %{dep:test_lib/stubs.js}
-   %{dep:test_lib/test_lib_jsoo.cma} -o %{target})))
+  (run
+   %{bin:js_of_ocaml}
+   --pretty
+   --toplevel
+   --include-runtime
+   %{read-strings:effects_flags.txt}
+   %{dep:test_lib/stubs.js}
+   %{dep:test_lib/test_lib_jsoo.cma}
+   -o
+   %{target})))
 
 (rule
  (targets export.txt)
@@ -100,11 +115,27 @@
   (package js_of_ocaml-tyxml)
   (package js_of_ocaml-toplevel))
  (action
-  (run jsoo_listunits -o %{targets} stdlib graphics str dynlink
-   js_of_ocaml-compiler.runtime js_of_ocaml-lwt.graphics
-   js_of_ocaml-ppx.as-lib js_of_ocaml.deriving lwt tyxml.functor
-   tyxml.functor:html_types.cmi react reactiveData js_of_ocaml
-   js_of_ocaml-lwt js_of_ocaml-tyxml js_of_ocaml-toplevel)))
+  (run
+   jsoo_listunits
+   -o
+   %{targets}
+   stdlib
+   graphics
+   str
+   dynlink
+   js_of_ocaml-compiler.runtime
+   js_of_ocaml-lwt.graphics
+   js_of_ocaml-ppx.as-lib
+   js_of_ocaml.deriving
+   lwt
+   tyxml.functor
+   tyxml.functor:html_types.cmi
+   react
+   reactiveData
+   js_of_ocaml
+   js_of_ocaml-lwt
+   js_of_ocaml-tyxml
+   js_of_ocaml-toplevel)))
 
 (executable
  (name effects_flags)
@@ -128,11 +159,30 @@
  (targets toplevel.js)
  (enabled_if %{env:js-enabled=})
  (action
-  (run %{bin:js_of_ocaml} compile --pretty %{read-strings:effects_flags.txt}
-   --Werror --target-env browser --file %{dep:examples.ml} --file
-   %{dep:test_dynlink.cmo} --file %{dep:test_dynlink.js} --file
-   %{dep:test_lib_jsoo.js} --export %{dep:export.txt} --toplevel --disable
-   shortvar %{dep:toplevel.bc} -o %{targets})))
+  (run
+   %{bin:js_of_ocaml}
+   compile
+   --pretty
+   %{read-strings:effects_flags.txt}
+   --Werror
+   --target-env
+   browser
+   --file
+   %{dep:examples.ml}
+   --file
+   %{dep:test_dynlink.cmo}
+   --file
+   %{dep:test_dynlink.js}
+   --file
+   %{dep:test_lib_jsoo.js}
+   --export
+   %{dep:export.txt}
+   --toplevel
+   --disable
+   shortvar
+   %{dep:toplevel.bc}
+   -o
+   %{targets})))
 
 (alias
  (name default)
diff --git a/toplevel/lib/dune b/toplevel/lib/dune
index e5946b4948..8a9d23c492 100644
--- a/toplevel/lib/dune
+++ b/toplevel/lib/dune
@@ -2,7 +2,10 @@
  (name js_of_ocaml_toplevel)
  (public_name js_of_ocaml-toplevel)
  (synopsis "Js_of_ocaml toplevel library")
- (libraries js_of_ocaml-compiler js_of_ocaml-compiler.dynlink
-  compiler-libs.bytecomp compiler-libs.toplevel)
+ (libraries
+  js_of_ocaml-compiler
+  js_of_ocaml-compiler.dynlink
+  compiler-libs.bytecomp
+  compiler-libs.toplevel)
  (preprocess
   (pps ppx_optcomp_light)))
diff --git a/toplevel/test/dune b/toplevel/test/dune
index ee4a694766..b56071400e 100644
--- a/toplevel/test/dune
+++ b/toplevel/test/dune
@@ -15,8 +15,16 @@
 (rule
  (targets test_toplevel.js)
  (action
-  (run %{bin:js_of_ocaml} --export %{dep:export.txt} --toplevel --disable
-   shortvar %{dep:test_toplevel.bc} -o %{targets})))
+  (run
+   %{bin:js_of_ocaml}
+   --export
+   %{dep:export.txt}
+   --toplevel
+   --disable
+   shortvar
+   %{dep:test_toplevel.bc}
+   -o
+   %{targets})))
 
 (rule
  (target test_toplevel.actual)

From 97db4d601766a9eb3086f15d6745715259cc3d8e Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 27 Nov 2024 22:39:46 +0100
Subject: [PATCH 466/481] Misc: bump test dep

---
 dune-project                       | 2 +-
 js_of_ocaml-toplevel.opam          | 2 +-
 toplevel/examples/server/server.ml | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/dune-project b/dune-project
index 6be93f23c5..d21f14b03f 100644
--- a/dune-project
+++ b/dune-project
@@ -93,7 +93,7 @@
   (ocaml (>= 4.08))
   (js_of_ocaml-compiler (= :version))
   (ocamlfind (>= 1.5.1))
-  (cohttp-lwt-unix :with-test)
+  (cohttp-lwt-unix (and (>= 6.0.0) :with-test))
   (graphics :with-test)
   (num :with-test)
   (ppx_expect (and (>= v0.14.2) :with-test))
diff --git a/js_of_ocaml-toplevel.opam b/js_of_ocaml-toplevel.opam
index c1423b680b..b2daa598b2 100644
--- a/js_of_ocaml-toplevel.opam
+++ b/js_of_ocaml-toplevel.opam
@@ -16,7 +16,7 @@ depends: [
   "ocaml" {>= "4.08"}
   "js_of_ocaml-compiler" {= version}
   "ocamlfind" {>= "1.5.1"}
-  "cohttp-lwt-unix" {with-test}
+  "cohttp-lwt-unix" {>= "6.0.0" & with-test}
   "graphics" {with-test}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}
diff --git a/toplevel/examples/server/server.ml b/toplevel/examples/server/server.ml
index d14cf2c229..4ddb58c8ad 100644
--- a/toplevel/examples/server/server.ml
+++ b/toplevel/examples/server/server.ml
@@ -31,7 +31,7 @@ let server () =
       >>= fun () -> Server.respond_file ~headers:header_plain_user_charset ~fname ()
     with _ ->
       (* send static file *)
-      let fname = Server.resolve_file ~docroot:"." ~uri in
+      let fname = Path.resolve_local_file ~docroot:"." ~uri in
       Lwt_io.eprintf "static: %s\n" fname
       >>= fun () ->
       let headers =

From 6239d596ace9985855fab5edfa4cacb63d216a26 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 26 Nov 2024 15:19:31 +0100
Subject: [PATCH 467/481] Use JS String Builtins to convert ASCII OCaml strings
 to Javascript strings

---
 runtime/wasm/jsstring.wat | 58 +++++++++++++++++++++++++++++++++++----
 runtime/wasm/runtime.js   |  1 +
 2 files changed, 54 insertions(+), 5 deletions(-)

diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
index d84df649cb..93956d3282 100644
--- a/runtime/wasm/jsstring.wat
+++ b/runtime/wasm/jsstring.wat
@@ -22,6 +22,10 @@
       (func $is_string (param externref) (result i32)))
    (import "wasm:js-string" "hash"
       (func $hash_string (param i32) (param anyref) (result i32)))
+   (import "wasm:js-string" "fromCharCodeArray"
+      (func $fromCharCodeArray
+         (param (ref null $wstring)) (param i32) (param i32)
+         (result (ref extern))))
 
    (import "wasm:text-decoder" "decodeStringFromUTF8Array"
       (func $decodeStringFromUTF8Array
@@ -41,15 +45,21 @@
       (func $append_string (param anyref) (param anyref) (result anyref)))
 
    (type $string (array (mut i8)))
+   (type $wstring (array (mut i16)))
+
+   (global $text_converters_available (mut i32) (i32.const 0))
+   (global $string_builtins_available (mut i32) (i32.const 0))
 
-   (global $builtins_available (mut i32) (i32.const 0))
+   (global $utf16_buffer_size i32 (i32.const 32768))
+   (global $buffer (mut (ref $wstring))
+      (array.new $wstring (i32.const 0) (i32.const 0)))
 
    (start $init)
 
    (func $init
       ;; Our dummy implementation of string conversion always returns
       ;; the empty string.
-      (global.set $builtins_available
+      (global.set $text_converters_available
          (i32.ne
             (i32.const 0)
             (call $compare_strings
@@ -58,7 +68,24 @@
                   (i32.const 0) (i32.const 1))
                (call $decodeStringFromUTF8Array
                   (array.new_fixed $string 1 (i32.const 1))
-                   (i32.const 0) (i32.const 1))))))
+                   (i32.const 0) (i32.const 1)))))
+      (global.set $string_builtins_available
+         (i32.ne
+            (i32.const 0)
+            (call $compare_strings
+               (call $fromCharCodeArray
+                  (array.new_fixed $wstring 1 (i32.const 0))
+                  (i32.const 0) (i32.const 1))
+               (call $fromCharCodeArray
+                  (array.new_fixed $wstring 1 (i32.const 1))
+                   (i32.const 0) (i32.const 1)))))
+      (if (i32.eqz (global.get $text_converters_available))
+         (then
+            (if (global.get $string_builtins_available)
+               (then
+                  (global.set $buffer
+                     (array.new $wstring (i32.const 0)
+                        (global.get $utf16_buffer_size))))))))
 
    (func (export "jsstring_compare")
       (param $s anyref) (param $s' anyref) (result i32)
@@ -75,13 +102,34 @@
    (func $jsstring_of_substring (export "jsstring_of_substring")
       (param $s (ref $string)) (param $pos i32) (param $len i32)
       (result anyref)
-      (if (global.get $builtins_available)
+      (local $i i32) (local $c i32)
+      (if (global.get $text_converters_available)
          (then
             (return
                (any.convert_extern
                   (call $decodeStringFromUTF8Array (local.get $s)
                      (local.get $pos)
                      (i32.add (local.get $pos) (local.get $len)))))))
+      (if $continue
+         (i32.and (global.get $string_builtins_available)
+            (i32.le_u (local.get $len) (global.get $utf16_buffer_size)))
+         (then
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (local.set $c
+                        (array.get $string (local.get $s)
+                           (i32.add (local.get $pos) (local.get $i))))
+                     (br_if $continue
+                        (i32.ge_u (local.get $c) (i32.const 128)))
+                     (array.set $wstring (global.get $buffer) (local.get $i)
+                        (local.get $c))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+                     (br $loop))))
+            (return
+               (any.convert_extern
+                  (call $fromCharCodeArray (global.get $buffer)
+                     (i32.const 0) (local.get $len))))))
       (return_call $jsstring_of_substring_fallback
          (local.get $s) (local.get $pos) (local.get $len)))
 
@@ -90,7 +138,7 @@
          (local.get $s) (i32.const 0) (array.len (local.get $s))))
 
    (func (export "string_of_jsstring") (param $s anyref) (result (ref $string))
-      (if (global.get $builtins_available)
+      (if (global.get $text_converters_available)
          (then
             (return_call $encodeStringToUTF8Array
                (extern.convert_any (local.get $s)))))
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 0e9ecc1170..c40c649ba0 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -465,6 +465,7 @@
     hash: hash_string,
     decodeStringFromUTF8Array: () => "",
     encodeStringToUTF8Array: () => 0,
+    fromCharCodeArray: () => "",
   };
   const imports = Object.assign(
     {

From 3656b8fae66c5ed6b276369f0aa3e7499a5208b6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Fri, 29 Nov 2024 18:50:03 +0100
Subject: [PATCH 468/481] Update examples

---
 examples/README.md                  | 13 ++++++
 examples/boulderdash/boulderdash.ml |  8 +---
 examples/boulderdash/dune           | 27 +++++--------
 examples/boulderdash/index.html     |  2 +-
 examples/cubes/dune                 | 15 +++----
 examples/cubes/index.html           |  2 +-
 examples/graph_viewer/dune          | 21 ++++------
 examples/graph_viewer/index.html    |  2 +-
 examples/graph_viewer/scene.ml      |  4 ++
 examples/graph_viewer/scene.mli     |  2 +
 examples/graph_viewer/viewer_js.ml  | 36 ++++++++++-------
 examples/graphics/dune              |  6 +++
 examples/hyperbolic/dune            | 33 +++++++--------
 examples/hyperbolic/hypertree.ml    | 62 ++++++++++++++++-------------
 examples/hyperbolic/index.html      |  2 +-
 examples/minesweeper/dune           |  9 +++--
 examples/minesweeper/index.html     |  2 +-
 examples/minesweeper/main.ml        |  7 +---
 examples/planet/dune                | 15 +++----
 examples/planet/index.html          |  2 +-
 examples/planet/planet.ml           |  9 ++---
 examples/test_wheel/dune            |  6 +++
 examples/webgl/dune                 | 19 ++++-----
 examples/webgl/index.html           |  2 +-
 examples/webgl/webgldemo.ml         | 10 ++---
 examples/wiki/dune                  |  9 +++--
 examples/wiki/index.html            |  2 +-
 examples/wiki/main.ml               |  7 +---
 examples/wysiwyg/dune               |  9 +++--
 examples/wysiwyg/index.html         |  2 +-
 examples/wysiwyg/main.ml            |  7 +---
 31 files changed, 180 insertions(+), 172 deletions(-)

diff --git a/examples/README.md b/examples/README.md
index 8742565178..842b7ba6b4 100644
--- a/examples/README.md
+++ b/examples/README.md
@@ -10,4 +10,17 @@ Or a single one:
 $> dune build @examples/<path-to-example-project>/default
 ```
 
+Add the `--profile wasm` option to compile to Wasm:
+```
+$> dune build @examples/boulderdash/default --profile wasm
+```
+
 Compilation artifacts can be found in `${REPO_ROOT}/_build/default/examples/`.
+
+When generating JavaScript code, you can directly open the
+`index.html` files in a browser. When generating Wasm code, you need
+to serve the files, for instance with the following command:
+```
+python -m http.server -d _build/default/examples/boulderdash/
+```
+and then open `http://localhost:8000` in a browser.
diff --git a/examples/boulderdash/boulderdash.ml b/examples/boulderdash/boulderdash.ml
index f5d0f8b5a0..c2b1bc962d 100644
--- a/examples/boulderdash/boulderdash.ml
+++ b/examples/boulderdash/boulderdash.ml
@@ -326,7 +326,7 @@ let http_get url =
   let msg = r.XmlHttpRequest.content in
   if cod = 0 || cod = 200 then Lwt.return msg else fst (Lwt.wait ())
 
-let getfile f = try Lwt.return (Sys_js.read_file ~name:f) with Not_found -> http_get f
+let getfile f = try Lwt.return (Sys_js.read_file ~name:f) with Sys_error _ -> http_get f
 
 exception Eos
 
@@ -507,8 +507,4 @@ let start _ =
   Dom.appendChild body div;
   Lwt.return ()
 
-let _ =
-  Html.window##.onload :=
-    Html.handler (fun _ ->
-        ignore (start ());
-        Js._false)
+let () = Lwt.async start
diff --git a/examples/boulderdash/dune b/examples/boulderdash/dune
index 952ee49396..3f26cd2f5a 100644
--- a/examples/boulderdash/dune
+++ b/examples/boulderdash/dune
@@ -1,30 +1,25 @@
 (executables
  (names boulderdash)
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
+ (js_of_ocaml
+  (flags :standard --file %{dep:maps.txt} --file maps))
+ (link_deps
+  (glob_files maps/*.map))
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (rule
- (targets boulderdash.js)
- (deps
-  (glob_files maps/*.map))
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:boulderdash.bc}
-   -o
-   %{targets}
-   --pretty
-   --file
-   %{dep:maps.txt}
-   --file
-   maps)))
+  (copy boulderdash.bc.wasm.js boulderdash.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
  (deps
-  boulderdash.js
+  boulderdash.bc.js
   index.html
+  maps.txt
+  (glob_files maps/*.map)
   (glob_files sprites/*.{png,svg})))
diff --git a/examples/boulderdash/index.html b/examples/boulderdash/index.html
index 1ccdf3e964..fcd89ea7d8 100644
--- a/examples/boulderdash/index.html
+++ b/examples/boulderdash/index.html
@@ -5,7 +5,7 @@
   <head>
     <title>Boulder Dash</title>
     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
-    <script type="text/javascript" src="boulderdash.js"></script>
+    <script type="text/javascript" src="boulderdash.bc.js" defer></script>
   </head>
   <body id="boulderdash">
   </body>
diff --git a/examples/cubes/dune b/examples/cubes/dune
index 56d43c509d..f945ab2f69 100644
--- a/examples/cubes/dune
+++ b/examples/cubes/dune
@@ -1,21 +1,16 @@
 (executables
  (names cubes)
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (rule
- (targets cubes.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:cubes.bc}
-   -o
-   %{targets}
-   --pretty)))
+  (copy cubes.bc.wasm.js cubes.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
- (deps cubes.js index.html))
+ (deps cubes.bc.js index.html))
diff --git a/examples/cubes/index.html b/examples/cubes/index.html
index b4cadb1ff7..09508370d2 100644
--- a/examples/cubes/index.html
+++ b/examples/cubes/index.html
@@ -4,7 +4,7 @@
 <html xmlns="http://www.w3.org/1999/xhtml">
   <head>
     <title>Cubes</title>
-    <script type="text/javascript" src="cubes.js" defer></script>
+    <script type="text/javascript" src="cubes.bc.js" defer></script>
   </head>
   <body>
   </body>
diff --git a/examples/graph_viewer/dune b/examples/graph_viewer/dune
index b22b3d62c2..e67a55a769 100644
--- a/examples/graph_viewer/dune
+++ b/examples/graph_viewer/dune
@@ -1,7 +1,7 @@
 (executables
  (names viewer_js) ;; add converter & viewer
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
  (modules
   (:standard
    \
@@ -13,24 +13,19 @@
    dot_lexer
    dot_graph
    dot_render))
+ (js_of_ocaml
+  (flags :standard --file %{dep:scene.json}))
  (preprocess
-  (pps js_of_ocaml-ppx)))
+  (pps js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json)))
 
 (ocamllex dot_lexer)
 
 (rule
- (targets viewer_js.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:viewer_js.bc}
-   -o
-   %{targets}
-   --pretty
-   --file
-   %{dep:scene.json})))
+  (copy viewer_js.bc.wasm.js viewer_js.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
- (deps viewer_js.js index.html))
+ (deps viewer_js.bc.js scene.json index.html))
diff --git a/examples/graph_viewer/index.html b/examples/graph_viewer/index.html
index 857bf5eaff..b4c6d482bd 100644
--- a/examples/graph_viewer/index.html
+++ b/examples/graph_viewer/index.html
@@ -4,7 +4,7 @@
 <html xmlns="http://www.w3.org/1999/xhtml">
   <head>
     <title>Graph viewer</title>
-  <script type="text/javascript" src="viewer_js.js"></script>
+  <script type="text/javascript" src="viewer_js.bc.js" defer></script>
   </head>
   <body>
   </body>
diff --git a/examples/graph_viewer/scene.ml b/examples/graph_viewer/scene.ml
index 8185bb8d9f..9a917e21e6 100644
--- a/examples/graph_viewer/scene.ml
+++ b/examples/graph_viewer/scene.ml
@@ -17,9 +17,12 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
+[@@@warning "-39"]
+
 type command =
   | Move_to of float * float
   | Curve_to of float * float * float * float * float * float
+[@@deriving json]
 
 type color = float * float * float
 
@@ -28,6 +31,7 @@ type ('color, 'font, 'text) element =
   | Polygon of (float * float) array * 'color option * 'color option
   | Ellipse of float * float * float * float * 'color option * 'color option
   | Text of float * float * 'text * 'font * 'color option * 'color option
+[@@deriving json]
 
 (****)
 
diff --git a/examples/graph_viewer/scene.mli b/examples/graph_viewer/scene.mli
index 685a9584b2..935ee5168a 100644
--- a/examples/graph_viewer/scene.mli
+++ b/examples/graph_viewer/scene.mli
@@ -20,6 +20,7 @@
 type command =
   | Move_to of float * float
   | Curve_to of float * float * float * float * float * float
+[@@deriving json]
 
 type color = float * float * float
 
@@ -28,6 +29,7 @@ type ('color, 'font, 'text) element =
   | Polygon of (float * float) array * 'color option * 'color option
   | Ellipse of float * float * float * float * 'color option * 'color option
   | Text of float * float * 'text * 'font * 'color option * 'color option
+[@@deriving json]
 
 (****)
 
diff --git a/examples/graph_viewer/viewer_js.ml b/examples/graph_viewer/viewer_js.ml
index a0e7316903..0e37cdff64 100644
--- a/examples/graph_viewer/viewer_js.ml
+++ b/examples/graph_viewer/viewer_js.ml
@@ -166,15 +166,8 @@ open Common
 let redraw st s h v (canvas : Html.canvasElement Js.t) =
   let width = canvas##.width in
   let height = canvas##.height in
-  (*Firebug.console##time (Js.string "draw");*)
   redraw st s h v canvas { x = 0; y = 0; width; height } 0 0 width height
 
-(*
-;Firebug.console##timeEnd (Js.string "draw")
-;Firebug.console##log_2 (Js.string "draw", Js.date##now())
-*)
-let json : < parse : Js.js_string Js.t -> 'a > Js.t = Js.Unsafe.pure_js_expr "JSON"
-
 let ( >>= ) = Lwt.bind
 
 let http_get url =
@@ -182,7 +175,7 @@ let http_get url =
   >>= fun { XmlHttpRequest.code = cod; content = msg; _ } ->
   if cod = 0 || cod = 200 then Lwt.return msg else fst (Lwt.wait ())
 
-let getfile f = try Lwt.return (Sys_js.read_file ~name:f) with Not_found -> http_get f
+let getfile f = try Lwt.return (Sys_js.read_file ~name:f) with Sys_error _ -> http_get f
 
 class adjustment
   ?(value = 0.)
@@ -275,6 +268,25 @@ let handle_drag element f =
            in this example. *)
         Js._true)
 
+let of_json ~typ v =
+  match Sys.backend_type with
+  | Other "js_of_ocaml" -> Js._JSON##parse (Js.string v)
+  | _ -> Deriving_Json.from_string typ v
+
+type js_string = Js.js_string Js.t
+
+let js_string_to_json _ _ : unit = assert false
+
+let js_string_of_json buf = Js.bytestring (Deriving_Json.Json_string.read buf)
+
+[@@@warning "-20-39"]
+
+type scene =
+  (float * float * float * float)
+  * (float * float * float * float) array
+  * (js_string, js_string, js_string) Scene.element array
+[@@deriving json]
+
 let start () =
   let doc = Html.document in
   let page = doc##.documentElement in
@@ -300,7 +312,7 @@ let start () =
   Firebug.console##timeEnd(Js.string "loading");
   Firebug.console##time(Js.string "parsing");
 *)
-  let (x1, y1, x2, y2), bboxes, scene = json##parse (Js.string s) in
+  let (x1, y1, x2, y2), bboxes, scene = of_json ~typ:[%json: scene] s in
   (*
   Firebug.console##timeEnd(Js.string "parsing");
   Firebug.console##time(Js.string "init");
@@ -560,8 +572,4 @@ Firebug.console##timeEnd(Js.string "init");
 *)
   Lwt.return ()
 
-let _ =
-  Html.window##.onload :=
-    Html.handler (fun _ ->
-        ignore (start ());
-        Js._false)
+let () = Lwt.async start
diff --git a/examples/graphics/dune b/examples/graphics/dune
index cecdf24620..da1fd0f113 100644
--- a/examples/graphics/dune
+++ b/examples/graphics/dune
@@ -5,6 +5,12 @@
  (preprocess
   (pps js_of_ocaml-ppx)))
 
+(rule
+ (action
+  (copy main.bc.wasm.js main.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
+
 (alias
  (name default)
  (deps main.bc.js index.html))
diff --git a/examples/hyperbolic/dune b/examples/hyperbolic/dune
index f1fb55f990..7a6788b708 100644
--- a/examples/hyperbolic/dune
+++ b/examples/hyperbolic/dune
@@ -1,31 +1,32 @@
 (executables
  (names hypertree)
  (libraries js_of_ocaml-lwt)
- (modes byte)
- (preprocess
-  (pps js_of_ocaml-ppx)))
-
-(rule
- (targets hypertree.js)
- (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:hypertree.bc}
-   -o
-   %{targets}
-   --pretty
+ (modes js wasm)
+ (js_of_ocaml
+  (flags
+   :standard
    --file
    %{dep:image_info.json}
    --file
    %{dep:messages.json}
    --file
-   %{dep:tree.json})))
+   %{dep:tree.json}))
+ (preprocess
+  (pps js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json)))
+
+(rule
+ (action
+  (copy hypertree.bc.wasm.js hypertree.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
  (deps
-  hypertree.js
+  hypertree.bc.js
   index.html
+  image_info.json
+  messages.json
+  tree.json
   (glob_files icons/*.{png,jpg})
   (glob_files thumbnails/*.{png,jpg})))
diff --git a/examples/hyperbolic/hypertree.ml b/examples/hyperbolic/hypertree.ml
index aacebb611e..b6d55991be 100644
--- a/examples/hyperbolic/hypertree.ml
+++ b/examples/hyperbolic/hypertree.ml
@@ -248,8 +248,6 @@ let lwt_wrap f =
 
 module Html = Dom_html
 
-let json : < parse : Js.js_string Js.t -> 'a > Js.t = Js.Unsafe.pure_js_expr "JSON"
-
 let http_get url =
   XmlHttpRequest.get url
   >>= fun r ->
@@ -257,7 +255,7 @@ let http_get url =
   let msg = r.XmlHttpRequest.content in
   if cod = 0 || cod = 200 then Lwt.return msg else fst (Lwt.wait ())
 
-let getfile f = try Lwt.return (Sys_js.read_file ~name:f) with Not_found -> http_get f
+let getfile f = try Lwt.return (Sys_js.read_file ~name:f) with Sys_error _ -> http_get f
 
 let load_image src =
   let img = Html.createImg Html.document in
@@ -524,6 +522,13 @@ let text_size font txt =
 
 (******)
 
+let of_json ~typ v =
+  match Sys.backend_type with
+  | Other "js_of_ocaml" -> Js._JSON##parse (Js.string v)
+  | _ -> Deriving_Json.from_string typ v
+
+(******)
+
 let default_language () =
   (Js.Optdef.get
      Dom_html.window##.navigator##.language
@@ -546,7 +551,7 @@ let set_language lang =
   language := lang
 
 let load_messages () =
-  getfile "messages.json" >>= fun s -> Lwt.return (json##parse (Js.string s))
+  getfile "messages.json" >>= fun s -> Lwt.return (Js._JSON##parse (Js.string s))
 
 let local_messages msgs : messages Js.t = option (Js.Unsafe.get msgs !language)
 
@@ -794,7 +799,7 @@ let tree_url = "tree.json"
 
 let ( >> ) x f = f x
 
-type 'a tree = Node of 'a * 'a tree array
+type 'a tree = Node of 'a * 'a tree array [@@deriving json]
 
 let rec tree_vertice_count n =
   let (Node (_, l)) = n in
@@ -1067,17 +1072,22 @@ let tree_layout node_names root =
   compute_text_nodes node_names nodes;
   vertices, edges, nodes, boxes
 
+type js_string = Js.js_string Js.t
+
+let js_string_to_json _ _ : unit = assert false
+
+let js_string_of_json buf = Js.bytestring (Deriving_Json.Json_string.read buf)
+
+[@@@warning "-20-39"]
+
+type tree_info =
+  js_string tree * (js_string * (js_string * js_string) array * js_string) array
+[@@deriving json]
+
 let load_tree () =
   getfile tree_url
   >>= fun s ->
-  let info :
-      Js.js_string Js.t tree
-      * (Js.js_string Js.t
-        * (Js.js_string Js.t * Js.js_string Js.t) array
-        * Js.js_string Js.t)
-        array =
-    json##parse (Js.string s)
-  in
+  let info : tree_info = of_json ~typ:[%json: tree_info] s in
   let tree, node_names = info in
   randomize_tree tree;
   let node_names =
@@ -1091,17 +1101,18 @@ let load_tree () =
   Lwt.return (tree_layout node_names tree, node_names)
 
 type info =
-  { name : Js.js_string Js.t
-  ; url : Js.js_string Js.t
-  ; attribution : Js.js_string Js.t
+  { name : js_string
+  ; url : js_string
+  ; attribution : js_string
   ; width : int
   ; height : int
-  ; links : (Js.js_string Js.t * Js.js_string Js.t * Js.js_string Js.t) array
-  ; img_url : Js.js_string Js.t option
+  ; links : (js_string * js_string * js_string) array
+  ; img_url : js_string option
   }
+[@@deriving json]
 
 let load_image_info () : info array Lwt.t =
-  getfile "image_info.json" >>= fun s -> Lwt.return (json##parse (Js.string s))
+  getfile "image_info.json" >>= fun s -> Lwt.return (of_json ~typ:[%json: info array] s)
 
 let close_button over =
   let color = opt_style style##.buttonColor (Js.string "#888888") in
@@ -1845,6 +1856,7 @@ debug_msg (Format.sprintf "Resize %d %d" w h);
       prev_buttons := Some buttons
     in
     make_buttons ();
+    (*
     let img = Html.createImg doc in
     img##.src := icon "ocsigen-powered.png";
     let a = Html.createA doc in
@@ -1857,15 +1869,11 @@ debug_msg (Format.sprintf "Resize %d %d" w h);
     logo##.style##.bottom := Js.string "0";
     Dom.appendChild logo a;
     Dom.appendChild doc##.body logo;
-    Lwt.return ());
-  Js._false
+*)
+    Lwt.return ())
 
-let start _ =
+let () =
   try
     ignore (Html.createCanvas Html.window##.document);
     start ()
-  with Html.Canvas_not_available ->
-    unsupported_messages ();
-    Js._false
-
-let _ = Html.window##.onload := Html.handler start
+  with Html.Canvas_not_available -> unsupported_messages ()
diff --git a/examples/hyperbolic/index.html b/examples/hyperbolic/index.html
index 6d29554d60..6b9f6e1c49 100644
--- a/examples/hyperbolic/index.html
+++ b/examples/hyperbolic/index.html
@@ -78,6 +78,6 @@
     </script>
   </head>
   <body>
-    <script type="text/javascript" src="hypertree.js"></script>
+    <script type="text/javascript" src="hypertree.bc.js" defer></script>
   </body>
 </html>
diff --git a/examples/minesweeper/dune b/examples/minesweeper/dune
index f393dd49ca..12a574195b 100644
--- a/examples/minesweeper/dune
+++ b/examples/minesweeper/dune
@@ -1,18 +1,19 @@
 (executables
  (names main)
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (rule
- (targets main.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:main.bc} -o %{targets} --pretty)))
+  (copy main.bc.wasm.js main.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
  (deps
-  main.js
+  main.bc.js
   index.html
   (glob_files sprites/*.{png,svg})))
diff --git a/examples/minesweeper/index.html b/examples/minesweeper/index.html
index 43eef95f15..f4243fca7a 100644
--- a/examples/minesweeper/index.html
+++ b/examples/minesweeper/index.html
@@ -5,7 +5,7 @@
   <head>
     <title>Minesweeper</title>
     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
-    <script type="text/javascript" src="main.js"></script>
+    <script type="text/javascript" src="main.bc.js" defer></script>
   </head>
   <body>
     <div id="main"></div>
diff --git a/examples/minesweeper/main.ml b/examples/minesweeper/main.ml
index 32bd38b5ae..0851c819f3 100644
--- a/examples/minesweeper/main.ml
+++ b/examples/minesweeper/main.ml
@@ -35,7 +35,7 @@ let button name callback =
   Dom.appendChild res input;
   res
 
-let onload _ =
+let () =
   let main = Js.Opt.get (document##getElementById (js "main")) (fun () -> assert false) in
   let nbr, nbc, nbm = ref 10, ref 12, ref 15 in
   Dom.appendChild main (int_input "Number of columns" nbr);
@@ -50,7 +50,4 @@ let onload _ =
          let div = Html.createDiv document in
          Dom.appendChild main div;
          Minesweeper.run div !nbc !nbr !nbm;
-         Js._false));
-  Js._false
-
-let () = Html.window##.onload := Html.handler onload
+         Js._false))
diff --git a/examples/planet/dune b/examples/planet/dune
index 30e0388841..c1c9db4ec8 100644
--- a/examples/planet/dune
+++ b/examples/planet/dune
@@ -1,21 +1,16 @@
 (executables
  (names planet)
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (rule
- (targets planet.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:planet.bc}
-   -o
-   %{targets}
-   --pretty)))
+  (copy planet.bc.wasm.js planet.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
- (deps planet.js index.html texture.jpg))
+ (deps planet.bc.js index.html texture.jpg))
diff --git a/examples/planet/index.html b/examples/planet/index.html
index eeeae461f1..aba6071fd8 100644
--- a/examples/planet/index.html
+++ b/examples/planet/index.html
@@ -13,7 +13,7 @@
 p {clear:left;}
 -->
 </style>
-  <script type="text/javascript" src="planet.js"></script>
+  <script type="text/javascript" src="planet.bc.js" defer></script>
   </head>
   <body>
   </body>
diff --git a/examples/planet/planet.ml b/examples/planet/planet.ml
index 1e55fdf5cd..25d0f4a724 100644
--- a/examples/planet/planet.ml
+++ b/examples/planet/planet.ml
@@ -592,9 +592,9 @@ let _texture = Js.string "black.jpg"
 
 let _texture = Js.string "../planet/land_ocean_ice_cloud_2048.jpg"
 
-let texture = Js.string "../planet/texture.jpg"
+let texture = Js.string "texture.jpg"
 
-let start _ =
+let () =
   Lwt.ignore_result
     (load_image texture
     >>= fun texture ->
@@ -776,7 +776,4 @@ if true then Lwt.return () else
       if (not !paused) && !follow then phi_rot := !phi_rot +. angle;
       loop t' (if !paused then phi else phi +. angle)
     in
-    loop (Js.to_float (new%js Js.date_now)##getTime) 0.);
-  Js._false
-
-let _ = Html.window##.onload := Html.handler start
+    loop (Js.to_float (new%js Js.date_now)##getTime) 0.)
diff --git a/examples/test_wheel/dune b/examples/test_wheel/dune
index ba4be3c0a9..09de8f259d 100644
--- a/examples/test_wheel/dune
+++ b/examples/test_wheel/dune
@@ -4,3 +4,9 @@
  (modes js wasm)
  (preprocess
   (pps js_of_ocaml-ppx)))
+
+(rule
+ (action
+  (copy test_wheel.bc.wasm.js test_wheel.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
diff --git a/examples/webgl/dune b/examples/webgl/dune
index 8025ac85fb..dd0cbcdd3e 100644
--- a/examples/webgl/dune
+++ b/examples/webgl/dune
@@ -1,23 +1,18 @@
 (executables
  (names webgldemo)
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
+ (js_of_ocaml
+  (flags :standard --file %{dep:monkey.model}))
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (rule
- (targets webgldemo.js)
  (action
-  (run
-   %{bin:js_of_ocaml}
-   --source-map
-   %{dep:webgldemo.bc}
-   -o
-   %{targets}
-   --pretty
-   --file
-   %{dep:monkey.model})))
+  (copy webgldemo.bc.wasm.js webgldemo.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
- (deps webgldemo.js index.html))
+ (deps webgldemo.bc.js monkey.model index.html))
diff --git a/examples/webgl/index.html b/examples/webgl/index.html
index 3110e5b81c..da0ce73cf8 100644
--- a/examples/webgl/index.html
+++ b/examples/webgl/index.html
@@ -42,7 +42,7 @@
     gl_FragColor = vec4( col * lighting + u_ambientLight, 1);
   }
 </script>
-  <script type="text/javascript" src="webgldemo.js"></script>
+  <script type="text/javascript" src="webgldemo.bc.js" defer></script>
   </head>
   <body>
     <canvas id="canvas" height="400" width="400"></canvas>
diff --git a/examples/webgl/webgldemo.ml b/examples/webgl/webgldemo.ml
index c071713e7a..082b6be798 100644
--- a/examples/webgl/webgldemo.ml
+++ b/examples/webgl/webgldemo.ml
@@ -220,7 +220,8 @@ let http_get url =
   if cod = 0 || cod = 200 then Lwt.return msg else fst (Lwt.wait ())
 
 let getfile f =
-  try Lwt.return (Sys_js.read_file ~name:f) with Not_found -> http_get f >|= fun s -> s
+  try Lwt.return (Sys_js.read_file ~name:f)
+  with Sys_error _ -> http_get f >|= fun s -> s
 
 let fetch_model s =
   getfile s
@@ -298,12 +299,9 @@ let start (pos, norm) =
   in
   f ()
 
-let go _ =
+let () =
   ignore
     (debug "fetching model";
      catch
        (fun () -> fetch_model "monkey.model" >>= start)
-       (fun exn -> error "uncaught exception: %s" (Printexc.to_string exn)));
-  _true
-
-let _ = Dom_html.window##.onload := Dom_html.handler go
+       (fun exn -> error "uncaught exception: %s" (Printexc.to_string exn)))
diff --git a/examples/wiki/dune b/examples/wiki/dune
index 93735a2832..ee357ad4a6 100644
--- a/examples/wiki/dune
+++ b/examples/wiki/dune
@@ -1,17 +1,18 @@
 (executables
  (names main)
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (ocamllex wikicreole)
 
 (rule
- (targets main.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:main.bc} -o %{targets} --pretty)))
+  (copy main.bc.wasm.js main.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
- (deps main.js index.html))
+ (deps main.bc.js index.html))
diff --git a/examples/wiki/index.html b/examples/wiki/index.html
index aa4519299e..8d8ff3fb68 100644
--- a/examples/wiki/index.html
+++ b/examples/wiki/index.html
@@ -5,7 +5,7 @@
   <head>
     <title>Realtime wiki syntax parsing</title>
     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
-    <script type="text/javascript" src="main.js"></script>
+    <script type="text/javascript" src="main.bc.js" defer></script>
   </head>
   <body id="wiki_demo">
   </body>
diff --git a/examples/wiki/main.ml b/examples/wiki/main.ml
index d7f8ea48c2..c9359e5705 100644
--- a/examples/wiki/main.ml
+++ b/examples/wiki/main.ml
@@ -27,7 +27,7 @@ let replace_child p n =
   Js.Opt.iter p##.firstChild (fun c -> Dom.removeChild p c);
   Dom.appendChild p n
 
-let onload _ =
+let () =
   let d = Html.document in
   let body =
     Js.Opt.get (d##getElementById (Js.string "wiki_demo")) (fun () -> assert false)
@@ -56,7 +56,4 @@ let onload _ =
     in
     Lwt_js.sleep (if n = 0 then 0.5 else 0.1) >>= fun () -> dyn_preview text n
   in
-  ignore (dyn_preview "" 0);
-  Js._false
-
-let _ = Html.window##.onload := Html.handler onload
+  ignore (dyn_preview "" 0)
diff --git a/examples/wysiwyg/dune b/examples/wysiwyg/dune
index 45c74c83cd..ef6b073cbe 100644
--- a/examples/wysiwyg/dune
+++ b/examples/wysiwyg/dune
@@ -1,15 +1,16 @@
 (executables
  (names main)
  (libraries js_of_ocaml-lwt)
- (modes byte)
+ (modes js wasm)
  (preprocess
   (pps js_of_ocaml-ppx)))
 
 (rule
- (targets main.js)
  (action
-  (run %{bin:js_of_ocaml} --source-map %{dep:main.bc} -o %{targets} --pretty)))
+  (copy main.bc.wasm.js main.bc.js))
+ (enabled_if
+  (not %{env:js-enabled=})))
 
 (alias
  (name default)
- (deps main.js index.html))
+ (deps main.bc.js index.html))
diff --git a/examples/wysiwyg/index.html b/examples/wysiwyg/index.html
index 57a2a92390..1631d03c66 100644
--- a/examples/wysiwyg/index.html
+++ b/examples/wysiwyg/index.html
@@ -5,7 +5,7 @@
   <head>
     <title>Kakadu's WYSIWYG wiki editor</title>
     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
-    <script type="text/javascript" src="main.js"></script>
+    <script type="text/javascript" src="main.bc.js" defer></script>
   </head>
   <body id="wiki_demo">
   </body>
diff --git a/examples/wysiwyg/main.ml b/examples/wysiwyg/main.ml
index 43341cecdf..d28b5f5863 100644
--- a/examples/wysiwyg/main.ml
+++ b/examples/wysiwyg/main.ml
@@ -102,7 +102,7 @@ let rec html2wiki body =
   done;
   Buffer.contents ans
 
-let onload _ =
+let () =
   let d = Html.document in
   let body =
     Js.Opt.get (d##getElementById (Js.string "wiki_demo")) (fun () -> assert false)
@@ -212,7 +212,4 @@ let onload _ =
         in
         Lwt_js.sleep (if n = 0 then 0.5 else 0.1) >>= fun () -> dyn_preview text n
       in
-      ignore (dyn_preview "" 0));
-  Js._false
-
-let _ = Html.window##.onload := Html.handler onload
+      ignore (dyn_preview "" 0))

From 50bdad213a3b9839d47e154b1ac2b79d45f2f358 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 3 Dec 2024 11:27:36 +0100
Subject: [PATCH 469/481] CI: cache binaryen

---
 .github/workflows/build.yml | 64 +++++++++++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 1bf899719e..d5709e6f63 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -115,6 +115,70 @@ jobs:
       - run: opam install conf-pkg-config
         if: runner.os == 'Windows'
 
+      - name: Restore cached binaryen
+        id: cache-binaryen
+        uses: actions/cache/restore@v4
+        with:
+          path: binaryen
+          key: ${{ runner.os }}-binaryen-version_118
+
+      - name: Checkout binaryen
+        if: steps.cache-binaryen.outputs.cache-hit != 'true'
+        uses: actions/checkout@v4
+        with:
+          repository: WebAssembly/binaryen
+          path: binaryen
+          submodules: true
+          ref: version_118
+
+      - name: Install ninja (Ubuntu)
+        if: matrix.os == 'ubuntu-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
+        run: sudo apt-get install ninja-build
+
+      - name: Install ninja (MacOS)
+        if: matrix.os == 'macos-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
+        run: brew install ninja
+
+      - name: Build binaryen
+        if: matrix.os != 'windows-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
+        working-directory: ./binaryen
+        run: |
+          cmake -G Ninja .
+          ninja
+
+      - name: Install binaryen build dependencies (Windows)
+        if: matrix.os == 'windows-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
+        working-directory: ./binaryen
+        run: opam install conf-cmake conf-c++
+
+      - name: Build binaryen (Windows)
+        if: matrix.os == 'windows-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
+        working-directory: ./binaryen
+        run: |
+          opam exec -- cmake . -DBUILD_STATIC_LIB=ON -DBUILD_TESTS=off -DINSTALL_LIBS=off -DCMAKE_C_COMPILER=x86_64-w64-mingw32-gcc
+          make -j 4
+
+      - name: Cache binaryen
+        if: steps.cache-binaryen.outputs.cache-hit != 'true'
+        uses: actions/cache/save@v4
+        with:
+          path: binaryen
+          key: ${{ runner.os }}-binaryen-version_118
+
+      - name: Set binaryen's path
+        shell: bash
+        run: echo "$GITHUB_WORKSPACE/binaryen/bin" >> $GITHUB_PATH
+
+      - name: Copy binaryen's tools (Windows)
+        if: matrix.os == 'windows-latest'
+        shell: bash
+        # Somehow, setting the path above does not work
+        run: cp $GITHUB_WORKSPACE/binaryen/bin/wasm-{merge,opt}.exe _opam/bin
+
+      - name: Install faked binaryen-bin package
+        # It's faster to use a cached version
+        run: opam install --fake binaryen-bin
+
       - run: opam install . --best-effort
         if: ${{ matrix.skip-test }}
 

From eeab61c22277e8b59645149c860cca353dcdb883 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Tue, 3 Dec 2024 00:12:18 +0100
Subject: [PATCH 470/481] Add missing primitives

---
 compiler/lib-wasm/generate.ml   |  8 +++-
 compiler/lib/flow.ml            | 13 ++++--
 runtime/wasm/array.wat          | 78 +++++++++++++++++++++++++++++++--
 runtime/wasm/domain.wat         |  3 +-
 runtime/wasm/md5.wat            |  2 +-
 runtime/wasm/runtime_events.wat |  4 ++
 6 files changed, 96 insertions(+), 12 deletions(-)

diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml
index e766b07b1b..63fd81e2d2 100644
--- a/compiler/lib-wasm/generate.ml
+++ b/compiler/lib-wasm/generate.ml
@@ -1168,9 +1168,13 @@ end
 
 let init () =
   let l =
-    [ "caml_ensure_stack_capacity", "%identity"; "caml_callback", "caml_trampoline" ]
+    [ "caml_ensure_stack_capacity", "%identity"
+    ; "caml_process_pending_actions_with_root", "%identity"
+    ; "caml_callback", "caml_trampoline"
+    ; "caml_make_array", "caml_array_of_uniform_array"
+    ]
   in
-  Primitive.register "caml_make_array" `Mutable None None;
+  Primitive.register "caml_array_of_uniform_array" `Mutable None None;
   let l =
     if Config.Flag.effects ()
     then ("caml_alloc_stack", "caml_cps_alloc_stack") :: l
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 799027de83..a580453ce1 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -198,7 +198,9 @@ let rec block_escape st x =
             | Immutable -> ()
             | Maybe_mutable -> Code.Var.ISet.add st.possibly_mutable y);
             Array.iter l ~f:(fun z -> block_escape st z)
-        | Expr (Prim (Extern "caml_make_array", [ Pv y ])) -> block_escape st y
+        | Expr
+            (Prim (Extern ("caml_make_array" | "caml_array_of_uniform_array"), [ Pv y ]))
+          -> block_escape st y
         | _ -> Code.Var.ISet.add st.possibly_mutable y))
     (Var.Tbl.get st.known_origins x)
 
@@ -208,7 +210,7 @@ let expr_escape st _x e =
   | Apply { args; _ } -> List.iter args ~f:(fun x -> block_escape st x)
   | Prim (Array_get, [ Pv x; _ ]) -> block_escape st x
   | Prim ((Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) -> ()
-  | Prim (Extern "caml_make_array", [ Pv _ ]) -> ()
+  | Prim (Extern ("caml_make_array" | "caml_array_of_uniform_array"), [ Pv _ ]) -> ()
   | Prim (Extern name, l) ->
       let ka =
         match Primitive.kind_args name with
@@ -233,7 +235,10 @@ let expr_escape st _x e =
                 | Expr (Constant (Tuple _)) -> ()
                 | Expr (Block (_, a, _, _)) ->
                     Array.iter a ~f:(fun x -> block_escape st x)
-                | Expr (Prim (Extern "caml_make_array", [ Pv y ])) -> (
+                | Expr
+                    (Prim
+                      ( Extern ("caml_make_array" | "caml_array_of_uniform_array")
+                      , [ Pv y ] )) -> (
                     match st.defs.(Var.idx y) with
                     | Expr (Block (_, a, _, _)) ->
                         Array.iter a ~f:(fun x -> block_escape st x)
@@ -416,7 +421,7 @@ let the_native_string_of ~target info x =
 let the_block_contents_of info x =
   match the_def_of info x with
   | Some (Block (_, a, _, _)) -> Some a
-  | Some (Prim (Extern "caml_make_array", [ x ])) -> (
+  | Some (Prim (Extern ("caml_make_array" | "caml_array_of_uniform_array"), [ x ])) -> (
       match the_def_of info x with
       | Some (Block (_, a, _, _)) -> Some a
       | _ -> None)
diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat
index 52daa53268..00d01e8082 100644
--- a/runtime/wasm/array.wat
+++ b/runtime/wasm/array.wat
@@ -29,7 +29,7 @@
    (global $empty_array (ref eq)
       (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
-   (func $caml_make_vect (export "caml_make_vect")
+   (func $caml_make_vect (export "caml_make_vect") (export "caml_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))))
@@ -51,8 +51,24 @@
       (array.set $block (local.get $b) (i32.const 0) (ref.i31 (i32.const 0)))
       (local.get $b))
 
-   (export "caml_make_float_vect" (func $caml_floatarray_create))
-   (func $caml_floatarray_create (export "caml_floatarray_create")
+   (func (export "caml_floatarray_make")
+      (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
+      (local $sz i32) (local $f f64)
+      (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
+      (if (i32.lt_s (local.get $sz) (i32.const 0))
+         (then
+            (call $caml_invalid_argument
+               (array.new_data $string $Array_make
+                               (i32.const 0) (i32.const 10)))))
+      (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array))))
+      (local.set $f
+         (struct.get $float 0
+            (ref.cast (ref $float) (local.get $v))))
+      (array.new $float_array (local.get $f) (local.get $sz)))
+
+   (func $caml_floatarray_create
+      (export "caml_make_float_vect") (export "caml_floatarray_create")
+      (export "caml_array_create_float")
       (param $n (ref eq)) (result (ref eq))
       (local $sz i32)
       (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
@@ -64,7 +80,8 @@
       (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array))))
       (array.new $float_array (f64.const 0) (local.get $sz)))
 
-   (func (export "caml_make_array") (param $vinit (ref eq)) (result (ref eq))
+   (func (export "caml_array_of_uniform_array")
+      (param $vinit (ref eq)) (result (ref eq))
       (local $init (ref $block)) (local $res (ref $float_array))
       (local $size i32) (local $i i32)
       (local.set $init (ref.cast (ref $block) (local.get $vinit)))
@@ -130,6 +147,21 @@
          (local.get $len))
       (local.get $fa2))
 
+   (func (export "caml_floatarray_sub")
+      (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
+      (result (ref eq))
+      (local $len i32)
+      (local $fa1 (ref $float_array)) (local $fa2 (ref $float_array))
+      (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+      (if (i32.eqz (local.get $len)) (then (return (global.get $empty_array))))
+      (local.set $fa1 (ref.cast (ref $float_array) (local.get $a)))
+      (local.set $fa2 (array.new $float_array (f64.const 0) (local.get $len)))
+      (array.copy $float_array $float_array
+         (local.get $fa2) (i32.const 0) (local.get $fa1)
+         (i31.get_u (ref.cast (ref i31) (local.get $i)))
+         (local.get $len))
+      (local.get $fa2))
+
    (func $caml_floatarray_dup (param $a (ref $float_array)) (result (ref eq))
       (local $a' (ref $float_array))
       (local $len i32)
@@ -188,6 +220,30 @@
          (return (local.get $fa))))
       (return_call $caml_floatarray_dup (local.get $fa1)))
 
+   (func (export "caml_floatarray_append")
+      (param $va1 (ref eq)) (param $va2 (ref eq)) (result (ref eq))
+      (local $fa1 (ref $float_array)) (local $fa2 (ref $float_array))
+      (local $fa (ref $float_array))
+      (local $l1 i32) (local $l2 i32)
+      (local.set $fa1 (ref.cast (ref $float_array) (local.get $va1)))
+      (drop (block $a2_not_float_array (result (ref eq))
+         (local.set $fa2
+            (br_on_cast_fail $a2_not_float_array (ref eq) (ref $float_array)
+               (local.get $va2)))
+         (local.set $l1 (array.len (local.get $fa1)))
+         (local.set $l2 (array.len (local.get $fa2)))
+         (local.set $fa
+            (array.new $float_array (f64.const 0)
+               (i32.add (local.get $l1) (local.get $l2))))
+         (array.copy $float_array $float_array
+            (local.get $fa) (i32.const 0) (local.get $fa1) (i32.const 0)
+            (local.get $l1))
+         (array.copy $float_array $float_array
+            (local.get $fa) (local.get $l1) (local.get $fa2) (i32.const 0)
+            (local.get $l2))
+         (return (local.get $fa))))
+      (return_call $caml_floatarray_dup (local.get $fa1)))
+
    (func (export "caml_array_concat") (param (ref eq)) (result (ref eq))
       (local $i i32) (local $len i32)
       (local $l (ref eq)) (local $v (ref eq))
@@ -334,4 +390,18 @@
                (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))
                (local.get $len))))
       (ref.i31 (i32.const 0)))
+
+   (func (export "caml_floatarray_fill")
+      (param $a (ref eq)) (param $i (ref eq)) (param $vlen (ref eq))
+      (param $v (ref eq)) (result (ref eq))
+      (local $len i32)
+      (local.set $len (i31.get_u (ref.cast (ref i31) (local.get $vlen))))
+      (if (local.get $len)
+         (then
+            (array.fill $float_array
+               (ref.cast (ref $float_array) (local.get $a))
+               (i31.get_u (ref.cast (ref i31) (local.get $i)))
+               (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))
+               (local.get $len))))
+      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat
index d07d700532..f5465bdf58 100644
--- a/runtime/wasm/domain.wat
+++ b/runtime/wasm/domain.wat
@@ -95,7 +95,8 @@
    (global $caml_domain_latest_id (export "caml_domain_latest_id") (mut i32)
       (i32.const 1))
 
-   (func (export "caml_ml_domain_id") (param (ref eq)) (result (ref eq))
+   (func (export "caml_ml_domain_id") (export "caml_ml_domain_index")
+      (param (ref eq)) (result (ref eq))
       (ref.i31 (global.get $caml_domain_id)))
 
    (func (export "caml_ml_domain_cpu_relax") (param (ref eq)) (result (ref eq))
diff --git a/runtime/wasm/md5.wat b/runtime/wasm/md5.wat
index 76bb4a389c..c8149eca6b 100644
--- a/runtime/wasm/md5.wat
+++ b/runtime/wasm/md5.wat
@@ -32,7 +32,7 @@
          (field (ref $int_array)) ;; buffer
          (field (ref $string))))  ;; intermediate buffer
 
-   (func (export "caml_md5_string")
+   (func (export "caml_md5_string") (export "caml_md5_bytes")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (local $ctx (ref $context))
       (local.set $ctx (call $MD5Init))
diff --git a/runtime/wasm/runtime_events.wat b/runtime/wasm/runtime_events.wat
index 8a50583cd7..9ac0f5f2f9 100644
--- a/runtime/wasm/runtime_events.wat
+++ b/runtime/wasm/runtime_events.wat
@@ -62,4 +62,8 @@
    (func (export "caml_runtime_events_read_poll")
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
+
+   (func (export "caml_ml_runtime_events_path")
+      (param (ref eq)) (result (ref eq))
+      (ref.i31 (i32.const 0)))
 )

From 3f22e30cbd7fc2137f02bab02e567d552d655f21 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 2 Dec 2024 23:40:33 +0100
Subject: [PATCH 471/481] Remove version upper bound in opam file

---
 .github/workflows/build-wasm_of_ocaml.yml | 1 +
 dune-project                              | 2 +-
 wasm_of_ocaml-compiler.opam               | 2 +-
 3 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index e0f394dc66..61d7616e76 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -20,6 +20,7 @@ jobs:
           - 5.00.x
           - 5.01.x
           - 5.02.x
+          - 5.3.0~beta2
         separate_compilation:
           - true
         include:
diff --git a/dune-project b/dune-project
index d21f14b03f..8bfe676983 100644
--- a/dune-project
+++ b/dune-project
@@ -139,7 +139,7 @@
  (description
   "Wasm_of_ocaml is a compiler from OCaml bytecode to WebAssembly. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js")
  (depends
-  (ocaml (and (>= 4.14) (< 5.3)))
+  (ocaml (>= 4.14))
   (js_of_ocaml (= :version))
   (num :with-test)
   (ppx_expect (and (>= v0.14.2) :with-test))
diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam
index b8a5d217ad..b145d310e0 100644
--- a/wasm_of_ocaml-compiler.opam
+++ b/wasm_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.17"}
-  "ocaml" {>= "4.14" & < "5.3"}
+  "ocaml" {>= "4.14"}
   "js_of_ocaml" {= version}
   "num" {with-test}
   "ppx_expect" {>= "v0.14.2" & with-test}

From a05e05ac5183740de3617bf200f62a20111fd19d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Mon, 2 Dec 2024 23:47:51 +0100
Subject: [PATCH 472/481] CI: test OCaml 5.3

---
 .github/workflows/build-wasm_of_ocaml.yml | 2 +-
 ppx/ppx_js/tests/dune                     | 8 ++++++--
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 61d7616e76..840b35bb73 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -20,7 +20,7 @@ jobs:
           - 5.00.x
           - 5.01.x
           - 5.02.x
-          - 5.3.0~beta2
+          - ocaml-compiler.5.3.0~beta2
         separate_compilation:
           - true
         include:
diff --git a/ppx/ppx_js/tests/dune b/ppx/ppx_js/tests/dune
index 6cc1f54563..2820801e71 100644
--- a/ppx/ppx_js/tests/dune
+++ b/ppx/ppx_js/tests/dune
@@ -7,7 +7,9 @@
 (rule
  (targets ppx.mlt.corrected)
  (enabled_if
-  (>= %{ocaml_version} 5.2))
+  (and
+   (>= %{ocaml_version} 5.2)
+   (< %{ocaml_version} 5.3)))
  (action
   (run %{exe:main.bc} %{dep:ppx.mlt})))
 
@@ -15,6 +17,8 @@
  (alias runtest)
  (package js_of_ocaml-ppx)
  (enabled_if
-  (>= %{ocaml_version} 5.2))
+  (and
+   (>= %{ocaml_version} 5.2)
+   (< %{ocaml_version} 5.3)))
  (action
   (diff ppx.mlt ppx.mlt.corrected)))

From ad0fee8fb038468ab8573b30d9285ba5781b2b43 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 4 Dec 2024 11:17:51 +0100
Subject: [PATCH 473/481] Misc: ocamlformat.0.27

---
 compiler/bin-wasm_of_ocaml/compile.ml       |  9 ++++---
 compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml |  4 +--
 compiler/lib-wasm/binaryen.ml               | 18 ++++++-------
 compiler/lib-wasm/gc_target.ml              | 27 ++++++++++----------
 compiler/lib-wasm/generate.ml               | 17 +++++++------
 compiler/lib-wasm/link.ml                   | 28 +++++++++++----------
 compiler/lib-wasm/wasm_link.ml              |  5 ++--
 compiler/lib-wasm/wasm_output.ml            |  2 +-
 compiler/lib-wasm/wat_output.ml             | 21 ++++++++--------
 compiler/lib/flow.ml                        |  4 +--
 lib/tests/test_fun_call_2.ml                |  4 +--
 11 files changed, 73 insertions(+), 66 deletions(-)

diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
index 5bb28906c3..9957756643 100644
--- a/compiler/bin-wasm_of_ocaml/compile.ml
+++ b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -304,10 +304,11 @@ let run
   if times () then Format.eprintf "Start parsing...@.";
   let need_debug = enable_source_maps || Config.Flag.debuginfo () in
   let check_debug (one : Parse_bytecode.one) =
-    if (not runtime_only)
-       && enable_source_maps
-       && Parse_bytecode.Debug.is_empty one.debug
-       && not (Code.is_empty one.code)
+    if
+      (not runtime_only)
+      && enable_source_maps
+      && Parse_bytecode.Debug.is_empty one.debug
+      && not (Code.is_empty one.code)
     then
       warn
         "Warning: '--source-map' is enabled but the bytecode program was compiled with \
diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
index 1c4ceec3fb..fdb2df384e 100644
--- a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
+++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml
@@ -28,8 +28,8 @@ let () =
       String.length x > 0
       && (not (Char.equal x.[0] '-'))
       && String.for_all x ~f:(function
-             | 'a' .. 'z' | 'A' .. 'Z' | '-' -> true
-             | _ -> false)
+           | 'a' .. 'z' | 'A' .. 'Z' | '-' -> true
+           | _ -> false)
     in
     match Array.to_list argv with
     | exe :: maybe_command :: rest ->
diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml
index 24ce55a613..93b0b7b7fb 100644
--- a/compiler/lib-wasm/binaryen.ml
+++ b/compiler/lib-wasm/binaryen.ml
@@ -63,15 +63,15 @@ let link ~runtime_files ~input_files ~opt_output_sourcemap ~output_file =
 let generate_dependencies ~dependencies primitives =
   Yojson.Basic.to_string
     (`List
-      (StringSet.fold
-         (fun nm s ->
-           `Assoc
-             [ "name", `String ("js:" ^ nm)
-             ; "import", `List [ `String "js"; `String nm ]
-             ]
-           :: s)
-         primitives
-         (Yojson.Basic.Util.to_list (Yojson.Basic.from_string dependencies))))
+       (StringSet.fold
+          (fun nm s ->
+            `Assoc
+              [ "name", `String ("js:" ^ nm)
+              ; "import", `List [ `String "js"; `String nm ]
+              ]
+            :: s)
+          primitives
+          (Yojson.Basic.Util.to_list (Yojson.Basic.from_string dependencies))))
 
 let filter_unused_primitives primitives usage_file =
   let ch = open_in usage_file in
diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml
index 9f51c9486e..f2e6b7eccd 100644
--- a/compiler/lib-wasm/gc_target.ml
+++ b/compiler/lib-wasm/gc_target.ml
@@ -909,18 +909,18 @@ module Constant = struct
   let str_js_utf8 s =
     let b = Buffer.create (String.length s) in
     String.iter s ~f:(function
-        | '\\' -> Buffer.add_string b "\\\\"
-        | c -> Buffer.add_char b c);
+      | '\\' -> Buffer.add_string b "\\\\"
+      | c -> Buffer.add_char b c);
     Buffer.contents b
 
   let str_js_byte s =
     let b = Buffer.create (String.length s) in
     String.iter s ~f:(function
-        | '\\' -> Buffer.add_string b "\\\\"
-        | '\128' .. '\255' as c ->
-            Buffer.add_string b "\\x";
-            Buffer.add_char_hex b c
-        | c -> Buffer.add_char b c);
+      | '\\' -> Buffer.add_string b "\\\\"
+      | '\128' .. '\255' as c ->
+          Buffer.add_string b "\\x";
+          Buffer.add_char_hex b c
+      | c -> Buffer.add_char b c);
     Buffer.contents b
 
   type t =
@@ -952,12 +952,13 @@ module Constant = struct
             l
         in
         let c = W.ArrayNewFixed (ty, RefI31 (Const (I32 (Int32.of_int tag))) :: l') in
-        if List.exists
-             ~f:(fun (const, _) ->
-               match const with
-               | Const | Const_named _ -> false
-               | Mutated -> true)
-             l
+        if
+          List.exists
+            ~f:(fun (const, _) ->
+              match const with
+              | Const | Const_named _ -> false
+              | Mutated -> true)
+            l
         then
           let* c = store_in_global c in
           let* () =
diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml
index 63fd81e2d2..d5e590dff2 100644
--- a/compiler/lib-wasm/generate.ml
+++ b/compiler/lib-wasm/generate.ml
@@ -890,12 +890,13 @@ module Generate (Target : Target_sig.S) = struct
             in
             (* Do not insert a block if the inner code contains a
                structured control flow instruction ([if] or [try] *)
-            if (not (List.is_empty rem))
-               ||
-               let block = Addr.Map.find pc ctx.blocks in
-               match block.branch with
-               | Cond _ | Pushtrap _ -> false (*ZZZ also some Switch*)
-               | _ -> true
+            if
+              (not (List.is_empty rem))
+              ||
+              let block = Addr.Map.find pc ctx.blocks in
+              match block.branch with
+              | Cond _ | Pushtrap _ -> false (*ZZZ also some Switch*)
+              | _ -> true
             then
               block { params = []; result = [] } (code ~context:(`Block pc' :: context))
             else code ~context
@@ -967,8 +968,8 @@ module Generate (Target : Target_sig.S) = struct
       match fall_through with
       | `Block dst' when dst = dst' -> return ()
       | _ ->
-          if (src >= 0 && Structure.is_backward g src dst)
-             || Structure.is_merge_node g dst
+          if
+            (src >= 0 && Structure.is_backward g src dst) || Structure.is_merge_node g dst
           then instr (Br (label_index context dst, None))
           else translate_tree result_typ fall_through dst context
     in
diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml
index 9b7e04a081..d043d0833e 100644
--- a/compiler/lib-wasm/link.ml
+++ b/compiler/lib-wasm/link.ml
@@ -739,14 +739,15 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
           | `Cmo -> true
           | `Cma | `Exe | `Runtime | `Unknown -> false
         in
-        if (not (Config.Flag.auto_link ()))
-           || cmo_file
-           || linkall
-           || List.exists ~f:(fun { unit_info; _ } -> unit_info.force_link) units
-           || List.exists
-                ~f:(fun { unit_info; _ } ->
-                  not (StringSet.is_empty (StringSet.inter requires unit_info.provides)))
-                units
+        if
+          (not (Config.Flag.auto_link ()))
+          || cmo_file
+          || linkall
+          || List.exists ~f:(fun { unit_info; _ } -> unit_info.force_link) units
+          || List.exists
+               ~f:(fun { unit_info; _ } ->
+                 not (StringSet.is_empty (StringSet.inter requires unit_info.provides)))
+               units
         then
           ( List.fold_right units ~init:requires ~f:(fun { unit_info; _ } requires ->
                 StringSet.diff
@@ -769,11 +770,12 @@ let link ~output_file ~linkall ~enable_source_maps ~files =
           units
           ~init:acc
           ~f:(fun { unit_name; unit_info; _ } (requires, to_link) ->
-            if (not (Config.Flag.auto_link ()))
-               || cmo_file
-               || linkall
-               || unit_info.force_link
-               || not (StringSet.is_empty (StringSet.inter requires unit_info.provides))
+            if
+              (not (Config.Flag.auto_link ()))
+              || cmo_file
+              || linkall
+              || unit_info.force_link
+              || not (StringSet.is_empty (StringSet.inter requires unit_info.provides))
             then
               ( StringSet.diff
                   (StringSet.union unit_info.requires requires)
diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml
index 03a9ac3f64..c3a84b2e05 100644
--- a/compiler/lib-wasm/wasm_link.ml
+++ b/compiler/lib-wasm/wasm_link.ml
@@ -365,8 +365,9 @@ module Read = struct
   let header = "\000asm\001\000\000\000"
 
   let check_header file contents =
-    if String.length contents < 8
-       || not (String.equal header (String.sub contents ~pos:0 ~len:8))
+    if
+      String.length contents < 8
+      || not (String.equal header (String.sub contents ~pos:0 ~len:8))
     then failwith (file ^ " is not a Wasm binary file (bad magic)")
 
   type ch =
diff --git a/compiler/lib-wasm/wasm_output.ml b/compiler/lib-wasm/wasm_output.ml
index 02fa6d6ad2..febd2c650e 100644
--- a/compiler/lib-wasm/wasm_output.ml
+++ b/compiler/lib-wasm/wasm_output.ml
@@ -914,7 +914,7 @@ end = struct
         set
         |> expr_function_references e
         |> (fun init ->
-             List.fold_left ~f:(fun set i -> instr_function_references i set) ~init l1)
+        List.fold_left ~f:(fun set i -> instr_function_references i set) ~init l1)
         |> fun init ->
         List.fold_left ~f:(fun set i -> instr_function_references i set) ~init l2
     | Br (_, None) | Return None | Nop | Rethrow _ -> set
diff --git a/compiler/lib-wasm/wat_output.ml b/compiler/lib-wasm/wat_output.ml
index 7f15a6b82e..27c2307801 100644
--- a/compiler/lib-wasm/wat_output.ml
+++ b/compiler/lib-wasm/wat_output.ml
@@ -119,22 +119,23 @@ let rec format_sexp f s =
   | List l ->
       let has_comment =
         List.exists l ~f:(function
-            | Comment _ -> true
-            | _ -> false)
+          | Comment _ -> true
+          | _ -> false)
       in
       if has_comment
       then (* Ensure comments are on their own line *)
         Format.fprintf f "@[<v 2>("
       else Format.fprintf f "@[<2>(";
       Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f "@ ") format_sexp f l;
-      if has_comment
-         && List.fold_left
-              ~f:(fun _ i ->
-                match i with
-                | Comment _ -> true
-                | _ -> false)
-              ~init:false
-              l
+      if
+        has_comment
+        && List.fold_left
+             ~f:(fun _ i ->
+               match i with
+               | Comment _ -> true
+               | _ -> false)
+             ~init:false
+             l
       then
         (* Make sure there is a newline when a comment is at the very end. *)
         Format.fprintf f "@ ";
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index a580453ce1..086fe2155d 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -237,8 +237,8 @@ let expr_escape st _x e =
                     Array.iter a ~f:(fun x -> block_escape st x)
                 | Expr
                     (Prim
-                      ( Extern ("caml_make_array" | "caml_array_of_uniform_array")
-                      , [ Pv y ] )) -> (
+                       ( Extern ("caml_make_array" | "caml_array_of_uniform_array")
+                       , [ Pv y ] )) -> (
                     match st.defs.(Var.idx y) with
                     | Expr (Block (_, a, _, _)) ->
                         Array.iter a ~f:(fun x -> block_escape st x)
diff --git a/lib/tests/test_fun_call_2.ml b/lib/tests/test_fun_call_2.ml
index 1a8dd0071e..00a48af3b9 100644
--- a/lib/tests/test_fun_call_2.ml
+++ b/lib/tests/test_fun_call_2.ml
@@ -83,8 +83,8 @@ let%expect_test "partial application, callback is called when all arguments are
     got 1, 2, 3, 4, 5, done
     Result: 0 |}]
 
-let%expect_test "partial application, 0 argument call is treated like 1 argument \
-                 (undefined)" =
+let%expect_test
+    "partial application, 0 argument call is treated like 1 argument (undefined)" =
   call_and_log (Js.wrap_callback cb5) {| (function(f){ return f(1)()(3)()(5) }) |};
   [%expect {|
     got 1, undefined, 3, undefined, 5, done

From edb11fa3dfbc33ce641ab8adf81c7f915f2b79a0 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Wed, 4 Dec 2024 11:35:07 +0100
Subject: [PATCH 474/481] Github action to setup binaryen

---
 .github/workflows/build-wasm_of_ocaml.yml | 48 ++--------------
 .github/workflows/build.yml               | 69 ++---------------------
 2 files changed, 11 insertions(+), 106 deletions(-)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 840b35bb73..9a5331b86b 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -45,48 +45,6 @@ jobs:
         with:
           node-version: 23
 
-      - name: Restore cached binaryen
-        id: cache-binaryen
-        uses: actions/cache/restore@v4
-        with:
-          path: binaryen
-          key: ${{ runner.os }}-binaryen-version_118
-
-      - name: Checkout binaryen
-        if: steps.cache-binaryen.outputs.cache-hit != 'true'
-        uses: actions/checkout@v4
-        with:
-          repository: WebAssembly/binaryen
-          path: binaryen
-          submodules: true
-          ref: version_118
-
-      - name: Install ninja (Ubuntu)
-        if: matrix.os == 'ubuntu-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
-        run: sudo apt-get install ninja-build
-
-      - name: Install ninja (MacOS)
-        if: matrix.os == 'macos-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
-        run: brew install ninja
-
-      - name: Build binaryen
-        if: steps.cache-binaryen.outputs.cache-hit != 'true'
-        working-directory: ./binaryen
-        run: |
-          cmake -G Ninja .
-          ninja
-
-      - name: Cache binaryen
-        if: steps.cache-binaryen.outputs.cache-hit != 'true'
-        uses: actions/cache/save@v4
-        with:
-          path: binaryen
-          key: ${{ runner.os }}-binaryen-version_118
-
-      - name: Set binaryen's path
-        run: |
-          echo "$GITHUB_WORKSPACE/binaryen/bin" >> $GITHUB_PATH
-
       - name: Install OCaml ${{ matrix.ocaml-compiler }}
         uses: ocaml/setup-ocaml@v3
         with:
@@ -97,6 +55,12 @@ jobs:
         with:
           path: wasm_of_ocaml
 
+      - name: Set-up Binaryen
+        uses: Aandreba/setup-binaryen@v1.0.0
+        with:
+         version: 118
+         token: ${{ secrets.GITHUB_TOKEN }}
+
       - name: Pin faked binaryen-bin package
         # It's faster to use a cached version
         run: opam install --fake binaryen-bin
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index d5709e6f63..32cf3f341a 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -115,65 +115,11 @@ jobs:
       - run: opam install conf-pkg-config
         if: runner.os == 'Windows'
 
-      - name: Restore cached binaryen
-        id: cache-binaryen
-        uses: actions/cache/restore@v4
+      - name: Set-up Binaryen
+        uses: Aandreba/setup-binaryen@v1.0.0
         with:
-          path: binaryen
-          key: ${{ runner.os }}-binaryen-version_118
-
-      - name: Checkout binaryen
-        if: steps.cache-binaryen.outputs.cache-hit != 'true'
-        uses: actions/checkout@v4
-        with:
-          repository: WebAssembly/binaryen
-          path: binaryen
-          submodules: true
-          ref: version_118
-
-      - name: Install ninja (Ubuntu)
-        if: matrix.os == 'ubuntu-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
-        run: sudo apt-get install ninja-build
-
-      - name: Install ninja (MacOS)
-        if: matrix.os == 'macos-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
-        run: brew install ninja
-
-      - name: Build binaryen
-        if: matrix.os != 'windows-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
-        working-directory: ./binaryen
-        run: |
-          cmake -G Ninja .
-          ninja
-
-      - name: Install binaryen build dependencies (Windows)
-        if: matrix.os == 'windows-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
-        working-directory: ./binaryen
-        run: opam install conf-cmake conf-c++
-
-      - name: Build binaryen (Windows)
-        if: matrix.os == 'windows-latest' && steps.cache-binaryen.outputs.cache-hit != 'true'
-        working-directory: ./binaryen
-        run: |
-          opam exec -- cmake . -DBUILD_STATIC_LIB=ON -DBUILD_TESTS=off -DINSTALL_LIBS=off -DCMAKE_C_COMPILER=x86_64-w64-mingw32-gcc
-          make -j 4
-
-      - name: Cache binaryen
-        if: steps.cache-binaryen.outputs.cache-hit != 'true'
-        uses: actions/cache/save@v4
-        with:
-          path: binaryen
-          key: ${{ runner.os }}-binaryen-version_118
-
-      - name: Set binaryen's path
-        shell: bash
-        run: echo "$GITHUB_WORKSPACE/binaryen/bin" >> $GITHUB_PATH
-
-      - name: Copy binaryen's tools (Windows)
-        if: matrix.os == 'windows-latest'
-        shell: bash
-        # Somehow, setting the path above does not work
-        run: cp $GITHUB_WORKSPACE/binaryen/bin/wasm-{merge,opt}.exe _opam/bin
+         version: 118
+         token: ${{ secrets.GITHUB_TOKEN }}
 
       - name: Install faked binaryen-bin package
         # It's faster to use a cached version
@@ -182,15 +128,10 @@ jobs:
       - run: opam install . --best-effort
         if: ${{ matrix.skip-test }}
 
-      - run: cat VERSION | xargs opam pin . -n --with-version 
+      - run: cat VERSION | xargs opam pin . -n --with-version
         if: ${{ !matrix.skip-test }}
         shell: bash
 
-      - run: opam install conf-c++
-        # Otherwise, the next step fails reinstalling gcc while compiling
-        # other packages
-        if: ${{ !matrix.skip-test && runner.os == 'Windows' }}
-
       - run: opam install . --with-test --deps-only
         # Install the test dependencies
         if: ${{ !matrix.skip-test }}

From 1e2c57d73c532b20e32df647f8959bb439587397 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 4 Dec 2024 14:24:31 +0100
Subject: [PATCH 475/481] Flow.the_native_string_of: add comment

---
 compiler/lib/flow.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 086fe2155d..0a3f8ea295 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -415,7 +415,11 @@ let the_string_of ~target info x =
 let the_native_string_of ~target info x =
   match the_const_of ~target info x with
   | Some (NativeString i) -> Some i
-  | Some (String i) -> Some (Native_string.of_bytestring i)
+  | Some (String i) ->
+      (* This function is used to optimize the primitives that access
+         object properties. These primitives are expected to work with
+         OCaml string as well, considered as byte strings. *)
+      Some (Native_string.of_bytestring i)
   | _ -> None
 
 let the_block_contents_of info x =

From 913dc6eb21b1793d19ae9712319635dbeeda83bc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 4 Dec 2024 15:00:27 +0100
Subject: [PATCH 476/481] Runtime: implement Sys.is_directory

---
 runtime/wasm/fs.wat     | 19 +++++++++++++------
 runtime/wasm/runtime.js |  1 +
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index cb0c50bde5..f81edab25e 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -25,6 +25,8 @@
       (func $readdir (param anyref) (result (ref extern))))
    (import "bindings" "file_exists"
       (func $file_exists (param anyref) (result (ref eq))))
+   (import "bindings" "is_directory"
+      (func $is_directory (param anyref) (result (ref eq))))
    (import "bindings" "rename" (func $rename (param anyref) (param anyref)))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
@@ -141,10 +143,15 @@
 
    (data $caml_sys_is_directory "caml_sys_is_directory")
 
-   (func (export "caml_sys_is_directory") (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $caml_sys_is_directory
-            (i32.const 0) (i32.const 21)))
-      (ref.i31 (i32.const 0)))
+   (func (export "caml_sys_is_directory")
+      (param $name (ref eq)) (result (ref eq))
+      (try
+         (do
+            (return
+               (call $is_directory
+                  (call $unwrap
+                     (call $caml_jsstring_of_string (local.get $name))))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))
+            (return (ref.i31 (i32.const 0))))))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index c40c649ba0..059f5b9c3a 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -437,6 +437,7 @@
     unlink: (p) => fs.unlinkSync(p),
     readdir: (p) => fs.readdirSync(p),
     file_exists: (p) => +fs.existsSync(p),
+    is_directory: (p) => +fs.lstatSync(p).isDirectory(),
     rename: (o, n) => fs.renameSync(o, n),
     throw: (e) => {
       throw e;

From 13f8c2fb83307b66b9907a911a2e4fba2dd95a2d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 4 Dec 2024 14:47:15 +0100
Subject: [PATCH 477/481] Remove unimplemented primitives

---
 runtime/wasm/dynlink.wat |  23 --
 runtime/wasm/fs.wat      |   4 -
 runtime/wasm/int64.wat   |   9 -
 runtime/wasm/io.wat      |  11 -
 runtime/wasm/nat.wat     | 541 +--------------------------------------
 runtime/wasm/runtime.js  |   2 +-
 6 files changed, 8 insertions(+), 582 deletions(-)

diff --git a/runtime/wasm/dynlink.wat b/runtime/wasm/dynlink.wat
index 45c68b3314..45e7d98f00 100644
--- a/runtime/wasm/dynlink.wat
+++ b/runtime/wasm/dynlink.wat
@@ -16,27 +16,4 @@
 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (module
-   (import "jslib" "log_str" (func $log_str (param (ref $string))))
-
-   (type $string (array (mut i8)))
-
-   (data $caml_dynlink_close_lib "caml_dynlink_close_lib")
-
-   (func (export "caml_dynlink_close_lib")
-      (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $caml_dynlink_close_lib
-            (i32.const 0) (i32.const 22)))
-      (ref.i31 (i32.const 0)))
-
-   (data $caml_dynlink_lookup_symbol "caml_dynlink_lookup_symbol")
-
-   (func (export "caml_dynlink_lookup_symbol")
-      (param (ref eq)) (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $caml_dynlink_lookup_symbol
-            (i32.const 0) (i32.const 26)))
-      (ref.i31 (i32.const 0)))
 )
diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat
index f81edab25e..f01d5612d0 100644
--- a/runtime/wasm/fs.wat
+++ b/runtime/wasm/fs.wat
@@ -131,10 +131,6 @@
 
    (func (export "caml_read_file_content")
       (param (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $caml_read_file_content
-            (i32.const 0) (i32.const 22)))
       (call $caml_raise_no_such_file (local.get 0))
       (ref.i31 (i32.const 0)))
 
diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat
index 6059623126..de7e64c52b 100644
--- a/runtime/wasm/int64.wat
+++ b/runtime/wasm/int64.wat
@@ -16,7 +16,6 @@
 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (module
-   (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "ints" "parse_sign_and_base"
       (func $parse_sign_and_base
          (param (ref $string)) (result i32 i32 i32 i32)))
@@ -212,14 +211,6 @@
 
    (data $caml_int64_create_lo_mi_hi "caml_int64_create_lo_mi_hi")
 
-   (func (export "caml_int64_create_lo_mi_hi")
-      (param (ref eq) (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ does not really make sense
-      (call $log_str
-         (array.new_data $string $caml_int64_create_lo_mi_hi
-            (i32.const 0) (i32.const 26)))
-      (ref.i31 (i32.const 0)))
-
    (func $format_int64_default (param $d i64) (result (ref eq))
       (local $s (ref $string))
       (local $negative i32) (local $i i32) (local $n i64)
diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat
index e5b523c8cf..76e02a2d39 100644
--- a/runtime/wasm/io.wat
+++ b/runtime/wasm/io.wat
@@ -16,7 +16,6 @@
 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (module
-   (import "jslib" "log_str" (func $log_str (param (ref $string))))
    (import "fail" "caml_raise_end_of_file" (func $caml_raise_end_of_file))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
@@ -828,16 +827,6 @@
                (then (call $caml_flush (local.get $ch))))))
       (ref.i31 (i32.const 0)))
 
-   (data $caml_ml_set_channel_refill "caml_ml_set_channel_refill")
-
-   (func (export "caml_ml_set_channel_refill")
-      (param (ref eq) (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $caml_ml_set_channel_refill
-            (i32.const 0) (i32.const 26)))
-      (ref.i31 (i32.const 0)))
-
    (func (export "caml_ml_channel_size") (param (ref eq)) (result (ref eq))
       ;; ZZZ check for overflow
       (ref.i31
diff --git a/runtime/wasm/nat.wat b/runtime/wasm/nat.wat
index 71719a9d62..e2aafb3b36 100644
--- a/runtime/wasm/nat.wat
+++ b/runtime/wasm/nat.wat
@@ -16,549 +16,22 @@
 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (module
-   (import "jslib" "log_str" (func $log_str (param (ref $string))))
-   (import "custom" "caml_register_custom_operations"
-      (func $caml_register_custom_operations
-         (param $ops (ref $custom_operations))))
-   (import "int32" "Nativeint_val"
-      (func $Nativeint_val (param (ref eq)) (result i32)))
-   (import "int32" "caml_copy_nativeint"
-      (func $caml_copy_nativeint (param i32) (result (ref eq))))
-
-   (type $string (array (mut i8)))
-   (type $data (array (mut i32)))
-   (type $compare
-      (func (param (ref eq)) (param (ref eq)) (param i32) (result i32)))
-   (type $hash
-      (func (param (ref eq)) (result i32)))
-   (type $fixed_length (struct (field $bsize_32 i32) (field $bsize_64 i32)))
-   (type $serialize
-      (func (param (ref eq)) (param (ref eq)) (result i32) (result i32)))
-   (type $deserialize (func (param (ref eq)) (result (ref eq)) (result i32)))
-   (type $dup (func (param (ref eq)) (result (ref eq))))
-   (type $custom_operations
-      (struct
-         (field $id (ref $string))
-         (field $compare (ref null $compare))
-         (field $compare_ext (ref null $compare))
-         (field $hash (ref null $hash))
-         (field $fixed_length (ref null $fixed_length))
-         (field $serialize (ref null $serialize))
-         (field $deserialize (ref null $deserialize))
-         (field $dup (ref null $dup))))
-   (type $custom (sub (struct (field (ref $custom_operations)))))
-
-   (global $nat_ops (ref $custom_operations)
-      (struct.new $custom_operations
-         (array.new_fixed $string 3
-            (i32.const 110) (i32.const 97) (i32.const 116)) ;; "_nat"
-         (ref.null $compare)
-         (ref.null $compare)
-         (ref.func $hash_nat)
-         (ref.null $fixed_length)
-         (ref.func $serialize_nat)
-         (ref.func $deserialize_nat)
-         (ref.null $dup)))
-
-   (type $nat
-      (sub final $custom
-         (struct
-            (field (ref $custom_operations))
-            (field $data (ref $data)))))
-
-   (func (export "initialize_nat")
-      (param (ref eq)) (result (ref eq))
-      (call $caml_register_custom_operations (global.get $nat_ops))
+   (func (export "initialize_nat") (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
 
-   (func (export "create_nat")
-      (param $sz (ref eq)) (result (ref eq))
-      (struct.new $nat
-         (global.get $nat_ops)
-         (array.new $data (i32.const 0)
-            (i31.get_u (ref.cast (ref i31) (local.get $sz))))))
-
-   (func (export "incr_nat")
-      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
-      (param $carry_in (ref eq)) (result (ref eq))
-      (local $data (ref $data))
-      (local $carry i32) (local $i i32) (local $ofs i32) (local $len i32)
-      (local $x i32)
-      (local.set $data
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat))))
-      (local.set $carry (i31.get_s (ref.cast (ref i31) (local.get $carry_in))))
-      (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
-      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (if (i32.eqz (local.get $carry))
-         (then (return (ref.i31 (i32.const 0)))))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (local.set $x
-                  (i32.add
-                     (array.get $data (local.get $data) (local.get $ofs))
-                     (i32.const 1)))
-               (array.set $data (local.get $data) (local.get $ofs)
-                  (local.get $x))
-               (if (local.get $x)
-                  (then
-                     (return (ref.i31 (i32.const 0)))))
-               (local.set $ofs (i32.add (local.get $ofs) (i32.const 1)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (ref.i31 (i32.const 1)))
-
-   (func (export "decr_nat")
-      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
-      (param $carry_in (ref eq)) (result (ref eq))
-      (local $data (ref $data))
-      (local $carry i32) (local $i i32) (local $ofs i32) (local $len i32)
-      (local $x i32)
-      (local.set $data
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat))))
-      (local.set $carry (i31.get_s (ref.cast (ref i31) (local.get $carry_in))))
-      (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
-      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (if (i32.eqz (local.get $carry))
-         (then (return (ref.i31 (i32.const 0)))))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len))
-            (then
-               (local.set $x
-                  (array.get $data (local.get $data) (local.get $ofs)))
-               (array.set $data (local.get $data) (local.get $ofs)
-                  (i32.sub (local.get $x) (i32.const 1)))
-               (if (local.get $x)
-                  (then
-                     (return (ref.i31 (i32.const 0)))))
-               (local.set $ofs (i32.add (local.get $ofs) (i32.const 1)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (br $loop))))
-      (ref.i31 (i32.const 1)))
-
-   (func (export "set_digit_nat")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (param $digit (ref eq))
-      (result (ref eq))
-      (array.set $data
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-         (i31.get_s (ref.cast (ref i31) (local.get $ofs)))
-         (i31.get_s (ref.cast (ref i31) (local.get $digit))))
-      (ref.i31 (i32.const 0)))
-
-   (func (export "set_digit_nat_native")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (param $digit (ref eq))
-      (result (ref eq))
-      (array.set $data
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-         (i31.get_s (ref.cast (ref i31) (local.get $ofs)))
-         (call $Nativeint_val (local.get $digit)))
+   (func (export "create_nat") (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
 
-   (func (export "nth_digit_nat")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
-      (ref.i31
-         (array.get $data
-            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-            (i31.get_s (ref.cast (ref i31) (local.get $ofs))))))
-
-   (func (export "nth_digit_nat_native")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
-      (call $caml_copy_nativeint
-         (array.get $data
-            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-            (i31.get_s (ref.cast (ref i31) (local.get $ofs))))))
-
-   (func (export "is_digit_zero")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
-      (ref.i31
-         (i32.eqz
-            (array.get $data
-               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
-
-   (func (export "num_leading_zero_bits_in_digit")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
-      (ref.i31
-         (i32.clz
-            (array.get $data
-               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
-
-   (func (export "is_digit_odd")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
-      (ref.i31
-         (i32.and (i32.const 1)
-            (array.get $data
-               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
-
-   (func (export "is_digit_int")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (result (ref eq))
-      (ref.i31
-         (i32.ge_u (i32.const 0x40000000)
-            (array.get $data
-               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-               (i31.get_s (ref.cast (ref i31) (local.get $ofs)))))))
-
    (func (export "set_to_zero_nat")
-      (param $nat (ref eq)) (param $ofs (ref eq)) (param $len (ref eq))
-      (result (ref eq))
-      (array.fill $data
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat)))
-         (i31.get_s (ref.cast (ref i31) (local.get $ofs)))
-         (i32.const 0)
-         (i31.get_s (ref.cast (ref i31) (local.get $len))))
-      (ref.i31 (i32.const 0)))
-
-   (func (export "blit_nat")
-      (param $nat1 (ref eq)) (param $ofs1 (ref eq))
-      (param $nat2 (ref eq)) (param $ofs2 (ref eq))
-      (param $len (ref eq)) (result (ref eq))
-      (array.copy $data $data
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1)))
-         (i31.get_s (ref.cast (ref i31) (local.get $ofs1)))
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2)))
-         (i31.get_s (ref.cast (ref i31) (local.get $ofs2)))
-         (i31.get_s (ref.cast (ref i31) (local.get $len))))
-      (ref.i31 (i32.const 0)))
-
-   (func (export "num_digits_nat")
-      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
-      (result (ref eq))
-      (local $ofs i32) (local $len i32) (local $data (ref $data))
-      (local.set $ofs (i31.get_s (ref.cast (ref i31) (local.get $vofs))))
-      (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen))))
-      (local.set $data
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat))))
-      (local.set $ofs
-         (i32.add (local.get $ofs) (i32.sub (local.get $len) (i32.const 1))))
-      (loop $loop
-         (if (i32.eqz (local.get $len)) (then (return (ref.i31 (i32.const 1)))))
-         (if (array.get $data (local.get $data) (local.get $ofs))
-            (then (return (ref.i31 (local.get $len)))))
-         (local.set $len (i32.sub (local.get $len) (i32.const 1)))
-         (local.set $ofs (i32.sub (local.get $ofs) (i32.const 1)))
-         (br $loop)))
-
-   (func (export "compare_digits_nat")
-      (param $nat1 (ref eq)) (param $ofs1 (ref eq))
-      (param $nat2 (ref eq)) (param $ofs2 (ref eq)) (result (ref eq))
-      (local $d1 i32) (local $d2 i32)
-      (local.set $d1
-         (array.get $data
-            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1)))
-            (i31.get_s (ref.cast (ref i31) (local.get $ofs1)))))
-      (local.set $d2
-         (array.get $data
-            (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2)))
-            (i31.get_s (ref.cast (ref i31) (local.get $ofs2)))))
-      (if (i32.gt_u (local.get $d1) (local.get $d2))
-         (then (return (ref.i31 (i32.const 1)))))
-      (if (i32.lt_u (local.get $d1) (local.get $d2))
-         (then (return (ref.i31 (i32.const -1)))))
-      (ref.i31 (i32.const 0)))
-
-   (func (export "compare_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (result (ref eq))
-      (local $ofs1 i32) (local $len1 i32) (local $data1 (ref $data))
-      (local $ofs2 i32) (local $len2 i32) (local $data2 (ref $data))
-      (local $d1 i32) (local $d2 i32)
-      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
-      (local.set $len1 (i31.get_s (ref.cast (ref i31) (local.get $vlen1))))
-      (local.set $data1
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
-      (local.set $ofs1
-         (i32.add (local.get $ofs1) (i32.sub (local.get $len1) (i32.const 1))))
-      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
-      (local.set $len2 (i31.get_s (ref.cast (ref i31) (local.get $vlen2))))
-      (local.set $data2
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
-      (local.set $ofs2
-         (i32.add (local.get $ofs2) (i32.sub (local.get $len2) (i32.const 1))))
-      (loop $loop
-         (if (local.get $len1)
-            (then
-               (if (i32.eqz
-                      (array.get $data (local.get $data1) (local.get $ofs1)))
-                  (then
-                     (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
-                     (local.set $ofs1 (i32.sub (local.get $ofs1) (i32.const 1)))
-                     (br $loop))))))
-      (loop $loop
-         (if (local.get $len2)
-            (then
-               (if (i32.eqz
-                      (array.get $data (local.get $data2) (local.get $ofs2)))
-                  (then
-                     (local.set $len2 (i32.sub (local.get $len2) (i32.const 1)))
-                     (local.set $ofs2 (i32.sub (local.get $ofs2) (i32.const 1)))
-                     (br $loop))))))
-      (if (i32.gt_u (local.get $len1) (local.get $len2))
-         (then (return (ref.i31 (i32.const 1)))))
-      (if (i32.lt_u (local.get $len2) (local.get $len1))
-         (then (return (ref.i31 (i32.const -1)))))
-      (loop $loop
-         (if (local.get $len1)
-            (then
-               (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
-               (local.set $d1
-                  (array.get $data (local.get $data1) (local.get $ofs1)))
-               (local.set $d2
-                  (array.get $data (local.get $data2) (local.get $ofs2)))
-               (if (i32.gt_u (local.get $d1) (local.get $d2))
-                  (then (return (ref.i31 (i32.const 1)))))
-               (if (i32.lt_u (local.get $d1) (local.get $d2))
-                  (then (return (ref.i31 (i32.const -1)))))
-               (local.set $ofs1 (i32.sub (local.get $ofs1) (i32.const 1)))
-               (local.set $ofs2 (i32.sub (local.get $ofs2) (i32.const 1)))
-               (br $loop))))
-      (ref.i31 (i32.const 0)))
-
-   (func (export "mult_digit_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (param $nat3 (ref eq)) (param $vofs3 (ref eq)) (result (ref eq))
-      (local $ofs1 i32) (local $len1 i32) (local $data1 (ref $data))
-      (local $ofs2 i32) (local $len2 i32) (local $data2 (ref $data))
-      (local $i i32) (local $d i64) (local $x i64) (local $carry i64)
-      (local $y i32)
-      (local.set $d
-         (i64.extend_i32_u
-            (array.get $data
-               (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat3)))
-               (i31.get_s (ref.cast (ref i31) (local.get $vofs3))))))
-      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
-      (local.set $len1 (i31.get_s (ref.cast (ref i31) (local.get $vlen1))))
-      (local.set $data1
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
-      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
-      (local.set $len2 (i31.get_s (ref.cast (ref i31) (local.get $vlen2))))
-      (local.set $data2
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
-      (local.set $len1 (i32.sub (local.get $len1) (local.get $len2)))
-      (loop $loop
-         (if (i32.lt_s (local.get $i) (local.get $len2))
-            (then
-               (local.set $x
-                  (i64.add
-                     (i64.add (local.get $carry)
-                        (i64.extend_i32_u
-                           (array.get $data (local.get $data1)
-                              (local.get $ofs1))))
-                     (i64.mul (local.get $d)
-                        (i64.extend_i32_u
-                           (array.get $data (local.get $data2)
-                              (local.get $ofs2))))))
-               (array.set $data (local.get $data1) (local.get $ofs1)
-                  (i32.wrap_i64 (local.get $x)))
-               (local.set $carry (i64.shr_u (local.get $x) (i64.const 32)))
-               (local.set $i (i32.add (local.get $i) (i32.const 1)))
-               (local.set $ofs1 (i32.add (local.get $ofs1) (i32.const 1)))
-               (local.set $ofs2 (i32.add (local.get $ofs2) (i32.const 1)))
-               (br $loop))))
-      (if (i32.eqz (local.get $len1))
-         (then (return (ref.i31 (i32.wrap_i64 (local.get $carry))))))
-      (local.set $x
-         (i64.add (local.get $carry)
-            (i64.extend_i32_u
-               (array.get $data (local.get $data1) (local.get $ofs1)))))
-      (array.set $data (local.get $data1) (local.get $ofs1)
-         (i32.wrap_i64 (local.get $x)))
-      (local.set $carry (i64.shr_u (local.get $x) (i64.const 32)))
-      (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
-      (if (i64.eqz (local.get $carry)) (then (return (ref.i31 (i32.const 0)))))
-      (if (i32.eqz (local.get $len1))
-         (then (return (ref.i31 (i32.wrap_i64 (local.get $carry))))))
-      (local.set $ofs1 (i32.add (local.get $ofs1) (i32.const 1)))
-      (loop $loop
-         (local.set $y
-            (i32.add
-               (array.get $data (local.get $data1) (local.get $ofs1))
-                  (i32.const 1)))
-         (array.set $data (local.get $data1) (local.get $ofs1) (local.get $y))
-         (if (local.get $y) (then (return (ref.i31 (i32.const 0)))))
-         (local.set $len1 (i32.sub (local.get $len1) (i32.const 1)))
-         (local.set $ofs1 (i32.add (local.get $ofs1) (i32.const 1)))
-         (if (local.get $len1) (then (br $loop))))
-      (ref.i31 (i32.const 1)))
-
-   (data $mult_nat "mult_nat")
-
-   (func (export "mult_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (param $nat3 (ref eq)) (param $vofs3 (ref eq)) (param $vlen3 (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $mult_nat (i32.const 0) (i32.const 8)))
-      (unreachable))
-
-   (data $square_nat "square_nat")
-
-   (func (export "square_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $square_nat (i32.const 0) (i32.const 10)))
-      (unreachable))
-
-   (data $shift_left_nat "shift_left_nat")
-
-   (func (export "shift_left_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vnbits (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $shift_left_nat (i32.const 0) (i32.const 14)))
-      (unreachable))
-
-   (data $shift_right_nat "shift_right_nat")
-
-   (func (export "shift_right_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vnbits (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $shift_right_nat (i32.const 0) (i32.const 15)))
-      (unreachable))
-
-   (data $div_digit_nat "div_digit_nat")
-
-   (func (export "div_digit_nat")
-      (param $natq (ref eq)) (param $ofsq (ref eq))
-      (param $natr (ref eq)) (param $ofsr (ref eq))
-      (param $nat1 (ref eq)) (param $ofs1 (ref eq)) (param $len (ref eq))
-      (param $nat2 (ref eq)) (param $ofs2 (ref eq)) (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $div_digit_nat (i32.const 0) (i32.const 13)))
-      (unreachable))
-
-   (data $div_nat "div_nat")
-
-   (func (export "div_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $div_nat (i32.const 0) (i32.const 7)))
-      (unreachable))
-
-   (data $add_nat "add_nat")
-
-   (func (export "add_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (param $carry_in (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $add_nat (i32.const 0) (i32.const 7)))
-      (unreachable))
-
-   (data $sub_nat "sub_nat")
-
-   (func (export "sub_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq)) (param $vlen1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq)) (param $vlen2 (ref eq))
-      (param $carry_in (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $sub_nat (i32.const 0) (i32.const 7)))
-      (unreachable))
-
-   (data $complement_nat "complement_nat")
-
-   (func (export "complement_nat")
-      (param $nat (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq))
-      (result (ref eq))
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $complement_nat (i32.const 0) (i32.const 14)))
-      (unreachable))
-
-   (func (export "land_digit_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq))
-      (result (ref eq))
-      (local $ofs1 i32) (local $data1 (ref $data))
-      (local $ofs2 i32) (local $data2 (ref $data))
-      (local.set $data1
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
-      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
-      (local.set $data2
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
-      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
-      (array.set $data (local.get $data1) (local.get $ofs1)
-         (i32.and (array.get $data (local.get $data1) (local.get $ofs1))
-            (array.get $data (local.get $data2) (local.get $ofs2))))
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
 
-   (func (export "lxor_digit_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq))
-      (result (ref eq))
-      (local $ofs1 i32) (local $data1 (ref $data))
-      (local $ofs2 i32) (local $data2 (ref $data))
-      (local.set $data1
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
-      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
-      (local.set $data2
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
-      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
-      (array.set $data (local.get $data1) (local.get $ofs1)
-         (i32.xor (array.get $data (local.get $data1) (local.get $ofs1))
-            (array.get $data (local.get $data2) (local.get $ofs2))))
+   (func (export "set_digit_nat")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
 
-   (func (export "lor_digit_nat")
-      (param $nat1 (ref eq)) (param $vofs1 (ref eq))
-      (param $nat2 (ref eq)) (param $vofs2 (ref eq))
+   (func (export "incr_nat")
+      (param (ref eq)) (param (ref eq)) (param (ref eq)) (param (ref eq))
       (result (ref eq))
-      (local $ofs1 i32) (local $data1 (ref $data))
-      (local $ofs2 i32) (local $data2 (ref $data))
-      (local.set $data1
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat1))))
-      (local.set $ofs1 (i31.get_s (ref.cast (ref i31) (local.get $vofs1))))
-      (local.set $data2
-         (struct.get $nat $data (ref.cast (ref $nat) (local.get $nat2))))
-      (local.set $ofs2 (i31.get_s (ref.cast (ref i31) (local.get $vofs2))))
-      (array.set $data (local.get $data1) (local.get $ofs1)
-         (i32.or (array.get $data (local.get $data1) (local.get $ofs1))
-            (array.get $data (local.get $data2) (local.get $ofs2))))
       (ref.i31 (i32.const 0)))
-
-   (data $hash_nat "hash_nat")
-
-   (func $hash_nat (param (ref eq)) (result i32)
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $hash_nat (i32.const 0) (i32.const 8)))
-      (unreachable))
-
-   (data $serialize_nat "serialize_nat")
-
-   (func $serialize_nat
-      (param (ref eq)) (param (ref eq)) (result i32) (result i32)
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $serialize_nat (i32.const 0) (i32.const 13)))
-      (unreachable))
-
-   (data $deserialize_nat "deserialize_nat")
-
-   (func $deserialize_nat (param (ref eq)) (result (ref eq)) (result i32)
-      ;; ZZZ
-      (call $log_str
-         (array.new_data $string $serialize_nat (i32.const 0) (i32.const 15)))
-      (unreachable))
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
index 059f5b9c3a..03a88e629f 100644
--- a/runtime/wasm/runtime.js
+++ b/runtime/wasm/runtime.js
@@ -458,7 +458,7 @@
     },
     map_set: (m, x, v) => m.set(x, v),
     map_delete: (m, x) => m.delete(x),
-    log: (x) => console.log("ZZZZZ", x),
+    log: (x) => console.log(x),
   };
   const string_ops = {
     test: (v) => +(typeof v === "string"),

From 18ced4b0752ee318311ef372096917e5b2c3e2b9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 16:39:49 +0100
Subject: [PATCH 478/481] Revert "Github action: automatically merge with
 js_of_ocaml"

This reverts commit f428e0ef6a388ef894fe7c79d30f0ed2e1a4e1ee.
---
 .github/workflows/merge.yml | 39 -------------------------------------
 1 file changed, 39 deletions(-)
 delete mode 100644 .github/workflows/merge.yml

diff --git a/.github/workflows/merge.yml b/.github/workflows/merge.yml
deleted file mode 100644
index 480f72088d..0000000000
--- a/.github/workflows/merge.yml
+++ /dev/null
@@ -1,39 +0,0 @@
-name: Automatic Merge with Js_of_ocaml
-
-on:
-  schedule:
-    - cron: '0 0 * * *'  # Executes daily at midnight UTC
-  workflow_dispatch:  # Allows manual triggering of the workflow
-
-permissions:
-  contents: write
-
-jobs:
-  merge:
-    runs-on: ubuntu-latest
-
-    steps:
-      - name: Checkout this repository
-        uses: actions/checkout@v4
-        with:
-          ref: main
-          fetch-depth: 1000
-
-      - name: Set Git committer identity
-        run: |
-          git config user.name github-actions
-          git config user.email github-actions@github.com
-
-      - name: Fetch js_of_ocaml master
-        run: git fetch https://github.com/ocsigen/js_of_ocaml.git master
-
-      - name: Merge js_of_ocaml master into current repository
-        run: git merge FETCH_HEAD
-
-      - name: Push merged changes to 'jsoo-merged' branch
-        run: |
-          if git show-ref --verify --quiet refs/heads/jsoo-merged; then
-            git branch -D jsoo-merged
-          fi
-          git checkout -b jsoo-merged
-          git push --force origin jsoo-merged

From 400e0d50fea42e89bd9bdbb3a0c20505f835bdbf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 17:11:37 +0100
Subject: [PATCH 479/481] Move READMEs

---
 README.md               | 178 ++++++++++++++++++++++++++++------------
 README_jsoo.md          | 154 ----------------------------------
 README_wasm_of_ocaml.md |  68 +++++++++++++++
 3 files changed, 195 insertions(+), 205 deletions(-)
 delete mode 100644 README_jsoo.md
 create mode 100644 README_wasm_of_ocaml.md

diff --git a/README.md b/README.md
index ee5c69df18..9e49456f71 100644
--- a/README.md
+++ b/README.md
@@ -1,68 +1,144 @@
-# Wasm_of_ocaml
-
-Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssembly.
-
-## Supported engines
-
-The generated code works with Chrome 11.9, Node.js 22 and Firefox 122 (or more recent versions of these applications).
-
-In particular, the output code requires the following [Wasm extensions](https://webassembly.org/roadmap/) to run:
-- [the GC extension](https://github.com/WebAssembly/gc), including functional references and 31-bit integers
-- [the tail-call extension](https://github.com/WebAssembly/tail-call/blob/main/proposals/tail-call/Overview.md)
-- [the exception handling extension](https://github.com/WebAssembly/exception-handling/blob/master/proposals/exception-handling/Exceptions.md)
-
-OCaml 5.x code using effect handlers can be compiled in two different ways:
-One can enable the CPS transformation from `js_of_ocaml` by passing the
-`--enable=effects` flag. Without the flag `wasm_of_ocaml` will instead emit code
-utilizing
-- [the JavaScript-Promise Integration extension](https://github.com/WebAssembly/js-promise-integration/blob/main/proposals/js-promise-integration/Overview.md)
-
+# Js_of_ocaml (jsoo)
+
+[![Build Status](https://github.com/ocsigen/js_of_ocaml/workflows/build/badge.svg?branch=master)](https://github.com/ocsigen/js_of_ocaml/actions)
+[![Update Web site - build](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml)
+[![Update Web site - deploy](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment)
+
+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.
+
+- It is easy to install and use as it works with an existing installation of
+  OCaml, with no need to recompile any library.
+- It comes with bindings for a large part of the browser APIs.
+- According to our benchmarks, the generated programs runs typically faster than
+  with the OCaml bytecode interpreter.
+- We believe this compiler will prove much easier to maintain than a retargeted
+  OCaml compiler, as the bytecode provides a very stable API.
+
+Js_of_ocaml is composed of multiple packages:
+- js_of_ocaml-compiler, the compiler.
+- js_of_ocaml-ppx, a ppx syntax extension.
+- js_of_ocaml, the base library.
+- js_of_ocaml-ppx_deriving_json
+- js_of_ocaml-lwt, lwt support.
+- js_of_ocaml-tyxml, tyxml support.
+- js_of_ocaml-toplevel, lib and tools to build an ocaml toplevel to
+  javascript.
+
+## Requirements
+
+See
+[opam](https://github.com/ocsigen/js_of_ocaml/blob/master/js_of_ocaml-compiler.opam)
+file for version constraints.
+
+### Toplevel requirements
+
+- tyxml, reactiveData
+- ocp-indent: needed to support indentation in the toplevel
+- higlo: needed to support Syntax highlighting in the toplevel
+- cohttp: needed to build the toplevel webserver
 
 ## Installation
 
-The following commands will perform a minimal installation:
-```
-git clone https://github.com/ocaml-wasm/wasm_of_ocaml
-cd wasm_of_ocaml
-opam pin add -n --with-version 6.0.0 .
-opam install dune.3.17.0 wasm_of_ocaml-compiler
-```
-You may want to install additional packages. For instance:
+### Opam
 
 ```
-opam install js_of_ocaml-ppx js_of_ocaml-lwt
+opam install js_of_ocaml js_of_ocaml-compiler js_of_ocaml-ppx
 ```
 
 ## Usage
 
-You can try compiling the program in `examples/cubes`. Your program must first be compiled using the OCaml bytecode compiler `ocamlc`. JavaScript bindings are provided by the `js_of_ocaml` package. The syntax extension is provided by `js_of_ocaml-ppx` package. Package `js_of_ocaml-lwt` provides Javascript specific Lwt functions.
-
-```
-ocamlfind ocamlc -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt -linkpkg -o cubes.byte cubes.mli cubes.ml
-```
-
-Then, run the `wasm_of_ocaml` compiler to produce WebAssembly code:
+Your program must first be compiled using the OCaml bytecode compiler `ocamlc`.
+JavaScript bindings are provided by the `js_of_ocaml` package. The syntax
+extension is provided by `js_of_ocaml-ppx` package.
 
 ```
-wasm_of_ocaml cubes.byte
+ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o cubes.byte cubes.ml
 ```
 
-This outputs a file `cubes.js` which loads the WebAssembly code from file `cube.wasm`. For debugging, we currently also output the generated WebAssembly code in text file to `cube.wat`. Since Chrome does not allow loading from the filesystem, you need to serve the files using some Web server. For instance:
-```
-python3 -m http.server 8000 --directory .
-```
+Then, run the `js_of_ocaml` compiler to produce JavaScript code:
 
-As a larger example, you can try [CAMLBOY](https://github.com/linoscope/CAMLBOY). You need to install a forked version of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm). Once the Js_of_ocaml UI is compiled (with `dune build --profile release`), you can generate WebAssembly code instead with the following command:
 ```
-wasm_of_ocaml _build/default/bin/web/index.bc-for-jsoo
+js_of_ocaml cubes.byte
 ```
 
-## Implementation status
-
-A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions and dynamic linking are not supported yet.
-
-## Compatibility with Js_of_ocaml
-
-Since the value representation is different, some adaptations are necessary.
-
-The most notable change is that, except for integers, OCaml numbers are no longer mapped to JavaScript numbers. So, explicit conversions `Js.to_float` and `Js.float` are now necessary to convert between OCaml floats and JavaScript numbers. The typing of JavaScript Typed Arrays has also been changed to deal with this.
+## Features
+
+Most of the OCaml standard library is supported. However,
+
+- Most of the Sys module is not supported.
+
+Extra libraries distributed with OCaml (such as Thread) are not supported in
+general. However,
+
+- Bigarray: bigarrays are supported using Typed Arrays
+- Num: supported
+- Str: supported
+- Graphics: partially supported using canvas (see js_of_ocaml-lwt.graphics)
+- Unix: time related functions are supported
+
+Tail call is not optimized in general. However, mutually recursive functions are
+optimized:
+
+- self recursive functions (when the tail calls are the function itself) are
+  compiled using a loop.
+- trampolines are used otherwise.
+  [More](http://ocsigen.org/js_of_ocaml/dev/manual/tailcall) about tail call
+  optimization.
+
+Effect handlers are supported with the `--enable=effects` flag.
+
+## Data representation
+
+Data representation differs from the usual one. Most notably, integers are 32
+bits (rather than 31 bits or 63 bits), which is their natural size in
+JavaScript, and floats are not boxed. As a consequence, marshalling, polymorphic
+comparison, and hashing functions can yield results different from usual:
+
+- marshalling floats might generate different output. Such output should not be
+  unmarshalled using the standard ocaml runtime (native or bytecode).
+- the polymorphic hash function will not give the same results on datastructures
+  containing floats;
+- these functions may be more prone to stack overflow.
+
+| OCaml | javascript |
+| ------------- | ------------- |
+| int   | number (32bit int)  |
+| int32 | number (32bit int)  |
+| nativeint | number (32bit int)  |
+| int64 | Object (MlInt64) |
+| float | number |
+| string | string or object (MlBytes) |
+| bytes | object (MlBytes) |
+| "immediate" (e.g. true, false, None, ()) | number (32bit int) |
+| "block" | array with tag as first element (e.g. `C(1,2) => [tag,1,2]`) |
+| array | block with tag 0 (e.g. `[\|1;2\|] => [0,1,2]`) |
+| tuple | block with tag 0 (e.g. `(1,2) => [0,1,2]`) |
+| record | block (e.g. `{x=1;y=2} => [0,1,2]`) |
+| constructor with arguments | block (e.g. `C (1, 2) => [tag,1,2]`) |
+| module | block |
+| exception and extensible variant | block or immediate |
+| function | function |
+
+
+
+## Toplevel
+
+- [OCaml 4.04.0+BER](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.04.0+BER)
+  see http://okmij.org/ftp/ML/MetaOCaml.html
+- [OCaml 4.06.0](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.06.0)
+  includes Base, Core_kernel, Async_kernel, Async_js
+
+## Contents of the distribution
+
+| Filename    | Description                                  |
+| ----------- | -------------------------------------------- |
+| LICENSE     | license and copyright notice                 |
+| README      | this file                                    |
+| compiler/   | compiler                                     |
+| examples/   | small examples                               |
+| lib/        | library for interfacing with JavaScript APIs |
+| ppx/        | ppx syntax extensions                        |
+| runtime/    | runtime system                               |
+| toplevel/   | web-based OCaml toplevel                     |
diff --git a/README_jsoo.md b/README_jsoo.md
deleted file mode 100644
index 1585664b42..0000000000
--- a/README_jsoo.md
+++ /dev/null
@@ -1,154 +0,0 @@
-# Js_of_ocaml (jsoo)
-
-[![Build Status](https://github.com/ocsigen/js_of_ocaml/workflows/build/badge.svg?branch=master)](https://github.com/ocsigen/js_of_ocaml/actions)
-[![Update Web site - build](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/siteupdate.yml)
-[![Update Web site - deploy](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment/badge.svg)](https://github.com/ocsigen/js_of_ocaml/actions/workflows/pages/pages-build-deployment)
-
-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.
-
-- It is easy to install and use as it works with an existing installation of
-  OCaml, with no need to recompile any library.
-- It comes with bindings for a large part of the browser APIs.
-- According to our benchmarks, the generated programs runs typically faster than
-  with the OCaml bytecode interpreter.
-- We believe this compiler will prove much easier to maintain than a retargeted
-  OCaml compiler, as the bytecode provides a very stable API.
-
-Js_of_ocaml is composed of multiple packages:
-- js_of_ocaml-compiler, the compiler.
-- js_of_ocaml-ppx, a ppx syntax extension.
-- js_of_ocaml, the base library.
-- js_of_ocaml-ppx_deriving_json
-- js_of_ocaml-lwt, lwt support.
-- js_of_ocaml-tyxml, tyxml support.
-- js_of_ocaml-toplevel, lib and tools to build an ocaml toplevel to
-  javascript.
-
-## Requirements
-
-See
-[opam](https://github.com/ocsigen/js_of_ocaml/blob/master/js_of_ocaml-compiler.opam)
-file for version constraints.
-
-### optional
-
-- [lwt](https://github.com/ocsigen/lwt)
-- [tyxml](https://github.com/ocsigen/tyxml)
-- [reactiveData](https://github.com/ocsigen/reactiveData)
-- [yojson](https://github.com/mjambon/yojson)
-
-### Toplevel requirements
-
-- tyxml, reactiveData
-- ocp-indent: needed to support indentation in the toplevel
-- higlo: needed to support Syntax highlighting in the toplevel
-- cohttp: needed to build the toplevel webserver
-
-## Installation
-
-### Opam
-
-```
-opam install js_of_ocaml js_of_ocaml-compiler js_of_ocaml-ppx
-```
-
-## Usage
-
-Your program must first be compiled using the OCaml bytecode compiler `ocamlc`.
-JavaScript bindings are provided by the `js_of_ocaml` package. The syntax
-extension is provided by `js_of_ocaml-ppx` package.
-
-```
-ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx -linkpkg -o cubes.byte cubes.ml
-```
-
-Then, run the `js_of_ocaml` compiler to produce JavaScript code:
-
-```
-js_of_ocaml cubes.byte
-```
-
-## Features
-
-Most of the OCaml standard library is supported. However,
-
-- Most of the Sys module is not supported.
-
-Extra libraries distributed with OCaml (such as Thread) are not supported in
-general. However,
-
-- Bigarray: bigarrays are supported using Typed Arrays
-- Num: supported
-- Str: supported
-- Graphics: partially supported using canvas (see js_of_ocaml-lwt.graphics)
-- Unix: time related functions are supported
-
-Tail call is not optimized in general. However, mutually recursive functions are
-optimized:
-
-- self recursive functions (when the tail calls are the function itself) are
-  compiled using a loop.
-- trampolines are used otherwise.
-  [More](http://ocsigen.org/js_of_ocaml/dev/manual/tailcall) about tail call
-  optimization.
-
-Effect handlers are supported with the `--enable=effects` flag.
-
-## Data representation
-
-Data representation differs from the usual one. Most notably, integers are 32
-bits (rather than 31 bits or 63 bits), which is their natural size in
-JavaScript, and floats are not boxed. As a consequence, marshalling, polymorphic
-comparison, and hashing functions can yield results different from usual:
-
-- marshalling of floats is not supported (unmarshalling works);
-- the polymorphic hash function will not give the same results on datastructures
-  containing floats;
-- these functions may be more prone to stack overflow.
-
-| Ocaml | javascript |
-| ------------- | ------------- |
-| int   | number (32bit int)  |
-| int32 | number (32bit int)  |
-| nativeint | number (32bit int)  |
-| int64 | Object (MlInt64) |
-| float | number |
-| string | string or object (MlBytes) |
-| bytes | object (MlBytes) |
-| "immediate" (e.g. true, false, None, ()) | number (32bit int) |
-| "block" | array with tag as first element (e.g. `C(1,2) => [tag,1,2]`) |
-| array | block with tag 0 (e.g. `[\|1;2\|] => [0,1,2]`) |
-| tuple | block with tag 0 (e.g. `(1,2) => [0,1,2]`) |
-| record | block (e.g. `{x=1;y=2} => [0,1,2]`) |
-| constructor with arguments | block (e.g. `C (1, 2) => [tag,1,2]`) |
-| module | block |
-| exception and extensible variant | block or immediate |
-| function | function |
-
-
-
-## Toplevel
-
-- [OCaml 4.04.2](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.04.2)
-  includes Base, Core_kernel, Async_kernel, Async_js
-- [OCaml 4.04.0+BER](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.04.0+BER)
-  see http://okmij.org/ftp/ML/MetaOCaml.html
-- [OCaml 4.05.0](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.05.0)
-  includes Base, Core_kernel, Async_kernel, Async_js
-- [OCaml 4.06.0](http://ocsigen.github.io/js_of_ocaml/toplevel/#version=4.06.0)
-  includes Base, Core_kernel, Async_kernel, Async_js
-
-## Contents of the distribution
-
-| Filename    | Description                                  |
-| ----------- | -------------------------------------------- |
-| LICENSE     | license and copyright notice                 |
-| README      | this file                                    |
-| compiler/   | compiler                                     |
-| examples/   | small examples                               |
-| lib/        | library for interfacing with JavaScript APIs |
-| ppx/        | ppx syntax extensions                        |
-| runtime/    | runtime system                               |
-| toplevel/   | web-based OCaml toplevel                     |
diff --git a/README_wasm_of_ocaml.md b/README_wasm_of_ocaml.md
new file mode 100644
index 0000000000..ee5c69df18
--- /dev/null
+++ b/README_wasm_of_ocaml.md
@@ -0,0 +1,68 @@
+# Wasm_of_ocaml
+
+Wasm_of_ocaml is a fork of Js_of_ocaml which compiles OCaml bytecode to WebAssembly.
+
+## Supported engines
+
+The generated code works with Chrome 11.9, Node.js 22 and Firefox 122 (or more recent versions of these applications).
+
+In particular, the output code requires the following [Wasm extensions](https://webassembly.org/roadmap/) to run:
+- [the GC extension](https://github.com/WebAssembly/gc), including functional references and 31-bit integers
+- [the tail-call extension](https://github.com/WebAssembly/tail-call/blob/main/proposals/tail-call/Overview.md)
+- [the exception handling extension](https://github.com/WebAssembly/exception-handling/blob/master/proposals/exception-handling/Exceptions.md)
+
+OCaml 5.x code using effect handlers can be compiled in two different ways:
+One can enable the CPS transformation from `js_of_ocaml` by passing the
+`--enable=effects` flag. Without the flag `wasm_of_ocaml` will instead emit code
+utilizing
+- [the JavaScript-Promise Integration extension](https://github.com/WebAssembly/js-promise-integration/blob/main/proposals/js-promise-integration/Overview.md)
+
+
+## Installation
+
+The following commands will perform a minimal installation:
+```
+git clone https://github.com/ocaml-wasm/wasm_of_ocaml
+cd wasm_of_ocaml
+opam pin add -n --with-version 6.0.0 .
+opam install dune.3.17.0 wasm_of_ocaml-compiler
+```
+You may want to install additional packages. For instance:
+
+```
+opam install js_of_ocaml-ppx js_of_ocaml-lwt
+```
+
+## Usage
+
+You can try compiling the program in `examples/cubes`. Your program must first be compiled using the OCaml bytecode compiler `ocamlc`. JavaScript bindings are provided by the `js_of_ocaml` package. The syntax extension is provided by `js_of_ocaml-ppx` package. Package `js_of_ocaml-lwt` provides Javascript specific Lwt functions.
+
+```
+ocamlfind ocamlc -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt -linkpkg -o cubes.byte cubes.mli cubes.ml
+```
+
+Then, run the `wasm_of_ocaml` compiler to produce WebAssembly code:
+
+```
+wasm_of_ocaml cubes.byte
+```
+
+This outputs a file `cubes.js` which loads the WebAssembly code from file `cube.wasm`. For debugging, we currently also output the generated WebAssembly code in text file to `cube.wat`. Since Chrome does not allow loading from the filesystem, you need to serve the files using some Web server. For instance:
+```
+python3 -m http.server 8000 --directory .
+```
+
+As a larger example, you can try [CAMLBOY](https://github.com/linoscope/CAMLBOY). You need to install a forked version of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm). Once the Js_of_ocaml UI is compiled (with `dune build --profile release`), you can generate WebAssembly code instead with the following command:
+```
+wasm_of_ocaml _build/default/bin/web/index.bc-for-jsoo
+```
+
+## Implementation status
+
+A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions and dynamic linking are not supported yet.
+
+## Compatibility with Js_of_ocaml
+
+Since the value representation is different, some adaptations are necessary.
+
+The most notable change is that, except for integers, OCaml numbers are no longer mapped to JavaScript numbers. So, explicit conversions `Js.to_float` and `Js.float` are now necessary to convert between OCaml floats and JavaScript numbers. The typing of JavaScript Typed Arrays has also been changed to deal with this.

From e30da15729f09bf5a4fa75050cb88ae16cbfbac0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 6 Nov 2024 17:29:40 +0100
Subject: [PATCH 480/481] Changelog

---
 CHANGES.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/CHANGES.md b/CHANGES.md
index 2e8ad43b60..83b2dab691 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,6 +3,7 @@
 ## Features/Changes
 * Lib: fix the type of some DOM properties and methods (#1747)
 * Test: use dune test stanzas (#1631)
+* Merged Wasm_of_ocaml (#1724)
 
 # 5.9.1 (02-12-2024) - Lille
 

From 217cc8b8bddfcfdce0f9c080949ae3ca562dd46e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= <jerome.vouillon@gmail.com>
Date: Wed, 4 Dec 2024 14:19:53 +0100
Subject: [PATCH 481/481] CI: no longer run the wasm workflow on all pushes

---
 .github/workflows/build-wasm_of_ocaml.yml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.github/workflows/build-wasm_of_ocaml.yml b/.github/workflows/build-wasm_of_ocaml.yml
index 9a5331b86b..e4ffefcff5 100644
--- a/.github/workflows/build-wasm_of_ocaml.yml
+++ b/.github/workflows/build-wasm_of_ocaml.yml
@@ -3,6 +3,8 @@ name: Build wasm_of_ocaml
 on:
   pull_request:
   push:
+    branches:
+      - master
 
 jobs:
   build: