constructed product result}
\begin{code}
+#ifndef OLD_STRICTNESS
+module CprAnalyse ( ) where
+
+#else
+
module CprAnalyse ( cprAnalyse ) where
#include "HsVersions.h"
-import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
+import CmdLineOpts ( DynFlags, DynFlag(..) )
import CoreLint ( showPass, endPass )
import CoreSyn
import CoreUtils ( exprIsValue )
import Id ( Id, setIdCprInfo, idCprInfo, idArity,
- isBottomingId, idDemandInfo )
+ isBottomingId, idDemandInfo, isImplicitId )
import IdInfo ( CprInfo(..) )
import Demand ( isStrict )
import VarEnv
-- we could use appropriate Tuple Vals
deriving (Eq,Show)
-isFun :: AbsVal -> Bool
-isFun (Fun _) = True
-isFun _ = False
-
-- For pretty debugging
instance Outputable AbsVal where
ppr Top = ptext SLIT("Top")
showPass dflags "Constructed Product analysis" ;
let { binds_plus_cpr = do_prog binds } ;
endPass dflags "Constructed Product analysis"
- (dopt Opt_D_dump_cpranal dflags || dopt Opt_D_verbose_core2core dflags)
- binds_plus_cpr
+ Opt_D_dump_cpranal binds_plus_cpr
}
where
do_prog :: [CoreBind] -> [CoreBind]
-- Return environment extended with info from this binding
cprAnalBind :: CPREnv -> CoreBind -> (CPREnv, CoreBind)
cprAnalBind rho (NonRec b e)
+ | isImplicitId b -- Don't touch the CPR info on constructors, selectors etc
+ = (rho, NonRec b e)
+ | otherwise
= (extendVarEnv rho b absval, NonRec b' e')
where
(e', absval) = cprAnalExpr rho e
arity = idArity v
-- Imported (non-nullary) constructors will have the CPR property
-- in their IdInfo, so no need to look at their unfolding
+#endif /* OLD_STRICTNESS */
\end{code}