import CoreSyn
import Rules ( RuleBase, pprRuleBase )
-import CoreFVs ( idFreeVars, mustHaveLocalBinding )
+import CoreFVs ( idFreeVars )
import CoreUtils ( exprOkForSpeculation, coreBindsSize, mkPiType )
import Bag
import Literal ( literalType )
import DataCon ( dataConRepType )
-import Var ( Var, Id, TyVar, idType, tyVarKind, isTyVar, isId )
+import Var ( Var, Id, TyVar, idType, tyVarKind, isTyVar, isId, mustHaveLocalBinding )
import VarSet
import Subst ( mkTyVarSubst, substTy )
import Name ( getSrcLoc )
import PprCore
-import ErrUtils ( doIfSet_dyn, dumpIfSet, ghcExit, Message, showPass,
+import ErrUtils ( doIfSet, dumpIfSet_core, ghcExit, Message, showPass,
ErrMsg, addErrLocHdrLine, pprBagOfErrors,
WarnMsg, pprBagOfWarnings)
import SrcLoc ( SrcLoc, noSrcLoc )
and do Core Lint when necessary.
\begin{code}
-endPass :: DynFlags -> String -> Bool -> [CoreBind] -> IO [CoreBind]
+endPass :: DynFlags -> String -> DynFlag -> [CoreBind] -> IO [CoreBind]
endPass dflags pass_name dump_flag binds
= do
(binds, _) <- endPassWithRules dflags pass_name dump_flag binds Nothing
return binds
-endPassWithRules :: DynFlags -> String -> Bool -> [CoreBind] -> Maybe RuleBase
+endPassWithRules :: DynFlags -> String -> DynFlag -> [CoreBind]
+ -> Maybe RuleBase
-> IO ([CoreBind], Maybe RuleBase)
endPassWithRules dflags pass_name dump_flag binds rules
= do
-- Report result size if required
-- This has the side effect of forcing the intermediate to be evaluated
- if dopt Opt_D_show_passes dflags then
+ if verbosity dflags >= 2 then
hPutStrLn stdout (" Result size = " ++ show (coreBindsSize binds))
else
return ()
-- Report verbosely, if required
- dumpIfSet dump_flag pass_name
+ dumpIfSet_core dflags dump_flag pass_name
(pprCoreBindings binds $$ case rules of
Nothing -> empty
Just rb -> pprRuleBase rb)
returnL ()
lint_bind (NonRec bndr rhs) = lintSingleBinding NonRecursive (bndr,rhs)
- done_lint = doIfSet_dyn dflags Opt_D_show_passes
+ done_lint = doIfSet (verbosity dflags >= 2)
(hPutStr stdout ("*** Core Linted result of " ++ whoDunnit ++ "\n"))
warn warnings
= vcat [