+section: compiler

+issues: #27962

+mrs: !16869

+synopsis:

+  Fix a Lint error when using `runRW#` and `coerce` together

+description:

+  Just an internal compiler bug, of long standing.

+section: compiler

+issues: #27963

+mrs: !16869

+synopsis:

+  Fix a rather obscure interaction of `coerce` and RULES

+description:

+  A `coerce` could prevent a RULE firing.

+        SimplClo(..), simplCloExpr, substId, lookupRecBndr,

+import GHC.Core.Subst( substExpr )

+type SimplIdSubst = IdEnv SimplClo -- IdId |--> OutExpr

+-- | A "closure" used in the Simplifier.  It is used

+--     * as the range of the substitution, 'SimplIdSubst'

+--     * as the argument in an 'ApplyToVal' continuation

+-- Roughly: either an (InExpr, StaticEnv) pair for an

+--                 as-yet-unsimplified expression

+--          or     an OutExpr, for an already-simplified one

+-- It's a bit like thunk: we may "evaluate" the SimplClo in a ApplyToVal

+--   and thereby transform it from `ContEx` to `DoneEx`

+--   This happens in the `ApplyToVal` case of `mkDupableContWithDmds`

+--   See Note [The argument of ApplyToVal] in GHC.Core.Opt.Simplify.Utils

+data SimplClo

+           MOutCoercion  -- See Note [The MOutCoercion field of ContEx]

+instance Outputable SimplClo where

+extendIdSubst :: SimplEnv -> Id -> SimplClo -> SimplEnv

+substId :: SimplEnv -> InId -> SimplClo

+  = mkSubst in_scope (mapVarEnv (simplCloExpr in_scope) id_env) tv_env cv_env

+

+simplCloExpr :: InScopeSet -> SimplClo -> OutExpr

+-- Turn a SimplClo into an OutExpr, by applying the substitution

+-- (if any) and the pending cast (if any)

+simplCloExpr _        (DoneEx e _)       = e

+simplCloExpr _        (DoneId v)         = Var v

+simplCloExpr in_scope (ContEx env e mco) = mkCastMCo e' mco

+    e' = GHC.Core.Subst.substExpr (getFullSubst in_scope env) e

+    -- NB: we use substExpr, not substExprSC: we want to get the benefit of

+    --     knowing what is evaluated etc, via the in-scope set

+  | Just env' <- preInlineLetUnconditionally env (bindContextLevel bind_cxt)

+                                             old_bndr rhs env

+  = do  { co1 <- simplCoercion env co

+        ; simplExprF env body (pushCast env co1 cont) }

+        ApplyToVal { sc_arg = ContEx env arg MRefl, sc_dup = NoDup

+                   , sc_cont = cont }

+  | Just env' <- preInlineLetUnconditionally env NotTopLevel bndr rhs env

+      ApplyToVal { sc_arg = arg, sc_cont = cont, sc_hole_ty = fun_ty }

