module GHC.Driver.Config.StgToCmm
  ( initStgToCmmConfig
  ) where

import GHC.StgToCmm.Config

import GHC.Driver.Backend
import GHC.Driver.Session
import GHC.Platform
import GHC.Platform.Profile
import GHC.Unit.Module
import GHC.Utils.Outputable

import Data.Maybe
import Prelude

initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig DynFlags
dflags Module
mod = StgToCmmConfig
  -- settings
  { 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
  , stgToCmmDebugLevel :: Int
stgToCmmDebugLevel    = DynFlags -> Int
debugLevel      DynFlags
dflags
  , stgToCmmBinBlobThresh :: Maybe Word
stgToCmmBinBlobThresh = Maybe Word
b_blob
  , stgToCmmMaxInlAllocSize :: Int
stgToCmmMaxInlAllocSize = DynFlags -> Int
maxInlineAllocSize           DynFlags
dflags
  -- ticky options
  , 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
  -- flags
  , 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
  -- backend flags
  , stgToCmmAllowBigArith :: Bool
stgToCmmAllowBigArith             = Bool -> Bool
not Bool
ncg
  , 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
  , stgToCmmAllowFabsInstrs :: Bool
stgToCmmAllowFabsInstrs           = (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc Bool -> Bool -> Bool
|| Bool
aarch64)) Bool -> Bool -> Bool
|| Bool
llvm
  -- SIMD flags
  , 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
          ncg :: Bool
ncg     = Backend
bk_end Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
NCG
          llvm :: Bool
llvm    = Backend
bk_end Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
LLVM
          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
          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
          aarch64 :: Bool
aarch64 = Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchAArch64
          vec_err :: Maybe String
vec_err = case DynFlags -> Backend
backend DynFlags
dflags of
                      Backend
LLVM -> Maybe String
forall a. Maybe a
Nothing
                      Backend
_    -> String -> Maybe String
forall a. a -> Maybe a
Just ([String] -> String
unlines [String
"SIMD vector instructions require the LLVM back-end.", String
"Please use -fllvm."])