Refactor tcDeriving to generate tyfam insts before any bindings

Previously, there was an awful hack in `genInst` (now called `genInstBinds`
after this patch) where we had to return a continutation rather than directly
returning the bindings for a derived instance. This was done for staging
purposes, as we had to first infer the instance contexts for derived instances
and then feed these contexts into the continuations to ensure the generated
instance bindings had accurate instance contexts.
`Note [Staging of tcDeriving]` in `GHC.Tc.Deriving` described this confusing
state of affairs.

The root cause of this confusing design was the fact that `genInst` was trying
to generate instance bindings and associated type family instances for derived
instances simultaneously. This really isn't possible, however: as
`Note [Staging of tcDeriving]` explains, one needs to have access to the
associated type family instances before one can properly infer the instance
contexts for derived instances. The use of continuation-returning style was an
attempt to circumvent this dependency, but it did so in an awkward way.

This patch detangles this awkwardness by splitting up `genInst` into two
functions: `genFamInsts` (for associated type family instances) and
`genInstBinds` (for instance bindings). Now, the `tcDeriving` function calls
`genFamInsts` and brings all the family instances into scope before calling
`genInstBinds`. This removes the need for the awkward continuation-returning
style seen in the previous version of `genInst`, making the code easier to
understand.

There are some knock-on changes as well:

1. `hasStockDeriving` now needs to return two separate functions: one that
   describes how to generate family instances for a stock-derived instance,
   and another that describes how to generate the instance bindings. I factored
   out this pattern into a new `StockGenFns` data type.
2. While documenting `StockGenFns`, I realized that there was some
   inconsistency regarding which `StockGenFns` functions needed which
   arguments. In particular, the function in `GHC.Tc.Deriv.Generics` which
   generates `Rep(1)` instances did not take a `SrcSpan` like other `gen_*`
   functions did, and it included an extra `[Type]` argument that was entirely
   redundant. As a consequence, I refactored the code in
   `GHC.Tc.Deriv.Generics` to more closely resemble other `gen_*` functions.
   A happy result of all this is that all `StockGenFns` functions now take
   exactly the same arguments, which makes everything more uniform.

This is purely a refactoring that should not have any effect on user-observable
behavior. The new design paves the way for an eventual fix for #20719.

6 files changed, 347 insertions, 309 deletions

diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index afae21e9d7..39900cb47e 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -197,72 +197,67 @@ tcDeriving deriv_infos deriv_decls
         ; traceTc "tcDeriving" (ppr early_specs)
 
         ; let (infer_specs, given_specs) = splitEarlyDerivSpec early_specs
-        ; insts1 <- mapM genInst given_specs
-        ; insts2 <- mapM genInst infer_specs
+        ; famInsts1 <- concatMapM genFamInsts given_specs
+        ; famInsts2 <- concatMapM genFamInsts infer_specs
+        ; let famInsts = famInsts1 ++ famInsts2
 
         ; dflags <- getDynFlags
         ; logger <- getLogger
 
-        ; let (_, deriv_stuff, fvs) = unzip3 (insts1 ++ insts2)
-        ; loc <- getSrcSpanM
-        ; let (binds, famInsts) = genAuxBinds dflags loc
-                                    (unionManyBags deriv_stuff)
-
-        ; let mk_inst_infos1 = map fstOf3 insts1
-        ; inst_infos1 <- apply_inst_infos mk_inst_infos1 given_specs
-
           -- We must put all the derived type family instances (from both
           -- infer_specs and given_specs) in the local instance environment
           -- before proceeding, or else simplifyInstanceContexts might
           -- get stuck if it has to reason about any of those family instances.
           -- See Note [Staging of tcDeriving]
-        ; tcExtendLocalFamInstEnv (bagToList famInsts) $
+        ; tcExtendLocalFamInstEnv famInsts $
           -- NB: only call tcExtendLocalFamInstEnv once, as it performs
           -- validity checking for all of the family instances you give it.
           -- If the family instances have errors, calling it twice will result
           -- in duplicate error messages!
 
-     do {
-        -- the stand-alone derived instances (@inst_infos1@) are used when
+     do { given_inst_binds <- mapM genInstBinds given_specs
+
+        ; let given_inst_infos = map fstOf3 given_inst_binds
+
+        -- the stand-alone derived instances (@given_inst_infos@) are used when
         -- inferring the contexts for "deriving" clauses' instances
         -- (@infer_specs@)
-        ; final_specs <- extendLocalInstEnv (map iSpec inst_infos1) $
-                         simplifyInstanceContexts infer_specs
+        ; final_infer_specs <-
+            extendLocalInstEnv (map iSpec given_inst_infos) $
+            simplifyInstanceContexts infer_specs
+        ; infer_inst_binds <- mapM genInstBinds final_infer_specs
+
+        ; let (_, aux_specs, fvs) = unzip3 (given_inst_binds ++ infer_inst_binds)
+        ; loc <- getSrcSpanM
+        ; let aux_binds = genAuxBinds dflags loc (unionManyBags aux_specs)
 
-        ; let mk_inst_infos2 = map fstOf3 insts2
-        ; inst_infos2 <- apply_inst_infos mk_inst_infos2 final_specs
-        ; let inst_infos = inst_infos1 ++ inst_infos2
+        ; let infer_inst_infos = map fstOf3 infer_inst_binds
+        ; let inst_infos = given_inst_infos ++ infer_inst_infos
 
-        ; (inst_info, rn_binds, rn_dus) <- renameDeriv inst_infos binds
+        ; (inst_info, rn_aux_binds, rn_dus) <- renameDeriv inst_infos aux_binds
 
         ; unless (isEmptyBag inst_info) $
              liftIO (putDumpFileMaybe logger Opt_D_dump_deriv "Derived instances"
                         FormatHaskell
-                        (ddump_deriving inst_info rn_binds famInsts))
+                        (ddump_deriving inst_info rn_aux_binds famInsts))
 
         ; gbl_env <- tcExtendLocalInstEnv (map iSpec (bagToList inst_info))
                                           getGblEnv
         ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ concat fvs)
-        ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) } }
+        ; return (addTcgDUs gbl_env all_dus, inst_info, rn_aux_binds) } }
   where
     ddump_deriving :: Bag (InstInfo GhcRn) -> HsValBinds GhcRn
-                   -> Bag FamInst             -- ^ Rep type family instances
+                   -> [FamInst]               -- ^ Associated type family instances
                    -> SDoc
-    ddump_deriving inst_infos extra_binds repFamInsts
+    ddump_deriving inst_infos extra_binds famInsts
       =    hang (text "Derived class instances:")
               2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") (bagToList inst_infos))
                  $$ ppr extra_binds)
         $$ hangP (text "Derived type family instances:")
-             (vcat (map pprRepTy (bagToList repFamInsts)))
+             (vcat (map pprRepTy famInsts))
 
     hangP s x = text "" $$ hang s 2 x
 
