module GHC.Driver.Config.Cmm
( initCmmConfig
) where
import GHC.Cmm.Config
import GHC.Driver.DynFlags
import GHC.Driver.Backend
import GHC.Platform
import GHC.Prelude
initCmmConfig :: DynFlags -> CmmConfig
initCmmConfig :: DynFlags -> CmmConfig
initCmmConfig DynFlags
dflags = CmmConfig
{ cmmProfile :: Profile
cmmProfile = DynFlags -> Profile
targetProfile DynFlags
dflags
, cmmOptControlFlow :: Bool
cmmOptControlFlow = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_CmmControlFlow DynFlags
dflags
, cmmDoLinting :: Bool
cmmDoLinting = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoCmmLinting DynFlags
dflags
, cmmOptElimCommonBlks :: Bool
cmmOptElimCommonBlks = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_CmmElimCommonBlocks DynFlags
dflags
, cmmOptSink :: Bool
cmmOptSink = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_CmmSink DynFlags
dflags
, cmmOptThreadSanitizer :: Bool
cmmOptThreadSanitizer = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_CmmThreadSanitizer DynFlags
dflags
, cmmGenStackUnwindInstr :: Bool
cmmGenStackUnwindInstr = DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
, cmmExternalDynamicRefs :: Bool
cmmExternalDynamicRefs = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags
, cmmDoCmmSwitchPlans :: Bool
cmmDoCmmSwitchPlans = Bool -> Bool
not (Backend -> Bool
backendHasNativeSwitch (DynFlags -> Backend
backend DynFlags
dflags))
, cmmSplitProcPoints :: Bool
cmmSplitProcPoints = Bool -> Bool
not (Backend -> Bool
backendSupportsUnsplitProcPoints (DynFlags -> Backend
backend DynFlags
dflags))
Bool -> Bool -> Bool
|| Bool -> Bool
not (Platform -> Bool
platformTablesNextToCode Platform
platform)
, cmmAllowMul2 :: Bool
cmmAllowMul2 = (Bool
ncg Bool -> Bool -> Bool
&& Bool
x86ish) Bool -> Bool -> Bool
|| Bool
llvm
, cmmOptConstDivision :: Bool
cmmOptConstDivision = Bool -> Bool
not Bool
llvm
}
where platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
(Bool
ncg, Bool
llvm) = case Backend -> PrimitiveImplementation
backendPrimitiveImplementation (DynFlags -> Backend
backend DynFlags
dflags) of
PrimitiveImplementation
GenericPrimitives -> (Bool
False, Bool
False)
PrimitiveImplementation
NcgPrimitives -> (Bool
True, Bool
False)
PrimitiveImplementation
LlvmPrimitives -> (Bool
False, Bool
True)
PrimitiveImplementation
JSPrimitives -> (Bool
False, Bool
False)
x86ish :: Bool
x86ish = case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> Bool
True
Arch
ArchX86_64 -> Bool
True
Arch
_ -> Bool
False