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 1/5] 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 c4b47bd19..b7143e3f2 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 8a22b98bf..16af48737 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 7424b6bdd..66c79a3ed 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 5a2f5fb93..e61bd48a5 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 ebf5773f5..b5ee88b9a 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 45859f1d7..5dcf214e4 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 9a638169a..3094ac98c 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 5709ada02..d42742b84 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 1caac8caf..906895a53 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 d3a376bee..314086521 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 ed4079d0e..0e7eafda2 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 5b7b95480..9f452b668 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 7dcc3ca6d..62c8d80ee 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 2/5] 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 b7143e3f2..591cac4c1 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 16af48737..6e8f0d0bd 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 ae182423f..5e7b61756 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 e61bd48a5..d8a4e48e2 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 b5ee88b9a..f5e8193ea 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 fdeaa8321..b0601ccba 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 5dcf214e4..58893caae 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 26b4f45d3..12c5caaee 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 906895a53..9f5c4fa43 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 159c8570a..88e541e69 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 4e735576c..bd1e41f41 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 3/5] 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 62c8d80ee..9eedaa7e9 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 deaed96b3..5c2cc2d47 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 4a2dd9084..59c528411 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 2d1051c7b..f1eaa1b80 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 4/5] 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 d8a4e48e2..21b1041dc 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 5/5] 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 21b1041dc..77eb5e332 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 3094ac98c..87f5d0cfe 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 40cebb0ad..16b9ae535 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)