-    -- Apply the suspended computations given by genInst calls.
-    -- See Note [Staging of tcDeriving]
-    apply_inst_infos :: [ThetaType -> TcM (InstInfo GhcPs)]
-                     -> [DerivSpec ThetaType] -> TcM [InstInfo GhcPs]
-    apply_inst_infos = zipWithM (\f ds -> f (ds_theta ds))
-
 -- Prints the representable type family instance
 pprRepTy :: FamInst -> SDoc
 pprRepTy fi@(FamInst { fi_tys = lhs })
@@ -359,32 +354,18 @@ simplifyInstanceContexts would get called without all the type family instances
 it needed in the environment in order to properly simplify instance like
 the C N instance above.
 
-To avoid this scenario, we carefully structure the order of events in
-tcDeriving. We first call genInst on the standalone derived instance specs and
-the instance specs obtained from deriving clauses. Note that the return type of
-genInst is a triple:
-
-    TcM (ThetaType -> TcM (InstInfo RdrName), BagDerivStuff, Maybe Name)
-
-The type family instances are in the BagDerivStuff. The first field of the
-triple is a suspended computation which, given an instance context, produces
-the rest of the instance. The fact that it is suspended is important, because
-right now, we don't have ThetaTypes for the instances that use deriving clauses
-(only the standalone-derived ones).
-
-Now we can collect the type family instances and extend the local instance
-environment. At this point, it is safe to run simplifyInstanceContexts on the
-deriving-clause instance specs, which gives us the ThetaTypes for the
-deriving-clause instances. Now we can feed all the ThetaTypes to the
-suspended computations and obtain our InstInfos, at which point
-tcDeriving is done.
-
-An alternative design would be to split up genInst so that the
-family instances are generated separately from the InstInfos. But this would
-require carving up a lot of the GHC deriving internals to accommodate the
-change. On the other hand, we can keep all of the InstInfo and type family
-instance logic together in genInst simply by converting genInst to
-continuation-returning style, so we opt for that route.
+To avoid this scenario, we generate things in tcDeriving in a specific order:
+
+1. First, we generate all of the associated type family instances for derived
+   instances (using `genFamInsts`).
+2. Next, we extend the local instance environment with these type family
+   instances.
+3. Then, we generate the instance bindings for derived instances
+   (using `genInstBinds`).
+4. Finally, for instances generated with `deriving` clauses, we infer the
+   instance contexts (using `simplifyInstanceContexts`). At this point, we
+   already have the necessary type family instances in scope (from step (2)),
+   so this is safe to do.
 
 Note [Why we don't pass rep_tc into deriveTyData]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1361,17 +1342,17 @@ mk_eqn_stock dit
        let isDeriveAnyClassEnabled =
              deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
        checkOriginativeSideConditions dit >>= \case
-         CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
-                                  DerivSpecStock { dsm_stock_dit    = dit
-                                                 , dsm_stock_gen_fn = gen_fn }
-         StockClassError why   -> derivingThingFailWith NoGeneralizedNewtypeDeriving why
-         CanDeriveAnyClass     -> derivingThingFailWith NoGeneralizedNewtypeDeriving
-                                    (DerivErrNotStockDeriveable isDeriveAnyClassEnabled)
+         CanDeriveStock gen_fns -> mk_eqn_from_mechanism $
+                                   DerivSpecStock { dsm_stock_dit     = dit
+                                                  , dsm_stock_gen_fns = gen_fns }
+         StockClassError why    -> derivingThingFailWith NoGeneralizedNewtypeDeriving why
+         CanDeriveAnyClass      -> derivingThingFailWith NoGeneralizedNewtypeDeriving
+                                     (DerivErrNotStockDeriveable isDeriveAnyClassEnabled)
          -- In the 'NonDerivableClass' case we can't derive with either stock or anyclass
          -- so we /don't want/ to suggest the user to enabled 'DeriveAnyClass', that's
          -- why we pass 'YesDeriveAnyClassEnabled', so that GHC won't attempt to suggest it.
-         NonDerivableClass     -> derivingThingFailWith NoGeneralizedNewtypeDeriving
-                                    (DerivErrNotStockDeriveable YesDeriveAnyClassEnabled)
+         NonDerivableClass      -> derivingThingFailWith NoGeneralizedNewtypeDeriving
+                                     (DerivErrNotStockDeriveable YesDeriveAnyClassEnabled)
 
 mk_eqn_anyclass :: DerivM EarlyDerivSpec
 mk_eqn_anyclass
@@ -1446,12 +1427,12 @@ mk_eqn_no_strategy = do
             = DerivErrNotStockDeriveable isDeriveAnyClassEnabled
 
       checkOriginativeSideConditions dit >>= \case
-        NonDerivableClass     -> derivingThingFailWith NoGeneralizedNewtypeDeriving dac_error
-        StockClassError why   -> derivingThingFailWith NoGeneralizedNewtypeDeriving why
-        CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
-                                 DerivSpecStock { dsm_stock_dit    = dit
-                                                , dsm_stock_gen_fn = gen_fn }
-        CanDeriveAnyClass     -> mk_eqn_from_mechanism DerivSpecAnyClass
+        NonDerivableClass      -> derivingThingFailWith NoGeneralizedNewtypeDeriving dac_error
+        StockClassError why    -> derivingThingFailWith NoGeneralizedNewtypeDeriving why
+        CanDeriveStock gen_fns -> mk_eqn_from_mechanism $
+                                  DerivSpecStock { dsm_stock_dit     = dit
+                                                 , dsm_stock_gen_fns = gen_fns }
+        CanDeriveAnyClass      -> mk_eqn_from_mechanism DerivSpecAnyClass
 
 {-
 ************************************************************************
@@ -1607,9 +1588,9 @@ mkNewTypeEqn newtype_strat dit@(DerivInstTys { dit_cls_tys     = cls_tys
                         $ TcRnDerivingDefaults cls
                  mk_eqn_from_mechanism DerivSpecAnyClass
                -- CanDeriveStock
-               CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
-                                        DerivSpecStock { dsm_stock_dit    = dit
-                                                       , dsm_stock_gen_fn = gen_fn }
+               CanDeriveStock gen_fns -> mk_eqn_from_mechanism $
+                                         DerivSpecStock { dsm_stock_dit     = dit
+                                                        , dsm_stock_gen_fns = gen_fns }
 
 {-
 Note [Recursive newtypes]
@@ -1816,32 +1797,31 @@ the renamer.  What a great hack!
 \end{itemize}
 -}
 
--- Generate the InstInfo for the required instance
--- plus any auxiliary bindings required
-genInst :: DerivSpec theta
-        -> TcM (ThetaType -> TcM (InstInfo GhcPs), BagDerivStuff, [Name])
--- We must use continuation-returning style here to get the order in which we
--- typecheck family instances and derived instances right.
--- See Note [Staging of tcDeriving]
-genInst spec@(DS { ds_tvs = tvs, ds_mechanism = mechanism
-                 , ds_tys = tys, ds_cls = clas, ds_loc = loc
-                 , ds_standalone_wildcard = wildcard })
-  = do (meth_binds, meth_sigs, deriv_stuff, unusedNames)
-         <- set_span_and_ctxt $
-            genDerivStuff mechanism loc clas tys tvs
-       let mk_inst_info theta = set_span_and_ctxt $ do
-             inst_spec <- newDerivClsInst theta spec
-             doDerivInstErrorChecks2 clas inst_spec theta wildcard mechanism
-             traceTc "newder" (ppr inst_spec)
-             return $ InstInfo
-                       { iSpec   = inst_spec
-                       , iBinds  = InstBindings
-                                     { ib_binds = meth_binds
-                                     , ib_tyvars = map Var.varName tvs
-                                     , ib_pragmas = meth_sigs
-                                     , ib_extensions = extensions
-                                     , ib_derived = True } }
-       return (mk_inst_info, deriv_stuff, unusedNames)
+-- | Generate the 'InstInfo' for the required instance,
+-- plus any auxiliary bindings required (see @Note [Auxiliary binders]@ in
+-- "GHC.Tc.Deriv.Generate") and any additional free variables
+-- that should be marked (see @Note [Deriving and unused record selectors]@
+-- in "GHC.Tc.Deriv.Utils").
+genInstBinds :: DerivSpec ThetaType
+             -> TcM (InstInfo GhcPs, Bag AuxBindSpec, [Name])
+genInstBinds spec@(DS { ds_tvs = tyvars, ds_mechanism = mechanism
+                      , ds_tys = inst_tys, ds_theta = theta, ds_cls = clas
+                      , ds_loc = loc, ds_standalone_wildcard = wildcard })
+  = set_spec_span_and_ctxt spec $
+    do (meth_binds, meth_sigs, aux_specs, unusedNames) <- gen_inst_binds
+       inst_spec <- newDerivClsInst spec
+       doDerivInstErrorChecks2 clas inst_spec theta wildcard mechanism
+       traceTc "newder" (ppr inst_spec)
+       let inst_info =
+             InstInfo
+               { iSpec   = inst_spec
+               , iBinds  = InstBindings
+                             { ib_binds = meth_binds
+                             , ib_tyvars = map Var.varName tyvars
+                             , ib_pragmas = meth_sigs
+                             , ib_extensions = extensions
+                             , ib_derived = True } }
+       return (inst_info, aux_specs, unusedNames)
   where
     extensions :: [LangExt.Extension]
     extensions
@@ -1860,8 +1840,75 @@ genInst spec@(DS { ds_tvs = tvs, ds_mechanism = mechanism
       | otherwise
       = []
 
-    set_span_and_ctxt :: TcM a -> TcM a
-    set_span_and_ctxt = setSrcSpan loc . addErrCtxt (instDeclCtxt3 clas tys)
+    gen_inst_binds :: TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
+    gen_inst_binds
+      = case mechanism of
+          -- See Note [Bindings for Generalised Newtype Deriving]
+          DerivSpecNewtype { dsm_newtype_rep_ty = rhs_ty}
+            -> gen_newtype_or_via rhs_ty
+
+          -- Try a stock deriver
+          DerivSpecStock { dsm_stock_dit = dit
+                         , dsm_stock_gen_fns =
+                             StockGenFns { stock_gen_binds = gen_fn } }
+            -> gen_fn loc dit
+
+          -- Try DeriveAnyClass
+          DerivSpecAnyClass
+            -> return (emptyBag, [], emptyBag, [])
+               -- No method bindings, signatures, auxiliary bindings or free
+               -- variable names are needed. The only interesting work happens when
+               -- defaulting associated type family instances (see the
+               -- DeriveSpecAnyClass case in genFamInsts below).
+
+          -- Try DerivingVia
+          DerivSpecVia{dsm_via_ty = via_ty}
+            -> gen_newtype_or_via via_ty
+
+    gen_newtype_or_via ty = do
+      let (binds, sigs) = gen_Newtype_binds loc clas tyvars inst_tys ty
+      return (binds, sigs, emptyBag, [])
+
+-- | Generate the associated type family instances for a derived instance.
+genFamInsts :: DerivSpec theta -> TcM [FamInst]
+genFamInsts spec@(DS { ds_tvs = tyvars, ds_mechanism = mechanism
+                     , ds_tys = inst_tys, ds_cls = clas, ds_loc = loc })
+  = set_spec_span_and_ctxt spec $
+    case mechanism of
+      -- See Note [GND and associated type families]
+      DerivSpecNewtype { dsm_newtype_rep_ty = rhs_ty}
+        -> gen_newtype_or_via rhs_ty
+
+      -- Try a stock deriver
+      DerivSpecStock { dsm_stock_dit = dit
+                     , dsm_stock_gen_fns =
+                         StockGenFns { stock_gen_fam_insts = gen_fn } }
+        -> gen_fn loc dit
+
+      -- See Note [DeriveAnyClass and default family instances]
+      DerivSpecAnyClass -> do
+        let mini_env   = mkVarEnv (classTyVars clas `zip` inst_tys)
+            mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
+        dflags <- getDynFlags
+        tyfam_insts <-
+          -- canDeriveAnyClass should ensure that this code can't be reached
+          -- unless -XDeriveAnyClass is enabled.
+          assertPpr (xopt LangExt.DeriveAnyClass dflags)
+                    (ppr "genFamInsts: bad derived class" <+> ppr clas) $
+          mapM (tcATDefault loc mini_subst emptyNameSet)
+               (classATItems clas)
+        pure $ concat tyfam_insts
+
+      -- Try DerivingVia
+      DerivSpecVia{dsm_via_ty = via_ty}
+        -> gen_newtype_or_via via_ty
+  where
+    gen_newtype_or_via ty = gen_Newtype_fam_insts loc clas tyvars inst_tys ty
+
+-- Set the SrcSpan and error context for an action that uses a DerivSpec.
+set_spec_span_and_ctxt :: DerivSpec theta -> TcM a -> TcM a
+set_spec_span_and_ctxt (DS{ ds_loc = loc, ds_cls = clas, ds_tys = tys }) =
+  setSrcSpan loc . addErrCtxt (instDeclCtxt3 clas tys)
 
 -- Checks:
 --
@@ -2004,47 +2051,6 @@ derivingThingFailWith newtype_deriving msg = do
   err <- derivingThingErrM newtype_deriving msg
   lift $ failWithTc err
 
-genDerivStuff :: DerivSpecMechanism -> SrcSpan -> Class
-              -> [Type] -> [TyVar]
-              -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name])
-genDerivStuff mechanism loc clas inst_tys tyvars
-  = case mechanism of
-      -- See Note [Bindings for Generalised Newtype Deriving]
-      DerivSpecNewtype { dsm_newtype_rep_ty = rhs_ty}
-        -> gen_newtype_or_via rhs_ty
-
-      -- Try a stock deriver
-      DerivSpecStock { dsm_stock_dit    = dit
-                     , dsm_stock_gen_fn = gen_fn }
-        -> gen_fn loc inst_tys dit
-
-      -- Try DeriveAnyClass
-      DerivSpecAnyClass -> do
-        let mini_env   = mkVarEnv (classTyVars clas `zip` inst_tys)
-            mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
-        dflags <- getDynFlags
-        tyfam_insts <-
-          -- canDeriveAnyClass should ensure that this code can't be reached
-          -- unless -XDeriveAnyClass is enabled.
-          assertPpr (xopt LangExt.DeriveAnyClass dflags)
-                    (ppr "genDerivStuff: bad derived class" <+> ppr clas) $
-          mapM (tcATDefault loc mini_subst emptyNameSet)
-               (classATItems clas)
-        return ( emptyBag, [] -- No method bindings are needed...
-               , listToBag (map DerivFamInst (concat tyfam_insts))
-               -- ...but we may need to generate binding for associated type
-               -- family default instances.
-               -- See Note [DeriveAnyClass and default family instances]
-               , [] )
-
-      -- Try DerivingVia
-      DerivSpecVia{dsm_via_ty = via_ty}
-        -> gen_newtype_or_via via_ty
-  where
-    gen_newtype_or_via ty = do
-      (binds, sigs, faminsts) <- gen_Newtype_binds loc clas tyvars inst_tys ty
-      return (binds, sigs, faminsts, [])
-
 {-
 Note [Bindings for Generalised Newtype Deriving]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2058,7 +2064,7 @@ The 'deriving C' clause generates, in effect
   instance (C [a], Eq a) => C (N a) where
      f = coerce (f :: [a] -> [a])
 
-This generates a cast for each method, but allows the superclasse to
+This generates a cast for each method, but allows the superclasses to
 be worked out in the usual way.  In this case the superclass (Eq (N
 a)) will be solved by the explicit Eq (N a) instance.  We do *not*
 create the superclasses by casting the superclass dictionaries for the
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs
index 1f781398ca..b3e9fb775c 100644
--- a/compiler/GHC/Tc/Deriv/Functor.hs
+++ b/compiler/GHC/Tc/Deriv/Functor.hs
@@ -149,7 +149,7 @@ is a similar algorithm for generating `p <$ x` (for some constant `p`):
   $(coreplace 'a '(tb -> tc) x) = \(y:tb[b/a]) -> $(coreplace 'a' 'tc' (x $(replace 'a 'tb y)))
 -}
 
-gen_Functor_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Functor_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
 -- When the argument is phantom, we can use  fmap _ = coerce
 -- See Note [Phantom types with Functor, Foldable, and Traversable]
 gen_Functor_binds loc (DerivInstTys{dit_rep_tc = tycon})
@@ -784,7 +784,7 @@ could surprise users if they switch to other types, but Ryan Scott seems to
 think it's okay to do it for now.
 -}
 
-gen_Foldable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Foldable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
 -- When the parameter is phantom, we can use foldMap _ _ = mempty
 -- See Note [Phantom types with Functor, Foldable, and Traversable]
 gen_Foldable_binds loc (DerivInstTys{dit_rep_tc = tycon})
@@ -1018,7 +1018,7 @@ removes all such types from consideration.
 See Note [Generated code for DeriveFoldable and DeriveTraversable].
 -}
 
-gen_Traversable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Traversable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
 -- When the argument is phantom, we can use traverse = pure . coerce
 -- See Note [Phantom types with Functor, Foldable, and Traversable]
 gen_Traversable_binds loc (DerivInstTys{dit_rep_tc = tycon})
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 7c03f52bd0..d61ad20707 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -19,7 +19,7 @@
 --
 -- This is where we do all the grimy bindings' generation.
 module GHC.Tc.Deriv.Generate (
-        BagDerivStuff, DerivStuff(..),
+        AuxBindSpec(..),
 
         gen_Eq_binds,
         gen_Ord_binds,
@@ -31,6 +31,7 @@ module GHC.Tc.Deriv.Generate (
         gen_Data_binds,
         gen_Lift_binds,
         gen_Newtype_binds,
+        gen_Newtype_fam_insts,
         mkCoerceClassMethEqn,
         genAuxBinds,
         ordOpTbl, boxConTbl, litConTbl,
@@ -87,8 +88,6 @@ import Data.List  ( find, partition, intersperse )
 import GHC.Data.Maybe ( expectJust )
 import GHC.Unit.Module
 
-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.
@@ -138,23 +137,6 @@ 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
-    -- ^ 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
-
-
 {-
 ************************************************************************
 *                                                                      *
@@ -214,7 +196,7 @@ for the instance decl, which it probably wasn't, so the decls
 produced don't get through the typechecker.
 -}
 
-gen_Eq_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Eq_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
 gen_Eq_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
                                   , dit_rep_tc_args = tycon_args }) = do
     return (method_binds, emptyBag)
@@ -391,7 +373,7 @@ gtResult OrdGE      = true_Expr
 gtResult OrdGT      = true_Expr
 
 ------------
-gen_Ord_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Ord_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
 gen_Ord_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
                                    , dit_rep_tc_args = tycon_args }) = do
     return $ if null tycon_data_cons -- No data-cons => invoke bale-out case
