From 956e3644b746ef539ec269bb81f3cb1bbdf604a4 Mon Sep 17 00:00:00 2001 From: John Ericson Date: Sun, 15 May 2022 16:00:54 +0000 Subject: Dedup `StgToCmmConfig` by including `CmmBuilderConfig` --- compiler/GHC/Driver/Config/StgToCmm.hs | 11 ++--------- compiler/GHC/StgToCmm/Config.hs | 35 +++++++++++++++++++++++++--------- compiler/GHC/StgToCmm/DataCon.hs | 1 + compiler/GHC/StgToCmm/Expr.hs | 1 + compiler/GHC/StgToCmm/Heap.hs | 1 + compiler/GHC/StgToCmm/Layout.hs | 5 ++++- 6 files changed, 35 insertions(+), 19 deletions(-) diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs index 0650a1852b..336f52c480 100644 --- a/compiler/GHC/Driver/Config/StgToCmm.hs +++ b/compiler/GHC/Driver/Config/StgToCmm.hs @@ -4,7 +4,7 @@ module GHC.Driver.Config.StgToCmm import GHC.StgToCmm.Config -import GHC.Driver.Config.StgToCmm.Ticky +import GHC.Driver.Config.Cmm.Builder import GHC.Driver.Backend import GHC.Driver.Session import GHC.Platform @@ -19,24 +19,17 @@ import Prelude initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig initStgToCmmConfig dflags mod = StgToCmmConfig -- settings - { stgToCmmProfile = profile + { stgToCmmBuilderCfg = initCmmBuilderConfig dflags , stgToCmmThisModule = mod , stgToCmmTmpDir = tmpDir dflags , stgToCmmContext = initSDocContext dflags defaultDumpStyle - , stgToCmmEmitDebugInfo = debugLevel dflags > 0 , stgToCmmBinBlobThresh = b_blob , stgToCmmMaxInlAllocSize = maxInlineAllocSize dflags - -- ticky options - , stgToCmmTickyCfg = initCmmTickyConfig dflags -- flags , stgToCmmLoopification = gopt Opt_Loopification dflags , stgToCmmAlignCheck = gopt Opt_AlignmentSanitisation dflags , stgToCmmOptHpc = gopt Opt_Hpc dflags , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags - , stgToCmmSCCProfiling = sccProfilingEnabled dflags - , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags - , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags - , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags , stgToCmmPIC = gopt Opt_PIC dflags , stgToCmmPIE = gopt Opt_PIE dflags diff --git a/compiler/GHC/StgToCmm/Config.hs b/compiler/GHC/StgToCmm/Config.hs index a1ac5cb68e..16ee7385d0 100644 --- a/compiler/GHC/StgToCmm/Config.hs +++ b/compiler/GHC/StgToCmm/Config.hs @@ -2,12 +2,19 @@ module GHC.StgToCmm.Config ( StgToCmmConfig(..) + , stgToCmmProfile , stgToCmmPlatform + , stgToCmmEmitDebugInfo + , stgToCmmSCCProfiling + , stgToCmmEagerBlackHole + , stgToCmmInfoTableMap + , stgToCmmOmitYields ) where import GHC.Platform import GHC.Platform.Profile import GHC.Platform.Profile.Class +import GHC.Cmm.Builder.Config ( CmmBuilderConfig(..) ) import GHC.StgToCmm.Ticky.Config import GHC.Unit.Module import GHC.Utils.Outputable @@ -18,13 +25,12 @@ import GHC.Prelude -- This config is static and contains information only passed *downwards* by StgToCmm.Monad data StgToCmmConfig = StgToCmmConfig + { stgToCmmBuilderCfg :: !CmmBuilderConfig -- ^ Config for building C-- in general ----------------------------- General Settings -------------------------------- - { stgToCmmProfile :: !Profile -- ^ Current profile , stgToCmmThisModule :: Module -- ^ The module being compiled. This field kept lazy for -- Cmm/Parser.y which preloads it with a panic , stgToCmmTmpDir :: !TempDir -- ^ Temp Dir for files used in compilation , stgToCmmContext :: !SDocContext -- ^ Context for StgToCmm phase - , stgToCmmEmitDebugInfo :: !Bool -- ^ Whether we wish to output debug information , stgToCmmBinBlobThresh :: !(Maybe Word) -- ^ Threshold at which Binary literals (e.g. strings) -- are either dumped to a file and a CmmFileEmbed literal -- is emitted (over threshold), or become a CmmString @@ -36,16 +42,10 @@ data StgToCmmConfig = StgToCmmConfig -- @cgTopBinding@ in GHC.StgToCmm. , stgToCmmMaxInlAllocSize :: !Int -- ^ Max size, in bytes, of inline array allocations. ---------------------------------- Flags -------------------------------------- - , stgToCmmTickyCfg :: !CmmTickyConfig -- ^ Flags related to ticky , stgToCmmLoopification :: !Bool -- ^ Loopification enabled (cf @-floopification@) , stgToCmmAlignCheck :: !Bool -- ^ Insert alignment check (cf @-falignment-sanitisation@) , stgToCmmOptHpc :: !Bool -- ^ perform code generation for code coverage , stgToCmmFastPAPCalls :: !Bool -- ^ - , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled - , stgToCmmEagerBlackHole :: !Bool -- ^ - , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping - -- Info Tables to Source Positions] - , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed , stgToCmmOmitIfPragmas :: !Bool -- ^ true means don't generate interface programs (implied by -O0) , stgToCmmPIC :: !Bool -- ^ true if @-fPIC@ , stgToCmmPIE :: !Bool -- ^ true if @-fPIE@ @@ -73,13 +73,30 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmAvx512f :: !Bool -- ^ check for Advanced Vector 512-bit Extensions } +stgToCmmProfile :: StgToCmmConfig -> Profile +stgToCmmProfile = platformProfile . stgToCmmBuilderCfg stgToCmmPlatform :: StgToCmmConfig -> Platform stgToCmmPlatform = profilePlatform . stgToCmmProfile +stgToCmmEmitDebugInfo :: StgToCmmConfig -> Bool +stgToCmmEmitDebugInfo = cmmBuilderEmitDebugInfo . stgToCmmBuilderCfg + +stgToCmmSCCProfiling :: StgToCmmConfig -> Bool +stgToCmmSCCProfiling = cmmBuilderSCCProfiling . stgToCmmBuilderCfg + +stgToCmmEagerBlackHole :: StgToCmmConfig -> Bool +stgToCmmEagerBlackHole = cmmBuilderEagerBlackHole . stgToCmmBuilderCfg + +stgToCmmInfoTableMap :: StgToCmmConfig -> Bool +stgToCmmInfoTableMap = cmmBuilderInfoTableMap . stgToCmmBuilderCfg + +stgToCmmOmitYields :: StgToCmmConfig -> Bool +stgToCmmOmitYields = cmmBuilderOmitYields . stgToCmmBuilderCfg + instance ContainsPlatformProfile StgToCmmConfig where platformProfile = stgToCmmProfile instance ContainsCmmTickyConfig StgToCmmConfig where - cmmTickyConfig = stgToCmmTickyCfg + cmmTickyConfig = cmmTickyConfig . stgToCmmBuilderCfg diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs index 89bdb88058..7c3700f769 100644 --- a/compiler/GHC/StgToCmm/DataCon.hs +++ b/compiler/GHC/StgToCmm/DataCon.hs @@ -22,6 +22,7 @@ import GHC.Platform import GHC.Stg.Syntax import GHC.Core ( AltCon(..) ) +import GHC.StgToCmm.Config (stgToCmmProfile) import GHC.StgToCmm.Monad import GHC.StgToCmm.Env import GHC.StgToCmm.Heap diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs index fcf91b4509..e8e409e20a 100644 --- a/compiler/GHC/StgToCmm/Expr.hs +++ b/compiler/GHC/StgToCmm/Expr.hs @@ -17,6 +17,7 @@ import GHC.Prelude hiding ((<*>)) import {-# SOURCE #-} GHC.StgToCmm.Bind ( cgBind ) +import GHC.StgToCmm.Config (stgToCmmProfile) import GHC.StgToCmm.Monad import GHC.StgToCmm.Heap import GHC.StgToCmm.Env diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs index c2c10244e8..8c9bb7cbe8 100644 --- a/compiler/GHC/StgToCmm/Heap.hs +++ b/compiler/GHC/StgToCmm/Heap.hs @@ -29,6 +29,7 @@ import GHC.Prelude hiding ((<*>)) import GHC.Stg.Syntax import GHC.Cmm.Builder.Config import GHC.Cmm.CLabel +import GHC.StgToCmm.Config (stgToCmmOmitYields) import GHC.StgToCmm.Layout import GHC.StgToCmm.Utils import GHC.StgToCmm.Monad diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs index 5b05e846d5..b3601675c5 100644 --- a/compiler/GHC/StgToCmm/Layout.hs +++ b/compiler/GHC/StgToCmm/Layout.hs @@ -64,7 +64,10 @@ import GHC.Utils.Panic.Plain import GHC.Utils.Constants (debugIsOn) import GHC.Data.FastString import Control.Monad -import GHC.StgToCmm.Config (stgToCmmPlatform) +import GHC.StgToCmm.Config ( stgToCmmPlatform + , stgToCmmProfile + , stgToCmmSCCProfiling + ) import GHC.StgToCmm.Types ------------------------------------------------------------------------ -- cgit v1.2.1