[project @ 1997-05-19 00:12:10 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 89866b7..aba852b 100644 (file)
--- a/ghc/compiler/main/ErrUtils.lhs
+++ b/ghc/compiler/main/ErrUtils.lhs
@@ -7,45 +7,63 @@
 #include "HsVersions.h"
 
 module ErrUtils (
-       Error(..), Warning(..), Message(..),
+       SYN_IE(Error), SYN_IE(Warning), SYN_IE(Message),
        addErrLoc,
-       addShortErrLocLine,
+       addShortErrLocLine, addShortWarnLocLine,
        dontAddErrLoc,
-       pprBagOfErrors
+       pprBagOfErrors,
+       ghcExit
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
-import Bag             ( bagToList )
+import Bag             --( bagToList )
 import PprStyle                ( PprStyle(..) )
 import Pretty
-import SrcLoc          ( mkUnknownSrcLoc, SrcLoc{-instance-} )
+import SrcLoc          ( noSrcLoc, SrcLoc{-instance-} )
+#if __GLASGOW_HASKELL__ >= 202
+import Outputable
+#endif
 \end{code}
 
 \begin{code}
-type Error   = PprStyle -> Pretty
-type Warning = PprStyle -> Pretty
-type Message = 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
-  = ppHang (ppBesides [ppr PprForUser locn,
-                      if null title then ppNil else ppStr (": " ++ title),
-                      ppChar ':'])
+  = hang (hcat [ppr PprForUser locn,
+               if null title then empty else text (": " ++ title),
+               char ':'])
         4 (rest_of_err_msg sty)
 
-addShortErrLocLine :: SrcLoc -> Error -> Error
+addShortErrLocLine, addShortWarnLocLine :: SrcLoc -> Error -> Error
+
 addShortErrLocLine locn rest_of_err_msg sty
-  = ppHang (ppBeside (ppr PprForUser locn) (ppChar ':'))
+  = hang ((<>) (ppr PprForUser locn) (char ':'))
+        4 (rest_of_err_msg sty)
+
+addShortWarnLocLine locn rest_of_err_msg sty
+  = hang ((<>) (ppr PprForUser locn) (ptext SLIT(":warning:")))
         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)
 
-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
-    ppAboves (map (\ p -> ppAbove ppSP p) pretties)
+    vcat (map (\ p -> ($$) space p) pretties)
+\end{code}
+
+\begin{code}
+ghcExit :: Int -> IO ()
+
+ghcExit val
+  = if val /= 0
+    then error "Compilation had errors\n"
+    else return ()
 \end{code}