X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=9159a3e35c05f794e11a0ce1f3d9329c43f2f071;hb=5e12e5be4fe676a79669f9a0cb5265e5cd33bebe;hp=a0325bf8080c29d3f1ff60ba3f5bffec4ed464e6;hpb=850a5149aa0449276fe038568aa9ce555d3fc186;p=ghc-hetmet.git diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index a0325bf..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 :: (ErrMsg -> IO a) -> IO a -> IO a -#if __GLASGOW_HASKELL__ < 609 -handleErrMsg = flip catchDyn -#else -handleErrMsg = handle -#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