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

5 files changed, 170 insertions, 159 deletions

diff --git a/compiler/GHC/SysTools/Elf.hs b/compiler/GHC/SysTools/Elf.hs
index 197c30624f..7dbfea9d2b 100644
--- a/compiler/GHC/SysTools/Elf.hs
+++ b/compiler/GHC/SysTools/Elf.hs
@@ -24,6 +24,7 @@ import GHC.Utils.Error
 import GHC.Data.Maybe       (MaybeT(..),runMaybeT)
 import GHC.Utils.Misc       (charToC)
 import GHC.Utils.Outputable (text,hcat)
+import GHC.Utils.Logger
 
 import Control.Monad (when)
 import Data.Binary.Get
@@ -141,9 +142,9 @@ data ElfHeader = ElfHeader
 
 
 -- | Read the ELF header
-readElfHeader :: DynFlags -> ByteString -> IO (Maybe ElfHeader)
-readElfHeader dflags bs = runGetOrThrow getHeader bs `catchIO` \_ -> do
-    debugTraceMsg dflags 3 $
+readElfHeader :: Logger -> DynFlags -> ByteString -> IO (Maybe ElfHeader)
+readElfHeader logger dflags bs = runGetOrThrow getHeader bs `catchIO` \_ -> do
+    debugTraceMsg logger dflags 3 $
       text ("Unable to read ELF header")
     return Nothing
   where
@@ -194,13 +195,14 @@ data SectionTable = SectionTable
   }
 
 -- | Read the ELF section table
-readElfSectionTable :: DynFlags
+readElfSectionTable :: Logger
+                    -> DynFlags
                     -> ElfHeader
                     -> ByteString
                     -> IO (Maybe SectionTable)
 
-readElfSectionTable dflags hdr bs = action `catchIO` \_ -> do
-    debugTraceMsg dflags 3 $
+readElfSectionTable logger dflags hdr bs = action `catchIO` \_ -> do
+    debugTraceMsg logger dflags 3 $
       text ("Unable to read ELF section table")
     return Nothing
   where
@@ -245,15 +247,16 @@ data Section = Section
   }
 
 -- | Read a ELF section
-readElfSectionByIndex :: DynFlags
+readElfSectionByIndex :: Logger
+                      -> DynFlags
                       -> ElfHeader
                       -> SectionTable
                       -> Word64
                       -> ByteString
                       -> IO (Maybe Section)
 
-readElfSectionByIndex dflags hdr secTable i bs = action `catchIO` \_ -> do
-    debugTraceMsg dflags 3 $
+readElfSectionByIndex logger dflags hdr secTable i bs = action `catchIO` \_ -> do
+    debugTraceMsg logger dflags 3 $
       text ("Unable to read ELF section")
     return Nothing
   where
@@ -289,13 +292,14 @@ readElfSectionByIndex dflags hdr secTable i bs = action `catchIO` \_ -> do
 -- | Find a section from its name. Return the section contents.
 --
 -- We do not perform any check on the section type.
-findSectionFromName :: DynFlags
+findSectionFromName :: Logger
+                    -> DynFlags
                     -> ElfHeader
                     -> SectionTable
                     -> String
                     -> ByteString
                     -> IO (Maybe ByteString)
-findSectionFromName dflags hdr secTable name bs =
+findSectionFromName logger dflags hdr secTable name bs =
     rec [0..sectionEntryCount secTable - 1]
   where
     -- convert the required section name into a ByteString to perform
@@ -306,7 +310,7 @@ findSectionFromName dflags hdr secTable name bs =
     -- the matching one, if any
     rec []     = return Nothing
     rec (x:xs) = do
-      me <- readElfSectionByIndex dflags hdr secTable x bs
+      me <- readElfSectionByIndex logger dflags hdr secTable x bs
       case me of
         Just e | entryName e == name' -> return (Just (entryBS e))
         _                             -> rec xs
@@ -316,20 +320,21 @@ findSectionFromName dflags hdr secTable name bs =
 --
 -- If the section isn't found or if there is any parsing error, we return
 -- Nothing
-readElfSectionByName :: DynFlags
+readElfSectionByName :: Logger
+                     -> DynFlags
                      -> ByteString
                      -> String
                      -> IO (Maybe LBS.ByteString)
 
-readElfSectionByName dflags bs name = action `catchIO` \_ -> do
-    debugTraceMsg dflags 3 $
+readElfSectionByName logger dflags bs name = action `catchIO` \_ -> do
+    debugTraceMsg logger dflags 3 $
       text ("Unable to read ELF section \"" ++ name ++ "\"")
     return Nothing
   where
     action = runMaybeT $ do
