module GHC.Driver.Config.CoreToStg.Prep ( initCorePrepConfig , initCorePrepPgmConfig ) where import GHC.Prelude import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig HscEnv hsc_env = do LitNumType -> Integer -> Maybe CoreExpr convertNumLit <- do let platform :: Platform platform = DynFlags -> Platform targetPlatform (DynFlags -> Platform) -> DynFlags -> Platform forall a b. (a -> b) -> a -> b $ HscEnv -> DynFlags hsc_dflags HscEnv hsc_env home_unit :: HomeUnit home_unit = HscEnv -> HomeUnit hsc_home_unit HscEnv hsc_env lookup_global :: Name -> IO TyThing lookup_global = HscEnv -> Name -> IO TyThing lookupGlobal HscEnv hsc_env Platform -> HomeUnit -> (Name -> IO TyThing) -> IO (LitNumType -> Integer -> Maybe CoreExpr) mkConvertNumLiteral Platform platform HomeUnit home_unit Name -> IO TyThing lookup_global CorePrepConfig -> IO CorePrepConfig forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (CorePrepConfig -> IO CorePrepConfig) -> CorePrepConfig -> IO CorePrepConfig forall a b. (a -> b) -> a -> b $ CorePrepConfig { cp_catchNonexhaustiveCases :: Bool cp_catchNonexhaustiveCases = GeneralFlag -> DynFlags -> Bool gopt GeneralFlag Opt_CatchNonexhaustiveCases (DynFlags -> Bool) -> DynFlags -> Bool forall a b. (a -> b) -> a -> b $ HscEnv -> DynFlags hsc_dflags HscEnv hsc_env , cp_convertNumLit :: LitNumType -> Integer -> Maybe CoreExpr cp_convertNumLit = LitNumType -> Integer -> Maybe CoreExpr convertNumLit } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig initCorePrepPgmConfig DynFlags dflags [Var] extra_vars = CorePrepPgmConfig { cpPgm_endPassConfig :: EndPassConfig cpPgm_endPassConfig = DynFlags -> [Var] -> NamePprCtx -> CoreToDo -> EndPassConfig initEndPassConfig DynFlags dflags [Var] extra_vars NamePprCtx alwaysQualify CoreToDo CorePrep , cpPgm_generateDebugInfo :: Bool cpPgm_generateDebugInfo = DynFlags -> Bool needSourceNotes DynFlags dflags }