+        -> do { arg' <- simplArg env Nothing fun_ty arg

+

+{- *********************************************************************

+                Arguments

+********************************************************************* -}

+         -> SimplClo                -- ^ The argument

+-- See Note [The argument of ApplyToVal] in GHC.Core.Opt.Simplify.Utils

+simplArg _ _ _ (DoneEx arg _) = return arg  -- See Note [Avoid repeated simplification]

+simplArg _ _ _ (DoneId v)     = return (Var v)

+simplArg env mb_arg_info fun_ty (ContEx arg_se arg mco)

+

+{- *********************************************************************

+                Lambdas

+********************************************************************* -}

+simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_cont = cont

+  | Just env' <- preInlineBetaUnconditionally env arg_levity bndr arg

+       ; case arg of

+           ContEx arg_env arg_expr MRefl

+             -> simplNonRecE env from_what bndr (arg_expr, arg_env) body cont

+           _ -> do { arg' <- simplArg env Nothing fun_ty arg

+  , ApplyToVal { sc_cont = cont3, sc_arg = arg_clo, sc_hole_ty = fun_ty } <- cont2

+  = do { let (arg_env, arg, arg_mco)

+                = case arg_clo of

+                    ContEx se e mco -> (se `setInScopeFromE` env, e, mco)

+                    DoneEx e _      -> (env, e,     MRefl)

+                    DoneId v        -> (env, Var v, MRefl)

+       --

+       -- But only if there is no pending cast on the argument (#27962);

+       -- if there is, the general case below deals with it properly

+           Lam s body

+             | MRefl <- arg_mco

+             -> do { (env', s') <- simplBinder arg_env s

+                   ; body' <- simplExprC env' body inner_cont

+                   ; return (Lam s' body') }

+                   -- Important: do not try to eta-expand this lambda

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

+                                 ApplyToVal { sc_arg  = DoneId s'

+                                            , sc_dup  = dup

+                         -- The argument (Var s') is small, but inner_cont may not be

+                         -- dupable; see (AV2) in Note [The argument of ApplyToVal]

+                         dup | contIsDupable inner_cont = OkDup

+                             | otherwise                = NoDup

+            (ApplyToVal { sc_arg = arg, sc_hole_ty = fun_ty, sc_cont = cont })

+  | ContEx arg_env arg_expr arg_mco <- arg

+  = simplExprF (arg_env `setInScopeFromE` env) arg_expr $

+  = do  { arg' <- simplArg env (Just fun_info) fun_ty arg

+ * So if `simpl_lam` did preInlineBetaUnconditionally we get (g BIG)

+   simplified, we /want/ to do preInlineBetaUnconditionally in simpl_lam.

+* The (sc_arg :: SimplClo) field of ApplyToVal records if the argument

+  has been simplified: it is a DoneEx if so, and a ContEx if not.

+  See Note [The argument of ApplyToVal] in GHC.Core.Opt.Simplify.Utils.

+  continuation as (DoneEx e1) and (DoneEx e2).

+  but we use `simplArg`, which in turn uses the DoneEx to avoid

+  `preInlineBetaUnconditionally` in `simpl_lam` will fire, and extend the

+  substitution with the very same SimplClo

+    rule_cont = ApplyToVal { sc_arg = ContEx in_env rhs MRefl, sc_dup = NoDup

+      | Just env' <- preInlineLetUnconditionally env NotTopLevel case_bndr

+                                                 con_app env

+    (ApplyToVal { sc_arg = arg, sc_cont = cont, sc_hole_ty = hole_ty })

+        ; arg' <- simplArg env' Nothing hole_ty arg

+                 , ApplyToVal { sc_arg = DoneEx triv_arg NotJoinPoint, sc_dup = OkDup

+                              , sc_cont = cont', sc_hole_ty = hole_ty }) }

+        preInlineLetUnconditionally, preInlineBetaUnconditionally,

+        postInlineUnconditionally,

+      , sc_dup  :: DupFlag       -- See Note [The argument of ApplyToVal]

+      , sc_arg  :: SimplClo      -- The argument

+                                 -- Invariant: if sc_arg is a ContEx, then sc_dup = NoDup

+Consider Select, which has

+    sc_env  :: StaticEnv

+    sc_bndr :: Id

+    sc_alts :: [CoreAlt]

+Initially, `sc_bndr` and `sc_alts` are un-simplified InThings, and `sc_env` is

+(UnSimplified env), where `env` gives meaning to their free variables; in

+particular, `env` may have substitutions that must apply to them.

+

+But sometimes (notably in `mkDupableCont`) we simplify them, and in that case

+`sc_bndr` and `sc_alts` are OutThings, and `sc_env` is (Simplified dup).

+

+When we finally simplify the alternatives (see `mkAltEnv`)

+  * If sc_env is Simplified, there is nothing to do

+  * If sc_env is (UnSimplified alt_env) we simplify them with

+     - Their captured envt `alt_env`

+          case (let y = ey in f) of alts

+    By the time we simplify alts, 'y' will be in scope.

+* We say sc_alts :: [CoreAlt], rather than [InAlt] or [OutAlt],

+  because whether they are InAlts or OutAlts depends on `sc_env`

+

+* Same deal for StrictBind, where the StaticEnv scopes over sc_bndr and sc_body.

+* ApplyToVal is similar, but simpler: it uses a SimplClo instead.

+  See Note [The argument of ApplyToVal].

+* Even though the InScopeSet of an (UnSimplified se) is overridden, that

+  InScopeSet is not irrelevant: it should include all the free vars of

+  applying the substitution to the InThing. Reason: contHoleType uses

+  perhapsSubstTy to apply the substitution to the binder, and that

+  (rightly) gives ASSERT failures if the InScopeSet isn't big enough.

+

+Note [The argument of ApplyToVal]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+ApplyToVal has

+    sc_dup :: DupFlag

+    sc_arg :: SimplClo

+

+Initially, `sc_arg` is (ContEx env arg MRefl), where `arg` is the un-simplified

+InExpr, and `env` gives meaning to the free variables of `arg`; in particular,

+`env` may have substitutions that must apply to the argument.

+

+But sometimes we simplify the argument, and in that case, `sc_arg` is

+(DoneEx arg' NotJoinPoint), where `arg'` is the simplified argument.

+

+The `sc_dup` flag says whether the continuation can be duplicated.  NoDup is

+the safe, conservative option, but in `mkDupableCont` we want to make the

+continuation duplicable, so we make the argument small (and hence a DoneEx)

+and set `sc_dup` to OkDup.  Invariants:

+

+  (AV1) If `sc_arg` is a ContEx, then `sc_dup` is NoDup.

+

+  (AV2) If `sc_dup` is OkDup then `sc_cont` is also ok-to-dup; see (SE1)

+        in Note [StaticEnv].

+

+We later simplify the argument, in `simplArg`.  Then

+  * If `sc_arg` is a DoneEx (or DoneId), it's a no-op

+  * If `sc_arg` is (ContEx arg_env arg mco) we simplify `arg` with

+     - Its captured envt `arg_env`

+     - but overriding its InScopeSet with the larger one at the

+       simplification point.

+    Why override the InScopeSet?  Example:

+          (let y = ey in f) ex

+    By the time we simplify ex, 'y' will be in scope.

+    Then we wrap the cast `mco` around the result.

+    See Note [The MOutCoercion field of ContEx].

+

+Using a SimplClo for the argument means that it can be substituted for a lambda

+binder, in `preInlineBetaUnconditionally`, without further ado.

+  ppr (ApplyToVal { sc_arg = arg, sc_dup = dup, sc_cont = cont, sc_hole_ty = hole_ty })

+    = (hang (text "ApplyToVal" <> braces (ppr dup) <+> text "hole-ty:" <+> pprParendType hole_ty)

+          2 (ppr arg))

+  = ApplyToVal { sc_hole_ty = fun_ty

+               , sc_arg = DoneEx arg NotJoinPoint, sc_dup = NoDup

+  = ApplyToVal { sc_arg = DoneEx arg NotJoinPoint, sc_dup = NoDup

+contIsDupable (ApplyToVal { sc_dup = dup, sc_arg = arg })

+  = assertPpr (not (okToDup dup && is_cont_ex arg)) (ppr arg) $

+    okToDup dup -- See (AV1,AV2) in Note [The argument of ApplyToVal]

+  where

+    is_cont_ex (ContEx {}) = True

+    is_cont_ex _           = False

+    go args (ApplyToVal { sc_arg = arg, sc_cont = k })

+                                        = go (interestingArg env arg : args) k

+    go (ApplyToVal { sc_arg = arg, sc_cont = cont })

+      = simplCloExpr in_scope arg : go cont

+        -- Make sure we apply the static environment of a ContEx as a substitution

+        -- simplCloExpr also wraps the pending cast (if any) around the argument;

+        --   omitting it can make a rule fail to match (#27963)

+{- Note [The MOutCoercion field of ContEx]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+argument.  But the argument may or may not have been simplified (see Note [The

+argument of ApplyToVal]):

+

+* If it has been simplified, it is (DoneEx arg' _), and we can simply wrap the

+  cast around `arg'`.

+

+* If it has not, it is (ContEx env arg mco), and we definitely can't just wrap

+  the (Out)cast around the InExpr `arg`. Instead we compose it with `mco` --

+  this is the whole reason for the MOutCoercion field of `ContEx`.

+

+All this is done by `mkCloCastMCo`.

+`preInlineBetaUnconditionally`; and since the substitution maps an Id to a SimplClo,

+the pending cast comes along for free.  Then we deal with it appropriately when

+/applying/ the substitution in `simplInId`.

+

+Note [Optimising reflexivity]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+It's important (for compiler performance) to get rid of reflexivity as soon

+as it appears.  See #11735, #14737, and #15019.

+

+In particular, we want to behave well on

+

+ *  e |> co1 |> co2

+    where the two happen to cancel out entirely. That is quite common;

+    e.g. a newtype wrapping and unwrapping cancel.

+

+

+ * (f |> co) @t1 @t2 ... @tn x1 .. xm

+   Here we will use pushCoTyArg and pushCoValArg successively, which

+   build up SelCo stacks.  Silly to do that if co is reflexive.

+

+However, we don't want to call isReflexiveCo too much, because it uses

+type equality which is expensive on big types (#14737 comment:7).

+

+A good compromise (determined experimentally) seems to be to call

+isReflexiveCo

+ * when composing casts, and

+ * at the end

+

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

+coercion shrinkage. See #15090.

+

+Note [Avoid re-simplifying coercions]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+In some benchmarks (with deeply nested cases) we successively push

+casts onto the SimplCont.  We don't want to call the coercion optimiser

+on each successive composition -- that's at least quadratic.  So:

+