fixup! Don't noop conversion between ints/float with the same runtime repr. Previously, primitives taking float arguments could receive Int/Int32/NativeInt/Float arg

Author: hhugo

compiler/lib/eval.ml

@@ -82,9 +82,21 @@ let eval_prim x =
   | Eq, [ Int i; Int j ] -> bool Targetint.(i = j)
   | Neq, [ Int i; Int j ] -> bool Targetint.(i <> j)
   | Ult, [ Int i; Int j ] -> bool (Targetint.(j < zero) || Targetint.(i < j))
-  | Extern name, l -> (
-      let name = Primitive.resolve name in
+  | Extern name', l -> (
+      let name = Primitive.resolve name' in
       match name, l with
+      | "%identity-ints-repr", [ c ] -> (
+          match name', c with
+          | "caml_int32_of_int", Int x -> Some (Int32 (Targetint.to_int32 x))
+          | "caml_int32_to_int", Int32 x -> Some (Int (Targetint.of_int32_exn x))
+          | "caml_int32_to_float", Int32 x -> Some (Float (Int32.to_float x))
+          | "caml_nativeint_of_int", Int x -> Some (NativeInt (Targetint.to_int32 x))
+          | "caml_nativeint_to_int", NativeInt x -> Some (Int (Targetint.of_int32_exn x))
+          | "caml_nativeint_to_float", NativeInt x -> Some (Float (Int32.to_float x))
+          | "caml_nativeint_of_int32", Int32 x -> Some (NativeInt x)
+          | "caml_nativeint_to_int32", NativeInt x -> Some (Int32 x)
+          | "caml_float_of_int", Int x -> Some (Float (Targetint.to_float x))
+          | _ -> assert false)
       (* int *)
       | "%int_add", _ -> int_binop l Targetint.add
       | "%int_sub", _ -> int_binop l Targetint.sub

compiler/lib/flow.ml

@@ -344,6 +344,7 @@ let the_def_of info x =
         (fun x ->
           match info.info_defs.(Var.idx x) with
           | Expr (Constant (Float _ | Int _ | NativeString _) as e) -> Some e
+          | Expr (Constant (Int32 _ | NativeInt _) as e) -> Some e
           | Expr (Constant (String _) as e) when Config.Flag.safe_string () -> Some e
           | Expr e -> if Var.ISet.mem info.info_possibly_mutable x then None else Some e
           | _ -> None)

compiler/lib/parse_bytecode.ml

@@ -408,7 +408,7 @@ end
 module Constants : sig
   val parse : Obj.t -> Code.constant
 
-  val inlined : Code.constant -> bool
+  val inlined : target:[ `JavaScript | `Wasm ] -> Code.constant -> bool
 end = struct
   (* In order to check that two custom objects share the same kind, we
      compare their identifier.  The identifier is currently extracted
@@ -474,14 +474,18 @@ end = struct
       let i : int = Obj.magic x in
       Int (Targetint.of_int_warning_on_overflow i)
 
-  let inlined = function
+  let inlined ~target c =
+    match c with
     | String _ | NativeString _ -> false
     | Float _ -> true
     | Float_array _ -> false
     | Int64 _ -> false
     | Tuple _ -> false
     | Int _ -> true
-    | Int32 _ | NativeInt _ -> false
+    | Int32 _ | NativeInt _ -> (
+        match target with
+        | `JavaScript -> true
+        | `Wasm -> false)
 end
 
 let const32 i = Constant (Int (Targetint.of_int32_exn i))
@@ -744,14 +748,15 @@ let get_global state instrs i =
       if debug_parser () then Format.printf "(global access %a)@." Var.print x;
       x, State.set_accu state x, instrs
   | None -> (
-      if i < Array.length g.constants && Constants.inlined g.constants.(i)
+      let target = Config.target () in
+      if i < Array.length g.constants && Constants.inlined ~target g.constants.(i)
       then
         (* Inlined constant *)
         let x, state = State.fresh_var state in
         let cst = g.constants.(i) in
         x, state, Let (x, Constant cst) :: instrs
       else
-        match i < Array.length g.constants, Config.target () with
+        match i < Array.length g.constants, target with
         | true, _ | false, `JavaScript ->
             (* Non-inlined constant, and reference to another compilation
                units in case of separate compilation (JavaScript).