diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-05-21 16:51:59 +0200 |
---|---|---|
committer | Sylvain Henry <sylvain@haskus.fr> | 2021-06-07 10:35:39 +0200 |
commit | 4dc681c7c0345ee8ae268749d98b419dabf6a3bc (patch) | |
tree | ab05546d61b2d90f2fc9e652a13da48ce89096ae /compiler/GHC/Driver/CodeOutput.hs | |
parent | 5e1a224435fc6ebd34d02566f17fe1eaf5475bab (diff) | |
download | haskell-4dc681c7c0345ee8ae268749d98b419dabf6a3bc.tar.gz |
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.
Diffstat (limited to 'compiler/GHC/Driver/CodeOutput.hs')
-rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 4f80b6feda..7c9c08e4c1 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -27,6 +27,7 @@ import GHC.Cmm ( RawCmmGroup ) import GHC.Cmm.CLabel import GHC.Driver.Session +import GHC.Driver.Config.CmmToAsm (initNCGConfig) import GHC.Driver.Ppr import GHC.Driver.Backend @@ -92,16 +93,14 @@ codeOutput logger tmpfs dflags unit_state this_mod filenm location genForeignStu else cmm_stream do_lint cmm = withTimingSilent logger - dflags (text "CmmLint"<+>brackets (ppr this_mod)) (const ()) $ do { case cmmLint (targetPlatform dflags) cmm of - Just err -> do { putLogMsg logger - dflags + Just err -> do { logMsg logger MCDump noSrcSpan $ withPprStyle defaultDumpStyle err - ; ghcExit logger dflags 1 + ; ghcExit logger 1 } Nothing -> return () ; return cmm @@ -137,7 +136,7 @@ outputC :: Logger -> [UnitId] -> IO a outputC logger dflags filenm cmm_stream packages = - withTiming logger dflags (text "C codegen") (\a -> seq a () {- FIXME -}) $ do + withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do let pkg_names = map unitIdString packages doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") @@ -145,7 +144,7 @@ outputC logger dflags filenm cmm_stream packages = let platform = targetPlatform dflags writeC cmm = do let doc = cmmToC platform cmm - dumpIfSet_dyn logger dflags Opt_D_dump_c_backend + putDumpFileMaybe logger Opt_D_dump_c_backend "C backend output" FormatC doc @@ -169,10 +168,11 @@ outputAsm :: Logger -> IO a outputAsm logger dflags this_mod location filenm cmm_stream = do ncg_uniqs <- mkSplitUniqSupply 'n' - debugTraceMsg logger dflags 4 (text "Outputing asm to" <+> text filenm) + debugTraceMsg logger 4 (text "Outputing asm to" <+> text filenm) + let ncg_config = initNCGConfig dflags this_mod {-# SCC "OutputAsm" #-} doOutput filenm $ \h -> {-# SCC "NativeCodeGen" #-} - nativeCodeGen logger dflags this_mod location h ncg_uniqs cmm_stream + nativeCodeGen logger ncg_config location h ncg_uniqs cmm_stream {- ************************************************************************ @@ -226,7 +226,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs createDirectoryIfMissing True (takeDirectory stub_h) - dumpIfSet_dyn logger dflags Opt_D_dump_foreign + putDumpFileMaybe logger Opt_D_dump_foreign "Foreign export header file" FormatC stub_h_output_d @@ -251,7 +251,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs <- outputForeignStubs_help stub_h stub_h_output_w ("#include <HsFFI.h>\n" ++ cplusplus_hdr) cplusplus_ftr - dumpIfSet_dyn logger dflags Opt_D_dump_foreign + putDumpFileMaybe logger Opt_D_dump_foreign "Foreign export stubs" FormatC stub_c_output_d stub_c_file_exists |