X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=9159a3e35c05f794e11a0ce1f3d9329c43f2f071;hp=7f5914e90486903a38809b7142f70abd27951688;hb=7bb3d1fc79521d591cd9f824893963141a7997b6;hpb=67ad7f3ba7381ec815faf55be1ca6a4c6a919cb1 diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 7f5914e..9159a3e 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -8,13 +8,12 @@ module ErrUtils ( Message, mkLocMessage, printError, Severity(..), - ErrMsg, WarnMsg, throwErrMsg, handleErrMsg, + ErrMsg, WarnMsg, ErrorMessages, WarningMessages, errMsgSpans, errMsgContext, errMsgShortDoc, errMsgExtraInfo, Messages, errorsFound, emptyMessages, mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg, printErrorsAndWarnings, printBagOfErrors, printBagOfWarnings, - handleFlagWarnings, warnIsErrorMsg, ghcExit, @@ -42,10 +41,8 @@ import StaticFlags ( opt_ErrorSpans ) import Control.Monad import System.Exit ( ExitCode(..), exitWith ) -import Data.Dynamic import Data.List import System.IO -import Exception -- ----------------------------------------------------------------------------- -- Basic error messages: just render a message with a source location. @@ -83,34 +80,9 @@ 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 :: ExceptionMonad m => (ErrMsg -> m a) -> m a -> m a -#if __GLASGOW_HASKELL__ < 609 -handleErrMsg = flip gcatchDyn -#else -handleErrMsg = ghandle -#endif - --- So we can throw these things as exceptions -errMsgTc :: TyCon -errMsgTc = mkTyCon "ErrMsg" -{-# NOINLINE errMsgTc #-} -instance Typeable ErrMsg where - typeOf _ = mkTyConApp errMsgTc [] - type WarnMsg = ErrMsg -- A short (one-line) error message, with context to tell us whether @@ -204,25 +176,6 @@ printBagOfWarnings dflags bag_of_warns EQ -> True GT -> False -handleFlagWarnings :: DynFlags -> [Located String] -> IO () -handleFlagWarnings dflags warns - = when (dopt Opt_WarnDeprecatedFlags dflags) - (handleFlagWarnings' dflags warns) - -handleFlagWarnings' :: DynFlags -> [Located String] -> IO () -handleFlagWarnings' _ [] = return () -handleFlagWarnings' dflags warns - = do -- It would be nicer if warns :: [Located Message], but that has circular - -- import problems. - mapM_ (handleFlagWarning dflags) warns - when (dopt Opt_WarnIsError dflags) $ - do errorMsg dflags $ text "\nFailing due to -Werror.\n" - exitWith (ExitFailure 1) - -handleFlagWarning :: DynFlags -> Located String -> IO () -handleFlagWarning dflags (L loc warn) - = log_action dflags SevWarning loc defaultUserStyle (text warn) - ghcExit :: DynFlags -> Int -> IO () ghcExit dflags val | val == 0 = exitWith ExitSuccess