diff options
| -rw-r--r-- | compiler/basicTypes/Demand.hs | 6 | ||||
| -rw-r--r-- | compiler/stranal/DmdAnal.hs | 2 |
2 files changed, 6 insertions, 2 deletions
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 071945386e..4707be798b 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -56,7 +56,7 @@ module Demand ( useCount, isUsedOnce, reuseEnv, killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig, - strictifyDictDmd + strictifyDictDmd, strictifyDmd ) where @@ -2033,6 +2033,10 @@ strictifyDictDmd ty dmd = case getUseDmd dmd of -- the superclass dicts are always a prefix _ -> dmd -- unused or not a dictionary +strictifyDmd :: Demand -> Demand +strictifyDmd dmd@(JD { sd = str }) + = dmd { sd = str `bothArgStr` Str VanStr HeadStr } + {- Note [HyperStr and Use demands] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index b606804079..995911939f 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -1222,7 +1222,7 @@ addDataConStrictness con ds where strs = dataConRepStrictness con add dmd str | isMarkedStrict str - , not (isAbsDmd dmd) = dmd `bothDmd` seqDmd + , not (isAbsDmd dmd) = strictifyDmd dmd | otherwise = dmd findBndrsDmds :: AnalEnv -> DmdType -> [Var] -> (DmdType, [Demand]) |