Dynflags: introduce DiagOpts

Use DiagOpts for diagnostic options instead of directly querying
DynFlags (#17957).

Surprising performance improvements on CI:

  T4801(normal) ghc/alloc   313236344.0   306515216.0  -2.1% GOOD
  T9961(normal) ghc/alloc   384502736.0   380584384.0  -1.0% GOOD
  ManyAlternatives(normal) ghc/alloc   797356128.0   786644928.0  -1.3%
  ManyConstructors(normal) ghc/alloc  4389732432.0  4317740880.0  -1.6%
  T783(normal) ghc/alloc   408142680.0   402812176.0  -1.3%

Metric Decrease:
    T4801
    T9961
    T783
    ManyAlternatives
    ManyConstructors

Bump haddock submodule

4 files changed, 47 insertions, 38 deletions

diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 2f6702bfc8..c26dce5161 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -14,68 +14,73 @@ module GHC.Tc.Errors(
 
 import GHC.Prelude
 
+import GHC.Driver.Env (hsc_units)
+import GHC.Driver.Session
+import GHC.Driver.Ppr
+import GHC.Driver.Config.Diagnostic
+
 import GHC.Tc.Types
 import GHC.Tc.Utils.Monad
+import GHC.Tc.Errors.Types
 import GHC.Tc.Types.Constraint
-import GHC.Core.Predicate
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.Env( tcInitTidyEnv )
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.Unify ( checkTyVarEq )
 import GHC.Tc.Types.Origin
-import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) )
-import GHC.Core.Type
-import GHC.Core.Coercion
-import GHC.Core.TyCo.Rep
-import GHC.Core.TyCo.Ppr  ( pprTyVars, pprWithExplicitKindsWhen, pprSourceTyCon, pprWithTYPE )
-import GHC.Core.Unify     ( tcMatchTys, flattenTys )
-import GHC.Unit.Module
-import GHC.Tc.Errors.Types
-import GHC.Tc.Instance.Family
-import GHC.Tc.Utils.Instantiate
-import GHC.Core.InstEnv
-import GHC.Core.TyCon
-import GHC.Core.Class
-import GHC.Core.DataCon
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.EvTerm
-import GHC.Hs.Binds ( PatSynBind(..) )
+import GHC.Tc.Instance.Family
+import GHC.Tc.Utils.Instantiate
+import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits )
+
 import GHC.Types.Name
 import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual
                              , emptyLocalRdrEnv, lookupGlobalRdrEnv , lookupLocalRdrOcc )
-import GHC.Builtin.Names ( typeableClassName )
 import GHC.Types.Id
 import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
-import GHC.Data.Bag
-import GHC.Utils.Error  (diagReasonSeverity,  pprLocMsgEnvelope )
+import GHC.Types.SrcLoc
 import GHC.Types.Basic
 import GHC.Types.Error
+
+import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) )
+import GHC.Unit.Module
+import GHC.Hs.Binds ( PatSynBind(..) )
+import GHC.Builtin.Names ( typeableClassName )
+import qualified GHC.LanguageExtensions as LangExt
+
+import GHC.Core.Predicate
+import GHC.Core.Type
+import GHC.Core.Coercion
+import GHC.Core.TyCo.Rep
+import GHC.Core.TyCo.Ppr  ( pprTyVars, pprWithExplicitKindsWhen, pprSourceTyCon, pprWithTYPE )
+import GHC.Core.Unify     ( tcMatchTys, flattenTys )
+import GHC.Core.InstEnv
+import GHC.Core.TyCon
+import GHC.Core.Class
+import GHC.Core.DataCon
 import GHC.Core.ConLike ( ConLike(..))
+
+import GHC.Utils.Error  (diagReasonSeverity,  pprLocMsgEnvelope )
 import GHC.Utils.Misc
-import GHC.Data.FastString
 import GHC.Utils.Outputable as O
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
-import GHC.Types.SrcLoc
-import GHC.Driver.Env (hsc_units)
-import GHC.Driver.Session
-import GHC.Driver.Ppr
+import GHC.Utils.FV ( fvVarList, unionFV )
+
+import GHC.Data.Bag
+import GHC.Data.FastString
 import GHC.Data.List.SetOps ( equivClasses )
 import GHC.Data.Maybe
-import qualified GHC.LanguageExtensions as LangExt
-import GHC.Utils.FV ( fvVarList, unionFV )
 import qualified GHC.Data.Strict as Strict
 
 import Control.Monad    ( unless, when, foldM, forM_ )
 import Data.Foldable    ( toList )
 import Data.List        ( partition, mapAccumL, sortBy, unfoldr )
