Remove errShortString, cleanup error-related functions

This commit removes the errShortString field from the ErrMsg type,
allowing us to cleanup a lot of dynflag-dependent error functions, and
move them in a more specialised 'GHC.Driver.Errors' closer to the
driver, where they are actually used.

Metric Increase:
  T4801
  T9961

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