Expressions

        body ::= app

              |  case body of pat -> body

              |  body |> co

 Note [Cloning in CorePrep]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~

 type CpeArg  = CoreExpr    -- Non-terminal 'arg'

 type CpeApp  = CoreExpr    -- Non-terminal 'app'

 type CpeBody = CoreExpr    -- Non-terminal 'body'

 {-

 ************************************************************************

     withTiming logger (text "CorePrep [expr]") (\e -> e `seq` ()) $ do

       us <- mkSplitUniqSupply StgTag

       let initialCorePrepEnv = mkInitialCorePrepEnv config

       putDumpFileMaybe logger Opt_D_dump_prep "CorePrep" FormatCore (ppr new_expr)

       return new_expr

 ---------------

 cpePair :: TopLevelFlag -> RecFlag -> Demand -> Levity

         -> CorePrepEnv -> OutId -> CoreExpr

 -- Used for all bindings

 -- The binder is already cloned, hence an OutId

 cpePair top_lvl is_rec dmd lev env0 bndr rhs

        -- See if we are allowed to float this stuff out of the RHS

        ; let dec = want_float_from_rhs floats1 rhs1

        -- Make the arity match up

        ; (floats3, rhs3)

 ---------------

 cpeJoinPair :: CorePrepEnv -> JoinId -> CoreExpr

 -- Used for all join bindings

 -- No eta-expansion: see Note [Do not eta-expand join points] in GHC.Core.Opt.Simplify.Utils

 cpeJoinPair env bndr rhs

        ; (env', bndrs') <- cpCloneBndrs env bndrs

                                       -- with a lambda

        ; let rhs'  = mkCoreLams bndrs' body'

 -}

 -- ---------------------------------------------------------------------------

 -- ---------------------------------------------------------------------------

 -- If

 --      e  ===>  (bs, e')

 -- then

          -- See [Floating Ticks in CorePrep]

        ; return (FloatTick tickish `consFloat` floats, body) }

   | otherwise

        ; return (emptyFloats, mkTick tickish' body) }

   where

     tickish' | Breakpoint ext bid fvs <- tickish

 cpeRhsE env expr@(Lam {})

    = do { let (bndrs,body) = collectBinders expr

         ; (env', bndrs') <- cpCloneBndrs env bndrs

         ; return (emptyFloats, mkLams bndrs' body') }

 cpeRhsE env (Case scrut bndr _ alts@[Alt con [covar] _])

   -- Note that `x` is a value here. This is visible in the GHCi debugger tests

   -- (such as `print003`).

   | Just rhs <- isUnsafeEqualityCase scrut bndr alts

        ; (env, bndr')  <- cpCloneBndr env bndr

        ; (env, covar') <- cpCloneCoVarBndr env covar

          -- Up until here this should do exactly the same as the regular code

          -- path of `cpeRhsE Case{}`.

          -- ... but we want to float `floats_rhs` as in (U3) so that rhs' might

          -- become a value

        ; let case_float = UnsafeEqualityCase scrut bndr' con [covar']

   = cpeRhsE (extendCorePrepEnv env token_out token_in') rhs

 cpeRhsE env (Case scrut bndr ty alts)

        ; (env', bndr2) <- cpCloneBndr env bndr

        ; let bndr3 = bndr2 `setIdUnfolding` evaldUnfolding

        ; let alts'

   where

     sat_alt env (Alt con bs rhs)

        = do { (env2, bs') <- cpCloneBndrs env bs

             ; return (Alt con bs' rhs') }

 -- ---------------------------------------------------------------------------

 -- let-bound using 'wrapBinds').  Generally you want this, esp.

 -- when you've reached a binding form (e.g., a lambda) and

 -- floating any further would be incorrect.

 cpeBody env expr

 -- ---------------------------------------------------------------------------

 --              CpeApp: produces a result satisfying CpeApp

 `tagToEnum# @Bool`. During eta expansion we then put that tick back onto the

 body of the eta-expansion lambdas. Giving us `\x -> Tick<foo> (tagToEnum# @Bool x)`.

 -}

 cpeApp top_env expr

   = do { let (terminal, args) = collect_args expr

       --  ; pprTraceM "cpeApp" $ (ppr expr)

     cpe_app :: CorePrepEnv

             -> CoreExpr -- The thing we are calling

             -> [ArgInfo]

     cpe_app env (Var f) (AIApp Type{} : AIApp arg : args)

         | f `hasKey` lazyIdKey          -- Replace (lazy a) with a, and

             -- See Note [lazyId magic] in GHC.Types.Id.Make

         --          case thing of res { __DEFAULT -> (# token, res#) } },

         -- allocating CaseBound Floats for token and thing as needed

         = do { (floats1, token) <- cpeArg env topDmd token

              ; case_bndr <- (`setIdUnfolding` evaldUnfolding) <$> newVar env ty

              ; let tup = mkCoreUnboxedTuple [token, Var case_bndr]

              ; let float = mkCaseFloat case_bndr thing

                  min_arity = case hd of

                    Just v_hd -> if hasNoBinding v_hd then Just $! (idArity v_hd) else Nothing

                    Nothing -> Nothing

            ; (app, floats, unsat_ticks) <- rebuild_app env args e2 emptyFloats stricts min_arity

         where

           depth = val_args args

           stricts = case idDmdSig v of

                           -- If evalDmd says that it's sure to be evaluated,

                           -- we'll end up case-binding it

            ; (app, floats,unsat_ticks) <- rebuild_app env args fun' fun_floats [] Nothing

     -- Count the number of value arguments *and* coercions (since we don't eliminate the later in STG)

     val_args :: [ArgInfo] -> Int

                   | isTypeArg e = n

                   | otherwise   = n+1

     -- Deconstruct and rebuild the application, floating any non-atomic

     -- arguments to the outside.  We collect the type of the expression,

        ; let arg_ty = exprType arg1

              lev    = typeLevity arg_ty

              dec    = wantFloatLocal NonRecursive dmd lev floats1 arg1

                 -- Else case: arg1 might have lambdas, and we can't

                 --            put them inside a wrapBinds

 eta_would_wreck_join (Case _ _ _ alts) = any eta_would_wreck_join (rhssOfAlts alts)

 eta_would_wreck_join _                 = False

 maybeSaturate fn expr n_args unsat_ticks

   | isJoinId fn  -- Never eta-expand a call to a join point

                  -- See Note [Do not eta-expand join points]

   | hasNoBinding fn || (n_args > 0 && excess_arity > 0)

     -- n_args > 0: do not eta-expand a naked variable!

     -- excess_arity > 0: eta-expansion would be a no-op

   | otherwise

 {-

   | hasNoBinding fn        -- There's no binding

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 It turns out to be much much easier to do eta expansion

 *after* the main CorePrep stuff.  But that places constraints

 For example here is what we do not want:

                 f = /\a -> g (h 3)      -- h has arity 2

       #24471 is a good example, where Prep took 25% of compile time!

 -}

 cpeEtaExpand arity expr

   | arity == 0 = expr

   | otherwise  = etaExpand arity expr

 getFloats :: Floats -> OrdList FloatingBind

 getFloats = fs_binds

 floatInfo :: FloatingBind -> FloatInfo

 floatInfo (Float _ _ info)     = info

 floatInfo UnsafeEqualityCase{} = LazyContextFloatable -- See Note [Floating in CorePrep]

   | Lifted   <- lev       = (LetBound, TopLvlFloatable)

       -- And these float freely but can't be speculated, hence LetBound

 mkCaseFloat bndr scrut

   = -- pprTrace "mkCaseFloat" (ppr bndr <+> ppr (bound,info)

     --                             -- <+> ppr is_lifted <+> ppr is_strict

           -- (ok-for-spec case bindings are unlikely anyway.)

       }

 mkNonRecFloat env lev bndr rhs

   = -- pprTrace "mkNonRecFloat" (ppr bndr <+> ppr (bound,info)

     --                             <+> if is_strict then text "strict" else if is_lifted then text "lazy" else text "unlifted"

   ppr FloatNone = text "none"

   ppr FloatAll  = text "all"

   = case dec of

 wantFloatTop :: Floats -> FloatDecision

 wantFloatTop fs

   | fs_info fs `floatsAtLeastAsFarAs` TopLvlFloatable = FloatAll

   | otherwise                                         = FloatNone

 -- See Note [wantFloatLocal]

 wantFloatLocal is_rec rhs_dmd rhs_lev floats rhs

   |  isEmptyFloats floats -- Well yeah...

 -- ---------------------------------------------------------------------------

 -- | Converts Bignum literals into their final CoreExpr

 cpeBigNatLit env i = assert (i >= 0) $ do

   let

     platform = cp_platform (cpe_config env)