Generate unique names for derived auxiliary bindings, don't deduplicate themwip/T18321

Previously, GHC attempted to deduplicate auxiliary bindings for
derived instances to avoid name clashes. See
`Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate`. However, this
approach was not bulletproof, as #18321 shows that this approach can
fall over in the presence of Template Haskell splices.

Rather than attempting to repair the previous approach, this patch
adopts the different approach of simply generating multiple copies of
each form of auxiliary binding, each with its own unique name taken
from a global counter. This can lead to code bloat, but GHC's CSE
pass in the optimizer is usually quite good about catching these,
since the definitions of auxiliary bindings are small. See the
revamped `Note [Auxiliary binders]` for the full story.

Fix #18321.

7 files changed, 370 insertions, 275 deletions

diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index a4d2be7ac6..013fd76a3e 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -202,9 +202,7 @@ tcDeriving deriv_infos deriv_decls
         ; dflags <- getDynFlags
 
         ; let (_, deriv_stuff, fvs) = unzip3 (insts1 ++ insts2)
-        ; loc <- getSrcSpanM
-        ; let (binds, famInsts) = genAuxBinds dflags loc
-                                    (unionManyBags deriv_stuff)
+        ; let (binds, famInsts) = genAuxBinds (unionManyBags deriv_stuff)
 
         ; let mk_inst_infos1 = map fstOf3 insts1
         ; inst_infos1 <- apply_inst_infos mk_inst_infos1 given_specs
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index a9791043a2..2ebd1d11eb 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -46,8 +46,6 @@ import GHC.Types.Name.Reader
 import GHC.Types.Basic
 import GHC.Core.DataCon
 import GHC.Types.Name
-import GHC.Utils.Fingerprint
-import GHC.Utils.Encoding
 
 import GHC.Driver.Session
 import GHC.Builtin.Utils
@@ -81,22 +79,18 @@ import Data.List  ( find, partition, intersperse )
 
 type BagDerivStuff = Bag DerivStuff
 
-data AuxBindSpec
-  = DerivCon2Tag TyCon  -- The con2Tag for given TyCon
-  | DerivTag2Con TyCon  -- ...ditto tag2Con
-  | DerivMaxTag  TyCon  -- ...and maxTag
-  deriving( Eq )
-  -- All these generate ZERO-BASED tag operations
-  -- I.e first constructor has tag 0
-
 data DerivStuff     -- Please add this auxiliary stuff
-  = DerivAuxBind AuxBindSpec
-
-  -- Generics and DeriveAnyClass
-  | DerivFamInst FamInst               -- New type family instances
+  = DerivFamInst FamInst
+    -- ^ A new type family instance. Used for:
+    --
+    -- * @DeriveGeneric@, which generates instances of @Rep(1)@
+    --
+    -- * @DeriveAnyClass@, which can fill in associated type family defaults
 
   -- New top-level auxiliary bindings