@@ -640,7 +622,7 @@ instance ... Enum (Foo ...) where
 For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
 -}
 
-gen_Enum_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Enum_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
 gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     -- See Note [Auxiliary binders]
     tag2con_RDR <- new_tag2con_rdr_name loc tycon
@@ -657,7 +639,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
       , enum_from_then tag2con_RDR maxtag_RDR -- [0, 1 ..]
       , from_enum
       ]
-    aux_binds tag2con_RDR maxtag_RDR = listToBag $ map DerivAuxBind
+    aux_binds tag2con_RDR maxtag_RDR = listToBag
       [ DerivTag2Con tycon tag2con_RDR
       , DerivMaxTag  tycon maxtag_RDR
       ]
@@ -730,7 +712,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
 ************************************************************************
 -}
 
-gen_Bounded_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Bounded_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
 gen_Bounded_binds loc (DerivInstTys{dit_rep_tc = tycon})
   | isEnumerationTyCon tycon
   = (listToBag [ min_bound_enum, max_bound_enum ], emptyBag)
@@ -817,14 +799,14 @@ we follow the scheme given in Figure~19 of the Haskell~1.2 report
 (p.~147).
 -}
 
-gen_Ix_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Ix_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
 
 gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     -- See Note [Auxiliary binders]
     tag2con_RDR <- new_tag2con_rdr_name loc tycon
 
     return $ if isEnumerationTyCon tycon
