Semantique analyser) was written by Andy Gill.
\begin{code}
+#ifndef OLD_STRICTNESS
+module StrictAnal ( ) where
+
+#else
+
module StrictAnal ( saBinds ) where
#include "HsVersions.h"
-import CmdLineOpts ( DynFlags, DynFlag(..) )
+import DynFlags ( DynFlags, DynFlag(..) )
import CoreSyn
import Id ( setIdStrictness, setInlinePragma,
idDemandInfo, setIdDemandInfo, isBottomingId,
Id
)
-import IdInfo ( neverInlinePrag )
import CoreLint ( showPass, endPass )
import ErrUtils ( dumpIfSet_dyn )
import SaAbsInt
import SaLib
import Demand ( Demand, wwStrict, isStrict, isLazy )
-import Util ( zipWith3Equal, stretchZipWith )
+import Util ( zipWith3Equal, stretchZipWith, compareLength )
+import BasicTypes ( Activation( NeverActive ) )
import Outputable
import FastTypes
\end{code}
\begin{code}
saBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
-#ifndef DEBUG
--- Omit strictness analyser if DEBUG is off
-
-saBinds dflags binds = return binds
-
-#else
saBinds dflags binds
= do {
showPass dflags "Strictness analysis";
-- This avoids fruitless inlining of top level error functions
addStrictnessInfoToTopId str_val abs_val bndr
= if isBottomingId new_id then
- new_id `setInlinePragma` neverInlinePrag
+ new_id `setInlinePragma` NeverActive
else
new_id
where
where
arg_dmds = case fun of
Var var -> case lookupAbsValEnv str_env var of
- Just (AbsApproxFun ds _) | length ds >= length args
+ Just (AbsApproxFun ds _)
+ | compareLength ds args /= LT
+ -- 'ds' is at least as long as 'args'.
-> ds ++ minDemands
other -> minDemands
other -> minDemands
ptext SLIT("; Let vars: "), int (iBox dlet), char '/', int (iBox tlet)
]
-#else {-OMIT_STRANAL_STATS-}
+#else /* OMIT_STRANAL_STATS */
-- identity monad
type SaM a = a
tickCases vars = panic "OMIT_STRANAL_STATS: tickCases"
tickLet var = panic "OMIT_STRANAL_STATS: tickLet"
-#endif {-OMIT_STRANAL_STATS-}
+#endif /* OMIT_STRANAL_STATS */
mapSa :: (a -> SaM b) -> [a] -> SaM [b]
sequenceSa (m:ms) = m `thenSa` \ r ->
sequenceSa ms `thenSa` \ rs ->
returnSa (r:rs)
-#endif /* DEBUG */
+
+#endif /* OLD_STRICTNESS */
\end{code}