\section[SaAbsInt]{Abstract interpreter for strictness analysis}
\begin{code}
-#ifndef DEBUG
--- If DEBUG is off, omit all exports
+#ifndef OLD_STRICTNESS
+-- If OLD_STRICTNESS is off, omit all exports
module SaAbsInt () where
#else
fixpoint,
isBot
) where
-#endif /* DEBUG */
+
#include "HsVersions.h"
-import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict )
+import StaticFlags ( opt_AllStrict, opt_NumbersStrict )
import CoreSyn
import CoreUnfold ( maybeUnfoldingTemplate )
-import Id ( Id, idType, idStrictness, idUnfolding, isDataConId_maybe )
+import Id ( Id, idType, idUnfolding, isDataConWorkId_maybe,
+ idStrictness,
+ )
import DataCon ( dataConTyCon, splitProductType_maybe, dataConRepArgTys )
import IdInfo ( StrictnessInfo(..) )
import Demand ( Demand(..), wwPrim, wwStrict, wwUnpack, wwLazy,
isUnLiftedType, Type )
import TyCon ( tyConUnique )
import PrelInfo ( numericTyKeys )
-import Util ( isIn, nOfThem, zipWithEqual )
+import Util ( isIn, nOfThem, zipWithEqual, equalLength )
import Outputable
\end{code}
AbsTop -> False
AbsBot -> True
AbsProd vals
- | length vals /= length demand_info -> pprTrace "TELL SIMON: evalStrictness" (ppr demand_info $$ ppr val)
+ | not (equalLength vals demand_info) -> pprTrace "TELL SIMON: evalStrictness" (ppr demand_info $$ ppr val)
False
| otherwise -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
AbsTop -> False -- No poison in here
AbsBot -> True -- Pure poison
AbsProd vals
- | length vals /= length demand_info -> pprTrace "TELL SIMON: evalAbsence" (ppr demand_info $$ ppr val)
+ | not (equalLength vals demand_info) -> pprTrace "TELL SIMON: evalAbsence" (ppr demand_info $$ ppr val)
True
| otherwise -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
_ -> pprTrace "TELL SIMON: evalAbsence"
absId anal var env
= case (lookupAbsValEnv env var,
- isDataConId_maybe var,
+ isDataConWorkId_maybe var,
idStrictness var,
maybeUnfoldingTemplate (idUnfolding var)) of
-- type; so the constructor in this alternative must be the right one
-- so we can go ahead and bind the constructor args to the components
-- of the product value.
- ASSERT(length arg_vals == length val_bndrs)
+ ASSERT(equalLength arg_vals val_bndrs)
absEval anal rhs rhs_env
where
val_bndrs = filter isId bndrs
NB: despite only having a two-point domain, we may still have many
iterations, because there are several variables involved at once.
+
+\begin{code}
+#endif /* OLD_STRICTNESS */
+\end{code}