-      then (enum_ixes tag2con_RDR, listToBag $ map DerivAuxBind
+      then (enum_ixes tag2con_RDR, listToBag
                    [ DerivTag2Con tycon tag2con_RDR
                    ])
       else (single_con_ixes, emptyBag)
@@ -1020,7 +1002,7 @@ we want to be able to parse (Left 3) just fine.
 -}
 
 gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> DerivInstTys
-               -> (LHsBinds GhcPs, BagDerivStuff)
+               -> (LHsBinds GhcPs, Bag AuxBindSpec)
 
 gen_Read_binds get_fixity loc dit@(DerivInstTys{dit_rep_tc = tycon})
   = (listToBag [read_prec, default_readlist, default_readlistprec], emptyBag)
@@ -1204,7 +1186,7 @@ Example
 -}
 
 gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> DerivInstTys
-               -> (LHsBinds GhcPs, BagDerivStuff)
+               -> (LHsBinds GhcPs, Bag AuxBindSpec)
 
 gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon
                                                , dit_rep_tc_args = tycon_args })
@@ -1377,7 +1359,7 @@ we generate
 gen_Data_binds :: SrcSpan
                -> DerivInstTys
                -> TcM (LHsBinds GhcPs,  -- The method bindings
-                       BagDerivStuff)   -- Auxiliary bindings
+                       Bag AuxBindSpec) -- Auxiliary bindings
 gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
   = do { -- See Note [Auxiliary binders]
          dataT_RDR  <- new_dataT_rdr_name loc rep_tc
@@ -1387,7 +1369,7 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
                           , toCon_bind dataC_RDRs, dataTypeOf_bind dataT_RDR ]
                 `unionBags` gcast_binds
                           -- Auxiliary definitions: the data type and constructors
