[Git][ghc/ghc][wip/simplifier-tweaks] Further wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Jul 20 11:27:23 UTC 2023
Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC
Commits:
6f86cc3b by Simon Peyton Jones at 2023-07-20T12:26:19+01:00
Further wibbles
In particular simplifying SelCo in Coercion.Opt
- - - - -
4 changed files:
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/TyCo/Rep.hs
Changes:
=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -37,7 +37,7 @@ module GHC.Core.Coercion (
mkAxInstLHS, mkUnbranchedAxInstLHS,
mkPiCo, mkPiCos, mkCoCast,
mkSymCo, mkTransCo,
- mkSelCo, mkSelCoResRole, getNthFun, getNthFromType, mkLRCo,
+ mkSelCo, mkSelCoResRole, getNthFun, selectFromType, mkLRCo,
mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo,
mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo,
mkNakedFunCo,
@@ -1127,8 +1127,8 @@ mkSymCo :: Coercion -> Coercion
mkSymCo co | isReflCo co = co
mkSymCo (SymCo co) = co
mkSymCo (SubCo (SymCo co)) = SubCo co
-mkSymCo (ForAllCo { fco_kind = kco, fco_body = co })
- | isReflCo kco = co { fco_body = mkSymCo co }
+mkSymCo co@(ForAllCo { fco_kind = kco, fco_body = body_co })
+ | isReflCo kco = co { fco_body = mkSymCo body_co }
mkSymCo co = SymCo co
-- | Create a new 'Coercion' by composing the two given 'Coercion's transitively.
@@ -1160,7 +1160,7 @@ mkSelCo_maybe cs co
go cs co
| Just (ty, r) <- isReflCo_maybe co
- = Just (mkReflCo (mkSelCoResRole cs r) (getNthFromType cs ty))
+ = Just (mkReflCo (mkSelCoResRole cs r) (selectFromType cs ty))
go SelForAll (ForAllCo { fco_kind = kind_co })
= Just kind_co
@@ -1229,22 +1229,22 @@ getNthFun SelMult mult _ _ = mult
getNthFun SelArg _ arg _ = arg
getNthFun SelRes _ _ res = res
-getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type
-getNthFromType (SelFun fs) ty
+selectFromType :: HasDebugCallStack => CoSel -> Type -> Type
+selectFromType (SelFun fs) ty
| Just (_af, mult, arg, res) <- splitFunTy_maybe ty
= getNthFun fs mult arg res
-getNthFromType (SelTyCon n _) ty
+selectFromType (SelTyCon n _) ty
| Just args <- tyConAppArgs_maybe ty
= assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $
args `getNth` n
-getNthFromType SelForAll ty -- Works for both tyvar and covar
+selectFromType SelForAll ty -- Works for both tyvar and covar
| Just (tv,_) <- splitForAllTyCoVar_maybe ty
= tyVarKind tv
-getNthFromType cs ty
- = pprPanic "getNthFromType" (ppr cs $$ ppr ty)
+selectFromType cs ty
+ = pprPanic "selectFromType" (ppr cs $$ ppr ty)
--------------------
mkLRCo :: LeftOrRight -> Coercion -> Coercion
@@ -2443,7 +2443,7 @@ coercionLKind co
go (InstCo aco arg) = go_app aco [go arg]
go (KindCo co) = typeKind (go co)
go (SubCo co) = go co
- go (SelCo d co) = getNthFromType d (go co)
+ go (SelCo d co) = selectFromType d (go co)
go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos)
go (AxiomRuleCo ax cos) = pFst $ expectJust "coercionKind" $
coaxrProves ax $ map coercionKind cos
@@ -2487,7 +2487,7 @@ coercionRKind co
go (InstCo aco arg) = go_app aco [go arg]
go (KindCo co) = typeKind (go co)
go (SubCo co) = go co
- go (SelCo d co) = getNthFromType d (go co)
+ go (SelCo d co) = selectFromType d (go co)
go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos)
go (AxiomRuleCo ax cos) = pSnd $ expectJust "coercionKind" $
coaxrProves ax $ map coercionKind cos
=====================================
compiler/GHC/Core/Coercion/Opt.hs
=====================================
@@ -24,10 +24,8 @@ import GHC.Core.Unify
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
--- import GHC.Types.Unique.Set
import GHC.Data.Pair
-import GHC.Data.List.SetOps ( getNth )
import GHC.Utils.Outputable
import GHC.Utils.Constants (debugIsOn)
@@ -162,8 +160,6 @@ optCoercion' env co
, text "out_ty2:" <+> ppr out_ty2
, text "in_role:" <+> ppr in_role
, text "out_role:" <+> ppr out_role
--- , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co
--- , text "subst:" <+> ppr env
]
in
warnPprTrace (not (isReflCo out_co) && isReflexiveCo out_co)
@@ -209,10 +205,11 @@ opt_co2 :: LiftingContext
-> Role -- ^ The role of the input coercion
-> Coercion -> NormalCo
opt_co2 env sym Phantom co = opt_phantom env sym co
-opt_co2 env sym r co = opt_co3 env sym Nothing r co
+opt_co2 env sym r co = opt_co4_wrap env sym False r co
-- See Note [Optimising coercion optimisation]
--- | Optimize a coercion, knowing the coercion's non-Phantom role.
+-- | Optimize a coercion, knowing the coercion's non-Phantom role,
+-- and with an optional downgrade
opt_co3 :: LiftingContext -> SymFlag -> Maybe Role -> Role -> Coercion -> NormalCo
opt_co3 env sym (Just Phantom) _ co = opt_phantom env sym co
opt_co3 env sym (Just Representational) r co = opt_co4_wrap env sym True r co
@@ -225,6 +222,7 @@ opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag
-> Role -> Coercion -> NormalCo
-- Precondition: In every call (opt_co4 lc sym rep role co)
-- we should have role = coercionRole co
+-- Precondition: role is not Phantom
-- Postcondition: The resulting coercion is equivalant to
-- wrapsub (wrapsym (mksub co)
-- where wrapsym is SymCo if sym=True
@@ -385,45 +383,15 @@ opt_co4 env sym rep r (TransCo co1 co2)
co2' = opt_co4_wrap env sym rep r co2
in_scope = lcInScopeSet env
-opt_co4 env _sym rep r (SelCo n co)
- | Just (ty, _co_role) <- isReflCo_maybe co
- = liftCoSubst (chooseRole rep r) env (getNthFromType n ty)
- -- NB: it is /not/ true that r = _co_role
- -- Rather, r = coercionRole (SelCo n co)
-
-opt_co4 env sym rep r (SelCo (SelTyCon n r1) (TyConAppCo _ _ cos))
- = assert (r == r1 )
- opt_co4_wrap env sym rep r (cos `getNth` n)
-
--- see the definition of GHC.Builtin.Types.Prim.funTyCon
-opt_co4 env sym rep r (SelCo (SelFun fs) (FunCo _r2 _afl _afr w co1 co2))
- = opt_co4_wrap env sym rep r (getNthFun fs w co1 co2)
-
-opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo { fco_kind = eta }))
- -- works for both tyvar and covar
- = opt_co4_wrap env sym rep Nominal eta
-
--- So the /input/ coercion isn't ForAllCo or Refl;
--- instead look at the /output/ coercion
opt_co4 env sym rep r (SelCo cs co)
- | Just (ty, co_role) <- isReflCo_maybe co'
- = mkReflCo (chooseRole rep (mkSelCoResRole cs co_role))
- (getNthFromType cs ty)
-
- | Just nth_co <- case (co', cs) of
- (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n)
- (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2)
- (ForAllCo { fco_kind = eta }, SelForAll) -> Just eta
- _ -> Nothing
- = if rep && (r == Nominal)
- -- keep propagating the SubCo
- then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co
- else nth_co
-
- | otherwise
- = wrapRole rep r $ SelCo cs co'
- where
- co' = opt_co1 env sym co
+ -- Historical note 1: we used to check `co` for Refl, TyConAppCo etc
+ -- before optimising `co`; but actually the SelCo will have been built
+ -- with mkSelCo, so these tests always fail.
+
+ -- Historical note 2: if rep=True and r=Nominal, we used to recursively
+ -- call opt_co4 to re-optimse the result. But (a) that is inefficient
+ -- and (b) wrapRole uses mkSubCo which does much the same job
+ = wrapRole rep r $ mkSelCo cs $ opt_co1 env sym co
opt_co4 env sym rep r (LRCo lr co)
| Just pr_co <- splitAppCo_maybe co
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -417,10 +417,10 @@ simplAuxBind _str env bndr new_rhs
= return (emptyFloats env, env) -- Here c is dead, and we avoid
-- creating the binding c = (a,b)
- -- The cases would be inlined unconditionally by completeBind:
- -- but it seems not uncommon, and it turns to be a little more
+ -- Next we have a fast-path for cases that would be inlined unconditionally by
+ -- completeBind: but it seems not uncommon, and it turns to be a little more
-- efficient (in compile time allocations) to do it here.
- -- Effectively this is just a poor man's postInlineUnconditionally
+ -- Effectively this is just a vastly-simplified postInlineUnconditionally
-- See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils
-- Note: auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings
| exprIsTrivial new_rhs -- Short-cut for let x = y in ...
@@ -1338,10 +1338,10 @@ 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
+ -- 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 = getSubst env
@@ -4022,8 +4022,8 @@ Note [Duplicating alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When should we duplicate an alternative, and when should we make a join point?
We don't want to make a join point if it will /definitely/ be inlined; that
-takes extra work to build, and an extra Simplifier iteration to do the inlining.
-So consider
+just takes extra work to build, and an extra Simplifier iteration to do the
+inlining. So consider
case (case x of True -> e2; False -> e2) of
K1 a b -> f b a
@@ -4035,10 +4035,13 @@ The (f b a) would turn into a join point like
which would immediately inline again because the call is not smaller than the RHS.
On the other hand, the (g x v) turns into
$j2 x = g x v
-which won't imediately inline. Finally the (Just v) would turn into
+which won't imediately inline, because the call $j2 x is smaller than the RHS
+(g x v). Finally the (Just v) would turn into
$j3 v = Just v
and you might think that would immediately inline.
+TODO -- more here
+
Note [Fusing case continuations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's important to fuse two successive case continuations when the
=====================================
compiler/GHC/Core/TyCo/Rep.hs
=====================================
@@ -1100,7 +1100,7 @@ SelTyCon, SelForAll, and SelFun.
* SelForAll:
co : forall (a:k1).t1 ~r0 forall (a:k2).t2
----------------------------------
- SelCo SelForAll : k1 ~N k2
+ SelCo SelForAll co : k1 ~N k2
NB: SelForAll always gives a Nominal coercion.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f86cc3bddfd6ca88d437cf86fef2d221c114001
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f86cc3bddfd6ca88d437cf86fef2d221c114001
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230720/066e0ec4/attachment-0001.html>
More information about the ghc-commits
mailing list