(deferType lam_ty, Lam var' body')
dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)])
- | let tycon = dataConTyCon dc,
- isProductTyCon tycon,
- not (isRecursiveTyCon tycon)
+ | let tycon = dataConTyCon dc
+ , isProductTyCon tycon
+ , not (isRecursiveTyCon tycon)
= let
sigs_alt = extendSigEnv NotTopLevel sigs case_bndr case_bndr_sig
(alt_ty, alt') = dmdAnalAlt sigs_alt dmd alt
both Abs d2 = d2
+-- Note [Bottom demands]
both Bot Bot = Bot
both Bot Abs = Bot
both Bot (Eval ds) = Eval (mapDmds (`both` Bot) ds)
- -- Consider
- -- f x = error x
- -- From 'error' itself we get demand Bot on x
- -- From the arg demand on x we get
- -- x :-> evalDmd = Box (Eval (Poly Abs))
- -- So we get Bot `both` Box (Eval (Poly Abs))
- -- = Seq Keep (Poly Bot)
- --
- -- Consider also
- -- f x = if ... then error (fst x) else fst x
- -- Then we get (Eval (Box Bot, Bot) `lub` Eval (SA))
- -- = Eval (SA)
- -- which is what we want.
+both Bot (Defer ds) = Eval (mapDmds (`both` Bot) ds)
both Bot d = errDmd
both Top Bot = errDmd
boths ds1 ds2 = zipWithDmds both ds1 ds2
\end{code}
+
+Note [Bottom demands]
+~~~~~~~~~~~~~~~~~~~~~
+Consider
+ f x = error x
+From 'error' itself we get demand Bot on x
+From the arg demand on x we get
+ x :-> evalDmd = Box (Eval (Poly Abs))
+So we get Bot `both` Box (Eval (Poly Abs))
+ = Seq Keep (Poly Bot)
+
+Consider also
+ f x = if ... then error (fst x) else fst x
+Then we get (Eval (Box Bot, Bot) `lub` Eval (SA))
+ = Eval (SA)
+which is what we want.
+
+Consider also
+ f x = error [fst x]
+Then we get
+ x :-> Bot `both` Defer [SA]
+and we want the Bot demand to cancel out the Defer
+so that we get Eval [SA]. Otherwise we'd have the odd
+situation that
+ f x = error (fst x) -- Strictness U(SA)b
+ g x = error ('y':fst x) -- Strictness Tb
+