extendFloats, isEmptyJoinFloats,

         doFloatFromRhs, getTopFloatBinds,

         -- * JoinFloats

         JoinFloat, JoinFloats, emptyJoinFloats,

 -- Precondition: used only when sfJoins is empty

 isEmptyFloats (SimplFloats { sfBinds = fs

                            , sfJoins = js })

 pprSimplEnv :: SimplEnv -> SDoc

 -- Used for debugging; selective

 {-

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

 *                                                                      *

 *                                                                      *

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

 difference to compile time, so we did not keep it.

 -}

 type JoinFloat  = OutBind

 type JoinFloats = OrdList JoinFloat

 doFloatFromRhs :: SimplEnv -> TopLevelFlag -> RecFlag

                -> OutExpr

                -> Maybe SimplFloats   -- Contains let-bindings only

 -- See Note [doFloatFromRhs]

 --

 -- If you change this function look also at FloatIn.noFloatIntoRhs

 doFloatFromRhs env lvl rec floats anf_lets rhs

   where

     !(SimplFloats { sfBinds = fs, sfJoins = jfs, sfInScope = in_scope }) = floats

     new_floats = assertPpr (isNilOL jfs) (ppr jfs) $

                        FloatNestedOnly -> not (isTopLevel lvl)

                        FloatEnabled    -> True

 emptyJoinFloats :: JoinFloats

 emptyJoinFloats = nilOL

   | otherwise

   = floats `addLetFloat` bind

 -- Add the let-bindings /inside/ the existing floats,

 -- and extend the in-scope set

 addLetFloats floats binds = foldlOL add floats binds

   where

     add fs bind = assertPpr (okLetFloat bind) (ppr bind) $

 mkRecFloats :: SimplFloats -> SimplFloats

 -- Flattens the floats into a single Rec group,

 mkRecFloats floats@(SimplFloats { sfBinds   = bs

                                 , sfJoins   = jbs

                                 , sfInScope = in_scope })

     letFloatBinds floats

 {-# INLINE mapLetFloats #-}

 mapLetFloats binds fun

    = binds1

    where

 import qualified GHC.Data.List.Infinite as Inf

 import GHC.Data.Maybe   ( isNothing, orElse, mapMaybe )

 import GHC.Data.FastString

 import GHC.Unit.Module ( moduleName )

 import GHC.Utils.Outputable

 import GHC.Utils.Panic

            => SimplEnvIS -> TopLevelFlag

            -> FastString    -- Base for any new variables

            -> OutExpr

 -- Transforms a RHS into a better RHS by ANF'ing args

 -- for expandable RHSs: constructors and PAPs

 -- e.g        x = Just e

 -- See Note [prepareRhs]

 prepareRhs env top_lvl occ rhs0

   | is_expandable = anfise rhs0

   where

     -- We can't use exprIsExpandable because the WHOLE POINT is that

     -- we want to treat (K <big>) as expandable, because we are just

          go (Tick _ rhs)  n_val_args   = go rhs n_val_args

          go _             _            = False

     anfise (Cast rhs co)

         = do { (floats, rhs') <- anfise rhs

              ; return (floats, Cast rhs' co) }

              ; (floats2, arg') <- makeTrivial env top_lvl topDmd occ arg

              ; return (floats1 `appOL` floats2, App fun' arg') }

     anfise (Var fun)

     anfise (Tick t rhs)

         -- We want to be able to float bindings past this tick.

                    floats' = mapLetFloats floats tickIt

              ; return (floats', Tick t rhs') }

 makeTrivialArg :: HasDebugCallStack => SimplEnvIS -> ArgSpec

 makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd })

   = do { (floats, e') <- makeTrivial env NotTopLevel dmd (fsLit "arg") e

        ; return (floats, arg { as_arg = e' }) }

 makeTrivialArg _ arg@(TyArg {})

 makeTrivial :: HasDebugCallStack

             => SimplEnvIS -> TopLevelFlag -> Demand

             -> FastString  -- ^ A "friendly name" to build the new binder from

             -> 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 env top_lvl dmd occ_fs expr

   | exprIsTrivial expr                          -- Already trivial

   || not (bindingOk top_lvl expr expr_ty)       -- Cannot trivialise

                                                 --   See Note [Cannot trivialise]

   | Cast expr' co <- expr

   = do { (floats, triv_expr) <- makeTrivial env top_lvl dmd occ_fs expr'

 and thence, by floating, into

     z = f y

     x = Just z

 sometimes it cannot trivialise its argument, and must return it unchanged.

 (CT1) Nested bindings.  Suppose that (f y) had type Int#, with a different data

         ; (env', bndrs') <- simplLamBndrs env (bndr:inner_bndrs)

         ; body'   <- simplExpr env' inner_body

         ; new_lam <- rebuildLam env' bndrs' body' cont

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

 simplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)

 import GHC.Types.Tickish

 import GHC.Types.Demand

 import GHC.Types.Var.Set

 import GHC.Types.Basic

 import GHC.Types.Name.Env

       manifestly a literal string.

 -}

                -> SimplFloats -- Let-bindings only: postcondition of `prepareBinding`

                -> OutExpr     -- The right-hand side of the binding

                -> SimplM (SimplFloats, OutExpr)

         ; return ( SimplFloats { sfBinds   = foldr (consOL . FloatLet) nilOL poly_binds

                                , sfJoins   = emptyJoinFloats

                  , GHC.Core.Subst.substExpr subst rhs) }

         --     new floated bindings; but not main_tvs, nor the original floats

         -- That reduces unnecessary renaming (see !7777 and test T16577)

   where

     !(SimplFloats { sfBinds = float_binds, sfJoins = jfs }) = floats

     is_top_lvl  = isTopLevel top_lvl

     uf_opts     = seUnfoldingOpts env

     subst_co (Right s) co = GHC.Core.Subst.substCo s co

     subst_expr (Left {}) e = e

     subst_bndrs subst bs = mapAccumL subst_bndr subst bs

     subst_bndr (Right subst) bndr = subst_bndr1 subst bndr

     subst_bndr1 subst bndr

       where

         (subst', bndr') = substBndr subst bndr