-----------------
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module DmdAnal ( dmdAnalPgm, dmdAnalTopRhs,
both {- needed by WwLib -}
) where
import Type ( isUnLiftedType, coreEqType, splitTyConApp_maybe )
import Coercion ( coercionKind )
import CoreLint ( showPass, endPass )
-import Util ( mapAndUnzip, mapAccumL, mapAccumR, lengthIs )
+import Util ( mapAndUnzip, lengthIs )
import BasicTypes ( Arity, TopLevelFlag(..), isTopLevel, isNeverActive,
RecFlag(..), isRec )
import Maybes ( orElse, expectJust )
import Outputable
+
+import Data.List
\end{code}
To think about
-- The insight is, of course, that a demand on y is a demand on the
-- scrutinee, so we need to `both` it with the scrut demand
- scrut_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isId b])
- `both`
+ alt_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isId b])
+ scrut_dmd = alt_dmd `both`
idNewDemandInfo case_bndr'
(scrut_ty, scrut') = dmdAnal sigs scrut_dmd scrut
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If the rhs is a thunk, we usually forget the CPR info, because
it is presumably shared (else it would have been inlined, and
-so we'd lose sharing if w/w'd it into a function.
+so we'd lose sharing if w/w'd it into a function). E.g.
+
+ let r = case expensive of
+ (a,b) -> (b,a)
+ in ...
+
+If we marked r as having the CPR property, then we'd w/w into
+
+ let $wr = \() -> case expensive of
+ (a,b) -> (# b, a #)
+ r = case $wr () of
+ (# b,a #) -> (b,a)
+ in ...
+
+But now r is a thunk, which won't be inlined, so we are no further ahead.
+But consider
+
+ f x = let r = case expensive of (a,b) -> (b,a)
+ in if foo r then r else (x,x)
+
+Does f have the CPR property? Well, no.
However, if the strictness analyser has figured out (in a previous
iteration) that it's strict, then we DON'T need to forget the CPR info.
lub (Box d1) (Box d2) = box (d1 `lub` d2)
lub d1@(Box _) d2 = d2 `lub` d1
-lubs = zipWithDmds lub
+lubs ds1 ds2 = zipWithDmds lub ds1 ds2
---------------------
-- box is the smart constructor for Box
both (Defer ds1) (Defer ds2) = deferEval (ds1 `boths` ds2)
both d1@(Defer ds1) d2 = d2 `both` d1
-boths = zipWithDmds both
+boths ds1 ds2 = zipWithDmds both ds1 ds2
\end{code}