Revamp the treatment of auxiliary bindings for derived instanceswip/T18321-take-two

This started as a simple fix for #18321 that organically grew into a
much more sweeping refactor of how auxiliary bindings for derived
instances are handled. I have rewritten `Note [Auxiliary binders]`
in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but
the highlights are:

* Previously, the OccName of each auxiliary binding would be given
  a suffix containing a hash of its package name, module name, and
  parent data type to avoid name clashes. This was needlessly
  complicated, so we take the more direct approach of generating
  `Exact` `RdrName`s for each auxiliary binding with the same
  `OccName`, but using an underlying `System` `Name` with a fresh
  `Unique` for each binding. Unlike hashes, allocating new `Unique`s
  does not require any cleverness and avoid name clashes all the
  same...
* ...speaking of which, in order to convince the renamer that multiple
  auxiliary bindings with the same `OccName` (but different
  `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of
  `rnTopBindsLHS` to rename auxiliary bindings. Again, see
  `Note [Auxiliary binders]` for the full story.
* I have removed the `DerivHsBind` constructor for
  `DerivStuff`—which was only used for `Data.Data`-related
  auxiliary bindings—and refactored `gen_Data_binds` to use
  `DerivAuxBind` instead. This brings the treatment of
  `Data.Data`-related auxiliary bindings in line with every other
  form of auxiliary binding.

Fixes #18321.

12 files changed, 668 insertions, 349 deletions

diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index f3b0aa44e1..567c84625e 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -377,3 +377,19 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
               from generating many of these usages (at least in
               one-shot mode), but that's even more bogus!
         -}
+
+{-
+Note [Internal used_names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Most of the used_names are External Names, but we can have System
+Names too. Two examples:
+
+* Names arising from Language.Haskell.TH.newName.
+  See Note [Binders in Template Haskell] in GHC.ThToHs (and #5362).
+* The names of auxiliary bindings in derived instances.
+  See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
+
+Such Names are always for locally-defined things, for which we don't gather
+usage info, so we can just ignore them in ent_map. Moreover, they are always
+System Names, hence the assert, just as a double check.
+-}
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index 09679d0542..cace8ae046 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -54,7 +54,7 @@ See Also: Note [The Name Cache] in GHC.Types.Name.Cache
 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
 -- Used for source code and interface files, to make the
 -- Name for a thing, given its Module and OccName
--- See Note [The Name Cache]
+-- See Note [The Name Cache] in GHC.Types.Name.Cache
 --
 -- The cache may already already have a binding for this thing,
 -- because we may have seen an occurrence before, but now is the
@@ -79,7 +79,7 @@ allocateGlobalBinder
   :: NameCache
   -> Module -> OccName -> SrcSpan
   -> (NameCache, Name)
--- See Note [The Name Cache]
+-- See Note [The Name Cache] in GHC.Types.Name.Cache
 allocateGlobalBinder name_supply mod occ loc
   = case lookupOrigNameCache (nsNames name_supply) mod occ of
         -- A hit in the cache!  We are at the binding site of the name.
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 53385600ae..b43fe30bb3 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -364,16 +364,6 @@ That is, in Y,
 
 In the result of mkIfaceExports, the names are grouped by defining module,
 so we may need to split up a single Avail into multiple ones.
-
-Note [Internal used_names]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-Most of the used_names are External Names, but we can have Internal
-Names too: see Note [Binders in Template Haskell] in "GHC.ThToHs", and
-#5362 for an example.  Such Names are always
-  - Such Names are always for locally-defined things, for which we
-    don't gather usage info, so we can just ignore them in ent_map
-  - They are always System Names, hence the assert, just as a double check.
-
 -}
 
 
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 062a60088d..5c5a5797c8 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -814,15 +814,17 @@ the encloseing instance decl, if any.
 
 Note [Looking up Exact RdrNames]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Exact RdrNames are generated by Template Haskell.  See Note [Binders
-in Template Haskell] in Convert.
+Exact RdrNames are generated by:
+
+* Template Haskell (See Note [Binders in Template Haskell] in GHC.ThToHs)
+* Derived instances (See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate)
 
 For data types and classes have Exact system Names in the binding
 positions for constructors, TyCons etc.  For example
     [d| data T = MkT Int |]
-when we splice in and Convert to HsSyn RdrName, we'll get
+when we splice in and convert to HsSyn RdrName, we'll get
     data (Exact (system Name "T")) = (Exact (system Name "MkT")) ...
-These System names are generated by Convert.thRdrName
+These System names are generated by GHC.ThToHs.thRdrName
 
 But, constructors and the like need External Names, not System Names!
 So we do the following
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index a4d2be7ac6..5140f29d00 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -38,11 +38,10 @@ import GHC.Tc.Gen.HsType
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Ppr ( pprTyVars )
 
-import GHC.Rename.Names  ( extendGlobalRdrEnvRn )
 import GHC.Rename.Bind
 import GHC.Rename.Env
 import GHC.Rename.Module ( addTcgDUs )
-import GHC.Types.Avail
+import GHC.Rename.Utils
 
 import GHC.Core.Unify( tcUnifyTy )
 import GHC.Core.Class
@@ -294,11 +293,12 @@ renameDeriv inst_infos bagBinds
         ; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos))
         ; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds
         ; let aux_val_binds = ValBinds noExtField aux_binds (bagToList aux_sigs)
-        ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
-        ; let bndrs = collectHsValBinders rn_aux_lhs
-        ; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ;
-        ; setEnvs envs $
-    do  { (rn_aux, dus_aux) <- rnValBindsRHS (TopSigCtxt (mkNameSet bndrs)) rn_aux_lhs
+        -- Importantly, we use rnLocalValBindsLHS, not rnTopBindsLHS, to rename
+        -- auxiliary bindings as if they were defined locally.
+        -- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
+        ; (bndrs, rn_aux_lhs) <- rnLocalValBindsLHS emptyFsEnv aux_val_binds
+        ; bindLocalNames bndrs $
+    do  { (rn_aux, dus_aux) <- rnLocalValBindsRHS (mkNameSet bndrs) rn_aux_lhs
         ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
         ; return (listToBag rn_inst_infos, rn_aux,
                   dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 7fa9975790..935298e2ba 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
@@ -82,22 +80,77 @@ import Data.List  ( find, partition, intersperse )
 
 type BagDerivStuff = Bag DerivStuff
 
+-- | A declarative description of an auxiliary binding that should be
+-- generated. See @Note [Auxiliary binders]@ for a more detailed description
+-- of how these are used.
 data AuxBindSpec
-  = DerivCon2Tag TyCon  -- The con2Tag for given TyCon
-  | DerivTag2Con TyCon  -- ...ditto tag2Con
-  | DerivMaxTag  TyCon  -- ...and maxTag
-  deriving( Eq )
+  -- DerivCon2Tag, DerivTag2Con, and DerivMaxTag are used in derived Eq, Ord,
+  -- Enum, and Ix instances.
   -- All these generate ZERO-BASED tag operations
   -- I.e first constructor has tag 0
 
+    -- | @$con2tag@: Computes the tag for a given constructor
+  = DerivCon2Tag
+      TyCon   -- The type constructor of the data type to which the
+              -- constructors belong
+      RdrName -- The to-be-generated $con2tag binding's RdrName
+
+    -- | @$tag2con@: Given a tag, computes the corresponding data constructor
+  | DerivTag2Con
+      TyCon   -- The type constructor of the data type to which the
+              -- constructors belong
+      RdrName -- The to-be-generated $tag2con binding's RdrName
+
+    -- | @$maxtag@: The maximum possible tag value among a data type's
+    -- constructors
+  | DerivMaxTag
+      TyCon   -- The type constructor of the data type to which the
+              -- constructors belong
+      RdrName -- The to-be-generated $maxtag binding's RdrName
+
+  -- DerivDataDataType and DerivDataConstr are only used in derived Data
+  -- instances
+
+    -- | @$t@: The @DataType@ representation for a @Data@ instance
+  | DerivDataDataType
+      TyCon     -- The type constructor of the data type to be represented
+      RdrName   -- The to-be-generated $t binding's RdrName
+      [RdrName] -- The RdrNames of the to-be-generated $c bindings for each
+                -- data constructor. These are only used on the RHS of the
+                -- to-be-generated $t binding.
+
+    -- | @$c@: The @Constr@ representation for a @Data@ instance
+  | DerivDataConstr
+      DataCon -- The data constructor to be represented
+      RdrName -- The to-be-generated $c binding's RdrName
+      RdrName -- The RdrName of the to-be-generated $t binding for the parent
+              -- data type. This is only used on the RHS of the
+              -- to-be-generated $c binding.
+
+-- | Retrieve the 'RdrName' of the binding that the supplied 'AuxBindSpec'
+-- describes.
+auxBindSpecRdrName :: AuxBindSpec -> RdrName
+auxBindSpecRdrName (DerivCon2Tag      _ con2tag_RDR) = con2tag_RDR
+auxBindSpecRdrName (DerivTag2Con      _ tag2con_RDR) = tag2con_RDR
+auxBindSpecRdrName (DerivMaxTag       _ maxtag_RDR)  = maxtag_RDR
+auxBindSpecRdrName (DerivDataDataType _ dataT_RDR _) = dataT_RDR
+auxBindSpecRdrName (DerivDataConstr   _ dataC_RDR _) = dataC_RDR
+
 data DerivStuff     -- Please add this auxiliary stuff
   = DerivAuxBind AuxBindSpec
+    -- ^ A new, top-level auxiliary binding. Used for deriving 'Eq', 'Ord',
+    --   'Enum', 'Ix', and 'Data'. See Note [Auxiliary binders].
 
   -- Generics and DeriveAnyClass
   | DerivFamInst FamInst               -- New type family instances
-
-  -- New top-level auxiliary bindings
-  | DerivHsBind (LHsBind GhcPs, LSig GhcPs) -- Also used for SYB
+    -- ^ A new type family instance. Used for:
+    --
+    -- * @DeriveGeneric@, which generates instances of @Rep(1)@
+    --
+    -- * @DeriveAnyClass@, which can fill in associated type family defaults
+    --
+    -- * @GeneralizedNewtypeDeriving@, which generates instances of associated
+    --   type families for newtypes
 
 
 {-
@@ -161,8 +214,10 @@ 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_RDR <- new_con2tag_rdr_name loc tycon
+
+    return (method_binds con2tag_RDR, aux_binds con2tag_RDR)
   where
     all_cons = tyConDataCons tycon
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons
@@ -176,7 +231,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
@@ -188,16 +243,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 $ DerivAuxBind $ DerivCon2Tag tycon con2tag_RDR
 
-    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
@@ -341,21 +398,25 @@ 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_RDR <- new_con2tag_rdr_name loc tycon
+
     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 $ DerivAuxBind $ DerivCon2Tag tycon con2tag_RDR
 
         -- 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
 
@@ -381,39 +442,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
-                  -> LMatch GhcPs (LHsExpr GhcPs)
+    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 ]
 
@@ -436,14 +498,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
@@ -462,11 +524,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
@@ -586,78 +648,86 @@ 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_RDR <- new_con2tag_rdr_name loc tycon
+    tag2con_RDR <- new_tag2con_rdr_name loc tycon
+    maxtag_RDR  <- new_maxtag_rdr_name  loc tycon
+
+    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 $ map DerivAuxBind
+      [ DerivCon2Tag tycon con2tag_RDR
+      , DerivTag2Con tycon tag2con_RDR
+      , DerivMaxTag  tycon maxtag_RDR
       ]
-    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])
 
 {-
@@ -758,35 +828,40 @@ 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_RDR <- new_con2tag_rdr_name loc tycon
+    tag2con_RDR <- new_tag2con_rdr_name loc tycon
+
     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 $ map DerivAuxBind
+                   [ DerivCon2Tag tycon con2tag_RDR
+                   , DerivTag2Con tycon tag2con_RDR
+                   ])
+      else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon con2tag_RDR)))
   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
@@ -797,11 +872,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
@@ -1313,66 +1388,24 @@ gen_Data_binds :: SrcSpan
                -> TcM (LHsBinds GhcPs,  -- The method bindings
                        BagDerivStuff)   -- Auxiliary bindings
 gen_Data_binds loc rep_tc
-  = do { dflags  <- getDynFlags
-
-       -- Make unique names for the data type and constructor
-       -- auxiliary bindings.  Start with the name of the TyCon/DataCon
-       -- but that might not be unique: see #12245.
-       ; dt_occ  <- chooseUniqueOccTc (mkDataTOcc (getOccName rep_tc))
-       ; dc_occs <- mapM (chooseUniqueOccTc . mkDataCOcc . getOccName)
-                         (tyConDataCons rep_tc)
-       ; let dt_rdr  = mkRdrUnqual dt_occ
-             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,
-                -- Auxiliary definitions: the data type and constructors
-     listToBag ( genDataTyCon
-               : zipWith genDataDataCon data_cons constr_names ) )
+  = do { -- See Note [Auxiliary binders]
+         dataT_RDR  <- new_dataT_rdr_name loc rep_tc
+       ; dataC_RDRs <- traverse (new_dataC_rdr_name loc) data_cons
+
+       ; pure ( listToBag [ gfoldl_bind, gunfold_bind
+                          , toCon_bind dataC_RDRs, dataTypeOf_bind dataT_RDR ]
+                `unionBags` gcast_binds
+                          -- Auxiliary definitions: the data type and constructors
+              , listToBag $ map DerivAuxBind
+                  ( DerivDataDataType rep_tc dataT_RDR dataC_RDRs
+                  : zipWith (\data_con dataC_RDR ->
+                               DerivDataConstr data_con dataC_RDR dataT_RDR)
+                            data_cons dataC_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)
@@ -1420,16 +1453,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 dataC_RDRs
+      = mkFunBindEC 1 loc toConstr_RDR id
+            (zipWith to_con_eqn data_cons dataC_RDRs)
     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 dataT_RDR
+      = mkSimpleGeneratedFunBind
+          loc
+          dataTypeOf_RDR
+          [nlWildPat]
+          (nlHsVar dataT_RDR)
 
         ------------ gcast1/2
         -- Make the binding    dataCast1 x = gcast1 x  -- if T :: * -> *
@@ -1944,7 +1979,7 @@ mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Generating extra binds (@con2tag@ and @tag2con@)}
+\subsection{Generating extra binds (@con2tag@, @tag2con@, etc.)}
 *                                                                      *
 ************************************************************************
 
@@ -1960,80 +1995,142 @@ 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))
+-- | Generate the full code for an auxiliary binding.
+-- See @Note [Auxiliary binders] (Wrinkle: Reducing code duplication)@.
+genAuxBindSpecOriginal :: DynFlags -> SrcSpan -> AuxBindSpec
+                       -> (LHsBind GhcPs, LSig GhcPs)
+genAuxBindSpecOriginal dflags loc spec
+  = (gen_bind spec,
+     L loc (TypeSig noExtField [L loc (auxBindSpecRdrName spec)]
+           (genAuxBindSpecSig loc spec)))
   where
-    rdr_name = con2tag_RDR dflags tycon
+    gen_bind :: AuxBindSpec -> LHsBind GhcPs
+    gen_bind (DerivCon2Tag tycon con2tag_RDR)
+      = mkFunBindSE 0 loc con2tag_RDR eqns
+      where
+        lots_of_constructors = tyConFamilySize tycon > 8
+                            -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS
+                            -- but we don't do vectored returns any more.
 
-    sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $
-             mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $
-             mkParentType tycon `mkVisFunTyMany` intPrimTy
+        eqns | lots_of_constructors = [get_tag_eqn]
+             | otherwise = map mk_eqn (tyConDataCons tycon)
 
-    lots_of_constructors = tyConFamilySize tycon > 8
-                        -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS
-                        -- but we don't do vectored returns any more.
+        get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr)
 
-    eqns | lots_of_constructors = [get_tag_eqn]
-         | otherwise = map mk_eqn (tyConDataCons tycon)
+        mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs)
+        mk_eqn con = ([nlWildConPat con],
+                      nlHsLit (HsIntPrim NoSourceText
+                                        (toInteger ((dataConTag con) - fIRST_TAG))))
 
-    get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr)
+    gen_bind (DerivTag2Con _ tag2con_RDR)
+      = mkFunBindSE 0 loc tag2con_RDR
+           [([nlConVarPat intDataCon_RDR [a_RDR]],
+              nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)]
 
-    mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs)
-    mk_eqn con = ([nlWildConPat con],
-                  nlHsLit (HsIntPrim NoSourceText
-                                    (toInteger ((dataConTag con) - fIRST_TAG))))
+    gen_bind (DerivMaxTag tycon maxtag_RDR)
+      = mkHsVarBind loc maxtag_RDR rhs
+      where
+        rhs = nlHsApp (nlHsVar intDataCon_RDR)
+                      (nlHsLit (HsIntPrim NoSourceText max_tag))
+        max_tag =  case (tyConDataCons tycon) of
+                     data_cons -> toInteger ((length data_cons) - 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 `mkVisFunTyMany` mkParentType tycon
+    gen_bind (DerivDataDataType tycon dataT_RDR dataC_RDRs)
+      = mkHsVarBind loc dataT_RDR rhs
+      where
+        ctx = initDefaultSDocContext dflags
+        rhs = nlHsVar mkDataType_RDR
+              `nlHsApp` nlHsLit (mkHsString (showSDocOneLine ctx (ppr tycon)))
+              `nlHsApp` nlList (map nlHsVar dataC_RDRs)
+
+    gen_bind (DerivDataConstr dc dataC_RDR dataT_RDR)
+      = mkHsVarBind loc dataC_RDR rhs
+      where
+        rhs = nlHsApps mkConstr_RDR constr_args
 
-    rdr_name = tag2con_RDR dflags tycon
+        constr_args
+           = [ -- nlHsIntLit (toInteger (dataConTag dc)),   -- Tag
+               nlHsVar dataT_RDR                            -- 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
 
-genAuxBindSpec dflags loc (DerivMaxTag tycon)
-  = (mkHsVarBind loc rdr_name rhs,
-     L loc (TypeSig noExtField [L loc rdr_name] sig_ty))
+-- | Generate the code for an auxiliary binding that is a duplicate of another
+-- auxiliary binding.
+-- See @Note [Auxiliary binders] (Wrinkle: Reducing code duplication)@.
+genAuxBindSpecDup :: SrcSpan -> RdrName -> AuxBindSpec
+                  -> (LHsBind GhcPs, LSig GhcPs)
+genAuxBindSpecDup loc original_rdr_name dup_spec
+  = (mkHsVarBind loc dup_rdr_name (nlHsVar original_rdr_name),
+     L loc (TypeSig noExtField [L loc dup_rdr_name]
+           (genAuxBindSpecSig loc dup_spec)))
   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)
+    dup_rdr_name = auxBindSpecRdrName dup_spec
+
+-- | Generate the type signature of an auxiliary binding.
+-- See @Note [Auxiliary binders]@.
+genAuxBindSpecSig :: SrcSpan -> AuxBindSpec -> LHsSigWcType GhcPs
+genAuxBindSpecSig loc spec = case spec of
+  DerivCon2Tag tycon _
+    -> mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $
+       mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $
+       mkParentType tycon `mkVisFunTyMany` intPrimTy
+  DerivTag2Con tycon _
+    -> mkLHsSigWcType $ L loc $
+       XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $
+       intTy `mkVisFunTyMany` mkParentType tycon
+  DerivMaxTag _ _
+    -> mkLHsSigWcType (L loc (XHsType (NHsCoreTy intTy)))
+  DerivDataDataType _ _ _
+    -> mkLHsSigWcType (nlHsTyVar dataType_RDR)
+  DerivDataConstr _ _ _
+    -> mkLHsSigWcType (nlHsTyVar constr_RDR)
 
 type SeparateBagsDerivStuff =
-  -- AuxBinds and SYB bindings
+  -- DerivAuxBinds
   ( Bag (LHsBind GhcPs, LSig GhcPs)
-  -- Extra family instances (used by Generic and DeriveAnyClass)
-  , Bag (FamInst) )
 
+  -- Extra family instances (used by DeriveGeneric, DeriveAnyClass, and
+  -- GeneralizedNewtypeDeriving)
+  , Bag FamInst )
+
+-- | Take a 'BagDerivStuff' and partition it into 'SeparateBagsDerivStuff'.
+-- Also generate the code for auxiliary bindings based on the declarative
+-- descriptions in the supplied 'AuxBindSpec's. See @Note [Auxiliary binders]@.
 genAuxBinds :: DynFlags -> SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff
-genAuxBinds dflags loc b = genAuxBinds' b2 where
+genAuxBinds dflags loc b = (gen_aux_bind_specs b1, 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' = foldr f ( mapBag (genAuxBindSpec dflags loc) (rm_dups b1)
-                            , emptyBag )
-  f :: DerivStuff -> SeparateBagsDerivStuff -> SeparateBagsDerivStuff
-  f (DerivAuxBind _) = panic "genAuxBinds'" -- We have removed these before
-  f (DerivHsBind  b) = add1 b
-  f (DerivFamInst t) = add2 t
-
-  add1 x (a,b) = (x `consBag` a,b)
-  add2 x (a,b) = (a,x `consBag` b)
+  splitDerivAuxBind (DerivFamInst t) = Right t
+
+  gen_aux_bind_specs = snd . foldr gen_aux_bind_spec (emptyOccEnv, emptyBag)
+
+  -- Perform a CSE-like pass over the generated auxiliary bindings to avoid
+  -- code duplication, as described in
+  -- Note [Auxiliary binders] (Wrinkle: Reducing code duplication).
+  -- The OccEnv remembers the first occurrence of each sort of auxiliary
+  -- binding and maps it to the unique RdrName for that binding.
+  gen_aux_bind_spec :: AuxBindSpec
+                    -> (OccEnv RdrName, Bag (LHsBind GhcPs, LSig GhcPs))
+                    -> (OccEnv RdrName, Bag (LHsBind GhcPs, LSig GhcPs))
+  gen_aux_bind_spec spec (original_rdr_name_env, spec_bag) =
+    case lookupOccEnv original_rdr_name_env spec_occ of
+      Nothing
+        -> ( extendOccEnv original_rdr_name_env spec_occ spec_rdr_name
+           , genAuxBindSpecOriginal dflags loc spec `consBag` spec_bag )
+      Just original_rdr_name
+        -> ( original_rdr_name_env
+           , genAuxBindSpecDup loc original_rdr_name spec `consBag` spec_bag )
+    where
+      spec_rdr_name = auxBindSpecRdrName spec
+      spec_occ      = rdrNameOcc spec_rdr_name
 
 mkParentType :: TyCon -> Type
 -- Turn the representation tycon of a family into
@@ -2268,13 +2365,12 @@ eq_Expr ty a b
  where
    (_, _, prim_eq, _, _) = primOrdOps "Eq" ty
 
-untag_Expr :: DynFlags -> TyCon -> [( 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 :: RdrName -> [(RdrName, RdrName)]
+           -> LHsExpr GhcPs -> LHsExpr GhcPs
+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
@@ -2386,54 +2482,251 @@ 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)
-  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
+new_con2tag_rdr_name, new_tag2con_rdr_name, new_maxtag_rdr_name
+  :: SrcSpan -> TyCon -> TcM RdrName
+-- Generates Exact RdrNames, for the binding positions
+new_con2tag_rdr_name dflags tycon = new_tc_deriv_rdr_name dflags tycon mkCon2TagOcc
+new_tag2con_rdr_name dflags tycon = new_tc_deriv_rdr_name dflags tycon mkTag2ConOcc
+new_maxtag_rdr_name  dflags tycon = new_tc_deriv_rdr_name dflags tycon mkMaxTagOcc
+
+new_dataT_rdr_name :: SrcSpan -> TyCon -> TcM RdrName
+new_dataT_rdr_name dflags tycon = new_tc_deriv_rdr_name dflags tycon mkDataTOcc
+
+new_dataC_rdr_name :: SrcSpan -> DataCon -> TcM RdrName
+new_dataC_rdr_name dflags dc = new_dc_deriv_rdr_name dflags dc mkDataCOcc
+
+new_tc_deriv_rdr_name :: SrcSpan -> TyCon -> (OccName -> OccName) -> TcM RdrName
+new_tc_deriv_rdr_name loc tycon occ_fun
+  = newAuxBinderRdrName loc (tyConName tycon) occ_fun
+
+new_dc_deriv_rdr_name :: SrcSpan -> DataCon -> (OccName -> OccName) -> TcM RdrName
+new_dc_deriv_rdr_name loc dc occ_fun
+  = newAuxBinderRdrName loc (dataConName dc) occ_fun
+
+-- | Generate the name for an auxiliary binding, giving it a fresh 'Unique'.
+-- Returns an 'Exact' 'RdrName' with an underlying 'System' 'Name'.
+-- See @Note [Auxiliary binders]@.
+newAuxBinderRdrName :: SrcSpan -> Name -> (OccName -> OccName) -> TcM RdrName
+newAuxBinderRdrName loc parent occ_fun = do
+  uniq <- newUnique
+  pure $ Exact $ mkSystemNameAt uniq (occ_fun (nameOccName parent)) loc
 
 
 {-
 Note [Auxiliary binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~
-We often want to make a top-level auxiliary binding.  E.g. for comparison we have
+We often want to make top-level auxiliary bindings in derived instances.
+For example, derived Eq instances sometimes generate code like this:
+
+  data T = ...
+  deriving instance Eq T
+
+  ==>
+
+  instance Eq T where
+    a == b = $con2tag_T a == $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 Eq
+instances, but also in derived Ord instances:
+
+  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....
+
+How do we ensure that the two usages of $con2tag_T do not conflict with each
+other? We do so by generating a separate $con2tag_T definition for each
+instance, giving each definition an Exact RdrName with a separate Unique to
+avoid name clashes:
+
+   instance Eq T where
+     a == b = $con2tag_T{Uniq1} a == $con2tag_T{Uniq1} b
 
-  $con2tag :: T -> Int
-  $con2tag = ...code....
+   instance Ord T where
+     compare a b = $con2tag_T{Uniq2} a `compare` $con2tag_T{Uniq2} b
 
-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.)
+   -- $con2tag_T{Uniq1} and $con2tag_T{Uniq2} are Exact RdrNames with
+   -- underyling System Names
 
-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.
+   $con2tag_T{Uniq1} :: T -> Int
+   $con2tag_T{Uniq1} = ...code....
 
-In the past we used the *unique* from the parent, but that's not stable across
-recompilations as uniques are nondeterministic.
+   $con2tag_T{Uniq2} :: T -> Int
+   $con2tag_T{Uniq2} = ...code....
+
+Note that:
+
+* This is /precisely/ the same mechanism that we use for
+  Template Haskell–generated code.
+  See Note [Binders in Template Haskell] in GHC.ThToHs.
+  There we explain why we use a 'System' flavour of the Name we generate.
+
+* See "Wrinkle: Reducing code duplication" for how we can avoid generating
+  lots of duplicated code in common situations.
+
+* See "Wrinkle: Why we sometimes do generated duplicate code" for why this
+  de-duplication mechanism isn't perfect, so we fall back to CSE
+  (which is very effective within a single module).
+
+* Note that the "_T" part of "$con2tag_T" is just for debug-printing
+  purposes. We could call them all "$con2tag", or even just "aux".
+  The Unique is enough to keep them separate.
+
+  This is important: we might be generating an Eq instance for two
+  completely-distinct imported type constructors T.
+
+At first glance, it might appear that this plan is infeasible, as it would
+require generating multiple top-level declarations with the same OccName. But
+what if auxiliary bindings /weren't/ top-level? Conceptually, we could imagine
+that auxiliary bindings are /local/ to the instance declarations in which they
+are used. Using some hypothetical Haskell syntax, it might look like this:
+
+  let {
+    $con2tag_T{Uniq1} :: T -> Int
+    $con2tag_T{Uniq1} = ...code....
+
+    $con2tag_T{Uniq2} :: T -> Int
+    $con2tag_T{Uniq2} = ...code....
+  } in {
+    instance Eq T where
+      a == b = $con2tag_T{Uniq1} a == $con2tag_T{Uniq1} b
+
+    instance Ord T where
+      compare a b = $con2tag_T{Uniq2} a `compare` $con2tag_T{Uniq2} b
+  }
+
+Making auxiliary bindings local is key to making this work, since GHC will
+not reject local bindings with duplicate names provided that:
+
+* Each binding has a distinct unique, and
+* Each binding has an Exact RdrName with a System Name.
+
+Even though the hypothetical Haskell syntax above does not exist, we can
+accomplish the same end result through some sleight of hand in renameDeriv:
+we rename auxiliary bindings with rnLocalValBindsLHS. (If we had used
+rnTopBindsLHS instead, then GHC would spuriously reject auxiliary bindings
+with the same OccName as duplicates.) Luckily, no special treatment is needed
+to typecheck them; we can typecheck them as normal top-level bindings
+(using tcTopBinds) without danger.
+
+-----
+-- Wrinkle: Reducing code duplication
+-----
+
+While the approach of generating copies of each sort of auxiliary binder per
+derived instance is simpler, it can lead to code bloat if done naïvely.
+Consider this example:
+
+  data T = ...
+  deriving instance Eq T
+  deriving instance Ord T
+
+  ==>
+
+  instance Eq T where
+    a == b = $con2tag_T{Uniq1} a == $con2tag_T{Uniq1} b
+
+  instance Ord T where
+    compare a b = $con2tag_T{Uniq2} a `compare` $con2tag_T{Uniq2} b
+
+  $con2tag_T{Uniq1} :: T -> Int
+  $con2tag_T{Uniq1} = ...code....
+
+  $con2tag_T{Uniq2} :: T -> Int
+  $con2tag_T{Uniq2} = ...code....
+
+$con2tag_T{Uniq1} and $con2tag_T{Uniq2} are blatant duplicates of each other,
+which is not ideal. Surely GHC can do better than that at the very least! And
+indeed it does. Within the genAuxBinds function, GHC performs a small CSE-like
+pass to define duplicate auxiliary binders in terms of the original one. On
+the example above, that would look like this:
+
+  $con2tag_T{Uniq1} :: T -> Int
+  $con2tag_T{Uniq1} = ...code....
+
+  $con2tag_T{Uniq2} :: T -> Int
+  $con2tag_T{Uniq2} = $con2tag_T{Uniq1}
+
+(Note that this pass does not cover all possible forms of code duplication.
+See "Wrinkle: Why we sometimes do generate duplicate code" for situations
+where genAuxBinds does not deduplicate code.)
+
+To start, genAuxBinds is given a list of AuxBindSpecs, which describe the sort
+of auxiliary bindings that must be generates along with their RdrNames. As
+genAuxBinds processes this list, it marks the first occurrence of each sort of
+auxiliary binding as the "original". For example, if genAuxBinds sees a
+DerivCon2Tag for the first time (with the RdrName $con2tag_T{Uniq1}), then it
+will generate the full code for a $con2tag binding:
+
+  $con2tag_T{Uniq1} :: T -> Int
+  $con2tag_T{Uniq1} = ...code....
+
+Later, if genAuxBinds sees any additional DerivCon2Tag values, it will treat
+them as duplicates. For example, if genAuxBinds later sees a DerivCon2Tag with
+the RdrName $con2tag_T{Uniq2}, it will generate this code, which is much more
+compact:
+
+  $con2tag_T{Uniq2} :: T -> Int
+  $con2tag_T{Uniq2} = $con2tag_T{Uniq1}
+
+An alternative approach would be /not/ performing any kind of deduplication in
+genAuxBinds at all and simply relying on GHC's simplifier to perform this kind
+of CSE. But this is a more expensive analysis in general, while genAuxBinds can
+accomplish the same result with a simple check.
+
+-----
+-- Wrinkle: Why we sometimes do generate duplicate code
+-----
+
+It is worth noting that deduplicating auxiliary binders is difficult in the
+general case. Here are two particular examples where GHC cannot easily remove
+duplicate copies of an auxiliary binding:
+
+1. When derived instances are contained in different modules, as in the
+   following example:
+
+     module A where
+       data T = ...
+     module B where
+       import A
+       deriving instance Eq T
+     module C where
+       import B
+       deriving instance Enum T
+
+   The derived Eq and Enum instances for T make use of $con2tag_T, and since
+   they are defined in separate modules, each module must produce its own copy
+   of $con2tag_T.
+
+2. When derived instances are separated by TH splices (#18321), as in the
+   following example:
+
+     module M where
+
+     data T = ...
+     deriving instance Eq T
+     $(pure [])
+     deriving instance Enum T
+
+   Due to the way that GHC typechecks TyClGroups, genAuxBinds will run twice
+   in this program: once for all the declarations before the TH splice, and
+   once again for all the declarations after the TH splice. As a result,
+   $con2tag_T will be generated twice, since genAuxBinds will be unable to
+   recognize the presence of duplicates.
+
+These situations are much rarer, so we do not spend any effort to deduplicate
+auxiliary bindings there. Instead, we focus on the common case of multiple
+derived instances within the same module, not separated by any TH splices.
+(This is the case described in "Wrinkle: Reducing code duplication".) In
+situation (1), we can at least fall back on GHC's simplifier to pick up
+genAuxBinds' slack.
 -}
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index e118c69830..657f61d03b 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -591,6 +591,10 @@ hasStockDeriving clas
       = let (binds, deriv_stuff) = gen_fn loc tc
         in return (binds, deriv_stuff, [])
 
+    -- Like `simple`, but monadic. The only monadic thing that these functions
+    -- do is allocate new Uniques, which are used for generating the names of
+    -- auxiliary bindings.
+    -- 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..f94f1f5ca1 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -608,7 +608,7 @@ mkDataConWrapperOcc, mkWorkerOcc,
         mkGenR, mkGen1R,
         mkDataConWorkerOcc, mkNewTyCoOcc,
         mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
-        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkDataTOcc, mkDataCOcc,
         mkTyConRepOcc
    :: OccName -> OccName
 
@@ -629,10 +629,13 @@ 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
+-- Used in derived instances for the names of auxilary bindings.
+-- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
 mkCon2TagOcc        = mk_simple_deriv varName  "$con2tag_"
 mkTag2ConOcc        = mk_simple_deriv varName  "$tag2con_"
 mkMaxTagOcc         = mk_simple_deriv varName  "$maxtag_"
+mkDataTOcc          = mk_simple_deriv varName  "$t"
+mkDataCOcc          = mk_simple_deriv varName  "$c"
 
 -- TyConRepName stuff; see Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable
 mkTyConRepOcc occ = mk_simple_deriv varName prefix occ
@@ -697,16 +700,6 @@ mkDFunOcc info_str is_boot set
     prefix | is_boot   = "$fx"
            | otherwise = "$f"
 
-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)
-
 {-
 Sometimes we need to pick an OccName that has not already been used,
 given a set of in-use OccNames.
diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr
index 2bf9552ff9..e0c8b332ed 100644
--- a/testsuite/tests/deriving/should_compile/T14682.stderr
+++ b/testsuite/tests/deriving/should_compile/T14682.stderr
@@ -23,8 +23,8 @@ Derived class instances:
     Data.Data.gfoldl k z (T14682.Foo a1 a2)
       = ((z (\ a1 a2 -> T14682.Foo a1 a2) `k` a1) `k` a2)
     Data.Data.gunfold k z _ = k (k (z (\ a1 a2 -> T14682.Foo a1 a2)))
-    Data.Data.toConstr (T14682.Foo _ _) = T14682.$cFoo
-    Data.Data.dataTypeOf _ = T14682.$tFoo
+    Data.Data.toConstr (T14682.Foo _ _) = $cFoo
+    Data.Data.dataTypeOf _ = $tFoo
   
   instance GHC.Classes.Eq T14682.Foo where
     (GHC.Classes.==) (T14682.Foo a1 a2) (T14682.Foo b1 b2)
@@ -71,14 +71,12 @@ 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
+  $tFoo :: Data.Data.DataType
+  $cFoo :: Data.Data.Constr
+  $con2tag_Foo :: T14682.Foo -> GHC.Prim.Int#
+  $con2tag_Foo (T14682.Foo _ _) = 0#
+  $tFoo = Data.Data.mkDataType "Foo" [$cFoo]
+  $cFoo = Data.Data.mkConstr $tFoo "Foo" [] Data.Data.Prefix
 
 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, [''])
diff --git a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr
index d6e4eee4b0..cb6a89b226 100644
--- a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr
+++ b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr
@@ -20,7 +20,7 @@ Derived class instances:
     Data.Data.gfoldl _ _ z = case z of
     Data.Data.gunfold k z c = case Data.Data.constrIndex c of
     Data.Data.toConstr z = case z of
-    Data.Data.dataTypeOf _ = DrvEmptyData.$tVoid
+    Data.Data.dataTypeOf _ = $tVoid
     Data.Data.dataCast1 f = Data.Typeable.gcast1 f
   
   instance GHC.Base.Functor DrvEmptyData.Void where
@@ -48,8 +48,8 @@ Derived class instances:
     Language.Haskell.TH.Syntax.lift z = GHC.Base.pure (case z of)
     Language.Haskell.TH.Syntax.liftTyped z = GHC.Base.pure (case z of)
   
-  DrvEmptyData.$tVoid :: Data.Data.DataType
-  DrvEmptyData.$tVoid = Data.Data.mkDataType "Void" []
+  $tVoid :: Data.Data.DataType
+  $tVoid = Data.Data.mkDataType "Void" []
 
 Derived type family instances:
   type GHC.Generics.Rep (DrvEmptyData.Void a) = GHC.Generics.D1
@@ -64,124 +64,124 @@ Derived type family instances:
 
 
 ==================== Filling in method body ====================
-GHC.Read.Read [DrvEmptyData.Void a[ssk:2]]
+GHC.Read.Read [DrvEmptyData.Void a[ssk:1]]
   GHC.Read.readsPrec = GHC.Read.$dmreadsPrec
-                         @(DrvEmptyData.Void a[ssk:2])
+                         @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Show.Show [DrvEmptyData.Void a[ssk:2]]
-  GHC.Show.show = GHC.Show.$dmshow @(DrvEmptyData.Void a[ssk:2])
+GHC.Show.Show [DrvEmptyData.Void a[ssk:1]]
+  GHC.Show.show = GHC.Show.$dmshow @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Show.Show [DrvEmptyData.Void a[ssk:2]]
+GHC.Show.Show [DrvEmptyData.Void a[ssk:1]]
   GHC.Show.showList = GHC.Show.$dmshowList
-                        @(DrvEmptyData.Void a[ssk:2])
+                        @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]]
-  GHC.Classes.< = GHC.Classes.$dm< @(DrvEmptyData.Void a[ssk:2])
+GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]]
+  GHC.Classes.< = GHC.Classes.$dm< @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]]
-  GHC.Classes.<= = GHC.Classes.$dm<= @(DrvEmptyData.Void a[ssk:2])
+GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]]
+  GHC.Classes.<= = GHC.Classes.$dm<= @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]]
-  GHC.Classes.> = GHC.Classes.$dm> @(DrvEmptyData.Void a[ssk:2])
+GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]]
+  GHC.Classes.> = GHC.Classes.$dm> @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]]
-  GHC.Classes.>= = GHC.Classes.$dm>= @(DrvEmptyData.Void a[ssk:2])
+GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]]
+  GHC.Classes.>= = GHC.Classes.$dm>= @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]]
-  GHC.Classes.max = GHC.Classes.$dmmax @(DrvEmptyData.Void a[ssk:2])
+GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]]
+  GHC.Classes.max = GHC.Classes.$dmmax @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]]
-  GHC.Classes.min = GHC.Classes.$dmmin @(DrvEmptyData.Void a[ssk:2])
+GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]]
+  GHC.Classes.min = GHC.Classes.$dmmin @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-GHC.Classes.Eq [DrvEmptyData.Void a[ssk:2]]
-  GHC.Classes./= = GHC.Classes.$dm/= @(DrvEmptyData.Void a[ssk:2])
+GHC.Classes.Eq [DrvEmptyData.Void a[ssk:1]]
+  GHC.Classes./= = GHC.Classes.$dm/= @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
   Data.Data.dataCast2 = Data.Data.$dmdataCast2
-                          @(DrvEmptyData.Void a[ssk:2])
+                          @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
-  Data.Data.gmapT = Data.Data.$dmgmapT @(DrvEmptyData.Void a[ssk:2])
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
+  Data.Data.gmapT = Data.Data.$dmgmapT @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
   Data.Data.gmapQl = Data.Data.$dmgmapQl
-                       @(DrvEmptyData.Void a[ssk:2])
+                       @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
   Data.Data.gmapQr = Data.Data.$dmgmapQr
-                       @(DrvEmptyData.Void a[ssk:2])
+                       @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
-  Data.Data.gmapQ = Data.Data.$dmgmapQ @(DrvEmptyData.Void a[ssk:2])
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
+  Data.Data.gmapQ = Data.Data.$dmgmapQ @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
   Data.Data.gmapQi = Data.Data.$dmgmapQi
-                       @(DrvEmptyData.Void a[ssk:2])
+                       @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
-  Data.Data.gmapM = Data.Data.$dmgmapM @(DrvEmptyData.Void a[ssk:2])
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
+  Data.Data.gmapM = Data.Data.$dmgmapM @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
   Data.Data.gmapMp = Data.Data.$dmgmapMp
-                       @(DrvEmptyData.Void a[ssk:2])
+                       @(DrvEmptyData.Void a[ssk:1])
 
 
 
 ==================== Filling in method body ====================
-Data.Data.Data [DrvEmptyData.Void a[ssk:2]]
+Data.Data.Data [DrvEmptyData.Void a[ssk:1]]
   Data.Data.gmapMo = Data.Data.$dmgmapMo
-                       @(DrvEmptyData.Void a[ssk:2])
+                       @(DrvEmptyData.Void a[ssk:1])
 
 
 
@@ -193,6 +193,13 @@ Data.Foldable.Foldable [DrvEmptyData.Void]
 
 ==================== Filling in method body ====================
 Data.Foldable.Foldable [DrvEmptyData.Void]
+  Data.Foldable.foldMap' = Data.Foldable.$dmfoldMap'
+                             @(DrvEmptyData.Void)
+
+
+
+==================== Filling in method body ====================
+Data.Foldable.Foldable [DrvEmptyData.Void]
   Data.Foldable.foldr = Data.Foldable.$dmfoldr @(DrvEmptyData.Void)