diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-01-07 14:25:15 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-13 21:27:34 -0500 |
| commit | 8e2f85f6b4662676f0d7addaff9bf2c7d751bb63 (patch) | |
| tree | 6a5bea5db12d907874cdf26d709d829a3f3216ba /compiler/GHC/CmmToLlvm/Base.hs | |
| parent | 40983d2331fe34c0af6925db7588d5ac6a19ae36 (diff) | |
| download | haskell-8e2f85f6b4662676f0d7addaff9bf2c7d751bb63.tar.gz | |
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
Diffstat (limited to 'compiler/GHC/CmmToLlvm/Base.hs')
| -rw-r--r-- | compiler/GHC/CmmToLlvm/Base.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs index d68b5d5c8e..84c82ef873 100644 --- a/compiler/GHC/CmmToLlvm/Base.hs +++ b/compiler/GHC/CmmToLlvm/Base.hs @@ -61,7 +61,7 @@ import GHC.Types.Unique import GHC.Utils.BufHandle ( BufHandle ) import GHC.Types.Unique.Set import GHC.Types.Unique.Supply -import GHC.Utils.Error +import GHC.Utils.Logger import qualified GHC.Data.Stream as Stream import Data.Maybe (fromJust) @@ -302,6 +302,7 @@ data LlvmEnv = LlvmEnv { envVersion :: LlvmVersion -- ^ LLVM version , envOpts :: LlvmOpts -- ^ LLVM backend options , envDynFlags :: DynFlags -- ^ Dynamic flags + , envLogger :: !Logger -- ^ Logger , envOutput :: BufHandle -- ^ Output buffer , envMask :: !Char -- ^ Mask for creating unique values , envFreshMeta :: MetaId -- ^ Supply of fresh metadata IDs @@ -332,6 +333,10 @@ instance Monad LlvmM where instance HasDynFlags LlvmM where getDynFlags = LlvmM $ \env -> return (envDynFlags env, env) +instance HasLogger LlvmM where + getLogger = LlvmM $ \env -> return (envLogger env, env) + + -- | Get target platform getPlatform :: LlvmM Platform getPlatform = llvmOptsPlatform <$> getLlvmOpts @@ -355,8 +360,8 @@ liftIO m = LlvmM $ \env -> do x <- m return (x, env) -- | Get initial Llvm environment. -runLlvm :: DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a -runLlvm dflags ver out m = do +runLlvm :: Logger -> DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a +runLlvm logger dflags ver out m = do (a, _) <- runLlvmM m env return a where env = LlvmEnv { envFunMap = emptyUFM @@ -367,6 +372,7 @@ runLlvm dflags ver out m = do , envVersion = ver , envOpts = initLlvmOpts dflags , envDynFlags = dflags + , envLogger = logger , envOutput = out , envMask = 'n' , envFreshMeta = MetaId 0 @@ -426,7 +432,8 @@ getLlvmVer = getEnv envVersion dumpIfSetLlvm :: DumpFlag -> String -> DumpFormat -> Outp.SDoc -> LlvmM () dumpIfSetLlvm flag hdr fmt doc = do dflags <- getDynFlags - liftIO $ dumpIfSet_dyn dflags flag hdr fmt doc + logger <- getLogger + liftIO $ dumpIfSet_dyn logger dflags flag hdr fmt doc -- | Prints the given contents to the output handle renderLlvm :: Outp.SDoc -> LlvmM () |