-      hdr      <- MaybeT $ readElfHeader dflags bs
-      secTable <- MaybeT $ readElfSectionTable dflags hdr bs
-      MaybeT $ findSectionFromName dflags hdr secTable name bs
+      hdr      <- MaybeT $ readElfHeader logger dflags bs
+      secTable <- MaybeT $ readElfSectionTable logger dflags hdr bs
+      MaybeT $ findSectionFromName logger dflags hdr secTable name bs
 
 ------------------
 -- NOTE SECTIONS
@@ -339,14 +344,15 @@ readElfSectionByName dflags bs name = action `catchIO` \_ -> do
 --
 -- If you try to read a note from a section which does not support the Note
 -- format, the parsing is likely to fail and Nothing will be returned
-readElfNoteBS :: DynFlags
+readElfNoteBS :: Logger
+              -> DynFlags
               -> ByteString
               -> String
               -> String
               -> IO (Maybe LBS.ByteString)
 
-readElfNoteBS dflags bs sectionName noteId = action `catchIO`  \_ -> do
-    debugTraceMsg dflags 3 $
+readElfNoteBS logger dflags bs sectionName noteId = action `catchIO`  \_ -> do
+    debugTraceMsg logger dflags 3 $
          text ("Unable to read ELF note \"" ++ noteId ++
                "\" in section \"" ++ sectionName ++ "\"")
     return Nothing
@@ -380,29 +386,30 @@ readElfNoteBS dflags bs sectionName noteId = action `catchIO`  \_ -> do
 
 
     action = runMaybeT $ do
-      hdr  <- MaybeT $ readElfHeader dflags bs
-      sec  <- MaybeT $ readElfSectionByName dflags bs sectionName
+      hdr  <- MaybeT $ readElfHeader logger dflags bs
+      sec  <- MaybeT $ readElfSectionByName logger dflags bs sectionName
       MaybeT $ runGetOrThrow (findNote hdr) sec
 
 -- | read a Note as a String
 --
 -- If you try to read a note from a section which does not support the Note
 -- format, the parsing is likely to fail and Nothing will be returned
-readElfNoteAsString :: DynFlags
+readElfNoteAsString :: Logger
+                    -> DynFlags
                     -> FilePath
                     -> String
                     -> String
                     -> IO (Maybe String)
 
-readElfNoteAsString dflags path sectionName noteId = action `catchIO`  \_ -> do
-    debugTraceMsg dflags 3 $
+readElfNoteAsString logger dflags path sectionName noteId = action `catchIO`  \_ -> do
+    debugTraceMsg logger dflags 3 $
          text ("Unable to read ELF note \"" ++ noteId ++
                "\" in section \"" ++ sectionName ++ "\"")
     return Nothing
   where
     action = do
       bs   <- LBS.readFile path
-      note <- readElfNoteBS dflags bs sectionName noteId
+      note <- readElfNoteBS logger dflags bs sectionName noteId
       return (fmap B8.unpack note)
 
 
diff --git a/compiler/GHC/SysTools/FileCleanup.hs b/compiler/GHC/SysTools/FileCleanup.hs
index d8791e280c..1b73ad2812 100644
--- a/compiler/GHC/SysTools/FileCleanup.hs
+++ b/compiler/GHC/SysTools/FileCleanup.hs
@@ -12,6 +12,7 @@ import GHC.Prelude
 import GHC.Driver.Session
 import GHC.Utils.Error
 import GHC.Utils.Outputable
+import GHC.Utils.Logger
 import GHC.Utils.Misc
 import GHC.Utils.Exception as Exception
 import GHC.Driver.Phases
@@ -40,17 +41,17 @@ data TempFileLifetime
   -- runGhc(T)
   deriving (Show)
 
-cleanTempDirs :: DynFlags -> IO ()
-cleanTempDirs dflags
+cleanTempDirs :: Logger -> DynFlags -> IO ()
+cleanTempDirs logger dflags
    = unless (gopt Opt_KeepTmpFiles dflags)
    $ mask_
    $ do let ref = dirsToClean dflags
         ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)
-        removeTmpDirs dflags (Map.elems ds)
+        removeTmpDirs logger dflags (Map.elems ds)
 
 -- | Delete all files in @filesToClean dflags@.
-cleanTempFiles :: DynFlags -> IO ()
-cleanTempFiles dflags
+cleanTempFiles :: Logger -> DynFlags -> IO ()
+cleanTempFiles logger dflags
    = unless (gopt Opt_KeepTmpFiles dflags)
    $ mask_
    $ do let ref = filesToClean dflags
@@ -60,21 +61,21 @@ cleanTempFiles dflags
                 , ftcGhcSession = gs_files
                 } -> ( emptyFilesToClean
                      , Set.toList cm_files ++ Set.toList gs_files)
-        removeTmpFiles dflags to_delete
+        removeTmpFiles logger dflags to_delete
 
 -- | Delete all files in @filesToClean dflags@. That have lifetime
 -- TFL_CurrentModule.
 -- If a file must be cleaned eventually, but must survive a
 -- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession.
