projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1997-06-05 21:22:15 by sof]
[ghc-hetmet.git]
/
ghc
/
compiler
/
main
/
ErrUtils.lhs
diff --git
a/ghc/compiler/main/ErrUtils.lhs
b/ghc/compiler/main/ErrUtils.lhs
index
d588f68
..
6e6e99a
100644
(file)
--- a/
ghc/compiler/main/ErrUtils.lhs
+++ b/
ghc/compiler/main/ErrUtils.lhs
@@
-7,44
+7,61
@@
#include "HsVersions.h"
module ErrUtils (
#include "HsVersions.h"
module ErrUtils (
-
- Error(..),
- addErrLoc, addShortErrLocLine,
- dontAddErrLoc, pprBagOfErrors
-
+ SYN_IE(Error), SYN_IE(Warning), SYN_IE(Message),
+ addErrLoc,
+ addShortErrLocLine, addShortWarnLocLine,
+ dontAddErrLoc,
+ pprBagOfErrors,
+ ghcExit
) where
) where
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
-import Bag ( bagToList )
-import PprStyle ( PprStyle(..) )
+import CmdLineOpts ( opt_PprUserLength )
+import Bag --( bagToList )
+import Outputable ( PprStyle(..), Outputable(..) )
import Pretty
import Pretty
-import SrcLoc ( mkUnknownSrcLoc, SrcLoc{-instance-} )
+import SrcLoc ( noSrcLoc, SrcLoc{-instance-} )
\end{code}
\begin{code}
\end{code}
\begin{code}
-type Error = PprStyle -> Pretty
+type Error = PprStyle -> Doc
+type Warning = PprStyle -> Doc
+type Message = PprStyle -> Doc
addErrLoc :: SrcLoc -> String -> Error -> Error
addErrLoc locn title rest_of_err_msg sty
addErrLoc :: SrcLoc -> String -> Error -> Error
addErrLoc locn title rest_of_err_msg sty
- = ppHang (ppBesides [ppr PprForUser locn,
- if null title then ppNil else ppStr (": " ++ title),
- ppChar ':'])
+ = hang (hcat [ppr (PprForUser opt_PprUserLength) locn,
+ if null title then empty else text (": " ++ title),
+ char ':'])
4 (rest_of_err_msg sty)
4 (rest_of_err_msg sty)
-addShortErrLocLine :: SrcLoc -> Error -> Error
+addShortErrLocLine, addShortWarnLocLine :: SrcLoc -> Error -> Error
+
addShortErrLocLine locn rest_of_err_msg sty
addShortErrLocLine locn rest_of_err_msg sty
- = ppHang (ppBeside (ppr PprForUser locn) (ppChar ':'))
+ = hang ((<>) (ppr (PprForUser opt_PprUserLength) locn) (char ':'))
+ 4 (rest_of_err_msg sty)
+
+addShortWarnLocLine locn rest_of_err_msg sty
+ = hang ((<>) (ppr (PprForUser opt_PprUserLength) locn) (ptext SLIT(":warning:")))
4 (rest_of_err_msg sty)
dontAddErrLoc :: String -> Error -> Error
dontAddErrLoc title rest_of_err_msg sty
4 (rest_of_err_msg sty)
dontAddErrLoc :: String -> Error -> Error
dontAddErrLoc title rest_of_err_msg sty
- = ppHang (ppBesides [ppStr title, ppChar ':'])
+ = hang (hcat [text title, char ':'])
4 (rest_of_err_msg sty)
4 (rest_of_err_msg sty)
-pprBagOfErrors :: PprStyle -> Bag Error -> Pretty
+pprBagOfErrors :: PprStyle -> Bag Error -> Doc
pprBagOfErrors sty bag_of_errors
= let pretties = map ( \ e -> e sty ) (bagToList bag_of_errors) in
pprBagOfErrors sty bag_of_errors
= let pretties = map ( \ e -> e sty ) (bagToList bag_of_errors) in
- ppAboves (map (\ p -> ppAbove ppSP p) pretties)
+ vcat (map (\ p -> ($$) space p) pretties)
\end{code}
\end{code}
+\begin{code}
+ghcExit :: Int -> IO ()
+
+ghcExit val
+ = if val /= 0
+ then error "Compilation had errors\n"
+ else return ()
+\end{code}