Commit 42d88003 authored by Matthew Pickering's avatar Matthew Pickering Committed by Marge Bot

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
-------------------------
parent 629a5e98
This diff is collapsed.
......@@ -52,7 +52,7 @@ scaleUsage x Bottom = MUsage x
scaleUsage x (MUsage y) = MUsage $ mkMultMul x y
-- For now, we use extra multiplicity Bottom for empty case.
data UsageEnv = UsageEnv (NameEnv Mult) Bool
data UsageEnv = UsageEnv !(NameEnv Mult) Bool
unitUE :: NamedThing n => n -> Mult -> UsageEnv
unitUE x w = UsageEnv (unitNameEnv (getName x) w) False
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment