Make Logger independent of DynFlags

Introduce LogFlags as a independent subset of DynFlags used for logging.
As a consequence in many places we don't have to pass both Logger and
DynFlags anymore.

The main reason for this refactoring is that I want to refactor the
systools interfaces: for now many systools functions use DynFlags both
to use the Logger and to fetch their parameters (e.g. ldInputs for the
linker). I'm interested in refactoring the way they fetch their
parameters (i.e. use dedicated XxxOpts data types instead of DynFlags)
for #19877. But if I did this refactoring before refactoring the Logger,
we would have duplicate parameters (e.g. ldInputs from DynFlags and
linkerInputs from LinkerOpts). Hence this patch first.

Some flags don't really belong to LogFlags because they are subsystem
specific (e.g. most DumpFlags). For example -ddump-asm should better be
passed in NCGConfig somehow. This patch doesn't fix this tight coupling:
the dump flags are part of the UI but they are passed all the way down
for example to infer the file name for the dumps.

Because LogFlags are a subset of the DynFlags, we must update the former
when the latter changes (not so often). As a consequence we now use
accessors to read/write DynFlags in HscEnv instead of using `hsc_dflags`
directly.

In the process I've also made some subsystems less dependent on DynFlags:

- CmmToAsm: by passing some missing flags via NCGConfig (see new fields
  in GHC.CmmToAsm.Config)
- Core.Opt.*:
    - by passing -dinline-check value into UnfoldingOpts
    - by fixing some Core passes interfaces (e.g. CallArity, FloatIn)
      that took DynFlags argument for no good reason.
    - as a side-effect GHC.Core.Opt.Pipeline.doCorePass is much less
      convoluted.

4 files changed, 82 insertions, 91 deletions

diff --git a/compiler/GHC/SysTools/Elf.hs b/compiler/GHC/SysTools/Elf.hs
index 7dbfea9d2b..da517e25dd 100644
--- a/compiler/GHC/SysTools/Elf.hs
+++ b/compiler/GHC/SysTools/Elf.hs
@@ -18,7 +18,6 @@ import GHC.Prelude
 
 import GHC.Utils.Asm
 import GHC.Utils.Exception
-import GHC.Driver.Session
 import GHC.Platform
 import GHC.Utils.Error
 import GHC.Data.Maybe       (MaybeT(..),runMaybeT)
@@ -142,9 +141,9 @@ data ElfHeader = ElfHeader
 
 
 -- | Read the ELF header
-readElfHeader :: Logger -> DynFlags -> ByteString -> IO (Maybe ElfHeader)
-readElfHeader logger dflags bs = runGetOrThrow getHeader bs `catchIO` \_ -> do
-    debugTraceMsg logger dflags 3 $
+readElfHeader :: Logger -> ByteString -> IO (Maybe ElfHeader)
+readElfHeader logger bs = runGetOrThrow getHeader bs `catchIO` \_ -> do
+    debugTraceMsg logger 3 $
       text ("Unable to read ELF header")
     return Nothing
   where
@@ -196,13 +195,12 @@ data SectionTable = SectionTable
 
 -- | Read the ELF section table
 readElfSectionTable :: Logger
-                    -> DynFlags
                     -> ElfHeader
                     -> ByteString
                     -> IO (Maybe SectionTable)
 
-readElfSectionTable logger dflags hdr bs = action `catchIO` \_ -> do
-    debugTraceMsg logger dflags 3 $
+readElfSectionTable logger hdr bs = action `catchIO` \_ -> do
+    debugTraceMsg logger 3 $
       text ("Unable to read ELF section table")
     return Nothing
   where
@@ -248,15 +246,14 @@ data Section = Section
 
 -- | Read a ELF section
 readElfSectionByIndex :: Logger
-                      -> DynFlags
                       -> ElfHeader
                       -> SectionTable
                       -> Word64
                       -> ByteString
                       -> IO (Maybe Section)
 
-readElfSectionByIndex logger dflags hdr secTable i bs = action `catchIO` \_ -> do
-    debugTraceMsg logger dflags 3 $
+readElfSectionByIndex logger hdr secTable i bs = action `catchIO` \_ -> do
+    debugTraceMsg logger 3 $
       text ("Unable to read ELF section")
     return Nothing
   where
@@ -293,13 +290,12 @@ readElfSectionByIndex logger dflags hdr secTable i bs = action `catchIO` \_ -> d
 --
 -- We do not perform any check on the section type.
 findSectionFromName :: Logger
-                    -> DynFlags
                     -> ElfHeader
                     -> SectionTable
                     -> String
                     -> ByteString
                     -> IO (Maybe ByteString)
-findSectionFromName logger dflags hdr secTable name bs =
+findSectionFromName logger hdr secTable name bs =
     rec [0..sectionEntryCount secTable - 1]
   where
     -- convert the required section name into a ByteString to perform
@@ -310,7 +306,7 @@ findSectionFromName logger dflags hdr secTable name bs =
     -- the matching one, if any
     rec []     = return Nothing
     rec (x:xs) = do
-      me <- readElfSectionByIndex logger dflags hdr secTable x bs
+      me <- readElfSectionByIndex logger hdr secTable x bs
       case me of
         Just e | entryName e == name' -> return (Just (entryBS e))
         _                             -> rec xs
@@ -321,20 +317,19 @@ findSectionFromName logger dflags hdr secTable name bs =
 -- If the section isn't found or if there is any parsing error, we return
 -- Nothing
 readElfSectionByName :: Logger
-                     -> DynFlags
                      -> ByteString
                      -> String
                      -> IO (Maybe LBS.ByteString)
 
-readElfSectionByName logger dflags bs name = action `catchIO` \_ -> do
-    debugTraceMsg logger dflags 3 $
+readElfSectionByName logger bs name = action `catchIO` \_ -> do
+    debugTraceMsg logger 3 $
       text ("Unable to read ELF section \"" ++ name ++ "\"")
     return Nothing
   where
     action = runMaybeT $ do
-      hdr      <- MaybeT $ readElfHeader logger dflags bs
-      secTable <- MaybeT $ readElfSectionTable logger dflags hdr bs
-      MaybeT $ findSectionFromName logger dflags hdr secTable name bs
+      hdr      <- MaybeT $ readElfHeader logger bs
+      secTable <- MaybeT $ readElfSectionTable logger hdr bs
+      MaybeT $ findSectionFromName logger hdr secTable name bs
 
 ------------------
 -- NOTE SECTIONS
@@ -345,14 +340,13 @@ readElfSectionByName logger 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 :: Logger
-              -> DynFlags
               -> ByteString
               -> String
               -> String
               -> IO (Maybe LBS.ByteString)
 
-readElfNoteBS logger dflags bs sectionName noteId = action `catchIO`  \_ -> do
-    debugTraceMsg logger dflags 3 $
+readElfNoteBS logger bs sectionName noteId = action `catchIO`  \_ -> do
+    debugTraceMsg logger 3 $
          text ("Unable to read ELF note \"" ++ noteId ++
                "\" in section \"" ++ sectionName ++ "\"")
     return Nothing
@@ -386,8 +380,8 @@ readElfNoteBS logger dflags bs sectionName noteId = action `catchIO`  \_ -> do
 
 
     action = runMaybeT $ do
-      hdr  <- MaybeT $ readElfHeader logger dflags bs
-      sec  <- MaybeT $ readElfSectionByName logger dflags bs sectionName
+      hdr  <- MaybeT $ readElfHeader logger bs
+      sec  <- MaybeT $ readElfSectionByName logger bs sectionName
       MaybeT $ runGetOrThrow (findNote hdr) sec
 
 -- | read a Note as a String
@@ -395,21 +389,20 @@ readElfNoteBS logger dflags bs sectionName noteId = 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
 readElfNoteAsString :: Logger
-                    -> DynFlags
                     -> FilePath
                     -> String
                     -> String
                     -> IO (Maybe String)
 
-readElfNoteAsString logger dflags path sectionName noteId = action `catchIO`  \_ -> do
-    debugTraceMsg logger dflags 3 $
+readElfNoteAsString logger path sectionName noteId = action `catchIO`  \_ -> do
+    debugTraceMsg logger 3 $
          text ("Unable to read ELF note \"" ++ noteId ++
                "\" in section \"" ++ sectionName ++ "\"")
     return Nothing
   where
     action = do
       bs   <- LBS.readFile path
-      note <- readElfNoteBS logger dflags bs sectionName noteId
+      note <- readElfNoteBS logger bs sectionName noteId
       return (fmap B8.unpack note)
 
 
diff --git a/compiler/GHC/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs
index 733c2eaade..12be61ea0b 100644
--- a/compiler/GHC/SysTools/Info.hs
+++ b/compiler/GHC/SysTools/Info.hs
@@ -195,10 +195,10 @@ getLinkerInfo' logger dflags = do
         parseLinkerInfo (lines stdo) (lines stde) exitc
     )
     (\err -> do
-        debugTraceMsg logger dflags 2
+        debugTraceMsg logger 2
             (text "Error (figuring out linker information):" <+>
              text (show err))
-        errorMsg logger dflags $ hang (text "Warning:") 9 $
+        errorMsg logger $ 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."
@@ -213,7 +213,7 @@ getCompilerInfo logger dflags = do
     Just v  -> return v
     Nothing -> do
       let pgm = pgm_c dflags
-      v <- getCompilerInfo' logger dflags pgm
+      v <- getCompilerInfo' logger pgm
       writeIORef (rtccInfo dflags) (Just v)
       return v
 
@@ -225,13 +225,13 @@ getAssemblerInfo logger dflags = do
     Just v  -> return v
     Nothing -> do
       let (pgm, _) = pgm_a dflags
-      v <- getCompilerInfo' logger dflags pgm
+      v <- getCompilerInfo' logger pgm
       writeIORef (rtasmInfo dflags) (Just v)
       return v
 
 -- See Note [Run-time linker info].
-getCompilerInfo' :: Logger -> DynFlags -> String -> IO CompilerInfo
-getCompilerInfo' logger dflags pgm = do
+getCompilerInfo' :: Logger -> String -> IO CompilerInfo
+getCompilerInfo' logger pgm = do
   let -- Try to grab the info from the process output.
       parseCompilerInfo _stdo stde _exitc
         -- Regular GCC
@@ -264,10 +264,10 @@ getCompilerInfo' logger dflags pgm = do
       parseCompilerInfo (lines stdo) (lines stde) exitc
       )
       (\err -> do
-          debugTraceMsg logger dflags 2
+          debugTraceMsg logger 2
               (text "Error (figuring out C compiler information):" <+>
                text (show err))
-          errorMsg logger dflags $ hang (text "Warning:") 9 $
+          errorMsg logger $ 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 7328a1c57f..6cb322363d 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -131,7 +131,6 @@ getGccEnv opts =
 -- Running an external program
 
 runSomething :: Logger
-             -> DynFlags
              -> String          -- For -v message
              -> String          -- Command name (possibly a full path)
                                 --      assumed already dos-ified
@@ -139,8 +138,8 @@ runSomething :: Logger
                                 --      runSomething will dos-ify them
              -> IO ()
 
-runSomething logger dflags phase_name pgm args =
-  runSomethingFiltered logger dflags id phase_name pgm args Nothing Nothing
+runSomething logger phase_name pgm args =
+  runSomethingFiltered logger id phase_name pgm args Nothing Nothing
 
 -- | Run a command, placing the arguments in an external response file.
 --
@@ -162,10 +161,10 @@ runSomethingResponseFile
   -> Maybe [(String,String)]
   -> IO ()
 runSomethingResponseFile logger tmpfs dflags filter_fn phase_name pgm args mb_env =
-    runSomethingWith logger dflags phase_name pgm args $ \real_args -> do
+    runSomethingWith logger phase_name pgm args $ \real_args -> do
         fp <- getResponseFile real_args
         let args = ['@':fp]
-        r <- builderMainLoop logger dflags filter_fn pgm args Nothing mb_env
+        r <- builderMainLoop logger filter_fn pgm args Nothing mb_env
         return (r,())
   where
     getResponseFile args = do
@@ -205,23 +204,23 @@ runSomethingResponseFile logger tmpfs dflags filter_fn phase_name pgm args mb_en
         ]
 
 runSomethingFiltered
-  :: Logger -> DynFlags -> (String->String) -> String -> String -> [Option]
+  :: Logger -> (String->String) -> String -> String -> [Option]
   -> Maybe FilePath -> Maybe [(String,String)] -> IO ()
 
-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
+runSomethingFiltered logger filter_fn phase_name pgm args mb_cwd mb_env =
+    runSomethingWith logger phase_name pgm args $ \real_args -> do
+        r <- builderMainLoop logger filter_fn pgm real_args mb_cwd mb_env
         return (r,())
 
 runSomethingWith
-  :: Logger -> DynFlags -> String -> String -> [Option]
+  :: Logger -> String -> String -> [Option]
   -> ([String] -> IO (ExitCode, a))
   -> IO a
 
-runSomethingWith logger dflags phase_name pgm args io = do
+runSomethingWith logger phase_name pgm args io = do
   let real_args = filter notNull (map showOpt args)
       cmdLine = showCommandForUser pgm real_args
-  traceCmd logger dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
+  traceCmd logger phase_name cmdLine $ handleProc pgm phase_name $ io real_args
 
 handleProc :: String -> String -> IO (ExitCode, r) -> IO r
 handleProc pgm phase_name proc = do
@@ -241,10 +240,10 @@ handleProc pgm phase_name proc = do
     does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
 
 
-builderMainLoop :: Logger -> DynFlags -> (String -> String) -> FilePath
+builderMainLoop :: Logger -> (String -> String) -> FilePath
                 -> [String] -> Maybe FilePath -> Maybe [(String, String)]
                 -> IO ExitCode
-builderMainLoop logger dflags filter_fn pgm real_args mb_cwd mb_env = do
+builderMainLoop logger filter_fn pgm real_args mb_cwd mb_env = do
   chan <- newChan
 
   -- We use a mask here rather than a bracket because we want
@@ -305,10 +304,10 @@ builderMainLoop logger dflags filter_fn pgm real_args mb_cwd mb_env = do
       msg <- readChan chan
       case msg of
         BuildMsg msg -> do
-          logInfo logger dflags $ withPprStyle defaultUserStyle msg
+          logInfo logger $ withPprStyle defaultUserStyle msg
           log_loop chan t
         BuildError loc msg -> do
-          putLogMsg logger dflags errorDiagnostic (mkSrcSpan loc loc)
+          logMsg logger errorDiagnostic (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 ce286fe8ca..6fec3a8839 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -42,31 +42,31 @@ import System.Process
 -}
 
 runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
-runUnlit logger dflags args = traceToolCommand logger dflags "unlit" $ do
+runUnlit logger dflags args = traceToolCommand logger "unlit" $ do
   let prog = pgm_L dflags
       opts = getOpts dflags opt_L
-  runSomething logger dflags "Literate pre-processor" prog
+  runSomething logger "Literate pre-processor" prog
                (map Option opts ++ args)
 
 runCpp :: Logger -> DynFlags -> [Option] -> IO ()
-runCpp logger dflags args = traceToolCommand logger dflags "cpp" $ do
+runCpp logger dflags args = traceToolCommand logger "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 logger dflags id  "C pre-processor" p
+  runSomethingFiltered logger id  "C pre-processor" p
                        (args0 ++ args1 ++ args2 ++ args) Nothing mb_env
 
 runPp :: Logger -> DynFlags -> [Option] -> IO ()
-runPp logger dflags args = traceToolCommand logger dflags "pp" $ do
+runPp logger dflags args = traceToolCommand logger "pp" $ do
   let prog = pgm_F dflags
       opts = map Option (getOpts dflags opt_F)
-  runSomething logger dflags "Haskell pre-processor" prog (args ++ opts)
+  runSomething logger "Haskell pre-processor" prog (args ++ opts)
 
 -- | Run compiler of C-like languages and raw objects (such as gcc or clang).
 runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
-runCc mLanguage logger tmpfs dflags args = traceToolCommand logger dflags "cc" $ do
+runCc mLanguage logger tmpfs dflags args = traceToolCommand logger "cc" $ do
   let p = pgm_c dflags
       args1 = map Option userOpts
       args2 = languageOptions ++ args ++ args1
@@ -148,43 +148,43 @@ xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
 
 -- | Run the linker with some arguments and return the output
 askLd :: Logger -> DynFlags -> [Option] -> IO String
-askLd logger dflags args = traceToolCommand logger dflags "linker" $ do
+askLd logger dflags args = traceToolCommand logger "linker" $ do
   let (p,args0) = pgm_l dflags
       args1     = map Option (getOpts dflags opt_l)
       args2     = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