-  | DerivHsBind (LHsBind GhcPs, LSig GhcPs) -- Also used for SYB
+  | DerivHsBind (LHsBind GhcPs, LSig GhcPs)
+    -- ^ A new, top-level auxiliary binding. Used for deriving 'Eq', 'Ord',
+    --   'Enum', 'Ix', and 'Data'. See Note [Auxiliary binders].
 
 
 {-
@@ -160,8 +154,11 @@ produced don't get through the typechecker.
 
 gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
 gen_Eq_binds loc tycon = do
-    dflags <- getDynFlags
-    return (method_binds dflags, aux_binds)
+    -- See Note [Auxiliary binders]
+    con2tag_occ <- chooseUniqueOccTc (mkCon2TagOcc (getOccName tycon))
+    let con2tag_RDR = mkRdrUnqual con2tag_occ
+
+    return (method_binds con2tag_RDR, aux_binds con2tag_RDR)
   where
     all_cons = tyConDataCons tycon
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons
@@ -175,7 +172,7 @@ gen_Eq_binds loc tycon = do
 
     no_tag_match_cons = null tag_match_cons
 
-    fall_through_eqn dflags
+    fall_through_eqn con2tag_RDR
       | no_tag_match_cons   -- All constructors have arguments
       = case pat_match_cons of
           []  -> []   -- No constructors; no fall-though case
@@ -187,16 +184,18 @@ gen_Eq_binds loc tycon = do
       | otherwise -- One or more tag_match cons; add fall-through of
                   -- extract tags compare for equality
       = [([a_Pat, b_Pat],
-         untag_Expr dflags tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
+         untag_Expr con2tag_RDR [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
                     (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]
 
-    aux_binds | no_tag_match_cons = emptyBag
-              | otherwise         = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
+    aux_binds con2tag_RDR
+      | no_tag_match_cons = emptyBag
+      | otherwise         = unitBag $ genCon2Tag con2tag_RDR loc tycon
 
-    method_binds dflags = unitBag (eq_bind dflags)
-    eq_bind dflags = mkFunBindEC 2 loc eq_RDR (const true_Expr)
-                                 (map pats_etc pat_match_cons
-                                   ++ fall_through_eqn dflags)
+    method_binds con2tag_RDR = unitBag (eq_bind con2tag_RDR)
+    eq_bind con2tag_RDR
+      = mkFunBindEC 2 loc eq_RDR (const true_Expr)
+                    (map pats_etc pat_match_cons
+                      ++ fall_through_eqn con2tag_RDR)
 
     ------------------------------------------------------------------
     pats_etc data_con
@@ -340,21 +339,26 @@ gtResult OrdGT      = true_Expr
 ------------
 gen_Ord_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
 gen_Ord_binds loc tycon = do
-    dflags <- getDynFlags
+    -- See Note [Auxiliary binders]
+    con2tag_occ <- chooseUniqueOccTc (mkCon2TagOcc (getOccName tycon))
+    let con2tag_RDR = mkRdrUnqual con2tag_occ
+
     return $ if null tycon_data_cons -- No data-cons => invoke bale-out case
       then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) []
            , emptyBag)
-      else ( unitBag (mkOrdOp dflags OrdCompare) `unionBags` other_ops dflags
-           , aux_binds)
+      else ( unitBag (mkOrdOp con2tag_RDR OrdCompare)
+             `unionBags` other_ops con2tag_RDR
+           , aux_binds con2tag_RDR)
   where
-    aux_binds | single_con_type = emptyBag
-              | otherwise       = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
+    aux_binds con2tag_RDR
+      | single_con_type = emptyBag
+      | otherwise       = unitBag $ genCon2Tag con2tag_RDR loc tycon
 
         -- Note [Game plan for deriving Ord]
-    other_ops dflags
+    other_ops con2tag_RDR
       | (last_tag - first_tag) <= 2     -- 1-3 constructors
         || null non_nullary_cons        -- Or it's an enumeration
-      = listToBag [mkOrdOp dflags OrdLT, lE, gT, gE]
+      = listToBag [mkOrdOp con2tag_RDR OrdLT, lE, gT, gE]
       | otherwise
       = emptyBag
 
@@ -380,39 +384,40 @@ gen_Ord_binds loc tycon = do
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon tycon_data_cons
 
 
-    mkOrdOp :: DynFlags -> OrdOp -> LHsBind GhcPs
+    mkOrdOp :: RdrName -> OrdOp -> LHsBind GhcPs
     -- Returns a binding   op a b = ... compares a and b according to op ....
-    mkOrdOp dflags op = mkSimpleGeneratedFunBind loc (ordMethRdr op) [a_Pat, b_Pat]
-                                        (mkOrdOpRhs dflags op)
+    mkOrdOp con2tag_RDR op
+      = mkSimpleGeneratedFunBind loc (ordMethRdr op) [a_Pat, b_Pat]
+                        (mkOrdOpRhs con2tag_RDR op)
 
-    mkOrdOpRhs :: DynFlags -> OrdOp -> LHsExpr GhcPs
-    mkOrdOpRhs dflags op       -- RHS for comparing 'a' and 'b' according to op
+    mkOrdOpRhs :: RdrName -> OrdOp -> LHsExpr GhcPs
+    mkOrdOpRhs con2tag_RDR op -- RHS for comparing 'a' and 'b' according to op
       | nullary_cons `lengthAtMost` 2 -- Two nullary or fewer, so use cases
       = nlHsCase (nlHsVar a_RDR) $
-        map (mkOrdOpAlt dflags op) tycon_data_cons
+        map (mkOrdOpAlt con2tag_RDR op) tycon_data_cons
         -- i.e.  case a of { C1 x y -> case b of C1 x y -> ....compare x,y...
         --                   C2 x   -> case b of C2 x -> ....comopare x.... }
 
       | null non_nullary_cons    -- All nullary, so go straight to comparing tags
-      = mkTagCmp dflags op
+      = mkTagCmp con2tag_RDR op
 
       | otherwise                -- Mixed nullary and non-nullary
       = nlHsCase (nlHsVar a_RDR) $
-        (map (mkOrdOpAlt dflags op) non_nullary_cons
-         ++ [mkHsCaseAlt nlWildPat (mkTagCmp dflags op)])
+        (map (mkOrdOpAlt con2tag_RDR op) non_nullary_cons
+         ++ [mkHsCaseAlt nlWildPat (mkTagCmp con2tag_RDR op)])
 
 
-    mkOrdOpAlt :: DynFlags -> OrdOp -> DataCon
+    mkOrdOpAlt :: RdrName -> OrdOp -> DataCon
                   -> LMatch GhcPs (LHsExpr GhcPs)
     -- Make the alternative  (Ki a1 a2 .. av ->
-    mkOrdOpAlt dflags op data_con
+    mkOrdOpAlt con2tag_RDR op data_con
       = mkHsCaseAlt (nlConVarPat data_con_RDR as_needed)
-                    (mkInnerRhs dflags op data_con)
+                    (mkInnerRhs con2tag_RDR op data_con)
       where
         as_needed    = take (dataConSourceArity data_con) as_RDRs
         data_con_RDR = getRdrName data_con
 
-    mkInnerRhs dflags op data_con
+    mkInnerRhs con2tag_RDR op data_con
       | single_con_type
       = nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con ]
 
@@ -435,14 +440,14 @@ gen_Ord_binds loc tycon = do
                                  , mkHsCaseAlt nlWildPat (gtResult op) ]
 
       | tag > last_tag `div` 2  -- lower range is larger
-      = untag_Expr dflags tycon [(b_RDR, bh_RDR)] $
+      = untag_Expr con2tag_RDR [(b_RDR, bh_RDR)] $
         nlHsIf (genPrimOpApp (nlHsVar bh_RDR) ltInt_RDR tag_lit)
                (gtResult op) $  -- Definitely GT
         nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con
                                  , mkHsCaseAlt nlWildPat (ltResult op) ]
 
       | otherwise               -- upper range is larger
-      = untag_Expr dflags tycon [(b_RDR, bh_RDR)] $
+      = untag_Expr con2tag_RDR [(b_RDR, bh_RDR)] $
         nlHsIf (genPrimOpApp (nlHsVar bh_RDR) gtInt_RDR tag_lit)
                (ltResult op) $  -- Definitely LT
         nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con
@@ -461,11 +466,11 @@ gen_Ord_binds loc tycon = do
         data_con_RDR = getRdrName data_con
         bs_needed    = take (dataConSourceArity data_con) bs_RDRs
 
