Use the type analysis to avoid using JavasScript strict equality (#2040)

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

---------

Co-authored-by: Hugo Heuzard <[email protected]>

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

@@ -540,7 +540,7 @@ module Value = struct
 
   let ( >>| ) x f = map f x
 
-  let eq_gen ~negate x y =
+  let js_eqeqeq ~negate x y =
     let xv = Code.Var.fresh () in
     let yv = Code.Var.fresh () in
     let* js = Type.js_type in
@@ -565,9 +565,15 @@ 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 x y =
+    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 x y =
+    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,31 @@ 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 ->
+        Value.js_eqeqeq
+          ~negate
+          (transl_prim_arg ctx ~typ:Top x)
+          (transl_prim_arg ctx ~typ:Top y)
+    | Bot, _ | _, Bot ->
+        (* this is deadcode *)
+        (if negate then Value.phys_neq else Value.phys_eq)
+          (transl_prim_arg ctx ~typ:Top x)
+          (transl_prim_arg ctx ~typ:Top y)
+    | (Int _ | Number _ | Tuple _), _ | _, (Int _ | Number _ | Tuple _) ->
+        (* Only Top may contain JavaScript values *)
+        (if negate then Value.phys_neq else Value.phys_eq)
+          (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 +880,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
+    val js_eqeqeq : negate:bool -> expression -> expression -> expression
 
-    val neq : expression -> expression -> expression
+    val phys_eq : expression -> expression -> expression
+
+    val phys_neq : expression -> expression -> expression
 
     val ult : expression -> expression -> expression