SimplEnvIS,  checkSimplEnvIS, pprBadSimplEnvIS,

         -- * Substitution results

         -- * Simplifying 'Id' binders

         simplNonRecBndr, simplNonRecJoinBndr, simplRecBndrs, simplRecJoinBndrs,

        -- and  v is a join-point of arity a

        --      <=> x is a join-point of arity a

            InExpr

 instance Outputable SimplSR where

   ppr (DoneId v)    = text "DoneId" <+> ppr v

                 NotJoinPoint -> empty

                 JoinPoint n  -> parens (int n)

         -- where

         -- fvs = exprFreeVars e

         -- filter_env env = filterVarEnv_Directly keep env

 setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv

 setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }

 {-

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

 *                                                                      *

 getFullSubst :: InScopeSet -> SimplEnv -> Subst

 getFullSubst in_scope (SimplEnv { seIdSubst = id_env, seTvSubst = tv_env, seCvSubst = cv_env })

   = mkSubst in_scope (mapVarEnv to_expr id_env) tv_env cv_env

   where

     to_expr :: SimplSR -> CoreExpr

     -- A tiresome impedence-matcher

 substTy :: HasDebugCallStack => SimplEnv -> Type -> Type

 substTy env ty = Type.substTy (getTCvSubst env) ty

 simplRecOrTopPair env bind_cxt old_bndr new_bndr rhs

   | Just env' <- preInlineUnconditionally env (bindContextLevel bind_cxt)

   = {-#SCC "simplRecOrTopPair-pre-inline-uncond" #-}

     simplTrace "SimplBindr:inline-uncond1" (ppr old_bndr) $

     do { tick (PreInlineUnconditionally old_bndr)

         simplExprF env fun $

         ApplyToVal { sc_arg = arg, sc_env = UnSimplified env

                    , sc_hole_ty = substTy env (exprType fun)

 simplExprF1 env expr@(Lam {}) cont

   = {-#SCC "simplExprF1-Lam" #-}

     do { ty' <- simplType env ty

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

     -- Because of the let-can-float invariant, it's ok to

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

   = do { simplTrace "SimplBindr:inline-uncond2" (ppr bndr) $

       ApplyToTy  { sc_arg_ty = ty, sc_cont = cont}

         -> rebuild_go env (App expr (Type ty)) cont

                  , sc_cont = cont, sc_hole_ty = fun_ty }

         -- See Note [Avoid redundant simplification]

               ; rebuild_go env (App expr arg') cont }

 completeBindX :: SimplEnv

     empty_subst = mkEmptySubst (seInScope env)

     opts = seOptCoercionOpts env

 pushCast :: SimplEnv -> OutCoercion -> SimplCont -> SimplM SimplCont

 pushCast env co cont

   = go co True cont

     --         co1 :: t1 ~ s1

     --         co2 :: s2 ~ t2

     go co co_is_opt cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se

       | not co_is_opt

       = -- pushCoValArg duplicates the coercion, so optimise first

         go (optOutCoercion (zapSubstEnv env) co co_is_opt) True cont

       | Just (m_co1, m_co2) <- pushCoValArg co

       = {-#SCC "addCoerce-pushCoValArg" #-}

         do { tail' <- go_mco m_co2 co_is_opt tail

                                 , sc_cont = tail'

     go co co_is_opt cont

       | isReflCo co = return cont  -- Having this at the end makes a huge

     go_mco (MCo co) opt cont = go co opt cont

 simplArg :: SimplEnvIS              -- ^ Used only for its InScopeSet

          -> Maybe ArgInfo           -- ^ Just <=> This arg `ai` occurs in an app

                                     --   `f a1 ... an` where we have ArgInfo on

                                     --   how `f` uses `ai`, affecting the Stop

                                     --   continuation passed to 'simplExprC'

          -> StaticEnv -> CoreExpr   -- ^ Expression with its static envt

   = do { let arg_env' = arg_se `setInScopeFromE` env

              arg_ty   = funArgTy fun_ty

              stop     = case mb_arg_info of

 {-

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

   = do { tick (BetaReduction bndr)

        ; simplLam (extendTvSubst env bndr arg_ty) body cont }

 -- Coercion beta-reduction

 simpl_lam env bndr body (ApplyToVal { sc_arg = Coercion arg_co, sc_env = arg_se

   = assertPpr (isCoVar bndr) (ppr bndr) $

     do { tick (BetaReduction bndr)

        ; simplLam (extendCvSubst env bndr arg_co') body cont }

 -- Value beta-reduction

 -- This works for /coercion/ lambdas too

 simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se

                                     , sc_hole_ty = fun_ty})

               -- Ok to test arg::InExpr in needsCaseBinding because

               -- exprOkForSpeculation is stable under simplification

        }

 -- Discard a non-counting tick on a lambda.  This may change the

 -- cost attribution slightly (moving the allocation of the

   = rebuild env (Var var) cont

   | otherwise

   = case substId env var of

         -- Don't trimJoinCont; haven't already simplified e,

         -- so the cont is not embodied in e

         where

           cont' = trimJoinCont out_id (idJoinPointHood out_id) cont

         where

           cont' = trimJoinCont var mb_join cont

   where

 -- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep.

 --

 -- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o

 simplOutId env fun cont

   | fun `hasKey` runRWKey

   , ApplyToTy  { sc_cont = cont1 } <- cont

   , ApplyToTy  { sc_cont = cont2, sc_arg_ty = hole_ty } <- cont1

                , sc_env = arg_se, sc_hole_ty = fun_ty } <- cont2

   -- Do this even if (contIsStop cont), or if seCaseCase is off.

   -- See Note [No eta-expansion in runRW#]

            _ -> do { s' <- newId (fsLit "s") ManyTy realWorldStatePrimTy

                    ; let (m,_,_) = splitFunTy fun_ty

                          env'  = arg_env `addNewInScopeIds` [s']

                                             , sc_env = Simplified OkDup, sc_cont = inner_cont

                                             , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy new_runrw_res_ty }

                                 -- cont' applies to s', then K

 ---------- Simplify value arguments --------------------

 rebuildCall env fun_info

                         , sc_hole_ty = fun_ty, sc_cont = cont })

   | UnSimplified arg_env <- arg_se

   , isStrictArgInfo fun_info  -- Strict arguments

   , seCaseCase env            -- But only when case-of-case is on.

                               -- See Note [Case-of-case and full laziness]

                 -- Note [Shadowing in the Simplifier]

   | otherwise      -- Lazy, or already simplified arguments

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

         ; rebuildCall env (addValArgTo fun_info  arg' fun_ty) cont }

 ---------- No further useful info, revert to generic rebuild ------------

                           , as_dmd = seqDmd

                           , as_hole_ty = res3_ty } ]

     rule_cont = ApplyToVal { sc_env = UnSimplified in_env, sc_arg = rhs

                            , sc_cont = cont, sc_hole_ty = res4_ty }

     out_args = [Type rhs_rep, Type scrut_ty, Type rhs_ty, no_cast_scrut]

         return ( emptyFloats env

                , extendIdSubst env case_bndr (DoneEx scrut NotJoinPoint))

       = return (emptyFloats env', env')

       | otherwise

                                     , sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) }

 mkDupableContWithDmds env dmds

                 , sc_cont = cont, sc_hole_ty = hole_ty })

   =     -- e.g.         [...hole...] (...arg...)

         --      ==>

     do  { let dmd:|cont_dmds = expectNonEmpty dmds

         ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont

         ; let env' = env `setInScopeFromF` floats1

         ; (let_floats2, triv_arg) <- makeTrivial env' NotTopLevel dmd (fsLit "karg") arg'

         ; let all_floats = floats1 `addLetFloats` let_floats2

         ; return ( all_floats

                  , ApplyToVal { sc_arg = triv_arg, sc_env = Simplified OkDup

 mkDupableContWithDmds env _

     (Select { sc_bndr = case_bndr, sc_alts = alts, sc_env = se, sc_cont = cont })

       , sc_cont :: SimplCont }

   | ApplyToVal         -- (ApplyToVal arg K)[e] = K[ e arg ]

       , sc_cont :: SimplCont }

   | ApplyToTy          -- (ApplyToTy ty K)[e] = K[ e ty ]

   = ApplyToTy { sc_hole_ty = fun_ty, sc_arg_ty = ty

               , sc_cont = pushArgs (piResultTy fun_ty ty) args cont }

   | otherwise

                , sc_arg = arg, sc_env = Simplified NoDup

                , sc_cont = pushArgs (funResultTy fun_ty) args  cont}

 pushArgSpec (TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty }) cont

   = ApplyToTy  { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont }

 pushArgSpec (ValArg { as_arg = arg, as_hole_ty = hole_ty }) cont

                , sc_hole_ty = hole_ty, sc_cont = cont }

 argSpecArg :: ArgSpec -> OutExpr

     go env n (Var v)

        = case substId env v of

            DoneId v'            -> go_var n v'

     go _   _ (Lit l)

        | isLitRubbish l        = NonTrivArg -- See (IA3) in Note [Interesting arguments]

 preInlineUnconditionally

     :: SimplEnv -> TopLevelFlag -> InId

     -> Maybe SimplEnv       -- Returned env has extended substitution

 -- Precondition: rhs satisfies the let-can-float invariant

 -- See Note [Core let-can-float invariant] in GHC.Core

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

 --         for unlifted, side-effect-ful bindings

   | not pre_inline_unconditionally           = Nothing

   | not active                               = Nothing

   | isTopLevel top_lvl && isDeadEndId bndr   = Nothing -- Note [Top-level bottoming Ids]

   -- See Note [Stable unfoldings and preInlineUnconditionally]

   | not (isInlinePragma inline_prag)

   | otherwise                                = Nothing

   where

     -- If not then ContEx

     -- ToDo: flesh this note out

     extend_subst_with inl_rhs

     one_occ IAmDead = True -- Happens in ((\x.1) v)

     one_occ OneOcc{ occ_n_br   = 1

 lvl = foo d

 bar = bar1 `cast` <Co:6> :: ...

  Unf=Unf{Src=<vanilla>, TopLvl=True,

          Value=True, ConLike=True, WorkFree=True, Expandable=True,

          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]

  Unf=Unf{Src=<vanilla>, TopLvl=True,

          Value=True, ConLike=True, WorkFree=True, Expandable=True,

   = {terms: 40, types: 122, coercions: 26, joins: 0/0}

 nat2Word#

       naturalToWord# ((natSing $dKnownNat) `cast` <Co:2> :: ...)

 fd

       naturalToWord# ((natSing $dKnownNat) `cast` <Co:6> :: ...)

 fm

       naturalToWord# ((natSing $dKnownNat) `cast` <Co:8> :: ...)

 fp

       naturalToWord# ((natSing $dKnownNat) `cast` <Co:10> :: ...)

 foo0 = \ x -> -# 10# x

 foo2 = \ x -> +# 10# x

 Result size of Tidy Core

   = {terms: 44, types: 107, coercions: 0, joins: 0/0}

 foo2 = foo0

 foo3 = foo1

 foo5 = foo4

 foo7 = foo6

 Result size of Tidy Core

   = {terms: 71, types: 45, coercions: 0, joins: 0/0}

 foo3 = foo0

 foo4' = I# 31#

 ctz3 = ctz0

 ctz4' = I# 62#

 clz1' = I# 5#

 PATTERN SYNONYMS

   (:||:) :: forall {a} {b}. a -> b -> (a, b)

 Dependent modules: []

 ==================== Tidy Core ====================

 Result size of Tidy Core

       (@b)

       (scrut :: (a, b))

       (cont :: a -> b -> r)

       case scrut of { (x, y) -> cont x y }

 ==================== Tidy Core rules ====================

 "USPEC f1 @Word @[e]"

       f1 @Word @[e] $dNum $dEq

 "USPEC f1 @Word @_"

       f1 @Word @e $dNum $dEq

 "USPEC f1_qc @_ @(g e) @Word"

     forall (@(g :: * -> *))

            (@e)

            (df :: forall x. Eq x => Eq (g x))

            ($dEq :: Eq (g e))

       f1_qc @g @(g e) @Word df $dEq $dNum

 "USPEC f2 @_ @_ @Word"

       f2 @c @c @Word $dEq $dEq1 $dNum

 "USPEC f3 @Int @_"

     forall (@(g :: * -> *))

            (df :: forall x. Eq x => Eq (g x)).

       f3 @Int @g $dEq df

       = f3_$sf3 @g df

 "USPEC f3 @_ @[]"

       f3 @c @[] $dEq df

       = f3_$sf1 @c $dEq

 "USPEC f4 @_ @(ST s)"

       f4 @b @(ST s) $dEq $dMonad

       = $fApplicativeST_$cpure @s @b

 "USPEC f4_qc @Int @_ @_"

     forall (@(r :: (* -> *) -> * -> *))

            (@(n :: * -> *))

            (df :: forall (m :: * -> *). Monad m => Monad (r m)).

       f4_qc @Int @r @n $dEq df

 "USPEC f5 @(D Int)"

 "USPEC f5_qc @Int @D"

       f5_qc @Int @D $dEq $dEq1 df

       = f5_$sf5

 "USPEC f5_qc @Int @_"

     forall (@(g :: * -> *))

            (df :: forall x. (Eq x, Eq (T x)) => Eq (g x)).

       f5_qc @Int @g $dEq $dEq1 df

       = f5_qc_$sf5_qc @g df

 "USPEC f6 @_ @_ @Word"

       f6 @c @c @Word $dEq $dOrd $dNum

 "USPEC f6_qc @_ @_ @Word"

     forall (@(h :: * -> *))

            (df1 :: forall y. Eq y => Ord (h y))

       f6_qc @h @h @Word df df1 $dNum

 "USPEC f7 @Int"

       f7 @Int $dCls $dEq

       = \ (x [Occ=Once1] :: Int) -> x

 "USPEC qcfd @C @G"

       qcfd @C @G $dF df

       = qcfd_x

     Module: (RewriteHigherOrderPatterns)

     Full arity: 1

     Before: bar \ x y z -> two (two x y) z

 Rule fired

     Rule: bar

     Module: (RewriteHigherOrderPatterns)

     Full arity: 1

 Rule fired

     Rule: foo

     Module: (RewriteHigherOrderPatterns)

     Full arity: 1

     Before: foo \ x -> two (two x (I# 2#)) x

 Rule fired

     Rule: qux

     Module: (RewriteHigherOrderPatterns)

     Full arity: 1

     Before: qux \ x y -> three (two x (I# 1#)) (I# 2#) y

 Rule fired

     Rule: baz

     Module: (RewriteHigherOrderPatterns)

     Full arity: 1

     Before: baz \ x -> three (two x (I# 1#)) (I# 2#) x

     Module: (T18668)

     Full arity: 0

     Before: GHC.Internal.Prim.+# 2# 3#

 Rule fired

     Rule: *#

     Module: (BUILTIN)

     Full arity: 2

     Before: GHC.Internal.Prim.*# 2# 3#

 Rule fired