Replace errors from badOrigBinding with new one (#22839)

Problem: in 02279a9c the type-level [] syntax was changed from a built-in name
to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if
a name is not built-in then it must have come from TH quotation, but this is
not necessarily the case with [].

The outdated assumption in badOrigBinding leads to incorrect error messages.
This code:
  data []
Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []"

Unfortunately, there is not enough information in RdrName to directly determine
if the name was constructed via TH or by the parser, so this patch changes the
error message instead.

It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote
into a new error TcRnBindingOfExistingName and changes its wording to avoid
guessing the origin of the name.

2 files changed, 23 insertions, 39 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 984cf95903..e173567844 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -25,7 +25,7 @@ module GHC.Tc.Errors.Ppr
 import GHC.Prelude
 
 import GHC.Builtin.Names
-import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon )
+import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon, filterCTuple )
 
 import GHC.Core.Coercion
 import GHC.Core.Unify     ( tcMatchTys )
@@ -968,10 +968,6 @@ 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
     TcRnPragmaWarning {pragma_warning_occ, pragma_warning_msg, pragma_warning_import_mod, pragma_warning_defined_mod}
       -> mkSimpleDecorated $
         sep [ sep [ text "In the use of"
@@ -1238,6 +1234,8 @@ instance Diagnostic TcRnMessage where
               Left gbl_names -> vcat (map (\name -> quotes (ppr $ grePrintableName name) <+> pprNameProvenance name) gbl_names)
               Right lcl_name -> quotes (ppr lcl_name) <+> text "defined at"
                 <+> ppr (nameSrcLoc lcl_name)
+    TcRnBindingOfExistingName name -> mkSimpleDecorated $
+      text "Illegal binding of an existing name:" <+> ppr (filterCTuple name)
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -1552,10 +1550,6 @@ instance Diagnostic TcRnMessage where
       -> WarningWithoutFlag
     TcRnSpecialiseNotVisible{}
       -> WarningWithoutFlag
-    TcRnNameByTemplateHaskellQuote{}
-      -> ErrorWithoutFlag
-    TcRnIllegalBindingOfBuiltIn{}
-      -> ErrorWithoutFlag
     TcRnPragmaWarning{}
       -> WarningWithFlag Opt_WarnWarningsDeprecations
     TcRnIllegalHsigDefaultMethods{}
@@ -1646,6 +1640,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnCapturedTermName{}
       -> WarningWithFlag Opt_WarnTermVariableCapture
+    TcRnBindingOfExistingName{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -1962,10 +1958,6 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnSpecialiseNotVisible name
       -> [SuggestSpecialiseVisibilityHints name]
-    TcRnNameByTemplateHaskellQuote{}
-      -> noHints
-    TcRnIllegalBindingOfBuiltIn{}
-      -> noHints
     TcRnPragmaWarning{}
       -> noHints
     TcRnIllegalHsigDefaultMethods{}
@@ -2059,6 +2051,8 @@ instance Diagnostic TcRnMessage where
       -> [suggestExtension LangExt.TupleSections]
     TcRnCapturedTermName{}
       -> [SuggestRenameTypeVariable]
+    TcRnBindingOfExistingName{}
+      -> noHints
 
   diagnosticCode = constructorCode
 
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index add396957c..3846dd874d 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -2193,32 +2193,6 @@ 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
-
   {- TcRnPragmaWarning is a warning that can happen when usage of something
      is warned or deprecated by pragma.
 
@@ -2773,6 +2747,22 @@ data TcRnMessage where
   -}
   TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage
 
+  {- TcRnBindingOfExistingName is an error triggered by an attempt to rebind
+     built-in syntax, punned list or tuple syntax, or a name quoted via Template Haskell.
+
+     Examples:
+
+       data []
+       data (->)
+       $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])
+
+     Test cases: rename/should_fail/T14907b
+                 rename/should_fail/T22839
+                 rename/should_fail/rnfail042
+                 th/T13968
+  -}
+  TcRnBindingOfExistingName :: RdrName -> TcRnMessage
+
   deriving Generic
 
 -- | Things forbidden in @type data@ declarations.