-
-import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits )
-
 -- import Data.Semigroup   ( Semigroup )
 import qualified Data.Semigroup as Semigroup
 
@@ -721,8 +726,8 @@ reportHoles :: [Ct]  -- other (tidied) constraints
             -> ReportErrCtxt -> [Hole] -> TcM ()
 reportHoles tidy_cts ctxt holes
   = do
-      df <- getDynFlags
-      let severity = diagReasonSeverity df (cec_type_holes ctxt)
+      diag_opts <- initDiagOpts <$> getDynFlags
+      let severity = diagReasonSeverity diag_opts (cec_type_holes ctxt)
           holes'   = filter (keepThisHole severity) holes
       -- Zonk and tidy all the TcLclEnvs before calling `mkHoleError`
       -- because otherwise types will be zonked and tidied many times over.
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index b4d15ee4ab..4a5c71a85c 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -38,6 +38,7 @@ import GHC.Driver.Main
 import GHC.Driver.Session
 import GHC.Driver.Env
 import GHC.Driver.Hooks
+import GHC.Driver.Config.Diagnostic
 
 import GHC.Hs
 
@@ -995,8 +996,8 @@ runMeta' show_code ppr_hs run_and_convert expr
         -- goes wrong. See Note [Errors in desugaring a splice]. This happens in all
         -- cases.
         ; logger <- getLogger
-        ; dflags <- getDynFlags
-        ; liftIO $ printMessages logger dflags ds_msgs
+        ; diag_opts <- initDiagOpts <$> getDynFlags
+        ; liftIO $ printMessages logger diag_opts ds_msgs
 
         ; ds_expr <- case mb_ds_expr of
             Nothing      -> failM   -- Case (a) from Note [Errors in desugaring a splice]
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 08005f1a74..696e8dc8a3 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -53,6 +53,7 @@ import GHC.Prelude
 import GHC.Driver.Env
 import GHC.Driver.Plugins
 import GHC.Driver.Session
+import GHC.Driver.Config.Diagnostic
 
 import GHC.Tc.Errors.Hole.FitTypes ( HoleFitPluginR (..) )
 import GHC.Tc.Errors.Types
@@ -3163,6 +3164,7 @@ mark_plugin_unsafe :: DynFlags -> TcM ()
 mark_plugin_unsafe dflags = unless (gopt Opt_PluginTrustworthy dflags) $
   recordUnsafeInfer pluginUnsafe
   where
+    !diag_opts = initDiagOpts dflags
     pluginUnsafe =
       singleMessage $
-      mkPlainMsgEnvelope dflags noSrcSpan TcRnUnsafeDueToPlugin
+      mkPlainMsgEnvelope diag_opts noSrcSpan TcRnUnsafeDueToPlugin
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 0572ab00db..ea6b2f2ba5 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -175,6 +175,7 @@ import GHC.Core.FamInstEnv
 
 import GHC.Driver.Env
 import GHC.Driver.Session
+import GHC.Driver.Config.Diagnostic
 
 import GHC.Runtime.Context
 
@@ -1051,8 +1052,8 @@ mkTcRnMessage :: SrcSpan
               -> TcRn (MsgEnvelope TcRnMessage)
 mkTcRnMessage loc msg
   = do { printer <- getPrintUnqualified ;
-         dflags <- getDynFlags ;
-         return $ mkMsgEnvelope dflags loc printer msg }
+         diag_opts <- initDiagOpts <$> getDynFlags ;
+         return $ mkMsgEnvelope diag_opts loc printer msg }
 
 reportDiagnostics :: [MsgEnvelope TcRnMessage] -> TcM ()
 reportDiagnostics = mapM_ reportDiagnostic
@@ -1538,11 +1539,11 @@ addDetailedDiagnostic :: (ErrInfo -> TcRnMessage) -> TcM ()
 addDetailedDiagnostic mkMsg = do
   loc <- getSrcSpanM
   printer <- getPrintUnqualified
-  dflags  <- getDynFlags
+  !diag_opts  <- initDiagOpts <$> getDynFlags
   env0 <- tcInitTidyEnv
   ctxt <- getErrCtxt
   err_info <- mkErrInfo env0 ctxt
-  reportDiagnostic (mkMsgEnvelope dflags loc printer (mkMsg (ErrInfo err_info empty)))
+  reportDiagnostic (mkMsgEnvelope diag_opts loc printer (mkMsg (ErrInfo err_info empty)))
 
 addTcRnDiagnostic :: TcRnMessage -> TcM ()
 addTcRnDiagnostic msg = do