-    mkTagCmp :: DynFlags -> OrdOp -> LHsExpr GhcPs
+    mkTagCmp :: RdrName -> OrdOp -> LHsExpr GhcPs
     -- Both constructors known to be nullary
     -- generates (case data2Tag a of a# -> case data2Tag b of b# -> a# `op` b#
-    mkTagCmp dflags op =
-      untag_Expr dflags tycon[(a_RDR, ah_RDR),(b_RDR, bh_RDR)] $
+    mkTagCmp con2tag_RDR op =
+      untag_Expr con2tag_RDR [(a_RDR, ah_RDR),(b_RDR, bh_RDR)] $
         unliftedOrdOp intPrimTy op ah_RDR bh_RDR
 
 mkCompareFields :: OrdOp -> [Type] -> LHsExpr GhcPs
@@ -585,78 +590,89 @@ For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
 
 gen_Enum_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
 gen_Enum_binds loc tycon = do
-    dflags <- getDynFlags
-    return (method_binds dflags, aux_binds)
+    -- See Note [Auxiliary binders]
+    con2tag_occ <- chooseUniqueOccTc (mkCon2TagOcc (getOccName tycon))
+    tag2con_occ <- chooseUniqueOccTc (mkTag2ConOcc (getOccName tycon))
+    maxtag_occ  <- chooseUniqueOccTc (mkMaxTagOcc  (getOccName tycon))
+    let con2tag_RDR = mkRdrUnqual con2tag_occ
+        tag2con_RDR = mkRdrUnqual tag2con_occ
+        maxtag_RDR  = mkRdrUnqual maxtag_occ
+
+    return ( method_binds con2tag_RDR tag2con_RDR maxtag_RDR
+           , aux_binds    con2tag_RDR tag2con_RDR maxtag_RDR )
   where
-    method_binds dflags = listToBag
-      [ succ_enum      dflags
-      , pred_enum      dflags
-      , to_enum        dflags
-      , enum_from      dflags -- [0 ..]
-      , enum_from_then dflags -- [0, 1 ..]
-      , from_enum      dflags
+    method_binds con2tag_RDR tag2con_RDR maxtag_RDR = listToBag
+      [ succ_enum      con2tag_RDR tag2con_RDR maxtag_RDR
+      , pred_enum      con2tag_RDR tag2con_RDR
+      , to_enum                    tag2con_RDR maxtag_RDR
+      , enum_from      con2tag_RDR tag2con_RDR maxtag_RDR -- [0 ..]
+      , enum_from_then con2tag_RDR tag2con_RDR maxtag_RDR -- [0, 1 ..]
+      , from_enum      con2tag_RDR
+      ]
+    aux_binds con2tag_RDR tag2con_RDR maxtag_RDR = listToBag
+      [ genCon2Tag con2tag_RDR loc tycon
+      , genTag2Con tag2con_RDR loc tycon
+      , genMaxTag  maxtag_RDR  loc tycon
       ]
-    aux_binds = listToBag $ map DerivAuxBind
-                  [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon]
 
     occ_nm = getOccString tycon
 
-    succ_enum dflags
+    succ_enum con2tag_RDR tag2con_RDR maxtag_RDR
       = mkSimpleGeneratedFunBind loc succ_RDR [a_Pat] $
-        untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
-        nlHsIf (nlHsApps eq_RDR [nlHsVar (maxtag_RDR dflags tycon),
+        untag_Expr con2tag_RDR [(a_RDR, ah_RDR)] $
+        nlHsIf (nlHsApps eq_RDR [nlHsVar maxtag_RDR,
                                nlHsVarApps intDataCon_RDR [ah_RDR]])
              (illegal_Expr "succ" occ_nm "tried to take `succ' of last tag in enumeration")
-             (nlHsApp (nlHsVar (tag2con_RDR dflags tycon))
+             (nlHsApp (nlHsVar tag2con_RDR)
                     (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
                                         nlHsIntLit 1]))
 
-    pred_enum dflags
+    pred_enum con2tag_RDR tag2con_RDR
       = mkSimpleGeneratedFunBind loc pred_RDR [a_Pat] $
-        untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
+        untag_Expr con2tag_RDR [(a_RDR, ah_RDR)] $
         nlHsIf (nlHsApps eq_RDR [nlHsIntLit 0,
                                nlHsVarApps intDataCon_RDR [ah_RDR]])
              (illegal_Expr "pred" occ_nm "tried to take `pred' of first tag in enumeration")
-             (nlHsApp (nlHsVar (tag2con_RDR dflags tycon))
+             (nlHsApp (nlHsVar tag2con_RDR)
                       (nlHsApps plus_RDR
                             [ nlHsVarApps intDataCon_RDR [ah_RDR]
                             , nlHsLit (HsInt noExtField
                                                 (mkIntegralLit (-1 :: Int)))]))
 
-    to_enum dflags
+    to_enum tag2con_RDR maxtag_RDR
       = mkSimpleGeneratedFunBind loc toEnum_RDR [a_Pat] $
         nlHsIf (nlHsApps and_RDR
                 [nlHsApps ge_RDR [nlHsVar a_RDR, nlHsIntLit 0],
                  nlHsApps le_RDR [ nlHsVar a_RDR
-                                 , nlHsVar (maxtag_RDR dflags tycon)]])
-             (nlHsVarApps (tag2con_RDR dflags tycon) [a_RDR])
-             (illegal_toEnum_tag occ_nm (maxtag_RDR dflags tycon))
+                                 , nlHsVar maxtag_RDR]])
+             (nlHsVarApps tag2con_RDR [a_RDR])
+             (illegal_toEnum_tag occ_nm maxtag_RDR)
 
-    enum_from dflags
+    enum_from con2tag_RDR tag2con_RDR maxtag_RDR
       = mkSimpleGeneratedFunBind loc enumFrom_RDR [a_Pat] $
-          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
+          untag_Expr con2tag_RDR [(a_RDR, ah_RDR)] $
           nlHsApps map_RDR
-                [nlHsVar (tag2con_RDR dflags tycon),
+                [nlHsVar tag2con_RDR,
                  nlHsPar (enum_from_to_Expr
                             (nlHsVarApps intDataCon_RDR [ah_RDR])
-                            (nlHsVar (maxtag_RDR dflags tycon)))]
+                            (nlHsVar maxtag_RDR))]
 
-    enum_from_then dflags
+    enum_from_then con2tag_RDR tag2con_RDR maxtag_RDR
       = mkSimpleGeneratedFunBind loc enumFromThen_RDR [a_Pat, b_Pat] $
-          untag_Expr dflags tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
-          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR dflags tycon]) $
+          untag_Expr con2tag_RDR [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
+          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR]) $
             nlHsPar (enum_from_then_to_Expr
                     (nlHsVarApps intDataCon_RDR [ah_RDR])
                     (nlHsVarApps intDataCon_RDR [bh_RDR])
                     (nlHsIf  (nlHsApps gt_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
                                                nlHsVarApps intDataCon_RDR [bh_RDR]])
                            (nlHsIntLit 0)
-                           (nlHsVar (maxtag_RDR dflags tycon))
+                           (nlHsVar maxtag_RDR)
                            ))
 
