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

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

    {-# LANGUAGE CPP #-}

    module GHC.Core.Opt.Simplify.Env (
            -- * The simplifier mode
            setMode, getMode, updMode, seDynFlags, seUnfoldingOpts, seLogger,

            -- * Environments
            SimplEnv(..), pprSimplEnv,   -- Temp not abstract
            mkSimplEnv, extendIdSubst,
            extendTvSubst, extendCvSubst,
            zapSubstEnv, setSubstEnv, bumpCaseDepth,
            getInScope, setInScopeFromE, setInScopeFromF,
            setInScopeSet, modifyInScope, addNewInScopeIds,
            getSimplRules,

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

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

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

            -- * LetFloats
            LetFloats, letFloatBinds, emptyLetFloats, unitLetFloat,
            addLetFlts,  mapLetFloats,

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

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Core.Opt.Simplify.Monad
    import GHC.Core.Opt.Monad        ( SimplMode(..) )
    import GHC.Core
    import GHC.Core.Utils
    import GHC.Core.Multiplicity     ( scaleScaled )
    import GHC.Core.Unfold
    import GHC.Types.Var
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Data.OrdList
    import GHC.Types.Id as Id
    import GHC.Core.Make            ( mkWildValBinder )
    import GHC.Driver.Session       ( DynFlags )
    import GHC.Builtin.Types
    import GHC.Core.TyCo.Rep        ( TyCoBinder(..) )
    import qualified GHC.Core.Type as Type
    import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, extendTvSubst, extendCvSubst )
    import qualified GHC.Core.Coercion as Coercion
    import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
    import GHC.Types.Basic
    import GHC.Utils.Monad
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Utils.Logger
    import GHC.Types.Unique.FM      ( pprUniqFM )

    import Data.List (mapAccumL)

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

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

            SimplEnv -> SimplMode
    seMode      :: !SimplMode

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

         ----------- 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
        }

    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
    text String
    "SimplFloats"
          SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    braces ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "lets: " SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr LetFloats
    lf
                           , String -> SDoc
    text String
    "joins:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr JoinFloats
    jf
                           , String -> SDoc
    text String
    "in_scope:" SDoc -> SDoc -> 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 }

    pprSimplEnv :: SimplEnv -> SDoc
    -- Used for debugging; selective
    pprSimplEnv :: SimplEnv -> SDoc
    pprSimplEnv SimplEnv
    env
      = [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "TvSubst:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (SimplEnv -> TvSubstEnv
    seTvSubst SimplEnv
    env),
              String -> SDoc
    text String
    "CvSubst:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (SimplEnv -> CvSubstEnv
    seCvSubst SimplEnv
    env),
              String -> SDoc
    text String
    "IdSubst:" SDoc -> SDoc -> SDoc
    <+> SDoc
    id_subst_doc,
              String -> SDoc
    text String
    "InScope:" SDoc -> SDoc -> SDoc
    <+> SDoc
    in_scope_vars_doc
        ]
      where
       id_subst_doc :: SDoc
    id_subst_doc = forall a key. (a -> SDoc) -> UniqFM key a -> SDoc
    pprUniqFM 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
    vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 = forall a. Outputable a => a -> SDoc
    ppr OutId
    v SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (OutId -> Unfolding
    idUnfolding OutId
    v)
                 | Bool
    otherwise = forall a. Outputable a => a -> SDoc
    ppr OutId
    v

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

    -- | A substitution result.
    data SimplSR
      = DoneEx OutExpr (Maybe JoinArity)
           -- 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
    text String
    "DoneId" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr OutId
    v
      ppr (DoneEx OutExpr
    e Maybe JoinArity
    mj) = String -> SDoc
    text String
    "DoneEx" SDoc -> SDoc -> SDoc
    <> SDoc
    pp_mj SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr OutExpr
    e
        where
          pp_mj :: SDoc
    pp_mj = case Maybe JoinArity
    mj of
                    Maybe JoinArity
    Nothing -> SDoc
    empty
                    Just JoinArity
    n  -> SDoc -> SDoc
    parens (JoinArity -> SDoc
    int JoinArity
    n)

      ppr (ContEx TvSubstEnv
    _tv CvSubstEnv
    _cv SimplIdSubst
    _id OutExpr
    e) = [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "ContEx" SDoc -> SDoc -> 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 synomyms, 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 -> SimplEnv
    mkSimplEnv :: SimplMode -> SimplEnv
    mkSimplEnv SimplMode
    mode
      = SimplEnv { seMode :: SimplMode
    seMode      = SimplMode
    mode
                 , seInScope :: InScopeSet
    seInScope   = InScopeSet
    init_in_scope
                 , seTvSubst :: TvSubstEnv
    seTvSubst   = forall a. VarEnv a
    emptyVarEnv
                 , seCvSubst :: CvSubstEnv
    seCvSubst   = forall a. VarEnv a
    emptyVarEnv
                 , seIdSubst :: SimplIdSubst
    seIdSubst   = forall a. VarEnv a
    emptyVarEnv
                 , seCaseDepth :: JoinArity
    seCaseDepth = 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
    Many 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.
    -}

    getMode :: SimplEnv -> SimplMode
    getMode :: SimplEnv -> SimplMode
    getMode SimplEnv
    env = SimplEnv -> SimplMode
    seMode SimplEnv
    env

    seDynFlags :: SimplEnv -> DynFlags
    seDynFlags :: SimplEnv -> DynFlags
    seDynFlags SimplEnv
    env = SimplMode -> DynFlags
    sm_dflags (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

    seLogger :: SimplEnv -> Logger
    seLogger :: SimplEnv -> Logger
    seLogger SimplEnv
    env = SimplMode -> Logger
    sm_logger (SimplEnv -> SimplMode
    seMode SimplEnv
    env)

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

    setMode :: SimplMode -> SimplEnv -> SimplEnv
    setMode :: SimplMode -> SimplEnv -> SimplEnv
    setMode SimplMode
    mode SimplEnv
    env = SimplEnv
    env { seMode :: SimplMode
    seMode = SimplMode
    mode }

    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 forall a b. (a -> b) -> a -> b
    $! (SimplEnv -> SimplMode
    seMode SimplEnv
    env)
        in SimplEnv
    env { seMode :: SimplMode
    seMode = SimplMode
    mode }

    bumpCaseDepth :: SimplEnv -> SimplEnv
    bumpCaseDepth :: SimplEnv -> SimplEnv
    bumpCaseDepth SimplEnv
    env = SimplEnv
    env { seCaseDepth :: JoinArity
    seCaseDepth = SimplEnv -> JoinArity
    seCaseDepth SimplEnv
    env forall a. Num a => a -> a -> a
    + JoinArity
    1 }

    ---------------------
    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
      = ASSERT2( isId var && not (isCoVar var), ppr var )
        SimplEnv
    env { seIdSubst :: SimplIdSubst
    seIdSubst = forall a. VarEnv a -> OutId -> a -> VarEnv a
    extendVarEnv SimplIdSubst
    subst OutId
    var SimplSR
    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
      = ASSERT2( isTyVar var, ppr var $$ ppr res )
        SimplEnv
    env {seTvSubst :: TvSubstEnv
    seTvSubst = forall a. VarEnv a -> OutId -> a -> VarEnv a
    extendVarEnv TvSubstEnv
    tsubst OutId
    var Kind
    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
      = ASSERT( isCoVar var )
        SimplEnv
    env {seCvSubst :: CvSubstEnv
    seCvSubst = forall a. VarEnv a -> OutId -> a -> VarEnv a
    extendVarEnv CvSubstEnv
    csubst OutId
    var Coercion
    co}

    ---------------------
    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 :: InScopeSet
    seInScope = InScopeSet
    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 :: InScopeSet
    seInScope = SimplEnv -> InScopeSet
    seInScope SimplEnv
    here_env }

    setInScopeFromF :: SimplEnv -> SimplFloats -> SimplEnv
    setInScopeFromF :: SimplEnv -> SimplFloats -> SimplEnv
    setInScopeFromF SimplEnv
    env SimplFloats
    floats = SimplEnv
    env { seInScope :: InScopeSet
    seInScope = SimplFloats -> InScopeSet
    sfInScope SimplFloats
    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 forall a. VarEnv a -> [OutId] -> VarEnv a
    `delVarEnvList` [OutId]
    vs
        in
        SimplEnv
    env { seInScope :: InScopeSet
    seInScope = InScopeSet
    in_scope1,
              seIdSubst :: SimplIdSubst
    seIdSubst = SimplIdSubst
    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 :: InScopeSet
    seInScope = InScopeSet -> OutId -> InScopeSet
    extendInScopeSet InScopeSet
    in_scope OutId
    v}

    {- 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
    zapSubstEnv :: SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env = SimplEnv
    env {seTvSubst :: TvSubstEnv
    seTvSubst = forall a. VarEnv a
    emptyVarEnv, seCvSubst :: CvSubstEnv
    seCvSubst = forall a. VarEnv a
    emptyVarEnv, seIdSubst :: SimplIdSubst
    seIdSubst = forall a. VarEnv a
    emptyVarEnv}

    setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
    setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
    setSubstEnv SimplEnv
    env TvSubstEnv
    tvs CvSubstEnv
    cvs SimplIdSubst
    ids = SimplEnv
    env { seTvSubst :: TvSubstEnv
    seTvSubst = TvSubstEnv
    tvs, seCvSubst :: CvSubstEnv
    seCvSubst = CvSubstEnv
    cvs, seIdSubst :: SimplIdSubst
    seIdSubst = SimplIdSubst
    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.

    * All of them satisfy the let/app invariant

    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

    Can't happen:
      NonRec x# (a /# b)    -- Might fail; does not satisfy let/app
      NonRec x# (f y)       -- Might diverge; does not satisfy let/app
    -}

    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

      | 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)

      | FltCareful  -- At least one binding is strict (or unlifted)
                    --      and not guaranteed cheap
                    --      Do not float these bindings out of a lazy let

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

    instance Outputable FloatFlag where
      ppr :: FloatFlag -> SDoc
    ppr FloatFlag
    FltLifted  = String -> SDoc
    text String
    "FltLifted"
      ppr FloatFlag
    FltOkSpec  = String -> SDoc
    text String
    "FltOkSpec"
      ppr FloatFlag
    FltCareful = String -> SDoc
    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 :: TopLevelFlag -> RecFlag -> Bool -> SimplFloats -> OutExpr -> Bool
    -- If you change this function look also at FloatIn.noFloatFromRhs
    doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> SimplFloats -> OutExpr -> Bool
    doFloatFromRhs TopLevelFlag
    lvl RecFlag
    rec Bool
    str (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats = LetFloats JoinFloats
    fs FloatFlag
    ff }) OutExpr
    rhs
      =  Bool -> Bool
    not (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
    str

    {-
    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 forall a. OrdList a
    nilOL FloatFlag
    FltLifted

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

    unitLetFloat :: OutBind -> LetFloats
    -- This key function constructs a singleton float with the right form
    unitLetFloat :: Bind OutId -> LetFloats
    unitLetFloat Bind OutId
    bind = ASSERT(all (not . isJoinId) (bindersOf bind))
                        JoinFloats -> FloatFlag -> LetFloats
    LetFloats (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                = ASSERT2( not (isUnliftedType (idType bndr)), ppr bndr )
                                       FloatFlag
    FltCareful
          -- Unlifted binders can only be let-bound if exprOkForSpeculation holds

    unitJoinFloat :: OutBind -> JoinFloats
    unitJoinFloat :: Bind OutId -> JoinFloats
    unitJoinFloat Bind OutId
    bind = ASSERT(all isJoinId (bindersOf bind))
                         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 :: InScopeSet
    seInScope = InScopeSet
    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 let_floats :: LetFloats
    let_floats@(LetFloats JoinFloats
    binds FloatFlag
    _)
      = SimplFloats
    floats { sfLetFloats :: LetFloats
    sfLetFloats = SimplFloats -> LetFloats
    sfLetFloats SimplFloats
    floats LetFloats -> LetFloats -> LetFloats
    `addLetFlts` LetFloats
    let_floats
               , sfInScope :: InScopeSet
    sfInScope   = forall b a. (b -> a -> b) -> b -> OrdList a -> b
    foldlOL InScopeSet -> Bind OutId -> InScopeSet
    extendInScopeSetBind
                                       (SimplFloats -> InScopeSet
    sfInScope SimplFloats
    floats) JoinFloats
    binds }

    addJoinFloats :: SimplFloats -> JoinFloats -> SimplFloats
    addJoinFloats :: SimplFloats -> JoinFloats -> SimplFloats
    addJoinFloats SimplFloats
    floats JoinFloats
    join_floats
      = SimplFloats
    floats { sfJoinFloats :: JoinFloats
    sfJoinFloats = SimplFloats -> JoinFloats
    sfJoinFloats SimplFloats
    floats JoinFloats -> JoinFloats -> JoinFloats
    `addJoinFlts` JoinFloats
    join_floats
               , sfInScope :: InScopeSet
    sfInScope    = forall b a. (b -> a -> b) -> b -> OrdList a -> b
    foldlOL InScopeSet -> Bind OutId -> InScopeSet
    extendInScopeSetBind
                                        (SimplFloats -> InScopeSet
    sfInScope SimplFloats
    floats) JoinFloats
    join_floats }

    extendInScopeSetBind :: InScopeSet -> CoreBind -> InScopeSet
    extendInScopeSetBind :: InScopeSet -> Bind OutId -> InScopeSet
    extendInScopeSetBind InScopeSet
    in_scope Bind OutId
    bind
      = InScopeSet -> [OutId] -> InScopeSet
    extendInScopeSetList InScopeSet
    in_scope (forall b. Bind b -> [b]
    bindersOf Bind OutId
    bind)

    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 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
    _) = forall a. OrdList a -> [a]
    fromOL JoinFloats
    bs

    addJoinFlts :: JoinFloats -> JoinFloats -> JoinFloats
    addJoinFlts :: JoinFloats -> JoinFloats -> JoinFloats
    addJoinFlts = 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 })
      = ASSERT2( isNilOL bs || isNilOL jbs, ppr floats )
        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'  | forall a. OrdList a -> Bool
    isNilOL JoinFloats
    bs  = LetFloats
    emptyLetFloats
                  | Bool
    otherwise   = Bind OutId -> LetFloats
    unitLetFloat (forall b. [(b, Expr b)] -> Bind b
    Rec (forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds (forall a. OrdList a -> [a]
    fromOL JoinFloats
    bs)))
        !jfloats' :: JoinFloats
    jfloats' | forall a. OrdList a -> Bool
    isNilOL JoinFloats
    jbs = JoinFloats
    emptyJoinFloats
                  | Bool
    otherwise   = Bind OutId -> JoinFloats
    unitJoinFloat (forall b. [(b, Expr b)] -> Bind b
    Rec (forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds (forall a. OrdList a -> [a]
    fromOL JoinFloats
    jbs)))

    wrapFloats :: SimplFloats -> OutExpr -> OutExpr
    -- Wrap the floats around the expression; they should all
    -- satisfy the let/app invariant, so mkLets should do the job just fine
    wrapFloats :: SimplFloats -> OutExpr -> OutExpr
    wrapFloats (SimplFloats { sfLetFloats :: SimplFloats -> LetFloats
    sfLetFloats  = LetFloats JoinFloats
    bs FloatFlag
    _
                            , sfJoinFloats :: SimplFloats -> JoinFloats
    sfJoinFloats = JoinFloats
    jbs }) OutExpr
    body
      = forall a b. (a -> b -> b) -> b -> OrdList a -> b
    foldrOL forall b. Bind b -> Expr b -> Expr b
    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

    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 :: JoinFloats
    sfJoinFloats = JoinFloats
    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
      = forall a b. (a -> b -> b) -> b -> OrdList a -> b
    foldrOL 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})
      = ASSERT( isNilOL jbs )  -- 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') -> forall b. b -> Expr b -> Bind b
    NonRec OutId
    b' OutExpr
    e'
        app (Rec [(OutId, OutExpr)]
    bs)     = forall b. [(b, Expr b)] -> Bind b
    Rec (forall a b. (a -> b) -> [a] -> [b]
    strictMap (OutId, OutExpr) -> (OutId, OutExpr)
    fun [(OutId, OutExpr)]
    bs)
        !fs1 :: JoinFloats
    fs1 = (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 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 -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "refineFromInScope" (forall a. Outputable a => a -> SDoc
    ppr InScopeSet
    in_scope SDoc -> SDoc -> 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 forall a. VarEnv a -> OutId -> Maybe a
    lookupVarEnv SimplIdSubst
    ids OutId
    v of
            Just (DoneId OutId
    v) -> OutId
    v
            Just SimplSR
    _ -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "lookupRecBndr" (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 = forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [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 seq :: forall a b. a -> b -> b
    `seq` 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 seq :: forall a b. a -> b -> b
    `seq` 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 seq :: forall a b. a -> b -> b
    `seq` 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]
      = ASSERT(all (not . isJoinId) ids)
        do  { let (!SimplEnv
    env1, [OutId]
    ids1) = 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 seq :: forall a b. a -> b -> b
    `seq` 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
      = ASSERT2( not (isCoVar old_id), ppr old_id )
        (SimplEnv
    env { seInScope :: InScopeSet
    seInScope = InScopeSet
    new_in_scope,
               seIdSubst :: SimplIdSubst
    seIdSubst = SimplIdSubst
    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 forall a. Eq a => a -> a -> Bool
    /= OutId
    old_id
                  = forall a. VarEnv a -> OutId -> a -> VarEnv a
    extendVarEnv SimplIdSubst
    id_subst OutId
    old_id (OutId -> SimplSR
    DoneId OutId
    new_id)
                  | Bool
    otherwise
                  = 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 seq :: forall a b. a -> b -> b
    `seq` ()

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

    seqIds :: [Id] -> ()
    seqIds :: [OutId] -> ()
    seqIds []       = ()
    seqIds (OutId
    id:[OutId]
    ids) = OutId -> ()
    seqId OutId
    id seq :: 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.  This is important, so that the arity of an Id is visible in
    its own RHS.  For example:
            f = \x. ....g (\y. f y)....
    We can eta-reduce the arg to g, because f is a value.  But that
    needs to be visible.

    This interacts with the 'state hack' too:
            f :: Bool -> IO Int
            f = \x. case x of
                      True  -> f y
                      False -> \s -> ...
    Can we eta-expand f?  Only if we see that f has arity 1, and then we
    take advantage of the 'state hack' on the result of
    (f y) :: State# -> (State#, Int) to expand the arity one more.

    There is a disadvantage though.  Making the arity visible in the RHS
    allows us to eta-reduce
            f = \x -> f x
    to
            f = f
    which technically is not sound.   This is very much a corner case, so
    I'm not worried about it.  Another idea is to ensure that f's arity
    never decreases; its arity started as 1, and we should never eta-reduce
    below 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 seq :: forall a b. a -> b -> b
    `seq` 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
      = ASSERT(all isJoinId ids)
        do  { let (SimplEnv
    env1, [OutId]
    ids1) = 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 seq :: forall a b. a -> b -> b
    `seq` 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 jont-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
      = ASSERT( isJoinId join_id )
        OutId -> Kind -> OutId
    setIdType OutId
    join_id Kind
    new_join_ty
      where
        orig_ar :: JoinArity
    orig_ar = OutId -> JoinArity
    idJoinArity OutId
    join_id
        orig_ty :: Kind
    orig_ty = OutId -> Kind
    idType OutId
    join_id

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

        go :: JoinArity -> Kind -> Kind
    go JoinArity
    0 Kind
    _  = Kind
    new_res_ty
        go JoinArity
    n Kind
    ty | Just (TyCoBinder
    arg_bndr, Kind
    res_ty) <- Kind -> Maybe (TyCoBinder, Kind)
    splitPiTy_maybe Kind
    ty
                = TyCoBinder -> Kind -> Kind
    mkPiTy (TyCoBinder -> TyCoBinder
    scale_bndr TyCoBinder
    arg_bndr) forall a b. (a -> b) -> a -> b
    $
                  JoinArity -> Kind -> Kind
    go (JoinArity
    nforall a. Num a => a -> a -> a
    -JoinArity
    1) Kind
    res_ty
                | Bool
    otherwise
                = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "adjustJoinPointType" (forall a. Outputable a => a -> SDoc
    ppr JoinArity
    orig_ar SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Kind
    orig_ty)

        -- See Note [Bangs in the Simplifier]
        scale_bndr :: TyCoBinder -> TyCoBinder
    scale_bndr (Anon AnonArgFlag
    af Scaled Kind
    t) = AnonArgFlag -> Scaled Kind -> TyCoBinder
    Anon AnonArgFlag
    af forall a b. (a -> b) -> a -> b
    $! (forall a. Kind -> Scaled a -> Scaled a
    scaleScaled Kind
    mult Scaled Kind
    t)
        scale_bndr b :: TyCoBinder
    b@(Named TyCoVarBinder
    _) = TyCoBinder
    b

    {- 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
    *                                                                      *
    ************************************************************************
    -}

    getTCvSubst :: SimplEnv -> TCvSubst
    getTCvSubst :: SimplEnv -> TCvSubst
    getTCvSubst (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) -> TCvSubst
    mkTCvSubst InScopeSet
    in_scope (TvSubstEnv
    tv_env, CvSubstEnv
    cv_env)

    substTy :: SimplEnv -> Type -> Type
    substTy :: SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env Kind
    ty = HasCallStack => TCvSubst -> Kind -> Kind
    Type.substTy (SimplEnv -> TCvSubst
    getTCvSubst SimplEnv
    env) Kind
    ty

    substTyVar :: SimplEnv -> TyVar -> Type
    substTyVar :: SimplEnv -> OutId -> Kind
    substTyVar SimplEnv
    env OutId
    tv = TCvSubst -> OutId -> Kind
    Type.substTyVar (SimplEnv -> TCvSubst
    getTCvSubst SimplEnv
    env) OutId
    tv

    substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
    substTyVarBndr :: SimplEnv -> OutId -> (SimplEnv, OutId)
    substTyVarBndr SimplEnv
    env OutId
    tv
      = case HasCallStack => TCvSubst -> OutId -> (TCvSubst, OutId)
    Type.substTyVarBndr (SimplEnv -> TCvSubst
    getTCvSubst SimplEnv
    env) OutId
    tv of
            (TCvSubst InScopeSet
    in_scope' TvSubstEnv
    tv_env' CvSubstEnv
    cv_env', OutId
    tv')
               -> (SimplEnv
    env { seInScope :: InScopeSet
    seInScope = InScopeSet
    in_scope', seTvSubst :: TvSubstEnv
    seTvSubst = TvSubstEnv
    tv_env', seCvSubst :: CvSubstEnv
    seCvSubst = CvSubstEnv
    cv_env' }, OutId
    tv')

    substCoVar :: SimplEnv -> CoVar -> Coercion
    substCoVar :: SimplEnv -> OutId -> Coercion
    substCoVar SimplEnv
    env OutId
    tv = TCvSubst -> OutId -> Coercion
    Coercion.substCoVar (SimplEnv -> TCvSubst
    getTCvSubst SimplEnv
    env) OutId
    tv

    substCoVarBndr :: SimplEnv -> CoVar -> (SimplEnv, CoVar)
    substCoVarBndr :: SimplEnv -> OutId -> (SimplEnv, OutId)
    substCoVarBndr SimplEnv
    env OutId
    cv
      = case HasCallStack => TCvSubst -> OutId -> (TCvSubst, OutId)
    Coercion.substCoVarBndr (SimplEnv -> TCvSubst
    getTCvSubst SimplEnv
    env) OutId
    cv of
            (TCvSubst InScopeSet
    in_scope' TvSubstEnv
    tv_env' CvSubstEnv
    cv_env', OutId
    cv')
               -> (SimplEnv
    env { seInScope :: InScopeSet
    seInScope = InScopeSet
    in_scope', seTvSubst :: TvSubstEnv
    seTvSubst = TvSubstEnv
    tv_env', seCvSubst :: CvSubstEnv
    seCvSubst = CvSubstEnv
    cv_env' }, OutId
    cv')

    substCo :: SimplEnv -> Coercion -> Coercion
    substCo :: SimplEnv -> Coercion -> Coercion
    substCo SimplEnv
    env Coercion
    co = HasCallStack => TCvSubst -> Coercion -> Coercion
    Coercion.substCo (SimplEnv -> TCvSubst
    getTCvSubst 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
      | (forall a. VarEnv a -> Bool
    isEmptyVarEnv TvSubstEnv
    tv_env Bool -> Bool -> 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 (TCvSubst -> Kind -> Kind
    Type.substTyUnchecked TCvSubst
    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 :: TCvSubst
    subst = InScopeSet -> TvSubstEnv -> CvSubstEnv -> TCvSubst
    TCvSubst InScopeSet
    in_scope 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