Refactoring: Consolidate some arguments with DerivInstTys

Various functions in GHC.Tc.Deriv.* were passing around `TyCon`s and
`[Type]`s that ultimately come from the same `DerivInstTys`. This patch
moves the definition of `DerivInstTys` to `GHC.Tc.Deriv.Generate` so that
all of these `TyCon` and `[Type]` arguments can be consolidated into a
single `DerivInstTys`. Not only does this make the code easier to read
(in my opinion), this will also be important in a subsequent commit where we
need to add another field to `DerivInstTys` that will also be used from
`GHC.Tc.Deriv.Generate` and friends.

5 files changed, 135 insertions, 141 deletions

diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index f82bf38abe..708239c0ba 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -1350,16 +1350,13 @@ mk_eqn_from_mechanism mechanism
 
 mk_eqn_stock :: DerivInstTys -- Information about the arguments to the class
              -> DerivM EarlyDerivSpec
-mk_eqn_stock dit@(DerivInstTys { dit_cls_tys = cls_tys
-                               , dit_tc      = tc
-                               , dit_rep_tc  = rep_tc })
+mk_eqn_stock dit
   = do DerivEnv { denv_cls  = cls
                 , denv_ctxt = deriv_ctxt } <- ask
        dflags <- getDynFlags
        let isDeriveAnyClassEnabled =
              deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
-       case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys
-                                           tc rep_tc of
+       case checkOriginativeSideConditions dflags deriv_ctxt cls dit of
          CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
                                   DerivSpecStock { dsm_stock_dit    = dit
                                                  , dsm_stock_gen_fn = gen_fn }
@@ -1431,9 +1428,8 @@ mk_eqn_no_strategy = do
     -- Use heuristics (checkOriginativeSideConditions) to determine whether
     -- stock or anyclass deriving should be used.
     mk_eqn_originative :: DerivInstTys -> DerivM EarlyDerivSpec
-    mk_eqn_originative dit@(DerivInstTys { dit_cls_tys = cls_tys
-                                         , dit_tc      = tc
-                                         , dit_rep_tc  = rep_tc }) = do
+    mk_eqn_originative dit@(DerivInstTys { dit_tc     = tc
+                                         , dit_rep_tc = rep_tc }) = do
       DerivEnv { denv_cls  = cls
                , denv_ctxt = deriv_ctxt } <- ask
       dflags <- getDynFlags
@@ -1447,8 +1443,7 @@ mk_eqn_no_strategy = do
             | otherwise
             = DerivErrNotStockDeriveable isDeriveAnyClassEnabled
 
-      case checkOriginativeSideConditions dflags deriv_ctxt cls
-             cls_tys tc rep_tc of
+      case checkOriginativeSideConditions dflags deriv_ctxt cls dit of
         NonDerivableClass     -> derivingThingFailWith NoGeneralizedNewtypeDeriving dac_error
         StockClassError why   -> derivingThingFailWith NoGeneralizedNewtypeDeriving why
         CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
@@ -1476,7 +1471,6 @@ mkNewTypeEqn :: Bool -- Was this instance derived using an explicit @newtype@
                      -- deriving strategy?
              -> DerivInstTys -> DerivM EarlyDerivSpec
 mkNewTypeEqn newtype_strat dit@(DerivInstTys { dit_cls_tys     = cls_tys
-                                             , dit_tc          = tycon
                                              , dit_rep_tc      = rep_tycon
                                              , dit_rep_tc_args = rep_tc_args })
 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
