diff --git a/CHANGES.md b/CHANGES.md index 3c6be5232f..3a035a4a95 100644 --- a/CHANGES.md +++ b/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) diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml index 686b62d096..36ca054e4c 100644 --- a/compiler/lib-wasm/gc_target.ml +++ b/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 diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index d65a71d04d..7d82219aa1 100644 --- a/compiler/lib-wasm/generate.ml +++ b/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) diff --git a/compiler/lib-wasm/target_sig.ml b/compiler/lib-wasm/target_sig.ml index 428327a3df..f5afebf6b9 100644 --- a/compiler/lib-wasm/target_sig.ml +++ b/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