X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=7f5914e90486903a38809b7142f70abd27951688;hb=67ad7f3ba7381ec815faf55be1ca6a4c6a919cb1;hp=bc5908f884414f46c5a1d746cb8efc5fd60d6db3;hpb=46aff9457fd48cfae1258739ffd4a6d889d015f5;p=ghc-hetmet.git

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index bc5908f..7f5914e 100644
--- 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, 
@@ -96,11 +97,11 @@ throwErrMsg = throwDyn
 throwErrMsg = throw
 #endif
 
-handleErrMsg :: (ErrMsg -> IO a) -> IO a -> IO a
+handleErrMsg :: ExceptionMonad m => (ErrMsg -> m a) -> m a -> m a
 #if __GLASGOW_HASKELL__ < 609
-handleErrMsg = flip catchDyn
+handleErrMsg = flip gcatchDyn
 #else
-handleErrMsg = handle
+handleErrMsg = ghandle
 #endif
 
 -- So we can throw these things as exceptions
@@ -144,6 +145,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