Flow.the_const_of: allow to use different comparison functions

Whether two constants should be considered equal depends on the context
in which they are used.

Author: vouillon

compiler/lib/eval.ml

@@ -467,10 +467,32 @@ let constant_js_equal a b =
   | Tuple _, _
   | _, Tuple _ -> None
 
+(* [eval_prim] does not distinguish the two constants *)
+let constant_equal a b =
+  match a, b with
+  | Int i, Int j -> Targetint.equal i j
+  | Float a, Float b -> Int64.equal a b
+  | NativeString a, NativeString b -> Native_string.equal a b
+  | String a, String b -> String.equal a b
+  | Int32 a, Int32 b -> Int32.equal a b
+  | NativeInt a, NativeInt b -> Int32.equal a b
+  | Int64 a, Int64 b -> Int64.equal a b
+  (* We don't need to compare other constants, so let's just return false. *)
+  | Tuple _, Tuple _ -> false
+  | Float_array _, Float_array _ -> false
+  | (Int _ | Float _ | Int64 _ | Int32 _ | NativeInt _), _ -> false
+  | (String _ | NativeString _), _ -> false
+  | (Float_array _ | Tuple _), _ -> false
+
 let eval_instr update_count inline_constant ~target info i =
   match i with
   | Let (x, Prim (Extern (("caml_equal" | "caml_notequal") as prim), [ y; z ])) -> (
-      match the_const_of ~target info y, the_const_of ~target info z with
+      let eq e1 e2 =
+        match Code.Constant.ocaml_equal e1 e2 with
+        | None -> false
+        | Some e -> e
+      in
+      match the_const_of ~eq info y, the_const_of ~eq info z with
       | Some e1, Some e2 -> (
           match Code.Constant.ocaml_equal e1 e2 with
           | None -> [ i ]
@@ -487,7 +509,12 @@ let eval_instr update_count inline_constant ~target info i =
               [ Let (x, c) ])
       | _ -> [ i ])
   | Let (x, Prim (Extern ("caml_js_equals" | "caml_js_strict_equals"), [ y; z ])) -> (
-      match the_const_of ~target info y, the_const_of ~target info z with
+      let eq e1 e2 =
+        match constant_js_equal e1 e2 with
+        | None -> false
+        | Some e -> e
+      in
+      match the_const_of ~eq info y, the_const_of ~eq info z with
       | Some e1, Some e2 -> (
           match constant_js_equal e1 e2 with
           | None -> [ i ]
@@ -586,7 +613,9 @@ let eval_instr update_count inline_constant ~target info 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 ~target info x) in
+      let prim_args' =
+        List.map prim_args ~f:(fun x -> the_const_of ~eq:constant_equal info x)
+      in
       let res =
         if
           List.for_all prim_args' ~f:(function

compiler/lib/flow.ml

@@ -360,53 +360,25 @@ let the_def_of info x =
         x
   | Pc c -> Some (Constant c)
 
-(* 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 ~(target : [ `JavaScript | `Wasm ]) a b =
-  match a, b, target with
-  | Int i, Int j, _ -> Targetint.equal i j
-  | Float a, Float b, `JavaScript -> Int64.equal a b
-  | Float _, Float _, `Wasm -> false
-  | NativeString a, NativeString b, `JavaScript -> Native_string.equal a b
-  | NativeString _, NativeString _, `Wasm ->
-      false
-      (* Native strings are boxed (JavaScript objects) in Wasm and are
-          possibly different objects *)
-  | String a, String b, `JavaScript -> Config.Flag.use_js_string () && String.equal a b
-  | String _, String _, `Wasm ->
-      false (* Strings are boxed in Wasm and are possibly different objects *)
-  | Int32 _, Int32 _, `Wasm ->
-      false (* [Int32]s are boxed in Wasm and are possibly different objects *)
-  | Int32 a, Int32 b, `JavaScript -> Int32.equal a b
-  | NativeInt _, NativeInt _, `Wasm ->
-      false (* [NativeInt]s are boxed in Wasm and are possibly different objects *)
-  | NativeInt a, NativeInt b, `JavaScript -> Int32.equal a b
-  (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
-  | Int64 _, Int64 _, _ -> false
-  | Tuple _, Tuple _, _ -> false
-  | Float_array _, Float_array _, _ -> false
-  | (Int _ | Float _ | Int64 _ | Int32 _ | NativeInt _), _, _ -> false
-  | (String _ | NativeString _), _, _ -> false
-  | (Float_array _ | Tuple _), _, _ -> false
-
-let the_const_of ~target info x =
+let the_const_of ~eq info x =
   match x with
   | Pv x ->
       get_approx
         info
         (fun x ->
-          match info.info_defs.(Var.idx x), target with
-          | Expr (Constant ((Float _ | Int _ | NativeString _) as c)), _ -> Some c
-          | Expr (Constant ((Int32 _ | NativeInt _) as c)), `JavaScript -> Some c
-          | Expr (Constant (String _ as c)), _ when Config.Flag.safe_string () -> Some c
-          | Expr (Constant c), _ ->
-              if Var.ISet.mem info.info_possibly_mutable x then None else Some c
+          match info.info_defs.(Var.idx x) with
+          | Expr
+              (Constant
+                 ((Float _ | Int _ | Int32 _ | Int64 _ | NativeInt _ | NativeString _) as
+                  c)) -> Some c
+          | Expr (Constant c)
+            when Config.Flag.safe_string ()
+                 || not (Var.ISet.mem info.info_possibly_mutable x) -> Some c
           | _ -> None)
         None
         (fun u v ->
           match u, v with
-          | Some i, Some j when constant_identical ~target i j -> u
+          | Some i, Some j when eq i j -> u
           | _ -> None)
         x
   | Pc c -> Some c
@@ -429,13 +401,13 @@ let the_int info x =
   | Pc (Int c) -> Some c
   | Pc _ -> None
 
-let the_string_of ~target info x =
-  match the_const_of info ~target x with
+let the_string_of info x =
+  match the_const_of ~eq:(fun _ _ -> false) info x with
   | Some (String i) -> Some i
   | _ -> None
 
-let the_native_string_of ~target info x =
-  match the_const_of ~target info x with
+let the_native_string_of info x =
+  match the_const_of ~eq:(fun _ _ -> false) info x with
   | Some (NativeString i) -> Some i
   | Some (String i) ->
       (* This function is used to optimize the primitives that access

compiler/lib/flow.mli

@@ -53,13 +53,14 @@ val get_approx :
 val the_def_of : Info.t -> Code.prim_arg -> Code.expr option
 
 val the_const_of :
-  target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.constant option
+     eq:(Code.constant -> Code.constant -> bool)
+  -> Info.t
+  -> Code.prim_arg
+  -> Code.constant option
 
-val the_string_of :
-  target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> string option
+val the_string_of : Info.t -> Code.prim_arg -> string option
 
-val the_native_string_of :
-  target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.Native_string.t option
+val the_native_string_of : Info.t -> Code.prim_arg -> Code.Native_string.t option
 
 val the_block_contents_of : Info.t -> Code.prim_arg -> Code.Var.t array option
 

compiler/lib/specialize_js.ml

@@ -34,7 +34,7 @@ let specialize_instr opt_count ~target info i =
       (* We can implement the special case where the format string is "%s" in JavaScript
          in a concise and efficient way with [""+x]. It does not make as much sense in
          Wasm to have a special case for this. *)
-      match the_string_of ~target info y with
+      match the_string_of info y with
       | Some "%d" -> (
           incr opt_count;
           match the_int info z with
@@ -53,15 +53,15 @@ let specialize_instr opt_count ~target info i =
         , Prim
             ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim)
             , [ (Pv _ as y) ] ) )
-    , target ) -> (
-      match the_string_of ~target info y with
+    , _ ) -> (
+      match the_string_of info y with
       | Some s ->
           incr opt_count;
           Let (x, Prim (Extern prim, [ Pc (String s) ]))
       | _ -> i)
   | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ (Pv _ as y); z ])), _
     -> (
-      match the_string_of ~target info y with
+      match the_string_of info y with
       | Some s when Primitive.need_named_value s ->
           incr opt_count;
           Let (x, Prim (Extern prim, [ Pc (String s); z ]))
@@ -84,7 +84,7 @@ let specialize_instr opt_count ~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 ~target info m with
+      match the_string_of info m with
       | Some m when Javascript.is_ident m -> (
           match the_block_contents_of info a with
           | Some a ->
@@ -118,7 +118,7 @@ let specialize_instr opt_count ~target info i =
               match the_def_of info (Pv x) with
               | Some (Block (_, [| k; v |], _, _)) ->
                   let k =
-                    match the_string_of ~target info (Pv k) with
+                    match the_string_of info (Pv k) with
                     | Some s when String.is_valid_utf_8 s ->
                         Pc (NativeString (Native_string.of_string s))
                     | Some _ | None -> raise Exit
@@ -133,32 +133,32 @@ let specialize_instr opt_count ~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 ~target info f with
+      match the_native_string_of info f with
       | Some s ->
           incr opt_count;
           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 ~target info f with
+      match the_native_string_of info f with
       | Some s ->
           incr opt_count;
           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 ~target info f with
+      match the_native_string_of info f with
       | Some s ->
           incr opt_count;
           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 ~target info y with
+      match the_string_of info y with
       | Some s when String.is_valid_utf_8 s ->
           incr opt_count;
           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 ~target info y with
+      match the_string_of info y with
       | Some s ->
           incr opt_count;
           Let (x, Constant (NativeString (Native_string.of_bytestring s)))