Skip to content

Flow.the_const_of: allow to use different comparison functions #1965

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
May 6, 2025
Merged

Flow.the_const_of: allow to use different comparison functions #1965

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
b7a412e
Flow.the_const_of: allow to use different comparison functions
vouillon Apr 29, 2025
7bd99be
CR
vouillon May 6, 2025
f57c8f7
Changes
vouillon May 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
* Compiler: use a Wasm text files preprocessor (#1822)
* Compiler: support for OCaml 4.14.3+trunk (#1844)
* Compiler: optimize compilation of switches
* Compiler: evaluate statically more primitives (#1915)
* Compiler: evaluate statically more primitives (#1912, #1915, #1965)
* Runtime: use es6 class (#1840)
* Runtime: support more Unix functions (#1829)
* Runtime: remove polyfill for Map to simplify MlObjectTable implementation (#1846)
Expand All @@ -24,7 +24,6 @@
* Ppx: allow "function" in object literals (#1897)
* Lib: make the Wasm version of Json.output work with native ints and JavaScript objects (#1872)
* Compiler: add the `--empty-sourcemap` flag
* Compiler: static evaluation of more primitives (#1912)
* Compiler: faster compilation by stopping sooner when optimizations become unproductive (#1939)
* Compiler: improve debug/sourcemap location of closures (#1947)
* Compiler: improve tailcall optimization (#1943)
Expand Down
35 changes: 32 additions & 3 deletions compiler/lib/eval.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ]
Expand All @@ -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 ]
Expand Down Expand Up @@ -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
Expand Down
70 changes: 27 additions & 43 deletions compiler/lib/flow.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -352,61 +352,38 @@ let the_def_of info x =
match info.info_defs.(Var.idx x) with
| Expr (Constant (Float _ | Int _ | NativeString _) as e) -> Some e
| Expr (Constant (Int32 _ | NativeInt _) as e) -> Some e
| Expr (Constant (String _) as e) when Config.Flag.safe_string () -> Some e
| Expr (Constant _ as e) when Config.Flag.safe_string () -> Some e
| Expr e -> if Var.ISet.mem info.info_possibly_mutable x then None else Some e
| _ -> None)
None
(fun _ _ -> None)
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 _
| Float_array _ ) as c)) -> Some c
| Expr (Constant (String _ as c))
when not (Var.ISet.mem info.info_possibly_mutable x) -> Some c
| Expr (Constant c) when Config.Flag.safe_string () -> 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
Expand All @@ -429,13 +406,20 @@ 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 string_equal a b =
match a, b with
| NativeString a, NativeString b -> Native_string.equal a b
| String a, String b -> String.equal a b
(* We don't need to compare other constants, so let's just return false. *)
| _ -> false

let the_string_of info x =
match the_const_of ~eq:string_equal 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:string_equal info x with
| Some (NativeString i) -> Some i
| Some (String i) ->
(* This function is used to optimize the primitives that access
Expand Down
11 changes: 6 additions & 5 deletions compiler/lib/flow.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
22 changes: 11 additions & 11 deletions compiler/lib/specialize_js.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ]))
Expand All @@ -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 ->
Expand Down Expand Up @@ -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
Expand All @@ -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)))
Expand Down
Loading