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

    \section[Simplify]{The main module of the simplifier}
    -}

    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE MultiWayIf #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    module GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules ) where

    import GHC.Prelude

    import GHC.Driver.Flags

    import GHC.Core
    import GHC.Core.Opt.Simplify.Monad
    import GHC.Core.Opt.ConstantFold
    import GHC.Core.Type hiding ( substCo, substTy, substTyVar, extendTvSubst, extendCvSubst )
    import GHC.Core.TyCo.Compare( eqType )
    import GHC.Core.Opt.Simplify.Env
    import GHC.Core.Opt.Simplify.Inline
    import GHC.Core.Opt.Simplify.Utils
    import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) )
    import GHC.Core.Make       ( FloatBind, mkImpossibleExpr, castBottomExpr )
    import qualified GHC.Core.Make
    import GHC.Core.Coercion hiding ( substCo, substCoVar )
    import GHC.Core.Reduction
    import GHC.Core.Coercion.Opt    ( optCoercion )
    import GHC.Core.FamInstEnv      ( FamInstEnv, topNormaliseType_maybe )
    import GHC.Core.DataCon
       ( DataCon, dataConWorkId, dataConRepStrictness
       , dataConRepArgTys, isUnboxedTupleDataCon
       , StrictnessMark (..), dataConWrapId_maybe )
    import GHC.Core.Opt.Stats ( Tick(..) )
    import GHC.Core.Ppr     ( pprCoreExpr )
    import GHC.Core.Unfold
    import GHC.Core.Unfold.Make
    import GHC.Core.Utils
    import GHC.Core.Opt.Arity ( ArityType, exprArity, arityTypeBotSigs_maybe
                              , pushCoTyArg, pushCoValArg, exprIsDeadEnd
                              , typeArity, arityTypeArity, etaExpandAT )
    import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )
    import GHC.Core.FVs     ( mkRuleInfo {- exprsFreeIds -} )
    import GHC.Core.Rules   ( lookupRule, getRules )
    import GHC.Core.Multiplicity

    import GHC.Types.Literal   ( litIsLifted ) --, mkLitInt ) -- temporarily commented out. See #8326
    import GHC.Types.SourceText
    import GHC.Types.Id
    import GHC.Types.Id.Make   ( seqId )
    import GHC.Types.Id.Info
    import GHC.Types.Name   ( mkSystemVarName, isExternalName, getOccFS )
    import GHC.Types.Demand
    import GHC.Types.Unique ( hasKey )
    import GHC.Types.Basic
    import GHC.Types.Tickish
    import GHC.Types.Var    ( isTyCoVar )
    import GHC.Builtin.Types.Prim( realWorldStatePrimTy )
    import GHC.Builtin.Names( runRWKey, seqHashKey )

    import GHC.Data.Maybe   ( isNothing, orElse, mapMaybe )
    import GHC.Data.FastString
    import GHC.Unit.Module ( moduleName )
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Monad  ( mapAccumLM, liftIO )
    import GHC.Utils.Logger
    import GHC.Utils.Misc

    import Control.Monad

    {-
    The guts of the simplifier is in this module, but the driver loop for
    the simplifier is in GHC.Core.Opt.Pipeline

    Note [The big picture]
    ~~~~~~~~~~~~~~~~~~~~~~
    The general shape of the simplifier is this:

      simplExpr :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr)
      simplBind :: SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)

     * SimplEnv contains
         - Simplifier mode
         - Ambient substitution
         - InScopeSet

     * SimplFloats contains
         - Let-floats (which includes ok-for-spec case-floats)
         - Join floats
         - InScopeSet (including all the floats)

     * Expressions
          simplExpr :: SimplEnv -> InExpr -> SimplCont
                    -> SimplM (SimplFloats, OutExpr)
       The result of simplifying an /expression/ is (floats, expr)
          - A bunch of floats (let bindings, join bindings)
          - A simplified expression.
       The overall result is effectively (let floats in expr)

     * Bindings
          simplBind :: SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)
       The result of simplifying a binding is
         - A bunch of floats, the last of which is the simplified binding
           There may be auxiliary bindings too; see prepareRhs
         - An environment suitable for simplifying the scope of the binding

       The floats may also be empty, if the binding is inlined unconditionally;
       in that case the returned SimplEnv will have an augmented substitution.

       The returned floats and env both have an in-scope set, and they are
       guaranteed to be the same.

    Eta expansion
    ~~~~~~~~~~~~~~
    For eta expansion, we want to catch things like

            case e of (a,b) -> \x -> case a of (p,q) -> \y -> r

    If the \x was on the RHS of a let, we'd eta expand to bring the two
    lambdas together.  And in general that's a good thing to do.  Perhaps
    we should eta expand wherever we find a (value) lambda?  Then the eta
    expansion at a let RHS can concentrate solely on the PAP case.

    Note [In-scope set as a substitution]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    As per Note [Lookups in in-scope set], an in-scope set can act as
    a substitution. Specifically, it acts as a substitution from variable to
    variables /with the same unique/.

    Why do we need this? Well, during the course of the simplifier, we may want to
    adjust inessential properties of a variable. For instance, when performing a
    beta-reduction, we change

        (\x. e) u ==> let x = u in e

    We typically want to add an unfolding to `x` so that it inlines to (the
    simplification of) `u`.

    We do that by adding the unfolding to the binder `x`, which is added to the
    in-scope set. When simplifying occurrences of `x` (every occurrence!), they are
    replaced by their “updated” version from the in-scope set, hence inherit the
    unfolding. This happens in `SimplEnv.substId`.

    Another example. Consider

       case x of y { Node a b -> ...y...
                   ; Leaf v   -> ...y... }

    In the Node branch want y's unfolding to be (Node a b); in the Leaf branch we
    want y's unfolding to be (Leaf v). We achieve this by adding the appropriate
    unfolding to y, and re-adding it to the in-scope set. See the calls to
    `addBinderUnfolding` in `Simplify.addAltUnfoldings` and elsewhere.

    It's quite convenient. This way we don't need to manipulate the substitution all
    the time: every update to a binder is automatically reflected to its bound
    occurrences.

    Note [Bangs in the Simplifier]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Both SimplFloats and SimplEnv do *not* generally benefit from making
    their fields strict. I don't know if this is because of good use of
    laziness or unintended side effects like closures capturing more variables
    after WW has run.

    But the end result is that we keep these lazy, but force them in some places
    where we know it's beneficial to the compiler.

    Similarly environments returned from functions aren't *always* beneficial to
    force. In some places they would never be demanded so forcing them early
    increases allocation. In other places they almost always get demanded so
    it's worthwhile to force them early.

    Would it be better to through every allocation of e.g. SimplEnv and decide
    wether or not to make this one strict? Absolutely! Would be a good use of
    someones time? Absolutely not! I made these strict that showed up during
    a profiled build or which I noticed while looking at core for one reason
    or another.

    The result sadly is that we end up with "random" bangs in the simplifier
    where we sometimes force e.g. the returned environment from a function and
    sometimes we don't for the same function. Depending on the context around
    the call. The treatment is also not very consistent. I only added bangs
    where I saw it making a difference either in the core or benchmarks. Some
    patterns where it would be beneficial aren't convered as a consequence as
    I neither have the time to go through all of the core and some cases are
    too small to show up in benchmarks.

    ************************************************************************
    *                                                                      *
    \subsection{Bindings}
    *                                                                      *
    ************************************************************************
    -}

    simplTopBinds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
    -- See Note [The big picture]
    simplTopBinds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
    simplTopBinds SimplEnv
    env0 [InBind]
    binds0
      = do  {       -- Put all the top-level binders into scope at the start
                    -- so that if a rewrite rule has unexpectedly brought
                    -- anything into scope, then we don't get a complaint about that.
                    -- It's rather as if the top-level binders were imported.
                    -- See Note [Glomming] in "GHC.Core.Opt.OccurAnal".
            -- See Note [Bangs in the Simplifier]
            ; !env1 <- {-#SCC "simplTopBinds-simplRecBndrs" #-} SimplEnv -> [CoreBndr] -> SimplM SimplEnv
    simplRecBndrs SimplEnv
    env0 ([InBind] -> [CoreBndr]
    forall b. [Bind b] -> [b]
    bindersOfBinds [InBind]
    binds0)
            ; (floats, env2) <- {-#SCC "simplTopBinds-simpl_binds" #-} simpl_binds env1 binds0
            ; freeTick SimplifierDone
            ; return (floats, env2) }
      where
            -- We need to track the zapped top-level binders, because
            -- they should have their fragile IdInfo zapped (notably occurrence info)
            -- That's why we run down binds and bndrs' simultaneously.
            --
        simpl_binds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
        simpl_binds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
    simpl_binds SimplEnv
    env []           = (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env)
        simpl_binds SimplEnv
    env (InBind
    bind:[InBind]
    binds) = do { (float,  env1) <- SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)
    simpl_bind SimplEnv
    env InBind
    bind
                                          ; (floats, env2) <- simpl_binds env1 binds
                                          -- See Note [Bangs in the Simplifier]
                                          ; let !floats1 = SimplFloats
    float SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats
                                          ; return (floats1, env2) }

        simpl_bind :: SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)
    simpl_bind SimplEnv
    env (Rec [(CoreBndr, CoreExpr)]
    pairs)
          = SimplEnv
    -> BindContext
    -> [(CoreBndr, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    simplRecBind SimplEnv
    env (TopLevelFlag -> RecFlag -> BindContext
    BC_Let TopLevelFlag
    TopLevel RecFlag
    Recursive) [(CoreBndr, CoreExpr)]
    pairs
        simpl_bind SimplEnv
    env (NonRec CoreBndr
    b CoreExpr
    r)
          = do { let bind_cxt :: BindContext
    bind_cxt = TopLevelFlag -> RecFlag -> BindContext
    BC_Let TopLevelFlag
    TopLevel RecFlag
    NonRecursive
               ; (env', b') <- SimplEnv
    -> CoreBndr
    -> CoreBndr
    -> BindContext
    -> SimplM (SimplEnv, CoreBndr)
    addBndrRules SimplEnv
    env CoreBndr
    b (SimplEnv -> CoreBndr -> CoreBndr
    lookupRecBndr SimplEnv
    env CoreBndr
    b) BindContext
    bind_cxt
               ; simplRecOrTopPair env' bind_cxt b b' r }

    {-
    ************************************************************************
    *                                                                      *
            Lazy bindings
    *                                                                      *
    ************************************************************************

    simplRecBind is used for
            * recursive bindings only
    -}

    simplRecBind :: SimplEnv -> BindContext
                 -> [(InId, InExpr)]
                 -> SimplM (SimplFloats, SimplEnv)
    simplRecBind :: SimplEnv
    -> BindContext
    -> [(CoreBndr, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    simplRecBind SimplEnv
    env0 BindContext
    bind_cxt [(CoreBndr, CoreExpr)]
    pairs0
      = do  { (env1, triples) <- (SimplEnv
     -> (CoreBndr, CoreExpr)
     -> SimplM (SimplEnv, (CoreBndr, CoreBndr, CoreExpr)))
    -> SimplEnv
    -> [(CoreBndr, CoreExpr)]
    -> SimplM (SimplEnv, [(CoreBndr, CoreBndr, CoreExpr)])
    forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM SimplEnv
    -> (CoreBndr, CoreExpr)
    -> SimplM (SimplEnv, (CoreBndr, CoreBndr, CoreExpr))
    add_rules SimplEnv
    env0 [(CoreBndr, CoreExpr)]
    pairs0
            ; let new_bndrs = ((CoreBndr, CoreBndr, CoreExpr) -> CoreBndr)
    -> [(CoreBndr, CoreBndr, CoreExpr)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, CoreBndr, CoreExpr) -> CoreBndr
    forall a b c. (a, b, c) -> b
    sndOf3 [(CoreBndr, CoreBndr, CoreExpr)]
    triples
            ; (rec_floats, env2) <- enterRecGroupRHSs env1 new_bndrs $ \SimplEnv
    env ->
                                    SimplEnv
    -> [(CoreBndr, CoreBndr, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    go SimplEnv
    env [(CoreBndr, CoreBndr, CoreExpr)]
    triples
            ; return (mkRecFloats rec_floats, env2) }
      where
        add_rules :: SimplEnv -> (InBndr,InExpr) -> SimplM (SimplEnv, (InBndr, OutBndr, InExpr))
            -- Add the (substituted) rules to the binder
        add_rules :: SimplEnv
    -> (CoreBndr, CoreExpr)
    -> SimplM (SimplEnv, (CoreBndr, CoreBndr, CoreExpr))
    add_rules SimplEnv
    env (CoreBndr
    bndr, CoreExpr
    rhs)
            = do { (env', bndr') <- SimplEnv
    -> CoreBndr
    -> CoreBndr
    -> BindContext
    -> SimplM (SimplEnv, CoreBndr)
    addBndrRules SimplEnv
    env CoreBndr
    bndr (SimplEnv -> CoreBndr -> CoreBndr
    lookupRecBndr SimplEnv
    env CoreBndr
    bndr) BindContext
    bind_cxt
                 ; return (env', (bndr, bndr', rhs)) }

        go :: SimplEnv
    -> [(CoreBndr, CoreBndr, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    go SimplEnv
    env [] = (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env)

        go SimplEnv
    env ((CoreBndr
    old_bndr, CoreBndr
    new_bndr, CoreExpr
    rhs) : [(CoreBndr, CoreBndr, CoreExpr)]
    pairs)
            = do { (float, env1) <- SimplEnv
    -> BindContext
    -> CoreBndr
    -> CoreBndr
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplRecOrTopPair SimplEnv
    env BindContext
    bind_cxt
                                                      CoreBndr
    old_bndr CoreBndr
    new_bndr CoreExpr
    rhs
                 ; (floats, env2) <- go env1 pairs
                 ; return (float `addFloats` floats, env2) }

    {-
    simplOrTopPair is used for
            * recursive bindings (whether top level or not)
            * top-level non-recursive bindings

    It assumes the binder has already been simplified, but not its IdInfo.
    -}

    simplRecOrTopPair :: SimplEnv
                      -> BindContext
                      -> InId -> OutBndr -> InExpr  -- Binder and rhs
                      -> SimplM (SimplFloats, SimplEnv)

    simplRecOrTopPair :: SimplEnv
    -> BindContext
    -> CoreBndr
    -> CoreBndr
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplRecOrTopPair SimplEnv
    env BindContext
    bind_cxt CoreBndr
    old_bndr CoreBndr
    new_bndr CoreExpr
    rhs
      | Just SimplEnv
    env' <- SimplEnv
    -> TopLevelFlag
    -> CoreBndr
    -> CoreExpr
    -> SimplEnv
    -> Maybe SimplEnv
    preInlineUnconditionally SimplEnv
    env (BindContext -> TopLevelFlag
    bindContextLevel BindContext
    bind_cxt)
                                              CoreBndr
    old_bndr CoreExpr
    rhs SimplEnv
    env
      = {-#SCC "simplRecOrTopPair-pre-inline-uncond" #-}
        String
    -> SDoc
    -> SimplM (SimplFloats, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    forall a. String -> SDoc -> SimplM a -> SimplM a
    simplTrace String
    "SimplBindr:inline-uncond" (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    old_bndr) (SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv))
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a b. (a -> b) -> a -> b
    $
        do { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    PreInlineUnconditionally CoreBndr
    old_bndr)
           ; (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env' ) }

      | Bool
    otherwise
      = case BindContext
    bind_cxt of
          BC_Join RecFlag
    is_rec SimplCont
    cont -> String
    -> SDoc
    -> SimplM (SimplFloats, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    forall a. String -> SDoc -> SimplM a -> SimplM a
    simplTrace String
    "SimplBind:join" (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    old_bndr) (SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv))
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a b. (a -> b) -> a -> b
    $
                                 RecFlag
    -> SimplCont
    -> (CoreBndr, SimplEnv)
    -> (CoreBndr, SimplEnv)
    -> (CoreExpr, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    simplJoinBind RecFlag
    is_rec SimplCont
    cont
                                               (CoreBndr
    old_bndr,SimplEnv
    env) (CoreBndr
    new_bndr,SimplEnv
    env) (CoreExpr
    rhs,SimplEnv
    env)

          BC_Let TopLevelFlag
    top_lvl RecFlag
    is_rec -> String
    -> SDoc
    -> SimplM (SimplFloats, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    forall a. String -> SDoc -> SimplM a -> SimplM a
    simplTrace String
    "SimplBind:normal" (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    old_bndr) (SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv))
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a b. (a -> b) -> a -> b
    $
                                   TopLevelFlag
    -> RecFlag
    -> (CoreBndr, SimplEnv)
    -> (CoreBndr, SimplEnv)
    -> (CoreExpr, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    simplLazyBind TopLevelFlag
    top_lvl RecFlag
    is_rec
                                                 (CoreBndr
    old_bndr,SimplEnv
    env) (CoreBndr
    new_bndr,SimplEnv
    env) (CoreExpr
    rhs,SimplEnv
    env)

    simplTrace :: String -> SDoc -> SimplM a -> SimplM a
    simplTrace :: forall a. String -> SDoc -> SimplM a -> SimplM a
    simplTrace String
    herald SDoc
    doc SimplM a
    thing_inside = do
      logger <- SimplM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
      if logHasDumpFlag logger Opt_D_verbose_core2core
        then logTraceMsg logger herald doc thing_inside
        else thing_inside

    --------------------------
    simplLazyBind :: TopLevelFlag -> RecFlag
                  -> (InId, SimplEnv)       -- InBinder, and static env for its unfolding (if any)
                  -> (OutId, SimplEnv)      -- OutBinder, and SimplEnv after simplifying that binder
                                            -- The OutId has IdInfo (notably RULES),
                                            -- except arity, unfolding
                  -> (InExpr, SimplEnv)     -- The RHS and its static environment
                  -> SimplM (SimplFloats, SimplEnv)
    -- Precondition: Ids only, no TyVars; not a JoinId
    -- Precondition: rhs obeys the let-can-float invariant
    simplLazyBind :: TopLevelFlag
    -> RecFlag
    -> (CoreBndr, SimplEnv)
    -> (CoreBndr, SimplEnv)
    -> (CoreExpr, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    simplLazyBind TopLevelFlag
    top_lvl RecFlag
    is_rec (CoreBndr
    bndr,SimplEnv
    unf_se) (CoreBndr
    bndr1,SimplEnv
    env) (CoreExpr
    rhs,SimplEnv
    rhs_se)
      = Bool
    -> (Bool
        -> SDoc
        -> SimplM (SimplFloats, SimplEnv)
        -> SimplM (SimplFloats, SimplEnv))
    -> Bool
    -> SDoc
    -> SimplM (SimplFloats, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isId CoreBndr
    bndr )
        Bool
    -> SDoc
    -> SimplM (SimplFloats, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Bool -> Bool
    not (CoreBndr -> Bool
    isJoinId CoreBndr
    bndr)) (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    bndr) (SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv))
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a b. (a -> b) -> a -> b
    $
        -- pprTrace "simplLazyBind" ((ppr bndr <+> ppr bndr1) $$ ppr rhs $$ ppr (seIdSubst rhs_se)) $
        do  { let   !rhs_env :: SimplEnv
    rhs_env     = SimplEnv
    rhs_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env -- See Note [Bangs in the Simplifier]
                    ([CoreBndr]
    tvs, CoreExpr
    body) = case CoreExpr -> ([CoreBndr], [CoreBndr], CoreExpr)
    collectTyAndValBinders CoreExpr
    rhs of
                                    ([CoreBndr]
    tvs, [], CoreExpr
    body)
                                      | CoreExpr -> Bool
    forall {b}. Expr b -> Bool
    surely_not_lam CoreExpr
    body -> ([CoreBndr]
    tvs, CoreExpr
    body)
                                    ([CoreBndr], [CoreBndr], CoreExpr)
    _                       -> ([], CoreExpr
    rhs)

                    surely_not_lam :: Expr b -> Bool
    surely_not_lam (Lam {})     = Bool
    False
                    surely_not_lam (Tick CoreTickish
    t Expr b
    e)
                      | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreTickish
    t) = Expr b -> Bool
    surely_not_lam Expr b
    e
                       -- eta-reduction could float
                    surely_not_lam Expr b
    _            = Bool
    True
                            -- Do not do the "abstract tyvar" thing if there's
                            -- a lambda inside, because it defeats eta-reduction
                            --    f = /\a. \x. g a x
                            -- should eta-reduce.

            ; (body_env, tvs') <- {-#SCC "simplBinders" #-} SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    simplBinders SimplEnv
    rhs_env [CoreBndr]
    tvs
                    -- See Note [Floating and type abstraction] in GHC.Core.Opt.Simplify.Utils

            -- Simplify the RHS
            ; let rhs_cont = Kind -> RecFlag -> Demand -> SimplCont
    mkRhsStop (HasDebugCallStack => SimplEnv -> Kind -> Kind
    SimplEnv -> Kind -> Kind
    substTy SimplEnv
    body_env (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    body))
                                       RecFlag
    is_rec (CoreBndr -> Demand
    idDemandInfo CoreBndr
    bndr)
            ; (body_floats0, body0) <- {-#SCC "simplExprF" #-} simplExprF body_env body rhs_cont

            -- ANF-ise a constructor or PAP rhs
            ; (body_floats2, body2) <- {-#SCC "prepareBinding" #-}
                                       prepareBinding env top_lvl is_rec
                                                      False  -- Not strict; this is simplLazyBind
                                                      bndr1 body_floats0 body0
              -- Subtle point: we do not need or want tvs' in the InScope set
              -- of body_floats2, so we pass in 'env' not 'body_env'.
              -- Don't want: if tvs' are in-scope in the scope of this let-binding, we may do
              -- more renaming than necessary => extra work (see !7777 and test T16577).
              -- Don't need: we wrap tvs' around the RHS anyway.

            ; (rhs_floats, body3)
                <-  if isEmptyFloats body_floats2 || null tvs then   -- Simple floating
                         {-#SCC "simplLazyBind-simple-floating" #-}
                         return (body_floats2, body2)

                    else -- Non-empty floats, and non-empty tyvars: do type-abstraction first
                         {-#SCC "simplLazyBind-type-abstraction-first" #-}
                         do { (poly_binds, body3) <- abstractFloats (seUnfoldingOpts env) top_lvl
                                                                    tvs' body_floats2 body2
                            ; let poly_floats = (SimplFloats -> InBind -> SimplFloats)
    -> SimplFloats -> [InBind] -> SimplFloats
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' SimplFloats -> InBind -> SimplFloats
    extendFloats (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env) [InBind]
    poly_binds
                            ; return (poly_floats, body3) }

            ; let env1 = SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    rhs_floats
            ; rhs' <- rebuildLam env1 tvs' body3 rhs_cont
            ; (bind_float, env2) <- completeBind (BC_Let top_lvl is_rec) (bndr,unf_se) (bndr1,rhs',env1)
            ; return (rhs_floats `addFloats` bind_float, env2) }

    --------------------------
    simplJoinBind :: RecFlag
                  -> SimplCont
                  -> (InId, SimplEnv)       -- InBinder, with static env for its unfolding
                  -> (OutId, SimplEnv)      -- OutBinder; SimplEnv has the binder in scope
                                            -- The OutId has IdInfo, except arity, unfolding
                  -> (InExpr, SimplEnv)     -- The right hand side and its env
                  -> SimplM (SimplFloats, SimplEnv)
    simplJoinBind :: RecFlag
    -> SimplCont
    -> (CoreBndr, SimplEnv)
    -> (CoreBndr, SimplEnv)
    -> (CoreExpr, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    simplJoinBind RecFlag
    is_rec SimplCont
    cont (CoreBndr
    old_bndr, SimplEnv
    unf_se) (CoreBndr
    new_bndr, SimplEnv
    env) (CoreExpr
    rhs, SimplEnv
    rhs_se)
      = do  { let rhs_env :: SimplEnv
    rhs_env = SimplEnv
    rhs_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env
            ; rhs' <- SimplEnv -> CoreBndr -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplJoinRhs SimplEnv
    rhs_env CoreBndr
    old_bndr CoreExpr
    rhs SimplCont
    cont
            ; completeBind (BC_Join is_rec cont) (old_bndr, unf_se) (new_bndr, rhs', env) }

    --------------------------
    simplAuxBind :: String
                 -> SimplEnv
                 -> InId            -- Old binder; not a JoinId
                 -> OutExpr         -- Simplified RHS
                 -> SimplM (SimplFloats, SimplEnv)
    -- A specialised variant of completeBindX used to construct non-recursive
    -- auxiliary bindings, notably in knownCon.
    --
    -- The binder comes from a case expression (case binder or alternative)
    -- and so does not have rules, unfolding, inline pragmas etc.
    --
    -- Precondition: rhs satisfies the let-can-float invariant

    simplAuxBind :: String
    -> SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplAuxBind String
    _str SimplEnv
    env CoreBndr
    bndr CoreExpr
    new_rhs
      | Bool -> SDoc -> Bool -> Bool
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (CoreBndr -> Bool
    isId CoreBndr
    bndr Bool -> Bool -> Bool
    && Bool -> Bool
    not (CoreBndr -> Bool
    isJoinId CoreBndr
    bndr)) (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    bndr) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $
        CoreBndr -> Bool
    isDeadBinder CoreBndr
    bndr   -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p }
      = (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env)    --  Here c is dead, and we avoid
                                         --  creating the binding c = (a,b)

      -- Next we have a fast-path for cases that would be inlined unconditionally by
      -- completeBind: but it seems not uncommon, and it turns to be a little more
      -- efficient (in compile time allocations) to do it here.
      -- Effectively this is just a vastly-simplified postInlineUnconditionally
      --   See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils
      -- We could instead use postInlineUnconditionally itself, but I think it's simpler
      --   and more direct to focus on the "hot" cases.
      -- e.g. auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings
      | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    new_rhs  -- Short-cut for let x = y in ...
        Bool -> Bool -> Bool
    || case (CoreBndr -> OccInfo
    idOccInfo CoreBndr
    bndr) of
              OneOcc{ occ_n_br :: OccInfo -> Int
    occ_n_br = Int
    1, occ_in_lam :: OccInfo -> InsideLam
    occ_in_lam = InsideLam
    NotInsideLam } -> Bool
    True
              OccInfo
    _                                                 -> Bool
    False
      = (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
               , SimplEnv -> CoreBndr -> CoreExpr -> SimplEnv
    extendCvIdSubst SimplEnv
    env CoreBndr
    bndr CoreExpr
    new_rhs )  -- bndr can be a CoVar

      | Bool
    otherwise
      = do  { -- ANF-ise the RHS
              let !occ_fs :: FastString
    occ_fs = CoreBndr -> FastString
    forall a. NamedThing a => a -> FastString
    getOccFS CoreBndr
    bndr
            ; (anf_floats, rhs1) <- HasDebugCallStack =>
    SimplEnv
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    SimplEnv
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    prepareRhs SimplEnv
    env TopLevelFlag
    NotTopLevel FastString
    occ_fs CoreExpr
    new_rhs
            ; unless (isEmptyLetFloats anf_floats) (tick LetFloatFromLet)
            ; let rhs_floats = SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env SimplFloats -> LetFloats -> SimplFloats
    `addLetFloats` LetFloats
    anf_floats

              -- Simplify the binder and complete the binding
            ; (env1, new_bndr) <- simplBinder (env `setInScopeFromF` rhs_floats) bndr
            ; (bind_float, env2) <- completeBind (BC_Let NotTopLevel NonRecursive)
                                                 (bndr,env) (new_bndr, rhs1, env1)

            ; return (rhs_floats `addFloats` bind_float, env2) }

    {- *********************************************************************
    *                                                                      *
               Cast worker/wrapper
    *                                                                      *
    ************************************************************************

    Note [Cast worker/wrapper]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we have a binding
       x = e |> co
    we want to do something very similar to worker/wrapper:
       $wx = e
       x = $wx |> co

    We call this making a cast worker/wrapper in tryCastWorkerWrapper.

    The main motivaiton is that x can be inlined freely.  There's a chance
    that e will be a constructor application or function, or something
    like that, so moving the coercion to the usage site may well cancel
    the coercions and lead to further optimisation.  Example:

         data family T a :: *
         data instance T Int = T Int

         foo :: Int -> Int -> Int
         foo m n = ...
            where
              t = T m
              go 0 = 0
              go n = case t of { T m -> go (n-m) }
                    -- This case should optimise

    A second reason for doing cast worker/wrapper is that the worker/wrapper
    pass after strictness analysis can't deal with RHSs like
         f = (\ a b c. blah) |> co
    Instead, it relies on cast worker/wrapper to get rid of the cast,
    leaving a simpler job for demand-analysis worker/wrapper.  See #19874.

    Wrinkles

    1. We must /not/ do cast w/w on
         f = g |> co
       otherwise it'll just keep repeating forever! You might think this
       is avoided because the call to tryCastWorkerWrapper is guarded by
       preInlineUnconditinally, but I'm worried that a loop-breaker or an
       exported Id might say False to preInlineUnonditionally.

    2. We need to be careful with inline/noinline pragmas:
           rec { {-# NOINLINE f #-}
                 f = (...g...) |> co
               ; g = ...f... }
       This is legitimate -- it tells GHC to use f as the loop breaker
       rather than g.  Now we do the cast thing, to get something like
           rec { $wf = ...g...
               ; f = $wf |> co
               ; g = ...f... }
       Where should the NOINLINE pragma go?  If we leave it on f we'll get
         rec { $wf = ...g...
             ; {-# NOINLINE f #-}
               f = $wf |> co
             ; g = ...f... }
       and that is bad: the whole point is that we want to inline that
       cast!  We want to transfer the pagma to $wf:
          rec { {-# NOINLINE $wf #-}
                $wf = ...g...
              ; f = $wf |> co
              ; g = ...f... }
       c.f. Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap.

    3. We should still do cast w/w even if `f` is INLINEABLE.  E.g.
          {- f: Stable unfolding = <stable-big> -}
          f = (\xy. <big-body>) |> co
       Then we want to w/w to
          {- $wf: Stable unfolding = <stable-big> |> sym co -}
          $wf = \xy. <big-body>
          f = $wf |> co
       Notice that the stable unfolding moves to the worker!  Now demand analysis
       will work fine on $wf, whereas it has trouble with the original f.
       c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap.
       This point also applies to strong loopbreakers with INLINE pragmas, see
       wrinkle (4).

    4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence
       hasInlineUnfolding in tryCastWorkerWrapper, which responds False to
       loop-breakers) because they'll definitely be inlined anyway, cast and
       all. And if we do cast w/w for an INLINE function with arity zero, we get
       something really silly: we inline that "worker" right back into the wrapper!
       Worse than a no-op, because we have then lost the stable unfolding.

    All these wrinkles are exactly like worker/wrapper for strictness analysis:
      f is the wrapper and must inline like crazy
      $wf is the worker and must carry f's original pragma
    See Note [Worker/wrapper for INLINABLE functions]
    and Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap.

    See #17673, #18093, #18078, #19890.

    Note [Preserve strictness in cast w/w]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In the Note [Cast worker/wrapper] transformation, keep the strictness info.
    Eg
            f = e `cast` co    -- f has strictness SSL
    When we transform to
            f' = e             -- f' also has strictness SSL
            f = f' `cast` co   -- f still has strictness SSL

    Its not wrong to drop it on the floor, but better to keep it.

    Note [Preserve RuntimeRep info in cast w/w]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We must not do cast w/w when the presence of the coercion is needed in order
    to determine the runtime representation.

    Example:

      Suppose we have a type family:

        type F :: RuntimeRep
        type family F where
          F = LiftedRep

      together with a type `ty :: TYPE F` and a top-level binding

        a :: ty |> TYPE F[0]

      The kind of `ty |> TYPE F[0]` is `LiftedRep`, so `a` is a top-level lazy binding.
      However, were we to apply cast w/w, we would get:

        b :: ty
        b = ...

        a :: ty |> TYPE F[0]
        a = b `cast` GRefl (TYPE F[0])

      Now we are in trouble because `ty :: TYPE F` does not have a known runtime
      representation, because we need to be able to reduce the nullary type family
      application `F` to find that out.

    Conclusion: only do cast w/w when doing so would not lose the RuntimeRep
    information. That is, when handling `Cast rhs co`, don't attempt cast w/w
    unless the kind of the type of rhs is concrete, in the sense of
    Note [Concrete types] in GHC.Tc.Utils.Concrete.
    -}

    tryCastWorkerWrapper :: SimplEnv -> BindContext
                         -> InId -> OutId -> OutExpr
                         -> SimplM (SimplFloats, SimplEnv)
    -- See Note [Cast worker/wrapper]
    tryCastWorkerWrapper :: SimplEnv
    -> BindContext
    -> CoreBndr
    -> CoreBndr
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    tryCastWorkerWrapper SimplEnv
    env BindContext
    bind_cxt CoreBndr
    old_bndr CoreBndr
    bndr (Cast CoreExpr
    rhs CoercionR
    co)
      | BC_Let TopLevelFlag
    top_lvl RecFlag
    is_rec <- BindContext
    bind_cxt  -- Not join points
      , Bool -> Bool
    not (CoreBndr -> Bool
    isDFunId CoreBndr
    bndr) -- nor DFuns; cast w/w is no help, and we can't transform
                            --            a DFunUnfolding in mk_worker_unfolding
      , Bool -> Bool
    not (CoreExpr -> Bool
    exprIsTrivial CoreExpr
    rhs)        -- Not x = y |> co; Wrinkle 1
      , Bool -> Bool
    not (IdInfo -> Bool
    hasInlineUnfolding IdInfo
    info)  -- Not INLINE things: Wrinkle 4
      , HasDebugCallStack => Kind -> Bool
    Kind -> Bool
    typeHasFixedRuntimeRep Kind
    work_ty    -- Don't peel off a cast if doing so would
                                          -- lose the underlying runtime representation.
                                          -- See Note [Preserve RuntimeRep info in cast w/w]
      , Bool -> Bool
    not (InlinePragma -> Bool
    isOpaquePragma (CoreBndr -> InlinePragma
    idInlinePragma CoreBndr
    old_bndr)) -- Not for OPAQUE bindings
                                                       -- See Note [OPAQUE pragma]
      = do  { uniq <- SimplM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
            ; let work_name = Unique -> FastString -> Name
    mkSystemVarName Unique
    uniq FastString
    occ_fs
                  work_id   = HasDebugCallStack => Name -> Kind -> Kind -> IdInfo -> CoreBndr
    Name -> Kind -> Kind -> IdInfo -> CoreBndr
    mkLocalIdWithInfo Name
    work_name Kind
    ManyTy Kind
    work_ty IdInfo
    work_info
                  is_strict = CoreBndr -> Bool
    isStrictId CoreBndr
    bndr

            ; (rhs_floats, work_rhs) <- prepareBinding env top_lvl is_rec is_strict
                                                       work_id (emptyFloats env) rhs

            ; work_unf <- mk_worker_unfolding top_lvl work_id work_rhs
            ; let  work_id_w_unf = CoreBndr
    work_id CoreBndr -> Unfolding -> CoreBndr
    `setIdUnfolding` Unfolding
    work_unf
                   floats   = SimplFloats
    rhs_floats SimplFloats -> LetFloats -> SimplFloats
    `addLetFloats`
                              InBind -> LetFloats
    unitLetFloat (CoreBndr -> CoreExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec CoreBndr
    work_id_w_unf CoreExpr
    work_rhs)

                   triv_rhs = CoreExpr -> CoercionR -> CoreExpr
    forall b. Expr b -> CoercionR -> Expr b
    Cast (CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    work_id_w_unf) CoercionR
    co

            ; if postInlineUnconditionally env bind_cxt old_bndr bndr triv_rhs
                 -- Almost always True, because the RHS is trivial
                 -- In that case we want to eliminate the binding fast
                 -- We conservatively use postInlineUnconditionally so that we
                 -- check all the right things
              then do { tick (PostInlineUnconditionally bndr)
                      ; return ( floats
                               , extendIdSubst (setInScopeFromF env floats) old_bndr $
                                 DoneEx triv_rhs NotJoinPoint ) }

              else do { wrap_unf <- mkLetUnfolding env top_lvl VanillaSrc bndr False triv_rhs
                      ; let bndr' = CoreBndr
    bndr CoreBndr -> InlinePragma -> CoreBndr
    `setInlinePragma` InlinePragma -> InlinePragma
    mkCastWrapperInlinePrag (CoreBndr -> InlinePragma
    idInlinePragma CoreBndr
    bndr)
                                    CoreBndr -> Unfolding -> CoreBndr
    `setIdUnfolding`  Unfolding
    wrap_unf
                            floats' = SimplFloats
    floats SimplFloats -> InBind -> SimplFloats
    `extendFloats` CoreBndr -> CoreExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec CoreBndr
    bndr' CoreExpr
    triv_rhs
                      ; return ( floats', setInScopeFromF env floats' ) } }
      where
        -- Force the occ_fs so that the old Id is not retained in the new Id.
        !occ_fs :: FastString
    occ_fs = CoreBndr -> FastString
    forall a. NamedThing a => a -> FastString
    getOccFS CoreBndr
    bndr
        work_ty :: Kind
    work_ty = HasDebugCallStack => CoercionR -> Kind
    CoercionR -> Kind
    coercionLKind CoercionR
    co
        info :: IdInfo
    info   = HasDebugCallStack => CoreBndr -> IdInfo
    CoreBndr -> IdInfo
    idInfo CoreBndr
    bndr
        work_arity :: Int
    work_arity = IdInfo -> Int
    arityInfo IdInfo
    info Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `min` Kind -> Int
    typeArity Kind
    work_ty

        work_info :: IdInfo
    work_info = IdInfo
    vanillaIdInfo IdInfo -> DmdSig -> IdInfo
    `setDmdSigInfo`     IdInfo -> DmdSig
    dmdSigInfo IdInfo
    info
                                  IdInfo -> CprSig -> IdInfo
    `setCprSigInfo`     IdInfo -> CprSig
    cprSigInfo IdInfo
    info
                                  IdInfo -> Demand -> IdInfo
    `setDemandInfo`     IdInfo -> Demand
    demandInfo IdInfo
    info
                                  IdInfo -> InlinePragma -> IdInfo
    `setInlinePragInfo` IdInfo -> InlinePragma
    inlinePragInfo IdInfo
    info
                                  IdInfo -> Int -> IdInfo
    `setArityInfo`      Int
    work_arity
               -- We do /not/ want to transfer OccInfo, Rules
               -- Note [Preserve strictness in cast w/w]
               -- and Wrinkle 2 of Note [Cast worker/wrapper]

        ----------- Worker unfolding -----------
        -- Stable case: if there is a stable unfolding we have to compose with (Sym co);
        --   the next round of simplification will do the job
        -- Non-stable case: use work_rhs
        -- Wrinkle 3 of Note [Cast worker/wrapper]
        mk_worker_unfolding :: TopLevelFlag -> CoreBndr -> CoreExpr -> SimplM Unfolding
    mk_worker_unfolding TopLevelFlag
    top_lvl CoreBndr
    work_id CoreExpr
    work_rhs
          = case IdInfo -> Unfolding
    realUnfoldingInfo IdInfo
    info of -- NB: the real one, even for loop-breakers
               unf :: Unfolding
    unf@(CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
    uf_tmpl = CoreExpr
    unf_rhs, uf_src :: Unfolding -> UnfoldingSource
    uf_src = UnfoldingSource
    src })
                 | UnfoldingSource -> Bool
    isStableSource UnfoldingSource
    src -> Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Unfolding
    unf { uf_tmpl = mkCast unf_rhs (mkSymCo co) })
               Unfolding
    _ -> SimplEnv
    -> TopLevelFlag
    -> UnfoldingSource
    -> CoreBndr
    -> Bool
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding SimplEnv
    env TopLevelFlag
    top_lvl UnfoldingSource
    VanillaSrc CoreBndr
    work_id Bool
    False CoreExpr
    work_rhs

    tryCastWorkerWrapper SimplEnv
    env BindContext
    _ CoreBndr
    _ CoreBndr
    bndr CoreExpr
    rhs  -- All other bindings
      = do { String -> SDoc -> SimplM ()
    traceSmpl String
    "tcww:no" ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "bndr:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    bndr
                                       , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "rhs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    rhs ])
            ; (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> InBind -> (SimplFloats, SimplEnv)
    mkFloatBind SimplEnv
    env (CoreBndr -> CoreExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec CoreBndr
    bndr CoreExpr
    rhs)) }

    mkCastWrapperInlinePrag :: InlinePragma -> InlinePragma
    -- See Note [Cast worker/wrapper]
    mkCastWrapperInlinePrag :: InlinePragma -> InlinePragma
    mkCastWrapperInlinePrag (InlinePragma { inl_inline :: InlinePragma -> InlineSpec
    inl_inline = InlineSpec
    fn_inl, inl_act :: InlinePragma -> Activation
    inl_act = Activation
    fn_act, inl_rule :: InlinePragma -> RuleMatchInfo
    inl_rule = RuleMatchInfo
    rule_info })
      = InlinePragma { inl_src :: SourceText
    inl_src    = FastString -> SourceText
    SourceText (FastString -> SourceText) -> FastString -> SourceText
    forall a b. (a -> b) -> a -> b
    $ String -> FastString
    fsLit String
    "{-# INLINE"
                     , inl_inline :: InlineSpec
    inl_inline = InlineSpec
    fn_inl       -- See Note [Worker/wrapper for INLINABLE functions]
                     , inl_sat :: Maybe Int
    inl_sat    = Maybe Int
    forall a. Maybe a
    Nothing      --     in GHC.Core.Opt.WorkWrap
                     , inl_act :: Activation
    inl_act    = Activation
    wrap_act     -- See Note [Wrapper activation]
                     , inl_rule :: RuleMatchInfo
    inl_rule   = RuleMatchInfo
    rule_info }  --     in GHC.Core.Opt.WorkWrap
                                    -- RuleMatchInfo is (and must be) unaffected
      where
        -- See Note [Wrapper activation] in GHC.Core.Opt.WorkWrap
        -- But simpler, because we don't need to disable during InitialPhase
        wrap_act :: Activation
    wrap_act | Activation -> Bool
    isNeverActive Activation
    fn_act = Activation
    activateDuringFinal
                 | Bool
    otherwise            = Activation
    fn_act

    {- *********************************************************************
    *                                                                      *
               prepareBinding, prepareRhs, makeTrivial
    *                                                                      *
    ********************************************************************* -}

    prepareBinding :: SimplEnv -> TopLevelFlag -> RecFlag -> Bool
                   -> Id   -- Used only for its OccName; can be InId or OutId
                   -> SimplFloats -> OutExpr
                   -> SimplM (SimplFloats, OutExpr)
    -- In (prepareBinding ... bndr floats rhs), the binding is really just
    --    bndr = let floats in rhs
    -- Maybe we can ANF-ise this binding and float out; e.g.
    --    bndr = let a = f x in K a a (g x)
    -- we could float out to give
    --    a    = f x
    --    tmp  = g x
    --    bndr = K a a tmp
    -- That's what prepareBinding does
    -- Precondition: binder is not a JoinId
    -- Postcondition: the returned SimplFloats contains only let-floats
    prepareBinding :: SimplEnv
    -> TopLevelFlag
    -> RecFlag
    -> Bool
    -> CoreBndr
    -> SimplFloats
    -> CoreExpr
    -> SimplM (SimplFloats, CoreExpr)
    prepareBinding SimplEnv
    env TopLevelFlag
    top_lvl RecFlag
    is_rec Bool
    strict_bind CoreBndr
    bndr SimplFloats
    rhs_floats CoreExpr
    rhs
      = do { -- Never float join-floats out of a non-join let-binding (which this is)
             -- So wrap the body in the join-floats right now
             -- Hence: rhs_floats1 consists only of let-floats
             let (SimplFloats
    rhs_floats1, CoreExpr
    rhs1) = SimplFloats -> CoreExpr -> (SimplFloats, CoreExpr)
    wrapJoinFloatsX SimplFloats
    rhs_floats CoreExpr
    rhs

             -- rhs_env: add to in-scope set the binders from rhs_floats
             -- so that prepareRhs knows what is in scope in rhs
           ; let rhs_env :: SimplEnv
    rhs_env = SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    rhs_floats1
                 -- Force the occ_fs so that the old Id is not retained in the new Id.
                 !occ_fs :: FastString
    occ_fs = CoreBndr -> FastString
    forall a. NamedThing a => a -> FastString
    getOccFS CoreBndr
    bndr

           -- Now ANF-ise the remaining rhs
           ; (anf_floats, rhs2) <- HasDebugCallStack =>
    SimplEnv
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    SimplEnv
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    prepareRhs SimplEnv
    rhs_env TopLevelFlag
    top_lvl FastString
    occ_fs CoreExpr
    rhs1

           -- Finally, decide whether or not to float
           ; let all_floats = SimplFloats
    rhs_floats1 SimplFloats -> LetFloats -> SimplFloats
    `addLetFloats` LetFloats
    anf_floats
           ; if doFloatFromRhs (seFloatEnable env) top_lvl is_rec strict_bind all_floats rhs2
             then -- Float!
                  do { tick LetFloatFromLet
                     ; return (all_floats, rhs2) }

             else -- Abandon floating altogether; revert to original rhs
                  -- Since we have already built rhs1, we just need to add
                  -- rhs_floats1 to it
                  return (emptyFloats env, wrapFloats rhs_floats1 rhs1) }

    {- Note [prepareRhs]
    ~~~~~~~~~~~~~~~~~~~~
    prepareRhs takes a putative RHS, checks whether it's a PAP or
    constructor application and, if so, converts it to ANF, so that the
    resulting thing can be inlined more easily.  Thus
            x = (f a, g b)
    becomes
            t1 = f a
            t2 = g b
            x = (t1,t2)

    We also want to deal well cases like this
            v = (f e1 `cast` co) e2
    Here we want to make e1,e2 trivial and get
            x1 = e1; x2 = e2; v = (f x1 `cast` co) v2
    That's what the 'go' loop in prepareRhs does
    -}

    prepareRhs :: HasDebugCallStack
               => SimplEnv -> TopLevelFlag
               -> FastString    -- Base for any new variables
               -> OutExpr
               -> SimplM (LetFloats, OutExpr)
    -- Transforms a RHS into a better RHS by ANF'ing args
    -- for expandable RHSs: constructors and PAPs
    -- e.g        x = Just e
    -- becomes    a = e               -- 'a' is fresh
    --            x = Just a
    -- See Note [prepareRhs]
    prepareRhs :: HasDebugCallStack =>
    SimplEnv
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    prepareRhs SimplEnv
    env TopLevelFlag
    top_lvl FastString
    occ CoreExpr
    rhs0
      | Bool
    is_expandable = CoreExpr -> SimplM (LetFloats, CoreExpr)
    anfise CoreExpr
    rhs0
      | Bool
    otherwise     = (LetFloats, CoreExpr) -> SimplM (LetFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    emptyLetFloats, CoreExpr
    rhs0)
      where
        -- We can't use exprIsExpandable because the WHOLE POINT is that
        -- we want to treat (K <big>) as expandable, because we are just
        -- about "anfise" the <big> expression.  exprIsExpandable would
        -- just say no!
        is_expandable :: Bool
    is_expandable = CoreExpr -> Int -> Bool
    forall {b}. Expr b -> Int -> Bool
    go CoreExpr
    rhs0 Int
    0
           where
             go :: Expr b -> Int -> Bool
    go (Var CoreBndr
    fun) Int
    n_val_args       = CheapAppFun
    isExpandableApp CoreBndr
    fun Int
    n_val_args
             go (App Expr b
    fun Expr b
    arg) Int
    n_val_args
               | Expr b -> Bool
    forall {b}. Expr b -> Bool
    isTypeArg Expr b
    arg             = Expr b -> Int -> Bool
    go Expr b
    fun Int
    n_val_args
               | Bool
    otherwise                 = Expr b -> Int -> Bool
    go Expr b
    fun (Int
    n_val_args Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
             go (Cast Expr b
    rhs CoercionR
    _)  Int
    n_val_args   = Expr b -> Int -> Bool
    go Expr b
    rhs Int
    n_val_args
             go (Tick CoreTickish
    _ Expr b
    rhs)  Int
    n_val_args   = Expr b -> Int -> Bool
    go Expr b
    rhs Int
    n_val_args
             go Expr b
    _             Int
    _            = Bool
    False

        anfise :: OutExpr -> SimplM (LetFloats, OutExpr)
        anfise :: CoreExpr -> SimplM (LetFloats, CoreExpr)
    anfise (Cast CoreExpr
    rhs CoercionR
    co)
            = do { (floats, rhs') <- CoreExpr -> SimplM (LetFloats, CoreExpr)
    anfise CoreExpr
    rhs
                 ; return (floats, Cast rhs' co) }
        anfise (App CoreExpr
    fun (Type Kind
    ty))
            = do { (floats, rhs') <- CoreExpr -> SimplM (LetFloats, CoreExpr)
    anfise CoreExpr
    fun
                 ; return (floats, App rhs' (Type ty)) }
        anfise (App CoreExpr
    fun CoreExpr
    arg)
            = do { (floats1, fun') <- CoreExpr -> SimplM (LetFloats, CoreExpr)
    anfise CoreExpr
    fun
                 ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg
                 ; return (floats1 `addLetFlts` floats2, App fun' arg') }
        anfise (Var CoreBndr
    fun)
            = (LetFloats, CoreExpr) -> SimplM (LetFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    emptyLetFloats, CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    fun)

        anfise (Tick CoreTickish
    t CoreExpr
    rhs)
            -- We want to be able to float bindings past this
            -- tick. Non-scoping ticks don't care.
            | CoreTickish -> TickishScoping
    forall (pass :: TickishPass). GenTickish pass -> TickishScoping
    tickishScoped CoreTickish
    t TickishScoping -> TickishScoping -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickishScoping
    NoScope
            = do { (floats, rhs') <- CoreExpr -> SimplM (LetFloats, CoreExpr)
    anfise CoreExpr
    rhs
                 ; return (floats, Tick t rhs') }

            -- On the other hand, for scoping ticks we need to be able to
            -- copy them on the floats, which in turn is only allowed if
            -- we can obtain non-counting ticks.
            | (Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    t) Bool -> Bool -> Bool
    || CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCanSplit CoreTickish
    t)
            = do { (floats, rhs') <- CoreExpr -> SimplM (LetFloats, CoreExpr)
    anfise CoreExpr
    rhs
                 ; let tickIt (CoreBndr
    id, CoreExpr
    expr) = (CoreBndr
    id, CoreTickish -> CoreExpr -> CoreExpr
    mkTick (CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoCount CoreTickish
    t) CoreExpr
    expr)
                       floats' = LetFloats
    -> ((CoreBndr, CoreExpr) -> (CoreBndr, CoreExpr)) -> LetFloats
    mapLetFloats LetFloats
    floats (CoreBndr, CoreExpr) -> (CoreBndr, CoreExpr)
    tickIt
                 ; return (floats', Tick t rhs') }

        anfise CoreExpr
    other = (LetFloats, CoreExpr) -> SimplM (LetFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    emptyLetFloats, CoreExpr
    other)

    makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec)
    makeTrivialArg :: HasDebugCallStack =>
    SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec)
    makeTrivialArg SimplEnv
    env arg :: ArgSpec
    arg@(ValArg { as_arg :: ArgSpec -> CoreExpr
    as_arg = CoreExpr
    e, as_dmd :: ArgSpec -> Demand
    as_dmd = Demand
    dmd })
      = do { (floats, e') <- HasDebugCallStack =>
    SimplEnv
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    SimplEnv
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    makeTrivial SimplEnv
    env TopLevelFlag
    NotTopLevel Demand
    dmd (String -> FastString
    fsLit String
    "arg") CoreExpr
    e
           ; return (floats, arg { as_arg = e' }) }
    makeTrivialArg SimplEnv
    _ ArgSpec
    arg
      = (LetFloats, ArgSpec) -> SimplM (LetFloats, ArgSpec)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    emptyLetFloats, ArgSpec
    arg)  -- CastBy, TyArg

    makeTrivial :: HasDebugCallStack
                => SimplEnv -> TopLevelFlag -> Demand
                -> FastString  -- ^ A "friendly name" to build the new binder from
                -> OutExpr
                -> SimplM (LetFloats, OutExpr)
    -- Binds the expression to a variable, if it's not trivial, returning the variable
    -- For the Demand argument, see Note [Keeping demand info in StrictArg Plan A]
    makeTrivial :: HasDebugCallStack =>
    SimplEnv
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    makeTrivial SimplEnv
    env TopLevelFlag
    top_lvl Demand
    dmd FastString
    occ_fs CoreExpr
    expr
      | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    expr                          -- Already trivial
      Bool -> Bool -> Bool
    || Bool -> Bool
    not (TopLevelFlag -> CoreExpr -> Kind -> Bool
    bindingOk TopLevelFlag
    top_lvl CoreExpr
    expr Kind
    expr_ty)       -- Cannot trivialise
                                                    --   See Note [Cannot trivialise]
      = (LetFloats, CoreExpr) -> SimplM (LetFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    emptyLetFloats, CoreExpr
    expr)

      | Cast CoreExpr
    expr' CoercionR
    co <- CoreExpr
    expr
      = do { (floats, triv_expr) <- HasDebugCallStack =>
    SimplEnv
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    SimplEnv
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    makeTrivial SimplEnv
    env TopLevelFlag
    top_lvl Demand
    dmd FastString
    occ_fs CoreExpr
    expr'
           ; return (floats, Cast triv_expr co) }

      | Bool
    otherwise -- 'expr' is not of form (Cast e co)
      = do  { (floats, expr1) <- HasDebugCallStack =>
    SimplEnv
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    SimplEnv
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    prepareRhs SimplEnv
    env TopLevelFlag
    top_lvl FastString
    occ_fs CoreExpr
    expr
            ; uniq <- getUniqueM
            ; let name = Unique -> FastString -> Name
    mkSystemVarName Unique
    uniq FastString
    occ_fs
                  var  = HasDebugCallStack => Name -> Kind -> Kind -> IdInfo -> CoreBndr
    Name -> Kind -> Kind -> IdInfo -> CoreBndr
    mkLocalIdWithInfo Name
    name Kind
    ManyTy Kind
    expr_ty IdInfo
    id_info

            -- Now something very like completeBind,
            -- but without the postInlineUnconditionally part
            ; (arity_type, expr2) <- tryEtaExpandRhs env (BC_Let top_lvl NonRecursive) var expr1
              -- Technically we should extend the in-scope set in 'env' with
              -- the 'floats' from prepareRHS; but they are all fresh, so there is
              -- no danger of introducing name shadowing in eta expansion

            ; unf <- mkLetUnfolding env top_lvl VanillaSrc var False expr2

            ; let final_id = CoreBndr -> ArityType -> Unfolding -> CoreBndr
    addLetBndrInfo CoreBndr
    var ArityType
    arity_type Unfolding
    unf
                  bind     = CoreBndr -> CoreExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec CoreBndr
    final_id CoreExpr
    expr2

            ; traceSmpl "makeTrivial" (vcat [text "final_id" <+> ppr final_id, text "rhs" <+> ppr expr2 ])
            ; return ( floats `addLetFlts` unitLetFloat bind, Var final_id ) }
      where
        id_info :: IdInfo
    id_info = IdInfo
    vanillaIdInfo IdInfo -> Demand -> IdInfo
    `setDemandInfo` Demand
    dmd
        expr_ty :: Kind
    expr_ty = HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    expr

    bindingOk :: TopLevelFlag -> CoreExpr -> Type -> Bool
    -- True iff we can have a binding of this expression at this level
    -- Precondition: the type is the type of the expression
    bindingOk :: TopLevelFlag -> CoreExpr -> Kind -> Bool
    bindingOk TopLevelFlag
    top_lvl CoreExpr
    expr Kind
    expr_ty
      | TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_lvl = CoreExpr -> Kind -> Bool
    exprIsTopLevelBindable CoreExpr
    expr Kind
    expr_ty
      | Bool
    otherwise          = Bool
    True

    {- Note [Cannot trivialise]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider:
       f :: Int -> Addr#

       foo :: Bar
       foo = Bar (f 3)

    Then we can't ANF-ise foo, even though we'd like to, because
    we can't make a top-level binding for the Addr# (f 3). And if
    so we don't want to turn it into
       foo = let x = f 3 in Bar x
    because we'll just end up inlining x back, and that makes the
    simplifier loop.  Better not to ANF-ise it at all.

    Literal strings are an exception.

       foo = Ptr "blob"#

    We want to turn this into:

       foo1 = "blob"#
       foo = Ptr foo1

    See Note [Core top-level string literals] in GHC.Core.

    ************************************************************************
    *                                                                      *
              Completing a lazy binding
    *                                                                      *
    ************************************************************************

    completeBind
      * deals only with Ids, not TyVars
      * takes an already-simplified binder and RHS
      * is used for both recursive and non-recursive bindings
      * is used for both top-level and non-top-level bindings

    It does the following:
      - tries discarding a dead binding
      - tries PostInlineUnconditionally
      - add unfolding [this is the only place we add an unfolding]
      - add arity
      - extend the InScopeSet of the SimplEnv

    It does *not* attempt to do let-to-case.  Why?  Because it is used for
      - top-level bindings (when let-to-case is impossible)
      - many situations where the "rhs" is known to be a WHNF
                    (so let-to-case is inappropriate).

    Nor does it do the atomic-argument thing
    -}

    completeBind :: BindContext
                 -> (InId, SimplEnv)           -- Old binder, and the static envt in which to simplify
                                               --   its stable unfolding (if any)
                 -> (OutId, OutExpr, SimplEnv) -- New binder and rhs; can be a JoinId.
                                               -- And the SimplEnv with that OutId in scope.
                 -> SimplM (SimplFloats, SimplEnv)
    -- completeBind may choose to do its work
    --      * by extending the substitution (e.g. let x = y in ...)
    --      * or by adding to the floats in the envt
    --
    -- Binder /can/ be a JoinId
    -- Precondition: rhs obeys the let-can-float invariant
    completeBind :: BindContext
    -> (CoreBndr, SimplEnv)
    -> (CoreBndr, CoreExpr, SimplEnv)
    -> SimplM (SimplFloats, SimplEnv)
    completeBind BindContext
    bind_cxt (CoreBndr
    old_bndr, SimplEnv
    unf_se) (CoreBndr
    new_bndr, CoreExpr
    new_rhs, SimplEnv
    env)
     | CoreBndr -> Bool
    isCoVar CoreBndr
    old_bndr
     = case CoreExpr
    new_rhs of
         Coercion CoercionR
    co -> (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv -> CoreBndr -> CoercionR -> SimplEnv
    extendCvSubst SimplEnv
    env CoreBndr
    old_bndr CoercionR
    co)
         CoreExpr
    _           -> (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> InBind -> (SimplFloats, SimplEnv)
    mkFloatBind SimplEnv
    env (CoreBndr -> CoreExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec CoreBndr
    new_bndr CoreExpr
    new_rhs))

     | Bool
    otherwise
     = Bool
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isId CoreBndr
    new_bndr) (SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv))
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a b. (a -> b) -> a -> b
    $
       do { let old_info :: IdInfo
    old_info = HasDebugCallStack => CoreBndr -> IdInfo
    CoreBndr -> IdInfo
    idInfo CoreBndr
    old_bndr
                old_unf :: Unfolding
    old_unf  = IdInfo -> Unfolding
    realUnfoldingInfo IdInfo
    old_info

             -- Do eta-expansion on the RHS of the binding
             -- See Note [Eta-expanding at let bindings] in GHC.Core.Opt.Simplify.Utils
          ; (new_arity, eta_rhs) <- SimplEnv
    -> BindContext
    -> CoreBndr
    -> CoreExpr
    -> SimplM (ArityType, CoreExpr)
    tryEtaExpandRhs SimplEnv
    env BindContext
    bind_cxt CoreBndr
    new_bndr CoreExpr
    new_rhs

            -- Simplify the unfolding; see Note [Environment for simplLetUnfolding]
          ; new_unfolding <- simplLetUnfolding (unf_se `setInScopeFromE` env)
                                bind_cxt old_bndr
                                eta_rhs (idType new_bndr) new_arity old_unf

          ; let new_bndr_w_info = CoreBndr -> ArityType -> Unfolding -> CoreBndr
    addLetBndrInfo CoreBndr
    new_bndr ArityType
    new_arity Unfolding
    new_unfolding
            -- See Note [In-scope set as a substitution]

          ; if postInlineUnconditionally env bind_cxt old_bndr new_bndr_w_info eta_rhs

            then -- Inline and discard the binding
                 do  { tick (PostInlineUnconditionally old_bndr)
                     ; let unf_rhs = Unfolding -> Maybe CoreExpr
    maybeUnfoldingTemplate Unfolding
    new_unfolding Maybe CoreExpr -> CoreExpr -> CoreExpr
    forall a. Maybe a -> a -> a
    `orElse` CoreExpr
    eta_rhs
                              -- See Note [Use occ-anald RHS in postInlineUnconditionally]
                     ; simplTrace "PostInlineUnconditionally" (ppr new_bndr <+> ppr unf_rhs) $
                       return ( emptyFloats env
                              , extendIdSubst env old_bndr $
                                DoneEx unf_rhs (idJoinPointHood new_bndr)) }
                    -- Use the substitution to make quite, quite sure that the
                    -- substitution will happen, since we are going to discard the binding

            else -- Keep the binding; do cast worker/wrapper
    --             simplTrace "completeBind" (vcat [ text "bndrs" <+> ppr old_bndr <+> ppr new_bndr
    --                                             , text "eta_rhs" <+> ppr eta_rhs ]) $
                 tryCastWorkerWrapper env bind_cxt old_bndr new_bndr_w_info eta_rhs }

    addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId
    addLetBndrInfo :: CoreBndr -> ArityType -> Unfolding -> CoreBndr
    addLetBndrInfo CoreBndr
    new_bndr ArityType
    new_arity_type Unfolding
    new_unf
      = CoreBndr
    new_bndr CoreBndr -> IdInfo -> CoreBndr
    `setIdInfo` IdInfo
    info5
      where
        new_arity :: Int
    new_arity = ArityType -> Int
    arityTypeArity ArityType
    new_arity_type
        info1 :: IdInfo
    info1 = HasDebugCallStack => CoreBndr -> IdInfo
    CoreBndr -> IdInfo
    idInfo CoreBndr
    new_bndr IdInfo -> Int -> IdInfo
    `setArityInfo` Int
    new_arity

        -- Unfolding info: Note [Setting the new unfolding]
        info2 :: IdInfo
    info2 = IdInfo
    info1 IdInfo -> Unfolding -> IdInfo
    `setUnfoldingInfo` Unfolding
    new_unf

        -- Demand info: Note [Setting the demand info]
        info3 :: IdInfo
    info3 | Unfolding -> Bool
    isEvaldUnfolding Unfolding
    new_unf
              = IdInfo -> Maybe IdInfo
    lazifyDemandInfo IdInfo
    info2 Maybe IdInfo -> IdInfo -> IdInfo
    forall a. Maybe a -> a -> a
    `orElse` IdInfo
    info2
              | Bool
    otherwise
              = IdInfo
    info2

        -- Bottoming bindings: see Note [Bottoming bindings]
        info4 :: IdInfo
    info4 = case ArityType -> Maybe (Int, DmdSig, CprSig)
    arityTypeBotSigs_maybe ArityType
    new_arity_type of
            Maybe (Int, DmdSig, CprSig)
    Nothing -> IdInfo
    info3
            Just (Int
    ar, DmdSig
    str_sig, CprSig
    cpr_sig) -> Bool -> IdInfo -> IdInfo
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    ar Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    new_arity) (IdInfo -> IdInfo) -> IdInfo -> IdInfo
    forall a b. (a -> b) -> a -> b
    $
                                           IdInfo
    info3 IdInfo -> DmdSig -> IdInfo
    `setDmdSigInfo` DmdSig
    str_sig
                                                 IdInfo -> CprSig -> IdInfo
    `setCprSigInfo` CprSig
    cpr_sig

         -- Zap call arity info. We have used it by now (via
         -- `tryEtaExpandRhs`), and the simplifier can invalidate this
         -- information, leading to broken code later (e.g. #13479)
        info5 :: IdInfo
    info5 = IdInfo -> IdInfo
    zapCallArityInfo IdInfo
    info4

    {- Note [Bottoming bindings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have
       let x = error "urk"
       in ...(case x of <alts>)...
    or
       let f = \y. error (y ++ "urk")
       in ...(case f "foo" of <alts>)...

    Then we'd like to drop the dead <alts> immediately.  So it's good to
    propagate the info that x's (or f's) RHS is bottom to x's (or f's)
    IdInfo as rapidly as possible.

    We use tryEtaExpandRhs on every binding, and it turns out that the
    arity computation it performs (via GHC.Core.Opt.Arity.findRhsArity) already
    does a simple bottoming-expression analysis.  So all we need to do
    is propagate that info to the binder's IdInfo.

    This showed up in #12150; see comment:16.

    There is a second reason for settting  the strictness signature. Consider
       let -- f :: <[S]b>
           f = \x. error "urk"
       in ...(f a b c)...
    Then, in GHC.Core.Opt.Arity.findRhsArity we'll use the demand-info on `f`
    to eta-expand to
       let f = \x y z. error "urk"
       in ...(f a b c)...

    But now f's strictness signature has too short an arity; see
    GHC.Core.Opt.DmdAnal Note [idArity varies independently of dmdTypeDepth].
    Fortuitously, the same strictness-signature-fixup code
    gives the function a new strictness signature with the right number of
    arguments.  Example in stranal/should_compile/EtaExpansion.

    Note [Setting the demand info]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If the unfolding is a value, the demand info may
    go pear-shaped, so we nuke it.  Example:
         let x = (a,b) in
         case x of (p,q) -> h p q x
    Here x is certainly demanded. But after we've nuked
    the case, we'll get just
         let x = (a,b) in h a b x
    and now x is not demanded (I'm assuming h is lazy)
    This really happens.  Similarly
         let f = \x -> e in ...f..f...
    After inlining f at some of its call sites the original binding may
    (for example) be no longer strictly demanded.
    The solution here is a bit ad hoc...

    Note [Use occ-anald RHS in postInlineUnconditionally]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we postInlineUnconditionally 'f in
      let f = \x -> x True in ...(f blah)...
    then we'd like to inline the /occ-anald/ RHS for 'f'.  If we
    use the non-occ-anald version, we'll end up with a
        ...(let x = blah in x True)...
    and hence an extra Simplifier iteration.

    We already /have/ the occ-anald version in the Unfolding for
    the Id.  Well, maybe not /quite/ always.  If the binder is Dead,
    postInlineUnconditionally will return True, but we may not have an
    unfolding because it's too big. Hence the belt-and-braces `orElse`
    in the defn of unf_rhs.  The Nothing case probably never happens.

    Note [Environment for simplLetUnfolding]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We need to be rather careful about the static environment in which
    we simplify a stable unfolding.  Consider (#24242):

      f x = let y_Xb = ... in
            let step1_Xb {Stable unfolding = ....y_Xb...} = rhs in
             ...

    Note that `y_Xb` and `step1_Xb` have the same unique (`Xb`). This can happen;
    see Note [Shadowing in Core] in GHC.Core, and Note [Shadowing in the Simplifier].
    This is perfectly fine. The `y_Xb` in the stable unfolding of the non-
    recursive binding for `step1` refers, of course, to `let y_Xb = ....`.
    When simplifying the binder `step1_Xb` we'll give it a new unique, and
    extend the static environment with [Xb :-> step1_Xc], say.

    But when simplifying step1's stable unfolding, we must use static environment
    /before/ simplifying the binder `step1_Xb`; that is, a static envt that maps
    [Xb :-> y_Xb], /not/ [Xb :-> step1_Xc].

    That is why we pass around a pair `(InId, SimplEnv)` for the binder, keeping
    track of the right environment for the unfolding of that InId.  See the type
    of `simplLazyBind`, `simplJoinBind`, `completeBind`.

    This only matters when we have
      - A non-recursive binding for f
      - has a stable unfolding
      - and that unfolding mentions a variable y
      - that has the same unique as f.
    So triggering  a bug here is really hard!

    ************************************************************************
    *                                                                      *
    \subsection[Simplify-simplExpr]{The main function: simplExpr}
    *                                                                      *
    ************************************************************************

    The reason for this OutExprStuff stuff is that we want to float *after*
    simplifying a RHS, not before.  If we do so naively we get quadratic
    behaviour as things float out.

    To see why it's important to do it after, consider this (real) example:

            let t = f x
            in fst t
    ==>
            let t = let a = e1
                        b = e2
                    in (a,b)
            in fst t
    ==>
            let a = e1
                b = e2
                t = (a,b)
            in
            a       -- Can't inline a this round, cos it appears twice
    ==>
            e1

    Each of the ==> steps is a round of simplification.  We'd save a
    whole round if we float first.  This can cascade.  Consider

            let f = g d
            in \x -> ...f...
    ==>
            let f = let d1 = ..d.. in \y -> e
            in \x -> ...f...
    ==>
            let d1 = ..d..
            in \x -> ...(\y ->e)...

    Only in this second round can the \y be applied, and it
    might do the same again.
    -}

    simplExpr :: SimplEnv -> CoreExpr -> SimplM CoreExpr
    simplExpr :: SimplEnv -> CoreExpr -> SimplM CoreExpr
    simplExpr !SimplEnv
    env (Type Kind
    ty) -- See Note [Bangs in the Simplifier]
      = do { ty' <- SimplEnv -> Kind -> SimplM Kind
    simplType SimplEnv
    env Kind
    ty  -- See Note [Avoiding space leaks in OutType]
           ; return (Type ty') }

    simplExpr SimplEnv
    env CoreExpr
    expr
      = SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env CoreExpr
    expr (Kind -> SimplCont
    mkBoringStop Kind
    expr_out_ty)
      where
        expr_out_ty :: OutType
        expr_out_ty :: Kind
    expr_out_ty = HasDebugCallStack => SimplEnv -> Kind -> Kind
    SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    expr)
        -- NB: Since 'expr' is term-valued, not (Type ty), this call
        --     to exprType will succeed.  exprType fails on (Type ty).

    simplExprC :: SimplEnv
               -> InExpr     -- A term-valued expression, never (Type ty)
               -> SimplCont
               -> SimplM OutExpr
            -- Simplify an expression, given a continuation
    simplExprC :: SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env CoreExpr
    expr SimplCont
    cont
      = -- pprTrace "simplExprC" (ppr expr $$ ppr cont) $
        do  { (floats, expr') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    expr SimplCont
    cont
            ; -- pprTrace "simplExprC ret" (ppr expr $$ ppr expr') $
              -- pprTrace "simplExprC ret3" (ppr (seInScope env')) $
              -- pprTrace "simplExprC ret4" (ppr (seLetFloats env')) $
              return (wrapFloats floats expr') }

    --------------------------------------------------
    simplExprF :: SimplEnv
               -> InExpr     -- A term-valued expression, never (Type ty)
               -> SimplCont
               -> SimplM (SimplFloats, OutExpr)

    simplExprF :: SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF !SimplEnv
    env CoreExpr
    e !SimplCont
    cont -- See Note [Bangs in the Simplifier]
      = {- pprTrace "simplExprF" (vcat
          [ ppr e
          , text "cont =" <+> ppr cont
          , text "inscope =" <+> ppr (seInScope env)
          , text "tvsubst =" <+> ppr (seTvSubst env)
          , text "idsubst =" <+> ppr (seIdSubst env)
          , text "cvsubst =" <+> ppr (seCvSubst env)
          ]) $ -}
        HasDebugCallStack =>
    SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF1 SimplEnv
    env CoreExpr
    e SimplCont
    cont

    simplExprF1 :: HasDebugCallStack
                => SimplEnv -> InExpr -> SimplCont
                -> SimplM (SimplFloats, OutExpr)

    simplExprF1 :: HasDebugCallStack =>
    SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF1 SimplEnv
    _ (Type Kind
    ty) SimplCont
    cont
      = String -> SDoc -> SimplM (SimplFloats, CoreExpr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "simplExprF: type" (Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    ty SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    textString
    "cont: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SimplCont -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SimplCont
    cont)
        -- simplExprF does only with term-valued expressions
        -- The (Type ty) case is handled separately by simplExpr
        -- and by the other callers of simplExprF

    simplExprF1 SimplEnv
    env (Var CoreBndr
    v)        SimplCont
    cont = {-#SCC "simplIdF" #-} SimplEnv -> CoreBndr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplIdF SimplEnv
    env CoreBndr
    v SimplCont
    cont
    simplExprF1 SimplEnv
    env (Lit Literal
    lit)      SimplCont
    cont = {-#SCC "rebuild" #-} SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit Literal
    lit) SimplCont
    cont
    simplExprF1 SimplEnv
    env (Tick CoreTickish
    t CoreExpr
    expr)  SimplCont
    cont = {-#SCC "simplTick" #-} SimplEnv
    -> CoreTickish
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplTick SimplEnv
    env CoreTickish
    t CoreExpr
    expr SimplCont
    cont
    simplExprF1 SimplEnv
    env (Cast CoreExpr
    body CoercionR
    co) SimplCont
    cont = {-#SCC "simplCast" #-} SimplEnv
    -> CoreExpr
    -> CoercionR
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplCast SimplEnv
    env CoreExpr
    body CoercionR
    co SimplCont
    cont
    simplExprF1 SimplEnv
    env (Coercion CoercionR
    co)  SimplCont
    cont = {-#SCC "simplCoercionF" #-} SimplEnv
    -> CoercionR -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplCoercionF SimplEnv
    env CoercionR
    co SimplCont
    cont

    simplExprF1 SimplEnv
    env (App CoreExpr
    fun CoreExpr
    arg) SimplCont
    cont
      = {-#SCC "simplExprF1-App" #-} case CoreExpr
    arg of
          Type Kind
    ty -> do { -- The argument type will (almost) certainly be used
                          -- in the output program, so just force it now.
                          -- See Note [Avoiding space leaks in OutType]
                          arg' <- SimplEnv -> Kind -> SimplM Kind
    simplType SimplEnv
    env Kind
    ty

                          -- But use substTy, not simplType, to avoid forcing
                          -- the hole type; it will likely not be needed.
                          -- See Note [The hole type in ApplyToTy]
                        ; let hole' = HasDebugCallStack => SimplEnv -> Kind -> Kind
    SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    fun)

                        ; simplExprF env fun $
                          ApplyToTy { sc_arg_ty  = arg'
                                    , sc_hole_ty = hole'
                                    , sc_cont    = cont } }
          CoreExpr
    _       ->
              -- Crucially, sc_hole_ty is a /lazy/ binding.  It will
              -- be forced only if we need to run contHoleType.
              -- When these are forced, we might get quadratic behavior;
              -- this quadratic blowup could be avoided by drilling down
              -- to the function and getting its multiplicities all at once
              -- (instead of one-at-a-time). But in practice, we have not
              -- observed the quadratic behavior, so this extra entanglement
              -- seems not worthwhile.
            SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    fun (SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
            ApplyToVal { sc_arg :: CoreExpr
    sc_arg = CoreExpr
    arg, sc_env :: SimplEnv
    sc_env = SimplEnv
    env
                       , sc_hole_ty :: Kind
    sc_hole_ty = HasDebugCallStack => SimplEnv -> Kind -> Kind
    SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    fun)
                       , sc_dup :: DupFlag
    sc_dup = DupFlag
    NoDup, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont }

    simplExprF1 SimplEnv
    env expr :: CoreExpr
    expr@(Lam {}) SimplCont
    cont
      = {-#SCC "simplExprF1-Lam" #-}
        SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env (CoreExpr -> Int -> CoreExpr
    zapLambdaBndrs CoreExpr
    expr Int
    n_args) SimplCont
    cont
            -- zapLambdaBndrs: the issue here is under-saturated lambdas
            --   (\x1. \x2. e) arg1
            -- Here x1 might have "occurs-once" occ-info, because occ-info
            -- is computed assuming that a group of lambdas is applied
            -- all at once.  If there are too few args, we must zap the
            -- occ-info, UNLESS the remaining binders are one-shot
      where
        n_args :: Int
    n_args = SimplCont -> Int
    countArgs SimplCont
    cont
            -- NB: countArgs counts all the args (incl type args)
            -- and likewise drop counts all binders (incl type lambdas)

    simplExprF1 SimplEnv
    env (Case CoreExpr
    scrut CoreBndr
    bndr Kind
    _ [Alt CoreBndr]
    alts) SimplCont
    cont
      = {-#SCC "simplExprF1-Case" #-}
        SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    scrut (Select { sc_dup :: DupFlag
    sc_dup = DupFlag
    NoDup, sc_bndr :: CoreBndr
    sc_bndr = CoreBndr
    bndr
                                     , sc_alts :: [Alt CoreBndr]
    sc_alts = [Alt CoreBndr]
    alts
                                     , sc_env :: SimplEnv
    sc_env = SimplEnv
    env, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont })

    simplExprF1 SimplEnv
    env (Let (Rec [(CoreBndr, CoreExpr)]
    pairs) CoreExpr
    body) SimplCont
    cont
      | Just [(CoreBndr, CoreExpr)]
    pairs' <- [(CoreBndr, CoreExpr)] -> Maybe [(CoreBndr, CoreExpr)]
    joinPointBindings_maybe [(CoreBndr, CoreExpr)]
    pairs
      = {-#SCC "simplRecJoinPoin" #-} SimplEnv
    -> [(CoreBndr, CoreExpr)]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplRecJoinPoint SimplEnv
    env [(CoreBndr, CoreExpr)]
    pairs' CoreExpr
    body SimplCont
    cont

      | Bool
    otherwise
      = {-#SCC "simplRecE" #-} SimplEnv
    -> [(CoreBndr, CoreExpr)]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplRecE SimplEnv
    env [(CoreBndr, CoreExpr)]
    pairs CoreExpr
    body SimplCont
    cont

    simplExprF1 SimplEnv
    env (Let (NonRec CoreBndr
    bndr CoreExpr
    rhs) CoreExpr
    body) SimplCont
    cont
      | Type Kind
    ty <- CoreExpr
    rhs    -- First deal with type lets (let a = Type ty in e)
      = {-#SCC "simplExprF1-NonRecLet-Type" #-}
        Bool
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isTyVar CoreBndr
    bndr) (SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
        do { ty' <- SimplEnv -> Kind -> SimplM Kind
    simplType SimplEnv
    env Kind
    ty
           ; simplExprF (extendTvSubst env bndr ty') body cont }

      | Just SimplEnv
    env' <- SimplEnv
    -> TopLevelFlag
    -> CoreBndr
    -> CoreExpr
    -> SimplEnv
    -> Maybe SimplEnv
    preInlineUnconditionally SimplEnv
    env TopLevelFlag
    NotTopLevel CoreBndr
    bndr CoreExpr
    rhs SimplEnv
    env
        -- Because of the let-can-float invariant, it's ok to
        -- inline freely, or to drop the binding if it is dead.
      = do { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    PreInlineUnconditionally CoreBndr
    bndr)
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    body SimplCont
    cont }

      -- Now check for a join point.  It's better to do the preInlineUnconditionally
      -- test first, because joinPointBinding_maybe has to eta-expand, so a trivial
      -- binding like { j = j2 |> co } would first be eta-expanded and then inlined
      -- Better to test preInlineUnconditionally first.
      | Just (CoreBndr
    bndr', CoreExpr
    rhs') <- CoreBndr -> CoreExpr -> Maybe (CoreBndr, CoreExpr)
    joinPointBinding_maybe CoreBndr
    bndr CoreExpr
    rhs
      = {-#SCC "simplNonRecJoinPoint" #-}
        SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecJoinPoint SimplEnv
    env CoreBndr
    bndr' CoreExpr
    rhs' CoreExpr
    body SimplCont
    cont

      | Bool
    otherwise
      = {-#SCC "simplNonRecE" #-}
        HasDebugCallStack =>
    SimplEnv
    -> FromWhat
    -> CoreBndr
    -> (CoreExpr, SimplEnv)
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    SimplEnv
    -> FromWhat
    -> CoreBndr
    -> (CoreExpr, SimplEnv)
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecE SimplEnv
    env FromWhat
    FromLet CoreBndr
    bndr (CoreExpr
    rhs, SimplEnv
    env) CoreExpr
    body SimplCont
    cont

    {- Note [Avoiding space leaks in OutType]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Since the simplifier is run for multiple iterations, we need to ensure
    that any thunks in the output of one simplifier iteration are forced
    by the evaluation of the next simplifier iteration. Otherwise we may
    retain multiple copies of the Core program and leak a terrible amount
    of memory (as in #13426).

    The simplifier is naturally strict in the entire "Expr part" of the
    input Core program, because any expression may contain binders, which
    we must find in order to extend the SimplEnv accordingly. But types
    do not contain binders and so it is tempting to write things like

        simplExpr env (Type ty) = return (Type (substTy env ty))   -- Bad!

    This is Bad because the result includes a thunk (substTy env ty) which
    retains a reference to the whole simplifier environment; and the next
    simplifier iteration will not force this thunk either, because the
    line above is not strict in ty.

    So instead our strategy is for the simplifier to fully evaluate
    OutTypes when it emits them into the output Core program, for example

        simplExpr env (Type ty) = do { ty' <- simplType env ty     -- Good
                                     ; return (Type ty') }

    where the only difference from above is that simplType calls seqType
    on the result of substTy.

    However, SimplCont can also contain OutTypes and it's not necessarily
    a good idea to force types on the way in to SimplCont, because they
    may end up not being used and forcing them could be a lot of wasted
    work. T5631 is a good example of this.

    - For ApplyToTy's sc_arg_ty, we force the type on the way in because
      the type will almost certainly appear as a type argument in the
      output program.

    - For the hole types in Stop and ApplyToTy, we force the type when we
      emit it into the output program, after obtaining it from
      contResultType. (The hole type in ApplyToTy is only directly used
      to form the result type in a new Stop continuation.)
    -}

    ---------------------------------
    -- Simplify a join point, adding the context.
    -- Context goes *inside* the lambdas. IOW, if the join point has arity n, we do:
    --   \x1 .. xn -> e => \x1 .. xn -> E[e]
    -- Note that we need the arity of the join point, since e may be a lambda
    -- (though this is unlikely). See Note [Join points and case-of-case].
    simplJoinRhs :: SimplEnv -> InId -> InExpr -> SimplCont
                 -> SimplM OutExpr
    simplJoinRhs :: SimplEnv -> CoreBndr -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplJoinRhs SimplEnv
    env CoreBndr
    bndr CoreExpr
    expr SimplCont
    cont
      | JoinPoint Int
    arity <- CoreBndr -> JoinPointHood
    idJoinPointHood CoreBndr
    bndr
      =  do { let ([CoreBndr]
    join_bndrs, CoreExpr
    join_body) = Int -> CoreExpr -> ([CoreBndr], CoreExpr)
    forall b. Int -> Expr b -> ([b], Expr b)
    collectNBinders Int
    arity CoreExpr
    expr
                  mult :: Kind
    mult = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
            ; (env', join_bndrs') <- SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    simplLamBndrs SimplEnv
    env ((CoreBndr -> CoreBndr) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Kind -> CoreBndr -> CoreBndr
    scaleVarBy Kind
    mult) [CoreBndr]
    join_bndrs)
            ; join_body' <- simplExprC env' join_body cont
            ; return $ mkLams join_bndrs' join_body' }

      | Bool
    otherwise
      = String -> SDoc -> SimplM CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "simplJoinRhs" (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    bndr)

    ---------------------------------
    simplType :: SimplEnv -> InType -> SimplM OutType
            -- Kept monadic just so we can do the seqType
            -- See Note [Avoiding space leaks in OutType]
    simplType :: SimplEnv -> Kind -> SimplM Kind
    simplType SimplEnv
    env Kind
    ty
      = -- pprTrace "simplType" (ppr ty $$ ppr (seTvSubst env)) $
        Kind -> ()
    seqType Kind
    new_ty () -> SimplM Kind -> SimplM Kind
    forall a b. a -> b -> b
    `seq` Kind -> SimplM Kind
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Kind
    new_ty
      where
        new_ty :: Kind
    new_ty = HasDebugCallStack => SimplEnv -> Kind -> Kind
    SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env Kind
    ty

    ---------------------------------
    simplCoercionF :: SimplEnv -> InCoercion -> SimplCont
                   -> SimplM (SimplFloats, OutExpr)
    simplCoercionF :: SimplEnv
    -> CoercionR -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplCoercionF SimplEnv
    env CoercionR
    co SimplCont
    cont
      = do { co' <- SimplEnv -> CoercionR -> SimplM CoercionR
    simplCoercion SimplEnv
    env CoercionR
    co
           ; rebuild env (Coercion co') cont }

    simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion
    simplCoercion :: SimplEnv -> CoercionR -> SimplM CoercionR
    simplCoercion SimplEnv
    env CoercionR
    co
      = do { let opt_co :: CoercionR
    opt_co | SimplEnv -> Bool
    reSimplifying SimplEnv
    env = SimplEnv -> CoercionR -> CoercionR
    substCo SimplEnv
    env CoercionR
    co
                        | Bool
    otherwise         = OptCoercionOpts -> Subst -> CoercionR -> CoercionR
    optCoercion OptCoercionOpts
    opts Subst
    subst CoercionR
    co
                 -- If (reSimplifying env) is True we have already simplified
                 -- this coercion once, and we don't want do so again; doing
                 -- so repeatedly risks non-linear behaviour
                 -- See Note [Inline depth] in GHC.Core.Opt.Simplify.Env
           ; CoercionR -> ()
    seqCo CoercionR
    opt_co () -> SimplM CoercionR -> SimplM CoercionR
    forall a b. a -> b -> b
    `seq` CoercionR -> SimplM CoercionR
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoercionR
    opt_co }
      where
        subst :: Subst
    subst = SimplEnv -> Subst
    getSubst SimplEnv
    env
        opts :: OptCoercionOpts
    opts  = SimplEnv -> OptCoercionOpts
    seOptCoercionOpts SimplEnv
    env

    -----------------------------------
    -- | Push a TickIt context outwards past applications and cases, as
    -- long as this is a non-scoping tick, to let case and application
    -- optimisations apply.

    simplTick :: SimplEnv -> CoreTickish -> InExpr -> SimplCont
              -> SimplM (SimplFloats, OutExpr)
    simplTick :: SimplEnv
    -> CoreTickish
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplTick SimplEnv
    env CoreTickish
    tickish CoreExpr
    expr SimplCont
    cont
      -- A scoped tick turns into a continuation, so that we can spot
      -- (scc t (\x . e)) in simplLam and eliminate the scc.  If we didn't do
      -- it this way, then it would take two passes of the simplifier to
      -- reduce ((scc t (\x . e)) e').
      -- NB, don't do this with counting ticks, because if the expr is
      -- bottom, then rebuildCall will discard the continuation.

    --------------------------
    --  | tickishScoped tickish && not (tickishCounts tickish)
    --  = simplExprF env expr (TickIt tickish cont)
    -- XXX: we cannot do this, because the simplifier assumes that
    -- the context can be pushed into a case with a single branch. e.g.
    --    scc<f>  case expensive of p -> e
    -- becomes
    --    case expensive of p -> scc<f> e
    --
    -- So I'm disabling this for now.  It just means we will do more
    -- simplifier iterations that necessary in some cases.
    --------------------------

      -- For unscoped or soft-scoped ticks, we are allowed to float in new
      -- cost, so we simply push the continuation inside the tick.  This
      -- has the effect of moving the tick to the outside of a case or
      -- application context, allowing the normal case and application
      -- optimisations to fire.
      | CoreTickish
    tickish CoreTickish -> TickishScoping -> Bool
    forall (pass :: TickishPass).
    GenTickish pass -> TickishScoping -> Bool
    `tickishScopesLike` TickishScoping
    SoftScope
      = do { (floats, expr') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    expr SimplCont
    cont
           ; return (floats, mkTick tickish expr')
           }

      -- Push tick inside if the context looks like this will allow us to
      -- do a case-of-case - see Note [case-of-scc-of-case]
      | Select {} <- SimplCont
    cont, Just CoreExpr
    expr' <- Maybe CoreExpr
    push_tick_inside
      = SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    expr' SimplCont
    cont

      -- We don't want to move the tick, but we might still want to allow
      -- floats to pass through with appropriate wrapping (or not, see
      -- wrap_floats below)
      --- | not (tickishCounts tickish) || tickishCanSplit tickish
      -- = wrap_floats

      | Bool
    otherwise
      = SimplM (SimplFloats, CoreExpr)
    no_floating_past_tick

     where

      -- Try to push tick inside a case, see Note [case-of-scc-of-case].
      push_tick_inside :: Maybe CoreExpr
    push_tick_inside =
        case CoreExpr
    expr0 of
          Case CoreExpr
    scrut CoreBndr
    bndr Kind
    ty [Alt CoreBndr]
    alts
                 -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> Maybe CoreExpr) -> CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreBndr -> Kind -> [Alt CoreBndr] -> CoreExpr
    forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
    Case (CoreExpr -> CoreExpr
    tickScrut CoreExpr
    scrut) CoreBndr
    bndr Kind
    ty ((Alt CoreBndr -> Alt CoreBndr) -> [Alt CoreBndr] -> [Alt CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt CoreBndr -> Alt CoreBndr
    tickAlt [Alt CoreBndr]
    alts)
          CoreExpr
    _other -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
       where ([CoreTickish]
    ticks, CoreExpr
    expr0) = (CoreTickish -> Bool) -> CoreExpr -> ([CoreTickish], CoreExpr)
    forall b.
    (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
    stripTicksTop CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    movable (CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    tickish CoreExpr
    expr)
             movable :: GenTickish pass -> Bool
    movable GenTickish pass
    t      = Bool -> Bool
    not (GenTickish pass -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts GenTickish pass
    t) Bool -> Bool -> Bool
    ||
                              GenTickish pass
    t GenTickish pass -> TickishScoping -> Bool
    forall (pass :: TickishPass).
    GenTickish pass -> TickishScoping -> Bool
    `tickishScopesLike` TickishScoping
    NoScope Bool -> Bool -> Bool
    ||
                              GenTickish pass -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCanSplit GenTickish pass
    t
             tickScrut :: CoreExpr -> CoreExpr
    tickScrut CoreExpr
    e    = (CoreTickish -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [CoreTickish] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreExpr
    e [CoreTickish]
    ticks
             -- Alternatives get annotated with all ticks that scope in some way,
             -- but we don't want to count entries.
             tickAlt :: Alt CoreBndr -> Alt CoreBndr
    tickAlt (Alt AltCon
    c [CoreBndr]
    bs CoreExpr
    e) = AltCon -> [CoreBndr] -> CoreExpr -> Alt CoreBndr
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    c [CoreBndr]
    bs ((CoreTickish -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [CoreTickish] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreExpr
    e [CoreTickish]
    ts_scope)
             ts_scope :: [CoreTickish]
    ts_scope         = (CoreTickish -> CoreTickish) -> [CoreTickish] -> [CoreTickish]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoCount ([CoreTickish] -> [CoreTickish]) -> [CoreTickish] -> [CoreTickish]
    forall a b. (a -> b) -> a -> b
    $
                                (CoreTickish -> Bool) -> [CoreTickish] -> [CoreTickish]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (CoreTickish -> Bool) -> CoreTickish -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CoreTickish -> TickishScoping -> Bool
    forall (pass :: TickishPass).
    GenTickish pass -> TickishScoping -> Bool
    `tickishScopesLike` TickishScoping
    NoScope)) [CoreTickish]
    ticks

      no_floating_past_tick :: SimplM (SimplFloats, CoreExpr)
    no_floating_past_tick =
        do { let (SimplCont
    inc,SimplCont
    outc) = SimplCont -> (SimplCont, SimplCont)
    splitCont SimplCont
    cont
           ; (floats, expr1) <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    expr SimplCont
    inc
           ; let expr2    = SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    floats CoreExpr
    expr1
                 tickish' = SimplEnv -> CoreTickish -> CoreTickish
    forall {pass :: TickishPass}.
    (XTickishId pass ~ CoreBndr) =>
    SimplEnv -> GenTickish pass -> GenTickish pass
    simplTickish SimplEnv
    env CoreTickish
    tickish
           ; rebuild env (mkTick tickish' expr2) outc
           }

    -- Alternative version that wraps outgoing floats with the tick.  This
    -- results in ticks being duplicated, as we don't make any attempt to
    -- eliminate the tick if we re-inline the binding (because the tick
    -- semantics allows unrestricted inlining of HNFs), so I'm not doing
    -- this any more.  FloatOut will catch any real opportunities for
    -- floating.
    --
    --  wrap_floats =
    --    do { let (inc,outc) = splitCont cont
    --       ; (env', expr') <- simplExprF (zapFloats env) expr inc
    --       ; let tickish' = simplTickish env tickish
    --       ; let wrap_float (b,rhs) = (zapIdDmdSig (setIdArity b 0),
    --                                   mkTick (mkNoCount tickish') rhs)
    --              -- when wrapping a float with mkTick, we better zap the Id's
    --              -- strictness info and arity, because it might be wrong now.
    --       ; let env'' = addFloats env (mapFloats env' wrap_float)
    --       ; rebuild env'' expr' (TickIt tickish' outc)
    --       }

      simplTickish :: SimplEnv -> GenTickish pass -> GenTickish pass
    simplTickish SimplEnv
    env GenTickish pass
    tickish
        | Breakpoint XBreakpoint pass
    ext Int
    n [XTickishId pass]
    ids Module
    modl <- GenTickish pass
    tickish
              = XBreakpoint pass
    -> Int -> [XTickishId pass] -> Module -> GenTickish pass
    forall (pass :: TickishPass).
    XBreakpoint pass
    -> Int -> [XTickishId pass] -> Module -> GenTickish pass
    Breakpoint XBreakpoint pass
    ext Int
    n ((CoreBndr -> Maybe CoreBndr) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (SimplSR -> Maybe CoreBndr
    getDoneId (SimplSR -> Maybe CoreBndr)
    -> (CoreBndr -> SimplSR) -> CoreBndr -> Maybe CoreBndr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SimplEnv -> CoreBndr -> SimplSR
    substId SimplEnv
    env) [CoreBndr]
    [XTickishId pass]
    ids) Module
    modl
        | Bool
    otherwise = GenTickish pass
    tickish

      -- Push type application and coercion inside a tick
      splitCont :: SimplCont -> (SimplCont, SimplCont)
      splitCont :: SimplCont -> (SimplCont, SimplCont)
    splitCont cont :: SimplCont
    cont@(ApplyToTy { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    tail }) = (SimplCont
    cont { sc_cont = inc }, SimplCont
    outc)
        where (SimplCont
    inc,SimplCont
    outc) = SimplCont -> (SimplCont, SimplCont)
    splitCont SimplCont
    tail
      splitCont cont :: SimplCont
    cont@(CastIt { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    tail }) = (SimplCont
    cont { sc_cont = inc }, SimplCont
    outc)
        where (SimplCont
    inc,SimplCont
    outc) = SimplCont -> (SimplCont, SimplCont)
    splitCont SimplCont
    tail
      splitCont SimplCont
    other = (Kind -> SimplCont
    mkBoringStop (SimplCont -> Kind
    contHoleType SimplCont
    other), SimplCont
    other)

      getDoneId :: SimplSR -> Maybe CoreBndr
    getDoneId (DoneId CoreBndr
    id)  = CoreBndr -> Maybe CoreBndr
    forall a. a -> Maybe a
    Just CoreBndr
    id
      getDoneId (DoneEx (Var CoreBndr
    id) JoinPointHood
    _) = CoreBndr -> Maybe CoreBndr
    forall a. a -> Maybe a
    Just CoreBndr
    id
      getDoneId (DoneEx CoreExpr
    e JoinPointHood
    _) = CoreExpr -> Maybe CoreBndr
    getIdFromTrivialExpr_maybe CoreExpr
    e -- Note [substTickish] in GHC.Core.Subst
      getDoneId SimplSR
    other = String -> SDoc -> Maybe CoreBndr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getDoneId" (SimplSR -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SimplSR
    other)

    -- Note [case-of-scc-of-case]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- It's pretty important to be able to transform case-of-case when
    -- there's an SCC in the way.  For example, the following comes up
    -- in nofib/real/compress/Encode.hs:
    --
    --        case scctick<code_string.r1>
    --             case $wcode_string_r13s wild_XC w1_s137 w2_s138 l_aje
    --             of _ { (# ww1_s13f, ww2_s13g, ww3_s13h #) ->
    --             (ww1_s13f, ww2_s13g, ww3_s13h)
    --             }
    --        of _ { (ww_s12Y, ww1_s12Z, ww2_s130) ->
    --        tick<code_string.f1>
    --        (ww_s12Y,
    --         ww1_s12Z,
    --         PTTrees.PT
    --           @ GHC.Types.Char @ GHC.Types.Int wild2_Xj ww2_s130 r_ajf)
    --        }
    --
    -- We really want this case-of-case to fire, because then the 3-tuple
    -- will go away (indeed, the CPR optimisation is relying on this
    -- happening).  But the scctick is in the way - we need to push it
    -- inside to expose the case-of-case.  So we perform this
    -- transformation on the inner case:
    --
    --   scctick c (case e of { p1 -> e1; ...; pn -> en })
    --    ==>
    --   case (scctick c e) of { p1 -> scc c e1; ...; pn -> scc c en }
    --
    -- So we've moved a constant amount of work out of the scc to expose
    -- the case.  We only do this when the continuation is interesting: in
    -- for now, it has to be another Case (maybe generalise this later).

    {-
    ************************************************************************
    *                                                                      *
    \subsection{The main rebuilder}
    *                                                                      *
    ************************************************************************
    -}

    rebuild :: SimplEnv -> OutExpr -> SimplCont -> SimplM (SimplFloats, OutExpr)
    -- At this point the substitution in the SimplEnv should be irrelevant;
    -- only the in-scope set matters
    rebuild :: SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env CoreExpr
    expr SimplCont
    cont
      = case SimplCont
    cont of
          Stop {}          -> (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, CoreExpr
    expr)
          TickIt CoreTickish
    t SimplCont
    cont    -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreTickish
    t CoreExpr
    expr) SimplCont
    cont
          CastIt { sc_co :: SimplCont -> CoercionR
    sc_co = CoercionR
    co, sc_opt :: SimplCont -> Bool
    sc_opt = Bool
    opt, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont }
            -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (HasDebugCallStack => CoreExpr -> CoercionR -> CoreExpr
    CoreExpr -> CoercionR -> CoreExpr
    mkCast CoreExpr
    expr CoercionR
    co') SimplCont
    cont
               -- NB: mkCast implements the (Coercion co |> g) optimisation
            where
              co' :: CoercionR
    co' = SimplEnv -> CoercionR -> Bool -> CoercionR
    optOutCoercion SimplEnv
    env CoercionR
    co Bool
    opt

          Select { sc_bndr :: SimplCont -> CoreBndr
    sc_bndr = CoreBndr
    bndr, sc_alts :: SimplCont -> [Alt CoreBndr]
    sc_alts = [Alt CoreBndr]
    alts, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont }
            -> SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    rebuildCase (SimplEnv
    se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) CoreExpr
    expr CoreBndr
    bndr [Alt CoreBndr]
    alts SimplCont
    cont

          StrictArg { sc_fun :: SimplCont -> ArgInfo
    sc_fun = ArgInfo
    fun, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont, sc_fun_ty :: SimplCont -> Kind
    sc_fun_ty = Kind
    fun_ty }
            -> SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo -> CoreExpr -> Kind -> ArgInfo
    addValArgTo ArgInfo
    fun CoreExpr
    expr Kind
    fun_ty ) SimplCont
    cont

          StrictBind { sc_bndr :: SimplCont -> CoreBndr
    sc_bndr = CoreBndr
    b, sc_body :: SimplCont -> CoreExpr
    sc_body = CoreExpr
    body, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se
                     , sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont, sc_from :: SimplCont -> FromWhat
    sc_from = FromWhat
    from_what }
            -> SimplEnv
    -> FromWhat
    -> CoreBndr
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    completeBindX (SimplEnv
    se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) FromWhat
    from_what CoreBndr
    b CoreExpr
    expr CoreExpr
    body SimplCont
    cont

          ApplyToTy  { sc_arg_ty :: SimplCont -> Kind
    sc_arg_ty = Kind
    ty, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont}
            -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    expr (Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type Kind
    ty)) SimplCont
    cont

          ApplyToVal { sc_arg :: SimplCont -> CoreExpr
    sc_arg = CoreExpr
    arg, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se, sc_dup :: SimplCont -> DupFlag
    sc_dup = DupFlag
    dup_flag
                     , sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont, sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    fun_ty }
            -- See Note [Avoid redundant simplification]
            -> do { (_, _, arg') <- SimplEnv
    -> DupFlag
    -> Kind
    -> Maybe ArgInfo
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplLazyArg SimplEnv
    env DupFlag
    dup_flag Kind
    fun_ty Maybe ArgInfo
    forall a. Maybe a
    Nothing SimplEnv
    se CoreExpr
    arg
                  ; rebuild env (App expr arg') cont }

    completeBindX :: SimplEnv
                  -> FromWhat
                  -> InId -> OutExpr   -- Non-recursively bind this Id to this (simplified) expression
                                       -- (the let-can-float invariant may not be satisfied)
                  -> InExpr            -- In this body
                  -> SimplCont         -- Consumed by this continuation
                  -> SimplM (SimplFloats, OutExpr)
    completeBindX :: SimplEnv
    -> FromWhat
    -> CoreBndr
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    completeBindX SimplEnv
    env FromWhat
    from_what CoreBndr
    bndr CoreExpr
    rhs CoreExpr
    body SimplCont
    cont
      | FromBeta Levity
    arg_levity <- FromWhat
    from_what
      , Levity -> CoreExpr -> Bool
    needsCaseBindingL Levity
    arg_levity CoreExpr
    rhs -- Enforcing the let-can-float-invariant
      = do { (env1, bndr1)   <- SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplNonRecBndr SimplEnv
    env CoreBndr
    bndr  -- Lambda binders don't have rules
           ; (floats, expr') <- simplNonRecBody env1 from_what body cont
           -- Do not float floats past the Case binder below
           ; let expr'' = SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    floats CoreExpr
    expr'
                 case_expr = CoreExpr -> CoreBndr -> Kind -> [Alt CoreBndr] -> CoreExpr
    forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
    Case CoreExpr
    rhs CoreBndr
    bndr1 (SimplCont -> Kind
    contResultType SimplCont
    cont) [AltCon -> [CoreBndr] -> CoreExpr -> Alt CoreBndr
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] CoreExpr
    expr'']
           ; return (emptyFloats env, case_expr) }

      | Bool
    otherwise -- Make a let-binding
      = do  { (env1, bndr1) <- SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplNonRecBndr SimplEnv
    env CoreBndr
    bndr
            ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive)

            ; let is_strict = CoreBndr -> Bool
    isStrictId CoreBndr
    bndr2
                  -- isStrictId: use simplified binder because the InId bndr might not have
                  -- a fixed runtime representation, which isStrictId doesn't expect
                  -- c.f. Note [Dark corner with representation polymorphism]

            ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict
                                                   bndr2 (emptyFloats env) rhs
                  -- NB: it makes a surprisingly big difference (5% in compiler allocation
                  -- in T9630) to pass 'env' rather than 'env1'.  It's fine to pass 'env',
                  -- because this is completeBindX, so bndr is not in scope in the RHS.

            ; let env3 = SimplEnv
    env2 SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    rhs_floats
            ; (bind_float, env4) <- completeBind (BC_Let NotTopLevel NonRecursive)
                                                 (bndr,env) (bndr2, rhs1, env3)
                  -- Must pass env1 to completeBind in case simplBinder had to clone,
                  -- and extended the substitution with [bndr :-> new_bndr]

            -- Simplify the body
            ; (body_floats, body') <- simplNonRecBody env4 from_what body cont

            ; let all_floats = SimplFloats
    rhs_floats SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    bind_float SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    body_floats
            ; return ( all_floats, body' ) }

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Lambdas}
    *                                                                      *
    ************************************************************************
    -}

    {- Note [Optimising reflexivity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's important (for compiler performance) to get rid of reflexivity as soon
    as it appears.  See #11735, #14737, and #15019.

    In particular, we want to behave well on

     *  e |> co1 |> co2
        where the two happen to cancel out entirely. That is quite common;
        e.g. a newtype wrapping and unwrapping cancel.

     * (f |> co) @t1 @t2 ... @tn x1 .. xm
       Here we will use pushCoTyArg and pushCoValArg successively, which
       build up SelCo stacks.  Silly to do that if co is reflexive.

    However, we don't want to call isReflexiveCo too much, because it uses
    type equality which is expensive on big types (#14737 comment:7).

    A good compromise (determined experimentally) seems to be to call
    isReflexiveCo
     * when composing casts, and
     * at the end

    In investigating this I saw missed opportunities for on-the-fly
    coercion shrinkage. See #15090.

    Note [Avoid re-simplifying coercions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In some benchmarks (with deeply nested cases) we successively push
    casts onto the SimplCont.  We don't want to call the coercion optimiser
    on each successive composition -- that's at least quadratic.  So:

    * The CastIt constructor in SimplCont has a `sc_opt :: Bool` flag to
      record whether the coercion optimiser has been applied to the coercion.

    * In `simplCast`, when we see (Cast e co), we simplify `co` to get
      an OutCoercion, and built a CastIt with sc_opt=True.

      Actually not quite: if we are simplifying the result of inlining an
      unfolding (seInlineDepth > 0), then instead of /optimising/ it again,
      just /substitute/ which is cheaper.  See `simplCoercion`.

    * In `addCoerce` (in `simplCast`) if we combine this new coercion with
      an existing once, we build a CastIt for (co1 ; co2) with sc_opt=False.

    * When unpacking a CastIt, in `rebuildCall` and `rebuild`, we optimise
      the (presumably composed) coercion if sc_opt=False; this is done
      by `optOutCoercion`.

    * When duplicating a continuation in `mkDupableContWithDmds`, before
      duplicating a CastIt, optimise the coercion. Otherwise we'll end up
      optimising it separately in the duplicate copies.
    -}

    optOutCoercion :: SimplEnv -> OutCoercion -> Bool -> OutCoercion
    -- See Note [Avoid re-simplifying coercions]
    optOutCoercion :: SimplEnv -> CoercionR -> Bool -> CoercionR
    optOutCoercion SimplEnv
    env CoercionR
    co Bool
    already_optimised
      | Bool
    already_optimised = CoercionR
    co  -- See Note [Avoid re-simplifying coercions]
      | Bool
    otherwise         = OptCoercionOpts -> Subst -> CoercionR -> CoercionR
    optCoercion OptCoercionOpts
    opts Subst
    empty_subst CoercionR
    co
      where
        empty_subst :: Subst
    empty_subst = InScopeSet -> Subst
    mkEmptySubst (SimplEnv -> InScopeSet
    seInScope SimplEnv
    env)
        opts :: OptCoercionOpts
    opts = SimplEnv -> OptCoercionOpts
    seOptCoercionOpts SimplEnv
    env

    simplCast :: SimplEnv -> InExpr -> InCoercion -> SimplCont
              -> SimplM (SimplFloats, OutExpr)
    simplCast :: SimplEnv
    -> CoreExpr
    -> CoercionR
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplCast SimplEnv
    env CoreExpr
    body CoercionR
    co0 SimplCont
    cont0
      = do  { co1   <- {-#SCC "simplCast-simplCoercion" #-} SimplEnv -> CoercionR -> SimplM CoercionR
    simplCoercion SimplEnv
    env CoercionR
    co0
            ; cont1 <- {-#SCC "simplCast-addCoerce" #-}
                       if isReflCo co1
                       then return cont0  -- See Note [Optimising reflexivity]
                       else addCoerce co1 True cont0
                            -- True <=> co1 is optimised
            ; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 }
      where

            -- If the first parameter is MRefl, then simplifying revealed a
            -- reflexive coercion. Omit.
            addCoerceM :: MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont
            addCoerceM :: MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont
    addCoerceM MOutCoercion
    MRefl    Bool
    _   SimplCont
    cont = SimplCont -> SimplM SimplCont
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SimplCont
    cont
            addCoerceM (MCo CoercionR
    co) Bool
    opt SimplCont
    cont = CoercionR -> Bool -> SimplCont -> SimplM SimplCont
    addCoerce CoercionR
    co Bool
    opt SimplCont
    cont

            addCoerce :: OutCoercion -> Bool -> SimplCont -> SimplM SimplCont
            addCoerce :: CoercionR -> Bool -> SimplCont -> SimplM SimplCont
    addCoerce CoercionR
    co1 Bool
    _ (CastIt { sc_co :: SimplCont -> CoercionR
    sc_co = CoercionR
    co2, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })  -- See Note [Optimising reflexivity]
              = CoercionR -> Bool -> SimplCont -> SimplM SimplCont
    addCoerce (HasDebugCallStack => CoercionR -> CoercionR -> CoercionR
    CoercionR -> CoercionR -> CoercionR
    mkTransCo CoercionR
    co1 CoercionR
    co2) Bool
    False SimplCont
    cont
                          -- False: (mkTransCo co1 co2) is not fully optimised
                          -- See Note [Avoid re-simplifying coercions]

            addCoerce CoercionR
    co Bool
    opt (ApplyToTy { sc_arg_ty :: SimplCont -> Kind
    sc_arg_ty = Kind
    arg_ty, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    tail })
              | Just (Kind
    arg_ty', MOutCoercion
    m_co') <- CoercionR -> Kind -> Maybe (Kind, MOutCoercion)
    pushCoTyArg CoercionR
    co Kind
    arg_ty
              = {-#SCC "addCoerce-pushCoTyArg" #-}
                do { tail' <- MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont
    addCoerceM MOutCoercion
    m_co' Bool
    opt SimplCont
    tail
                   ; return (ApplyToTy { sc_arg_ty  = arg_ty'
                                       , sc_cont    = tail'
                                       , sc_hole_ty = coercionLKind co }) }
                                            -- NB!  As the cast goes past, the
                                            -- type of the hole changes (#16312)
            -- (f |> co) e   ===>   (f (e |> co1)) |> co2
            -- where   co :: (s1->s2) ~ (t1->t2)
            --         co1 :: t1 ~ s1
            --         co2 :: s2 ~ t2
            addCoerce CoercionR
    co Bool
    opt cont :: SimplCont
    cont@(ApplyToVal { sc_arg :: SimplCont -> CoreExpr
    sc_arg = CoreExpr
    arg, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    arg_se
                                              , sc_dup :: SimplCont -> DupFlag
    sc_dup = DupFlag
    dup, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    tail
                                              , sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    fun_ty })
              | Bool -> Bool
    not Bool
    opt  -- pushCoValArg duplicates the coercion, so optimise first
              = CoercionR -> Bool -> SimplCont -> SimplM SimplCont
    addCoerce (SimplEnv -> CoercionR -> Bool -> CoercionR
    optOutCoercion SimplEnv
    env CoercionR
    co Bool
    opt) Bool
    True SimplCont
    cont

              | Just (MOutCoercion
    m_co1, MOutCoercion
    m_co2) <- CoercionR -> Maybe (MOutCoercion, MOutCoercion)
    pushCoValArg CoercionR
    co
              , MOutCoercion -> Bool
    fixed_rep MOutCoercion
    m_co1
              = {-#SCC "addCoerce-pushCoValArg" #-}
                do { tail' <- MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont
    addCoerceM MOutCoercion
    m_co2 Bool
    opt SimplCont
    tail
                   ; case m_co1 of {
                       MOutCoercion
    MRefl -> SimplCont -> SimplM SimplCont
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplCont
    cont { sc_cont = tail'
                                             , sc_hole_ty = coercionLKind co }) ;
                          -- See Note [Avoiding simplifying repeatedly]

                       MCo CoercionR
    co1 ->
                do { (dup', arg_se', arg') <- SimplEnv
    -> DupFlag
    -> Kind
    -> Maybe ArgInfo
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplLazyArg SimplEnv
    env DupFlag
    dup Kind
    fun_ty Maybe ArgInfo
    forall a. Maybe a
    Nothing SimplEnv
    arg_se CoreExpr
    arg
                        -- When we build the ApplyTo we can't mix the OutCoercion
                        -- 'co' with the InExpr 'arg', so we simplify
                        -- to make it all consistent.  It's a bit messy.
                        -- But it isn't a common case.
                        -- Example of use: #995
                   ; return (ApplyToVal { sc_arg  = mkCast arg' co1
                                        , sc_env  = arg_se'
                                        , sc_dup  = dup'
                                        , sc_cont = tail'
                                        , sc_hole_ty = coercionLKind co }) } } }

            addCoerce CoercionR
    co Bool
    opt SimplCont
    cont
              | CoercionR -> Bool
    isReflCo CoercionR
    co = SimplCont -> SimplM SimplCont
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SimplCont
    cont  -- Having this at the end makes a huge
                                           -- difference in T12227, for some reason
                                           -- See Note [Optimising reflexivity]
              | Bool
    otherwise = SimplCont -> SimplM SimplCont
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CastIt { sc_co :: CoercionR
    sc_co = CoercionR
    co, sc_opt :: Bool
    sc_opt = Bool
    opt, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont })

            fixed_rep :: MCoercionR -> Bool
            fixed_rep :: MOutCoercion -> Bool
    fixed_rep MOutCoercion
    MRefl    = Bool
    True
            fixed_rep (MCo CoercionR
    co) = HasDebugCallStack => Kind -> Bool
    Kind -> Bool
    typeHasFixedRuntimeRep (Kind -> Bool) -> Kind -> Bool
    forall a b. (a -> b) -> a -> b
    $ HasDebugCallStack => CoercionR -> Kind
    CoercionR -> Kind
    coercionRKind CoercionR
    co
              -- Without this check, we can get an argument which does not
              -- have a fixed runtime representation.
              -- See Note [Representation polymorphism invariants] in GHC.Core
              -- test: typecheck/should_run/EtaExpandLevPoly

    simplLazyArg :: SimplEnv -> DupFlag
                 -> OutType                 -- ^ Type of the function applied to this arg
                 -> Maybe ArgInfo           -- ^ Just <=> This arg `ai` occurs in an app
                                            --   `f a1 ... an` where we have ArgInfo on
                                            --   how `f` uses `ai`, affecting the Stop
                                            --   continuation passed to 'simplExprC'
                 -> StaticEnv -> CoreExpr   -- ^ Expression with its static envt
                 -> SimplM (DupFlag, StaticEnv, OutExpr)
    simplLazyArg :: SimplEnv
    -> DupFlag
    -> Kind
    -> Maybe ArgInfo
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplLazyArg SimplEnv
    env DupFlag
    dup_flag Kind
    fun_ty Maybe ArgInfo
    mb_arg_info SimplEnv
    arg_env CoreExpr
    arg
      | DupFlag -> Bool
    isSimplified DupFlag
    dup_flag
      = (DupFlag, SimplEnv, CoreExpr)
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DupFlag
    dup_flag, SimplEnv
    arg_env, CoreExpr
    arg)
      | Bool
    otherwise
      = do { let arg_env' :: SimplEnv
    arg_env' = SimplEnv
    arg_env SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env
           ; let arg_ty :: Kind
    arg_ty = HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    funArgTy Kind
    fun_ty
           ; let stop :: SimplCont
    stop = case Maybe ArgInfo
    mb_arg_info of
                   Maybe ArgInfo
    Nothing -> Kind -> SimplCont
    mkBoringStop Kind
    arg_ty
                   Just ArgInfo
    ai -> Kind -> ArgInfo -> SimplCont
    mkLazyArgStop Kind
    arg_ty ArgInfo
    ai
           ; arg' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    arg_env' CoreExpr
    arg SimplCont
    stop
           ; return (Simplified, zapSubstEnv arg_env', arg') }
             -- Return a StaticEnv that includes the in-scope set from 'env',
             -- because arg' may well mention those variables (#20639)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Lambdas}
    *                                                                      *
    ************************************************************************
    -}

    simplNonRecBody :: SimplEnv -> FromWhat
                    -> InExpr -> SimplCont
                    -> SimplM (SimplFloats, OutExpr)
    simplNonRecBody :: SimplEnv
    -> FromWhat
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecBody SimplEnv
    env FromWhat
    from_what CoreExpr
    body SimplCont
    cont
      = case FromWhat
    from_what of
          FromWhat
    FromLet     -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    body SimplCont
    cont
          FromBeta {} -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplLam   SimplEnv
    env CoreExpr
    body SimplCont
    cont

    simplLam :: SimplEnv -> InExpr -> SimplCont
             -> SimplM (SimplFloats, OutExpr)

    simplLam :: SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env (Lam CoreBndr
    bndr CoreExpr
    body) SimplCont
    cont = HasDebugCallStack =>
    SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simpl_lam SimplEnv
    env CoreBndr
    bndr CoreExpr
    body SimplCont
    cont
    simplLam SimplEnv
    env CoreExpr
    expr            SimplCont
    cont = SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    expr SimplCont
    cont

    simpl_lam :: HasDebugCallStack
              => SimplEnv -> InBndr -> InExpr -> SimplCont
              -> SimplM (SimplFloats, OutExpr)

    -- Type beta-reduction
    simpl_lam :: HasDebugCallStack =>
    SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simpl_lam SimplEnv
    env CoreBndr
    bndr CoreExpr
    body (ApplyToTy { sc_arg_ty :: SimplCont -> Kind
    sc_arg_ty = Kind
    arg_ty, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })
      = do { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    BetaReduction CoreBndr
    bndr)
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplLam (SimplEnv -> CoreBndr -> Kind -> SimplEnv
    extendTvSubst SimplEnv
    env CoreBndr
    bndr Kind
    arg_ty) CoreExpr
    body SimplCont
    cont }

    -- Coercion beta-reduction
    simpl_lam SimplEnv
    env CoreBndr
    bndr CoreExpr
    body (ApplyToVal { sc_arg :: SimplCont -> CoreExpr
    sc_arg = Coercion CoercionR
    arg_co, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    arg_se
                                        , sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })
      = Bool
    -> SDoc
    -> SimplM (SimplFloats, CoreExpr)
    -> SimplM (SimplFloats, CoreExpr)
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (CoreBndr -> Bool
    isCoVar CoreBndr
    bndr) (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    bndr) (SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
        do { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    BetaReduction CoreBndr
    bndr)
           ; let arg_co' :: CoercionR
    arg_co' = SimplEnv -> CoercionR -> CoercionR
    substCo (SimplEnv
    arg_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) CoercionR
    arg_co
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplLam (SimplEnv -> CoreBndr -> CoercionR -> SimplEnv
    extendCvSubst SimplEnv
    env CoreBndr
    bndr CoercionR
    arg_co') CoreExpr
    body SimplCont
    cont }

    -- Value beta-reduction
    -- This works for /coercion/ lambdas too
    simpl_lam SimplEnv
    env CoreBndr
    bndr CoreExpr
    body (ApplyToVal { sc_arg :: SimplCont -> CoreExpr
    sc_arg = CoreExpr
    arg, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    arg_se
                                        , sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont, sc_dup :: SimplCont -> DupFlag
    sc_dup = DupFlag
    dup
                                        , sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    fun_ty})
      = do { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    BetaReduction CoreBndr
    bndr)
           ; let from_what :: FromWhat
    from_what = Levity -> FromWhat
    FromBeta Levity
    arg_levity
                 arg_levity :: Levity
    arg_levity
                   | Kind -> Bool
    isForAllTy Kind
    fun_ty = Bool -> SDoc -> Levity -> Levity
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (CoreBndr -> Bool
    isCoVar CoreBndr
    bndr) (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    bndr) Levity
    Unlifted
                   | Bool
    otherwise         = HasDebugCallStack => Kind -> Levity
    Kind -> Levity
    typeLevity (HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    funArgTy Kind
    fun_ty)
                 -- Example:  (\(cv::a ~# b). blah) co
                 -- The type of (\cv.blah) can be (forall cv. ty); see GHC.Core.Utils.mkLamType

                 -- Using fun_ty: see Note [Dark corner with representation polymorphism]
                 -- e.g  (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg
                 --      When we come to `x=arg` we must choose lazy/strict correctly
                 --      It's wrong to err in either direction
                 --      But fun_ty is an OutType, so is fully substituted

           ; if | DupFlag -> Bool
    isSimplified DupFlag
    dup  -- Don't re-simplify if we've simplified it once
                                    -- Including don't preInlineUnconditionally
                                    -- See Note [Avoiding simplifying repeatedly]
                -> SimplEnv
    -> FromWhat
    -> CoreBndr
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    completeBindX SimplEnv
    env FromWhat
    from_what CoreBndr
    bndr CoreExpr
    arg CoreExpr
    body SimplCont
    cont

                | Just SimplEnv
    env' <- SimplEnv
    -> TopLevelFlag
    -> CoreBndr
    -> CoreExpr
    -> SimplEnv
    -> Maybe SimplEnv
    preInlineUnconditionally SimplEnv
    env TopLevelFlag
    NotTopLevel CoreBndr
    bndr CoreExpr
    arg SimplEnv
    arg_se
                , Bool -> Bool
    not (Levity -> CoreExpr -> Bool
    needsCaseBindingL Levity
    arg_levity CoreExpr
    arg)
                  -- Ok to test arg::InExpr in needsCaseBinding because
                  -- exprOkForSpeculation is stable under simplification
                -> do { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    PreInlineUnconditionally CoreBndr
    bndr)
                      ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env' CoreExpr
    body SimplCont
    cont }

                | Bool
    otherwise
                -> HasDebugCallStack =>
    SimplEnv
    -> FromWhat
    -> CoreBndr
    -> (CoreExpr, SimplEnv)
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    SimplEnv
    -> FromWhat
    -> CoreBndr
    -> (CoreExpr, SimplEnv)
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecE SimplEnv
    env FromWhat
    from_what CoreBndr
    bndr (CoreExpr
    arg, SimplEnv
    arg_se) CoreExpr
    body SimplCont
    cont }

    -- Discard a non-counting tick on a lambda.  This may change the
    -- cost attribution slightly (moving the allocation of the
    -- lambda elsewhere), but we don't care: optimisation changes
    -- cost attribution all the time.
    simpl_lam SimplEnv
    env CoreBndr
    bndr CoreExpr
    body (TickIt CoreTickish
    tickish SimplCont
    cont)
      | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    tickish)
      = HasDebugCallStack =>
    SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simpl_lam SimplEnv
    env CoreBndr
    bndr CoreExpr
    body SimplCont
    cont

    -- Not enough args, so there are real lambdas left to put in the result
    simpl_lam SimplEnv
    env CoreBndr
    bndr CoreExpr
    body SimplCont
    cont
      = do  { let ([CoreBndr]
    inner_bndrs, CoreExpr
    inner_body) = CoreExpr -> ([CoreBndr], CoreExpr)
    forall b. Expr b -> ([b], Expr b)
    collectBinders CoreExpr
    body
            ; (env', bndrs') <- SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    simplLamBndrs SimplEnv
    env (CoreBndr
    bndrCoreBndr -> [CoreBndr] -> [CoreBndr]
    forall a. a -> [a] -> [a]
    :[CoreBndr]
    inner_bndrs)
            ; body'   <- simplExpr env' inner_body
            ; new_lam <- rebuildLam env' bndrs' body' cont
            ; rebuild env' new_lam cont }

    -------------
    simplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
    -- Historically this had a special case for when a lambda-binder
    -- could have a stable unfolding;
    -- see Historical Note [Case binders and join points]
    -- But now it is much simpler! We now only remove unfoldings.
    -- See Note [Never put `OtherCon` unfoldings on lambda binders]
    simplLamBndr :: SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplLamBndr SimplEnv
    env CoreBndr
    bndr = SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplBinder SimplEnv
    env (CoreBndr -> CoreBndr
    zapIdUnfolding CoreBndr
    bndr)

    simplLamBndrs :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
    simplLamBndrs :: SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    simplLamBndrs SimplEnv
    env [CoreBndr]
    bndrs = (SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr))
    -> SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplLamBndr SimplEnv
    env [CoreBndr]
    bndrs

    ------------------
    simplNonRecE :: HasDebugCallStack
                 => SimplEnv
                 -> FromWhat
                 -> InId               -- The binder, always an Id
                                       -- Never a join point
                                       -- The static env for its unfolding (if any) is the first parameter
                 -> (InExpr, SimplEnv) -- Rhs of binding (or arg of lambda)
                 -> InExpr             -- Body of the let/lambda
                 -> SimplCont
                 -> SimplM (SimplFloats, OutExpr)

    -- simplNonRecE is used for
    --  * from=FromLet:  a non-top-level non-recursive non-join-point let-expression
    --  * from=FromBeta: a binding arising from a beta reduction
    --
    -- simplNonRecE env b (rhs, rhs_se) body k
    --   = let env in
    --     cont< let b = rhs_se(rhs) in body >
    --
    -- It deals with strict bindings, via the StrictBind continuation,
    -- which may abort the whole process.
    --
    -- from_what=FromLet => the RHS satisfies the let-can-float invariant
    -- Otherwise it may or may not satisfy it.

    simplNonRecE :: HasDebugCallStack =>
    SimplEnv
    -> FromWhat
    -> CoreBndr
    -> (CoreExpr, SimplEnv)
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecE SimplEnv
    env FromWhat
    from_what CoreBndr
    bndr (CoreExpr
    rhs, SimplEnv
    rhs_se) CoreExpr
    body SimplCont
    cont
      | Bool -> Bool -> Bool
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isId CoreBndr
    bndr Bool -> Bool -> Bool
    && Bool -> Bool
    not (CoreBndr -> Bool
    isJoinId CoreBndr
    bndr) ) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $
        Bool
    is_strict_bind
      = -- Evaluate RHS strictly
        SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF (SimplEnv
    rhs_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) CoreExpr
    rhs
                   (StrictBind { sc_bndr :: CoreBndr
    sc_bndr = CoreBndr
    bndr, sc_body :: CoreExpr
    sc_body = CoreExpr
    body, sc_from :: FromWhat
    sc_from = FromWhat
    from_what
                               , sc_env :: SimplEnv
    sc_env = SimplEnv
    env, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont, sc_dup :: DupFlag
    sc_dup = DupFlag
    NoDup })

      | Bool
    otherwise  -- Evaluate RHS lazily
      = do { (env1, bndr1)    <- SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplNonRecBndr SimplEnv
    env CoreBndr
    bndr
           ; (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive)
           ; (floats1, env3)  <- simplLazyBind NotTopLevel NonRecursive
                                               (bndr,env) (bndr2,env2) (rhs,rhs_se)
           ; (floats2, expr') <- simplNonRecBody env3 from_what body cont
           ; return (floats1 `addFloats` floats2, expr') }

      where
        is_strict_bind :: Bool
    is_strict_bind = case FromWhat
    from_what of
           FromBeta Levity
    Unlifted -> Bool
    True
           -- If we are coming from a beta-reduction (FromBeta) we must
           -- establish the let-can-float invariant, so go via StrictBind
           -- If not, the invariant holds already, and it's optional.

           -- (FromBeta Lifted) or FromLet: look at the demand info
           FromWhat
    _ -> SimplEnv -> Bool
    seCaseCase SimplEnv
    env Bool -> Bool -> Bool
    && Demand -> Bool
    isStrUsedDmd (CoreBndr -> Demand
    idDemandInfo CoreBndr
    bndr)

    ------------------
    simplRecE :: SimplEnv
              -> [(InId, InExpr)]
              -> InExpr
              -> SimplCont
              -> SimplM (SimplFloats, OutExpr)

    -- simplRecE is used for
    --  * non-top-level recursive lets in expressions
    -- Precondition: not a join-point binding
    simplRecE :: SimplEnv
    -> [(CoreBndr, CoreExpr)]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplRecE SimplEnv
    env [(CoreBndr, CoreExpr)]
    pairs CoreExpr
    body SimplCont
    cont
      = do  { let bndrs :: [CoreBndr]
    bndrs = ((CoreBndr, CoreExpr) -> CoreBndr)
    -> [(CoreBndr, CoreExpr)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, CoreExpr) -> CoreBndr
    forall a b. (a, b) -> a
    fst [(CoreBndr, CoreExpr)]
    pairs
            ; Bool -> SimplM ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert ((CoreBndr -> Bool) -> [CoreBndr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> (CoreBndr -> Bool) -> CoreBndr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBndr -> Bool
    isJoinId) [CoreBndr]
    bndrs)
            ; env1 <- SimplEnv -> [CoreBndr] -> SimplM SimplEnv
    simplRecBndrs SimplEnv
    env [CoreBndr]
    bndrs
                    -- NB: bndrs' don't have unfoldings or rules
                    -- We add them as we go down
            ; (floats1, env2)  <- simplRecBind env1 (BC_Let NotTopLevel Recursive) pairs
            ; (floats2, expr') <- simplExprF env2 body cont
            ; return (floats1 `addFloats` floats2, expr') }

    {- Note [Dark corner with representation polymorphism]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In `simplNonRecE`, the call to `needsCaseBinding` or to `isStrictId` will fail
    if the binder does not have a fixed runtime representation, e.g. if it is of kind (TYPE r).
    So we are careful to call `isStrictId` on the OutId, not the InId, in case we have
         ((\(r::RuntimeRep) \(x::TYPE r). blah) Lifted arg)
    That will lead to `simplNonRecE env (x::TYPE r) arg`, and we can't tell
    if x is lifted or unlifted from that.

    We only get such redexes from the compulsory inlining of a wired-in,
    representation-polymorphic function like `rightSection` (see
    GHC.Types.Id.Make).  Mind you, SimpleOpt should probably have inlined
    such compulsory inlinings already, but belt and braces does no harm.

    Plus, it turns out that GHC.Driver.Main.hscCompileCoreExpr calls the
    Simplifier without first calling SimpleOpt, so anything involving
    GHCi or TH and operator sections will fall over if we don't take
    care here.

    Note [Avoiding simplifying repeatedly]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    One way in which we can get exponential behaviour is if we simplify a
    big expression, and then re-simplify it -- and then this happens in a
    deeply-nested way.  So we must be jolly careful about re-simplifying
    an expression (#13379).

    Example:
      f BIG, where f has a RULE
    Then
     * We simplify BIG before trying the rule; but the rule does not fire
       (forcing this simplification is why we have the RULE in this example)
     * We inline f = \x. g x, in `simpl_lam`
     * So if `simpl_lam` did preInlineUnconditionally we get (g BIG)
     * Now if g has a RULE we'll simplify BIG again, and this whole thing can
       iterate.
     * However, if `f` did not have a RULE, so that BIG has /not/ already been
       simplified, we /want/ to do preInlineUnconditionally in simpl_lam.

    So we go to some effort to avoid repeatedly simplifying the same thing:

    * ApplyToVal has a (sc_dup :: DupFlag) field which records if the argument
      has been evaluated.

    * simplArg checks this flag to avoid re-simplifying.

    * simpl_lam has:
        - a case for (isSimplified dup), which goes via completeBindX, and
        - a case for an un-simplified argument, which tries preInlineUnconditionally

    * We go to some efforts to avoid unnecessarily simplifying ApplyToVal,
      in at least two places
        - In simplCast/addCoerce, where we check for isReflCo
        - In rebuildCall we avoid simplifying arguments before we have to
          (see Note [Trying rewrite rules])

    All that said /postInlineUnconditionally/ (called in `completeBind`) does
    fire in the above (f BIG) situation.  See Note [Post-inline for single-use
    things] in Simplify.Utils.  This certainly risks repeated simplification, but
    in practice seems to be a small win.

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

    {- Note [Rules and unfolding for join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have

       simplExpr (join j x = rhs                         ) cont
                 (      {- RULE j (p:ps) = blah -}       )
                 (      {- StableUnfolding j = blah -}   )
                 (in blah                                )

    Then we will push 'cont' into the rhs of 'j'.  But we should *also* push
    'cont' into the RHS of
      * Any RULEs for j, e.g. generated by SpecConstr
      * Any stable unfolding for j, e.g. the result of an INLINE pragma

    Simplifying rules and stable-unfoldings happens a bit after
    simplifying the right-hand side, so we remember whether or not it
    is a join point, and what 'cont' is, in a value of type MaybeJoinCont

    #13900 was caused by forgetting to push 'cont' into the RHS
    of a SpecConstr-generated RULE for a join point.
    -}

    simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr
                         -> InExpr -> SimplCont
                         -> SimplM (SimplFloats, OutExpr)
    simplNonRecJoinPoint :: SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecJoinPoint SimplEnv
    env CoreBndr
    bndr CoreExpr
    rhs CoreExpr
    body SimplCont
    cont
       = Bool
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isJoinId CoreBndr
    bndr ) (SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
         SimplEnv
    -> SimplCont
    -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr)
    wrapJoinCont SimplEnv
    env SimplCont
    cont ((SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
     -> SimplM (SimplFloats, CoreExpr))
    -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ \ SimplEnv
    env SimplCont
    cont ->
         do { -- We push join_cont into the join RHS and the body;
              -- and wrap wrap_cont around the whole thing
            ; let mult :: Kind
    mult   = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
                  res_ty :: Kind
    res_ty = SimplCont -> Kind
    contResultType SimplCont
    cont
            ; (env1, bndr1)    <- SimplEnv -> CoreBndr -> Kind -> Kind -> SimplM (SimplEnv, CoreBndr)
    simplNonRecJoinBndr SimplEnv
    env CoreBndr
    bndr Kind
    mult Kind
    res_ty
            ; (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (BC_Join NonRecursive cont)
            ; (floats1, env3)  <- simplJoinBind NonRecursive cont (bndr,env) (bndr2,env2) (rhs,env)
            ; (floats2, body') <- simplExprF env3 body cont
            ; return (floats1 `addFloats` floats2, body') }

    ------------------
    simplRecJoinPoint :: SimplEnv -> [(InId, InExpr)]
                      -> InExpr -> SimplCont
                      -> SimplM (SimplFloats, OutExpr)
    simplRecJoinPoint :: SimplEnv
    -> [(CoreBndr, CoreExpr)]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplRecJoinPoint SimplEnv
    env [(CoreBndr, CoreExpr)]
    pairs CoreExpr
    body SimplCont
    cont
      = SimplEnv
    -> SimplCont
    -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr)
    wrapJoinCont SimplEnv
    env SimplCont
    cont ((SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
     -> SimplM (SimplFloats, CoreExpr))
    -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ \ SimplEnv
    env SimplCont
    cont ->
        do { let bndrs :: [CoreBndr]
    bndrs  = ((CoreBndr, CoreExpr) -> CoreBndr)
    -> [(CoreBndr, CoreExpr)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, CoreExpr) -> CoreBndr
    forall a b. (a, b) -> a
    fst [(CoreBndr, CoreExpr)]
    pairs
                 mult :: Kind
    mult   = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
                 res_ty :: Kind
    res_ty = SimplCont -> Kind
    contResultType SimplCont
    cont
           ; env1 <- SimplEnv -> [CoreBndr] -> Kind -> Kind -> SimplM SimplEnv
    simplRecJoinBndrs SimplEnv
    env [CoreBndr]
    bndrs Kind
    mult Kind
    res_ty
                   -- NB: bndrs' don't have unfoldings or rules
                   -- We add them as we go down
           ; (floats1, env2)  <- simplRecBind env1 (BC_Join Recursive cont) pairs
           ; (floats2, body') <- simplExprF env2 body cont
           ; return (floats1 `addFloats` floats2, body') }

    --------------------
    wrapJoinCont :: SimplEnv -> SimplCont
                 -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, OutExpr))
                 -> SimplM (SimplFloats, OutExpr)
    -- Deal with making the continuation duplicable if necessary,
    -- and with the no-case-of-case situation.
    wrapJoinCont :: SimplEnv
    -> SimplCont
    -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr)
    wrapJoinCont SimplEnv
    env SimplCont
    cont SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    thing_inside
      | SimplCont -> Bool
    contIsStop SimplCont
    cont        -- Common case; no need for fancy footwork
      = SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    thing_inside SimplEnv
    env SimplCont
    cont

      | Bool -> Bool
    not (SimplEnv -> Bool
    seCaseCase SimplEnv
    env)
        -- See Note [Join points with -fno-case-of-case]
      = do { (floats1, expr1) <- SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    thing_inside SimplEnv
    env (Kind -> SimplCont
    mkBoringStop (SimplCont -> Kind
    contHoleType SimplCont
    cont))
           ; let (floats2, expr2) = wrapJoinFloatsX floats1 expr1
           ; (floats3, expr3) <- rebuild (env `setInScopeFromF` floats2) expr2 cont
           ; return (floats2 `addFloats` floats3, expr3) }

      | Bool
    otherwise
        -- Normal case; see Note [Join points and case-of-case]
      = do { (floats1, cont')  <- SimplEnv -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableCont SimplEnv
    env SimplCont
    cont
           ; (floats2, result) <- thing_inside (env `setInScopeFromF` floats1) cont'
           ; return (floats1 `addFloats` floats2, result) }

    --------------------
    trimJoinCont :: Id         -- Used only in error message
                 -> JoinPointHood
                 -> SimplCont -> SimplCont
    -- Drop outer context from join point invocation (jump)
    -- See Note [Join points and case-of-case]

    trimJoinCont :: CoreBndr -> JoinPointHood -> SimplCont -> SimplCont
    trimJoinCont CoreBndr
    _ JoinPointHood
    NotJoinPoint SimplCont
    cont
      = SimplCont
    cont -- Not a jump
    trimJoinCont CoreBndr
    var (JoinPoint Int
    arity) SimplCont
    cont
      = Int -> SimplCont -> SimplCont
    trim Int
    arity SimplCont
    cont
      where
        trim :: Int -> SimplCont -> SimplCont
    trim Int
    0 cont :: SimplCont
    cont@(Stop {})
          = SimplCont
    cont
        trim Int
    0 SimplCont
    cont
          = Kind -> SimplCont
    mkBoringStop (SimplCont -> Kind
    contResultType SimplCont
    cont)
        trim Int
    n cont :: SimplCont
    cont@(ApplyToVal { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    k })
          = SimplCont
    cont { sc_cont = trim (n-1) k }
        trim Int
    n cont :: SimplCont
    cont@(ApplyToTy { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    k })
          = SimplCont
    cont { sc_cont = trim (n-1) k } -- join arity counts types!
        trim Int
    _ SimplCont
    cont
          = String -> SDoc -> SimplCont
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "completeCall" (SDoc -> SimplCont) -> SDoc -> SimplCont
    forall a b. (a -> b) -> a -> b
    $ CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    var SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SimplCont -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SimplCont
    cont

    {- Note [Join points and case-of-case]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we perform the case-of-case transform (or otherwise push continuations
    inward), we want to treat join points specially. Since they're always
    tail-called and we want to maintain this invariant, we can do this (for any
    evaluation context E):

      E[join j = e
        in case ... of
             A -> jump j 1
             B -> jump j 2
             C -> f 3]

        -->

      join j = E[e]
      in case ... of
           A -> jump j 1
           B -> jump j 2
           C -> E[f 3]

    As is evident from the example, there are two components to this behavior:

      1. When entering the RHS of a join point, copy the context inside.
      2. When a join point is invoked, discard the outer context.

    We need to be very careful here to remain consistent---neither part is
    optional!

    We need do make the continuation E duplicable (since we are duplicating it)
    with mkDupableCont.

    Note [Join points with -fno-case-of-case]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Supose case-of-case is switched off, and we are simplifying

        case (join j x = <j-rhs> in
              case y of
                 A -> j 1
                 B -> j 2
                 C -> e) of <outer-alts>

    Usually, we'd push the outer continuation (case . of <outer-alts>) into
    both the RHS and the body of the join point j.  But since we aren't doing
    case-of-case we may then end up with this totally bogus result

        join x = case <j-rhs> of <outer-alts> in
        case (case y of
                 A -> j 1
                 B -> j 2
                 C -> e) of <outer-alts>

    This would be OK in the language of the paper, but not in GHC: j is no longer
    a join point.  We can only do the "push continuation into the RHS of the
    join point j" if we also push the continuation right down to the /jumps/ to
    j, so that it can evaporate there.  If we are doing case-of-case, we'll get to

        join x = case <j-rhs> of <outer-alts> in
        case y of
          A -> j 1
          B -> j 2
          C -> case e of <outer-alts>

    which is great.

    Bottom line: if case-of-case is off, we must stop pushing the continuation
    inwards altogether at any join point.  Instead simplify the (join ... in ...)
    with a Stop continuation, and wrap the original continuation around the
    outside.  Surprisingly tricky!

    ************************************************************************
    *                                                                      *
                         Variables
    *                                                                      *
    ************************************************************************

    Note [zapSubstEnv]
    ~~~~~~~~~~~~~~~~~~
    When simplifying something that has already been simplified, be sure to
    zap the SubstEnv.  This is VITAL.  Consider
         let x = e in
         let y = \z -> ...x... in
         \ x -> ...y...

    We'll clone the inner \x, adding x->x' in the id_subst Then when we
    inline y, we must *not* replace x by x' in the inlined copy!!

    Note [Fast path for data constructors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For applications of a data constructor worker, the full glory of
    rebuildCall is a waste of effort;
    * They never inline, obviously
    * They have no rewrite rules
    * They are not strict (see Note [Data-con worker strictness]
      in GHC.Core.DataCon)
    So it's fine to zoom straight to `rebuild` which just rebuilds the
    call in a very straightforward way.

    Some programs have a /lot/ of data constructors in the source program
    (compiler/perf/T9961 is an example), so this fast path can be very
    valuable.
    -}

    simplVar :: SimplEnv -> InVar -> SimplM OutExpr
    -- Look up an InVar in the environment
    simplVar :: SimplEnv -> CoreBndr -> SimplM CoreExpr
    simplVar SimplEnv
    env CoreBndr
    var
      -- Why $! ? See Note [Bangs in the Simplifier]
      | CoreBndr -> Bool
    isTyVar CoreBndr
    var = CoreExpr -> SimplM CoreExpr
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> SimplM CoreExpr) -> CoreExpr -> SimplM CoreExpr
    forall a b. (a -> b) -> a -> b
    $! Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type (Kind -> CoreExpr) -> Kind -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $! (SimplEnv -> CoreBndr -> Kind
    substTyVar SimplEnv
    env CoreBndr
    var)
      | CoreBndr -> Bool
    isCoVar CoreBndr
    var = CoreExpr -> SimplM CoreExpr
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> SimplM CoreExpr) -> CoreExpr -> SimplM CoreExpr
    forall a b. (a -> b) -> a -> b
    $! CoercionR -> CoreExpr
    forall b. CoercionR -> Expr b
    Coercion (CoercionR -> CoreExpr) -> CoercionR -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $! (SimplEnv -> CoreBndr -> CoercionR
    substCoVar SimplEnv
    env CoreBndr
    var)
      | Bool
    otherwise
      = case SimplEnv -> CoreBndr -> SimplSR
    substId SimplEnv
    env CoreBndr
    var of
            ContEx TvSubstEnv
    tvs CvSubstEnv
    cvs SimplIdSubst
    ids CoreExpr
    e -> let env' :: SimplEnv
    env' = SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
    setSubstEnv SimplEnv
    env TvSubstEnv
    tvs CvSubstEnv
    cvs SimplIdSubst
    ids
                                    in SimplEnv -> CoreExpr -> SimplM CoreExpr
    simplExpr SimplEnv
    env' CoreExpr
    e
            DoneId CoreBndr
    var1          -> CoreExpr -> SimplM CoreExpr
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    var1)
            DoneEx CoreExpr
    e JoinPointHood
    _           -> CoreExpr -> SimplM CoreExpr
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    e

    simplIdF :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr)
    simplIdF :: SimplEnv -> CoreBndr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplIdF SimplEnv
    env CoreBndr
    var SimplCont
    cont
      | CoreBndr -> Bool
    isDataConWorkId CoreBndr
    var         -- See Note [Fast path for data constructors]
      = SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    var) SimplCont
    cont
      | Bool
    otherwise
      = case SimplEnv -> CoreBndr -> SimplSR
    substId SimplEnv
    env CoreBndr
    var of
          ContEx TvSubstEnv
    tvs CvSubstEnv
    cvs SimplIdSubst
    ids CoreExpr
    e -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    e SimplCont
    cont
            -- Don't trimJoinCont; haven't already simplified e,
            -- so the cont is not embodied in e
            where
              env' :: SimplEnv
    env' = SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
    setSubstEnv SimplEnv
    env TvSubstEnv
    tvs CvSubstEnv
    cvs SimplIdSubst
    ids

          DoneId CoreBndr
    var1 ->
            do { rule_base <- SimplM RuleEnv
    getSimplRules
               ; let cont' = CoreBndr -> JoinPointHood -> SimplCont -> SimplCont
    trimJoinCont CoreBndr
    var1 (CoreBndr -> JoinPointHood
    idJoinPointHood CoreBndr
    var1) SimplCont
    cont
                     info  = SimplEnv -> RuleEnv -> CoreBndr -> SimplCont -> ArgInfo
    mkArgInfo SimplEnv
    env RuleEnv
    rule_base CoreBndr
    var1 SimplCont
    cont'
               ; rebuildCall env info cont' }

          DoneEx CoreExpr
    e JoinPointHood
    mb_join -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    e SimplCont
    cont'
            where
              cont' :: SimplCont
    cont' = CoreBndr -> JoinPointHood -> SimplCont -> SimplCont
    trimJoinCont CoreBndr
    var JoinPointHood
    mb_join SimplCont
    cont
              env' :: SimplEnv
    env'  = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env  -- See Note [zapSubstEnv]

    ---------------------------------------------------------
    --      Dealing with a call site

    rebuildCall :: SimplEnv -> ArgInfo -> SimplCont
                -> SimplM (SimplFloats, OutExpr)

    ---------- Bottoming applications --------------
    rebuildCall :: SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo { ai_fun :: ArgInfo -> CoreBndr
    ai_fun = CoreBndr
    fun, ai_args :: ArgInfo -> [ArgSpec]
    ai_args = [ArgSpec]
    rev_args, ai_dmds :: ArgInfo -> [Demand]
    ai_dmds = [] }) SimplCont
    cont
      -- When we run out of strictness args, it means
      -- that the call is definitely bottom; see GHC.Core.Opt.Simplify.Utils.mkArgInfo
      -- Then we want to discard the entire strict continuation.  E.g.
      --    * case (error "hello") of { ... }
      --    * (error "Hello") arg
      --    * f (error "Hello") where f is strict
      --    etc
      -- Then, especially in the first of these cases, we'd like to discard
      -- the continuation, leaving just the bottoming expression.  But the
      -- type might not be right, so we may have to add a coerce.
      | Bool -> Bool
    not (SimplCont -> Bool
    contIsTrivial SimplCont
    cont)     -- Only do this if there is a non-trivial
                                     -- continuation to discard, else we do it
                                     -- again and again!
      = Kind -> ()
    seqType Kind
    cont_ty ()
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a b. a -> b -> b
    `seq`        -- See Note [Avoiding space leaks in OutType]
        (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, CoreExpr -> Kind -> CoreExpr
    castBottomExpr CoreExpr
    res Kind
    cont_ty)
      where
        res :: CoreExpr
    res     = CoreBndr -> [ArgSpec] -> CoreExpr
    argInfoExpr CoreBndr
    fun [ArgSpec]
    rev_args
        cont_ty :: Kind
    cont_ty = SimplCont -> Kind
    contResultType SimplCont
    cont

    ---------- Try inlining, if ai_rewrite = TryInlining --------
    -- In the TryInlining case we try inlining immediately, before simplifying
    -- any (more) arguments. Why?  See Note [Rewrite rules and inlining].
    --
    -- If there are rewrite rules we'll skip this case until we have
    -- simplified enough args to satisfy nr_wanted==0 in the TryRules case below
    -- Then we'll try the rules, and if that fails, we'll do TryInlining
    rebuildCall SimplEnv
    env info :: ArgInfo
    info@(ArgInfo { ai_fun :: ArgInfo -> CoreBndr
    ai_fun = CoreBndr
    fun, ai_args :: ArgInfo -> [ArgSpec]
    ai_args = [ArgSpec]
    rev_args
                                  , ai_rewrite :: ArgInfo -> RewriteCall
    ai_rewrite = RewriteCall
    TryInlining }) SimplCont
    cont
      = do { logger <- SimplM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
           ; let full_cont = SimplEnv -> [ArgSpec] -> SimplCont -> SimplCont
    pushSimplifiedRevArgs SimplEnv
    env [ArgSpec]
    rev_args SimplCont
    cont
           ; mb_inline <- tryInlining env logger fun full_cont
           ; case mb_inline of
                Just CoreExpr
    expr -> do { Tick -> SimplM ()
    checkedTick (CoreBndr -> Tick
    UnfoldingDone CoreBndr
    fun)
                                ; let env1 :: SimplEnv
    env1 = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env
                                ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env1 CoreExpr
    expr SimplCont
    full_cont }
                Maybe CoreExpr
    Nothing -> SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo
    info { ai_rewrite = TryNothing }) SimplCont
    cont
           }

    ---------- Try rewrite RULES, if ai_rewrite = TryRules --------------
    -- See Note [Rewrite rules and inlining]
    -- See also Note [Trying rewrite rules]
    rebuildCall SimplEnv
    env info :: ArgInfo
    info@(ArgInfo { ai_fun :: ArgInfo -> CoreBndr
    ai_fun = CoreBndr
    fun, ai_args :: ArgInfo -> [ArgSpec]
    ai_args = [ArgSpec]
    rev_args
                                  , ai_rewrite :: ArgInfo -> RewriteCall
    ai_rewrite = TryRules Int
    nr_wanted [CoreRule]
    rules }) SimplCont
    cont
      | Int
    nr_wanted Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    || Bool
    no_more_args
      = -- We've accumulated a simplified call in <fun,rev_args>
        -- so try rewrite rules; see Note [RULES apply to simplified arguments]
        -- See also Note [Rules for recursive functions]
        do { mb_match <- SimplEnv
    -> [CoreRule]
    -> CoreBndr
    -> [ArgSpec]
    -> SimplCont
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    tryRules SimplEnv
    env [CoreRule]
    rules CoreBndr
    fun ([ArgSpec] -> [ArgSpec]
    forall a. [a] -> [a]
    reverse [ArgSpec]
    rev_args) SimplCont
    cont
           ; case mb_match of
                 Just (SimplEnv
    env', CoreExpr
    rhs, SimplCont
    cont') -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    rhs SimplCont
    cont'
                 Maybe (SimplEnv, CoreExpr, SimplCont)
    Nothing -> SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo
    info { ai_rewrite = TryInlining }) SimplCont
    cont }
      where
        -- If we have run out of arguments, just try the rules; there might
        -- be some with lower arity.  Casts get in the way -- they aren't
        -- allowed on rule LHSs
        no_more_args :: Bool
    no_more_args = case SimplCont
    cont of
                          ApplyToTy  {} -> Bool
    False
                          ApplyToVal {} -> Bool
    False
                          SimplCont
    _             -> Bool
    True

    ---------- Simplify type applications and casts --------------
    rebuildCall SimplEnv
    env ArgInfo
    info (CastIt { sc_co :: SimplCont -> CoercionR
    sc_co = CoercionR
    co, sc_opt :: SimplCont -> Bool
    sc_opt = Bool
    opt, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })
      = SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo -> CoercionR -> ArgInfo
    addCastTo ArgInfo
    info CoercionR
    co') SimplCont
    cont
      where
        co' :: CoercionR
    co' = SimplEnv -> CoercionR -> Bool -> CoercionR
    optOutCoercion SimplEnv
    env CoercionR
    co Bool
    opt

    rebuildCall SimplEnv
    env ArgInfo
    info (ApplyToTy { sc_arg_ty :: SimplCont -> Kind
    sc_arg_ty = Kind
    arg_ty, sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    hole_ty, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })
      = SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo -> Kind -> Kind -> ArgInfo
    addTyArgTo ArgInfo
    info Kind
    arg_ty Kind
    hole_ty) SimplCont
    cont

    ---------- The runRW# rule. Do this after absorbing all arguments ------
    -- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep.
    --
    -- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o
    -- K[ runRW# rr ty body ]   -->   runRW rr' ty' (\s. K[ body s ])
    rebuildCall SimplEnv
    env (ArgInfo { ai_fun :: ArgInfo -> CoreBndr
    ai_fun = CoreBndr
    fun_id, ai_args :: ArgInfo -> [ArgSpec]
    ai_args = [ArgSpec]
    rev_args })
                (ApplyToVal { sc_arg :: SimplCont -> CoreExpr
    sc_arg = CoreExpr
    arg, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    arg_se
                            , sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont, sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    fun_ty })
      | CoreBndr
    fun_id CoreBndr -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    runRWKey
      , [ TyArg { as_arg_ty :: ArgSpec -> Kind
    as_arg_ty = Kind
    hole_ty }, TyArg {} ] <- [ArgSpec]
    rev_args
      -- Do this even if (contIsStop cont), or if seCaseCase is off.
      -- See Note [No eta-expansion in runRW#]
      = do { let arg_env :: SimplEnv
    arg_env = SimplEnv
    arg_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env

                 overall_res_ty :: Kind
    overall_res_ty  = SimplCont -> Kind
    contResultType SimplCont
    cont
                 -- hole_ty is the type of the current runRW# application
                 (SimplCont
    outer_cont, Kind
    new_runrw_res_ty, SimplCont
    inner_cont)
                    | SimplEnv -> Bool
    seCaseCase SimplEnv
    env = (Kind -> SimplCont
    mkBoringStop Kind
    overall_res_ty, Kind
    overall_res_ty, SimplCont
    cont)
                    | Bool
    otherwise      = (SimplCont
    cont, Kind
    hole_ty, Kind -> SimplCont
    mkBoringStop Kind
    hole_ty)
                    -- Only when case-of-case is on. See GHC.Driver.Config.Core.Opt.Simplify
                    --    Note [Case-of-case and full laziness]

           -- If the argument is a literal lambda already, take a short cut
           -- This isn't just efficiency:
           --    * If we don't do this we get a beta-redex every time, so the
           --      simplifier keeps doing more iterations.
           --    * Even more important: see Note [No eta-expansion in runRW#]
           ; arg' <- case CoreExpr
    arg of
               Lam CoreBndr
    s CoreExpr
    body -> do { (env', s') <- SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplBinder SimplEnv
    arg_env CoreBndr
    s
                                ; body' <- simplExprC env' body inner_cont
                                ; return (Lam s' body') }
                                -- Important: do not try to eta-expand this lambda
                                -- See Note [No eta-expansion in runRW#]

               CoreExpr
    _ -> do { s' <- FastString -> Kind -> Kind -> SimplM CoreBndr
    newId (String -> FastString
    fsLit String
    "s") Kind
    ManyTy Kind
    realWorldStatePrimTy
                       ; let (m,_,_) = splitFunTy fun_ty
                             env'  = SimplEnv
    arg_env SimplEnv -> [CoreBndr] -> SimplEnv
    `addNewInScopeIds` [CoreBndr
    s']
                             cont' = ApplyToVal { sc_dup :: DupFlag
    sc_dup = DupFlag
    Simplified, sc_arg :: CoreExpr
    sc_arg = CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    s'
                                                , sc_env :: SimplEnv
    sc_env = SimplEnv
    env', sc_cont :: SimplCont
    sc_cont = SimplCont
    inner_cont
                                                , sc_hole_ty :: Kind
    sc_hole_ty = HasDebugCallStack => Kind -> Kind -> Kind -> Kind
    Kind -> Kind -> Kind -> Kind
    mkVisFunTy Kind
    m Kind
    realWorldStatePrimTy Kind
    new_runrw_res_ty }
                                    -- cont' applies to s', then K
                       ; body' <- simplExprC env' arg cont'
                       ; return (Lam s' body') }

           ; let rr'   = HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    getRuntimeRep Kind
    new_runrw_res_ty
                 call' = CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    fun_id) [Kind -> CoreExpr
    forall b. Kind -> Expr b
    mkTyArg Kind
    rr', Kind -> CoreExpr
    forall b. Kind -> Expr b
    mkTyArg Kind
    new_runrw_res_ty, CoreExpr
    arg']
           ; rebuild env call' outer_cont }

    ---------- Simplify value arguments --------------------
    rebuildCall SimplEnv
    env ArgInfo
    fun_info
                (ApplyToVal { sc_arg :: SimplCont -> CoreExpr
    sc_arg = CoreExpr
    arg, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    arg_se
                            , sc_dup :: SimplCont -> DupFlag
    sc_dup = DupFlag
    dup_flag, sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    fun_ty
                            , sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })
      -- Argument is already simplified
      | DupFlag -> Bool
    isSimplified DupFlag
    dup_flag     -- See Note [Avoid redundant simplification]
      = SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo -> CoreExpr -> Kind -> ArgInfo
    addValArgTo ArgInfo
    fun_info CoreExpr
    arg Kind
    fun_ty) SimplCont
    cont

      -- Strict arguments
      | ArgInfo -> Bool
    isStrictArgInfo ArgInfo
    fun_info
      , SimplEnv -> Bool
    seCaseCase SimplEnv
    env    -- Only when case-of-case is on. See GHC.Driver.Config.Core.Opt.Simplify
                          --    Note [Case-of-case and full laziness]
      = -- pprTrace "Strict Arg" (ppr arg $$ ppr (seIdSubst env) $$ ppr (seInScope env)) $
        SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF (SimplEnv
    arg_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) CoreExpr
    arg
                   (StrictArg { sc_fun :: ArgInfo
    sc_fun = ArgInfo
    fun_info, sc_fun_ty :: Kind
    sc_fun_ty = Kind
    fun_ty
                              , sc_dup :: DupFlag
    sc_dup = DupFlag
    Simplified
                              , sc_cont :: SimplCont
    sc_cont = SimplCont
    cont })
                    -- Note [Shadowing in the Simplifier]

      -- Lazy arguments
      | Bool
    otherwise
            -- DO NOT float anything outside, hence simplExprC
            -- There is no benefit (unlike in a let-binding), and we'd
            -- have to be very careful about bogus strictness through
            -- floating a demanded let.
      = do  { (_, _, arg') <- SimplEnv
    -> DupFlag
    -> Kind
    -> Maybe ArgInfo
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplLazyArg SimplEnv
    env DupFlag
    dup_flag Kind
    fun_ty (ArgInfo -> Maybe ArgInfo
    forall a. a -> Maybe a
    Just ArgInfo
    fun_info) SimplEnv
    arg_se CoreExpr
    arg
            ; rebuildCall env (addValArgTo fun_info  arg' fun_ty) cont }

    ---------- No further useful info, revert to generic rebuild ------------
    rebuildCall SimplEnv
    env (ArgInfo { ai_fun :: ArgInfo -> CoreBndr
    ai_fun = CoreBndr
    fun, ai_args :: ArgInfo -> [ArgSpec]
    ai_args = [ArgSpec]
    rev_args }) SimplCont
    cont
      = SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (CoreBndr -> [ArgSpec] -> CoreExpr
    argInfoExpr CoreBndr
    fun [ArgSpec]
    rev_args) SimplCont
    cont

    -----------------------------------
    tryInlining :: SimplEnv -> Logger -> OutId -> SimplCont -> SimplM (Maybe OutExpr)
    tryInlining :: SimplEnv
    -> Logger -> CoreBndr -> SimplCont -> SimplM (Maybe CoreExpr)
    tryInlining SimplEnv
    env Logger
    logger CoreBndr
    var SimplCont
    cont
      | Just CoreExpr
    expr <- SimplEnv
    -> Logger
    -> CoreBndr
    -> Bool
    -> [ArgSummary]
    -> CallCtxt
    -> Maybe CoreExpr
    callSiteInline SimplEnv
    env Logger
    logger CoreBndr
    var Bool
    lone_variable [ArgSummary]
    arg_infos CallCtxt
    interesting_cont
      = do { CoreExpr -> SimplCont -> SimplM ()
    dump_inline CoreExpr
    expr SimplCont
    cont
           ; Maybe CoreExpr -> SimplM (Maybe CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    expr) }

      | Bool
    otherwise
      = Maybe CoreExpr -> SimplM (Maybe CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CoreExpr
    forall a. Maybe a
    Nothing

      where
        (Bool
    lone_variable, [ArgSummary]
    arg_infos, SimplCont
    call_cont) = SimplCont -> (Bool, [ArgSummary], SimplCont)
    contArgs SimplCont
    cont
        interesting_cont :: CallCtxt
    interesting_cont = SimplEnv -> SimplCont -> CallCtxt
    interestingCallContext SimplEnv
    env SimplCont
    call_cont

        log_inlining :: SDoc -> SimplM ()
    log_inlining SDoc
    doc
          = IO () -> SimplM ()
    forall a. IO a -> SimplM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> SimplM ()) -> IO () -> SimplM ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    logDumpFile Logger
    logger (NamePprCtx -> PprStyle
    mkDumpStyle NamePprCtx
    alwaysQualify)
               DumpFlag
    Opt_D_dump_inlinings
               String
    "" DumpFormat
    FormatText SDoc
    doc

        dump_inline :: CoreExpr -> SimplCont -> SimplM ()
    dump_inline CoreExpr
    unfolding SimplCont
    cont
          | Bool -> Bool
    not (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_inlinings) = () -> SimplM ()
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          | Bool -> Bool
    not (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_verbose_core2core)
          = Bool -> SimplM () -> SimplM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Name -> Bool
    isExternalName (CoreBndr -> Name
    idName CoreBndr
    var)) (SimplM () -> SimplM ()) -> SimplM () -> SimplM ()
    forall a b. (a -> b) -> a -> b
    $
                SDoc -> SimplM ()
    log_inlining (SDoc -> SimplM ()) -> SDoc -> SimplM ()
    forall a b. (a -> b) -> a -> b
    $
                    [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Inlining done:", Int -> SDoc -> SDoc
    nest Int
    4 (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    var)]
          | Bool
    otherwise
          = SDoc -> SimplM ()
    log_inlining (SDoc -> SimplM ()) -> SDoc -> SimplM ()
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Inlining done: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    var,
                    Int -> SDoc -> SDoc
    nest Int
    4 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Inlined fn: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc -> SDoc
    nest Int
    2 (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    unfolding),
                                  String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Cont:  " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SimplCont -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SimplCont
    cont])]

    {- Note [Trying rewrite rules]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider an application (f e1 e2 e3) where the e1,e2,e3 are not yet
    simplified.  We want to simplify enough arguments to allow the rules
    to apply, but it's more efficient to avoid simplifying e2,e3 if e1 alone
    is sufficient.  Example: class ops
       (+) dNumInt e2 e3
    If we rewrite ((+) dNumInt) to plusInt, we can take advantage of the
    latter's strictness when simplifying e2, e3.  Moreover, suppose we have
      RULE  f Int = \x. x True

    Then given (f Int e1) we rewrite to
       (\x. x True) e1
    without simplifying e1.  Now we can inline x into its unique call site,
    and absorb the True into it all in the same pass.  If we simplified
    e1 first, we couldn't do that; see Note [Avoiding simplifying repeatedly].

    So we try to apply rules if either
      (a) no_more_args: we've run out of argument that the rules can "see"
      (b) nr_wanted: none of the rules wants any more arguments

    Note [RULES apply to simplified arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's very desirable to try RULES once the arguments have been simplified, because
    doing so ensures that rule cascades work in one pass.  Consider
       {-# RULES g (h x) = k x
                 f (k x) = x #-}
       ...f (g (h x))...
    Then we want to rewrite (g (h x)) to (k x) and only then try f's rules. If
    we match f's rules against the un-simplified RHS, it won't match.  This
    makes a particularly big difference when superclass selectors are involved:
            op ($p1 ($p2 (df d)))
    We want all this to unravel in one sweep.

    Note [Rewrite rules and inlining]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In general we try to arrange that inlining is disabled (via a pragma) if
    a rewrite rule should apply, so that the rule has a decent chance to fire
    before we inline the function.

    But it turns out that (especially when type-class specialisation or
    SpecConstr is involved) it is very helpful for the the rewrite rule to
    "win" over inlining when both are active at once: see #21851, #22097.

    The simplifier arranges to do this, as follows. In effect, the ai_rewrite
    field of the ArgInfo record is the state of a little state-machine:

    * mkArgInfo sets the ai_rewrite field to TryRules if there are any rewrite
      rules avaialable for that function.

    * rebuildCall simplifies arguments until enough are simplified to match the
      rule with greatest arity.  See Note [RULES apply to simplified arguments]
      and the first field of `TryRules`.

      But no more! As soon as we have simplified enough arguments to satisfy the
      maximum-arity rules, we try the rules; see Note [Trying rewrite rules].

    * Once we have tried rules (or immediately if there are no rules) set
      ai_rewrite to TryInlining, and the Simplifier will try to inline the
      function.  We want to try this immediately (before simplifying any (more)
      arguments). Why? Consider
          f BIG      where   f = \x{OneOcc}. ...x...
      If we inline `f` before simplifying `BIG` well use preInlineUnconditionally,
      and we'll simplify BIG once, at x's occurrence, rather than twice.

    * GHC.Core.Opt.Simplify.Utils. mkRewriteCall: if there are no rules, and no
      unfolding, we can skip both TryRules and TryInlining, which saves work.

    Note [Avoid redundant simplification]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Because RULES apply to simplified arguments, there's a danger of repeatedly
    simplifying already-simplified arguments.  An important example is that of
            (>>=) d e1 e2
    Here e1, e2 are simplified before the rule is applied, but don't really
    participate in the rule firing. So we mark them as Simplified to avoid
    re-simplifying them.

    Note [Shadowing in the Simplifier]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    This part of the simplifier may return an expression that has shadowing.
    (See Note [Shadowing in Core] in GHC.Core.hs.) Consider
            f (...(\a -> e)...) (case y of (a,b) -> e')
    where f is strict in its second arg
    If we simplify the innermost one first we get (...(\a -> e)...)
    Simplifying the second arg makes us float the case out, so we end up with
            case y of (a,b) -> f (...(\a -> e)...) e'
    So the output does not have the no-shadowing invariant.  However, there is
    no danger of getting name-capture, because when the first arg was simplified
    we used an in-scope set that at least mentioned all the variables free in its
    static environment, and that is enough.

    We can't just do innermost first, or we'd end up with a dual problem:
            case x of (a,b) -> f e (...(\a -> e')...)

    I spent hours trying to recover the no-shadowing invariant, but I just could
    not think of an elegant way to do it.  The simplifier is already knee-deep in
    continuations.  We have to keep the right in-scope set around; AND we have
    to get the effect that finding (error "foo") in a strict arg position will
    discard the entire application and replace it with (error "foo").  Getting
    all this at once is TOO HARD!

    See also Note [Shadowing in prepareAlts] in GHC.Core.Opt.Simplify.Utils.

    Note [No eta-expansion in runRW#]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we see `runRW# (\s. blah)` we must not attempt to eta-expand that
    lambda.  Why not?  Because
    * `blah` can mention join points bound outside the runRW#
    * eta-expansion uses arityType, and
    * `arityType` cannot cope with free join Ids:

    So the simplifier spots the literal lambda, and simplifies inside it.
    It's a very special lambda, because it is the one the OccAnal spots and
    allows join points bound /outside/ to be called /inside/.

    See Note [No free join points in arityType] in GHC.Core.Opt.Arity

    ************************************************************************
    *                                                                      *
                    Rewrite rules
    *                                                                      *
    ************************************************************************
    -}

    tryRules :: SimplEnv -> [CoreRule]
             -> Id
             -> [ArgSpec]   -- In /normal, forward/ order
             -> SimplCont
             -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))

    tryRules :: SimplEnv
    -> [CoreRule]
    -> CoreBndr
    -> [ArgSpec]
    -> SimplCont
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    tryRules SimplEnv
    env [CoreRule]
    rules CoreBndr
    fn [ArgSpec]
    args SimplCont
    call_cont
      | [CoreRule] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    rules
      = Maybe (SimplEnv, CoreExpr, SimplCont)
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (SimplEnv, CoreExpr, SimplCont)
    forall a. Maybe a
    Nothing

      | Just (CoreRule
    rule, CoreExpr
    rule_rhs) <- RuleOpts
    -> InScopeEnv
    -> (Activation -> Bool)
    -> CoreBndr
    -> [CoreExpr]
    -> [CoreRule]
    -> Maybe (CoreRule, CoreExpr)
    lookupRule RuleOpts
    ropts (SimplEnv -> InScopeEnv
    getUnfoldingInRuleMatch SimplEnv
    env)
                                            (SimplMode -> Activation -> Bool
    activeRule (SimplEnv -> SimplMode
    seMode SimplEnv
    env)) CoreBndr
    fn
                                            ([ArgSpec] -> [CoreExpr]
    argInfoAppArgs [ArgSpec]
    args) [CoreRule]
    rules
      -- Fire a rule for the function
      = do { logger <- SimplM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
           ; checkedTick (RuleFired (ruleName rule))
           ; let cont' = SimplEnv -> [ArgSpec] -> SimplCont -> SimplCont
    pushSimplifiedArgs SimplEnv
    zapped_env
                                            (Int -> [ArgSpec] -> [ArgSpec]
    forall a. Int -> [a] -> [a]
    drop (CoreRule -> Int
    ruleArity CoreRule
    rule) [ArgSpec]
    args)
                                            SimplCont
    call_cont
                         -- (ruleArity rule) says how
                         -- many args the rule consumed

                 occ_anald_rhs = CoreExpr -> CoreExpr
    occurAnalyseExpr CoreExpr
    rule_rhs
                     -- See Note [Occurrence-analyse after rule firing]
           ; dump logger rule rule_rhs
           ; return (Just (zapped_env, occ_anald_rhs, cont')) }
                -- The occ_anald_rhs and cont' are all Out things
                -- hence zapping the environment

      | Bool
    otherwise  -- No rule fires
      = do { logger <- SimplM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
           ; nodump logger  -- This ensures that an empty file is written
           ; return Nothing }

      where
        ropts :: RuleOpts
    ropts      = SimplEnv -> RuleOpts
    seRuleOpts SimplEnv
    env
        zapped_env :: SimplEnv
    zapped_env = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env  -- See Note [zapSubstEnv]

        printRuleModule :: CoreRule -> doc
    printRuleModule CoreRule
    rule
          = doc -> doc
    forall doc. IsLine doc => doc -> doc
    parens (doc -> (Module -> doc) -> Maybe Module -> doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> doc
    forall doc. IsLine doc => String -> doc
    text String
    "BUILTIN")
                          (ModuleName -> doc
    forall doc. IsLine doc => ModuleName -> doc
    pprModuleName (ModuleName -> doc) -> (Module -> ModuleName) -> Module -> doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName)
                          (CoreRule -> Maybe Module
    ruleModule CoreRule
    rule))

        dump :: Logger -> CoreRule -> CoreExpr -> SimplM ()
    dump Logger
    logger CoreRule
    rule CoreExpr
    rule_rhs
          | Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_rule_rewrites
          = DumpFlag -> String -> SDoc -> SimplM ()
    forall {m :: * -> *}.
    (HasLogger m, MonadIO m) =>
    DumpFlag -> String -> SDoc -> m ()
    log_rule DumpFlag
    Opt_D_dump_rule_rewrites String
    "Rule fired" (SDoc -> SimplM ()) -> SDoc -> SimplM ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
              [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FastString -> SDoc
    forall doc. IsLine doc => FastString -> doc
    ftext (CoreRule -> FastString
    ruleName CoreRule
    rule)
              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Module:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>  CoreRule -> SDoc
    forall {doc}. IsLine doc => CoreRule -> doc
    printRuleModule CoreRule
    rule
              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Before:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> Int -> SDoc -> SDoc
    hang (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    fn) Int
    2 ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep ((ArgSpec -> SDoc) -> [ArgSpec] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ArgSpec -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ArgSpec]
    args))
              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "After: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> Int -> SDoc -> SDoc
    hang (CoreExpr -> SDoc
    forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr CoreExpr
    rule_rhs) Int
    2
                                   ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (ArgSpec -> SDoc) -> [ArgSpec] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ArgSpec -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([ArgSpec] -> [SDoc]) -> [ArgSpec] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ Int -> [ArgSpec] -> [ArgSpec]
    forall a. Int -> [a] -> [a]
    drop (CoreRule -> Int
    ruleArity CoreRule
    rule) [ArgSpec]
    args)
              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Cont:  " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SimplCont -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SimplCont
    call_cont ]

          | Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_rule_firings
          = DumpFlag -> String -> SDoc -> SimplM ()
    forall {m :: * -> *}.
    (HasLogger m, MonadIO m) =>
    DumpFlag -> String -> SDoc -> m ()
    log_rule DumpFlag
    Opt_D_dump_rule_firings String
    "Rule fired:" (SDoc -> SimplM ()) -> SDoc -> SimplM ()
    forall a b. (a -> b) -> a -> b
    $
              FastString -> SDoc
    forall doc. IsLine doc => FastString -> doc
    ftext (CoreRule -> FastString
    ruleName CoreRule
    rule)
                SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreRule -> SDoc
    forall {doc}. IsLine doc => CoreRule -> doc
    printRuleModule CoreRule
    rule

          | Bool
    otherwise
          = () -> SimplM ()
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        nodump :: Logger -> m ()
    nodump Logger
    logger
          | Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_rule_rewrites
          = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $
              Logger -> DumpFlag -> IO ()
    touchDumpFile Logger
    logger DumpFlag
    Opt_D_dump_rule_rewrites

          | Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_rule_firings
          = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $
              Logger -> DumpFlag -> IO ()
    touchDumpFile Logger
    logger DumpFlag
    Opt_D_dump_rule_firings

          | Bool
    otherwise
          = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        log_rule :: DumpFlag -> String -> SDoc -> m ()
    log_rule DumpFlag
    flag String
    hdr SDoc
    details
          = do
          { logger <- m Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
          ; liftIO $ logDumpFile logger (mkDumpStyle alwaysQualify) flag "" FormatText
                   $ sep [text hdr, nest 4 details]
          }

    trySeqRules :: SimplEnv
                -> OutExpr -> InExpr   -- Scrutinee and RHS
                -> SimplCont
                -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    -- See Note [User-defined RULES for seq]
    trySeqRules :: SimplEnv
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    trySeqRules SimplEnv
    in_env CoreExpr
    scrut CoreExpr
    rhs SimplCont
    cont
      = do { rule_base <- SimplM RuleEnv
    getSimplRules
           ; tryRules in_env (getRules rule_base seqId) seqId out_args rule_cont }
      where
        no_cast_scrut :: CoreExpr
    no_cast_scrut = CoreExpr -> CoreExpr
    forall {b}. Expr b -> Expr b
    drop_casts CoreExpr
    scrut
        scrut_ty :: Kind
    scrut_ty  = HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    no_cast_scrut
        seq_id_ty :: Kind
    seq_id_ty = CoreBndr -> Kind
    idType CoreBndr
    seqId                    -- forall r a (b::TYPE r). a -> b -> b
        res1_ty :: Kind
    res1_ty   = HasDebugCallStack => Kind -> Kind -> Kind
    Kind -> Kind -> Kind
    piResultTy Kind
    seq_id_ty Kind
    rhs_rep    -- forall a (b::TYPE rhs_rep). a -> b -> b
        res2_ty :: Kind
    res2_ty   = HasDebugCallStack => Kind -> Kind -> Kind
    Kind -> Kind -> Kind
    piResultTy Kind
    res1_ty   Kind
    scrut_ty   -- forall (b::TYPE rhs_rep). scrut_ty -> b -> b
        res3_ty :: Kind
    res3_ty   = HasDebugCallStack => Kind -> Kind -> Kind
    Kind -> Kind -> Kind
    piResultTy Kind
    res2_ty   Kind
    rhs_ty     -- scrut_ty -> rhs_ty -> rhs_ty
        res4_ty :: Kind
    res4_ty   = HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    funResultTy Kind
    res3_ty             -- rhs_ty -> rhs_ty
        rhs_ty :: Kind
    rhs_ty    = HasDebugCallStack => SimplEnv -> Kind -> Kind
    SimplEnv -> Kind -> Kind
    substTy SimplEnv
    in_env (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    rhs)
        rhs_rep :: Kind
    rhs_rep   = HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    getRuntimeRep Kind
    rhs_ty
        out_args :: [ArgSpec]
    out_args  = [ TyArg { as_arg_ty :: Kind
    as_arg_ty  = Kind
    rhs_rep
                            , as_hole_ty :: Kind
    as_hole_ty = Kind
    seq_id_ty }
                    , TyArg { as_arg_ty :: Kind
    as_arg_ty  = Kind
    scrut_ty
                            , as_hole_ty :: Kind
    as_hole_ty = Kind
    res1_ty }
                    , TyArg { as_arg_ty :: Kind
    as_arg_ty  = Kind
    rhs_ty
                            , as_hole_ty :: Kind
    as_hole_ty = Kind
    res2_ty }
                    , ValArg { as_arg :: CoreExpr
    as_arg = CoreExpr
    no_cast_scrut
                             , as_dmd :: Demand
    as_dmd = Demand
    seqDmd
                             , as_hole_ty :: Kind
    as_hole_ty = Kind
    res3_ty } ]
        rule_cont :: SimplCont
    rule_cont = ApplyToVal { sc_dup :: DupFlag
    sc_dup = DupFlag
    NoDup, sc_arg :: CoreExpr
    sc_arg = CoreExpr
    rhs
                               , sc_env :: SimplEnv
    sc_env = SimplEnv
    in_env, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont
                               , sc_hole_ty :: Kind
    sc_hole_ty = Kind
    res4_ty }

        -- Lazily evaluated, so we don't do most of this

        drop_casts :: Expr b -> Expr b
    drop_casts (Cast Expr b
    e CoercionR
    _) = Expr b -> Expr b
    drop_casts Expr b
    e
        drop_casts Expr b
    e          = Expr b
    e

    {- Note [User-defined RULES for seq]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Given
       case (scrut |> co) of _ -> rhs
    look for rules that match the expression
       seq @t1 @t2 scrut
    where scrut :: t1
          rhs   :: t2

    If you find a match, rewrite it, and apply to 'rhs'.

    Notice that we can simply drop casts on the fly here, which
    makes it more likely that a rule will match.

    See Note [User-defined RULES for seq] in GHC.Types.Id.Make.

    Note [Occurrence-analyse after rule firing]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    After firing a rule, we occurrence-analyse the instantiated RHS before
    simplifying it.  Usually this doesn't make much difference, but it can
    be huge.  Here's an example (simplCore/should_compile/T7785)

      map f (map f (map f xs)

    = -- Use build/fold form of map, twice
      map f (build (\cn. foldr (mapFB c f) n
                               (build (\cn. foldr (mapFB c f) n xs))))

    = -- Apply fold/build rule
      map f (build (\cn. (\cn. foldr (mapFB c f) n xs) (mapFB c f) n))

    = -- Beta-reduce
      -- Alas we have no occurrence-analysed, so we don't know
      -- that c is used exactly once
      map f (build (\cn. let c1 = mapFB c f in
                         foldr (mapFB c1 f) n xs))

    = -- Use mapFB rule:   mapFB (mapFB c f) g = mapFB c (f.g)
      -- We can do this because (mapFB c n) is a PAP and hence expandable
      map f (build (\cn. let c1 = mapFB c n in
                         foldr (mapFB c (f.f)) n x))

    This is not too bad.  But now do the same with the outer map, and
    we get another use of mapFB, and t can interact with /both/ remaining
    mapFB calls in the above expression.  This is stupid because actually
    that 'c1' binding is dead.  The outer map introduces another c2. If
    there is a deep stack of maps we get lots of dead bindings, and lots
    of redundant work as we repeatedly simplify the result of firing rules.

    The easy thing to do is simply to occurrence analyse the result of
    the rule firing.  Note that this occ-anals not only the RHS of the
    rule, but also the function arguments, which by now are OutExprs.
    E.g.
          RULE f (g x) = x+1

    Call   f (g BIG)  -->   (\x. x+1) BIG

    The rule binders are lambda-bound and applied to the OutExpr arguments
    (here BIG) which lack all internal occurrence info.

    Is this inefficient?  Not really: we are about to walk over the result
    of the rule firing to simplify it, so occurrence analysis is at most
    a constant factor.

    Note, however, that the rule RHS is /already/ occ-analysed; see
    Note [OccInfo in unfoldings and rules] in GHC.Core.  There is something
    unsatisfactory about doing it twice; but the rule RHS is usually very
    small, and this is simple.

    Note [Rules for recursive functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    You might think that we shouldn't apply rules for a loop breaker:
    doing so might give rise to an infinite loop, because a RULE is
    rather like an extra equation for the function:
         RULE:           f (g x) y = x+y
         Eqn:            f a     y = a-y

    But it's too drastic to disable rules for loop breakers.
    Even the foldr/build rule would be disabled, because foldr
    is recursive, and hence a loop breaker:
         foldr k z (build g) = g k z
    So it's up to the programmer: rules can cause divergence

    ************************************************************************
    *                                                                      *
                    Rebuilding a case expression
    *                                                                      *
    ************************************************************************

    Note [Case elimination]
    ~~~~~~~~~~~~~~~~~~~~~~~
    The case-elimination transformation discards redundant case expressions.
    Start with a simple situation:

            case x# of      ===>   let y# = x# in e
              y# -> e

    (when x#, y# are of primitive type, of course).  We can't (in general)
    do this for algebraic cases, because we might turn bottom into
    non-bottom!

    The code in GHC.Core.Opt.Simplify.Utils.prepareAlts has the effect of generalise
    this idea to look for a case where we're scrutinising a variable, and we know
    that only the default case can match.  For example:

            case x of
              0#      -> ...
              DEFAULT -> ...(case x of
                             0#      -> ...
                             DEFAULT -> ...) ...

    Here the inner case is first trimmed to have only one alternative, the
    DEFAULT, after which it's an instance of the previous case.  This
    really only shows up in eliminating error-checking code.

    Note that GHC.Core.Opt.Simplify.Utils.mkCase combines identical RHSs.  So

            case e of       ===> case e of DEFAULT -> r
               True  -> r
               False -> r

    Now again the case may be eliminated by the CaseElim transformation.
    This includes things like (==# a# b#)::Bool so that we simplify
          case ==# a# b# of { True -> x; False -> x }
    to just
          x
    This particular example shows up in default methods for
    comparison operations (e.g. in (>=) for Int.Int32)

    Note [Case to let transformation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If a case over a lifted type has a single alternative, and is being
    used as a strict 'let' (all isDeadBinder bndrs), we may want to do
    this transformation:

        case e of r       ===>   let r = e in ...r...
          _ -> ...r...

    We treat the unlifted and lifted cases separately:

    * Unlifted case: 'e' satisfies exprOkForSpeculation
      (ok-for-spec is needed to satisfy the let-can-float invariant).
      This turns     case a +# b of r -> ...r...
      into           let r = a +# b in ...r...
      and thence     .....(a +# b)....

      However, if we have
          case indexArray# a i of r -> ...r...
      we might like to do the same, and inline the (indexArray# a i).
      But indexArray# is not okForSpeculation, so we don't build a let
      in rebuildCase (lest it get floated *out*), so the inlining doesn't
      happen either.  Annoying.

    * Lifted case: we need to be sure that the expression is already
      evaluated (exprIsHNF).  If it's not already evaluated
          - we risk losing exceptions, divergence or
            user-specified thunk-forcing
          - even if 'e' is guaranteed to converge, we don't want to
            create a thunk (call by need) instead of evaluating it
            right away (call by value)

      However, we can turn the case into a /strict/ let if the 'r' is
      used strictly in the body.  Then we won't lose divergence; and
      we won't build a thunk because the let is strict.
      See also Note [Case-to-let for strictly-used binders]

    Note [Case-to-let for strictly-used binders]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we have this:
       case <scrut> of r { _ -> ..r.. }
    where 'r' is used strictly in (..r..), we /could/ safely transform to
       let r = <scrut> in ...r...
    As a special case,  we have a plain `seq` like
       case r of r1 { _ -> ...r1... }
    where `r` is used strictly, we /could/ simply drop the `case` to get
       ...r....

    HOWEVER, there are some serious downsides to this transformation, so
    GHC doesn't do it any longer (#24251):

    * Suppose the Simplifier sees
         case x of y* { __DEFAULT ->
         let z = case y of { __DEFAULT -> expr } in
         z+1 }
      The "y*" means "y is used strictly in its scope.  Now we may:
         - Eliminate the inner case because `y` is evaluated.
      Now the demand-info on `y` is not right, because `y` is no longer used
      strictly in its scope.  But it is hard to spot that without doing a new
      demand analysis.  So there is a danger that we will subsequently:
         - Eliminate the outer case because `y` is used strictly
      Yikes!  We can't eliminate both!

    * It introduces space leaks (#24251).  Consider
          go 0 where go x = x `seq` go (x + 1)
      It is an infinite loop, true, but it should not leak space. Yet if we drop
      the `seq`, it will.  Another great example is #21741.

    * Dropping the outer `case` can change the error behaviour.  For example,
      we might transform
           case x of { _ -> error "bad" }    -->     error "bad"
      which is might be puzzling if 'x' currently lambda-bound, but later gets
      let-bound to (error "good").  Tht is OK accoring to the paper "A semantics for
      imprecise exceptions", but see #8900 for an example where the loss of this
      transformation bit us in practice.

    * If we have (case e of x -> f x), where `f` is strict, then it looks as if `x`
      is strictly used, and we could soundly transform to
         let x = e in f x
      But if f's strictness info got worse (which can happen in in obscure cases;
      see #21392) then we might have turned a non-thunk into a thunk!  Bad.

    Lacking this "drop-strictly-used-seq" transformation means we can end up with
    some redundant-looking evals.  For example, consider
        f x y = case x of DEFAULT ->    -- A redundant-looking eval
                case y of
                  True  -> case x of { Nothing -> False; Just z  -> z }
                  False -> case x of { Nothing -> True;  Just z  -> z }
    That outer eval will be retained right through to code generation.  But,
    perhaps surprisingly, that is probably a /good/ thing:

       Key point: those inner (case x) expressions will be compiled a simple 'if',
       because the code generator can see that `x` is, at those points, evaluated
       and properly tagged.

    If we dropped the outer eval, both the inner (case x) expressions would need to
    do a proper eval, pushing a return address, with an info table. See the example
    in #15631 where, in the Description, the (case ys) will be a simple multi-way
    jump.

    In fact (#24251), when I stopped GHC implementing the drop-strictly-used-seqs
    transformation, binary sizes fell by 1%, and a few programs actually allocated
    less and ran faster.  A case in point is nofib/imaginary/digits-of-e2. (I'm not
    sure exactly why it improves so much, though.)

    Slightly related: Note [Empty case alternatives] in GHC.Core.

    Historical notes:

    There have been various earlier versions of this patch:

    * By Sept 18 the code looked like this:
         || scrut_is_demanded_var scrut

        scrut_is_demanded_var :: CoreExpr -> Bool
        scrut_is_demanded_var (Cast s _) = scrut_is_demanded_var s
        scrut_is_demanded_var (Var _)    = isStrUsedDmd (idDemandInfo case_bndr)
        scrut_is_demanded_var _          = False

      This only fired if the scrutinee was a /variable/, which seems
      an unnecessary restriction. So in #15631 I relaxed it to allow
      arbitrary scrutinees.  Less code, less to explain -- but the change
      had 0.00% effect on nofib.

    * Previously, in Jan 13 the code looked like this:
         || case_bndr_evald_next rhs

        case_bndr_evald_next :: CoreExpr -> Bool
          -- See Note [Case binder next]
        case_bndr_evald_next (Var v)         = v == case_bndr
        case_bndr_evald_next (Cast e _)      = case_bndr_evald_next e
        case_bndr_evald_next (App e _)       = case_bndr_evald_next e
        case_bndr_evald_next (Case e _ _ _)  = case_bndr_evald_next e
        case_bndr_evald_next _               = False

      This patch was part of fixing #7542. See also
      Note [Eta reduction soundness], criterion (E) in GHC.Core.Utils.)

    Further notes about case elimination
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider:       test :: Integer -> IO ()
                    test = print

    Turns out that this compiles to:
        Print.test
          = \ eta :: Integer
              eta1 :: Void# ->
              case PrelNum.< eta PrelNum.zeroInteger of wild { __DEFAULT ->
              case hPutStr stdout
                     (PrelNum.jtos eta ($w[] @ Char))
                     eta1
              of wild1 { (# new_s, a4 #) -> PrelIO.lvl23 new_s  }}

    Notice the strange '<' which has no effect at all. This is a funny one.
    It started like this:

    f x y = if x < 0 then jtos x
              else if y==0 then "" else jtos x

    At a particular call site we have (f v 1).  So we inline to get

            if v < 0 then jtos x
            else if 1==0 then "" else jtos x

    Now simplify the 1==0 conditional:

            if v<0 then jtos v else jtos v

    Now common-up the two branches of the case:

            case (v<0) of DEFAULT -> jtos v

    Why don't we drop the case?  Because it's strict in v.  It's technically
    wrong to drop even unnecessary evaluations, and in practice they
    may be a result of 'seq' so we *definitely* don't want to drop those.
    I don't really know how to improve this situation.

    Note [FloatBinds from constructor wrappers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we have FloatBinds coming from the constructor wrapper
    (as in Note [exprIsConApp_maybe on data constructors with wrappers]),
    we cannot float past them. We'd need to float the FloatBind
    together with the simplify floats, unfortunately the
    simplifier doesn't have case-floats. The simplest thing we can
    do is to wrap all the floats here. The next iteration of the
    simplifier will take care of all these cases and lets.

    Given data T = MkT !Bool, this allows us to simplify
    case $WMkT b of { MkT x -> f x }
    to
    case b of { b' -> f b' }.

    We could try and be more clever (like maybe wfloats only contain
    let binders, so we could float them). But the need for the
    extra complication is not clear.

    Note [Do not duplicate constructor applications]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this (#20125)
       let x = (a,b)
       in ...(case x of x' -> blah)...x...x...

    We want that `case` to vanish (since `x` is bound to a data con) leaving
       let x = (a,b)
       in ...(let x'=x in blah)...x..x...

    In rebuildCase, `exprIsConApp_maybe` will succeed on the scrutinee `x`,
    since is bound to (a,b).  But in eliminating the case, if the scrutinee
    is trivial, we want to bind the case-binder to the scrutinee, /not/ to
    the constructor application.  Hence the case_bndr_rhs in rebuildCase.

    This applies equally to a non-DEFAULT case alternative, say
       let x = (a,b) in ...(case x of x' { (p,q) -> blah })...
    This variant is handled by bind_case_bndr in knownCon.

    We want to bind x' to x, and not to a duplicated (a,b)).
    -}

    ---------------------------------------------------------
    --      Eliminate the case if possible

    rebuildCase, reallyRebuildCase
       :: SimplEnv
       -> OutExpr          -- Scrutinee
       -> InId             -- Case binder
       -> [InAlt]          -- Alternatives (increasing order)
       -> SimplCont
       -> SimplM (SimplFloats, OutExpr)

    --------------------------------------------------
    --      1. Eliminate the case if there's a known constructor
    --------------------------------------------------

    rebuildCase :: SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    rebuildCase SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont
      | Lit Literal
    lit <- CoreExpr
    scrut    -- No need for same treatment as constructors
                            -- because literals are inlined more vigorously
      , Bool -> Bool
    not (Literal -> Bool
    litIsLifted Literal
    lit)
      = do  { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    KnownBranch CoreBndr
    case_bndr)
            ; case AltCon -> [Alt CoreBndr] -> Maybe (Alt CoreBndr)
    forall b. AltCon -> [Alt b] -> Maybe (Alt b)
    findAlt (Literal -> AltCon
    LitAlt Literal
    lit) [Alt CoreBndr]
    alts of
                Maybe (Alt CoreBndr)
    Nothing             -> SimplEnv
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    missingAlt SimplEnv
    env CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont
                Just (Alt AltCon
    _ [CoreBndr]
    bs CoreExpr
    rhs) -> SimplEnv
    -> [FloatBind]
    -> CoreExpr
    -> [CoreBndr]
    -> CoreExpr
    -> SimplM (SimplFloats, CoreExpr)
    simple_rhs SimplEnv
    env [] CoreExpr
    scrut [CoreBndr]
    bs CoreExpr
    rhs }

      | Just (InScopeSet
    in_scope', [FloatBind]
    wfloats, DataCon
    con, [Kind]
    ty_args, [CoreExpr]
    other_args)
          <- HasDebugCallStack =>
    InScopeEnv
    -> CoreExpr
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
    InScopeEnv
    -> CoreExpr
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Kind], [CoreExpr])
    exprIsConApp_maybe (SimplEnv -> InScopeEnv
    getUnfoldingInRuleMatch SimplEnv
    env) CoreExpr
    scrut
            -- Works when the scrutinee is a variable with a known unfolding
            -- as well as when it's an explicit constructor application
      , let env0 :: SimplEnv
    env0 = SimplEnv -> InScopeSet -> SimplEnv
    setInScopeSet SimplEnv
    env InScopeSet
    in_scope'
      = do  { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    KnownBranch CoreBndr
    case_bndr)
            ; let scaled_wfloats :: [FloatBind]
    scaled_wfloats = (FloatBind -> FloatBind) -> [FloatBind] -> [FloatBind]
    forall a b. (a -> b) -> [a] -> [b]
    map FloatBind -> FloatBind
    scale_float [FloatBind]
    wfloats
                  -- case_bndr_unf: see Note [Do not duplicate constructor applications]
                  case_bndr_rhs :: CoreExpr
    case_bndr_rhs | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    scrut = CoreExpr
    scrut
                                | Bool
    otherwise           = CoreExpr
    con_app
                  con_app :: CoreExpr
    con_app = CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var (DataCon -> CoreBndr
    dataConWorkId DataCon
    con) CoreExpr -> [Kind] -> CoreExpr
    forall b. Expr b -> [Kind] -> Expr b
    `mkTyApps` [Kind]
    ty_args
                                                    CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    `mkApps`   [CoreExpr]
    other_args
            ; case AltCon -> [Alt CoreBndr] -> Maybe (Alt CoreBndr)
    forall b. AltCon -> [Alt b] -> Maybe (Alt b)
    findAlt (DataCon -> AltCon
    DataAlt DataCon
    con) [Alt CoreBndr]
    alts of
                Maybe (Alt CoreBndr)
    Nothing                   -> SimplEnv
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    missingAlt SimplEnv
    env0 CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont
                Just (Alt AltCon
    DEFAULT [CoreBndr]
    bs CoreExpr
    rhs) -> SimplEnv
    -> [FloatBind]
    -> CoreExpr
    -> [CoreBndr]
    -> CoreExpr
    -> SimplM (SimplFloats, CoreExpr)
    simple_rhs SimplEnv
    env0 [FloatBind]
    scaled_wfloats CoreExpr
    case_bndr_rhs [CoreBndr]
    bs CoreExpr
    rhs
                Just (Alt AltCon
    _       [CoreBndr]
    bs CoreExpr
    rhs) -> SimplEnv
    -> CoreExpr
    -> [FloatBind]
    -> DataCon
    -> [Kind]
    -> [CoreExpr]
    -> CoreBndr
    -> [CoreBndr]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    knownCon SimplEnv
    env0 CoreExpr
    scrut [FloatBind]
    scaled_wfloats DataCon
    con [Kind]
    ty_args
                                                      [CoreExpr]
    other_args CoreBndr
    case_bndr [CoreBndr]
    bs CoreExpr
    rhs SimplCont
    cont
            }
      where
        simple_rhs :: SimplEnv
    -> [FloatBind]
    -> CoreExpr
    -> [CoreBndr]
    -> CoreExpr
    -> SimplM (SimplFloats, CoreExpr)
    simple_rhs SimplEnv
    env [FloatBind]
    wfloats CoreExpr
    case_bndr_rhs [CoreBndr]
    bs CoreExpr
    rhs =
          Bool
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. HasCallStack => Bool -> a -> a
    assert ([CoreBndr] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreBndr]
    bs) (SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
          do { (floats1, env') <- String
    -> SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplAuxBind String
    "rebuildCase" SimplEnv
    env CoreBndr
    case_bndr CoreExpr
    case_bndr_rhs
                 -- scrut is a constructor application,
                 -- hence satisfies let-can-float invariant
             ; (floats2, expr') <- simplExprF env' rhs cont
             ; case wfloats of
                 [] -> (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    expr')
                 [FloatBind]
    _ -> (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                   -- See Note [FloatBinds from constructor wrappers]
                       ( SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env,
                         [FloatBind] -> CoreExpr -> CoreExpr
    GHC.Core.Make.wrapFloats [FloatBind]
    wfloats (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                         SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2) CoreExpr
    expr' )}

        -- This scales case floats by the multiplicity of the continuation hole (see
        -- Note [Scaling in case-of-case]).  Let floats are _not_ scaled, because
        -- they are aliases anyway.
        scale_float :: FloatBind -> FloatBind
    scale_float (GHC.Core.Make.FloatCase CoreExpr
    scrut CoreBndr
    case_bndr AltCon
    con [CoreBndr]
    vars) =
          let
            scale_id :: CoreBndr -> CoreBndr
    scale_id CoreBndr
    id = Kind -> CoreBndr -> CoreBndr
    scaleVarBy Kind
    holeScaling CoreBndr
    id
          in
          CoreExpr -> CoreBndr -> AltCon -> [CoreBndr] -> FloatBind
    GHC.Core.Make.FloatCase CoreExpr
    scrut (CoreBndr -> CoreBndr
    scale_id CoreBndr
    case_bndr) AltCon
    con ((CoreBndr -> CoreBndr) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreBndr -> CoreBndr
    scale_id [CoreBndr]
    vars)
        scale_float FloatBind
    f = FloatBind
    f

        holeScaling :: Kind
    holeScaling = SimplCont -> Kind
    contHoleScaling SimplCont
    cont Kind -> Kind -> Kind
    `mkMultMul` CoreBndr -> Kind
    idMult CoreBndr
    case_bndr
         -- We are in the following situation
         --   case[p] case[q] u of { D x -> C v } of { C x -> w }
         -- And we are producing case[??] u of { D x -> w[x\v]}
         --
         -- What should the multiplicity `??` be? In order to preserve the usage of
         -- variables in `u`, it needs to be `pq`.
         --
         -- As an illustration, consider the following
         --   case[Many] case[1] of { C x -> C x } of { C x -> (x, x) }
         -- Where C :: A %1 -> T is linear
         -- If we were to produce a case[1], like the inner case, we would get
         --   case[1] of { C x -> (x, x) }
         -- Which is ill-typed with respect to linearity. So it needs to be a
         -- case[Many].

    --------------------------------------------------
    --      2. Eliminate the case if scrutinee is evaluated
    --------------------------------------------------

    rebuildCase SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr alts :: [Alt CoreBndr]
    alts@[Alt AltCon
    _ [CoreBndr]
    bndrs CoreExpr
    rhs] SimplCont
    cont
      -- See if we can get rid of the case altogether
      -- See Note [Case elimination]
      -- mkCase made sure that if all the alternatives are equal,
      -- then there is now only one (DEFAULT) rhs

      -- 2a.  Dropping the case altogether, if
      --      a) it binds nothing (so it's really just a 'seq')
      --      b) evaluating the scrutinee has no side effects
      | Bool
    is_plain_seq
      , CoreExpr -> Bool
    exprOkToDiscard CoreExpr
    scrut
              -- The entire case is dead, so we can drop it
              -- if the scrutinee converges without having imperative
              -- side effects or raising a Haskell exception
       = SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    rhs SimplCont
    cont

      -- 2b.  Turn the case into a let, if
      --      a) it binds only the case-binder
      --      b) unlifted case: the scrutinee is ok-for-speculation
      --           lifted case: the scrutinee is in HNF (or will later be demanded)
      -- See Note [Case to let transformation]
      | Bool
    all_dead_bndrs
      , CoreExpr -> CoreBndr -> Bool
    doCaseToLet CoreExpr
    scrut CoreBndr
    case_bndr
      = do { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    CaseElim CoreBndr
    case_bndr)
           ; (floats1, env')  <- String
    -> SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplAuxBind String
    "rebuildCaseAlt1" SimplEnv
    env CoreBndr
    case_bndr CoreExpr
    scrut
           ; (floats2, expr') <- simplExprF env' rhs cont
           ; return (floats1 `addFloats` floats2, expr') }

      -- 2c. Try the seq rules if
      --     a) it binds only the case binder
      --     b) a rule for seq applies
      -- See Note [User-defined RULES for seq] in GHC.Types.Id.Make
      | Bool
    is_plain_seq
      = do { mb_rule <- SimplEnv
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    trySeqRules SimplEnv
    env CoreExpr
    scrut CoreExpr
    rhs SimplCont
    cont
           ; case mb_rule of
               Just (SimplEnv
    env', CoreExpr
    rule_rhs, SimplCont
    cont') -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    rule_rhs SimplCont
    cont'
               Maybe (SimplEnv, CoreExpr, SimplCont)
    Nothing                      -> SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    reallyRebuildCase SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont }

    --------------------------------------------------
    --      3. Primop-related case-rules
    --------------------------------------------------

      |Just (CoreExpr
    scrut', CoreBndr
    case_bndr', [Alt CoreBndr]
    alts') <- CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> Maybe (CoreExpr, CoreBndr, [Alt CoreBndr])
    caseRules2 CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts
      = SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    reallyRebuildCase SimplEnv
    env CoreExpr
    scrut' CoreBndr
    case_bndr' [Alt CoreBndr]
    alts' SimplCont
    cont

      where
        all_dead_bndrs :: Bool
    all_dead_bndrs = (CoreBndr -> Bool) -> [CoreBndr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all CoreBndr -> Bool
    isDeadBinder [CoreBndr]
    bndrs       -- bndrs are [InId]
        is_plain_seq :: Bool
    is_plain_seq   = Bool
    all_dead_bndrs Bool -> Bool -> Bool
    && CoreBndr -> Bool
    isDeadBinder CoreBndr
    case_bndr -- Evaluation *only* for effect

    rebuildCase SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont
      = SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    reallyRebuildCase SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont

    doCaseToLet :: OutExpr          -- Scrutinee
                -> InId             -- Case binder
                -> Bool
    -- The situation is         case scrut of b { DEFAULT -> body }
    -- Can we transform thus?   let { b = scrut } in body
    doCaseToLet :: CoreExpr -> CoreBndr -> Bool
    doCaseToLet CoreExpr
    scrut CoreBndr
    case_bndr
      | CoreBndr -> Bool
    isTyCoVar CoreBndr
    case_bndr    -- Respect GHC.Core
      = CoreExpr -> Bool
    forall {b}. Expr b -> Bool
    isTyCoArg CoreExpr
    scrut        -- Note [Core type and coercion invariant]

      | HasDebugCallStack => Kind -> Bool
    Kind -> Bool
    isUnliftedType (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    scrut)
        -- We can call isUnliftedType here: scrutinees always have a fixed RuntimeRep (see FRRCase).
        -- Note however that we must check 'scrut' (which is an 'OutExpr') and not 'case_bndr'
        -- (which is an 'InId'): see Note [Dark corner with representation polymorphism].
        -- Using `exprType` is typically cheap because `scrut` is typically a variable.
        -- We could instead use mightBeUnliftedType (idType case_bndr), but that hurts
        -- the brain more.  Consider that if this test ever turns out to be a perf
        -- problem (which seems unlikely).
      = CoreExpr -> Bool
    exprOkForSpeculation CoreExpr
    scrut

      | Bool
    otherwise  -- Scrut has a lifted type
      = CoreExpr -> Bool
    exprIsHNF CoreExpr
    scrut
           --    || isStrUsedDmd (idDemandInfo case_bndr)
           -- We no longer look at the demand on the case binder
           -- See Note [Case-to-let for strictly-used binders]

    --------------------------------------------------
    --      3. Catch-all case
    --------------------------------------------------

    reallyRebuildCase :: SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    reallyRebuildCase SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont
      | Bool -> Bool
    not (SimplEnv -> Bool
    seCaseCase SimplEnv
    env)    -- Only when case-of-case is on.
                                -- See GHC.Driver.Config.Core.Opt.Simplify
                                --    Note [Case-of-case and full laziness]
      = do { case_expr <- SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM CoreExpr
    simplAlts SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts
                                    (Kind -> SimplCont
    mkBoringStop (SimplCont -> Kind
    contHoleType SimplCont
    cont))
           ; rebuild env case_expr cont }

      | Bool
    otherwise
      = do { (floats, env', cont') <- SimplEnv
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, SimplEnv, SimplCont)
    mkDupableCaseCont SimplEnv
    env [Alt CoreBndr]
    alts SimplCont
    cont
           ; case_expr <- simplAlts env' scrut
                                    (scaleIdBy holeScaling case_bndr)
                                    (scaleAltsBy holeScaling alts)
                                    cont'
           ; return (floats, case_expr) }
      where
        holeScaling :: Kind
    holeScaling = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
        -- Note [Scaling in case-of-case]

    {-
    simplCaseBinder checks whether the scrutinee is a variable, v.  If so,
    try to eliminate uses of v in the RHSs in favour of case_bndr; that
    way, there's a chance that v will now only be used once, and hence
    inlined.

    Historical note: we use to do the "case binder swap" in the Simplifier
    so there were additional complications if the scrutinee was a variable.
    Now the binder-swap stuff is done in the occurrence analyser; see
    "GHC.Core.Opt.OccurAnal" Note [Binder swap].

    Note [knownCon occ info]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    If the case binder is not dead, then neither are the pattern bound
    variables:
            case <any> of x { (a,b) ->
            case x of { (p,q) -> p } }
    Here (a,b) both look dead, but come alive after the inner case is eliminated.
    The point is that we bring into the envt a binding
            let x = (a,b)
    after the outer case, and that makes (a,b) alive.  At least we do unless
    the case binder is guaranteed dead.

    Note [DataAlt occ info]
    ~~~~~~~~~~~~~~~~~~~~~~~
    Our general goal is to preserve dead-ness occ-info on the field binders of a
    case alternative. Why? It's generally a good idea, but one specific reason is to
    support (SEQ4) of Note [seq# magic].

    But we have to be careful: even if the field binder is not mentioned in the case
    alternative and thus annotated IAmDead by OccurAnal, it might "come back to
    life" in one of two ways:

     1. If the case binder is alive, its unfolding might bring back the field
        binder, as in Note [knownCon occ info]:
          case blah of y { I# _ -> $wf (case y of I# v -> v) }
          ==>
          case blah of y { I# v -> $wf v }
     2. Even if the case binder appears to be dead, there is the scenario in
        Note [Add unfolding for scrutinee], in which the fields come back to live
        through the unfolding of variable scrutinee, as follows:
          join j = case x of Just v -> blah v; Nothing -> ... in
          case x of Just _ -> jump j; Nothing -> ...
          ==> { inline j, unfold x to Just v, simplify }
          join j = case x of Just v -> blah v; Nothing -> ... in
          case x of Just v -> blah v; Nothing -> ...

    Thus, when we are simply reconstructing a case (the common case), and the
    case binder is not dead, or the scrutinee is a variable, we zap the
    occurrence info on DataAlt field binders. See `adjustFieldOccInfo`.

    Note [Improving seq]
    ~~~~~~~~~~~~~~~~~~~~
    Consider
            type family F :: * -> *
            type instance F Int = Int

    We'd like to transform
            case e of (x :: F Int) { DEFAULT -> rhs }
    ===>
            case e `cast` co of (x'::Int)
               I# x# -> let x = x' `cast` sym co
                        in rhs

    so that 'rhs' can take advantage of the form of x'.  Notice that Note
    [Case of cast] (in OccurAnal) may then apply to the result.

    We'd also like to eliminate empty types (#13468). So if

        data Void
        type instance F Bool = Void

    then we'd like to transform
            case (x :: F Bool) of { _ -> error "urk" }
    ===>
            case (x |> co) of (x' :: Void) of {}

    Nota Bene: we used to have a built-in rule for 'seq' that dropped
    casts, so that
        case (x |> co) of { _ -> blah }
    dropped the cast; in order to improve the chances of trySeqRules
    firing.  But that works in the /opposite/ direction to Note [Improving
    seq] so there's a danger of flip/flopping.  Better to make trySeqRules
    insensitive to the cast, which is now is.

    The need for [Improving seq] showed up in Roman's experiments.  Example:
      foo :: F Int -> Int -> Int
      foo t n = t `seq` bar n
         where
           bar 0 = 0
           bar n = bar (n - case t of TI i -> i)
    Here we'd like to avoid repeated evaluating t inside the loop, by
    taking advantage of the `seq`.

    At one point I did transformation in LiberateCase, but it's more
    robust here.  (Otherwise, there's a danger that we'll simply drop the
    'seq' altogether, before LiberateCase gets to see it.)

    Note [Scaling in case-of-case]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When two cases commute, if done naively, the multiplicities will be wrong:

      case (case u of w[1] { (x[1], y[1]) } -> f x y) of w'[Many]
      { (z[Many], t[Many]) -> z
      }

    The multiplicities here, are correct, but if I perform a case of case:

      case u of w[1]
      { (x[1], y[1]) -> case f x y of w'[Many] of { (z[Many], t[Many]) -> z }
      }

    This is wrong! Using `f x y` inside a `case … of w'[Many]` means that `x` and
    `y` must have multiplicities `Many` not `1`! The correct solution is to make
    all the `1`-s be `Many`-s instead:

      case u of w[Many]
      { (x[Many], y[Many]) -> case f x y of w'[Many] of { (z[Many], t[Many]) -> z }
      }

    In general, when commuting two cases, the rule has to be:

      case (case … of x[p] {…}) of y[q] { … }
      ===> case … of x[p*q] { … case … of y[q] { … } }

    This is materialised, in the simplifier, by the fact that every time we simplify
    case alternatives with a continuation (the surrounded case (or more!)), we must
    scale the entire case we are simplifying, by a scaling factor which can be
    computed in the continuation (with function `contHoleScaling`).
    -}

    simplAlts :: SimplEnv
              -> OutExpr         -- Scrutinee
              -> InId            -- Case binder
              -> [InAlt]         -- Non-empty
              -> SimplCont
              -> SimplM OutExpr  -- Returns the complete simplified case expression

    simplAlts :: SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM CoreExpr
    simplAlts SimplEnv
    env0 CoreExpr
    scrut CoreBndr
    case_bndr [Alt CoreBndr]
    alts SimplCont
    cont'
      = do  { String -> SDoc -> SimplM ()
    traceSmpl String
    "simplAlts" ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    case_bndr
                                          , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "cont':" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SimplCont -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SimplCont
    cont'
                                          , 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 (SimplEnv -> InScopeSet
    seInScope SimplEnv
    env0) ])
            ; (env1, case_bndr1) <- SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplBinder SimplEnv
    env0 CoreBndr
    case_bndr
            ; let case_bndr2 = CoreBndr
    case_bndr1 CoreBndr -> Unfolding -> CoreBndr
    `setIdUnfolding` Unfolding
    evaldUnfolding
                  env2       = SimplEnv -> CoreBndr -> SimplEnv
    modifyInScope SimplEnv
    env1 CoreBndr
    case_bndr2
                  -- See Note [Case binder evaluated-ness]
                  fam_envs   = SimplEnv -> (FamInstEnv, FamInstEnv)
    seFamEnvs SimplEnv
    env0

            ; (alt_env', scrut', case_bndr') <- improveSeq fam_envs env2 scrut
                                                           case_bndr case_bndr2 alts

            ; (imposs_deflt_cons, in_alts) <- prepareAlts scrut' case_bndr alts
              -- NB: it's possible that the returned in_alts is empty: this is handled
              --     by the caller (rebuildCase) in the missingAlt function
              -- NB: pass case_bndr::InId, not case_bndr' :: OutId, to prepareAlts
              --     See Note [Shadowing in prepareAlts] in GHC.Core.Opt.Simplify.Utils

            ; alts' <- forM in_alts $
                simplAlt alt_env' (Just scrut') imposs_deflt_cons
                         case_bndr' (scrutOkForBinderSwap scrut) cont'

            ; let alts_ty' = SimplCont -> Kind
    contResultType SimplCont
    cont'
            -- See Note [Avoiding space leaks in OutType]
            ; seqType alts_ty' `seq`
              mkCase (seMode env0) scrut' case_bndr' alts_ty' alts' }

    ------------------------------------
    improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv
               -> OutExpr -> InId -> OutId -> [InAlt]
               -> SimplM (SimplEnv, OutExpr, OutId)
    -- Note [Improving seq]
    improveSeq :: (FamInstEnv, FamInstEnv)
    -> SimplEnv
    -> CoreExpr
    -> CoreBndr
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplM (SimplEnv, CoreExpr, CoreBndr)
    improveSeq (FamInstEnv, FamInstEnv)
    fam_envs SimplEnv
    env CoreExpr
    scrut CoreBndr
    case_bndr CoreBndr
    case_bndr1 [Alt AltCon
    DEFAULT [CoreBndr]
    _ CoreExpr
    _]
      | Just (Reduction CoercionR
    co Kind
    ty2) <- (FamInstEnv, FamInstEnv) -> Kind -> Maybe Reduction
    topNormaliseType_maybe (FamInstEnv, FamInstEnv)
    fam_envs (CoreBndr -> Kind
    idType CoreBndr
    case_bndr1)
      = do { case_bndr2 <- FastString -> Kind -> Kind -> SimplM CoreBndr
    newId (String -> FastString
    fsLit String
    "nt") Kind
    ManyTy Kind
    ty2
            ; let rhs  = CoreExpr -> JoinPointHood -> SimplSR
    DoneEx (CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    case_bndr2 CoreExpr -> CoercionR -> CoreExpr
    forall b. Expr b -> CoercionR -> Expr b
    `Cast` CoercionR -> CoercionR
    mkSymCo CoercionR
    co) JoinPointHood
    NotJoinPoint
                  env2 = SimplEnv -> CoreBndr -> SimplSR -> SimplEnv
    extendIdSubst SimplEnv
    env CoreBndr
    case_bndr SimplSR
    rhs
            ; return (env2, scrut `Cast` co, case_bndr2) }

    improveSeq (FamInstEnv, FamInstEnv)
    _ SimplEnv
    env CoreExpr
    scrut CoreBndr
    _ CoreBndr
    case_bndr1 [Alt CoreBndr]
    _
      = (SimplEnv, CoreExpr, CoreBndr)
    -> SimplM (SimplEnv, CoreExpr, CoreBndr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env, CoreExpr
    scrut, CoreBndr
    case_bndr1)

    ------------------------------------
    simplAlt :: SimplEnv
             -> Maybe OutExpr       -- The scrutinee
             -> [AltCon]            -- These constructors can't be present when
                                    -- matching the DEFAULT alternative
             -> OutId               -- The case binder `bndr`
             -> BinderSwapDecision  -- DoBinderSwap v co <==> scrut = Just (v |> co),
                                    --           add unfolding `v :-> bndr |> sym co`
             -> SimplCont
             -> InAlt
             -> SimplM OutAlt

    simplAlt :: SimplEnv
    -> Maybe CoreExpr
    -> [AltCon]
    -> CoreBndr
    -> BinderSwapDecision
    -> SimplCont
    -> Alt CoreBndr
    -> SimplM (Alt CoreBndr)
    simplAlt SimplEnv
    env Maybe CoreExpr
    _scrut' [AltCon]
    imposs_deflt_cons CoreBndr
    case_bndr' BinderSwapDecision
    bndr_swap' SimplCont
    cont' (Alt AltCon
    DEFAULT [CoreBndr]
    bndrs CoreExpr
    rhs)
      = Bool -> SimplM (Alt CoreBndr) -> SimplM (Alt CoreBndr)
    forall a. HasCallStack => Bool -> a -> a
    assert ([CoreBndr] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreBndr]
    bndrs) (SimplM (Alt CoreBndr) -> SimplM (Alt CoreBndr))
    -> SimplM (Alt CoreBndr) -> SimplM (Alt CoreBndr)
    forall a b. (a -> b) -> a -> b
    $
        do  { let env' :: SimplEnv
    env' = SimplEnv -> CoreBndr -> BinderSwapDecision -> [AltCon] -> SimplEnv
    addDefaultUnfoldings SimplEnv
    env CoreBndr
    case_bndr' BinderSwapDecision
    bndr_swap' [AltCon]
    imposs_deflt_cons
            ; rhs' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env' CoreExpr
    rhs SimplCont
    cont'
            ; return (Alt DEFAULT [] rhs') }

    simplAlt SimplEnv
    env Maybe CoreExpr
    _scrut' [AltCon]
    _ CoreBndr
    case_bndr' BinderSwapDecision
    bndr_swap' SimplCont
    cont' (Alt (LitAlt Literal
    lit) [CoreBndr]
    bndrs CoreExpr
    rhs)
      = Bool -> SimplM (Alt CoreBndr) -> SimplM (Alt CoreBndr)
    forall a. HasCallStack => Bool -> a -> a
    assert ([CoreBndr] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreBndr]
    bndrs) (SimplM (Alt CoreBndr) -> SimplM (Alt CoreBndr))
    -> SimplM (Alt CoreBndr) -> SimplM (Alt CoreBndr)
    forall a b. (a -> b) -> a -> b
    $
        do  { let env' :: SimplEnv
    env' = SimplEnv -> CoreBndr -> BinderSwapDecision -> CoreExpr -> SimplEnv
    addAltUnfoldings SimplEnv
    env CoreBndr
    case_bndr' BinderSwapDecision
    bndr_swap' (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit Literal
    lit)
            ; rhs' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env' CoreExpr
    rhs SimplCont
    cont'
            ; return (Alt (LitAlt lit) [] rhs') }

    simplAlt SimplEnv
    env Maybe CoreExpr
    scrut' [AltCon]
    _ CoreBndr
    case_bndr' BinderSwapDecision
    bndr_swap' SimplCont
    cont' (Alt (DataAlt DataCon
    con) [CoreBndr]
    vs CoreExpr
    rhs)
      = do  { -- See Note [Adding evaluatedness info to pattern-bound variables]
              -- and Note [DataAlt occ info]
            ; let vs_with_info :: [CoreBndr]
    vs_with_info = Maybe CoreExpr
    -> CoreBndr
    -> BinderSwapDecision
    -> DataCon
    -> [CoreBndr]
    -> [CoreBndr]
    adjustFieldsIdInfo Maybe CoreExpr
    scrut' CoreBndr
    case_bndr' BinderSwapDecision
    bndr_swap' DataCon
    con [CoreBndr]
    vs
              -- Adjust evaluated-ness and occ-info flags before `simplBinders`
              -- because the latter extends the in-scope set, which propagates this
              -- adjusted info to use sites.
            ; (env', vs') <- SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    simplBinders SimplEnv
    env [CoreBndr]
    vs_with_info

                    -- Bind the case-binder to (con args)
            ; let inst_tys' = HasDebugCallStack => Kind -> [Kind]
    Kind -> [Kind]
    tyConAppArgs (CoreBndr -> Kind
    idType CoreBndr
    case_bndr')
                  con_app :: OutExpr
                  con_app = DataCon -> [Kind] -> [CoreBndr] -> CoreExpr
    forall b. DataCon -> [Kind] -> [CoreBndr] -> Expr b
    mkConApp2 DataCon
    con [Kind]
    inst_tys' [CoreBndr]
    vs'
                  env''   = SimplEnv -> CoreBndr -> BinderSwapDecision -> CoreExpr -> SimplEnv
    addAltUnfoldings SimplEnv
    env' CoreBndr
    case_bndr' BinderSwapDecision
    bndr_swap' CoreExpr
    con_app

            ; rhs' <- simplExprC env'' rhs cont'
            ; return (Alt (DataAlt con) vs' rhs') }

    {- Note [Adding evaluatedness info to pattern-bound variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    addEvals records the evaluated-ness of the bound variables of
    a case pattern.  This is *important*.  Consider

         data T = T !Int !Int

         case x of { T a b -> T (a+1) b }

    We really must record that b is already evaluated so that we don't
    go and re-evaluate it when constructing the result.
    See Note [Data-con worker strictness] in GHC.Core.DataCon

    NB: simplLamBndrs preserves this eval info

    In addition to handling data constructor fields with !s, addEvals
    also records the fact that the result of seq# is always in WHNF.
    See Note [seq# magic] in GHC.Types.Id.Make.  Example (#15226):

      case seq# v s of
        (# s', v' #) -> E

    we want the compiler to be aware that v' is in WHNF in E.

    Open problem: we don't record that v itself is in WHNF (and we can't
    do it here).  The right thing is to do some kind of binder-swap;
    see #15226 for discussion.
    -}

    adjustFieldsIdInfo :: Maybe OutExpr -> OutId -> BinderSwapDecision -> DataCon -> [Id] -> [Id]
    -- See Note [Adding evaluatedness info to pattern-bound variables]
    -- and Note [DataAlt occ info]
    adjustFieldsIdInfo :: Maybe CoreExpr
    -> CoreBndr
    -> BinderSwapDecision
    -> DataCon
    -> [CoreBndr]
    -> [CoreBndr]
    adjustFieldsIdInfo Maybe CoreExpr
    scrut CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap DataCon
    con [CoreBndr]
    vs
      -- Deal with seq# applications
      | Just CoreExpr
    scr <- Maybe CoreExpr
    scrut
      , DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    con
      , [CoreBndr
    s,CoreBndr
    x] <- [CoreBndr]
    vs
        -- Use stripNArgs rather than collectArgsTicks to avoid building
        -- a list of arguments only to throw it away immediately.
      , Just (Var CoreBndr
    f) <- Word -> CoreExpr -> Maybe CoreExpr
    forall a. Word -> Expr a -> Maybe (Expr a)
    stripNArgs Word
    4 CoreExpr
    scr
      , CoreBndr
    f CoreBndr -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    seqHashKey
      , let x' :: CoreBndr
    x' = StrictnessMark -> CoreBndr -> CoreBndr
    setCaseBndrEvald StrictnessMark
    MarkedStrict CoreBndr
    x
      = (CoreBndr -> CoreBndr) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr -> BinderSwapDecision -> CoreBndr -> CoreBndr
    adjustFieldOccInfo CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap) [CoreBndr
    s, CoreBndr
    x']

      -- Deal with banged datacon fields
      -- This case is quite allocation sensitive to T9233 which has a large record
      -- with strict fields. Hence we try not to update vs twice!
    adjustFieldsIdInfo Maybe CoreExpr
    _scrut CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap DataCon
    con [CoreBndr]
    vs
      | Maybe CoreBndr
    Nothing <- DataCon -> Maybe CoreBndr
    dataConWrapId_maybe DataCon
    con
          -- A common fast path; no need to allocate the_strs when they are all lazy
          -- anyway! It shaves off 2% in T9675
      = (CoreBndr -> CoreBndr) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr -> BinderSwapDecision -> CoreBndr -> CoreBndr
    adjustFieldOccInfo CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap) [CoreBndr]
    vs
      | Bool
    otherwise
      = [CoreBndr] -> [StrictnessMark] -> [CoreBndr]
    go [CoreBndr]
    vs [StrictnessMark]
    the_strs
      where
        the_strs :: [StrictnessMark]
    the_strs = DataCon -> [StrictnessMark]
    dataConRepStrictness DataCon
    con

        go :: [CoreBndr] -> [StrictnessMark] -> [CoreBndr]
    go [] [] = []
        go (CoreBndr
    v:[CoreBndr]
    vs') [StrictnessMark]
    strs | CoreBndr -> Bool
    isTyVar CoreBndr
    v = CoreBndr
    v CoreBndr -> [CoreBndr] -> [CoreBndr]
    forall a. a -> [a] -> [a]
    : [CoreBndr] -> [StrictnessMark] -> [CoreBndr]
    go [CoreBndr]
    vs' [StrictnessMark]
    strs
        go (CoreBndr
    v:[CoreBndr]
    vs') (StrictnessMark
    str:[StrictnessMark]
    strs) = CoreBndr -> BinderSwapDecision -> CoreBndr -> CoreBndr
    adjustFieldOccInfo CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap (StrictnessMark -> CoreBndr -> CoreBndr
    setCaseBndrEvald StrictnessMark
    str CoreBndr
    v) CoreBndr -> [CoreBndr] -> [CoreBndr]
    forall a. a -> [a] -> [a]
    : [CoreBndr] -> [StrictnessMark] -> [CoreBndr]
    go [CoreBndr]
    vs' [StrictnessMark]
    strs
        go [CoreBndr]
    _ [StrictnessMark]
    _ = String -> SDoc -> [CoreBndr]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Simplify.adjustFieldsIdInfo"
                  (DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    con SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   [CoreBndr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreBndr]
    vs  SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   [SDoc] -> SDoc
    forall {t :: * -> *} {a}.
    (Outputable (t a), Foldable t) =>
    t a -> SDoc
    ppr_with_length ((StrictnessMark -> SDoc) -> [StrictnessMark] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map StrictnessMark -> SDoc
    strdisp [StrictnessMark]
    the_strs) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   [Scaled Kind] -> SDoc
    forall {t :: * -> *} {a}.
    (Outputable (t a), Foldable t) =>
    t a -> SDoc
    ppr_with_length (DataCon -> [Scaled Kind]
    dataConRepArgTys DataCon
    con) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   [StrictnessMark] -> SDoc
    forall {t :: * -> *} {a}.
    (Outputable (t a), Foldable t) =>
    t a -> SDoc
    ppr_with_length (DataCon -> [StrictnessMark]
    dataConRepStrictness DataCon
    con))
          where
            ppr_with_length :: t a -> SDoc
    ppr_with_length t a
    list
              = t a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr t a
    list SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "length =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    list))
            strdisp :: StrictnessMark -> SDoc
            strdisp :: StrictnessMark -> SDoc
    strdisp StrictnessMark
    MarkedStrict = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "MarkedStrict"
            strdisp StrictnessMark
    NotMarkedStrict = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "NotMarkedStrict"

    adjustFieldOccInfo :: OutId -> BinderSwapDecision -> CoreBndr -> CoreBndr
    -- Kill occ info if we do binder swap and the case binder is alive;
    -- see Note [DataAlt occ info]
    adjustFieldOccInfo :: CoreBndr -> BinderSwapDecision -> CoreBndr -> CoreBndr
    adjustFieldOccInfo CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap CoreBndr
    field_bndr
      | CoreBndr -> Bool
    isTyVar CoreBndr
    field_bndr
      = CoreBndr
    field_bndr

      | Bool -> Bool
    not (CoreBndr -> Bool
    isDeadBinder CoreBndr
    case_bndr)  -- (1) in the Note: If the case binder is alive,
      = CoreBndr -> CoreBndr
    zapIdOccInfo CoreBndr
    field_bndr       -- the field binders might come back alive

      | DoBinderSwap{} <- BinderSwapDecision
    bndr_swap   -- (2) in the Note: If binder swap might take place,
      = CoreBndr -> CoreBndr
    zapIdOccInfo CoreBndr
    field_bndr       -- the case binder might come back alive

      | Bool
    otherwise
      = CoreBndr
    field_bndr                    -- otherwise the field binders stay dead

    addDefaultUnfoldings :: SimplEnv -> OutId -> BinderSwapDecision -> [AltCon] -> SimplEnv
    addDefaultUnfoldings :: SimplEnv -> CoreBndr -> BinderSwapDecision -> [AltCon] -> SimplEnv
    addDefaultUnfoldings SimplEnv
    env CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap [AltCon]
    imposs_deflt_cons
      = SimplEnv
    env2
      where
        unf :: Unfolding
    unf = [AltCon] -> Unfolding
    mkOtherCon [AltCon]
    imposs_deflt_cons
              -- Record the constructors that the case-binder *can't* be.
        env1 :: SimplEnv
    env1 = SimplEnv -> CoreBndr -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env CoreBndr
    case_bndr Unfolding
    unf
        env2 :: SimplEnv
    env2 | DoBinderSwap CoreBndr
    v MOutCoercion
    _mco <- BinderSwapDecision
    bndr_swap
             = SimplEnv -> CoreBndr -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env1 CoreBndr
    v Unfolding
    unf
             | Bool
    otherwise = SimplEnv
    env1

    addAltUnfoldings :: SimplEnv -> OutId -> BinderSwapDecision -> OutExpr -> SimplEnv
    addAltUnfoldings :: SimplEnv -> CoreBndr -> BinderSwapDecision -> CoreExpr -> SimplEnv
    addAltUnfoldings SimplEnv
    env CoreBndr
    case_bndr BinderSwapDecision
    bndr_swap CoreExpr
    con_app
      = SimplEnv
    env2
      where
        con_app_unf :: Unfolding
    con_app_unf = CoreExpr -> Unfolding
    mk_simple_unf CoreExpr
    con_app
        env1 :: SimplEnv
    env1 = SimplEnv -> CoreBndr -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env CoreBndr
    case_bndr Unfolding
    con_app_unf

        -- See Note [Add unfolding for scrutinee]
        env2 :: SimplEnv
    env2 | DoBinderSwap CoreBndr
    v MOutCoercion
    mco <- BinderSwapDecision
    bndr_swap
             = SimplEnv -> CoreBndr -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env1 CoreBndr
    v (Unfolding -> SimplEnv) -> Unfolding -> SimplEnv
    forall a b. (a -> b) -> a -> b
    $
                  if MOutCoercion -> Bool
    isReflMCo MOutCoercion
    mco  -- isReflMCo: avoid calling mk_simple_unf
                  then Unfolding
    con_app_unf  --            twice in the common case
                  else CoreExpr -> Unfolding
    mk_simple_unf (CoreExpr -> MOutCoercion -> CoreExpr
    mkCastMCo CoreExpr
    con_app MOutCoercion
    mco)

             | Bool
    otherwise = SimplEnv
    env1

        -- Force the opts, so that the whole SimplEnv isn't retained
        !opts :: UnfoldingOpts
    opts = SimplEnv -> UnfoldingOpts
    seUnfoldingOpts SimplEnv
    env
        mk_simple_unf :: CoreExpr -> Unfolding
    mk_simple_unf = UnfoldingOpts -> CoreExpr -> Unfolding
    mkSimpleUnfolding UnfoldingOpts
    opts

    addBinderUnfolding :: SimplEnv -> Id -> Unfolding -> SimplEnv
    addBinderUnfolding :: SimplEnv -> CoreBndr -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env CoreBndr
    bndr Unfolding
    unf
      | Bool
    debugIsOn, Just CoreExpr
    tmpl <- Unfolding -> Maybe CoreExpr
    maybeUnfoldingTemplate Unfolding
    unf
      = Bool -> String -> SDoc -> SimplEnv -> SimplEnv
    forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
    warnPprTrace (Bool -> Bool
    not (HasCallStack => Kind -> Kind -> Bool
    Kind -> Kind -> Bool
    eqType (CoreBndr -> Kind
    idType CoreBndr
    bndr) (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    tmpl)))
              String
    "unfolding type mismatch"
              (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    bndr SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CoreBndr -> Kind
    idType CoreBndr
    bndr) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    tmpl SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    tmpl)) (SimplEnv -> SimplEnv) -> SimplEnv -> SimplEnv
    forall a b. (a -> b) -> a -> b
    $
              SimplEnv -> CoreBndr -> SimplEnv
    modifyInScope SimplEnv
    env (CoreBndr
    bndr CoreBndr -> Unfolding -> CoreBndr
    `setIdUnfolding` Unfolding
    unf)

      | Bool
    otherwise
      = SimplEnv -> CoreBndr -> SimplEnv
    modifyInScope SimplEnv
    env (CoreBndr
    bndr CoreBndr -> Unfolding -> CoreBndr
    `setIdUnfolding` Unfolding
    unf)

    zapBndrOccInfo :: Bool -> Id -> Id
    -- Consider  case e of b { (a,b) -> ... }
    -- Then if we bind b to (a,b) in "...", and b is not dead,
    -- then we must zap the deadness info on a,b
    zapBndrOccInfo :: Bool -> CoreBndr -> CoreBndr
    zapBndrOccInfo Bool
    keep_occ_info CoreBndr
    pat_id
      | Bool
    keep_occ_info = CoreBndr
    pat_id
      | Bool
    otherwise     = CoreBndr -> CoreBndr
    zapIdOccInfo CoreBndr
    pat_id

    {- Note [Case binder evaluated-ness]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We pin on a (OtherCon []) unfolding to the case-binder of a Case,
    even though it'll be over-ridden in every case alternative with a more
    informative unfolding.  Why?  Because suppose a later, less clever, pass
    simply replaces all occurrences of the case binder with the binder itself;
    then Lint may complain about the let-can-float invariant.  Example
        case e of b { DEFAULT -> let v = reallyUnsafePtrEquality# b y in ....
                    ; K       -> blah }

    The let-can-float invariant requires that y is evaluated in the call to
    reallyUnsafePtrEquality#, which it is.  But we still want that to be true if we
    propagate binders to occurrences.

    This showed up in #13027.

    Note [Add unfolding for scrutinee]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In general it's unlikely that a variable scrutinee will appear
    in the case alternatives   case x of { ...x unlikely to appear... }
    because the binder-swap in OccurAnal has got rid of all such occurrences
    See Note [Binder swap] in "GHC.Core.Opt.OccurAnal".

    BUT it is still VERY IMPORTANT to add a suitable unfolding for a
    variable scrutinee, in simplAlt.  Here's why
       case x of y
         (a,b) -> case b of c
                    I# v -> ...(f y)...
    There is no occurrence of 'b' in the (...(f y)...).  But y gets
    the unfolding (a,b), and *that* mentions b.  If f has a RULE
        RULE f (p, I# q) = ...
    we want that rule to match, so we must extend the in-scope env with a
    suitable unfolding for 'y'.  It's *essential* for rule matching; but
    it's also good for case-elimination -- suppose that 'f' was inlined
    and did multi-level case analysis, then we'd solve it in one
    simplifier sweep instead of two.

    HOWEVER, given
      case x of y { Just a -> r1; Nothing -> r2 }
    we do not want to add the unfolding x -> y to 'x', which might seem cool,
    since 'y' itself has different unfoldings in r1 and r2.  Reason: if we
    did that, we'd have to zap y's deadness info and that is a very useful
    piece of information.

    So instead we add the unfolding x -> Just a, and x -> Nothing in the
    respective RHSs.

    Since this transformation is tantamount to a binder swap, we use
    GHC.Core.Opt.OccurAnal.scrutOkForBinderSwap to do the check.

    Exactly the same issue arises in GHC.Core.Opt.SpecConstr;
    see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr

    ************************************************************************
    *                                                                      *
    \subsection{Known constructor}
    *                                                                      *
    ************************************************************************

    We are a bit careful with occurrence info.  Here's an example

            (\x* -> case x of (a*, b) -> f a) (h v, e)

    where the * means "occurs once".  This effectively becomes
            case (h v, e) of (a*, b) -> f a)
    and then
            let a* = h v; b = e in f a
    and then
            f (h v)

    All this should happen in one sweep.
    -}

    knownCon :: SimplEnv
             -> OutExpr                                           -- The scrutinee
             -> [FloatBind] -> DataCon -> [OutType] -> [OutExpr]  -- The scrutinee (in pieces)
             -> InId -> [InBndr] -> InExpr                        -- The alternative
             -> SimplCont
             -> SimplM (SimplFloats, OutExpr)

    knownCon :: SimplEnv
    -> CoreExpr
    -> [FloatBind]
    -> DataCon
    -> [Kind]
    -> [CoreExpr]
    -> CoreBndr
    -> [CoreBndr]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    knownCon SimplEnv
    env CoreExpr
    scrut [FloatBind]
    dc_floats DataCon
    dc [Kind]
    dc_ty_args [CoreExpr]
    dc_args CoreBndr
    bndr [CoreBndr]
    bs CoreExpr
    rhs SimplCont
    cont
      = do  { (floats1, env1)  <- SimplEnv
    -> [CoreBndr] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args SimplEnv
    env [CoreBndr]
    bs [CoreExpr]
    dc_args
            ; (floats2, env2)  <- bind_case_bndr env1
            ; (floats3, expr') <- simplExprF env2 rhs cont
            ; case dc_floats of
                [] ->
                  (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats3, CoreExpr
    expr')
                [FloatBind]
    _ ->
                  (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
                   -- See Note [FloatBinds from constructor wrappers]
                         , [FloatBind] -> CoreExpr -> CoreExpr
    GHC.Core.Make.wrapFloats [FloatBind]
    dc_floats (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                           SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats3) CoreExpr
    expr') }
      where
        zap_occ :: CoreBndr -> CoreBndr
    zap_occ = Bool -> CoreBndr -> CoreBndr
    zapBndrOccInfo (CoreBndr -> Bool
    isDeadBinder CoreBndr
    bndr)    -- bndr is an InId

                      -- Ugh!
        bind_args :: SimplEnv
    -> [CoreBndr] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args SimplEnv
    env' [] [CoreExpr]
    _  = (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env', SimplEnv
    env')

        bind_args SimplEnv
    env' (CoreBndr
    b:[CoreBndr]
    bs') (Type Kind
    ty : [CoreExpr]
    args)
          = Bool
    -> (SimplEnv
        -> [CoreBndr] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv))
    -> SimplEnv
    -> [CoreBndr]
    -> [CoreExpr]
    -> SimplM (SimplFloats, SimplEnv)
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isTyVar CoreBndr
    b )
            SimplEnv
    -> [CoreBndr] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args (SimplEnv -> CoreBndr -> Kind -> SimplEnv
    extendTvSubst SimplEnv
    env' CoreBndr
    b Kind
    ty) [CoreBndr]
    bs' [CoreExpr]
    args

        bind_args SimplEnv
    env' (CoreBndr
    b:[CoreBndr]
    bs') (Coercion CoercionR
    co : [CoreExpr]
    args)
          = Bool
    -> (SimplEnv
        -> [CoreBndr] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv))
    -> SimplEnv
    -> [CoreBndr]
    -> [CoreExpr]
    -> SimplM (SimplFloats, SimplEnv)
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isCoVar CoreBndr
    b )
            SimplEnv
    -> [CoreBndr] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args (SimplEnv -> CoreBndr -> CoercionR -> SimplEnv
    extendCvSubst SimplEnv
    env' CoreBndr
    b CoercionR
    co) [CoreBndr]
    bs' [CoreExpr]
    args

        bind_args SimplEnv
    env' (CoreBndr
    b:[CoreBndr]
    bs') (CoreExpr
    arg : [CoreExpr]
    args)
          = Bool
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. HasCallStack => Bool -> a -> a
    assert (CoreBndr -> Bool
    isId CoreBndr
    b) (SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv))
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a b. (a -> b) -> a -> b
    $
            do { let b' :: CoreBndr
    b' = CoreBndr -> CoreBndr
    zap_occ CoreBndr
    b
                 -- zap_occ: the binder might be "dead", because it doesn't
                 -- occur in the RHS; and simplAuxBind may therefore discard it.
                 -- Nevertheless we must keep it if the case-binder is alive,
                 -- because it may be used in the con_app.  See Note [knownCon occ info]
               ; (floats1, env2) <- String
    -> SimplEnv
    -> CoreBndr
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplAuxBind String
    "knownCon" SimplEnv
    env' CoreBndr
    b' CoreExpr
    arg  -- arg satisfies let-can-float invariant
               ; (floats2, env3) <- bind_args env2 bs' args
               ; return (floats1 `addFloats` floats2, env3) }

        bind_args SimplEnv
    _ [CoreBndr]
    _ [CoreExpr]
    _ =
          String -> SDoc -> SimplM (SimplFloats, SimplEnv)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "bind_args" (SDoc -> SimplM (SimplFloats, SimplEnv))
    -> SDoc -> SimplM (SimplFloats, SimplEnv)
    forall a b. (a -> b) -> a -> b
    $ DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [CoreBndr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreBndr]
    bs SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    dc_args SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                 String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "scrut:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    scrut

           -- It's useful to bind bndr to scrut, rather than to a fresh
           -- binding      x = Con arg1 .. argn
           -- because very often the scrut is a variable, so we avoid
           -- creating, and then subsequently eliminating, a let-binding
           -- BUT, if scrut is a not a variable, we must be careful
           -- about duplicating the arg redexes; in that case, make
           -- a new con-app from the args
        bind_case_bndr :: SimplEnv -> SimplM (SimplFloats, SimplEnv)
    bind_case_bndr SimplEnv
    env
          | CoreBndr -> Bool
    isDeadBinder CoreBndr
    bndr   = (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env)
          | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    scrut = (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
                                         , SimplEnv -> CoreBndr -> SimplSR -> SimplEnv
    extendIdSubst SimplEnv
    env CoreBndr
    bndr (CoreExpr -> JoinPointHood -> SimplSR
    DoneEx CoreExpr
    scrut JoinPointHood
    NotJoinPoint))
                                  -- See Note [Do not duplicate constructor applications]
          | Bool
    otherwise           = do { dc_args <- (CoreBndr -> SimplM CoreExpr) -> [CoreBndr] -> SimplM [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (SimplEnv -> CoreBndr -> SimplM CoreExpr
    simplVar SimplEnv
    env) [CoreBndr]
    bs
                                             -- dc_ty_args are already OutTypes,
                                             -- but bs are InBndrs
                                     ; let con_app = CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var (DataCon -> CoreBndr
    dataConWorkId DataCon
    dc)
                                                     CoreExpr -> [Kind] -> CoreExpr
    forall b. Expr b -> [Kind] -> Expr b
    `mkTyApps` [Kind]
    dc_ty_args
                                                     CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    `mkApps`   [CoreExpr]
    dc_args
                                     ; simplAuxBind "case-bndr" env bndr con_app }

    -------------------
    missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont
               -> SimplM (SimplFloats, OutExpr)
                    -- This isn't strictly an error, although it is unusual.
                    -- It's possible that the simplifier might "see" that
                    -- an inner case has no accessible alternatives before
                    -- it "sees" that the entire branch of an outer case is
                    -- inaccessible.  So we simply put an error case here instead.
    missingAlt :: SimplEnv
    -> CoreBndr
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    missingAlt SimplEnv
    env CoreBndr
    case_bndr [Alt CoreBndr]
    _ SimplCont
    cont
      = Bool
    -> String
    -> SDoc
    -> SimplM (SimplFloats, CoreExpr)
    -> SimplM (SimplFloats, CoreExpr)
    forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
    warnPprTrace Bool
    True String
    "missingAlt" (CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreBndr
    case_bndr) (SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
        -- See Note [Avoiding space leaks in OutType]
        let cont_ty :: Kind
    cont_ty = SimplCont -> Kind
    contResultType SimplCont
    cont
        in Kind -> ()
    seqType Kind
    cont_ty ()
    -> SimplM (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a b. a -> b -> b
    `seq`
           (SimplFloats, CoreExpr) -> SimplM (SimplFloats, CoreExpr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, Kind -> String -> CoreExpr
    mkImpossibleExpr Kind
    cont_ty String
    "Simplify.Iteration.missingAlt")

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Duplicating continuations}
    *                                                                      *
    ************************************************************************

    Consider
      let x* = case e of { True -> e1; False -> e2 }
      in b
    where x* is a strict binding.  Then mkDupableCont will be given
    the continuation
       case [] of { True -> e1; False -> e2 } ; let x* = [] in b ; stop
    and will split it into
       dupable:      case [] of { True -> $j1; False -> $j2 } ; stop
       join floats:  $j1 = e1, $j2 = e2
       non_dupable:  let x* = [] in b; stop

    Putting this back together would give
       let x* = let { $j1 = e1; $j2 = e2 } in
                case e of { True -> $j1; False -> $j2 }
       in b
    (Of course we only do this if 'e' wants to duplicate that continuation.)
    Note how important it is that the new join points wrap around the
    inner expression, and not around the whole thing.

    In contrast, any let-bindings introduced by mkDupableCont can wrap
    around the entire thing.

    Note [Bottom alternatives]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we have
         case (case x of { A -> error .. ; B -> e; C -> error ..)
           of alts
    then we can just duplicate those alts because the A and C cases
    will disappear immediately.  This is more direct than creating
    join points and inlining them away.  See #4930.
    -}

    --------------------
    mkDupableCaseCont :: SimplEnv -> [InAlt] -> SimplCont
                      -> SimplM ( SimplFloats  -- Join points (if any)
                                , SimplEnv     -- Use this for the alts
                                , SimplCont)
    mkDupableCaseCont :: SimplEnv
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, SimplEnv, SimplCont)
    mkDupableCaseCont SimplEnv
    env [Alt CoreBndr]
    alts SimplCont
    cont
      | [Alt CoreBndr] -> Bool
    altsWouldDup [Alt CoreBndr]
    alts = do { (floats, cont) <- SimplEnv -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableCont SimplEnv
    env SimplCont
    cont
                               ; let env' = SimplEnv -> SimplEnv
    bumpCaseDepth (SimplEnv -> SimplEnv) -> SimplEnv -> SimplEnv
    forall a b. (a -> b) -> a -> b
    $
                                            SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    floats
                               ; return (floats, env', cont) }
      | Bool
    otherwise         = (SimplFloats, SimplEnv, SimplCont)
    -> SimplM (SimplFloats, SimplEnv, SimplCont)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env, SimplCont
    cont)

    altsWouldDup :: [InAlt] -> Bool -- True iff strictly > 1 non-bottom alternative
    altsWouldDup :: [Alt CoreBndr] -> Bool
    altsWouldDup []  = Bool
    False        -- See Note [Bottom alternatives]
    altsWouldDup [Alt CoreBndr
    _] = Bool
    False
    altsWouldDup (Alt CoreBndr
    alt:[Alt CoreBndr]
    alts)
      | Alt CoreBndr -> Bool
    is_bot_alt Alt CoreBndr
    alt = [Alt CoreBndr] -> Bool
    altsWouldDup [Alt CoreBndr]
    alts
      | Bool
    otherwise      = Bool -> Bool
    not ((Alt CoreBndr -> Bool) -> [Alt CoreBndr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Alt CoreBndr -> Bool
    is_bot_alt [Alt CoreBndr]
    alts)
        -- otherwise case: first alt is non-bot, so all the rest must be bot
      where
        is_bot_alt :: Alt CoreBndr -> Bool
    is_bot_alt (Alt AltCon
    _ [CoreBndr]
    _ CoreExpr
    rhs) = CoreExpr -> Bool
    exprIsDeadEnd CoreExpr
    rhs

    -------------------------
    mkDupableCont :: SimplEnv
                  -> SimplCont
                  -> SimplM ( SimplFloats  -- Incoming SimplEnv augmented with
                                           --   extra let/join-floats and in-scope variables
                            , SimplCont)   -- dup_cont: duplicable continuation
    mkDupableCont :: SimplEnv -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableCont SimplEnv
    env SimplCont
    cont
      = SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env (Demand -> [Demand]
    forall a. a -> [a]
    repeat Demand
    topDmd) SimplCont
    cont

    mkDupableContWithDmds
       :: SimplEnv  -> [Demand]  -- Demands on arguments; always infinite
       -> SimplCont -> SimplM ( SimplFloats, SimplCont)

    mkDupableContWithDmds :: SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    _ SimplCont
    cont
      | SimplCont -> Bool
    contIsDupable SimplCont
    cont
      = (SimplFloats, SimplCont) -> SimplM (SimplFloats, SimplCont)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplCont
    cont)

    mkDupableContWithDmds SimplEnv
    _ [Demand]
    _ (Stop {}) = String -> SimplM (SimplFloats, SimplCont)
    forall a. HasCallStack => String -> a
    panic String
    "mkDupableCont"     -- Handled by previous eqn

    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds (CastIt { sc_co :: SimplCont -> CoercionR
    sc_co = CoercionR
    co, sc_opt :: SimplCont -> Bool
    sc_opt = Bool
    opt, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })
      = do  { (floats, cont') <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds SimplCont
    cont
            ; return (floats, CastIt { sc_co = optOutCoercion env co opt
                                     , sc_opt = True, sc_cont = cont' }) }
                     -- optOutCoercion: see Note [Avoid re-simplifying coercions]

    -- Duplicating ticks for now, not sure if this is good or not
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds (TickIt CoreTickish
    t SimplCont
    cont)
      = do  { (floats, cont') <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds SimplCont
    cont
            ; return (floats, TickIt t cont') }

    mkDupableContWithDmds SimplEnv
    env [Demand]
    _
         (StrictBind { sc_bndr :: SimplCont -> CoreBndr
    sc_bndr = CoreBndr
    bndr, sc_body :: SimplCont -> CoreExpr
    sc_body = CoreExpr
    body, sc_from :: SimplCont -> FromWhat
    sc_from = FromWhat
    from_what
                     , sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont})
    -- See Note [Duplicating StrictBind]
    -- K[ let x = <> in b ]  -->   join j x = K[ b ]
    --                             j <>
      = do { let sb_env :: SimplEnv
    sb_env = SimplEnv
    se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env
           ; (sb_env1, bndr')      <- SimplEnv -> CoreBndr -> SimplM (SimplEnv, CoreBndr)
    simplBinder SimplEnv
    sb_env CoreBndr
    bndr
           ; (floats1, join_inner) <- simplNonRecBody sb_env1 from_what body cont
              -- No need to use mkDupableCont before simplNonRecBody; we
              -- use cont once here, and then share the result if necessary

           ; let join_body = SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    floats1 CoreExpr
    join_inner
                 res_ty    = SimplCont -> Kind
    contResultType SimplCont
    cont

           ; mkDupableStrictBind env bndr' join_body res_ty }

    mkDupableContWithDmds SimplEnv
    env [Demand]
    _
        (StrictArg { sc_fun :: SimplCont -> ArgInfo
    sc_fun = ArgInfo
    fun, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont
                   , sc_fun_ty :: SimplCont -> Kind
    sc_fun_ty = Kind
    fun_ty })
      -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
      | Maybe DataCon -> Bool
    forall a. Maybe a -> Bool
    isNothing (CoreBndr -> Maybe DataCon
    isDataConId_maybe (ArgInfo -> CoreBndr
    ai_fun ArgInfo
    fun))
             -- isDataConId: see point (DJ4) of Note [Duplicating join points]
      , SimplCont -> Bool
    thumbsUpPlanA SimplCont
    cont
      = -- Use Plan A of Note [Duplicating StrictArg]
    --    pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $
        do { let (Demand
    _ : [Demand]
    dmds) = ArgInfo -> [Demand]
    ai_dmds ArgInfo
    fun
           ; (floats1, cont')  <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds SimplCont
    cont
                                  -- Use the demands from the function to add the right
                                  -- demand info on any bindings we make for further args
           ; (floats_s, args') <- mapAndUnzipM (makeTrivialArg env)
                                               (ai_args fun)
           ; return ( foldl' addLetFloats floats1 floats_s
                    , StrictArg { sc_fun = fun { ai_args = args' }
                                , sc_cont = cont'
                                , sc_fun_ty = fun_ty
                                , sc_dup = OkToDup} ) }

      | Bool
    otherwise
      = -- Use Plan B of Note [Duplicating StrictArg]
        --   K[ f a b <> ]   -->   join j x = K[ f a b x ]
        --                         j <>
        do { let rhs_ty :: Kind
    rhs_ty       = SimplCont -> Kind
    contResultType SimplCont
    cont
                 (Kind
    m,Kind
    arg_ty,Kind
    _) = Kind -> (Kind, Kind, Kind)
    splitFunTy Kind
    fun_ty
           ; arg_bndr <- FastString -> Kind -> Kind -> SimplM CoreBndr
    newId (String -> FastString
    fsLit String
    "arg") Kind
    m Kind
    arg_ty
           ; let env' = SimplEnv
    env SimplEnv -> [CoreBndr] -> SimplEnv
    `addNewInScopeIds` [CoreBndr
    arg_bndr]
           ; (floats, join_rhs) <- rebuildCall env' (addValArgTo fun (Var arg_bndr) fun_ty) cont
           ; mkDupableStrictBind env' arg_bndr (wrapFloats floats join_rhs) rhs_ty }
      where
        thumbsUpPlanA :: SimplCont -> Bool
    thumbsUpPlanA (StrictArg {})               = Bool
    False
        thumbsUpPlanA (StrictBind {})              = Bool
    True
        thumbsUpPlanA (Stop {})                    = Bool
    True
        thumbsUpPlanA (Select {})                  = Bool
    True
        thumbsUpPlanA (CastIt { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    k })     = SimplCont -> Bool
    thumbsUpPlanA SimplCont
    k
        thumbsUpPlanA (TickIt CoreTickish
    _ SimplCont
    k)                 = SimplCont -> Bool
    thumbsUpPlanA SimplCont
    k
        thumbsUpPlanA (ApplyToVal { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    k }) = SimplCont -> Bool
    thumbsUpPlanA SimplCont
    k
        thumbsUpPlanA (ApplyToTy  { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    k }) = SimplCont -> Bool
    thumbsUpPlanA SimplCont
    k

    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds
        (ApplyToTy { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont, sc_arg_ty :: SimplCont -> Kind
    sc_arg_ty = Kind
    arg_ty, sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    hole_ty })
      = do  { (floats, cont') <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds SimplCont
    cont
            ; return (floats, ApplyToTy { sc_cont = cont'
                                        , sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) }

    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds
        (ApplyToVal { sc_arg :: SimplCont -> CoreExpr
    sc_arg = CoreExpr
    arg, sc_dup :: SimplCont -> DupFlag
    sc_dup = DupFlag
    dup, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se
                    , sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont, sc_hole_ty :: SimplCont -> Kind
    sc_hole_ty = Kind
    hole_ty })
      =     -- e.g.         [...hole...] (...arg...)
            --      ==>
            --              let a = ...arg...
            --              in [...hole...] a
            -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
        do  { let (Demand
    dmd:[Demand]
    cont_dmds) = [Demand]
    dmds   -- Never fails
            ; (floats1, cont') <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    cont_dmds SimplCont
    cont
            ; let env' = SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    floats1
            ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg
            ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
            ; let all_floats = SimplFloats
    floats1 SimplFloats -> LetFloats -> SimplFloats
    `addLetFloats` LetFloats
    let_floats2
            ; return ( all_floats
                     , ApplyToVal { sc_arg = arg''
                                  , sc_env = se' `setInScopeFromF` all_floats
                                             -- Ensure that sc_env includes the free vars of
                                             -- arg'' in its in-scope set, even if makeTrivial
                                             -- has turned arg'' into a fresh variable
                                             -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils
                                  , sc_dup = OkToDup, sc_cont = cont'
                                  , sc_hole_ty = hole_ty }) }

    mkDupableContWithDmds SimplEnv
    env [Demand]
    _
        (Select { sc_bndr :: SimplCont -> CoreBndr
    sc_bndr = CoreBndr
    case_bndr, sc_alts :: SimplCont -> [Alt CoreBndr]
    sc_alts = [Alt CoreBndr]
    alts, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont })
      =     -- e.g.         (case [...hole...] of { pi -> ei })
            --      ===>
            --              let ji = \xij -> ei
            --              in case [...hole...] of { pi -> ji xij }
            -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
        do  { Tick -> SimplM ()
    tick (CoreBndr -> Tick
    CaseOfCase CoreBndr
    case_bndr)
            ; (floats, alt_env, alt_cont) <- SimplEnv
    -> [Alt CoreBndr]
    -> SimplCont
    -> SimplM (SimplFloats, SimplEnv, SimplCont)
    mkDupableCaseCont (SimplEnv
    se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) [Alt CoreBndr]
    alts SimplCont
    cont
                    -- NB: We call mkDupableCaseCont here to make cont duplicable
                    --     (if necessary, depending on the number of alts)
                    -- And this is important: see Note [Fusing case continuations]

            ; let cont_scaling = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
              -- See Note [Scaling in case-of-case]
            ; (alt_env', case_bndr') <- simplBinder alt_env (scaleIdBy cont_scaling case_bndr)
            ; alts' <- forM (scaleAltsBy cont_scaling alts) $
                simplAlt alt_env' Nothing [] case_bndr' NoBinderSwap alt_cont
                    -- Safe to say that there are no handled-cons for the DEFAULT case
                    -- NB: simplBinder does not zap deadness occ-info, so
                    -- a dead case_bndr' will still advertise its deadness
                    -- This is really important because in
                    --      case e of b { (# p,q #) -> ... }
                    -- b is always dead, and indeed we are not allowed to bind b to (# p,q #),
                    -- which might happen if e was an explicit unboxed pair and b wasn't marked dead.
                    -- In the new alts we build, we have the new case binder, so it must retain
                    -- its deadness.
            -- NB: we don't use alt_env further; it has the substEnv for
            --     the alternatives, and we don't want that

            ; (join_floats, alts'') <- mapAccumLM (mkDupableAlt env case_bndr')
                                                  emptyJoinFloats alts'

            ; let all_floats = SimplFloats
    floats SimplFloats -> JoinFloats -> SimplFloats
    `addJoinFloats` JoinFloats
    join_floats
                               -- Note [Duplicated env]
            ; return (all_floats
                     , Select { sc_dup  = OkToDup
                              , sc_bndr = case_bndr'
                              , sc_alts = alts''
                              , sc_env  = zapSubstEnv se `setInScopeFromF` all_floats
                                          -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils
                              , sc_cont = mkBoringStop (contResultType cont) } ) }

    mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType
                        -> SimplM (SimplFloats, SimplCont)
    mkDupableStrictBind :: SimplEnv
    -> CoreBndr -> CoreExpr -> Kind -> SimplM (SimplFloats, SimplCont)
    mkDupableStrictBind SimplEnv
    env CoreBndr
    arg_bndr CoreExpr
    join_rhs Kind
    res_ty
      | [CoreBndr] -> CoreExpr -> Bool
    uncondInlineJoin [CoreBndr
    arg_bndr] CoreExpr
    join_rhs
         -- See point (DJ2) of Note [Duplicating join points]
      = (SimplFloats, SimplCont) -> SimplM (SimplFloats, SimplCont)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
               , StrictBind { sc_bndr :: CoreBndr
    sc_bndr = CoreBndr
    arg_bndr
                            , sc_body :: CoreExpr
    sc_body = CoreExpr
    join_rhs
                            , sc_env :: SimplEnv
    sc_env  = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env
                            , sc_from :: FromWhat
    sc_from = FromWhat
    FromLet
                              -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils
                            , sc_dup :: DupFlag
    sc_dup  = DupFlag
    OkToDup
                            , sc_cont :: SimplCont
    sc_cont = Kind -> SimplCont
    mkBoringStop Kind
    res_ty } )
      | Bool
    otherwise
      = do { join_bndr <- [CoreBndr] -> Kind -> SimplM CoreBndr
    newJoinId [CoreBndr
    arg_bndr] Kind
    res_ty
           ; let arg_info = ArgInfo { ai_fun :: CoreBndr
    ai_fun   = CoreBndr
    join_bndr
                                    , ai_rewrite :: RewriteCall
    ai_rewrite = RewriteCall
    TryNothing, ai_args :: [ArgSpec]
    ai_args  = []
                                    , ai_encl :: Bool
    ai_encl  = Bool
    False, ai_dmds :: [Demand]
    ai_dmds  = Demand -> [Demand]
    forall a. a -> [a]
    repeat Demand
    topDmd
                                    , ai_discs :: [Int]
    ai_discs = Int -> [Int]
    forall a. a -> [a]
    repeat Int
    0 }
           ; return ( addJoinFloats (emptyFloats env) $
                      unitJoinFloat                   $
                      NonRec join_bndr                $
                      Lam (setOneShotLambda arg_bndr) join_rhs
                    , StrictArg { sc_dup    = OkToDup
                                , sc_fun    = arg_info
                                , sc_fun_ty = idType join_bndr
                                , sc_cont   = mkBoringStop res_ty
                                } ) }

    mkDupableAlt :: SimplEnv -> OutId
                 -> JoinFloats -> OutAlt
                 -> SimplM (JoinFloats, OutAlt)
    mkDupableAlt :: SimplEnv
    -> CoreBndr
    -> JoinFloats
    -> Alt CoreBndr
    -> SimplM (JoinFloats, Alt CoreBndr)
    mkDupableAlt SimplEnv
    _env CoreBndr
    case_bndr JoinFloats
    jfloats (Alt AltCon
    con [CoreBndr]
    alt_bndrs CoreExpr
    alt_rhs_in)
      | [CoreBndr] -> CoreExpr -> Bool
    uncondInlineJoin [CoreBndr]
    alt_bndrs CoreExpr
    alt_rhs_in
        -- See point (DJ2) of Note [Duplicating join points]
      = (JoinFloats, Alt CoreBndr) -> SimplM (JoinFloats, Alt CoreBndr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JoinFloats
    jfloats, AltCon -> [CoreBndr] -> CoreExpr -> Alt CoreBndr
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [CoreBndr]
    alt_bndrs CoreExpr
    alt_rhs_in)

      | Bool
    otherwise
      = do  { let rhs_ty' :: Kind
    rhs_ty'  = HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    alt_rhs_in

                  bangs :: [StrictnessMark]
    bangs
                    | DataAlt DataCon
    c <- AltCon
    con
                    = DataCon -> [StrictnessMark]
    dataConRepStrictness DataCon
    c
                    | Bool
    otherwise = []

                  abstracted_binders :: [(CoreBndr, StrictnessMark)]
    abstracted_binders = [CoreBndr] -> [StrictnessMark] -> [(CoreBndr, StrictnessMark)]
    abstract_binders [CoreBndr]
    alt_bndrs [StrictnessMark]
    bangs

                  abstract_binders :: [Var] -> [StrictnessMark] -> [(Id,StrictnessMark)]
                  abstract_binders :: [CoreBndr] -> [StrictnessMark] -> [(CoreBndr, StrictnessMark)]
    abstract_binders [] []
                    -- Abstract over the case binder too if it's used.
                    | CoreBndr -> Bool
    isDeadBinder CoreBndr
    case_bndr  = []
                    | Bool
    otherwise               = [(CoreBndr
    case_bndr,StrictnessMark
    MarkedStrict)]
                  abstract_binders (CoreBndr
    alt_bndr:[CoreBndr]
    alt_bndrs) [StrictnessMark]
    marks
                    -- Abstract over all type variables just in case
                    | CoreBndr -> Bool
    isTyVar CoreBndr
    alt_bndr        = (CoreBndr
    alt_bndr,StrictnessMark
    NotMarkedStrict) (CoreBndr, StrictnessMark)
    -> [(CoreBndr, StrictnessMark)] -> [(CoreBndr, StrictnessMark)]
    forall a. a -> [a] -> [a]
    : [CoreBndr] -> [StrictnessMark] -> [(CoreBndr, StrictnessMark)]
    abstract_binders [CoreBndr]
    alt_bndrs [StrictnessMark]
    marks
                  abstract_binders (CoreBndr
    alt_bndr:[CoreBndr]
    alt_bndrs) (StrictnessMark
    mark:[StrictnessMark]
    marks)
                    -- The deadness info on the new Ids is preserved by simplBinders
                    -- We don't abstract over dead ids here.
                    | CoreBndr -> Bool
    isDeadBinder CoreBndr
    alt_bndr   = [CoreBndr] -> [StrictnessMark] -> [(CoreBndr, StrictnessMark)]
    abstract_binders [CoreBndr]
    alt_bndrs [StrictnessMark]
    marks
                    | Bool
    otherwise               = (CoreBndr
    alt_bndr,StrictnessMark
    mark) (CoreBndr, StrictnessMark)
    -> [(CoreBndr, StrictnessMark)] -> [(CoreBndr, StrictnessMark)]
    forall a. a -> [a] -> [a]
    : [CoreBndr] -> [StrictnessMark] -> [(CoreBndr, StrictnessMark)]
    abstract_binders [CoreBndr]
    alt_bndrs [StrictnessMark]
    marks
                  abstract_binders [CoreBndr]
    _ [StrictnessMark]
    _ = String -> SDoc -> [(CoreBndr, StrictnessMark)]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "abstrict_binders - failed to abstract" (Alt CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Alt CoreBndr -> SDoc) -> Alt CoreBndr -> SDoc
    forall a b. (a -> b) -> a -> b
    $ AltCon -> [CoreBndr] -> CoreExpr -> Alt CoreBndr
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [CoreBndr]
    alt_bndrs CoreExpr
    alt_rhs_in)

                  filtered_binders :: [CoreBndr]
    filtered_binders = ((CoreBndr, StrictnessMark) -> CoreBndr)
    -> [(CoreBndr, StrictnessMark)] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoreBndr, StrictnessMark) -> CoreBndr
    forall a b. (a, b) -> a
    fst [(CoreBndr, StrictnessMark)]
    abstracted_binders
                  -- We want to make any binder with an evaldUnfolding strict in the rhs.
                  -- See Note [Call-by-value for worker args] (which also applies to join points)
                  rhs_with_seqs :: CoreExpr
    rhs_with_seqs = [(CoreBndr, StrictnessMark)] -> CoreExpr -> CoreExpr
    mkStrictFieldSeqs [(CoreBndr, StrictnessMark)]
    abstracted_binders CoreExpr
    alt_rhs_in

                  final_args :: [CoreExpr]
    final_args = [CoreBndr] -> [CoreExpr]
    forall b. [CoreBndr] -> [Expr b]
    varsToCoreExprs [CoreBndr]
    filtered_binders
                               -- Note [Join point abstraction]

                    -- We make the lambdas into one-shot-lambdas.  The
                    -- join point is sure to be applied at most once, and doing so
                    -- prevents the body of the join point being floated out by
                    -- the full laziness pass
                  final_bndrs :: [CoreBndr]
    final_bndrs     = (CoreBndr -> CoreBndr) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreBndr -> CoreBndr
    one_shot [CoreBndr]
    filtered_binders
                  one_shot :: CoreBndr -> CoreBndr
    one_shot CoreBndr
    v | CoreBndr -> Bool
    isId CoreBndr
    v    = CoreBndr -> CoreBndr
    setOneShotLambda CoreBndr
    v
                             | Bool
    otherwise = CoreBndr
    v

                  -- No lambda binder has an unfolding, but (currently) case binders can,
                  -- so we must zap them here.
                  join_rhs :: CoreExpr
    join_rhs   = [CoreBndr] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams ((CoreBndr -> CoreBndr) -> [CoreBndr] -> [CoreBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreBndr -> CoreBndr
    zapIdUnfolding [CoreBndr]
    final_bndrs) CoreExpr
    rhs_with_seqs

            ; join_bndr <- [CoreBndr] -> Kind -> SimplM CoreBndr
    newJoinId [CoreBndr]
    filtered_binders Kind
    rhs_ty'
            ; let -- join_bndr_w_unf = join_bndr `setIdUnfolding`
                  --                   mkUnfolding uf_opts VanillaSrc False False join_rhs Nothing
                  -- See Note [Do not add unfoldings to join points at birth]
                  join_call = CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (CoreBndr -> CoreExpr
    forall b. CoreBndr -> Expr b
    Var CoreBndr
    join_bndr) [CoreExpr]
    final_args
                  alt'      = AltCon -> [CoreBndr] -> CoreExpr -> Alt CoreBndr
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [CoreBndr]
    alt_bndrs CoreExpr
    join_call

            ; return ( jfloats `addJoinFlts` unitJoinFloat (NonRec join_bndr join_rhs)
                     , alt') }
                    -- See Note [Duplicated env]

    {-
    Note [Do not add unfoldings to join points at birth]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this (#15360)

       case (case (case (case ...))) of
          Left x  -> e1
          Right y -> e2

    We will make a join point for e1, e2, thus
        $j1a x = e1
        $j1b y = e2

    Now those join point calls count as "duplicable" , so we feel free to duplicate
    them into the loop nest.  And each of those calls are then subject to
    callSiteInline, which might inline them, if e1, e2 are reasonably small.  Now,
    if this applies recursive to the next `case` inwards, and so on, the net
    effect is that we can get an exponential number of calls to $j1a and $j1b, and
    an exponential number of inlinings (since each is done independently).

    This hit #15360 (not a complicated program!) badly.  Our simple solution is this:
    when a join point is born, we don't give it an unfolding, so it will not be inlined
    at its call sites, at least not in that pass.  So we end up with
        $j1a x = e1
        $j1b y = e2
        $j2a x = ...$j1a ... $j1b...
        $j2b x = ...$j1a ... $j1b...
        ... and so on...

    In the next iteration of the Simplifier we are into Note [Avoid inlining into
    deeply nested cases] in Simplify.Inline, which is still a challenge.  But at
    least we have a chance. If we add inlinings at birth we never get that chance.

    Wrinkle

    (JU1) It turns out that the same problem shows up in a different guise, via
          Note [Post-inline for single-use things] in Simplify.Utils.  I think
          we have something like
             case K (join $j x = <rhs> in jblah) of K y{OneOcc} -> blah
          where $j is a freshly-born join point.  After case-of-known-constructor
          wo we end up substituting (join $j x = <rhs> in jblah) for `y` in `blah`;
          and thus we re-simplify that join binding.  In test T15630 this results in
          massive duplication.

          So in `simplLetUnfolding` we spot this case a bit hackily; a freshly-born
          join point will have OccInfo of ManyOccs, unlike an existing join point which
          will have OneOcc.  So in simplLetUnfolding we kill the unfolding of a freshly
          born join point.

    I can't quite articulate precisely why this is so important.  But it makes a
    MASSIVE difference in T15630 (a fantastic test case); and at worst it'll merely
    delay inlining join points by one simplifier iteration.

    In effect (JU1) just extends the original Note [Do not add unfoldings to join
    points at birth] to occasions where we re-visit the same join-point in the same
    Simplifier iteration.

    Note [Fusing case continuations]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's important to fuse two successive case continuations when the
    first has one alternative.  That's why we call prepareCaseCont here.
    Consider this, which arises from thunk splitting (see Note [Thunk
    splitting] in GHC.Core.Opt.WorkWrap):

          let
            x* = case (case v of {pn -> rn}) of
                   I# a -> I# a
          in body

    The simplifier will find
        (Var v) with continuation
                Select (pn -> rn) (
                Select [I# a -> I# a] (
                StrictBind body Stop

    So we'll call mkDupableCont on
       Select [I# a -> I# a] (StrictBind body Stop)
    There is just one alternative in the first Select, so we want to
    simplify the rhs (I# a) with continuation (StrictBind body Stop)
    Supposing that body is big, we end up with
              let $j a = <let x = I# a in body>
              in case v of { pn -> case rn of
                                     I# a -> $j a }
    This is just what we want because the rn produces a box that
    the case rn cancels with.

    See #4957 a fuller example.

    Note [Duplicating join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In #19996 we discovered that we want to be really careful about
    inlining join points.   Consider
        case (join $j x = K f x )
             (in case v of      )
             (     p1 -> $j x1  ) of
             (     p2 -> $j x2  )
             (     p3 -> $j x3  )
          K g y -> blah[g,y]

    Here the join-point RHS is very small, just a constructor
    application (K f x).  So we might inline it to get
        case (case v of          )
             (     p1 -> K f x1  ) of
             (     p2 -> K f x2  )
             (     p3 -> K f x3  )
          K g y -> blah[g,y]

    But now we have to make `blah` into a join point, /abstracted/
    over `g` and `y`.   In contrast, if we /don't/ inline $j we
    don't need a join point for `blah` and we'll get
        join $j x = let g=f, y=x in blah[g,y]
        in case v of
           p1 -> $j x1
           p2 -> $j x2
           p3 -> $j x3

    This can make a /massive/ difference, because `blah` can see
    what `f` is, instead of lambda-abstracting over it.

    Beyond this, not-inlining join points reduces duplication.  In the above
    example, if `blah` was small enough we'd inline it, but that duplicates code,
    for no gain.  Best just to keep not-inline the join point in the first place.
    So not-inlining join points is our default: but see Note [Inlining join points]
    in GHC.Core.Opt.Simplify.Inline for when we /do/ inline them.

    To achieve this parsimonious inlining of join points, we need to do two things:
    (a) create a join point even if the RHS is small; and (b) don't do
    unconditional-inlining for join points.

    (DJ1) Do not postInlineUnconditionally a join point, ever. Doing
       postInlineUnconditionally is primarily to push allocation into cold
       branches; but a join point doesn't allocate, so that's a non-motivation.

    (DJ2) In mkDupableAlt and mkDupableStrictBind, generate an alterative for /all/
       alternatives, /except/ for ones that will definitely inline unconditionally
       straight away.  (In that case it's silly to make a join point in the first
       place; it just takes an extra Simplifier iteration to undo.)  This choice is
       made by GHC.Core.Unfold.uncondInlineJoin.

       This plan generates a lot of join points, but makes them much more
       case-of-case friendly.

    (DJ3) When should `uncondInlineJoin` return True?
       * (exprIsTrivial rhs); this includes uses of unsafeEqualityProof etc; see
         the defn of exprIsTrivial.  Also nullary constructors.

       * The RHS is a call ($j x y z), where the arguments are all trivial and $j
         is a join point: there is no point in creating an indirection.

    (DJ4) By the same token we want to use Plan B in Note [Duplicating StrictArg] when
       the RHS of the new join point is a data constructor application.  See the
       call to isDataConId in the StrictArg case of mkDupableContWithDmds.

       That same Note [Duplicating StrictArg] explains why we sometimes want Plan A
       when the RHS of the new join point would be a non-data-constructor
       application

    (DJ5) You might worry that $j = K x y might look so small that it is inlined
       by the call site inliner, defeating (DJ3). But in fact

       - The UnfoldingGuidance for a join point is only UnfWhen (unconditional)
         if `uncondInlineJoin` is true; see GHC.Core.Unfold.uncondInline

       - `GHC.Core.Opt.Simplify.Inline.tryUnfolding` has a special case for join
         points, described Note [Inlining join points] in that module.

    Historical Note [Case binders and join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    NB: this entire Note is now irrelevant.  In Jun 21 we stopped
    adding unfoldings to lambda binders (#17530).  It was always a
    hack and bit us in multiple small and not-so-small ways

    Consider this
       case (case .. ) of c {
         I# c# -> ....c....

    If we make a join point with c but not c# we get
      $j = \c -> ....c....

    But if later inlining scrutinises the c, thus

      $j = \c -> ... case c of { I# y -> ... } ...

    we won't see that 'c' has already been scrutinised.  This actually
    happens in the 'tabulate' function in wave4main, and makes a significant
    difference to allocation.

    An alternative plan is this:

       $j = \c# -> let c = I# c# in ...c....

    but that is bad if 'c' is *not* later scrutinised.

    So instead we do both: we pass 'c' and 'c#' , and record in c's inlining
    (a stable unfolding) that it's really I# c#, thus

       $j = \c# -> \c[=I# c#] -> ...c....

    Absence analysis may later discard 'c'.

    NB: take great care when doing strictness analysis;
        see Note [Lambda-bound unfoldings] in GHC.Core.Opt.DmdAnal.

    Also note that we can still end up passing stuff that isn't used.  Before
    strictness analysis we have
       let $j x y c{=(x,y)} = (h c, ...)
       in ...
    After strictness analysis we see that h is strict, we end up with
       let $j x y c{=(x,y)} = ($wh x y, ...)
    and c is unused.

    Note [Duplicated env]
    ~~~~~~~~~~~~~~~~~~~~~
    Some of the alternatives are simplified, but have not been turned into a join point
    So they *must* have a zapped subst-env.  So we can't use completeNonRecX to
    bind the join point, because it might to do PostInlineUnconditionally, and
    we'd lose that when zapping the subst-env.  We could have a per-alt subst-env,
    but zapping it (as we do in mkDupableCont, the Select case) is safe, and
    at worst delays the join-point inlining.

    Note [Funky mkLamTypes]
    ~~~~~~~~~~~~~~~~~~~~~~
    Notice the funky mkLamTypes.  If the constructor has existentials
    it's possible that the join point will be abstracted over
    type variables as well as term variables.
     Example:  Suppose we have
            data T = forall t.  C [t]
     Then faced with
            case (case e of ...) of
                C t xs::[t] -> rhs
     We get the join point
            let j :: forall t. [t] -> ...
                j = /\t \xs::[t] -> rhs
            in
            case (case e of ...) of
                C t xs::[t] -> j t xs

    Note [Duplicating StrictArg]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dealing with making a StrictArg continuation duplicable has turned out
    to be one of the trickiest corners of the simplifier, giving rise
    to several cases in which the simplier expanded the program's size
    *exponentially*.  They include
      #13253 exponential inlining
      #10421 ditto
      #18140 strict constructors
      #18282 another nested-function call case

    Suppose we have a call
      f e1 (case x of { True -> r1; False -> r2 }) e3
    and f is strict in its second argument.  Then we end up in
    mkDupableCont with a StrictArg continuation for (f e1 <> e3).
    There are two ways to make it duplicable.

    * Plan A: move the entire call inwards, being careful not
      to duplicate e1 or e3, thus:
         let a1 = e1
             a3 = e3
         in case x of { True  -> f a1 r1 a3
                      ; False -> f a1 r2 a3 }

    * Plan B: make a join point:
         join $j x = f e1 x e3
         in case x of { True  -> jump $j r1
                      ; False -> jump $j r2 }

      Notice that Plan B is very like the way we handle strict bindings;
      see Note [Duplicating StrictBind].  And Plan B is exactly what we'd
      get if we turned use a case expression to evaluate the strict arg:

           case (case x of { True -> r1; False -> r2 }) of
             r -> f e1 r e3

      So, looking at Note [Duplicating join points], we also want Plan B
      when `f` is a data constructor.

    Plan A is often good:

    * The calls to `f` may well be able to inline, since they are now applied
      to more informative arguments, `r1`, `r2`. For example:
            && E (case x of { T -> F; F -> T })
      Pushing the call inward (being careful not to duplicate E) we get
            let a = E
            in case x of { T -> && a F; F -> && a T }
      and now the (&& a F) etc can optimise.

    * Moreover there might be a RULE for the function that can fire when it "sees"
      the particular case alternative.

    * More specialisation can happen.  Here's an example from #3116
         go (n+1) (case l of
                     1  -> bs'
                     _  -> Chunk p fpc (o+1) (l-1) bs')

      If we pushed the entire call for 'go' inside the case, we get
      call-pattern specialisation for 'go', which is *crucial* for
      this particular program.

    But Plan A can have terrible, terrible behaviour. Here is a classic
    case:
      f (f (f (f (f True))))

    Suppose f is strict, and has a body that is small enough to inline.
    The innermost call inlines (seeing the True) to give
      f (f (f (f (case v of { True -> e1; False -> e2 }))))

    Now, suppose we naively push the entire continuation into both
    case branches (it doesn't look large, just f.f.f.f). We get
      case v of
        True  -> f (f (f (f e1)))
        False -> f (f (f (f e2)))

    And now the process repeats, so we end up with an exponentially large
    number of copies of f. No good!

    CONCLUSION: we want Plan A in general, but do Plan B is there a
    danger of this nested call behaviour. The function that decides
    this is called thumbsUpPlanA.

    Note [Keeping demand info in StrictArg Plan A]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Following on from Note [Duplicating StrictArg], another common code
    pattern that can go bad is this:
       f (case x1 of { T -> F; F -> T })
         (case x2 of { T -> F; F -> T })
         ...etc...
    when f is strict in all its arguments.  (It might, for example, be a
    strict data constructor whose wrapper has not yet been inlined.)

    We use Plan A (because there is no nesting) giving
      let a2 = case x2 of ...
          a3 = case x3 of ...
      in case x1 of { T -> f F a2 a3 ... ; F -> f T a2 a3 ... }

    Now we must be careful!  a2 and a3 are small, and the OneOcc code in
    postInlineUnconditionally may inline them both at both sites; see Note
    Note [Inline small things to avoid creating a thunk] in
    Simplify.Utils. But if we do inline them, the entire process will
    repeat -- back to exponential behaviour.

    So we are careful to keep the demand-info on a2 and a3.  Then they'll
    be /strict/ let-bindings, which will be dealt with by StrictBind.
    That's why contIsDupableWithDmds is careful to propagage demand
    info to the auxiliary bindings it creates.  See the Demand argument
    to makeTrivial.

    Note [Duplicating StrictBind]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We make a StrictBind duplicable in a very similar way to
    that for case expressions.  After all,
       let x* = e in b   is similar to    case e of x -> b

    So we potentially make a join-point for the body, thus:
       let x = <> in b   ==>   join j x = b
                               in j <>

    Just like StrictArg in fact -- and indeed they share code.

    Note [Join point abstraction]  Historical note
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    NB: This note is now historical, describing how (in the past) we used
    to add a void argument to nullary join points.  But now that "join
    point" is not a fuzzy concept but a formal syntactic construct (as
    distinguished by the JoinId constructor of IdDetails), each of these
    concerns is handled separately, with no need for a vestigial extra
    argument.

    Join points always have at least one value argument,
    for several reasons

    * If we try to lift a primitive-typed something out
      for let-binding-purposes, we will *caseify* it (!),
      with potentially-disastrous strictness results.  So
      instead we turn it into a function: \v -> e
      where v::Void#.  The value passed to this function is void,
      which generates (almost) no code.

    * CPR.  We used to say "&& isUnliftedType rhs_ty'" here, but now
      we make the join point into a function whenever used_bndrs'
      is empty.  This makes the join-point more CPR friendly.
      Consider:       let j = if .. then I# 3 else I# 4
                      in case .. of { A -> j; B -> j; C -> ... }

      Now CPR doesn't w/w j because it's a thunk, so
      that means that the enclosing function can't w/w either,
      which is a lose.  Here's the example that happened in practice:
              kgmod :: Int -> Int -> Int
              kgmod x y = if x > 0 && y < 0 || x < 0 && y > 0
                          then 78
                          else 5

    * Let-no-escape.  We want a join point to turn into a let-no-escape
      so that it is implemented as a jump, and one of the conditions
      for LNE is that it's not updatable.  In CoreToStg, see
      Note [What is a non-escaping let]

    * Floating.  Since a join point will be entered once, no sharing is
      gained by floating out, but something might be lost by doing
      so because it might be allocated.

    I have seen a case alternative like this:
            True -> \v -> ...
    It's a bit silly to add the realWorld dummy arg in this case, making
            $j = \s v -> ...
               True -> $j s
    (the \v alone is enough to make CPR happy) but I think it's rare

    There's a slight infelicity here: we pass the overall
    case_bndr to all the join points if it's used in *any* RHS,
    because we don't know its usage in each RHS separately

    ************************************************************************
    *                                                                      *
                        Unfoldings
    *                                                                      *
    ************************************************************************
    -}

    simplLetUnfolding :: SimplEnv
                      -> BindContext
                      -> InId
                      -> OutExpr -> OutType -> ArityType
                      -> Unfolding -> SimplM Unfolding
    simplLetUnfolding :: SimplEnv
    -> BindContext
    -> CoreBndr
    -> CoreExpr
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplLetUnfolding SimplEnv
    env BindContext
    bind_cxt CoreBndr
    id CoreExpr
    new_rhs Kind
    rhs_ty ArityType
    arity Unfolding
    unf
      | Unfolding -> Bool
    isStableUnfolding Unfolding
    unf
      = SimplEnv
    -> BindContext
    -> CoreBndr
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplStableUnfolding SimplEnv
    env BindContext
    bind_cxt CoreBndr
    id Kind
    rhs_ty ArityType
    arity Unfolding
    unf

      | CoreBndr -> Bool
    freshly_born_join_point CoreBndr
    id
      = -- This is a tricky one!
        -- See wrinkle (JU1) in Note [Do not add unfoldings to join points at birth]
        Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    noUnfolding

      | CoreBndr -> Bool
    isExitJoinId CoreBndr
    id
      = -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify
        Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    noUnfolding

      | Bool
    otherwise
      = SimplEnv
    -> TopLevelFlag
    -> UnfoldingSource
    -> CoreBndr
    -> Bool
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding SimplEnv
    env (BindContext -> TopLevelFlag
    bindContextLevel BindContext
    bind_cxt) UnfoldingSource
    VanillaSrc CoreBndr
    id Bool
    is_join_point CoreExpr
    new_rhs

      where
        is_join_point :: Bool
    is_join_point = CoreBndr -> Bool
    isJoinId CoreBndr
    id
        freshly_born_join_point :: CoreBndr -> Bool
    freshly_born_join_point CoreBndr
    id = Bool
    is_join_point Bool -> Bool -> Bool
    && OccInfo -> Bool
    isManyOccs (CoreBndr -> OccInfo
    idOccInfo CoreBndr
    id)
          -- OLD: too_many_occs (OneOcc { occ_n_br = n }) = n > 10 -- See #23627

    -------------------
    mkLetUnfolding :: SimplEnv -> TopLevelFlag -> UnfoldingSource
                   -> InId -> Bool    -- True <=> this is a join point
                   -> OutExpr -> SimplM Unfolding
    mkLetUnfolding :: SimplEnv
    -> TopLevelFlag
    -> UnfoldingSource
    -> CoreBndr
    -> Bool
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding SimplEnv
    env TopLevelFlag
    top_lvl UnfoldingSource
    src CoreBndr
    id Bool
    is_join CoreExpr
    new_rhs
      = Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnfoldingOpts
    -> UnfoldingSource
    -> Bool
    -> Bool
    -> Bool
    -> CoreExpr
    -> Maybe UnfoldingCache
    -> Unfolding
    mkUnfolding UnfoldingOpts
    uf_opts UnfoldingSource
    src Bool
    is_top_lvl Bool
    is_bottoming Bool
    is_join CoreExpr
    new_rhs Maybe UnfoldingCache
    forall a. Maybe a
    Nothing)
                -- We make an  unfolding *even for loop-breakers*.
                -- Reason: (a) It might be useful to know that they are WHNF
                --         (b) In GHC.Iface.Tidy we currently assume that, if we want to
                --             expose the unfolding then indeed we *have* an unfolding
                --             to expose.  (We could instead use the RHS, but currently
                --             we don't.)  The simple thing is always to have one.
      where
        -- !opts: otherwise, we end up retaining all the SimpleEnv
        !uf_opts :: UnfoldingOpts
    uf_opts = SimplEnv -> UnfoldingOpts
    seUnfoldingOpts SimplEnv
    env

        -- Might as well force this, profiles indicate up to
        -- 0.5MB of thunks just from this site.
        !is_top_lvl :: Bool
    is_top_lvl   = TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_lvl
        -- See Note [Force bottoming field]
        !is_bottoming :: Bool
    is_bottoming = CoreBndr -> Bool
    isDeadEndId CoreBndr
    id

    -------------------
    simplStableUnfolding :: SimplEnv -> BindContext
                         -> InId
                         -> OutType
                         -> ArityType      -- Used to eta expand, but only for non-join-points
                         -> Unfolding
                         ->SimplM Unfolding
    -- Note [Setting the new unfolding]
    simplStableUnfolding :: SimplEnv
    -> BindContext
    -> CoreBndr
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplStableUnfolding SimplEnv
    env BindContext
    bind_cxt CoreBndr
    id Kind
    rhs_ty ArityType
    id_arity Unfolding
    unf
      = case Unfolding
    unf of
          Unfolding
    NoUnfolding   -> Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    unf
          Unfolding
    BootUnfolding -> Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    unf
          OtherCon {}   -> Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    unf

          DFunUnfolding { df_bndrs :: Unfolding -> [CoreBndr]
    df_bndrs = [CoreBndr]
    bndrs, df_con :: Unfolding -> DataCon
    df_con = DataCon
    con, df_args :: Unfolding -> [CoreExpr]
    df_args = [CoreExpr]
    args }
            -> do { (env', bndrs') <- SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    simplBinders SimplEnv
    unf_env [CoreBndr]
    bndrs
                  ; args' <- mapM (simplExpr env') args
                  ; return (mkDFunUnfolding bndrs' con args') }

          CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
    uf_tmpl = CoreExpr
    expr, uf_src :: Unfolding -> UnfoldingSource
    uf_src = UnfoldingSource
    src, uf_guidance :: Unfolding -> UnfoldingGuidance
    uf_guidance = UnfoldingGuidance
    guide }
            | UnfoldingSource -> Bool
    isStableSource UnfoldingSource
    src
            -> do { expr' <- case BindContext
    bind_cxt of
                      BC_Join RecFlag
    _ SimplCont
    cont    -> -- Binder is a join point
                                           -- See Note [Rules and unfolding for join points]
                                           SimplEnv -> CoreBndr -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplJoinRhs SimplEnv
    unf_env CoreBndr
    id CoreExpr
    expr SimplCont
    cont
                      BC_Let TopLevelFlag
    _ RecFlag
    is_rec -> -- Binder is not a join point
                                         do { let cont :: SimplCont
    cont = Kind -> RecFlag -> Demand -> SimplCont
    mkRhsStop Kind
    rhs_ty RecFlag
    is_rec Demand
    topDmd
                                               -- mkRhsStop: switch off eta-expansion at the top level
                                            ; expr' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    unf_env CoreExpr
    expr SimplCont
    cont
                                            ; return (eta_expand expr') }
                  ; case guide of
                      UnfWhen { ug_boring_ok :: UnfoldingGuidance -> Bool
    ug_boring_ok = Bool
    boring_ok }
                         -- Happens for INLINE things
                         -- Really important to force new_boring_ok since otherwise
                         --   `ug_boring_ok` is a thunk chain of
                         --   inlineBoringExprOk expr0 || inlineBoringExprOk expr1 || ...
                         -- See #20134
                         -> let !new_boring_ok :: Bool
    new_boring_ok = Bool
    boring_ok Bool -> Bool -> Bool
    || CoreExpr -> Bool
    inlineBoringOk CoreExpr
    expr'
                                guide' :: UnfoldingGuidance
    guide' = UnfoldingGuidance
    guide { ug_boring_ok = new_boring_ok }
                            -- Refresh the boring-ok flag, in case expr'
                            -- has got small. This happens, notably in the inlinings
                            -- for dfuns for single-method classes; see
                            -- Note [Single-method classes] in GHC.Tc.TyCl.Instance.
                            -- A test case is #4138
                            -- But retain a previous boring_ok of True; e.g. see
                            -- the way it is set in calcUnfoldingGuidanceWithArity
                            in Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnfoldingSource
    -> Bool
    -> CoreExpr
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src Bool
    is_top_lvl CoreExpr
    expr' Maybe UnfoldingCache
    forall a. Maybe a
    Nothing UnfoldingGuidance
    guide')
                                -- See Note [Top-level flag on inline rules] in GHC.Core.Unfold

                      UnfoldingGuidance
    _other              -- Happens for INLINABLE things
                         -> SimplEnv
    -> TopLevelFlag
    -> UnfoldingSource
    -> CoreBndr
    -> Bool
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding SimplEnv
    env TopLevelFlag
    top_lvl UnfoldingSource
    src CoreBndr
    id Bool
    False CoreExpr
    expr' }
                    -- If the guidance is UnfIfGoodArgs, this is an INLINABLE
                    -- unfolding, and we need to make sure the guidance is kept up
                    -- to date with respect to any changes in the unfolding.

            | Bool
    otherwise -> Unfolding -> SimplM Unfolding
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    noUnfolding   -- Discard unstable unfoldings
      where
        -- Forcing this can save about 0.5MB of max residency and the result
        -- is small and easy to compute so might as well force it.
        top_lvl :: TopLevelFlag
    top_lvl     = BindContext -> TopLevelFlag
    bindContextLevel BindContext
    bind_cxt
        !is_top_lvl :: Bool
    is_top_lvl = TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_lvl
        act :: Activation
    act        = CoreBndr -> Activation
    idInlineActivation CoreBndr
    id
        unf_env :: SimplEnv
    unf_env    = (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv
    updMode (Activation -> SimplMode -> SimplMode
    updModeForStableUnfoldings Activation
    act) SimplEnv
    env
             -- See Note [Simplifying inside stable unfoldings] in GHC.Core.Opt.Simplify.Utils

        -- See Note [Eta-expand stable unfoldings]
        -- Use the arity from the main Id (in id_arity), rather than computing it from rhs
        -- Not used for join points
        eta_expand :: CoreExpr -> CoreExpr
    eta_expand CoreExpr
    expr | SimplEnv -> Bool
    seEtaExpand SimplEnv
    env
                        , CoreExpr -> Int
    exprArity CoreExpr
    expr Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < ArityType -> Int
    arityTypeArity ArityType
    id_arity
                        , CoreExpr -> Bool
    wantEtaExpansion CoreExpr
    expr
                        = InScopeSet -> ArityType -> CoreExpr -> CoreExpr
    etaExpandAT (SimplEnv -> InScopeSet
    getInScope SimplEnv
    env) ArityType
    id_arity CoreExpr
    expr
                        | Bool
    otherwise
                        = CoreExpr
    expr

    {- Note [Eta-expand stable unfoldings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For INLINE/INLINABLE things (which get stable unfoldings) there's a danger
    of getting
       f :: Int -> Int -> Int -> Blah
       [ Arity = 3                 -- Good arity
       , Unf=Stable (\xy. blah)    -- Less good arity, only 2
       f = \pqr. e

    This can happen because f's RHS is optimised more vigorously than
    its stable unfolding.  Now suppose we have a call
       g = f x
    Because f has arity=3, g will have arity=2.  But if we inline f (using
    its stable unfolding) g's arity will reduce to 1, because <blah>
    hasn't been optimised yet.  This happened in the 'parsec' library,
    for Text.Pasec.Char.string.

    Generally, if we know that 'f' has arity N, it seems sensible to
    eta-expand the stable unfolding to arity N too. Simple and consistent.

    Wrinkles

    * See Historical-note [Eta-expansion in stable unfoldings] in
      GHC.Core.Opt.Simplify.Utils

    * Don't eta-expand a trivial expr, else each pass will eta-reduce it,
      and then eta-expand again. See Note [Which RHSs do we eta-expand?]
      in GHC.Core.Opt.Simplify.Utils.

    * Don't eta-expand join points; see Note [Do not eta-expand join points]
      in GHC.Core.Opt.Simplify.Utils.  We uphold this because the join-point
      case (bind_cxt = BC_Join {}) doesn't use eta_expand.

    Note [Force bottoming field]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We need to force bottoming, or the new unfolding holds
    on to the old unfolding (which is part of the id).

    Note [Setting the new unfolding]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    * If there's an INLINE pragma, we simplify the RHS gently.  Maybe we
      should do nothing at all, but simplifying gently might get rid of
      more crap.

    * If not, we make an unfolding from the new RHS.  But *only* for
      non-loop-breakers. Making loop breakers not have an unfolding at all
      means that we can avoid tests in exprIsConApp, for example.  This is
      important: if exprIsConApp says 'yes' for a recursive thing, then we
      can get into an infinite loop

    If there's a stable unfolding on a loop breaker (which happens for
    INLINABLE), we hang on to the inlining.  It's pretty dodgy, but the
    user did say 'INLINE'.  May need to revisit this choice.

    ************************************************************************
    *                                                                      *
                        Rules
    *                                                                      *
    ************************************************************************

    Note [Rules in a letrec]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    After creating fresh binders for the binders of a letrec, we
    substitute the RULES and add them back onto the binders; this is done
    *before* processing any of the RHSs.  This is important.  Manuel found
    cases where he really, really wanted a RULE for a recursive function
    to apply in that function's own right-hand side.

    See Note [Forming Rec groups] in "GHC.Core.Opt.OccurAnal"
    -}

    addBndrRules :: SimplEnv -> InBndr -> OutBndr
                 -> BindContext
                 -> SimplM (SimplEnv, OutBndr)
    -- Rules are added back into the bin
    addBndrRules :: SimplEnv
    -> CoreBndr
    -> CoreBndr
    -> BindContext
    -> SimplM (SimplEnv, CoreBndr)
    addBndrRules SimplEnv
    env CoreBndr
    in_id CoreBndr
    out_id BindContext
    bind_cxt
      | [CoreRule] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    old_rules
      = (SimplEnv, CoreBndr) -> SimplM (SimplEnv, CoreBndr)
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env, CoreBndr
    out_id)
      | Bool
    otherwise
      = do { new_rules <- SimplEnv
    -> Maybe CoreBndr -> [CoreRule] -> BindContext -> SimplM [CoreRule]
    simplRules SimplEnv
    env (CoreBndr -> Maybe CoreBndr
    forall a. a -> Maybe a
    Just CoreBndr
    out_id) [CoreRule]
    old_rules BindContext
    bind_cxt
           ; let final_id  = CoreBndr
    out_id CoreBndr -> RuleInfo -> CoreBndr
    `setIdSpecialisation` [CoreRule] -> RuleInfo
    mkRuleInfo [CoreRule]
    new_rules
           ; return (modifyInScope env final_id, final_id) }
      where
        old_rules :: [CoreRule]
    old_rules = RuleInfo -> [CoreRule]
    ruleInfoRules (CoreBndr -> RuleInfo
    idSpecialisation CoreBndr
    in_id)

    simplImpRules :: SimplEnv -> [CoreRule] -> SimplM [CoreRule]
    -- Simplify local rules for imported Ids
    simplImpRules :: SimplEnv -> [CoreRule] -> SimplM [CoreRule]
    simplImpRules SimplEnv
    env [CoreRule]
    rules
      = SimplEnv
    -> Maybe CoreBndr -> [CoreRule] -> BindContext -> SimplM [CoreRule]
    simplRules SimplEnv
    env Maybe CoreBndr
    forall a. Maybe a
    Nothing [CoreRule]
    rules (TopLevelFlag -> RecFlag -> BindContext
    BC_Let TopLevelFlag
    TopLevel RecFlag
    NonRecursive)

    simplRules :: SimplEnv -> Maybe OutId -> [CoreRule]
               -> BindContext -> SimplM [CoreRule]
    simplRules :: SimplEnv
    -> Maybe CoreBndr -> [CoreRule] -> BindContext -> SimplM [CoreRule]
    simplRules SimplEnv
    env Maybe CoreBndr
    mb_new_id [CoreRule]
    rules BindContext
    bind_cxt
      = (CoreRule -> SimplM CoreRule) -> [CoreRule] -> SimplM [CoreRule]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM CoreRule -> SimplM CoreRule
    simpl_rule [CoreRule]
    rules
      where
        simpl_rule :: CoreRule -> SimplM CoreRule
    simpl_rule rule :: CoreRule
    rule@(BuiltinRule {})
          = CoreRule -> SimplM CoreRule
    forall a. a -> SimplM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreRule
    rule

        simpl_rule rule :: CoreRule
    rule@(Rule { ru_bndrs :: CoreRule -> [CoreBndr]
    ru_bndrs = [CoreBndr]
    bndrs, ru_args :: CoreRule -> [CoreExpr]
    ru_args = [CoreExpr]
    args
                              , ru_fn :: CoreRule -> Name
    ru_fn = Name
    fn_name, ru_rhs :: CoreRule -> CoreExpr
    ru_rhs = CoreExpr
    rhs
                              , ru_act :: CoreRule -> Activation
    ru_act = Activation
    act })
          = do { (env', bndrs') <- SimplEnv -> [CoreBndr] -> SimplM (SimplEnv, [CoreBndr])
    simplBinders SimplEnv
    env [CoreBndr]
    bndrs
               ; let rhs_ty = HasDebugCallStack => SimplEnv -> Kind -> Kind
    SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env' (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    rhs)
                     rhs_cont = case BindContext
    bind_cxt of  -- See Note [Rules and unfolding for join points]
                                    BC_Let {}      -> Kind -> SimplCont
    mkBoringStop Kind
    rhs_ty
                                    BC_Join RecFlag
    _ SimplCont
    cont -> Bool -> SDoc -> SimplCont -> SimplCont
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr Bool
    join_ok SDoc
    bad_join_msg SimplCont
    cont
                     lhs_env = (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv
    updMode SimplMode -> SimplMode
    updModeForRules SimplEnv
    env'
                     rhs_env = (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv
    updMode (Activation -> SimplMode -> SimplMode
    updModeForStableUnfoldings Activation
    act) SimplEnv
    env'
                               -- See Note [Simplifying the RHS of a RULE]
                     -- Force this to avoid retaining reference to old Id
                     !fn_name' = case Maybe CoreBndr
    mb_new_id of
                                  Just CoreBndr
    id -> CoreBndr -> Name
    idName CoreBndr
    id
                                  Maybe CoreBndr
    Nothing -> Name
    fn_name

                     -- join_ok is an assertion check that the join-arity of the
                     -- binder matches that of the rule, so that pushing the
                     -- continuation into the RHS makes sense
                     join_ok = case Maybe CoreBndr
    mb_new_id of
                                 Just CoreBndr
    id | JoinPoint Int
    join_arity <- CoreBndr -> JoinPointHood
    idJoinPointHood CoreBndr
    id
                                         -> [CoreExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    join_arity
                                 Maybe CoreBndr
    _ -> Bool
    False
                     bad_join_msg = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ Maybe CoreBndr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe CoreBndr
    mb_new_id, CoreRule -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreRule
    rule
                                         , Maybe JoinPointHood -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((CoreBndr -> JoinPointHood)
    -> Maybe CoreBndr -> Maybe JoinPointHood
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CoreBndr -> JoinPointHood
    idJoinPointHood Maybe CoreBndr
    mb_new_id) ]

               ; args' <- mapM (simplExpr lhs_env) args
               ; rhs'  <- simplExprC rhs_env rhs rhs_cont
               ; return (rule { ru_bndrs = bndrs'
                              , ru_fn    = fn_name'
                              , ru_args  = args'
                              , ru_rhs   = occurAnalyseExpr rhs' }) }
                                -- Remember to occ-analyse, to drop dead code.
                                -- See Note [OccInfo in unfoldings and rules] in GHC.Core

    {- Note [Simplifying the RHS of a RULE]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We can simplify the RHS of a RULE much as we do the RHS of a stable
    unfolding.  We used to use the much more conservative updModeForRules
    for the RHS as well as the LHS, but that seems more conservative
    than necesary.  Allowing some inlining might, for example, eliminate
    a binding.
    -}