never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    4 
    5 -}
    6 
    7 
    8 {-# LANGUAGE MultiWayIf #-}
    9 {-# LANGUAGE TypeFamilies #-}
   10 
   11 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
   12 
   13 -- | Handles @deriving@ clauses on @data@ declarations.
   14 module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where
   15 
   16 import GHC.Prelude
   17 
   18 import GHC.Hs
   19 import GHC.Driver.Session
   20 
   21 import GHC.Tc.Errors.Types
   22 import GHC.Tc.Utils.Monad
   23 import GHC.Tc.Instance.Family
   24 import GHC.Tc.Types.Origin
   25 import GHC.Tc.Deriv.Infer
   26 import GHC.Tc.Deriv.Utils
   27 import GHC.Tc.TyCl.Class( instDeclCtxt3, tcATDefault )
   28 import GHC.Tc.Utils.Env
   29 import GHC.Tc.Deriv.Generate
   30 import GHC.Tc.Validity( allDistinctTyVars, checkValidInstHead )
   31 import GHC.Core.InstEnv
   32 import GHC.Tc.Utils.Instantiate
   33 import GHC.Core.FamInstEnv
   34 import GHC.Tc.Gen.HsType
   35 import GHC.Core.TyCo.Rep
   36 import GHC.Core.TyCo.Ppr ( pprTyVars )
   37 
   38 import GHC.Rename.Bind
   39 import GHC.Rename.Env
   40 import GHC.Rename.Module ( addTcgDUs )
   41 import GHC.Rename.Utils
   42 
   43 import GHC.Core.Unify( tcUnifyTy )
   44 import GHC.Core.Class
   45 import GHC.Core.Type
   46 import GHC.Utils.Error
   47 import GHC.Core.DataCon
   48 import GHC.Data.Maybe
   49 import GHC.Types.Name.Reader
   50 import GHC.Types.Name
   51 import GHC.Types.Name.Set as NameSet
   52 import GHC.Core.TyCon
   53 import GHC.Tc.Utils.TcType
   54 import GHC.Types.Var as Var
   55 import GHC.Types.Var.Env
   56 import GHC.Types.Var.Set
   57 import GHC.Builtin.Names
   58 import GHC.Types.SrcLoc
   59 import GHC.Utils.Misc
   60 import GHC.Utils.Outputable as Outputable
   61 import GHC.Utils.Panic
   62 import GHC.Utils.Panic.Plain
   63 import GHC.Utils.Logger
   64 import GHC.Data.Bag
   65 import GHC.Utils.FV as FV (fvVarList, unionFV, mkFVs)
   66 import qualified GHC.LanguageExtensions as LangExt
   67 
   68 import Control.Monad
   69 import Control.Monad.Trans.Class
   70 import Control.Monad.Trans.Reader
   71 import Data.List (partition, find)
   72 
   73 {-
   74 ************************************************************************
   75 *                                                                      *
   76                 Overview
   77 *                                                                      *
   78 ************************************************************************
   79 
   80 Overall plan
   81 ~~~~~~~~~~~~
   82 1.  Convert the decls (i.e. data/newtype deriving clauses,
   83     plus standalone deriving) to [EarlyDerivSpec]
   84 
   85 2.  Infer the missing contexts for the InferTheta's
   86 
   87 3.  Add the derived bindings, generating InstInfos
   88 -}
   89 
   90 data EarlyDerivSpec = InferTheta (DerivSpec [ThetaOrigin])
   91                     | GivenTheta (DerivSpec ThetaType)
   92         -- InferTheta ds => the context for the instance should be inferred
   93         --      In this case ds_theta is the list of all the sets of
   94         --      constraints needed, such as (Eq [a], Eq a), together with a
   95         --      suitable CtLoc to get good error messages.
   96         --      The inference process is to reduce this to a
   97         --      simpler form (e.g. Eq a)
   98         --
   99         -- GivenTheta ds => the exact context for the instance is supplied
  100         --                  by the programmer; it is ds_theta
  101         -- See Note [Inferring the instance context] in GHC.Tc.Deriv.Infer
  102 
  103 splitEarlyDerivSpec :: [EarlyDerivSpec]
  104                     -> ([DerivSpec [ThetaOrigin]], [DerivSpec ThetaType])
  105 splitEarlyDerivSpec [] = ([],[])
  106 splitEarlyDerivSpec (InferTheta spec : specs) =
  107     case splitEarlyDerivSpec specs of (is, gs) -> (spec : is, gs)
  108 splitEarlyDerivSpec (GivenTheta spec : specs) =
  109     case splitEarlyDerivSpec specs of (is, gs) -> (is, spec : gs)
  110 
  111 instance Outputable EarlyDerivSpec where
  112   ppr (InferTheta spec) = ppr spec <+> text "(Infer)"
  113   ppr (GivenTheta spec) = ppr spec <+> text "(Given)"
  114 
  115 {-
  116 Note [Data decl contexts]
  117 ~~~~~~~~~~~~~~~~~~~~~~~~~
  118 Consider
  119 
  120         data (RealFloat a) => Complex a = !a :+ !a deriving( Read )
  121 
  122 We will need an instance decl like:
  123 
  124         instance (Read a, RealFloat a) => Read (Complex a) where
  125           ...
  126 
  127 The RealFloat in the context is because the read method for Complex is bound
  128 to construct a Complex, and doing that requires that the argument type is
  129 in RealFloat.
  130 
  131 But this ain't true for Show, Eq, Ord, etc, since they don't construct
  132 a Complex; they only take them apart.
  133 
  134 Our approach: identify the offending classes, and add the data type
  135 context to the instance decl.  The "offending classes" are
  136 
  137         Read, Enum?
  138 
  139 FURTHER NOTE ADDED March 2002.  In fact, Haskell98 now requires that
  140 pattern matching against a constructor from a data type with a context
  141 gives rise to the constraints for that context -- or at least the thinned
  142 version.  So now all classes are "offending".
  143 
  144 Note [Newtype deriving]
  145 ~~~~~~~~~~~~~~~~~~~~~~~
  146 Consider this:
  147     class C a b
  148     instance C [a] Char
  149     newtype T = T Char deriving( C [a] )
  150 
  151 Notice the free 'a' in the deriving.  We have to fill this out to
  152     newtype T = T Char deriving( forall a. C [a] )
  153 
  154 And then translate it to:
  155     instance C [a] Char => C [a] T where ...
  156 
  157 Note [Unused constructors and deriving clauses]
  158 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  159 See #3221.  Consider
  160    data T = T1 | T2 deriving( Show )
  161 Are T1 and T2 unused?  Well, no: the deriving clause expands to mention
  162 both of them.  So we gather defs/uses from deriving just like anything else.
  163 
  164 -}
  165 
  166 -- | Stuff needed to process a datatype's `deriving` clauses
  167 data DerivInfo = DerivInfo { di_rep_tc  :: TyCon
  168                              -- ^ The data tycon for normal datatypes,
  169                              -- or the *representation* tycon for data families
  170                            , di_scoped_tvs :: ![(Name,TyVar)]
  171                              -- ^ Variables that scope over the deriving clause.
  172                              -- See @Note [Scoped tyvars in a TcTyCon]@ in
  173                              -- "GHC.Core.TyCon".
  174                            , di_clauses :: [LHsDerivingClause GhcRn]
  175                            , di_ctxt    :: SDoc -- ^ error context
  176                            }
  177 
  178 {-
  179 
  180 ************************************************************************
  181 *                                                                      *
  182 Top-level function for \tr{derivings}
  183 *                                                                      *
  184 ************************************************************************
  185 -}
  186 
  187 tcDeriving  :: [DerivInfo]       -- All `deriving` clauses
  188             -> [LDerivDecl GhcRn] -- All stand-alone deriving declarations
  189             -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
  190 tcDeriving deriv_infos deriv_decls
  191   = recoverM (do { g <- getGblEnv
  192                  ; return (g, emptyBag, emptyValBindsOut)}) $
  193     do  { -- Fish the "deriving"-related information out of the GHC.Tc.Utils.Env
  194           -- And make the necessary "equations".
  195           early_specs <- makeDerivSpecs deriv_infos deriv_decls
  196         ; traceTc "tcDeriving" (ppr early_specs)
  197 
  198         ; let (infer_specs, given_specs) = splitEarlyDerivSpec early_specs
  199         ; insts1 <- mapM genInst given_specs
  200         ; insts2 <- mapM genInst infer_specs
  201 
  202         ; dflags <- getDynFlags
  203         ; logger <- getLogger
  204 
  205         ; let (_, deriv_stuff, fvs) = unzip3 (insts1 ++ insts2)
  206         ; loc <- getSrcSpanM
  207         ; let (binds, famInsts) = genAuxBinds dflags loc
  208                                     (unionManyBags deriv_stuff)
  209 
  210         ; let mk_inst_infos1 = map fstOf3 insts1
  211         ; inst_infos1 <- apply_inst_infos mk_inst_infos1 given_specs
  212 
  213           -- We must put all the derived type family instances (from both
  214           -- infer_specs and given_specs) in the local instance environment
  215           -- before proceeding, or else simplifyInstanceContexts might
  216           -- get stuck if it has to reason about any of those family instances.
  217           -- See Note [Staging of tcDeriving]
  218         ; tcExtendLocalFamInstEnv (bagToList famInsts) $
  219           -- NB: only call tcExtendLocalFamInstEnv once, as it performs
  220           -- validity checking for all of the family instances you give it.
  221           -- If the family instances have errors, calling it twice will result
  222           -- in duplicate error messages!
  223 
  224      do {
  225         -- the stand-alone derived instances (@inst_infos1@) are used when
  226         -- inferring the contexts for "deriving" clauses' instances
  227         -- (@infer_specs@)
  228         ; final_specs <- extendLocalInstEnv (map iSpec inst_infos1) $
  229                          simplifyInstanceContexts infer_specs
  230 
  231         ; let mk_inst_infos2 = map fstOf3 insts2
  232         ; inst_infos2 <- apply_inst_infos mk_inst_infos2 final_specs
  233         ; let inst_infos = inst_infos1 ++ inst_infos2
  234 
  235         ; (inst_info, rn_binds, rn_dus) <- renameDeriv inst_infos binds
  236 
  237         ; unless (isEmptyBag inst_info) $
  238              liftIO (putDumpFileMaybe logger Opt_D_dump_deriv "Derived instances"
  239                         FormatHaskell
  240                         (ddump_deriving inst_info rn_binds famInsts))
  241 
  242         ; gbl_env <- tcExtendLocalInstEnv (map iSpec (bagToList inst_info))
  243                                           getGblEnv
  244         ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ concat fvs)
  245         ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) } }
  246   where
  247     ddump_deriving :: Bag (InstInfo GhcRn) -> HsValBinds GhcRn
  248                    -> Bag FamInst             -- ^ Rep type family instances
  249                    -> SDoc
  250     ddump_deriving inst_infos extra_binds repFamInsts
  251       =    hang (text "Derived class instances:")
  252               2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") (bagToList inst_infos))
  253                  $$ ppr extra_binds)
  254         $$ hangP (text "Derived type family instances:")
  255              (vcat (map pprRepTy (bagToList repFamInsts)))
  256 
  257     hangP s x = text "" $$ hang s 2 x
  258 
  259     -- Apply the suspended computations given by genInst calls.
  260     -- See Note [Staging of tcDeriving]
  261     apply_inst_infos :: [ThetaType -> TcM (InstInfo GhcPs)]
  262                      -> [DerivSpec ThetaType] -> TcM [InstInfo GhcPs]
  263     apply_inst_infos = zipWithM (\f ds -> f (ds_theta ds))
  264 
  265 -- Prints the representable type family instance
  266 pprRepTy :: FamInst -> SDoc
  267 pprRepTy fi@(FamInst { fi_tys = lhs })
  268   = text "type" <+> ppr (mkTyConApp (famInstTyCon fi) lhs) <+>
  269       equals <+> ppr rhs
  270   where rhs = famInstRHS fi
  271 
  272 renameDeriv :: [InstInfo GhcPs]
  273             -> Bag (LHsBind GhcPs, LSig GhcPs)
  274             -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
  275 renameDeriv inst_infos bagBinds
  276   = discardWarnings $
  277     -- Discard warnings about unused bindings etc
  278     setXOptM LangExt.EmptyCase $
  279     -- Derived decls (for empty types) can have
  280     --    case x of {}
  281     setXOptM LangExt.ScopedTypeVariables $
  282     setXOptM LangExt.KindSignatures $
  283     -- Derived decls (for newtype-deriving) can use ScopedTypeVariables &
  284     -- KindSignatures
  285     setXOptM LangExt.TypeApplications $
  286     -- GND/DerivingVia uses TypeApplications in generated code
  287     -- (See Note [Newtype-deriving instances] in GHC.Tc.Deriv.Generate)
  288     unsetXOptM LangExt.RebindableSyntax $
  289     -- See Note [Avoid RebindableSyntax when deriving]
  290     setXOptM LangExt.TemplateHaskellQuotes $
  291     -- DeriveLift makes uses of quotes
  292     do  {
  293         -- Bring the extra deriving stuff into scope
  294         -- before renaming the instances themselves
  295         ; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos))
  296         ; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds
  297         ; let aux_val_binds = ValBinds NoAnnSortKey aux_binds (bagToList aux_sigs)
  298         -- Importantly, we use rnLocalValBindsLHS, not rnTopBindsLHS, to rename
  299         -- auxiliary bindings as if they were defined locally.
  300         -- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
  301         ; (bndrs, rn_aux_lhs) <- rnLocalValBindsLHS emptyFsEnv aux_val_binds
  302         ; bindLocalNames bndrs $
  303     do  { (rn_aux, dus_aux) <- rnLocalValBindsRHS (mkNameSet bndrs) rn_aux_lhs
  304         ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
  305         ; return (listToBag rn_inst_infos, rn_aux,
  306                   dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
  307 
  308   where
  309     rn_inst_info :: InstInfo GhcPs -> TcM (InstInfo GhcRn, FreeVars)
  310     rn_inst_info
  311       inst_info@(InstInfo { iSpec = inst
  312                           , iBinds = InstBindings
  313                             { ib_binds = binds
  314                             , ib_tyvars = tyvars
  315                             , ib_pragmas = sigs
  316                             , ib_extensions = exts -- Only for type-checking
  317                             , ib_derived = sa } })
  318         =  do { (rn_binds, rn_sigs, fvs) <- rnMethodBinds False (is_cls_nm inst)
  319                                                           tyvars binds sigs
  320               ; let binds' = InstBindings { ib_binds = rn_binds
  321                                           , ib_tyvars = tyvars
  322                                           , ib_pragmas = rn_sigs
  323                                           , ib_extensions = exts
  324                                           , ib_derived = sa }
  325               ; return (inst_info { iBinds = binds' }, fvs) }
  326 
  327 {-
  328 Note [Staging of tcDeriving]
  329 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  330 Here's a tricky corner case for deriving (adapted from #2721):
  331 
  332     class C a where
  333       type T a
  334       foo :: a -> T a
  335 
  336     instance C Int where
  337       type T Int = Int
  338       foo = id
  339 
  340     newtype N = N Int deriving C
  341 
  342 This will produce an instance something like this:
  343 
  344     instance C N where
  345       type T N = T Int
  346       foo = coerce (foo :: Int -> T Int) :: N -> T N
  347 
  348 We must be careful in order to typecheck this code. When determining the
  349 context for the instance (in simplifyInstanceContexts), we need to determine
  350 that T N and T Int have the same representation, but to do that, the T N
  351 instance must be in the local family instance environment. Otherwise, GHC
  352 would be unable to conclude that T Int is representationally equivalent to
  353 T Int, and simplifyInstanceContexts would get stuck.
  354 
  355 Previously, tcDeriving would defer adding any derived type family instances to
  356 the instance environment until the very end, which meant that
  357 simplifyInstanceContexts would get called without all the type family instances
  358 it needed in the environment in order to properly simplify instance like
  359 the C N instance above.
  360 
  361 To avoid this scenario, we carefully structure the order of events in
  362 tcDeriving. We first call genInst on the standalone derived instance specs and
  363 the instance specs obtained from deriving clauses. Note that the return type of
  364 genInst is a triple:
  365 
  366     TcM (ThetaType -> TcM (InstInfo RdrName), BagDerivStuff, Maybe Name)
  367 
  368 The type family instances are in the BagDerivStuff. The first field of the
  369 triple is a suspended computation which, given an instance context, produces
  370 the rest of the instance. The fact that it is suspended is important, because
  371 right now, we don't have ThetaTypes for the instances that use deriving clauses
  372 (only the standalone-derived ones).
  373 
  374 Now we can collect the type family instances and extend the local instance
  375 environment. At this point, it is safe to run simplifyInstanceContexts on the
  376 deriving-clause instance specs, which gives us the ThetaTypes for the
  377 deriving-clause instances. Now we can feed all the ThetaTypes to the
  378 suspended computations and obtain our InstInfos, at which point
  379 tcDeriving is done.
  380 
  381 An alternative design would be to split up genInst so that the
  382 family instances are generated separately from the InstInfos. But this would
  383 require carving up a lot of the GHC deriving internals to accommodate the
  384 change. On the other hand, we can keep all of the InstInfo and type family
  385 instance logic together in genInst simply by converting genInst to
  386 continuation-returning style, so we opt for that route.
  387 
  388 Note [Why we don't pass rep_tc into deriveTyData]
  389 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  390 Down in the bowels of mk_deriv_inst_tys_maybe, we need to convert the fam_tc
  391 back into the rep_tc by means of a lookup. And yet we have the rep_tc right
  392 here! Why look it up again? Answer: it's just easier this way.
  393 We drop some number of arguments from the end of the datatype definition
  394 in deriveTyData. The arguments are dropped from the fam_tc.
  395 This action may drop a *different* number of arguments
  396 passed to the rep_tc, depending on how many free variables, etc., the
  397 dropped patterns have.
  398 
  399 Also, this technique carries over the kind substitution from deriveTyData
  400 nicely.
  401 
  402 Note [Avoid RebindableSyntax when deriving]
  403 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  404 The RebindableSyntax extension interacts awkwardly with the derivation of
  405 any stock class whose methods require the use of string literals. The Show
  406 class is a simple example (see #12688):
  407 
  408   {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
  409   newtype Text = Text String
  410   fromString :: String -> Text
  411   fromString = Text
  412 
  413   data Foo = Foo deriving Show
  414 
  415 This will generate code to the effect of:
  416 
  417   instance Show Foo where
  418     showsPrec _ Foo = showString "Foo"
  419 
  420 But because RebindableSyntax and OverloadedStrings are enabled, the "Foo"
  421 string literal is now of type Text, not String, which showString doesn't
  422 accept! This causes the generated Show instance to fail to typecheck.
  423 
  424 To avoid this kind of scenario, we simply turn off RebindableSyntax entirely
  425 in derived code.
  426 
  427 ************************************************************************
  428 *                                                                      *
  429                 From HsSyn to DerivSpec
  430 *                                                                      *
  431 ************************************************************************
  432 
  433 @makeDerivSpecs@ fishes around to find the info about needed derived instances.
  434 -}
  435 
  436 makeDerivSpecs :: [DerivInfo]
  437                -> [LDerivDecl GhcRn]
  438                -> TcM [EarlyDerivSpec]
  439 makeDerivSpecs deriv_infos deriv_decls
  440   = do  { eqns1 <- sequenceA
  441                      [ deriveClause rep_tc scoped_tvs dcs (deriv_clause_preds dct) err_ctxt
  442                      | DerivInfo { di_rep_tc = rep_tc
  443                                  , di_scoped_tvs = scoped_tvs
  444                                  , di_clauses = clauses
  445                                  , di_ctxt = err_ctxt } <- deriv_infos
  446                      , L _ (HsDerivingClause { deriv_clause_strategy = dcs
  447                                              , deriv_clause_tys = dct })
  448                          <- clauses
  449                      ]
  450         ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls
  451         ; return $ concat eqns1 ++ catMaybes eqns2 }
  452   where
  453     deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn]
  454     deriv_clause_preds (L _ dct) = case dct of
  455       DctSingle _ ty -> [ty]
  456       DctMulti _ tys -> tys
  457 
  458 ------------------------------------------------------------------
  459 -- | Process the derived classes in a single @deriving@ clause.
  460 deriveClause :: TyCon
  461              -> [(Name, TcTyVar)]  -- Scoped type variables taken from tcTyConScopedTyVars
  462                                    -- See Note [Scoped tyvars in a TcTyCon] in "GHC.Core.TyCon"
  463              -> Maybe (LDerivStrategy GhcRn)
  464              -> [LHsSigType GhcRn] -> SDoc
  465              -> TcM [EarlyDerivSpec]
  466 deriveClause rep_tc scoped_tvs mb_lderiv_strat deriv_preds err_ctxt
  467   = addErrCtxt err_ctxt $ do
  468       traceTc "deriveClause" $ vcat
  469         [ text "tvs"             <+> ppr tvs
  470         , text "scoped_tvs"      <+> ppr scoped_tvs
  471         , text "tc"              <+> ppr tc
  472         , text "tys"             <+> ppr tys
  473         , text "mb_lderiv_strat" <+> ppr mb_lderiv_strat ]
  474       tcExtendNameTyVarEnv scoped_tvs $ do
  475         (mb_lderiv_strat', via_tvs) <- tcDerivStrategy mb_lderiv_strat
  476         tcExtendTyVarEnv via_tvs $
  477         -- Moreover, when using DerivingVia one can bind type variables in
  478         -- the `via` type as well, so these type variables must also be
  479         -- brought into scope.
  480           mapMaybeM (derivePred tc tys mb_lderiv_strat' via_tvs) deriv_preds
  481           -- After typechecking the `via` type once, we then typecheck all
  482           -- of the classes associated with that `via` type in the
  483           -- `deriving` clause.
  484           -- See also Note [Don't typecheck too much in DerivingVia].
  485   where
  486     tvs = tyConTyVars rep_tc
  487     (tc, tys) = case tyConFamInstSig_maybe rep_tc of
  488                         -- data family:
  489                   Just (fam_tc, pats, _) -> (fam_tc, pats)
  490       -- NB: deriveTyData wants the *user-specified*
  491       -- name. See Note [Why we don't pass rep_tc into deriveTyData]
  492 
  493                   _ -> (rep_tc, mkTyVarTys tvs)     -- datatype
  494 
  495 -- | Process a single predicate in a @deriving@ clause.
  496 --
  497 -- This returns a 'Maybe' because the user might try to derive 'Typeable',
  498 -- which is a no-op nowadays.
  499 derivePred :: TyCon -> [Type] -> Maybe (LDerivStrategy GhcTc) -> [TyVar]
  500            -> LHsSigType GhcRn -> TcM (Maybe EarlyDerivSpec)
  501 derivePred tc tys mb_lderiv_strat via_tvs deriv_pred =
  502   -- We carefully set up uses of recoverM to minimize error message
  503   -- cascades. See Note [Recovering from failures in deriving clauses].
  504   recoverM (pure Nothing) $
  505   setSrcSpan (getLocA deriv_pred) $ do
  506     traceTc "derivePred" $ vcat
  507       [ text "tc"              <+> ppr tc
  508       , text "tys"             <+> ppr tys
  509       , text "deriv_pred"      <+> ppr deriv_pred
  510       , text "mb_lderiv_strat" <+> ppr mb_lderiv_strat
  511       , text "via_tvs"         <+> ppr via_tvs ]
  512     (cls_tvs, cls, cls_tys, cls_arg_kinds) <- tcHsDeriv deriv_pred
  513     when (cls_arg_kinds `lengthIsNot` 1) $
  514       failWithTc (TcRnNonUnaryTypeclassConstraint deriv_pred)
  515     let [cls_arg_kind] = cls_arg_kinds
  516         mb_deriv_strat = fmap unLoc mb_lderiv_strat
  517     if (className cls == typeableClassName)
  518     then do warnUselessTypeable
  519             return Nothing
  520     else let deriv_tvs = via_tvs ++ cls_tvs in
  521          Just <$> deriveTyData tc tys mb_deriv_strat
  522                                deriv_tvs cls cls_tys cls_arg_kind
  523 
  524 {-
  525 Note [Don't typecheck too much in DerivingVia]
  526 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  527 Consider the following example:
  528 
  529   data D = ...
  530     deriving (A1 t, ..., A20 t) via T t
  531 
  532 GHC used to be engineered such that it would typecheck the `deriving`
  533 clause like so:
  534 
  535 1. Take the first class in the clause (`A1`).
  536 2. Typecheck the `via` type (`T t`) and bring its bound type variables
  537    into scope (`t`).
  538 3. Typecheck the class (`A1`).
  539 4. Move on to the next class (`A2`) and repeat the process until all
  540    classes have been typechecked.
  541 
  542 This algorithm gets the job done most of the time, but it has two notable
  543 flaws. One flaw is that it is wasteful: it requires that `T t` be typechecked
  544 20 different times, once for each class in the `deriving` clause. This is
  545 unnecessary because we only need to typecheck `T t` once in order to get
  546 access to its bound type variable.
  547 
  548 The other issue with this algorithm arises when there are no classes in the
  549 `deriving` clause, like in the following example:
  550 
  551   data D2 = ...
  552     deriving () via Maybe Maybe
  553 
  554 Because there are no classes, the algorithm above will simply do nothing.
  555 As a consequence, GHC will completely miss the fact that `Maybe Maybe`
  556 is ill-kinded nonsense (#16923).
  557 
  558 To address both of these problems, GHC now uses this algorithm instead:
  559 
  560 1. Typecheck the `via` type and bring its bound type variables into scope.
  561 2. Take the first class in the `deriving` clause.
  562 3. Typecheck the class.
  563 4. Move on to the next class and repeat the process until all classes have been
  564    typechecked.
  565 
  566 This algorithm ensures that the `via` type is always typechecked, even if there
  567 are no classes in the `deriving` clause. Moreover, it typecheck the `via` type
  568 /exactly/ once and no more, even if there are multiple classes in the clause.
  569 
  570 Note [Recovering from failures in deriving clauses]
  571 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  572 Consider what happens if you run this program (from #10684) without
  573 DeriveGeneric enabled:
  574 
  575     data A = A deriving (Show, Generic)
  576     data B = B A deriving (Show)
  577 
  578 Naturally, you'd expect GHC to give an error to the effect of:
  579 
  580     Can't make a derived instance of `Generic A':
  581       You need -XDeriveGeneric to derive an instance for this class
  582 
  583 And *only* that error, since the other two derived Show instances appear to be
  584 independent of this derived Generic instance. Yet GHC also used to give this
  585 additional error on the program above:
  586 
  587     No instance for (Show A)
  588       arising from the 'deriving' clause of a data type declaration
  589     When deriving the instance for (Show B)
  590 
  591 This was happening because when GHC encountered any error within a single
  592 data type's set of deriving clauses, it would call recoverM and move on
  593 to the next data type's deriving clauses. One unfortunate consequence of
  594 this design is that if A's derived Generic instance failed, its derived
  595 Show instance would be skipped entirely, leading to the "No instance for
  596 (Show A)" error cascade.
  597 
  598 The solution to this problem is to push through uses of recoverM to the
  599 level of the individual derived classes in a particular data type's set of
  600 deriving clauses. That is, if you have:
  601 
  602     newtype C = C D
  603       deriving (E, F, G)
  604 
  605 Then instead of processing instances E through M under the scope of a single
  606 recoverM, as in the following pseudocode:
  607 
  608   recoverM (pure Nothing) $ mapM derivePred [E, F, G]
  609 
  610 We instead use recoverM in each iteration of the loop:
  611 
  612   mapM (recoverM (pure Nothing) . derivePred) [E, F, G]
  613 
  614 And then process each class individually, under its own recoverM scope. That
  615 way, failure to derive one class doesn't cancel out other classes in the
  616 same set of clause-derived classes.
  617 -}
  618 
  619 ------------------------------------------------------------------
  620 deriveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)
  621 -- Process a single standalone deriving declaration
  622 --  e.g.   deriving instance Show a => Show (T a)
  623 -- Rather like tcLocalInstDecl
  624 --
  625 -- This returns a Maybe because the user might try to derive Typeable, which is
  626 -- a no-op nowadays.
  627 deriveStandalone (L loc (DerivDecl _ deriv_ty mb_lderiv_strat overlap_mode))
  628   = setSrcSpanA loc                       $
  629     addErrCtxt (standaloneCtxt deriv_ty)  $
  630     do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
  631        ; let ctxt = GHC.Tc.Types.Origin.InstDeclCtxt True
  632        ; traceTc "Deriving strategy (standalone deriving)" $
  633            vcat [ppr mb_lderiv_strat, ppr deriv_ty]
  634        ; (mb_lderiv_strat, via_tvs) <- tcDerivStrategy mb_lderiv_strat
  635        ; (cls_tvs, deriv_ctxt, cls, inst_tys)
  636            <- tcExtendTyVarEnv via_tvs $
  637               tcStandaloneDerivInstType ctxt deriv_ty
  638        ; let mb_deriv_strat = fmap unLoc mb_lderiv_strat
  639              tvs            = via_tvs ++ cls_tvs
  640          -- See Note [Unify kinds in deriving]
  641        ; (tvs', deriv_ctxt', inst_tys', mb_deriv_strat') <-
  642            case mb_deriv_strat of
  643              -- Perform an additional unification with the kind of the `via`
  644              -- type and the result of the previous kind unification.
  645              Just (ViaStrategy via_ty)
  646                   -- This unification must be performed on the last element of
  647                   -- inst_tys, but we have not yet checked for this property.
  648                   -- (This is done later in expectNonNullaryClsArgs). For now,
  649                   -- simply do nothing if inst_tys is empty, since
  650                   -- expectNonNullaryClsArgs will error later if this
  651                   -- is the case.
  652                |  Just inst_ty <- lastMaybe inst_tys
  653                -> do
  654                let via_kind     = tcTypeKind via_ty
  655                    inst_ty_kind = tcTypeKind inst_ty
  656                    mb_match     = tcUnifyTy inst_ty_kind via_kind
  657 
  658                checkTc (isJust mb_match)
  659                        (TcRnCannotDeriveInstance cls mempty Nothing NoGeneralizedNewtypeDeriving $
  660                           DerivErrDerivingViaWrongKind inst_ty_kind via_ty via_kind)
  661 
  662                let Just kind_subst = mb_match
  663                    ki_subst_range  = getTCvSubstRangeFVs kind_subst
  664                    -- See Note [Unification of two kind variables in deriving]
  665                    unmapped_tkvs = filter (\v -> v `notElemTCvSubst` kind_subst
  666                                         && not (v `elemVarSet` ki_subst_range))
  667                                           tvs
  668                    (subst, _)    = substTyVarBndrs kind_subst unmapped_tkvs
  669                    (final_deriv_ctxt, final_deriv_ctxt_tys)
  670                      = case deriv_ctxt of
  671                          InferContext wc -> (InferContext wc, [])
  672                          SupplyContext theta ->
  673                            let final_theta = substTheta subst theta
  674                            in (SupplyContext final_theta, final_theta)
  675                    final_inst_tys   = substTys subst inst_tys
  676                    final_via_ty     = substTy  subst via_ty
  677                    -- See Note [Floating `via` type variables]
  678                    final_tvs        = tyCoVarsOfTypesWellScoped $
  679                                       final_deriv_ctxt_tys ++ final_inst_tys
  680                                         ++ [final_via_ty]
  681                pure ( final_tvs, final_deriv_ctxt, final_inst_tys
  682                     , Just (ViaStrategy final_via_ty) )
  683 
  684              _ -> pure (tvs, deriv_ctxt, inst_tys, mb_deriv_strat)
  685        ; traceTc "Standalone deriving;" $ vcat
  686               [ text "tvs':" <+> ppr tvs'
  687               , text "mb_deriv_strat':" <+> ppr mb_deriv_strat'
  688               , text "deriv_ctxt':" <+> ppr deriv_ctxt'
  689               , text "cls:" <+> ppr cls
  690               , text "inst_tys':" <+> ppr inst_tys' ]
  691                 -- C.f. GHC.Tc.TyCl.Instance.tcLocalInstDecl1
  692 
  693        ; if className cls == typeableClassName
  694          then do warnUselessTypeable
  695                  return Nothing
  696          else Just <$> mkEqnHelp (fmap unLoc overlap_mode)
  697                                  tvs' cls inst_tys'
  698                                  deriv_ctxt' mb_deriv_strat' }
  699 
  700 -- Typecheck the type in a standalone deriving declaration.
  701 --
  702 -- This may appear dense, but it's mostly huffing and puffing to recognize
  703 -- the special case of a type with an extra-constraints wildcard context, e.g.,
  704 --
  705 --   deriving instance _ => Eq (Foo a)
  706 --
  707 -- If there is such a wildcard, we typecheck this as if we had written
  708 -- @deriving instance Eq (Foo a)@, and return @'InferContext' ('Just' loc)@,
  709 -- as the 'DerivContext', where loc is the location of the wildcard used for
  710 -- error reporting. This indicates that we should infer the context as if we
  711 -- were deriving Eq via a deriving clause
  712 -- (see Note [Inferring the instance context] in GHC.Tc.Deriv.Infer).
  713 --
  714 -- If there is no wildcard, then proceed as normal, and instead return
  715 -- @'SupplyContext' theta@, where theta is the typechecked context.
  716 --
  717 -- Note that this will never return @'InferContext' 'Nothing'@, as that can
  718 -- only happen with @deriving@ clauses.
  719 tcStandaloneDerivInstType
  720   :: UserTypeCtxt -> LHsSigWcType GhcRn
  721   -> TcM ([TyVar], DerivContext, Class, [Type])
  722 tcStandaloneDerivInstType ctxt
  723     (HsWC { hswc_body = deriv_ty@(L loc (HsSig { sig_bndrs = outer_bndrs
  724                                                , sig_body = deriv_ty_body }))})
  725   | (theta, rho) <- splitLHsQualTy deriv_ty_body
  726   , [wc_pred] <- fromMaybeContext theta
  727   , L wc_span (HsWildCardTy _) <- ignoreParens wc_pred
  728   = do dfun_ty <- tcHsClsInstType ctxt $ L loc $
  729                   HsSig { sig_ext   = noExtField
  730                         , sig_bndrs = outer_bndrs
  731                         , sig_body  = rho }
  732        let (tvs, _theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
  733        pure (tvs, InferContext (Just (locA wc_span)), cls, inst_tys)
  734   | otherwise
  735   = do dfun_ty <- tcHsClsInstType ctxt deriv_ty
  736        let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
  737        pure (tvs, SupplyContext theta, cls, inst_tys)
  738 
  739 warnUselessTypeable :: TcM ()
  740 warnUselessTypeable = addDiagnosticTc TcRnUselessTypeable
  741 
  742 ------------------------------------------------------------------
  743 deriveTyData :: TyCon -> [Type] -- LHS of data or data instance
  744                     -- Can be a data instance, hence [Type] args
  745                     -- and in that case the TyCon is the /family/ tycon
  746              -> Maybe (DerivStrategy GhcTc) -- The optional deriving strategy
  747              -> [TyVar] -- The type variables bound by the derived class
  748              -> Class   -- The derived class
  749              -> [Type]  -- The derived class's arguments
  750              -> Kind    -- The function argument in the derived class's kind.
  751                         -- (e.g., if `deriving Functor`, this would be
  752                         -- `Type -> Type` since
  753                         -- `Functor :: (Type -> Type) -> Constraint`)
  754              -> TcM EarlyDerivSpec
  755 -- The deriving clause of a data or newtype declaration
  756 -- I.e. not standalone deriving
  757 deriveTyData tc tc_args mb_deriv_strat deriv_tvs cls cls_tys cls_arg_kind
  758    = do {  -- Given data T a b c = ... deriving( C d ),
  759            -- we want to drop type variables from T so that (C d (T a)) is well-kinded
  760           let (arg_kinds, _)  = splitFunTys cls_arg_kind
  761               n_args_to_drop  = length arg_kinds
  762               n_args_to_keep  = length tc_args - n_args_to_drop
  763                                 -- See Note [tc_args and tycon arity]
  764               (tc_args_to_keep, args_to_drop)
  765                               = splitAt n_args_to_keep tc_args
  766               inst_ty_kind    = tcTypeKind (mkTyConApp tc tc_args_to_keep)
  767 
  768               -- Match up the kinds, and apply the resulting kind substitution
  769               -- to the types.  See Note [Unify kinds in deriving]
  770               -- We are assuming the tycon tyvars and the class tyvars are distinct
  771               mb_match        = tcUnifyTy inst_ty_kind cls_arg_kind
  772               enough_args     = n_args_to_keep >= 0
  773 
  774         -- Check that the result really is well-kinded
  775         ; checkTc (enough_args && isJust mb_match)
  776                   (TcRnCannotDeriveInstance cls cls_tys Nothing NoGeneralizedNewtypeDeriving $
  777                      DerivErrNotWellKinded tc cls_arg_kind n_args_to_keep)
  778 
  779         ; let -- Returns a singleton-element list if using ViaStrategy and an
  780               -- empty list otherwise. Useful for free-variable calculations.
  781               deriv_strat_tys :: Maybe (DerivStrategy GhcTc) -> [Type]
  782               deriv_strat_tys = foldMap (foldDerivStrategy [] (:[]))
  783 
  784               propagate_subst kind_subst tkvs' cls_tys' tc_args' mb_deriv_strat'
  785                 = (final_tkvs, final_cls_tys, final_tc_args, final_mb_deriv_strat)
  786                 where
  787                   ki_subst_range  = getTCvSubstRangeFVs kind_subst
  788                   -- See Note [Unification of two kind variables in deriving]
  789                   unmapped_tkvs   = filter (\v -> v `notElemTCvSubst` kind_subst
  790                                          && not (v `elemVarSet` ki_subst_range))
  791                                            tkvs'
  792                   (subst, _)           = substTyVarBndrs kind_subst unmapped_tkvs
  793                   final_tc_args        = substTys subst tc_args'
  794                   final_cls_tys        = substTys subst cls_tys'
  795                   final_mb_deriv_strat = fmap (mapDerivStrategy (substTy subst))
  796                                               mb_deriv_strat'
  797                   -- See Note [Floating `via` type variables]
  798                   final_tkvs           = tyCoVarsOfTypesWellScoped $
  799                                          final_cls_tys ++ final_tc_args
  800                                            ++ deriv_strat_tys final_mb_deriv_strat
  801 
  802         ; let tkvs = scopedSort $ fvVarList $
  803                      unionFV (tyCoFVsOfTypes tc_args_to_keep)
  804                              (FV.mkFVs deriv_tvs)
  805               Just kind_subst = mb_match
  806               (tkvs', cls_tys', tc_args', mb_deriv_strat')
  807                 = propagate_subst kind_subst tkvs cls_tys
  808                                   tc_args_to_keep mb_deriv_strat
  809 
  810           -- See Note [Unify kinds in deriving]
  811         ; (final_tkvs, final_cls_tys, final_tc_args, final_mb_deriv_strat) <-
  812             case mb_deriv_strat' of
  813               -- Perform an additional unification with the kind of the `via`
  814               -- type and the result of the previous kind unification.
  815               Just (ViaStrategy via_ty) -> do
  816                 let via_kind = tcTypeKind via_ty
  817                     inst_ty_kind
  818                               = tcTypeKind (mkTyConApp tc tc_args')
  819                     via_match = tcUnifyTy inst_ty_kind via_kind
  820 
  821                 checkTc (isJust via_match)
  822                         (TcRnCannotDeriveInstance cls mempty Nothing NoGeneralizedNewtypeDeriving $
  823                            DerivErrDerivingViaWrongKind inst_ty_kind via_ty via_kind)
  824 
  825                 let Just via_subst = via_match
  826                 pure $ propagate_subst via_subst tkvs' cls_tys'
  827                                        tc_args' mb_deriv_strat'
  828 
  829               _ -> pure (tkvs', cls_tys', tc_args', mb_deriv_strat')
  830 
  831         ; traceTc "deriveTyData 1" $ vcat
  832             [ ppr final_mb_deriv_strat, pprTyVars deriv_tvs, ppr tc, ppr tc_args
  833             , pprTyVars (tyCoVarsOfTypesList tc_args)
  834             , ppr n_args_to_keep, ppr n_args_to_drop
  835             , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
  836             , ppr final_tc_args, ppr final_cls_tys ]
  837 
  838         ; traceTc "deriveTyData 2" $ vcat
  839             [ ppr final_tkvs ]
  840 
  841         ; let final_tc_app   = mkTyConApp tc final_tc_args
  842               final_cls_args = final_cls_tys ++ [final_tc_app]
  843         ; checkTc (allDistinctTyVars (mkVarSet final_tkvs) args_to_drop) -- (a, b, c)
  844                   (TcRnCannotDeriveInstance cls final_cls_tys Nothing NoGeneralizedNewtypeDeriving $
  845                      DerivErrNoEtaReduce final_tc_app)
  846                 -- Check that
  847                 --  (a) The args to drop are all type variables; eg reject:
  848                 --              data instance T a Int = .... deriving( Monad )
  849                 --  (b) The args to drop are all *distinct* type variables; eg reject:
  850                 --              class C (a :: * -> * -> *) where ...
  851                 --              data instance T a a = ... deriving( C )
  852                 --  (c) The type class args, or remaining tycon args,
  853                 --      do not mention any of the dropped type variables
  854                 --              newtype T a s = ... deriving( ST s )
  855                 --              newtype instance K a a = ... deriving( Monad )
  856                 --
  857                 -- It is vital that the implementation of allDistinctTyVars
  858                 -- expand any type synonyms.
  859                 -- See Note [Eta-reducing type synonyms]
  860 
  861         ; checkValidInstHead DerivClauseCtxt cls final_cls_args
  862                 -- Check that we aren't deriving an instance of a magical
  863                 -- type like (~) or Coercible (#14916).
  864 
  865         ; spec <- mkEqnHelp Nothing final_tkvs cls final_cls_args
  866                             (InferContext Nothing) final_mb_deriv_strat
  867         ; traceTc "deriveTyData 3" (ppr spec)
  868         ; return spec }
  869 
  870 
  871 {- Note [tc_args and tycon arity]
  872 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  873 You might wonder if we could use (tyConArity tc) at this point, rather
  874 than (length tc_args).  But for data families the two can differ!  The
  875 tc and tc_args passed into 'deriveTyData' come from 'deriveClause' which
  876 in turn gets them from 'tyConFamInstSig_maybe' which in turn gets them
  877 from DataFamInstTyCon:
  878 
  879 | DataFamInstTyCon          -- See Note [Data type families]
  880       (CoAxiom Unbranched)
  881       TyCon   -- The family TyCon
  882       [Type]  -- Argument types (mentions the tyConTyVars of this TyCon)
  883               -- No shorter in length than the tyConTyVars of the family TyCon
  884               -- How could it be longer? See [Arity of data families] in GHC.Core.FamInstEnv
  885 
  886 Notice that the arg tys might not be the same as the family tycon arity
  887 (= length tyConTyVars).
  888 
  889 Note [Unify kinds in deriving]
  890 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  891 Consider (#8534)
  892     data T a b = MkT a deriving( Functor )
  893     -- where Functor :: (*->*) -> Constraint
  894 
  895 So T :: forall k. * -> k -> *.   We want to get
  896     instance Functor (T * (a:*)) where ...
  897 Notice the '*' argument to T.
  898 
  899 Moreover, as well as instantiating T's kind arguments, we may need to instantiate
  900 C's kind args.  Consider (#8865):
  901   newtype T a b = MkT (Either a b) deriving( Category )
  902 where
  903   Category :: forall k. (k -> k -> *) -> Constraint
  904 We need to generate the instance
  905   instance Category * (Either a) where ...
  906 Notice the '*' argument to Category.
  907 
  908 So we need to
  909  * drop arguments from (T a b) to match the number of
  910    arrows in the (last argument of the) class;
  911  * and then *unify* kind of the remaining type against the
  912    expected kind, to figure out how to instantiate C's and T's
  913    kind arguments.
  914 
  915 In the two examples,
  916  * we unify   kind-of( T k (a:k) ) ~ kind-of( Functor )
  917          i.e.      (k -> *) ~ (* -> *)   to find k:=*.
  918          yielding  k:=*
  919 
  920  * we unify   kind-of( Either ) ~ kind-of( Category )
  921          i.e.      (* -> * -> *)  ~ (k -> k -> k)
  922          yielding  k:=*
  923 
  924 Now we get a kind substitution.  We then need to:
  925 
  926   1. Remove the substituted-out kind variables from the quantified kind vars
  927 
  928   2. Apply the substitution to the kinds of quantified *type* vars
  929      (and extend the substitution to reflect this change)
  930 
  931   3. Apply that extended substitution to the non-dropped args (types and
  932      kinds) of the type and class
  933 
  934 Forgetting step (2) caused #8893:
  935   data V a = V [a] deriving Functor
  936   data P (x::k->*) (a:k) = P (x a) deriving Functor
  937   data C (x::k->*) (a:k) = C (V (P x a)) deriving Functor
  938 
  939 When deriving Functor for P, we unify k to *, but we then want
  940 an instance   $df :: forall (x:*->*). Functor x => Functor (P * (x:*->*))
  941 and similarly for C.  Notice the modified kind of x, both at binding
  942 and occurrence sites.
  943 
  944 This can lead to some surprising results when *visible* kind binder is
  945 unified (in contrast to the above examples, in which only non-visible kind
  946 binders were considered). Consider this example from #11732:
  947 
  948     data T k (a :: k) = MkT deriving Functor
  949 
  950 Since unification yields k:=*, this results in a generated instance of:
  951 
  952     instance Functor (T *) where ...
  953 
  954 which looks odd at first glance, since one might expect the instance head
  955 to be of the form Functor (T k). Indeed, one could envision an alternative
  956 generated instance of:
  957 
  958     instance (k ~ *) => Functor (T k) where
  959 
  960 But this does not typecheck by design: kind equalities are not allowed to be
  961 bound in types, only terms. But in essence, the two instance declarations are
  962 entirely equivalent, since even though (T k) matches any kind k, the only
  963 possibly value for k is *, since anything else is ill-typed. As a result, we can
  964 just as comfortably use (T *).
  965 
  966 Another way of thinking about is: deriving clauses often infer constraints.
  967 For example:
  968 
  969     data S a = S a deriving Eq
  970 
  971 infers an (Eq a) constraint in the derived instance. By analogy, when we
  972 are deriving Functor, we might infer an equality constraint (e.g., k ~ *).
  973 The only distinction is that GHC instantiates equality constraints directly
  974 during the deriving process.
  975 
  976 Another quirk of this design choice manifests when typeclasses have visible
  977 kind parameters. Consider this code (also from #11732):
  978 
  979     class Cat k (cat :: k -> k -> *) where
  980       catId   :: cat a a
  981       catComp :: cat b c -> cat a b -> cat a c
  982 
  983     instance Cat * (->) where
  984       catId   = id
  985       catComp = (.)
  986 
  987     newtype Fun a b = Fun (a -> b) deriving (Cat k)
  988 
  989 Even though we requested a derived instance of the form (Cat k Fun), the
  990 kind unification will actually generate (Cat * Fun) (i.e., the same thing as if
  991 the user wrote deriving (Cat *)).
  992 
  993 What happens with DerivingVia, when you have yet another type? Consider:
  994 
  995   newtype Foo (a :: Type) = MkFoo (Proxy a)
  996     deriving Functor via Proxy
  997 
  998 As before, we unify the kind of Foo (* -> *) with the kind of the argument to
  999 Functor (* -> *). But that's not enough: the `via` type, Proxy, has the kind
 1000 (k -> *), which is more general than what we want. So we must additionally
 1001 unify (k -> *) with (* -> *).
 1002 
 1003 Currently, all of this unification is implemented kludgily with the pure
 1004 unifier, which is rather tiresome. #14331 lays out a plan for how this
 1005 might be made cleaner.
 1006 
 1007 Note [Unification of two kind variables in deriving]
 1008 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1009 As a special case of the Note above, it is possible to derive an instance of
 1010 a poly-kinded typeclass for a poly-kinded datatype. For example:
 1011 
 1012     class Category (cat :: k -> k -> *) where
 1013     newtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category
 1014 
 1015 This case is surprisingly tricky. To see why, let's write out what instance GHC
 1016 will attempt to derive (using -fprint-explicit-kinds syntax):
 1017 
 1018     instance Category k1 (T k2 c) where ...
 1019 
 1020 GHC will attempt to unify k1 and k2, which produces a substitution (kind_subst)
 1021 that looks like [k2 :-> k1]. Importantly, we need to apply this substitution to
 1022 the type variable binder for c, since its kind is (k2 -> k2 -> *).
 1023 
 1024 We used to accomplish this by doing the following:
 1025 
 1026     unmapped_tkvs = filter (`notElemTCvSubst` kind_subst) all_tkvs
 1027     (subst, _)    = substTyVarBndrs kind_subst unmapped_tkvs
 1028 
 1029 Where all_tkvs contains all kind variables in the class and instance types (in
 1030 this case, all_tkvs = [k1,k2]). But since kind_subst only has one mapping,
 1031 this results in unmapped_tkvs being [k1], and as a consequence, k1 gets mapped
 1032 to another kind variable in subst! That is, subst = [k2 :-> k1, k1 :-> k_new].
 1033 This is bad, because applying that substitution yields the following instance:
 1034 
 1035    instance Category k_new (T k1 c) where ...
 1036 
 1037 In other words, keeping k1 in unmapped_tvks taints the substitution, resulting
 1038 in an ill-kinded instance (this caused #11837).
 1039 
 1040 To prevent this, we need to filter out any variable from all_tkvs which either
 1041 
 1042 1. Appears in the domain of kind_subst. notElemTCvSubst checks this.
 1043 2. Appears in the range of kind_subst. To do this, we compute the free
 1044    variable set of the range of kind_subst with getTCvSubstRangeFVs, and check
 1045    if a kind variable appears in that set.
 1046 
 1047 Note [Eta-reducing type synonyms]
 1048 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1049 One can instantiate a type in a data family instance with a type synonym that
 1050 mentions other type variables:
 1051 
 1052   type Const a b = a
 1053   data family Fam (f :: * -> *) (a :: *)
 1054   newtype instance Fam f (Const a f) = Fam (f a) deriving Functor
 1055 
 1056 It is also possible to define kind synonyms, and they can mention other types in
 1057 a datatype declaration. For example,
 1058 
 1059   type Const a b = a
 1060   newtype T f (a :: Const * f) = T (f a) deriving Functor
 1061 
 1062 When deriving, we need to perform eta-reduction analysis to ensure that none of
 1063 the eta-reduced type variables are mentioned elsewhere in the declaration. But
 1064 we need to be careful, because if we don't expand through the Const type
 1065 synonym, we will mistakenly believe that f is an eta-reduced type variable and
 1066 fail to derive Functor, even though the code above is correct (see #11416,
 1067 where this was first noticed). For this reason, we expand the type synonyms in
 1068 the eta-reduced types before doing any analysis.
 1069 
 1070 Note [Floating `via` type variables]
 1071 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1072 When generating a derived instance, it will be of the form:
 1073 
 1074   instance forall ???. C c_args (D d_args) where ...
 1075 
 1076 To fill in ???, GHC computes the free variables of `c_args` and `d_args`.
 1077 `DerivingVia` adds an extra wrinkle to this formula, since we must also
 1078 include the variables bound by the `via` type when computing the binders
 1079 used to fill in ???. This might seem strange, since if a `via` type binds
 1080 any type variables, then in almost all scenarios it will appear free in
 1081 `c_args` or `d_args`. There are certain corner cases where this does not hold,
 1082 however, such as in the following example (adapted from #15831):
 1083 
 1084   newtype Age = MkAge Int
 1085     deriving Eq via Const Int a
 1086 
 1087 In this example, the `via` type binds the type variable `a`, but `a` appears
 1088 nowhere in `Eq Age`. Nevertheless, we include it in the generated instance:
 1089 
 1090   instance forall a. Eq Age where
 1091     (==) = coerce @(Const Int a -> Const Int a -> Bool)
 1092                   @(Age         -> Age         -> Bool)
 1093                   (==)
 1094 
 1095 The use of `forall a` is certainly required here, since the `a` in
 1096 `Const Int a` would not be in scope otherwise. This instance is somewhat
 1097 strange in that nothing in the instance head `Eq Age` ever determines what `a`
 1098 will be, so any code that uses this instance will invariably instantiate `a`
 1099 to be `Any`. We refer to this property of `a` as being a "floating" `via`
 1100 type variable. Programs with floating `via` type variables are the only known
 1101 class of program in which the `via` type quantifies type variables that aren't
 1102 mentioned in the instance head in the generated instance.
 1103 
 1104 Fortunately, the choice to instantiate floating `via` type variables to `Any`
 1105 is one that is completely transparent to the user (since the instance will
 1106 work as expected regardless of what `a` is instantiated to), so we decide to
 1107 permit them. An alternative design would make programs with floating `via`
 1108 variables illegal, by requiring that every variable mentioned in the `via` type
 1109 is also mentioned in the data header or the derived class. That restriction
 1110 would require the user to pick a particular type (the choice does not matter);
 1111 for example:
 1112 
 1113   newtype Age = MkAge Int
 1114     -- deriving Eq via Const Int a  -- Floating 'a'
 1115     deriving Eq via Const Int ()    -- Choose a=()
 1116     deriving Eq via Const Int Any   -- Choose a=Any
 1117 
 1118 No expressiveness would be lost thereby, but stylistically it seems preferable
 1119 to allow a type variable to indicate "it doesn't matter".
 1120 
 1121 Note that by quantifying the `a` in `forall a. Eq Age`, we are deferring the
 1122 work of instantiating `a` to `Any` at every use site of the instance. An
 1123 alternative approach would be to generate an instance that directly defaulted
 1124 to `Any`:
 1125 
 1126   instance Eq Age where
 1127     (==) = coerce @(Const Int Any -> Const Int Any -> Bool)
 1128                   @(Age           -> Age           -> Bool)
 1129                   (==)
 1130 
 1131 We do not implement this approach since it would require a nontrivial amount
 1132 of implementation effort to substitute `Any` for the floating `via` type
 1133 variables, and since the end result isn't distinguishable from the former
 1134 instance (at least from the user's perspective), the amount of engineering
 1135 required to obtain the latter instance just isn't worth it.
 1136 -}
 1137 
 1138 mkEqnHelp :: Maybe OverlapMode
 1139           -> [TyVar]
 1140           -> Class -> [Type]
 1141           -> DerivContext
 1142                -- SupplyContext => context supplied (standalone deriving)
 1143                -- InferContext  => context inferred (deriving on data decl, or
 1144                --                  standalone deriving decl with a wildcard)
 1145           -> Maybe (DerivStrategy GhcTc)
 1146           -> TcRn EarlyDerivSpec
 1147 -- Make the EarlyDerivSpec for an instance
 1148 --      forall tvs. theta => cls (tys ++ [ty])
 1149 -- where the 'theta' is optional (that's the Maybe part)
 1150 -- Assumes that this declaration is well-kinded
 1151 
 1152 mkEqnHelp overlap_mode tvs cls cls_args deriv_ctxt deriv_strat = do
 1153   is_boot <- tcIsHsBootOrSig
 1154   when is_boot $ bale_out DerivErrBootFileFound
 1155   runReaderT mk_eqn deriv_env
 1156   where
 1157     deriv_env = DerivEnv { denv_overlap_mode = overlap_mode
 1158                          , denv_tvs          = tvs
 1159                          , denv_cls          = cls
 1160                          , denv_inst_tys     = cls_args
 1161                          , denv_ctxt         = deriv_ctxt
 1162                          , denv_strat        = deriv_strat }
 1163 
 1164     bale_out =
 1165       failWithTc . TcRnCannotDeriveInstance cls cls_args deriv_strat NoGeneralizedNewtypeDeriving
 1166 
 1167     mk_eqn :: DerivM EarlyDerivSpec
 1168     mk_eqn = do
 1169       DerivEnv { denv_inst_tys = cls_args
 1170                , denv_strat    = mb_strat } <- ask
 1171       case mb_strat of
 1172         Just (StockStrategy _) -> do
 1173           (cls_tys, inst_ty) <- expectNonNullaryClsArgs cls_args
 1174           dit                <- expectAlgTyConApp cls_tys inst_ty
 1175           mk_eqn_stock dit
 1176 
 1177         Just (AnyclassStrategy _) -> mk_eqn_anyclass
 1178 
 1179         Just (ViaStrategy via_ty) -> do
 1180           (cls_tys, inst_ty) <- expectNonNullaryClsArgs cls_args
 1181           mk_eqn_via cls_tys inst_ty via_ty
 1182 
 1183         Just (NewtypeStrategy _) -> do
 1184           (cls_tys, inst_ty) <- expectNonNullaryClsArgs cls_args
 1185           dit                <- expectAlgTyConApp cls_tys inst_ty
 1186           unless (isNewTyCon (dit_rep_tc dit)) $
 1187             derivingThingFailWith NoGeneralizedNewtypeDeriving DerivErrGNDUsedOnData
 1188           mkNewTypeEqn True dit
 1189 
 1190         Nothing -> mk_eqn_no_strategy
 1191 
 1192 -- @expectNonNullaryClsArgs inst_tys@ checks if @inst_tys@ is non-empty.
 1193 -- If so, return @(init inst_tys, last inst_tys)@.
 1194 -- Otherwise, throw an error message.
 1195 -- See @Note [DerivEnv and DerivSpecMechanism]@ in "GHC.Tc.Deriv.Utils" for why this
 1196 -- property is important.
 1197 expectNonNullaryClsArgs :: [Type] -> DerivM ([Type], Type)
 1198 expectNonNullaryClsArgs inst_tys =
 1199   maybe (derivingThingFailWith NoGeneralizedNewtypeDeriving DerivErrNullaryClasses) pure $
 1200   snocView inst_tys
 1201 
 1202 -- @expectAlgTyConApp cls_tys inst_ty@ checks if @inst_ty@ is an application
 1203 -- of an algebraic type constructor. If so, return a 'DerivInstTys' consisting
 1204 -- of @cls_tys@ and the constituent pars of @inst_ty@.
 1205 -- Otherwise, throw an error message.
 1206 -- See @Note [DerivEnv and DerivSpecMechanism]@ in "GHC.Tc.Deriv.Utils" for why this
 1207 -- property is important.
 1208 expectAlgTyConApp :: [Type] -- All but the last argument to the class in a
 1209                             -- derived instance
 1210                   -> Type   -- The last argument to the class in a
 1211                             -- derived instance
 1212                   -> DerivM DerivInstTys
 1213 expectAlgTyConApp cls_tys inst_ty = do
 1214   fam_envs <- lift tcGetFamInstEnvs
 1215   case mk_deriv_inst_tys_maybe fam_envs cls_tys inst_ty of
 1216     Nothing -> derivingThingFailWith NoGeneralizedNewtypeDeriving DerivErrLastArgMustBeApp
 1217     Just dit -> do expectNonDataFamTyCon dit
 1218                    pure dit
 1219 
 1220 -- @expectNonDataFamTyCon dit@ checks if @dit_rep_tc dit@ is a representation
 1221 -- type constructor for a data family instance, and if not,
 1222 -- throws an error message.
 1223 -- See @Note [DerivEnv and DerivSpecMechanism]@ in "GHC.Tc.Deriv.Utils" for why this
 1224 -- property is important.
 1225 expectNonDataFamTyCon :: DerivInstTys -> DerivM ()
 1226 expectNonDataFamTyCon (DerivInstTys { dit_tc      = tc
 1227                                     , dit_tc_args = tc_args
 1228                                     , dit_rep_tc  = rep_tc }) =
 1229   -- If it's still a data family, the lookup failed; i.e no instance exists
 1230   when (isDataFamilyTyCon rep_tc) $
 1231     derivingThingFailWith NoGeneralizedNewtypeDeriving $
 1232       DerivErrNoFamilyInstance tc tc_args
 1233 
 1234 mk_deriv_inst_tys_maybe :: FamInstEnvs
 1235                         -> [Type] -> Type -> Maybe DerivInstTys
 1236 mk_deriv_inst_tys_maybe fam_envs cls_tys inst_ty =
 1237   fmap lookup $ tcSplitTyConApp_maybe inst_ty
 1238   where
 1239     lookup :: (TyCon, [Type]) -> DerivInstTys
 1240     lookup (tc, tc_args) =
 1241       -- Find the instance of a data family
 1242       -- Note [Looking up family instances for deriving]
 1243       let (rep_tc, rep_tc_args, _co) = tcLookupDataFamInst fam_envs tc tc_args
 1244       in DerivInstTys { dit_cls_tys     = cls_tys
 1245                       , dit_tc          = tc
 1246                       , dit_tc_args     = tc_args
 1247                       , dit_rep_tc      = rep_tc
 1248                       , dit_rep_tc_args = rep_tc_args }
 1249 
 1250 {-
 1251 Note [Looking up family instances for deriving]
 1252 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1253 tcLookupFamInstExact is an auxiliary lookup wrapper which requires
 1254 that looked-up family instances exist.  If called with a vanilla
 1255 tycon, the old type application is simply returned.
 1256 
 1257 If we have
 1258   data instance F () = ... deriving Eq
 1259   data instance F () = ... deriving Eq
 1260 then tcLookupFamInstExact will be confused by the two matches;
 1261 but that can't happen because tcInstDecls1 doesn't call tcDeriving
 1262 if there are any overlaps.
 1263 
 1264 There are two other things that might go wrong with the lookup.
 1265 First, we might see a standalone deriving clause
 1266    deriving Eq (F ())
 1267 when there is no data instance F () in scope.
 1268 
 1269 Note that it's OK to have
 1270   data instance F [a] = ...
 1271   deriving Eq (F [(a,b)])
 1272 where the match is not exact; the same holds for ordinary data types
 1273 with standalone deriving declarations.
 1274 
 1275 Note [Deriving, type families, and partial applications]
 1276 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1277 When there are no type families, it's quite easy:
 1278 
 1279     newtype S a = MkS [a]
 1280     -- :CoS :: S  ~ []  -- Eta-reduced
 1281 
 1282     instance Eq [a] => Eq (S a)         -- by coercion sym (Eq (:CoS a)) : Eq [a] ~ Eq (S a)
 1283     instance Monad [] => Monad S        -- by coercion sym (Monad :CoS)  : Monad [] ~ Monad S
 1284 
 1285 When type families are involved it's trickier:
 1286 
 1287     data family T a b
 1288     newtype instance T Int a = MkT [a] deriving( Eq, Monad )
 1289     -- :RT is the representation type for (T Int a)
 1290     --  :Co:RT    :: :RT ~ []          -- Eta-reduced!
 1291     --  :CoF:RT a :: T Int a ~ :RT a   -- Also eta-reduced!
 1292 
 1293     instance Eq [a] => Eq (T Int a)     -- easy by coercion
 1294        -- d1 :: Eq [a]
 1295        -- d2 :: Eq (T Int a) = d1 |> Eq (sym (:Co:RT a ; :coF:RT a))
 1296 
 1297     instance Monad [] => Monad (T Int)  -- only if we can eta reduce???
 1298        -- d1 :: Monad []
 1299        -- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))
 1300 
 1301 Note the need for the eta-reduced rule axioms.  After all, we can
 1302 write it out
 1303     instance Monad [] => Monad (T Int)  -- only if we can eta reduce???
 1304       return x = MkT [x]
 1305       ... etc ...
 1306 
 1307 See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom
 1308 
 1309 %************************************************************************
 1310 %*                                                                      *
 1311                 Deriving data types
 1312 *                                                                      *
 1313 ************************************************************************
 1314 -}
 1315 
 1316 -- Once the DerivSpecMechanism is known, we can finally produce an
 1317 -- EarlyDerivSpec from it.
 1318 mk_eqn_from_mechanism :: DerivSpecMechanism -> DerivM EarlyDerivSpec
 1319 mk_eqn_from_mechanism mechanism
 1320   = do DerivEnv { denv_overlap_mode = overlap_mode
 1321                 , denv_tvs          = tvs
 1322                 , denv_cls          = cls
 1323                 , denv_inst_tys     = inst_tys
 1324                 , denv_ctxt         = deriv_ctxt } <- ask
 1325        doDerivInstErrorChecks1 mechanism
 1326        loc       <- lift getSrcSpanM
 1327        dfun_name <- lift $ newDFunName cls inst_tys loc
 1328        case deriv_ctxt of
 1329         InferContext wildcard ->
 1330           do { (inferred_constraints, tvs', inst_tys')
 1331                  <- inferConstraints mechanism
 1332              ; return $ InferTheta $ DS
 1333                    { ds_loc = loc
 1334                    , ds_name = dfun_name, ds_tvs = tvs'
 1335                    , ds_cls = cls, ds_tys = inst_tys'
 1336                    , ds_theta = inferred_constraints
 1337                    , ds_overlap = overlap_mode
 1338                    , ds_standalone_wildcard = wildcard
 1339                    , ds_mechanism = mechanism } }
 1340 
 1341         SupplyContext theta ->
 1342             return $ GivenTheta $ DS
 1343                    { ds_loc = loc
 1344                    , ds_name = dfun_name, ds_tvs = tvs
 1345                    , ds_cls = cls, ds_tys = inst_tys
 1346                    , ds_theta = theta
 1347                    , ds_overlap = overlap_mode
 1348                    , ds_standalone_wildcard = Nothing
 1349                    , ds_mechanism = mechanism }
 1350 
 1351 mk_eqn_stock :: DerivInstTys -- Information about the arguments to the class
 1352              -> DerivM EarlyDerivSpec
 1353 mk_eqn_stock dit@(DerivInstTys { dit_cls_tys = cls_tys
 1354                                , dit_tc      = tc
 1355                                , dit_rep_tc  = rep_tc })
 1356   = do DerivEnv { denv_cls  = cls
 1357                 , denv_ctxt = deriv_ctxt } <- ask
 1358        dflags <- getDynFlags
 1359        let isDeriveAnyClassEnabled =
 1360              deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
 1361        case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys
 1362                                            tc rep_tc of
 1363          CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
 1364                                   DerivSpecStock { dsm_stock_dit    = dit
 1365                                                  , dsm_stock_gen_fn = gen_fn }
 1366          StockClassError why   -> derivingThingFailWith NoGeneralizedNewtypeDeriving why
 1367          CanDeriveAnyClass     -> derivingThingFailWith NoGeneralizedNewtypeDeriving
 1368                                     (DerivErrNotStockDeriveable isDeriveAnyClassEnabled)
 1369          -- In the 'NonDerivableClass' case we can't derive with either stock or anyclass
 1370          -- so we /don't want/ to suggest the user to enabled 'DeriveAnyClass', that's
 1371          -- why we pass 'YesDeriveAnyClassEnabled', so that GHC won't attempt to suggest it.
 1372          NonDerivableClass     -> derivingThingFailWith NoGeneralizedNewtypeDeriving
 1373                                     (DerivErrNotStockDeriveable YesDeriveAnyClassEnabled)
 1374 
 1375 mk_eqn_anyclass :: DerivM EarlyDerivSpec
 1376 mk_eqn_anyclass
 1377   = do dflags <- getDynFlags
 1378        let isDeriveAnyClassEnabled =
 1379              deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
 1380        case xopt LangExt.DeriveAnyClass dflags of
 1381          True  -> mk_eqn_from_mechanism DerivSpecAnyClass
 1382          False -> derivingThingFailWith NoGeneralizedNewtypeDeriving
 1383                                         (DerivErrNotDeriveable isDeriveAnyClassEnabled)
 1384 
 1385 mk_eqn_newtype :: DerivInstTys -- Information about the arguments to the class
 1386                -> Type         -- The newtype's representation type
 1387                -> DerivM EarlyDerivSpec
 1388 mk_eqn_newtype dit rep_ty =
 1389   mk_eqn_from_mechanism $ DerivSpecNewtype { dsm_newtype_dit    = dit
 1390                                            , dsm_newtype_rep_ty = rep_ty }
 1391 
 1392 mk_eqn_via :: [Type] -- All arguments to the class besides the last
 1393            -> Type   -- The last argument to the class
 1394            -> Type   -- The @via@ type
 1395            -> DerivM EarlyDerivSpec
 1396 mk_eqn_via cls_tys inst_ty via_ty =
 1397   mk_eqn_from_mechanism $ DerivSpecVia { dsm_via_cls_tys = cls_tys
 1398                                        , dsm_via_inst_ty = inst_ty
 1399                                        , dsm_via_ty      = via_ty }
 1400 
 1401 -- Derive an instance without a user-requested deriving strategy. This uses
 1402 -- heuristics to determine which deriving strategy to use.
 1403 -- See Note [Deriving strategies].
 1404 mk_eqn_no_strategy :: DerivM EarlyDerivSpec
 1405 mk_eqn_no_strategy = do
 1406   DerivEnv { denv_cls      = cls
 1407            , denv_inst_tys = cls_args } <- ask
 1408   fam_envs <- lift tcGetFamInstEnvs
 1409 
 1410   -- First, check if the last argument is an application of a type constructor.
 1411   -- If not, fall back to DeriveAnyClass.
 1412   if |  Just (cls_tys, inst_ty) <- snocView cls_args
 1413      ,  Just dit <- mk_deriv_inst_tys_maybe fam_envs cls_tys inst_ty
 1414      -> if |  isNewTyCon (dit_rep_tc dit)
 1415               -- We have a dedicated code path for newtypes (see the
 1416               -- documentation for mkNewTypeEqn as to why this is the case)
 1417            -> mkNewTypeEqn False dit
 1418 
 1419            |  otherwise
 1420            -> do -- Otherwise, our only other options are stock or anyclass.
 1421                  -- If it is stock, we must confirm that the last argument's
 1422                  -- type constructor is algebraic.
 1423                  -- See Note [DerivEnv and DerivSpecMechanism] in GHC.Tc.Deriv.Utils
 1424                  whenIsJust (hasStockDeriving cls) $ \_ ->
 1425                    expectNonDataFamTyCon dit
 1426                  mk_eqn_originative dit
 1427 
 1428      |  otherwise
 1429      -> mk_eqn_anyclass
 1430   where
 1431     -- Use heuristics (checkOriginativeSideConditions) to determine whether
 1432     -- stock or anyclass deriving should be used.
 1433     mk_eqn_originative :: DerivInstTys -> DerivM EarlyDerivSpec
 1434     mk_eqn_originative dit@(DerivInstTys { dit_cls_tys = cls_tys
 1435                                          , dit_tc      = tc
 1436                                          , dit_rep_tc  = rep_tc }) = do
 1437       DerivEnv { denv_cls  = cls
 1438                , denv_ctxt = deriv_ctxt } <- ask
 1439       dflags <- getDynFlags
 1440       let isDeriveAnyClassEnabled =
 1441             deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
 1442 
 1443       -- See Note [Deriving instances for classes themselves]
 1444       let dac_error
 1445             | isClassTyCon rep_tc
 1446             = DerivErrOnlyAnyClassDeriveable tc isDeriveAnyClassEnabled
 1447             | otherwise
 1448             = DerivErrNotStockDeriveable isDeriveAnyClassEnabled
 1449 
 1450       case checkOriginativeSideConditions dflags deriv_ctxt cls
 1451              cls_tys tc rep_tc of
 1452         NonDerivableClass     -> derivingThingFailWith NoGeneralizedNewtypeDeriving dac_error
 1453         StockClassError why   -> derivingThingFailWith NoGeneralizedNewtypeDeriving why
 1454         CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
 1455                                  DerivSpecStock { dsm_stock_dit    = dit
 1456                                                 , dsm_stock_gen_fn = gen_fn }
 1457         CanDeriveAnyClass     -> mk_eqn_from_mechanism DerivSpecAnyClass
 1458 
 1459 {-
 1460 ************************************************************************
 1461 *                                                                      *
 1462             Deriving instances for newtypes
 1463 *                                                                      *
 1464 ************************************************************************
 1465 -}
 1466 
 1467 -- Derive an instance for a newtype. We put this logic into its own function
 1468 -- because
 1469 --
 1470 -- (a) When no explicit deriving strategy is requested, we have special
 1471 --     heuristics for newtypes to determine which deriving strategy should
 1472 --     actually be used. See Note [Deriving strategies].
 1473 -- (b) We make an effort to give error messages specifically tailored to
 1474 --     newtypes.
 1475 mkNewTypeEqn :: Bool -- Was this instance derived using an explicit @newtype@
 1476                      -- deriving strategy?
 1477              -> DerivInstTys -> DerivM EarlyDerivSpec
 1478 mkNewTypeEqn newtype_strat dit@(DerivInstTys { dit_cls_tys     = cls_tys
 1479                                              , dit_tc          = tycon
 1480                                              , dit_rep_tc      = rep_tycon
 1481                                              , dit_rep_tc_args = rep_tc_args })
 1482 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
 1483   = do DerivEnv { denv_cls   = cls
 1484                 , denv_ctxt  = deriv_ctxt } <- ask
 1485        dflags <- getDynFlags
 1486 
 1487        let newtype_deriving  = xopt LangExt.GeneralizedNewtypeDeriving dflags
 1488            deriveAnyClass    = xopt LangExt.DeriveAnyClass             dflags
 1489 
 1490            bale_out = derivingThingFailWith (usingGeneralizedNewtypeDeriving newtype_deriving)
 1491 
 1492            -- Here is the plan for newtype derivings.  We see
 1493            --        newtype T a1...an = MkT (t ak+1...an)
 1494            --          deriving (.., C s1 .. sm, ...)
 1495            -- where t is a type,
 1496            --       ak+1...an is a suffix of a1..an, and are all tyvars
 1497            --       ak+1...an do not occur free in t, nor in the s1..sm
 1498            --       (C s1 ... sm) is a  *partial applications* of class C
 1499            --                      with the last parameter missing
 1500            --       (T a1 .. ak) matches the kind of C's last argument
 1501            --              (and hence so does t)
 1502            -- The latter kind-check has been done by deriveTyData already,
 1503            -- and tc_args are already trimmed
 1504            --
 1505            -- We generate the instance
 1506            --       instance forall ({a1..ak} u fvs(s1..sm)).
 1507            --                C s1 .. sm t => C s1 .. sm (T a1...ak)
 1508            -- where T a1...ap is the partial application of
 1509            --       the LHS of the correct kind and p >= k
 1510            --
 1511            --      NB: the variables below are:
 1512            --              tc_tvs = [a1, ..., an]
 1513            --              tyvars_to_keep = [a1, ..., ak]
 1514            --              rep_ty = t ak .. an
 1515            --              deriv_tvs = fvs(s1..sm) \ tc_tvs
 1516            --              tys = [s1, ..., sm]
 1517            --              rep_fn' = t
 1518            --
 1519            -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
 1520            -- We generate the instance
 1521            --      instance Monad (ST s) => Monad (T s) where
 1522 
 1523            nt_eta_arity = newTyConEtadArity rep_tycon
 1524                    -- For newtype T a b = MkT (S a a b), the TyCon
 1525                    -- machinery already eta-reduces the representation type, so
 1526                    -- we know that
 1527                    --      T a ~ S a a
 1528                    -- That's convenient here, because we may have to apply
 1529                    -- it to fewer than its original complement of arguments
 1530 
 1531            -- Note [Newtype representation]
 1532            -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1533            -- Need newTyConRhs (*not* a recursive representation finder)
 1534            -- to get the representation type. For example
 1535            --      newtype B = MkB Int
 1536            --      newtype A = MkA B deriving( Num )
 1537            -- We want the Num instance of B, *not* the Num instance of Int,
 1538            -- when making the Num instance of A!
 1539            rep_inst_ty = newTyConInstRhs rep_tycon rep_tc_args
 1540 
 1541            -------------------------------------------------------------------
 1542            --  Figuring out whether we can only do this newtype-deriving thing
 1543 
 1544            -- See Note [Determining whether newtype-deriving is appropriate]
 1545            might_be_newtype_derivable
 1546               =  not (non_coercible_class cls)
 1547               && eta_ok
 1548 --            && not (isRecursiveTyCon tycon)      -- Note [Recursive newtypes]
 1549 
 1550            -- Check that eta reduction is OK
 1551            eta_ok = rep_tc_args `lengthAtLeast` nt_eta_arity
 1552              -- The newtype can be eta-reduced to match the number
 1553              --     of type argument actually supplied
 1554              --        newtype T a b = MkT (S [a] b) deriving( Monad )
 1555              --     Here the 'b' must be the same in the rep type (S [a] b)
 1556              --     And the [a] must not mention 'b'.  That's all handled
 1557              --     by nt_eta_rity.
 1558 
 1559        massert (cls_tys `lengthIs` (classArity cls - 1))
 1560        if newtype_strat
 1561        then
 1562            -- Since the user explicitly asked for GeneralizedNewtypeDeriving,
 1563            -- we don't need to perform all of the checks we normally would,
 1564            -- such as if the class being derived is known to produce ill-roled
 1565            -- coercions (e.g., Traversable), since we can just derive the
 1566            -- instance and let it error if need be.
 1567            -- See Note [Determining whether newtype-deriving is appropriate]
 1568            if eta_ok && newtype_deriving
 1569              then mk_eqn_newtype dit rep_inst_ty
 1570              else bale_out (DerivErrCannotEtaReduceEnough eta_ok)
 1571        else
 1572          if might_be_newtype_derivable
 1573              && ((newtype_deriving && not deriveAnyClass)
 1574                   || std_class_via_coercible cls)
 1575          then mk_eqn_newtype dit rep_inst_ty
 1576          else case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys
 1577                                                  tycon rep_tycon of
 1578                StockClassError why
 1579                  -- There's a particular corner case where
 1580                  --
 1581                  -- 1. -XGeneralizedNewtypeDeriving and -XDeriveAnyClass are
 1582                  --    both enabled at the same time
 1583                  -- 2. We're deriving a particular stock derivable class
 1584                  --    (such as Functor)
 1585                  --
 1586                  -- and the previous cases won't catch it. This fixes the bug
 1587                  -- reported in #10598.
 1588                  | might_be_newtype_derivable && newtype_deriving
 1589                 -> mk_eqn_newtype dit rep_inst_ty
 1590                  -- Otherwise, throw an error for a stock class
 1591                  | might_be_newtype_derivable && not newtype_deriving
 1592                 -> bale_out why
 1593                  | otherwise
 1594                 -> bale_out why
 1595 
 1596                -- Must use newtype deriving or DeriveAnyClass
 1597                NonDerivableClass
 1598                  -- Too hard, even with newtype deriving
 1599                  | newtype_deriving           -> bale_out (DerivErrCannotEtaReduceEnough eta_ok)
 1600                  -- Try newtype deriving!
 1601                  -- Here we suggest GeneralizedNewtypeDeriving even in cases
 1602                  -- where it may not be applicable. See #9600.
 1603                  | otherwise                  -> bale_out DerivErrNewtypeNonDeriveableClass
 1604 
 1605                -- DeriveAnyClass
 1606                CanDeriveAnyClass -> do
 1607                  -- If both DeriveAnyClass and GeneralizedNewtypeDeriving are
 1608                  -- enabled, we take the diplomatic approach of defaulting to
 1609                  -- DeriveAnyClass, but emitting a warning about the choice.
 1610                  -- See Note [Deriving strategies]
 1611                  when (newtype_deriving && deriveAnyClass) $
 1612                    lift $ addDiagnosticTc
 1613                         $ TcRnDerivingDefaults cls
 1614                  mk_eqn_from_mechanism DerivSpecAnyClass
 1615                -- CanDeriveStock
 1616                CanDeriveStock gen_fn -> mk_eqn_from_mechanism $
 1617                                         DerivSpecStock { dsm_stock_dit    = dit
 1618                                                        , dsm_stock_gen_fn = gen_fn }
 1619 
 1620 {-
 1621 Note [Recursive newtypes]
 1622 ~~~~~~~~~~~~~~~~~~~~~~~~~
 1623 Newtype deriving works fine, even if the newtype is recursive.
 1624 e.g.    newtype S1 = S1 [T1 ()]
 1625         newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )
 1626 Remember, too, that type families are currently (conservatively) given
 1627 a recursive flag, so this also allows newtype deriving to work
 1628 for type famillies.
 1629 
 1630 We used to exclude recursive types, because we had a rather simple
 1631 minded way of generating the instance decl:
 1632    newtype A = MkA [A]
 1633    instance Eq [A] => Eq A      -- Makes typechecker loop!
 1634 But now we require a simple context, so it's ok.
 1635 
 1636 Note [Determining whether newtype-deriving is appropriate]
 1637 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1638 When we see
 1639   newtype NT = MkNT Foo
 1640     deriving C
 1641 we have to decide how to perform the deriving. Do we do newtype deriving,
 1642 or do we do normal deriving? In general, we prefer to do newtype deriving
 1643 wherever possible. So, we try newtype deriving unless there's a glaring
 1644 reason not to.
 1645 
 1646 "Glaring reasons not to" include trying to derive a class for which a
 1647 coercion-based instance doesn't make sense. These classes are listed in
 1648 the definition of non_coercible_class. They include Show (since it must
 1649 show the name of the datatype) and Traversable (since a coercion-based
 1650 Traversable instance is ill-roled).
 1651 
 1652 However, non_coercible_class is ignored if the user explicitly requests
 1653 to derive an instance with GeneralizedNewtypeDeriving using the newtype
 1654 deriving strategy. In such a scenario, GHC will unquestioningly try to
 1655 derive the instance via coercions (even if the final generated code is
 1656 ill-roled!). See Note [Deriving strategies].
 1657 
 1658 Note that newtype deriving might fail, even after we commit to it. This
 1659 is because the derived instance uses `coerce`, which must satisfy its
 1660 `Coercible` constraint. This is different than other deriving scenarios,
 1661 where we're sure that the resulting instance will type-check.
 1662 
 1663 Note [GND and associated type families]
 1664 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1665 It's possible to use GeneralizedNewtypeDeriving (GND) to derive instances for
 1666 classes with associated type families. A general recipe is:
 1667 
 1668     class C x y z where
 1669       type T y z x
 1670       op :: x -> [y] -> z
 1671 
 1672     newtype N a = MkN <rep-type> deriving( C )
 1673 
 1674     =====>
 1675 
 1676     instance C x y <rep-type> => C x y (N a) where
 1677       type T y (N a) x = T y <rep-type> x
 1678       op = coerce (op :: x -> [y] -> <rep-type>)
 1679 
 1680 However, we must watch out for three things:
 1681 
 1682 (a) The class must not contain any data families. If it did, we'd have to
 1683     generate a fresh data constructor name for the derived data family
 1684     instance, and it's not clear how to do this.
 1685 
 1686 (b) Each associated type family's type variables must mention the last type
 1687     variable of the class. As an example, you wouldn't be able to use GND to
 1688     derive an instance of this class:
 1689 
 1690       class C a b where
 1691         type T a
 1692 
 1693     But you would be able to derive an instance of this class:
 1694 
 1695       class C a b where
 1696         type T b
 1697 
 1698     The difference is that in the latter T mentions the last parameter of C
 1699     (i.e., it mentions b), but the former T does not. If you tried, e.g.,
 1700 
 1701       newtype Foo x = Foo x deriving (C a)
 1702 
 1703     with the former definition of C, you'd end up with something like this:
 1704 
 1705       instance C a (Foo x) where
 1706         type T a = T ???
 1707 
 1708     This T family instance doesn't mention the newtype (or its representation
 1709     type) at all, so we disallow such constructions with GND.
 1710 
 1711 (c) UndecidableInstances might need to be enabled. Here's a case where it is
 1712     most definitely necessary:
 1713 
 1714       class C a where
 1715         type T a
 1716       newtype Loop = Loop MkLoop deriving C
 1717 
 1718       =====>
 1719 
 1720       instance C Loop where
 1721         type T Loop = T Loop
 1722 
 1723     Obviously, T Loop would send the typechecker into a loop. Unfortunately,
 1724     you might even need UndecidableInstances even in cases where the
 1725     typechecker would be guaranteed to terminate. For example:
 1726 
 1727       instance C Int where
 1728         type C Int = Int
 1729       newtype MyInt = MyInt Int deriving C
 1730 
 1731       =====>
 1732 
 1733       instance C MyInt where
 1734         type T MyInt = T Int
 1735 
 1736     GHC's termination checker isn't sophisticated enough to conclude that the
 1737     definition of T MyInt terminates, so UndecidableInstances is required.
 1738 
 1739 (d) For the time being, we do not allow the last type variable of the class to
 1740     appear in a /kind/ of an associated type family definition. For instance:
 1741 
 1742     class C a where
 1743       type T1 a        -- OK
 1744       type T2 (x :: a) -- Illegal: a appears in the kind of x
 1745       type T3 y :: a   -- Illegal: a appears in the kind of (T3 y)
 1746 
 1747     The reason we disallow this is because our current approach to deriving
 1748     associated type family instances—i.e., by unwrapping the newtype's type
 1749     constructor as shown above—is ill-equipped to handle the scenario when
 1750     the last type variable appears as an implicit argument. In the worst case,
 1751     allowing the last variable to appear in a kind can result in improper Core
 1752     being generated (see #14728).
 1753 
 1754     There is hope for this feature being added some day, as one could
 1755     conceivably take a newtype axiom (which witnesses a coercion between a
 1756     newtype and its representation type) at lift that through each associated
 1757     type at the Core level. See #14728, comment:3 for a sketch of how this
 1758     might work. Until then, we disallow this featurette wholesale.
 1759 
 1760 The same criteria apply to DerivingVia.
 1761 
 1762 ************************************************************************
 1763 *                                                                      *
 1764 Bindings for the various classes
 1765 *                                                                      *
 1766 ************************************************************************
 1767 
 1768 After all the trouble to figure out the required context for the
 1769 derived instance declarations, all that's left is to chug along to
 1770 produce them.  They will then be shoved into @tcInstDecls2@, which
 1771 will do all its usual business.
 1772 
 1773 There are lots of possibilities for code to generate.  Here are
 1774 various general remarks.
 1775 
 1776 PRINCIPLES:
 1777 \begin{itemize}
 1778 \item
 1779 We want derived instances of @Eq@ and @Ord@ (both v common) to be
 1780 ``you-couldn't-do-better-by-hand'' efficient.
 1781 
 1782 \item
 1783 Deriving @Show@---also pretty common--- should also be reasonable good code.
 1784 
 1785 \item
 1786 Deriving for the other classes isn't that common or that big a deal.
 1787 \end{itemize}
 1788 
 1789 PRAGMATICS:
 1790 
 1791 \begin{itemize}
 1792 \item
 1793 Deriving @Ord@ is done mostly with the 1.3 @compare@ method.
 1794 
 1795 \item
 1796 Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.
 1797 
 1798 \item
 1799 We {\em normally} generate code only for the non-defaulted methods;
 1800 there are some exceptions for @Eq@ and (especially) @Ord@...
 1801 
 1802 \item
 1803 Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
 1804 constructor's numeric (@Int#@) tag.  These are generated by
 1805 @gen_tag_n_con_binds@, and the heuristic for deciding if one of
 1806 these is around is given by @hasCon2TagFun@.
 1807 
 1808 The examples under the different sections below will make this
 1809 clearer.
 1810 
 1811 \item
 1812 Much less often (really just for deriving @Ix@), we use a
 1813 @_tag2con_<tycon>@ function.  See the examples.
 1814 
 1815 \item
 1816 We use the renamer!!!  Reason: we're supposed to be
 1817 producing @LHsBinds Name@ for the methods, but that means
 1818 producing correctly-uniquified code on the fly.  This is entirely
 1819 possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
 1820 So, instead, we produce @MonoBinds RdrName@ then heave 'em through
 1821 the renamer.  What a great hack!
 1822 \end{itemize}
 1823 -}
 1824 
 1825 -- Generate the InstInfo for the required instance
 1826 -- plus any auxiliary bindings required
 1827 genInst :: DerivSpec theta
 1828         -> TcM (ThetaType -> TcM (InstInfo GhcPs), BagDerivStuff, [Name])
 1829 -- We must use continuation-returning style here to get the order in which we
 1830 -- typecheck family instances and derived instances right.
 1831 -- See Note [Staging of tcDeriving]
 1832 genInst spec@(DS { ds_tvs = tvs, ds_mechanism = mechanism
 1833                  , ds_tys = tys, ds_cls = clas, ds_loc = loc
 1834                  , ds_standalone_wildcard = wildcard })
 1835   = do (meth_binds, meth_sigs, deriv_stuff, unusedNames)
 1836          <- set_span_and_ctxt $
 1837             genDerivStuff mechanism loc clas tys tvs
 1838        let mk_inst_info theta = set_span_and_ctxt $ do
 1839              inst_spec <- newDerivClsInst theta spec
 1840              doDerivInstErrorChecks2 clas inst_spec theta wildcard mechanism
 1841              traceTc "newder" (ppr inst_spec)
 1842              return $ InstInfo
 1843                        { iSpec   = inst_spec
 1844                        , iBinds  = InstBindings
 1845                                      { ib_binds = meth_binds
 1846                                      , ib_tyvars = map Var.varName tvs
 1847                                      , ib_pragmas = meth_sigs
 1848                                      , ib_extensions = extensions
 1849                                      , ib_derived = True } }
 1850        return (mk_inst_info, deriv_stuff, unusedNames)
 1851   where
 1852     extensions :: [LangExt.Extension]
 1853     extensions
 1854       | isDerivSpecNewtype mechanism || isDerivSpecVia mechanism
 1855       = [
 1856           -- Both these flags are needed for higher-rank uses of coerce...
 1857           LangExt.ImpredicativeTypes, LangExt.RankNTypes
 1858           -- ...and this flag is needed to support the instance signatures
 1859           -- that bring type variables into scope.
 1860           -- See Note [Newtype-deriving instances] in GHC.Tc.Deriv.Generate
 1861         , LangExt.InstanceSigs
 1862         ]
 1863       | otherwise
 1864       = []
 1865 
 1866     set_span_and_ctxt :: TcM a -> TcM a
 1867     set_span_and_ctxt = setSrcSpan loc . addErrCtxt (instDeclCtxt3 clas tys)
 1868 
 1869 -- Checks:
 1870 --
 1871 -- * All of the data constructors for a data type are in scope for a
 1872 --   standalone-derived instance (for `stock` and `newtype` deriving).
 1873 --
 1874 -- * All of the associated type families of a class are suitable for
 1875 --   GeneralizedNewtypeDeriving or DerivingVia (for `newtype` and `via`
 1876 --   deriving).
 1877 doDerivInstErrorChecks1 :: DerivSpecMechanism -> DerivM ()
 1878 doDerivInstErrorChecks1 mechanism =
 1879   case mechanism of
 1880     DerivSpecStock{dsm_stock_dit = dit}
 1881       -> data_cons_in_scope_check dit
 1882     DerivSpecNewtype{dsm_newtype_dit = dit}
 1883       -> do atf_coerce_based_error_checks
 1884             data_cons_in_scope_check dit
 1885     DerivSpecAnyClass{}
 1886       -> pure ()
 1887     DerivSpecVia{}
 1888       -> atf_coerce_based_error_checks
 1889   where
 1890     -- When processing a standalone deriving declaration, check that all of the
 1891     -- constructors for the data type are in scope. For instance:
 1892     --
 1893     --   import M (T)
 1894     --   deriving stock instance Eq T
 1895     --
 1896     -- This should be rejected, as the derived Eq instance would need to refer
 1897     -- to the constructors for T, which are not in scope.
 1898     --
 1899     -- Note that the only strategies that require this check are `stock` and
 1900     -- `newtype`. Neither `anyclass` nor `via` require it as the code that they
 1901     -- generate does not require using data constructors.
 1902     data_cons_in_scope_check :: DerivInstTys -> DerivM ()
 1903     data_cons_in_scope_check (DerivInstTys { dit_tc     = tc
 1904                                            , dit_rep_tc = rep_tc }) = do
 1905       standalone <- isStandaloneDeriv
 1906       when standalone $ do
 1907         let bale_out msg = do err <- derivingThingErrMechanism mechanism msg
 1908                               lift $ failWithTc err
 1909 
 1910         rdr_env <- lift getGlobalRdrEnv
 1911         let data_con_names = map dataConName (tyConDataCons rep_tc)
 1912             hidden_data_cons = not (isWiredIn rep_tc) &&
 1913                                (isAbstractTyCon rep_tc ||
 1914                                 any not_in_scope data_con_names)
 1915             not_in_scope dc  = isNothing (lookupGRE_Name rdr_env dc)
 1916 
 1917         -- Make sure to also mark the data constructors as used so that GHC won't
 1918         -- mistakenly emit -Wunused-imports warnings about them.
 1919         lift $ addUsedDataCons rdr_env rep_tc
 1920 
 1921         unless (not hidden_data_cons) $
 1922           bale_out $ DerivErrDataConsNotAllInScope tc
 1923 
 1924     -- Ensure that a class's associated type variables are suitable for
 1925     -- GeneralizedNewtypeDeriving or DerivingVia. Unsurprisingly, this check is
 1926     -- only required for the `newtype` and `via` strategies.
 1927     --
 1928     -- See Note [GND and associated type families]
 1929     atf_coerce_based_error_checks :: DerivM ()
 1930     atf_coerce_based_error_checks = do
 1931       cls <- asks denv_cls
 1932       let bale_out msg = do err <- derivingThingErrMechanism mechanism msg
 1933                             lift $ failWithTc err
 1934 
 1935           cls_tyvars = classTyVars cls
 1936 
 1937           ats_look_sensible
 1938              =  -- Check (a) from Note [GND and associated type families]
 1939                 no_adfs
 1940                 -- Check (b) from Note [GND and associated type families]
 1941              && isNothing at_without_last_cls_tv
 1942                 -- Check (d) from Note [GND and associated type families]
 1943              && isNothing at_last_cls_tv_in_kinds
 1944 
 1945           (adf_tcs, atf_tcs) = partition isDataFamilyTyCon at_tcs
 1946           no_adfs            = null adf_tcs
 1947                  -- We cannot newtype-derive data family instances
 1948 
 1949           at_without_last_cls_tv
 1950             = find (\tc -> last_cls_tv `notElem` tyConTyVars tc) atf_tcs
 1951           at_last_cls_tv_in_kinds
 1952             = find (\tc -> any (at_last_cls_tv_in_kind . tyVarKind)
 1953                                (tyConTyVars tc)
 1954                         || at_last_cls_tv_in_kind (tyConResKind tc)) atf_tcs
 1955           at_last_cls_tv_in_kind kind
 1956             = last_cls_tv `elemVarSet` exactTyCoVarsOfType kind
 1957           at_tcs = classATs cls
 1958           last_cls_tv = assert (notNull cls_tyvars )
 1959                         last cls_tyvars
 1960 
 1961       unless ats_look_sensible $
 1962         bale_out (DerivErrHasAssociatedDatatypes
 1963                    (hasAssociatedDataFamInsts (not no_adfs))
 1964                    (associatedTyLastVarInKind at_last_cls_tv_in_kinds)
 1965                    (associatedTyNotParamOverLastTyVar at_without_last_cls_tv)
 1966                  )
 1967 
 1968 doDerivInstErrorChecks2 :: Class -> ClsInst -> ThetaType -> Maybe SrcSpan
 1969                         -> DerivSpecMechanism -> TcM ()
 1970 doDerivInstErrorChecks2 clas clas_inst theta wildcard mechanism
 1971   = do { traceTc "doDerivInstErrorChecks2" (ppr clas_inst)
 1972        ; dflags <- getDynFlags
 1973        ; xpartial_sigs <- xoptM LangExt.PartialTypeSignatures
 1974        ; wpartial_sigs <- woptM Opt_WarnPartialTypeSignatures
 1975 
 1976          -- Error if PartialTypeSignatures isn't enabled when a user tries
 1977          -- to write @deriving instance _ => Eq (Foo a)@. Or, if that
 1978          -- extension is enabled, give a warning if -Wpartial-type-signatures
 1979          -- is enabled.
 1980        ; case wildcard of
 1981            Nothing -> pure ()
 1982            Just span -> setSrcSpan span $ do
 1983              let suggParSigs = suggestPartialTypeSignatures xpartial_sigs
 1984              let dia = TcRnPartialTypeSignatures suggParSigs theta
 1985              checkTc xpartial_sigs dia
 1986              diagnosticTc wpartial_sigs dia
 1987 
 1988          -- Check for Generic instances that are derived with an exotic
 1989          -- deriving strategy like DAC
 1990          -- See Note [Deriving strategies]
 1991        ; when (exotic_mechanism && className clas `elem` genericClassNames) $
 1992          do { failIfTc (safeLanguageOn dflags)
 1993                        (TcRnCannotDeriveInstance clas mempty Nothing NoGeneralizedNewtypeDeriving $
 1994                           DerivErrSafeHaskellGenericInst)
 1995             ; when (safeInferOn dflags) (recordUnsafeInfer emptyMessages) } }
 1996   where
 1997     exotic_mechanism = not $ isDerivSpecStock mechanism
 1998 
 1999 derivingThingFailWith :: UsingGeneralizedNewtypeDeriving
 2000                          -- ^ If 'YesGeneralizedNewtypeDeriving', add a snippet about
 2001                          -- how not even GeneralizedNewtypeDeriving would make this
 2002                          -- declaration work. This only kicks in when
 2003                          -- an explicit deriving strategy is not given.
 2004                       -> DeriveInstanceErrReason -- The reason the derivation failed
 2005                       -> DerivM a
 2006 derivingThingFailWith newtype_deriving msg = do
 2007   err <- derivingThingErrM newtype_deriving msg
 2008   lift $ failWithTc err
 2009 
 2010 genDerivStuff :: DerivSpecMechanism -> SrcSpan -> Class
 2011               -> [Type] -> [TyVar]
 2012               -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff, [Name])
 2013 genDerivStuff mechanism loc clas inst_tys tyvars
 2014   = case mechanism of
 2015       -- See Note [Bindings for Generalised Newtype Deriving]
 2016       DerivSpecNewtype { dsm_newtype_rep_ty = rhs_ty}
 2017         -> gen_newtype_or_via rhs_ty
 2018 
 2019       -- Try a stock deriver
 2020       DerivSpecStock { dsm_stock_dit    = DerivInstTys
 2021                         { dit_rep_tc = rep_tc
 2022                         , dit_rep_tc_args = rep_tc_args
 2023                         }
 2024                      , dsm_stock_gen_fn = gen_fn }
 2025         -> gen_fn loc rep_tc rep_tc_args inst_tys
 2026 
 2027       -- Try DeriveAnyClass
 2028       DerivSpecAnyClass -> do
 2029         let mini_env   = mkVarEnv (classTyVars clas `zip` inst_tys)
 2030             mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
 2031         dflags <- getDynFlags
 2032         tyfam_insts <-
 2033           -- canDeriveAnyClass should ensure that this code can't be reached
 2034           -- unless -XDeriveAnyClass is enabled.
 2035           assertPpr (xopt LangExt.DeriveAnyClass dflags)
 2036                     (ppr "genDerivStuff: bad derived class" <+> ppr clas) $
 2037           mapM (tcATDefault loc mini_subst emptyNameSet)
 2038                (classATItems clas)
 2039         return ( emptyBag, [] -- No method bindings are needed...
 2040                , listToBag (map DerivFamInst (concat tyfam_insts))
 2041                -- ...but we may need to generate binding for associated type
 2042                -- family default instances.
 2043                -- See Note [DeriveAnyClass and default family instances]
 2044                , [] )
 2045 
 2046       -- Try DerivingVia
 2047       DerivSpecVia{dsm_via_ty = via_ty}
 2048         -> gen_newtype_or_via via_ty
 2049   where
 2050     gen_newtype_or_via ty = do
 2051       (binds, sigs, faminsts) <- gen_Newtype_binds loc clas tyvars inst_tys ty
 2052       return (binds, sigs, faminsts, [])
 2053 
 2054 {-
 2055 Note [Bindings for Generalised Newtype Deriving]
 2056 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 2057 Consider
 2058   class Eq a => C a where
 2059      f :: a -> a
 2060   newtype N a = MkN [a] deriving( C )
 2061   instance Eq (N a) where ...
 2062 
 2063 The 'deriving C' clause generates, in effect
 2064   instance (C [a], Eq a) => C (N a) where
 2065      f = coerce (f :: [a] -> [a])
 2066 
 2067 This generates a cast for each method, but allows the superclasse to
 2068 be worked out in the usual way.  In this case the superclass (Eq (N
 2069 a)) will be solved by the explicit Eq (N a) instance.  We do *not*
 2070 create the superclasses by casting the superclass dictionaries for the
 2071 representation type.
 2072 
 2073 See the paper "Safe zero-cost coercions for Haskell".
 2074 
 2075 Note [DeriveAnyClass and default family instances]
 2076 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 2077 
 2078 When a class has a associated type family with a default instance, e.g.:
 2079 
 2080   class C a where
 2081     type T a
 2082     type T a = Char
 2083 
 2084 then there are a couple of scenarios in which a user would expect T a to
 2085 default to Char. One is when an instance declaration for C is given without
 2086 an implementation for T:
 2087 
 2088   instance C Int
 2089 
 2090 Another scenario in which this can occur is when the -XDeriveAnyClass extension
 2091 is used:
 2092 
 2093   data Example = Example deriving (C, Generic)
 2094 
 2095 In the latter case, we must take care to check if C has any associated type
 2096 families with default instances, because -XDeriveAnyClass will never provide
 2097 an implementation for them. We "fill in" the default instances using the
 2098 tcATDefault function from GHC.Tc.TyCl.Class (which is also used in GHC.Tc.TyCl.Instance to
 2099 handle the empty instance declaration case).
 2100 
 2101 Note [Deriving strategies]
 2102 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 2103 GHC has a notion of deriving strategies, which allow the user to explicitly
 2104 request which approach to use when deriving an instance (enabled with the
 2105 -XDerivingStrategies language extension). For more information, refer to the
 2106 original issue (#10598) or the associated wiki page:
 2107 https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/deriving-strategies
 2108 
 2109 A deriving strategy can be specified in a deriving clause:
 2110 
 2111     newtype Foo = MkFoo Bar
 2112       deriving newtype C
 2113 
 2114 Or in a standalone deriving declaration:
 2115 
 2116     deriving anyclass instance C Foo
 2117 
 2118 -XDerivingStrategies also allows the use of multiple deriving clauses per data
 2119 declaration so that a user can derive some instance with one deriving strategy
 2120 and other instances with another deriving strategy. For example:
 2121 
 2122     newtype Baz = Baz Quux
 2123       deriving          (Eq, Ord)
 2124       deriving stock    (Read, Show)
 2125       deriving newtype  (Num, Floating)
 2126       deriving anyclass C
 2127 
 2128 Currently, the deriving strategies are:
 2129 
 2130 * stock: Have GHC implement a "standard" instance for a data type, if possible
 2131   (e.g., Eq, Ord, Generic, Data, Functor, etc.)
 2132 
 2133 * anyclass: Use -XDeriveAnyClass
 2134 
 2135 * newtype: Use -XGeneralizedNewtypeDeriving
 2136 
 2137 * via: Use -XDerivingVia
 2138 
 2139 The latter two strategies (newtype and via) are referred to as the
 2140 "coerce-based" strategies, since they generate code that relies on the `coerce`
 2141 function. See, for instance, GHC.Tc.Deriv.Infer.inferConstraintsCoerceBased.
 2142 
 2143 The former two strategies (stock and anyclass), in contrast, are
 2144 referred to as the "originative" strategies, since they create "original"
 2145 instances instead of "reusing" old instances (by way of `coerce`).
 2146 See, for instance, GHC.Tc.Deriv.Utils.checkOriginativeSideConditions.
 2147 
 2148 If an explicit deriving strategy is not given, GHC has an algorithm it uses to
 2149 determine which strategy it will actually use. The algorithm is quite long,
 2150 so it lives in the Haskell wiki at
 2151 https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/deriving-strategies
 2152 ("The deriving strategy resolution algorithm" section).
 2153 
 2154 Internally, GHC uses the DerivStrategy datatype to denote a user-requested
 2155 deriving strategy, and it uses the DerivSpecMechanism datatype to denote what
 2156 GHC will use to derive the instance after taking the above steps. In other
 2157 words, GHC will always settle on a DerivSpecMechnism, even if the user did not
 2158 ask for a particular DerivStrategy (using the algorithm linked to above).
 2159 
 2160 Note [Deriving instances for classes themselves]
 2161 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 2162 Much of the code in GHC.Tc.Deriv assumes that deriving only works on data types.
 2163 But this assumption doesn't hold true for DeriveAnyClass, since it's perfectly
 2164 reasonable to do something like this:
 2165 
 2166   {-# LANGUAGE DeriveAnyClass #-}
 2167   class C1 (a :: Constraint) where
 2168   class C2 where
 2169   deriving instance C1 C2
 2170     -- This is equivalent to `instance C1 C2`
 2171 
 2172 If DeriveAnyClass isn't enabled in the code above (i.e., it defaults to stock
 2173 deriving), we throw a special error message indicating that DeriveAnyClass is
 2174 the only way to go. We don't bother throwing this error if an explicit 'stock'
 2175 or 'newtype' keyword is used, since both options have their own perfectly
 2176 sensible error messages in the case of the above code (as C1 isn't a stock
 2177 derivable class, and C2 isn't a newtype).
 2178 
 2179 ************************************************************************
 2180 *                                                                      *
 2181 What con2tag/tag2con functions are available?
 2182 *                                                                      *
 2183 ************************************************************************
 2184 -}
 2185 
 2186 derivingThingErrM :: UsingGeneralizedNewtypeDeriving
 2187                   -> DeriveInstanceErrReason
 2188                   -> DerivM TcRnMessage
 2189 derivingThingErrM newtype_deriving why
 2190   = do DerivEnv { denv_cls      = cls
 2191                 , denv_inst_tys = cls_args
 2192                 , denv_strat    = mb_strat } <- ask
 2193        pure $ TcRnCannotDeriveInstance cls cls_args mb_strat newtype_deriving why
 2194 
 2195 derivingThingErrMechanism :: DerivSpecMechanism -> DeriveInstanceErrReason -> DerivM TcRnMessage
 2196 derivingThingErrMechanism mechanism why
 2197   = do DerivEnv { denv_cls      = cls
 2198                 , denv_inst_tys = cls_args
 2199                 , denv_strat    = mb_strat } <- ask
 2200        pure $ TcRnCannotDeriveInstance cls cls_args mb_strat newtype_deriving why
 2201   where
 2202     newtype_deriving :: UsingGeneralizedNewtypeDeriving
 2203     newtype_deriving
 2204       = if isDerivSpecNewtype mechanism then YesGeneralizedNewtypeDeriving
 2205                                         else NoGeneralizedNewtypeDeriving
 2206 
 2207 standaloneCtxt :: LHsSigWcType GhcRn -> SDoc
 2208 standaloneCtxt ty = hang (text "In the stand-alone deriving instance for")
 2209                        2 (quotes (ppr ty))