@@ -1573,8 +1567,7 @@ mkNewTypeEqn newtype_strat dit@(DerivInstTys { dit_cls_tys     = cls_tys
              && ((newtype_deriving && not deriveAnyClass)
                   || std_class_via_coercible cls)
          then mk_eqn_newtype dit rep_inst_ty
-         else case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys
-                                                 tycon rep_tycon of
+         else case checkOriginativeSideConditions dflags deriv_ctxt cls dit of
                StockClassError why
                  -- There's a particular corner case where
                  --
@@ -2017,12 +2010,9 @@ genDerivStuff mechanism loc clas inst_tys tyvars
         -> gen_newtype_or_via rhs_ty
 
       -- Try a stock deriver
-      DerivSpecStock { dsm_stock_dit    = DerivInstTys
-                        { dit_rep_tc = rep_tc
-                        , dit_rep_tc_args = rep_tc_args
-                        }
+      DerivSpecStock { dsm_stock_dit    = dit
                      , dsm_stock_gen_fn = gen_fn }
-        -> gen_fn loc rep_tc rep_tc_args inst_tys
+        -> gen_fn loc inst_tys dit
 
       -- Try DeriveAnyClass
       DerivSpecAnyClass -> do
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs
index bc22c6f7c9..204c8ce88d 100644
--- a/compiler/GHC/Tc/Deriv/Functor.hs
+++ b/compiler/GHC/Tc/Deriv/Functor.hs
@@ -149,10 +149,10 @@ 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 -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Functor_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
 -- When the argument is phantom, we can use  fmap _ = coerce
 -- See Note [Phantom types with Functor, Foldable, and Traversable]
-gen_Functor_binds loc tycon _
+gen_Functor_binds loc (DerivInstTys{dit_rep_tc = tycon})
   | Phantom <- last (tyConRoles tycon)
   = (unitBag fmap_bind, emptyBag)
   where
@@ -163,7 +163,8 @@ gen_Functor_binds loc tycon _
                                coerce_Expr]
     fmap_match_ctxt = mkPrefixFunRhs fmap_name
 
-gen_Functor_binds loc tycon tycon_args
+gen_Functor_binds loc (DerivInstTys{ dit_rep_tc = tycon
+                                   , dit_rep_tc_args = tycon_args })
   = (listToBag [fmap_bind, replace_bind], emptyBag)
   where
     data_cons = getPossibleDataCons tycon tycon_args
@@ -783,10 +784,10 @@ 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 -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Foldable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
 -- When the parameter is phantom, we can use foldMap _ _ = mempty
 -- See Note [Phantom types with Functor, Foldable, and Traversable]
-gen_Foldable_binds loc tycon _
+gen_Foldable_binds loc (DerivInstTys{dit_rep_tc = tycon})
   | Phantom <- last (tyConRoles tycon)
   = (unitBag foldMap_bind, emptyBag)
   where
@@ -797,7 +798,8 @@ gen_Foldable_binds loc tycon _
                                   mempty_Expr]
     foldMap_match_ctxt = mkPrefixFunRhs foldMap_name
 
-gen_Foldable_binds loc tycon tycon_args
+gen_Foldable_binds loc (DerivInstTys{ dit_rep_tc = tycon
+                                    , dit_rep_tc_args = tycon_args })
   | null data_cons  -- There's no real point producing anything but
                     -- foldMap for a type with no constructors.
   = (unitBag foldMap_bind, emptyBag)
@@ -1016,10 +1018,10 @@ removes all such types from consideration.
 See Note [Generated code for DeriveFoldable and DeriveTraversable].
 -}
 
-gen_Traversable_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Traversable_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
 -- When the argument is phantom, we can use traverse = pure . coerce
 -- See Note [Phantom types with Functor, Foldable, and Traversable]
-gen_Traversable_binds loc tycon _
+gen_Traversable_binds loc (DerivInstTys{dit_rep_tc = tycon})
   | Phantom <- last (tyConRoles tycon)
   = (unitBag traverse_bind, emptyBag)
   where
@@ -1031,7 +1033,8 @@ gen_Traversable_binds loc tycon _
                        (nlHsApps pure_RDR [nlHsApp coerce_Expr z_Expr])]
     traverse_match_ctxt = mkPrefixFunRhs traverse_name
 
-gen_Traversable_binds loc tycon tycon_args
+gen_Traversable_binds loc (DerivInstTys{ dit_rep_tc = tycon
+                                       , dit_rep_tc_args = tycon_args })
   = (unitBag traverse_bind, emptyBag)
   where
     data_cons = getPossibleDataCons tycon tycon_args
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index b63b7696b1..79843eb77f 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -36,7 +36,8 @@ module GHC.Tc.Deriv.Generate (
         ordOpTbl, boxConTbl, litConTbl,
         mkRdrFunBind, mkRdrFunBindEC, mkRdrFunBindSE, error_Expr,
 
-        getPossibleDataCons, tyConInstArgTys
+        getPossibleDataCons, tyConInstArgTys,
+        DerivInstTys(..)
     ) where
 
 import GHC.Prelude
