Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC Commits: 86d4cd86 by Simon Peyton Jones at 2025-12-31T10:22:11+00:00 More refactoring - - - - - 8 changed files: - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/DynFlags.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -42,13 +42,32 @@ import Control.Monad ( zipWithM ) %* * %************************************************************************ +Note [Coercion optimisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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. +However, although powerful and occasionally very effective, coercion optimisation +can be very expensive (#26679). So we apply it sparingly: + +* In the Simplifier, function `rebuild_go`, we use `isReflexiveCo` (which + computes the type of the coercion) to eliminate reflexive coercion, just + before we build a cast (e |> co). + + (More precisely, we use `isReflexiveCoIgnoringMultiplicity.) + +* We have a whole pass, `optCoProgram` that runs the coercion optimiser on all + the coercions in the program. + + - We run it once in all optimisation levels + (see GHC.Driver.DynFlags.optLevelFlags) + + - We run it early in the optimisation pipeline + (see GHC.Core.Opt.Pipeline.getCoreToDo). + + Note [Optimising coercion optimisation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Looking up a coercion's role or kind is linear in the size of the ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -227,6 +227,7 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Optimise coercions -- With -O do this after one run of the Simplifier. -- Without -O, just take what the desugarer produced + -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt runWhen do_co_opt CoreOptCoercion, if full_laziness then ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -161,15 +161,16 @@ following table: Note [Inline depth] ~~~~~~~~~~~~~~~~~~~ +The seInlineDepth tells us how deep in inlining we are. + 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. -The seInlineDepth tells us how deep in inlining we are. Currently, -seInlineDepth is used for just one purpose: when we encounter a -coercion we don't apply optCoercion to it if seInlineDepth>0. -Reason: it has already been optimised once, no point in doing so again. +Currently, `seInlineDepth` is entirely unused! (It was previously used to avoid +repeatedly optimising coercions.) But it's cheap to maintain and might prove +useful, so I have no removed it. -} data SimplEnv ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) import GHC.Core.Reduction -import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( FamInstEnv, topNormaliseType_maybe ) import GHC.Core.DataCon import GHC.Core.Opt.Stats ( Tick(..) ) @@ -1358,16 +1357,8 @@ simplCoercionF env co cont simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co - = do { let opt_co | reSimplifying env = substCo env co - | otherwise = optCoercion opts subst co - -- If (reSimplifying env) is True we have already simplified - -- this coercion once, and we don't want do so again; doing - -- so repeatedly risks non-linear behaviour - -- See Note [Inline depth] in GHC.Core.Opt.Simplify.Env - ; seqCo opt_co `seq` return opt_co } - where - subst = getTCvSubst env - opts = seOptCoercionOpts env + = do { let out_co = substCo env co + ; seqCo out_co `seq` return out_co } ----------------------------------- -- | Push a TickIt context outwards past applications and cases, as @@ -1538,15 +1529,13 @@ rebuild_go env expr cont case cont of Stop {} -> return (emptyFloats env, expr) TickIt t cont -> rebuild_go env (mkTick t expr) cont - CastIt { sc_co = co, sc_opt = opt, sc_cont = cont } + CastIt { sc_co = co, sc_cont = cont } | isReflexiveCoIgnoringMultiplicity co -- ignoring multiplicity: c.f. GHC.Core.Coercion.Opt.opt_univ -> rebuild_go env expr cont | otherwise - -> rebuild_go env (mkCast expr co') cont + -> rebuild_go env (mkCast expr co) cont -- NB: mkCast implements the (Coercion co |> g) optimisation - where - co' = optOutCoercion env co opt Select { sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont } -> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont @@ -1645,45 +1634,9 @@ isReflexiveCo 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: - -* The CastIt constructor in SimplCont has a `sc_opt :: Bool` flag to - record whether the coercion optimiser has been applied to the coercion. - -* In `simplCast`, when we see (Cast e co), we simplify `co` to get - an OutCoercion, and built a CastIt with sc_opt=True. - - Actually not quite: if we are simplifying the result of inlining an - unfolding (seInlineDepth > 0), then instead of /optimising/ it again, - just /substitute/ which is cheaper. See `simplCoercion`. - -* In `addCoerce` (in `simplCast`) if we combine this new coercion with - an existing once, we build a CastIt for (co1 ; co2) with sc_opt=False. - -* When unpacking a CastIt, in `rebuildCall` and `rebuild`, we optimise - the (presumably composed) coercion if sc_opt=False; this is done - by `optOutCoercion`. - -* When duplicating a continuation in `mkDupableContWithDmds`, before - duplicating a CastIt, optimise the coercion. Otherwise we'll end up - optimising it separately in the duplicate copies. -} -optOutCoercion :: SimplEnvIS -> OutCoercion -> Bool -> OutCoercion --- See Note [Avoid re-simplifying coercions] -optOutCoercion env co already_optimised - | already_optimised = co -- See Note [Avoid re-simplifying coercions] - | otherwise = optCoercion opts empty_subst co - where - empty_subst = mkEmptySubst (seInScope env) - opts = seOptCoercionOpts env - simplCast :: SimplEnv -> InExpr -> InCoercion -> SimplCont -> SimplM (SimplFloats, OutExpr) simplCast env body co0 cont0 @@ -1691,27 +1644,25 @@ simplCast env body co0 cont0 ; cont1 <- {-#SCC "simplCast-addCoerce" #-} if isReflCo co1 then return cont0 -- See Note [Optimising reflexivity] - else addCoerce co1 True cont0 - -- True <=> co1 is optimised + else addCoerce co1 cont0 ; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 } where - -- If the first parameter is MRefl, then simplifying revealed a -- reflexive coercion. Omit. - addCoerceM :: MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont - addCoerceM MRefl _ cont = return cont - addCoerceM (MCo co) opt cont = addCoerce co opt cont + addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont + addCoerceM MRefl cont = return cont + addCoerceM (MCo co) cont = addCoerce co cont - addCoerce :: OutCoercion -> Bool -> SimplCont -> SimplM SimplCont - addCoerce co1 _ (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity] - = addCoerce (mkTransCo co1 co2) False cont + addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont + addCoerce co1 (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity] + = addCoerce (mkTransCo co1 co2) cont -- False: (mkTransCo co1 co2) is not fully optimised -- See Note [Avoid re-simplifying coercions] - addCoerce co co_is_opt (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) + addCoerce co (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty = {-#SCC "addCoerce-pushCoTyArg" #-} - do { tail' <- addCoerceM m_co' co_is_opt tail + do { tail' <- addCoerceM m_co' tail ; return (ApplyToTy { sc_arg_ty = arg_ty' , sc_cont = tail' , sc_hole_ty = coercionLKind co }) } @@ -1721,15 +1672,12 @@ simplCast env body co0 cont0 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 -- co2 :: s2 ~ t2 - addCoerce co co_is_opt cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_dup = dup, sc_cont = tail - , sc_hole_ty = fun_ty }) - | not co_is_opt -- pushCoValArg duplicates the coercion, so optimise first - = addCoerce (optOutCoercion (zapSubstEnv env) co co_is_opt) True cont - + addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se + , sc_dup = dup, sc_cont = tail + , sc_hole_ty = fun_ty }) | Just (m_co1, m_co2) <- pushCoValArg co = {-#SCC "addCoerce-pushCoValArg" #-} - do { tail' <- addCoerceM m_co2 co_is_opt tail + do { tail' <- addCoerceM m_co2 tail ; case m_co1 of { MRefl -> return (cont { sc_cont = tail' , sc_hole_ty = coercionLKind co }) ; @@ -1748,11 +1696,11 @@ simplCast env body co0 cont0 , sc_cont = tail' , sc_hole_ty = coercionLKind co }) } } } - addCoerce co co_is_opt cont + addCoerce co cont | isReflCo co = return cont -- Having this at the end makes a huge -- difference in T12227, for some reason -- See Note [Optimising reflexivity] - | otherwise = return (CastIt { sc_co = co, sc_opt = co_is_opt, sc_cont = cont }) + | otherwise = return (CastIt { sc_co = co, sc_cont = cont }) simplLazyArg :: SimplEnvIS -- ^ Used only for its InScopeSet -> DupFlag @@ -3877,11 +3825,9 @@ mkDupableContWithDmds env _ cont mkDupableContWithDmds _ _ (Stop {}) = panic "mkDupableCont" -- Handled by previous eqn -mkDupableContWithDmds env dmds (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }) +mkDupableContWithDmds env dmds (CastIt { sc_co = co, sc_cont = cont }) = do { (floats, cont') <- mkDupableContWithDmds env dmds cont - ; return (floats, CastIt { sc_co = optOutCoercion env co opt - , sc_opt = True, sc_cont = cont' }) } - -- optOutCoercion: see Note [Avoid re-simplifying coercions] + ; return (floats, CastIt { sc_co = co, sc_cont = cont' }) } -- Duplicating ticks for now, not sure if this is good or not mkDupableContWithDmds env dmds (TickIt t cont) ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -164,9 +164,6 @@ data SimplCont | CastIt -- (CastIt co K)[e] = K[ e `cast` co ] { sc_co :: OutCoercion -- The coercion simplified -- Invariant: never an identity coercion - , sc_opt :: Bool -- True <=> sc_co has had optCoercion applied to it - -- See Note [Avoid re-simplifying coercions] - -- in GHC.Core.Opt.Simplify.Iteration , sc_cont :: SimplCont } | ApplyToVal -- (ApplyToVal arg K)[e] = K[ e arg ] ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -30,7 +30,6 @@ import GHC.Core.Unfold.Make import GHC.Core.Make ( FloatBind(..), mkWildValBinder ) import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs ) import GHC.Core.DataCon -import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList , isInScope, substTyVarBndr, cloneTyVarBndr ) import GHC.Core.Predicate( isCoVarType ) @@ -113,7 +112,6 @@ See ticket #25790 -- | Simple optimiser options data SimpleOpts = SimpleOpts { so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options - , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options , so_eta_red :: !Bool -- ^ Eta reduction on? , so_inline :: !Bool -- ^ False <=> do no inlining whatsoever, -- even for trivial or used-once things @@ -123,7 +121,6 @@ data SimpleOpts = SimpleOpts defaultSimpleOpts :: SimpleOpts defaultSimpleOpts = SimpleOpts { so_uf_opts = defaultUnfoldingOpts - , so_co_opts = OptCoercionOpts { optCoercionEnabled = False } , so_eta_red = False , so_inline = True } @@ -288,7 +285,7 @@ simple_opt_expr env expr = go expr go e@(Lam {}) = simple_app env e [] go (Type ty) = Type (substTyUnchecked subst ty) - go (Coercion co) = Coercion (go_co co) + go (Coercion co) = Coercion (simple_opt_co env co) 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 @@ -323,15 +320,15 @@ simple_opt_expr env expr = go expr e' = go e (env', b') = subst_opt_bndr env b - ---------------------- - go_co co = optCoercion (so_co_opts (soe_opts env)) subst co - ---------------------- go_alt env (Alt con bndrs rhs) = Alt con bndrs' (simple_opt_expr env' rhs) where (env', bndrs') = subst_opt_bndrs env bndrs +simple_opt_co :: SimpleOptEnv -> InCoercion -> OutCoercion +simple_opt_co env co = substCo (soe_subst env) co + 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) @@ -471,7 +468,7 @@ add_cast env co1 as CastIt co2:rest -> CastIt (co1' `mkTransCo` co2):rest _ -> CastIt co1':as where - co1' = optCoercion (so_co_opts (soe_opts env)) (soe_subst env) co1 + co1' = simple_opt_co env co1 rebuild_app :: HasDebugCallStack => SimpleOptEnv -> OutExpr -> [SimpleContItem] -> OutExpr @@ -606,7 +603,7 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst, soe_opts = opt (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing) | Coercion co <- in_rhs - , let out_co = optCoercion (so_co_opts (soe_opts env)) (soe_subst rhs_env) co + , let out_co = simple_opt_co rhs_env co = assert (isCoVar in_bndr) (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing) ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -24,7 +24,6 @@ initOptCoercionOpts dflags = OptCoercionOpts initSimpleOpts :: DynFlags -> SimpleOpts initSimpleOpts dflags = SimpleOpts { so_uf_opts = unfoldingOpts dflags - , so_co_opts = initOptCoercionOpts dflags , so_eta_red = gopt Opt_DoEtaReduction dflags , so_inline = True } ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1236,7 +1236,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([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 ) - , ([0,1,2], Opt_OptCoercion ) + , ([0,1,2], Opt_OptCoercion ) -- See Note [Coercion optimisation] in GHC.Core.Coercion.Opt , ([2], Opt_DictsStrict) , ([0], Opt_IgnoreInterfacePragmas) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86d4cd861572e6a901098a7fc6ea77da... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86d4cd861572e6a901098a7fc6ea77da... You're receiving this email because of your account on gitlab.haskell.org.