-cleanCurrentModuleTempFiles :: DynFlags -> IO ()
-cleanCurrentModuleTempFiles dflags
+cleanCurrentModuleTempFiles :: Logger -> DynFlags -> IO ()
+cleanCurrentModuleTempFiles logger dflags
    = unless (gopt Opt_KeepTmpFiles dflags)
    $ mask_
    $ do let ref = filesToClean dflags
         to_delete <- atomicModifyIORef' ref $
             \ftc@FilesToClean{ftcCurrentModule = cm_files} ->
                 (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files)
-        removeTmpFiles dflags to_delete
+        removeTmpFiles logger dflags to_delete
 
 -- | Ensure that new_files are cleaned on the next call of
 -- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime.
@@ -117,9 +118,9 @@ newTempSuffix dflags =
   atomicModifyIORef' (nextTempSuffix dflags) $ \n -> (n+1,n)
 
 -- Find a temporary name that doesn't already exist.
-newTempName :: DynFlags -> TempFileLifetime -> Suffix -> IO FilePath
-newTempName dflags lifetime extn
-  = do d <- getTempDir dflags
+newTempName :: Logger -> DynFlags -> TempFileLifetime -> Suffix -> IO FilePath
+newTempName logger dflags lifetime extn
+  = do d <- getTempDir logger dflags
        findTempName (d </> "ghc_") -- See Note [Deterministic base name]
   where
     findTempName :: FilePath -> IO FilePath
@@ -132,9 +133,9 @@ newTempName dflags lifetime extn
                         addFilesToClean dflags lifetime [filename]
                         return filename
 
-newTempDir :: DynFlags -> IO FilePath
-newTempDir dflags
-  = do d <- getTempDir dflags
+newTempDir :: Logger -> DynFlags -> IO FilePath
+newTempDir logger dflags
+  = do d <- getTempDir logger dflags
        findTempDir (d </> "ghc_")
   where
     findTempDir :: FilePath -> IO FilePath
@@ -147,10 +148,10 @@ newTempDir dflags
                         -- see mkTempDir below; this is wrong: -> consIORef (dirsToClean dflags) filename
                         return filename
 
-newTempLibName :: DynFlags -> TempFileLifetime -> Suffix
+newTempLibName :: Logger -> DynFlags -> TempFileLifetime -> Suffix
   -> IO (FilePath, FilePath, String)
-newTempLibName dflags lifetime extn
-  = do d <- getTempDir dflags
+newTempLibName logger dflags lifetime extn
+  = do d <- getTempDir logger dflags
        findTempName d ("ghc_")
   where
     findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
@@ -167,8 +168,8 @@ newTempLibName dflags lifetime extn
 
 -- Return our temporary directory within tmp_dir, creating one if we
 -- don't have one yet.
-getTempDir :: DynFlags -> IO FilePath
-getTempDir dflags = do
+getTempDir :: Logger -> DynFlags -> IO FilePath
+getTempDir logger dflags = do
     mapping <- readIORef dir_ref
     case Map.lookup tmp_dir mapping of
         Nothing -> do
@@ -199,7 +200,7 @@ getTempDir dflags = do
         -- directory we created.  Otherwise return the directory we created.
         case their_dir of
             Nothing  -> do
-                debugTraceMsg dflags 2 $
+                debugTraceMsg logger dflags 2 $
                     text "Created temporary directory:" <+> text our_dir
                 return our_dir
             Just dir -> do
@@ -219,18 +220,18 @@ the process id).
 
 This is ok, as the temporary directory used contains the pid (see getTempDir).
 -}
-removeTmpDirs :: DynFlags -> [FilePath] -> IO ()
-removeTmpDirs dflags ds
-  = traceCmd dflags "Deleting temp dirs"
+removeTmpDirs :: Logger -> DynFlags -> [FilePath] -> IO ()
+removeTmpDirs logger dflags ds
+  = traceCmd logger dflags "Deleting temp dirs"
              ("Deleting: " ++ unwords ds)
-             (mapM_ (removeWith dflags removeDirectory) ds)
+             (mapM_ (removeWith logger dflags removeDirectory) ds)
 
-removeTmpFiles :: DynFlags -> [FilePath] -> IO ()
-removeTmpFiles dflags fs
+removeTmpFiles :: Logger -> DynFlags -> [FilePath] -> IO ()
+removeTmpFiles logger dflags fs
   = warnNon $
-    traceCmd dflags "Deleting temp files"
+    traceCmd logger dflags "Deleting temp files"
              ("Deleting: " ++ unwords deletees)