@@ -212,8 +213,9 @@ for the instance decl, which it probably wasn't, so the decls
 produced don't get through the typechecker.
 -}
 
-gen_Eq_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
-gen_Eq_binds loc tycon tycon_args = do
+gen_Eq_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Eq_binds loc (DerivInstTys{ dit_rep_tc = tycon
+                              , dit_rep_tc_args = tycon_args }) = do
     return (method_binds, emptyBag)
   where
     all_cons = getPossibleDataCons tycon tycon_args
@@ -388,8 +390,9 @@ gtResult OrdGE      = true_Expr
 gtResult OrdGT      = true_Expr
 
 ------------
-gen_Ord_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
-gen_Ord_binds loc tycon tycon_args = do
+gen_Ord_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Ord_binds loc (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
       then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) []
            , emptyBag)
@@ -636,8 +639,8 @@ instance ... Enum (Foo ...) where
 For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
 -}
 
-gen_Enum_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
-gen_Enum_binds loc tycon _ = do
+gen_Enum_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     -- See Note [Auxiliary binders]
     tag2con_RDR <- new_tag2con_rdr_name loc tycon
     maxtag_RDR  <- new_maxtag_rdr_name  loc tycon
@@ -726,8 +729,8 @@ gen_Enum_binds loc tycon _ = do
 ************************************************************************
 -}
 
-gen_Bounded_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
-gen_Bounded_binds loc tycon _
+gen_Bounded_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Bounded_binds loc (DerivInstTys{dit_rep_tc = tycon})
   | isEnumerationTyCon tycon
   = (listToBag [ min_bound_enum, max_bound_enum ], emptyBag)
   | otherwise
@@ -813,9 +816,9 @@ we follow the scheme given in Figure~19 of the Haskell~1.2 report
 (p.~147).
 -}
 
-gen_Ix_binds :: SrcSpan -> TyCon -> [Type] -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Ix_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, BagDerivStuff)
 
-gen_Ix_binds loc tycon _ = do
+gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
     -- See Note [Auxiliary binders]
     tag2con_RDR <- new_tag2con_rdr_name loc tycon
 
@@ -1015,10 +1018,10 @@ These instances are also useful for Read (Either Int Emp), where
 we want to be able to parse (Left 3) just fine.
 -}
 
-gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> [Type]
+gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> DerivInstTys
                -> (LHsBinds GhcPs, BagDerivStuff)
 
-gen_Read_binds get_fixity loc tycon _
+gen_Read_binds get_fixity loc (DerivInstTys{dit_rep_tc = tycon})
   = (listToBag [read_prec, default_readlist, default_readlistprec], emptyBag)
   where
     -----------------------------------------------------------------------
@@ -1199,10 +1202,11 @@ Example
                     -- the most tightly-binding operator
 -}
 
-gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> [Type]
+gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> DerivInstTys
                -> (LHsBinds GhcPs, BagDerivStuff)
 
-gen_Show_binds get_fixity loc tycon tycon_args
+gen_Show_binds get_fixity loc (DerivInstTys{ dit_rep_tc = tycon
+                                           , dit_rep_tc_args = tycon_args })
   = (unitBag shows_prec, emptyBag)
   where
     data_cons = getPossibleDataCons tycon tycon_args
@@ -1370,12 +1374,10 @@ we generate
 -}
 
 gen_Data_binds :: SrcSpan
-               -> TyCon                 -- For data families, this is the
-                                        --  *representation* TyCon
-               -> [Type]
+               -> DerivInstTys
                -> TcM (LHsBinds GhcPs,  -- The method bindings
                        BagDerivStuff)   -- Auxiliary bindings
