constructed product result}
\begin{code}
+#ifndef OLD_STRICTNESS
+module CprAnalyse ( ) where
+
+#else
+
module CprAnalyse ( cprAnalyse ) where
#include "HsVersions.h"
-import CmdLineOpts ( DynFlags, DynFlag(..) )
+import DynFlags ( DynFlags, DynFlag(..) )
import CoreLint ( showPass, endPass )
import CoreSyn
-import CoreUtils ( exprIsValue )
+import CoreUtils ( exprIsHNF )
import Id ( Id, setIdCprInfo, idCprInfo, idArity,
isBottomingId, idDemandInfo, isImplicitId )
import IdInfo ( CprInfo(..) )
\begin{code}
cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
-#ifndef DEBUG
--- Omit unless DEBUG is on
-cprAnalyse dflags binds = return binds
-
-#else
cprAnalyse dflags binds
= do {
showPass dflags "Constructed Product analysis" ;
cprAnalCaseAlts :: CPREnv -> [CoreAlt] -> ([CoreAlt], AbsVal)
cprAnalCaseAlts rho alts
- = foldl anal_alt ([], Bot) alts
+ = foldr anal_alt ([], Bot) alts
where
- anal_alt :: ([CoreAlt], AbsVal) -> CoreAlt -> ([CoreAlt], AbsVal)
- anal_alt (done, aval) (con, binds, exp)
- = (done ++ [(con,binds,exp_cpr)], aval `lub` exp_aval)
+ anal_alt :: CoreAlt -> ([CoreAlt], AbsVal) -> ([CoreAlt], AbsVal)
+ anal_alt (con, binds, exp) (done, aval)
+ = ((con,binds,exp_cpr) : done, exp_aval `lub` aval)
where (exp_cpr, exp_aval) = cprAnalExpr rho' exp
rho' = rho `extendVarEnvList` (zip binds (repeat Top))
Fun _ -> idArity bndr >= n_fun_tys absval
-- Enough visible lambdas
- Tuple -> exprIsValue rhs || isStrict (idDemandInfo bndr)
+ Tuple -> exprIsHNF rhs || isStrict (idDemandInfo bndr)
-- If the rhs is a value, and returns a constructed product,
-- it will be inlined at usage sites, so we give it a Tuple absval
-- If it isn't a value, we won't inline it (code/work dup worries), so
arity = idArity v
-- Imported (non-nullary) constructors will have the CPR property
-- in their IdInfo, so no need to look at their unfolding
-#endif /* DEBUG */
+#endif /* OLD_STRICTNESS */
\end{code}