summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core/Opt/DmdAnal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Core/Opt/DmdAnal.hs')
-rw-r--r--compiler/GHC/Core/Opt/DmdAnal.hs12
1 files changed, 7 insertions, 5 deletions
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index 4869fb1fa9..ae8aab18a8 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -233,9 +233,10 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(alt, bndrs, rhs)])
(rhs_ty, rhs') = dmdAnal env dmd rhs
(alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs
(alt_ty2, case_bndr_dmd) = findBndrDmd env False alt_ty1 case_bndr
- -- Evaluation cardinality on the case binder is irrelevant and a no-op.
- -- What matters is its nested sub-demand!
- (_ :* case_bndr_sd) = case_bndr_dmd
+ -- The peelDmd below will lazify the relative sub-demands if the
+ -- case_bndr_dmd had lazy evaluation cardinality.
+ -- See Note [Absent sub-demand] in GHC.Types.Demand
+ case_bndr_sd = peelDmd case_bndr_dmd
-- Compute demand on the scrutinee
(bndrs', scrut_sd)
| DataAlt _ <- alt
@@ -388,9 +389,10 @@ dmdAnalSumAlt :: AnalEnv -> SubDemand -> Id -> Alt Var -> (DmdType, Alt Var)
dmdAnalSumAlt env dmd case_bndr (con,bndrs,rhs)
| (rhs_ty, rhs') <- dmdAnal env dmd rhs
, (alt_ty, dmds) <- findBndrsDmds env rhs_ty bndrs
- , let (_ :* case_bndr_sd) = findIdDemand alt_ty case_bndr
+ , let case_bndr_dmd = findIdDemand alt_ty case_bndr
-- See Note [Demand on scrutinee of a product case]
- id_dmds = addCaseBndrDmd case_bndr_sd dmds
+ -- See Note [Absent sub-demand] in GHC.Types.Demand
+ id_dmds = addCaseBndrDmd (peelDmd case_bndr_dmd) dmds
= (alt_ty, (con, setBndrsDemandInfo bndrs id_dmds, rhs'))
{-