projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2003-05-28 12:10:43 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
0ed2a1c
..
5915c2b
100644
(file)
--- a/
ghc/compiler/coreSyn/CoreLint.lhs
+++ b/
ghc/compiler/coreSyn/CoreLint.lhs
@@
-12,8
+12,6
@@
module CoreLint (
#include "HsVersions.h"
#include "HsVersions.h"
-import IO ( hPutStr, hPutStrLn, stdout )
-
import CoreSyn
import CoreFVs ( idFreeVars )
import CoreUtils ( findDefault, exprOkForSpeculation, coreBindsSize, mkPiType )
import CoreSyn
import CoreFVs ( idFreeVars )
import CoreUtils ( findDefault, exprOkForSpeculation, coreBindsSize, mkPiType )
@@
-26,7
+24,7
@@
import VarSet
import Subst ( substTyWith )
import Name ( getSrcLoc )
import PprCore
import Subst ( substTyWith )
import Name ( getSrcLoc )
import PprCore
-import ErrUtils ( doIfSet, dumpIfSet_core, ghcExit, Message, showPass,
+import ErrUtils ( dumpIfSet_core, ghcExit, Message, showPass,
addErrLocHdrLine )
import SrcLoc ( SrcLoc, noSrcLoc )
import Type ( Type, tyVarsOfType, eqType,
addErrLocHdrLine )
import SrcLoc ( SrcLoc, noSrcLoc )
import Type ( Type, tyVarsOfType, eqType,
@@
-39,10
+37,15
@@
import Type ( Type, tyVarsOfType, eqType,
import TyCon ( isPrimTyCon )
import BasicTypes ( RecFlag(..), isNonRec )
import CmdLineOpts
import TyCon ( isPrimTyCon )
import BasicTypes ( RecFlag(..), isNonRec )
import CmdLineOpts
-import Maybe
-import Util ( notNull )
import Outputable
import Outputable
+#ifdef DEBUG
+import Util ( notNull )
+#endif
+
+import Maybe
+import IO ( hPutStrLn, stderr )
+
infixr 9 `thenL`, `seqL`
\end{code}
infixr 9 `thenL`, `seqL`
\end{code}
@@
-63,7
+66,7
@@
endPass dflags pass_name dump_flag binds
-- Report result size if required
-- This has the side effect of forcing the intermediate to be evaluated
if verbosity dflags >= 2 then
-- Report result size if required
-- This has the side effect of forcing the intermediate to be evaluated
if verbosity dflags >= 2 then
- hPutStrLn stdout (" Result size = " ++ show (coreBindsSize binds))
+ hPutStrLn stderr (" Result size = " ++ show (coreBindsSize binds))
else
return ()
else
return ()
@@
-116,7
+119,7
@@
lintCoreBindings dflags whoDunnit binds
lintCoreBindings dflags whoDunnit binds
= case (initL (lint_binds binds)) of
lintCoreBindings dflags whoDunnit binds
= case (initL (lint_binds binds)) of
- Nothing -> done_lint
+ Nothing -> showPass dflags ("Core Linted result of " ++ whoDunnit)
Just bad_news -> printDump (display bad_news) >>
ghcExit 1
where
Just bad_news -> printDump (display bad_news) >>
ghcExit 1
where
@@
-130,9
+133,6
@@
lintCoreBindings dflags whoDunnit binds
returnL ()
lint_bind (NonRec bndr rhs) = lintSingleBinding NonRecursive (bndr,rhs)
returnL ()
lint_bind (NonRec bndr rhs) = lintSingleBinding NonRecursive (bndr,rhs)
- done_lint = doIfSet (verbosity dflags >= 2)
- (hPutStr stdout ("*** Core Linted result of " ++ whoDunnit ++ "\n"))
-
display bad_news
= vcat [ text ("*** Core Lint Errors: in result of " ++ whoDunnit ++ " ***"),
bad_news,
display bad_news
= vcat [ text ("*** Core Lint Errors: in result of " ++ whoDunnit ++ " ***"),
bad_news,