-              , listToBag $ map DerivAuxBind
+              , listToBag
                   ( DerivDataDataType rep_tc dataT_RDR dataC_RDRs
                   : zipWith (\data_con dataC_RDR ->
                                DerivDataConstr data_con dataC_RDR dataT_RDR)
@@ -1642,7 +1624,7 @@ lifting warning in derived code. (See #20688)
 -}
 
 
-gen_Lift_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Lift_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
 gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
                                 , dit_rep_tc_args = tycon_args }) =
   (listToBag [lift_bind, liftTyped_bind], emptyBag)
@@ -1971,17 +1953,18 @@ gen_Newtype_binds :: SrcSpan
                              -- newtype itself)
                   -> [Type]  -- instance head parameters (incl. newtype)
                   -> Type    -- the representation type
-                  -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff)
+                  -> (LHsBinds GhcPs, [LSig GhcPs])
 -- See Note [Newtype-deriving instances]
 gen_Newtype_binds loc' cls inst_tvs inst_tys rhs_ty
-  = do let ats = classATs cls
-           (binds, sigs) = mapAndUnzip mk_bind_and_sig (classMethods cls)
-       atf_insts <- assert (all (not . isDataFamilyTyCon) ats) $
-                    mapM mk_atf_inst ats
-       return ( listToBag binds
-              , sigs
-              , listToBag $ map DerivFamInst atf_insts )
+  = (listToBag binds, sigs)
   where
+    (binds, sigs) = mapAndUnzip mk_bind_and_sig (classMethods cls)
+
+    -- Same as inst_tys, but with the last argument type replaced by the
+    -- representation type.
+    underlying_inst_tys :: [Type]
+    underlying_inst_tys = changeLast inst_tys rhs_ty
+
     locn = noAnnSrcSpan loc'
     loca = noAnnSrcSpan loc'
     -- For each class method, generate its derived binding and instance
@@ -2051,6 +2034,33 @@ gen_Newtype_binds loc' cls inst_tvs inst_tys rhs_ty
                      -- Filter out any inferred arguments, since they can't be
                      -- applied with visible type application.
 
+gen_Newtype_fam_insts :: SrcSpan
+                      -> Class   -- the class being derived
+                      -> [TyVar] -- the tvs in the instance head (this includes
+                                 -- the tvs from both the class types and the
+                                 -- newtype itself)
+                      -> [Type]  -- instance head parameters (incl. newtype)
+                      -> Type    -- the representation type
+                      -> TcM [FamInst]
+-- See Note [GND and associated type families] in GHC.Tc.Deriv
+gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty
+  = assert (all (not . isDataFamilyTyCon) ats) $
+    mapM mk_atf_inst ats
+  where
+    -- Same as inst_tys, but with the last argument type replaced by the
+    -- representation type.
+    underlying_inst_tys :: [Type]
+    underlying_inst_tys = changeLast inst_tys rhs_ty
+
+    ats       = classATs cls
+    locn      = noAnnSrcSpan loc'
+    cls_tvs   = classTyVars cls
+    in_scope  = mkInScopeSet $ mkVarSet inst_tvs
+    lhs_env   = zipTyEnv cls_tvs inst_tys
+    lhs_subst = mkTvSubst in_scope lhs_env
+    rhs_env   = zipTyEnv cls_tvs underlying_inst_tys
+    rhs_subst = mkTvSubst in_scope rhs_env
+
     mk_atf_inst :: TyCon -> TcM FamInst
     mk_atf_inst fam_tc = do
         rep_tc_name <- newFamInstTyConName (L locn (tyConName fam_tc))
@@ -2061,12 +2071,6 @@ gen_Newtype_binds loc' cls inst_tvs inst_tys rhs_ty
         checkValidCoAxBranch fam_tc (coAxiomSingleBranch axiom)
         newFamInst SynFamilyInst axiom
       where
-        cls_tvs     = classTyVars cls
-        in_scope    = mkInScopeSet $ mkVarSet inst_tvs
-        lhs_env     = zipTyEnv cls_tvs inst_tys
-        lhs_subst   = mkTvSubst in_scope lhs_env
-        rhs_env     = zipTyEnv cls_tvs underlying_inst_tys
-        rhs_subst   = mkTvSubst in_scope rhs_env
         fam_tvs     = tyConTyVars fam_tc
         rep_lhs_tys = substTyVars lhs_subst fam_tvs
         rep_rhs_tys = substTyVars rhs_subst fam_tvs
@@ -2076,11 +2080,6 @@ gen_Newtype_binds loc' cls inst_tvs inst_tys rhs_ty
         rep_tvs'    = scopedSort rep_tvs
         rep_cvs'    = scopedSort rep_cvs
 
-    -- Same as inst_tys, but with the last argument type replaced by the
-    -- representation type.
-    underlying_inst_tys :: [Type]
-    underlying_inst_tys = changeLast inst_tys rhs_ty
-
 nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
 nlHsAppType e s = noLocA (HsAppType noSrcSpan e hs_ty)
   where
@@ -2216,25 +2215,13 @@ genAuxBindSpecSig loc spec = case spec of
   where
     mk_sig = mkHsWildCardBndrs . L (noAnnSrcSpan loc) . mkHsImplicitSigType
 
