diff options
-rw-r--r-- | compiler/GHC/Rename/Env.hs | 60 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 32 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 70 | ||||
-rw-r--r-- | testsuite/tests/rename/should_fail/T12686.stderr | 8 | ||||
-rw-r--r-- | testsuite/tests/rename/should_fail/T3265.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/tcfail173.stderr | 2 |
6 files changed, 127 insertions, 49 deletions
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs index e5c1c17f3c..13343135ab 100644 --- a/compiler/GHC/Rename/Env.hs +++ b/compiler/GHC/Rename/Env.hs @@ -77,7 +77,7 @@ import GHC.Types.Hint import GHC.Types.Error import GHC.Unit.Module import GHC.Unit.Module.ModIface -import GHC.Unit.Module.Warnings ( WarningTxt, pprWarningTxtForMsg ) +import GHC.Unit.Module.Warnings ( WarningTxt ) import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.TyCon @@ -275,7 +275,7 @@ lookupTopBndrRn which_suggest rdr_name = let occ = rdrNameOcc rdr_name ; when (isTcOcc occ && isSymOcc occ) (do { op_ok <- xoptM LangExt.TypeOperators - ; unless op_ok (addErr (opDeclErr rdr_name)) }) + ; unless op_ok (addErr (TcRnIllegalTypeOperatorDecl rdr_name)) }) ; env <- getGlobalRdrEnv ; case filter isLocalGRE (lookupGRE_RdrName rdr_name env) of @@ -1111,10 +1111,10 @@ lookup_promoted rdr_name badVarInType :: RdrName -> RnM Name badVarInType rdr_name - = do { addErr (TcRnUnknownMessage $ mkPlainError noHints - (text "Illegal promoted term variable in a type:" - <+> ppr rdr_name)) - ; return (mkUnboundNameRdr rdr_name) } + = do { addErr (TcRnUnpromotableThing name TermVariablePE) + ; return name } + where + name = mkUnboundNameRdr rdr_name {- Note [Promoted variables in types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1553,34 +1553,22 @@ warnIfDeprecated gre@(GRE { gre_imp = iss }) -- See Note [Handling of deprecations] do { iface <- loadInterfaceForName doc name ; case lookupImpDeprec iface gre of - Just txt -> do - let msg = TcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations) - noHints - (mk_msg imp_spec txt) - - addDiagnostic msg + Just deprText -> addDiagnostic $ + TcRnDeprecated { + depr_occ = occ, + depr_msg = deprText, + depr_import_mod = importSpecModule imp_spec, + depr_defined_mod = definedMod + } Nothing -> return () } } | otherwise = return () where occ = greOccName gre name = greMangledName gre - name_mod = assertPpr (isExternalName name) (ppr name) (nameModule name) + definedMod = moduleName $ assertPpr (isExternalName name) (ppr name) (nameModule name) doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly" - mk_msg imp_spec txt - = sep [ sep [ text "In the use of" - <+> pprNonVarNameSpace (occNameSpace occ) - <+> quotes (ppr occ) - , parens imp_msg <> colon ] - , pprWarningTxtForMsg txt ] - where - imp_mod = importSpecModule imp_spec - imp_msg = text "imported from" <+> ppr imp_mod <> extra - extra | imp_mod == moduleName name_mod = Outputable.empty - | otherwise = text ", but defined in" <+> ppr name_mod - lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn) lookupImpDeprec iface gre = mi_warn_fn (mi_final_exts iface) (greOccName gre) `mplus` -- Bleat if the thing, @@ -2093,25 +2081,9 @@ lookupQualifiedDoName ctxt std_name -- Error messages -opDeclErr :: RdrName -> TcRnMessage -opDeclErr n - = TcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal declaration of a type or class operator" <+> quotes (ppr n)) - 2 (text "Use TypeOperators to declare operators in type and declarations") - badOrigBinding :: RdrName -> TcRnMessage badOrigBinding name - | Just _ <- isBuiltInOcc_maybe occ - = TcRnUnknownMessage $ mkPlainError noHints $ text "Illegal binding of built-in syntax:" <+> ppr occ - -- Use an OccName here because we don't want to print Prelude.(,) - | otherwise - = TcRnUnknownMessage $ mkPlainError noHints $ - text "Cannot redefine a Name retrieved by a Template Haskell quote:" <+> ppr name - -- This can happen when one tries to use a Template Haskell splice to - -- define a top-level identifier with an already existing name, e.g., - -- - -- $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []]) - -- - -- (See #13968.) + | Just _ <- isBuiltInOcc_maybe occ = TcRnIllegalBindingOfBuiltIn occ + | otherwise = TcRnNameByTemplateHaskellQuote name where occ = rdrNameOcc $ filterCTuple name diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 3dc1ea685b..3ab4fc2927 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -69,6 +69,7 @@ import GHC.Types.Var.Env import GHC.Unit.State (pprWithUnitState, UnitState) import GHC.Unit.Module +import GHC.Unit.Module.Warnings ( pprWarningTxtForMsg ) import GHC.Data.Bag import GHC.Data.FastString @@ -668,6 +669,9 @@ instance Diagnostic TcRnMessage where -> mkSimpleDecorated $ text "Illegal operator" <+> quotes (ppr op) <+> text "in type" <+> quotes (ppr overall_ty) + TcRnIllegalTypeOperatorDecl name + -> mkSimpleDecorated $ + text "Illegal declaration of a type or class operator" <+> quotes (ppr name) TcRnGADTMonoLocalBinds -> mkSimpleDecorated $ fsep [ text "Pattern matching on GADTs without MonoLocalBinds" @@ -894,6 +898,7 @@ instance Diagnostic TcRnMessage where RecDataConPE -> same_rec_group_msg ClassPE -> same_rec_group_msg TyConPE -> same_rec_group_msg + TermVariablePE -> text "term variables cannot be promoted" same_rec_group_msg = text "it is defined and used in the same recursive group" TcRnMatchesHaveDiffNumArgs argsContext match1 bad_matches -> mkSimpleDecorated $ @@ -937,6 +942,20 @@ instance Diagnostic TcRnMessage where -> mkSimpleDecorated $ text "You cannot SPECIALISE" <+> quotes (ppr name) <+> text "because its definition is not visible in this module" + TcRnNameByTemplateHaskellQuote name -> mkSimpleDecorated $ + text "Cannot redefine a Name retrieved by a Template Haskell quote:" <+> ppr name + TcRnIllegalBindingOfBuiltIn name -> mkSimpleDecorated $ + text "Illegal binding of built-in syntax:" <+> ppr name + TcRnDeprecated {depr_occ, depr_msg, depr_import_mod, depr_defined_mod} -> mkSimpleDecorated $ + sep [ sep [ text "In the use of" + <+> pprNonVarNameSpace (occNameSpace depr_occ) + <+> quotes (ppr depr_occ) + , parens impMsg <> colon ] + , pprWarningTxtForMsg depr_msg ] + where + impMsg = text "imported from" <+> ppr depr_import_mod <> extra + extra | depr_import_mod == depr_defined_mod = empty + | otherwise = text ", but defined in" <+> ppr depr_defined_mod diagnosticReason = \case TcRnUnknownMessage m @@ -1167,6 +1186,8 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnTypeEqualityRequiresOperators TcRnIllegalTypeOperator {} -> ErrorWithoutFlag + TcRnIllegalTypeOperatorDecl {} + -> ErrorWithoutFlag TcRnGADTMonoLocalBinds {} -> WarningWithFlag Opt_WarnGADTMonoLocalBinds TcRnIncorrectNameSpace {} @@ -1243,6 +1264,12 @@ instance Diagnostic TcRnMessage where -> WarningWithoutFlag TcRnSpecialiseNotVisible{} -> WarningWithoutFlag + TcRnNameByTemplateHaskellQuote{} + -> ErrorWithoutFlag + TcRnIllegalBindingOfBuiltIn{} + -> ErrorWithoutFlag + TcRnDeprecated{} + -> WarningWithFlag Opt_WarnWarningsDeprecations diagnosticHints = \case TcRnUnknownMessage m @@ -1467,6 +1494,8 @@ instance Diagnostic TcRnMessage where -> [suggestExtension LangExt.TypeOperators] TcRnIllegalTypeOperator {} -> [suggestExtension LangExt.TypeOperators] + TcRnIllegalTypeOperatorDecl {} + -> [suggestExtension LangExt.TypeOperators] TcRnGADTMonoLocalBinds {} -> [suggestAnyExtension [LangExt.GADTs, LangExt.TypeFamilies]] TcRnIncorrectNameSpace nm is_th_use @@ -1551,6 +1580,9 @@ instance Diagnostic TcRnMessage where -> noHints TcRnSpecialiseNotVisible name -> [SuggestSpecialiseVisibilityHints name] + TcRnNameByTemplateHaskellQuote{} -> noHints + TcRnIllegalBindingOfBuiltIn{} -> noHints + TcRnDeprecated{} -> noHints -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index ad5f3db81b..fff6ff7dc9 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -113,6 +113,7 @@ import GHC.Data.FastString (FastString) import qualified Data.List.NonEmpty as NE import Data.Typeable hiding (TyCon) import qualified Data.Semigroup as Semigroup +import GHC.Unit.Module.Warnings (WarningTxt) {- Note [Migrating TcM Messages] @@ -1621,6 +1622,27 @@ data TcRnMessage where -} TcRnIllegalTypeOperator :: !SDoc -> !RdrName -> TcRnMessage + {-| TcRnIllegalTypeOperatorDecl is an error that occurs when a type or class + operator is declared without the TypeOperators extension. + + See Note [Type and class operator definitions] + + Example: + {-# LANGUAGE Haskell2010 #-} + {-# LANGUAGE MultiParamTypeClasses #-} + + module T3265 where + + data a :+: b = Left a | Right b + + class a :*: b where {} + + + Test cases: T3265, tcfail173 + -} + TcRnIllegalTypeOperatorDecl :: !RdrName -> TcRnMessage + + {-| TcRnGADTMonoLocalBinds is a warning controlled by -Wgadt-mono-local-binds that occurs when pattern matching on a GADT when -XMonoLocalBinds is off. @@ -2006,6 +2028,7 @@ data TcRnMessage where polykinds/T15116a saks/should_fail/T16727a saks/should_fail/T16727b + rename/should_fail/T12686 -} TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage @@ -2109,6 +2132,50 @@ data TcRnMessage where -} TcRnSpecialiseNotVisible :: !Name -> TcRnMessage + {- TcRnNameByTemplateHaskellQuote is an error that occurs when one tries + to use a Template Haskell splice to define a top-level identifier with + an already existing name. + + (See issue #13968 (closed) on GHC's issue tracker for more details) + + Example(s): + + $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []]) + + Test cases: + T13968 + -} + TcRnNameByTemplateHaskellQuote :: !RdrName -> TcRnMessage + + {- TcRnIllegalBindingOfBuiltIn is an error that occurs when one uses built-in + syntax for data constructors or class names. + + Use an OccName here because we don't want to print Prelude.(,) + + Test cases: + rename/should_fail/T14907b + rename/should_fail/rnfail042 + -} + TcRnIllegalBindingOfBuiltIn :: !OccName -> TcRnMessage + + {- TcRnDeprecated is a warning that can happen when usage of something + is deprecated. + + Test cases: + DeprU + T5281 + T5867 + rn050 + rn066 + T3303 + -} + TcRnDeprecated :: { + depr_occ :: OccName, + depr_msg :: WarningTxt GhcRn, + depr_import_mod :: ModuleName, + depr_defined_mod :: ModuleName + } -> TcRnMessage + -- | Specifies which back ends can handle a requested foreign import or export type ExpectedBackends = [Backend] @@ -3081,6 +3148,7 @@ data PromotionErr | RecDataConPE -- Data constructor in a recursive loop -- See Note [Recursion and promoting data constructors] in GHC.Tc.TyCl + | TermVariablePE -- See Note [Promoted variables in types] | NoDataKindsDC -- -XDataKinds not enabled (for a datacon) instance Outputable PromotionErr where @@ -3092,6 +3160,7 @@ instance Outputable PromotionErr where <+> parens (ppr pred) ppr RecDataConPE = text "RecDataConPE" ppr NoDataKindsDC = text "NoDataKindsDC" + ppr TermVariablePE = text "TermVariablePE" pprPECategory :: PromotionErr -> SDoc pprPECategory = text . capitalise . peCategory @@ -3104,6 +3173,7 @@ peCategory FamDataConPE = "data constructor" peCategory ConstrainedDataConPE{} = "data constructor" peCategory RecDataConPE = "data constructor" peCategory NoDataKindsDC = "data constructor" +peCategory TermVariablePE = "term variable" -- | Stores the information to be reported in a representation-polymorphism -- error message. diff --git a/testsuite/tests/rename/should_fail/T12686.stderr b/testsuite/tests/rename/should_fail/T12686.stderr index 24acc9c8c1..682a3bd8f4 100644 --- a/testsuite/tests/rename/should_fail/T12686.stderr +++ b/testsuite/tests/rename/should_fail/T12686.stderr @@ -1,4 +1,8 @@ -T12686.hs:7:16: error: Illegal promoted term variable in a type: x +T12686.hs:7:16: + Term variable ‘x’ cannot be used here + (term variables cannot be promoted) -T12686.hs:12:19: error: Illegal promoted term variable in a type: a +T12686.hs:12:19: + Term variable ‘a’ cannot be used here + (term variables cannot be promoted) diff --git a/testsuite/tests/rename/should_fail/T3265.stderr b/testsuite/tests/rename/should_fail/T3265.stderr index 42d89d0b4e..8ef1acdf39 100644 --- a/testsuite/tests/rename/should_fail/T3265.stderr +++ b/testsuite/tests/rename/should_fail/T3265.stderr @@ -1,8 +1,8 @@ T3265.hs:8:8: error: Illegal declaration of a type or class operator ‘:+:’ - Use TypeOperators to declare operators in type and declarations + Suggested fix: Perhaps you intended to use TypeOperators T3265.hs:10:9: error: Illegal declaration of a type or class operator ‘:*:’ - Use TypeOperators to declare operators in type and declarations + Suggested fix: Perhaps you intended to use TypeOperators diff --git a/testsuite/tests/typecheck/should_fail/tcfail173.stderr b/testsuite/tests/typecheck/should_fail/tcfail173.stderr index a3da917f27..bd3a062062 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail173.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail173.stderr @@ -1,4 +1,4 @@ tcfail173.hs:6:12: error: Illegal declaration of a type or class operator ‘<.>’ - Use TypeOperators to declare operators in type and declarations + Suggested fix: Perhaps you intended to use TypeOperators |