module GHC.Driver.Config.StgToCmm
( initStgToCmmConfig
) where
import GHC.Prelude.Basic
import GHC.StgToCmm.Config
import GHC.Driver.Backend
import GHC.Driver.Session
import GHC.Platform
import GHC.Platform.Profile
import GHC.Utils.Error
import GHC.Unit.Module
import GHC.Utils.Outputable
initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig DynFlags
dflags Module
mod = StgToCmmConfig
{ stgToCmmProfile :: Profile
stgToCmmProfile = Profile
profile
, stgToCmmThisModule :: Module
stgToCmmThisModule = Module
mod
, stgToCmmTmpDir :: TempDir
stgToCmmTmpDir = DynFlags -> TempDir
tmpDir DynFlags
dflags
, stgToCmmContext :: SDocContext
stgToCmmContext = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
defaultDumpStyle
, stgToCmmEmitDebugInfo :: Bool
stgToCmmEmitDebugInfo = DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
, stgToCmmBinBlobThresh :: Maybe Word
stgToCmmBinBlobThresh = Maybe Word
b_blob
, stgToCmmMaxInlAllocSize :: Int
stgToCmmMaxInlAllocSize = DynFlags -> Int
maxInlineAllocSize DynFlags
dflags
, stgToCmmDoTicky :: Bool
stgToCmmDoTicky = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Ticky DynFlags
dflags
, stgToCmmTickyAllocd :: Bool
stgToCmmTickyAllocd = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Ticky_Allocd DynFlags
dflags
, stgToCmmTickyLNE :: Bool
stgToCmmTickyLNE = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Ticky_LNE DynFlags
dflags
, stgToCmmTickyDynThunk :: Bool
stgToCmmTickyDynThunk = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Ticky_Dyn_Thunk DynFlags
dflags
, stgToCmmTickyTag :: Bool
stgToCmmTickyTag = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Ticky_Tag DynFlags
dflags
, stgToCmmLoopification :: Bool
stgToCmmLoopification = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Loopification DynFlags
dflags
, stgToCmmAlignCheck :: Bool
stgToCmmAlignCheck = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_AlignmentSanitisation DynFlags
dflags
, stgToCmmOptHpc :: Bool
stgToCmmOptHpc = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Hpc DynFlags
dflags
, stgToCmmFastPAPCalls :: Bool
stgToCmmFastPAPCalls = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_FastPAPCalls DynFlags
dflags
, stgToCmmSCCProfiling :: Bool
stgToCmmSCCProfiling = DynFlags -> Bool
sccProfilingEnabled DynFlags
dflags
, stgToCmmEagerBlackHole :: Bool
stgToCmmEagerBlackHole = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_EagerBlackHoling DynFlags
dflags
, stgToCmmInfoTableMap :: Bool
stgToCmmInfoTableMap = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_InfoTableMap DynFlags
dflags
, stgToCmmOmitYields :: Bool
stgToCmmOmitYields = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_OmitYields DynFlags
dflags
, stgToCmmOmitIfPragmas :: Bool
stgToCmmOmitIfPragmas = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_OmitInterfacePragmas DynFlags
dflags
, stgToCmmPIC :: Bool
stgToCmmPIC = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIC DynFlags
dflags
, stgToCmmPIE :: Bool
stgToCmmPIE = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PIE DynFlags
dflags
, stgToCmmExtDynRefs :: Bool
stgToCmmExtDynRefs = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags
, stgToCmmDoBoundsCheck :: Bool
stgToCmmDoBoundsCheck = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoBoundsChecking DynFlags
dflags
, stgToCmmDoTagCheck :: Bool
stgToCmmDoTagCheck = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoTagInferenceChecks DynFlags
dflags
, stgToCmmAllowBigArith :: Bool
stgToCmmAllowBigArith = Bool -> Bool
not Bool
ncg Bool -> Bool -> Bool
|| Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchWasm32
, stgToCmmAllowQuotRemInstr :: Bool
stgToCmmAllowQuotRemInstr = Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
, stgToCmmAllowQuotRem2 :: Bool
stgToCmmAllowQuotRem2 = (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)) Bool -> Bool -> Bool
|| Bool
llvm
, stgToCmmAllowExtendedAddSubInstrs :: Bool
stgToCmmAllowExtendedAddSubInstrs = (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)) Bool -> Bool -> Bool
|| Bool
llvm
, stgToCmmAllowIntMul2Instr :: Bool
stgToCmmAllowIntMul2Instr = (Bool
ncg Bool -> Bool -> Bool
&& Bool
x86ish) Bool -> Bool -> Bool
|| Bool
llvm
, stgToCmmVecInstrsErr :: Maybe String
stgToCmmVecInstrsErr = Maybe String
vec_err
, stgToCmmAvx :: Bool
stgToCmmAvx = DynFlags -> Bool
isAvxEnabled DynFlags
dflags
, stgToCmmAvx2 :: Bool
stgToCmmAvx2 = DynFlags -> Bool
isAvx2Enabled DynFlags
dflags
, stgToCmmAvx512f :: Bool
stgToCmmAvx512f = DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags
, stgToCmmTickyAP :: Bool
stgToCmmTickyAP = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Ticky_AP DynFlags
dflags
} where profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
bk_end :: Backend
bk_end = DynFlags -> Backend
backend DynFlags
dflags
b_blob :: Maybe Word
b_blob = if Bool -> Bool
not Bool
ncg then Maybe Word
forall a. Maybe a
Nothing else DynFlags -> Maybe Word
binBlobThreshold DynFlags
dflags
(Bool
ncg, Bool
llvm) = case Backend -> PrimitiveImplementation
backendPrimitiveImplementation Backend
bk_end of
PrimitiveImplementation
GenericPrimitives -> (Bool
False, Bool
False)
PrimitiveImplementation
JSPrimitives -> (Bool
False, Bool
False)
PrimitiveImplementation
NcgPrimitives -> (Bool
True, Bool
False)
PrimitiveImplementation
LlvmPrimitives -> (Bool
False, Bool
True)
x86ish :: Bool
x86ish = case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> Bool
True
Arch
ArchX86_64 -> Bool
True
Arch
_ -> Bool
False
ppc :: Bool
ppc = case Platform -> Arch
platformArch Platform
platform of
Arch
ArchPPC -> Bool
True
ArchPPC_64 PPC_64ABI
_ -> Bool
True
Arch
_ -> Bool
False
vec_err :: Maybe String
vec_err = case Backend -> Validity' String
backendSimdValidity (DynFlags -> Backend
backend DynFlags
dflags) of
Validity' String
IsValid -> Maybe String
forall a. Maybe a
Nothing
NotValid String
msg -> String -> Maybe String
forall a. a -> Maybe a
Just String
msg