-    from_enum dflags
+    from_enum con2tag_RDR
       = mkSimpleGeneratedFunBind loc fromEnum_RDR [a_Pat] $
-          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
+          untag_Expr con2tag_RDR [(a_RDR, ah_RDR)] $
           (nlHsVarApps intDataCon_RDR [ah_RDR])
 
 {-
@@ -757,35 +773,42 @@ we follow the scheme given in Figure~19 of the Haskell~1.2 report
 gen_Ix_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
 
 gen_Ix_binds loc tycon = do
-    dflags <- getDynFlags
+    -- See Note [Auxiliary binders]
+    con2tag_occ <- chooseUniqueOccTc (mkCon2TagOcc (getOccName tycon))
+    tag2con_occ <- chooseUniqueOccTc (mkTag2ConOcc (getOccName tycon))
+    let con2tag_RDR = mkRdrUnqual con2tag_occ
+        tag2con_RDR = mkRdrUnqual tag2con_occ
+
     return $ if isEnumerationTyCon tycon
-      then (enum_ixes dflags, listToBag $ map DerivAuxBind
-                   [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon])
-      else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon)))
+      then ( enum_ixes con2tag_RDR tag2con_RDR
+           , listToBag [ genCon2Tag con2tag_RDR loc tycon
+                       , genTag2Con tag2con_RDR loc tycon
+                       ])
+      else (single_con_ixes, unitBag (genCon2Tag con2tag_RDR loc tycon))
   where
     --------------------------------------------------------------
-    enum_ixes dflags = listToBag
-      [ enum_range   dflags
-      , enum_index   dflags
-      , enum_inRange dflags
+    enum_ixes con2tag_RDR tag2con_RDR = listToBag
+      [ enum_range   con2tag_RDR tag2con_RDR
+      , enum_index   con2tag_RDR
+      , enum_inRange con2tag_RDR
       ]
 
-    enum_range dflags
+    enum_range con2tag_RDR tag2con_RDR
       = mkSimpleGeneratedFunBind loc range_RDR [nlTuplePat [a_Pat, b_Pat] Boxed] $
-          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
-          untag_Expr dflags tycon [(b_RDR, bh_RDR)] $
-          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR dflags tycon]) $
+          untag_Expr con2tag_RDR [(a_RDR, ah_RDR)] $
+          untag_Expr con2tag_RDR [(b_RDR, bh_RDR)] $
+          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR]) $
               nlHsPar (enum_from_to_Expr
                         (nlHsVarApps intDataCon_RDR [ah_RDR])
                         (nlHsVarApps intDataCon_RDR [bh_RDR]))
 