-             (mapM_ (removeWith dflags removeFile) deletees)
+             (mapM_ (removeWith logger dflags removeFile) deletees)
   where
      -- Flat out refuse to delete files that are likely to be source input
      -- files (is there a worse bug than having a compiler delete your source
@@ -241,21 +242,21 @@ removeTmpFiles dflags fs
     warnNon act
      | null non_deletees = act
      | otherwise         = do
-        putMsg dflags (text "WARNING - NOT deleting source files:"
+        putMsg logger dflags (text "WARNING - NOT deleting source files:"
                        <+> hsep (map text non_deletees))
         act
 
     (non_deletees, deletees) = partition isHaskellUserSrcFilename fs
 
-removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
-removeWith dflags remover f = remover f `catchIO`
+removeWith :: Logger -> DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
+removeWith logger dflags remover f = remover f `catchIO`
   (\e ->
    let msg = if isDoesNotExistError e
              then text "Warning: deleting non-existent" <+> text f
              else text "Warning: exception raised when deleting"
                                             <+> text f <> colon
                $$ text (show e)
-   in debugTraceMsg dflags 2 msg
+   in debugTraceMsg logger dflags 2 msg
   )
 
 #if defined(mingw32_HOST_OS)
diff --git a/compiler/GHC/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs
index 89a81a7b7b..b53d0fb567 100644
--- a/compiler/GHC/SysTools/Info.hs
+++ b/compiler/GHC/SysTools/Info.hs
@@ -13,6 +13,7 @@ import GHC.Utils.Error
 import GHC.Driver.Session
 import GHC.Utils.Outputable
 import GHC.Utils.Misc
+import GHC.Utils.Logger
 
 import Data.List ( isInfixOf, isPrefixOf )
 import Data.IORef
@@ -103,19 +104,19 @@ neededLinkArgs (AixLD o)     = o
 neededLinkArgs UnknownLD     = []
 
 -- Grab linker info and cache it in DynFlags.
-getLinkerInfo :: DynFlags -> IO LinkerInfo
-getLinkerInfo dflags = do
+getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo
+getLinkerInfo logger dflags = do
   info <- readIORef (rtldInfo dflags)
   case info of
     Just v  -> return v
     Nothing -> do
-      v <- getLinkerInfo' dflags
+      v <- getLinkerInfo' logger dflags
       writeIORef (rtldInfo dflags) (Just v)
       return v
 
 -- See Note [Run-time linker info].
-getLinkerInfo' :: DynFlags -> IO LinkerInfo
-getLinkerInfo' dflags = do
+getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo
+getLinkerInfo' logger dflags = do
   let platform = targetPlatform dflags
       os = platformOS platform
       (pgm,args0) = pgm_l dflags
@@ -194,10 +195,10 @@ getLinkerInfo' dflags = do
         parseLinkerInfo (lines stdo) (lines stde) exitc
     )
     (\err -> do
-        debugTraceMsg dflags 2
+        debugTraceMsg logger dflags 2
             (text "Error (figuring out linker information):" <+>
              text (show err))
-        errorMsg dflags $ hang (text "Warning:") 9 $
+        errorMsg logger dflags $ hang (text "Warning:") 9 $
           text "Couldn't figure out linker information!" $$
           text "Make sure you're using GNU ld, GNU gold" <+>
           text "or the built in OS X linker, etc."
@@ -205,19 +206,19 @@ getLinkerInfo' dflags = do
     )
 
 -- Grab compiler info and cache it in DynFlags.
-getCompilerInfo :: DynFlags -> IO CompilerInfo
-getCompilerInfo dflags = do
+getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo
+getCompilerInfo logger dflags = do
   info <- readIORef (rtccInfo dflags)
   case info of
     Just v  -> return v
     Nothing -> do
-      v <- getCompilerInfo' dflags
+      v <- getCompilerInfo' logger dflags
       writeIORef (rtccInfo dflags) (Just v)
       return v
 
 -- See Note [Run-time linker info].
-getCompilerInfo' :: DynFlags -> IO CompilerInfo
-getCompilerInfo' dflags = do
+getCompilerInfo' :: Logger -> DynFlags -> IO CompilerInfo
+getCompilerInfo' logger dflags = do
   let pgm = pgm_c dflags
       -- Try to grab the info from the process output.
       parseCompilerInfo _stdo stde _exitc
@@ -251,10 +252,10 @@ getCompilerInfo' dflags = do
       parseCompilerInfo (lines stdo) (lines stde) exitc
       )
       (\err -> do
-          debugTraceMsg dflags 2
+          debugTraceMsg logger dflags 2
               (text "Error (figuring out C compiler information):" <+>
                text (show err))
-          errorMsg dflags $ hang (text "Warning:") 9 $
+          errorMsg logger dflags $ hang (text "Warning:") 9 $
             text "Couldn't figure out C compiler information!" $$
             text "Make sure you're using GNU gcc, or clang"
           return UnknownCC
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index 62f3f0d258..df12cb4af7 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -18,7 +18,8 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Prelude
 import GHC.Utils.Misc
-import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
+import GHC.Utils.Logger
+import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, mkSrcSpan )
 
 import Control.Concurrent
 import Data.Char
