diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-03-26 11:48:40 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-08 08:07:11 -0400 |
| commit | 42d88003b0815f4e975fd80e34422000c3100c6c (patch) | |
| tree | b3859084288575a66f52acf53546ceedec55f44b /compiler/GHC/Types/Demand.hs | |
| parent | 629a5e98b72e1643ef8eeabb700a7046a27a783a (diff) | |
| download | haskell-42d88003b0815f4e975fd80e34422000c3100c6c.tar.gz | |
Make sure result of demand analysis is forced promptly
This avoids a big spike in memory usage during demand analysis.
Part of fixing #15455
-------------------------
Metric Decrease:
T18698a
T18698b
T9233
T9675
T9961
-------------------------
Diffstat (limited to 'compiler/GHC/Types/Demand.hs')
| -rw-r--r-- | compiler/GHC/Types/Demand.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs index b4d9aa9384..84e5a9ac67 100644 --- a/compiler/GHC/Types/Demand.hs +++ b/compiler/GHC/Types/Demand.hs @@ -1118,9 +1118,9 @@ keepAliveDmdEnv env vs -- * Diverges on every code path or not ('dt_div') data DmdType = DmdType - { dt_env :: DmdEnv -- ^ Demand on explicitly-mentioned free variables - , dt_args :: [Demand] -- ^ Demand on arguments - , dt_div :: Divergence -- ^ Whether evaluation diverges. + { dt_env :: !DmdEnv -- ^ Demand on explicitly-mentioned free variables + , dt_args :: ![Demand] -- ^ Demand on arguments + , dt_div :: !Divergence -- ^ Whether evaluation diverges. -- See Note [Demand type Divergence] } @@ -1225,9 +1225,10 @@ peelFV :: DmdType -> Var -> (DmdType, Demand) peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv) (DmdType fv' ds res, dmd) where - fv' = fv `delVarEnv` id + -- Force these arguments so that old `Env` is not retained. + !fv' = fv `delVarEnv` id -- See Note [Default demand on free variables and arguments] - dmd = lookupVarEnv fv id `orElse` defaultFvDmd res + !dmd = lookupVarEnv fv id `orElse` defaultFvDmd res addDemand :: Demand -> DmdType -> DmdType addDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res |