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 /testsuite | |
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 'testsuite')
-rw-r--r-- | testsuite/tests/callarity/unittest/CallArity1.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/count-deps/CountDepsAst.stdout | 3 | ||||
-rw-r--r-- | testsuite/tests/count-deps/CountDepsParser.stdout | 3 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/T11579.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/T7478/T7478.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/T9015.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/plugins/static-plugins.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/regalloc/regalloc_unit_tests.hs | 29 |
8 files changed, 31 insertions, 28 deletions
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs index 64800dd243..7f51426823 100644 --- a/testsuite/tests/callarity/unittest/CallArity1.hs +++ b/testsuite/tests/callarity/unittest/CallArity1.hs @@ -173,16 +173,16 @@ main = do logger <- getLogger liftIO $ forM_ exprs $ \(n,e) -> do case lintExpr dflags [f,scrutf,scruta] e of - Just errs -> putMsg logger dflags (pprMessageBag errs $$ text "in" <+> text n) + Just errs -> putMsg logger (pprMessageBag errs $$ text "in" <+> text n) Nothing -> return () - putMsg logger dflags (text n Outputable.<> char ':') - -- liftIO $ putMsg dflags (ppr e) + putMsg logger (text n Outputable.<> char ':') + -- liftIO $ putMsg logger (ppr e) let e' = callArityRHS e let bndrs = nonDetEltsUniqSet (allBoundIds e') -- It should be OK to use nonDetEltsUniqSet here, if it becomes a -- problem we should use DVarSet - -- liftIO $ putMsg dflags (ppr e') - forM_ bndrs $ \v -> putMsg logger dflags $ nest 4 $ ppr v <+> ppr (idCallArity v) + -- liftIO $ putMsg logger (ppr e') + forM_ bndrs $ \v -> putMsg logger $ nest 4 $ ppr v <+> ppr (idCallArity v) -- Utilities mkLApps :: Id -> [Integer] -> CoreExpr diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index 4b33ad2982..8411e66318 100644 --- a/testsuite/tests/count-deps/CountDepsAst.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout @@ -1,4 +1,4 @@ -Found 266 Language.Haskell.Syntax module dependencies +Found 267 Language.Haskell.Syntax module dependencies GHC.Builtin.Names GHC.Builtin.PrimOps GHC.Builtin.Types @@ -82,6 +82,7 @@ GHC.Data.StringBuffer GHC.Data.TrieMap GHC.Driver.Backend GHC.Driver.CmdLine +GHC.Driver.Config.Logger GHC.Driver.Env GHC.Driver.Env.Types GHC.Driver.Errors diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index 16dbb8e185..d6878d6bd5 100644 --- a/testsuite/tests/count-deps/CountDepsParser.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout @@ -1,4 +1,4 @@ -Found 272 GHC.Parser module dependencies +Found 273 GHC.Parser module dependencies GHC.Builtin.Names GHC.Builtin.PrimOps GHC.Builtin.Types @@ -83,6 +83,7 @@ GHC.Data.TrieMap GHC.Driver.Backend GHC.Driver.Backpack.Syntax GHC.Driver.CmdLine +GHC.Driver.Config.Logger GHC.Driver.Env GHC.Driver.Env.Types GHC.Driver.Errors diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs index f2beeb3035..fc8c2c5fff 100644 --- a/testsuite/tests/ghc-api/T11579.hs +++ b/testsuite/tests/ghc-api/T11579.hs @@ -1,6 +1,6 @@ import System.Environment import GHC.Driver.Session -import GHC.Driver.Config +import GHC.Driver.Config.Parser (initParserOpts) import GHC.Data.FastString import GHC import GHC.Data.StringBuffer diff --git a/testsuite/tests/ghc-api/T7478/T7478.hs b/testsuite/tests/ghc-api/T7478/T7478.hs index dbea3f9547..b31a5688a6 100644 --- a/testsuite/tests/ghc-api/T7478/T7478.hs +++ b/testsuite/tests/ghc-api/T7478/T7478.hs @@ -24,6 +24,10 @@ compileInGhc targets handlerOutput = do flags0 <- getSessionDynFlags let flags = flags0 {verbosity = 1 } setSessionDynFlags flags + let collectSrcError handlerOutput _flags MCOutput _srcspan msg + = handlerOutput $ GHC.showSDocForUser flags emptyUnitState alwaysQualify msg + collectSrcError _ _ _ _ _ + = return () pushLogHookM (const (collectSrcError handlerOutput)) -- Set up targets. oldTargets <- getTargets @@ -48,10 +52,6 @@ compileInGhc targets handlerOutput = do TargetFile file Nothing -> file _ -> error "fileFromTarget: not a known target" - collectSrcError handlerOutput flags MCOutput _srcspan msg - = handlerOutput $ GHC.showSDocForUser flags emptyUnitState alwaysQualify msg - collectSrcError _ _ _ _ _ - = return () main :: IO () main = do diff --git a/testsuite/tests/ghc-api/T9015.hs b/testsuite/tests/ghc-api/T9015.hs index 3ca05afc7d..b97ec34a60 100644 --- a/testsuite/tests/ghc-api/T9015.hs +++ b/testsuite/tests/ghc-api/T9015.hs @@ -3,7 +3,7 @@ module Main where import GHC import GHC.Driver.Session import GHC.Driver.Monad -import GHC.Driver.Config +import GHC.Driver.Config.Parser (initParserOpts) import System.Environment testStrings = [ diff --git a/testsuite/tests/plugins/static-plugins.hs b/testsuite/tests/plugins/static-plugins.hs index b263c01b1d..73d91a93e3 100644 --- a/testsuite/tests/plugins/static-plugins.hs +++ b/testsuite/tests/plugins/static-plugins.hs @@ -2,7 +2,7 @@ module Main where import GHC.Driver.Env import GHC.Driver.Session - (getDynFlags, parseDynamicFlagsCmdLine, defaultFatalMessager, defaultFlushOut) + (extractDynFlags, parseDynamicFlagsCmdLine, defaultFatalMessager, defaultFlushOut) import GHC.Driver.Plugins import GHC.Driver.Monad diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs index f68cd040df..419a723062 100644 --- a/testsuite/tests/regalloc/regalloc_unit_tests.hs +++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs @@ -24,6 +24,7 @@ import qualified GHC.CmmToAsm.Reg.Graph.Stats as Color import qualified GHC.CmmToAsm.Reg.Linear.Base as Linear import qualified GHC.CmmToAsm.X86.Instr as X86.Instr import qualified GHC.CmmToAsm.X86 as X86 +import GHC.Driver.Config.CmmToAsm import GHC.Driver.Main import GHC.Driver.Env import GHC.StgToCmm.CgUtils @@ -44,6 +45,7 @@ import GHC.Types.Unique.Supply import GHC.Driver.Session import GHC.Driver.Errors import GHC.Utils.Error +import GHC.Utils.Logger import GHC.Utils.Outputable import GHC.Types.Basic import GHC.Unit.Home @@ -64,8 +66,15 @@ main = do --get a GHC context and run the tests runGhc (Just libdir) $ do - dflags0 <- fmap setOptions getDynFlags - setSessionDynFlags dflags0 + dflags0 <- flip gopt_set Opt_RegsGraph <$> getDynFlags + --the register allocator's intermediate data + --structures are usually discarded + --(in GHC.CmmToAsm.cmmNativeGen) for performance + --reasons. To prevent this we need to tell + --cmmNativeGen we want them printed out even + --though we ignore stderr in the test configuration. + let dflags1 = dopt_set dflags0 Opt_D_dump_asm_stats + setSessionDynFlags dflags1 dflags <- getDynFlags logger <- getLogger @@ -75,8 +84,6 @@ main = do return () - where setOptions = (flip gopt_set) Opt_RegsGraph - -- | TODO: Make this an IORef along the lines of Data.Unique.newUnique to add -- stronger guarantees a UniqSupply won't be accidentally reused @@ -113,7 +120,7 @@ compileCmmForRegAllocStats :: UniqSupply -> IO [( Maybe [Color.RegAllocStats (Alignment, RawCmmStatics) X86.Instr.Instr] , Maybe [Linear.RegAllocStats])] -compileCmmForRegAllocStats logger dflags' cmmFile ncgImplF us = do +compileCmmForRegAllocStats logger dflags cmmFile ncgImplF us = do let ncgImpl = ncgImplF (initNCGConfig dflags thisMod) hscEnv <- newHscEnv dflags @@ -127,13 +134,14 @@ compileCmmForRegAllocStats logger dflags' cmmFile ncgImplF us = do let initTopSRT = emptySRT thisMod cmmGroup <- fmap snd $ cmmPipeline hscEnv initTopSRT $ fst $ fromJust parsedCmm - rawCmms <- cmmToRawCmm logger dflags (Stream.yield cmmGroup) + let profile = targetProfile dflags + rawCmms <- cmmToRawCmm logger profile (Stream.yield cmmGroup) collectedCmms <- mconcat <$> Stream.collect rawCmms -- compile and discard the generated code, returning regalloc stats mapM (\ (count, thisCmm) -> - cmmNativeGen logger dflags thisModLoc ncgImpl + cmmNativeGen logger thisModLoc ncgImpl usb dwarfFileIds dbgMap thisCmm count >>= (\(_, _, _, _, colorStats, linearStats, _) -> -- scrub unneeded output from cmmNativeGen @@ -141,13 +149,6 @@ compileCmmForRegAllocStats logger dflags' cmmFile ncgImplF us = do $ zip [0.. (length collectedCmms)] collectedCmms where - --the register allocator's intermediate data - --structures are usually discarded - --(in AsmCodeGen.cmmNativeGen) for performance - --reasons. To prevent this we need to tell - --cmmNativeGen we want them printed out even - --though we ignore stderr in the test configuration. - dflags = dopt_set dflags' Opt_D_dump_asm_stats [usa, usb, usc, usd] = take 4 . listSplitUniqSupply $ us -- don't need debugging information dwarfFileIds = emptyUFM |