%*                                                                      *

 %************************************************************************

 This module does coercion optimisation.  See the paper

    Evidence normalization in Systtem FV (RTA'13)

    https://simon.peytonjones.org/evidence-normalization/

 The paper is also in the GHC repo, in docs/opt-coercion.

 Note [Optimising coercion optimisation]

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

 Looking up a coercion's role or kind is linear in the size of the

         -- Optimise coercions

         -- With -O do this after one run of the Simplifier.

         -- Without -O, just take what the desugarer produced

         runWhen do_co_opt CoreOptCoercion,

         if full_laziness then

 Note [Inline depth]

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

 When we inline an /already-simplified/ unfolding, we

 * Zap the substitution environment; the inlined thing is an OutExpr

 * Bump the seInlineDepth in the SimplEnv

 Both these tasks are done in zapSubstEnv.

 -}

 data SimplEnv

 import qualified GHC.Core.Make

 import GHC.Core.Coercion hiding ( substCo, substCoVar )

 import GHC.Core.Reduction

 import GHC.Core.FamInstEnv      ( FamInstEnv, topNormaliseType_maybe )

 import GHC.Core.DataCon

 import GHC.Core.Opt.Stats ( Tick(..) )

 simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion

 simplCoercion env co

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

 -- | Push a TickIt context outwards past applications and cases, as

     case cont of

       Stop {}          -> return (emptyFloats env, expr)

       TickIt t cont    -> rebuild_go env (mkTick t expr) cont

         | isReflexiveCoIgnoringMultiplicity co

               -- ignoring multiplicity: c.f. GHC.Core.Coercion.Opt.opt_univ

         -> rebuild_go env expr cont

         | otherwise

            -- NB: mkCast implements the (Coercion co |> g) optimisation

       Select { sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont }

         -> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont

 In investigating this I saw missed opportunities for on-the-fly

 coercion shrinkage. See #15090.

 -}

 simplCast :: SimplEnv -> InExpr -> InCoercion -> SimplCont

           -> SimplM (SimplFloats, OutExpr)

 simplCast env body co0 cont0

         ; cont1 <- {-#SCC "simplCast-addCoerce" #-}

                    if isReflCo co1

                    then return cont0  -- See Note [Optimising reflexivity]

         ; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 }

   where

         -- If the first parameter is MRefl, then simplifying revealed a

         -- reflexive coercion. Omit.

                       -- False: (mkTransCo co1 co2) is not fully optimised

                       -- See Note [Avoid re-simplifying coercions]

           | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty

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

                ; return (ApplyToTy { sc_arg_ty  = arg_ty'

                                    , sc_cont    = tail'

                                    , sc_hole_ty = coercionLKind co }) }

         -- where   co :: (s1->s2) ~ (t1->t2)

         --         co1 :: t1 ~ s1

         --         co2 :: s2 ~ t2

           | Just (m_co1, m_co2) <- pushCoValArg co

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

                ; case m_co1 of {

                    MRefl -> return (cont { sc_cont = tail'

                                          , sc_hole_ty = coercionLKind co }) ;

                                     , sc_cont = tail'

                                     , sc_hole_ty = coercionLKind co }) } } }

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

                                        -- difference in T12227, for some reason

                                        -- See Note [Optimising reflexivity]

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

              -> DupFlag

 mkDupableContWithDmds _ _ (Stop {}) = panic "mkDupableCont"     -- Handled by previous eqn

   = do  { (floats, cont') <- mkDupableContWithDmds env dmds cont

 -- Duplicating ticks for now, not sure if this is good or not

 mkDupableContWithDmds env dmds (TickIt t cont)

   | CastIt              -- (CastIt co K)[e] = K[ e `cast` co ]

       { sc_co   :: OutCoercion  -- The coercion simplified

                                 -- Invariant: never an identity coercion

       , sc_cont :: SimplCont }

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

 import GHC.Core.Make ( FloatBind(..), mkWildValBinder )

 import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs )

 import GHC.Core.DataCon

 import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList

                             , isInScope, substTyVarBndr, cloneTyVarBndr )

 import GHC.Core.Predicate( isCoVarType )

 -- | Simple optimiser options

 data SimpleOpts = SimpleOpts

    { so_uf_opts :: !UnfoldingOpts   -- ^ Unfolding options

    , so_eta_red :: !Bool            -- ^ Eta reduction on?

    , so_inline :: !Bool             -- ^ False <=> do no inlining whatsoever,

                                     --    even for trivial or used-once things

 defaultSimpleOpts :: SimpleOpts

 defaultSimpleOpts = SimpleOpts

    { so_uf_opts = defaultUnfoldingOpts

    , so_eta_red = False

    , so_inline  = True

    }

     go e@(Lam {})  = simple_app env e []

     go (Type ty)        = Type     (substTyUnchecked subst ty)

     go (Lit lit)        = Lit lit

     go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)

     go (Let bind body)  = case simple_opt_bind env bind NotTopLevel of

         e' = go e

         (env', b') = subst_opt_bndr env b

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

     go_alt env (Alt con bndrs rhs)

       = Alt con bndrs' (simple_opt_expr env' rhs)

       where

         (env', bndrs') = subst_opt_bndrs env bndrs

 mk_cast :: CoreExpr -> CoercionR -> CoreExpr

 -- Like GHC.Core.Utils.mkCast, but does a full reflexivity check.

 -- mkCast doesn't do that because the Simplifier does (in simplCast)

       CastIt co2:rest -> CastIt (co1' `mkTransCo` co2):rest

       _               -> CastIt co1':as

   where

 rebuild_app :: HasDebugCallStack

             => SimpleOptEnv -> OutExpr -> [SimpleContItem] -> OutExpr

     (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)

   | Coercion co <- in_rhs

   = assert (isCoVar in_bndr)

     (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)

 initSimpleOpts :: DynFlags -> SimpleOpts

 initSimpleOpts dflags = SimpleOpts

    { so_uf_opts = unfoldingOpts dflags

    , so_eta_red = gopt Opt_DoEtaReduction dflags

    , so_inline  = True

    }

     , ([1,2],   Opt_DoCleverArgEtaExpansion) -- See Note [Eta expansion of arguments in CorePrep]

     , ([0,1,2], Opt_DoEtaReduction)          -- See Note [Eta-reduction in -O0]

     , ([0,1,2], Opt_ProfManualCcs )

     , ([2], Opt_DictsStrict)

     , ([0],     Opt_IgnoreInterfacePragmas)