diff options
Diffstat (limited to 'compiler/GHC/Parser')
| -rw-r--r-- | compiler/GHC/Parser/Errors/Ppr.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Parser/Header.hs | 40 |
2 files changed, 20 insertions, 22 deletions
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs index edb9b04380..98b2341cf1 100644 --- a/compiler/GHC/Parser/Errors/Ppr.hs +++ b/compiler/GHC/Parser/Errors/Ppr.hs @@ -29,7 +29,6 @@ mkParserErr span doc = ErrMsg { errMsgSpan = span , errMsgContext = alwaysQualify , errMsgDoc = ErrDoc [doc] [] [] - , errMsgShortString = renderWithContext defaultSDocContext doc , errMsgSeverity = SevError , errMsgReason = NoReason } @@ -39,7 +38,6 @@ mkParserWarn flag span doc = ErrMsg { errMsgSpan = span , errMsgContext = alwaysQualify , errMsgDoc = ErrDoc [doc] [] [] - , errMsgShortString = renderWithContext defaultSDocContext doc , errMsgSeverity = SevWarning , errMsgReason = Reason flag } diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs index 5abb0497d4..8c0a876c36 100644 --- a/compiler/GHC/Parser/Header.hs +++ b/compiler/GHC/Parser/Header.hs @@ -39,11 +39,11 @@ import GHC.Hs import GHC.Unit.Module import GHC.Builtin.Names +import GHC.Types.Error import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.SourceText -import GHC.Utils.Error import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic @@ -259,7 +259,7 @@ getOptions' dflags toks | IToptions_prag str <- unLoc open , ITclose_prag <- unLoc close = case toArgs str of - Left _err -> optionsParseError str dflags $ -- #15053 + Left _err -> optionsParseError str $ -- #15053 combineSrcSpans (getLoc open) (getLoc close) Right args -> map (L (getLoc open)) args ++ parseToks xs parseToks (open:close:xs) @@ -284,10 +284,10 @@ getOptions' dflags toks case rest of (L _loc ITcomma):more -> parseLanguage more (L _loc ITclose_prag):more -> parseToks more - (L loc _):_ -> languagePragParseError dflags loc + (L loc _):_ -> languagePragParseError loc [] -> panic "getOptions'.parseLanguage(1) went past eof token" parseLanguage (tok:_) - = languagePragParseError dflags (getLoc tok) + = languagePragParseError (getLoc tok) parseLanguage [] = panic "getOptions'.parseLanguage(2) went past eof token" @@ -308,12 +308,12 @@ getOptions' dflags toks -- -- Throws a 'SourceError' if the input list is non-empty claiming that the -- input flags are unknown. -checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m () -checkProcessArgsResult dflags flags +checkProcessArgsResult :: MonadIO m => [Located String] -> m () +checkProcessArgsResult flags = when (notNull flags) $ liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags where mkMsg (L loc flag) - = mkPlainErrMsg dflags loc $ + = mkPlainErrMsg loc $ (text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+> text flag) @@ -330,9 +330,9 @@ checkExtension dflags (L l ext) ext' = unpackFS ext supported = supportedLanguagesAndExtensions $ platformArchOS $ targetPlatform dflags -languagePragParseError :: DynFlags -> SrcSpan -> a -languagePragParseError dflags loc = - throwErr dflags loc $ +languagePragParseError :: SrcSpan -> a +languagePragParseError loc = + throwErr loc $ vcat [ text "Cannot parse LANGUAGE pragma" , text "Expecting comma-separated list of language options," , text "each starting with a capital letter" @@ -340,7 +340,7 @@ languagePragParseError dflags loc = unsupportedExtnError :: DynFlags -> SrcSpan -> String -> a unsupportedExtnError dflags loc unsup = - throwErr dflags loc $ + throwErr loc $ text "Unsupported extension: " <> text unsup $$ if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions) where @@ -348,8 +348,8 @@ unsupportedExtnError dflags loc unsup = suggestions = fuzzyMatch unsup supported -optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages -optionsErrorMsgs dflags unhandled_flags flags_lines _filename +optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages +optionsErrorMsgs unhandled_flags flags_lines _filename = (emptyBag, listToBag (map mkMsg unhandled_flags_lines)) where unhandled_flags_lines :: [Located String] unhandled_flags_lines = [ L l f @@ -357,17 +357,17 @@ optionsErrorMsgs dflags unhandled_flags flags_lines _filename , L l f' <- flags_lines , f == f' ] mkMsg (L flagSpan flag) = - GHC.Utils.Error.mkPlainErrMsg dflags flagSpan $ + mkPlainErrMsg flagSpan $ text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+> text flag -optionsParseError :: String -> DynFlags -> SrcSpan -> a -- #15053 -optionsParseError str dflags loc = - throwErr dflags loc $ +optionsParseError :: String -> SrcSpan -> a -- #15053 +optionsParseError str loc = + throwErr loc $ vcat [ text "Error while parsing OPTIONS_GHC pragma." , text "Expecting whitespace-separated list of GHC options." , text " E.g. {-# OPTIONS_GHC -Wall -O2 #-}" , text ("Input was: " ++ show str) ] -throwErr :: DynFlags -> SrcSpan -> SDoc -> a -- #15053 -throwErr dflags loc doc = - throw $ mkSrcErr $ unitBag $ mkPlainErrMsg dflags loc doc +throwErr :: SrcSpan -> SDoc -> a -- #15053 +throwErr loc doc = + throw $ mkSrcErr $ unitBag $ mkPlainErrMsg loc doc |