From 4329f3b61061af0ac513dcec79cb5c21662785d6 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 17 Mar 2025 15:34:14 +0100
Subject: [PATCH] Remove SDocs from HsDocContext
This commit removes the remaining SDocs from the HsDocContext data type.
It adds the following constructors:
ClassInstanceCtx -- Class instances
ClassMethodSigCtx -- Class method signatures
SpecialiseSigCtx -- SPECIALISE pragmas
PatSynSigCtx -- Pattern synonym signatures
We now report a bit more information for errors while renaming class instances,
which slightly improves renamer-emitted error messages.
---
compiler/GHC/Rename/Bind.hs | 15 +++------
compiler/GHC/Rename/Module.hs | 33 +++++++++----------
compiler/GHC/Tc/Errors/Ppr.hs | 15 +++++++--
compiler/GHC/Tc/Errors/Types.hs | 21 +++++++++---
compiler/GHC/Tc/Gen/Splice.hs | 2 +-
.../dependent/should_fail/T16326_Fail8.stderr | 4 +--
.../tests/parser/should_fail/T3811c.stderr | 2 +-
.../should_fail/WildcardInInstanceHead.stderr | 4 +--
.../tests/rename/should_fail/T16114.stderr | 6 ++--
.../tests/rename/should_fail/T18240a.stderr | 16 ++++-----
.../tests/rename/should_fail/T5951.stderr | 6 ++--
.../tests/saks/should_fail/T16722.stderr | 4 +--
.../saks/should_fail/saks_fail003.stderr | 4 +--
.../should_fail/ExplicitSpecificity5.stderr | 6 ++--
.../should_fail/ExplicitSpecificity6.stderr | 10 +++---
.../tests/typecheck/should_fail/T16394.stderr | 6 ++--
16 files changed, 83 insertions(+), 71 deletions(-)
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 49f5c1e1911..3a05e27f5d3 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -1066,7 +1066,7 @@ renameSigs ctxt sigs
renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars)
renameSig ctxt sig@(TypeSig _ vs ty)
= do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
- ; let doc = TypeSigCtx (ppr_sig_bndrs vs)
+ ; let doc = TypeSigCtx vs
; (new_ty, fvs) <- rnHsSigWcType doc ty
; return (TypeSig noAnn new_vs new_ty, fvs) }
@@ -1079,8 +1079,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
; return (ClassOpSig noAnn is_deflt new_v new_ty, fvs) }
where
v1:|_ = expectNonEmpty vs
- ty_ctxt = GenericCtx (text "a class method signature for"
- <+> quotes (ppr v1))
+ ty_ctxt = ClassMethodSigCtx v1
renameSig _ (SpecInstSig (_, src) ty)
= do { checkInferredVars doc ty
@@ -1106,10 +1105,8 @@ renameSig ctxt sig@(SpecSig _ v tys inl)
; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
; return (SpecSig noAnn new_v new_ty inl, fvs) }
where
- ty_ctxt = GenericCtx (text "a SPECIALISE signature for"
- <+> quotes (ppr v))
do_one (tys,fvs) ty
- = do { (new_ty, fvs_ty) <- rnHsSigType ty_ctxt TypeLevel ty
+ = do { (new_ty, fvs_ty) <- rnHsSigType (SpecialiseSigCtx v) TypeLevel ty
; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
renameSig _ctxt (SpecSigE _ bndrs spec_e inl)
@@ -1136,8 +1133,7 @@ renameSig ctxt sig@(PatSynSig _ vs ty)
; (ty', fvs) <- rnHsSigType ty_ctxt TypeLevel ty
; return (PatSynSig noAnn new_vs ty', fvs) }
where
- ty_ctxt = GenericCtx (text "a pattern synonym signature for"
- <+> ppr_sig_bndrs vs)
+ ty_ctxt = PatSynSigCtx vs
renameSig ctxt sig@(SCCFunSig (_, st) v s)
= do { new_v <- lookupSigOccRn ctxt sig v
@@ -1195,9 +1191,6 @@ For now we simply disallow orphan COMPLETE pragmas, as the added
complexity of supporting them properly doesn't seem worthwhile.
-}
-ppr_sig_bndrs :: [LocatedN RdrName] -> SDoc
-ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
-
okHsSig :: HsSigCtxt -> LSig (GhcPass a) -> Bool
okHsSig ctxt (L _ sig)
= case (sig, ctxt) of
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index c9ffdbf089e..45d491fb7c6 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
@@ -581,16 +582,17 @@ rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
, cid_sigs = uprags, cid_tyfam_insts = ats
, cid_overlap_mode = oflag
, cid_datafam_insts = adts })
- = do { checkInferredVars ctxt inst_ty
- ; (inst_ty', inst_fvs) <- rnHsSigType ctxt TypeLevel inst_ty
- ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'
- -- Check if there are any nested `forall`s or contexts, which are
+ = do { rec { let ctxt = ClassInstanceCtx head_ty'
+ ; checkInferredVars ctxt inst_ty
+ ; (inst_ty', inst_fvs) <- rnHsSigType ctxt TypeLevel inst_ty
+ ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'
+ }
+ ; let -- Check if there are any nested `forall`s or contexts, which are
-- illegal in the type of an instance declaration (see
-- Note [No nested foralls or contexts in instance types] in
-- GHC.Hs.Type)...
- mb_nested_msg = noNestedForallsContextsErr
- NFC_InstanceHead head_ty'
- -- ...then check if the instance head is actually headed by a
+ mb_nested_msg = noNestedForallsContextsErr NFC_InstanceHead head_ty'
+ -- ...then check that the instance head is actually headed by a
-- class type constructor...
eith_cls = case hsTyGetAppHead_maybe head_ty' of
Just (L _ cls) -> Right cls
@@ -607,8 +609,8 @@ rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
-- from mb_nested_msg or eith_cls at a time.
; cls <- case (mb_nested_msg, eith_cls) of
(Nothing, Right cls) -> pure cls
- (Just err1, _) -> bail_out err1
- (_, Left err2) -> bail_out err2
+ (Just err1, _) -> bail_out ctxt err1
+ (_, Left err2) -> bail_out ctxt err2
-- Rename the bindings
-- The typechecker (not the renamer) checks that all
@@ -648,14 +650,12 @@ rnClsInstDecl (ClsInstDecl { cid_ext = (inst_warn_ps, _, _)
-- strange, but should not matter (and it would be more work
-- to remove the context).
where
- ctxt = GenericCtx $ text "an instance declaration"
-
-- The instance is malformed. We'd still like to make *some* progress
-- (rather than failing outright), so we report an error and continue for
-- as long as we can. Importantly, this error should be thrown before we
-- reach the typechecker, lest we encounter different errors that are
-- hopelessly confusing (such as the one in #16114).
- bail_out (l, err_msg) = do
+ bail_out ctxt (l, err_msg) = do
addErrAt l $ TcRnWithHsDocContext ctxt err_msg
pure $ mkUnboundName (mkTcOccFS (fsLit "<class>"))
@@ -1513,8 +1513,7 @@ rnStandaloneKindSignature tc_names (StandaloneKindSig _ v ki)
= do { standalone_ki_sig_ok <- xoptM LangExt.StandaloneKindSignatures
; unless standalone_ki_sig_ok $ addErr TcRnUnexpectedStandaloneKindSig
; new_v <- lookupSigCtxtOccRn (TopSigCtxt tc_names) SigLikeStandaloneKindSig v
- ; let doc = StandaloneKindSigCtx (ppr v)
- ; (new_ki, fvs) <- rnHsSigType doc KindLevel ki
+ ; (new_ki, fvs) <- rnHsSigType (StandaloneKindSigCtx v) KindLevel ki
; return (StandaloneKindSig noExtField new_v new_ki, fvs)
}
@@ -1883,8 +1882,8 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond
}
has_labelled_fields (ConDeclGADT { con_g_args = RecConGADT _ _ }) = True
- has_labelled_fields (ConDeclH98 { con_args = RecCon rec })
- = not (null (unLoc rec))
+ has_labelled_fields (ConDeclH98 { con_args = RecCon flds })
+ = not (null (unLoc flds))
has_labelled_fields _ = False
has_strictness_flags condecl
@@ -2523,7 +2522,7 @@ extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do {
conDetailsVisArity :: HsPatSynDetails (GhcPass p) -> VisArity
conDetailsVisArity = \case
PrefixCon args -> length args
- RecCon rec -> length rec
+ RecCon flds -> length flds
InfixCon _ _ -> 2
{-
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index f796ebfe480..6bb68b5516d 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -5607,8 +5607,8 @@ inHsDocContext ctxt = text "In" <+> pprHsDocContext ctxt
pprHsDocContext :: HsDocContext -> SDoc
pprHsDocContext (GenericCtx doc) = doc
-pprHsDocContext (TypeSigCtx doc) = text "the type signature for" <+> doc
-pprHsDocContext (StandaloneKindSigCtx doc) = text "the standalone kind signature for" <+> doc
+pprHsDocContext (TypeSigCtx vs) = text "the type signature for" <+> ppr_sig_bndrs vs
+pprHsDocContext (StandaloneKindSigCtx v)= text "the standalone kind signature for" <+> quotes (ppr v)
pprHsDocContext PatCtx = text "a pattern type-signature"
pprHsDocContext SpecInstSigCtx = text "a SPECIALISE instance pragma"
pprHsDocContext DefaultDeclCtx = text "a `default' declaration"
@@ -5626,7 +5626,13 @@ pprHsDocContext HsTypeCtx = text "a type argument"
pprHsDocContext HsTypePatCtx = text "a type argument in a pattern"
pprHsDocContext GHCiCtx = text "GHCi input"
pprHsDocContext (SpliceTypeCtx hs_ty) = text "the spliced type" <+> quotes (ppr hs_ty)
-pprHsDocContext ClassInstanceCtx = text "GHC.Tc.Gen.Splice.reifyInstances"
+pprHsDocContext ReifyInstancesCtx = text "GHC.Tc.Gen.Splice.reifyInstances"
+pprHsDocContext (ClassInstanceCtx inst_ty) =
+ text "the instance declaration for" <+> quotes (ppr inst_ty)
+pprHsDocContext (ClassMethodSigCtx name) = text "a class method signature for" <+> quotes (ppr name)
+pprHsDocContext (SpecialiseSigCtx name) = text "a SPECIALISE signature for" <+> quotes (ppr name)
+pprHsDocContext (PatSynSigCtx vs) =
+ text "a pattern synonym signature for" <+> ppr_sig_bndrs vs
pprHsDocContext (ForeignDeclCtx name)
= text "the foreign declaration for" <+> quotes (ppr name)
@@ -5635,6 +5641,9 @@ pprHsDocContext (ConDeclCtx [name])
pprHsDocContext (ConDeclCtx names)
= text "the definition of data constructors" <+> interpp'SP names
+ppr_sig_bndrs :: [LocatedN RdrName] -> SDoc
+ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
+
pprConversionFailReason :: ConversionFailReason -> SDoc
pprConversionFailReason = \case
IllegalOccName ctxt_ns occ ->
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index a0a7b84ea6c..9bacf1fad41 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -6024,11 +6024,13 @@ data FixedRuntimeRepErrorInfo
************************************************************************
-}
--- AZ:TODO: Change these all to be Name instead of RdrName.
--- Merge TcType.UserTypeContext in to it.
+-- | An error message context, for errors in the renamer.
+--
+-- TODO: this should probably get merged in some way with 'ErrCtxtMsg',
+-- but that's a battle for another day.
data HsDocContext
- = TypeSigCtx SDoc
- | StandaloneKindSigCtx SDoc
+ = TypeSigCtx [LocatedN RdrName]
+ | StandaloneKindSigCtx (LocatedN RdrName)
| PatCtx
| SpecInstSigCtx
| DefaultDeclCtx
@@ -6048,7 +6050,16 @@ data HsDocContext
| HsTypePatCtx
| GHCiCtx
| SpliceTypeCtx (LHsType GhcPs)
- | ClassInstanceCtx
+ | ReifyInstancesCtx
+ | ClassInstanceCtx (LHsType GhcRn)
+ | ClassMethodSigCtx (LocatedN RdrName) -- ^ Class method signature
+ | SpecialiseSigCtx (LocatedN RdrName) -- ^ SPECIALISE signature
+ | PatSynSigCtx [LocatedN RdrName] -- ^ Pattern synonym signature
+
+ -- | Escape hatch, for GHC plugins and other GHC API users.
+ --
+ -- Not for use within GHC; add a new constructor to 'HsDocContext'
+ -- if you need to add a new renamer error context.
| GenericCtx SDoc
-- | Context for a mismatch in the number of arguments
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index e7969b0fa87..35b0bce6a71 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -1929,7 +1929,7 @@ reifyInstances' th_nm th_tys
; return $ Right (tc, map fim_instance matches) }
_ -> bale_out $ TcRnTHError $ THReifyError $ CannotReifyInstance ty }
where
- doc = ClassInstanceCtx
+ doc = ReifyInstancesCtx
bale_out msg = failWithTc msg
cvt :: EnumSet LangExt.Extension -> Origin -> SrcSpan -> TH.Type -> TcM (LHsType GhcPs)
diff --git a/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr b/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr
index 2896c7c336f..d72526de307 100644
--- a/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr
+++ b/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr
@@ -1,4 +1,4 @@
-
T16326_Fail8.hs:7:10: error: [GHC-51580]
• Illegal visible, dependent quantification in the type of a term
- • In an instance declaration
+ • In the instance declaration for ‘forall a -> C (Blah a)’
+
diff --git a/testsuite/tests/parser/should_fail/T3811c.stderr b/testsuite/tests/parser/should_fail/T3811c.stderr
index 9c91612b63e..f8060ca7f7a 100644
--- a/testsuite/tests/parser/should_fail/T3811c.stderr
+++ b/testsuite/tests/parser/should_fail/T3811c.stderr
@@ -1,5 +1,5 @@
T3811c.hs:6:10: error: [GHC-18932]
• Unexpected strictness (!) annotation: !Show
strictness (!) annotation can only appear on the arguments of a data constructor type
- • In an instance declaration
+ • In the instance declaration for ‘Show D’
diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr
index 4b2d2872c14..c219ced1771 100644
--- a/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr
@@ -1,4 +1,4 @@
-
WildcardInInstanceHead.hs:7:14: error: [GHC-65507]
• Wildcard ‘_’ not allowed
- • In an instance declaration
+ • In the instance declaration for ‘Foo _’
+
diff --git a/testsuite/tests/rename/should_fail/T16114.stderr b/testsuite/tests/rename/should_fail/T16114.stderr
index 8ed4db8192b..c51833ad9e1 100644
--- a/testsuite/tests/rename/should_fail/T16114.stderr
+++ b/testsuite/tests/rename/should_fail/T16114.stderr
@@ -1,4 +1,4 @@
-
T16114.hs:4:18: error: [GHC-71492]
- Instance head cannot contain nested ‘forall’s or contexts
- In an instance declaration
+ • Instance head cannot contain nested ‘forall’s or contexts
+ • In the instance declaration for ‘Eq a => Eq (T a)’
+
diff --git a/testsuite/tests/rename/should_fail/T18240a.stderr b/testsuite/tests/rename/should_fail/T18240a.stderr
index 096edd20734..89dab707f4a 100644
--- a/testsuite/tests/rename/should_fail/T18240a.stderr
+++ b/testsuite/tests/rename/should_fail/T18240a.stderr
@@ -1,43 +1,43 @@
-
T18240a.hs:11:11: error: [GHC-71492]
• Instance head cannot contain nested ‘forall’s or contexts
- • In an instance declaration
+ • In the instance declaration for ‘(forall a. C [a])’
T18240a.hs:12:15: error: [GHC-76037]
Not in scope: type variable ‘a’
T18240a.hs:14:11: error: [GHC-71492]
• Instance head cannot contain nested ‘forall’s or contexts
- • In an instance declaration
+ • In the instance declaration for ‘(Eq a => C [a])’
T18240a.hs:17:11: error: [GHC-71492]
• Instance head cannot contain nested ‘forall’s or contexts
- • In an instance declaration
+ • In the instance declaration for ‘(forall a. C (Either a b))’
T18240a.hs:18:22: error: [GHC-76037]
Not in scope: type variable ‘a’
T18240a.hs:20:21: error: [GHC-71492]
• Instance head cannot contain nested ‘forall’s or contexts
- • In an instance declaration
+ • In the instance declaration for ‘(forall b. C (Either a b))’
T18240a.hs:21:24: error: [GHC-76037]
Not in scope: type variable ‘b’
T18240a.hs:23:19: error: [GHC-71492]
• Instance head cannot contain nested ‘forall’s or contexts
- • In an instance declaration
+ • In the instance declaration for ‘(Eq b => C (Either a b))’
T18240a.hs:28:10: error: [GHC-53946]
• Illegal head of an instance declaration: ‘42’.
Instance heads must be of the form
C ty_1 ... ty_n
where ‘C’ is a class.
- • In an instance declaration
+ • In the instance declaration for ‘42’
T18240a.hs:29:10: error: [GHC-53946]
• Illegal head of an instance declaration: ‘Int -> Int’.
Instance heads must be of the form
C ty_1 ... ty_n
where ‘C’ is a class.
- • In an instance declaration
+ • In the instance declaration for ‘Int -> Int’
+
diff --git a/testsuite/tests/rename/should_fail/T5951.stderr b/testsuite/tests/rename/should_fail/T5951.stderr
index 19d849c8f79..3e376db558d 100644
--- a/testsuite/tests/rename/should_fail/T5951.stderr
+++ b/testsuite/tests/rename/should_fail/T5951.stderr
@@ -1,4 +1,4 @@
-
T5951.hs:9:8: error: [GHC-71492]
- Instance head cannot contain nested ‘forall’s or contexts
- In an instance declaration
+ • Instance head cannot contain nested ‘forall’s or contexts
+ • In the instance declaration for ‘B => C’
+
diff --git a/testsuite/tests/saks/should_fail/T16722.stderr b/testsuite/tests/saks/should_fail/T16722.stderr
index 16ad413e563..e65b3770b2f 100644
--- a/testsuite/tests/saks/should_fail/T16722.stderr
+++ b/testsuite/tests/saks/should_fail/T16722.stderr
@@ -1,6 +1,6 @@
-
T16722.hs:8:11: error: [GHC-12875]
• Unexpected kind variable ‘k’
- • In the standalone kind signature for D
+ • In the standalone kind signature for ‘D’
Suggested fix:
Perhaps you intended to use the ‘PolyKinds’ extension
+
diff --git a/testsuite/tests/saks/should_fail/saks_fail003.stderr b/testsuite/tests/saks/should_fail/saks_fail003.stderr
index 605f1fd6386..3d8402ac587 100644
--- a/testsuite/tests/saks/should_fail/saks_fail003.stderr
+++ b/testsuite/tests/saks/should_fail/saks_fail003.stderr
@@ -1,4 +1,4 @@
-
saks_fail003.hs:6:11: error: [GHC-65507]
• Wildcard ‘_’ not allowed
- • In the standalone kind signature for T
+ • In the standalone kind signature for ‘T’
+
diff --git a/testsuite/tests/typecheck/should_fail/ExplicitSpecificity5.stderr b/testsuite/tests/typecheck/should_fail/ExplicitSpecificity5.stderr
index 270a1561c61..5d0117cf936 100644
--- a/testsuite/tests/typecheck/should_fail/ExplicitSpecificity5.stderr
+++ b/testsuite/tests/typecheck/should_fail/ExplicitSpecificity5.stderr
@@ -1,4 +1,4 @@
-
ExplicitSpecificity5.hs:7:1: error: [GHC-54832]
- Inferred type variables are not allowed
- In an instance declaration
+ • Inferred type variables are not allowed
+ • In the instance declaration for ‘C (Either a b)’
+
diff --git a/testsuite/tests/typecheck/should_fail/ExplicitSpecificity6.stderr b/testsuite/tests/typecheck/should_fail/ExplicitSpecificity6.stderr
index db62abcb4b5..743216f7403 100644
--- a/testsuite/tests/typecheck/should_fail/ExplicitSpecificity6.stderr
+++ b/testsuite/tests/typecheck/should_fail/ExplicitSpecificity6.stderr
@@ -1,8 +1,8 @@
-
ExplicitSpecificity6.hs:8:1: error: [GHC-54832]
- Inferred type variables are not allowed
- In an instance declaration
+ • Inferred type variables are not allowed
+ • In the instance declaration for ‘C (Either a b)’
ExplicitSpecificity6.hs:9:3: error: [GHC-54832]
- Inferred type variables are not allowed
- In a SPECIALISE instance pragma
+ • Inferred type variables are not allowed
+ • In a SPECIALISE instance pragma
+
diff --git a/testsuite/tests/typecheck/should_fail/T16394.stderr b/testsuite/tests/typecheck/should_fail/T16394.stderr
index af8384ccfed..c1c1846f1d8 100644
--- a/testsuite/tests/typecheck/should_fail/T16394.stderr
+++ b/testsuite/tests/typecheck/should_fail/T16394.stderr
@@ -1,4 +1,4 @@
-
T16394.hs:6:17: error: [GHC-71492]
- Instance head cannot contain nested ‘forall’s or contexts
- In an instance declaration
+ • Instance head cannot contain nested ‘forall’s or contexts
+ • In the instance declaration for ‘C b => C (a, b)’
+
--
GitLab