From 88bbc95a2509970ab1fe14145a6ed7d9a3421368 Mon Sep 17 00:00:00 2001 From: Guillaume Bury Date: Wed, 3 Jul 2024 17:41:31 +0200 Subject: [PATCH 1/5] Add tests --- .../tests/flambda/unboxing_finds_invalid1.ml | 35 +++++++++++++++++++ .../tests/flambda/unboxing_finds_invalid2.ml | 31 ++++++++++++++++ 2 files changed, 66 insertions(+) create mode 100644 ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml create mode 100644 ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml diff --git a/ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml new file mode 100644 index 00000000000..a4cef5452f6 --- /dev/null +++ b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml @@ -0,0 +1,35 @@ +(* TEST *) + +type _ foo = + | Int : int foo + | Float : float foo + +type _ bar = + | I : int -> int bar + | F : float -> float bar + +type t = T : 'a foo * 'a -> t + +let[@inline never] bar b = b + +(* In this test, `z` is not unboxed, but `x` is, and one of the calls to `foo` + (which are all continuations calls, givne the @local), can be found to be + invalid because of the unboxing (it is not found earlier because the `Int` + value is hidden thanks to `Sys.opaque_identity). + + In an early version of invalids during unboxing, there was a bug where in + such cases, there would be missing cases in the extra arguments computed + by the unboxing. *) +let test f g = + let[@local] foo (type a) z (x : a bar) = + match x with + | I i -> z i + | F f -> z (int_of_float f) + in + let aux = Sys.opaque_identity Int in + let t : t = T (aux, 0) in + match t with + | T (Int, i) -> foo f (I i) + | T (Float, f) -> foo g (F f) + + diff --git a/ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml new file mode 100644 index 00000000000..1fdecd61779 --- /dev/null +++ b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml @@ -0,0 +1,31 @@ +(* TEST *) + +type _ foo = + | Int : int foo + | Float : float foo + +type _ bar = + | I : int -> int bar + | F : float -> float bar + +type t = T : 'a foo * 'a -> t + +let[@inline never] bar b = b + +(* Here, both `b` and `x` are unboxed, and in an early version of + invalids during unboxing, this results in an overlap of rewrite id + between extra args computed for `b` and the invalids (which were found + when computing the extra args for `x`). *) +let test () = + let[@local] foo (type a) b (x : a bar) = + match x with + | I i -> if b then i else 0 + | F f -> if b then int_of_float f else 0 + in + let aux = Sys.opaque_identity Int in + let t : t = T (aux, 0) in + match t with + | T (Int, i) -> foo true (I i) + | T (Float, f) -> foo false (F f) + + From 3b7c521a7cc40c8ba3e876d892485ea3211b0ecf Mon Sep 17 00:00:00 2001 From: Guillaume Bury Date: Tue, 2 Jul 2024 13:31:14 +0200 Subject: [PATCH 2/5] More detailed error message --- .../continuation_extra_params_and_args.ml | 28 +++++++++++++++---- .../simplify/env/continuation_uses.ml | 3 ++ .../simplify/env/continuation_uses.mli | 2 ++ 3 files changed, 27 insertions(+), 6 deletions(-) diff --git a/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml b/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml index 6cf43eff1d8..2ef4f7d4b05 100644 --- a/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml +++ b/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml @@ -95,18 +95,34 @@ let add t ~invalids ~extra_param ~extra_args = let extra_params = Bound_parameters.cons extra_param extra_params in let extra_args = Apply_cont_rewrite_id.Map.merge - (fun id already_extra_args extra_args -> - match already_extra_args, extra_args with + (fun id already_extra_args extra_arg -> + match already_extra_args, extra_arg with | None, None -> None | None, Some _ -> - Misc.fatal_errorf "Cannot change domain: %a" - Apply_cont_rewrite_id.print id + Misc.fatal_errorf + "[Extra Params and Args] Unexpected New Apply_cont_rewrite_id \ + (%a) for:\n\ + new param: %a\n\ + new args: %a\n\ + new invalids: %a\n\ + existing epa: %a" Apply_cont_rewrite_id.print id + Bound_parameter.print extra_param + (Apply_cont_rewrite_id.Map.print Extra_arg.print) + extra_args Apply_cont_rewrite_id.Set.print invalids print t | Some _, None -> if Apply_cont_rewrite_id.Set.mem id invalids then Some Or_invalid.Invalid else - Misc.fatal_errorf "Cannot change domain: %a" - Apply_cont_rewrite_id.print id + Misc.fatal_errorf + "[Extra Params and Args] Existing Apply_cont_rewrite_id (%a) \ + missing for:\n\ + new param: %a\n\ + new args: %a\n\ + new invalids: %a\n\ + existing epa: %a" Apply_cont_rewrite_id.print id + Bound_parameter.print extra_param + (Apply_cont_rewrite_id.Map.print Extra_arg.print) + extra_args Apply_cont_rewrite_id.Set.print invalids print t | Some Or_invalid.Invalid, Some _ -> Some Or_invalid.Invalid | Some (Or_invalid.Ok already_extra_args), Some extra_arg -> Some (Or_invalid.Ok (extra_arg :: already_extra_args))) diff --git a/middle_end/flambda2/simplify/env/continuation_uses.ml b/middle_end/flambda2/simplify/env/continuation_uses.ml index 42cb5321859..2cbdf9e0884 100644 --- a/middle_end/flambda2/simplify/env/continuation_uses.ml +++ b/middle_end/flambda2/simplify/env/continuation_uses.ml @@ -76,6 +76,9 @@ type arg_at_use = type arg_types_by_use_id = arg_at_use Apply_cont_rewrite_id.Map.t list +let print_arg_type_at_use ppf { arg_type; typing_env = _ } = + Flambda2_types.print ppf arg_type + let add_value_to_arg_map arg_map arg_type ~use = let env_at_use = U.env_at_use use in let typing_env = DE.typing_env env_at_use in diff --git a/middle_end/flambda2/simplify/env/continuation_uses.mli b/middle_end/flambda2/simplify/env/continuation_uses.mli index 7af4f7591b6..87d98a420d8 100644 --- a/middle_end/flambda2/simplify/env/continuation_uses.mli +++ b/middle_end/flambda2/simplify/env/continuation_uses.mli @@ -42,6 +42,8 @@ type arg_at_use = private type arg_types_by_use_id = arg_at_use Apply_cont_rewrite_id.Map.t list +val print_arg_type_at_use : Format.formatter -> arg_at_use -> unit + val get_arg_types_by_use_id : t -> arg_types_by_use_id (* When we want to get the arg_types_by_use_id of the invariant params of a From 3c0d81152e1a1f4140fb1fd129d3d80644bd88e3 Mon Sep 17 00:00:00 2001 From: Guillaume Bury Date: Tue, 2 Jul 2024 18:12:59 +0200 Subject: [PATCH 3/5] Fix missing rewrite ids when unboxing detect invalid apply conts In some cases (e.g. a do_not_unbox decision, followed by a decision that does unbox, and that discovers that some apply conts are invalids), it could happen that the set of rewrite ids known as being invalid was dropped/reset to empty. That together with the caching of the extra args computsion (done through the rewrite ids seen) meant that we could "forget" some rewrite ids. --- .../flambda2/simplify/unboxing/unbox_continuation_params.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/middle_end/flambda2/simplify/unboxing/unbox_continuation_params.ml b/middle_end/flambda2/simplify/unboxing/unbox_continuation_params.ml index 1662f578a3c..b39209627b0 100644 --- a/middle_end/flambda2/simplify/unboxing/unbox_continuation_params.ml +++ b/middle_end/flambda2/simplify/unboxing/unbox_continuation_params.ml @@ -22,7 +22,7 @@ let refine_decision_based_on_arg_types_at_uses ~pass ~rewrite_ids_seen ~rewrites_ids_known_as_invalid nth_arg arg_type_by_use_id (decision : U.decision) = match decision with - | Do_not_unbox _ as decision -> decision, Apply_cont_rewrite_id.Set.empty + | Do_not_unbox _ as decision -> decision, rewrites_ids_known_as_invalid | Unbox _ as decision -> Apply_cont_rewrite_id.Map.fold (fun rewrite_id (arg_at_use : Continuation_uses.arg_at_use) From c37889edd73a2a3406717e505598e648285b22e8 Mon Sep 17 00:00:00 2001 From: Guillaume Bury Date: Wed, 3 Jul 2024 17:33:44 +0200 Subject: [PATCH 4/5] Allow overlap of invalid rewrite id and extra_args As the comment states, it can happen that, when adding a extra param and args, there is an overlap between the domain of the extra_args map, and the set of invalids (because of the way these are computed by the unboxing code). This case is reasonable, so in such a case, we can allow the invalid set to take precedenhce. --- .../continuation_extra_params_and_args.ml | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml b/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml index 2ef4f7d4b05..428984366cf 100644 --- a/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml +++ b/middle_end/flambda2/simplify/continuation_extra_params_and_args.ml @@ -65,18 +65,12 @@ let empty = Empty let is_empty = function Empty -> true | Non_empty _ -> false let add t ~invalids ~extra_param ~extra_args = - if not - (Apply_cont_rewrite_id.Set.is_empty - (Apply_cont_rewrite_id.Set.inter invalids - (Apply_cont_rewrite_id.Map.keys extra_args))) - then - Misc.fatal_errorf - "Broken invariants: when adding an extra param to a continuation, every \ - Apply_cont_rewrite_id should either have a valid extra arg, or be \ - invalid, but not both:@ %a@ %a" - Apply_cont_rewrite_id.Set.print invalids - (Apply_cont_rewrite_id.Map.print Extra_arg.print) - extra_args; + (* Note: there can be some overlap between the invalid ids and the keys of the + [extra_args] map. This is notably used by the unboxing code which may + compute some extra args and only later (when computing extra args for + another parameter) realize that some rewrite ids are invalids, and then + call this function with this new invalid set and the extra_args computed + before this invalid set was known. *) match t with | Empty -> let extra_params = Bound_parameters.create [extra_param] in @@ -96,6 +90,10 @@ let add t ~invalids ~extra_param ~extra_args = let extra_args = Apply_cont_rewrite_id.Map.merge (fun id already_extra_args extra_arg -> + (* The [invalids] set is expected to be small (actually, empty most of + the time), so the lookups in each case of the merge should be + reasonable, compared to merging (and allocating) the [invalids] set + and the [extra_args] map. *) match already_extra_args, extra_arg with | None, None -> None | None, Some _ -> @@ -125,7 +123,9 @@ let add t ~invalids ~extra_param ~extra_args = extra_args Apply_cont_rewrite_id.Set.print invalids print t | Some Or_invalid.Invalid, Some _ -> Some Or_invalid.Invalid | Some (Or_invalid.Ok already_extra_args), Some extra_arg -> - Some (Or_invalid.Ok (extra_arg :: already_extra_args))) + if Apply_cont_rewrite_id.Set.mem id invalids + then Some Or_invalid.Invalid + else Some (Or_invalid.Ok (extra_arg :: already_extra_args))) already_extra_args extra_args in Non_empty { extra_params; extra_args } From 627c2ffc70dbf148e6bb23296bcf9678a77a9c87 Mon Sep 17 00:00:00 2001 From: Guillaume Bury Date: Thu, 4 Jul 2024 14:00:57 +0200 Subject: [PATCH 5/5] Force tests to be compiled with O3 Although not strictly necessary for the tests to work, it's safer to ensure that they are optimized as expected --- ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml | 2 ++ ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml | 2 ++ 2 files changed, 4 insertions(+) diff --git a/ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml index a4cef5452f6..4bd900a0803 100644 --- a/ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml +++ b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid1.ml @@ -1,5 +1,7 @@ (* TEST *) +[@@@flambda_o3] + type _ foo = | Int : int foo | Float : float foo diff --git a/ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml index 1fdecd61779..b00c19bc6b5 100644 --- a/ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml +++ b/ocaml/testsuite/tests/flambda/unboxing_finds_invalid2.ml @@ -1,5 +1,7 @@ (* TEST *) +[@@@flambda_o3] + type _ foo = | Int : int foo | Float : float foo