[project @ 2000-12-06 13:03:28 by simonmar]

[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreLint.lhs

diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs
index 5a0c140..cbcfb56 100644 (file)
--- a/ghc/compiler/coreSyn/CoreLint.lhs
+++ b/ghc/compiler/coreSyn/CoreLint.lhs
@@ -27,7 +27,7 @@ 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 )
@@ -58,13 +58,14 @@ place for them.  They print out stuff before and after core passes,
 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 
@@ -72,13 +73,13 @@ endPassWithRules dflags pass_name dump_flag binds rules
 
        -- 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)
@@ -148,7 +149,7 @@ lintCoreBindings dflags whoDunnit binds
                                  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 [