-type SeparateBagsDerivStuff =
-  -- DerivAuxBinds
-  ( Bag (LHsBind GhcPs, LSig GhcPs)
-
-  -- 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 = (gen_aux_bind_specs b1, b2) where
-  (b1,b2) = partitionBagWith splitDerivAuxBind b
-  splitDerivAuxBind (DerivAuxBind x) = Left x
-  splitDerivAuxBind (DerivFamInst t) = Right t
-
-  gen_aux_bind_specs = snd . foldr gen_aux_bind_spec (emptyOccEnv, emptyBag)
-
+-- | Take a 'Bag' of 'AuxBindSpec's and generate the code for auxiliary
+-- bindings based on the declarative descriptions in the supplied
+-- 'AuxBindSpec's. See @Note [Auxiliary binders]@.
+genAuxBinds :: DynFlags -> SrcSpan -> Bag AuxBindSpec
+            -> Bag (LHsBind GhcPs, LSig GhcPs)
+genAuxBinds dflags loc = snd . foldr gen_aux_bind_spec (emptyOccEnv, emptyBag)
+ where
   -- Perform a CSE-like pass over the generated auxiliary bindings to avoid
   -- code duplication, as described in
   -- Note [Auxiliary binders] (Wrinkle: Reducing code duplication).
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index 65a7329729..dde32082e6 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -12,10 +12,11 @@
 
 -- | The deriving code for the Generic class
 module GHC.Tc.Deriv.Generics
-   (canDoGenerics
+   ( canDoGenerics
    , canDoGenerics1
    , GenericKind(..)
    , gen_Generic_binds
+   , gen_Generic_fam_inst
    , get_gen1_constrained_tys
    )
 where
@@ -76,13 +77,11 @@ For the generic representation we need to generate:
 \end{itemize}
 -}
 
-gen_Generic_binds :: GenericKind -> (Name -> Fixity) -> [Type] -> DerivInstTys
-                  -> TcM (LHsBinds GhcPs, [LSig GhcPs], FamInst)
-gen_Generic_binds gk get_fixity inst_tys dit = do
+gen_Generic_binds :: GenericKind -> SrcSpan -> DerivInstTys
+                  -> TcM (LHsBinds GhcPs, [LSig GhcPs])
+gen_Generic_binds gk loc dit = do
   dflags <- getDynFlags
-  repTyInsts <- tc_mkRepFamInsts gk get_fixity inst_tys dit
-  let (binds, sigs) = mkBindsRep dflags gk dit
-  return (binds, sigs, repTyInsts)
+  return $ mkBindsRep dflags gk loc dit
 
 {-
 ************************************************************************
@@ -332,8 +331,8 @@ gk2gkDC Gen1 dc tc_args = Gen1_DC $ assert (isTyVarTy last_dc_inst_univ)
 
 
 -- Bindings for the Generic instance
-mkBindsRep :: DynFlags -> GenericKind -> DerivInstTys -> (LHsBinds GhcPs, [LSig GhcPs])
-mkBindsRep dflags gk dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
+mkBindsRep :: DynFlags -> GenericKind -> SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, [LSig GhcPs])
+mkBindsRep dflags gk loc dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
       where
         binds = unitBag (mkRdrFunBind (L loc' from01_RDR) [from_eqn])
               `unionBags`
@@ -369,7 +368,6 @@ mkBindsRep dflags gk dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
 
         from_matches  = [mkHsCaseAlt pat rhs | (pat,rhs) <- from_alts]
         to_matches    = [mkHsCaseAlt pat rhs | (pat,rhs) <- to_alts  ]
-        loc           = srcLocSpan (getSrcLoc tycon)
         loc'          = noAnnSrcSpan loc
         loc''         = noAnnSrcSpan loc
         datacons      = tyConDataCons tycon
@@ -388,14 +386,17 @@ mkBindsRep dflags gk dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
 --       type Rep_D a b = ...representation type for D ...
 --------------------------------------------------------------------------------
 
-tc_mkRepFamInsts :: GenericKind      -- Gen0 or Gen1
-                 -> (Name -> Fixity) -- Get the Fixity for a data constructor Name
-                 -> [Type]           -- The type(s) to which Generic(1) is applied
-                                     -- in the generated instance
-                 -> DerivInstTys     -- Information about the last type argument,
-                                     -- including the data type's TyCon
-                 -> TcM FamInst      -- Generated representation0 coercion
-tc_mkRepFamInsts gk get_fixity inst_tys dit@(DerivInstTys{dit_rep_tc = tycon}) =
+gen_Generic_fam_inst :: GenericKind      -- Gen0 or Gen1
+                     -> (Name -> Fixity) -- Get the Fixity for a data constructor Name
+                     -> SrcSpan          -- The current source location
+                     -> DerivInstTys     -- Information about the type(s) to which
+                                         -- Generic(1) is applied in the generated
+                                         -- instance, including the data type's TyCon
+                     -> TcM FamInst      -- Generated representation0 coercion
+gen_Generic_fam_inst gk get_fixity loc
+       dit@(DerivInstTys{ dit_cls_tys = cls_tys
+                        , dit_tc = tc, dit_tc_args = tc_args
+                        , dit_rep_tc = tycon }) =
        -- Consider the example input tycon `D`, where data D a b = D_ a
        -- Also consider `R:DInt`, where { data family D x y :: * -> *
        --                               ; data instance D Int a b = D_ a }
@@ -413,17 +414,18 @@ tc_mkRepFamInsts gk get_fixity inst_tys dit@(DerivInstTys{dit_rep_tc = tycon}) =
            --   instance Generic1 (Bar x :: k -> *)
            -- then:
            --   `arg_k` = k, `inst_ty` = Bar x :: k -> *
-           (arg_ki, inst_ty) = case (gk, inst_tys) of
-             (Gen0, [inst_t])        -> (liftedTypeKind, inst_t)
-             (Gen1, [arg_k, inst_t]) -> (arg_k,          inst_t)
-             _ -> pprPanic "tc_mkRepFamInsts" (ppr inst_tys)
+           arg_ki = case (gk, cls_tys) of
+             (Gen0, [])      -> liftedTypeKind
+             (Gen1, [arg_k]) -> arg_k
+             _ -> pprPanic "gen_Generic_fam_insts" (ppr cls_tys)
+           inst_ty = mkTyConApp tc tc_args
+           inst_tys = cls_tys ++ [inst_ty]
 
        -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *
      ; repTy <- tc_mkRepTy gk get_fixity dit arg_ki
 
        -- `rep_name` is a name we generate for the synonym
      ; mod <- getModule
-     ; loc <- getSrcSpanM
      ; let tc_occ  = nameOccName (tyConName tycon)
            rep_occ = case gk of Gen0 -> mkGenR tc_occ; Gen1 -> mkGen1R tc_occ
      ; rep_name <- newGlobalBinder mod rep_occ loc
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index ccc44df2b4..3b2d3f80dd 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -665,13 +665,14 @@ simplifyInstanceContexts infer_specs
       | otherwise
       = do {      -- Extend the inst info from the explicit instance decls
                   -- with the current set of solutions, and simplify each RHS
-             inst_specs <- zipWithM newDerivClsInst current_solns infer_specs
+             inst_specs <- zipWithM (\soln -> newDerivClsInst . setDerivSpecTheta soln)
+                                    current_solns infer_specs
            ; new_solns <- checkNoErrs $
                           extendLocalInstEnv inst_specs $
                           mapM gen_soln infer_specs
 
            ; if (current_solns `eqSolution` new_solns) then
-                return [ spec { ds_theta = soln }
+                return [ setDerivSpecTheta soln spec
                        | (spec, soln) <- zip infer_specs current_solns ]
              else
                 iterate_deriv (n+1) new_solns }
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index 8a5b376767..5fe1f6b185 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -10,10 +10,10 @@
 -- | Error-checking and other utilities for @deriving@ clauses or declarations.
 module GHC.Tc.Deriv.Utils (
         DerivM, DerivEnv(..),
-        DerivSpec(..), pprDerivSpec,
+        DerivSpec(..), pprDerivSpec, setDerivSpecTheta,
         DerivSpecMechanism(..), derivSpecMechanismToStrategy, isDerivSpecStock,
         isDerivSpecNewtype, isDerivSpecAnyClass, isDerivSpecVia,
-        DerivContext(..), OriginativeDerivStatus(..),
+        DerivContext(..), OriginativeDerivStatus(..), StockGenFns(..),
         isStandaloneDeriv, isStandaloneWildcardDeriv, mkDerivOrigin,
         PredOrigin(..), ThetaOrigin(..), mkPredOrigin,
         mkThetaOrigin, mkThetaOriginFromPreds, substPredOrigin,
@@ -28,6 +28,7 @@ import GHC.Data.Bag
 import GHC.Types.Basic
 import GHC.Core.Class
 import GHC.Core.DataCon
+import GHC.Core.FamInstEnv
 import GHC.Driver.Session
 import GHC.Utils.Error
 import GHC.Types.Fixity.Env (lookupFixity)
@@ -179,6 +180,10 @@ pprDerivSpec (DS { ds_loc = l, ds_name = n, ds_tvs = tvs, ds_cls = c,
 instance Outputable theta => Outputable (DerivSpec theta) where
   ppr = pprDerivSpec
 
+-- | Set the 'ds_theta' in a 'DerivSpec'.
+setDerivSpecTheta :: theta' -> DerivSpec theta -> DerivSpec theta'
+setDerivSpecTheta theta ds = ds{ds_theta = theta}
+
 -- | What action to take in order to derive a class instance.
 -- See @Note [DerivEnv and DerivSpecMechanism]@, as well as
 -- @Note [Deriving strategies]@ in "GHC.Tc.Deriv".
@@ -189,28 +194,9 @@ data DerivSpecMechanism
       -- ^ Information about the arguments to the class in the derived
       -- instance, including what type constructor the last argument is
       -- headed by. See @Note [DerivEnv and DerivSpecMechanism]@.
-    , dsm_stock_gen_fn ::
-        SrcSpan -> [Type]       -- inst_tys
-                -> DerivInstTys -- dsm_stock_dit
-                -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name])
-      -- ^ This function returns four things:
-      --
-      -- 1. @LHsBinds GhcPs@: The derived instance's function bindings
-      --    (e.g., @compare (T x) (T y) = compare x y@)
-      --
-      -- 2. @[LSig GhcPs]@: A list of instance specific signatures/pragmas.
-      --    Most likely INLINE pragmas for class methods.
-      --
-      -- 3. @BagDerivStuff@: Auxiliary bindings needed to support the derived
-      --    instance. As examples, derived 'Generic' instances require
-      --    associated type family instances, and derived 'Eq' and 'Ord'
-      --    instances require top-level @con2tag@ functions.
-      --    See @Note [Auxiliary binders]@ in "GHC.Tc.Deriv.Generate".
-      --
-      -- 4. @[Name]@: A list of Names for which @-Wunused-binds@ should be
-      --    suppressed. This is used to suppress unused warnings for record
-      --    selectors when deriving 'Read', 'Show', or 'Generic'.
-      --    See @Note [Deriving and unused record selectors]@.
+    , dsm_stock_gen_fns :: StockGenFns
+      -- ^ How to generate the instance bindings and associated type family
+      -- instances.
     }
 
     -- | @GeneralizedNewtypeDeriving@
@@ -401,13 +387,61 @@ instance Outputable DerivContext where
 --
 -- See @Note [Deriving strategies]@ in "GHC.Tc.Deriv".
 data OriginativeDerivStatus
-  = CanDeriveStock            -- Stock class, can derive
-      (SrcSpan -> [Type] -> DerivInstTys
-               -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))
+  = CanDeriveStock StockGenFns -- Stock class, can derive
   | StockClassError !DeriveInstanceErrReason -- Stock class, but can't do it
   | CanDeriveAnyClass         -- See Note [Deriving any class]
   | NonDerivableClass -- Cannot derive with either stock or anyclass
 
+-- | Describes how to generate instance bindings ('stock_gen_binds') and
+-- associated type family instances ('stock_gen_fam_insts') for a particular
+-- stock-derived instance.
+data StockGenFns = StockGenFns
+  { stock_gen_binds ::
+         SrcSpan -> DerivInstTys
+      -> TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
+    -- ^ Describes how to generate instance bindings for a stock-derived
+    -- instance.
+    --
+    -- This function takes two arguments:
+    --
+    -- 1. 'SrcSpan': the source location where the instance is being derived.
+    --    This will eventually be instantiated with the 'ds_loc' field of a
+    --    'DerivSpec'.
+    --
+    -- 2. 'DerivInstTys': information about the argument types to which a
+    --    class is applied in a derived instance. This will eventually be
+    --    instantiated with the 'dsm_stock_dit' field of a
+    --    'DerivSpecMechanism'.
+    --
+    -- This function returns four things:
+    --
+    -- 1. @'LHsBinds' 'GhcPs'@: The derived instance's function bindings
+    --    (e.g., @compare (T x) (T y) = compare x y@)
+    --
+    -- 2. @['LSig' 'GhcPs']@: A list of instance specific signatures/pragmas.
+    --    Most likely @INLINE@ pragmas for class methods.
+    --
+    -- 3. @'Bag' 'AuxBindSpec'@: Auxiliary bindings needed to support the
+    --    derived instance. As examples, derived 'Eq' and 'Ord' instances
+    --    sometimes require top-level @con2tag@ functions.
+    --    See @Note [Auxiliary binders]@ in "GHC.Tc.Deriv.Generate".
+    --
+    -- 4. @['Name']@: A list of Names for which @-Wunused-binds@ should be
+    --    suppressed. This is used to suppress unused warnings for record
+    --    selectors when deriving 'Read', 'Show', or 'Generic'.
+    --    See @Note [Deriving and unused record selectors]@.
+  , stock_gen_fam_insts ::
+         SrcSpan -> DerivInstTys
+      -> TcM [FamInst]
+    -- ^ Describes how to generate associated type family instances for a
+    -- stock-derived instance. This function takes the same arguments as the
+    -- 'stock_gen_binds' function but returns a list of 'FamInst's instead.
+    -- Generating type family instances is done separately from
+    -- 'stock_gen_binds' since the type family instances must be generated
+    -- before the instance bindings can be typechecked. See
+    -- @Note [Staging of tcDeriving]@ in "GHC.Tc.Deriv".
+  }
+
 -- A stock class is one either defined in the Haskell report or for which GHC
 -- otherwise knows how to generate code for (possibly requiring the use of a
 -- language extension), such as Eq, Ord, Ix, Data, Generic, etc.)
@@ -542,58 +576,65 @@ is willing to support it.
 -}
 
 hasStockDeriving
-  :: Class -> Maybe (SrcSpan
-                     -> [Type]
-                     -> DerivInstTys
-                     -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))
+  :: Class -> Maybe StockGenFns
 hasStockDeriving clas
   = assocMaybe gen_list (getUnique clas)
   where
