Dedup `StgToCmmConfig` by including `CmmBuilderConfig`wip/cmm-parser-no-stg

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
 
 ------------------------------------------------------------------------