{-# LANGUAGE DerivingStrategies #-}
module GHC.Cmm.Config
( CmmConfig(..)
, cmmPlatform
) where
import GHC.Prelude
import GHC.Platform
import GHC.Platform.Profile
data CmmConfig = CmmConfig
{ CmmConfig -> Profile
cmmProfile :: !Profile
, CmmConfig -> Bool
cmmOptControlFlow :: !Bool
, CmmConfig -> Bool
cmmDoLinting :: !Bool
, CmmConfig -> Bool
cmmOptElimCommonBlks :: !Bool
, CmmConfig -> Bool
cmmOptSink :: !Bool
, CmmConfig -> Bool
cmmOptThreadSanitizer :: !Bool
, CmmConfig -> Bool
cmmGenStackUnwindInstr :: !Bool
, CmmConfig -> Bool
cmmExternalDynamicRefs :: !Bool
, CmmConfig -> Bool
cmmDoCmmSwitchPlans :: !Bool
, CmmConfig -> Bool
cmmSplitProcPoints :: !Bool
}
cmmPlatform :: CmmConfig -> Platform
cmmPlatform :: CmmConfig -> Platform
cmmPlatform = Profile -> Platform
profilePlatform (Profile -> Platform)
-> (CmmConfig -> Profile) -> CmmConfig -> Platform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmConfig -> Profile
cmmProfile