-    gen_list
-      :: [(Unique, SrcSpan
-                   -> [Type]
-                   -> DerivInstTys
-                   -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))]
-    gen_list = [ (eqClassKey,          simpleM gen_Eq_binds)
-               , (ordClassKey,         simpleM gen_Ord_binds)
-               , (enumClassKey,        simpleM gen_Enum_binds)
-               , (boundedClassKey,     simple gen_Bounded_binds)
-               , (ixClassKey,          simpleM gen_Ix_binds)
-               , (showClassKey,        read_or_show gen_Show_binds)
-               , (readClassKey,        read_or_show gen_Read_binds)
-               , (dataClassKey,        simpleM gen_Data_binds)
-               , (functorClassKey,     simple gen_Functor_binds)
-               , (foldableClassKey,    simple gen_Foldable_binds)
-               , (traversableClassKey, simple gen_Traversable_binds)
-               , (liftClassKey,        simple gen_Lift_binds)
-               , (genClassKey,         generic (gen_Generic_binds Gen0))
-               , (gen1ClassKey,        generic (gen_Generic_binds Gen1)) ]
-
-    simple gen_fn loc _ dit
-      = let (binds, deriv_stuff) = gen_fn loc dit
-        in return (binds, [], deriv_stuff, [])
+    gen_list :: [(Unique, StockGenFns)]
+    gen_list =
+      [ (eqClassKey,          mk (simple_bindsM gen_Eq_binds) no_fam_insts)
+      , (ordClassKey,         mk (simple_bindsM gen_Ord_binds) no_fam_insts)
+      , (enumClassKey,        mk (simple_bindsM gen_Enum_binds) no_fam_insts)
+      , (boundedClassKey,     mk (simple_binds gen_Bounded_binds) no_fam_insts)
+      , (ixClassKey,          mk (simple_bindsM gen_Ix_binds) no_fam_insts)
+      , (showClassKey,        mk (read_or_show_binds gen_Show_binds) no_fam_insts)
+      , (readClassKey,        mk (read_or_show_binds gen_Read_binds) no_fam_insts)
+      , (dataClassKey,        mk (simple_bindsM gen_Data_binds) no_fam_insts)
+      , (functorClassKey,     mk (simple_binds gen_Functor_binds) no_fam_insts)
+      , (foldableClassKey,    mk (simple_binds gen_Foldable_binds) no_fam_insts)
+      , (traversableClassKey, mk (simple_binds gen_Traversable_binds) no_fam_insts)
+      , (liftClassKey,        mk (simple_binds gen_Lift_binds) no_fam_insts)
+      , (genClassKey,         mk (generic_binds Gen0) (generic_fam_inst Gen0))
+      , (gen1ClassKey,        mk (generic_binds Gen1) (generic_fam_inst Gen1))
+      ]
+
+    mk gen_binds_fn gen_fam_insts_fn = StockGenFns
+      { stock_gen_binds     = gen_binds_fn
+      , stock_gen_fam_insts = gen_fam_insts_fn
+      }
+
+    simple_binds gen_fn loc dit
+      = let (binds, aux_specs) = gen_fn loc dit
+        in return (binds, [], aux_specs, [])
 
     -- 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 _ dit
