Skip to content
Snippets Groups Projects
Commit 0f55a795 authored by sof's avatar sof
Browse files

[project @ 1997-09-04 20:21:37 by sof]

ppr tidy up
parent 72592f20
No related branches found
No related tags found
No related merge requests found
...@@ -13,7 +13,7 @@ module CoreLint ( ...@@ -13,7 +13,7 @@ module CoreLint (
IMP_Ubiq() IMP_Ubiq()
import CmdLineOpts ( opt_PprUserLength ) import CmdLineOpts ( opt_D_show_passes, opt_PprUserLength, opt_DoCoreLinting )
import CoreSyn import CoreSyn
import Bag import Bag
...@@ -30,7 +30,8 @@ import Maybes ( catMaybes ) ...@@ -30,7 +30,8 @@ import Maybes ( catMaybes )
import Name ( isLocallyDefined, getSrcLoc, Name{-instance NamedThing-}, import Name ( isLocallyDefined, getSrcLoc, Name{-instance NamedThing-},
NamedThing(..) ) NamedThing(..) )
import PprCore import PprCore
import Outputable ( PprStyle(..), Outputable(..) ) import Outputable ( PprStyle(..), Outputable(..), pprErrorsStyle, printErrs )
import ErrUtils ( doIfSet, ghcExit )
import PprType ( GenType, GenTyVar, TyCon ) import PprType ( GenType, GenTyVar, TyCon )
import Pretty import Pretty
import PrimOp ( primOpType, PrimOp(..) ) import PrimOp ( primOpType, PrimOp(..) )
...@@ -86,25 +87,33 @@ Outstanding issues: ...@@ -86,25 +87,33 @@ Outstanding issues:
-- --
\begin{code} \begin{code}
lintCoreBindings lintCoreBindings :: String -> Bool -> [CoreBinding] -> IO ()
:: PprStyle -> String -> Bool -> [CoreBinding] -> [CoreBinding]
lintCoreBindings sty whoDunnit spec_done binds lintCoreBindings whoDunnit spec_done binds
| not opt_DoCoreLinting
= return ()
lintCoreBindings whoDunnit spec_done binds
= case (initL (lint_binds binds) spec_done) of = case (initL (lint_binds binds) spec_done) of
Nothing -> binds Nothing -> doIfSet opt_D_show_passes
Just msg -> (hPutStr stderr ("*** Core Linted result of " ++ whoDunnit ++ "\n"))
pprPanic "" (vcat [
text ("*** Core Lint Errors: in " ++ whoDunnit ++ " ***"), Just bad_news -> printErrs (display bad_news) >>
msg sty, ghcExit 1
ptext SLIT("*** Offending Program ***"),
vcat (map (pprCoreBinding sty) binds),
ptext SLIT("*** End of Offense ***")
])
where where
lint_binds [] = returnL () lint_binds [] = returnL ()
lint_binds (bind:binds) lint_binds (bind:binds)
= lintCoreBinding bind `thenL` \binders -> = lintCoreBinding bind `thenL` \binders ->
addInScopeVars binders (lint_binds binds) addInScopeVars binders (lint_binds binds)
display bad_news
= vcat [
text ("*** Core Lint Errors: in result of " ++ whoDunnit ++ " ***"),
bad_news pprErrorsStyle,
ptext SLIT("*** Offending Program ***"),
pprCoreBindings pprErrorsStyle binds,
ptext SLIT("*** End of Offense ***")
]
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment