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.

1 files changed, 38 insertions, 28 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 7e882dbd8b..20f0ec633a 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -310,7 +310,8 @@ import GHC.Driver.Errors.Types
 import GHC.Driver.CmdLine
 import GHC.Driver.Session
 import GHC.Driver.Backend
-import GHC.Driver.Config
+import GHC.Driver.Config.Parser (initParserOpts)
+import GHC.Driver.Config.Logger (initLogFlags)
 import GHC.Driver.Main
 import GHC.Driver.Make
 import GHC.Driver.Hooks
@@ -655,7 +656,7 @@ setSessionDynFlags dflags0 = do
              | otherwise = ""
            msg = text "Starting " <> text prog
          tr <- if verbosity dflags >= 3
-                then return (logInfo logger dflags $ withPprStyle defaultDumpStyle msg)
+                then return (logInfo logger $ withPprStyle defaultDumpStyle msg)
                 else return (pure ())
          let
           conf = IServConfig
@@ -687,13 +688,15 @@ setSessionDynFlags dflags0 = do
         , ue_units     = unit_state
         , ue_unit_dbs  = Just dbs
         }
-  modifySession $ \h -> h{ hsc_dflags = dflags
-                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags }
+
+  modifySession $ \h -> hscSetFlags dflags $
+                        h{ hsc_IC = (hsc_IC h){ ic_dflags = dflags }
                          , hsc_interp = hsc_interp h <|> interp
                            -- we only update the interpreter if there wasn't
                            -- already one set up
                          , hsc_unit_env = unit_env
                          }
+
   invalidateModSummaryCache
 
 -- | Sets the program 'DynFlags'.  Note: this invalidates the internal
@@ -728,10 +731,9 @@ setProgramDynFlags_ invalidate_needed dflags = do
               , ue_units     = unit_state
               , ue_unit_dbs  = Just dbs
               }
-        modifySession $ \h -> h{ hsc_dflags   = dflags1
-                               , hsc_unit_env = unit_env
-                               }
-    else modifySession $ \h -> h{ hsc_dflags = dflags0 }
+        modifySession $ \h -> hscSetFlags dflags1 $ h{ hsc_unit_env = unit_env }
+    else modifySession (hscSetFlags dflags0)
+
   when invalidate_needed $ invalidateModSummaryCache
   return changed
 
@@ -806,7 +808,10 @@ parseDynamicFlags
     -> m (DynFlags, [Located String], [Warn])
 parseDynamicFlags logger dflags cmdline = do
   (dflags1, leftovers, warns) <- parseDynamicFlagsCmdLine dflags cmdline
-  dflags2 <- liftIO $ interpretPackageEnv logger dflags1
+  -- flags that have just been read are used by the logger when loading package
+  -- env (this is checked by T16318)
+  let logger1 = setLogFlags logger (initLogFlags dflags1)
+  dflags2 <- liftIO $ interpretPackageEnv logger1 dflags1
   return (dflags2, leftovers, warns)
 
 -- | Parse command line arguments that look like files.
@@ -1132,9 +1137,10 @@ getModSummary mod = do
 parseModule :: GhcMonad m => ModSummary -> m ParsedModule
 parseModule ms = do
    hsc_env <- getSession
-   let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
-   hpm <- liftIO $ hscParse hsc_env_tmp ms
-   return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm))
+   liftIO $ do
+     let lcl_hsc_env = hscSetFlags (ms_hspp_opts ms) hsc_env
+     hpm <- hscParse lcl_hsc_env ms
+     return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm))
                -- See Note [exact print annotations] in GHC.Parser.Annotation
 
 -- | Typecheck and rename a parsed module.
@@ -1142,17 +1148,20 @@ parseModule ms = do
 -- Throws a 'SourceError' if either fails.
 typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
 typecheckModule pmod = do
- let ms = modSummary pmod
  hsc_env <- getSession
- let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
- (tc_gbl_env, rn_info)
-       <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
-                      HsParsedModule { hpm_module = parsedSource pmod,
-                                       hpm_src_files = pm_extra_src_files pmod }
- details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
- safe    <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
-
- return $
+
+ liftIO $ do
+   let ms          = modSummary pmod
+   let lcl_dflags  = ms_hspp_opts ms -- take into account pragmas (OPTIONS_GHC, etc.)
+   let lcl_hsc_env = hscSetFlags lcl_dflags hsc_env
+   let lcl_logger  = hsc_logger lcl_hsc_env
+   (tc_gbl_env, rn_info) <- hscTypecheckRename lcl_hsc_env ms $
+                        HsParsedModule { hpm_module = parsedSource pmod,
+                                         hpm_src_files = pm_extra_src_files pmod }
+   details <- makeSimpleDetails lcl_logger tc_gbl_env
+   safe    <- finalSafeMode lcl_dflags tc_gbl_env
+
+   return $
      TypecheckedModule {
        tm_internals_          = (tc_gbl_env, details),
        tm_parsed_module       = pmod,
@@ -1172,12 +1181,13 @@ typecheckModule pmod = do
 -- | Desugar a typechecked module.
 desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
 desugarModule tcm = do
- let ms = modSummary tcm
- let (tcg, _) = tm_internals tcm
  hsc_env <- getSession
- let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
- guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg
- return $
+ liftIO $ do
+   let ms = modSummary tcm
+   let (tcg, _) = tm_internals tcm
+   let lcl_hsc_env = hscSetFlags (ms_hspp_opts ms) hsc_env
+   guts <- hscDesugar lcl_hsc_env ms tcg
+   return $
      DesugaredModule {
        dm_typechecked_module = tcm,
        dm_core_module        = guts
@@ -1825,7 +1835,7 @@ interpretPackageEnv logger dflags = do
         return dflags
       Just envfile -> do
         content <- readFile envfile
-        compilationProgressMsg logger dflags (text "Loaded package environment from " <> text envfile)
+        compilationProgressMsg logger (text "Loaded package environment from " <> text envfile)
         let (_, dflags') = runCmdLine (runEwM (setFlagsFromEnvFile envfile content)) dflags
 
         return dflags'