-      = do { (binds, deriv_stuff) <- gen_fn loc dit
-           ; return (binds, [], deriv_stuff, []) }
+    simple_bindsM gen_fn loc dit
+      = do { (binds, aux_specs) <- gen_fn loc dit
+           ; return (binds, [], aux_specs, []) }
 
-    read_or_show gen_fn loc _ dit
+    read_or_show_binds gen_fn loc dit
       = do { let tc = dit_rep_tc dit
            ; fix_env <- getDataConFixityFun tc
-           ; let (binds, deriv_stuff) = gen_fn fix_env loc dit
-                 field_names          = all_field_names tc
-           ; return (binds, [], deriv_stuff, field_names) }
+           ; let (binds, aux_specs) = gen_fn fix_env loc dit
+                 field_names        = all_field_names tc
+           ; return (binds, [], aux_specs, field_names) }
 
-    generic gen_fn _ inst_tys dit
+    generic_binds gk loc dit
       = do { let tc = dit_rep_tc dit
-           ; fix_env <- getDataConFixityFun tc
-           ; (binds, sigs, faminst) <- gen_fn fix_env inst_tys dit
+           ; (binds, sigs) <- gen_Generic_binds gk loc dit
            ; let field_names = all_field_names tc
-           ; return (binds, sigs, unitBag (DerivFamInst faminst), field_names) }
+           ; return (binds, sigs, emptyBag, field_names) }
+
+    generic_fam_inst gk loc dit
+      = do { let tc = dit_rep_tc dit
+           ; fix_env <- getDataConFixityFun tc
+           ; faminst <- gen_Generic_fam_inst gk fix_env loc dit
+           ; return [faminst] }
+
+    no_fam_insts _ _ = pure []
 
     -- See Note [Deriving and unused record selectors]
     all_field_names = map flSelector . concatMap dataConFieldLabels
@@ -983,9 +1024,10 @@ non_coercible_class cls
 
 ------------------------------------------------------------------
 
-newDerivClsInst :: ThetaType -> DerivSpec theta -> TcM ClsInst
-newDerivClsInst theta (DS { ds_name = dfun_name, ds_overlap = overlap_mode
-                          , ds_tvs = tvs, ds_cls = clas, ds_tys = tys })
+newDerivClsInst :: DerivSpec ThetaType -> TcM ClsInst
+newDerivClsInst (DS { ds_name = dfun_name, ds_overlap = overlap_mode
+                    , ds_tvs = tvs, ds_theta = theta
+                    , ds_cls = clas, ds_tys = tys })
   = newClsInst overlap_mode dfun_name tvs theta clas tys
 
 extendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a