-  runSomethingWith logger dflags "gcc" p args2 $ \real_args ->
+  runSomethingWith logger "gcc" p args2 $ \real_args ->
     readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
 
 runAs :: Logger -> DynFlags -> [Option] -> IO ()
-runAs logger dflags args = traceToolCommand logger dflags "as" $ do
+runAs logger dflags args = traceToolCommand logger "as" $ do
   let (p,args0) = pgm_a dflags
       args1 = map Option (getOpts dflags opt_a)
       args2 = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
-  runSomethingFiltered logger dflags id "Assembler" p args2 Nothing mb_env
+  runSomethingFiltered logger id "Assembler" p args2 Nothing mb_env
 
 -- | Run the LLVM Optimiser
 runLlvmOpt :: Logger -> DynFlags -> [Option] -> IO ()
-runLlvmOpt logger dflags args = traceToolCommand logger dflags "opt" $ do
+runLlvmOpt logger dflags args = traceToolCommand logger "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 logger dflags "LLVM Optimiser" p (args1 ++ args ++ args0)
+  runSomething logger "LLVM Optimiser" p (args1 ++ args ++ args0)
 
 -- | Run the LLVM Compiler
 runLlvmLlc :: Logger -> DynFlags -> [Option] -> IO ()
-runLlvmLlc logger dflags args = traceToolCommand logger dflags "llc" $ do
+runLlvmLlc logger dflags args = traceToolCommand logger "llc" $ do
   let (p,args0) = pgm_lc dflags
       args1 = map Option (getOpts dflags opt_lc)
-  runSomething logger dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
+  runSomething logger "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 :: Logger -> DynFlags -> [Option] -> IO ()
-runClang logger dflags args = traceToolCommand logger dflags "clang" $ do
+runClang logger dflags args = traceToolCommand logger "clang" $ do
   let (clang,_) = pgm_lcc dflags
       -- be careful what options we call clang with
       -- see #5903 and #7617 for bugs caused by this.
@@ -193,9 +193,9 @@ runClang logger dflags args = traceToolCommand logger dflags "clang" $ do
       args2 = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
   catchException