-gen_Data_binds loc rep_tc _
+gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
   = do { -- See Note [Auxiliary binders]
          dataT_RDR  <- new_dataT_rdr_name loc rep_tc
        ; dataC_RDRs <- traverse (new_dataC_rdr_name loc) data_cons
@@ -1636,8 +1638,10 @@ Example:
 -}
 
 
-gen_Lift_binds :: SrcSpan -> TyCon -> [Type] -> (LHsBinds GhcPs, BagDerivStuff)
-gen_Lift_binds loc tycon tycon_args = (listToBag [lift_bind, liftTyped_bind], emptyBag)
+gen_Lift_binds :: SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
+                                , dit_rep_tc_args = tycon_args }) =
+  (listToBag [lift_bind, liftTyped_bind], emptyBag)
   where
     lift_bind      = mkFunBindEC 1 loc lift_RDR (nlHsApp pure_Expr)
                                  (map (pats_etc mk_exp) data_cons)
@@ -2669,6 +2673,35 @@ tyConInstArgTys tycon tycon_args = chkAppend tycon_args $ map mkTyVarTy tycon_ar
   where
     tycon_args_suffix = drop (length tycon_args) $ tyConTyVars tycon
 
+-- | Information about the arguments to the class in a stock- or
+-- newtype-derived instance.
+-- See @Note [DerivEnv and DerivSpecMechanism]@.
+data DerivInstTys = DerivInstTys
+  { dit_cls_tys     :: [Type]
+    -- ^ Other arguments to the class except the last
+  , dit_tc          :: TyCon
+    -- ^ Type constructor for which the instance is requested
+    --   (last arguments to the type class)
+  , dit_tc_args     :: [Type]
+    -- ^ Arguments to the type constructor
+  , dit_rep_tc      :: TyCon
+    -- ^ The representation tycon for 'dit_tc'
+    --   (for data family instances). Otherwise the same as 'dit_tc'.
+  , dit_rep_tc_args :: [Type]
+    -- ^ The representation types for 'dit_tc_args'
+    --   (for data family instances). Otherwise the same as 'dit_tc_args'.
+  }
+
+instance Outputable DerivInstTys where
+  ppr (DerivInstTys { dit_cls_tys = cls_tys, dit_tc = tc, dit_tc_args = tc_args
+                    , dit_rep_tc = rep_tc, dit_rep_tc_args = rep_tc_args })
+    = hang (text "DerivInstTys")
+         2 (vcat [ text "dit_cls_tys"     <+> ppr cls_tys
+                 , text "dit_tc"          <+> ppr tc
+                 , text "dit_tc_args"     <+> ppr tc_args
+                 , text "dit_rep_tc"      <+> ppr rep_tc
+                 , text "dit_rep_tc_args" <+> ppr rep_tc_args ])
+
 {-
 Note [Auxiliary binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index eee7496b6f..db7bf0fc8b 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -78,12 +78,12 @@ For the generic representation we need to generate:
 \end{itemize}
 -}
 
-gen_Generic_binds :: GenericKind -> TyCon -> [Type]
-                 -> TcM (LHsBinds GhcPs, [LSig GhcPs], FamInst)
-gen_Generic_binds gk tc inst_tys = do
+gen_Generic_binds :: GenericKind -> [Type] -> DerivInstTys
+                  -> TcM (LHsBinds GhcPs, [LSig GhcPs], FamInst)
+gen_Generic_binds gk inst_tys dit = do
   dflags <- getDynFlags
-  repTyInsts <- tc_mkRepFamInsts gk tc inst_tys
-  let (binds, sigs) = mkBindsRep dflags gk tc
+  repTyInsts <- tc_mkRepFamInsts gk inst_tys dit
+  let (binds, sigs) = mkBindsRep dflags gk dit
   return (binds, sigs, repTyInsts)
 
 {-
@@ -148,7 +148,7 @@ following constraints are satisfied.
 
 -}
 
-canDoGenerics :: TyCon -> Validity' [DeriveGenericsErrReason]
+canDoGenerics :: DerivInstTys -> Validity' [DeriveGenericsErrReason]
 -- canDoGenerics determines if Generic/Rep can be derived.
 --
 -- Check (a) from Note [Requirements for deriving Generic and Rep] is taken
@@ -156,7 +156,7 @@ canDoGenerics :: TyCon -> Validity' [DeriveGenericsErrReason]
 --
 -- It returns IsValid if deriving is possible. It returns (NotValid reason)
 -- if not.
-canDoGenerics tc
+canDoGenerics (DerivInstTys{dit_rep_tc = tc})
   = mergeErrors (
           -- Check (b) from Note [Requirements for deriving Generic and Rep].
               (if (not (null (tyConStupidTheta tc)))
@@ -244,9 +244,9 @@ explicitly, even though foldDataConArgs is also doing this internally.
 --
 -- It returns IsValid if deriving is possible. It returns (NotValid reason)
 -- if not.
-canDoGenerics1 :: TyCon -> Validity' [DeriveGenericsErrReason]
-canDoGenerics1 rep_tc =
-  canDoGenerics rep_tc `andValid` additionalChecks
+canDoGenerics1 :: DerivInstTys -> Validity' [DeriveGenericsErrReason]
+canDoGenerics1 dit@(DerivInstTys{dit_rep_tc = rep_tc}) =
+  canDoGenerics dit `andValid` additionalChecks
   where
     additionalChecks
         -- check (d) from Note [Requirements for deriving Generic and Rep]
@@ -330,8 +330,8 @@ gk2gkDC Gen1_{} d = Gen1_DC $ last $ dataConUnivTyVars d
 
 
 -- Bindings for the Generic instance
-mkBindsRep :: DynFlags -> GenericKind -> TyCon -> (LHsBinds GhcPs, [LSig GhcPs])
-mkBindsRep dflags gk tycon = (binds, sigs)
+mkBindsRep :: DynFlags -> GenericKind -> DerivInstTys -> (LHsBinds GhcPs, [LSig GhcPs])
+mkBindsRep dflags gk (DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
       where
         binds = unitBag (mkRdrFunBind (L loc' from01_RDR) [from_eqn])
               `unionBags`
@@ -392,11 +392,12 @@ mkBindsRep dflags gk tycon = (binds, sigs)
 --------------------------------------------------------------------------------
 
 tc_mkRepFamInsts :: GenericKind   -- Gen0 or Gen1
-                 -> TyCon         -- The type to generate representation for
                  -> [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 tycon inst_tys =
+tc_mkRepFamInsts gk inst_tys dit@(DerivInstTys{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 }
@@ -437,7 +438,7 @@ tc_mkRepFamInsts gk tycon inst_tys =
              where all_tyvars = tyConTyVars tycon
 
        -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *
-     ; repTy <- tc_mkRepTy gk_ tycon arg_ki
+     ; repTy <- tc_mkRepTy gk_ dit arg_ki
 
        -- `rep_name` is a name we generate for the synonym
      ; mod <- getModule
@@ -542,14 +543,14 @@ argTyFold argVar (ArgTyAlg {ata_rec0 = mkRec0,
 
 tc_mkRepTy ::  -- Gen0_ or Gen1_, for Rep or Rep1
                GenericKind_
-              -- The type to generate representation for
-            -> TyCon
-              -- The kind of the representation type's argument
-              -- See Note [Handling kinds in a Rep instance]
+               -- Information about the last type argument to Generic(1)
+            -> DerivInstTys
+               -- The kind of the representation type's argument
+               -- See Note [Handling kinds in a Rep instance]
             -> Kind
                -- Generated representation0 type
             -> TcM Type
-tc_mkRepTy gk_ tycon k =
+tc_mkRepTy gk_ (DerivInstTys{dit_rep_tc = tycon}) k =
   do
     d1      <- tcLookupTyCon d1TyConName
     c1      <- tcLookupTyCon c1TyConName
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index dfd1b557a7..a65dcca956 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -9,7 +9,7 @@
 -- | Error-checking and other utilities for @deriving@ clauses or declarations.
 module GHC.Tc.Deriv.Utils (
         DerivM, DerivEnv(..),
-        DerivSpec(..), pprDerivSpec, DerivInstTys(..),
+        DerivSpec(..), pprDerivSpec,
         DerivSpecMechanism(..), derivSpecMechanismToStrategy, isDerivSpecStock,
         isDerivSpecNewtype, isDerivSpecAnyClass, isDerivSpecVia,
         DerivContext(..), OriginativeDerivStatus(..),
@@ -179,35 +179,6 @@ pprDerivSpec (DS { ds_loc = l, ds_name = n, ds_tvs = tvs, ds_cls = c,
 instance Outputable theta => Outputable (DerivSpec theta) where
   ppr = pprDerivSpec
 
--- | Information about the arguments to the class in a stock- or
--- newtype-derived instance.
--- See @Note [DerivEnv and DerivSpecMechanism]@.
-data DerivInstTys = DerivInstTys
-  { dit_cls_tys     :: [Type]
-    -- ^ Other arguments to the class except the last
-  , dit_tc          :: TyCon
-    -- ^ Type constructor for which the instance is requested
-    --   (last arguments to the type class)
-  , dit_tc_args     :: [Type]
-    -- ^ Arguments to the type constructor
-  , dit_rep_tc      :: TyCon
-    -- ^ The representation tycon for 'dit_tc'
-    --   (for data family instances). Otherwise the same as 'dit_tc'.
-  , dit_rep_tc_args :: [Type]
-    -- ^ The representation types for 'dit_tc_args'
-    --   (for data family instances). Otherwise the same as 'dit_tc_args'.
-  }
-
-instance Outputable DerivInstTys where
-  ppr (DerivInstTys { dit_cls_tys = cls_tys, dit_tc = tc, dit_tc_args = tc_args
-                    , dit_rep_tc = rep_tc, dit_rep_tc_args = rep_tc_args })
-    = hang (text "DITTyConHead")
-         2 (vcat [ text "dit_cls_tys"     <+> ppr cls_tys
-                 , text "dit_tc"          <+> ppr tc
-                 , text "dit_tc_args"     <+> ppr tc_args
-                 , text "dit_rep_tc"      <+> ppr rep_tc
-                 , text "dit_rep_tc_args" <+> ppr rep_tc_args ])
-
 -- | 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".
@@ -219,9 +190,8 @@ data DerivSpecMechanism
       -- instance, including what type constructor the last argument is
       -- headed by. See @Note [DerivEnv and DerivSpecMechanism]@.
     , dsm_stock_gen_fn ::
-        SrcSpan -> TyCon  -- dit_rep_tc
-                -> [Type] -- dit_rep_tc_args
-                -> [Type] -- inst_tys
+        SrcSpan -> [Type]       -- inst_tys
+                -> DerivInstTys -- dsm_stock_dit
                 -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name])
       -- ^ This function returns four things:
       --
@@ -429,7 +399,7 @@ instance Outputable DerivContext where
 -- See @Note [Deriving strategies]@ in "GHC.Tc.Deriv".
 data OriginativeDerivStatus
   = CanDeriveStock            -- Stock class, can derive
-      (SrcSpan -> TyCon -> [Type] -> [Type]
+      (SrcSpan -> [Type] -> DerivInstTys
                -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))
   | StockClassError !DeriveInstanceErrReason -- Stock class, but can't do it
   | CanDeriveAnyClass         -- See Note [Deriving any class]
@@ -565,18 +535,16 @@ is willing to support it.
 
 hasStockDeriving
   :: Class -> Maybe (SrcSpan
-                     -> TyCon
-                     -> [Type]
                      -> [Type]
+                     -> DerivInstTys
                      -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))
 hasStockDeriving clas
   = assocMaybe gen_list (getUnique clas)
   where
     gen_list
       :: [(Unique, SrcSpan
-                   -> TyCon
-                   -> [Type]
                    -> [Type]
+                   -> DerivInstTys
                    -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name]))]
     gen_list = [ (eqClassKey,          simpleM gen_Eq_binds)
                , (ordClassKey,         simpleM gen_Ord_binds)
@@ -593,27 +561,28 @@ hasStockDeriving clas
                , (genClassKey,         generic (gen_Generic_binds Gen0))
                , (gen1ClassKey,        generic (gen_Generic_binds Gen1)) ]
 
-    simple gen_fn loc tc tc_args _
-      = let (binds, deriv_stuff) = gen_fn loc tc tc_args
+    simple gen_fn loc _ dit
+      = let (binds, deriv_stuff) = gen_fn loc dit
         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 tc_args _
-      = do { (binds, deriv_stuff) <- gen_fn loc tc tc_args
+    simpleM gen_fn loc _ dit
+      = do { (binds, deriv_stuff) <- gen_fn loc dit
            ; return (binds, [], deriv_stuff, []) }
 
-    read_or_show gen_fn loc tc tc_args _
-      = do { fix_env <- getDataConFixityFun tc
-           ; let (binds, deriv_stuff) = gen_fn fix_env loc tc tc_args
+    read_or_show 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) }
 
-    generic gen_fn _ tc _ inst_tys
-      = do { (binds, sigs, faminst) <- gen_fn tc inst_tys
-           ; let field_names = all_field_names tc
+    generic gen_fn _ inst_tys dit
+      = do { (binds, sigs, faminst) <- gen_fn inst_tys dit
+           ; let field_names = all_field_names (dit_rep_tc dit)
            ; return (binds, sigs, unitBag (DerivFamInst faminst), field_names) }
 
     -- See Note [Deriving and unused record selectors]
@@ -680,13 +649,13 @@ getDataConFixityFun tc
 -- family tycon (with indexes) in error messages.
 
 checkOriginativeSideConditions
-  :: DynFlags -> DerivContext -> Class -> [TcType]
-  -> TyCon -> TyCon
+  :: DynFlags -> DerivContext -> Class -> DerivInstTys
   -> OriginativeDerivStatus
-checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys tc rep_tc
+checkOriginativeSideConditions dflags deriv_ctxt cls
+                               dit@(DerivInstTys{dit_cls_tys = cls_tys})
     -- First, check if stock deriving is possible...
   | Just cond <- stockSideConditions deriv_ctxt cls
-  = case (cond dflags tc rep_tc) of
+  = case cond dflags dit of
         NotValid err -> StockClassError err  -- Class-specific error
         IsValid  | null (filterOutInvisibleTypes (classTyCon cls) cls_tys)
                    -- All stock derivable classes are unary in the sense that
@@ -758,20 +727,16 @@ stockSideConditions deriv_ctxt cls
 type Condition
    = DynFlags
 
-  -> TyCon    -- ^ The data type's 'TyCon'. For data families, this is the
-              -- family 'TyCon'.
-
-  -> TyCon    -- ^ For data families, this is the representation 'TyCon'.
-              -- Otherwise, this is the same as the other 'TyCon' argument.
+  -> DerivInstTys -- ^ Information about the type arguments to the class.
 
   -> Validity' DeriveInstanceErrReason
-     -- ^ 'IsValid' if deriving an instance for this 'TyCon' is
+     -- ^ 'IsValid' if deriving an instance for this type is
      -- possible. Otherwise, it's @'NotValid' err@, where @err@
      -- explains what went wrong.
 
 andCond :: Condition -> Condition -> Condition
-andCond c1 c2 dflags tc rep_tc
-  = c1 dflags tc rep_tc `andValid` c2 dflags tc rep_tc
+andCond c1 c2 dflags dit
+  = c1 dflags dit `andValid` c2 dflags dit
 
 -- | Some common validity checks shared among stock derivable classes. One
 -- check that absolutely must hold is that if an instance @C (T a)@ is being
@@ -801,7 +766,8 @@ cond_stdOK
                   -- the -XEmptyDataDeriving extension.
 
   -> Condition
-cond_stdOK deriv_ctxt permissive dflags tc rep_tc
+cond_stdOK deriv_ctxt permissive dflags
+           dit@(DerivInstTys{dit_tc = tc, dit_rep_tc = rep_tc})
   = valid_ADT `andValid` valid_misc
   where
     valid_ADT, valid_misc :: Validity' DeriveInstanceErrReason
@@ -822,7 +788,7 @@ cond_stdOK deriv_ctxt permissive dflags tc rep_tc
          InferContext wildcard
            | null data_cons -- 1.
            , not permissive
-           -> checkFlag LangExt.EmptyDataDeriving dflags tc rep_tc `orValid`
+           -> checkFlag LangExt.EmptyDataDeriving dflags dit `orValid`
               NotValid (no_cons_why rep_tc)
            | not (null con_whys)
            -> NotValid $ DerivErrBadConstructor (Just $ has_wildcard wildcard) con_whys
@@ -856,14 +822,14 @@ no_cons_why :: TyCon -> DeriveInstanceErrReason
 no_cons_why = DerivErrNoConstructors
 
 cond_RepresentableOk :: Condition
-cond_RepresentableOk _ _ rep_tc =
-  case canDoGenerics rep_tc of
+cond_RepresentableOk _ dit =
+  case canDoGenerics dit of
     IsValid -> IsValid
     NotValid generic_errs -> NotValid $ DerivErrGenerics generic_errs
 
 cond_Representable1Ok :: Condition
-cond_Representable1Ok _ _ rep_tc =
-  case canDoGenerics1 rep_tc of
+cond_Representable1Ok _ dit =
+  case canDoGenerics1 dit of
     IsValid -> IsValid
     NotValid generic_errs -> NotValid $ DerivErrGenerics generic_errs
 
@@ -872,8 +838,8 @@ cond_enumOrProduct cls = cond_isEnumeration `orCond`
                          (cond_isProduct `andCond` cond_args cls)
   where
     orCond :: Condition -> Condition -> Condition
-    orCond c1 c2 dflags tc rep_tc
-      = case (c1 dflags tc rep_tc, c2 dflags tc rep_tc) of
+    orCond c1 c2 dflags dit
+      = case (c1 dflags dit, c2 dflags dit) of
          (IsValid,    _)          -> IsValid    -- c1 succeeds
          (_,          IsValid)    -> IsValid    -- c21 succeeds
          (NotValid x, NotValid y) -> NotValid $ DerivErrEnumOrProduct x y
@@ -885,7 +851,7 @@ cond_args :: Class -> Condition
 -- by generating specialised code.  For others (eg 'Data') we don't.
 -- For even others (eg 'Lift'), unlifted types aren't even a special
 -- consideration!
-cond_args cls _ _ rep_tc
+cond_args cls _ (DerivInstTys{dit_rep_tc = rep_tc})
   = case bad_args of
       []     -> IsValid
       (ty:_) -> NotValid $ DerivErrDunnoHowToDeriveForType ty
@@ -908,12 +874,12 @@ cond_args cls _ _ rep_tc
 
 
 cond_isEnumeration :: Condition
-cond_isEnumeration _ _ rep_tc
+cond_isEnumeration _ (DerivInstTys{dit_rep_tc = rep_tc})
   | isEnumerationTyCon rep_tc = IsValid
   | otherwise                 = NotValid $ DerivErrMustBeEnumType rep_tc
 
 cond_isProduct :: Condition
-cond_isProduct _ _ rep_tc
+cond_isProduct _ (DerivInstTys{dit_rep_tc = rep_tc})
   | Just _ <- tyConSingleDataCon_maybe rep_tc
   = IsValid
   | otherwise
@@ -926,7 +892,8 @@ cond_functorOK :: Bool -> Bool -> Condition
 --            (c) don't use argument in the wrong place, e.g. data T a = T (X a a)
 --            (d) optionally: don't use function types
 --            (e) no "stupid context" on data type
-cond_functorOK allowFunctions allowExQuantifiedLastTyVar _ _ rep_tc
+cond_functorOK allowFunctions allowExQuantifiedLastTyVar _
+               (DerivInstTys{dit_rep_tc = rep_tc})
   | null tc_tvs
   = NotValid $ DerivErrMustHaveSomeParameters rep_tc
 
@@ -972,7 +939,7 @@ cond_functorOK allowFunctions allowExQuantifiedLastTyVar _ _ rep_tc
 
 
 checkFlag :: LangExt.Extension -> Condition
-checkFlag flag dflags _ _
+checkFlag flag dflags _
   | xopt flag dflags = IsValid
   | otherwise        = NotValid why
   where