diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2018-10-15 13:48:53 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-10-15 17:59:20 -0400 |
commit | c5b477c29127d8375b3f23d37f877278b52547f6 (patch) | |
tree | 25e3637d93edd9141cbc399be48d2da03b269f65 | |
parent | 26e81e90281685af37c8f2cf149c242b4039117a (diff) | |
download | haskell-c5b477c29127d8375b3f23d37f877278b52547f6.tar.gz |
Fix cardinality change of fields in addDataConStrictness
Test Plan: This validates
Reviewers: simonpj, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, carter
Differential Revision: https://phabricator.haskell.org/D5225
-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]) |