115 lines
4.0 KiB
Diff
115 lines
4.0 KiB
Diff
From acdc441ff1acb5390467e649bc9a9bfddd7df774 Mon Sep 17 00:00:00 2001
|
|
From: Florian Weimer <fweimer@redhat.com>
|
|
Date: Thu, 9 May 2024 10:03:23 +0200
|
|
Subject: [PATCH 5/7] flambda: Improve transitive closure in
|
|
invariant_params_in_recursion (#13150)
|
|
|
|
The old implementation did not really exploit the sparseness of the
|
|
graph because it used newly discovered edges in later iterations.
|
|
The new implementation processes each original relation only once
|
|
per starting node, and does not re-process newly discovered relations.
|
|
|
|
(cherry picked from commit 787b4fbb5aaf3728de54ca240ba9ca0bf56ace60)
|
|
---
|
|
Changes | 5 ++
|
|
middle_end/flambda/invariant_params.ml | 66 ++++++++++----------------
|
|
2 files changed, 31 insertions(+), 40 deletions(-)
|
|
|
|
diff --git a/Changes b/Changes
|
|
index 75842fc216..d26512067d 100644
|
|
--- a/Changes
|
|
+++ b/Changes
|
|
@@ -1,6 +1,11 @@
|
|
OCaml 5.2.0 (13 May 2024)
|
|
-------------------------
|
|
|
|
+- #13150: improve a transitive-closure computation algorithm in the flambda
|
|
+ middle-end to avoid a compilation time blowup on Menhir-generated code
|
|
+ (Florian Weimer, review by Gabriel Scherer and Pierre Chambart,
|
|
+ report by Richard Jones)
|
|
+
|
|
(Changes that can break existing programs are marked with a "*")
|
|
|
|
### Restored and new backends:
|
|
diff --git a/middle_end/flambda/invariant_params.ml b/middle_end/flambda/invariant_params.ml
|
|
index 414d39310a..dba63970fd 100644
|
|
--- a/middle_end/flambda/invariant_params.ml
|
|
+++ b/middle_end/flambda/invariant_params.ml
|
|
@@ -65,47 +65,33 @@ let implies relation from to_ =
|
|
relation
|
|
|
|
let transitive_closure state =
|
|
- let union s1 s2 =
|
|
- match s1, s2 with
|
|
- | Top, _ | _, Top -> Top
|
|
- | Implication s1, Implication s2 ->
|
|
- Implication (Variable.Pair.Set.union s1 s2)
|
|
+ (* Depth-first search for all implications for one argument.
|
|
+ Arguments are moved from candidate to frontier, assuming
|
|
+ they are newly added to the result. *)
|
|
+ let rec loop candidate frontier result =
|
|
+ match (candidate, frontier) with
|
|
+ | ([], []) -> Implication result
|
|
+ | ([], frontier::fs) ->
|
|
+ (* Obtain fresh candidate for the frontier argument. *)
|
|
+ (match Variable.Pair.Map.find frontier state with
|
|
+ | exception Not_found -> loop [] fs result
|
|
+ | Top -> Top
|
|
+ | Implication candidate ->
|
|
+ loop (Variable.Pair.Set.elements candidate) fs result)
|
|
+ | (candidate::cs, frontier) ->
|
|
+ let result' = Variable.Pair.Set.add candidate result in
|
|
+ if result' != result then
|
|
+ (* Result change means candidate becomes part of frontier. *)
|
|
+ loop cs (candidate :: frontier) result'
|
|
+ else
|
|
+ loop cs frontier result
|
|
in
|
|
- let equal s1 s2 =
|
|
- match s1, s2 with
|
|
- | Top, Implication _ | Implication _, Top -> false
|
|
- | Top, Top -> true
|
|
- | Implication s1, Implication s2 -> Variable.Pair.Set.equal s1 s2
|
|
- in
|
|
- let update arg state =
|
|
- let original_set =
|
|
- try Variable.Pair.Map.find arg state with
|
|
- | Not_found -> Implication Variable.Pair.Set.empty
|
|
- in
|
|
- match original_set with
|
|
- | Top -> state
|
|
- | Implication arguments ->
|
|
- let set =
|
|
- Variable.Pair.Set.fold
|
|
- (fun orig acc->
|
|
- let set =
|
|
- try Variable.Pair.Map.find orig state with
|
|
- | Not_found -> Implication Variable.Pair.Set.empty in
|
|
- union set acc)
|
|
- arguments original_set
|
|
- in
|
|
- Variable.Pair.Map.add arg set state
|
|
- in
|
|
- let once state =
|
|
- Variable.Pair.Map.fold (fun arg _ state -> update arg state) state state
|
|
- in
|
|
- let rec fp state =
|
|
- let state' = once state in
|
|
- if Variable.Pair.Map.equal equal state state'
|
|
- then state
|
|
- else fp state'
|
|
- in
|
|
- fp state
|
|
+ Variable.Pair.Map.map
|
|
+ (fun set ->
|
|
+ match set with
|
|
+ | Top -> Top
|
|
+ | Implication set -> loop [] (Variable.Pair.Set.elements set) set)
|
|
+ state
|
|
|
|
(* CR-soon pchambart: to move to Flambda_utils and document
|
|
mshinwell: I think this calculation is basically the same as
|
|
--
|
|
2.44.0
|
|
|