Fix constant_identical for Wasm target

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

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
 

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
 

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