Refactor Logger

Before this patch, the only way to override GHC's default logging
behavior was to set `log_action`, `dump_action` and `trace_action`
fields in DynFlags. This patch introduces a new Logger abstraction and
stores it in HscEnv instead.

This is part of #17957 (avoid storing state in DynFlags). DynFlags are
duplicated and updated per-module (because of OPTIONS_GHC pragma), so
we shouldn't store global state in them.

This patch also fixes a race in parallel "--make" mode which updated
the `generatedDumps` IORef concurrently.

Bump haddock submodule

The increase in MultilayerModules is tracked in #19293.

Metric Increase:
    MultiLayerModules

1 files changed, 12 insertions, 14 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 48886ea88f..7dc253b894 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -58,7 +58,7 @@ import GHC.Driver.Config
 import qualified GHC
 import GHC ( LoadHowMuch(..), Target(..),  TargetId(..),
              Resume, SingleStep, Ghc,
-             GetDocsFailure(..),
+             GetDocsFailure(..), putLogMsgM, pushLogHookM,
              getModuleGraph, handleSourceError, ms_mod )
 import GHC.Driver.Main (hscParseDeclsWithLocation, hscParseStmtWithLocation)
 import GHC.Hs.ImpExp
@@ -86,6 +86,7 @@ import GHC.Unit.Module.ModSummary
 
 import GHC.Data.StringBuffer
 import GHC.Utils.Outputable
+import GHC.Utils.Logger
 
 -- Other random utilities
 import GHC.Types.Basic hiding ( isTopLevel )
@@ -478,13 +479,10 @@ interactiveUI config srcs maybe_exprs = do
                $ dflags
    GHC.setInteractiveDynFlags dflags'
 
+   -- Update the LogAction. Ensure we don't override the user's log action lest
+   -- we break -ddump-json (#14078)
    lastErrLocationsRef <- liftIO $ newIORef []
-   progDynFlags <- GHC.getProgramDynFlags
-   _ <- GHC.setProgramDynFlags $
-      -- Ensure we don't override the user's log action lest we break
-      -- -ddump-json (#14078)
-      progDynFlags { log_action = ghciLogAction (log_action progDynFlags)
-                                                lastErrLocationsRef }
+   pushLogHookM (ghciLogAction lastErrLocationsRef)
 
    when (isNothing maybe_exprs) $ do
         -- Only for GHCi (not runghc and ghc -e):
@@ -576,8 +574,8 @@ resetLastErrorLocations = do
     st <- getGHCiState
     liftIO $ writeIORef (lastErrorLocations st) []
 
-ghciLogAction :: LogAction -> IORef [(FastString, Int)] ->  LogAction
-ghciLogAction old_log_action lastErrLocations
+ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction
+ghciLogAction lastErrLocations old_log_action
               dflags flag severity srcSpan msg = do
     old_log_action dflags flag severity srcSpan msg
     case severity of
@@ -3014,10 +3012,11 @@ newDynFlags :: GhciMonad m => Bool -> [String] -> m ()
 newDynFlags interactive_only minus_opts = do
       let lopts = map noLoc minus_opts
 
+      logger <- getLogger
       idflags0 <- GHC.getInteractiveDynFlags
-      (idflags1, leftovers, warns) <- GHC.parseDynamicFlags idflags0 lopts
+      (idflags1, leftovers, warns) <- GHC.parseDynamicFlags logger idflags0 lopts
 
-      liftIO $ handleFlagWarnings idflags1 warns
+      liftIO $ handleFlagWarnings logger idflags1 warns
       when (not $ null leftovers)
            (throwGhcException . CmdLineError
             $ "Some flags have not been recognized: "
@@ -3031,7 +3030,7 @@ newDynFlags interactive_only minus_opts = do
       dflags0 <- getDynFlags
 
       when (not interactive_only) $ do
-        (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags dflags0 lopts
+        (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags logger dflags0 lopts
         must_reload <- GHC.setProgramDynFlags dflags1
 
         -- if the package flags changed, reset the context and link
@@ -3168,8 +3167,7 @@ showCmd str = do
             , action "bindings"   $ showBindings
             , action "linker"     $ do
                msg <- liftIO $ Loader.showLoaderState (hsc_loader hsc_env)
-               dflags <- getDynFlags
-               liftIO $ putLogMsg dflags NoReason SevDump noSrcSpan msg
+               putLogMsgM NoReason SevDump noSrcSpan msg
             , action "breaks"     $ showBkptTable
             , action "context"    $ showContext
             , action "packages"   $ showUnits