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
        -- Copied from StgToCmm
        (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