-    enum_index dflags
+    enum_index con2tag_RDR
       = mkSimpleGeneratedFunBind loc unsafeIndex_RDR
                 [noLoc (AsPat noExtField (noLoc c_RDR)
                            (nlTuplePat [a_Pat, nlWildPat] Boxed)),
                                 d_Pat] (
-           untag_Expr dflags tycon [(a_RDR, ah_RDR)] (
-           untag_Expr dflags tycon [(d_RDR, dh_RDR)] (
+           untag_Expr con2tag_RDR [(a_RDR, ah_RDR)] (
+           untag_Expr con2tag_RDR [(d_RDR, dh_RDR)] (
            let
                 rhs = nlHsVarApps intDataCon_RDR [c_RDR]
            in
@@ -796,11 +819,11 @@ gen_Ix_binds loc tycon = do
         )
 
     -- This produces something like `(ch >= ah) && (ch <= bh)`
-    enum_inRange dflags
+    enum_inRange con2tag_RDR
       = mkSimpleGeneratedFunBind loc inRange_RDR [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat] $
-          untag_Expr dflags tycon [(a_RDR, ah_RDR)] (
-          untag_Expr dflags tycon [(b_RDR, bh_RDR)] (
-          untag_Expr dflags tycon [(c_RDR, ch_RDR)] (
+          untag_Expr con2tag_RDR [(a_RDR, ah_RDR)] (
+          untag_Expr con2tag_RDR [(b_RDR, bh_RDR)] (
+          untag_Expr con2tag_RDR [(c_RDR, ch_RDR)] (
           -- This used to use `if`, which interacts badly with RebindableSyntax.
           -- See #11396.
           nlHsApps and_RDR
@@ -1324,54 +1347,17 @@ gen_Data_binds loc rep_tc
              dc_rdrs = map mkRdrUnqual dc_occs
 
        -- OK, now do the work
-       ; return (gen_data dflags dt_rdr dc_rdrs loc rep_tc) }
-
-gen_data :: DynFlags -> RdrName -> [RdrName]
-         -> SrcSpan -> TyCon
-         -> (LHsBinds GhcPs,      -- The method bindings
-             BagDerivStuff)       -- Auxiliary bindings
-gen_data dflags data_type_name constr_names loc rep_tc
-  = (listToBag [gfoldl_bind, gunfold_bind, toCon_bind, dataTypeOf_bind]
-     `unionBags` gcast_binds,
+       ; pure ( listToBag [ gfoldl_bind, gunfold_bind
+                          , toCon_bind dc_rdrs, dataTypeOf_bind dt_rdr ]
+                `unionBags` gcast_binds
                 -- Auxiliary definitions: the data type and constructors
-     listToBag ( genDataTyCon
-               : zipWith genDataDataCon data_cons constr_names ) )
+              , listToBag ( genDataTyCon dflags dt_rdr dc_rdrs loc rep_tc
+                          : zipWith (genDataDataCon dt_rdr loc) data_cons dc_rdrs )
+              ) }
   where
     data_cons  = tyConDataCons rep_tc
     n_cons     = length data_cons
     one_constr = n_cons == 1
-    genDataTyCon :: DerivStuff
-    genDataTyCon        --  $dT
-      = DerivHsBind (mkHsVarBind loc data_type_name rhs,
-                     L loc (TypeSig noExtField [L loc data_type_name] sig_ty))
-
-    sig_ty = mkLHsSigWcType (nlHsTyVar dataType_RDR)
-    ctx    = initDefaultSDocContext dflags
-    rhs    = nlHsVar mkDataType_RDR
-             `nlHsApp` nlHsLit (mkHsString (showSDocOneLine ctx (ppr rep_tc)))
-             `nlHsApp` nlList (map nlHsVar constr_names)
-
-    genDataDataCon :: DataCon -> RdrName -> DerivStuff
-    genDataDataCon dc constr_name       --  $cT1 etc
-      = DerivHsBind (mkHsVarBind loc constr_name rhs,
-                     L loc (TypeSig noExtField [L loc constr_name] sig_ty))
-      where
-        sig_ty   = mkLHsSigWcType (nlHsTyVar constr_RDR)
-        rhs      = nlHsApps mkConstr_RDR constr_args
-
-        constr_args
-           = [ -- nlHsIntLit (toInteger (dataConTag dc)),   -- Tag
-               nlHsVar (data_type_name)                     -- DataType
-             , nlHsLit (mkHsString (occNameString dc_occ))  -- String name
-             , nlList  labels                               -- Field labels
-             , nlHsVar fixity ]                             -- Fixity
-
-        labels   = map (nlHsLit . mkHsString . unpackFS . flLabel)
-                       (dataConFieldLabels dc)
-        dc_occ   = getOccName dc
-        is_infix = isDataSymOcc dc_occ
-        fixity | is_infix  = infix_RDR
-               | otherwise = prefix_RDR
 
         ------------ gfoldl
     gfoldl_bind = mkFunBindEC 3 loc gfoldl_RDR id (map gfoldl_eqn data_cons)
@@ -1410,16 +1396,18 @@ gen_data dflags data_type_name constr_names loc rep_tc
         tag = dataConTag dc
 
         ------------ toConstr
-    toCon_bind = mkFunBindEC 1 loc toConstr_RDR id
-                     (zipWith to_con_eqn data_cons constr_names)
+    toCon_bind constr_names
+      = mkFunBindEC 1 loc toConstr_RDR id
+            (zipWith to_con_eqn data_cons constr_names)
     to_con_eqn dc con_name = ([nlWildConPat dc], nlHsVar con_name)
 
         ------------ dataTypeOf
-    dataTypeOf_bind = mkSimpleGeneratedFunBind
-                        loc
-                        dataTypeOf_RDR
-                        [nlWildPat]
-                        (nlHsVar data_type_name)
+    dataTypeOf_bind data_type_name
+      = mkSimpleGeneratedFunBind
+          loc
+          dataTypeOf_RDR
+          [nlWildPat]
+          (nlHsVar data_type_name)
 
         ------------ gcast1/2
         -- Make the binding    dataCast1 x = gcast1 x  -- if T :: * -> *
@@ -1934,7 +1922,7 @@ mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Generating extra binds (@con2tag@ and @tag2con@)}
+\subsection{Generating extra binds (@con2tag@, @tag2con@, etc.)}
 *                                                                      *
 ************************************************************************
 
@@ -1950,75 +1938,18 @@ The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
 fiddling around.
 -}
 
-genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec
-                  -> (LHsBind GhcPs, LSig GhcPs)
-genAuxBindSpec dflags loc (DerivCon2Tag tycon)
-  = (mkFunBindSE 0 loc rdr_name eqns,
-     L loc (TypeSig noExtField [L loc rdr_name] sig_ty))
-  where
-    rdr_name = con2tag_RDR dflags tycon
-
-    sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $
-             mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $
-             mkParentType tycon `mkVisFunTy` intPrimTy
-
-    lots_of_constructors = tyConFamilySize tycon > 8
-                        -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS
-                        -- but we don't do vectored returns any more.
-
-    eqns | lots_of_constructors = [get_tag_eqn]
-         | otherwise = map mk_eqn (tyConDataCons tycon)
-
-    get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr)
-
-    mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs)
-    mk_eqn con = ([nlWildConPat con],
-                  nlHsLit (HsIntPrim NoSourceText
-                                    (toInteger ((dataConTag con) - fIRST_TAG))))
-
-genAuxBindSpec dflags loc (DerivTag2Con tycon)
-  = (mkFunBindSE 0 loc rdr_name
-        [([nlConVarPat intDataCon_RDR [a_RDR]],
-           nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)],
-     L loc (TypeSig noExtField [L loc rdr_name] sig_ty))
-  where
-    sig_ty = mkLHsSigWcType $ L loc $
-             XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $
-             intTy `mkVisFunTy` mkParentType tycon
-
-    rdr_name = tag2con_RDR dflags tycon
-
-genAuxBindSpec dflags loc (DerivMaxTag tycon)
-  = (mkHsVarBind loc rdr_name rhs,
-     L loc (TypeSig noExtField [L loc rdr_name] sig_ty))
-  where
-    rdr_name = maxtag_RDR dflags tycon
-    sig_ty = mkLHsSigWcType (L loc (XHsType (NHsCoreTy intTy)))
-    rhs = nlHsApp (nlHsVar intDataCon_RDR)
-                  (nlHsLit (HsIntPrim NoSourceText max_tag))
-    max_tag =  case (tyConDataCons tycon) of
-                 data_cons -> toInteger ((length data_cons) - fIRST_TAG)
-
 type SeparateBagsDerivStuff =
   -- AuxBinds and SYB bindings
   ( Bag (LHsBind GhcPs, LSig GhcPs)
   -- Extra family instances (used by Generic and DeriveAnyClass)
   , Bag (FamInst) )
 
-genAuxBinds :: DynFlags -> SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff
-genAuxBinds dflags loc b = genAuxBinds' b2 where
-  (b1,b2) = partitionBagWith splitDerivAuxBind b
-  splitDerivAuxBind (DerivAuxBind x) = Left x
-  splitDerivAuxBind  x               = Right x
-
-  rm_dups = foldr dup_check emptyBag
-  dup_check a b = if anyBag (== a) b then b else consBag a b
-
+genAuxBinds :: BagDerivStuff -> SeparateBagsDerivStuff
+genAuxBinds b = genAuxBinds' b where
   genAuxBinds' :: BagDerivStuff -> SeparateBagsDerivStuff
-  genAuxBinds' = foldr f ( mapBag (genAuxBindSpec dflags loc) (rm_dups b1)
-                            , emptyBag )
+  genAuxBinds' = foldr f (emptyBag, emptyBag)
+
   f :: DerivStuff -> SeparateBagsDerivStuff -> SeparateBagsDerivStuff
-  f (DerivAuxBind _) = panic "genAuxBinds'" -- We have removed these before
   f (DerivHsBind  b) = add1 b
   f (DerivFamInst t) = add2 t
 
@@ -2258,13 +2189,12 @@ eq_Expr ty a b
  where
    (_, _, prim_eq, _, _) = primOrdOps "Eq" ty
 
-untag_Expr :: DynFlags -> TyCon -> [( RdrName,  RdrName)]
+untag_Expr :: RdrName -> [( RdrName,  RdrName)]
               -> LHsExpr GhcPs -> LHsExpr GhcPs
-untag_Expr _ _ [] expr = expr
-untag_Expr dflags tycon ((untag_this, put_tag_here) : more) expr
-  = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR dflags tycon)
-                                   [untag_this])) {-of-}
-      [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr dflags tycon more expr)]
+untag_Expr _ [] expr = expr
+untag_Expr con2tag_RDR ((untag_this, put_tag_here) : more) expr
+  = nlHsCase (nlHsPar (nlHsVarApps con2tag_RDR [untag_this])) {-of-}
+      [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr con2tag_RDR more expr)]
 
 enum_from_to_Expr
         :: LHsExpr GhcPs -> LHsExpr GhcPs
