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(..), dopt )
+import DynFlags ( DynFlags, DynFlag(..) )
import CoreSyn
import Id ( setIdStrictness, setInlinePragma,
idDemandInfo, setIdDemandInfo, isBottomingId,
Id
)
-import IdInfo ( neverInlinePrag )
-import CoreLint ( beginPass, endPass )
+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]
-
saBinds dflags binds
= do {
- beginPass dflags "Strictness analysis";
+ showPass dflags "Strictness analysis";
-- Mark each binder with its strictness
#ifndef OMIT_STRANAL_STATS
let { binds_w_strictness = saTopBindsBinds binds };
#endif
- endPass dflags "Strictness analysis"
- (dopt Opt_D_dump_stranal dflags || dopt Opt_D_verbose_core2core dflags)
+ endPass dflags "Strictness analysis" Opt_D_dump_stranal
binds_w_strictness
}
\end{code}
-- 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 /* OLD_STRICTNESS */
\end{code}