module GHC.Driver.Config.Stg.Pipeline
( initStgPipelineOpts
) where
import GHC.Prelude
import Control.Monad (guard)
import GHC.Stg.Pipeline
import GHC.Stg.Utils
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Stg.Lift
import GHC.Driver.Config.Stg.Ppr
import GHC.Driver.DynFlags
initStgPipelineOpts :: DynFlags -> Bool -> StgPipelineOpts
initStgPipelineOpts :: DynFlags -> Bool -> StgPipelineOpts
initStgPipelineOpts DynFlags
dflags Bool
for_bytecode =
let !platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
!ext_dyn_refs :: Bool
ext_dyn_refs = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags
in StgPipelineOpts
{ stgPipeline_lint :: Maybe DiagOpts
stgPipeline_lint = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoStgLinting DynFlags
dflags
DiagOpts -> Maybe DiagOpts
forall a. a -> Maybe a
Just (DiagOpts -> Maybe DiagOpts) -> DiagOpts -> Maybe DiagOpts
forall a b. (a -> b) -> a -> b
$ DynFlags -> DiagOpts
initDiagOpts DynFlags
dflags
, stgPipeline_pprOpts :: StgPprOpts
stgPipeline_pprOpts = DynFlags -> StgPprOpts
initStgPprOpts DynFlags
dflags
, stgPipeline_phases :: [StgToDo]
stgPipeline_phases = Bool -> DynFlags -> [StgToDo]
getStgToDo Bool
for_bytecode DynFlags
dflags
, stgPlatform :: Platform
stgPlatform = Platform
platform
, stgPipeline_forBytecode :: Bool
stgPipeline_forBytecode = Bool
for_bytecode
, stgPipeline_allowTopLevelConApp :: Module -> DataCon -> [StgArg] -> Bool
stgPipeline_allowTopLevelConApp = Platform -> Bool -> Module -> DataCon -> [StgArg] -> Bool
allowTopLevelConApp Platform
platform Bool
ext_dyn_refs
}
getStgToDo
:: Bool
-> DynFlags
-> [StgToDo]
getStgToDo :: Bool -> DynFlags -> [StgToDo]
getStgToDo Bool
for_bytecode DynFlags
dflags =
(StgToDo -> Bool) -> [StgToDo] -> [StgToDo]
forall a. (a -> Bool) -> [a] -> [a]
filter (StgToDo -> StgToDo -> Bool
forall a. Eq a => a -> a -> Bool
/= StgToDo
StgDoNothing)
[ StgToDo -> StgToDo
forall {a}. a -> a
mandatory StgToDo
StgUnarise
, GeneralFlag -> StgToDo -> StgToDo
optional GeneralFlag
Opt_StgCSE StgToDo
StgCSE
, GeneralFlag -> StgToDo -> StgToDo
optional GeneralFlag
Opt_StgLiftLams (StgToDo -> StgToDo) -> StgToDo -> StgToDo
forall a b. (a -> b) -> a -> b
$ StgLiftConfig -> StgToDo
StgLiftLams (StgLiftConfig -> StgToDo) -> StgLiftConfig -> StgToDo
forall a b. (a -> b) -> a -> b
$ DynFlags -> StgLiftConfig
initStgLiftConfig DynFlags
dflags
, Bool -> StgToDo -> StgToDo
runWhen Bool
for_bytecode StgToDo
StgBcPrep
, GeneralFlag -> StgToDo -> StgToDo
optional GeneralFlag
Opt_StgStats StgToDo
StgStats
] where
optional :: GeneralFlag -> StgToDo -> StgToDo
optional GeneralFlag
opt = Bool -> StgToDo -> StgToDo
runWhen (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
opt DynFlags
dflags)
mandatory :: a -> a
mandatory = a -> a
forall {a}. a -> a
id
runWhen :: Bool -> StgToDo -> StgToDo
runWhen :: Bool -> StgToDo -> StgToDo
runWhen Bool
True StgToDo
todo = StgToDo
todo
runWhen Bool
_ StgToDo
_ = StgToDo
StgDoNothing