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

CHANGES.md

@@ -43,6 +43,7 @@
 * Compiler: directly write Wasm binary modules (#2000, #2003)
 * Compiler: rewrote inlining pass (#1935, #2018, #2027)
 * Compiler/wasm: optimize integer operations (#2032)
+* Compiler/wasm: use type analysis to remove some unnecessary uses of JavasScript strict equality (#2040)
 
 ## Bug fixes
 * Compiler: fix stack overflow issues with double translation (#1869)

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,29 @@ 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_neq else Value.phys_eq)
+          ~relaxed:true
+          (transl_prim_arg ctx ~typ:Top x)
+          (transl_prim_arg ctx ~typ:Top y)
+    | Int (Normalized | Unnormalized), (Int Ref | Top | Bot | Number _ | Tuple _)
+    | (Int Ref | Top | Bot | Number _ | Tuple _), Int (Normalized | Unnormalized)
+    | ( (Int Ref | Top | Bot | Number _ | Tuple _)
+      , (Int Ref | Top | Bot | Number _ | Tuple _) ) ->
+        (if negate then Value.phys_neq else Value.phys_eq)
+          ~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 +878,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