@@ -132,7 +133,8 @@ getGccEnv opts =
 -----------------------------------------------------------------------------
 -- Running an external program
 
-runSomething :: DynFlags
+runSomething :: Logger
+             -> DynFlags
              -> String          -- For -v message
              -> String          -- Command name (possibly a full path)
                                 --      assumed already dos-ified
@@ -140,8 +142,8 @@ runSomething :: DynFlags
                                 --      runSomething will dos-ify them
              -> IO ()
 
-runSomething dflags phase_name pgm args =
-  runSomethingFiltered dflags id phase_name pgm args Nothing Nothing
+runSomething logger dflags phase_name pgm args =
+  runSomethingFiltered logger dflags id phase_name pgm args Nothing Nothing
 
 -- | Run a command, placing the arguments in an external response file.
 --
@@ -153,18 +155,18 @@ runSomething dflags phase_name pgm args =
 --     https://gcc.gnu.org/wiki/Response_Files
 --     https://gitlab.haskell.org/ghc/ghc/issues/10777
 runSomethingResponseFile
-  :: DynFlags -> (String->String) -> String -> String -> [Option]
+  :: Logger -> DynFlags -> (String->String) -> String -> String -> [Option]
   -> Maybe [(String,String)] -> IO ()
 
-runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =
-    runSomethingWith dflags phase_name pgm args $ \real_args -> do
+runSomethingResponseFile logger dflags filter_fn phase_name pgm args mb_env =
+    runSomethingWith logger dflags phase_name pgm args $ \real_args -> do
         fp <- getResponseFile real_args
         let args = ['@':fp]
-        r <- builderMainLoop dflags filter_fn pgm args Nothing mb_env
+        r <- builderMainLoop logger dflags filter_fn pgm args Nothing mb_env
         return (r,())
   where
     getResponseFile args = do
-      fp <- newTempName dflags TFL_CurrentModule "rsp"
+      fp <- newTempName logger dflags TFL_CurrentModule "rsp"
       withFile fp WriteMode $ \h -> do
 #if defined(mingw32_HOST_OS)
           hSetEncoding h latin1
@@ -200,23 +202,23 @@ runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =
         ]
 
 runSomethingFiltered
-  :: DynFlags -> (String->String) -> String -> String -> [Option]
+  :: Logger -> DynFlags -> (String->String) -> String -> String -> [Option]
   -> Maybe FilePath -> Maybe [(String,String)] -> IO ()
 
-runSomethingFiltered dflags filter_fn phase_name pgm args mb_cwd mb_env =
-    runSomethingWith dflags phase_name pgm args $ \real_args -> do
-        r <- builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env
+runSomethingFiltered logger dflags filter_fn phase_name pgm args mb_cwd mb_env =
+    runSomethingWith logger dflags phase_name pgm args $ \real_args -> do
+        r <- builderMainLoop logger dflags filter_fn pgm real_args mb_cwd mb_env
         return (r,())
 
 runSomethingWith
-  :: DynFlags -> String -> String -> [Option]
+  :: Logger -> DynFlags -> String -> String -> [Option]
   -> ([String] -> IO (ExitCode, a))
   -> IO a
 
-runSomethingWith dflags phase_name pgm args io = do
+runSomethingWith logger dflags phase_name pgm args io = do
   let real_args = filter notNull (map showOpt args)
       cmdLine = showCommandForUser pgm real_args
-  traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
+  traceCmd logger dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
 
 handleProc :: String -> String -> IO (ExitCode, r) -> IO r
 handleProc pgm phase_name proc = do
@@ -236,10 +238,10 @@ handleProc pgm phase_name proc = do
     does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
 
 
-builderMainLoop :: DynFlags -> (String -> String) -> FilePath
+builderMainLoop :: Logger -> DynFlags -> (String -> String) -> FilePath
                 -> [String] -> Maybe FilePath -> Maybe [(String, String)]
                 -> IO ExitCode
-builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do
+builderMainLoop logger dflags filter_fn pgm real_args mb_cwd mb_env = do
   chan <- newChan
 
   -- We use a mask here rather than a bracket because we want
@@ -300,11 +302,10 @@ builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do
       msg <- readChan chan
       case msg of
         BuildMsg msg -> do
-          putLogMsg dflags NoReason SevInfo noSrcSpan
-              $ withPprStyle defaultUserStyle msg
+          logInfo logger dflags $ withPprStyle defaultUserStyle msg
           log_loop chan t
         BuildError loc msg -> do