-    (runSomethingFiltered logger dflags id "Clang (Assembler)" clang args2 Nothing mb_env)
+    (runSomethingFiltered logger id "Clang (Assembler)" clang args2 Nothing mb_env)
     (\(err :: SomeException) -> do
-        errorMsg logger dflags $
+        errorMsg logger $
             text ("Error running clang! you need clang installed to use the" ++
                   " LLVM backend") $+$
             text "(or GHC tried to execute clang incorrectly)"
@@ -204,7 +204,7 @@ runClang logger dflags args = traceToolCommand logger dflags "clang" $ do
 
 -- | Figure out which version of LLVM we are running this session
 figureLlvmVersion :: Logger -> DynFlags -> IO (Maybe LlvmVersion)
-figureLlvmVersion logger dflags = traceToolCommand logger dflags "llc" $ do
+figureLlvmVersion logger dflags = traceToolCommand logger "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
@@ -230,10 +230,10 @@ figureLlvmVersion logger dflags = traceToolCommand logger dflags "llc" $ do
               return mb_ver
             )
             (\err -> do
-                debugTraceMsg logger dflags 2
+                debugTraceMsg logger 2
                     (text "Error (figuring out LLVM version):" <+>
                       text (show err))
-                errorMsg logger dflags $ vcat
+                errorMsg logger $ vcat
                     [ text "Warning:", nest 9 $
                           text "Couldn't figure out LLVM version!" $$
                           text ("Make sure you have installed LLVM between "
@@ -245,7 +245,7 @@ figureLlvmVersion logger dflags = traceToolCommand logger dflags "llc" $ do
 
 
 runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
-runLink logger tmpfs dflags args = traceToolCommand logger dflags "linker" $ do
+runLink logger tmpfs dflags args = traceToolCommand logger "linker" $ do
   -- See Note [Run-time linker info]
   --
   -- `-optl` args come at the end, so that later `-l` options
@@ -310,7 +310,7 @@ ld: warning: symbol referencing errors
 -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
 runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
 runMergeObjects logger tmpfs dflags args =
-  traceToolCommand logger dflags "merge-objects" $ do
+  traceToolCommand logger "merge-objects" $ do
     let (p,args0) = pgm_lm dflags
         optl_args = map Option (getOpts dflags opt_lm)
         args2     = args0 ++ args ++ optl_args
@@ -321,40 +321,40 @@ runMergeObjects logger tmpfs dflags args =
         mb_env <- getGccEnv args2
         runSomethingResponseFile logger tmpfs dflags id "Merge objects" p args2 mb_env
       else do
-        runSomething logger dflags "Merge objects" p args2
+        runSomething logger "Merge objects" p args2
 
 runLibtool :: Logger -> DynFlags -> [Option] -> IO ()
-runLibtool logger dflags args = traceToolCommand logger dflags "libtool" $ do
+runLibtool logger dflags args = traceToolCommand logger "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 logger dflags id "Libtool" libtool args2 Nothing mb_env
+  runSomethingFiltered logger id "Libtool" libtool args2 Nothing mb_env
 
 runAr :: Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO ()
-runAr logger dflags cwd args = traceToolCommand logger dflags "ar" $ do
+runAr logger dflags cwd args = traceToolCommand logger "ar" $ do
   let ar = pgm_ar dflags
-  runSomethingFiltered logger dflags id "Ar" ar args cwd Nothing
+  runSomethingFiltered logger id "Ar" ar args cwd Nothing
 
 askOtool :: Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO String
 askOtool logger dflags mb_cwd args = do
   let otool = pgm_otool dflags
-  runSomethingWith logger dflags "otool" otool args $ \real_args ->
+  runSomethingWith logger "otool" otool args $ \real_args ->
     readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd }
 
 runInstallNameTool :: Logger -> DynFlags -> [Option] -> IO ()
 runInstallNameTool logger dflags args = do
   let tool = pgm_install_name_tool dflags
-  runSomethingFiltered logger dflags id "Install Name Tool" tool args Nothing Nothing
+  runSomethingFiltered logger id "Install Name Tool" tool args Nothing Nothing
 
 runRanlib :: Logger -> DynFlags -> [Option] -> IO ()
-runRanlib logger dflags args = traceToolCommand logger dflags "ranlib" $ do
+runRanlib logger dflags args = traceToolCommand logger "ranlib" $ do
   let ranlib = pgm_ranlib dflags
-  runSomethingFiltered logger dflags id "Ranlib" ranlib args Nothing Nothing
+  runSomethingFiltered logger id "Ranlib" ranlib args Nothing Nothing
 
 runWindres :: Logger -> DynFlags -> [Option] -> IO ()
-runWindres logger dflags args = traceToolCommand logger dflags "windres" $ do
+runWindres logger dflags args = traceToolCommand logger "windres" $ do
   let cc = pgm_c dflags
       cc_args = map Option (sOpt_c (settings dflags))
       windres = pgm_windres dflags
@@ -374,11 +374,11 @@ runWindres logger dflags args = traceToolCommand logger dflags "windres" $ do
             : Option "--use-temp-file"
             : args
   mb_env <- getGccEnv cc_args
-  runSomethingFiltered logger dflags id "Windres" windres args' Nothing mb_env
+  runSomethingFiltered logger id "Windres" windres args' Nothing mb_env
 
 touch :: Logger -> DynFlags -> String -> String -> IO ()
-touch logger dflags purpose arg = traceToolCommand logger dflags "touch" $
-  runSomething logger dflags purpose (pgm_T dflags) [FileOption "" arg]
+touch logger dflags purpose arg = traceToolCommand logger "touch" $
+  runSomething logger purpose (pgm_T dflags) [FileOption "" arg]
 
 -- * Tracing utility
 
@@ -389,6 +389,5 @@ touch logger dflags purpose arg = traceToolCommand logger dflags "touch" $
 --
 --   For those events to show up in the eventlog, you need
 --   to run GHC with @-v2@ or @-ddump-timings@.
-traceToolCommand :: Logger -> DynFlags -> String -> IO a -> IO a
-traceToolCommand logger dflags tool = withTiming logger
-  dflags (text $ "systool:" ++ tool) (const ())
+traceToolCommand :: Logger -> String -> IO a -> IO a
+traceToolCommand logger tool = withTiming logger (text "systool:" <> text tool) (const ())