@@ -2376,54 +2306,203 @@ minusInt_RDR, tagToEnum_RDR :: RdrName
 minusInt_RDR  = getRdrName (primOpId IntSubOp   )
 tagToEnum_RDR = getRdrName (primOpId TagToEnumOp)
 
-con2tag_RDR, tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName
--- Generates Orig s RdrName, for the binding positions
-con2tag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkCon2TagOcc
-tag2con_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkTag2ConOcc
-maxtag_RDR  dflags tycon = mk_tc_deriv_name dflags tycon mkMaxTagOcc
-
-mk_tc_deriv_name :: DynFlags -> TyCon -> (OccName -> OccName) -> RdrName
-mk_tc_deriv_name dflags tycon occ_fun =
-   mkAuxBinderName dflags (tyConName tycon) occ_fun
-
-mkAuxBinderName :: DynFlags -> Name -> (OccName -> OccName) -> RdrName
--- ^ Make a top-level binder name for an auxiliary binding for a parent name
--- See Note [Auxiliary binders]
-mkAuxBinderName dflags parent occ_fun
-  = mkRdrUnqual (occ_fun stable_parent_occ)
+-- Generate @$con2tag_T :: T -> Int#@, which returns the tag corresponding to a
+-- constructor of type @T@.
+genCon2Tag :: RdrName -> SrcSpan -> TyCon -> DerivStuff
+genCon2Tag con2tag_RDR loc tycon
+  = DerivHsBind (mkFunBindSE 0 loc con2tag_RDR eqns,
+                 L loc (TypeSig noExtField [L loc con2tag_RDR] sig_ty))
+  where
+    sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $
+             mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $
+             mkParentType tycon `mkVisFunTy` intPrimTy
+
+    lots_of_constructors = tyConFamilySize tycon > 8
+                        -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS
+                        -- but we don't do vectored returns any more.
+
+    eqns | lots_of_constructors = [get_tag_eqn]
+         | otherwise = map mk_eqn (tyConDataCons tycon)
+
+    get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr)
+
+    mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs)
+    mk_eqn con = ([nlWildConPat con],
+                  nlHsLit (HsIntPrim NoSourceText
+                                    (toInteger ((dataConTag con) - fIRST_TAG))))
+
+-- Generate @$tag2con_T :: Int -> T@, which returns the data constructor (of
+-- type @T@) corresponding to a particular tag.
+genTag2Con :: RdrName -> SrcSpan -> TyCon -> DerivStuff
+genTag2Con tag2con_RDR loc tycon
+  = DerivHsBind (mkFunBindSE 0 loc tag2con_RDR
+                    [([nlConVarPat intDataCon_RDR [a_RDR]],
+                       nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)],
+                 L loc (TypeSig noExtField [L loc tag2con_RDR] sig_ty))
+  where
+    sig_ty = mkLHsSigWcType $ L loc $
+             XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $
+             intTy `mkVisFunTy` mkParentType tycon
+
+-- Generate @$maxtag_T :: Int@, which returns the maximum tag for the data
+-- constructors of some data type @T@.
+genMaxTag :: RdrName -> SrcSpan -> TyCon -> DerivStuff
+genMaxTag maxtag_RDR loc tycon
+  = DerivHsBind (mkHsVarBind loc maxtag_RDR rhs,
+                 L loc (TypeSig noExtField [L loc maxtag_RDR] sig_ty))
+  where
+    sig_ty = mkLHsSigWcType (L loc (XHsType (NHsCoreTy intTy)))
+    rhs = nlHsApp (nlHsVar intDataCon_RDR)
+                  (nlHsLit (HsIntPrim NoSourceText max_tag))
+    max_tag =  case (tyConDataCons tycon) of
+                 data_cons -> toInteger ((length data_cons) - fIRST_TAG)
+
+-- Generate @$tT :: Data.Data.DataType@, which contains the representation for
+-- the data type @T@.
+genDataTyCon :: DynFlags -> RdrName -> [RdrName] -> SrcSpan -> TyCon -> DerivStuff
+genDataTyCon dflags data_type_name constr_names loc rep_tc
+  = DerivHsBind (mkHsVarBind loc data_type_name rhs,
+                 L loc (TypeSig noExtField [L loc data_type_name] sig_ty))
   where