-          putLogMsg dflags NoReason SevError (mkSrcSpan loc loc)
+          putLogMsg logger dflags NoReason SevError (mkSrcSpan loc loc)
               $ withPprStyle defaultUserStyle msg
           log_loop chan t
         EOF ->
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index f71958f276..b802623325 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -24,6 +24,7 @@ import GHC.Utils.Exception as Exception
 import GHC.Utils.Error
 import GHC.Utils.Outputable
 import GHC.Utils.Misc
+import GHC.Utils.Logger
 
 import Data.List (tails, isPrefixOf)
 import System.IO
@@ -37,39 +38,39 @@ import System.Process
 ************************************************************************
 -}
 
-runUnlit :: DynFlags -> [Option] -> IO ()
-runUnlit dflags args = traceToolCommand dflags "unlit" $ do
+runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
+runUnlit logger dflags args = traceToolCommand logger dflags "unlit" $ do
   let prog = pgm_L dflags
       opts = getOpts dflags opt_L
-  runSomething dflags "Literate pre-processor" prog
+  runSomething logger dflags "Literate pre-processor" prog
                (map Option opts ++ args)
 
-runCpp :: DynFlags -> [Option] -> IO ()
-runCpp dflags args = traceToolCommand dflags "cpp" $ do
+runCpp :: Logger -> DynFlags -> [Option] -> IO ()
+runCpp logger dflags args = traceToolCommand logger dflags "cpp" $ do
   let (p,args0) = pgm_P dflags
       args1 = map Option (getOpts dflags opt_P)
       args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
                 ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
   mb_env <- getGccEnv args2
-  runSomethingFiltered dflags id  "C pre-processor" p
+  runSomethingFiltered logger dflags id  "C pre-processor" p
                        (args0 ++ args1 ++ args2 ++ args) Nothing mb_env
 
-runPp :: DynFlags -> [Option] -> IO ()
-runPp dflags args = traceToolCommand dflags "pp" $ do
+runPp :: Logger -> DynFlags -> [Option] -> IO ()
+runPp logger dflags args = traceToolCommand logger dflags "pp" $ do
   let prog = pgm_F dflags
       opts = map Option (getOpts dflags opt_F)
-  runSomething dflags "Haskell pre-processor" prog (args ++ opts)
+  runSomething logger dflags "Haskell pre-processor" prog (args ++ opts)
 
 -- | Run compiler of C-like languages and raw objects (such as gcc or clang).
-runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO ()
-runCc mLanguage dflags args = traceToolCommand dflags "cc" $ do
+runCc :: Maybe ForeignSrcLang -> Logger -> DynFlags -> [Option] -> IO ()
+runCc mLanguage logger dflags args = traceToolCommand logger dflags "cc" $ do
   let p = pgm_c dflags
       args1 = map Option userOpts
       args2 = languageOptions ++ args ++ args1
       -- We take care to pass -optc flags in args1 last to ensure that the
       -- user can override flags passed by GHC. See #14452.
   mb_env <- getGccEnv args2
-  runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env
+  runSomethingResponseFile logger dflags cc_filter "C Compiler" p args2 mb_env
  where
   -- discard some harmless warnings from gcc that we can't turn off
   cc_filter = unlines . doFilter . lines
@@ -143,44 +144,44 @@ isContainedIn :: String -> String -> Bool
 xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
 
 -- | Run the linker with some arguments and return the output
-askLd :: DynFlags -> [Option] -> IO String
-askLd dflags args = traceToolCommand dflags "linker" $ do
+askLd :: Logger -> DynFlags -> [Option] -> IO String
+askLd logger dflags args = traceToolCommand logger dflags "linker" $ do
   let (p,args0) = pgm_l dflags
       args1     = map Option (getOpts dflags opt_l)
       args2     = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
-  runSomethingWith dflags "gcc" p args2 $ \real_args ->
+  runSomethingWith logger dflags "gcc" p args2 $ \real_args ->
     readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
 
-runAs :: DynFlags -> [Option] -> IO ()
-runAs dflags args = traceToolCommand dflags "as" $ do
+runAs :: Logger -> DynFlags -> [Option] -> IO ()
+runAs logger dflags args = traceToolCommand logger dflags "as" $ do
   let (p,args0) = pgm_a dflags
       args1 = map Option (getOpts dflags opt_a)
       args2 = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
-  runSomethingFiltered dflags id "Assembler" p args2 Nothing mb_env
+  runSomethingFiltered logger dflags id "Assembler" p args2 Nothing mb_env
 
 -- | Run the LLVM Optimiser
-runLlvmOpt :: DynFlags -> [Option] -> IO ()
-runLlvmOpt dflags args = traceToolCommand dflags "opt" $ do
+runLlvmOpt :: Logger -> DynFlags -> [Option] -> IO ()
+runLlvmOpt logger dflags args = traceToolCommand logger dflags "opt" $ do
   let (p,args0) = pgm_lo dflags
       args1 = map Option (getOpts dflags opt_lo)
       -- We take care to pass -optlo flags (e.g. args0) last to ensure that the
       -- user can override flags passed by GHC. See #14821.
