[Git][ghc/ghc][wip/T23923-mikolaj-take-2] 3 commits: Try to avoid a Sphinx error
Mikolaj Konarski (@Mikolaj)
gitlab at gitlab.haskell.org
Tue Apr 9 05:57:15 UTC 2024
Mikolaj Konarski pushed to branch wip/T23923-mikolaj-take-2 at Glasgow Haskell Compiler / GHC
Commits:
f9e9d150 by Mikolaj Konarski at 2024-04-09T07:45:47+02:00
Try to avoid a Sphinx error
- - - - -
b021b7e9 by Mikolaj Konarski at 2024-04-09T07:48:09+02:00
Retitle a note
- - - - -
3dc19098 by Mikolaj Konarski at 2024-04-09T07:56:22+02:00
Mention a note and tweak existing comments
- - - - -
4 changed files:
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Types/TyThing/Ppr.hs
- docs/users_guide/9.12.1-notes.rst
Changes:
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -177,7 +177,7 @@ toIfaceTypeX :: VarSet -> Type -> IfaceType
-- translates the tyvars in 'free' as IfaceFreeTyVars
--
-- Synonyms are retained in the interface type
-toIfaceTypeX fr (TyVarTy tv) -- See Note [Free tyvars in IfaceType] in GHC.Iface.Type
+toIfaceTypeX fr (TyVarTy tv) -- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type
| tv `elemVarSet` fr = IfaceFreeTyVar tv
| otherwise = IfaceTyVar (toIfaceTyVar tv)
toIfaceTypeX fr ty@(AppTy {}) =
@@ -284,7 +284,7 @@ toIfaceCoercionX fr co
go (Refl ty) = IfaceReflCo (toIfaceTypeX fr ty)
go (GRefl r ty mco) = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco)
go (CoVarCo cv)
- -- See Note [Free tyvars in IfaceType] in GHC.Iface.Type
+ -- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type
| cv `elemVarSet` fr = IfaceFreeCoVar cv
| otherwise = IfaceCoVarCo (toIfaceCoVar cv)
go (HoleCo h) = IfaceHoleCo (coHoleCoVar h)
=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -155,7 +155,7 @@ type IfaceKind = IfaceType
-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'
-- before being printed. See Note [Pretty printing via Iface syntax] in "GHC.Types.TyThing.Ppr"
data IfaceType
- = IfaceFreeTyVar TyVar -- See Note [Free tyvars in IfaceType]
+ = IfaceFreeTyVar TyVar -- See Note [Free TyVars and CoVars in IfaceType]
| IfaceTyVar IfLclName -- Type/coercion variable only, not tycon
| IfaceLitTy IfaceTyLit
| IfaceAppTy IfaceType IfaceAppArgs
@@ -285,7 +285,7 @@ instance Outputable IfaceTyConSort where
ppr (IfaceSumTyCon n) = text "sum:" <> ppr n
ppr IfaceEqualityTyCon = text "equality"
-{- Note [Free tyvars in IfaceType]
+{- Note [Free TyVars and CoVars in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to
an IfaceType and pretty printing that. This eliminates a lot of
@@ -433,7 +433,7 @@ data IfaceCoercion
| IfaceCoVarCo IfLclName
| IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion]
| IfaceAxiomRuleCo IfLclName [IfaceCoercion]
- -- There are only a fixed number of CoAxiomRules, so it suffices
+ -- ^ There are only a fixed number of CoAxiomRules, so it suffices
-- to use an IfaceLclName to distinguish them.
-- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals
| IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType
@@ -444,15 +444,15 @@ data IfaceCoercion
| IfaceInstCo IfaceCoercion IfaceCoercion
| IfaceKindCo IfaceCoercion
| IfaceSubCo IfaceCoercion
- | IfaceFreeCoVar CoVar -- See Note [Free tyvars in IfaceType]
+ | IfaceFreeCoVar CoVar -- ^ See Note [Free TyVars and CoVars in IfaceType]
| IfaceHoleCo CoVar -- ^ See Note [Holes in IfaceCoercion]
data IfaceUnivCoProv
= IfacePhantomProv IfaceCoercion
| IfaceProofIrrelProv IfaceCoercion
| IfacePluginProv String [IfLclName] [Var]
- -- Local covars and open (free) covars resp
- -- See Note [Free tyvars in IfaceType]
+ -- ^ Local covars and open (free) covars resp
+ -- See Note [Free TyVars and CoVars in IfaceType]
{- Note [Holes in IfaceCoercion]
@@ -1027,7 +1027,7 @@ ppr_ty ctxt_prec ty
| not (isIfaceRhoType ty) = ppr_sigma ShowForAllMust ctxt_prec ty
ppr_ty _ (IfaceForAllTy {}) = panic "ppr_ty" -- Covered by not.isIfaceRhoType
ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reason for IfaceFreeTyVar!
-ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [Free tyvars in IfaceType]
+ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [Free TyVars and CoVars in IfaceType]
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
ppr_ty ctxt_prec (IfaceTupleTy i p tys) = ppr_tuple ctxt_prec i p tys -- always fully saturated
ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n
@@ -1959,7 +1959,7 @@ ppr_co ctxt_prec co@(IfaceForAllCo {})
= let (tvs, co'') = split_co co' in ((name,kind_co,visL,visR):tvs,co'')
split_co co' = ([], co')
--- Why these three? See Note [Free tyvars in IfaceType]
+-- Why these three? See Note [Free TyVars and CoVars in IfaceType]
ppr_co _ (IfaceFreeCoVar covar) = ppr covar
ppr_co _ (IfaceCoVarCo covar) = ppr covar
ppr_co _ (IfaceHoleCo covar) = braces (ppr covar)
@@ -2176,6 +2176,7 @@ ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))
instance Binary IfaceType where
put_ _ (IfaceFreeTyVar tv)
= pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)
+ -- See Note [Free TyVars and CoVars in IfaceType]
put_ bh (IfaceForAllTy aa ab) = do
putByte bh 0
@@ -2324,9 +2325,10 @@ instance Binary IfaceCoercion where
put_ bh b
put_ _ (IfaceFreeCoVar cv)
= pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
+ -- See Note [Free TyVars and CoVars in IfaceType]
put_ _ (IfaceHoleCo cv)
= pprPanic "Can't serialise IfaceHoleCo" (ppr cv)
- -- See Note [Holes in IfaceCoercion]
+ -- See Note [Holes in IfaceCoercion]
get bh = do
tag <- getByte bh
@@ -2399,6 +2401,7 @@ instance Binary IfaceUnivCoProv where
put_ bh (IfacePluginProv a cvs fcvs) = do
putByte bh 3
put_ bh a
+ -- See Note [Free TyVars and CoVars in IfaceType]
assertPpr (null fcvs) (ppr cvs $$ ppr fcvs) $
put_ bh cvs
=====================================
compiler/GHC/Types/TyThing/Ppr.hs
=====================================
@@ -98,7 +98,7 @@ Consequences:
(in GHC.IfaceToCore). For example, IfaceClosedSynFamilyTyCon
stores a [IfaceAxBranch] that is used only for pretty-printing.
-- See Note [Free tyvars in IfaceType] in GHC.Iface.Type
+- See Note [Free TyVars and CoVars in IfaceType] in GHC.Iface.Type
See #7730, #8776 for details -}
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -19,8 +19,9 @@ Compiler
for typing plugins, gets an extra ``DCoVarSet`` argument.
The argument is intended to contain the in-scope coercion variables
that the the proof represented by the coercion makes use of.
-See ``Note [The importance of tracking free coercion variables]`` in ``GHC.Core.TyCo.Rep``,
- :ref:`constraint-solving-with-plugins`, and the migration guide.
+See ``Note [The importance of tracking free coercion variables]``
+in ``GHC.Core.TyCo.Rep``, :ref:`constraint-solving-with-plugins`
+and the migration guide.
GHCi
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a549f6439673134fb609666cb8e85c73645c8586...3dc19098d999738cc236450caf33016948e9eef8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a549f6439673134fb609666cb8e85c73645c8586...3dc19098d999738cc236450caf33016948e9eef8
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/20240409/7570bad5/attachment-0001.html>
More information about the ghc-commits
mailing list