Skip to content

Commit d3ac83a

Browse files
committed
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.
1 parent 6971c1a commit d3ac83a

File tree

4 files changed

+63
-61
lines changed

4 files changed

+63
-61
lines changed

compiler/lib/eval.ml

Lines changed: 32 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -467,10 +467,32 @@ let constant_js_equal a b =
467467
| Tuple _, _
468468
| _, Tuple _ -> None
469469

470+
(* [eval_prim] does not distinguish the two constants *)
471+
let constant_equal a b =
472+
match a, b with
473+
| Int i, Int j -> Targetint.equal i j
474+
| Float a, Float b -> Int64.equal a b
475+
| NativeString a, NativeString b -> Native_string.equal a b
476+
| String a, String b -> String.equal a b
477+
| Int32 a, Int32 b -> Int32.equal a b
478+
| NativeInt a, NativeInt b -> Int32.equal a b
479+
| Int64 a, Int64 b -> Int64.equal a b
480+
(* We don't need to compare other constants, so let's just return false. *)
481+
| Tuple _, Tuple _ -> false
482+
| Float_array _, Float_array _ -> false
483+
| (Int _ | Float _ | Int64 _ | Int32 _ | NativeInt _), _ -> false
484+
| (String _ | NativeString _), _ -> false
485+
| (Float_array _ | Tuple _), _ -> false
486+
470487
let eval_instr update_count inline_constant ~target info i =
471488
match i with
472489
| Let (x, Prim (Extern (("caml_equal" | "caml_notequal") as prim), [ y; z ])) -> (
473-
match the_const_of ~target info y, the_const_of ~target info z with
490+
let eq e1 e2 =
491+
match Code.Constant.ocaml_equal e1 e2 with
492+
| None -> false
493+
| Some e -> e
494+
in
495+
match the_const_of ~eq info y, the_const_of ~eq info z with
474496
| Some e1, Some e2 -> (
475497
match Code.Constant.ocaml_equal e1 e2 with
476498
| None -> [ i ]
@@ -487,7 +509,12 @@ let eval_instr update_count inline_constant ~target info i =
487509
[ Let (x, c) ])
488510
| _ -> [ i ])
489511
| Let (x, Prim (Extern ("caml_js_equals" | "caml_js_strict_equals"), [ y; z ])) -> (
490-
match the_const_of ~target info y, the_const_of ~target info z with
512+
let eq e1 e2 =
513+
match constant_js_equal e1 e2 with
514+
| None -> false
515+
| Some e -> e
516+
in
517+
match the_const_of ~eq info y, the_const_of ~eq info z with
491518
| Some e1, Some e2 -> (
492519
match constant_js_equal e1 e2 with
493520
| None -> [ i ]
@@ -586,7 +613,9 @@ let eval_instr update_count inline_constant ~target info i =
586613
| Let (_, Prim (Extern ("%resume" | "%perform" | "%reperform"), _)) ->
587614
[ i ] (* We need that the arguments to this primitives remain variables *)
588615
| Let (x, Prim (prim, prim_args)) -> (
589-
let prim_args' = List.map prim_args ~f:(fun x -> the_const_of ~target info x) in
616+
let prim_args' =
617+
List.map prim_args ~f:(fun x -> the_const_of ~eq:constant_equal info x)
618+
in
590619
let res =
591620
if
592621
List.for_all prim_args' ~f:(function

compiler/lib/flow.ml

Lines changed: 14 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -360,53 +360,25 @@ let the_def_of info x =
360360
x
361361
| Pc c -> Some (Constant c)
362362

363-
(* If [constant_identical a b = true], then the two values cannot be
364-
distinguished, i.e., they are not different objects (and [caml_js_equals a b
365-
= true]) and if both are floats, they are bitwise equal. *)
366-
let constant_identical ~(target : [ `JavaScript | `Wasm ]) a b =
367-
match a, b, target with
368-
| Int i, Int j, _ -> Targetint.equal i j
369-
| Float a, Float b, `JavaScript -> Int64.equal a b
370-
| Float _, Float _, `Wasm -> false
371-
| NativeString a, NativeString b, `JavaScript -> Native_string.equal a b
372-
| NativeString _, NativeString _, `Wasm ->
373-
false
374-
(* Native strings are boxed (JavaScript objects) in Wasm and are
375-
possibly different objects *)
376-
| String a, String b, `JavaScript -> Config.Flag.use_js_string () && String.equal a b
377-
| String _, String _, `Wasm ->
378-
false (* Strings are boxed in Wasm and are possibly different objects *)
379-
| Int32 _, Int32 _, `Wasm ->
380-
false (* [Int32]s are boxed in Wasm and are possibly different objects *)
381-
| Int32 a, Int32 b, `JavaScript -> Int32.equal a b
382-
| NativeInt _, NativeInt _, `Wasm ->
383-
false (* [NativeInt]s are boxed in Wasm and are possibly different objects *)
384-
| NativeInt a, NativeInt b, `JavaScript -> Int32.equal a b
385-
(* All other values may be distinct objects and thus different by [caml_js_equals]. *)
386-
| Int64 _, Int64 _, _ -> false
387-
| Tuple _, Tuple _, _ -> false
388-
| Float_array _, Float_array _, _ -> false
389-
| (Int _ | Float _ | Int64 _ | Int32 _ | NativeInt _), _, _ -> false
390-
| (String _ | NativeString _), _, _ -> false
391-
| (Float_array _ | Tuple _), _, _ -> false
392-
393-
let the_const_of ~target info x =
363+
let the_const_of ~eq info x =
394364
match x with
395365
| Pv x ->
396366
get_approx
397367
info
398368
(fun x ->
399-
match info.info_defs.(Var.idx x), target with
400-
| Expr (Constant ((Float _ | Int _ | NativeString _) as c)), _ -> Some c
401-
| Expr (Constant ((Int32 _ | NativeInt _) as c)), `JavaScript -> Some c
402-
| Expr (Constant (String _ as c)), _ when Config.Flag.safe_string () -> Some c
403-
| Expr (Constant c), _ ->
404-
if Var.ISet.mem info.info_possibly_mutable x then None else Some c
369+
match info.info_defs.(Var.idx x) with
370+
| Expr
371+
(Constant
372+
((Float _ | Int _ | Int32 _ | Int64 _ | NativeInt _ | NativeString _) as
373+
c)) -> Some c
374+
| Expr (Constant c)
375+
when Config.Flag.safe_string ()
376+
|| not (Var.ISet.mem info.info_possibly_mutable x) -> Some c
405377
| _ -> None)
406378
None
407379
(fun u v ->
408380
match u, v with
409-
| Some i, Some j when constant_identical ~target i j -> u
381+
| Some i, Some j when eq i j -> u
410382
| _ -> None)
411383
x
412384
| Pc c -> Some c
@@ -429,13 +401,13 @@ let the_int info x =
429401
| Pc (Int c) -> Some c
430402
| Pc _ -> None
431403

432-
let the_string_of ~target info x =
433-
match the_const_of info ~target x with
404+
let the_string_of info x =
405+
match the_const_of ~eq:(fun _ _ -> false) info x with
434406
| Some (String i) -> Some i
435407
| _ -> None
436408

437-
let the_native_string_of ~target info x =
438-
match the_const_of ~target info x with
409+
let the_native_string_of info x =
410+
match the_const_of ~eq:(fun _ _ -> false) info x with
439411
| Some (NativeString i) -> Some i
440412
| Some (String i) ->
441413
(* This function is used to optimize the primitives that access

compiler/lib/flow.mli

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -53,13 +53,14 @@ val get_approx :
5353
val the_def_of : Info.t -> Code.prim_arg -> Code.expr option
5454

5555
val the_const_of :
56-
target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.constant option
56+
eq:(Code.constant -> Code.constant -> bool)
57+
-> Info.t
58+
-> Code.prim_arg
59+
-> Code.constant option
5760

58-
val the_string_of :
59-
target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> string option
61+
val the_string_of : Info.t -> Code.prim_arg -> string option
6062

61-
val the_native_string_of :
62-
target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.Native_string.t option
63+
val the_native_string_of : Info.t -> Code.prim_arg -> Code.Native_string.t option
6364

6465
val the_block_contents_of : Info.t -> Code.prim_arg -> Code.Var.t array option
6566

compiler/lib/specialize_js.ml

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ let specialize_instr opt_count ~target info i =
3434
(* We can implement the special case where the format string is "%s" in JavaScript
3535
in a concise and efficient way with [""+x]. It does not make as much sense in
3636
Wasm to have a special case for this. *)
37-
match the_string_of ~target info y with
37+
match the_string_of info y with
3838
| Some "%d" -> (
3939
incr opt_count;
4040
match the_int info z with
@@ -53,15 +53,15 @@ let specialize_instr opt_count ~target info i =
5353
, Prim
5454
( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim)
5555
, [ (Pv _ as y) ] ) )
56-
, target ) -> (
57-
match the_string_of ~target info y with
56+
, _ ) -> (
57+
match the_string_of info y with
5858
| Some s ->
5959
incr opt_count;
6060
Let (x, Prim (Extern prim, [ Pc (String s) ]))
6161
| _ -> i)
6262
| Let (x, Prim (Extern ("caml_register_named_value" as prim), [ (Pv _ as y); z ])), _
6363
-> (
64-
match the_string_of ~target info y with
64+
match the_string_of info y with
6565
| Some s when Primitive.need_named_value s ->
6666
incr opt_count;
6767
Let (x, Prim (Extern prim, [ Pc (String s); z ]))
@@ -84,7 +84,7 @@ let specialize_instr opt_count ~target info i =
8484
Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a))
8585
| _ -> i)
8686
| Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), _ -> (
87-
match the_string_of ~target info m with
87+
match the_string_of info m with
8888
| Some m when Javascript.is_ident m -> (
8989
match the_block_contents_of info a with
9090
| Some a ->
@@ -118,7 +118,7 @@ let specialize_instr opt_count ~target info i =
118118
match the_def_of info (Pv x) with
119119
| Some (Block (_, [| k; v |], _, _)) ->
120120
let k =
121-
match the_string_of ~target info (Pv k) with
121+
match the_string_of info (Pv k) with
122122
| Some s when String.is_valid_utf_8 s ->
123123
Pc (NativeString (Native_string.of_string s))
124124
| Some _ | None -> raise Exit
@@ -133,32 +133,32 @@ let specialize_instr opt_count ~target info i =
133133
Let (x, Prim (Extern "%caml_js_opt_object", List.flatten (Array.to_list a)))
134134
with Exit -> i)
135135
| Let (x, Prim (Extern "caml_js_get", [ o; (Pv _ as f) ])), _ -> (
136-
match the_native_string_of ~target info f with
136+
match the_native_string_of info f with
137137
| Some s ->
138138
incr opt_count;
139139
Let (x, Prim (Extern "caml_js_get", [ o; Pc (NativeString s) ]))
140140
| _ -> i)
141141
| Let (x, Prim (Extern "caml_js_set", [ o; (Pv _ as f); v ])), _ -> (
142-
match the_native_string_of ~target info f with
142+
match the_native_string_of info f with
143143
| Some s ->
144144
incr opt_count;
145145
Let (x, Prim (Extern "caml_js_set", [ o; Pc (NativeString s); v ]))
146146
| _ -> i)
147147
| Let (x, Prim (Extern "caml_js_delete", [ o; (Pv _ as f) ])), _ -> (
148-
match the_native_string_of ~target info f with
148+
match the_native_string_of info f with
149149
| Some s ->
150150
incr opt_count;
151151
Let (x, Prim (Extern "caml_js_delete", [ o; Pc (NativeString s) ]))
152152
| _ -> i)
153153
| Let (x, Prim (Extern ("caml_jsstring_of_string" | "caml_js_from_string"), [ y ])), _
154154
-> (
155-
match the_string_of ~target info y with
155+
match the_string_of info y with
156156
| Some s when String.is_valid_utf_8 s ->
157157
incr opt_count;
158158
Let (x, Constant (NativeString (Native_string.of_string s)))
159159
| Some _ | None -> i)
160160
| Let (x, Prim (Extern "caml_jsbytes_of_string", [ y ])), _ -> (
161-
match the_string_of ~target info y with
161+
match the_string_of info y with
162162
| Some s ->
163163
incr opt_count;
164164
Let (x, Constant (NativeString (Native_string.of_bytestring s)))

0 commit comments

Comments
 (0)