-  runSomething dflags "LLVM Optimiser" p (args1 ++ args ++ args0)
+  runSomething logger dflags "LLVM Optimiser" p (args1 ++ args ++ args0)
 
 -- | Run the LLVM Compiler
-runLlvmLlc :: DynFlags -> [Option] -> IO ()
-runLlvmLlc dflags args = traceToolCommand dflags "llc" $ do
+runLlvmLlc :: Logger -> DynFlags -> [Option] -> IO ()
+runLlvmLlc logger dflags args = traceToolCommand logger dflags "llc" $ do
   let (p,args0) = pgm_lc dflags
       args1 = map Option (getOpts dflags opt_lc)
-  runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
+  runSomething logger dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
 
 -- | Run the clang compiler (used as an assembler for the LLVM
 -- backend on OS X as LLVM doesn't support the OS X system
 -- assembler)
-runClang :: DynFlags -> [Option] -> IO ()
-runClang dflags args = traceToolCommand dflags "clang" $ do
+runClang :: Logger -> DynFlags -> [Option] -> IO ()
+runClang logger dflags args = traceToolCommand logger dflags "clang" $ do
   let (clang,_) = pgm_lcc dflags
       -- be careful what options we call clang with
       -- see #5903 and #7617 for bugs caused by this.
@@ -189,9 +190,9 @@ runClang dflags args = traceToolCommand dflags "clang" $ do
       args2 = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
   catch
-    (runSomethingFiltered dflags id "Clang (Assembler)" clang args2 Nothing mb_env)
+    (runSomethingFiltered logger dflags id "Clang (Assembler)" clang args2 Nothing mb_env)
     (\(err :: SomeException) -> do
-        errorMsg dflags $
+        errorMsg logger dflags $
             text ("Error running clang! you need clang installed to use the" ++
                   " LLVM backend") $+$
             text "(or GHC tried to execute clang incorrectly)"
@@ -199,8 +200,8 @@ runClang dflags args = traceToolCommand dflags "clang" $ do
     )
 
 -- | Figure out which version of LLVM we are running this session
-figureLlvmVersion :: DynFlags -> IO (Maybe LlvmVersion)
-figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do
+figureLlvmVersion :: Logger -> DynFlags -> IO (Maybe LlvmVersion)
+figureLlvmVersion logger dflags = traceToolCommand logger dflags "llc" $ do
   let (pgm,opts) = pgm_lc dflags
       args = filter notNull (map showOpt opts)
       -- we grab the args even though they should be useless just in
