[Git][ghc/ghc][master] Add structured error messages for GHC.Tc.Utils.Backpack
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Mar 17 18:37:08 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00
Add structured error messages for GHC.Tc.Utils.Backpack
Tracking ticket: #20119
MR: !10127
This converts uses of `mkTcRnUnknownMessage` to newly added constructors
of `TcRnMessage`.
One occurrence, when handing a nested error from the interface loading
machinery, was omitted. It will be handled by a subsequent changeset
that addresses interface errors.
- - - - -
15 changed files:
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Name/Shape.hs
- testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
- testsuite/tests/backpack/should_fail/bkpfail01.stderr
- testsuite/tests/backpack/should_fail/bkpfail05.stderr
- testsuite/tests/backpack/should_fail/bkpfail09.stderr
- testsuite/tests/backpack/should_fail/bkpfail16.stderr
- testsuite/tests/backpack/should_fail/bkpfail20.stderr
- testsuite/tests/backpack/should_fail/bkpfail21.stderr
- testsuite/tests/backpack/should_fail/bkpfail35.stderr
- testsuite/tests/backpack/should_fail/bkpfail37.stderr
- testsuite/tests/backpack/should_fail/bkpfail38.stderr
Changes:
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -73,6 +73,7 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
+import GHC.Types.Fixity (defaultFixity)
import GHC.Unit.State (pprWithUnitState, UnitState)
import GHC.Unit.Module
@@ -994,6 +995,32 @@ instance Diagnostic TcRnMessage where
TcRnIllegalHsigDefaultMethods name meths
-> mkSimpleDecorated $
text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file"
+ TcRnHsigFixityMismatch real_thing real_fixity sig_fixity
+ ->
+ let ppr_fix f = ppr f <+> if f == defaultFixity then parens (text "default") else empty
+ in mkSimpleDecorated $
+ vcat [ppr real_thing <+> text "has conflicting fixities in the module",
+ text "and its hsig file",
+ text "Main module:" <+> ppr_fix real_fixity,
+ text "Hsig file:" <+> ppr_fix sig_fixity]
+ TcRnHsigShapeMismatch (HsigShapeSortMismatch info1 info2)
+ -> mkSimpleDecorated $
+ text "While merging export lists, could not combine"
+ <+> ppr info1 <+> text "with" <+> ppr info2
+ <+> parens (text "one is a type, the other is a plain identifier")
+ TcRnHsigShapeMismatch (HsigShapeNotUnifiable name1 name2 notHere)
+ ->
+ let extra = if notHere
+ then text "Neither name variable originates from the current signature."
+ else empty
+ in mkSimpleDecorated $
+ text "While merging export lists, could not unify"
+ <+> ppr name1 <+> text "with" <+> ppr name2 $$ extra
+ TcRnHsigMissingModuleExport occ unit_state impl_mod
+ -> mkSimpleDecorated $
+ quotes (ppr occ)
+ <+> text "is exported by the hsig file, but not exported by the implementing module"
+ <+> quotes (pprWithUnitState unit_state $ ppr impl_mod)
TcRnBadGenericMethod clas op
-> mkSimpleDecorated $
hsep [text "Class", quotes (ppr clas),
@@ -1726,6 +1753,12 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag Opt_WarnWarningsDeprecations
TcRnIllegalHsigDefaultMethods{}
-> ErrorWithoutFlag
+ TcRnHsigFixityMismatch{}
+ -> ErrorWithoutFlag
+ TcRnHsigShapeMismatch{}
+ -> ErrorWithoutFlag
+ TcRnHsigMissingModuleExport{}
+ -> ErrorWithoutFlag
TcRnBadGenericMethod{}
-> ErrorWithoutFlag
TcRnWarningMinimalDefIncomplete{}
@@ -2196,6 +2229,12 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnIllegalHsigDefaultMethods{}
-> noHints
+ TcRnHsigFixityMismatch{}
+ -> noHints
+ TcRnHsigShapeMismatch{}
+ -> noHints
+ TcRnHsigMissingModuleExport{}
+ -> noHints
TcRnBadGenericMethod{}
-> noHints
TcRnWarningMinimalDefIncomplete{}
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -91,6 +91,7 @@ module GHC.Tc.Errors.Types (
, DeclSort(..)
, NonStandardGuards(..)
, RuleLhsErrReason(..)
+ , HsigShapeMismatchReason(..)
) where
import GHC.Prelude
@@ -105,6 +106,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol)
, FixedRuntimeRepOrigin(..) )
import GHC.Tc.Types.Rank (Rank)
import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType)
+import GHC.Types.Avail (AvailInfo)
import GHC.Types.Error
import GHC.Types.Hint (UntickedPromotedThing(..))
import GHC.Types.ForeignCall (CLabelString)
@@ -2239,10 +2241,39 @@ data TcRnMessage where
Test case:
bkpfail40
-}
-
TcRnIllegalHsigDefaultMethods :: !Name -- ^ 'Name' of the class
-> NE.NonEmpty (LHsBind GhcRn) -- ^ default methods
-> TcRnMessage
+
+ {-| TcRnHsigFixityMismatch is an error indicating that the fixity decl in a
+ Backpack signature file differs from the one in the source file for the same
+ operator.
+
+ Test cases:
+ bkpfail37, bkpfail38
+ -}
+ TcRnHsigFixityMismatch :: !TyThing -- ^ The operator whose fixity is defined
+ -> !Fixity -- ^ the fixity used in the source file
+ -> !Fixity -- ^ the fixity used in the signature
+ -> TcRnMessage
+
+ {-| TcRnHsigShapeMismatch is a group of errors related to mismatches between
+ backpack signatures.
+ -}
+ TcRnHsigShapeMismatch :: !HsigShapeMismatchReason
+ -> TcRnMessage
+
+ {-| TcRnHsigMissingModuleExport is an error indicating that a module doesn't
+ export a name exported by its signature.
+
+ Test cases:
+ bkpfail01, bkpfail05, bkpfail09, bkpfail16, bkpfail35, bkpcabal06
+ -}
+ TcRnHsigMissingModuleExport :: !OccName -- ^ The missing name
+ -> !UnitState -- ^ The module's unit state
+ -> !Module -- ^ The implementation module
+ -> TcRnMessage
+
{-| TcRnBadGenericMethod
This test ensures that if you provide a "more specific" type signatures
for the default method, you must also provide a binding.
@@ -4419,3 +4450,24 @@ data NonStandardGuards where
data RuleLhsErrReason
= UnboundVariable RdrName NotInScopeError
| IllegalExpression
+
+data HsigShapeMismatchReason =
+ {-| HsigShapeSortMismatch is an error indicating that an item in the
+ export list of a signature doesn't match the item of the same name in
+ another signature when merging the two – one is a type while the other is a
+ plain identifier.
+
+ Test cases:
+ none
+ -}
+ HsigShapeSortMismatch !AvailInfo !AvailInfo
+ |
+ {-| HsigShapeNotUnifiable is an error indicating that a name in the
+ export list of a signature cannot be unified with a name of the same name in
+ another signature when merging the two.
+
+ Test cases:
+ bkpfail20, bkpfail21
+ -}
+ HsigShapeNotUnifiable !Name !Name !Bool
+ deriving (Generic)
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -88,21 +88,6 @@ import Data.List (find)
import {-# SOURCE #-} GHC.Tc.Module
-
-fixityMisMatch :: TyThing -> Fixity -> Fixity -> TcRnMessage
-fixityMisMatch real_thing real_fixity sig_fixity =
- mkTcRnUnknownMessage $ mkPlainError noHints $
- vcat [ppr real_thing <+> text "has conflicting fixities in the module",
- text "and its hsig file",
- text "Main module:" <+> ppr_fix real_fixity,
- text "Hsig file:" <+> ppr_fix sig_fixity]
- where
- ppr_fix f =
- ppr f <+>
- (if f == defaultFixity
- then parens (text "default")
- else empty)
-
checkHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn ()
checkHsigDeclM sig_iface sig_thing real_thing = do
let name = getName real_thing
@@ -115,7 +100,7 @@ checkHsigDeclM sig_iface sig_thing real_thing = do
Just f -> f
when (real_fixity /= sig_fixity) $
addErrAt (nameSrcSpan name)
- (fixityMisMatch real_thing real_fixity sig_fixity)
+ (TcRnHsigFixityMismatch real_thing real_fixity sig_fixity)
-- | Given a 'ModDetails' of an instantiated signature (note that the
-- 'ModDetails' must be knot-tied consistently with the actual implementation)
@@ -677,7 +662,7 @@ mergeSignatures
-- 3(d). Extend the name substitution (performing shaping)
mb_r <- extend_ns nsubst as2
case mb_r of
- Left err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err)
+ Left err -> failWithTc (TcRnHsigShapeMismatch err)
Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces)
nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0)
ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0))
@@ -1004,10 +989,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
-- we need. (Notice we IGNORE the Modules in the AvailInfos.)
forM_ (exportOccs (mi_exports isig_iface)) $ \occ ->
case lookupGlobalRdrEnv impl_gr occ of
- [] -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $
- quotes (ppr occ)
- <+> text "is exported by the hsig file, but not exported by the implementing module"
- <+> quotes (pprWithUnitState unit_state $ ppr impl_mod)
+ [] -> addErr $ TcRnHsigMissingModuleExport occ unit_state impl_mod
_ -> return ()
failIfErrsM
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -471,6 +471,11 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl" = 50649
GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods" = 93006
+ GhcDiagnosticCode "TcRnHsigFixityMismatch" = 93007
+ GhcDiagnosticCode "HsigShapeSortMismatch" = 93008
+ GhcDiagnosticCode "HsigShapeNotUnifiable" = 93009
+ GhcDiagnosticCode "TcRnHsigNoIface" = 93010
+ GhcDiagnosticCode "TcRnHsigMissingModuleExport" = 93011
GhcDiagnosticCode "TcRnBadGenericMethod" = 59794
GhcDiagnosticCode "TcRnWarningMinimalDefIncomplete" = 13511
GhcDiagnosticCode "TcRnDefaultMethodForPragmaLacksBinding" = 28587
@@ -691,6 +696,7 @@ type family ConRecursInto con where
ConRecursInto "TcRnPragmaWarning" = 'Just (WarningTxt GhcRn)
ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError
ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason
+ ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason
--
-- TH errors
=====================================
compiler/GHC/Types/Name/Shape.hs
=====================================
@@ -25,8 +25,8 @@ import GHC.Types.Name.Env
import GHC.Tc.Utils.Monad
import GHC.Iface.Env
+import GHC.Tc.Errors.Types
-import GHC.Utils.Outputable
import GHC.Utils.Panic.Plain
import Control.Monad
@@ -106,7 +106,7 @@ mkNameShape mod_name as =
-- restricted notion of shaping than in Backpack'14: we do shaping
-- *as* we do type-checking. Thus, once we shape a signature, its
-- exports are *final* and we're not allowed to refine them further,
-extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either SDoc NameShape)
+extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either HsigShapeMismatchReason NameShape)
extendNameShape hsc_env ns as =
case uAvailInfos (ns_mod_name ns) (ns_exports ns) as of
Left err -> return (Left err)
@@ -224,7 +224,7 @@ mergeAvails as1 as2 =
-- | Unify two lists of 'AvailInfo's, given an existing substitution @subst@,
-- with only name holes from @flexi@ unifiable (all other name holes rigid.)
-uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst
+uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either HsigShapeMismatchReason ShNameSubst
uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $
let mkOE as = listToUFM $ do a <- as
n <- availNames a
@@ -236,34 +236,27 @@ uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $
-- | Unify two 'AvailInfo's, given an existing substitution @subst@,
-- with only name holes from @flexi@ unifiable (all other name holes rigid.)
uAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo
- -> Either SDoc ShNameSubst
+ -> Either HsigShapeMismatchReason ShNameSubst
uAvailInfo flexi subst (Avail (NormalGreName n1)) (Avail (NormalGreName n2)) = uName flexi subst n1 n2
uAvailInfo flexi subst (AvailTC n1 _) (AvailTC n2 _) = uName flexi subst n1 n2
-uAvailInfo _ _ a1 a2 = Left $ text "While merging export lists, could not combine"
- <+> ppr a1 <+> text "with" <+> ppr a2
- <+> parens (text "one is a type, the other is a plain identifier")
+uAvailInfo _ _ a1 a2 = Left $ HsigShapeSortMismatch a1 a2
-- | Unify two 'Name's, given an existing substitution @subst@,
-- with only name holes from @flexi@ unifiable (all other name holes rigid.)
-uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst
+uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either HsigShapeMismatchReason ShNameSubst
uName flexi subst n1 n2
| n1 == n2 = Right subst
| isFlexi n1 = uHoleName flexi subst n1 n2
| isFlexi n2 = uHoleName flexi subst n2 n1
- | otherwise = Left (text "While merging export lists, could not unify"
- <+> ppr n1 <+> text "with" <+> ppr n2 $$ extra)
+ | otherwise = Left (HsigShapeNotUnifiable n1 n2 (isHoleName n1 || isHoleName n2))
where
isFlexi n = isHoleName n && moduleName (nameModule n) == flexi
- extra | isHoleName n1 || isHoleName n2
- = text "Neither name variable originates from the current signature."
- | otherwise
- = empty
-- | Unify a name @h@ which 'isHoleName' with another name, given an existing
-- substitution @subst@, with only name holes from @flexi@ unifiable (all
-- other name holes rigid.)
uHoleName :: ModuleName -> ShNameSubst -> Name {- hole name -} -> Name
- -> Either SDoc ShNameSubst
+ -> Either HsigShapeMismatchReason ShNameSubst
uHoleName flexi subst h n =
assert (isHoleName h) $
case lookupNameEnv subst h of
=====================================
testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
=====================================
@@ -1,4 +1,4 @@
-sig/P.hsig:1:1: error:
+sig/P.hsig:1:1: error: [GHC-93011]
• ‘p’ is exported by the hsig file, but not exported by the implementing module ‘bkpcabal06-0.1.0.0:impl:P’
• while checking that bkpcabal06-0.1.0.0:impl:P implements signature P in bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:impl:P]
=====================================
testsuite/tests/backpack/should_fail/bkpfail01.stderr
=====================================
@@ -10,10 +10,10 @@
Instantiating p[H=q:H]
[1 of 2] Compiling H[sig] ( p/H.hsig, nothing )
-bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error:
+bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
-bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error:
+bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
=====================================
testsuite/tests/backpack/should_fail/bkpfail05.stderr
=====================================
@@ -18,6 +18,6 @@
Instantiating h[H=h-impl:H]
[1 of 1] Compiling H[sig] ( h/H.hsig, bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/H.o )
-bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error:
+bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error: [GHC-93011]
• ‘T1’ is exported by the hsig file, but not exported by the implementing module ‘h-impl:H’
• while checking that h-impl:H implements signature H in h[H=h-impl:H]
=====================================
testsuite/tests/backpack/should_fail/bkpfail09.stderr
=====================================
@@ -8,10 +8,10 @@
[1 of 3] Compiling H2[sig] ( r/H2.hsig, nothing )
[2 of 3] Instantiating p
-Command line argument: -unit-id p[H=H]:0:0: error:
+Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
-Command line argument: -unit-id p[H=H]:0:0: error:
+Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011]
• ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’
• while checking that q:H implements signature H in p[H=q:H]
=====================================
testsuite/tests/backpack/should_fail/bkpfail16.stderr
=====================================
@@ -6,6 +6,6 @@
Instantiating p[ShouldFail=base-4.13.0.0:Data.Bool]
[1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/ShouldFail.o )
-bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error:
+bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: [GHC-93011]
• ‘Booly’ is exported by the hsig file, but not exported by the implementing module ‘Data.Bool’
• while checking that Data.Bool implements signature ShouldFail in p[ShouldFail=Data.Bool]
=====================================
testsuite/tests/backpack/should_fail/bkpfail20.stderr
=====================================
@@ -5,7 +5,7 @@
[3 of 3] Processing r
[1 of 3] Compiling B[sig] ( r/B.hsig, nothing )
-bkpfail20.bkp:1:1: error:
+bkpfail20.bkp:1:1: error: [GHC-93009]
• While merging export lists, could not unify Data.STRef.Lazy.newSTRef with GHC.STRef.newSTRef
• while merging the signatures from:
• p[A=<B>]:A
=====================================
testsuite/tests/backpack/should_fail/bkpfail21.stderr
=====================================
@@ -9,7 +9,7 @@
[2 of 5] Compiling H1[sig] ( r/H1.hsig, nothing )
[3 of 5] Compiling H3[sig] ( r/H3.hsig, nothing )
-bkpfail21.bkp:1:1: error:
+bkpfail21.bkp:1:1: error: [GHC-93009]
• While merging export lists, could not unify {H1.T} with {H2.T}
Neither name variable originates from the current signature.
• while merging the signatures from:
=====================================
testsuite/tests/backpack/should_fail/bkpfail35.stderr
=====================================
@@ -13,6 +13,6 @@
Instantiating q[A=aimpl:A]
[1 of 1] Compiling A[sig] ( q/A.hsig, bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/A.o )
-bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error:
+bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: [GHC-93011]
• ‘y’ is exported by the hsig file, but not exported by the implementing module ‘aimpl:A’
• while checking that aimpl:A implements signature A in q[A=aimpl:A]
=====================================
testsuite/tests/backpack/should_fail/bkpfail37.stderr
=====================================
@@ -9,7 +9,7 @@
Instantiating p[A=q:A]
[1 of 1] Compiling A[sig] ( p/A.hsig, bkpfail37.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o )
-bkpfail37.bkp:9:9: error:
+bkpfail37.bkp:9:9: error: [GHC-93007]
• Identifier ‘op’ has conflicting fixities in the module
and its hsig file
Main module: infixr 4
=====================================
testsuite/tests/backpack/should_fail/bkpfail38.stderr
=====================================
@@ -5,7 +5,7 @@
[3 of 3] Processing r
[1 of 3] Compiling A[sig] ( r/A.hsig, nothing )
-bkpfail38.bkp:8:9: error:
+bkpfail38.bkp:8:9: error: [GHC-93007]
• Identifier ‘op’ has conflicting fixities in the module
and its hsig file
Main module: infixr 4
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73d07c6e1986bd2b3516d4f009cc1e30ba804f06
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73d07c6e1986bd2b3516d4f009cc1e30ba804f06
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/20230317/817d7516/attachment-0001.html>
More information about the ghc-commits
mailing list