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

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

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}

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

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Platform
    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Driver.Config
    import GHC.Core.Opt.Simplify.Monad
    import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst )
    import GHC.Core.Opt.Simplify.Env
    import GHC.Core.Opt.Simplify.Utils
    import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
    import GHC.Types.Literal   ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326
    import GHC.Types.SourceText
    import GHC.Types.Id
    import GHC.Types.Id.Make   ( seqId )
    import GHC.Core.Make       ( FloatBind, mkImpossibleExpr, castBottomExpr )
    import qualified GHC.Core.Make
    import GHC.Types.Id.Info
    import GHC.Types.Name           ( mkSystemVarName, isExternalName, getOccFS )
    import GHC.Core.Coercion hiding ( substCo, substCoVar )
    import GHC.Core.Coercion.Opt    ( optCoercion )
    import GHC.Core.FamInstEnv      ( FamInstEnv, topNormaliseType_maybe )
    import GHC.Core.DataCon
       ( DataCon, dataConWorkId, dataConRepStrictness
       , dataConRepArgTys, isUnboxedTupleDataCon
       , StrictnessMark (..) )
    import GHC.Core.Opt.Monad ( Tick(..), SimplMode(..) )
    import GHC.Core
    import GHC.Builtin.Types.Prim( realWorldStatePrimTy )
    import GHC.Builtin.Names( runRWKey )
    import GHC.Types.Demand ( StrictSig(..), Demand, dmdTypeDepth, isStrUsedDmd
                            , mkClosedStrictSig, topDmd, seqDmd, isDeadEndDiv )
    import GHC.Types.Cpr    ( mkCprSig, botCpr )
    import GHC.Core.Ppr     ( pprCoreExpr )
    import GHC.Types.Unique ( hasKey )
    import GHC.Core.Unfold
    import GHC.Core.Unfold.Make
    import GHC.Core.Utils
    import GHC.Core.Opt.Arity ( ArityType(..)
                              , pushCoTyArg, pushCoValArg
                              , idArityType, etaExpandAT )
    import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )
    import GHC.Core.FVs     ( mkRuleInfo )
    import GHC.Core.Rules   ( lookupRule, getRules, initRuleOpts )
    import GHC.Types.Basic
    import GHC.Utils.Monad  ( mapAccumLM, liftIO )
    import GHC.Utils.Logger
    import GHC.Types.Tickish
    import GHC.Types.Var    ( isTyCoVar )
    import GHC.Data.Maybe   ( isNothing, orElse )
    import Control.Monad
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Data.FastString
    import GHC.Utils.Misc
    import GHC.Unit.Module ( moduleName, pprModuleName )
    import GHC.Core.Multiplicity
    import GHC.Builtin.PrimOps ( PrimOp (SeqOp) )

    {-
    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 (which includes DynFlags for convenience)
         - 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.

    Note [Shadowing]
    ~~~~~~~~~~~~~~~~
    The simplifier used to guarantee that the output had no shadowing, but
    it does not do so any more.   (Actually, it never did!)  The reason is
    documented with simplifyArgs.

    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]
            ; !SimplEnv
    env1 <- {-#SCC "simplTopBinds-simplRecBndrs" #-} SimplEnv -> [OutId] -> SimplM SimplEnv
    simplRecBndrs SimplEnv
    env0 (forall b. [Bind b] -> [b]
    bindersOfBinds [InBind]
    binds0)
            ; (SimplFloats
    floats, SimplEnv
    env2) <- {-#SCC "simplTopBinds-simpl_binds" #-} SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
    simpl_binds SimplEnv
    env1 [InBind]
    binds0
            ; Tick -> SimplM ()
    freeTick Tick
    SimplifierDone
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, SimplEnv
    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 []           = 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 { (SimplFloats
    float,  SimplEnv
    env1) <- SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)
    simpl_bind SimplEnv
    env InBind
    bind
                                          ; (SimplFloats
    floats, SimplEnv
    env2) <- SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
    simpl_binds SimplEnv
    env1 [InBind]
    binds
                                          -- See Note [Bangs in the Simplifier]
                                          ; let !floats1 :: SimplFloats
    floats1 = SimplFloats
    float SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats
                                          ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1, SimplEnv
    env2) }

        simpl_bind :: SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)
    simpl_bind SimplEnv
    env (Rec [(OutId, CoreExpr)]
    pairs)
          = SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> [(OutId, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    simplRecBind SimplEnv
    env TopLevelFlag
    TopLevel forall a. Maybe a
    Nothing [(OutId, CoreExpr)]
    pairs
        simpl_bind SimplEnv
    env (NonRec OutId
    b CoreExpr
    r)
          = do { (SimplEnv
    env', OutId
    b') <- SimplEnv
    -> OutId -> OutId -> MaybeJoinCont -> SimplM (SimplEnv, OutId)
    addBndrRules SimplEnv
    env OutId
    b (SimplEnv -> OutId -> OutId
    lookupRecBndr SimplEnv
    env OutId
    b) forall a. Maybe a
    Nothing
               ; SimplEnv
    -> TopLevelFlag
    -> RecFlag
    -> MaybeJoinCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplRecOrTopPair SimplEnv
    env' TopLevelFlag
    TopLevel RecFlag
    NonRecursive forall a. Maybe a
    Nothing OutId
    b OutId
    b' CoreExpr
    r }

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

    simplRecBind is used for
            * recursive bindings only
    -}

    simplRecBind :: SimplEnv -> TopLevelFlag -> MaybeJoinCont
                 -> [(InId, InExpr)]
                 -> SimplM (SimplFloats, SimplEnv)
    simplRecBind :: SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> [(OutId, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    simplRecBind SimplEnv
    env0 TopLevelFlag
    top_lvl MaybeJoinCont
    mb_cont [(OutId, CoreExpr)]
    pairs0
      = do  { (SimplEnv
    env_with_info, [(OutId, OutId, CoreExpr)]
    triples) <- forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM SimplEnv
    -> (OutId, CoreExpr) -> SimplM (SimplEnv, (OutId, OutId, CoreExpr))
    add_rules SimplEnv
    env0 [(OutId, CoreExpr)]
    pairs0
            ; (SimplFloats
    rec_floats, SimplEnv
    env1) <- SimplEnv
    -> [(OutId, OutId, CoreExpr)] -> SimplM (SimplFloats, SimplEnv)
    go SimplEnv
    env_with_info [(OutId, OutId, CoreExpr)]
    triples
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats -> SimplFloats
    mkRecFloats SimplFloats
    rec_floats, SimplEnv
    env1) }
      where
        add_rules :: SimplEnv -> (InBndr,InExpr) -> SimplM (SimplEnv, (InBndr, OutBndr, InExpr))
            -- Add the (substituted) rules to the binder
        add_rules :: SimplEnv
    -> (OutId, CoreExpr) -> SimplM (SimplEnv, (OutId, OutId, CoreExpr))
    add_rules SimplEnv
    env (OutId
    bndr, CoreExpr
    rhs)
            = do { (SimplEnv
    env', OutId
    bndr') <- SimplEnv
    -> OutId -> OutId -> MaybeJoinCont -> SimplM (SimplEnv, OutId)
    addBndrRules SimplEnv
    env OutId
    bndr (SimplEnv -> OutId -> OutId
    lookupRecBndr SimplEnv
    env OutId
    bndr) MaybeJoinCont
    mb_cont
                 ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env', (OutId
    bndr, OutId
    bndr', CoreExpr
    rhs)) }

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

        go SimplEnv
    env ((OutId
    old_bndr, OutId
    new_bndr, CoreExpr
    rhs) : [(OutId, OutId, CoreExpr)]
    pairs)
            = do { (SimplFloats
    float, SimplEnv
    env1) <- SimplEnv
    -> TopLevelFlag
    -> RecFlag
    -> MaybeJoinCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplRecOrTopPair SimplEnv
    env TopLevelFlag
    top_lvl RecFlag
    Recursive MaybeJoinCont
    mb_cont
                                                      OutId
    old_bndr OutId
    new_bndr CoreExpr
    rhs
                 ; (SimplFloats
    floats, SimplEnv
    env2) <- SimplEnv
    -> [(OutId, OutId, CoreExpr)] -> SimplM (SimplFloats, SimplEnv)
    go SimplEnv
    env1 [(OutId, OutId, CoreExpr)]
    pairs
                 ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    float SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats, SimplEnv
    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
                      -> TopLevelFlag -> RecFlag -> MaybeJoinCont
                      -> InId -> OutBndr -> InExpr  -- Binder and rhs
                      -> SimplM (SimplFloats, SimplEnv)

    simplRecOrTopPair :: SimplEnv
    -> TopLevelFlag
    -> RecFlag
    -> MaybeJoinCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    simplRecOrTopPair SimplEnv
    env TopLevelFlag
    top_lvl RecFlag
    is_rec MaybeJoinCont
    mb_cont OutId
    old_bndr OutId
    new_bndr CoreExpr
    rhs
      | Just SimplEnv
    env' <- SimplEnv
    -> TopLevelFlag -> OutId -> CoreExpr -> SimplEnv -> Maybe SimplEnv
    preInlineUnconditionally SimplEnv
    env TopLevelFlag
    top_lvl OutId
    old_bndr CoreExpr
    rhs SimplEnv
    env
      = {-#SCC "simplRecOrTopPair-pre-inline-uncond" #-}
        [Char]
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    trace_bind [Char]
    "pre-inline-uncond" forall a b. (a -> b) -> a -> b
    $
        do { Tick -> SimplM ()
    tick (OutId -> Tick
    PreInlineUnconditionally OutId
    old_bndr)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env' ) }

      | Just SimplCont
    cont <- MaybeJoinCont
    mb_cont
      = {-#SCC "simplRecOrTopPair-join" #-}
        ASSERT( isNotTopLevel top_lvl && isJoinId new_bndr )
        [Char]
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    trace_bind [Char]
    "join" forall a b. (a -> b) -> a -> b
    $
        SimplEnv
    -> SimplCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplEnv
    -> SimplM (SimplFloats, SimplEnv)
    simplJoinBind SimplEnv
    env SimplCont
    cont OutId
    old_bndr OutId
    new_bndr CoreExpr
    rhs SimplEnv
    env

      | Bool
    otherwise
      = {-#SCC "simplRecOrTopPair-normal" #-}
        [Char]
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    trace_bind [Char]
    "normal" forall a b. (a -> b) -> a -> b
    $
        SimplEnv
    -> TopLevelFlag
    -> RecFlag
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplEnv
    -> SimplM (SimplFloats, SimplEnv)
    simplLazyBind SimplEnv
    env TopLevelFlag
    top_lvl RecFlag
    is_rec OutId
    old_bndr OutId
    new_bndr CoreExpr
    rhs SimplEnv
    env

      where
        dflags :: DynFlags
    dflags = SimplEnv -> DynFlags
    seDynFlags SimplEnv
    env
        logger :: Logger
    logger = SimplEnv -> Logger
    seLogger SimplEnv
    env

        -- trace_bind emits a trace for each top-level binding, which
        -- helps to locate the tracing for inlining and rule firing
        trace_bind :: [Char]
    -> SimplM (SimplFloats, SimplEnv) -> SimplM (SimplFloats, SimplEnv)
    trace_bind [Char]
    what SimplM (SimplFloats, SimplEnv)
    thing_inside
          | Bool -> Bool
    not (DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_verbose_core2core DynFlags
    dflags)
          = SimplM (SimplFloats, SimplEnv)
    thing_inside
          | Bool
    otherwise
          = forall a. Logger -> TraceAction a
    putTraceMsg Logger
    logger DynFlags
    dflags ([Char]
    "SimplBind " forall a. [a] -> [a] -> [a]
    ++ [Char]
    what)
             (forall a. Outputable a => a -> SDoc
    ppr OutId
    old_bndr) SimplM (SimplFloats, SimplEnv)
    thing_inside

    --------------------------
    simplLazyBind :: SimplEnv
                  -> TopLevelFlag -> RecFlag
                  -> InId -> OutId          -- Binder, both pre-and post simpl
                                            -- Not a JoinId
                                            -- The OutId has IdInfo, except arity, unfolding
                                            -- Ids only, no TyVars
                  -> InExpr -> SimplEnv     -- The RHS and its environment
                  -> SimplM (SimplFloats, SimplEnv)
    -- Precondition: not a JoinId
    -- Precondition: rhs obeys the let/app invariant
    -- NOT used for JoinIds
    simplLazyBind :: SimplEnv
    -> TopLevelFlag
    -> RecFlag
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplEnv
    -> SimplM (SimplFloats, SimplEnv)
    simplLazyBind SimplEnv
    env TopLevelFlag
    top_lvl RecFlag
    is_rec OutId
    bndr OutId
    bndr1 CoreExpr
    rhs SimplEnv
    rhs_se
      = ASSERT( isId bndr )
        ASSERT2( not (isJoinId bndr), ppr bndr )
        -- 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]
                    ([OutId]
    tvs, CoreExpr
    body) = case CoreExpr -> ([OutId], [OutId], CoreExpr)
    collectTyAndValBinders CoreExpr
    rhs of
                                    ([OutId]
    tvs, [], CoreExpr
    body)
                                      | forall {b}. Expr b -> Bool
    surely_not_lam CoreExpr
    body -> ([OutId]
    tvs, CoreExpr
    body)
                                    ([OutId], [OutId], 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 (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.

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

            -- Simplify the RHS
            ; let rhs_cont :: SimplCont
    rhs_cont = Kind -> SimplCont
    mkRhsStop (SimplEnv -> Kind -> Kind
    substTy SimplEnv
    body_env (CoreExpr -> Kind
    exprType CoreExpr
    body))
            ; (SimplFloats
    body_floats0, CoreExpr
    body0) <- {-#SCC "simplExprF" #-} SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    body_env CoreExpr
    body SimplCont
    rhs_cont

                  -- 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: body_floats1 consists only of let-floats
            ; let (SimplFloats
    body_floats1, CoreExpr
    body1) = SimplFloats -> CoreExpr -> (SimplFloats, CoreExpr)
    wrapJoinFloatsX SimplFloats
    body_floats0 CoreExpr
    body0

            -- ANF-ise a constructor or PAP rhs
            -- We get at most one float per argument here
            ; let body_env1 :: SimplEnv
    body_env1 = SimplEnv
    body_env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    body_floats1
                  -- body_env1: add to in-scope set the binders from body_floats1
                  -- so that prepareBinding knows what is in scope in body1
            ; (LetFloats
    let_floats, OutId
    bndr2, CoreExpr
    body2) <- {-#SCC "prepareBinding" #-}
                                            SimplEnv
    -> TopLevelFlag
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (LetFloats, OutId, CoreExpr)
    prepareBinding SimplEnv
    body_env1 TopLevelFlag
    top_lvl OutId
    bndr OutId
    bndr1 CoreExpr
    body1
            ; let body_floats2 :: SimplFloats
    body_floats2 = SimplFloats
    body_floats1 SimplFloats -> LetFloats -> SimplFloats
    `addLetFloats` LetFloats
    let_floats

            ; (SimplFloats
    rhs_floats, CoreExpr
    body3)
                <-  if Bool -> Bool
    not (TopLevelFlag -> RecFlag -> Bool -> SimplFloats -> CoreExpr -> Bool
    doFloatFromRhs TopLevelFlag
    top_lvl RecFlag
    is_rec Bool
    False SimplFloats
    body_floats2 CoreExpr
    body2)
                    then                    -- No floating, revert to body1
                         forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    body_floats2 CoreExpr
    body1)

                    else if forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [OutId]
    tvs then   -- Simple floating
                         {-#SCC "simplLazyBind-simple-floating" #-}
                         do { Tick -> SimplM ()
    tick Tick
    LetFloatFromLet
                            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    body_floats2, CoreExpr
    body2) }

                    else                    -- Do type-abstraction first
                         {-#SCC "simplLazyBind-type-abstraction-first" #-}
                         do { Tick -> SimplM ()
    tick Tick
    LetFloatFromLet
                            ; ([InBind]
    poly_binds, CoreExpr
    body3) <- UnfoldingOpts
    -> TopLevelFlag
    -> [OutId]
    -> SimplFloats
    -> CoreExpr
    -> SimplM ([InBind], CoreExpr)
    abstractFloats (SimplEnv -> UnfoldingOpts
    seUnfoldingOpts SimplEnv
    env) TopLevelFlag
    top_lvl
                                                                    [OutId]
    tvs' SimplFloats
    body_floats2 CoreExpr
    body2
                            ; let floats :: SimplFloats
    floats = 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
                            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, CoreExpr
    body3) }

            ; let env' :: SimplEnv
    env' = SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    rhs_floats
            ; CoreExpr
    rhs' <- SimplEnv -> [OutId] -> CoreExpr -> SimplCont -> SimplM CoreExpr
    mkLam SimplEnv
    env' [OutId]
    tvs' CoreExpr
    body3 SimplCont
    rhs_cont
            ; (SimplFloats
    bind_float, SimplEnv
    env2) <- SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    completeBind SimplEnv
    env' TopLevelFlag
    top_lvl forall a. Maybe a
    Nothing OutId
    bndr OutId
    bndr2 CoreExpr
    rhs'
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    rhs_floats SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    bind_float, SimplEnv
    env2) }

    --------------------------
    simplJoinBind :: SimplEnv
                  -> SimplCont
                  -> InId -> OutId          -- Binder, both pre-and post simpl
                                            -- The OutId has IdInfo, except arity,
                                            --   unfolding
                  -> InExpr -> SimplEnv     -- The right hand side and its env
                  -> SimplM (SimplFloats, SimplEnv)
    simplJoinBind :: SimplEnv
    -> SimplCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplEnv
    -> SimplM (SimplFloats, SimplEnv)
    simplJoinBind SimplEnv
    env SimplCont
    cont OutId
    old_bndr OutId
    new_bndr CoreExpr
    rhs SimplEnv
    rhs_se
      = do  { let rhs_env :: SimplEnv
    rhs_env = SimplEnv
    rhs_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env
            ; CoreExpr
    rhs' <- SimplEnv -> OutId -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplJoinRhs SimplEnv
    rhs_env OutId
    old_bndr CoreExpr
    rhs SimplCont
    cont
            ; SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    completeBind SimplEnv
    env TopLevelFlag
    NotTopLevel (forall a. a -> Maybe a
    Just SimplCont
    cont) OutId
    old_bndr OutId
    new_bndr CoreExpr
    rhs' }

    --------------------------
    simplNonRecX :: SimplEnv
                 -> InId            -- Old binder; not a JoinId
                 -> OutExpr         -- Simplified RHS
                 -> SimplM (SimplFloats, SimplEnv)
    -- A specialised variant of simplNonRec used when the RHS is already
    -- simplified, notably in knownCon.  It uses case-binding where necessary.
    --
    -- Precondition: rhs satisfies the let/app invariant

    simplNonRecX :: SimplEnv -> OutId -> CoreExpr -> SimplM (SimplFloats, SimplEnv)
    simplNonRecX SimplEnv
    env OutId
    bndr CoreExpr
    new_rhs
      | ASSERT2( not (isJoinId bndr), ppr bndr )
        OutId -> Bool
    isDeadBinder OutId
    bndr   -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p }
      = 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)

      | Coercion Coercion
    co <- CoreExpr
    new_rhs
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv -> OutId -> Coercion -> SimplEnv
    extendCvSubst SimplEnv
    env OutId
    bndr Coercion
    co)

      | Bool
    otherwise
      = do  { (SimplEnv
    env', OutId
    bndr') <- SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder SimplEnv
    env OutId
    bndr
            ; TopLevelFlag
    -> SimplEnv
    -> Bool
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    completeNonRecX TopLevelFlag
    NotTopLevel SimplEnv
    env' (OutId -> Bool
    isStrictId OutId
    bndr') OutId
    bndr OutId
    bndr' CoreExpr
    new_rhs }
              -- NotTopLevel: simplNonRecX is only used for NotTopLevel things
              --
              -- isStrictId: use bndr' because in a levity-polymorphic setting
              -- the InId bndr might have a levity-polymorphic type, which
              -- which isStrictId doesn't expect
              -- c.f. Note [Dark corner with levity polymorphism]

    --------------------------
    completeNonRecX :: TopLevelFlag -> SimplEnv
                    -> Bool
                    -> InId                 -- Old binder; not a JoinId
                    -> OutId                -- New binder
                    -> OutExpr              -- Simplified RHS
                    -> SimplM (SimplFloats, SimplEnv)    -- The new binding is in the floats
    -- Precondition: rhs satisfies the let/app invariant
    --               See Note [Core let/app invariant] in GHC.Core

    completeNonRecX :: TopLevelFlag
    -> SimplEnv
    -> Bool
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    completeNonRecX TopLevelFlag
    top_lvl SimplEnv
    env Bool
    is_strict OutId
    old_bndr OutId
    new_bndr CoreExpr
    new_rhs
      = ASSERT2( not (isJoinId new_bndr), ppr new_bndr )
        do  { (LetFloats
    prepd_floats, OutId
    new_bndr, CoreExpr
    new_rhs)
                  <- SimplEnv
    -> TopLevelFlag
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (LetFloats, OutId, CoreExpr)
    prepareBinding SimplEnv
    env TopLevelFlag
    top_lvl OutId
    old_bndr OutId
    new_bndr CoreExpr
    new_rhs
            ; let floats :: SimplFloats
    floats = SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env SimplFloats -> LetFloats -> SimplFloats
    `addLetFloats` LetFloats
    prepd_floats
            ; (SimplFloats
    rhs_floats, CoreExpr
    rhs2) <-
                    if TopLevelFlag -> RecFlag -> Bool -> SimplFloats -> CoreExpr -> Bool
    doFloatFromRhs TopLevelFlag
    NotTopLevel RecFlag
    NonRecursive Bool
    is_strict SimplFloats
    floats CoreExpr
    new_rhs
                    then    -- Add the floats to the main env
                         do { Tick -> SimplM ()
    tick Tick
    LetFloatFromLet
                            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, CoreExpr
    new_rhs) }
                    else    -- Do not float; wrap the floats around the RHS
                         forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    floats CoreExpr
    new_rhs)

            ; (SimplFloats
    bind_float, SimplEnv
    env2) <- SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    completeBind (SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    rhs_floats)
                                                 TopLevelFlag
    NotTopLevel forall a. Maybe a
    Nothing
                                                 OutId
    old_bndr OutId
    new_bndr CoreExpr
    rhs2
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    rhs_floats SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    bind_float, SimplEnv
    env2) }

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

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

    So now 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

    We call this making a cast worker/wrapper, and it's done by prepareBinding.

    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... }
    It's 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 NOINLINE functions] in
    GHC.Core.Opt.WorkWrap.

    See #17673, #18093, #18078.

    Note [Preserve strictness in cast w/w]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In the Note [Cast worker/wrappers] 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 [Cast w/w: unlifted]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    BUT don't do cast worker/wrapper if 'e' has an unlifted type.
    This *can* happen:

         foo :: Int = (error (# Int,Int #) "urk")
                      `cast` CoUnsafe (# Int,Int #) Int

    If do the makeTrivial thing to the error call, we'll get
        foo = case error (# Int,Int #) "urk" of v -> v `cast` ...
    But 'v' isn't in scope!

    These strange casts can happen as a result of case-of-case
            bar = case (case x of { T -> (# 2,3 #); F -> error "urk" }) of
                    (# p,q #) -> p+q

    NOTE: Nowadays we don't use casts for these error functions;
    instead, we use (case erorr ... of {}). So I'm not sure
    this Note makes much sense any more.
    -}

    prepareBinding :: SimplEnv -> TopLevelFlag
                   -> InId -> OutId -> OutExpr
                   -> SimplM (LetFloats, OutId, OutExpr)

    prepareBinding :: SimplEnv
    -> TopLevelFlag
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (LetFloats, OutId, CoreExpr)
    prepareBinding SimplEnv
    env TopLevelFlag
    top_lvl OutId
    old_bndr OutId
    bndr CoreExpr
    rhs
      | Cast CoreExpr
    rhs1 Coercion
    co <- CoreExpr
    rhs
        -- Try for cast worker/wrapper
        -- See Note [Cast worker/wrappers]
      , Bool -> Bool
    not (Unfolding -> Bool
    isStableUnfolding (OutId -> Unfolding
    realIdUnfolding OutId
    old_bndr))
            -- Don't make a cast w/w if the thing is going to be inlined anyway
      , Bool -> Bool
    not (CoreExpr -> Bool
    exprIsTrivial CoreExpr
    rhs1)
            -- Nor if the RHS is trivial; then again it'll be inlined
      , let ty1 :: Kind
    ty1 = Coercion -> Kind
    coercionLKind Coercion
    co
      , Bool -> Bool
    not (HasDebugCallStack => Kind -> Bool
    isUnliftedType Kind
    ty1)
            -- Not if rhs has an unlifted type; see Note [Cast w/w: unlifted]
      = do { (LetFloats
    floats, OutId
    new_id) <- SimplMode
    -> TopLevelFlag
    -> FastString
    -> IdInfo
    -> CoreExpr
    -> Kind
    -> SimplM (LetFloats, OutId)
    makeTrivialBinding (SimplEnv -> SimplMode
    getMode SimplEnv
    env) TopLevelFlag
    top_lvl
                                       (forall a. NamedThing a => a -> FastString
    getOccFS OutId
    bndr) IdInfo
    worker_info CoreExpr
    rhs1 Kind
    ty1
           ; let bndr' :: OutId
    bndr' = OutId
    bndr OutId -> InlinePragma -> OutId
    `setInlinePragma` InlinePragma -> InlinePragma
    mkCastWrapperInlinePrag (OutId -> InlinePragma
    idInlinePragma OutId
    bndr)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    floats, OutId
    bndr', forall b. Expr b -> Coercion -> Expr b
    Cast (forall b. OutId -> Expr b
    Var OutId
    new_id) Coercion
    co) }

      | Bool
    otherwise
      = do { (LetFloats
    floats, CoreExpr
    rhs') <- SimplMode
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    prepareRhs (SimplEnv -> SimplMode
    getMode SimplEnv
    env) TopLevelFlag
    top_lvl (forall a. NamedThing a => a -> FastString
    getOccFS OutId
    bndr) CoreExpr
    rhs
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    floats, OutId
    bndr, CoreExpr
    rhs') }
     where
       info :: IdInfo
    info = HasDebugCallStack => OutId -> IdInfo
    idInfo OutId
    bndr
       worker_info :: IdInfo
    worker_info = IdInfo
    vanillaIdInfo IdInfo -> StrictSig -> IdInfo
    `setStrictnessInfo` IdInfo -> StrictSig
    strictnessInfo IdInfo
    info
                                   IdInfo -> CprSig -> IdInfo
    `setCprInfo`        IdInfo -> CprSig
    cprInfo IdInfo
    info
                                   IdInfo -> Demand -> IdInfo
    `setDemandInfo`     IdInfo -> Demand
    demandInfo IdInfo
    info
                                   IdInfo -> InlinePragma -> IdInfo
    `setInlinePragInfo` IdInfo -> InlinePragma
    inlinePragInfo IdInfo
    info
                                   IdInfo -> Int -> IdInfo
    `setArityInfo`      IdInfo -> Int
    arityInfo IdInfo
    info
              -- We do /not/ want to transfer OccInfo, Rules, Unfolding
              -- Note [Preserve strictness in cast w/w]

    mkCastWrapperInlinePrag :: InlinePragma -> InlinePragma
    -- See Note [Cast wrappers]
    mkCastWrapperInlinePrag :: InlinePragma -> InlinePragma
    mkCastWrapperInlinePrag (InlinePragma { inl_act :: InlinePragma -> Activation
    inl_act = Activation
    act, inl_rule :: InlinePragma -> RuleMatchInfo
    inl_rule = RuleMatchInfo
    rule_info })
      = InlinePragma { inl_src :: SourceText
    inl_src    = [Char] -> SourceText
    SourceText [Char]
    "{-# INLINE"
                     , inl_inline :: InlineSpec
    inl_inline = InlineSpec
    NoUserInlinePrag -- See Note [Wrapper NoUserInline]
                     , inl_sat :: Maybe Int
    inl_sat    = 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
    act = Activation
    activateDuringFinal
                 | Bool
    otherwise         = Activation
    act

    {- 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 :: SimplMode -> 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 :: SimplMode
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    prepareRhs SimplMode
    mode TopLevelFlag
    top_lvl FastString
    occ CoreExpr
    rhs0
      = do  { (Bool
    _is_exp, LetFloats
    floats, CoreExpr
    rhs1) <- Int -> CoreExpr -> SimplM (Bool, LetFloats, CoreExpr)
    go Int
    0 CoreExpr
    rhs0
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    floats, CoreExpr
    rhs1) }
      where
        go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr)
        go :: Int -> CoreExpr -> SimplM (Bool, LetFloats, CoreExpr)
    go Int
    n_val_args (Cast CoreExpr
    rhs Coercion
    co)
            = do { (Bool
    is_exp, LetFloats
    floats, CoreExpr
    rhs') <- Int -> CoreExpr -> SimplM (Bool, LetFloats, CoreExpr)
    go Int
    n_val_args CoreExpr
    rhs
                 ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    is_exp, LetFloats
    floats, forall b. Expr b -> Coercion -> Expr b
    Cast CoreExpr
    rhs' Coercion
    co) }
        go Int
    n_val_args (App CoreExpr
    fun (Type Kind
    ty))
            = do { (Bool
    is_exp, LetFloats
    floats, CoreExpr
    rhs') <- Int -> CoreExpr -> SimplM (Bool, LetFloats, CoreExpr)
    go Int
    n_val_args CoreExpr
    fun
                 ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    is_exp, LetFloats
    floats, forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    rhs' (forall b. Kind -> Expr b
    Type Kind
    ty)) }
        go Int
    n_val_args (App CoreExpr
    fun CoreExpr
    arg)
            = do { (Bool
    is_exp, LetFloats
    floats1, CoreExpr
    fun') <- Int -> CoreExpr -> SimplM (Bool, LetFloats, CoreExpr)
    go (Int
    n_val_argsforall a. Num a => a -> a -> a
    +Int
    1) CoreExpr
    fun
                 ; case Bool
    is_exp of
                    Bool
    False -> forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, LetFloats
    emptyLetFloats, forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun CoreExpr
    arg)
                    Bool
    True  -> do { (LetFloats
    floats2, CoreExpr
    arg') <- SimplMode
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    makeTrivial SimplMode
    mode TopLevelFlag
    top_lvl Demand
    topDmd FastString
    occ CoreExpr
    arg
                                ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, LetFloats
    floats1 LetFloats -> LetFloats -> LetFloats
    `addLetFlts` LetFloats
    floats2, forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun' CoreExpr
    arg') } }
        go Int
    n_val_args (Var OutId
    fun)
            = forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    is_exp, LetFloats
    emptyLetFloats, forall b. OutId -> Expr b
    Var OutId
    fun)
            where
              is_exp :: Bool
    is_exp = CheapAppFun
    isExpandableApp OutId
    fun Int
    n_val_args   -- The fun a constructor or PAP
                            -- See Note [CONLIKE pragma] in GHC.Types.Basic
                            -- The definition of is_exp should match that in
                            -- 'GHC.Core.Opt.OccurAnal.occAnalApp'

        go Int
    n_val_args (Tick CoreTickish
    t CoreExpr
    rhs)
            -- We want to be able to float bindings past this
            -- tick. Non-scoping ticks don't care.
            | forall (pass :: TickishPass). GenTickish pass -> TickishScoping
    tickishScoped CoreTickish
    t forall a. Eq a => a -> a -> Bool
    == TickishScoping
    NoScope
            = do { (Bool
    is_exp, LetFloats
    floats, CoreExpr
    rhs') <- Int -> CoreExpr -> SimplM (Bool, LetFloats, CoreExpr)
    go Int
    n_val_args CoreExpr
    rhs
                 ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    is_exp, LetFloats
    floats, forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t CoreExpr
    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 (forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    t) Bool -> Bool -> Bool
    || forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCanSplit CoreTickish
    t)
            = do { (Bool
    is_exp, LetFloats
    floats, CoreExpr
    rhs') <- Int -> CoreExpr -> SimplM (Bool, LetFloats, CoreExpr)
    go Int
    n_val_args CoreExpr
    rhs
                 ; let tickIt :: (OutId, CoreExpr) -> (OutId, CoreExpr)
    tickIt (OutId
    id, CoreExpr
    expr) = (OutId
    id, CoreTickish -> CoreExpr -> CoreExpr
    mkTick (forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoCount CoreTickish
    t) CoreExpr
    expr)
                       floats' :: LetFloats
    floats' = LetFloats -> ((OutId, CoreExpr) -> (OutId, CoreExpr)) -> LetFloats
    mapLetFloats LetFloats
    floats (OutId, CoreExpr) -> (OutId, CoreExpr)
    tickIt
                 ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    is_exp, LetFloats
    floats', forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t CoreExpr
    rhs') }

        go Int
    _ CoreExpr
    other
            = forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, LetFloats
    emptyLetFloats, CoreExpr
    other)

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

    makeTrivial :: SimplMode -> TopLevelFlag -> Demand
                -> FastString  -- ^ A "friendly name" to build the new binder from
                -> OutExpr     -- ^ This expression satisfies the let/app invariant
                -> 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 :: SimplMode
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    makeTrivial SimplMode
    mode 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]
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    emptyLetFloats, CoreExpr
    expr)

      | Cast CoreExpr
    expr' Coercion
    co <- CoreExpr
    expr
      = do { (LetFloats
    floats, CoreExpr
    triv_expr) <- SimplMode
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    makeTrivial SimplMode
    mode TopLevelFlag
    top_lvl Demand
    dmd FastString
    occ_fs CoreExpr
    expr'
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    floats, forall b. Expr b -> Coercion -> Expr b
    Cast CoreExpr
    triv_expr Coercion
    co) }

      | Bool
    otherwise
      = do { (LetFloats
    floats, OutId
    new_id) <- SimplMode
    -> TopLevelFlag
    -> FastString
    -> IdInfo
    -> CoreExpr
    -> Kind
    -> SimplM (LetFloats, OutId)
    makeTrivialBinding SimplMode
    mode TopLevelFlag
    top_lvl FastString
    occ_fs
                                                    IdInfo
    id_info CoreExpr
    expr Kind
    expr_ty
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (LetFloats
    floats, forall b. OutId -> Expr b
    Var OutId
    new_id) }
      where
        id_info :: IdInfo
    id_info = IdInfo
    vanillaIdInfo IdInfo -> Demand -> IdInfo
    `setDemandInfo` Demand
    dmd
        expr_ty :: Kind
    expr_ty = CoreExpr -> Kind
    exprType CoreExpr
    expr

    makeTrivialBinding :: SimplMode -> TopLevelFlag
                       -> FastString  -- ^ a "friendly name" to build the new binder from
                       -> IdInfo
                       -> OutExpr     -- ^ This expression satisfies the let/app invariant
                       -> OutType     -- Type of the expression
                       -> SimplM (LetFloats, OutId)
    makeTrivialBinding :: SimplMode
    -> TopLevelFlag
    -> FastString
    -> IdInfo
    -> CoreExpr
    -> Kind
    -> SimplM (LetFloats, OutId)
    makeTrivialBinding SimplMode
    mode TopLevelFlag
    top_lvl FastString
    occ_fs IdInfo
    info CoreExpr
    expr Kind
    expr_ty
      = do  { (LetFloats
    floats, CoreExpr
    expr1) <- SimplMode
    -> TopLevelFlag
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    prepareRhs SimplMode
    mode TopLevelFlag
    top_lvl FastString
    occ_fs CoreExpr
    expr
            ; Unique
    uniq <- forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
            ; let name :: Name
    name = Unique -> FastString -> Name
    mkSystemVarName Unique
    uniq FastString
    occ_fs
                  var :: OutId
    var  = HasDebugCallStack => Name -> Kind -> Kind -> IdInfo -> OutId
    mkLocalIdWithInfo Name
    name Kind
    Many Kind
    expr_ty IdInfo
    info

            -- Now something very like completeBind,
            -- but without the postInlineUnconditionally part
            ; (ArityType
    arity_type, CoreExpr
    expr2) <- SimplMode -> OutId -> CoreExpr -> SimplM (ArityType, CoreExpr)
    tryEtaExpandRhs SimplMode
    mode OutId
    var CoreExpr
    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 shadowig in eta expansion

            ; Unfolding
    unf <- UnfoldingOpts
    -> TopLevelFlag
    -> UnfoldingSource
    -> OutId
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding (SimplMode -> UnfoldingOpts
    sm_uf_opts SimplMode
    mode) TopLevelFlag
    top_lvl UnfoldingSource
    InlineRhs OutId
    var CoreExpr
    expr2

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

            ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( LetFloats
    floats LetFloats -> LetFloats -> LetFloats
    `addLetFlts` InBind -> LetFloats
    unitLetFloat InBind
    bind, OutId
    final_id ) }

    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

    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 :: SimplEnv
                 -> TopLevelFlag            -- Flag stuck into unfolding
                 -> MaybeJoinCont           -- Required only for join point
                 -> InId                    -- Old binder
                 -> OutId -> OutExpr        -- New binder and RHS
                 -> 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/app invariant
    completeBind :: SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplM (SimplFloats, SimplEnv)
    completeBind SimplEnv
    env TopLevelFlag
    top_lvl MaybeJoinCont
    mb_cont OutId
    old_bndr OutId
    new_bndr CoreExpr
    new_rhs
     | OutId -> Bool
    isCoVar OutId
    old_bndr
     = case CoreExpr
    new_rhs of
         Coercion Coercion
    co -> forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv -> OutId -> Coercion -> SimplEnv
    extendCvSubst SimplEnv
    env OutId
    old_bndr Coercion
    co)
         CoreExpr
    _           -> forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> InBind -> (SimplFloats, SimplEnv)
    mkFloatBind SimplEnv
    env (forall b. b -> Expr b -> Bind b
    NonRec OutId
    new_bndr CoreExpr
    new_rhs))

     | Bool
    otherwise
     = ASSERT( isId new_bndr )
       do { let old_info :: IdInfo
    old_info = HasDebugCallStack => OutId -> IdInfo
    idInfo OutId
    old_bndr
                old_unf :: Unfolding
    old_unf  = IdInfo -> Unfolding
    unfoldingInfo IdInfo
    old_info
                occ_info :: OccInfo
    occ_info = IdInfo -> OccInfo
    occInfo 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
          ; (ArityType
    new_arity, CoreExpr
    final_rhs) <- SimplMode -> OutId -> CoreExpr -> SimplM (ArityType, CoreExpr)
    tryEtaExpandRhs (SimplEnv -> SimplMode
    getMode SimplEnv
    env) OutId
    new_bndr CoreExpr
    new_rhs

            -- Simplify the unfolding
          ; Unfolding
    new_unfolding <- SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> CoreExpr
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplLetUnfolding SimplEnv
    env TopLevelFlag
    top_lvl MaybeJoinCont
    mb_cont OutId
    old_bndr
                              CoreExpr
    final_rhs (OutId -> Kind
    idType OutId
    new_bndr) ArityType
    new_arity Unfolding
    old_unf

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

          ; if SimplEnv -> TopLevelFlag -> OutId -> OccInfo -> CoreExpr -> Bool
    postInlineUnconditionally SimplEnv
    env TopLevelFlag
    top_lvl OutId
    final_bndr OccInfo
    occ_info CoreExpr
    final_rhs

            then -- Inline and discard the binding
                 do  { Tick -> SimplM ()
    tick (OutId -> Tick
    PostInlineUnconditionally OutId
    old_bndr)
                     ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
                              , SimplEnv -> OutId -> SimplSR -> SimplEnv
    extendIdSubst SimplEnv
    env OutId
    old_bndr forall a b. (a -> b) -> a -> b
    $
                                CoreExpr -> Maybe Int -> SimplSR
    DoneEx CoreExpr
    final_rhs (OutId -> Maybe Int
    isJoinId_maybe OutId
    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
                 -- pprTrace "Binding" (ppr final_bndr <+> ppr new_unfolding) $
                 forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> InBind -> (SimplFloats, SimplEnv)
    mkFloatBind SimplEnv
    env (forall b. b -> Expr b -> Bind b
    NonRec OutId
    final_bndr CoreExpr
    final_rhs)) }

    addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId
    addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId
    addLetBndrInfo OutId
    new_bndr ArityType
    new_arity_type Unfolding
    new_unf
      = OutId
    new_bndr OutId -> IdInfo -> OutId
    `setIdInfo` IdInfo
    info5
      where
        AT [OneShotInfo]
    oss Divergence
    div = ArityType
    new_arity_type
        new_arity :: Int
    new_arity  = forall (t :: * -> *) a. Foldable t => t a -> Int
    length [OneShotInfo]
    oss

        info1 :: IdInfo
    info1 = HasDebugCallStack => OutId -> IdInfo
    idInfo OutId
    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]
        -- We also have to nuke demand info if for some reason
        -- eta-expansion *reduces* the arity of the binding to less
        -- than that of the strictness sig. This can happen: see Note [Arity decrease].
        info3 :: IdInfo
    info3 | Unfolding -> Bool
    isEvaldUnfolding Unfolding
    new_unf
                Bool -> Bool -> Bool
    || (case IdInfo -> StrictSig
    strictnessInfo IdInfo
    info2 of
                      StrictSig DmdType
    dmd_ty -> Int
    new_arity forall a. Ord a => a -> a -> Bool
    < DmdType -> Int
    dmdTypeDepth DmdType
    dmd_ty)
              = IdInfo -> Maybe IdInfo
    zapDemandInfo IdInfo
    info2 forall a. Maybe a -> a -> a
    `orElse` IdInfo
    info2
              | Bool
    otherwise
              = IdInfo
    info2

        -- Bottoming bindings: see Note [Bottoming bindings]
        info4 :: IdInfo
    info4 | Divergence -> Bool
    isDeadEndDiv Divergence
    div = IdInfo
    info3 IdInfo -> StrictSig -> IdInfo
    `setStrictnessInfo` StrictSig
    bot_sig
                                         IdInfo -> CprSig -> IdInfo
    `setCprInfo`        CprSig
    bot_cpr
              | Bool
    otherwise        = IdInfo
    info3

        bot_sig :: StrictSig
    bot_sig = [Demand] -> Divergence -> StrictSig
    mkClosedStrictSig (forall a. Int -> a -> [a]
    replicate Int
    new_arity Demand
    topDmd) Divergence
    div
        bot_cpr :: CprSig
    bot_cpr = Int -> Cpr -> CprSig
    mkCprSig Int
    new_arity Cpr
    botCpr

         -- 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 [Arity decrease]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    Generally speaking the arity of a binding should not decrease.  But it *can*
    legitimately happen because of RULES.  Eg
            f = g @Int
    where g has arity 2, will have arity 2.  But if there's a rewrite rule
            g @Int --> h
    where h has arity 1, then f's arity will decrease.  Here's a real-life example,
    which is in the output of Specialise:

         Rec {
            $dm {Arity 2} = \d.\x. op d
            {-# RULES forall d. $dm Int d = $s$dm #-}

            dInt = MkD .... opInt ...
            opInt {Arity 1} = $dm dInt

            $s$dm {Arity 0} = \x. op dInt }

    Here opInt has arity 1; but when we apply the rule its arity drops to 0.
    That's why Specialise goes to a little trouble to pin the right arity
    on specialised functions too.

    Note [Bottoming bindings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have
       let x = error "urk"
       in ...(case x of <alts>)...
    or
       let f = \x. error (x ++ "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 RHS is bottom to x'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.

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

    ************************************************************************
    *                                                                      *
    \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 { Kind
    ty' <- SimplEnv -> Kind -> SimplM Kind
    simplType SimplEnv
    env Kind
    ty  -- See Note [Avoiding space leaks in OutType]
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. Kind -> Expr b
    Type Kind
    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 = SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env (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 {- $$ ppr (seIdSubst env) -} $$ ppr (seLetFloats env) ) $
        do  { (SimplFloats
    floats, CoreExpr
    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')) $
              forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $! SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    floats CoreExpr
    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)
          ]) $ -}
        SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF1 SimplEnv
    env CoreExpr
    e SimplCont
    cont

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

    simplExprF1 :: SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF1 SimplEnv
    _ (Type Kind
    ty) SimplCont
    cont
      = forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "simplExprF: type" (forall a. Outputable a => a -> SDoc
    ppr Kind
    ty SDoc -> SDoc -> SDoc
    <+> [Char] -> SDoc
    text[Char]
    "cont: " SDoc -> SDoc -> 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 OutId
    v)        SimplCont
    cont = {-#SCC "simplIdF" #-} SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplIdF SimplEnv
    env OutId
    v SimplCont
    cont
    simplExprF1 SimplEnv
    env (Lit Literal
    lit)      SimplCont
    cont = {-#SCC "rebuild" #-} SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (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 Coercion
    co) SimplCont
    cont = {-#SCC "simplCast" #-} SimplEnv
    -> CoreExpr
    -> Coercion
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplCast SimplEnv
    env CoreExpr
    body Coercion
    co SimplCont
    cont
    simplExprF1 SimplEnv
    env (Coercion Coercion
    co)  SimplCont
    cont = {-#SCC "simplCoercionF" #-} SimplEnv -> Coercion -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplCoercionF SimplEnv
    env Coercion
    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]
                          Kind
    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' :: Kind
    hole' = SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env (CoreExpr -> Kind
    exprType CoreExpr
    fun)

                        ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    fun forall a b. (a -> b) -> a -> b
    $
                          ApplyToTy { sc_arg_ty :: Kind
    sc_arg_ty  = Kind
    arg'
                                    , sc_hole_ty :: Kind
    sc_hole_ty = Kind
    hole'
                                    , sc_cont :: SimplCont
    sc_cont    = SimplCont
    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 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 = SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env (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
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env [OutId]
    zapped_bndrs CoreExpr
    body SimplCont
    cont
            -- The main 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
        ([OutId]
    bndrs, CoreExpr
    body) = forall b. Expr b -> ([b], Expr b)
    collectBinders CoreExpr
    expr
        zapped_bndrs :: [OutId]
    zapped_bndrs = Int -> [OutId] -> [OutId]
    zapLamBndrs Int
    n_args [OutId]
    bndrs
        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 OutId
    bndr Kind
    _ [Alt OutId]
    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 :: OutId
    sc_bndr = OutId
    bndr
                                     , sc_alts :: [Alt OutId]
    sc_alts = [Alt OutId]
    alts
                                     , sc_env :: SimplEnv
    sc_env = SimplEnv
    env, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont })

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

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

    simplExprF1 SimplEnv
    env (Let (NonRec OutId
    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" #-}
        ASSERT( isTyVar bndr )
        do { Kind
    ty' <- SimplEnv -> Kind -> SimplM Kind
    simplType SimplEnv
    env Kind
    ty
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF (SimplEnv -> OutId -> Kind -> SimplEnv
    extendTvSubst SimplEnv
    env OutId
    bndr Kind
    ty') CoreExpr
    body SimplCont
    cont }

      | Just (OutId
    bndr', CoreExpr
    rhs') <- OutId -> CoreExpr -> Maybe (OutId, CoreExpr)
    joinPointBinding_maybe OutId
    bndr CoreExpr
    rhs
      = {-#SCC "simplNonRecJoinPoint" #-} SimplEnv
    -> OutId
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecJoinPoint SimplEnv
    env OutId
    bndr' CoreExpr
    rhs' CoreExpr
    body SimplCont
    cont

      | Bool
    otherwise
      = {-#SCC "simplNonRecE" #-} SimplEnv
    -> OutId
    -> (CoreExpr, SimplEnv)
    -> ([OutId], CoreExpr)
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecE SimplEnv
    env OutId
    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 -> OutId -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplJoinRhs SimplEnv
    env OutId
    bndr CoreExpr
    expr SimplCont
    cont
      | Just Int
    arity <- OutId -> Maybe Int
    isJoinId_maybe OutId
    bndr
      =  do { let ([OutId]
    join_bndrs, CoreExpr
    join_body) = forall b. Int -> Expr b -> ([b], Expr b)
    collectNBinders Int
    arity CoreExpr
    expr
                  mult :: Kind
    mult = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
            ; (SimplEnv
    env', [OutId]
    join_bndrs') <- SimplEnv -> [OutId] -> SimplM (SimplEnv, [OutId])
    simplLamBndrs SimplEnv
    env (forall a b. (a -> b) -> [a] -> [b]
    map (Kind -> OutId -> OutId
    scaleVarBy Kind
    mult) [OutId]
    join_bndrs)
            ; CoreExpr
    join_body' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env' CoreExpr
    join_body SimplCont
    cont
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall b. [b] -> Expr b -> Expr b
    mkLams [OutId]
    join_bndrs' CoreExpr
    join_body' }

      | Bool
    otherwise
      = forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "simplJoinRhs" (forall a. Outputable a => a -> SDoc
    ppr OutId
    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 seq :: forall a b. a -> b -> b
    `seq` forall (m :: * -> *) a. Monad m => a -> m a
    return Kind
    new_ty
      where
        new_ty :: Kind
    new_ty = SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env Kind
    ty

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

    simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion
    simplCoercion :: SimplEnv -> Coercion -> SimplM Coercion
    simplCoercion SimplEnv
    env Coercion
    co
      = do { OptCoercionOpts
    opts <- SimplM OptCoercionOpts
    getOptCoercionOpts
           ; let opt_co :: Coercion
    opt_co = OptCoercionOpts -> TCvSubst -> Coercion -> Coercion
    optCoercion OptCoercionOpts
    opts (SimplEnv -> TCvSubst
    getTCvSubst SimplEnv
    env) Coercion
    co
           ; Coercion -> ()
    seqCo Coercion
    opt_co seq :: forall a b. a -> b -> b
    `seq` forall (m :: * -> *) a. Monad m => a -> m a
    return Coercion
    opt_co }

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

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

    --  | tickishScoped tickish && not (tickishCounts tickish)
    --  = simplExprF env expr (TickIt tickish cont)

      -- 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 forall (pass :: TickishPass).
    GenTickish pass -> TickishScoping -> Bool
    `tickishScopesLike` TickishScoping
    SoftScope
      = do { (SimplFloats
    floats, CoreExpr
    expr') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    expr SimplCont
    cont
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreTickish
    tickish CoreExpr
    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 OutId
    bndr Kind
    ty [Alt OutId]
    alts
                 -> forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
    Case (CoreExpr -> CoreExpr
    tickScrut CoreExpr
    scrut) OutId
    bndr Kind
    ty (forall a b. (a -> b) -> [a] -> [b]
    map Alt OutId -> Alt OutId
    tickAlt [Alt OutId]
    alts)
          CoreExpr
    _other -> forall a. Maybe a
    Nothing
       where ([CoreTickish]
    ticks, CoreExpr
    expr0) = forall b.
    (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
    stripTicksTop forall (pass :: TickishPass). GenTickish pass -> Bool
    movable (forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    tickish CoreExpr
    expr)
             movable :: GenTickish pass -> Bool
    movable GenTickish pass
    t      = Bool -> Bool
    not (forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts GenTickish pass
    t) Bool -> Bool -> Bool
    ||
                              GenTickish pass
    t forall (pass :: TickishPass).
    GenTickish pass -> TickishScoping -> Bool
    `tickishScopesLike` TickishScoping
    NoScope Bool -> Bool -> Bool
    ||
                              forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCanSplit GenTickish pass
    t
             tickScrut :: CoreExpr -> CoreExpr
    tickScrut CoreExpr
    e    = 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 OutId -> Alt OutId
    tickAlt (Alt AltCon
    c [OutId]
    bs CoreExpr
    e) = forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    c [OutId]
    bs (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         = forall a b. (a -> b) -> [a] -> [b]
    map forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoCount forall a b. (a -> b) -> a -> b
    $
                                forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (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
           ; (SimplFloats
    floats, CoreExpr
    expr1) <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    expr SimplCont
    inc
           ; let expr2 :: CoreExpr
    expr2    = SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    floats CoreExpr
    expr1
                 tickish' :: CoreTickish
    tickish' = forall {pass :: TickishPass}.
    (XTickishId pass ~ OutId) =>
    SimplEnv -> GenTickish pass -> GenTickish pass
    simplTickish SimplEnv
    env CoreTickish
    tickish
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreTickish
    tickish' CoreExpr
    expr2) SimplCont
    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) = (zapIdStrictness (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 <- GenTickish pass
    tickish
              = forall (pass :: TickishPass).
    XBreakpoint pass -> Int -> [XTickishId pass] -> GenTickish pass
    Breakpoint XBreakpoint pass
    ext Int
    n (forall a b. (a -> b) -> [a] -> [b]
    map (SimplSR -> OutId
    getDoneId forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SimplEnv -> OutId -> SimplSR
    substId SimplEnv
    env) [XTickishId pass]
    ids)
        | 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 :: SimplCont
    sc_cont = SimplCont
    inc }, SimplCont
    outc)
        where (SimplCont
    inc,SimplCont
    outc) = SimplCont -> (SimplCont, SimplCont)
    splitCont SimplCont
    tail
      splitCont (CastIt Coercion
    co SimplCont
    c) = (Coercion -> SimplCont -> SimplCont
    CastIt Coercion
    co SimplCont
    inc, SimplCont
    outc)
        where (SimplCont
    inc,SimplCont
    outc) = SimplCont -> (SimplCont, SimplCont)
    splitCont SimplCont
    c
      splitCont SimplCont
    other = (Kind -> SimplCont
    mkBoringStop (SimplCont -> Kind
    contHoleType SimplCont
    other), SimplCont
    other)

      getDoneId :: SimplSR -> OutId
    getDoneId (DoneId OutId
    id)  = OutId
    id
      getDoneId (DoneEx CoreExpr
    e Maybe Int
    _) = HasDebugCallStack => CoreExpr -> OutId
    getIdFromTrivialExpr CoreExpr
    e -- Note [substTickish] in GHC.Core.Subst
      getDoneId SimplSR
    other = forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "getDoneId" (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 {}          -> 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 Coercion
    co SimplCont
    cont   -> SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (CoreExpr -> Coercion -> CoreExpr
    mkCast CoreExpr
    expr Coercion
    co) SimplCont
    cont
                           -- NB: mkCast implements the (Coercion co |> g) optimisation

          Select { sc_bndr :: SimplCont -> OutId
    sc_bndr = OutId
    bndr, sc_alts :: SimplCont -> [Alt OutId]
    sc_alts = [Alt OutId]
    alts, sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont }
            -> SimplEnv
    -> CoreExpr
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    rebuildCase (SimplEnv
    se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) CoreExpr
    expr OutId
    bndr [Alt OutId]
    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 -> OutId
    sc_bndr = OutId
    b, sc_bndrs :: SimplCont -> [OutId]
    sc_bndrs = [OutId]
    bs, sc_body :: SimplCont -> CoreExpr
    sc_body = CoreExpr
    body
                     , sc_env :: SimplCont -> SimplEnv
    sc_env = SimplEnv
    se, sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    cont }
            -> do { (SimplFloats
    floats1, SimplEnv
    env') <- SimplEnv -> OutId -> CoreExpr -> SimplM (SimplFloats, SimplEnv)
    simplNonRecX (SimplEnv
    se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) OutId
    b CoreExpr
    expr
                                      -- expr satisfies let/app since it started life
                                      -- in a call to simplNonRecE
                  ; (SimplFloats
    floats2, CoreExpr
    expr') <- SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env' [OutId]
    bs CoreExpr
    body SimplCont
    cont
                  ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    expr') }

          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 (forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    expr (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}
            -- See Note [Avoid redundant simplification]
            -> do { (DupFlag
    _, SimplEnv
    _, CoreExpr
    arg') <- SimplEnv
    -> DupFlag
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplArg SimplEnv
    env DupFlag
    dup_flag SimplEnv
    se CoreExpr
    arg
                  ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    expr CoreExpr
    arg') SimplCont
    cont }

    {-
    ************************************************************************
    *                                                                      *
    \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 NthCo 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.
    -}

    simplCast :: SimplEnv -> InExpr -> Coercion -> SimplCont
              -> SimplM (SimplFloats, OutExpr)
    simplCast :: SimplEnv
    -> CoreExpr
    -> Coercion
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplCast SimplEnv
    env CoreExpr
    body Coercion
    co0 SimplCont
    cont0
      = do  { Coercion
    co1   <- {-#SCC "simplCast-simplCoercion" #-} SimplEnv -> Coercion -> SimplM Coercion
    simplCoercion SimplEnv
    env Coercion
    co0
            ; SimplCont
    cont1 <- {-#SCC "simplCast-addCoerce" #-}
                       if Coercion -> Bool
    isReflCo Coercion
    co1
                       then forall (m :: * -> *) a. Monad m => a -> m a
    return SimplCont
    cont0  -- See Note [Optimising reflexivity]
                       else Coercion -> SimplCont -> SimplM SimplCont
    addCoerce Coercion
    co1 SimplCont
    cont0
            ; {-#SCC "simplCast-simplExprF" #-} SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    body SimplCont
    cont1 }
      where
            -- If the first parameter is MRefl, then simplifying revealed a
            -- reflexive coercion. Omit.
            addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont
            addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont
    addCoerceM MOutCoercion
    MRefl   SimplCont
    cont = forall (m :: * -> *) a. Monad m => a -> m a
    return SimplCont
    cont
            addCoerceM (MCo Coercion
    co) SimplCont
    cont = Coercion -> SimplCont -> SimplM SimplCont
    addCoerce Coercion
    co SimplCont
    cont

            addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont
            addCoerce :: Coercion -> SimplCont -> SimplM SimplCont
    addCoerce Coercion
    co1 (CastIt Coercion
    co2 SimplCont
    cont)  -- See Note [Optimising reflexivity]
              | Coercion -> Bool
    isReflexiveCo Coercion
    co' = forall (m :: * -> *) a. Monad m => a -> m a
    return SimplCont
    cont
              | Bool
    otherwise         = Coercion -> SimplCont -> SimplM SimplCont
    addCoerce Coercion
    co' SimplCont
    cont
              where
                co' :: Coercion
    co' = Coercion -> Coercion -> Coercion
    mkTransCo Coercion
    co1 Coercion
    co2

            addCoerce Coercion
    co (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') <- Coercion -> Kind -> Maybe (Kind, MOutCoercion)
    pushCoTyArg Coercion
    co Kind
    arg_ty
              = {-#SCC "addCoerce-pushCoTyArg" #-}
                do { SimplCont
    tail' <- MOutCoercion -> SimplCont -> SimplM SimplCont
    addCoerceM MOutCoercion
    m_co' SimplCont
    tail
                   ; forall (m :: * -> *) a. Monad m => a -> m a
    return (ApplyToTy { sc_arg_ty :: Kind
    sc_arg_ty  = Kind
    arg_ty'
                                       , sc_cont :: SimplCont
    sc_cont    = SimplCont
    tail'
                                       , sc_hole_ty :: Kind
    sc_hole_ty = Coercion -> Kind
    coercionLKind Coercion
    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 Coercion
    co 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 })
              | Just (MOutCoercion
    m_co1, MOutCoercion
    m_co2) <- Coercion -> Maybe (MOutCoercion, MOutCoercion)
    pushCoValArg Coercion
    co
              , MOutCoercion -> Bool
    levity_ok MOutCoercion
    m_co1
              = {-#SCC "addCoerce-pushCoValArg" #-}
                do { SimplCont
    tail' <- MOutCoercion -> SimplCont -> SimplM SimplCont
    addCoerceM MOutCoercion
    m_co2 SimplCont
    tail
                   ; case MOutCoercion
    m_co1 of {
                       MOutCoercion
    MRefl -> forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplCont
    cont { sc_cont :: SimplCont
    sc_cont = SimplCont
    tail'
                                             , sc_hole_ty :: Kind
    sc_hole_ty = Coercion -> Kind
    coercionLKind Coercion
    co }) ;
                          -- Avoid simplifying if possible;
                          -- See Note [Avoiding exponential behaviour]

                       MCo Coercion
    co1 ->
                do { (DupFlag
    dup', SimplEnv
    arg_se', CoreExpr
    arg') <- SimplEnv
    -> DupFlag
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplArg SimplEnv
    env DupFlag
    dup 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
                   ; forall (m :: * -> *) a. Monad m => a -> m a
    return (ApplyToVal { sc_arg :: CoreExpr
    sc_arg  = CoreExpr -> Coercion -> CoreExpr
    mkCast CoreExpr
    arg' Coercion
    co1
                                        , sc_env :: SimplEnv
    sc_env  = SimplEnv
    arg_se'
                                        , sc_dup :: DupFlag
    sc_dup  = DupFlag
    dup'
                                        , sc_cont :: SimplCont
    sc_cont = SimplCont
    tail'
                                        , sc_hole_ty :: Kind
    sc_hole_ty = Coercion -> Kind
    coercionLKind Coercion
    co }) } } }

            addCoerce Coercion
    co SimplCont
    cont
              | Coercion -> Bool
    isReflexiveCo Coercion
    co = 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        = forall (m :: * -> *) a. Monad m => a -> m a
    return (Coercion -> SimplCont -> SimplCont
    CastIt Coercion
    co SimplCont
    cont)

            levity_ok :: MCoercionR -> Bool
            levity_ok :: MOutCoercion -> Bool
    levity_ok MOutCoercion
    MRefl = Bool
    True
            levity_ok (MCo Coercion
    co) = Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ Kind -> Bool
    isTypeLevPoly forall a b. (a -> b) -> a -> b
    $ Coercion -> Kind
    coercionRKind Coercion
    co
              -- Without this check, we get a lev-poly arg
              -- See Note [Levity polymorphism invariants] in GHC.Core
              -- test: typecheck/should_run/EtaExpandLevPoly

    simplArg :: SimplEnv -> DupFlag -> StaticEnv -> CoreExpr
             -> SimplM (DupFlag, StaticEnv, OutExpr)
    simplArg :: SimplEnv
    -> DupFlag
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplArg SimplEnv
    env DupFlag
    dup_flag SimplEnv
    arg_env CoreExpr
    arg
      | DupFlag -> Bool
    isSimplified DupFlag
    dup_flag
      = 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
           ; CoreExpr
    arg' <- SimplEnv -> CoreExpr -> SimplM CoreExpr
    simplExpr SimplEnv
    arg_env'  CoreExpr
    arg
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (DupFlag
    Simplified, SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    arg_env', CoreExpr
    arg') }
             -- Return a StaticEnv that includes the in-scope set from 'env',
             -- because arg' may well mention those variables (#20639)

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

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

    simplLam :: SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env [] CoreExpr
    body SimplCont
    cont
      = SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env CoreExpr
    body SimplCont
    cont

    simplLam SimplEnv
    env (OutId
    bndr:[OutId]
    bndrs) 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 (OutId -> Tick
    BetaReduction OutId
    bndr)
           ; SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam (SimplEnv -> OutId -> Kind -> SimplEnv
    extendTvSubst SimplEnv
    env OutId
    bndr Kind
    arg_ty) [OutId]
    bndrs CoreExpr
    body SimplCont
    cont }

    simplLam SimplEnv
    env (OutId
    bndr:[OutId]
    bndrs) 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 })
      | DupFlag -> Bool
    isSimplified DupFlag
    dup  -- Don't re-simplify if we've simplified it once
                          -- See Note [Avoiding exponential behaviour]
      = do  { Tick -> SimplM ()
    tick (OutId -> Tick
    BetaReduction OutId
    bndr)
            ; (SimplFloats
    floats1, SimplEnv
    env') <- SimplEnv -> OutId -> CoreExpr -> SimplM (SimplFloats, SimplEnv)
    simplNonRecX SimplEnv
    env OutId
    zapped_bndr CoreExpr
    arg
            ; (SimplFloats
    floats2, CoreExpr
    expr') <- SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env' [OutId]
    bndrs CoreExpr
    body SimplCont
    cont
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    expr') }

      | Bool
    otherwise
      = do  { Tick -> SimplM ()
    tick (OutId -> Tick
    BetaReduction OutId
    bndr)
            ; SimplEnv
    -> OutId
    -> (CoreExpr, SimplEnv)
    -> ([OutId], CoreExpr)
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecE SimplEnv
    env OutId
    zapped_bndr (CoreExpr
    arg, SimplEnv
    arg_se) ([OutId]
    bndrs, CoreExpr
    body) SimplCont
    cont }
      where
        zapped_bndr :: OutId
    zapped_bndr  -- See Note [Zap unfolding when beta-reducing]
          | OutId -> Bool
    isId OutId
    bndr = OutId -> OutId
    zapStableUnfolding OutId
    bndr
          | Bool
    otherwise = OutId
    bndr

          -- 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.
    simplLam SimplEnv
    env [OutId]
    bndrs CoreExpr
    body (TickIt CoreTickish
    tickish SimplCont
    cont)
      | Bool -> Bool
    not (forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    tickish)
      = SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env [OutId]
    bndrs CoreExpr
    body SimplCont
    cont

            -- Not enough args, so there are real lambdas left to put in the result
    simplLam SimplEnv
    env [OutId]
    bndrs CoreExpr
    body SimplCont
    cont
      = do  { (SimplEnv
    env', [OutId]
    bndrs') <- SimplEnv -> [OutId] -> SimplM (SimplEnv, [OutId])
    simplLamBndrs SimplEnv
    env [OutId]
    bndrs
            ; CoreExpr
    body' <- SimplEnv -> CoreExpr -> SimplM CoreExpr
    simplExpr SimplEnv
    env' CoreExpr
    body
            ; CoreExpr
    new_lam <- SimplEnv -> [OutId] -> CoreExpr -> SimplCont -> SimplM CoreExpr
    mkLam SimplEnv
    env [OutId]
    bndrs' CoreExpr
    body' SimplCont
    cont
            ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env' CoreExpr
    new_lam SimplCont
    cont }

    -------------
    simplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
    -- Used for lambda binders.  These sometimes have unfoldings added by
    -- the worker/wrapper pass that must be preserved, because they can't
    -- be reconstructed from context.  For example:
    --      f x = case x of (a,b) -> fw a b x
    --      fw a b x{=(a,b)} = ...
    -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
    simplLamBndr :: SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplLamBndr SimplEnv
    env OutId
    bndr
      | OutId -> Bool
    isId OutId
    bndr Bool -> Bool -> Bool
    && Unfolding -> Bool
    hasCoreUnfolding Unfolding
    old_unf   -- Special case
      = do { (SimplEnv
    env1, OutId
    bndr1) <- SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder SimplEnv
    env OutId
    bndr
           ; Unfolding
    unf'          <- SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplStableUnfolding SimplEnv
    env1 TopLevelFlag
    NotTopLevel forall a. Maybe a
    Nothing OutId
    bndr
                                          (OutId -> Kind
    idType OutId
    bndr1) (OutId -> ArityType
    idArityType OutId
    bndr1) Unfolding
    old_unf
           ; let bndr2 :: OutId
    bndr2 = OutId
    bndr1 OutId -> Unfolding -> OutId
    `setIdUnfolding` Unfolding
    unf'
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> OutId -> SimplEnv
    modifyInScope SimplEnv
    env1 OutId
    bndr2, OutId
    bndr2) }

      | Bool
    otherwise
      = SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder SimplEnv
    env OutId
    bndr                -- Normal case
      where
        old_unf :: Unfolding
    old_unf = OutId -> Unfolding
    idUnfolding OutId
    bndr

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

    ------------------
    simplNonRecE :: SimplEnv
                 -> InId                    -- The binder, always an Id
                                            -- Never a join point
                 -> (InExpr, SimplEnv)      -- Rhs of binding (or arg of lambda)
                 -> ([InBndr], InExpr)      -- Body of the let/lambda
                                            --      \xs.e
                 -> SimplCont
                 -> SimplM (SimplFloats, OutExpr)

    -- simplNonRecE is used for
    --  * non-top-level non-recursive non-join-point lets in expressions
    --  * beta reduction
    --
    -- simplNonRec env b (rhs, rhs_se) (bs, body) k
    --   = let env in
    --     cont< let b = rhs_se(rhs) in \bs.body >
    --
    -- It deals with strict bindings, via the StrictBind continuation,
    -- which may abort the whole process
    --
    -- Precondition: rhs satisfies the let/app invariant
    --               Note [Core let/app invariant] in GHC.Core
    --
    -- The "body" of the binding comes as a pair of ([InId],InExpr)
    -- representing a lambda; so we recurse back to simplLam
    -- Why?  Because of the binder-occ-info-zapping done before
    --       the call to simplLam in simplExprF (Lam ...)

    simplNonRecE :: SimplEnv
    -> OutId
    -> (CoreExpr, SimplEnv)
    -> ([OutId], CoreExpr)
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecE SimplEnv
    env OutId
    bndr (CoreExpr
    rhs, SimplEnv
    rhs_se) ([OutId]
    bndrs, CoreExpr
    body) SimplCont
    cont
      | ASSERT( isId bndr && not (isJoinId bndr) ) True
      , Just SimplEnv
    env' <- SimplEnv
    -> TopLevelFlag -> OutId -> CoreExpr -> SimplEnv -> Maybe SimplEnv
    preInlineUnconditionally SimplEnv
    env TopLevelFlag
    NotTopLevel OutId
    bndr CoreExpr
    rhs SimplEnv
    rhs_se
      = do { Tick -> SimplM ()
    tick (OutId -> Tick
    PreInlineUnconditionally OutId
    bndr)
           ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $
             SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env' [OutId]
    bndrs CoreExpr
    body SimplCont
    cont }

      | Bool
    otherwise
      = do { (SimplEnv
    env1, OutId
    bndr1) <- SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplNonRecBndr SimplEnv
    env OutId
    bndr

           -- Deal with strict bindings
           -- See Note [Dark corner with levity polymorphism]
           ; if OutId -> Bool
    isStrictId OutId
    bndr1 Bool -> Bool -> Bool
    && SimplMode -> Bool
    sm_case_case (SimplEnv -> SimplMode
    getMode SimplEnv
    env)
             then SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF (SimplEnv
    rhs_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) CoreExpr
    rhs
                       (StrictBind { sc_bndr :: OutId
    sc_bndr = OutId
    bndr, sc_bndrs :: [OutId]
    sc_bndrs = [OutId]
    bndrs, sc_body :: CoreExpr
    sc_body = CoreExpr
    body
                                   , sc_env :: SimplEnv
    sc_env = SimplEnv
    env, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont, sc_dup :: DupFlag
    sc_dup = DupFlag
    NoDup })

           -- Deal with lazy bindings
             else do
           { (SimplEnv
    env2, OutId
    bndr2) <- SimplEnv
    -> OutId -> OutId -> MaybeJoinCont -> SimplM (SimplEnv, OutId)
    addBndrRules SimplEnv
    env1 OutId
    bndr OutId
    bndr1 forall a. Maybe a
    Nothing
           ; (SimplFloats
    floats1, SimplEnv
    env3) <- SimplEnv
    -> TopLevelFlag
    -> RecFlag
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplEnv
    -> SimplM (SimplFloats, SimplEnv)
    simplLazyBind SimplEnv
    env2 TopLevelFlag
    NotTopLevel RecFlag
    NonRecursive OutId
    bndr OutId
    bndr2 CoreExpr
    rhs SimplEnv
    rhs_se
           ; (SimplFloats
    floats2, CoreExpr
    expr') <- SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    env3 [OutId]
    bndrs CoreExpr
    body SimplCont
    cont
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    expr') } }

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

    -- simplRecE is used for
    --  * non-top-level recursive lets in expressions
    simplRecE :: SimplEnv
    -> [(OutId, CoreExpr)]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplRecE SimplEnv
    env [(OutId, CoreExpr)]
    pairs CoreExpr
    body SimplCont
    cont
      = do  { let bndrs :: [OutId]
    bndrs = forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(OutId, CoreExpr)]
    pairs
            ; MASSERT(all (not . isJoinId) bndrs)
            ; SimplEnv
    env1 <- SimplEnv -> [OutId] -> SimplM SimplEnv
    simplRecBndrs SimplEnv
    env [OutId]
    bndrs
                    -- NB: bndrs' don't have unfoldings or rules
                    -- We add them as we go down
            ; (SimplFloats
    floats1, SimplEnv
    env2) <- SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> [(OutId, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    simplRecBind SimplEnv
    env1 TopLevelFlag
    NotTopLevel forall a. Maybe a
    Nothing [(OutId, CoreExpr)]
    pairs
            ; (SimplFloats
    floats2, CoreExpr
    expr') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env2 CoreExpr
    body SimplCont
    cont
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    expr') }

    {- Note [Dark corner with levity polymorphism]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In `simplNonRecE`, the call to `isStrictId` will fail if the binder
    has a levity-polymorphic type, 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,
    levity-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 exponential behaviour]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    One way in which we can get exponential behaviour is if we simplify a
    big expression, and the re-simplify it -- and then this happens in a
    deeply-nested way.  So we must be jolly careful about re-simplifying
    an expression.  That is why completeNonRecX does not try
    preInlineUnconditionally.

    Example:
      f BIG, where f has a RULE
    Then
     * We simplify BIG before trying the rule; but the rule does not fire
     * We inline f = \x. x True
     * So if we did preInlineUnconditionally we'd re-simplify (BIG True)

    However, if BIG has /not/ already been simplified, we'd /like/ to
    simplify BIG True; maybe good things happen.  That is why

    * simplLam has
        - a case for (isSimplified dup), which goes via simplNonRecX, and
        - a case for the un-simplified case, which goes via simplNonRecE

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

    Note [Zap unfolding when beta-reducing]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Lambda-bound variables can have stable unfoldings, such as
       $j = \x. \b{Unf=Just x}. e
    See Note [Case binders and join points] below; the unfolding for lets
    us optimise e better.  However when we beta-reduce it we want to
    revert to using the actual value, otherwise we can end up in the
    stupid situation of
              let x = blah in
              let b{Unf=Just x} = y
              in ...b...
    Here it'd be far better to drop the unfolding and use the actual RHS.

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

    type MaybeJoinCont = Maybe SimplCont
      -- Nothing => Not a join point
      -- Just k  => This is a join binding with continuation k
      -- See Note [Rules and unfolding for join points]

    simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr
                         -> InExpr -> SimplCont
                         -> SimplM (SimplFloats, OutExpr)
    simplNonRecJoinPoint :: SimplEnv
    -> OutId
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplNonRecJoinPoint SimplEnv
    env OutId
    bndr CoreExpr
    rhs CoreExpr
    body SimplCont
    cont
      | ASSERT( isJoinId bndr ) True
      , Just SimplEnv
    env' <- SimplEnv
    -> TopLevelFlag -> OutId -> CoreExpr -> SimplEnv -> Maybe SimplEnv
    preInlineUnconditionally SimplEnv
    env TopLevelFlag
    NotTopLevel OutId
    bndr CoreExpr
    rhs SimplEnv
    env
      = do { Tick -> SimplM ()
    tick (OutId -> Tick
    PreInlineUnconditionally OutId
    bndr)
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    body SimplCont
    cont }

       | Bool
    otherwise
       = SimplEnv
    -> SimplCont
    -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr)
    wrapJoinCont SimplEnv
    env SimplCont
    cont 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
            ; (SimplEnv
    env1, OutId
    bndr1)    <- SimplEnv -> OutId -> Kind -> Kind -> SimplM (SimplEnv, OutId)
    simplNonRecJoinBndr SimplEnv
    env OutId
    bndr Kind
    mult Kind
    res_ty
            ; (SimplEnv
    env2, OutId
    bndr2)    <- SimplEnv
    -> OutId -> OutId -> MaybeJoinCont -> SimplM (SimplEnv, OutId)
    addBndrRules SimplEnv
    env1 OutId
    bndr OutId
    bndr1 (forall a. a -> Maybe a
    Just SimplCont
    cont)
            ; (SimplFloats
    floats1, SimplEnv
    env3)  <- SimplEnv
    -> SimplCont
    -> OutId
    -> OutId
    -> CoreExpr
    -> SimplEnv
    -> SimplM (SimplFloats, SimplEnv)
    simplJoinBind SimplEnv
    env2 SimplCont
    cont OutId
    bndr OutId
    bndr2 CoreExpr
    rhs SimplEnv
    env
            ; (SimplFloats
    floats2, CoreExpr
    body') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env3 CoreExpr
    body SimplCont
    cont
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    body') }

    ------------------
    simplRecJoinPoint :: SimplEnv -> [(InId, InExpr)]
                      -> InExpr -> SimplCont
                      -> SimplM (SimplFloats, OutExpr)
    simplRecJoinPoint :: SimplEnv
    -> [(OutId, CoreExpr)]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplRecJoinPoint SimplEnv
    env [(OutId, CoreExpr)]
    pairs CoreExpr
    body SimplCont
    cont
      = SimplEnv
    -> SimplCont
    -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr))
    -> SimplM (SimplFloats, CoreExpr)
    wrapJoinCont SimplEnv
    env SimplCont
    cont forall a b. (a -> b) -> a -> b
    $ \ SimplEnv
    env SimplCont
    cont ->
        do { let bndrs :: [OutId]
    bndrs  = forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(OutId, CoreExpr)]
    pairs
                 mult :: Kind
    mult   = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
                 res_ty :: Kind
    res_ty = SimplCont -> Kind
    contResultType SimplCont
    cont
           ; SimplEnv
    env1 <- SimplEnv -> [OutId] -> Kind -> Kind -> SimplM SimplEnv
    simplRecJoinBndrs SimplEnv
    env [OutId]
    bndrs Kind
    mult Kind
    res_ty
                   -- NB: bndrs' don't have unfoldings or rules
                   -- We add them as we go down
           ; (SimplFloats
    floats1, SimplEnv
    env2)  <- SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> [(OutId, CoreExpr)]
    -> SimplM (SimplFloats, SimplEnv)
    simplRecBind SimplEnv
    env1 TopLevelFlag
    NotTopLevel (forall a. a -> Maybe a
    Just SimplCont
    cont) [(OutId, CoreExpr)]
    pairs
           ; (SimplFloats
    floats2, CoreExpr
    body') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env2 CoreExpr
    body SimplCont
    cont
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    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 (SimplMode -> Bool
    sm_case_case (SimplEnv -> SimplMode
    getMode SimplEnv
    env))
        -- See Note [Join points with -fno-case-of-case]
      = do { (SimplFloats
    floats1, CoreExpr
    expr1) <- SimplEnv -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    thing_inside SimplEnv
    env (Kind -> SimplCont
    mkBoringStop (SimplCont -> Kind
    contHoleType SimplCont
    cont))
           ; let (SimplFloats
    floats2, CoreExpr
    expr2) = SimplFloats -> CoreExpr -> (SimplFloats, CoreExpr)
    wrapJoinFloatsX SimplFloats
    floats1 CoreExpr
    expr1
           ; (SimplFloats
    floats3, CoreExpr
    expr3) <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild (SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    floats2) CoreExpr
    expr2 SimplCont
    cont
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats2 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats3, CoreExpr
    expr3) }

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

    --------------------
    trimJoinCont :: Id -> Maybe JoinArity -> SimplCont -> SimplCont
    -- Drop outer context from join point invocation (jump)
    -- See Note [Join points and case-of-case]

    trimJoinCont :: OutId -> Maybe Int -> SimplCont -> SimplCont
    trimJoinCont OutId
    _ Maybe Int
    Nothing SimplCont
    cont
      = SimplCont
    cont -- Not a jump
    trimJoinCont OutId
    var (Just 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 :: SimplCont
    sc_cont = Int -> SimplCont -> SimplCont
    trim (Int
    nforall a. Num a => a -> a -> a
    -Int
    1) SimplCont
    k }
        trim Int
    n cont :: SimplCont
    cont@(ApplyToTy { sc_cont :: SimplCont -> SimplCont
    sc_cont = SimplCont
    k })
          = SimplCont
    cont { sc_cont :: SimplCont
    sc_cont = Int -> SimplCont -> SimplCont
    trim (Int
    nforall a. Num a => a -> a -> a
    -Int
    1) SimplCont
    k } -- join arity counts types!
        trim Int
    _ SimplCont
    cont
          = forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "completeCall" forall a b. (a -> b) -> a -> b
    $ forall a. Outputable a => a -> SDoc
    ppr OutId
    var SDoc -> SDoc -> 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
    *                                                                      *
    ************************************************************************
    -}

    simplVar :: SimplEnv -> InVar -> SimplM OutExpr
    -- Look up an InVar in the environment
    simplVar :: SimplEnv -> OutId -> SimplM CoreExpr
    simplVar SimplEnv
    env OutId
    var
      -- Why $! ? See Note [Bangs in the Simplifier]
      | OutId -> Bool
    isTyVar OutId
    var = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $! forall b. Kind -> Expr b
    Type forall a b. (a -> b) -> a -> b
    $! (SimplEnv -> OutId -> Kind
    substTyVar SimplEnv
    env OutId
    var)
      | OutId -> Bool
    isCoVar OutId
    var = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $! forall b. Coercion -> Expr b
    Coercion forall a b. (a -> b) -> a -> b
    $! (SimplEnv -> OutId -> Coercion
    substCoVar SimplEnv
    env OutId
    var)
      | Bool
    otherwise
      = case SimplEnv -> OutId -> SimplSR
    substId SimplEnv
    env OutId
    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 OutId
    var1          -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. OutId -> Expr b
    Var OutId
    var1)
            DoneEx CoreExpr
    e Maybe Int
    _           -> forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    e

    simplIdF :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr)
    simplIdF :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplIdF SimplEnv
    env OutId
    var SimplCont
    cont
      = case SimplEnv -> OutId -> SimplSR
    substId SimplEnv
    env OutId
    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 -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    e SimplCont
    cont
              -- Don't trim; haven't already simplified e,
              -- so the cont is not embodied in e

          DoneId OutId
    var1 ->
              let cont' :: SimplCont
    cont' = OutId -> Maybe Int -> SimplCont -> SimplCont
    trimJoinCont OutId
    var (OutId -> Maybe Int
    isJoinId_maybe OutId
    var1) SimplCont
    cont
              in SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    completeCall SimplEnv
    env OutId
    var1 SimplCont
    cont'

          DoneEx CoreExpr
    e Maybe Int
    mb_join ->
              let env' :: SimplEnv
    env' = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env
                  cont' :: SimplCont
    cont' = OutId -> Maybe Int -> SimplCont -> SimplCont
    trimJoinCont OutId
    var Maybe Int
    mb_join SimplCont
    cont
              in SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    e SimplCont
    cont'
                  -- Note [zapSubstEnv]
                  -- The template is already simplified, so don't re-substitute.
                  -- 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!!

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

    completeCall :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr)
    completeCall :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    completeCall SimplEnv
    env OutId
    var SimplCont
    cont
      | Just CoreExpr
    expr <- Logger
    -> DynFlags
    -> Int
    -> OutId
    -> Bool
    -> Bool
    -> [ArgSummary]
    -> CallCtxt
    -> Maybe CoreExpr
    callSiteInline Logger
    logger DynFlags
    dflags Int
    case_depth OutId
    var Bool
    active_unf
                                    Bool
    lone_variable [ArgSummary]
    arg_infos CallCtxt
    interesting_cont
      -- Inline the variable's RHS
      = do { Tick -> SimplM ()
    checkedTick (OutId -> Tick
    UnfoldingDone OutId
    var)
           ; CoreExpr -> SimplCont -> SimplM ()
    dump_inline CoreExpr
    expr SimplCont
    cont
           ; let env1 :: SimplEnv
    env1 = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env1 CoreExpr
    expr SimplCont
    cont }

      | Bool
    otherwise
      -- Don't inline; instead rebuild the call
      = do { RuleEnv
    rule_base <- SimplM RuleEnv
    getSimplRules
           ; let rules :: [CoreRule]
    rules = RuleEnv -> OutId -> [CoreRule]
    getRules RuleEnv
    rule_base OutId
    var
                 info :: ArgInfo
    info = SimplEnv -> OutId -> [CoreRule] -> Int -> SimplCont -> ArgInfo
    mkArgInfo SimplEnv
    env OutId
    var [CoreRule]
    rules
                                  Int
    n_val_args SimplCont
    call_cont
           ; SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env ArgInfo
    info SimplCont
    cont }

      where
        dflags :: DynFlags
    dflags     = SimplEnv -> DynFlags
    seDynFlags SimplEnv
    env
        case_depth :: Int
    case_depth = SimplEnv -> Int
    seCaseDepth SimplEnv
    env
        logger :: Logger
    logger     = SimplEnv -> Logger
    seLogger SimplEnv
    env
        (Bool
    lone_variable, [ArgSummary]
    arg_infos, SimplCont
    call_cont) = SimplCont -> (Bool, [ArgSummary], SimplCont)
    contArgs SimplCont
    cont
        n_val_args :: Int
    n_val_args       = forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ArgSummary]
    arg_infos
        interesting_cont :: CallCtxt
    interesting_cont = SimplEnv -> SimplCont -> CallCtxt
    interestingCallContext SimplEnv
    env SimplCont
    call_cont
        active_unf :: Bool
    active_unf       = SimplMode -> OutId -> Bool
    activeUnfolding (SimplEnv -> SimplMode
    getMode SimplEnv
    env) OutId
    var

        log_inlining :: SDoc -> SimplM ()
    log_inlining SDoc
    doc
          = forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ Logger -> DumpAction
    putDumpMsg Logger
    logger DynFlags
    dflags
               (PrintUnqualified -> PprStyle
    mkDumpStyle PrintUnqualified
    alwaysQualify)
               DumpFlag
    Opt_D_dump_inlinings
               [Char]
    "" DumpFormat
    FormatText SDoc
    doc

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

    rebuildCall :: SimplEnv
                -> ArgInfo
                -> SimplCont
                -> SimplM (SimplFloats, OutExpr)
    -- We decided not to inline, so
    --    - simplify the arguments
    --    - try rewrite rules
    --    - and rebuild

    ---------- Bottoming applications --------------
    rebuildCall :: SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo { ai_fun :: ArgInfo -> OutId
    ai_fun = OutId
    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 seq :: forall a b. a -> b -> b
    `seq`        -- See Note [Avoiding space leaks in OutType]
        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     = OutId -> [ArgSpec] -> CoreExpr
    argInfoExpr OutId
    fun [ArgSpec]
    rev_args
        cont_ty :: Kind
    cont_ty = SimplCont -> Kind
    contResultType SimplCont
    cont

    ---------- Try rewrite RULES --------------
    -- See Note [Trying rewrite rules]
    rebuildCall SimplEnv
    env info :: ArgInfo
    info@(ArgInfo { ai_fun :: ArgInfo -> OutId
    ai_fun = OutId
    fun, ai_args :: ArgInfo -> [ArgSpec]
    ai_args = [ArgSpec]
    rev_args
                                  , ai_rules :: ArgInfo -> FunRules
    ai_rules = Just (Int
    nr_wanted, [CoreRule]
    rules) }) SimplCont
    cont
      | Int
    nr_wanted forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    || Bool
    no_more_args
      , let info' :: ArgInfo
    info' = ArgInfo
    info { ai_rules :: FunRules
    ai_rules = forall a. Maybe a
    Nothing }
      = -- 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 { Maybe (SimplEnv, CoreExpr, SimplCont)
    mb_match <- SimplEnv
    -> [CoreRule]
    -> OutId
    -> [ArgSpec]
    -> SimplCont
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    tryRules SimplEnv
    env [CoreRule]
    rules OutId
    fun (forall a. [a] -> [a]
    reverse [ArgSpec]
    rev_args) SimplCont
    cont
           ; case Maybe (SimplEnv, CoreExpr, SimplCont)
    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' SimplCont
    cont }
      where
        no_more_args :: Bool
    no_more_args = case SimplCont
    cont of
                          ApplyToTy  {} -> Bool
    False
                          ApplyToVal {} -> Bool
    False
                          SimplCont
    _             -> Bool
    True

    ---------- Simplify applications and casts --------------
    rebuildCall SimplEnv
    env ArgInfo
    info (CastIt Coercion
    co SimplCont
    cont)
      = SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo -> Coercion -> ArgInfo
    addCastTo ArgInfo
    info Coercion
    co) SimplCont
    cont

    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 -> OutId
    ai_fun = OutId
    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 })
      | OutId
    fun_id forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    runRWKey
      , [ TyArg {}, TyArg {} ] <- [ArgSpec]
    rev_args
      -- Do this even if (contIsStop cont)
      -- See Note [No eta-expansion in runRW#]
      = do { let arg_env :: SimplEnv
    arg_env = SimplEnv
    arg_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env
                 ty' :: Kind
    ty'   = SimplCont -> Kind
    contResultType SimplCont
    cont

           -- 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.
           ; CoreExpr
    arg' <- case CoreExpr
    arg of
               Lam OutId
    s CoreExpr
    body -> do { (SimplEnv
    env', OutId
    s') <- SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder SimplEnv
    arg_env OutId
    s
                                ; CoreExpr
    body' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env' CoreExpr
    body SimplCont
    cont
                                ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. b -> Expr b -> Expr b
    Lam OutId
    s' CoreExpr
    body') }
                                -- Important: do not try to eta-expand this lambda
                                -- See Note [No eta-expansion in runRW#]
               CoreExpr
    _ -> do { OutId
    s' <- FastString -> Kind -> Kind -> SimplM OutId
    newId ([Char] -> FastString
    fsLit [Char]
    "s") Kind
    Many Kind
    realWorldStatePrimTy
                       ; let (Kind
    m,Kind
    _,Kind
    _) = Kind -> (Kind, Kind, Kind)
    splitFunTy Kind
    fun_ty
                             env' :: SimplEnv
    env'  = SimplEnv
    arg_env SimplEnv -> [OutId] -> SimplEnv
    `addNewInScopeIds` [OutId
    s']
                             cont' :: SimplCont
    cont' = ApplyToVal { sc_dup :: DupFlag
    sc_dup = DupFlag
    Simplified, sc_arg :: CoreExpr
    sc_arg = forall b. OutId -> Expr b
    Var OutId
    s'
                                                , sc_env :: SimplEnv
    sc_env = SimplEnv
    env', sc_cont :: SimplCont
    sc_cont = SimplCont
    cont
                                                , sc_hole_ty :: Kind
    sc_hole_ty = Kind -> Kind -> Kind -> Kind
    mkVisFunTy Kind
    m Kind
    realWorldStatePrimTy Kind
    ty' }
                                    -- cont' applies to s', then K
                       ; CoreExpr
    body' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env' CoreExpr
    arg SimplCont
    cont'
                       ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. b -> Expr b -> Expr b
    Lam OutId
    s' CoreExpr
    body') }

           ; let rr' :: Kind
    rr'   = HasDebugCallStack => Kind -> Kind
    getRuntimeRep Kind
    ty'
                 call' :: CoreExpr
    call' = forall b. Expr b -> [Expr b] -> Expr b
    mkApps (forall b. OutId -> Expr b
    Var OutId
    fun_id) [forall b. Kind -> Expr b
    mkTyArg Kind
    rr', forall b. Kind -> Expr b
    mkTyArg Kind
    ty', CoreExpr
    arg']
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, CoreExpr
    call') }

    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
      , SimplMode -> Bool
    sm_case_case (SimplEnv -> SimplMode
    getMode SimplEnv
    env)
      = -- 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]

      -- 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  { CoreExpr
    arg' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC (SimplEnv
    arg_se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) CoreExpr
    arg
                                 (Kind -> CallCtxt -> SimplCont
    mkLazyArgStop Kind
    arg_ty (ArgInfo -> CallCtxt
    lazyArgContext ArgInfo
    fun_info))
            ; SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env (ArgInfo -> CoreExpr -> Kind -> ArgInfo
    addValArgTo ArgInfo
    fun_info  CoreExpr
    arg' Kind
    fun_ty) SimplCont
    cont }
      where
        arg_ty :: Kind
    arg_ty = Kind -> Kind
    funArgTy Kind
    fun_ty

    ---------- No further useful info, revert to generic rebuild ------------
    rebuildCall SimplEnv
    env (ArgInfo { ai_fun :: ArgInfo -> OutId
    ai_fun = OutId
    fun, ai_args :: ArgInfo -> [ArgSpec]
    ai_args = [ArgSpec]
    rev_args }) SimplCont
    cont
      = SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env (OutId -> [ArgSpec] -> CoreExpr
    argInfoExpr OutId
    fun [ArgSpec]
    rev_args) 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 exponential behaviour].

    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 [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]
    ~~~~~~~~~~~~~~~~
    This part of the simplifier may break the no-shadowing invariant
    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!

    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]
             -> SimplCont
             -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))

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

    {- Disabled until we fix #8326
      | fn `hasKey` tagToEnumKey   -- See Note [Optimising tagToEnum#]
      , [_type_arg, val_arg] <- args
      , Select dup bndr ((_,[],rhs1) : rest_alts) se cont <- call_cont
      , isDeadBinder bndr
      = do { let enum_to_tag :: CoreAlt -> CoreAlt
                    -- Takes   K -> e  into   tagK# -> e
                    -- where tagK# is the tag of constructor K
                 enum_to_tag (DataAlt con, [], rhs)
                   = ASSERT( isEnumerationTyCon (dataConTyCon con) )
                    (LitAlt tag, [], rhs)
                  where
                    tag = mkLitInt dflags (toInteger (dataConTag con - fIRST_TAG))
                 enum_to_tag alt = pprPanic "tryRules: tagToEnum" (ppr alt)

                 new_alts = (DEFAULT, [], rhs1) : map enum_to_tag rest_alts
                 new_bndr = setIdType bndr intPrimTy
                     -- The binder is dead, but should have the right type
          ; return (Just (val_arg, Select dup new_bndr new_alts se cont)) }
    -}

      | Just (CoreRule
    rule, CoreExpr
    rule_rhs) <- RuleOpts
    -> InScopeEnv
    -> (Activation -> Bool)
    -> OutId
    -> [CoreExpr]
    -> [CoreRule]
    -> Maybe (CoreRule, CoreExpr)
    lookupRule RuleOpts
    ropts (SimplEnv -> InScopeEnv
    getUnfoldingInRuleMatch SimplEnv
    env)
                                            (SimplMode -> Activation -> Bool
    activeRule (SimplEnv -> SimplMode
    getMode SimplEnv
    env)) OutId
    fn
                                            ([ArgSpec] -> [CoreExpr]
    argInfoAppArgs [ArgSpec]
    args) [CoreRule]
    rules
      -- Fire a rule for the function
      = do { Tick -> SimplM ()
    checkedTick (FastString -> Tick
    RuleFired (CoreRule -> FastString
    ruleName CoreRule
    rule))
           ; let cont' :: SimplCont
    cont' = SimplEnv -> [ArgSpec] -> SimplCont -> SimplCont
    pushSimplifiedArgs SimplEnv
    zapped_env
                                            (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
    occ_anald_rhs = CoreExpr -> CoreExpr
    occurAnalyseExpr CoreExpr
    rule_rhs
                     -- See Note [Occurrence-analyse after rule firing]
           ; CoreRule -> CoreExpr -> SimplM ()
    dump CoreRule
    rule CoreExpr
    rule_rhs
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> Maybe a
    Just (SimplEnv
    zapped_env, CoreExpr
    occ_anald_rhs, SimplCont
    cont')) }
                -- The occ_anald_rhs and cont' are all Out things
                -- hence zapping the environment

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

      where
        -- Force this to avoid retaining DynFlags and hence SimplEnv
        !ropts :: RuleOpts
    ropts     = DynFlags -> RuleOpts
    initRuleOpts DynFlags
    dflags
        dflags :: DynFlags
    dflags     = SimplEnv -> DynFlags
    seDynFlags SimplEnv
    env
        logger :: Logger
    logger     = SimplEnv -> Logger
    seLogger SimplEnv
    env
        zapped_env :: SimplEnv
    zapped_env = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env  -- See Note [zapSubstEnv]

        printRuleModule :: CoreRule -> SDoc
    printRuleModule CoreRule
    rule
          = SDoc -> SDoc
    parens (forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> SDoc
    text [Char]
    "BUILTIN")
                          (ModuleName -> SDoc
    pprModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall unit. GenModule unit -> ModuleName
    moduleName)
                          (CoreRule -> Maybe (GenModule Unit)
    ruleModule CoreRule
    rule))

        dump :: CoreRule -> CoreExpr -> SimplM ()
    dump CoreRule
    rule CoreExpr
    rule_rhs
          | DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_rule_rewrites DynFlags
    dflags
          = DynFlags -> DumpFlag -> [Char] -> SDoc -> SimplM ()
    log_rule DynFlags
    dflags DumpFlag
    Opt_D_dump_rule_rewrites [Char]
    "Rule fired" forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
              [ [Char] -> SDoc
    text [Char]
    "Rule:" SDoc -> SDoc -> SDoc
    <+> FastString -> SDoc
    ftext (CoreRule -> FastString
    ruleName CoreRule
    rule)
              , [Char] -> SDoc
    text [Char]
    "Module:" SDoc -> SDoc -> SDoc
    <+>  CoreRule -> SDoc
    printRuleModule CoreRule
    rule
              , [Char] -> SDoc
    text [Char]
    "Before:" SDoc -> SDoc -> SDoc
    <+> SDoc -> Int -> SDoc -> SDoc
    hang (forall a. Outputable a => a -> SDoc
    ppr OutId
    fn) Int
    2 ([SDoc] -> SDoc
    sep (forall a b. (a -> b) -> [a] -> [b]
    map forall a. Outputable a => a -> SDoc
    ppr [ArgSpec]
    args))
              , [Char] -> SDoc
    text [Char]
    "After: " SDoc -> SDoc -> SDoc
    <+> SDoc -> Int -> SDoc -> SDoc
    hang (forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr CoreExpr
    rule_rhs) Int
    2
                                   ([SDoc] -> SDoc
    sep forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map forall a. Outputable a => a -> SDoc
    ppr forall a b. (a -> b) -> a -> b
    $ forall a. Int -> [a] -> [a]
    drop (CoreRule -> Int
    ruleArity CoreRule
    rule) [ArgSpec]
    args)
              , [Char] -> SDoc
    text [Char]
    "Cont:  " SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr SimplCont
    call_cont ]

          | DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_rule_firings DynFlags
    dflags
          = DynFlags -> DumpFlag -> [Char] -> SDoc -> SimplM ()
    log_rule DynFlags
    dflags DumpFlag
    Opt_D_dump_rule_firings [Char]
    "Rule fired:" forall a b. (a -> b) -> a -> b
    $
              FastString -> SDoc
    ftext (CoreRule -> FastString
    ruleName CoreRule
    rule)
                SDoc -> SDoc -> SDoc
    <+> CoreRule -> SDoc
    printRuleModule CoreRule
    rule

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

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

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

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

        log_rule :: DynFlags -> DumpFlag -> [Char] -> SDoc -> SimplM ()
    log_rule DynFlags
    dflags DumpFlag
    flag [Char]
    hdr SDoc
    details
          = forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ do
              let sty :: PprStyle
    sty = PrintUnqualified -> PprStyle
    mkDumpStyle PrintUnqualified
    alwaysQualify
              Logger -> DumpAction
    putDumpMsg Logger
    logger DynFlags
    dflags PprStyle
    sty DumpFlag
    flag [Char]
    "" DumpFormat
    FormatText forall a b. (a -> b) -> a -> b
    $
                  [SDoc] -> SDoc
    sep [[Char] -> SDoc
    text [Char]
    hdr, Int -> SDoc -> SDoc
    nest Int
    4 SDoc
    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 { RuleEnv
    rule_base <- SimplM RuleEnv
    getSimplRules
           ; SimplEnv
    -> [CoreRule]
    -> OutId
    -> [ArgSpec]
    -> SimplCont
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    tryRules SimplEnv
    in_env (RuleEnv -> OutId -> [CoreRule]
    getRules RuleEnv
    rule_base OutId
    seqId) OutId
    seqId [ArgSpec]
    out_args SimplCont
    rule_cont }
      where
        no_cast_scrut :: CoreExpr
    no_cast_scrut = forall {b}. Expr b -> Expr b
    drop_casts CoreExpr
    scrut
        scrut_ty :: Kind
    scrut_ty  = CoreExpr -> Kind
    exprType CoreExpr
    no_cast_scrut
        seq_id_ty :: Kind
    seq_id_ty = OutId -> Kind
    idType OutId
    seqId                    -- forall r a (b::TYPE r). a -> b -> b
        res1_ty :: Kind
    res1_ty   = HasDebugCallStack => 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
    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
    piResultTy Kind
    res2_ty   Kind
    rhs_ty     -- scrut_ty -> rhs_ty -> rhs_ty
        res4_ty :: Kind
    res4_ty   = Kind -> Kind
    funResultTy Kind
    res3_ty             -- rhs_ty -> rhs_ty
        rhs_ty :: Kind
    rhs_ty    = SimplEnv -> Kind -> Kind
    substTy SimplEnv
    in_env (CoreExpr -> Kind
    exprType CoreExpr
    rhs)
        rhs_rep :: Kind
    rhs_rep   = HasDebugCallStack => 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 Coercion
    _) = 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.

    Possible improvement: occ-anal the rules when putting them in the
    database; and in the simplifier just occ-anal the OutExpr arguments.
    But that's more complicated and the rule RHS is usually tiny; so I'm
    just doing the simple thing.

    Historical note: previously we did occ-anal the rules in Rule.hs,
    but failed to occ-anal the OutExpr arguments, which led to the
    nasty performance problem described above.

    Note [Optimising tagToEnum#]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we have an enumeration data type:

      data Foo = A | B | C

    Then we want to transform

       case tagToEnum# x of   ==>    case x of
         A -> e1                       DEFAULT -> e1
         B -> e2                       1#      -> e2
         C -> e3                       2#      -> e3

    thereby getting rid of the tagToEnum# altogether.  If there was a DEFAULT
    alternative we retain it (remember it comes first).  If not the case must
    be exhaustive, and we reflect that in the transformed version by adding
    a DEFAULT.  Otherwise Lint complains that the new case is not exhaustive.
    See #8317.

    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/app 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]

      NB: absentError satisfies exprIsHNF: see Note [aBSENT_ERROR_ID] in GHC.Core.Make.
      We want to turn
         case (absentError "foo") of r -> ...MkT r...
      into
         let r = absentError "foo" in ...MkT r...

    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 can safely transform to
       let r = <scrut> in ...r...

    This is a Good Thing, because 'r' might be dead (if the body just
    calls error), or might be used just once (in which case it can be
    inlined); or we might be able to float the let-binding up or down.
    E.g. #15631 has an example.

    Note that this 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").

    Nevertheless, the paper "A semantics for imprecise exceptions" allows
    this transformation. If you want to fix the evaluation order, use
    'pseq'.  See #8900 for an example where the loss of this
    transformation bit us in practice.

    See also 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 of an eval'd function] 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.
    -}

    ---------------------------------------------------------
    --      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
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    rebuildCase SimplEnv
    env CoreExpr
    scrut OutId
    case_bndr [Alt OutId]
    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 (OutId -> Tick
    KnownBranch OutId
    case_bndr)
            ; case forall b. AltCon -> [Alt b] -> Maybe (Alt b)
    findAlt (Literal -> AltCon
    LitAlt Literal
    lit) [Alt OutId]
    alts of
                Maybe (Alt OutId)
    Nothing             -> SimplEnv
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    missingAlt SimplEnv
    env OutId
    case_bndr [Alt OutId]
    alts SimplCont
    cont
                Just (Alt AltCon
    _ [OutId]
    bs CoreExpr
    rhs) -> SimplEnv
    -> [FloatBind]
    -> CoreExpr
    -> [OutId]
    -> CoreExpr
    -> SimplM (SimplFloats, CoreExpr)
    simple_rhs SimplEnv
    env [] CoreExpr
    scrut [OutId]
    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])
    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 (OutId -> Tick
    KnownBranch OutId
    case_bndr)
            ; let scaled_wfloats :: [FloatBind]
    scaled_wfloats = forall a b. (a -> b) -> [a] -> [b]
    map FloatBind -> FloatBind
    scale_float [FloatBind]
    wfloats
            ; case forall b. AltCon -> [Alt b] -> Maybe (Alt b)
    findAlt (DataCon -> AltCon
    DataAlt DataCon
    con) [Alt OutId]
    alts of
                Maybe (Alt OutId)
    Nothing  -> SimplEnv
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    missingAlt SimplEnv
    env0 OutId
    case_bndr [Alt OutId]
    alts SimplCont
    cont
                Just (Alt AltCon
    DEFAULT [OutId]
    bs CoreExpr
    rhs) -> let con_app :: CoreExpr
    con_app = forall b. OutId -> Expr b
    Var (DataCon -> OutId
    dataConWorkId DataCon
    con)
                                                     forall b. Expr b -> [Kind] -> Expr b
    `mkTyApps` [Kind]
    ty_args
                                                     forall b. Expr b -> [Expr b] -> Expr b
    `mkApps`   [CoreExpr]
    other_args
                                             in SimplEnv
    -> [FloatBind]
    -> CoreExpr
    -> [OutId]
    -> CoreExpr
    -> SimplM (SimplFloats, CoreExpr)
    simple_rhs SimplEnv
    env0 [FloatBind]
    scaled_wfloats CoreExpr
    con_app [OutId]
    bs CoreExpr
    rhs
                Just (Alt AltCon
    _ [OutId]
    bs CoreExpr
    rhs)       -> SimplEnv
    -> CoreExpr
    -> [FloatBind]
    -> DataCon
    -> [Kind]
    -> [CoreExpr]
    -> OutId
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    knownCon SimplEnv
    env0 CoreExpr
    scrut [FloatBind]
    scaled_wfloats DataCon
    con [Kind]
    ty_args [CoreExpr]
    other_args
                                                      OutId
    case_bndr [OutId]
    bs CoreExpr
    rhs SimplCont
    cont
            }
      where
        simple_rhs :: SimplEnv
    -> [FloatBind]
    -> CoreExpr
    -> [OutId]
    -> CoreExpr
    -> SimplM (SimplFloats, CoreExpr)
    simple_rhs SimplEnv
    env [FloatBind]
    wfloats CoreExpr
    scrut' [OutId]
    bs CoreExpr
    rhs =
          ASSERT( null bs )
          do { (SimplFloats
    floats1, SimplEnv
    env') <- SimplEnv -> OutId -> CoreExpr -> SimplM (SimplFloats, SimplEnv)
    simplNonRecX SimplEnv
    env OutId
    case_bndr CoreExpr
    scrut'
                 -- scrut is a constructor application,
                 -- hence satisfies let/app invariant
             ; (SimplFloats
    floats2, CoreExpr
    expr') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    rhs SimplCont
    cont
             ; case [FloatBind]
    wfloats of
                 [] -> forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    expr')
                 [FloatBind]
    _ -> 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 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 OutId
    case_bndr AltCon
    con [OutId]
    vars) =
          let
            scale_id :: OutId -> OutId
    scale_id OutId
    id = Kind -> OutId -> OutId
    scaleVarBy Kind
    holeScaling OutId
    id
          in
          CoreExpr -> OutId -> AltCon -> [OutId] -> FloatBind
    GHC.Core.Make.FloatCase CoreExpr
    scrut (OutId -> OutId
    scale_id OutId
    case_bndr) AltCon
    con (forall a b. (a -> b) -> [a] -> [b]
    map OutId -> OutId
    scale_id [OutId]
    vars)
        scale_float FloatBind
    f = FloatBind
    f

        holeScaling :: Kind
    holeScaling = SimplCont -> Kind
    contHoleScaling SimplCont
    cont Kind -> Kind -> Kind
    `mkMultMul` OutId -> Kind
    idMult OutId
    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 OutId
    case_bndr alts :: [Alt OutId]
    alts@[Alt AltCon
    _ [OutId]
    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
    exprOkForSideEffects 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
              -- See Note [PrimOp can_fail and has_side_effects] in GHC.Builtin.PrimOps
       = 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 -> OutId -> Bool
    doCaseToLet CoreExpr
    scrut OutId
    case_bndr
      = do { Tick -> SimplM ()
    tick (OutId -> Tick
    CaseElim OutId
    case_bndr)
           ; (SimplFloats
    floats1, SimplEnv
    env') <- SimplEnv -> OutId -> CoreExpr -> SimplM (SimplFloats, SimplEnv)
    simplNonRecX SimplEnv
    env OutId
    case_bndr CoreExpr
    scrut
           ; (SimplFloats
    floats2, CoreExpr
    expr') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env' CoreExpr
    rhs SimplCont
    cont
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, CoreExpr
    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 { Maybe (SimplEnv, CoreExpr, SimplCont)
    mb_rule <- SimplEnv
    -> CoreExpr
    -> CoreExpr
    -> SimplCont
    -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))
    trySeqRules SimplEnv
    env CoreExpr
    scrut CoreExpr
    rhs SimplCont
    cont
           ; case Maybe (SimplEnv, CoreExpr, SimplCont)
    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
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    reallyRebuildCase SimplEnv
    env CoreExpr
    scrut OutId
    case_bndr [Alt OutId]
    alts SimplCont
    cont }
      where
        all_dead_bndrs :: Bool
    all_dead_bndrs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all OutId -> Bool
    isDeadBinder [OutId]
    bndrs       -- bndrs are [InId]
        is_plain_seq :: Bool
    is_plain_seq   = Bool
    all_dead_bndrs Bool -> Bool -> Bool
    && OutId -> Bool
    isDeadBinder OutId
    case_bndr -- Evaluation *only* for effect

    rebuildCase SimplEnv
    env CoreExpr
    scrut OutId
    case_bndr [Alt OutId]
    alts SimplCont
    cont
      = SimplEnv
    -> CoreExpr
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    reallyRebuildCase SimplEnv
    env CoreExpr
    scrut OutId
    case_bndr [Alt OutId]
    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 -> OutId -> Bool
    doCaseToLet CoreExpr
    scrut OutId
    case_bndr
      | OutId -> Bool
    isTyCoVar OutId
    case_bndr    -- Respect GHC.Core
      = forall {b}. Expr b -> Bool
    isTyCoArg CoreExpr
    scrut        -- Note [Core type and coercion invariant]

      | HasDebugCallStack => Kind -> Bool
    isUnliftedType (OutId -> Kind
    idType OutId
    case_bndr)
      = CoreExpr -> Bool
    exprOkForSpeculation CoreExpr
    scrut

      | Bool
    otherwise  -- Scrut has a lifted type
      = CoreExpr -> Bool
    exprIsHNF CoreExpr
    scrut
        Bool -> Bool -> Bool
    || Demand -> Bool
    isStrUsedDmd (OutId -> Demand
    idDemandInfo OutId
    case_bndr)
        -- See Note [Case-to-let for strictly-used binders]

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

    reallyRebuildCase :: SimplEnv
    -> CoreExpr
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    reallyRebuildCase SimplEnv
    env CoreExpr
    scrut OutId
    case_bndr [Alt OutId]
    alts SimplCont
    cont
      | Bool -> Bool
    not (SimplMode -> Bool
    sm_case_case (SimplEnv -> SimplMode
    getMode SimplEnv
    env))
      = do { CoreExpr
    case_expr <- SimplEnv
    -> CoreExpr -> OutId -> [Alt OutId] -> SimplCont -> SimplM CoreExpr
    simplAlts SimplEnv
    env CoreExpr
    scrut OutId
    case_bndr [Alt OutId]
    alts
                                    (Kind -> SimplCont
    mkBoringStop (SimplCont -> Kind
    contHoleType SimplCont
    cont))
           ; SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuild SimplEnv
    env CoreExpr
    case_expr SimplCont
    cont }

      | Bool
    otherwise
      = do { (SimplFloats
    floats, SimplEnv
    env', SimplCont
    cont') <- SimplEnv
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, SimplEnv, SimplCont)
    mkDupableCaseCont SimplEnv
    env [Alt OutId]
    alts SimplCont
    cont
           ; CoreExpr
    case_expr <- SimplEnv
    -> CoreExpr -> OutId -> [Alt OutId] -> SimplCont -> SimplM CoreExpr
    simplAlts SimplEnv
    env' CoreExpr
    scrut
                                    (Kind -> OutId -> OutId
    scaleIdBy Kind
    holeScaling OutId
    case_bndr)
                                    (Kind -> [Alt OutId] -> [Alt OutId]
    scaleAltsBy Kind
    holeScaling [Alt OutId]
    alts)
                                    SimplCont
    cont'
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, CoreExpr
    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 [Case alternative occ info]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we are simply reconstructing a case (the common case), we always
    zap the occurrence info on the binders in the alternatives.  Even
    if the case binder is dead, the scrutinee is usually a variable, and *that*
    can bring the case-alternative binders back to life.
    See Note [Add unfolding for scrutinee]

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

            ; (FamInstEnv, FamInstEnv)
    fam_envs <- SimplM (FamInstEnv, FamInstEnv)
    getFamEnvs
            ; (SimplEnv
    alt_env', CoreExpr
    scrut', OutId
    case_bndr') <- (FamInstEnv, FamInstEnv)
    -> SimplEnv
    -> CoreExpr
    -> OutId
    -> OutId
    -> [Alt OutId]
    -> SimplM (SimplEnv, CoreExpr, OutId)
    improveSeq (FamInstEnv, FamInstEnv)
    fam_envs SimplEnv
    env2 CoreExpr
    scrut
                                                           OutId
    case_bndr OutId
    case_bndr2 [Alt OutId]
    alts

            ; ([AltCon]
    imposs_deflt_cons, [Alt OutId]
    in_alts) <- CoreExpr -> OutId -> [Alt OutId] -> SimplM ([AltCon], [Alt OutId])
    prepareAlts CoreExpr
    scrut' OutId
    case_bndr' [Alt OutId]
    alts
              -- NB: it's possible that the returned in_alts is empty: this is handled
              -- by the caller (rebuildCase) in the missingAlt function

            ; [Alt OutId]
    alts' <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SimplEnv
    -> Maybe CoreExpr
    -> [AltCon]
    -> OutId
    -> SimplCont
    -> Alt OutId
    -> SimplM (Alt OutId)
    simplAlt SimplEnv
    alt_env' (forall a. a -> Maybe a
    Just CoreExpr
    scrut') [AltCon]
    imposs_deflt_cons OutId
    case_bndr' SimplCont
    cont') [Alt OutId]
    in_alts
            ; -- pprTrace "simplAlts" (ppr case_bndr $$ ppr alts_ty $$ ppr alts_ty' $$ ppr alts $$ ppr cont') $

            ; let alts_ty' :: Kind
    alts_ty' = SimplCont -> Kind
    contResultType SimplCont
    cont'
            -- See Note [Avoiding space leaks in OutType]
            ; Kind -> ()
    seqType Kind
    alts_ty' seq :: forall a b. a -> b -> b
    `seq`
              DynFlags
    -> CoreExpr -> OutId -> Kind -> [Alt OutId] -> SimplM CoreExpr
    mkCase (SimplEnv -> DynFlags
    seDynFlags SimplEnv
    env0) CoreExpr
    scrut' OutId
    case_bndr' Kind
    alts_ty' [Alt OutId]
    alts' }

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

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

    ------------------------------------
    simplAlt :: SimplEnv
             -> Maybe OutExpr  -- The scrutinee
             -> [AltCon]       -- These constructors can't be present when
                               -- matching the DEFAULT alternative
             -> OutId          -- The case binder
             -> SimplCont
             -> InAlt
             -> SimplM OutAlt

    simplAlt :: SimplEnv
    -> Maybe CoreExpr
    -> [AltCon]
    -> OutId
    -> SimplCont
    -> Alt OutId
    -> SimplM (Alt OutId)
    simplAlt SimplEnv
    env Maybe CoreExpr
    _ ![AltCon]
    imposs_deflt_cons OutId
    case_bndr' SimplCont
    cont' (Alt AltCon
    DEFAULT [OutId]
    bndrs CoreExpr
    rhs)
      = ASSERT( null bndrs )
        do  { let env' :: SimplEnv
    env' = SimplEnv -> OutId -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env OutId
    case_bndr'
                                            ([AltCon] -> Unfolding
    mkOtherCon [AltCon]
    imposs_deflt_cons)
                    -- Record the constructors that the case-binder *can't* be.
            ; CoreExpr
    rhs' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env' CoreExpr
    rhs SimplCont
    cont'
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] CoreExpr
    rhs') }

    simplAlt SimplEnv
    env Maybe CoreExpr
    scrut' [AltCon]
    _ OutId
    case_bndr' SimplCont
    cont' (Alt (LitAlt Literal
    lit) [OutId]
    bndrs CoreExpr
    rhs)
      = ASSERT( null bndrs )
        do  { SimplEnv
    env' <- SimplEnv -> Maybe CoreExpr -> OutId -> CoreExpr -> SimplM SimplEnv
    addAltUnfoldings SimplEnv
    env Maybe CoreExpr
    scrut' OutId
    case_bndr' (forall b. Literal -> Expr b
    Lit Literal
    lit)
            ; CoreExpr
    rhs' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env' CoreExpr
    rhs SimplCont
    cont'
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (Literal -> AltCon
    LitAlt Literal
    lit) [] CoreExpr
    rhs') }

    simplAlt SimplEnv
    env Maybe CoreExpr
    scrut' [AltCon]
    _ OutId
    case_bndr' SimplCont
    cont' (Alt (DataAlt DataCon
    con) [OutId]
    vs CoreExpr
    rhs)
      = do  { -- See Note [Adding evaluatedness info to pattern-bound variables]
              let vs_with_evals :: [OutId]
    vs_with_evals = Maybe CoreExpr -> DataCon -> [OutId] -> [OutId]
    addEvals Maybe CoreExpr
    scrut' DataCon
    con [OutId]
    vs
            ; (SimplEnv
    env', [OutId]
    vs') <- SimplEnv -> [OutId] -> SimplM (SimplEnv, [OutId])
    simplLamBndrs SimplEnv
    env [OutId]
    vs_with_evals

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

            ; SimplEnv
    env'' <- SimplEnv -> Maybe CoreExpr -> OutId -> CoreExpr -> SimplM SimplEnv
    addAltUnfoldings SimplEnv
    env' Maybe CoreExpr
    scrut' OutId
    case_bndr' CoreExpr
    con_app
            -- Forced so that simplExprC forces wrapFloats which means we don't
            -- retain the InScopeSet in SimplFloats
            ; !CoreExpr
    rhs' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    env'' CoreExpr
    rhs SimplCont
    cont'
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt DataCon
    con) [OutId]
    vs' CoreExpr
    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.Core.Opt.ConstantFold.  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.
    -}

    addEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id]
    -- See Note [Adding evaluatedness info to pattern-bound variables]
    addEvals :: Maybe CoreExpr -> DataCon -> [OutId] -> [OutId]
    addEvals Maybe CoreExpr
    scrut DataCon
    con [OutId]
    vs
      -- Deal with seq# applications
      | Just CoreExpr
    scr <- Maybe CoreExpr
    scrut
      , DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    con
      , [OutId
    s,OutId
    x] <- [OutId]
    vs
        -- Use stripNArgs rather than collectArgsTicks to avoid building
        -- a list of arguments only to throw it away immediately.
      , Just (Var OutId
    f) <- forall a. Word -> Expr a -> Maybe (Expr a)
    stripNArgs Word
    4 CoreExpr
    scr
      , Just PrimOp
    SeqOp <- OutId -> Maybe PrimOp
    isPrimOpId_maybe OutId
    f
      , let x' :: OutId
    x' = StrictnessMark -> OutId -> OutId
    zapIdOccInfoAndSetEvald StrictnessMark
    MarkedStrict OutId
    x
      = [OutId
    s, OutId
    x']

      -- Deal with banged datacon fields
    addEvals Maybe CoreExpr
    _scrut DataCon
    con [OutId]
    vs = [OutId] -> [StrictnessMark] -> [OutId]
    go [OutId]
    vs [StrictnessMark]
    the_strs
        where
          the_strs :: [StrictnessMark]
    the_strs = DataCon -> [StrictnessMark]
    dataConRepStrictness DataCon
    con

          go :: [OutId] -> [StrictnessMark] -> [OutId]
    go [] [] = []
          go (OutId
    v:[OutId]
    vs') [StrictnessMark]
    strs | OutId -> Bool
    isTyVar OutId
    v = OutId
    v forall a. a -> [a] -> [a]
    : [OutId] -> [StrictnessMark] -> [OutId]
    go [OutId]
    vs' [StrictnessMark]
    strs
          go (OutId
    v:[OutId]
    vs') (StrictnessMark
    str:[StrictnessMark]
    strs) = StrictnessMark -> OutId -> OutId
    zapIdOccInfoAndSetEvald StrictnessMark
    str OutId
    v forall a. a -> [a] -> [a]
    : [OutId] -> [StrictnessMark] -> [OutId]
    go [OutId]
    vs' [StrictnessMark]
    strs
          go [OutId]
    _ [StrictnessMark]
    _ = forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Simplify.addEvals"
                    (forall a. Outputable a => a -> SDoc
    ppr DataCon
    con SDoc -> SDoc -> SDoc
    $$
                     forall a. Outputable a => a -> SDoc
    ppr [OutId]
    vs  SDoc -> SDoc -> SDoc
    $$
                     forall {t :: * -> *} {a}.
    (Outputable (t a), Foldable t) =>
    t a -> SDoc
    ppr_with_length (forall a b. (a -> b) -> [a] -> [b]
    map StrictnessMark -> SDoc
    strdisp [StrictnessMark]
    the_strs) SDoc -> SDoc -> 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 {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
                = forall a. Outputable a => a -> SDoc
    ppr t a
    list SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens ([Char] -> SDoc
    text [Char]
    "length =" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    list))
              strdisp :: StrictnessMark -> SDoc
    strdisp StrictnessMark
    MarkedStrict = [Char] -> SDoc
    text [Char]
    "MarkedStrict"
              strdisp StrictnessMark
    NotMarkedStrict = [Char] -> SDoc
    text [Char]
    "NotMarkedStrict"

    zapIdOccInfoAndSetEvald :: StrictnessMark -> Id -> Id
    zapIdOccInfoAndSetEvald :: StrictnessMark -> OutId -> OutId
    zapIdOccInfoAndSetEvald StrictnessMark
    str OutId
    v =
      StrictnessMark -> OutId -> OutId
    setCaseBndrEvald StrictnessMark
    str forall a b. (a -> b) -> a -> b
    $ -- Add eval'dness info
      OutId -> OutId
    zapIdOccInfo OutId
    v         -- And kill occ info;
                             -- see Note [Case alternative occ info]

    addAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv
    addAltUnfoldings :: SimplEnv -> Maybe CoreExpr -> OutId -> CoreExpr -> SimplM SimplEnv
    addAltUnfoldings SimplEnv
    env Maybe CoreExpr
    scrut OutId
    case_bndr CoreExpr
    con_app
      = do { let con_app_unf :: Unfolding
    con_app_unf = CoreExpr -> Unfolding
    mk_simple_unf CoreExpr
    con_app
                 env1 :: SimplEnv
    env1 = SimplEnv -> OutId -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env OutId
    case_bndr Unfolding
    con_app_unf

                 -- See Note [Add unfolding for scrutinee]
                 env2 :: SimplEnv
    env2 | Kind
    Many <- OutId -> Kind
    idMult OutId
    case_bndr = case Maybe CoreExpr
    scrut of
                          Just (Var OutId
    v)           -> SimplEnv -> OutId -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env1 OutId
    v Unfolding
    con_app_unf
                          Just (Cast (Var OutId
    v) Coercion
    co) -> SimplEnv -> OutId -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env1 OutId
    v forall a b. (a -> b) -> a -> b
    $
                                                    CoreExpr -> Unfolding
    mk_simple_unf (forall b. Expr b -> Coercion -> Expr b
    Cast CoreExpr
    con_app (Coercion -> Coercion
    mkSymCo Coercion
    co))
                          Maybe CoreExpr
    _                      -> SimplEnv
    env1
                      | Bool
    otherwise = SimplEnv
    env1

           ; [Char] -> SDoc -> SimplM ()
    traceSmpl [Char]
    "addAltUnf" ([SDoc] -> SDoc
    vcat [forall a. Outputable a => a -> SDoc
    ppr OutId
    case_bndr SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Maybe CoreExpr
    scrut, forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    con_app])
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return SimplEnv
    env2 }
      where
        -- 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 -> OutId -> Unfolding -> SimplEnv
    addBinderUnfolding SimplEnv
    env OutId
    bndr Unfolding
    unf
      | Bool
    debugIsOn, Just CoreExpr
    tmpl <- Unfolding -> Maybe CoreExpr
    maybeUnfoldingTemplate Unfolding
    unf
      = WARN( not (eqType (idType bndr) (exprType tmpl)),
              ppr bndr $$ ppr (idType bndr) $$ ppr tmpl $$ ppr (exprType tmpl) )
        SimplEnv -> OutId -> SimplEnv
    modifyInScope SimplEnv
    env (OutId
    bndr OutId -> Unfolding -> OutId
    `setIdUnfolding` Unfolding
    unf)

      | Bool
    otherwise
      = SimplEnv -> OutId -> SimplEnv
    modifyInScope SimplEnv
    env (OutId
    bndr OutId -> Unfolding -> OutId
    `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 -> OutId -> OutId
    zapBndrOccInfo Bool
    keep_occ_info OutId
    pat_id
      | Bool
    keep_occ_info = OutId
    pat_id
      | Bool
    otherwise     = OutId -> OutId
    zapIdOccInfo OutId
    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/app invariant.  Example
        case e of b { DEFAULT -> let v = reallyUnsafePtrEq# b y in ....
                    ; K       -> blah }

    The let/app invariant requires that y is evaluated in the call to
    reallyUnsafePtrEq#, 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.

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

    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, the same caveat as in
    Note [Suppressing binder-swaps on linear case] in OccurAnal apply.

    ************************************************************************
    *                                                                      *
    \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]
    -> OutId
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    knownCon SimplEnv
    env CoreExpr
    scrut [FloatBind]
    dc_floats DataCon
    dc [Kind]
    dc_ty_args [CoreExpr]
    dc_args OutId
    bndr [OutId]
    bs CoreExpr
    rhs SimplCont
    cont
      = do  { (SimplFloats
    floats1, SimplEnv
    env1)  <- SimplEnv -> [OutId] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args SimplEnv
    env [OutId]
    bs [CoreExpr]
    dc_args
            ; (SimplFloats
    floats2, SimplEnv
    env2)  <- SimplEnv -> SimplM (SimplFloats, SimplEnv)
    bind_case_bndr SimplEnv
    env1
            ; (SimplFloats
    floats3, CoreExpr
    expr') <- SimplEnv -> CoreExpr -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    simplExprF SimplEnv
    env2 CoreExpr
    rhs SimplCont
    cont
            ; case [FloatBind]
    dc_floats of
                [] ->
                  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]
    _ ->
                  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 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 :: OutId -> OutId
    zap_occ = Bool -> OutId -> OutId
    zapBndrOccInfo (OutId -> Bool
    isDeadBinder OutId
    bndr)    -- bndr is an InId

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

        bind_args SimplEnv
    env' (OutId
    b:[OutId]
    bs') (Type Kind
    ty : [CoreExpr]
    args)
          = ASSERT( isTyVar b )
            SimplEnv -> [OutId] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args (SimplEnv -> OutId -> Kind -> SimplEnv
    extendTvSubst SimplEnv
    env' OutId
    b Kind
    ty) [OutId]
    bs' [CoreExpr]
    args

        bind_args SimplEnv
    env' (OutId
    b:[OutId]
    bs') (Coercion Coercion
    co : [CoreExpr]
    args)
          = ASSERT( isCoVar b )
            SimplEnv -> [OutId] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args (SimplEnv -> OutId -> Coercion -> SimplEnv
    extendCvSubst SimplEnv
    env' OutId
    b Coercion
    co) [OutId]
    bs' [CoreExpr]
    args

        bind_args SimplEnv
    env' (OutId
    b:[OutId]
    bs') (CoreExpr
    arg : [CoreExpr]
    args)
          = ASSERT( isId b )
            do { let b' :: OutId
    b' = OutId -> OutId
    zap_occ OutId
    b
                 -- Note that the binder might be "dead", because it doesn't
                 -- occur in the RHS; and simplNonRecX may therefore discard
                 -- it via postInlineUnconditionally.
                 -- 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]
               ; (SimplFloats
    floats1, SimplEnv
    env2) <- SimplEnv -> OutId -> CoreExpr -> SimplM (SimplFloats, SimplEnv)
    simplNonRecX SimplEnv
    env' OutId
    b' CoreExpr
    arg  -- arg satisfies let/app invariant
               ; (SimplFloats
    floats2, SimplEnv
    env3)  <- SimplEnv -> [OutId] -> [CoreExpr] -> SimplM (SimplFloats, SimplEnv)
    bind_args SimplEnv
    env2 [OutId]
    bs' [CoreExpr]
    args
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats1 SimplFloats -> SimplFloats -> SimplFloats
    `addFloats` SimplFloats
    floats2, SimplEnv
    env3) }

        bind_args SimplEnv
    _ [OutId]
    _ [CoreExpr]
    _ =
          forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "bind_args" forall a b. (a -> b) -> a -> b
    $ forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr [OutId]
    bs SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    dc_args SDoc -> SDoc -> SDoc
    $$
                                 [Char] -> SDoc
    text [Char]
    "scrut:" SDoc -> SDoc -> 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
          | OutId -> Bool
    isDeadBinder OutId
    bndr   = forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplEnv
    env)
          | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    scrut = forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
                                         , SimplEnv -> OutId -> SimplSR -> SimplEnv
    extendIdSubst SimplEnv
    env OutId
    bndr (CoreExpr -> Maybe Int -> SimplSR
    DoneEx CoreExpr
    scrut forall a. Maybe a
    Nothing))
          | Bool
    otherwise           = do { [CoreExpr]
    dc_args <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SimplEnv -> OutId -> SimplM CoreExpr
    simplVar SimplEnv
    env) [OutId]
    bs
                                             -- dc_ty_args are already OutTypes,
                                             -- but bs are InBndrs
                                     ; let con_app :: CoreExpr
    con_app = forall b. OutId -> Expr b
    Var (DataCon -> OutId
    dataConWorkId DataCon
    dc)
                                                     forall b. Expr b -> [Kind] -> Expr b
    `mkTyApps` [Kind]
    dc_ty_args
                                                     forall b. Expr b -> [Expr b] -> Expr b
    `mkApps`   [CoreExpr]
    dc_args
                                     ; SimplEnv -> OutId -> CoreExpr -> SimplM (SimplFloats, SimplEnv)
    simplNonRecX SimplEnv
    env OutId
    bndr CoreExpr
    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
    -> OutId
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    missingAlt SimplEnv
    env OutId
    case_bndr [Alt OutId]
    _ SimplCont
    cont
      = WARN( True, text "missingAlt" <+> ppr case_bndr )
        -- See Note [Avoiding space leaks in OutType]
        let cont_ty :: Kind
    cont_ty = SimplCont -> Kind
    contResultType SimplCont
    cont
        in Kind -> ()
    seqType Kind
    cont_ty seq :: forall a b. a -> b -> b
    `seq`
           forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, Kind -> CoreExpr
    mkImpossibleExpr Kind
    cont_ty)

    {-
    ************************************************************************
    *                                                                      *
    \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 OutId]
    -> SimplCont
    -> SimplM (SimplFloats, SimplEnv, SimplCont)
    mkDupableCaseCont SimplEnv
    env [Alt OutId]
    alts SimplCont
    cont
      | [Alt OutId] -> Bool
    altsWouldDup [Alt OutId]
    alts = do { (SimplFloats
    floats, SimplCont
    cont) <- SimplEnv -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableCont SimplEnv
    env SimplCont
    cont
                               ; let env' :: SimplEnv
    env' = SimplEnv -> SimplEnv
    bumpCaseDepth forall a b. (a -> b) -> a -> b
    $
                                            SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    floats
                               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, SimplEnv
    env', SimplCont
    cont) }
      | Bool
    otherwise         = 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 OutId] -> Bool
    altsWouldDup []  = Bool
    False        -- See Note [Bottom alternatives]
    altsWouldDup [Alt OutId
    _] = Bool
    False
    altsWouldDup (Alt OutId
    alt:[Alt OutId]
    alts)
      | Alt OutId -> Bool
    is_bot_alt Alt OutId
    alt = [Alt OutId] -> Bool
    altsWouldDup [Alt OutId]
    alts
      | Bool
    otherwise      = Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Alt OutId -> Bool
    is_bot_alt [Alt OutId]
    alts)
        -- otherwise case: first alt is non-bot, so all the rest must be bot
      where
        is_bot_alt :: Alt OutId -> Bool
    is_bot_alt (Alt AltCon
    _ [OutId]
    _ 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 (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
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env, SimplCont
    cont)

    mkDupableContWithDmds SimplEnv
    _ [Demand]
    _ (Stop {}) = forall a. [Char] -> a
    panic [Char]
    "mkDupableCont"     -- Handled by previous eqn

    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds (CastIt Coercion
    ty SimplCont
    cont)
      = do  { (SimplFloats
    floats, SimplCont
    cont') <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds SimplCont
    cont
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, Coercion -> SimplCont -> SimplCont
    CastIt Coercion
    ty SimplCont
    cont') }

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

    mkDupableContWithDmds SimplEnv
    env [Demand]
    _
         (StrictBind { sc_bndr :: SimplCont -> OutId
    sc_bndr = OutId
    bndr, sc_bndrs :: SimplCont -> [OutId]
    sc_bndrs = [OutId]
    bndrs
                     , sc_body :: SimplCont -> CoreExpr
    sc_body = CoreExpr
    body, 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
           ; (SimplEnv
    sb_env1, OutId
    bndr')      <- SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder SimplEnv
    sb_env OutId
    bndr
           ; (SimplFloats
    floats1, CoreExpr
    join_inner) <- SimplEnv
    -> [OutId]
    -> CoreExpr
    -> SimplCont
    -> SimplM (SimplFloats, CoreExpr)
    simplLam SimplEnv
    sb_env1 [OutId]
    bndrs CoreExpr
    body SimplCont
    cont
              -- No need to use mkDupableCont before simplLam; we
              -- use cont once here, and then share the result if necessary

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

           ; SimplEnv
    -> OutId -> CoreExpr -> Kind -> SimplM (SimplFloats, SimplCont)
    mkDupableStrictBind SimplEnv
    env OutId
    bndr' CoreExpr
    join_body Kind
    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
      | forall a. Maybe a -> Bool
    isNothing (OutId -> Maybe DataCon
    isDataConId_maybe (ArgInfo -> OutId
    ai_fun ArgInfo
    fun))
      , SimplCont -> Bool
    thumbsUpPlanA SimplCont
    cont  -- See point (3) of Note [Duplicating join points]
      = -- Use Plan A of Note [Duplicating StrictArg]
        do { let (Demand
    _ : [Demand]
    dmds) = ArgInfo -> [Demand]
    ai_dmds ArgInfo
    fun
           ; (SimplFloats
    floats1, SimplCont
    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
           ; ([LetFloats]
    floats_s, [ArgSpec]
    args') <- forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM (SimplMode -> ArgSpec -> SimplM (LetFloats, ArgSpec)
    makeTrivialArg (SimplEnv -> SimplMode
    getMode SimplEnv
    env))
                                               (ArgInfo -> [ArgSpec]
    ai_args ArgInfo
    fun)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' SimplFloats -> LetFloats -> SimplFloats
    addLetFloats SimplFloats
    floats1 [LetFloats]
    floats_s
                    , StrictArg { sc_fun :: ArgInfo
    sc_fun = ArgInfo
    fun { ai_args :: [ArgSpec]
    ai_args = [ArgSpec]
    args' }
                                , sc_cont :: SimplCont
    sc_cont = SimplCont
    cont'
                                , sc_fun_ty :: Kind
    sc_fun_ty = Kind
    fun_ty
                                , sc_dup :: DupFlag
    sc_dup = DupFlag
    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
           ; OutId
    arg_bndr <- FastString -> Kind -> Kind -> SimplM OutId
    newId ([Char] -> FastString
    fsLit [Char]
    "arg") Kind
    m Kind
    arg_ty
           ; let env' :: SimplEnv
    env' = SimplEnv
    env SimplEnv -> [OutId] -> SimplEnv
    `addNewInScopeIds` [OutId
    arg_bndr]
           ; (SimplFloats
    floats, CoreExpr
    join_rhs) <- SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, CoreExpr)
    rebuildCall SimplEnv
    env' (ArgInfo -> CoreExpr -> Kind -> ArgInfo
    addValArgTo ArgInfo
    fun (forall b. OutId -> Expr b
    Var OutId
    arg_bndr) Kind
    fun_ty) SimplCont
    cont
           ; SimplEnv
    -> OutId -> CoreExpr -> Kind -> SimplM (SimplFloats, SimplCont)
    mkDupableStrictBind SimplEnv
    env' OutId
    arg_bndr (SimplFloats -> CoreExpr -> CoreExpr
    wrapFloats SimplFloats
    floats CoreExpr
    join_rhs) Kind
    rhs_ty }
      where
        thumbsUpPlanA :: SimplCont -> Bool
    thumbsUpPlanA (StrictArg {})               = Bool
    False
        thumbsUpPlanA (CastIt Coercion
    _ 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
        thumbsUpPlanA (Select {})                  = Bool
    True
        thumbsUpPlanA (StrictBind {})              = Bool
    True
        thumbsUpPlanA (Stop {})                    = Bool
    True

    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  { (SimplFloats
    floats, SimplCont
    cont') <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds SimplCont
    cont
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplFloats
    floats, ApplyToTy { sc_cont :: SimplCont
    sc_cont = SimplCont
    cont'
                                        , sc_arg_ty :: Kind
    sc_arg_ty = Kind
    arg_ty, sc_hole_ty :: Kind
    sc_hole_ty = Kind
    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]
    _) = [Demand]
    dmds   -- Never fails
            ; (SimplFloats
    floats1, SimplCont
    cont') <- SimplEnv
    -> [Demand] -> SimplCont -> SimplM (SimplFloats, SimplCont)
    mkDupableContWithDmds SimplEnv
    env [Demand]
    dmds SimplCont
    cont
            ; let env' :: SimplEnv
    env' = SimplEnv
    env SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    floats1
            ; (DupFlag
    _, SimplEnv
    se', CoreExpr
    arg') <- SimplEnv
    -> DupFlag
    -> SimplEnv
    -> CoreExpr
    -> SimplM (DupFlag, SimplEnv, CoreExpr)
    simplArg SimplEnv
    env' DupFlag
    dup SimplEnv
    se CoreExpr
    arg
            ; (LetFloats
    let_floats2, CoreExpr
    arg'') <- SimplMode
    -> TopLevelFlag
    -> Demand
    -> FastString
    -> CoreExpr
    -> SimplM (LetFloats, CoreExpr)
    makeTrivial (SimplEnv -> SimplMode
    getMode SimplEnv
    env) TopLevelFlag
    NotTopLevel Demand
    dmd ([Char] -> FastString
    fsLit [Char]
    "karg") CoreExpr
    arg'
            ; let all_floats :: SimplFloats
    all_floats = SimplFloats
    floats1 SimplFloats -> LetFloats -> SimplFloats
    `addLetFloats` LetFloats
    let_floats2
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( SimplFloats
    all_floats
                     , ApplyToVal { sc_arg :: CoreExpr
    sc_arg = CoreExpr
    arg''
                                  , sc_env :: SimplEnv
    sc_env = SimplEnv
    se' SimplEnv -> SimplFloats -> SimplEnv
    `setInScopeFromF` SimplFloats
    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 :: DupFlag
    sc_dup = DupFlag
    OkToDup, sc_cont :: SimplCont
    sc_cont = SimplCont
    cont'
                                  , sc_hole_ty :: Kind
    sc_hole_ty = Kind
    hole_ty }) }

    mkDupableContWithDmds SimplEnv
    env [Demand]
    _
        (Select { sc_bndr :: SimplCont -> OutId
    sc_bndr = OutId
    case_bndr, sc_alts :: SimplCont -> [Alt OutId]
    sc_alts = [Alt OutId]
    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 (OutId -> Tick
    CaseOfCase OutId
    case_bndr)
            ; (SimplFloats
    floats, SimplEnv
    alt_env, SimplCont
    alt_cont) <- SimplEnv
    -> [Alt OutId]
    -> SimplCont
    -> SimplM (SimplFloats, SimplEnv, SimplCont)
    mkDupableCaseCont (SimplEnv
    se SimplEnv -> SimplEnv -> SimplEnv
    `setInScopeFromE` SimplEnv
    env) [Alt OutId]
    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 :: Kind
    cont_scaling = SimplCont -> Kind
    contHoleScaling SimplCont
    cont
              -- See Note [Scaling in case-of-case]
            ; (SimplEnv
    alt_env', OutId
    case_bndr') <- SimplEnv -> OutId -> SimplM (SimplEnv, OutId)
    simplBinder SimplEnv
    alt_env (Kind -> OutId -> OutId
    scaleIdBy Kind
    cont_scaling OutId
    case_bndr)
            ; [Alt OutId]
    alts' <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SimplEnv
    -> Maybe CoreExpr
    -> [AltCon]
    -> OutId
    -> SimplCont
    -> Alt OutId
    -> SimplM (Alt OutId)
    simplAlt SimplEnv
    alt_env' forall a. Maybe a
    Nothing [] OutId
    case_bndr' SimplCont
    alt_cont) (Kind -> [Alt OutId] -> [Alt OutId]
    scaleAltsBy Kind
    cont_scaling [Alt OutId]
    alts)
            -- 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

            ; (JoinFloats
    join_floats, [Alt OutId]
    alts'') <- forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM (Platform
    -> OutId
    -> JoinFloats
    -> Alt OutId
    -> SimplM (JoinFloats, Alt OutId)
    mkDupableAlt (DynFlags -> Platform
    targetPlatform (SimplEnv -> DynFlags
    seDynFlags SimplEnv
    env)) OutId
    case_bndr')
                                                  JoinFloats
    emptyJoinFloats [Alt OutId]
    alts'

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

    mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType
                        -> SimplM (SimplFloats, SimplCont)
    mkDupableStrictBind :: SimplEnv
    -> OutId -> CoreExpr -> Kind -> SimplM (SimplFloats, SimplCont)
    mkDupableStrictBind SimplEnv
    env OutId
    arg_bndr CoreExpr
    join_rhs Kind
    res_ty
      | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    join_rhs   -- See point (2) of Note [Duplicating join points]
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env
               , StrictBind { sc_bndr :: OutId
    sc_bndr = OutId
    arg_bndr, sc_bndrs :: [OutId]
    sc_bndrs = []
                            , sc_body :: CoreExpr
    sc_body = CoreExpr
    join_rhs
                            , sc_env :: SimplEnv
    sc_env  = SimplEnv -> SimplEnv
    zapSubstEnv SimplEnv
    env
                              -- 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 { OutId
    join_bndr <- [OutId] -> Kind -> SimplM OutId
    newJoinId [OutId
    arg_bndr] Kind
    res_ty
           ; let arg_info :: ArgInfo
    arg_info = ArgInfo { ai_fun :: OutId
    ai_fun   = OutId
    join_bndr
                                    , ai_rules :: FunRules
    ai_rules = forall a. Maybe a
    Nothing, ai_args :: [ArgSpec]
    ai_args  = []
                                    , ai_encl :: Bool
    ai_encl  = Bool
    False, ai_dmds :: [Demand]
    ai_dmds  = forall a. a -> [a]
    repeat Demand
    topDmd
                                    , ai_discs :: [Int]
    ai_discs = forall a. a -> [a]
    repeat Int
    0 }
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( SimplFloats -> JoinFloats -> SimplFloats
    addJoinFloats (SimplEnv -> SimplFloats
    emptyFloats SimplEnv
    env) forall a b. (a -> b) -> a -> b
    $
                      InBind -> JoinFloats
    unitJoinFloat                   forall a b. (a -> b) -> a -> b
    $
                      forall b. b -> Expr b -> Bind b
    NonRec OutId
    join_bndr                forall a b. (a -> b) -> a -> b
    $
                      forall b. b -> Expr b -> Expr b
    Lam (OutId -> OutId
    setOneShotLambda OutId
    arg_bndr) CoreExpr
    join_rhs
                    , StrictArg { sc_dup :: DupFlag
    sc_dup    = DupFlag
    OkToDup
                                , sc_fun :: ArgInfo
    sc_fun    = ArgInfo
    arg_info
                                , sc_fun_ty :: Kind
    sc_fun_ty = OutId -> Kind
    idType OutId
    join_bndr
                                , sc_cont :: SimplCont
    sc_cont   = Kind -> SimplCont
    mkBoringStop Kind
    res_ty
                                } ) }

    mkDupableAlt :: Platform -> OutId
                 -> JoinFloats -> OutAlt
                 -> SimplM (JoinFloats, OutAlt)
    mkDupableAlt :: Platform
    -> OutId
    -> JoinFloats
    -> Alt OutId
    -> SimplM (JoinFloats, Alt OutId)
    mkDupableAlt Platform
    _platform OutId
    case_bndr JoinFloats
    jfloats (Alt AltCon
    con [OutId]
    bndrs' CoreExpr
    rhs')
      | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    rhs'   -- See point (2) of Note [Duplicating join points]
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (JoinFloats
    jfloats, forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [OutId]
    bndrs' CoreExpr
    rhs')

      | Bool
    otherwise
      = do  { SimpleOpts
    simpl_opts <- DynFlags -> SimpleOpts
    initSimpleOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            ; let rhs_ty' :: Kind
    rhs_ty'  = CoreExpr -> Kind
    exprType CoreExpr
    rhs'
                  scrut_ty :: Kind
    scrut_ty = OutId -> Kind
    idType OutId
    case_bndr
                  case_bndr_w_unf :: OutId
    case_bndr_w_unf
                    = case AltCon
    con of
                          AltCon
    DEFAULT    -> OutId
    case_bndr
                          DataAlt DataCon
    dc -> OutId -> Unfolding -> OutId
    setIdUnfolding OutId
    case_bndr Unfolding
    unf
                              where
                                     -- See Note [Case binders and join points]
                                 unf :: Unfolding
    unf = SimpleOpts -> CoreExpr -> Unfolding
    mkInlineUnfolding SimpleOpts
    simpl_opts CoreExpr
    rhs
                                 rhs :: CoreExpr
    rhs = forall b. DataCon -> [Kind] -> [OutId] -> Expr b
    mkConApp2 DataCon
    dc (Kind -> [Kind]
    tyConAppArgs Kind
    scrut_ty) [OutId]
    bndrs'

                          LitAlt {} -> WARN( True, text "mkDupableAlt"
                                                    <+> ppr case_bndr <+> ppr con )
                                       OutId
    case_bndr
                               -- The case binder is alive but trivial, so why has
                               -- it not been substituted away?

                  final_bndrs' :: [OutId]
    final_bndrs'
                    | OutId -> Bool
    isDeadBinder OutId
    case_bndr = forall a. (a -> Bool) -> [a] -> [a]
    filter OutId -> Bool
    abstract_over [OutId]
    bndrs'
                    | Bool
    otherwise              = [OutId]
    bndrs' forall a. [a] -> [a] -> [a]
    ++ [OutId
    case_bndr_w_unf]

                  abstract_over :: OutId -> Bool
    abstract_over OutId
    bndr
                      | OutId -> Bool
    isTyVar OutId
    bndr = Bool
    True -- Abstract over all type variables just in case
                      | Bool
    otherwise    = Bool -> Bool
    not (OutId -> Bool
    isDeadBinder OutId
    bndr)
                            -- The deadness info on the new Ids is preserved by simplBinders
                  final_args :: [CoreExpr]
    final_args = forall b. [OutId] -> [Expr b]
    varsToCoreExprs [OutId]
    final_bndrs'
                               -- 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
                  really_final_bndrs :: [OutId]
    really_final_bndrs     = forall a b. (a -> b) -> [a] -> [b]
    map OutId -> OutId
    one_shot [OutId]
    final_bndrs'
                  one_shot :: OutId -> OutId
    one_shot OutId
    v | OutId -> Bool
    isId OutId
    v    = OutId -> OutId
    setOneShotLambda OutId
    v
                             | Bool
    otherwise = OutId
    v
                  join_rhs :: CoreExpr
    join_rhs   = forall b. [b] -> Expr b -> Expr b
    mkLams [OutId]
    really_final_bndrs CoreExpr
    rhs'

            ; OutId
    join_bndr <- [OutId] -> Kind -> SimplM OutId
    newJoinId [OutId]
    final_bndrs' Kind
    rhs_ty'

            ; let join_call :: CoreExpr
    join_call = forall b. Expr b -> [Expr b] -> Expr b
    mkApps (forall b. OutId -> Expr b
    Var OutId
    join_bndr) [CoreExpr]
    final_args
                  alt' :: Alt OutId
    alt'      = forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [OutId]
    bndrs' CoreExpr
    join_call

            ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( JoinFloats
    jfloats JoinFloats -> JoinFloats -> JoinFloats
    `addJoinFlts` InBind -> JoinFloats
    unitJoinFloat (forall b. b -> Expr b -> Bind b
    NonRec OutId
    join_bndr CoreExpr
    join_rhs)
                     , Alt OutId
    alt') }
                    -- See Note [Duplicated env]

    {-
    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 x y).  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.

    To achieve this:

    1. Do not postInlineUnconditionally a join point, until the Final
       phase.  (The Final phase is still quite early, so we might consider
       delaying still more.)

    2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for
       all alternatives, except for exprIsTrival RHSs. Previously we used
       exprIsDupable.  This generates a lot more join points, but makes
       them much more case-of-case friendly.

       It is definitely worth checking for exprIsTrivial, otherwise we get
       an extra Simplifier iteration, because it is inlined in the next
       round.

    3. 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.  That same Note explains why we
       want Plan A when the RHS of the new join point would be a
       non-data-constructor application

    4. You might worry that $j will be inlined by the call-site inliner,
       but it won't because the call-site context for a join is usually
       extremely boring (the arguments come from the pattern match).
       And if not, then perhaps inlining it would be a good idea.

       You might also wonder if we get UnfWhen, because the RHS of the
       join point is no bigger than the call. But in the cases we care
       about it will be a little bigger, because of that free `f` in
           $j x = K f x
       So for now we don't do anything special in callSiteInline

    There is a bit of tension between (2) and (3).  Do we want to retain
    the join point only when the RHS is
    * a constructor application? or
    * just non-trivial?
    Currently, a bit ad-hoc, but we definitely want to retain the join
    point for data constructors in mkDupalbleALt (point 2); that is the
    whole point of #19996 described above.

    Note [Case binders and join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    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. 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.

    Here is another example.
            && E (case x of { T -> F; F -> T })

    Pushing the call inward (being careful not to duplicate E)
            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.

    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-> TopLevelFlag
                      -> MaybeJoinCont
                      -> InId
                      -> OutExpr -> OutType -> ArityType
                      -> Unfolding -> SimplM Unfolding
    simplLetUnfolding :: SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> CoreExpr
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplLetUnfolding SimplEnv
    env TopLevelFlag
    top_lvl MaybeJoinCont
    cont_mb OutId
    id CoreExpr
    new_rhs Kind
    rhs_ty ArityType
    arity Unfolding
    unf
      | Unfolding -> Bool
    isStableUnfolding Unfolding
    unf
      = SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplStableUnfolding SimplEnv
    env TopLevelFlag
    top_lvl MaybeJoinCont
    cont_mb OutId
    id Kind
    rhs_ty ArityType
    arity Unfolding
    unf
      | OutId -> Bool
    isExitJoinId OutId
    id
      = forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify
      | Bool
    otherwise
      = -- Otherwise, we end up retaining all the SimpleEnv
        let !opts :: UnfoldingOpts
    opts = SimplEnv -> UnfoldingOpts
    seUnfoldingOpts SimplEnv
    env
        in UnfoldingOpts
    -> TopLevelFlag
    -> UnfoldingSource
    -> OutId
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding UnfoldingOpts
    opts TopLevelFlag
    top_lvl UnfoldingSource
    InlineRhs OutId
    id CoreExpr
    new_rhs

    -------------------
    mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource
                   -> InId -> OutExpr -> SimplM Unfolding
    mkLetUnfolding :: UnfoldingOpts
    -> TopLevelFlag
    -> UnfoldingSource
    -> OutId
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding !UnfoldingOpts
    uf_opts TopLevelFlag
    top_lvl UnfoldingSource
    src OutId
    id CoreExpr
    new_rhs
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (UnfoldingOpts
    -> UnfoldingSource -> Bool -> Bool -> CoreExpr -> Unfolding
    mkUnfolding UnfoldingOpts
    uf_opts UnfoldingSource
    src Bool
    is_top_lvl Bool
    is_bottoming CoreExpr
    new_rhs)
                -- 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
        -- 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 = OutId -> Bool
    isDeadEndId OutId
    id

    -------------------
    simplStableUnfolding :: SimplEnv -> TopLevelFlag
                         -> MaybeJoinCont  -- Just k => a join point with continuation k
                         -> InId
                         -> OutType
                         -> ArityType      -- Used to eta expand, but only for non-join-points
                         -> Unfolding
                         ->SimplM Unfolding
    -- Note [Setting the new unfolding]
    simplStableUnfolding :: SimplEnv
    -> TopLevelFlag
    -> MaybeJoinCont
    -> OutId
    -> Kind
    -> ArityType
    -> Unfolding
    -> SimplM Unfolding
    simplStableUnfolding SimplEnv
    env TopLevelFlag
    top_lvl MaybeJoinCont
    mb_cont OutId
    id Kind
    rhs_ty ArityType
    id_arity Unfolding
    unf
      = case Unfolding
    unf of
          Unfolding
    NoUnfolding   -> forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    unf
          Unfolding
    BootUnfolding -> forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    unf
          OtherCon {}   -> forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    unf

          DFunUnfolding { df_bndrs :: Unfolding -> [OutId]
    df_bndrs = [OutId]
    bndrs, df_con :: Unfolding -> DataCon
    df_con = DataCon
    con, df_args :: Unfolding -> [CoreExpr]
    df_args = [CoreExpr]
    args }
            -> do { (SimplEnv
    env', [OutId]
    bndrs') <- SimplEnv -> [OutId] -> SimplM (SimplEnv, [OutId])
    simplBinders SimplEnv
    unf_env [OutId]
    bndrs
                  ; [CoreExpr]
    args' <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SimplEnv -> CoreExpr -> SimplM CoreExpr
    simplExpr SimplEnv
    env') [CoreExpr]
    args
                  ; forall (m :: * -> *) a. Monad m => a -> m a
    return ([OutId] -> DataCon -> [CoreExpr] -> Unfolding
    mkDFunUnfolding [OutId]
    bndrs' DataCon
    con [CoreExpr]
    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 { CoreExpr
    expr' <- case MaybeJoinCont
    mb_cont of
                               Just SimplCont
    cont -> -- Binder is a join point
                                            -- See Note [Rules and unfolding for join points]
                                            SimplEnv -> OutId -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplJoinRhs SimplEnv
    unf_env OutId
    id CoreExpr
    expr SimplCont
    cont
                               MaybeJoinCont
    Nothing   -> -- Binder is not a join point
                                            do { CoreExpr
    expr' <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    unf_env CoreExpr
    expr (Kind -> SimplCont
    mkBoringStop Kind
    rhs_ty)
                                               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> CoreExpr
    eta_expand CoreExpr
    expr') }
                  ; case UnfoldingGuidance
    guide of
                      UnfWhen { ug_arity :: UnfoldingGuidance -> Int
    ug_arity = Int
    arity
                              , ug_unsat_ok :: UnfoldingGuidance -> Bool
    ug_unsat_ok = Bool
    sat_ok
                              , ug_boring_ok :: UnfoldingGuidance -> Bool
    ug_boring_ok = Bool
    boring_ok
                              }
                              -- Happens for INLINE things
                            -- Really important to force new_boring_ok as 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' =
                                  UnfWhen { ug_arity :: Int
    ug_arity = Int
    arity
                                          , ug_unsat_ok :: Bool
    ug_unsat_ok = Bool
    sat_ok
                                          , ug_boring_ok :: Bool
    ug_boring_ok = Bool
    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 forall (m :: * -> *) a. Monad m => a -> m a
    return (UnfoldingSource
    -> Bool -> CoreExpr -> UnfoldingGuidance -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src Bool
    is_top_lvl CoreExpr
    expr' UnfoldingGuidance
    guide')
                                -- See Note [Top-level flag on inline rules] in GHC.Core.Unfold

                      UnfoldingGuidance
    _other              -- Happens for INLINABLE things
                         -> UnfoldingOpts
    -> TopLevelFlag
    -> UnfoldingSource
    -> OutId
    -> CoreExpr
    -> SimplM Unfolding
    mkLetUnfolding UnfoldingOpts
    uf_opts TopLevelFlag
    top_lvl UnfoldingSource
    src OutId
    id 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 -> forall (m :: * -> *) a. Monad m => a -> m a
    return Unfolding
    noUnfolding   -- Discard unstable unfoldings
      where
        uf_opts :: UnfoldingOpts
    uf_opts    = SimplEnv -> UnfoldingOpts
    seUnfoldingOpts SimplEnv
    env
        -- 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.
        !is_top_lvl :: Bool
    is_top_lvl = TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_lvl
        act :: Activation
    act        = OutId -> Activation
    idInlineActivation OutId
    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]
        eta_expand :: CoreExpr -> CoreExpr
    eta_expand CoreExpr
    expr
          | Bool -> Bool
    not Bool
    eta_on         = CoreExpr
    expr
          | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    expr = CoreExpr
    expr
          | Bool
    otherwise          = ArityType -> CoreExpr -> CoreExpr
    etaExpandAT ArityType
    id_arity CoreExpr
    expr
        eta_on :: Bool
    eta_on = SimplMode -> Bool
    sm_eta_expand (SimplEnv -> SimplMode
    getMode SimplEnv
    env)

    {- 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 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 [Do not eta-expand trivial expressions]
      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 (mb_cont = Just _) 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
                 -> MaybeJoinCont   -- Just k for a join point binder
                                    -- Nothing otherwise
                 -> SimplM (SimplEnv, OutBndr)
    -- Rules are added back into the bin
    addBndrRules :: SimplEnv
    -> OutId -> OutId -> MaybeJoinCont -> SimplM (SimplEnv, OutId)
    addBndrRules SimplEnv
    env OutId
    in_id OutId
    out_id MaybeJoinCont
    mb_cont
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    old_rules
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv
    env, OutId
    out_id)
      | Bool
    otherwise
      = do { [CoreRule]
    new_rules <- SimplEnv
    -> Maybe OutId -> [CoreRule] -> MaybeJoinCont -> SimplM [CoreRule]
    simplRules SimplEnv
    env (forall a. a -> Maybe a
    Just OutId
    out_id) [CoreRule]
    old_rules MaybeJoinCont
    mb_cont
           ; let final_id :: OutId
    final_id  = OutId
    out_id OutId -> RuleInfo -> OutId
    `setIdSpecialisation` [CoreRule] -> RuleInfo
    mkRuleInfo [CoreRule]
    new_rules
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplEnv -> OutId -> SimplEnv
    modifyInScope SimplEnv
    env OutId
    final_id, OutId
    final_id) }
      where
        old_rules :: [CoreRule]
    old_rules = RuleInfo -> [CoreRule]
    ruleInfoRules (OutId -> RuleInfo
    idSpecialisation OutId
    in_id)

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

        simpl_rule rule :: CoreRule
    rule@(Rule { ru_bndrs :: CoreRule -> [OutId]
    ru_bndrs = [OutId]
    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 { (SimplEnv
    env', [OutId]
    bndrs') <- SimplEnv -> [OutId] -> SimplM (SimplEnv, [OutId])
    simplBinders SimplEnv
    env [OutId]
    bndrs
               ; let rhs_ty :: Kind
    rhs_ty = SimplEnv -> Kind -> Kind
    substTy SimplEnv
    env' (CoreExpr -> Kind
    exprType CoreExpr
    rhs)
                     rhs_cont :: SimplCont
    rhs_cont = case MaybeJoinCont
    mb_cont of  -- See Note [Rules and unfolding for join points]
                                    MaybeJoinCont
    Nothing   -> Kind -> SimplCont
    mkBoringStop Kind
    rhs_ty
                                    Just SimplCont
    cont -> ASSERT2( join_ok, bad_join_msg )
                                                 SimplCont
    cont
                     lhs_env :: SimplEnv
    lhs_env = (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv
    updMode SimplMode -> SimplMode
    updModeForRules SimplEnv
    env'
                     rhs_env :: SimplEnv
    rhs_env = (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv
    updMode (Activation -> SimplMode -> SimplMode
    updModeForStableUnfoldings Activation
    act) SimplEnv
    env'
                               -- See Note [Simplifying the RHS of a RULE]
                     fn_name' :: Name
    fn_name' = case Maybe OutId
    mb_new_id of
                                  Just OutId
    id -> OutId -> Name
    idName OutId
    id
                                  Maybe OutId
    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 :: Bool
    join_ok = case Maybe OutId
    mb_new_id of
                                 Just OutId
    id | Just Int
    join_arity <- OutId -> Maybe Int
    isJoinId_maybe OutId
    id
                                         -> forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    args forall a. Eq a => a -> a -> Bool
    == Int
    join_arity
                                 Maybe OutId
    _ -> Bool
    False
                     bad_join_msg :: SDoc
    bad_join_msg = [SDoc] -> SDoc
    vcat [ forall a. Outputable a => a -> SDoc
    ppr Maybe OutId
    mb_new_id, forall a. Outputable a => a -> SDoc
    ppr CoreRule
    rule
                                         , forall a. Outputable a => a -> SDoc
    ppr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap OutId -> Maybe Int
    isJoinId_maybe Maybe OutId
    mb_new_id) ]

               ; [CoreExpr]
    args' <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SimplEnv -> CoreExpr -> SimplM CoreExpr
    simplExpr SimplEnv
    lhs_env) [CoreExpr]
    args
               ; CoreExpr
    rhs'  <- SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
    simplExprC SimplEnv
    rhs_env CoreExpr
    rhs SimplCont
    rhs_cont
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreRule
    rule { ru_bndrs :: [OutId]
    ru_bndrs = [OutId]
    bndrs'
                              , ru_fn :: Name
    ru_fn    = Name
    fn_name'
                              , ru_args :: [CoreExpr]
    ru_args  = [CoreExpr]
    args'
                              , ru_rhs :: CoreExpr
    ru_rhs   = CoreExpr
    rhs' }) }

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