CR

ocsigen · Sep 25, 2024 · 191b917 · 191b917
1 parent aa0ae8b
commit 191b917
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 8 deletions.
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
@@ -434,13 +434,13 @@ let eval_instr ~target info ((x, loc) as i) =
                     ( prim
                     , List.map2 prim_args prim_args' ~f:(fun arg (c : constant option) ->
                           match c, target with
-                          | Some ((Int _ | NativeString _) as c), _ -> Pc c
-                          | Some (Int32 _ | NativeInt _), `Wasm ->
+                          | 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 _ as c), `JavaScript -> Pc c
+                          | Some ((Float _ | NativeString _) as c), `JavaScript -> Pc c
                           | Some (String _ as c), `JavaScript
                             when Config.Flag.use_js_string () -> Pc c
                           | Some _, _

diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml
@@ -31,9 +31,15 @@ let rec constant_of_const c : Code.constant =
   | ((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) -> (
+      match Config.target () with
+      | `JavaScript -> Int i
+      | `Wasm -> 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) -> (
+      match Config.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
@@ -490,10 +490,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 (Obj.magic x : int32)
-        | Some name when same_ident name ident_native ->
+        | Some name when same_ident name ident_32 -> (
+            let i : int32 = Obj.magic x in
+            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
-            Int (Int32.of_nativeint_warning_on_overflow i)
+            match Config.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