diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-08-10 09:16:43 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2022-08-18 15:18:28 +0100 |
| commit | 1f968018733e6afefd623c0f87c0460c6c035292 (patch) | |
| tree | f0ab028bee96fad049eaab0ac7298cb23e910eef | |
| parent | 93d379a1e436302034cb9baa2686fcf1baa97c58 (diff) | |
| download | haskell-wip/unfolding-leaks.tar.gz | |
Force unfoldings when they are cleaned-up in Tidy and CorePrepwip/unfolding-leaks
If these thunks are not forced then the entire unfolding for the binding
is live throughout the whole of CodeGen despite the fact it should have
been discarded.
Fixes #22071
| -rw-r--r-- | compiler/GHC/CoreToStg/Prep.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Tidy.hs | 6 |
2 files changed, 7 insertions, 3 deletions
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index 6f02d8e3a2..2405a2feda 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -2153,7 +2153,9 @@ cpCloneBndr env bndr -- Drop (now-useless) rules/unfoldings -- See Note [Drop unfoldings and rules] -- and Note [Preserve evaluatedness] in GHC.Core.Tidy - ; let unfolding' = trimUnfolding (realIdUnfolding bndr) + -- And force it.. otherwise the old unfolding is just retained. + -- See #22071 + ; let !unfolding' = trimUnfolding (realIdUnfolding bndr) -- Simplifier will set the Id's unfolding bndr'' = bndr' `setIdUnfolding` unfolding' diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs index 5f22f0275a..92e7e3c0df 100644 --- a/compiler/GHC/Iface/Tidy.hs +++ b/compiler/GHC/Iface/Tidy.hs @@ -1292,12 +1292,14 @@ tidyTopIdInfo uf_opts rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unf --------- Unfolding ------------ unf_info = realUnfoldingInfo idinfo - unfold_info + -- Force this, otherwise the old unfolding is retained over code generation + -- See #22071 + !unfold_info | isCompulsoryUnfolding unf_info || show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs | otherwise = minimal_unfold_info - minimal_unfold_info = trimUnfolding unf_info + !minimal_unfold_info = trimUnfolding unf_info unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or |