Turn libffi into a Haskell package

[ghc-hetmet.git] / compiler / main / ErrUtils.lhs

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index bc5908f..d98fddb 100644 (file)
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -15,6 +15,7 @@ module ErrUtils (
        mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg,
        printErrorsAndWarnings, printBagOfErrors, printBagOfWarnings,
     handleFlagWarnings,
+       warnIsErrorMsg,
 
        ghcExit,
        doIfSet, doIfSet_dyn, 
@@ -82,26 +83,16 @@ data ErrMsg = ErrMsg {
        -- NB  Pretty.Doc not SDoc: we deal with the printing style (in ptic 
        -- whether to qualify an External Name) at the error occurrence
 
-#if __GLASGOW_HASKELL__ >= 609
 instance Exception ErrMsg
-#endif
 
 instance Show ErrMsg where
     show em = showSDoc (errMsgShortDoc em)
 
 throwErrMsg :: ErrMsg -> a
-#if __GLASGOW_HASKELL__ < 609
-throwErrMsg = throwDyn
-#else
 throwErrMsg = throw
-#endif
 
-handleErrMsg :: (ErrMsg -> IO a) -> IO a -> IO a
-#if __GLASGOW_HASKELL__ < 609
-handleErrMsg = flip catchDyn
-#else
-handleErrMsg = handle
-#endif
+handleErrMsg :: ExceptionMonad m => (ErrMsg -> m a) -> m a -> m a
+handleErrMsg = ghandle
 
 -- So we can throw these things as exceptions
 errMsgTc :: TyCon
@@ -144,6 +135,9 @@ type ErrorMessages   = Bag ErrMsg
 emptyMessages :: Messages
 emptyMessages = (emptyBag, emptyBag)
 
+warnIsErrorMsg :: ErrMsg
+warnIsErrorMsg = mkPlainErrMsg noSrcSpan (text "\nFailing due to -Werror.\n")
+
 errorsFound :: DynFlags -> Messages -> Bool
 -- The dyn-flags are used to see if the user has specified
 -- -Werror, which says that warnings should be fatal