-    stable_parent_occ = mkOccName (occNameSpace parent_occ) stable_string
-    stable_string
-      | hasPprDebug dflags = parent_stable
-      | otherwise          = parent_stable_hash
-    parent_stable = nameStableString parent
-    parent_stable_hash =
-      let Fingerprint high low = fingerprintString parent_stable
-      in toBase62 high ++ toBase62Padded low
-      -- See Note [Base 62 encoding 128-bit integers] in GHC.Utils.Encoding
-    parent_occ  = nameOccName parent
+    sig_ty = mkLHsSigWcType (nlHsTyVar dataType_RDR)
+    ctx    = initDefaultSDocContext dflags
+    rhs    = nlHsVar mkDataType_RDR
+             `nlHsApp` nlHsLit (mkHsString (showSDocOneLine ctx (ppr rep_tc)))
+             `nlHsApp` nlList (map nlHsVar constr_names)
 
+-- Generate @$cD :: Data.Data.Constr@, which contains the representation for
+-- the data constructor @D@.
+genDataDataCon :: RdrName -> SrcSpan -> DataCon -> RdrName -> DerivStuff
+genDataDataCon data_type_name loc dc constr_name
+  = DerivHsBind (mkHsVarBind loc constr_name rhs,
+                 L loc (TypeSig noExtField [L loc constr_name] sig_ty))
+  where
+    sig_ty   = mkLHsSigWcType (nlHsTyVar constr_RDR)
+    rhs      = nlHsApps mkConstr_RDR constr_args
+
+    constr_args
+       = [ -- nlHsIntLit (toInteger (dataConTag dc)),   -- Tag
+           nlHsVar (data_type_name)                     -- DataType
+         , nlHsLit (mkHsString (occNameString dc_occ))  -- String name
+         , nlList  labels                               -- Field labels
+         , nlHsVar fixity ]                             -- Fixity
+
+    labels   = map (nlHsLit . mkHsString . unpackFS . flLabel)
+                   (dataConFieldLabels dc)
+    dc_occ   = getOccName dc
+    is_infix = isDataSymOcc dc_occ
+    fixity | is_infix  = infix_RDR
+           | otherwise = prefix_RDR
 
 {-
 Note [Auxiliary binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~
-We often want to make a top-level auxiliary binding.  E.g. for comparison we have
+We often want to make a top-level auxiliary bindings in derived instances.
+E.g. for derived Ord instances we have:
+
+  data T = ...
+  deriving instance Ord T
+
+  ==>
 
   instance Ord T where
-    compare a b = $con2tag a `compare` $con2tag b
+    compare a b = $con2tag_T a `compare` $con2tag_T b
+
+  $con2tag_T :: T -> Int
+  $con2tag_T = ...code....
+
+Note that multiple instances of the same type might need to use the same sort
+of auxiliary binding. For example, $con2tag is used not only in derived Ord
+instances, but also in derived Eq instances:
+
+  deriving instance Eq T
+
+  ==>
+
+  instance Eq T where
+    a == b = $con2tag_T a == $con2tag_T b
+
+In fact, there are situations where the same sort of auxiliary binding can be
+used in multiple instances of the same type /and/ the same type class. Consider
+this example:
+
+  data S a = ...
+
+  deriving instance Eq (S Int)
+  deriving instance Eq (S Bool)
+
+  ==>
+
+  instance Eq (S Int) where
+    a == b = $con2tag_S a == $con2tag_S b
+  instance Eq (S Int) where
+    a == b = $con2tag_S a == $con2tag_S b
+
+  $con2tag_S :: S a -> Int
+  $con2tag_S = ...code....
+
+These examples can prove challenging because if GHC implements `deriving` in a
+naïve way, then it is easy to generate multiple copies of the same sort of
+auxiliary binding per type constructor /with the same name/. When these copies
+are colocated in the same module, bad things usually follow.
+See #7947, #12245, and #18321 for examples of bad things that can happen.
+
+Note that we are really only concerned about duplicate auxiliary binding names
+within the same module. If there are two copies of $con2tag_T in two different
+modules, then we don't have to worry, since GHC will be able to distinguish
+them. In order to avoid duplicates within the same module, we have considered
+three options:
+
+1. Always generate a unique copy of each sort of auxiliary binding per data type
+   definition, and use these unique copies across all derived instances for
+   each data type.
+
+2. In each derived instance, generate a copy of each sort of auxiliary
+   binding, but without any effort to make the names unique. Later, perform a
+   deduplication pass to ensure that there is only one copy per module.
+
+3. In each derived instance, generate a copy of each sort of auxiliary
+   binding, giving each copy a unique name.
+
+Here are the pros and cons of each approach:
+
+1. Pros: Because each data type has unique auxiliary bindings associated with
+   it, there is no danger of having name clashes between instances that use
+   these auxiliary bindings.
+
+   Cons: GHC would need to make sure that the implementations for each sort of
+   auxiliary binding are available for each data type. If a data type never
+   has any derived instances that use these bindings, then users pay the cost
+   of compiling extra code that never gets used.
+
+2. Pros: If implementing correctly, this option ensures that at most one copy
+   of each sort of auxiliary binding is defined per data type. Therefore, this
+   option promises to have the least code bloat.
+
+   Cons: It's surprisingly awkward to implement this in practice, especially
+   when instances across Template Haskell splice boundaries (see #18321). It's
+   possible to deduplicate auxiliary bindings with a dedicated pass in the
+   renamer, but it's rather grungy.
+   (See https://gitlab.haskell.org/ghc/ghc/issues/18321#note_281178.)
 
-  $con2tag :: T -> Int
-  $con2tag = ...code....
+3. Pros: This option is conceptually very simple to implement, as it requires
+   no manual deduplication. Just generate auxiliary bindings for each instance
+   on the fly, and use a unique number as a suffix to avoid intra-module name
+   clashes.
 
-Of course these top-level bindings should all have distinct name, and we are
-generating RdrNames here.  We can't just use the TyCon or DataCon to distinguish
-because with standalone deriving two imported TyCons might both be called T!
-(See #7947.)
+   Cons: It's easy to end up with multiple copies of the same sort of auxiliary
+   binding, but with different names. This increases the potential for code
+   bloat, but given that most auxiliary bindings are quite small in size, a
+   CSE pass will often deduplicate these copies anyway when optimizations are
+   enabled.
 
-So we use package name, module name and the name of the parent
-(T in this example) as part of the OccName we generate for the new binding.
-To make the symbol names short we take a base62 hash of the full name.
+In practice, GHC implements option (3). As a result, any gen_* function defined
+in this module that needs to use auxiliary bindings must use TcM. This is
+because each auxiliary binding name needs a unique number, so these unique
+numbers are taken from a global counter that is incremented each time an
+auxiliary binding is defined.
 
-In the past we used the *unique* from the parent, but that's not stable across
-recompilations as uniques are nondeterministic.
+In the past we used the Unique from the parent TyCon rather than taking it from
+a dedicated global counter, but that's not stable across recompilations as
+Uniques are nondeterministic.
 -}
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index 66adb4e554..478ff0b6fe 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -590,6 +590,13 @@ hasStockDeriving clas
       = let (binds, deriv_stuff) = gen_fn loc tc
         in return (binds, deriv_stuff, [])
 
+    -- Like 'simple', but monadic. The only monadic things these functions do
+    -- at present are:
+    --
+    -- - Obtain the DynFlags
+    --
+    -- - Generate unique numbers for auxiliary binding names.
+    --   See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
     simpleM gen_fn loc tc _
       = do { (binds, deriv_stuff) <- gen_fn loc tc
            ; return (binds, deriv_stuff, []) }
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index 2062d5449b..7b11d670fb 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -608,7 +608,6 @@ mkDataConWrapperOcc, mkWorkerOcc,
         mkGenR, mkGen1R,
         mkDataConWorkerOcc, mkNewTyCoOcc,
         mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
-        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
         mkTyConRepOcc
    :: OccName -> OccName
 
@@ -629,11 +628,6 @@ mkNewTyCoOcc        = mk_simple_deriv tcName   "N:"   -- Coercion for newtypes
 mkInstTyCoOcc       = mk_simple_deriv tcName   "D:"   -- Coercion for type functions
 mkEqPredCoOcc       = mk_simple_deriv tcName   "$co"
 
--- Used in derived instances
-mkCon2TagOcc        = mk_simple_deriv varName  "$con2tag_"
-mkTag2ConOcc        = mk_simple_deriv varName  "$tag2con_"
-mkMaxTagOcc         = mk_simple_deriv varName  "$maxtag_"
-
 -- TyConRepName stuff; see Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable
 mkTyConRepOcc occ = mk_simple_deriv varName prefix occ
   where
@@ -697,15 +691,17 @@ mkDFunOcc info_str is_boot set
     prefix | is_boot   = "$fx"
            | otherwise = "$f"
 
-mkDataTOcc, mkDataCOcc
+mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkDataTOcc, mkDataCOcc
   :: OccName            -- ^ TyCon or data con string
   -> OccSet             -- ^ avoid these Occs
   -> OccName            -- ^ E.g. @$f3OrdMaybe@
--- data T = MkT ... deriving( Data ) needs definitions for
---      $tT   :: Data.Generics.Basics.DataType
---      $cMkT :: Data.Generics.Basics.Constr
-mkDataTOcc occ = chooseUniqueOcc VarName ("$t" ++ occNameString occ)
-mkDataCOcc occ = chooseUniqueOcc VarName ("$c" ++ occNameString occ)
+-- Generates the names of auxiliary bindings used for derived instances.
+-- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
+mkCon2TagOcc occ = chooseUniqueOcc VarName ("$con2tag_" ++ occNameString occ)
+mkTag2ConOcc occ = chooseUniqueOcc VarName ("$tag2con_" ++ occNameString occ)
+mkMaxTagOcc  occ = chooseUniqueOcc VarName ("$maxtag_"  ++ occNameString occ)
+mkDataTOcc   occ = chooseUniqueOcc VarName ("$t" ++ occNameString occ)
+mkDataCOcc   occ = chooseUniqueOcc VarName ("$c" ++ occNameString occ)
 
 {-
 Sometimes we need to pick an OccName that has not already been used,
diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr
index 59fc405cdb..ca81b45b2d 100644
--- a/testsuite/tests/deriving/should_compile/T14682.stderr
+++ b/testsuite/tests/deriving/should_compile/T14682.stderr
@@ -71,14 +71,13 @@ Derived class instances:
       = (GHC.Ix.inRange (a1, b1) c1
            GHC.Classes.&& GHC.Ix.inRange (a2, b2) c2)
   
-  T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX ::
-    T14682.Foo -> GHC.Prim.Int#
-  T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX (T14682.Foo _ _) = 0#
   T14682.$tFoo :: Data.Data.DataType
   T14682.$cFoo :: Data.Data.Constr
   T14682.$tFoo = Data.Data.mkDataType "Foo" [T14682.$cFoo]
   T14682.$cFoo
     = Data.Data.mkConstr T14682.$tFoo "Foo" [] Data.Data.Prefix
+  T14682.$con2tag_Foo1 :: T14682.Foo -> GHC.Prim.Int#
+  T14682.$con2tag_Foo1 (T14682.Foo _ _) = 0#
 
 Derived type family instances:
 
diff --git a/testsuite/tests/deriving/should_compile/T18321.hs b/testsuite/tests/deriving/should_compile/T18321.hs
new file mode 100644
index 0000000000..5391cf602b
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T18321.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T18321 where
+
+import Data.Ix
+
+data T = MkT deriving (Eq, Ord, Ix)
+$(return [])
+deriving instance Enum T
+
+data S a = MkS
+deriving instance Enum (S Int)
+$(return [])
+deriving instance Enum (S Bool)
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 8a363e72f9..f6e9d43b06 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -124,3 +124,4 @@ test('T17339', normal, compile,
      ['-ddump-simpl -dsuppress-idinfo -dno-typeable-binds'])
 test('T17880', normal, compile, [''])
 test('T18055', normal, compile, [''])
+test('T18321', normal, compile, [''])