NoEffect, we may float such an invalid call out of a dead branch

     and speculatively evaluate it.

     Marking uncheckedShiftLWord32# as CanFail instead of NoEffect

     would give us the freedom to rewrite such invalid calls to runtime

     where it is guarded by exprOkToDiscard, which in turn checks

     primOpOkToDiscard.

   * So primops that aren't NoEffect will appear only as the

     scrutinees of cases, and that's why the FloatIn pass is capable

 --    this corresponds to allocating a thunk for the things

 --    bound and then executing the sub-expression.

 --

 --    See Note [Representation polymorphism invariants]

 --    See Note [Core type and coercion invariant]

 --

 * See Note [Shadowing in SpecConstr] in GHC.Core.Opt.SpecContr

 constructor worker or wrapper

       e.g.   data T = MkT Int

       we generate

              S1 = S1

       We allow this top-level unlifted binding to exist.

 This means that the let can be floated around

 without difficulty. For example, this is OK:

 alternatively use 'GHC.Core.Make.mkCoreLet' rather than this constructor directly,

 which will generate a @case@ if necessary

 Historical Note [The let/app invariant]

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

 But the let/app invariant got in the way of RULES; see #19313.  For example

   up :: Int# -> Int#

 application is always a variable or a constant.  To allow RULES to work nicely

 we need to allow lots of things in the arguments of a call.

 Note [Core top-level string literals]

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

 Note [Core type and coercion invariant]

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

 * A type variable binding must have a RHS of (Type ty)

 * A coercion variable binding must have a RHS of (Coercion co)

   It is possible to have terms that return a coercion, but we use

   case-binding for those; e.g.

   Note [Equality superclasses in quantified constraints]

   in GHC.Tc.Solver.Dict

 Note [Representation polymorphism invariants]

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

 GHC allows us to abstract over calling conventions using **representation polymorphism**.

 However, join points have simpler invariants in other ways

   5. A join point can have an unboxed type without the RHS being

      e.g.  let j :: Int# = factorial x in ...

   6. The RHS of join point is not required to have a fixed runtime representation,

 mkDoubleLit       d = Lit (mkLitDouble d)

 mkDoubleLitDouble d = Lit (mkLitDouble (toRational d))

 -- 'GHC.Core.Make.mkCoreLets' if possible, which does guarantee the invariant

 mkLets        :: [Bind b] -> Expr b -> Expr b

 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to

 This module does coercion optimisation.  The purpose is to reduce the size

 of the coercions that the compiler carries around -- they are just proofs,

 and serve no runtime need. So the purpose of coercion optimisation is simply

 See the paper

    Evidence normalization in Systtem FV (RTA'13)

 optimisation can itself be very expensive (#26679).  So we apply it sparingly:

 * In the Simplifier, function `rebuild_go`, we use `isReflexiveCo` (which

   before we build a cast (e |> co).

   (More precisely, we use `isReflexiveCoIgnoringMultiplicity;

 %********************************************************************* -}

 optCoProgram :: CoreProgram -> CoreProgram

 optCoProgram binds

   = map go binds

   where

 %*                                                                      *

 %********************************************************************* -}

 optCoRefl :: Coercion -> Coercion

 optCoRefl in_co

 #ifdef DEBUG

   -- Debug check that optCoRefl doesn't change the type

        ; checkL (not (isCoVar binder) || isCoArg rhs)

                 (mkLetErr binder rhs)

        ; checkL (bindingIsOk top_lvl rec_flag binder binder_ty rhs) $

          mkLetErr binder rhs

         -- the unfolding is a SimplifiableCoreExpr. Give up for now.

 bindingIsOk :: TopLevelFlag -> RecFlag -> OutId -> OutType -> CoreExpr -> Bool

 bindingIsOk top_lvl rec_flag binder binder_ty rhs

   | isCoVar binder

   = isCoArg rhs

 -- | Bind a binding group over an expression, using a @let@ or @case@ as

 -- appropriate (see "GHC.Core#let_can_float_invariant")

 mkCoreLet :: HasDebugCallStack => CoreBind -> CoreExpr -> CoreExpr

 mkCoreLet bind body

   = Let bind body

    case x |> co of (y::Array# Int) { ... }

 We do not want to extend the substitution with (y -> x |> co); since y

 But surely (x |> co) is ok-for-speculation, because it's a trivial

 expression, and x's type is also unlifted, presumably.  Well, maybe

     let x = I# (error "invalid shift")

     in ...

 Consequently we instead take advantage of the fact that the result of a

 large shift is unspecified (see associated documentation in primops.txt.pp)

 Int#/Word#/etc. primops. See builtinBignumRules.

 These rules are built-in because they can't be expressed as regular rules for

   case integerAdd 1 x of r { _ -> integerAdd 1 r }

 doesn't constant-fold into `integerAdd 2 x` with a regular rule. That's because

 GHC never floats in `integerAdd 1 x` to form `integerAdd 1 (integerAdd 1 x)`

 terminates).

 In the built-in rule for `integerAdd` we can access the unfolding of `r` and we

   = isRec is_rec -- Joins are one-shot iff non-recursive

   | definitelyUnliftedType (idType bndr)

   | otherwise

   = noFloatIntoArg rhs

    - noFloatIntoArg: the argument of a function application

 Definitely don't float into RHS if it has unlifted type;

 * Wrinkle 1: do not float in if

      (a) any non-one-shot value lambdas

      let x = a /# 3

 to

      let x = case bx of I# a -> a /# 3

 If an expression is okay for speculation, we could also float it out

 *without* boxing and unboxing, since evaluating it early is okay.

   NonRec x# (y +# 3)    FltOkSpec   -- Unboxed, but ok-for-spec'n

   NonRec x* (f y)       FltCareful  -- Strict binding; might fail or diverge

 -}

 data LetFloats = LetFloats (OrdList OutBind) FloatFlag

   = FltLifted   -- All bindings are lifted and lazy *or*

                 --     consist of a single primitive string literal

                 -- Hence ok to float to top level, or recursive

   | FltOkSpec   -- All bindings are FltLifted *or*

                 --      strict (perhaps because unlifted,

                 -- Hence ok to float out of the RHS

                 -- of a lazy non-recursive let binding

                 -- (but not to top level, or into a rec group)

   | FltCareful  -- At least one binding is strict (or unlifted)

                 --      and not guaranteed cheap

                 -- Do not float these bindings out of a lazy let!

 instance Outputable LetFloats where

   ppr (LetFloats binds ff) = ppr ff $$ ppr (fromOL binds)

      -- Note: Always safe to put the joins on the inside

      -- since the values can't refer to them

   where

 wrapJoinFloatsX :: SimplFloats -> OutExpr -> (SimplFloats, OutExpr)

 -- Wrap the sfJoinFloats of the env around the expression,

               -> (InExpr, SimplEnv)     -- The RHS and its static environment

               -> SimplM (SimplFloats, SimplEnv)

 -- Precondition: Ids only, no TyVars; not a JoinId

 simplLazyBind top_lvl is_rec (bndr,unf_se) (bndr1,env) (rhs,rhs_se)

   = assert (isId bndr )

     assertPpr (not (isJoinId bndr)) (ppr bndr) $

 -- The binder comes from a case expression (case binder or alternative)

 -- and so does not have rules, unfolding, inline pragmas etc.

 --

 simplAuxBind _str env bndr new_rhs

   | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $

 --      * or by adding to the floats in the envt

 --

 -- Binder /can/ be a JoinId

 completeBind bind_cxt (old_bndr, unf_se) (new_bndr, new_rhs, env)

   | isCoVar old_bndr

   = case new_rhs of

        ; simplExprF (extendTvSubst env bndr ty') body cont }

   | Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env

     -- inline freely, or to drop the binding if it is dead.

   = do { simplTrace "SimplBindr:inline-uncond2" (ppr bndr <+> ppr rhs) $

          tick (PreInlineUnconditionally bndr)

 completeBindX :: SimplEnv

               -> FromWhat

               -> InId -> OutExpr   -- Non-recursively bind this Id to this (simplified) expression

               -> InExpr            -- In this body

               -> SimplCont         -- Consumed by this continuation

               -> SimplM (SimplFloats, OutExpr)

 completeBindX env from_what bndr rhs body cont

   | FromBeta arg_levity <- from_what

   = do { (env1, bndr1)   <- simplNonRecBndr env bndr  -- Lambda binders don't have rules

        ; (floats, expr') <- simplNonRecBody env1 from_what body cont

        -- Do not float floats past the Case binder below

 -- It deals with strict bindings, via the StrictBind continuation,

 -- which may abort the whole process.

 --

 -- Otherwise it may or may not satisfy it.

 simplNonRecE env from_what bndr (rhs, rhs_se) body cont

     is_strict_bind = case from_what of

        FromBeta Unlifted -> True

        -- If we are coming from a beta-reduction (FromBeta) we must

        -- If not, the invariant holds already, and it's optional.

        -- (FromBeta Lifted) or FromLet: look at the demand info

 We treat the unlifted and lifted cases separately:

 * Unlifted case: 'e' satisfies exprOkForSpeculation

   This turns     case a +# b of r -> ...r...

   into           let r = a +# b in ...r...

   and thence     .....(a +# b)....

       assert (null bs) $

       do { (floats1, env') <- simplAuxBind "rebuildCase" env case_bndr case_bndr_rhs

              -- scrut is a constructor application,

          ; (floats2, expr') <- simplExprF env' rhs cont

          ; case wfloats of

              [] -> return (floats1 `addFloats` floats2, expr')

 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;

     case e of b { DEFAULT -> let v = reallyUnsafePtrEquality# b y in ....

                 ; K       -> blah }

 reallyUnsafePtrEquality#, which it is.  But we still want that to be true if we

 propagate binders to occurrences.

              -- occur in the RHS; and simplAuxBind may therefore discard it.

              -- Nevertheless we must keep it if the case-binder is alive,

              -- because it may be used in the con_app.  See Note [knownCon occ info]

            ; (floats2, env3) <- bind_args env2 bs' args

            ; return (floats1 `addFloats` floats2, env3) }

     :: SimplEnv -> TopLevelFlag -> InId

     -> InExpr -> StaticEnv  -- These two go together

     -> Maybe SimplEnv       -- Returned env has extended substitution

 -- Reason: we don't want to inline single uses, or discard dead bindings,

 --         for unlifted, side-effect-ful bindings

 preInlineUnconditionally env top_lvl bndr rhs rhs_env

     -> InId -> OutId    -- The binder (*not* a CoVar), including its unfolding

     -> OutExpr

     -> Bool

 -- Reason: we don't want to inline single uses, or discard dead bindings,

 --         for unlifted, side-effect-ful bindings

 postInlineUnconditionally env bind_cxt old_bndr bndr rhs

 This is conservative: maybe the RHS of `x` has a free var that would stop it

 floating to top level anyway; but that is hard to spot (since we don't know what

 the non-top-level in-scope binders are) and rare (since the binding must satisfy

 Note [Specialising Calls]

         -- See Note [Dark corner with representation polymorphism]

         needsCaseBinding (idType b') (snd a)

         -- This arg must not be inlined (side-effects) and cannot be let-bound,

       , let a' = simple_opt_clo (soeInScope env) a

       = mkDefaultCase a' b' $ do_beta env' body as

   where

     do_tcv is v = EndoOS do_it

       where

                   | v `elemVarSet` is  = acc

                   | v `elemVarSet` acc = acc

                   | otherwise          = appEndoOS (deep_ty (varType v)) $

 {- Note [Keeping the substitution empty]

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

 A very common situation is where we run over a term doing no cloning,

 it is /very/ valuable to /keep/ it empty:

 * It's wasted effort to build up an identity substitution mapping

 -- See also Note [Classifying primop effects] in "GHC.Builtin.PrimOps"

 -- and Note [Transformations affected by primop effects].

 --

 exprOkForSpeculation, exprOkToDiscard :: CoreExpr -> Bool

 exprOkForSpeculation = expr_ok fun_always_ok primOpOkForSpeculation

                                                ; False -> e2 }

                        in ...) ...

      DEFAULT -> ... (let v::Int# = case x of { ... }

                      in ...) ....

   not evaluated. See Note [Binder-swap during float-out]

   in GHC.Core.Opt.SetLevels.  To avoid this awkwardness it seems simpler

   to stick to unlifted scrutinees where the issue does not

 And now the expression does not obey the let-can-float invariant!  Yikes!

 Moreover we really might float (dataToTagLarge# x) outside the case,

 The solution is simple: exprOkForSpeculation does not try to take

 advantage of the evaluated-ness of (lifted) variables.  And it returns

 GHC.Builtin.PrimOps.

 Note that exprIsHNF /can/ and does take advantage of evaluated-ness;

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

 *                                                                      *

 - Variables should be defined before used.

 - If linting after unarisation, invariants listed in Note [Post-unarisation

   invariants].