summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core/Tidy.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2022-08-26 12:16:01 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2022-08-26 16:36:09 +0100
commit4945953823620b223a0b51b2b1275a1de8f4a851 (patch)
treed5e86a5b9c9fb63d643cb2e7d308ae85ad47f427 /compiler/GHC/Core/Tidy.hs
parent6b47aa1cc87426db4fe7d805af69894de05780ff (diff)
downloadhaskell-wip/T22112.tar.gz
Fix a nasty loop in Tidywip/T22112
As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes]
Diffstat (limited to 'compiler/GHC/Core/Tidy.hs')
-rw-r--r--compiler/GHC/Core/Tidy.hs37
1 files changed, 20 insertions, 17 deletions
diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index d3cface58c..3a73ce7dd5 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/compiler/GHC/Core/Tidy.hs
@@ -10,7 +10,7 @@ The code for *top-level* bindings is in GHC.Iface.Tidy.
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Core.Tidy (
- tidyExpr, tidyRules, tidyUnfolding, tidyCbvInfoTop
+ tidyExpr, tidyRules, tidyCbvInfoTop, tidyBndrs
) where
import GHC.Prelude
@@ -360,33 +360,36 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id
`setUnfoldingInfo` new_unf
old_unf = realUnfoldingInfo old_info
- new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
- | otherwise = trimUnfolding old_unf
- -- See Note [Preserve evaluatedness]
+ new_unf = tidyNestedUnfolding rec_tidy_env old_unf
in
((tidy_env', var_env'), id') }
------------ Unfolding --------------
-tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
-tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
+tidyNestedUnfolding :: TidyEnv -> Unfolding -> Unfolding
+tidyNestedUnfolding _ NoUnfolding = NoUnfolding
+tidyNestedUnfolding _ BootUnfolding = BootUnfolding
+tidyNestedUnfolding _ (OtherCon {}) = evaldUnfolding
+
+tidyNestedUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args })
= df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
where
(tidy_env', bndrs') = tidyBndrs tidy_env bndrs
-tidyUnfolding tidy_env
- unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
- unf_from_rhs
+tidyNestedUnfolding tidy_env
+ unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_is_value = is_value })
| isStableSource src
= seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo
- -- This seqIt avoids a space leak: otherwise the uf_is_value,
- -- uf_is_conlike, ... fields may retain a reference to the
- -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them)
-
- | otherwise
- = unf_from_rhs
- where seqIt unf = seqUnfolding unf `seq` unf
-tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon
+ -- This seqIt avoids a space leak: otherwise the uf_is_value,
+ -- uf_is_conlike, ... fields may retain a reference to the
+ -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them)
+
+ -- Discard unstable unfoldings, but see Note [Preserve evaluatedness]
+ | is_value = evaldUnfolding
+ | otherwise = noUnfolding
+
+ where
+ seqIt unf = seqUnfolding unf `seq` unf
{-
Note [Tidy IdInfo]