    module GHC.Driver.Config.Core.Opt.Simplify
      ( initSimplifyExprOpts
      , initSimplifyOpts
      , initSimplMode
      , initGentleSimplMode
      ) where

    import GHC.Prelude

    import GHC.Core.Rules ( RuleBase )
    import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
    import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) )
    import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..) )
    import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) )

    import GHC.Driver.Config ( initOptCoercionOpts )
    import GHC.Driver.Config.Core.Lint ( initLintPassResultConfig )
    import GHC.Driver.Config.Core.Rules ( initRuleOpts )
    import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts )
    import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt )

    import GHC.Runtime.Context ( InteractiveContext(..) )

    import GHC.Types.Basic ( CompilerPhase(..) )
    import GHC.Types.Var ( Var )

    initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts
    initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts
    initSimplifyExprOpts DynFlags
    dflags InteractiveContext
    ic = SimplifyExprOpts
      { se_fam_inst :: [FamInst]
    se_fam_inst = (InstEnv, [FamInst]) -> [FamInst]
    forall a b. (a, b) -> b
    snd ((InstEnv, [FamInst]) -> [FamInst])
    -> (InstEnv, [FamInst]) -> [FamInst]
    forall a b. (a -> b) -> a -> b
    $ InteractiveContext -> (InstEnv, [FamInst])
    ic_instances InteractiveContext
    ic
      , se_mode :: SimplMode
    se_mode = (DynFlags -> CompilerPhase -> String -> SimplMode
    initSimplMode DynFlags
    dflags CompilerPhase
    InitialPhase String
    "GHCi")
        { sm_inline = False
          -- Do not do any inlining, in case we expose some
          -- unboxed tuple stuff that confuses the bytecode
          -- interpreter
        }
      , se_top_env_cfg :: TopEnvConfig
    se_top_env_cfg = TopEnvConfig
        { te_history_size :: Int
    te_history_size = DynFlags -> Int
    historySize DynFlags
    dflags
        , te_tick_factor :: Int
    te_tick_factor = DynFlags -> Int
    simplTickFactor DynFlags
    dflags
        }
      }

    initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts
    initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts
    initSimplifyOpts DynFlags
    dflags [Var]
    extra_vars Int
    iterations SimplMode
    mode RuleBase
    hpt_rule_base = let
      -- This is a particularly ugly construction, but we will get rid of it in !8341.
      opts :: SimplifyOpts
    opts = SimplifyOpts
        { so_dump_core_sizes :: Bool
    so_dump_core_sizes = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_SuppressCoreSizes DynFlags
    dflags
        , so_iterations :: Int
    so_iterations      = Int
    iterations
        , so_mode :: SimplMode
    so_mode            = SimplMode
    mode
        , so_pass_result_cfg :: Maybe LintPassResultConfig
    so_pass_result_cfg = if GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_DoCoreLinting DynFlags
    dflags
                               then LintPassResultConfig -> Maybe LintPassResultConfig
    forall a. a -> Maybe a
    Just (LintPassResultConfig -> Maybe LintPassResultConfig)
    -> LintPassResultConfig -> Maybe LintPassResultConfig
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> [Var] -> CoreToDo -> LintPassResultConfig
    initLintPassResultConfig DynFlags
    dflags [Var]
    extra_vars
                                                                (SimplifyOpts -> CoreToDo
    CoreDoSimplify SimplifyOpts
    opts)
                               else Maybe LintPassResultConfig
    forall a. Maybe a
    Nothing
        , so_hpt_rules :: RuleBase
    so_hpt_rules       = RuleBase
    hpt_rule_base
        , so_top_env_cfg :: TopEnvConfig
    so_top_env_cfg     = TopEnvConfig { te_history_size :: Int
    te_history_size = DynFlags -> Int
    historySize DynFlags
    dflags
                                            , te_tick_factor :: Int
    te_tick_factor = DynFlags -> Int
    simplTickFactor DynFlags
    dflags }
        }
      in SimplifyOpts
    opts

    initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode
    initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode
    initSimplMode DynFlags
    dflags CompilerPhase
    phase String
    name = SimplMode
      { sm_names :: [String]
    sm_names = [String
    name]
      , sm_phase :: CompilerPhase
    sm_phase = CompilerPhase
    phase
      , sm_rules :: Bool
    sm_rules = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_EnableRewriteRules DynFlags
    dflags
      , sm_eta_expand :: Bool
    sm_eta_expand = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_DoLambdaEtaExpansion DynFlags
    dflags
      , sm_cast_swizzle :: Bool
    sm_cast_swizzle = Bool
    True
      , sm_inline :: Bool
    sm_inline = Bool
    True
      , sm_uf_opts :: UnfoldingOpts
    sm_uf_opts = DynFlags -> UnfoldingOpts
    unfoldingOpts DynFlags
    dflags
      , sm_case_case :: Bool
    sm_case_case = Bool
    True
      , sm_pre_inline :: Bool
    sm_pre_inline = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_SimplPreInlining DynFlags
    dflags
      , sm_float_enable :: FloatEnable
    sm_float_enable = DynFlags -> FloatEnable
    floatEnable DynFlags
    dflags
      , sm_do_eta_reduction :: Bool
    sm_do_eta_reduction = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_DoEtaReduction DynFlags
    dflags
      , sm_arity_opts :: ArityOpts
    sm_arity_opts = DynFlags -> ArityOpts
    initArityOpts DynFlags
    dflags
      , sm_rule_opts :: RuleOpts
    sm_rule_opts = DynFlags -> RuleOpts
    initRuleOpts DynFlags
    dflags
      , sm_case_folding :: Bool
    sm_case_folding = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_CaseFolding DynFlags
    dflags
      , sm_case_merge :: Bool
    sm_case_merge = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_CaseMerge DynFlags
    dflags
      , sm_co_opt_opts :: OptCoercionOpts
    sm_co_opt_opts = DynFlags -> OptCoercionOpts
    initOptCoercionOpts DynFlags
    dflags
      }

    initGentleSimplMode :: DynFlags -> SimplMode
    initGentleSimplMode :: DynFlags -> SimplMode
    initGentleSimplMode DynFlags
    dflags = (DynFlags -> CompilerPhase -> String -> SimplMode
    initSimplMode DynFlags
    dflags CompilerPhase
    InitialPhase String
    "Gentle")
      { -- Don't do case-of-case transformations.
        -- This makes full laziness work better
        sm_case_case = False
      }

    floatEnable :: DynFlags -> FloatEnable
    floatEnable :: DynFlags -> FloatEnable
    floatEnable DynFlags
    dflags =
      case (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_LocalFloatOut DynFlags
    dflags, GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_LocalFloatOutTopLevel DynFlags
    dflags) of
        (Bool
    True, Bool
    True) -> FloatEnable
    FloatEnabled
        (Bool
    True, Bool
    False)-> FloatEnable
    FloatNestedOnly
        (Bool
    False, Bool
    _)   -> FloatEnable
    FloatDisabled