@@ -226,10 +227,10 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do
               return mb_ver
             )
             (\err -> do
-                debugTraceMsg dflags 2
+                debugTraceMsg logger dflags 2
                     (text "Error (figuring out LLVM version):" <+>
                       text (show err))
-                errorMsg dflags $ vcat
+                errorMsg logger dflags $ vcat
                     [ text "Warning:", nest 9 $
                           text "Couldn't figure out LLVM version!" $$
                           text ("Make sure you have installed LLVM " ++
@@ -238,19 +239,19 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do
 
 
 
-runLink :: DynFlags -> [Option] -> IO ()
-runLink dflags args = traceToolCommand dflags "linker" $ do
+runLink :: Logger -> DynFlags -> [Option] -> IO ()
+runLink logger dflags args = traceToolCommand logger dflags "linker" $ do
   -- See Note [Run-time linker info]
   --
   -- `-optl` args come at the end, so that later `-l` options
   -- given there manually can fill in symbols needed by
   -- Haskell libraries coming in via `args`.
-  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
+  linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags
   let (p,args0) = pgm_l dflags
       optl_args = map Option (getOpts dflags opt_l)
       args2     = args0 ++ linkargs ++ args ++ optl_args
   mb_env <- getGccEnv args2
-  runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env
+  runSomethingResponseFile logger dflags ld_filter "Linker" p args2 mb_env
   where
     ld_filter = case (platformOS (targetPlatform dflags)) of
                   OSSolaris2 -> sunos_ld_filter
@@ -302,8 +303,8 @@ ld: warning: symbol referencing errors
     ld_warning_found = not . null . snd . ld_warn_break
 
 -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
-runMergeObjects :: DynFlags -> [Option] -> IO ()
-runMergeObjects dflags args = traceToolCommand dflags "merge-objects" $ do
+runMergeObjects :: Logger -> DynFlags -> [Option] -> IO ()
+runMergeObjects logger dflags args = traceToolCommand logger dflags "merge-objects" $ do
   let (p,args0) = pgm_lm dflags
       optl_args = map Option (getOpts dflags opt_lm)
       args2     = args0 ++ args ++ optl_args
@@ -311,43 +312,43 @@ runMergeObjects dflags args = traceToolCommand dflags "merge-objects" $ do
   -- use them on Windows where they are truly necessary.
 #if defined(mingw32_HOST_OS)
   mb_env <- getGccEnv args2
-  runSomethingResponseFile dflags id "Merge objects" p args2 mb_env
+  runSomethingResponseFile logger dflags id "Merge objects" p args2 mb_env
 #else
-  runSomething dflags "Merge objects" p args2
+  runSomething logger dflags "Merge objects" p args2
 #endif
 
-runLibtool :: DynFlags -> [Option] -> IO ()
-runLibtool dflags args = traceToolCommand dflags "libtool" $ do
-  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
+runLibtool :: Logger -> DynFlags -> [Option] -> IO ()
+runLibtool logger dflags args = traceToolCommand logger dflags "libtool" $ do
+  linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags
   let args1      = map Option (getOpts dflags opt_l)
       args2      = [Option "-static"] ++ args1 ++ args ++ linkargs
       libtool    = pgm_libtool dflags
   mb_env <- getGccEnv args2
-  runSomethingFiltered dflags id "Libtool" libtool args2 Nothing mb_env
+  runSomethingFiltered logger dflags id "Libtool" libtool args2 Nothing mb_env
 
-runAr :: DynFlags -> Maybe FilePath -> [Option] -> IO ()
-runAr dflags cwd args = traceToolCommand dflags "ar" $ do
+runAr :: Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO ()
+runAr logger dflags cwd args = traceToolCommand logger dflags "ar" $ do
   let ar = pgm_ar dflags
-  runSomethingFiltered dflags id "Ar" ar args cwd Nothing
+  runSomethingFiltered logger dflags id "Ar" ar args cwd Nothing
 
-askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String
-askOtool dflags mb_cwd args = do
+askOtool :: Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO String
+askOtool logger dflags mb_cwd args = do
   let otool = pgm_otool dflags
-  runSomethingWith dflags "otool" otool args $ \real_args ->
+  runSomethingWith logger dflags "otool" otool args $ \real_args ->
     readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd }
 
-runInstallNameTool :: DynFlags -> [Option] -> IO ()
-runInstallNameTool dflags args = do
+runInstallNameTool :: Logger -> DynFlags -> [Option] -> IO ()
+runInstallNameTool logger dflags args = do
   let tool = pgm_install_name_tool dflags
-  runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing
+  runSomethingFiltered logger dflags id "Install Name Tool" tool args Nothing Nothing
 
-runRanlib :: DynFlags -> [Option] -> IO ()
-runRanlib dflags args = traceToolCommand dflags "ranlib" $ do
+runRanlib :: Logger -> DynFlags -> [Option] -> IO ()
+runRanlib logger dflags args = traceToolCommand logger dflags "ranlib" $ do
   let ranlib = pgm_ranlib dflags
-  runSomethingFiltered dflags id "Ranlib" ranlib args Nothing Nothing
+  runSomethingFiltered logger dflags id "Ranlib" ranlib args Nothing Nothing
 
-runWindres :: DynFlags -> [Option] -> IO ()
-runWindres dflags args = traceToolCommand dflags "windres" $ do
+runWindres :: Logger -> DynFlags -> [Option] -> IO ()
+runWindres logger dflags args = traceToolCommand logger dflags "windres" $ do
   let cc = pgm_c dflags
       cc_args = map Option (sOpt_c (settings dflags))
       windres = pgm_windres dflags
@@ -367,11 +368,11 @@ runWindres dflags args = traceToolCommand dflags "windres" $ do
             : Option "--use-temp-file"
             : args
   mb_env <- getGccEnv cc_args
-  runSomethingFiltered dflags id "Windres" windres args' Nothing mb_env
+  runSomethingFiltered logger dflags id "Windres" windres args' Nothing mb_env
 
-touch :: DynFlags -> String -> String -> IO ()
-touch dflags purpose arg = traceToolCommand dflags "touch" $
-  runSomething dflags purpose (pgm_T dflags) [FileOption "" arg]
+touch :: Logger -> DynFlags -> String -> String -> IO ()
+touch logger dflags purpose arg = traceToolCommand logger dflags "touch" $
+  runSomething logger dflags purpose (pgm_T dflags) [FileOption "" arg]
 
 -- * Tracing utility
 
@@ -382,6 +383,6 @@ touch dflags purpose arg = traceToolCommand dflags "touch" $
 --
 --   For those events to show up in the eventlog, you need
 --   to run GHC with @-v2@ or @-ddump-timings@.
-traceToolCommand :: DynFlags -> String -> IO a -> IO a
-traceToolCommand dflags tool = withTiming
+traceToolCommand :: Logger -> DynFlags -> String -> IO a -> IO a
+traceToolCommand logger dflags tool = withTiming logger
   dflags (text $ "systool:" ++ tool) (const ())