+\subsection{Demands}
+%* *
+%************************************************************************
+
+\begin{code}
+data Demand
+ = Top -- T; used for unlifted types too, so that
+ -- A `lub` T = T
+ | Abs -- A
+
+ | Call Demand -- C(d)
+
+ | Eval Demands -- U(ds)
+
+ | Defer Demands -- D(ds)
+
+ | Box Demand -- B(d)
+
+ | Bot -- B
+ deriving( Eq )
+ -- Equality needed for fixpoints in DmdAnal
+
+data Demands = Poly Demand -- Polymorphic case
+ | Prod [Demand] -- Product case
+ deriving( Eq )
+
+allTop (Poly d) = isTop d
+allTop (Prod ds) = all isTop ds
+
+isTop Top = True
+isTop d = False
+
+isAbsent Abs = True
+isAbsent d = False
+
+mapDmds :: (Demand -> Demand) -> Demands -> Demands
+mapDmds f (Poly d) = Poly (f d)
+mapDmds f (Prod ds) = Prod (map f ds)
+
+zipWithDmds :: (Demand -> Demand -> Demand)
+ -> Demands -> Demands -> Demands
+zipWithDmds f (Poly d1) (Poly d2) = Poly (d1 `f` d2)
+zipWithDmds f (Prod ds1) (Poly d2) = Prod [d1 `f` d2 | d1 <- ds1]
+zipWithDmds f (Poly d1) (Prod ds2) = Prod [d1 `f` d2 | d2 <- ds2]
+zipWithDmds f (Prod ds1) (Prod ds2) = Prod (zipWithEqual "zipWithDmds" f ds1 ds2)
+
+topDmd, lazyDmd, seqDmd :: Demand
+topDmd = Top -- The most uninformative demand
+lazyDmd = Box Abs
+seqDmd = Eval (Poly Abs) -- Polymorphic seq demand
+evalDmd = Box seqDmd -- Evaluate and return
+errDmd = Box Bot -- This used to be called X
+
+isStrictDmd :: Demand -> Bool
+isStrictDmd Bot = True
+isStrictDmd (Eval _) = True
+isStrictDmd (Call _) = True
+isStrictDmd (Box d) = isStrictDmd d
+isStrictDmd other = False
+
+seqDemand :: Demand -> ()
+seqDemand (Call d) = seqDemand d
+seqDemand (Eval ds) = seqDemands ds
+seqDemand (Defer ds) = seqDemands ds
+seqDemand (Box d) = seqDemand d
+seqDemand _ = ()
+
+seqDemands :: Demands -> ()
+seqDemands (Poly d) = seqDemand d
+seqDemands (Prod ds) = seqDemandList ds
+
+seqDemandList :: [Demand] -> ()
+seqDemandList [] = ()
+seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
+
+instance Outputable Demand where
+ ppr Top = char 'T'
+ ppr Abs = char 'A'
+ ppr Bot = char 'B'
+
+ ppr (Defer ds) = char 'D' <> ppr ds
+ ppr (Eval ds) = char 'U' <> ppr ds
+
+ ppr (Box (Eval ds)) = char 'S' <> ppr ds
+ ppr (Box Abs) = char 'L'
+ ppr (Box Bot) = char 'X'
+
+ ppr (Call d) = char 'C' <> parens (ppr d)
+
+
+instance Outputable Demands where
+ ppr (Poly Abs) = empty
+ ppr (Poly d) = parens (ppr d <> char '*')
+ ppr (Prod ds) = parens (hcat (map ppr ds))
+ -- At one time I printed U(AAA) as U, but that
+ -- confuses (Poly Abs) with (Prod AAA), and the
+ -- worker/wrapper generation differs slightly for these two
+ -- [Reason: in the latter case we can avoid passing the arg;
+ -- see notes with WwLib.mkWWstr_one.]
+\end{code}
+
+
+%************************************************************************
+%* *