Use type analysis to avoid using JavasScript strict equality

If we know that one of the compared values is not a JavaScript value, we
can directly use physical equality.

Author: vouillon

compiler/lib-wasm/gc_target.ml

@@ -565,9 +565,21 @@ module Value = struct
        return ())
       (if negate then Arith.eqz n else n)
 
-  let eq x y = eq_gen ~negate:false x y
+  let phys_eq ~relaxed x y =
+    if relaxed
+    then eq_gen ~negate:false x y
+    else
+      let* x = x in
+      let* y = y in
+      return (W.RefEq (x, y))
 
-  let neq x y = eq_gen ~negate:true x y
+  let phys_neq ~relaxed x y =
+    if relaxed
+    then eq_gen ~negate:true x y
+    else
+      let* x = x in
+      let* y = y in
+      Arith.eqz (return (W.RefEq (x, y)))
 
   let ult = Arith.ult
 

compiler/lib-wasm/generate.ml

@@ -215,15 +215,26 @@ module Generate (Target : Target_sig.S) = struct
           (transl_prim_arg ctx ~typ:(Int Normalized) x)
           (transl_prim_arg ctx ~typ:(Int Normalized) y)
 
-  let translate_int_equality ctx op op' x y =
+  let translate_int_equality ctx ~negate x y =
     match get_type ctx x, get_type ctx y with
     | (Int Normalized as typ), Int Normalized ->
-        op (transl_prim_arg ctx ~typ x) (transl_prim_arg ctx ~typ y)
+        (if negate then Arith.( = ) else Arith.( <> ))
+          (transl_prim_arg ctx ~typ x)
+          (transl_prim_arg ctx ~typ y)
     | Int (Normalized | Unnormalized), Int (Normalized | Unnormalized) ->
-        op
+        (if negate then Arith.( = ) else Arith.( <> ))
           Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) x lsl const 1l)
           Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) y lsl const 1l)
-    | _ -> op' (transl_prim_arg ctx ~typ:Top x) (transl_prim_arg ctx ~typ:Top y)
+    | Top, Top ->
+        (if negate then Value.phys_eq else Value.phys_neq)
+          ~relaxed:true
+          (transl_prim_arg ctx ~typ:Top x)
+          (transl_prim_arg ctx ~typ:Top y)
+    | _ ->
+        (if negate then Value.phys_eq else Value.phys_neq)
+          ~relaxed:false
+          (transl_prim_arg ctx ~typ:Top x)
+          (transl_prim_arg ctx ~typ:Top y)
 
   let internal_primitives =
     let h = String.Hashtbl.create 128 in
@@ -864,8 +875,8 @@ module Generate (Target : Target_sig.S) = struct
     | Prim (Lt, [ x; y ]) -> translate_int_comparison ctx Arith.( < ) x y
     | Prim (Le, [ x; y ]) -> translate_int_comparison ctx Arith.( <= ) x y
     | Prim (Ult, [ x; y ]) -> translate_int_comparison ctx Arith.ult x y
-    | Prim (Eq, [ x; y ]) -> translate_int_equality ctx Arith.( = ) Value.eq x y
-    | Prim (Neq, [ x; y ]) -> translate_int_equality ctx Arith.( <> ) Value.neq x y
+    | Prim (Eq, [ x; y ]) -> translate_int_equality ctx ~negate:false x y
+    | Prim (Neq, [ x; y ]) -> translate_int_equality ctx ~negate:true x y
     | Prim (Array_get, [ x; y ]) ->
         Memory.array_get
           (transl_prim_arg ctx x)

compiler/lib-wasm/target_sig.ml

@@ -124,9 +124,11 @@ module type S = sig
 
     val le : expression -> expression -> expression
 
-    val eq : expression -> expression -> expression
+    (* Relaxed means using JavaScript strict equality to compare
+       JavaScript values *)
+    val phys_eq : relaxed:bool -> expression -> expression -> expression
 
-    val neq : expression -> expression -> expression
+    val phys_neq : relaxed:bool -> expression -> expression -> expression
 
     val ult : expression -> expression -> expression