    {-
    (c) The AQUA Project, Glasgow University, 1993-1998

    \section[GHC.Core.Opt.Simplify.Monad]{The simplifier Monad}
    -}

    module GHC.Core.Opt.Simplify.Env (
            -- * The simplifier mode
            SimplMode(..), updMode,
            smPedanticBottoms, smPlatform,

            -- * Environments
            SimplEnv(..), pprSimplEnv,   -- Temp not abstract
            seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle,
            seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames,
            seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline,
            seRuleOpts, seRules, seUnfoldingOpts,
            mkSimplEnv, extendIdSubst, extendCvIdSubst,
            extendTvSubst, extendCvSubst,
            zapSubstEnv, setSubstEnv, bumpCaseDepth,
            getInScope, setInScopeFromE, setInScopeFromF,
            setInScopeSet, modifyInScope, addNewInScopeIds,
            getSimplRules, enterRecGroupRHSs,
            reSimplifying,

            -- * Substitution results
            SimplSR(..), mkContEx, substId, lookupRecBndr,

            -- * Simplifying 'Id' binders
            simplNonRecBndr, simplNonRecJoinBndr, simplRecBndrs, simplRecJoinBndrs,
            simplBinder, simplBinders,
            substTy, substTyVar, getSubst,
            substCo, substCoVar,

            -- * Floats
            SimplFloats(..), emptyFloats, isEmptyFloats, mkRecFloats,
            mkFloatBind, addLetFloats, addJoinFloats, addFloats,
            extendFloats, wrapFloats,
            isEmptyJoinFloats, isEmptyLetFloats,
            doFloatFromRhs, getTopFloatBinds,

            -- * LetFloats
            LetFloats, FloatEnable(..), letFloatBinds, emptyLetFloats, unitLetFloat,
            addLetFlts,  mapLetFloats,

            -- * JoinFloats
            JoinFloat, JoinFloats, emptyJoinFloats,
            wrapJoinFloats, wrapJoinFloatsX, unitJoinFloat, addJoinFlts
        ) where

    import GHC.Prelude

    import GHC.Core.Coercion.Opt ( OptCoercionOpts )
    import GHC.Core.FamInstEnv ( FamInstEnv )
    import GHC.Core.Opt.Arity ( ArityOpts(..) )
    import GHC.Core.Opt.Simplify.Monad
    import GHC.Core.Rules.Config ( RuleOpts(..) )
    import GHC.Core
    import GHC.Core.Utils
    import GHC.Core.Unfold
    import GHC.Core.TyCo.Subst (emptyIdSubstEnv)
    import GHC.Core.Multiplicity( Scaled(..), mkMultMul )
    import GHC.Core.Make            ( mkWildValBinder, mkCoreLet )
    import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, substCo
                                    , extendTvSubst, extendCvSubst )
    import qualified GHC.Core.Coercion as Coercion
    import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
    import qualified GHC.Core.Type as Type

    import GHC.Types.Var
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Types.Id as Id
    import GHC.Types.Basic
    import GHC.Types.Unique.FM      ( pprUniqFM )

    import GHC.Data.OrdList
    import GHC.Data.Graph.UnVar

    import GHC.Builtin.Types
    import GHC.Platform ( Platform )

    import GHC.Utils.Monad
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc

    import Data.List ( intersperse, mapAccumL )

    {-
    ************************************************************************
    *                                                                      *
    \subsubsection{The @SimplEnv@ type}
    *                                                                      *
    ************************************************************************
    -}

    {-
    Note [The environments of the Simplify pass]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The functions of the Simplify pass draw their contextual data from two
    environments: `SimplEnv`, which is passed to the functions as an argument, and
    `SimplTopEnv`, which is part of the `SimplM` monad. For both environments exist
    corresponding configuration records `SimplMode` and `TopEnvConfig` respectively.
    A configuration record denotes a unary datatype bundeling the various options
    and switches we provide to control the behaviour of the respective part of the
    Simplify pass. The value is provided by the driver using the functions found in
    the GHC.Driver.Config.Core.Opt.Simplify module.

    These configuration records are part in the environment to avoid needless
    copying of their values. This raises the question which data value goes in which
    of the four datatypes. For each value needed by the pass we ask the following
    two questions:

     * Does the value only make sense in a monadic environment?

     * Is it part of the configuration of the pass and provided by the user or is it
       it an internal value?

    Examples of values that make only sense in conjunction with `SimplM` are the
    logger and the values related to counting. As it does not make sense to use them
    in a pure function (the logger needs IO and counting needs access to the
    accumulated counts in the monad) we want these to live in `SimplTopEnv`.
    Other values, like the switches controlling the behaviour of the pass (e.g.
    whether to do case merging or not) are perfectly usable in a non-monadic setting.
    Indeed many of those are used in guard expressions and it would be cumbersome to
    query them from the monadic environment and feed them to the pure functions as
    an argument. Hence we conveniently store them in the `SpecEnv` environment which
    can be passed to pure functions as a whole.

    Now that we know in which of the two environments a particular value lives we
    turn to the second question to determine if the value is part of the
    configuration record embedded in the environment or if it is stored in an own
    field in the environment type. Some values like the tick factor must be provided
    from outside as we can neither derive it from other values provided to us nor
    does a constant value make sense. Other values like the maximal number of ticks
    are computed on environment initialization and we wish not to expose the field
    to the "user" or the pass -- it is an internal value. Therefore the distinction
    here is between "freely set by the caller" and "internally managed by the pass".

    Note that it doesn't matter for the decision procedure wheter a value is altered
    throughout an iteration of the Simplify pass: The fields sm_phase, sm_inline,
    sm_rules, sm_cast_swizzle and sm_eta_expand are updated locally (See the
    definitions of `updModeForStableUnfoldings` and `updModeForRules` in
    GHC.Core.Opt.Simplify.Utils) but they are still part of `SimplMode` as the
    caller of the Simplify pass needs to provide the initial values for those fields.

    The decision which value goes into which datatype can be summarized by the
    following table:
                                     |          Usable in a           |
                                     | pure setting | monadic setting |
        |----------------------------|--------------|-----------------|
        | Set by user                | SimplMode    | TopEnvConfig    |
        | Computed on initialization | SimplEnv     | SimplTopEnv     |

    Note [Inline depth]
    ~~~~~~~~~~~~~~~~~~~
    When we inline an /already-simplified/ unfolding, we
    * Zap the substitution environment; the inlined thing is an OutExpr
    * Bump the seInlineDepth in the SimplEnv
    Both these tasks are done in zapSubstEnv.

    The seInlineDepth tells us how deep in inlining we are.  Currently,
    seInlineDepth is used for just one purpose: when we encounter a
    coercion we don't apply optCoercion to it if seInlineDepth>0.
    Reason: it has already been optimised once, no point in doing so again.
    -}

    data SimplEnv
      = SimplEnv {
         ----------- Static part of the environment -----------
         -- Static in the sense of lexically scoped,
         -- wrt the original expression

            -- See Note [The environments of the Simplify pass]
            SimplEnv -> SimplMode
    seMode      :: !SimplMode
          , SimplEnv -> (FamInstEnv, FamInstEnv)
    seFamEnvs   :: !(FamInstEnv, FamInstEnv)

            -- The current substitution
          , SimplEnv -> TvSubstEnv
    seTvSubst   :: TvSubstEnv      -- InTyVar |--> OutType
          , SimplEnv -> CvSubstEnv
    seCvSubst   :: CvSubstEnv      -- InCoVar |--> OutCoercion
          , SimplEnv -> SimplIdSubst
    seIdSubst   :: SimplIdSubst    -- InId    |--> OutExpr

            -- | Fast OutVarSet tracking which recursive RHSs we are analysing.
            -- See Note [Eta reduction in recursive RHSs] in GHC.Core.Opt.Arity.
          , SimplEnv -> UnVarSet
    seRecIds :: !UnVarSet

         ----------- Dynamic part of the environment -----------
         -- Dynamic in the sense of describing the setup where
         -- the expression finally ends up

            -- The current set of in-scope variables
            -- They are all OutVars, and all bound in this module
          , SimplEnv -> InScopeSet
    seInScope   :: !InScopeSet       -- OutVars only

          , SimplEnv -> JoinArity
    seCaseDepth   :: !Int  -- Depth of multi-branch case alternatives

          , SimplEnv -> JoinArity
    seInlineDepth :: !Int  -- 0 initially, 1 when we inline an already-simplified
                                   -- unfolding, and simplify again; and so on
                                   -- See Note [Inline depth]
        }

    seArityOpts :: SimplEnv -> ArityOpts
    seArityOpts :: SimplEnv -> ArityOpts
    seArityOpts SimplEnv
    env = SimplMode -> ArityOpts
    sm_arity_opts (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seCaseCase :: SimplEnv -> Bool
    seCaseCase :: SimplEnv -> Bool
    seCaseCase SimplEnv
    env = SimplMode -> Bool
    sm_case_case (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seCaseFolding :: SimplEnv -> Bool
    seCaseFolding :: SimplEnv -> Bool
    seCaseFolding SimplEnv
    env = SimplMode -> Bool
    sm_case_folding (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seCaseMerge :: SimplEnv -> Bool
    seCaseMerge :: SimplEnv -> Bool
    seCaseMerge SimplEnv
    env = SimplMode -> Bool
    sm_case_merge (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seCastSwizzle :: SimplEnv -> Bool
    seCastSwizzle :: SimplEnv -> Bool
    seCastSwizzle SimplEnv
    env = SimplMode -> Bool
    sm_cast_swizzle (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seDoEtaReduction :: SimplEnv -> Bool
    seDoEtaReduction :: SimplEnv -> Bool
    seDoEtaReduction SimplEnv
    env = SimplMode -> Bool
    sm_do_eta_reduction (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seEtaExpand :: SimplEnv -> Bool
    seEtaExpand :: SimplEnv -> Bool
    seEtaExpand SimplEnv
    env = SimplMode -> Bool
    sm_eta_expand (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seFloatEnable :: SimplEnv -> FloatEnable
    seFloatEnable :: SimplEnv -> FloatEnable
    seFloatEnable SimplEnv
    env = SimplMode -> FloatEnable
    sm_float_enable (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seInline :: SimplEnv -> Bool
    seInline :: SimplEnv -> Bool
    seInline SimplEnv
    env = SimplMode -> Bool
    sm_inline (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seNames :: SimplEnv -> [String]
    seNames :: SimplEnv -> [String]
    seNames SimplEnv
    env = SimplMode -> [String]
    sm_names (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seOptCoercionOpts :: SimplEnv -> OptCoercionOpts
    seOptCoercionOpts :: SimplEnv -> OptCoercionOpts
    seOptCoercionOpts SimplEnv
    env = SimplMode -> OptCoercionOpts
    sm_co_opt_opts (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    sePedanticBottoms :: SimplEnv -> Bool
    sePedanticBottoms :: SimplEnv -> Bool
    sePedanticBottoms SimplEnv
    env = SimplMode -> Bool
    smPedanticBottoms (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    sePhase :: SimplEnv -> CompilerPhase
    sePhase :: SimplEnv -> CompilerPhase
    sePhase SimplEnv
    env = SimplMode -> CompilerPhase
    sm_phase (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    sePlatform :: SimplEnv -> Platform
    sePlatform :: SimplEnv -> Platform
    sePlatform SimplEnv
    env = SimplMode -> Platform
    smPlatform (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    sePreInline :: SimplEnv -> Bool
    sePreInline :: SimplEnv -> Bool
    sePreInline SimplEnv
    env = SimplMode -> Bool
    sm_pre_inline (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seRuleOpts :: SimplEnv -> RuleOpts
    seRuleOpts :: SimplEnv -> RuleOpts
    seRuleOpts SimplEnv
    env = SimplMode -> RuleOpts
    sm_rule_opts (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seRules :: SimplEnv -> Bool
    seRules :: SimplEnv -> Bool
    seRules SimplEnv
    env = SimplMode -> Bool
    sm_rules (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seUnfoldingOpts :: SimplEnv -> UnfoldingOpts
    seUnfoldingOpts :: SimplEnv -> UnfoldingOpts
    seUnfoldingOpts SimplEnv
    env = SimplMode -> UnfoldingOpts
    sm_uf_opts (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    -- See Note [The environments of the Simplify pass]
    data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad
      { SimplMode -> CompilerPhase
    sm_phase        :: !CompilerPhase
      , SimplMode -> [String]
    sm_names        :: ![String]      -- ^ Name(s) of the phase
      , SimplMode -> Bool
    sm_rules        :: !Bool          -- ^ Whether RULES are enabled
      , SimplMode -> Bool
    sm_inline       :: !Bool          -- ^ Whether inlining is enabled
      , SimplMode -> Bool
    sm_eta_expand   :: !Bool          -- ^ Whether eta-expansion is enabled
      , SimplMode -> Bool
    sm_cast_swizzle :: !Bool          -- ^ Do we swizzle casts past lambdas?
      , SimplMode -> UnfoldingOpts
    sm_uf_opts      :: !UnfoldingOpts -- ^ Unfolding options
      , SimplMode -> Bool
    sm_case_case    :: !Bool          -- ^ Whether case-of-case is enabled
      , SimplMode -> Bool
    sm_pre_inline   :: !Bool          -- ^ Whether pre-inlining is enabled
      , SimplMode -> FloatEnable
    sm_float_enable :: !FloatEnable   -- ^ Whether to enable floating out
      , SimplMode -> Bool
    sm_do_eta_reduction :: !Bool
      , SimplMode -> ArityOpts
    sm_arity_opts :: !ArityOpts
      , SimplMode -> RuleOpts
    sm_rule_opts :: !RuleOpts
      , SimplMode -> Bool
    sm_case_folding :: !Bool
      , SimplMode -> Bool
    sm_case_merge :: !Bool
      , SimplMode -> OptCoercionOpts
    sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
      }

    instance Outputable SimplMode where
        ppr :: SimplMode -> SDoc
    ppr (SimplMode { sm_phase :: SimplMode -> CompilerPhase
    sm_phase = CompilerPhase
    p , sm_names :: SimplMode -> [String]
    sm_names = [String]
    ss
                       , sm_rules :: SimplMode -> Bool
    sm_rules = Bool
    r, sm_inline :: SimplMode -> Bool
    sm_inline = Bool
    i
                       , sm_cast_swizzle :: SimplMode -> Bool
    sm_cast_swizzle = Bool
    cs
                       , sm_eta_expand :: SimplMode -> Bool
    sm_eta_expand = Bool
    eta, sm_case_case :: SimplMode -> Bool
    sm_case_case = Bool
    cc })
           = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SimplMode" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    braces (
             [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Phase =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CompilerPhase -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CompilerPhase
    p SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                   SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    brackets (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    "," [String]
    ss)) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                 , Bool -> SDoc -> SDoc
    forall {doc}. IsLine doc => Bool -> doc -> doc
    pp_flag Bool
    i   (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "inline") SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                 , Bool -> SDoc -> SDoc
    forall {doc}. IsLine doc => Bool -> doc -> doc
    pp_flag Bool
    r   (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "rules") SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                 , Bool -> SDoc -> SDoc
    forall {doc}. IsLine doc => Bool -> doc -> doc
    pp_flag Bool
    eta (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "eta-expand") SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                 , Bool -> SDoc -> SDoc
    forall {doc}. IsLine doc => Bool -> doc -> doc
    pp_flag Bool
    cs (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "cast-swizzle") SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                 , Bool -> SDoc -> SDoc
    forall {doc}. IsLine doc => Bool -> doc -> doc
    pp_flag Bool
    cc  (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "case-of-case") ])
             where
               pp_flag :: Bool -> doc -> doc
    pp_flag Bool
    f doc
    s = Bool -> doc -> doc
    forall doc. IsOutput doc => Bool -> doc -> doc
    ppUnless Bool
    f (String -> doc
    forall doc. IsLine doc => String -> doc
    text String
    "no") doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> doc
    s

    smPedanticBottoms :: SimplMode -> Bool
    smPedanticBottoms :: SimplMode -> Bool
    smPedanticBottoms SimplMode
    opts = ArityOpts -> Bool
    ao_ped_bot (SimplMode -> ArityOpts
    sm_arity_opts SimplMode
    opts)

    smPlatform :: SimplMode -> Platform
    smPlatform :: SimplMode -> Platform
    smPlatform SimplMode
    opts = RuleOpts -> Platform
    roPlatform (SimplMode -> RuleOpts
    sm_rule_opts SimplMode
    opts)

    data FloatEnable  -- Controls local let-floating
      = FloatDisabled      -- Do no local let-floating
      | FloatNestedOnly    -- Local let-floating for nested (NotTopLevel) bindings only
      | FloatEnabled       -- Do local let-floating on all bindings

    {-
    Note [Local floating]
    ~~~~~~~~~~~~~~~~~~~~~
    The Simplifier can perform local let-floating: it floats let-bindings
    out of the RHS of let-bindings.  See
      Let-floating: moving bindings to give faster programs (ICFP'96)
      https://www.microsoft.com/en-us/research/publication/let-floating-moving-bindings-to-give-faster-programs/

    Here's an example
       x = let y = v+1 in (y,true)

    The RHS of x is a thunk.  Much better to float that y-binding out to give
       y = v+1
       x = (y,true)

    Not only have we avoided building a thunk, but any (case x of (p,q) -> ...) in
    the scope of the x-binding can now be simplified.

    This local let-floating is done in GHC.Core.Opt.Simplify.prepareBinding,
    controlled by the predicate GHC.Core.Opt.Simplify.Env.doFloatFromRhs.

    The `FloatEnable` data type controls where local let-floating takes place;
    it allows you to specify that it should be done only for nested bindings;
    or for top-level bindings as well; or not at all.

    Note that all of this is quite separate from the global FloatOut pass;
    see GHC.Core.Opt.FloatOut.

    -}

    data SimplFloats
      = SimplFloats
          { -- Ordinary let bindings
            SimplFloats -> LetFloats
    sfLetFloats  :: LetFloats
                    -- See Note [LetFloats]

            -- Join points
          , SimplFloats -> JoinFloats
    sfJoinFloats :: JoinFloats
                    -- Handled separately; they don't go very far
                    -- We consider these to be /inside/ sfLetFloats
                    -- because join points can refer to ordinary bindings,
                    -- but not vice versa

            -- Includes all variables bound by sfLetFloats and
            -- sfJoinFloats, plus at least whatever is in scope where
            -- these bindings land up.
          , SimplFloats -> InScopeSet
    sfInScope :: InScopeSet  -- All OutVars
          }

    instance Outputable SimplFloats where
      ppr :: SimplFloats -> SDoc
    ppr (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats = LetFloats
    lf, sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jf, sfInScope :: SimplFloats -> InScopeSet
    sfInScope = InScopeSet
    is })
        = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SimplFloats"
          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    braces ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "lets: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> LetFloats -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LetFloats
    lf
                           , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "joins:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> JoinFloats -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr JoinFloats
    jf
                           , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in_scope:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> InScopeSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr InScopeSet
    is ])

    emptyFloats :: SimplEnv -> SimplFloats
    emptyFloats :: SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
      = SimplFloats { sfLetFloats :: LetFloats
    sfLetFloats  = LetFloats
    emptyLetFloats
                    , sfJoinFloats :: JoinFloats
    sfJoinFloats = JoinFloats
    emptyJoinFloats
                    , sfInScope :: InScopeSet
    sfInScope    = SimplEnv -> InScopeSet
    seInScope SimplEnv
    env }

    isEmptyFloats :: SimplFloats -> Bool
    -- Precondition: used only when sfJoinFloats is empty
    isEmptyFloats :: SimplFloats -> Bool
    isEmptyFloats (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats  = LetFloats JoinFloats
    fs FloatFlag
    _
                               , sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    js })
      = Bool -> SDoc -> Bool -> Bool
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    js) (JoinFloats -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr JoinFloats
    js ) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $
        JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    fs

    pprSimplEnv :: SimplEnv -> SDoc
    -- Used for debugging; selective
    pprSimplEnv :: SimplEnv -> SDoc
    pprSimplEnv SimplEnv
    env
      = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "TvSubst:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> TvSubstEnv -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SimplEnv -> TvSubstEnv
    seTvSubst SimplEnv
    env),
              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "CvSubst:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CvSubstEnv -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SimplEnv -> CvSubstEnv
    seCvSubst SimplEnv
    env),
              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "IdSubst:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    id_subst_doc,
              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "InScope:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    in_scope_vars_doc
        ]
      where
       id_subst_doc :: SDoc
    id_subst_doc = (SimplSR -> SDoc) -> SimplIdSubst -> SDoc
    forall {k} a (key :: k). (a -> SDoc) -> UniqFM key a -> SDoc
    pprUniqFM SimplSR -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SimplEnv -> SimplIdSubst
    seIdSubst SimplEnv
    env)
       in_scope_vars_doc :: SDoc
    in_scope_vars_doc = VarSet -> ([OutId] -> SDoc) -> SDoc
    pprVarSet (InScopeSet -> VarSet
    getInScopeVars (SimplEnv -> InScopeSet
    seInScope SimplEnv
    env))
                                     ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ([SDoc] -> SDoc) -> ([OutId] -> [SDoc]) -> [OutId] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OutId -> SDoc) -> [OutId] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map OutId -> SDoc
    ppr_one)
       ppr_one :: OutId -> SDoc
    ppr_one OutId
    v | OutId -> Bool
    isId OutId
    v = OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    v SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Unfolding -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (IdUnfoldingFun
    idUnfolding OutId
    v)
                 | Bool
    otherwise = OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    v

    type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
            -- See Note [Extending the IdSubstEnv] in GHC.Core.Subst

    -- | A substitution result.
    data SimplSR
      = DoneEx OutExpr JoinPointHood
           -- If  x :-> DoneEx e ja   is in the SimplIdSubst
           -- then replace occurrences of x by e
           -- and  ja = Just a <=> x is a join-point of arity a
           -- See Note [Join arity in SimplIdSubst]

      | DoneId OutId
           -- If  x :-> DoneId v   is in the SimplIdSubst
           -- then replace occurrences of x by v
           -- and  v is a join-point of arity a
           --      <=> x is a join-point of arity a

      | ContEx TvSubstEnv                 -- A suspended substitution
               CvSubstEnv
               SimplIdSubst
               InExpr
          -- If   x :-> ContEx tv cv id e   is in the SimplISubst
          -- then replace occurrences of x by (subst (tv,cv,id) e)

    instance Outputable SimplSR where
      ppr :: SimplSR -> SDoc
    ppr (DoneId OutId
    v)    = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DoneId" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    v
      ppr (DoneEx OutExpr
    e JoinPointHood
    mj) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DoneEx" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    pp_mj SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> OutExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutExpr
    e
        where
          pp_mj :: SDoc
    pp_mj = case JoinPointHood
    mj of
                    JoinPointHood
    NotJoinPoint -> SDoc
    forall doc. IsOutput doc => doc
    empty
                    JoinPoint JoinArity
    n  -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (JoinArity -> SDoc
    forall doc. IsLine doc => JoinArity -> doc
    int JoinArity
    n)

      ppr (ContEx TvSubstEnv
    _tv CvSubstEnv
    _cv SimplIdSubst
    _id OutExpr
    e) = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ContEx" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> OutExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutExpr
    e {-,
                                    ppr (filter_env tv), ppr (filter_env id) -}]
            -- where
            -- fvs = exprFreeVars e
            -- filter_env env = filterVarEnv_Directly keep env
            -- keep uniq _ = uniq `elemUFM_Directly` fvs

    {-
    Note [SimplEnv invariants]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    seInScope:
            The in-scope part of Subst includes *all* in-scope TyVars and Ids
            The elements of the set may have better IdInfo than the
            occurrences of in-scope Ids, and (more important) they will
            have a correctly-substituted type.  So we use a lookup in this
            set to replace occurrences

            The Ids in the InScopeSet are replete with their Rules,
            and as we gather info about the unfolding of an Id, we replace
            it in the in-scope set.

            The in-scope set is actually a mapping OutVar -> OutVar, and
            in case expressions we sometimes bind

    seIdSubst:
            The substitution is *apply-once* only, because InIds and OutIds
            can overlap.
            For example, we generally omit mappings
                    a77 -> a77
            from the substitution, when we decide not to clone a77, but it's quite
            legitimate to put the mapping in the substitution anyway.

            Furthermore, consider
                    let x = case k of I# x77 -> ... in
                    let y = case k of I# x77 -> ... in ...
            and suppose the body is strict in both x and y.  Then the simplifier
            will pull the first (case k) to the top; so the second (case k) will
            cancel out, mapping x77 to, well, x77!  But one is an in-Id and the
            other is an out-Id.

            Of course, the substitution *must* applied! Things in its domain
            simply aren't necessarily bound in the result.

    * substId adds a binding (DoneId new_id) to the substitution if
            the Id's unique has changed

      Note, though that the substitution isn't necessarily extended
      if the type of the Id changes.  Why not?  Because of the next point:

    * We *always, always* finish by looking up in the in-scope set
      any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
      Reason: so that we never finish up with a "old" Id in the result.
      An old Id might point to an old unfolding and so on... which gives a space
      leak.

      [The DoneEx and DoneVar hits map to "new" stuff.]

    * It follows that substExpr must not do a no-op if the substitution is empty.
      substType is free to do so, however.

    * When we come to a let-binding (say) we generate new IdInfo, including an
      unfolding, attach it to the binder, and add this newly adorned binder to
      the in-scope set.  So all subsequent occurrences of the binder will get
      mapped to the full-adorned binder, which is also the one put in the
      binding site.

    * The in-scope "set" usually maps x->x; we use it simply for its domain.
      But sometimes we have two in-scope Ids that are synonyms, and should
      map to the same target:  x->x, y->x.  Notably:
            case y of x { ... }
      That's why the "set" is actually a VarEnv Var

    Note [Join arity in SimplIdSubst]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We have to remember which incoming variables are join points: the occurrences
    may not be marked correctly yet, and we're in change of propagating the change if
    OccurAnal makes something a join point).

    Normally the in-scope set is where we keep the latest information, but
    the in-scope set tracks only OutVars; if a binding is unconditionally
    inlined (via DoneEx), it never makes it into the in-scope set, and we
    need to know at the occurrence site that the variable is a join point
    so that we know to drop the context. Thus we remember which join
    points we're substituting. -}

    mkSimplEnv :: SimplMode -> (FamInstEnv, FamInstEnv) -> SimplEnv
    mkSimplEnv :: SimplMode -> (FamInstEnv, FamInstEnv) -> SimplEnv
    mkSimplEnv SimplMode
    mode (FamInstEnv, FamInstEnv)
    fam_envs
      = SimplEnv { seMode :: SimplMode
    seMode        = SimplMode
    mode
                 , seFamEnvs :: (FamInstEnv, FamInstEnv)
    seFamEnvs     = (FamInstEnv, FamInstEnv)
    fam_envs
                 , seInScope :: InScopeSet
    seInScope     = InScopeSet
    init_in_scope
                 , seTvSubst :: TvSubstEnv
    seTvSubst     = TvSubstEnv
    forall a. VarEnv a
    emptyVarEnv
                 , seCvSubst :: CvSubstEnv
    seCvSubst     = CvSubstEnv
    forall a. VarEnv a
    emptyVarEnv
                 , seIdSubst :: SimplIdSubst
    seIdSubst     = SimplIdSubst
    forall a. VarEnv a
    emptyVarEnv
                 , seRecIds :: UnVarSet
    seRecIds      = UnVarSet
    emptyUnVarSet
                 , seCaseDepth :: JoinArity
    seCaseDepth   = JoinArity
    0
                 , seInlineDepth :: JoinArity
    seInlineDepth = JoinArity
    0 }
            -- The top level "enclosing CC" is "SUBSUMED".

    init_in_scope :: InScopeSet
    init_in_scope :: InScopeSet
    init_in_scope = VarSet -> InScopeSet
    mkInScopeSet (OutId -> VarSet
    unitVarSet (Kind -> Kind -> OutId
    mkWildValBinder Kind
    ManyTy Kind
    unitTy))
                  -- See Note [WildCard binders]

    {-
    Note [WildCard binders]
    ~~~~~~~~~~~~~~~~~~~~~~~
    The program to be simplified may have wild binders
        case e of wild { p -> ... }
    We want to *rename* them away, so that there are no
    occurrences of 'wild-id' (with wildCardKey).  The easy
    way to do that is to start of with a representative
    Id in the in-scope set

    There can be *occurrences* of wild-id.  For example,
    GHC.Core.Make.mkCoreApp transforms
       e (a /# b)   -->   case (a /# b) of wild { DEFAULT -> e wild }
    This is ok provided 'wild' isn't free in 'e', and that's the delicate
    thing. Generally, you want to run the simplifier to get rid of the
    wild-ids before doing much else.

    It's a very dark corner of GHC.  Maybe it should be cleaned up.
    -}

    updMode :: (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv
    updMode :: (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv
    updMode SimplMode -> SimplMode
    upd SimplEnv
    env
      = -- Avoid keeping env alive in case inlining fails.
        let mode :: SimplMode
    mode = SimplMode -> SimplMode
    upd (SimplMode -> SimplMode) -> SimplMode -> SimplMode
    forall a b. (a -> b) -> a -> b
    $! (SimplEnv -> SimplMode
    seMode SimplEnv
    env)
        in SimplEnv
    env { seMode = mode }

    bumpCaseDepth :: SimplEnv -> SimplEnv
    bumpCaseDepth :: SimplEnv -> SimplEnv
    bumpCaseDepth SimplEnv
    env = SimplEnv
    env { seCaseDepth = seCaseDepth env + 1 }

    reSimplifying :: SimplEnv -> Bool
    reSimplifying :: SimplEnv -> Bool
    reSimplifying (SimplEnv { seInlineDepth :: SimplEnv -> JoinArity
    seInlineDepth = JoinArity
    n }) = JoinArity
    nJoinArity -> JoinArity -> Bool
    forall a. Ord a => a -> a -> Bool
    >JoinArity
    0

    ---------------------
    extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
    extendIdSubst :: SimplEnv -> OutId -> SimplSR -> SimplEnv
    extendIdSubst env :: SimplEnv
    env@(SimplEnv {seIdSubst :: SimplEnv -> SimplIdSubst
    seIdSubst = SimplIdSubst
    subst}) OutId
    var SimplSR
    res
      = Bool -> SDoc -> SimplEnv -> SimplEnv
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (OutId -> Bool
    isId OutId
    var Bool -> Bool -> Bool
    && Bool -> Bool
    not (OutId -> Bool
    isCoVar OutId
    var)) (OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    var) (SimplEnv -> SimplEnv) -> SimplEnv -> SimplEnv
    forall a b. (a -> b) -> a -> b
    $
        SimplEnv
    env { seIdSubst = extendVarEnv subst var res }

    extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
    extendTvSubst :: SimplEnv -> OutId -> Kind -> SimplEnv
    extendTvSubst env :: SimplEnv
    env@(SimplEnv {seTvSubst :: SimplEnv -> TvSubstEnv
    seTvSubst = TvSubstEnv
    tsubst}) OutId
    var Kind
    res
      = Bool -> SDoc -> SimplEnv -> SimplEnv
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (OutId -> Bool
    isTyVar OutId
    var) (OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    var SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    res) (SimplEnv -> SimplEnv) -> SimplEnv -> SimplEnv
    forall a b. (a -> b) -> a -> b
    $
        SimplEnv
    env {seTvSubst = extendVarEnv tsubst var res}

    extendCvSubst :: SimplEnv -> CoVar -> Coercion -> SimplEnv
    extendCvSubst :: SimplEnv -> OutId -> Coercion -> SimplEnv
    extendCvSubst env :: SimplEnv
    env@(SimplEnv {seCvSubst :: SimplEnv -> CvSubstEnv
    seCvSubst = CvSubstEnv
    csubst}) OutId
    var Coercion
    co
      = Bool -> SimplEnv -> SimplEnv
    forall a. HasCallStack => Bool -> a -> a
    assert (OutId -> Bool
    isCoVar OutId
    var) (SimplEnv -> SimplEnv) -> SimplEnv -> SimplEnv
    forall a b. (a -> b) -> a -> b
    $
        SimplEnv
    env {seCvSubst = extendVarEnv csubst var co}

    extendCvIdSubst :: SimplEnv -> Id -> OutExpr -> SimplEnv
    extendCvIdSubst :: SimplEnv -> OutId -> OutExpr -> SimplEnv
    extendCvIdSubst SimplEnv
    env OutId
    bndr (Coercion Coercion
    co) = SimplEnv -> OutId -> Coercion -> SimplEnv
    extendCvSubst SimplEnv
    env OutId
    bndr Coercion
    co
    extendCvIdSubst SimplEnv
    env OutId
    bndr OutExpr
    rhs           = SimplEnv -> OutId -> SimplSR -> SimplEnv
    extendIdSubst SimplEnv
    env OutId
    bndr (OutExpr -> JoinPointHood -> SimplSR
    DoneEx OutExpr
    rhs JoinPointHood
    NotJoinPoint)

    ---------------------
    getInScope :: SimplEnv -> InScopeSet
    getInScope :: SimplEnv -> InScopeSet
    getInScope SimplEnv
    env = SimplEnv -> InScopeSet
    seInScope SimplEnv
    env

    setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
    setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
    setInScopeSet SimplEnv
    env InScopeSet
    in_scope = SimplEnv
    env {seInScope = in_scope}

    setInScopeFromE :: SimplEnv -> SimplEnv -> SimplEnv
    -- See Note [Setting the right in-scope set]
    setInScopeFromE :: SimplEnv -> SimplEnv -> SimplEnv
    setInScopeFromE SimplEnv
    rhs_env SimplEnv
    here_env = SimplEnv
    rhs_env { seInScope = seInScope here_env }

    setInScopeFromF :: SimplEnv -> SimplFloats -> SimplEnv
    setInScopeFromF :: SimplEnv -> SimplFloats -> SimplEnv
    setInScopeFromF SimplEnv
    env SimplFloats
    floats = SimplEnv
    env { seInScope = sfInScope floats }

    addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
            -- The new Ids are guaranteed to be freshly allocated
    addNewInScopeIds :: SimplEnv -> [OutId] -> SimplEnv
    addNewInScopeIds env :: SimplEnv
    env@(SimplEnv { seInScope :: SimplEnv -> InScopeSet
    seInScope = InScopeSet
    in_scope, seIdSubst :: SimplEnv -> SimplIdSubst
    seIdSubst = SimplIdSubst
    id_subst }) [OutId]
    vs
    -- See Note [Bangs in the Simplifier]
      = let !in_scope1 :: InScopeSet
    in_scope1 = InScopeSet
    in_scope InScopeSet -> [OutId] -> InScopeSet
    `extendInScopeSetList` [OutId]
    vs
            !id_subst1 :: SimplIdSubst
    id_subst1 = SimplIdSubst
    id_subst SimplIdSubst -> [OutId] -> SimplIdSubst
    forall a. VarEnv a -> [OutId] -> VarEnv a
    `delVarEnvList` [OutId]
    vs
        in
        SimplEnv
    env { seInScope = in_scope1,
              seIdSubst = id_subst1 }
            -- Why delete?  Consider
            --      let x = a*b in (x, \x -> x+3)
            -- We add [x |-> a*b] to the substitution, but we must
            -- _delete_ it from the substitution when going inside
            -- the (\x -> ...)!

    modifyInScope :: SimplEnv -> CoreBndr -> SimplEnv
    -- The variable should already be in scope, but
    -- replace the existing version with this new one
    -- which has more information
    modifyInScope :: SimplEnv -> OutId -> SimplEnv
    modifyInScope env :: SimplEnv
    env@(SimplEnv {seInScope :: SimplEnv -> InScopeSet
    seInScope = InScopeSet
    in_scope}) OutId
    v
      = SimplEnv
    env {seInScope = extendInScopeSet in_scope v}

    enterRecGroupRHSs :: SimplEnv -> [OutBndr] -> (SimplEnv -> SimplM (r, SimplEnv))
                      -> SimplM (r, SimplEnv)
    enterRecGroupRHSs :: forall r.
    SimplEnv
    -> [OutId]
    -> (SimplEnv -> SimplM (r, SimplEnv))
    -> SimplM (r, SimplEnv)
    enterRecGroupRHSs SimplEnv
    env [OutId]
    bndrs SimplEnv -> SimplM (r, SimplEnv)
    k = do
      --pprTraceM "enterRecGroupRHSs" (ppr bndrs)
      (r, env'') <- SimplEnv -> SimplM (r, SimplEnv)
    k SimplEnv
    env{seRecIds = extendUnVarSetList bndrs (seRecIds env)}
      return (r, env''{seRecIds = seRecIds env})

    {- Note [Setting the right in-scope set]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      \x. (let x = e in b) arg[x]
    where the let shadows the lambda.  Really this means something like
      \x1. (let x2 = e in b) arg[x1]

    - When we capture the 'arg' in an ApplyToVal continuation, we capture
      the environment, which says what 'x' is bound to, namely x1

    - Then that continuation gets pushed under the let

    - Finally we simplify 'arg'.  We want
         - the static, lexical environment binding x :-> x1
         - the in-scopeset from "here", under the 'let' which includes
           both x1 and x2

    It's important to have the right in-scope set, else we may rename a
    variable to one that is already in scope.  So we must pick up the
    in-scope set from "here", but otherwise use the environment we
    captured along with 'arg'.  This transfer of in-scope set is done by
    setInScopeFromE.
    -}

    ---------------------
    zapSubstEnv :: SimplEnv -> SimplEnv
    -- See Note [Inline depth]
    -- We call zapSubstEnv precisely when we are about to
    -- simplify an already-simplified term
    zapSubstEnv :: SimplEnv -> SimplEnv
    zapSubstEnv env :: SimplEnv
    env@(SimplEnv { seInlineDepth :: SimplEnv -> JoinArity
    seInlineDepth = JoinArity
    n })
      = SimplEnv
    env { seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv
            , seInlineDepth = n+1 }

    setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
    setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
    setSubstEnv SimplEnv
    env TvSubstEnv
    tvs CvSubstEnv
    cvs SimplIdSubst
    ids = SimplEnv
    env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }

    mkContEx :: SimplEnv -> InExpr -> SimplSR
    mkContEx :: SimplEnv -> OutExpr -> SimplSR
    mkContEx (SimplEnv { seTvSubst :: SimplEnv -> TvSubstEnv
    seTvSubst = TvSubstEnv
    tvs, seCvSubst :: SimplEnv -> CvSubstEnv
    seCvSubst = CvSubstEnv
    cvs, seIdSubst :: SimplEnv -> SimplIdSubst
    seIdSubst = SimplIdSubst
    ids }) OutExpr
    e = TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> OutExpr -> SimplSR
    ContEx TvSubstEnv
    tvs CvSubstEnv
    cvs SimplIdSubst
    ids OutExpr
    e

    {-
    ************************************************************************
    *                                                                      *
    \subsection{LetFloats}
    *                                                                      *
    ************************************************************************

    Note [LetFloats]
    ~~~~~~~~~~~~~~~~
    The LetFloats is a bunch of bindings, classified by a FloatFlag.

    The `FloatFlag` contains summary information about the bindings, see the data
    type declaration of `FloatFlag`

    Examples

      NonRec x (y:ys)       FltLifted
      Rec [(x,rhs)]         FltLifted

      NonRec x* (p:q)       FltOKSpec   -- RHS is WHNF.  Question: why not FltLifted?
      NonRec x# (y +# 3)    FltOkSpec   -- Unboxed, but ok-for-spec'n

      NonRec x* (f y)       FltCareful  -- Strict binding; might fail or diverge
      NonRec x# (a /# b)    FltCareful  -- Might fail; does not satisfy let-can-float invariant
      NonRec x# (f y)       FltCareful  -- Might diverge; does not satisfy let-can-float invariant
    -}

    data LetFloats = LetFloats (OrdList OutBind) FloatFlag
                     -- See Note [LetFloats]

    type JoinFloat  = OutBind
    type JoinFloats = OrdList JoinFloat

    data FloatFlag
      = FltLifted   -- All bindings are lifted and lazy *or*
                    --     consist of a single primitive string literal
                    -- Hence ok to float to top level, or recursive
                    -- NB: consequence: all bindings satisfy let-can-float invariant

      | FltOkSpec   -- All bindings are FltLifted *or*
                    --      strict (perhaps because unlifted,
                    --      perhaps because of a strict binder),
                    --        *and* ok-for-speculation
                    -- Hence ok to float out of the RHS
                    -- of a lazy non-recursive let binding
                    -- (but not to top level, or into a rec group)
                    -- NB: consequence: all bindings satisfy let-can-float invariant

      | FltCareful  -- At least one binding is strict (or unlifted)
                    --      and not guaranteed cheap
                    -- Do not float these bindings out of a lazy let!
                    -- NB: some bindings may not satisfy let-can-float

    instance Outputable LetFloats where
      ppr :: LetFloats -> SDoc
    ppr (LetFloats JoinFloats
    binds FloatFlag
    ff) = FloatFlag -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FloatFlag
    ff SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [Bind OutId] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (JoinFloats -> [Bind OutId]
    forall a. OrdList a -> [a]
    fromOL JoinFloats
    binds)

    instance Outputable FloatFlag where
      ppr :: FloatFlag -> SDoc
    ppr FloatFlag
    FltLifted  = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "FltLifted"
      ppr FloatFlag
    FltOkSpec  = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "FltOkSpec"
      ppr FloatFlag
    FltCareful = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "FltCareful"

    andFF :: FloatFlag -> FloatFlag -> FloatFlag
    andFF :: FloatFlag -> FloatFlag -> FloatFlag
    andFF FloatFlag
    FltCareful FloatFlag
    _          = FloatFlag
    FltCareful
    andFF FloatFlag
    FltOkSpec  FloatFlag
    FltCareful = FloatFlag
    FltCareful
    andFF FloatFlag
    FltOkSpec  FloatFlag
    _          = FloatFlag
    FltOkSpec
    andFF FloatFlag
    FltLifted  FloatFlag
    flt        = FloatFlag
    flt

    doFloatFromRhs :: FloatEnable -> TopLevelFlag -> RecFlag -> Bool -> SimplFloats -> OutExpr -> Bool
    -- If you change this function look also at FloatIn.noFloatIntoRhs
    doFloatFromRhs :: FloatEnable
    -> TopLevelFlag
    -> RecFlag
    -> Bool
    -> SimplFloats
    -> OutExpr
    -> Bool
    doFloatFromRhs FloatEnable
    fe TopLevelFlag
    lvl RecFlag
    rec Bool
    strict_bind (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats = LetFloats JoinFloats
    fs FloatFlag
    ff }) OutExpr
    rhs
      = TopLevelFlag -> FloatEnable -> Bool
    floatEnabled TopLevelFlag
    lvl FloatEnable
    fe
          Bool -> Bool -> Bool
    && Bool -> Bool
    not (JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    fs)
          Bool -> Bool -> Bool
    && Bool
    want_to_float
          Bool -> Bool -> Bool
    && Bool
    can_float
      where
         want_to_float :: Bool
    want_to_float = TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    lvl Bool -> Bool -> Bool
    || OutExpr -> Bool
    exprIsCheap OutExpr
    rhs Bool -> Bool -> Bool
    || OutExpr -> Bool
    exprIsExpandable OutExpr
    rhs
                         -- See Note [Float when cheap or expandable]
         can_float :: Bool
    can_float = case FloatFlag
    ff of
                       FloatFlag
    FltLifted  -> Bool
    True
                       FloatFlag
    FltOkSpec  -> TopLevelFlag -> Bool
    isNotTopLevel TopLevelFlag
    lvl Bool -> Bool -> Bool
    && RecFlag -> Bool
    isNonRec RecFlag
    rec
                       FloatFlag
    FltCareful -> TopLevelFlag -> Bool
    isNotTopLevel TopLevelFlag
    lvl Bool -> Bool -> Bool
    && RecFlag -> Bool
    isNonRec RecFlag
    rec Bool -> Bool -> Bool
    && Bool
    strict_bind

         -- Whether any floating is allowed by flags.
         floatEnabled :: TopLevelFlag -> FloatEnable -> Bool
         floatEnabled :: TopLevelFlag -> FloatEnable -> Bool
    floatEnabled TopLevelFlag
    _ FloatEnable
    FloatDisabled = Bool
    False
         floatEnabled TopLevelFlag
    lvl FloatEnable
    FloatNestedOnly = Bool -> Bool
    not (TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    lvl)
         floatEnabled TopLevelFlag
    _ FloatEnable
    FloatEnabled = Bool
    True

    {-
    Note [Float when cheap or expandable]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We want to float a let from a let if the residual RHS is
       a) cheap, such as (\x. blah)
       b) expandable, such as (f b) if f is CONLIKE
    But there are
      - cheap things that are not expandable (eg \x. expensive)
      - expandable things that are not cheap (eg (f b) where b is CONLIKE)
    so we must take the 'or' of the two.
    -}

    emptyLetFloats :: LetFloats
    emptyLetFloats :: LetFloats
    emptyLetFloats = JoinFloats -> FloatFlag -> LetFloats
    LetFloats JoinFloats
    forall a. OrdList a
    nilOL FloatFlag
    FltLifted

    isEmptyLetFloats :: LetFloats -> Bool
    isEmptyLetFloats :: LetFloats -> Bool
    isEmptyLetFloats (LetFloats JoinFloats
    fs FloatFlag
    _) = JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    fs

    emptyJoinFloats :: JoinFloats
    emptyJoinFloats :: JoinFloats
    emptyJoinFloats = JoinFloats
    forall a. OrdList a
    nilOL

    isEmptyJoinFloats :: JoinFloats -> Bool
    isEmptyJoinFloats :: JoinFloats -> Bool
    isEmptyJoinFloats = JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL

    unitLetFloat :: OutBind -> LetFloats
    -- This key function constructs a singleton float with the right form
    unitLetFloat :: Bind OutId -> LetFloats
    unitLetFloat Bind OutId
    bind = Bool -> LetFloats -> LetFloats
    forall a. HasCallStack => Bool -> a -> a
    assert ((OutId -> Bool) -> [OutId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> (OutId -> Bool) -> OutId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OutId -> Bool
    isJoinId) (Bind OutId -> [OutId]
    forall b. Bind b -> [b]
    bindersOf Bind OutId
    bind)) (LetFloats -> LetFloats) -> LetFloats -> LetFloats
    forall a b. (a -> b) -> a -> b
    $
                        JoinFloats -> FloatFlag -> LetFloats
    LetFloats (Bind OutId -> JoinFloats
    forall a. a -> OrdList a
    unitOL Bind OutId
    bind) (Bind OutId -> FloatFlag
    flag Bind OutId
    bind)
      where
        flag :: Bind OutId -> FloatFlag
    flag (Rec {})                = FloatFlag
    FltLifted
        flag (NonRec OutId
    bndr OutExpr
    rhs)
          | Bool -> Bool
    not (OutId -> Bool
    isStrictId OutId
    bndr)    = FloatFlag
    FltLifted
          | OutExpr -> Bool
    exprIsTickedString OutExpr
    rhs   = FloatFlag
    FltLifted
              -- String literals can be floated freely.
              -- See Note [Core top-level string literals] in GHC.Core.
          | OutExpr -> Bool
    exprOkForSpeculation OutExpr
    rhs = FloatFlag
    FltOkSpec  -- Unlifted, and lifted but ok-for-spec (eg HNF)
          | Bool
    otherwise                = FloatFlag
    FltCareful

    unitJoinFloat :: OutBind -> JoinFloats
    unitJoinFloat :: Bind OutId -> JoinFloats
    unitJoinFloat Bind OutId
    bind = Bool -> JoinFloats -> JoinFloats
    forall a. HasCallStack => Bool -> a -> a
    assert ((OutId -> Bool) -> [OutId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all OutId -> Bool
    isJoinId (Bind OutId -> [OutId]
    forall b. Bind b -> [b]
    bindersOf Bind OutId
    bind)) (JoinFloats -> JoinFloats) -> JoinFloats -> JoinFloats
    forall a b. (a -> b) -> a -> b
    $
                         Bind OutId -> JoinFloats
    forall a. a -> OrdList a
    unitOL Bind OutId
    bind

    mkFloatBind :: SimplEnv -> OutBind -> (SimplFloats, SimplEnv)
    -- Make a singleton SimplFloats, and
    -- extend the incoming SimplEnv's in-scope set with its binders
    -- These binders may already be in the in-scope set,
    -- but may have by now been augmented with more IdInfo
    mkFloatBind :: SimplEnv -> Bind OutId -> (SimplFloats, SimplEnv)
    mkFloatBind SimplEnv
    env Bind OutId
    bind
      = (SimplFloats
    floats, SimplEnv
    env { seInScope = in_scope' })
      where
        floats :: SimplFloats
    floats
          | Bind OutId -> Bool
    isJoinBind Bind OutId
    bind
          = SimplFloats { sfLetFloats :: LetFloats
    sfLetFloats  = LetFloats
    emptyLetFloats
                        , sfJoinFloats :: JoinFloats
    sfJoinFloats = Bind OutId -> JoinFloats
    unitJoinFloat Bind OutId
    bind
                        , sfInScope :: InScopeSet
    sfInScope    = InScopeSet
    in_scope' }
          | Bool
    otherwise
          = SimplFloats { sfLetFloats :: LetFloats
    sfLetFloats  = Bind OutId -> LetFloats
    unitLetFloat Bind OutId
    bind
                        , sfJoinFloats :: JoinFloats
    sfJoinFloats = JoinFloats
    emptyJoinFloats
                        , sfInScope :: InScopeSet
    sfInScope    = InScopeSet
    in_scope' }
        -- See Note [Bangs in the Simplifier]
        !in_scope' :: InScopeSet
    in_scope' = SimplEnv -> InScopeSet
    seInScope SimplEnv
    env InScopeSet -> Bind OutId -> InScopeSet
    `extendInScopeSetBind` Bind OutId
    bind

    extendFloats :: SimplFloats -> OutBind -> SimplFloats
    -- Add this binding to the floats, and extend the in-scope env too
    extendFloats :: SimplFloats -> Bind OutId -> SimplFloats
    extendFloats (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats  = LetFloats
    floats
                              , sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jfloats
                              , sfInScope :: SimplFloats -> InScopeSet
    sfInScope    = InScopeSet
    in_scope })
                 Bind OutId
    bind
      | Bind OutId -> Bool
    isJoinBind Bind OutId
    bind
      = SimplFloats { sfInScope :: InScopeSet
    sfInScope    = InScopeSet
    in_scope'
                    , sfLetFloats :: LetFloats
    sfLetFloats  = LetFloats
    floats
                    , sfJoinFloats :: JoinFloats
    sfJoinFloats = JoinFloats
    jfloats' }
      | Bool
    otherwise
      = SimplFloats { sfInScope :: InScopeSet
    sfInScope    = InScopeSet
    in_scope'
                    , sfLetFloats :: LetFloats
    sfLetFloats  = LetFloats
    floats'
                    , sfJoinFloats :: JoinFloats
    sfJoinFloats = JoinFloats
    jfloats }
      where
        in_scope' :: InScopeSet
    in_scope' = InScopeSet
    in_scope InScopeSet -> Bind OutId -> InScopeSet
    `extendInScopeSetBind` Bind OutId
    bind
        floats' :: LetFloats
    floats'   = LetFloats
    floats  LetFloats -> LetFloats -> LetFloats
    `addLetFlts`  Bind OutId -> LetFloats
    unitLetFloat Bind OutId
    bind
        jfloats' :: JoinFloats
    jfloats'  = JoinFloats
    jfloats JoinFloats -> JoinFloats -> JoinFloats
    `addJoinFlts` Bind OutId -> JoinFloats
    unitJoinFloat Bind OutId
    bind

    addLetFloats :: SimplFloats -> LetFloats -> SimplFloats
    -- Add the let-floats for env2 to env1;
    -- *plus* the in-scope set for env2, which is bigger
    -- than that for env1
    addLetFloats :: SimplFloats -> LetFloats -> SimplFloats
    addLetFloats SimplFloats
    floats LetFloats
    let_floats
      = SimplFloats
    floats { sfLetFloats = sfLetFloats floats `addLetFlts` let_floats
               , sfInScope   = sfInScope floats `extendInScopeFromLF` let_floats }

    extendInScopeFromLF :: InScopeSet -> LetFloats -> InScopeSet
    extendInScopeFromLF :: InScopeSet -> LetFloats -> InScopeSet
    extendInScopeFromLF InScopeSet
    in_scope (LetFloats JoinFloats
    binds FloatFlag
    _)
      = (InScopeSet -> Bind OutId -> InScopeSet)
    -> InScopeSet -> JoinFloats -> InScopeSet
    forall b a. (b -> a -> b) -> b -> OrdList a -> b
    foldlOL InScopeSet -> Bind OutId -> InScopeSet
    extendInScopeSetBind InScopeSet
    in_scope JoinFloats
    binds

    addJoinFloats :: SimplFloats -> JoinFloats -> SimplFloats
    addJoinFloats :: SimplFloats -> JoinFloats -> SimplFloats
    addJoinFloats SimplFloats
    floats JoinFloats
    join_floats
      = SimplFloats
    floats { sfJoinFloats = sfJoinFloats floats `addJoinFlts` join_floats
               , sfInScope    = foldlOL extendInScopeSetBind
                                        (sfInScope floats) join_floats }

    addFloats :: SimplFloats -> SimplFloats -> SimplFloats
    -- Add both let-floats and join-floats for env2 to env1;
    -- *plus* the in-scope set for env2, which is bigger
    -- than that for env1
    addFloats :: SimplFloats -> SimplFloats -> SimplFloats
    addFloats (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats = LetFloats
    lf1, sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jf1 })
              (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats = LetFloats
    lf2, sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jf2, sfInScope :: SimplFloats -> InScopeSet
    sfInScope = InScopeSet
    in_scope })
      = SimplFloats { sfLetFloats :: LetFloats
    sfLetFloats  = LetFloats
    lf1 LetFloats -> LetFloats -> LetFloats
    `addLetFlts` LetFloats
    lf2
                    , sfJoinFloats :: JoinFloats
    sfJoinFloats = JoinFloats
    jf1 JoinFloats -> JoinFloats -> JoinFloats
    `addJoinFlts` JoinFloats
    jf2
                    , sfInScope :: InScopeSet
    sfInScope    = InScopeSet
    in_scope }

    addLetFlts :: LetFloats -> LetFloats -> LetFloats
    addLetFlts :: LetFloats -> LetFloats -> LetFloats
    addLetFlts (LetFloats JoinFloats
    bs1 FloatFlag
    l1) (LetFloats JoinFloats
    bs2 FloatFlag
    l2)
      = JoinFloats -> FloatFlag -> LetFloats
    LetFloats (JoinFloats
    bs1 JoinFloats -> JoinFloats -> JoinFloats
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` JoinFloats
    bs2) (FloatFlag
    l1 FloatFlag -> FloatFlag -> FloatFlag
    `andFF` FloatFlag
    l2)

    letFloatBinds :: LetFloats -> [CoreBind]
    letFloatBinds :: LetFloats -> [Bind OutId]
    letFloatBinds (LetFloats JoinFloats
    bs FloatFlag
    _) = JoinFloats -> [Bind OutId]
    forall a. OrdList a -> [a]
    fromOL JoinFloats
    bs

    addJoinFlts :: JoinFloats -> JoinFloats -> JoinFloats
    addJoinFlts :: JoinFloats -> JoinFloats -> JoinFloats
    addJoinFlts = JoinFloats -> JoinFloats -> JoinFloats
    forall a. OrdList a -> OrdList a -> OrdList a
    appOL

    mkRecFloats :: SimplFloats -> SimplFloats
    -- Flattens the floats into a single Rec group,
    -- They must either all be lifted LetFloats or all JoinFloats
    mkRecFloats :: SimplFloats -> SimplFloats
    mkRecFloats floats :: SimplFloats
    floats@(SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats  = LetFloats JoinFloats
    bs FloatFlag
    _ff
                                    , sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jbs
                                    , sfInScope :: SimplFloats -> InScopeSet
    sfInScope    = InScopeSet
    in_scope })
      = Bool -> SDoc -> SimplFloats -> SimplFloats
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    bs Bool -> Bool -> Bool
    || JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    jbs) (SimplFloats -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SimplFloats
    floats) (SimplFloats -> SimplFloats) -> SimplFloats -> SimplFloats
    forall a b. (a -> b) -> a -> b
    $
        SimplFloats { sfLetFloats :: LetFloats
    sfLetFloats  = LetFloats
    floats'
                    , sfJoinFloats :: JoinFloats
    sfJoinFloats = JoinFloats
    jfloats'
                    , sfInScope :: InScopeSet
    sfInScope    = InScopeSet
    in_scope }
      where
        -- See Note [Bangs in the Simplifier]
        !floats' :: LetFloats
    floats'  | JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    bs  = LetFloats
    emptyLetFloats
                  | Bool
    otherwise   = Bind OutId -> LetFloats
    unitLetFloat ([(OutId, OutExpr)] -> Bind OutId
    forall b. [(b, Expr b)] -> Bind b
    Rec ([Bind OutId] -> [(OutId, OutExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds (JoinFloats -> [Bind OutId]
    forall a. OrdList a -> [a]
    fromOL JoinFloats
    bs)))
        !jfloats' :: JoinFloats
    jfloats' | JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    jbs = JoinFloats
    emptyJoinFloats
                  | Bool
    otherwise   = Bind OutId -> JoinFloats
    unitJoinFloat ([(OutId, OutExpr)] -> Bind OutId
    forall b. [(b, Expr b)] -> Bind b
    Rec ([Bind OutId] -> [(OutId, OutExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds (JoinFloats -> [Bind OutId]
    forall a. OrdList a -> [a]
    fromOL JoinFloats
    jbs)))

    wrapFloats :: SimplFloats -> OutExpr -> OutExpr
    -- Wrap the floats around the expression
    wrapFloats :: SimplFloats -> OutExpr -> OutExpr
    wrapFloats (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats  = LetFloats JoinFloats
    bs FloatFlag
    flag
                            , sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jbs }) OutExpr
    body
      = (Bind OutId -> OutExpr -> OutExpr)
    -> OutExpr -> JoinFloats -> OutExpr
    forall a b. (a -> b -> b) -> b -> OrdList a -> b
    foldrOL Bind OutId -> OutExpr -> OutExpr
    mk_let (JoinFloats -> OutExpr -> OutExpr
    wrapJoinFloats JoinFloats
    jbs OutExpr
    body) JoinFloats
    bs
         -- Note: Always safe to put the joins on the inside
         -- since the values can't refer to them
      where
        mk_let :: Bind OutId -> OutExpr -> OutExpr
    mk_let | FloatFlag
    FltCareful <- FloatFlag
    flag = Bind OutId -> OutExpr -> OutExpr
    mkCoreLet -- need to enforce let-can-float-invariant
               | Bool
    otherwise          = Bind OutId -> OutExpr -> OutExpr
    forall b. Bind b -> Expr b -> Expr b
    Let       -- let-can-float invariant hold

    wrapJoinFloatsX :: SimplFloats -> OutExpr -> (SimplFloats, OutExpr)
    -- Wrap the sfJoinFloats of the env around the expression,
    -- and take them out of the SimplEnv
    wrapJoinFloatsX :: SimplFloats -> OutExpr -> (SimplFloats, OutExpr)
    wrapJoinFloatsX SimplFloats
    floats OutExpr
    body
      = ( SimplFloats
    floats { sfJoinFloats = emptyJoinFloats }
        , JoinFloats -> OutExpr -> OutExpr
    wrapJoinFloats (SimplFloats -> JoinFloats
    sfJoinFloats SimplFloats
    floats) OutExpr
    body )

    wrapJoinFloats :: JoinFloats -> OutExpr -> OutExpr
    -- Wrap the sfJoinFloats of the env around the expression,
    -- and take them out of the SimplEnv
    wrapJoinFloats :: JoinFloats -> OutExpr -> OutExpr
    wrapJoinFloats JoinFloats
    join_floats OutExpr
    body
      = (Bind OutId -> OutExpr -> OutExpr)
    -> OutExpr -> JoinFloats -> OutExpr
    forall a b. (a -> b -> b) -> b -> OrdList a -> b
    foldrOL Bind OutId -> OutExpr -> OutExpr
    forall b. Bind b -> Expr b -> Expr b
    Let OutExpr
    body JoinFloats
    join_floats

    getTopFloatBinds :: SimplFloats -> [CoreBind]
    getTopFloatBinds :: SimplFloats -> [Bind OutId]
    getTopFloatBinds (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats  = LetFloats
    lbs
                                  , sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jbs})
      = Bool -> [Bind OutId] -> [Bind OutId]
    forall a. HasCallStack => Bool -> a -> a
    assert (JoinFloats -> Bool
    forall a. OrdList a -> Bool
    isNilOL JoinFloats
    jbs) ([Bind OutId] -> [Bind OutId]) -> [Bind OutId] -> [Bind OutId]
    forall a b. (a -> b) -> a -> b
    $  -- Can't be any top-level join bindings
        LetFloats -> [Bind OutId]
    letFloatBinds LetFloats
    lbs

    {-# INLINE mapLetFloats #-}
    mapLetFloats :: LetFloats -> ((Id,CoreExpr) -> (Id,CoreExpr)) -> LetFloats
    mapLetFloats :: LetFloats -> ((OutId, OutExpr) -> (OutId, OutExpr)) -> LetFloats
    mapLetFloats (LetFloats JoinFloats
    fs FloatFlag
    ff) (OutId, OutExpr) -> (OutId, OutExpr)
    fun
       = JoinFloats -> FloatFlag -> LetFloats
    LetFloats JoinFloats
    fs1 FloatFlag
    ff
       where
        app :: Bind OutId -> Bind OutId
    app (NonRec OutId
    b OutExpr
    e) = case (OutId, OutExpr) -> (OutId, OutExpr)
    fun (OutId
    b,OutExpr
    e) of (OutId
    b',OutExpr
    e') -> OutId -> OutExpr -> Bind OutId
    forall b. b -> Expr b -> Bind b
    NonRec OutId
    b' OutExpr
    e'
        app (Rec [(OutId, OutExpr)]
    bs)     = [(OutId, OutExpr)] -> Bind OutId
    forall b. [(b, Expr b)] -> Bind b
    Rec (((OutId, OutExpr) -> (OutId, OutExpr))
    -> [(OutId, OutExpr)] -> [(OutId, OutExpr)]
    forall a b. (a -> b) -> [a] -> [b]
    strictMap (OutId, OutExpr) -> (OutId, OutExpr)
    fun [(OutId, OutExpr)]
    bs)
        !fs1 :: JoinFloats
    fs1 = ((Bind OutId -> Bind OutId) -> JoinFloats -> JoinFloats
    forall a b. (a -> b) -> OrdList a -> OrdList b
    mapOL' Bind OutId -> Bind OutId
    app JoinFloats
    fs) -- See Note [Bangs in the Simplifier]

    {-
    ************************************************************************
    *                                                                      *
                    Substitution of Vars
    *                                                                      *
    ************************************************************************

    Note [Global Ids in the substitution]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We look up even a global (eg imported) Id in the substitution. Consider
       case X.g_34 of b { (a,b) ->  ... case X.g_34 of { (p,q) -> ...} ... }
    The binder-swap in the occurrence analyser will add a binding
    for a LocalId version of g (with the same unique though):
       case X.g_34 of b { (a,b) ->  let g_34 = b in
                                    ... case X.g_34 of { (p,q) -> ...} ... }
    So we want to look up the inner X.g_34 in the substitution, where we'll
    find that it has been substituted by b.  (Or conceivably cloned.)
    -}

    substId :: SimplEnv -> InId -> SimplSR
    -- Returns DoneEx only on a non-Var expression
    substId :: SimplEnv -> OutId -> SimplSR
    substId (SimplEnv { seInScope :: SimplEnv -> InScopeSet
    seInScope = InScopeSet
    in_scope, seIdSubst :: SimplEnv -> SimplIdSubst
    seIdSubst = SimplIdSubst
    ids }) OutId
    v
      = case SimplIdSubst -> OutId -> Maybe SimplSR
    forall a. VarEnv a -> OutId -> Maybe a
    lookupVarEnv SimplIdSubst
    ids OutId
    v of  -- Note [Global Ids in the substitution]
            Maybe SimplSR
    Nothing               -> OutId -> SimplSR
    DoneId (InScopeSet -> OutId -> OutId
    refineFromInScope InScopeSet
    in_scope OutId
    v)
            Just (DoneId OutId
    v)       -> OutId -> SimplSR
    DoneId (InScopeSet -> OutId -> OutId
    refineFromInScope InScopeSet
    in_scope OutId
    v)
            Just SimplSR
    res              -> SimplSR
    res    -- DoneEx non-var, or ContEx

            -- Get the most up-to-date thing from the in-scope set
            -- Even though it isn't in the substitution, it may be in
            -- the in-scope set with better IdInfo.
            --
            -- See also Note [In-scope set as a substitution] in GHC.Core.Opt.Simplify.

    refineFromInScope :: InScopeSet -> Var -> Var
    refineFromInScope :: InScopeSet -> OutId -> OutId
    refineFromInScope InScopeSet
    in_scope OutId
    v
      | OutId -> Bool
    isLocalId OutId
    v = case InScopeSet -> OutId -> Maybe OutId
    lookupInScope InScopeSet
    in_scope OutId
    v of
                      Just OutId
    v' -> OutId
    v'
                      Maybe OutId
    Nothing -> String -> SDoc -> OutId
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "refineFromInScope" (InScopeSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr InScopeSet
    in_scope SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    v)
                                 -- c.f #19074 for a subtle place where this went wrong
      | Bool
    otherwise = OutId
    v

    lookupRecBndr :: SimplEnv -> InId -> OutId
    -- Look up an Id which has been put into the envt by simplRecBndrs,
    -- but where we have not yet done its RHS
    lookupRecBndr :: SimplEnv -> OutId -> OutId
    lookupRecBndr (SimplEnv { seInScope :: SimplEnv -> InScopeSet
    seInScope = InScopeSet
    in_scope, seIdSubst :: SimplEnv -> SimplIdSubst
    seIdSubst = SimplIdSubst
    ids }) OutId
    v
      = case SimplIdSubst -> OutId -> Maybe SimplSR
    forall a. VarEnv a -> OutId -> Maybe a
    lookupVarEnv SimplIdSubst
    ids OutId
    v of
            Just (DoneId OutId
    v) -> OutId
    v
            Just SimplSR
    _ -> String -> SDoc -> OutId
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "lookupRecBndr" (OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    v)
            Maybe SimplSR
    Nothing -> InScopeSet -> OutId -> OutId
    refineFromInScope InScopeSet
    in_scope OutId
    v

    {-
    ************************************************************************
    *                                                                      *
    \section{Substituting an Id binder}
    *                                                                      *
    ************************************************************************

    These functions are in the monad only so that they can be made strict via seq.

    Note [Return type for join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider

       (join j :: Char -> Int -> Int) 77
       (     j x = \y. y + ord x    )
       (in case v of                )
       (     A -> j 'x'             )
       (     B -> j 'y'             )
       (     C -> <blah>            )

    The simplifier pushes the "apply to 77" continuation inwards to give

       join j :: Char -> Int
            j x = (\y. y + ord x) 77
       in case v of
            A -> j 'x'
            B -> j 'y'
            C -> <blah> 77

    Notice that the "apply to 77" continuation went into the RHS of the
    join point.  And that meant that the return type of the join point
    changed!!

    That's why we pass res_ty into simplNonRecJoinBndr, and substIdBndr
    takes a (Just res_ty) argument so that it knows to do the type-changing
    thing.

    See also Note [Scaling join point arguments].
    -}

    simplBinders :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
    simplBinders :: SimplEnv -> [OutId] -> SimplM (SimplEnv, [OutId])
    simplBinders  !SimplEnv
    env [OutId]
    bndrs = (SimplEnv -> OutId -> SimplM (SimplEnv, OutId))
    -> SimplEnv -> [OutId] -> SimplM (SimplEnv, [OutId])
    forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder  SimplEnv
    env [OutId]
    bndrs

    -------------
    simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
    -- Used for lambda and case-bound variables
    -- Clone Id if necessary, substitute type
    -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
    -- The substitution is extended only if the variable is cloned, because
    -- we *don't* need to use it to track occurrence info.
    simplBinder :: SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder !SimplEnv
    env OutId
    bndr
      | OutId -> Bool
    isTyVar OutId
    bndr  = do  { let (SimplEnv
    env', OutId
    tv) = SimplEnv -> OutId -> (SimplEnv, OutId)
    substTyVarBndr SimplEnv
    env OutId
    bndr
                            ; OutId -> ()
    seqTyVar OutId
    tv () -> SimplM (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a b. a -> b -> b
    `seq` (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env', OutId
    tv) }
      | Bool
    otherwise     = do  { let (SimplEnv
    env', OutId
    id) = SimplEnv -> OutId -> (SimplEnv, OutId)
    substIdBndr SimplEnv
    env OutId
    bndr
                            ; OutId -> ()
    seqId OutId
    id () -> SimplM (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a b. a -> b -> b
    `seq` (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env', OutId
    id) }

    ---------------
    simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
    -- A non-recursive let binder
    simplNonRecBndr :: SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplNonRecBndr !SimplEnv
    env OutId
    id
      -- See Note [Bangs in the Simplifier]
      = do  { let (!SimplEnv
    env1, OutId
    id1) = SimplEnv -> OutId -> (SimplEnv, OutId)
    substIdBndr SimplEnv
    env OutId
    id
            ; OutId -> ()
    seqId OutId
    id1 () -> SimplM (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a b. a -> b -> b
    `seq` (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env1, OutId
    id1) }

    ---------------
    simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
    -- Recursive let binders
    simplRecBndrs :: SimplEnv -> [OutId] -> SimplM SimplEnv
    simplRecBndrs env :: SimplEnv
    env@(SimplEnv {}) [OutId]
    ids
      -- See Note [Bangs in the Simplifier]
      = Bool -> SimplM SimplEnv -> SimplM SimplEnv
    forall a. HasCallStack => Bool -> a -> a
    assert ((OutId -> Bool) -> [OutId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> (OutId -> Bool) -> OutId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OutId -> Bool
    isJoinId) [OutId]
    ids) (SimplM SimplEnv -> SimplM SimplEnv)
    -> SimplM SimplEnv -> SimplM SimplEnv
    forall a b. (a -> b) -> a -> b
    $
        do  { let (!SimplEnv
    env1, [OutId]
    ids1) = (SimplEnv -> OutId -> (SimplEnv, OutId))
    -> SimplEnv -> [OutId] -> (SimplEnv, [OutId])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL SimplEnv -> OutId -> (SimplEnv, OutId)
    substIdBndr SimplEnv
    env [OutId]
    ids
            ; [OutId] -> ()
    seqIds [OutId]
    ids1 () -> SimplM SimplEnv -> SimplM SimplEnv
    forall a b. a -> b -> b
    `seq` SimplEnv -> SimplM SimplEnv
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SimplEnv
    env1 }

    ---------------
    substIdBndr :: SimplEnv -> InBndr -> (SimplEnv, OutBndr)
    -- Might be a coercion variable
    substIdBndr :: SimplEnv -> OutId -> (SimplEnv, OutId)
    substIdBndr SimplEnv
    env OutId
    bndr
      | OutId -> Bool
    isCoVar OutId
    bndr  = SimplEnv -> OutId -> (SimplEnv, OutId)
    substCoVarBndr SimplEnv
    env OutId
    bndr
      | Bool
    otherwise     = SimplEnv -> OutId -> (SimplEnv, OutId)
    substNonCoVarIdBndr SimplEnv
    env OutId
    bndr

    ---------------
    substNonCoVarIdBndr
       :: SimplEnv
       -> InBndr    -- Env and binder to transform
       -> (SimplEnv, OutBndr)
    -- Clone Id if necessary, substitute its type
    -- Return an Id with its
    --      * Type substituted
    --      * UnfoldingInfo, Rules, WorkerInfo zapped
    --      * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
    --      * Robust info, retained especially arity and demand info,
    --         so that they are available to occurrences that occur in an
    --         earlier binding of a letrec
    --
    -- For the robust info, see Note [Arity robustness]
    --
    -- Augment the substitution  if the unique changed
    -- Extend the in-scope set with the new Id
    --
    -- Similar to GHC.Core.Subst.substIdBndr, except that
    --      the type of id_subst differs
    --      all fragile info is zapped
    substNonCoVarIdBndr :: SimplEnv -> OutId -> (SimplEnv, OutId)
    substNonCoVarIdBndr SimplEnv
    env OutId
    id = SimplEnv -> OutId -> (OutId -> OutId) -> (SimplEnv, OutId)
    subst_id_bndr SimplEnv
    env OutId
    id (\OutId
    x -> OutId
    x)

    -- Inline to make the (OutId -> OutId) function a known call.
    -- This is especially important for `substNonCoVarIdBndr` which
    -- passes an identity lambda.
    {-# INLINE subst_id_bndr #-}
    subst_id_bndr :: SimplEnv
                  -> InBndr    -- Env and binder to transform
                  -> (OutId -> OutId)  -- Adjust the type
                  -> (SimplEnv, OutBndr)
    subst_id_bndr :: SimplEnv -> OutId -> (OutId -> OutId) -> (SimplEnv, OutId)
    subst_id_bndr env :: SimplEnv
    env@(SimplEnv { seInScope :: SimplEnv -> InScopeSet
    seInScope = InScopeSet
    in_scope, seIdSubst :: SimplEnv -> SimplIdSubst
    seIdSubst = SimplIdSubst
    id_subst })
                  OutId
    old_id OutId -> OutId
    adjust_type
      = Bool -> SDoc -> (SimplEnv, OutId) -> (SimplEnv, OutId)
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Bool -> Bool
    not (OutId -> Bool
    isCoVar OutId
    old_id)) (OutId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutId
    old_id)
        (SimplEnv
    env { seInScope = new_in_scope,
               seIdSubst = new_subst }, OutId
    new_id)
        -- It's important that both seInScope and seIdSubst are updated with
        -- the new_id, /after/ applying adjust_type. That's why adjust_type
        -- is done here.  If we did adjust_type in simplJoinBndr (the only
        -- place that gives a non-identity adjust_type) we'd have to fiddle
        -- afresh with both seInScope and seIdSubst
      where
        -- See Note [Bangs in the Simplifier]
        !id1 :: OutId
    id1  = InScopeSet -> OutId -> OutId
    uniqAway InScopeSet
    in_scope OutId
    old_id
        !id2 :: OutId
    id2  = SimplEnv -> OutId -> OutId
    substIdType SimplEnv
    env OutId
    id1
        !id3 :: OutId
    id3  = OutId -> OutId
    zapFragileIdInfo OutId
    id2      -- Zaps rules, worker-info, unfolding
                                          -- and fragile OccInfo
        !new_id :: OutId
    new_id = OutId -> OutId
    adjust_type OutId
    id3

            -- Extend the substitution if the unique has changed,
            -- or there's some useful occurrence information
            -- See the notes with substTyVarBndr for the delSubstEnv
        !new_subst :: SimplIdSubst
    new_subst | OutId
    new_id OutId -> OutId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= OutId
    old_id
                  = SimplIdSubst -> OutId -> SimplSR -> SimplIdSubst
    forall a. VarEnv a -> OutId -> a -> VarEnv a
    extendVarEnv SimplIdSubst
    id_subst OutId
    old_id (OutId -> SimplSR
    DoneId OutId
    new_id)
                  | Bool
    otherwise
                  = SimplIdSubst -> OutId -> SimplIdSubst
    forall a. VarEnv a -> OutId -> VarEnv a
    delVarEnv SimplIdSubst
    id_subst OutId
    old_id

        !new_in_scope :: InScopeSet
    new_in_scope = InScopeSet
    in_scope InScopeSet -> OutId -> InScopeSet
    `extendInScopeSet` OutId
    new_id

    ------------------------------------
    seqTyVar :: TyVar -> ()
    seqTyVar :: OutId -> ()
    seqTyVar OutId
    b = OutId
    b OutId -> () -> ()
    forall a b. a -> b -> b
    `seq` ()

    seqId :: Id -> ()
    seqId :: OutId -> ()
    seqId OutId
    id = Kind -> ()
    seqType (OutId -> Kind
    idType OutId
    id)  () -> () -> ()
    forall a b. a -> b -> b
    `seq`
               HasDebugCallStack => OutId -> IdInfo
    OutId -> IdInfo
    idInfo OutId
    id            IdInfo -> () -> ()
    forall a b. a -> b -> b
    `seq`
               ()

    seqIds :: [Id] -> ()
    seqIds :: [OutId] -> ()
    seqIds []       = ()
    seqIds (OutId
    id:[OutId]
    ids) = OutId -> ()
    seqId OutId
    id () -> () -> ()
    forall a b. a -> b -> b
    `seq` [OutId] -> ()
    seqIds [OutId]
    ids

    {-
    Note [Arity robustness]
    ~~~~~~~~~~~~~~~~~~~~~~~
    We *do* transfer the arity from the in_id of a let binding to the
    out_id so that its arity is visible in its RHS. Examples:

      * f = \x y. let g = \p q. f (p+q) in Just (...g..g...)
        Here we want to give `g` arity 3 and eta-expand. `findRhsArity` will have a
        hard time figuring that out when `f` only has arity 0 in its own RHS.
      * f = \x y. ....(f `seq` blah)....
        We want to drop the seq.
      * f = \x. g (\y. f y)
        You'd think we could eta-reduce `\y. f y` to `f` here. And indeed, that is true.
        Unfortunately, it is not sound in general to eta-reduce in f's RHS.
        Example: `f = \x. f x`. See Note [Eta reduction in recursive RHSs] for how
        we prevent that.

    Note [Robust OccInfo]
    ~~~~~~~~~~~~~~~~~~~~~
    It's important that we *do* retain the loop-breaker OccInfo, because
    that's what stops the Id getting inlined infinitely, in the body of
    the letrec.
    -}

    {- *********************************************************************
    *                                                                      *
                    Join points
    *                                                                      *
    ********************************************************************* -}

    simplNonRecJoinBndr :: SimplEnv -> InBndr
                        -> Mult -> OutType
                        -> SimplM (SimplEnv, OutBndr)

    -- A non-recursive let binder for a join point;
    -- context being pushed inward may change the type
    -- See Note [Return type for join points]
    simplNonRecJoinBndr :: SimplEnv -> OutId -> Kind -> Kind -> SimplM (SimplEnv, OutId)
    simplNonRecJoinBndr SimplEnv
    env OutId
    id Kind
    mult Kind
    res_ty
      = do { let (SimplEnv
    env1, OutId
    id1) = Kind -> Kind -> SimplEnv -> OutId -> (SimplEnv, OutId)
    simplJoinBndr Kind
    mult Kind
    res_ty SimplEnv
    env OutId
    id
           ; OutId -> ()
    seqId OutId
    id1 () -> SimplM (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a b. a -> b -> b
    `seq` (SimplEnv, OutId) -> SimplM (SimplEnv, OutId)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env1, OutId
    id1) }

    simplRecJoinBndrs :: SimplEnv -> [InBndr]
                      -> Mult -> OutType
                      -> SimplM SimplEnv
    -- Recursive let binders for join points;
    -- context being pushed inward may change types
    -- See Note [Return type for join points]
    simplRecJoinBndrs :: SimplEnv -> [OutId] -> Kind -> Kind -> SimplM SimplEnv
    simplRecJoinBndrs env :: SimplEnv
    env@(SimplEnv {}) [OutId]
    ids Kind
    mult Kind
    res_ty
      = Bool -> SimplM SimplEnv -> SimplM SimplEnv
    forall a. HasCallStack => Bool -> a -> a
    assert ((OutId -> Bool) -> [OutId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all OutId -> Bool
    isJoinId [OutId]
    ids) (SimplM SimplEnv -> SimplM SimplEnv)
    -> SimplM SimplEnv -> SimplM SimplEnv
    forall a b. (a -> b) -> a -> b
    $
        do  { let (SimplEnv
    env1, [OutId]
    ids1) = (SimplEnv -> OutId -> (SimplEnv, OutId))
    -> SimplEnv -> [OutId] -> (SimplEnv, [OutId])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL (Kind -> Kind -> SimplEnv -> OutId -> (SimplEnv, OutId)
    simplJoinBndr Kind
    mult Kind
    res_ty) SimplEnv
    env [OutId]
    ids
            ; [OutId] -> ()
    seqIds [OutId]
    ids1 () -> SimplM SimplEnv -> SimplM SimplEnv
    forall a b. a -> b -> b
    `seq` SimplEnv -> SimplM SimplEnv
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SimplEnv
    env1 }

    ---------------
    simplJoinBndr :: Mult -> OutType
                  -> SimplEnv -> InBndr
                  -> (SimplEnv, OutBndr)
    simplJoinBndr :: Kind -> Kind -> SimplEnv -> OutId -> (SimplEnv, OutId)
    simplJoinBndr Kind
    mult Kind
    res_ty SimplEnv
    env OutId
    id
      = SimplEnv -> OutId -> (OutId -> OutId) -> (SimplEnv, OutId)
    subst_id_bndr SimplEnv
    env OutId
    id (Kind -> Kind -> OutId -> OutId
    adjustJoinPointType Kind
    mult Kind
    res_ty)

    ---------------
    adjustJoinPointType :: Mult
                        -> Type     -- New result type
                        -> Id       -- Old join-point Id
                        -> Id       -- Adjusted join-point Id
    -- (adjustJoinPointType mult new_res_ty join_id) does two things:
    --
    --   1. Set the return type of the join_id to new_res_ty
    --      See Note [Return type for join points]
    --
    --   2. Adjust the multiplicity of arrows in join_id's type, as
    --      directed by 'mult'. See Note [Scaling join point arguments]
    --
    -- INVARIANT: If any of the first n binders are foralls, those tyvars
    -- cannot appear in the original result type. See isValidJoinPointType.
    adjustJoinPointType :: Kind -> Kind -> OutId -> OutId
    adjustJoinPointType Kind
    mult Kind
    new_res_ty OutId
    join_id
      = Bool -> OutId -> OutId
    forall a. HasCallStack => Bool -> a -> a
    assert (OutId -> Bool
    isJoinId OutId
    join_id) (OutId -> OutId) -> OutId -> OutId
    forall a b. (a -> b) -> a -> b
    $
        OutId -> Kind -> OutId
    setIdType OutId
    join_id Kind
    new_join_ty
      where
        join_arity :: JoinArity
    join_arity = OutId -> JoinArity
    idJoinArity OutId
    join_id
        orig_ty :: Kind
    orig_ty    = OutId -> Kind
    idType OutId
    join_id
        res_torc :: TypeOrConstraint
    res_torc   = HasDebugCallStack => Kind -> TypeOrConstraint
    Kind -> TypeOrConstraint
    typeTypeOrConstraint Kind
    new_res_ty :: TypeOrConstraint

        new_join_ty :: Kind
    new_join_ty = JoinArity -> Kind -> Kind
    go JoinArity
    join_arity Kind
    orig_ty :: Type

        go :: JoinArity -> Type -> Type
        go :: JoinArity -> Kind -> Kind
    go JoinArity
    n Kind
    ty
          | JoinArity
    n JoinArity -> JoinArity -> Bool
    forall a. Eq a => a -> a -> Bool
    == JoinArity
    0
          = Kind
    new_res_ty

          | Just (PiTyBinder
    arg_bndr, Kind
    body_ty) <- Kind -> Maybe (PiTyBinder, Kind)
    splitPiTy_maybe Kind
    ty
          , let body_ty' :: Kind
    body_ty' = JoinArity -> Kind -> Kind
    go (JoinArity
    nJoinArity -> JoinArity -> JoinArity
    forall a. Num a => a -> a -> a
    -JoinArity
    1) Kind
    body_ty
          = case PiTyBinder
    arg_bndr of
              Named ForAllTyBinder
    b                          -> ForAllTyBinder -> Kind -> Kind
    mkForAllTy ForAllTyBinder
    b Kind
    body_ty'
              Anon (Scaled Kind
    arg_mult Kind
    arg_ty) FunTyFlag
    af -> HasDebugCallStack => FunTyFlag -> Kind -> Kind -> Kind -> Kind
    FunTyFlag -> Kind -> Kind -> Kind -> Kind
    mkFunTy FunTyFlag
    af' Kind
    arg_mult' Kind
    arg_ty Kind
    body_ty'
                  where
                    -- Using "!": See Note [Bangs in the Simplifier]
                    -- mkMultMul: see Note [Scaling join point arguments]
                    !arg_mult' :: Kind
    arg_mult' = Kind
    arg_mult Kind -> Kind -> Kind
    `mkMultMul` Kind
    mult

                    -- the new_res_ty might be ConstraintLike while the original
                    -- one was TypeLike.  So we may need to adjust the FunTyFlag.
                    -- (see #23952)
                    !af' :: FunTyFlag
    af' = TypeOrConstraint -> TypeOrConstraint -> FunTyFlag
    mkFunTyFlag (FunTyFlag -> TypeOrConstraint
    funTyFlagArgTypeOrConstraint FunTyFlag
    af) TypeOrConstraint
    res_torc

          | Bool
    otherwise
          = String -> SDoc -> Kind
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "adjustJoinPointType" (JoinArity -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr JoinArity
    join_arity SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    orig_ty)

    {- Note [Scaling join point arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider a join point which is linear in its variable, in some context E:

    E[join j :: a %1 -> a
           j x = x
      in case v of
           A -> j 'x'
           B -> <blah>]

    The simplifier changes to:

    join j :: a %1 -> a
         j x = E[x]
    in case v of
         A -> j 'x'
         B -> E[<blah>]

    If E uses its argument in a nonlinear way (e.g. a case['Many]), then
    this is wrong: the join point has to change its type to a -> a.
    Otherwise, we'd get a linearity error.

    See also Note [Return type for join points] and Note [Join points and case-of-case].
    -}

    {-
    ************************************************************************
    *                                                                      *
                    Impedance matching to type substitution
    *                                                                      *
    ************************************************************************
    -}

    getSubst :: SimplEnv -> Subst
    getSubst :: SimplEnv -> Subst
    getSubst (SimplEnv { seInScope :: SimplEnv -> InScopeSet
    seInScope = InScopeSet
    in_scope, seTvSubst :: SimplEnv -> TvSubstEnv
    seTvSubst = TvSubstEnv
    tv_env, seCvSubst :: SimplEnv -> CvSubstEnv
    seCvSubst = CvSubstEnv
    cv_env })
      = InScopeSet -> TvSubstEnv -> CvSubstEnv -> Subst
    mkTCvSubst InScopeSet
    in_scope TvSubstEnv
    tv_env CvSubstEnv
    cv_env

    substTy :: HasDebugCallStack => SimplEnv -> Type -> Type
    substTy :: HasDebugCallStack => SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env Kind
    ty = HasDebugCallStack => Subst -> Kind -> Kind
    Subst -> Kind -> Kind
    Type.substTy (SimplEnv -> Subst
    getSubst SimplEnv
    env) Kind
    ty

    substTyVar :: SimplEnv -> TyVar -> Type
    substTyVar :: SimplEnv -> OutId -> Kind
    substTyVar SimplEnv
    env OutId
    tv = Subst -> OutId -> Kind
    Type.substTyVar (SimplEnv -> Subst
    getSubst SimplEnv
    env) OutId
    tv

    substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
    substTyVarBndr :: SimplEnv -> OutId -> (SimplEnv, OutId)
    substTyVarBndr SimplEnv
    env OutId
    tv
      = case HasDebugCallStack => Subst -> OutId -> (Subst, OutId)
    Subst -> OutId -> (Subst, OutId)
    Type.substTyVarBndr (SimplEnv -> Subst
    getSubst SimplEnv
    env) OutId
    tv of
            (Subst InScopeSet
    in_scope' IdSubstEnv
    _ TvSubstEnv
    tv_env' CvSubstEnv
    cv_env', OutId
    tv')
               -> (SimplEnv
    env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, OutId
    tv')

    substCoVar :: SimplEnv -> CoVar -> Coercion
    substCoVar :: SimplEnv -> OutId -> Coercion
    substCoVar SimplEnv
    env OutId
    tv = Subst -> OutId -> Coercion
    Coercion.substCoVar (SimplEnv -> Subst
    getSubst SimplEnv
    env) OutId
    tv

    substCoVarBndr :: SimplEnv -> CoVar -> (SimplEnv, CoVar)
    substCoVarBndr :: SimplEnv -> OutId -> (SimplEnv, OutId)
    substCoVarBndr SimplEnv
    env OutId
    cv
      = case HasDebugCallStack => Subst -> OutId -> (Subst, OutId)
    Subst -> OutId -> (Subst, OutId)
    Coercion.substCoVarBndr (SimplEnv -> Subst
    getSubst SimplEnv
    env) OutId
    cv of
            (Subst InScopeSet
    in_scope' IdSubstEnv
    _ TvSubstEnv
    tv_env' CvSubstEnv
    cv_env', OutId
    cv')
               -> (SimplEnv
    env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, OutId
    cv')

    substCo :: SimplEnv -> Coercion -> Coercion
    substCo :: SimplEnv -> Coercion -> Coercion
    substCo SimplEnv
    env Coercion
    co = HasDebugCallStack => Subst -> Coercion -> Coercion
    Subst -> Coercion -> Coercion
    Coercion.substCo (SimplEnv -> Subst
    getSubst SimplEnv
    env) Coercion
    co

    ------------------
    substIdType :: SimplEnv -> Id -> Id
    substIdType :: SimplEnv -> OutId -> OutId
    substIdType (SimplEnv { seInScope :: SimplEnv -> InScopeSet
    seInScope = InScopeSet
    in_scope, seTvSubst :: SimplEnv -> TvSubstEnv
    seTvSubst = TvSubstEnv
    tv_env, seCvSubst :: SimplEnv -> CvSubstEnv
    seCvSubst = CvSubstEnv
    cv_env }) OutId
    id
      | (TvSubstEnv -> Bool
    forall a. VarEnv a -> Bool
    isEmptyVarEnv TvSubstEnv
    tv_env Bool -> Bool -> Bool
    && CvSubstEnv -> Bool
    forall a. VarEnv a -> Bool
    isEmptyVarEnv CvSubstEnv
    cv_env)
        Bool -> Bool -> Bool
    || Bool
    no_free_vars
      = OutId
    id
      | Bool
    otherwise = (Kind -> Kind) -> OutId -> OutId
    Id.updateIdTypeAndMult (Subst -> Kind -> Kind
    Type.substTyUnchecked Subst
    subst) OutId
    id
                    -- The tyCoVarsOfType is cheaper than it looks
                    -- because we cache the free tyvars of the type
                    -- in a Note in the id's type itself
      where
        no_free_vars :: Bool
    no_free_vars = Kind -> Bool
    noFreeVarsOfType Kind
    old_ty Bool -> Bool -> Bool
    && Kind -> Bool
    noFreeVarsOfType Kind
    old_w
        subst :: Subst
    subst = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
    Subst InScopeSet
    in_scope IdSubstEnv
    emptyIdSubstEnv TvSubstEnv
    tv_env CvSubstEnv
    cv_env
        old_ty :: Kind
    old_ty = OutId -> Kind
    idType OutId
    id
        old_w :: Kind
    old_w  = OutId -> Kind
    varMult OutId
    id