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.

10 files changed, 57 insertions, 70 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 0c0e944d64..ec423d0087 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -187,7 +187,7 @@ newTopSrcBinder (L loc rdr_name)
     if isExternalName name then
       do { this_mod <- getModule
          ; unless (this_mod == nameModule name)
-                  (addErrAt (locA loc) (badOrigBinding rdr_name))
+                  (addErrAt (locA loc) (TcRnBindingOfExistingName rdr_name))
          ; return name }
     else   -- See Note [Binders in Template Haskell] in "GHC.ThToHs"
       do { this_mod <- getModule
@@ -196,7 +196,7 @@ newTopSrcBinder (L loc rdr_name)
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
   = do  { this_mod <- getModule
         ; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
-                 (addErrAt (locA loc) (badOrigBinding rdr_name))
+                 (addErrAt (locA loc) (TcRnBindingOfExistingName rdr_name))
         -- When reading External Core we get Orig names as binders,
         -- but they should agree with the module gotten from the monad
         --
@@ -205,7 +205,7 @@ newTopSrcBinder (L loc rdr_name)
         -- the constructor is parsed as a type, and then GHC.Parser.PostProcess.tyConToDataCon
         -- uses setRdrNameSpace to make it into a data constructors.  At that point
         -- the nice Exact name for the TyCon gets swizzled to an Orig name.
-        -- Hence the badOrigBinding error message.
+        -- Hence the TcRnBindingOfExistingName error message.
         --
 
         -- MP 2022: I suspect this code path is never called for `rOOT_MAIN` anymore
@@ -2118,13 +2118,3 @@ lookupQualifiedDoName ctxt std_name
   = case qualifiedDoModuleName_maybe ctxt of
       Nothing -> lookupSyntaxName std_name
       Just modName -> lookupNameWithQualifier std_name modName
-
-
--- Error messages
-
-badOrigBinding :: RdrName -> TcRnMessage
-badOrigBinding name
-  | 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 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.
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index 544ebc905f..c46320da0d 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -468,8 +468,6 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnNonOverloadedSpecialisePragma"             = 35827
   GhcDiagnosticCode "TcRnSpecialiseNotVisible"                      = 85337
   GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl"                   = 50649
-  GhcDiagnosticCode "TcRnNameByTemplateHaskellQuote"                = 40027
-  GhcDiagnosticCode "TcRnIllegalBindingOfBuiltIn"                   = 69639
 
   GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods"                 = 93006
   GhcDiagnosticCode "TcRnBadGenericMethod"                          = 59794
@@ -502,6 +500,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnBadFamInstDecl"                            = 06206
   GhcDiagnosticCode "TcRnNotOpenFamily"                             = 06207
   GhcDiagnosticCode "TcRnCapturedTermName"                          = 54201
+  GhcDiagnosticCode "TcRnBindingOfExistingName"                     = 58805
 
   -- IllegalNewtypeReason
   GhcDiagnosticCode "DoesNotHaveSingleField"                        = 23517
@@ -607,6 +606,8 @@ type family GhcDiagnosticCode c = n | n -> c where
   -- no longer reports. These are collected below.
 
   GhcDiagnosticCode "Example outdated error"                        = 00000
+  GhcDiagnosticCode "TcRnNameByTemplateHaskellQuote"                = 40027
+  GhcDiagnosticCode "TcRnIllegalBindingOfBuiltIn"                   = 69639
 
 {- *********************************************************************
 *                                                                      *
diff --git a/testsuite/tests/rename/should_fail/T14907b.stderr b/testsuite/tests/rename/should_fail/T14907b.stderr
index c113238389..e499b6b354 100644
--- a/testsuite/tests/rename/should_fail/T14907b.stderr
+++ b/testsuite/tests/rename/should_fail/T14907b.stderr
@@ -1,9 +1,9 @@
 
-T14907b.hs:5:1: error: [GHC-69639]
-    Illegal binding of built-in syntax: ()
+T14907b.hs:5:1: error: [GHC-58805]
+    Illegal binding of an existing name: ()
 
-T14907b.hs:6:1: error: [GHC-69639]
-    Illegal binding of built-in syntax: (,)
+T14907b.hs:6:1: error: [GHC-58805]
+    Illegal binding of an existing name: (,)
 
-T14907b.hs:7:1: error: [GHC-69639]
-    Illegal binding of built-in syntax: (,,)
+T14907b.hs:7:1: error: [GHC-58805]
+    Illegal binding of an existing name: (,,)
diff --git a/testsuite/tests/rename/should_fail/T22839.hs b/testsuite/tests/rename/should_fail/T22839.hs
new file mode 100644
index 0000000000..2bb66caffd
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T22839.hs
@@ -0,0 +1,5 @@
+module T22839 where
+
+data []
+
+data (->)
diff --git a/testsuite/tests/rename/should_fail/T22839.stderr b/testsuite/tests/rename/should_fail/T22839.stderr
new file mode 100644
index 0000000000..964aa96295
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T22839.stderr
@@ -0,0 +1,6 @@
+
+T22839.hs:3:1: error: [GHC-58805]
+    Illegal binding of an existing name: []
+
+T22839.hs:5:1: error: [GHC-58805]
+    Illegal binding of an existing name: ->
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index f4f6685fdc..c25ba747e7 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -183,3 +183,4 @@ test('T21605a', normal, compile_fail, [''])
 test('T21605b', normal, compile_fail, [''])
 test('T21605c', normal, compile_fail, [''])
 test('T21605d', normal, compile_fail, [''])
+test('T22839', normal, compile_fail, [''])
diff --git a/testsuite/tests/rename/should_fail/rnfail042.stderr b/testsuite/tests/rename/should_fail/rnfail042.stderr
index 3ba1f9566f..bea8a97f50 100644
--- a/testsuite/tests/rename/should_fail/rnfail042.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail042.stderr
@@ -1,12 +1,12 @@
 
-rnfail042.hs:5:11: error: [GHC-69639]
-    Illegal binding of built-in syntax: ()
+rnfail042.hs:5:11: error: [GHC-58805]
+    Illegal binding of an existing name: ()
 
-rnfail042.hs:6:10: error: [GHC-69639]
-    Illegal binding of built-in syntax: (,,,)
+rnfail042.hs:6:10: error: [GHC-58805]
+    Illegal binding of an existing name: (,,,)
 
-rnfail042.hs:7:12: error: [GHC-69639]
-    Illegal binding of built-in syntax: []
+rnfail042.hs:7:12: error: [GHC-58805]
+    Illegal binding of an existing name: []
 
-rnfail042.hs:8:13: error: [GHC-69639]
-    Illegal binding of built-in syntax: :
+rnfail042.hs:8:13: error: [GHC-58805]
+    Illegal binding of an existing name: :
diff --git a/testsuite/tests/th/T13968.stderr b/testsuite/tests/th/T13968.stderr
index 95be60b0b1..fb6f967ede 100644
--- a/testsuite/tests/th/T13968.stderr
+++ b/testsuite/tests/th/T13968.stderr
@@ -1,3 +1,3 @@
 
-T13968.hs:6:2: error: [GHC-40027]
-    Cannot redefine a Name retrieved by a Template Haskell quote: succ
+T13968.hs:6:2: error: [GHC-58805]
+    Illegal binding of an existing name: succ