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

2 files changed, 15 insertions, 7 deletions

diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index d68b5d5c8e..84c82ef873 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -61,7 +61,7 @@ import GHC.Types.Unique
 import GHC.Utils.BufHandle   ( BufHandle )
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
-import GHC.Utils.Error
+import GHC.Utils.Logger
 import qualified GHC.Data.Stream as Stream
 
 import Data.Maybe (fromJust)
@@ -302,6 +302,7 @@ data LlvmEnv = LlvmEnv
   { envVersion :: LlvmVersion      -- ^ LLVM version
   , envOpts    :: LlvmOpts         -- ^ LLVM backend options
   , envDynFlags :: DynFlags        -- ^ Dynamic flags
+  , envLogger :: !Logger           -- ^ Logger
   , envOutput :: BufHandle         -- ^ Output buffer
   , envMask :: !Char               -- ^ Mask for creating unique values
   , envFreshMeta :: MetaId         -- ^ Supply of fresh metadata IDs
@@ -332,6 +333,10 @@ instance Monad LlvmM where
 instance HasDynFlags LlvmM where
     getDynFlags = LlvmM $ \env -> return (envDynFlags env, env)
 
+instance HasLogger LlvmM where
+    getLogger = LlvmM $ \env -> return (envLogger env, env)
+
+
 -- | Get target platform
 getPlatform :: LlvmM Platform
 getPlatform = llvmOptsPlatform <$> getLlvmOpts
@@ -355,8 +360,8 @@ liftIO m = LlvmM $ \env -> do x <- m
                               return (x, env)
 
 -- | Get initial Llvm environment.
-runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a
-runLlvm dflags ver out m = do
+runLlvm :: Logger -> DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a
+runLlvm logger dflags ver out m = do
     (a, _) <- runLlvmM m env
     return a
   where env = LlvmEnv { envFunMap = emptyUFM
@@ -367,6 +372,7 @@ runLlvm dflags ver out m = do
                       , envVersion = ver
                       , envOpts = initLlvmOpts dflags
                       , envDynFlags = dflags
+                      , envLogger = logger
                       , envOutput = out
                       , envMask = 'n'
                       , envFreshMeta = MetaId 0
@@ -426,7 +432,8 @@ getLlvmVer = getEnv envVersion
 dumpIfSetLlvm :: DumpFlag -> String -> DumpFormat -> Outp.SDoc -> LlvmM ()
 dumpIfSetLlvm flag hdr fmt doc = do
   dflags <- getDynFlags
-  liftIO $ dumpIfSet_dyn dflags flag hdr fmt doc
+  logger <- getLogger
+  liftIO $ dumpIfSet_dyn logger dflags flag hdr fmt doc
 
 -- | Prints the given contents to the output handle
 renderLlvm :: Outp.SDoc -> LlvmM ()
diff --git a/compiler/GHC/CmmToLlvm/Mangler.hs b/compiler/GHC/CmmToLlvm/Mangler.hs
index 0436dbcf07..805f1b8074 100644
--- a/compiler/GHC/CmmToLlvm/Mangler.hs
+++ b/compiler/GHC/CmmToLlvm/Mangler.hs
@@ -17,15 +17,16 @@ import GHC.Driver.Session ( DynFlags, targetPlatform )
 import GHC.Platform ( platformArch, Arch(..) )
 import GHC.Utils.Error ( withTiming )
 import GHC.Utils.Outputable ( text )
+import GHC.Utils.Logger
 
 import Control.Exception
 import qualified Data.ByteString.Char8 as B
 import System.IO
 
 -- | Read in assembly file and process
-llvmFixupAsm :: DynFlags -> FilePath -> FilePath -> IO ()
-llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-}
-    withTiming dflags (text "LLVM Mangler") id $
+llvmFixupAsm :: Logger -> DynFlags -> FilePath -> FilePath -> IO ()
+llvmFixupAsm logger dflags f1 f2 = {-# SCC "llvm_mangler" #-}
+    withTiming logger dflags (text "LLVM Mangler") id $
     withBinaryFile f1 ReadMode $ \r -> withBinaryFile f2 WriteMode $ \w -> do
         go r w
         hClose r