    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

    -}

    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE TypeFamilies #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -- | Handles @deriving@ clauses on @data@ declarations.
    module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where

    import GHC.Prelude

    import GHC.Hs
    import GHC.Driver.Session

    import GHC.Tc.Errors.Types
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Instance.Family
    import GHC.Tc.Types.Origin
    import GHC.Tc.Deriv.Infer
    import GHC.Tc.Deriv.Utils
    import GHC.Tc.TyCl.Class( instDeclCtxt3, tcATDefault )
    import GHC.Tc.Utils.Env
    import GHC.Tc.Deriv.Generate
    import GHC.Tc.Validity( checkValidInstHead )
    import GHC.Core.InstEnv
    import GHC.Tc.Utils.Instantiate
    import GHC.Core.FamInstEnv
    import GHC.Tc.Gen.HsType
    import GHC.Core.TyCo.Rep
    import GHC.Core.TyCo.Ppr ( pprTyVars )
    import GHC.Unit.Module.Warnings

    import GHC.Rename.Bind
    import GHC.Rename.Env
    import GHC.Rename.Module ( addTcgDUs )
    import GHC.Rename.Utils

    import GHC.Core.Unify( tcUnifyTy )
    import GHC.Core.Class
    import GHC.Core.Type
    import GHC.Utils.Error
    import GHC.Core.DataCon
    import GHC.Data.Maybe
    import GHC.Types.Name.Reader
    import GHC.Types.Name
    import GHC.Types.Name.Set as NameSet
    import GHC.Core.TyCon
    import GHC.Tc.Utils.TcType
    import GHC.Types.Var as Var
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Builtin.Names
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Logger
    import GHC.Data.Bag
    import GHC.Utils.FV as FV (fvVarList, unionFV, mkFVs)
    import qualified GHC.LanguageExtensions as LangExt
    import GHC.Data.BooleanFormula ( isUnsatisfied )

    import Control.Monad
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.Reader
    import Data.List (partition, find)

    {-
    ************************************************************************
    *                                                                      *
                    Overview
    *                                                                      *
    ************************************************************************

    Overall plan
    ~~~~~~~~~~~~
    1.  Convert the decls (i.e. data/newtype deriving clauses,
        plus standalone deriving) to [EarlyDerivSpec]

    2.  Infer the missing contexts for the InferTheta's

    3.  Add the derived bindings, generating InstInfos
    -}

    data EarlyDerivSpec = InferTheta (DerivSpec ThetaSpec)
                        | GivenTheta (DerivSpec ThetaType)
            -- InferTheta ds => the context for the instance should be inferred
            --      In this case ds_theta is the list of all the sets of
            --      constraints needed, such as (Eq [a], Eq a), together with a
            --      suitable CtLoc to get good error messages.
            --      The inference process is to reduce this to a
            --      simpler form (e.g. Eq a)
            --
            -- GivenTheta ds => the exact context for the instance is supplied
            --                  by the programmer; it is ds_theta
            -- See Note [Inferring the instance context] in GHC.Tc.Deriv.Infer

    splitEarlyDerivSpec :: [EarlyDerivSpec]
                        -> ([DerivSpec ThetaSpec], [DerivSpec ThetaType])
    splitEarlyDerivSpec :: [EarlyDerivSpec] -> ([DerivSpec ThetaSpec], [DerivSpec [Type]])
    splitEarlyDerivSpec [] = ([],[])
    splitEarlyDerivSpec (InferTheta DerivSpec ThetaSpec
    spec : [EarlyDerivSpec]
    specs) =
        case [EarlyDerivSpec] -> ([DerivSpec ThetaSpec], [DerivSpec [Type]])
    splitEarlyDerivSpec [EarlyDerivSpec]
    specs of ([DerivSpec ThetaSpec]
    is, [DerivSpec [Type]]
    gs) -> (DerivSpec ThetaSpec
    spec DerivSpec ThetaSpec
    -> [DerivSpec ThetaSpec] -> [DerivSpec ThetaSpec]
    forall a. a -> [a] -> [a]
    : [DerivSpec ThetaSpec]
    is, [DerivSpec [Type]]
    gs)
    splitEarlyDerivSpec (GivenTheta DerivSpec [Type]
    spec : [EarlyDerivSpec]
    specs) =
        case [EarlyDerivSpec] -> ([DerivSpec ThetaSpec], [DerivSpec [Type]])
    splitEarlyDerivSpec [EarlyDerivSpec]
    specs of ([DerivSpec ThetaSpec]
    is, [DerivSpec [Type]]
    gs) -> ([DerivSpec ThetaSpec]
    is, DerivSpec [Type]
    spec DerivSpec [Type] -> [DerivSpec [Type]] -> [DerivSpec [Type]]
    forall a. a -> [a] -> [a]
    : [DerivSpec [Type]]
    gs)

    instance Outputable EarlyDerivSpec where
      ppr :: EarlyDerivSpec -> SDoc
    ppr (InferTheta DerivSpec ThetaSpec
    spec) = DerivSpec ThetaSpec -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DerivSpec ThetaSpec
    spec SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "(Infer)"
      ppr (GivenTheta DerivSpec [Type]
    spec) = DerivSpec [Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DerivSpec [Type]
    spec SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "(Given)"

    {-
    Note [Data decl contexts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider

            data (RealFloat a) => Complex a = !a :+ !a deriving( Read )

    We will need an instance decl like:

            instance (Read a, RealFloat a) => Read (Complex a) where
              ...

    The RealFloat in the context is because the read method for Complex is bound
    to construct a Complex, and doing that requires that the argument type is
    in RealFloat.

    But this ain't true for Show, Eq, Ord, etc, since they don't construct
    a Complex; they only take them apart.

    Our approach: identify the offending classes, and add the data type
    context to the instance decl.  The "offending classes" are

            Read, Enum?

    FURTHER NOTE ADDED March 2002.  In fact, Haskell98 now requires that
    pattern matching against a constructor from a data type with a context
    gives rise to the constraints for that context -- or at least the thinned
    version.  So now all classes are "offending".

    Note [Newtype deriving]
    ~~~~~~~~~~~~~~~~~~~~~~~
    Consider this:
        class C a b
        instance C [a] Char
        newtype T = T Char deriving( C [a] )

    Notice the free 'a' in the deriving.  We have to fill this out to
        newtype T = T Char deriving( forall a. C [a] )

    And then translate it to:
        instance C [a] Char => C [a] T where ...

    Note [Unused constructors and deriving clauses]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    See #3221.  Consider
       data T = T1 | T2 deriving( Show )
    Are T1 and T2 unused?  Well, no: the deriving clause expands to mention
    both of them.  So we gather defs/uses from deriving just like anything else.

    -}

    -- | Stuff needed to process a datatype's `deriving` clauses
    data DerivInfo = DerivInfo { DerivInfo -> TyCon
    di_rep_tc  :: TyCon
                                 -- ^ The data tycon for normal datatypes,
                                 -- or the *representation* tycon for data families
                               , DerivInfo -> [(Name, TyVar)]
    di_scoped_tvs :: ![(Name,TyVar)]
                                 -- ^ Variables that scope over the deriving clause.
                                 -- See @Note [Scoped tyvars in a TcTyCon]@ in
                                 -- "GHC.Core.TyCon".
                               , DerivInfo -> [LHsDerivingClause GhcRn]
    di_clauses :: [LHsDerivingClause GhcRn]
                               , DerivInfo -> SDoc
    di_ctxt    :: SDoc -- ^ error context
                               }

    {-

    ************************************************************************
    *                                                                      *
    Top-level function for \tr{derivings}
    *                                                                      *
    ************************************************************************
    -}

    tcDeriving  :: [DerivInfo]       -- All `deriving` clauses
                -> [LDerivDecl GhcRn] -- All stand-alone deriving declarations
                -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
    tcDeriving :: [DerivInfo]
    -> [LDerivDecl GhcRn]
    -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
    tcDeriving [DerivInfo]
    deriv_infos [LDerivDecl GhcRn]
    deriv_decls
      = TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
    -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
    -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
    forall r. TcRn r -> TcRn r -> TcRn r
    recoverM (do { g <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
                     ; return (g, emptyBag, emptyValBindsOut)}) (TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
     -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn))
    -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
    -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)
    forall a b. (a -> b) -> a -> b
    $
        do  { -- Fish the "deriving"-related information out of the GHC.Tc.Utils.Env
              -- And make the necessary "equations".
              early_specs <- [DerivInfo] -> [LDerivDecl GhcRn] -> TcM [EarlyDerivSpec]
    makeDerivSpecs [DerivInfo]
    deriv_infos [LDerivDecl GhcRn]
    deriv_decls
            ; traceTc "tcDeriving" (ppr early_specs)

            ; let (infer_specs, given_specs) = splitEarlyDerivSpec early_specs
            ; famInsts1 <- concatMapM genFamInsts given_specs
            ; famInsts2 <- concatMapM genFamInsts infer_specs
            ; let famInsts = [FamInst]
    famInsts1 [FamInst] -> [FamInst] -> [FamInst]
    forall a. [a] -> [a] -> [a]
    ++ [FamInst]
    famInsts2

            ; logger <- getLogger

              -- We must put all the derived type family instances (from both
              -- infer_specs and given_specs) in the local instance environment
              -- before proceeding, or else simplifyInstanceContexts might
              -- get stuck if it has to reason about any of those family instances.
              -- See Note [Staging of tcDeriving]
            ; tcExtendLocalFamInstEnv famInsts $
              -- NB: only call tcExtendLocalFamInstEnv once, as it performs
              -- validity checking for all of the family instances you give it.
              -- If the family instances have errors, calling it twice will result
              -- in duplicate error messages!

         do { given_inst_binds <- mapM genInstBinds given_specs

            ; let given_inst_infos = ((InstInfo GhcPs, Bag AuxBindSpec, [Name]) -> InstInfo GhcPs)
    -> [(InstInfo GhcPs, Bag AuxBindSpec, [Name])] -> [InstInfo GhcPs]
    forall a b. (a -> b) -> [a] -> [b]
    map (InstInfo GhcPs, Bag AuxBindSpec, [Name]) -> InstInfo GhcPs
    forall a b c. (a, b, c) -> a
    fstOf3 [(InstInfo GhcPs, Bag AuxBindSpec, [Name])]
    given_inst_binds

            -- the stand-alone derived instances (@given_inst_infos@) are used when
            -- inferring the contexts for "deriving" clauses' instances
            -- (@infer_specs@)
            ; final_infer_specs <-
                extendLocalInstEnv (map iSpec given_inst_infos) $
                simplifyInstanceContexts infer_specs
            ; infer_inst_binds <- mapM genInstBinds final_infer_specs

            ; let (_, aux_specs, fvs) = unzip3 (given_inst_binds ++ infer_inst_binds)
            ; loc <- getSrcSpanM
            ; let aux_binds = SrcSpan -> Bag AuxBindSpec -> Bag (LHsBind GhcPs, LSig GhcPs)
    genAuxBinds SrcSpan
    loc ([Bag AuxBindSpec] -> Bag AuxBindSpec
    forall a. [Bag a] -> Bag a
    unionManyBags [Bag AuxBindSpec]
    aux_specs)

            ; let infer_inst_infos = ((InstInfo GhcPs, Bag AuxBindSpec, [Name]) -> InstInfo GhcPs)
    -> [(InstInfo GhcPs, Bag AuxBindSpec, [Name])] -> [InstInfo GhcPs]
    forall a b. (a -> b) -> [a] -> [b]
    map (InstInfo GhcPs, Bag AuxBindSpec, [Name]) -> InstInfo GhcPs
    forall a b c. (a, b, c) -> a
    fstOf3 [(InstInfo GhcPs, Bag AuxBindSpec, [Name])]
    infer_inst_binds
            ; let inst_infos = [InstInfo GhcPs]
    given_inst_infos [InstInfo GhcPs] -> [InstInfo GhcPs] -> [InstInfo GhcPs]
    forall a. [a] -> [a] -> [a]
    ++ [InstInfo GhcPs]
    infer_inst_infos

            ; (inst_info, rn_aux_binds, rn_dus) <- renameDeriv inst_infos aux_binds

            ; unless (isEmptyBag inst_info) $
                 liftIO (putDumpFileMaybe logger Opt_D_dump_deriv "Derived instances"
                            FormatHaskell
                            (ddump_deriving inst_info rn_aux_binds famInsts))

            ; gbl_env <- tcExtendLocalInstEnv (map iSpec (bagToList inst_info))
                                              getGblEnv
            ; let all_dus = DefUses
    rn_dus DefUses -> DefUses -> DefUses
    `plusDU` Uses -> DefUses
    usesOnly ([Name] -> Uses
    NameSet.mkFVs ([Name] -> Uses) -> [Name] -> Uses
    forall a b. (a -> b) -> a -> b
    $ [[Name]] -> [Name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Name]]
    fvs)
            ; return (addTcgDUs gbl_env all_dus, inst_info, rn_aux_binds) } }
      where
        ddump_deriving :: Bag (InstInfo GhcRn) -> HsValBinds GhcRn
                       -> [FamInst]               -- Associated type family instances
                       -> SDoc
        ddump_deriving :: Bag (InstInfo GhcRn) -> HsValBinds GhcRn -> [FamInst] -> SDoc
    ddump_deriving Bag (InstInfo GhcRn)
    inst_infos HsValBinds GhcRn
    extra_binds [FamInst]
    famInsts
          =    SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Derived class instances:")
                  Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((InstInfo GhcRn -> SDoc) -> [InstInfo GhcRn] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\InstInfo GhcRn
    i -> InstInfo GhcRn -> SDoc
    forall (a :: Pass).
    OutputableBndrId a =>
    InstInfo (GhcPass a) -> SDoc
    pprInstInfoDetails InstInfo GhcRn
    i SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "") (Bag (InstInfo GhcRn) -> [InstInfo GhcRn]
    forall a. Bag a -> [a]
    bagToList Bag (InstInfo GhcRn)
    inst_infos))
                     SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ HsValBinds GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsValBinds GhcRn
    extra_binds)
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc -> SDoc -> SDoc
    hangP (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Derived type family instances:")
                 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((FamInst -> SDoc) -> [FamInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map FamInst -> SDoc
    pprRepTy [FamInst]
    famInsts))

        hangP :: SDoc -> SDoc -> SDoc
    hangP SDoc
    s SDoc
    x = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "" SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    s Int
    2 SDoc
    x

    -- Prints the representable type family instance
    pprRepTy :: FamInst -> SDoc
    pprRepTy :: FamInst -> SDoc
    pprRepTy fi :: FamInst
    fi@(FamInst { fi_tys :: FamInst -> [Type]
    fi_tys = [Type]
    lhs })
      = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "type" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> [Type] -> Type
    mkTyConApp (FamInst -> TyCon
    famInstTyCon FamInst
    fi) [Type]
    lhs) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
          SDoc
    forall doc. IsLine doc => doc
    equals SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    rhs
      where rhs :: Type
    rhs = FamInst -> Type
    famInstRHS FamInst
    fi

    renameDeriv :: [InstInfo GhcPs]
                -> Bag (LHsBind GhcPs, LSig GhcPs)
                -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    renameDeriv :: [InstInfo GhcPs]
    -> Bag (LHsBind GhcPs, LSig GhcPs)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    renameDeriv [InstInfo GhcPs]
    inst_infos Bag (LHsBind GhcPs, LSig GhcPs)
    bagBinds
      = TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a. TcRn a -> TcRn a
    discardWarnings (TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
     -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses))
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a b. (a -> b) -> a -> b
    $
        -- Discard warnings about unused bindings etc
        Extension
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM Extension
    LangExt.EmptyCase (TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
     -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses))
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a b. (a -> b) -> a -> b
    $
        -- Derived decls (for empty types) can have
        --    case x of {}
        Extension
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM Extension
    LangExt.ScopedTypeVariables (TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
     -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses))
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a b. (a -> b) -> a -> b
    $
        Extension
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM Extension
    LangExt.KindSignatures (TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
     -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses))
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a b. (a -> b) -> a -> b
    $
        -- Derived decls (for newtype-deriving) can use ScopedTypeVariables &
        -- KindSignatures
        Extension
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM Extension
    LangExt.TypeApplications (TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
     -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses))
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a b. (a -> b) -> a -> b
    $
        -- GND/DerivingVia uses TypeApplications in generated code
        -- (See Note [Newtype-deriving instances] in GHC.Tc.Deriv.Generate)
        Extension
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetXOptM Extension
    LangExt.RebindableSyntax (TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
     -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses))
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a b. (a -> b) -> a -> b
    $
        -- See Note [Avoid RebindableSyntax when deriving]
        Extension
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM Extension
    LangExt.TemplateHaskellQuotes (TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
     -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses))
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)
    forall a b. (a -> b) -> a -> b
    $
        -- DeriveLift makes uses of quotes
        do  {
            -- Bring the extra deriving stuff into scope
            -- before renaming the instances themselves
            ; String -> SDoc -> TcRn ()
    traceTc String
    "rnd" ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((InstInfo GhcPs -> SDoc) -> [InstInfo GhcPs] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\InstInfo GhcPs
    i -> InstInfo GhcPs -> SDoc
    forall (a :: Pass).
    OutputableBndrId a =>
    InstInfo (GhcPass a) -> SDoc
    pprInstInfoDetails InstInfo GhcPs
    i SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "") [InstInfo GhcPs]
    inst_infos))
            ; let (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
    aux_binds, Bag (GenLocated SrcSpanAnnA (Sig GhcPs))
    aux_sigs) = Bag
      (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs),
       GenLocated SrcSpanAnnA (Sig GhcPs))
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag (GenLocated SrcSpanAnnA (Sig GhcPs)))
    forall a b. Bag (a, b) -> (Bag a, Bag b)
    unzipBag Bag (LHsBind GhcPs, LSig GhcPs)
    Bag
      (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs),
       GenLocated SrcSpanAnnA (Sig GhcPs))
    bagBinds
                  aux_val_binds :: HsValBindsLR GhcPs GhcPs
    aux_val_binds = XValBinds GhcPs GhcPs
    -> LHsBindsLR GhcPs GhcPs
    -> [LSig GhcPs]
    -> HsValBindsLR GhcPs GhcPs
    forall idL idR.
    XValBinds idL idR
    -> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
    ValBinds XValBinds GhcPs GhcPs
    AnnSortKey BindTag
    forall tag. AnnSortKey tag
    NoAnnSortKey LHsBindsLR GhcPs GhcPs
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
    aux_binds (Bag (GenLocated SrcSpanAnnA (Sig GhcPs))
    -> [GenLocated SrcSpanAnnA (Sig GhcPs)]
    forall a. Bag a -> [a]
    bagToList Bag (GenLocated SrcSpanAnnA (Sig GhcPs))
    aux_sigs)
            -- Importantly, we use rnLocalValBindsLHS, not rnTopBindsLHS, to rename
            -- auxiliary bindings as if they were defined locally.
            -- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
            ; (bndrs, rn_aux_lhs) <- MiniFixityEnv
    -> HsValBindsLR GhcPs GhcPs
    -> RnM ([Name], HsValBindsLR GhcRn GhcPs)
    rnLocalValBindsLHS MiniFixityEnv
    emptyMiniFixityEnv HsValBindsLR GhcPs GhcPs
    aux_val_binds
            ; bindLocalNames bndrs $
        do  { (rn_aux, dus_aux) <- rnLocalValBindsRHS (mkNameSet bndrs) rn_aux_lhs
            ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
            ; return (listToBag rn_inst_infos, rn_aux,
                      dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }

      where
        rn_inst_info :: InstInfo GhcPs -> TcM (InstInfo GhcRn, FreeVars)
        rn_inst_info :: InstInfo GhcPs
    -> IOEnv (Env TcGblEnv TcLclEnv) (InstInfo GhcRn, Uses)
    rn_inst_info
          inst_info :: InstInfo GhcPs
    inst_info@(InstInfo { iSpec :: forall a. InstInfo a -> ClsInst
    iSpec = ClsInst
    inst
                              , iBinds :: forall a. InstInfo a -> InstBindings a
    iBinds = InstBindings
                                { ib_binds :: forall a. InstBindings a -> LHsBinds a
    ib_binds = LHsBindsLR GhcPs GhcPs
    binds
                                , ib_tyvars :: forall a. InstBindings a -> [Name]
    ib_tyvars = [Name]
    tyvars
                                , ib_pragmas :: forall a. InstBindings a -> [LSig a]
    ib_pragmas = [LSig GhcPs]
    sigs
                                , ib_extensions :: forall a. InstBindings a -> [Extension]
    ib_extensions = [Extension]
    exts -- Only for type-checking
                                , ib_derived :: forall a. InstBindings a -> Bool
    ib_derived = Bool
    sa } })
            =  do { (rn_binds, rn_sigs, fvs) <- Bool
    -> Name
    -> [Name]
    -> LHsBindsLR GhcPs GhcPs
    -> [LSig GhcPs]
    -> RnM (LHsBinds GhcRn, [LSig GhcRn], Uses)
    rnMethodBinds Bool
    False (ClsInst -> Name
    is_cls_nm ClsInst
    inst)
                                                              [Name]
    tyvars LHsBindsLR GhcPs GhcPs
    binds [LSig GhcPs]
    sigs
                  ; let binds' = InstBindings { ib_binds :: LHsBinds GhcRn
    ib_binds = LHsBinds GhcRn
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
    rn_binds
                                              , ib_tyvars :: [Name]
    ib_tyvars = [Name]
    tyvars
                                              , ib_pragmas :: [LSig GhcRn]
    ib_pragmas = [LSig GhcRn]
    [GenLocated SrcSpanAnnA (Sig GhcRn)]
    rn_sigs
                                              , ib_extensions :: [Extension]
    ib_extensions = [Extension]
    exts
                                              , ib_derived :: Bool
    ib_derived = Bool
    sa }
                  ; return (inst_info { iBinds = binds' }, fvs) }

    {-
    Note [Staging of tcDeriving]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Here's a tricky corner case for deriving (adapted from #2721):

        class C a where
          type T a
          foo :: a -> T a

        instance C Int where
          type T Int = Int
          foo = id

        newtype N = N Int deriving C

    This will produce an instance something like this:

        instance C N where
          type T N = T Int
          foo = coerce (foo :: Int -> T Int) :: N -> T N

    We must be careful in order to typecheck this code. When determining the
    context for the instance (in simplifyInstanceContexts), we need to determine
    that T N and T Int have the same representation, but to do that, the T N
    instance must be in the local family instance environment. Otherwise, GHC
    would be unable to conclude that T Int is representationally equivalent to
    T Int, and simplifyInstanceContexts would get stuck.

    Previously, tcDeriving would defer adding any derived type family instances to
    the instance environment until the very end, which meant that
    simplifyInstanceContexts would get called without all the type family instances
    it needed in the environment in order to properly simplify instance like
    the C N instance above.

    To avoid this scenario, we generate things in tcDeriving in a specific order:

    1. First, we generate all of the associated type family instances for derived
       instances (using `genFamInsts`).
    2. Next, we extend the local instance environment with these type family
       instances.
    3. Then, we generate the instance bindings for derived instances
       (using `genInstBinds`).
    4. Finally, for instances generated with `deriving` clauses, we infer the
       instance contexts (using `simplifyInstanceContexts`). At this point, we
       already have the necessary type family instances in scope (from step (2)),
       so this is safe to do.

    Note [Why we don't pass rep_tc into deriveTyData]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Down in the bowels of mk_deriv_inst_tys_maybe, we need to convert the fam_tc
    back into the rep_tc by means of a lookup. And yet we have the rep_tc right
    here! Why look it up again? Answer: it's just easier this way.
    We drop some number of arguments from the end of the datatype definition
    in deriveTyData. The arguments are dropped from the fam_tc.
    This action may drop a *different* number of arguments
    passed to the rep_tc, depending on how many free variables, etc., the
    dropped patterns have.

    Also, this technique carries over the kind substitution from deriveTyData
    nicely.

    Note [Avoid RebindableSyntax when deriving]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The RebindableSyntax extension interacts awkwardly with the derivation of
    any stock class whose methods require the use of string literals. The Show
    class is a simple example (see #12688):

      {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
      newtype Text = Text String
      fromString :: String -> Text
      fromString = Text

      data Foo = Foo deriving Show

    This will generate code to the effect of:

      instance Show Foo where
        showsPrec _ Foo = showString "Foo"

    But because RebindableSyntax and OverloadedStrings are enabled, the "Foo"
    string literal is now of type Text, not String, which showString doesn't
    accept! This causes the generated Show instance to fail to typecheck.

    To avoid this kind of scenario, we simply turn off RebindableSyntax entirely
    in derived code.

    ************************************************************************
    *                                                                      *
                    From HsSyn to DerivSpec
    *                                                                      *
    ************************************************************************

    @makeDerivSpecs@ fishes around to find the info about needed derived instances.
    -}

    makeDerivSpecs :: [DerivInfo]
                   -> [LDerivDecl GhcRn]
                   -> TcM [EarlyDerivSpec]
    makeDerivSpecs :: [DerivInfo] -> [LDerivDecl GhcRn] -> TcM [EarlyDerivSpec]
    makeDerivSpecs [DerivInfo]
    deriv_infos [LDerivDecl GhcRn]
    deriv_decls
      = do  { eqns1 <- [TcM [EarlyDerivSpec]]
    -> IOEnv (Env TcGblEnv TcLclEnv) [[EarlyDerivSpec]]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
    sequenceA
                          -- MP: scoped_tvs here magically converts TyVar into TcTyVar
                         [ TyCon
    -> [(Name, TyVar)]
    -> Maybe (LDerivStrategy GhcRn)
    -> [LHsSigType GhcRn]
    -> SDoc
    -> TcM [EarlyDerivSpec]
    deriveClause TyCon
    rep_tc [(Name, TyVar)]
    scoped_tvs Maybe (LDerivStrategy GhcRn)
    dcs (LDerivClauseTys GhcRn -> [LHsSigType GhcRn]
    deriv_clause_preds LDerivClauseTys GhcRn
    dct) SDoc
    err_ctxt
                         | DerivInfo { di_rep_tc :: DerivInfo -> TyCon
    di_rep_tc = TyCon
    rep_tc
                                     , di_scoped_tvs :: DerivInfo -> [(Name, TyVar)]
    di_scoped_tvs = [(Name, TyVar)]
    scoped_tvs
                                     , di_clauses :: DerivInfo -> [LHsDerivingClause GhcRn]
    di_clauses = [LHsDerivingClause GhcRn]
    clauses
                                     , di_ctxt :: DerivInfo -> SDoc
    di_ctxt = SDoc
    err_ctxt } <- [DerivInfo]
    deriv_infos
                         , L EpAnnCO
    _ (HsDerivingClause { deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
    deriv_clause_strategy = Maybe (LDerivStrategy GhcRn)
    dcs
                                                 , deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
    deriv_clause_tys = LDerivClauseTys GhcRn
    dct })
                             <- [LHsDerivingClause GhcRn]
    [GenLocated EpAnnCO (HsDerivingClause GhcRn)]
    clauses
                         ]
            ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls
            ; return $ concat eqns1 ++ catMaybes eqns2 }
      where
        deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn]
        deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn]
    deriv_clause_preds (L SrcSpanAnnC
    _ DerivClauseTys GhcRn
    dct) = case DerivClauseTys GhcRn
    dct of
          DctSingle XDctSingle GhcRn
    _ LHsSigType GhcRn
    ty -> [LHsSigType GhcRn
    ty]
          DctMulti XDctMulti GhcRn
    _ [LHsSigType GhcRn]
    tys -> [LHsSigType GhcRn]
    tys

    ------------------------------------------------------------------
    -- | Process the derived classes in a single @deriving@ clause.
    deriveClause :: TyCon
                 -> [(Name, TcTyVar)]  -- Scoped type variables taken from tcTyConScopedTyVars
                                       -- See Note [Scoped tyvars in a TcTyCon] in "GHC.Core.TyCon"
                 -> Maybe (LDerivStrategy GhcRn)
                 -> [LHsSigType GhcRn] -> SDoc
                 -> TcM [EarlyDerivSpec]
    deriveClause :: TyCon
    -> [(Name, TyVar)]
    -> Maybe (LDerivStrategy GhcRn)
    -> [LHsSigType GhcRn]
    -> SDoc
    -> TcM [EarlyDerivSpec]
    deriveClause TyCon
    rep_tc [(Name, TyVar)]
    scoped_tvs Maybe (LDerivStrategy GhcRn)
    mb_lderiv_strat [LHsSigType GhcRn]
    deriv_preds SDoc
    err_ctxt
      = SDoc -> TcM [EarlyDerivSpec] -> TcM [EarlyDerivSpec]
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt SDoc
    err_ctxt (TcM [EarlyDerivSpec] -> TcM [EarlyDerivSpec])
    -> TcM [EarlyDerivSpec] -> TcM [EarlyDerivSpec]
    forall a b. (a -> b) -> a -> b
    $ do
          String -> SDoc -> TcRn ()
    traceTc String
    "deriveClause" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
            [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "tvs"             SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [TyVar] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyVar]
    tvs
            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "scoped_tvs"      SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [(Name, TyVar)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [(Name, TyVar)]
    scoped_tvs
            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "tc"              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc
            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "tys"             SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    tys
            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "mb_lderiv_strat" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe (GenLocated EpAnnCO (DerivStrategy GhcRn)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe (LDerivStrategy GhcRn)
    Maybe (GenLocated EpAnnCO (DerivStrategy GhcRn))
    mb_lderiv_strat ]
          [(Name, TyVar)] -> TcM [EarlyDerivSpec] -> TcM [EarlyDerivSpec]
    forall r. [(Name, TyVar)] -> TcM r -> TcM r
    tcExtendNameTyVarEnv [(Name, TyVar)]
    scoped_tvs (TcM [EarlyDerivSpec] -> TcM [EarlyDerivSpec])
    -> TcM [EarlyDerivSpec] -> TcM [EarlyDerivSpec]
    forall a b. (a -> b) -> a -> b
    $ do
            (mb_lderiv_strat', via_tvs) <- Maybe (LDerivStrategy GhcRn)
    -> TcM (Maybe (LDerivStrategy GhcTc), [TyVar])
    tcDerivStrategy Maybe (LDerivStrategy GhcRn)
    mb_lderiv_strat
            tcExtendTyVarEnv via_tvs $
            -- Moreover, when using DerivingVia one can bind type variables in
            -- the `via` type as well, so these type variables must also be
            -- brought into scope.
              mapMaybeM (derivePred tc tys mb_lderiv_strat' via_tvs) deriv_preds
              -- After typechecking the `via` type once, we then typecheck all
              -- of the classes associated with that `via` type in the
              -- `deriving` clause.
              -- See also Note [Don't typecheck too much in DerivingVia].
      where
        tvs :: [TyVar]
    tvs = TyCon -> [TyVar]
    tyConTyVars TyCon
    rep_tc
        (TyCon
    tc, [Type]
    tys) = case TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)
    tyConFamInstSig_maybe TyCon
    rep_tc of
                            -- data family:
                      Just (TyCon
    fam_tc, [Type]
    pats, CoAxiom Unbranched
    _) -> (TyCon
    fam_tc, [Type]
    pats)
          -- NB: deriveTyData wants the *user-specified*
          -- name. See Note [Why we don't pass rep_tc into deriveTyData]

                      Maybe (TyCon, [Type], CoAxiom Unbranched)
    _ -> (TyCon
    rep_tc, [TyVar] -> [Type]
    mkTyVarTys [TyVar]
    tvs)     -- datatype

    -- | Process a single predicate in a @deriving@ clause.
    --
    -- This returns a 'Maybe' because the user might try to derive 'Typeable',
    -- which is a no-op nowadays.
    derivePred :: TyCon -> [Type] -> Maybe (LDerivStrategy GhcTc) -> [TyVar]
               -> LHsSigType GhcRn -> TcM (Maybe EarlyDerivSpec)
    derivePred :: TyCon
    -> [Type]
    -> Maybe (LDerivStrategy GhcTc)
    -> [TyVar]
    -> LHsSigType GhcRn
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    derivePred TyCon
    tc [Type]
    tys Maybe (LDerivStrategy GhcTc)
    mb_lderiv_strat [TyVar]
    via_tvs LHsSigType GhcRn
    deriv_pred =
      -- We carefully set up uses of recoverM to minimize error message
      -- cascades. See Note [Recovering from failures in deriving clauses].
      IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall r. TcRn r -> TcRn r -> TcRn r
    recoverM (Maybe EarlyDerivSpec
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe EarlyDerivSpec
    forall a. Maybe a
    Nothing) (IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall a b. (a -> b) -> a -> b
    $
      SrcSpan
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA LHsSigType GhcRn
    GenLocated SrcSpanAnnA (HsSigType GhcRn)
    deriv_pred) (IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall a b. (a -> b) -> a -> b
    $ do
        String -> SDoc -> TcRn ()
    traceTc String
    "derivePred" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
          [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "tc"              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc
          , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "tys"             SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    tys
          , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "deriv_pred"      SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigType GhcRn
    GenLocated SrcSpanAnnA (HsSigType GhcRn)
    deriv_pred
          , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "mb_lderiv_strat" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe (GenLocated EpAnnCO (DerivStrategy GhcTc)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe (LDerivStrategy GhcTc)
    Maybe (GenLocated EpAnnCO (DerivStrategy GhcTc))
    mb_lderiv_strat
          , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "via_tvs"         SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [TyVar] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyVar]
    via_tvs ]
        (cls_tvs, cls, cls_tys, cls_arg_kinds) <- LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Type])
    tcHsDeriv LHsSigType GhcRn
    deriv_pred
        when (cls_arg_kinds `lengthIsNot` 1) $
          failWithTc (TcRnNonUnaryTypeclassConstraint deriv_pred)
        let [cls_arg_kind] = cls_arg_kinds
            mb_deriv_strat = (GenLocated EpAnnCO (DerivStrategy GhcTc) -> DerivStrategy GhcTc)
    -> Maybe (GenLocated EpAnnCO (DerivStrategy GhcTc))
    -> Maybe (DerivStrategy GhcTc)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GenLocated EpAnnCO (DerivStrategy GhcTc) -> DerivStrategy GhcTc
    forall l e. GenLocated l e -> e
    unLoc Maybe (LDerivStrategy GhcTc)
    Maybe (GenLocated EpAnnCO (DerivStrategy GhcTc))
    mb_lderiv_strat
        if (className cls == typeableClassName)
        then do warnUselessTypeable
                return Nothing
        else let deriv_tvs = [TyVar]
    via_tvs [TyVar] -> [TyVar] -> [TyVar]
    forall a. [a] -> [a] -> [a]
    ++ [TyVar]
    cls_tvs in
             Just <$> deriveTyData tc tys mb_deriv_strat
                                   deriv_tvs cls cls_tys cls_arg_kind

    {-
    Note [Don't typecheck too much in DerivingVia]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider the following example:

      data D = ...
        deriving (A1 t, ..., A20 t) via T t

    GHC used to be engineered such that it would typecheck the `deriving`
    clause like so:

    1. Take the first class in the clause (`A1`).
    2. Typecheck the `via` type (`T t`) and bring its bound type variables
       into scope (`t`).
    3. Typecheck the class (`A1`).
    4. Move on to the next class (`A2`) and repeat the process until all
       classes have been typechecked.

    This algorithm gets the job done most of the time, but it has two notable
    flaws. One flaw is that it is wasteful: it requires that `T t` be typechecked
    20 different times, once for each class in the `deriving` clause. This is
    unnecessary because we only need to typecheck `T t` once in order to get
    access to its bound type variable.

    The other issue with this algorithm arises when there are no classes in the
    `deriving` clause, like in the following example:

      data D2 = ...
        deriving () via Maybe Maybe

    Because there are no classes, the algorithm above will simply do nothing.
    As a consequence, GHC will completely miss the fact that `Maybe Maybe`
    is ill-kinded nonsense (#16923).

    To address both of these problems, GHC now uses this algorithm instead:

    1. Typecheck the `via` type and bring its bound type variables into scope.
    2. Take the first class in the `deriving` clause.
    3. Typecheck the class.
    4. Move on to the next class and repeat the process until all classes have been
       typechecked.

    This algorithm ensures that the `via` type is always typechecked, even if there
    are no classes in the `deriving` clause. Moreover, it typecheck the `via` type
    /exactly/ once and no more, even if there are multiple classes in the clause.

    Note [Recovering from failures in deriving clauses]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider what happens if you run this program (from #10684) without
    DeriveGeneric enabled:

        data A = A deriving (Show, Generic)
        data B = B A deriving (Show)

    Naturally, you'd expect GHC to give an error to the effect of:

        Can't make a derived instance of `Generic A':
          You need -XDeriveGeneric to derive an instance for this class

    And *only* that error, since the other two derived Show instances appear to be
    independent of this derived Generic instance. Yet GHC also used to give this
    additional error on the program above:

        No instance for (Show A)
          arising from the 'deriving' clause of a data type declaration
        When deriving the instance for (Show B)

    This was happening because when GHC encountered any error within a single
    data type's set of deriving clauses, it would call recoverM and move on
    to the next data type's deriving clauses. One unfortunate consequence of
    this design is that if A's derived Generic instance failed, its derived
    Show instance would be skipped entirely, leading to the "No instance for
    (Show A)" error cascade.

    The solution to this problem is to push through uses of recoverM to the
    level of the individual derived classes in a particular data type's set of
    deriving clauses. That is, if you have:

        newtype C = C D
          deriving (E, F, G)

    Then instead of processing instances E through M under the scope of a single
    recoverM, as in the following pseudocode:

      recoverM (pure Nothing) $ mapM derivePred [E, F, G]

    We instead use recoverM in each iteration of the loop:

      mapM (recoverM (pure Nothing) . derivePred) [E, F, G]

    And then process each class individually, under its own recoverM scope. That
    way, failure to derive one class doesn't cancel out other classes in the
    same set of clause-derived classes.
    -}

    ------------------------------------------------------------------
    deriveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)
    -- Process a single standalone deriving declaration
    --  e.g.   deriving instance Show a => Show (T a)
    -- Rather like tcLocalInstDecl
    --
    -- This returns a Maybe because the user might try to derive Typeable, which is
    -- a no-op nowadays.
    deriveStandalone :: LDerivDecl GhcRn
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    deriveStandalone (L SrcSpanAnnA
    loc (DerivDecl (Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcRn))
    warn, [AddEpAnn]
    _) LHsSigWcType GhcRn
    deriv_ty Maybe (LDerivStrategy GhcRn)
    mb_lderiv_strat Maybe (XRec GhcRn OverlapMode)
    overlap_mode))
      = SrcSpanAnnA
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc                       (IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall a b. (a -> b) -> a -> b
    $
        SDoc
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (LHsSigWcType GhcRn -> SDoc
    standaloneCtxt LHsSigWcType GhcRn
    deriv_ty)  (IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe EarlyDerivSpec)
    forall a b. (a -> b) -> a -> b
    $
        do { String -> SDoc -> TcRn ()
    traceTc String
    "Standalone deriving decl for" (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigWcType GhcRn
    HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    deriv_ty)
           ; let ctxt :: UserTypeCtxt
    ctxt = Bool -> UserTypeCtxt
    GHC.Tc.Types.Origin.InstDeclCtxt Bool
    True
           ; String -> SDoc -> TcRn ()
    traceTc String
    "Deriving strategy (standalone deriving)" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [Maybe (GenLocated EpAnnCO (DerivStrategy GhcRn)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe (LDerivStrategy GhcRn)
    Maybe (GenLocated EpAnnCO (DerivStrategy GhcRn))
    mb_lderiv_strat, HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigWcType GhcRn
    HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    deriv_ty]
           ; (mb_lderiv_strat, via_tvs) <- Maybe (LDerivStrategy GhcRn)
    -> TcM (Maybe (LDerivStrategy GhcTc), [TyVar])
    tcDerivStrategy Maybe (LDerivStrategy GhcRn)
    mb_lderiv_strat
           ; traceTc "Deriving strategy (standalone deriving) 2" $
               vcat [ppr mb_lderiv_strat, ppr via_tvs]
           ; (cls_tvs, deriv_ctxt, cls, inst_tys)
               <- tcExtendTyVarEnv via_tvs $
                  tcStandaloneDerivInstType ctxt deriv_ty
           ; let mb_deriv_strat = (GenLocated EpAnnCO (DerivStrategy GhcTc) -> DerivStrategy GhcTc)
    -> Maybe (GenLocated EpAnnCO (DerivStrategy GhcTc))
    -> Maybe (DerivStrategy GhcTc)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GenLocated EpAnnCO (DerivStrategy GhcTc) -> DerivStrategy GhcTc
    forall l e. GenLocated l e -> e
    unLoc Maybe (GenLocated EpAnnCO (DerivStrategy GhcTc))
    mb_lderiv_strat
                 tvs            = [TyVar]
    via_tvs [TyVar] -> [TyVar] -> [TyVar]
    forall a. [a] -> [a] -> [a]
    ++ [TyVar]
    cls_tvs
             -- See Note [Unify kinds in deriving]
           ; (tvs', deriv_ctxt', inst_tys', mb_deriv_strat') <-
               case mb_deriv_strat of
                 -- Perform an additional unification with the kind of the `via`
                 -- type and the result of the previous kind unification.
                 Just (ViaStrategy XViaStrategy GhcTc
    via_ty)
                      -- This unification must be performed on the last element of
                      -- inst_tys, but we have not yet checked for this property.
                      -- (This is done later in expectNonNullaryClsArgs). For now,
                      -- simply do nothing if inst_tys is empty, since
                      -- expectNonNullaryClsArgs will error later if this
                      -- is the case.
                   |  Just Type
    inst_ty <- [Type] -> Maybe Type
    forall a. [a] -> Maybe a
    lastMaybe [Type]
    inst_tys
                   -> do
                   let via_kind :: Type
    via_kind     = HasDebugCallStack => Type -> Type
    Type -> Type
    typeKind XViaStrategy GhcTc
    Type
    via_ty
                       inst_ty_kind :: Type
    inst_ty_kind = HasDebugCallStack => Type -> Type
    Type -> Type
    typeKind Type
    inst_ty
                       mb_match :: Maybe Subst
    mb_match     = Type -> Type -> Maybe Subst
    tcUnifyTy Type
    inst_ty_kind Type
    via_kind

                   Bool -> TcRnMessage -> TcRn ()
    checkTc (Maybe Subst -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Subst
    mb_match)
                           (Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason
    -> TcRnMessage
    TcRnCannotDeriveInstance Class
    cls [Type]
    forall a. Monoid a => a
    mempty Maybe (DerivStrategy GhcTc)
    forall a. Maybe a
    Nothing UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving (DeriveInstanceErrReason -> TcRnMessage)
    -> DeriveInstanceErrReason -> TcRnMessage
    forall a b. (a -> b) -> a -> b
    $
                              Type -> Type -> Type -> DeriveInstanceErrReason
    DerivErrDerivingViaWrongKind Type
    inst_ty_kind XViaStrategy GhcTc
    Type
    via_ty Type
    via_kind)

                   let Just Subst
    kind_subst = Maybe Subst
    mb_match
                       ki_subst_range :: VarSet
    ki_subst_range  = Subst -> VarSet
    getSubstRangeTyCoFVs Subst
    kind_subst
                       -- See Note [Unification of two kind variables in deriving]
                       unmapped_tkvs :: [TyVar]
    unmapped_tkvs = (TyVar -> Bool) -> [TyVar] -> [TyVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\TyVar
    v -> TyVar
    v TyVar -> Subst -> Bool
    `notElemSubst` Subst
    kind_subst
                                            Bool -> Bool -> Bool
    && Bool -> Bool
    not (TyVar
    v TyVar -> VarSet -> Bool
    `elemVarSet` VarSet
    ki_subst_range))
                                              [TyVar]
    tvs
                       (Subst
    subst, [TyVar]
    _)    = HasDebugCallStack => Subst -> [TyVar] -> (Subst, [TyVar])
    Subst -> [TyVar] -> (Subst, [TyVar])
    substTyVarBndrs Subst
    kind_subst [TyVar]
    unmapped_tkvs
                       (DerivContext
    final_deriv_ctxt, [Type]
    final_deriv_ctxt_tys)
                         = case DerivContext
    deriv_ctxt of
                             InferContext Maybe SrcSpan
    wc -> (Maybe SrcSpan -> DerivContext
    InferContext Maybe SrcSpan
    wc, [])
                             SupplyContext [Type]
    theta ->
                               let final_theta :: [Type]
    final_theta = HasDebugCallStack => Subst -> [Type] -> [Type]
    Subst -> [Type] -> [Type]
    substTheta Subst
    subst [Type]
    theta
                               in ([Type] -> DerivContext
    SupplyContext [Type]
    final_theta, [Type]
    final_theta)
                       final_inst_tys :: [Type]
    final_inst_tys   = HasDebugCallStack => Subst -> [Type] -> [Type]
    Subst -> [Type] -> [Type]
    substTys Subst
    subst [Type]
    inst_tys
                       final_via_ty :: Type
    final_via_ty     = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy  Subst
    subst XViaStrategy GhcTc
    Type
    via_ty
                       -- See Note [Floating `via` type variables]
                       final_tvs :: [TyVar]
    final_tvs        = [Type] -> [TyVar]
    tyCoVarsOfTypesWellScoped ([Type] -> [TyVar]) -> [Type] -> [TyVar]
    forall a b. (a -> b) -> a -> b
    $
                                          [Type]
    final_deriv_ctxt_tys [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    final_inst_tys
                                            [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type
    final_via_ty]
                   ([TyVar], DerivContext, [Type], Maybe (DerivStrategy GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyVar], DerivContext, [Type], Maybe (DerivStrategy GhcTc))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ( [TyVar]
    final_tvs, DerivContext
    final_deriv_ctxt, [Type]
    final_inst_tys
                        , DerivStrategy GhcTc -> Maybe (DerivStrategy GhcTc)
    forall a. a -> Maybe a
    Just (XViaStrategy GhcTc -> DerivStrategy GhcTc
    forall pass. XViaStrategy pass -> DerivStrategy pass
    ViaStrategy XViaStrategy GhcTc
    Type
    final_via_ty) )

                 Maybe (DerivStrategy GhcTc)
    _ -> ([TyVar], DerivContext, [Type], Maybe (DerivStrategy GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyVar], DerivContext, [Type], Maybe (DerivStrategy GhcTc))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([TyVar]
    tvs, DerivContext
    deriv_ctxt, [Type]
    inst_tys, Maybe (DerivStrategy GhcTc)
    mb_deriv_strat)
           ; traceTc "Standalone deriving;" $ vcat
                  [ text "tvs':" <+> ppr tvs'
                  , text "mb_deriv_strat':" <+> ppr mb_deriv_strat'
                  , text "deriv_ctxt':" <+> ppr deriv_ctxt'
                  , text "cls:" <+> ppr cls
                  , text "inst_tys':" <+> ppr inst_tys' ]
                    -- C.f. GHC.Tc.TyCl.Instance.tcLocalInstDecl1

           ; if className cls == typeableClassName
             then do warnUselessTypeable
                     return Nothing
             else Just <$> mkEqnHelp (fmap unLoc overlap_mode)
                                     tvs' cls inst_tys'
                                     deriv_ctxt' mb_deriv_strat'
                                     (fmap unLoc warn) }

    -- Typecheck the type in a standalone deriving declaration.
    --
    -- This may appear dense, but it's mostly huffing and puffing to recognize
    -- the special case of a type with an extra-constraints wildcard context, e.g.,
    --
    --   deriving instance _ => Eq (Foo a)
    --
    -- If there is such a wildcard, we typecheck this as if we had written
    -- @deriving instance Eq (Foo a)@, and return @'InferContext' ('Just' loc)@,
    -- as the 'DerivContext', where loc is the location of the wildcard used for
    -- error reporting. This indicates that we should infer the context as if we
    -- were deriving Eq via a deriving clause
    -- (see Note [Inferring the instance context] in GHC.Tc.Deriv.Infer).
    --
    -- If there is no wildcard, then proceed as normal, and instead return
    -- @'SupplyContext' theta@, where theta is the typechecked context.
    --
    -- Note that this will never return @'InferContext' 'Nothing'@, as that can
    -- only happen with @deriving@ clauses.
    tcStandaloneDerivInstType
      :: UserTypeCtxt -> LHsSigWcType GhcRn
      -> TcM ([TyVar], DerivContext, Class, [Type])
    tcStandaloneDerivInstType :: UserTypeCtxt
    -> LHsSigWcType GhcRn -> TcM ([TyVar], DerivContext, Class, [Type])
    tcStandaloneDerivInstType UserTypeCtxt
    ctxt
        (HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
    hswc_body = deriv_ty :: LHsSigType GhcRn
    deriv_ty@(L SrcSpanAnnA
    loc (HsSig { sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
    sig_bndrs = HsOuterSigTyVarBndrs GhcRn
    outer_bndrs
                                                   , sig_body :: forall pass. HsSigType pass -> LHsType pass
    sig_body = LHsType GhcRn
    deriv_ty_body }))})
      | (Maybe (LHsContext GhcRn)
    theta, LHsType GhcRn
    rho) <- LHsType GhcRn -> (Maybe (LHsContext GhcRn), LHsType GhcRn)
    forall (pass :: Pass).
    LHsType (GhcPass pass)
    -> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
    splitLHsQualTy LHsType GhcRn
    deriv_ty_body
      , [LHsType GhcRn
    wc_pred] <- Maybe (LHsContext GhcRn) -> [LHsType GhcRn]
    forall (p :: Pass).
    Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
    fromMaybeContext Maybe (LHsContext GhcRn)
    theta
      , L SrcSpanAnnA
    wc_span (HsWildCardTy XWildCardTy GhcRn
    _) <- LHsType GhcRn -> LHsType GhcRn
    forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
    ignoreParens LHsType GhcRn
    wc_pred
      = do dfun_ty <- UserTypeCtxt -> LHsSigType GhcRn -> TcM Type
    tcHsClsInstType UserTypeCtxt
    ctxt (LHsSigType GhcRn -> TcM Type) -> LHsSigType GhcRn -> TcM Type
    forall a b. (a -> b) -> a -> b
    $ SrcSpanAnnA
    -> HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc (HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn))
    -> HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn)
    forall a b. (a -> b) -> a -> b
    $
                      HsSig { sig_ext :: XHsSig GhcRn
    sig_ext   = XHsSig GhcRn
    NoExtField
    noExtField
                            , sig_bndrs :: HsOuterSigTyVarBndrs GhcRn
    sig_bndrs = HsOuterSigTyVarBndrs GhcRn
    outer_bndrs
                            , sig_body :: LHsType GhcRn
    sig_body  = LHsType GhcRn
    rho }
           let (tvs, _theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
           pure (tvs, InferContext (Just (locA wc_span)), cls, inst_tys)
      | Bool
    otherwise
      = do dfun_ty <- UserTypeCtxt -> LHsSigType GhcRn -> TcM Type
    tcHsClsInstType UserTypeCtxt
    ctxt LHsSigType GhcRn
    deriv_ty
           let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
           pure (tvs, SupplyContext theta, cls, inst_tys)

    warnUselessTypeable :: TcM ()
    warnUselessTypeable :: TcRn ()
    warnUselessTypeable = TcRnMessage -> TcRn ()
    addDiagnosticTc TcRnMessage
    TcRnUselessTypeable

    ------------------------------------------------------------------
    deriveTyData :: TyCon -> [Type] -- LHS of data or data instance
                        -- Can be a data instance, hence [Type] args
                        -- and in that case the TyCon is the /family/ tycon
                 -> Maybe (DerivStrategy GhcTc) -- The optional deriving strategy
                 -> [TyVar] -- The type variables bound by the derived class
                 -> Class   -- The derived class
                 -> [Type]  -- The derived class's arguments
                 -> Kind    -- The function argument in the derived class's kind.
                            -- (e.g., if `deriving Functor`, this would be
                            -- `Type -> Type` since
                            -- `Functor :: (Type -> Type) -> Constraint`)
                 -> TcM EarlyDerivSpec
    -- The deriving clause of a data or newtype declaration
    -- I.e. not standalone deriving
    deriveTyData :: TyCon
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> [TyVar]
    -> Class
    -> [Type]
    -> Type
    -> IOEnv (Env TcGblEnv TcLclEnv) EarlyDerivSpec
    deriveTyData TyCon
    tc [Type]
    tc_args Maybe (DerivStrategy GhcTc)
    mb_deriv_strat [TyVar]
    deriv_tvs Class
    cls [Type]
    cls_tys Type
    cls_arg_kind
       = do {  -- Given data T a b c = ... deriving( C d ),
               -- we want to drop type variables from T so that (C d (T a)) is well-kinded
              let ([Scaled Type]
    arg_kinds, Type
    _)  = Type -> ([Scaled Type], Type)
    splitFunTys Type
    cls_arg_kind
                  n_args_to_drop :: Int
    n_args_to_drop  = [Scaled Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Scaled Type]
    arg_kinds
                  n_args_to_keep :: Int
    n_args_to_keep  = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    tc_args Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n_args_to_drop
                                    -- See Note [tc_args and tycon arity]
                  ([Type]
    tc_args_to_keep, [Type]
    args_to_drop)
                                  = Int -> [Type] -> ([Type], [Type])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n_args_to_keep [Type]
    tc_args
                  inst_ty_kind :: Type
    inst_ty_kind    = HasDebugCallStack => Type -> Type
    Type -> Type
    typeKind (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    tc_args_to_keep)

                  -- Match up the kinds, and apply the resulting kind substitution
                  -- to the types.  See Note [Unify kinds in deriving]
                  -- We are assuming the tycon tyvars and the class tyvars are distinct
                  mb_match :: Maybe Subst
    mb_match        = Type -> Type -> Maybe Subst
    tcUnifyTy Type
    inst_ty_kind Type
    cls_arg_kind
                  enough_args :: Bool
    enough_args     = Int
    n_args_to_keep Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0

            -- Check that the result really is well-kinded
            ; String -> SDoc -> TcRn ()
    traceTc String
    "deriveTyData" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
              [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "class:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> Type
    tyConKind (Class -> TyCon
    classTyCon Class
    cls))
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "cls_tys:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    cls_tys
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "tycon:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> Type
    tyConKind TyCon
    tc)
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "cls_arg:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    tc_args_to_keep) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    inst_ty_kind
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "cls_arg_kind:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    cls_arg_kind ]
            ; Bool -> TcRnMessage -> TcRn ()
    checkTc (Bool
    enough_args Bool -> Bool -> Bool
    && Maybe Subst -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Subst
    mb_match)
                      (Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason
    -> TcRnMessage
    TcRnCannotDeriveInstance Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    forall a. Maybe a
    Nothing UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving (DeriveInstanceErrReason -> TcRnMessage)
    -> DeriveInstanceErrReason -> TcRnMessage
    forall a b. (a -> b) -> a -> b
    $
                         TyCon -> Type -> Int -> DeriveInstanceErrReason
    DerivErrNotWellKinded TyCon
    tc Type
    cls_arg_kind Int
    n_args_to_keep)

            ; let -- Returns a singleton-element list if using ViaStrategy and an
                  -- empty list otherwise. Useful for free-variable calculations.
                  deriv_strat_tys :: Maybe (DerivStrategy GhcTc) -> [Type]
                  deriv_strat_tys :: Maybe (DerivStrategy GhcTc) -> [Type]
    deriv_strat_tys = (DerivStrategy GhcTc -> [Type])
    -> Maybe (DerivStrategy GhcTc) -> [Type]
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ([Type]
    -> (XViaStrategy GhcTc -> [Type]) -> DerivStrategy GhcTc -> [Type]
    forall p (pass :: Pass) r.
    (p ~ GhcPass pass) =>
    r -> (XViaStrategy p -> r) -> DerivStrategy p -> r
    foldDerivStrategy [] (XViaStrategy GhcTc -> [XViaStrategy GhcTc] -> [XViaStrategy GhcTc]
    forall a. a -> [a] -> [a]
    :[]))

                  propagate_subst :: Subst
    -> [TyVar]
    -> [Type]
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    propagate_subst Subst
    kind_subst [TyVar]
    tkvs' [Type]
    cls_tys' [Type]
    tc_args' Maybe (DerivStrategy GhcTc)
    mb_deriv_strat'
                    = ([TyVar]
    final_tkvs, [Type]
    final_cls_tys, [Type]
    final_tc_args, Maybe (DerivStrategy GhcTc)
    final_mb_deriv_strat)
                    where
                      ki_subst_range :: VarSet
    ki_subst_range  = Subst -> VarSet
    getSubstRangeTyCoFVs Subst
    kind_subst
                      -- See Note [Unification of two kind variables in deriving]
                      unmapped_tkvs :: [TyVar]
    unmapped_tkvs   = (TyVar -> Bool) -> [TyVar] -> [TyVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\TyVar
    v -> TyVar
    v TyVar -> Subst -> Bool
    `notElemSubst` Subst
    kind_subst
                                             Bool -> Bool -> Bool
    && Bool -> Bool
    not (TyVar
    v TyVar -> VarSet -> Bool
    `elemVarSet` VarSet
    ki_subst_range))
                                               [TyVar]
    tkvs'
                      (Subst
    subst, [TyVar]
    _)           = HasDebugCallStack => Subst -> [TyVar] -> (Subst, [TyVar])
    Subst -> [TyVar] -> (Subst, [TyVar])
    substTyVarBndrs Subst
    kind_subst [TyVar]
    unmapped_tkvs
                      final_tc_args :: [Type]
    final_tc_args        = HasDebugCallStack => Subst -> [Type] -> [Type]
    Subst -> [Type] -> [Type]
    substTys Subst
    subst [Type]
    tc_args'
                      final_cls_tys :: [Type]
    final_cls_tys        = HasDebugCallStack => Subst -> [Type] -> [Type]
    Subst -> [Type] -> [Type]
    substTys Subst
    subst [Type]
    cls_tys'
                      final_mb_deriv_strat :: Maybe (DerivStrategy GhcTc)
    final_mb_deriv_strat = (DerivStrategy GhcTc -> DerivStrategy GhcTc)
    -> Maybe (DerivStrategy GhcTc) -> Maybe (DerivStrategy GhcTc)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((XViaStrategy GhcTc -> XViaStrategy GhcTc)
    -> DerivStrategy GhcTc -> DerivStrategy GhcTc
    forall p (pass :: Pass).
    (p ~ GhcPass pass) =>
    (XViaStrategy p -> XViaStrategy p)
    -> DerivStrategy p -> DerivStrategy p
    mapDerivStrategy (HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy Subst
    subst))
                                                  Maybe (DerivStrategy GhcTc)
    mb_deriv_strat'
                      -- See Note [Floating `via` type variables]
                      final_tkvs :: [TyVar]
    final_tkvs           = [Type] -> [TyVar]
    tyCoVarsOfTypesWellScoped ([Type] -> [TyVar]) -> [Type] -> [TyVar]
    forall a b. (a -> b) -> a -> b
    $
                                             [Type]
    final_cls_tys [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    final_tc_args
                                               [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ Maybe (DerivStrategy GhcTc) -> [Type]
    deriv_strat_tys Maybe (DerivStrategy GhcTc)
    final_mb_deriv_strat

            ; let tkvs :: [TyVar]
    tkvs = [TyVar] -> [TyVar]
    scopedSort ([TyVar] -> [TyVar]) -> [TyVar] -> [TyVar]
    forall a b. (a -> b) -> a -> b
    $ FV -> [TyVar]
    fvVarList (FV -> [TyVar]) -> FV -> [TyVar]
    forall a b. (a -> b) -> a -> b
    $
                         FV -> FV -> FV
    unionFV ([Type] -> FV
    tyCoFVsOfTypes [Type]
    tc_args_to_keep)
                                 ([TyVar] -> FV
    FV.mkFVs [TyVar]
    deriv_tvs)
                  Just Subst
    kind_subst = Maybe Subst
    mb_match
                  ([TyVar]
    tkvs', [Type]
    cls_tys', [Type]
    tc_args', Maybe (DerivStrategy GhcTc)
    mb_deriv_strat')
                    = Subst
    -> [TyVar]
    -> [Type]
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    propagate_subst Subst
    kind_subst [TyVar]
    tkvs [Type]
    cls_tys
                                      [Type]
    tc_args_to_keep Maybe (DerivStrategy GhcTc)
    mb_deriv_strat

              -- See Note [Unify kinds in deriving]
            ; (final_tkvs, final_cls_tys, final_tc_args, final_mb_deriv_strat) <-
                case Maybe (DerivStrategy GhcTc)
    mb_deriv_strat' of
                  -- Perform an additional unification with the kind of the `via`
                  -- type and the result of the previous kind unification.
                  Just (ViaStrategy XViaStrategy GhcTc
    via_ty) -> do
                    let via_kind :: Type
    via_kind = HasDebugCallStack => Type -> Type
    Type -> Type
    typeKind XViaStrategy GhcTc
    Type
    via_ty
                        inst_ty_kind :: Type
    inst_ty_kind
                                  = HasDebugCallStack => Type -> Type
    Type -> Type
    typeKind (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    tc_args')
                        via_match :: Maybe Subst
    via_match = Type -> Type -> Maybe Subst
    tcUnifyTy Type
    inst_ty_kind Type
    via_kind

                    Bool -> TcRnMessage -> TcRn ()
    checkTc (Maybe Subst -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Subst
    via_match)
                            (Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason
    -> TcRnMessage
    TcRnCannotDeriveInstance Class
    cls [Type]
    forall a. Monoid a => a
    mempty Maybe (DerivStrategy GhcTc)
    forall a. Maybe a
    Nothing UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving (DeriveInstanceErrReason -> TcRnMessage)
    -> DeriveInstanceErrReason -> TcRnMessage
    forall a b. (a -> b) -> a -> b
    $
                               Type -> Type -> Type -> DeriveInstanceErrReason
    DerivErrDerivingViaWrongKind Type
    inst_ty_kind XViaStrategy GhcTc
    Type
    via_ty Type
    via_kind)

                    let Just Subst
    via_subst = Maybe Subst
    via_match
                    ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc)))
    -> ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    forall a b. (a -> b) -> a -> b
    $ Subst
    -> [TyVar]
    -> [Type]
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    propagate_subst Subst
    via_subst [TyVar]
    tkvs' [Type]
    cls_tys'
                                           [Type]
    tc_args' Maybe (DerivStrategy GhcTc)
    mb_deriv_strat'

                  Maybe (DerivStrategy GhcTc)
    _ -> ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TyVar], [Type], [Type], Maybe (DerivStrategy GhcTc))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([TyVar]
    tkvs', [Type]
    cls_tys', [Type]
    tc_args', Maybe (DerivStrategy GhcTc)
    mb_deriv_strat')

            ; traceTc "deriveTyData 1" $ vcat
                [ ppr final_mb_deriv_strat, pprTyVars deriv_tvs, ppr tc, ppr tc_args
                , pprTyVars (tyCoVarsOfTypesList tc_args)
                , ppr n_args_to_keep, ppr n_args_to_drop
                , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
                , ppr final_tc_args, ppr final_cls_tys ]

            ; traceTc "deriveTyData 2" $ vcat
                [ ppr final_tkvs ]

            ; let final_tc_app   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    final_tc_args
                  final_cls_args = [Type]
    final_cls_tys [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type
    final_tc_app]
            ; checkTc (allDistinctTyVars (mkVarSet final_tkvs) args_to_drop) -- (a, b, c)
                      (TcRnCannotDeriveInstance cls final_cls_tys Nothing NoGeneralizedNewtypeDeriving $
                         DerivErrNoEtaReduce final_tc_app)
                    -- Check that
                    --  (a) The args to drop are all type variables; eg reject:
                    --              data instance T a Int = .... deriving( Monad )
                    --  (b) The args to drop are all *distinct* type variables; eg reject:
                    --              class C (a :: * -> * -> *) where ...
                    --              data instance T a a = ... deriving( C )
                    --  (c) The type class args, or remaining tycon args,
                    --      do not mention any of the dropped type variables
                    --              newtype T a s = ... deriving( ST s )
                    --              newtype instance K a a = ... deriving( Monad )
                    --
                    -- It is vital that the implementation of allDistinctTyVars
                    -- expand any type synonyms.
                    -- See Note [Eta-reducing type synonyms]

            ; checkValidInstHead DerivClauseCtxt cls final_cls_args
                    -- Check that we aren't deriving an instance of a magical
                    -- type like (~) or Coercible (#14916).

            ; spec <- mkEqnHelp Nothing final_tkvs cls final_cls_args
                                (InferContext Nothing) final_mb_deriv_strat
                                Nothing
            ; traceTc "deriveTyData 3" (ppr spec)
            ; return spec }

    {- Note [tc_args and tycon arity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    You might wonder if we could use (tyConArity tc) at this point, rather
    than (length tc_args).  But for data families the two can differ!  The
    tc and tc_args passed into 'deriveTyData' come from 'deriveClause' which
    in turn gets them from 'tyConFamInstSig_maybe' which in turn gets them
    from DataFamInstTyCon:

    | DataFamInstTyCon          -- See Note [Data type families]
          (CoAxiom Unbranched)
          TyCon   -- The family TyCon
          [Type]  -- Argument types (mentions the tyConTyVars of this TyCon)
                  -- No shorter in length than the tyConTyVars of the family TyCon
                  -- How could it be longer? See [Arity of data families] in GHC.Core.FamInstEnv

    Notice that the arg tys might not be the same as the family tycon arity
    (= length tyConTyVars).

    Note [Unify kinds in deriving]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (#8534)
        data T a b = MkT a deriving( Functor )
        -- where Functor :: (*->*) -> Constraint

    So T :: forall k. * -> k -> *.   We want to get
        instance Functor (T * (a:*)) where ...
    Notice the '*' argument to T.

    Moreover, as well as instantiating T's kind arguments, we may need to instantiate
    C's kind args.  Consider (#8865):
      newtype T a b = MkT (Either a b) deriving( Category )
    where
      Category :: forall k. (k -> k -> *) -> Constraint
    We need to generate the instance
      instance Category * (Either a) where ...
    Notice the '*' argument to Category.

    So we need to
     * drop arguments from (T a b) to match the number of
       arrows in the (last argument of the) class;
     * and then *unify* kind of the remaining type against the
       expected kind, to figure out how to instantiate C's and T's
       kind arguments.

    In the two examples,
     * we unify   kind-of( T k (a:k) ) ~ kind-of( Functor )
             i.e.      (k -> *) ~ (* -> *)   to find k:=*.
             yielding  k:=*

     * we unify   kind-of( Either ) ~ kind-of( Category )
             i.e.      (* -> * -> *)  ~ (k -> k -> k)
             yielding  k:=*

    Now we get a kind substitution.  We then need to:

      1. Remove the substituted-out kind variables from the quantified kind vars

      2. Apply the substitution to the kinds of quantified *type* vars
         (and extend the substitution to reflect this change)

      3. Apply that extended substitution to the non-dropped args (types and
         kinds) of the type and class

    Forgetting step (2) caused #8893:
      data V a = V [a] deriving Functor
      data P (x::k->*) (a:k) = P (x a) deriving Functor
      data C (x::k->*) (a:k) = C (V (P x a)) deriving Functor

    When deriving Functor for P, we unify k to *, but we then want
    an instance   $df :: forall (x:*->*). Functor x => Functor (P * (x:*->*))
    and similarly for C.  Notice the modified kind of x, both at binding
    and occurrence sites.

    This can lead to some surprising results when *visible* kind binder is
    unified (in contrast to the above examples, in which only non-visible kind
    binders were considered). Consider this example from #11732:

        data T k (a :: k) = MkT deriving Functor

    Since unification yields k:=*, this results in a generated instance of:

        instance Functor (T *) where ...

    which looks odd at first glance, since one might expect the instance head
    to be of the form Functor (T k). Indeed, one could envision an alternative
    generated instance of:

        instance (k ~ *) => Functor (T k) where

    But this does not typecheck by design: kind equalities are not allowed to be
    bound in types, only terms. But in essence, the two instance declarations are
    entirely equivalent, since even though (T k) matches any kind k, the only
    possibly value for k is *, since anything else is ill-typed. As a result, we can
    just as comfortably use (T *).

    Another way of thinking about is: deriving clauses often infer constraints.
    For example:

        data S a = S a deriving Eq

    infers an (Eq a) constraint in the derived instance. By analogy, when we
    are deriving Functor, we might infer an equality constraint (e.g., k ~ *).
    The only distinction is that GHC instantiates equality constraints directly
    during the deriving process.

    Another quirk of this design choice manifests when typeclasses have visible
    kind parameters. Consider this code (also from #11732):

        class Cat k (cat :: k -> k -> *) where
          catId   :: cat a a
          catComp :: cat b c -> cat a b -> cat a c

        instance Cat * (->) where
          catId   = id
          catComp = (.)

        newtype Fun a b = Fun (a -> b) deriving (Cat k)

    Even though we requested a derived instance of the form (Cat k Fun), the
    kind unification will actually generate (Cat * Fun) (i.e., the same thing as if
    the user wrote deriving (Cat *)).

    What happens with DerivingVia, when you have yet another type? Consider:

      newtype Foo (a :: Type) = MkFoo (Proxy a)
        deriving Functor via Proxy

    As before, we unify the kind of Foo (* -> *) with the kind of the argument to
    Functor (* -> *). But that's not enough: the `via` type, Proxy, has the kind
    (k -> *), which is more general than what we want. So we must additionally
    unify (k -> *) with (* -> *).

    Currently, all of this unification is implemented kludgily with the pure
    unifier, which is rather tiresome. #14331 lays out a plan for how this
    might be made cleaner.

    Note [Unification of two kind variables in deriving]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    As a special case of the Note above, it is possible to derive an instance of
    a poly-kinded typeclass for a poly-kinded datatype. For example:

        class Category (cat :: k -> k -> *) where
        newtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category

    This case is surprisingly tricky. To see why, let's write out what instance GHC
    will attempt to derive (using -fprint-explicit-kinds syntax):

        instance Category k1 (T k2 c) where ...

    GHC will attempt to unify k1 and k2, which produces a substitution (kind_subst)
    that looks like [k2 :-> k1]. Importantly, we need to apply this substitution to
    the type variable binder for c, since its kind is (k2 -> k2 -> *).

    We used to accomplish this by doing the following:

        unmapped_tkvs = filter (`notElemSubst` kind_subst) all_tkvs
        (subst, _)    = substTyVarBndrs kind_subst unmapped_tkvs

    Where all_tkvs contains all kind variables in the class and instance types (in
    this case, all_tkvs = [k1,k2]). But since kind_subst only has one mapping,
    this results in unmapped_tkvs being [k1], and as a consequence, k1 gets mapped
    to another kind variable in subst! That is, subst = [k2 :-> k1, k1 :-> k_new].
    This is bad, because applying that substitution yields the following instance:

       instance Category k_new (T k1 c) where ...

    In other words, keeping k1 in unmapped_tvks taints the substitution, resulting
    in an ill-kinded instance (this caused #11837).

    To prevent this, we need to filter out any variable from all_tkvs which either

    1. Appears in the domain of kind_subst. notElemSubst checks this.
    2. Appears in the range of kind_subst. To do this, we compute the free
       variable set of the range of kind_subst with getSubstRangeTyCoFVs, and check
       if a kind variable appears in that set.

    Note [Eta-reducing type synonyms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    One can instantiate a type in a data family instance with a type synonym that
    mentions other type variables:

      type Const a b = a
      data family Fam (f :: * -> *) (a :: *)
      newtype instance Fam f (Const a f) = Fam (f a) deriving Functor

    It is also possible to define kind synonyms, and they can mention other types in
    a datatype declaration. For example,

      type Const a b = a
      newtype T f (a :: Const * f) = T (f a) deriving Functor

    When deriving, we need to perform eta-reduction analysis to ensure that none of
    the eta-reduced type variables are mentioned elsewhere in the declaration. But
    we need to be careful, because if we don't expand through the Const type
    synonym, we will mistakenly believe that f is an eta-reduced type variable and
    fail to derive Functor, even though the code above is correct (see #11416,
    where this was first noticed). For this reason, we expand the type synonyms in
    the eta-reduced types before doing any analysis.

    Note [Floating `via` type variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When generating a derived instance, it will be of the form:

      instance forall ???. C c_args (D d_args) where ...

    To fill in ???, GHC computes the free variables of `c_args` and `d_args`.
    `DerivingVia` adds an extra wrinkle to this formula, since we must also
    include the variables bound by the `via` type when computing the binders
    used to fill in ???. This might seem strange, since if a `via` type binds
    any type variables, then in almost all scenarios it will appear free in
    `c_args` or `d_args`. There are certain corner cases where this does not hold,
    however, such as in the following example (adapted from #15831):

      newtype Age = MkAge Int
        deriving Eq via Const Int a

    In this example, the `via` type binds the type variable `a`, but `a` appears
    nowhere in `Eq Age`. Nevertheless, we include it in the generated instance:

      instance forall a. Eq Age where
        (==) = coerce @(Const Int a -> Const Int a -> Bool)
                      @(Age         -> Age         -> Bool)
                      (==)

    The use of `forall a` is certainly required here, since the `a` in
    `Const Int a` would not be in scope otherwise. This instance is somewhat
    strange in that nothing in the instance head `Eq Age` ever determines what `a`
    will be, so any code that uses this instance will invariably instantiate `a`
    to be `Any`. We refer to this property of `a` as being a "floating" `via`
    type variable. Programs with floating `via` type variables are the only known
    class of program in which the `via` type quantifies type variables that aren't
    mentioned in the instance head in the generated instance.

    Fortunately, the choice to instantiate floating `via` type variables to `Any`
    is one that is completely transparent to the user (since the instance will
    work as expected regardless of what `a` is instantiated to), so we decide to
    permit them. An alternative design would make programs with floating `via`
    variables illegal, by requiring that every variable mentioned in the `via` type
    is also mentioned in the data header or the derived class. That restriction
    would require the user to pick a particular type (the choice does not matter);
    for example:

      newtype Age = MkAge Int
        -- deriving Eq via Const Int a  -- Floating 'a'
        deriving Eq via Const Int ()    -- Choose a=()
        deriving Eq via Const Int Any   -- Choose a=Any

    No expressiveness would be lost thereby, but stylistically it seems preferable
    to allow a type variable to indicate "it doesn't matter".

    Note that by quantifying the `a` in `forall a. Eq Age`, we are deferring the
    work of instantiating `a` to `Any` at every use site of the instance. An
    alternative approach would be to generate an instance that directly defaulted
    to `Any`:

      instance Eq Age where
        (==) = coerce @(Const Int Any -> Const Int Any -> Bool)
                      @(Age           -> Age           -> Bool)
                      (==)

    We do not implement this approach since it would require a nontrivial amount
    of implementation effort to substitute `Any` for the floating `via` type
    variables, and since the end result isn't distinguishable from the former
    instance (at least from the user's perspective), the amount of engineering
    required to obtain the latter instance just isn't worth it.
    -}

    mkEqnHelp :: Maybe OverlapMode
              -> [TyVar]
              -> Class -> [Type]
              -> DerivContext
                   -- SupplyContext => context supplied (standalone deriving)
                   -- InferContext  => context inferred (deriving on data decl, or
                   --                  standalone deriving decl with a wildcard)
              -> Maybe (DerivStrategy GhcTc)
              -> Maybe (WarningTxt GhcRn)
              -> TcRn EarlyDerivSpec
    -- Make the EarlyDerivSpec for an instance
    --      forall tvs. theta => cls (tys ++ [ty])
    -- where the 'theta' is optional (that's the Maybe part)
    -- Assumes that this declaration is well-kinded

    mkEqnHelp :: Maybe OverlapMode
    -> [TyVar]
    -> Class
    -> [Type]
    -> DerivContext
    -> Maybe (DerivStrategy GhcTc)
    -> Maybe (WarningTxt GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) EarlyDerivSpec
    mkEqnHelp Maybe OverlapMode
    overlap_mode [TyVar]
    tvs Class
    cls [Type]
    cls_args DerivContext
    deriv_ctxt Maybe (DerivStrategy GhcTc)
    deriv_strat Maybe (WarningTxt GhcRn)
    warn = do
      is_boot <- TcRn Bool
    tcIsHsBootOrSig
      when is_boot $ bale_out DerivErrBootFileFound

      let pred = Class -> [Type] -> Type
    mkClassPred Class
    cls [Type]
    cls_args
      skol_info <- mkSkolemInfo (DerivSkol pred)
      (tvs', cls_args', deriv_strat') <-
        skolemise_when_inferring_context skol_info deriv_ctxt
      let deriv_env = DerivEnv
                        { denv_overlap_mode :: Maybe OverlapMode
    denv_overlap_mode = Maybe OverlapMode
    overlap_mode
                        , denv_tvs :: [TyVar]
    denv_tvs          = [TyVar]
    tvs'
                        , denv_cls :: Class
    denv_cls          = Class
    cls
                        , denv_inst_tys :: [Type]
    denv_inst_tys     = [Type]
    cls_args'
                        , denv_ctxt :: DerivContext
    denv_ctxt         = DerivContext
    deriv_ctxt
                        , denv_skol_info :: SkolemInfo
    denv_skol_info    = SkolemInfo
    skol_info
                        , denv_strat :: Maybe (DerivStrategy GhcTc)
    denv_strat        = Maybe (DerivStrategy GhcTc)
    deriv_strat'
                        , denv_warn :: Maybe (WarningTxt GhcRn)
    denv_warn         = Maybe (WarningTxt GhcRn)
    warn }
      runReaderT mk_eqn deriv_env
      where
        skolemise_when_inferring_context ::
             SkolemInfo -> DerivContext
          -> TcM ([TcTyVar], [TcType], Maybe (DerivStrategy GhcTc))
        skolemise_when_inferring_context :: SkolemInfo
    -> DerivContext
    -> TcM ([TyVar], [Type], Maybe (DerivStrategy GhcTc))
    skolemise_when_inferring_context SkolemInfo
    skol_info DerivContext
    deriv_ctxt =
          case DerivContext
    deriv_ctxt of
            -- In order to infer an instance context, we must later make use of
            -- the constraint solving machinery, which expects TcTyVars rather
            -- than TyVars. We skolemise the type variables with non-overlappable
            -- (vanilla) skolems.
            -- See Note [Overlap and deriving] in GHC.Tc.Deriv.Infer.
            InferContext{} -> do
              (skol_subst, tvs') <- SkolemInfo -> [TyVar] -> TcM (Subst, [TyVar])
    tcInstSkolTyVars SkolemInfo
    skol_info [TyVar]
    tvs
              let cls_args'    = HasDebugCallStack => Subst -> [Type] -> [Type]
    Subst -> [Type] -> [Type]
    substTys Subst
    skol_subst [Type]
    cls_args
                  deriv_strat' = (DerivStrategy GhcTc -> DerivStrategy GhcTc)
    -> Maybe (DerivStrategy GhcTc) -> Maybe (DerivStrategy GhcTc)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((XViaStrategy GhcTc -> XViaStrategy GhcTc)
    -> DerivStrategy GhcTc -> DerivStrategy GhcTc
    forall p (pass :: Pass).
    (p ~ GhcPass pass) =>
    (XViaStrategy p -> XViaStrategy p)
    -> DerivStrategy p -> DerivStrategy p
    mapDerivStrategy (HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy Subst
    skol_subst))
                                      Maybe (DerivStrategy GhcTc)
    deriv_strat
              pure (tvs', cls_args', deriv_strat')
            -- If the instance context is supplied, we don't need to skolemise
            -- at all.
            SupplyContext{} -> ([TyVar], [Type], Maybe (DerivStrategy GhcTc))
    -> TcM ([TyVar], [Type], Maybe (DerivStrategy GhcTc))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([TyVar]
    tvs, [Type]
    cls_args, Maybe (DerivStrategy GhcTc)
    deriv_strat)

        bale_out :: DeriveInstanceErrReason -> TcRn ()
    bale_out =
          TcRnMessage -> TcRn ()
    forall a. TcRnMessage -> TcM a
    failWithTc (TcRnMessage -> TcRn ())
    -> (DeriveInstanceErrReason -> TcRnMessage)
    -> DeriveInstanceErrReason
    -> TcRn ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason
    -> TcRnMessage
    TcRnCannotDeriveInstance Class
    cls [Type]
    cls_args Maybe (DerivStrategy GhcTc)
    deriv_strat UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving

        mk_eqn :: DerivM EarlyDerivSpec
        mk_eqn :: ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn = do
          DerivEnv { denv_inst_tys = cls_args
                   , denv_strat    = mb_strat } <- ReaderT DerivEnv TcRn DerivEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
          case mb_strat of
            Just (StockStrategy XStockStrategy GhcTc
    _) -> do
              (cls_tys, inst_ty) <- [Type] -> DerivM ([Type], Type)
    expectNonNullaryClsArgs [Type]
    cls_args
              dit                <- expectAlgTyConApp cls_tys inst_ty
              mk_eqn_stock dit

            Just (AnyclassStrategy XAnyClassStrategy GhcTc
    _) -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_anyclass

            Just (ViaStrategy XViaStrategy GhcTc
    via_ty) -> do
              (cls_tys, inst_ty) <- [Type] -> DerivM ([Type], Type)
    expectNonNullaryClsArgs [Type]
    cls_args
              mk_eqn_via cls_tys inst_ty via_ty

            Just (NewtypeStrategy XNewtypeStrategy GhcTc
    _) -> do
              (cls_tys, inst_ty) <- [Type] -> DerivM ([Type], Type)
    expectNonNullaryClsArgs [Type]
    cls_args
              dit                <- expectAlgTyConApp cls_tys inst_ty
              unless (isNewTyCon (dit_rep_tc dit)) $
                derivingThingFailWith NoGeneralizedNewtypeDeriving DerivErrGNDUsedOnData
              mkNewTypeEqn True dit

            Maybe (DerivStrategy GhcTc)
    Nothing -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_no_strategy

    -- @expectNonNullaryClsArgs inst_tys@ checks if @inst_tys@ is non-empty.
    -- If so, return @(init inst_tys, last inst_tys)@.
    -- Otherwise, throw an error message.
    -- See @Note [DerivEnv and DerivSpecMechanism]@ in "GHC.Tc.Deriv.Utils" for why this
    -- property is important.
    expectNonNullaryClsArgs :: [Type] -> DerivM ([Type], Type)
    expectNonNullaryClsArgs :: [Type] -> DerivM ([Type], Type)
    expectNonNullaryClsArgs [Type]
    inst_tys =
      DerivM ([Type], Type)
    -> (([Type], Type) -> DerivM ([Type], Type))
    -> Maybe ([Type], Type)
    -> DerivM ([Type], Type)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM ([Type], Type)
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving DeriveInstanceErrReason
    DerivErrNullaryClasses) ([Type], Type) -> DerivM ([Type], Type)
    forall a. a -> ReaderT DerivEnv TcRn a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe ([Type], Type) -> DerivM ([Type], Type))
    -> Maybe ([Type], Type) -> DerivM ([Type], Type)
    forall a b. (a -> b) -> a -> b
    $
      [Type] -> Maybe ([Type], Type)
    forall a. [a] -> Maybe ([a], a)
    snocView [Type]
    inst_tys

    -- @expectAlgTyConApp cls_tys inst_ty@ checks if @inst_ty@ is an application
    -- of an algebraic type constructor. If so, return a 'DerivInstTys' consisting
    -- of @cls_tys@ and the constituent pars of @inst_ty@.
    -- Otherwise, throw an error message.
    -- See @Note [DerivEnv and DerivSpecMechanism]@ in "GHC.Tc.Deriv.Utils" for why this
    -- property is important.
    expectAlgTyConApp :: [Type] -- All but the last argument to the class in a
                                -- derived instance
                      -> Type   -- The last argument to the class in a
                                -- derived instance
                      -> DerivM DerivInstTys
    expectAlgTyConApp :: [Type] -> Type -> DerivM DerivInstTys
    expectAlgTyConApp [Type]
    cls_tys Type
    inst_ty = do
      fam_envs <- TcRn FamInstEnvs -> ReaderT DerivEnv TcRn FamInstEnvs
    forall (m :: * -> *) a. Monad m => m a -> ReaderT DerivEnv m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift TcRn FamInstEnvs
    tcGetFamInstEnvs
      case mk_deriv_inst_tys_maybe fam_envs cls_tys inst_ty of
        Maybe DerivInstTys
    Nothing -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM DerivInstTys
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving DeriveInstanceErrReason
    DerivErrLastArgMustBeApp
        Just DerivInstTys
    dit -> do DerivInstTys -> ReaderT DerivEnv TcRn ()
    expectNonDataFamTyCon DerivInstTys
    dit
                       DerivInstTys -> DerivM DerivInstTys
    forall a. a -> ReaderT DerivEnv TcRn a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DerivInstTys
    dit

    -- @expectNonDataFamTyCon dit@ checks if @dit_rep_tc dit@ is a representation
    -- type constructor for a data family instance, and if not,
    -- throws an error message.
    -- See @Note [DerivEnv and DerivSpecMechanism]@ in "GHC.Tc.Deriv.Utils" for why this
    -- property is important.
    expectNonDataFamTyCon :: DerivInstTys -> DerivM ()
    expectNonDataFamTyCon :: DerivInstTys -> ReaderT DerivEnv TcRn ()
    expectNonDataFamTyCon (DerivInstTys { dit_tc :: DerivInstTys -> TyCon
    dit_tc      = TyCon
    tc
                                        , dit_tc_args :: DerivInstTys -> [Type]
    dit_tc_args = [Type]
    tc_args
                                        , dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc  = TyCon
    rep_tc }) =
      -- If it's still a data family, the lookup failed; i.e no instance exists
      Bool -> ReaderT DerivEnv TcRn () -> ReaderT DerivEnv TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TyCon -> Bool
    isDataFamilyTyCon TyCon
    rep_tc) (ReaderT DerivEnv TcRn () -> ReaderT DerivEnv TcRn ())
    -> ReaderT DerivEnv TcRn () -> ReaderT DerivEnv TcRn ()
    forall a b. (a -> b) -> a -> b
    $
        UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn ()
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving (DeriveInstanceErrReason -> ReaderT DerivEnv TcRn ())
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn ()
    forall a b. (a -> b) -> a -> b
    $
          TyCon -> [Type] -> DeriveInstanceErrReason
    DerivErrNoFamilyInstance TyCon
    tc [Type]
    tc_args

    mk_deriv_inst_tys_maybe :: FamInstEnvs
                            -> [Type] -> Type -> Maybe DerivInstTys
    mk_deriv_inst_tys_maybe :: FamInstEnvs -> [Type] -> Type -> Maybe DerivInstTys
    mk_deriv_inst_tys_maybe FamInstEnvs
    fam_envs [Type]
    cls_tys Type
    inst_ty =
      ((TyCon, [Type]) -> DerivInstTys)
    -> Maybe (TyCon, [Type]) -> Maybe DerivInstTys
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (TyCon, [Type]) -> DerivInstTys
    lookup (Maybe (TyCon, [Type]) -> Maybe DerivInstTys)
    -> Maybe (TyCon, [Type]) -> Maybe DerivInstTys
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    tcSplitTyConApp_maybe Type
    inst_ty
      where
        lookup :: (TyCon, [Type]) -> DerivInstTys
        lookup :: (TyCon, [Type]) -> DerivInstTys
    lookup (TyCon
    tc, [Type]
    tc_args) =
          -- Find the instance of a data family
          -- Note [Looking up family instances for deriving]
          let (TyCon
    rep_tc, [Type]
    rep_tc_args, Coercion
    _co) = FamInstEnvs -> TyCon -> [Type] -> (TyCon, [Type], Coercion)
    tcLookupDataFamInst FamInstEnvs
    fam_envs TyCon
    tc [Type]
    tc_args
              dc_inst_arg_env :: DataConEnv [Type]
    dc_inst_arg_env = TyCon -> [Type] -> DataConEnv [Type]
    buildDataConInstArgEnv TyCon
    rep_tc [Type]
    rep_tc_args
          in DerivInstTys { dit_cls_tys :: [Type]
    dit_cls_tys         = [Type]
    cls_tys
                          , dit_tc :: TyCon
    dit_tc              = TyCon
    tc
                          , dit_tc_args :: [Type]
    dit_tc_args         = [Type]
    tc_args
                          , dit_rep_tc :: TyCon
    dit_rep_tc          = TyCon
    rep_tc
                          , dit_rep_tc_args :: [Type]
    dit_rep_tc_args     = [Type]
    rep_tc_args
                          , dit_dc_inst_arg_env :: DataConEnv [Type]
    dit_dc_inst_arg_env = DataConEnv [Type]
    dc_inst_arg_env }

    {-
    Note [Looking up family instances for deriving]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    tcLookupFamInstExact is an auxiliary lookup wrapper which requires
    that looked-up family instances exist.  If called with a vanilla
    tycon, the old type application is simply returned.

    If we have
      data instance F () = ... deriving Eq
      data instance F () = ... deriving Eq
    then tcLookupFamInstExact will be confused by the two matches;
    but that can't happen because tcInstDecls1 doesn't call tcDeriving
    if there are any overlaps.

    There are two other things that might go wrong with the lookup.
    First, we might see a standalone deriving clause
       deriving Eq (F ())
    when there is no data instance F () in scope.

    Note that it's OK to have
      data instance F [a] = ...
      deriving Eq (F [(a,b)])
    where the match is not exact; the same holds for ordinary data types
    with standalone deriving declarations.

    Note [Deriving, type families, and partial applications]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When there are no type families, it's quite easy:

        newtype S a = MkS [a]
        -- :CoS :: S  ~ []  -- Eta-reduced

        instance Eq [a] => Eq (S a)         -- by coercion sym (Eq (:CoS a)) : Eq [a] ~ Eq (S a)
        instance Monad [] => Monad S        -- by coercion sym (Monad :CoS)  : Monad [] ~ Monad S

    When type families are involved it's trickier:

        data family T a b
        newtype instance T Int a = MkT [a] deriving( Eq, Monad )
        -- :RT is the representation type for (T Int a)
        --  :Co:RT    :: :RT ~ []          -- Eta-reduced!
        --  :CoF:RT a :: T Int a ~ :RT a   -- Also eta-reduced!

        instance Eq [a] => Eq (T Int a)     -- easy by coercion
           -- d1 :: Eq [a]
           -- d2 :: Eq (T Int a) = d1 |> Eq (sym (:Co:RT a ; :coF:RT a))

        instance Monad [] => Monad (T Int)  -- only if we can eta reduce???
           -- d1 :: Monad []
           -- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))

    Note the need for the eta-reduced rule axioms.  After all, we can
    write it out
        instance Monad [] => Monad (T Int)  -- only if we can eta reduce???
          return x = MkT [x]
          ... etc ...

    See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom

    %************************************************************************
    %*                                                                      *
                    Deriving data types
    *                                                                      *
    ************************************************************************
    -}

    -- Once the DerivSpecMechanism is known, we can finally produce an
    -- EarlyDerivSpec from it.
    mk_eqn_from_mechanism :: DerivSpecMechanism -> DerivM EarlyDerivSpec
    mk_eqn_from_mechanism :: DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism DerivSpecMechanism
    mechanism
      = do DerivEnv { denv_overlap_mode = overlap_mode
                    , denv_tvs          = tvs
                    , denv_cls          = cls
                    , denv_inst_tys     = inst_tys
                    , denv_ctxt         = deriv_ctxt
                    , denv_skol_info    = skol_info
                    , denv_warn         = warn } <- ReaderT DerivEnv TcRn DerivEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
           user_ctxt <- askDerivUserTypeCtxt
           doDerivInstErrorChecks1 mechanism
           loc       <- lift getSrcSpanM
           dfun_name <- lift $ newDFunName cls inst_tys loc
           case deriv_ctxt of
            InferContext Maybe SrcSpan
    wildcard ->
              do { (inferred_constraints, tvs', inst_tys', mechanism')
                     <- DerivSpecMechanism
    -> DerivM (ThetaSpec, [TyVar], [Type], DerivSpecMechanism)
    inferConstraints DerivSpecMechanism
    mechanism
                 ; return $ InferTheta $ DS
                       { ds_loc = loc
                       , ds_name = dfun_name, ds_tvs = tvs'
                       , ds_cls = cls, ds_tys = inst_tys'
                       , ds_theta = inferred_constraints
                       , ds_skol_info = skol_info
                       , ds_user_ctxt = user_ctxt
                       , ds_overlap = overlap_mode
                       , ds_standalone_wildcard = wildcard
                       , ds_mechanism = mechanism'
                       , ds_warn = warn } }

            SupplyContext [Type]
    theta ->
                EarlyDerivSpec -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a. a -> ReaderT DerivEnv TcRn a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EarlyDerivSpec -> ReaderT DerivEnv TcRn EarlyDerivSpec)
    -> EarlyDerivSpec -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a b. (a -> b) -> a -> b
    $ DerivSpec [Type] -> EarlyDerivSpec
    GivenTheta (DerivSpec [Type] -> EarlyDerivSpec)
    -> DerivSpec [Type] -> EarlyDerivSpec
    forall a b. (a -> b) -> a -> b
    $ DS
                       { ds_loc :: SrcSpan
    ds_loc = SrcSpan
    loc
                       , ds_name :: Name
    ds_name = Name
    dfun_name, ds_tvs :: [TyVar]
    ds_tvs = [TyVar]
    tvs
                       , ds_cls :: Class
    ds_cls = Class
    cls, ds_tys :: [Type]
    ds_tys = [Type]
    inst_tys
                       , ds_theta :: [Type]
    ds_theta = [Type]
    theta
                       , ds_skol_info :: SkolemInfo
    ds_skol_info = SkolemInfo
    skol_info
                       , ds_user_ctxt :: UserTypeCtxt
    ds_user_ctxt = UserTypeCtxt
    user_ctxt
                       , ds_overlap :: Maybe OverlapMode
    ds_overlap = Maybe OverlapMode
    overlap_mode
                       , ds_standalone_wildcard :: Maybe SrcSpan
    ds_standalone_wildcard = Maybe SrcSpan
    forall a. Maybe a
    Nothing
                       , ds_mechanism :: DerivSpecMechanism
    ds_mechanism = DerivSpecMechanism
    mechanism
                       , ds_warn :: Maybe (WarningTxt GhcRn)
    ds_warn = Maybe (WarningTxt GhcRn)
    warn }

    mk_eqn_stock :: DerivInstTys -- Information about the arguments to the class
                 -> DerivM EarlyDerivSpec
    mk_eqn_stock :: DerivInstTys -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_stock DerivInstTys
    dit
      = do dflags <- ReaderT DerivEnv TcRn DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           let isDeriveAnyClassEnabled =
                 Bool -> DeriveAnyClassEnabled
    deriveAnyClassEnabled (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.DeriveAnyClass DynFlags
    dflags)
           checkOriginativeSideConditions dit >>= \case
             CanDeriveStock StockGenFns
    gen_fns -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism (DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec)
    -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a b. (a -> b) -> a -> b
    $
                                       DerivSpecStock { dsm_stock_dit :: DerivInstTys
    dsm_stock_dit     = DerivInstTys
    dit
                                                      , dsm_stock_gen_fns :: StockGenFns
    dsm_stock_gen_fns = StockGenFns
    gen_fns }
             StockClassError DeriveInstanceErrReason
    why    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving DeriveInstanceErrReason
    why
             OriginativeDerivStatus
    CanDeriveAnyClass      -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving
                                         (DeriveAnyClassEnabled -> DeriveInstanceErrReason
    DerivErrNotStockDeriveable DeriveAnyClassEnabled
    isDeriveAnyClassEnabled)
             -- In the 'NonDerivableClass' case we can't derive with either stock or anyclass
             -- so we /don't want/ to suggest the user to enabled 'DeriveAnyClass', that's
             -- why we pass 'YesDeriveAnyClassEnabled', so that GHC won't attempt to suggest it.
             OriginativeDerivStatus
    NonDerivableClass      -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving
                                         (DeriveAnyClassEnabled -> DeriveInstanceErrReason
    DerivErrNotStockDeriveable DeriveAnyClassEnabled
    YesDeriveAnyClassEnabled)

    mk_eqn_anyclass :: DerivM EarlyDerivSpec
    mk_eqn_anyclass :: ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_anyclass
      = do dflags <- ReaderT DerivEnv TcRn DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           let isDeriveAnyClassEnabled =
                 Bool -> DeriveAnyClassEnabled
    deriveAnyClassEnabled (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.DeriveAnyClass DynFlags
    dflags)
           case xopt LangExt.DeriveAnyClass dflags of
             Bool
    True  -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism DerivSpecMechanism
    DerivSpecAnyClass
             Bool
    False -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving
                                            (DeriveAnyClassEnabled -> DeriveInstanceErrReason
    DerivErrNotDeriveable DeriveAnyClassEnabled
    isDeriveAnyClassEnabled)

    mk_eqn_newtype :: DerivInstTys -- Information about the arguments to the class
                   -> Type         -- The newtype's representation type
                   -> DerivM EarlyDerivSpec
    mk_eqn_newtype :: DerivInstTys -> Type -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_newtype DerivInstTys
    dit Type
    rep_ty =
      DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism (DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec)
    -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a b. (a -> b) -> a -> b
    $ DerivSpecNewtype { dsm_newtype_dit :: DerivInstTys
    dsm_newtype_dit    = DerivInstTys
    dit
                                               , dsm_newtype_rep_ty :: Type
    dsm_newtype_rep_ty = Type
    rep_ty }

    mk_eqn_via :: [Type] -- All arguments to the class besides the last
               -> Type   -- The last argument to the class
               -> Type   -- The @via@ type
               -> DerivM EarlyDerivSpec
    mk_eqn_via :: [Type] -> Type -> Type -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_via [Type]
    cls_tys Type
    inst_ty Type
    via_ty =
      DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism (DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec)
    -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a b. (a -> b) -> a -> b
    $ DerivSpecVia { dsm_via_cls_tys :: [Type]
    dsm_via_cls_tys = [Type]
    cls_tys
                                           , dsm_via_inst_ty :: Type
    dsm_via_inst_ty = Type
    inst_ty
                                           , dsm_via_ty :: Type
    dsm_via_ty      = Type
    via_ty }

    -- Derive an instance without a user-requested deriving strategy. This uses
    -- heuristics to determine which deriving strategy to use.
    -- See Note [Deriving strategies].
    mk_eqn_no_strategy :: DerivM EarlyDerivSpec
    mk_eqn_no_strategy :: ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_no_strategy = do
      DerivEnv { denv_cls      = cls
               , denv_inst_tys = cls_args } <- ReaderT DerivEnv TcRn DerivEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      fam_envs <- lift tcGetFamInstEnvs

      -- First, check if the last argument is an application of a type constructor.
      -- If not, fall back to DeriveAnyClass.
      if |  Just (cls_tys, inst_ty) <- snocView cls_args
         ,  Just dit <- mk_deriv_inst_tys_maybe fam_envs cls_tys inst_ty
         -> if |  isNewTyCon (dit_rep_tc dit)
                  -- We have a dedicated code path for newtypes (see the
                  -- documentation for mkNewTypeEqn as to why this is the case)
               -> mkNewTypeEqn False dit

               |  otherwise
               -> do -- Otherwise, our only other options are stock or anyclass.
                     -- If it is stock, we must confirm that the last argument's
                     -- type constructor is algebraic.
                     -- See Note [DerivEnv and DerivSpecMechanism] in GHC.Tc.Deriv.Utils
                     whenIsJust (hasStockDeriving cls) $ \StockGenFns
    _ ->
                       DerivInstTys -> ReaderT DerivEnv TcRn ()
    expectNonDataFamTyCon DerivInstTys
    dit
                     mk_eqn_originative cls dit

         |  otherwise
         -> mk_eqn_anyclass
      where
        -- Use heuristics (checkOriginativeSideConditions) to determine whether
        -- stock or anyclass deriving should be used.
        mk_eqn_originative :: Class -> DerivInstTys -> DerivM EarlyDerivSpec
        mk_eqn_originative :: Class -> DerivInstTys -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_originative Class
    cls dit :: DerivInstTys
    dit@(DerivInstTys { dit_tc :: DerivInstTys -> TyCon
    dit_tc     = TyCon
    tc
                                                 , dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc = TyCon
    rep_tc }) = do
          dflags <- ReaderT DerivEnv TcRn DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
          let isDeriveAnyClassEnabled
                | Class -> Bool
    canSafelyDeriveAnyClass Class
    cls
                = Bool -> DeriveAnyClassEnabled
    deriveAnyClassEnabled (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.DeriveAnyClass DynFlags
    dflags)
                | Bool
    otherwise
                -- Pretend that the extension is enabled so that we won't suggest
                -- enabling it.
                = DeriveAnyClassEnabled
    YesDeriveAnyClassEnabled

          -- See Note [Deriving instances for classes themselves]
          let dac_error
                | TyCon -> Bool
    isClassTyCon TyCon
    rep_tc
                = TyCon -> DeriveAnyClassEnabled -> DeriveInstanceErrReason
    DerivErrOnlyAnyClassDeriveable TyCon
    tc DeriveAnyClassEnabled
    isDeriveAnyClassEnabled
                | Bool
    otherwise
                = DeriveAnyClassEnabled -> DeriveInstanceErrReason
    DerivErrNotStockDeriveable DeriveAnyClassEnabled
    isDeriveAnyClassEnabled

          checkOriginativeSideConditions dit >>= \case
            OriginativeDerivStatus
    NonDerivableClass      -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving DeriveInstanceErrReason
    dac_error
            StockClassError DeriveInstanceErrReason
    why    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving DeriveInstanceErrReason
    why
            CanDeriveStock StockGenFns
    gen_fns -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism (DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec)
    -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a b. (a -> b) -> a -> b
    $
                                      DerivSpecStock { dsm_stock_dit :: DerivInstTys
    dsm_stock_dit     = DerivInstTys
    dit
                                                     , dsm_stock_gen_fns :: StockGenFns
    dsm_stock_gen_fns = StockGenFns
    gen_fns }
            OriginativeDerivStatus
    CanDeriveAnyClass      -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism DerivSpecMechanism
    DerivSpecAnyClass

        canSafelyDeriveAnyClass :: Class -> Bool
    canSafelyDeriveAnyClass Class
    cls =
          -- If the set of minimal required definitions is nonempty,
          -- `DeriveAnyClass` will generate an instance with undefined methods or
          -- associated types, so don't suggest enabling it.
          Maybe (BooleanFormula Name) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (BooleanFormula Name) -> Bool)
    -> Maybe (BooleanFormula Name) -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Name -> Bool)
    -> BooleanFormula Name -> Maybe (BooleanFormula Name)
    forall a.
    Eq a =>
    (a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a)
    isUnsatisfied (Bool -> Name -> Bool
    forall a b. a -> b -> a
    const Bool
    False) (Class -> BooleanFormula Name
    classMinimalDef Class
    cls)

    {-
    ************************************************************************
    *                                                                      *
                Deriving instances for newtypes
    *                                                                      *
    ************************************************************************
    -}

    -- Derive an instance for a newtype. We put this logic into its own function
    -- because
    --
    -- (a) When no explicit deriving strategy is requested, we have special
    --     heuristics for newtypes to determine which deriving strategy should
    --     actually be used. See Note [Deriving strategies].
    -- (b) We make an effort to give error messages specifically tailored to
    --     newtypes.
    mkNewTypeEqn :: Bool -- Was this instance derived using an explicit @newtype@
                         -- deriving strategy?
                 -> DerivInstTys -> DerivM EarlyDerivSpec
    mkNewTypeEqn :: Bool -> DerivInstTys -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mkNewTypeEqn Bool
    newtype_strat dit :: DerivInstTys
    dit@(DerivInstTys { dit_cls_tys :: DerivInstTys -> [Type]
    dit_cls_tys     = [Type]
    cls_tys
                                                 , dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc      = TyCon
    rep_tycon
                                                 , dit_rep_tc_args :: DerivInstTys -> [Type]
    dit_rep_tc_args = [Type]
    rep_tc_args })
    -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
      = do DerivEnv{denv_cls = cls} <- ReaderT DerivEnv TcRn DerivEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
           dflags <- getDynFlags

           let newtype_deriving  = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.GeneralizedNewtypeDeriving DynFlags
    dflags
               deriveAnyClass    = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.DeriveAnyClass             DynFlags
    dflags

               bale_out = UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith (Bool -> UsingGeneralizedNewtypeDeriving
    usingGeneralizedNewtypeDeriving Bool
    newtype_deriving)

               -- Here is the plan for newtype derivings.  We see
               --        newtype T a1...an = MkT (t ak+1...an)
               --          deriving (.., C s1 .. sm, ...)
               -- where t is a type,
               --       ak+1...an is a suffix of a1..an, and are all tyvars
               --       ak+1...an do not occur free in t, nor in the s1..sm
               --       (C s1 ... sm) is a  *partial applications* of class C
               --                      with the last parameter missing
               --       (T a1 .. ak) matches the kind of C's last argument
               --              (and hence so does t)
               -- The latter kind-check has been done by deriveTyData already,
               -- and tc_args are already trimmed
               --
               -- We generate the instance
               --       instance forall ({a1..ak} u fvs(s1..sm)).
               --                C s1 .. sm t => C s1 .. sm (T a1...ak)
               -- where T a1...ap is the partial application of
               --       the LHS of the correct kind and p >= k
               --
               --      NB: the variables below are:
               --              tc_tvs = [a1, ..., an]
               --              tyvars_to_keep = [a1, ..., ak]
               --              rep_ty = t ak .. an
               --              deriv_tvs = fvs(s1..sm) \ tc_tvs
               --              tys = [s1, ..., sm]
               --              rep_fn' = t
               --
               -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
               -- We generate the instance
               --      instance Monad (ST s) => Monad (T s) where

               nt_eta_arity = TyCon -> Int
    newTyConEtadArity TyCon
    rep_tycon
                       -- For newtype T a b = MkT (S a a b), the TyCon
                       -- machinery already eta-reduces the representation type, so
                       -- we know that
                       --      T a ~ S a a
                       -- That's convenient here, because we may have to apply
                       -- it to fewer than its original complement of arguments

               -- Note [Newtype representation]
               -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
               -- Need newTyConRhs (*not* a recursive representation finder)
               -- to get the representation type. For example
               --      newtype B = MkB Int
               --      newtype A = MkA B deriving( Num )
               -- We want the Num instance of B, *not* the Num instance of Int,
               -- when making the Num instance of A!
               rep_inst_ty = TyCon -> [Type] -> Type
    newTyConInstRhs TyCon
    rep_tycon [Type]
    rep_tc_args

               -------------------------------------------------------------------
               --  Figuring out whether we can only do this newtype-deriving thing

               -- See Note [Determining whether newtype-deriving is appropriate]
               might_be_newtype_derivable
                  =  Bool -> Bool
    not (Class -> Bool
    non_coercible_class Class
    cls)
                  Bool -> Bool -> Bool
    && Bool
    eta_ok
    --            && not (isRecursiveTyCon tycon)      -- Note [Recursive newtypes]

               -- Check that eta reduction is OK
               eta_ok = [Type]
    rep_tc_args [Type] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthAtLeast` Int
    nt_eta_arity
                 -- The newtype can be eta-reduced to match the number
                 --     of type argument actually supplied
                 --        newtype T a b = MkT (S [a] b) deriving( Monad )
                 --     Here the 'b' must be the same in the rep type (S [a] b)
                 --     And the [a] must not mention 'b'.  That's all handled
                 --     by nt_eta_rity.

           massert (cls_tys `lengthIs` (classArity cls - 1))
           if newtype_strat
           then
               -- Since the user explicitly asked for GeneralizedNewtypeDeriving,
               -- we don't need to perform all of the checks we normally would,
               -- such as if the class being derived is known to produce ill-roled
               -- coercions (e.g., Traversable), since we can just derive the
               -- instance and let it error if need be.
               -- See Note [Determining whether newtype-deriving is appropriate]
               if eta_ok && newtype_deriving
                 then mk_eqn_newtype dit rep_inst_ty
                 else bale_out (DerivErrCannotEtaReduceEnough eta_ok)
           else
             if might_be_newtype_derivable
                 && ((newtype_deriving && not deriveAnyClass)
                      || std_class_via_coercible cls)
             then mk_eqn_newtype dit rep_inst_ty
             else checkOriginativeSideConditions dit >>= \case
                   StockClassError DeriveInstanceErrReason
    why
                     -- There's a particular corner case where
                     --
                     -- 1. -XGeneralizedNewtypeDeriving and -XDeriveAnyClass are
                     --    both enabled at the same time
                     -- 2. We're deriving a particular stock derivable class
                     --    (such as Functor)
                     --
                     -- and the previous cases won't catch it. This fixes the bug
                     -- reported in #10598.
                     | Bool
    might_be_newtype_derivable Bool -> Bool -> Bool
    && Bool
    newtype_deriving
                    -> DerivInstTys -> Type -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_newtype DerivInstTys
    dit Type
    rep_inst_ty
                     -- Otherwise, throw an error for a stock class
                     | Bool
    might_be_newtype_derivable Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    newtype_deriving
                    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    bale_out DeriveInstanceErrReason
    why
                     | Bool
    otherwise
                    -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    bale_out DeriveInstanceErrReason
    why

                   -- Must use newtype deriving or DeriveAnyClass
                   OriginativeDerivStatus
    NonDerivableClass
                     -- Too hard, even with newtype deriving
                     | Bool
    newtype_deriving           -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    bale_out (Bool -> DeriveInstanceErrReason
    DerivErrCannotEtaReduceEnough Bool
    eta_ok)
                     -- Try newtype deriving!
                     -- Here we suggest GeneralizedNewtypeDeriving even in cases
                     -- where it may not be applicable. See #9600.
                     | Bool
    otherwise                  -> DeriveInstanceErrReason -> ReaderT DerivEnv TcRn EarlyDerivSpec
    bale_out DeriveInstanceErrReason
    DerivErrNewtypeNonDeriveableClass

                   -- DeriveAnyClass
                   OriginativeDerivStatus
    CanDeriveAnyClass -> do
                     -- If both DeriveAnyClass and GeneralizedNewtypeDeriving are
                     -- enabled, we take the diplomatic approach of defaulting to
                     -- DeriveAnyClass, but emitting a warning about the choice.
                     -- See Note [Deriving strategies]
                     Bool -> ReaderT DerivEnv TcRn () -> ReaderT DerivEnv TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    newtype_deriving Bool -> Bool -> Bool
    && Bool
    deriveAnyClass) (ReaderT DerivEnv TcRn () -> ReaderT DerivEnv TcRn ())
    -> ReaderT DerivEnv TcRn () -> ReaderT DerivEnv TcRn ()
    forall a b. (a -> b) -> a -> b
    $
                       TcRn () -> ReaderT DerivEnv TcRn ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT DerivEnv m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (TcRn () -> ReaderT DerivEnv TcRn ())
    -> TcRn () -> ReaderT DerivEnv TcRn ()
    forall a b. (a -> b) -> a -> b
    $ TcRnMessage -> TcRn ()
    addDiagnosticTc
                            (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Class -> TcRnMessage
    TcRnDerivingDefaults Class
    cls
                     DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism DerivSpecMechanism
    DerivSpecAnyClass
                   -- CanDeriveStock
                   CanDeriveStock StockGenFns
    gen_fns -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    mk_eqn_from_mechanism (DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec)
    -> DerivSpecMechanism -> ReaderT DerivEnv TcRn EarlyDerivSpec
    forall a b. (a -> b) -> a -> b
    $
                                             DerivSpecStock { dsm_stock_dit :: DerivInstTys
    dsm_stock_dit     = DerivInstTys
    dit
                                                            , dsm_stock_gen_fns :: StockGenFns
    dsm_stock_gen_fns = StockGenFns
    gen_fns }

    {-
    Note [Recursive newtypes]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Newtype deriving works fine, even if the newtype is recursive.
    e.g.    newtype S1 = S1 [T1 ()]
            newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )
    Remember, too, that type families are currently (conservatively) given
    a recursive flag, so this also allows newtype deriving to work
    for type families.

    We used to exclude recursive types, because we had a rather simple
    minded way of generating the instance decl:
       newtype A = MkA [A]
       instance Eq [A] => Eq A      -- Makes typechecker loop!
    But now we require a simple context, so it's ok.

    Note [Determining whether newtype-deriving is appropriate]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we see
      newtype NT = MkNT Foo
        deriving C
    we have to decide how to perform the deriving. Do we do newtype deriving,
    or do we do normal deriving? In general, we prefer to do newtype deriving
    wherever possible. So, we try newtype deriving unless there's a glaring
    reason not to.

    "Glaring reasons not to" include trying to derive a class for which a
    coercion-based instance doesn't make sense. These classes are listed in
    the definition of non_coercible_class. They include Show (since it must
    show the name of the datatype) and Traversable (since a coercion-based
    Traversable instance is ill-roled).

    However, non_coercible_class is ignored if the user explicitly requests
    to derive an instance with GeneralizedNewtypeDeriving using the newtype
    deriving strategy. In such a scenario, GHC will unquestioningly try to
    derive the instance via coercions (even if the final generated code is
    ill-roled!). See Note [Deriving strategies].

    Note that newtype deriving might fail, even after we commit to it. This
    is because the derived instance uses `coerce`, which must satisfy its
    `Coercible` constraint. This is different than other deriving scenarios,
    where we're sure that the resulting instance will type-check.

    Note [GND and associated type families]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's possible to use GeneralizedNewtypeDeriving (GND) to derive instances for
    classes with associated type families. A general recipe is:

        class C x y z where
          type T y z x
          op :: x -> [y] -> z

        newtype N a = MkN <rep-type> deriving( C )

        =====>

        instance C x y <rep-type> => C x y (N a) where
          type T y (N a) x = T y <rep-type> x
          op = coerce (op :: x -> [y] -> <rep-type>)

    However, we must watch out for three things:

    (a) The class must not contain any data families. If it did, we'd have to
        generate a fresh data constructor name for the derived data family
        instance, and it's not clear how to do this.

    (b) Each associated type family's type variables must mention the last type
        variable of the class. As an example, you wouldn't be able to use GND to
        derive an instance of this class:

          class C a b where
            type T a

        But you would be able to derive an instance of this class:

          class C a b where
            type T b

        The difference is that in the latter T mentions the last parameter of C
        (i.e., it mentions b), but the former T does not. If you tried, e.g.,

          newtype Foo x = Foo x deriving (C a)

        with the former definition of C, you'd end up with something like this:

          instance C a (Foo x) where
            type T a = T ???

        This T family instance doesn't mention the newtype (or its representation
        type) at all, so we disallow such constructions with GND.

    (c) UndecidableInstances might need to be enabled. Here's a case where it is
        most definitely necessary:

          class C a where
            type T a
          newtype Loop = Loop MkLoop deriving C

          =====>

          instance C Loop where
            type T Loop = T Loop

        Obviously, T Loop would send the typechecker into a loop. Unfortunately,
        you might even need UndecidableInstances even in cases where the
        typechecker would be guaranteed to terminate. For example:

          instance C Int where
            type C Int = Int
          newtype MyInt = MyInt Int deriving C

          =====>

          instance C MyInt where
            type T MyInt = T Int

        GHC's termination checker isn't sophisticated enough to conclude that the
        definition of T MyInt terminates, so UndecidableInstances is required.

    (d) For the time being, we do not allow the last type variable of the class to
        appear in a /kind/ of an associated type family definition. For instance:

        class C a where
          type T1 a        -- OK
          type T2 (x :: a) -- Illegal: a appears in the kind of x
          type T3 y :: a   -- Illegal: a appears in the kind of (T3 y)

        The reason we disallow this is because our current approach to deriving
        associated type family instances—i.e., by unwrapping the newtype's type
        constructor as shown above—is ill-equipped to handle the scenario when
        the last type variable appears as an implicit argument. In the worst case,
        allowing the last variable to appear in a kind can result in improper Core
        being generated (see #14728).

        There is hope for this feature being added some day, as one could
        conceivably take a newtype axiom (which witnesses a coercion between a
        newtype and its representation type) at lift that through each associated
        type at the Core level. See #14728, comment:3 for a sketch of how this
        might work. Until then, we disallow this featurette wholesale.

    The same criteria apply to DerivingVia.

    ************************************************************************
    *                                                                      *
    Bindings for the various classes
    *                                                                      *
    ************************************************************************

    After all the trouble to figure out the required context for the
    derived instance declarations, all that's left is to chug along to
    produce them.  They will then be shoved into @tcInstDecls2@, which
    will do all its usual business.

    There are lots of possibilities for code to generate.  Here are
    various general remarks.

    PRINCIPLES:
    \begin{itemize}
    \item
    We want derived instances of @Eq@ and @Ord@ (both v common) to be
    ``you-couldn't-do-better-by-hand'' efficient.

    \item
    Deriving @Show@---also pretty common--- should also be reasonable good code.

    \item
    Deriving for the other classes isn't that common or that big a deal.
    \end{itemize}

    PRAGMATICS:

    \begin{itemize}
    \item
    Deriving @Ord@ is done mostly with the 1.3 @compare@ method.

    \item
    Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.

    \item
    We {\em normally} generate code only for the non-defaulted methods;
    there are some exceptions for @Eq@ and (especially) @Ord@...

    \item
    Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
    constructor's numeric (@Int#@) tag.  These are generated by
    @gen_tag_n_con_binds@, and the heuristic for deciding if one of
    these is around is given by @hasCon2TagFun@.

    The examples under the different sections below will make this
    clearer.

    \item
    Much less often (really just for deriving @Ix@), we use a
    @_tag2con_<tycon>@ function.  See the examples.

    \item
    We use the renamer!!!  Reason: we're supposed to be
    producing @LHsBinds Name@ for the methods, but that means
    producing correctly-uniquified code on the fly.  This is entirely
    possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
    So, instead, we produce @MonoBinds RdrName@ then heave 'em through
    the renamer.  What a great hack!
    \end{itemize}
    -}

    -- | Generate the 'InstInfo' for the required instance,
    -- plus any auxiliary bindings required (see @Note [Auxiliary binders]@ in
    -- "GHC.Tc.Deriv.Generate") and any additional free variables
    -- that should be marked (see @Note [Deriving and unused record selectors]@
    -- in "GHC.Tc.Deriv.Utils").
    genInstBinds :: DerivSpec ThetaType
                 -> TcM (InstInfo GhcPs, Bag AuxBindSpec, [Name])
    genInstBinds :: DerivSpec [Type]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (InstInfo GhcPs, Bag AuxBindSpec, [Name])
    genInstBinds spec :: DerivSpec [Type]
    spec@(DS { ds_tvs :: forall theta. DerivSpec theta -> [TyVar]
    ds_tvs = [TyVar]
    tyvars, ds_mechanism :: forall theta. DerivSpec theta -> DerivSpecMechanism
    ds_mechanism = DerivSpecMechanism
    mechanism
                          , ds_tys :: forall theta. DerivSpec theta -> [Type]
    ds_tys = [Type]
    inst_tys, ds_theta :: forall theta. DerivSpec theta -> theta
    ds_theta = [Type]
    theta, ds_cls :: forall theta. DerivSpec theta -> Class
    ds_cls = Class
    clas
                          , ds_loc :: forall theta. DerivSpec theta -> SrcSpan
    ds_loc = SrcSpan
    loc, ds_standalone_wildcard :: forall theta. DerivSpec theta -> Maybe SrcSpan
    ds_standalone_wildcard = Maybe SrcSpan
    wildcard })
      = DerivSpec [Type]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (InstInfo GhcPs, Bag AuxBindSpec, [Name])
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (InstInfo GhcPs, Bag AuxBindSpec, [Name])
    forall theta a. DerivSpec theta -> TcM a -> TcM a
    set_spec_span_and_ctxt DerivSpec [Type]
    spec (IOEnv
       (Env TcGblEnv TcLclEnv) (InstInfo GhcPs, Bag AuxBindSpec, [Name])
     -> IOEnv
          (Env TcGblEnv TcLclEnv) (InstInfo GhcPs, Bag AuxBindSpec, [Name]))
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (InstInfo GhcPs, Bag AuxBindSpec, [Name])
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (InstInfo GhcPs, Bag AuxBindSpec, [Name])
    forall a b. (a -> b) -> a -> b
    $
        do (meth_binds, meth_sigs, aux_specs, unusedNames) <- TcM (LHsBindsLR GhcPs GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    IOEnv
      (Env TcGblEnv TcLclEnv)
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
       [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    gen_inst_binds
           inst_spec <- newDerivClsInst spec
           doDerivInstErrorChecks2 clas inst_spec theta wildcard mechanism
           traceTc "newder" (ppr inst_spec)
           let inst_info =
                 InstInfo
                   { iSpec :: ClsInst
    iSpec   = ClsInst
    inst_spec
                   , iBinds :: InstBindings GhcPs
    iBinds  = InstBindings
                                 { ib_binds :: LHsBindsLR GhcPs GhcPs
    ib_binds = LHsBindsLR GhcPs GhcPs
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
    meth_binds
                                 , ib_tyvars :: [Name]
    ib_tyvars = (TyVar -> Name) -> [TyVar] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVar -> Name
    Var.varName [TyVar]
    tyvars
                                 , ib_pragmas :: [LSig GhcPs]
    ib_pragmas = [LSig GhcPs]
    [GenLocated SrcSpanAnnA (Sig GhcPs)]
    meth_sigs
                                 , ib_extensions :: [Extension]
    ib_extensions = [Extension]
    extensions
                                 , ib_derived :: Bool
    ib_derived = Bool
    True } }
           return (inst_info, aux_specs, unusedNames)
      where
        extensions :: [LangExt.Extension]
        extensions :: [Extension]
    extensions
          | DerivSpecMechanism -> Bool
    isDerivSpecNewtype DerivSpecMechanism
    mechanism Bool -> Bool -> Bool
    || DerivSpecMechanism -> Bool
    isDerivSpecVia DerivSpecMechanism
    mechanism
          = [
              -- Both these flags are needed for higher-rank uses of coerce...
              Extension
    LangExt.ImpredicativeTypes, Extension
    LangExt.RankNTypes
              -- ...and this flag is needed to support the instance signatures
              -- that bring type variables into scope.
              -- See Note [Newtype-deriving instances] in GHC.Tc.Deriv.Generate
            , Extension
    LangExt.InstanceSigs
              -- Skip unboxed tuples checking for derived instances when imported
              -- in a different module, see #20524
            , Extension
    LangExt.UnboxedTuples
            ]
          | Bool
    otherwise
          = []

        gen_inst_binds :: TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
        gen_inst_binds :: TcM (LHsBindsLR GhcPs GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    gen_inst_binds
          = case DerivSpecMechanism
    mechanism of
              -- See Note [Bindings for Generalised Newtype Deriving]
              DerivSpecNewtype { dsm_newtype_rep_ty :: DerivSpecMechanism -> Type
    dsm_newtype_rep_ty = Type
    rhs_ty}
                -> Type
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    gen_newtype_or_via Type
    rhs_ty

              -- Try a stock deriver
              DerivSpecStock { dsm_stock_dit :: DerivSpecMechanism -> DerivInstTys
    dsm_stock_dit = DerivInstTys
    dit
                             , dsm_stock_gen_fns :: DerivSpecMechanism -> StockGenFns
    dsm_stock_gen_fns =
                                 StockGenFns { stock_gen_binds :: StockGenFns
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (LHsBindsLR GhcPs GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    stock_gen_binds = SrcSpan
    -> DerivInstTys
    -> TcM
         (LHsBindsLR GhcPs GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    gen_fn } }
                -> SrcSpan
    -> DerivInstTys
    -> TcM
         (LHsBindsLR GhcPs GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    gen_fn SrcSpan
    loc DerivInstTys
    dit

              -- Try DeriveAnyClass
              DerivSpecMechanism
    DerivSpecAnyClass
                -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
     [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
    forall a. Bag a
    emptyBag, [], Bag AuxBindSpec
    forall a. Bag a
    emptyBag, [])
                   -- No method bindings, signatures, auxiliary bindings or free
                   -- variable names are needed. The only interesting work happens when
                   -- defaulting associated type family instances (see the
                   -- DeriveSpecAnyClass case in genFamInsts below).

              -- Try DerivingVia
              DerivSpecVia{dsm_via_ty :: DerivSpecMechanism -> Type
    dsm_via_ty = Type
    via_ty}
                -> Type
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    gen_newtype_or_via Type
    via_ty

        gen_newtype_or_via :: Type
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    gen_newtype_or_via Type
    ty = do
          let (LHsBindsLR GhcPs GhcPs
    binds, [LSig GhcPs]
    sigs) = SrcSpan
    -> Class
    -> [TyVar]
    -> [Type]
    -> Type
    -> (LHsBindsLR GhcPs GhcPs, [LSig GhcPs])
    gen_Newtype_binds SrcSpan
    loc Class
    clas [TyVar]
    tyvars [Type]
    inst_tys Type
    ty
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
     [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBindsLR GhcPs GhcPs
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs))
    binds, [LSig GhcPs]
    [GenLocated SrcSpanAnnA (Sig GhcPs)]
    sigs, Bag AuxBindSpec
    forall a. Bag a
    emptyBag, [])

    -- | Generate the associated type family instances for a derived instance.
    genFamInsts :: DerivSpec theta -> TcM [FamInst]
    genFamInsts :: forall theta.
    DerivSpec theta -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    genFamInsts spec :: DerivSpec theta
    spec@(DS { ds_tvs :: forall theta. DerivSpec theta -> [TyVar]
    ds_tvs = [TyVar]
    tyvars, ds_mechanism :: forall theta. DerivSpec theta -> DerivSpecMechanism
    ds_mechanism = DerivSpecMechanism
    mechanism
                         , ds_tys :: forall theta. DerivSpec theta -> [Type]
    ds_tys = [Type]
    inst_tys, ds_cls :: forall theta. DerivSpec theta -> Class
    ds_cls = Class
    clas, ds_loc :: forall theta. DerivSpec theta -> SrcSpan
    ds_loc = SrcSpan
    loc })
      = DerivSpec theta
    -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    forall theta a. DerivSpec theta -> TcM a -> TcM a
    set_spec_span_and_ctxt DerivSpec theta
    spec (IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
     -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst])
    -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    forall a b. (a -> b) -> a -> b
    $
        case DerivSpecMechanism
    mechanism of
          -- See Note [GND and associated type families]
          DerivSpecNewtype { dsm_newtype_rep_ty :: DerivSpecMechanism -> Type
    dsm_newtype_rep_ty = Type
    rhs_ty}
            -> Type -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    gen_newtype_or_via Type
    rhs_ty

          -- Try a stock deriver
          DerivSpecStock { dsm_stock_dit :: DerivSpecMechanism -> DerivInstTys
    dsm_stock_dit = DerivInstTys
    dit
                         , dsm_stock_gen_fns :: DerivSpecMechanism -> StockGenFns
    dsm_stock_gen_fns =
                             StockGenFns { stock_gen_fam_insts :: StockGenFns
    -> SrcSpan
    -> DerivInstTys
    -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    stock_gen_fam_insts = SrcSpan -> DerivInstTys -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    gen_fn } }
            -> SrcSpan -> DerivInstTys -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    gen_fn SrcSpan
    loc DerivInstTys
    dit

          -- See Note [DeriveAnyClass and default family instances]
          DerivSpecMechanism
    DerivSpecAnyClass -> do
            let mini_env :: VarEnv Type
    mini_env   = [(TyVar, Type)] -> VarEnv Type
    forall a. [(TyVar, a)] -> VarEnv a
    mkVarEnv (Class -> [TyVar]
    classTyVars Class
    clas [TyVar] -> [Type] -> [(TyVar, Type)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Type]
    inst_tys)
                mini_subst :: Subst
    mini_subst = InScopeSet -> VarEnv Type -> Subst
    mkTvSubst ([TyVar] -> InScopeSet
    mkInScopeSetList [TyVar]
    tyvars) VarEnv Type
    mini_env
            dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            tyfam_insts <-
              -- canDeriveAnyClass should ensure that this code can't be reached
              -- unless -XDeriveAnyClass is enabled.
              assertPpr (xopt LangExt.DeriveAnyClass dflags)
                        (text "genFamInsts: bad derived class" <+> ppr clas) $
              mapM (tcATDefault loc mini_subst emptyNameSet)
                   (classATItems clas)
            pure $ concat tyfam_insts

          -- Try DerivingVia
          DerivSpecVia{dsm_via_ty :: DerivSpecMechanism -> Type
    dsm_via_ty = Type
    via_ty}
            -> Type -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    gen_newtype_or_via Type
    via_ty
      where
        gen_newtype_or_via :: Type -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    gen_newtype_or_via Type
    ty = SrcSpan
    -> Class
    -> [TyVar]
    -> [Type]
    -> Type
    -> IOEnv (Env TcGblEnv TcLclEnv) [FamInst]
    gen_Newtype_fam_insts SrcSpan
    loc Class
    clas [TyVar]
    tyvars [Type]
    inst_tys Type
    ty

    -- Set the SrcSpan and error context for an action that uses a DerivSpec.
    set_spec_span_and_ctxt :: DerivSpec theta -> TcM a -> TcM a
    set_spec_span_and_ctxt :: forall theta a. DerivSpec theta -> TcM a -> TcM a
    set_spec_span_and_ctxt (DS{ ds_loc :: forall theta. DerivSpec theta -> SrcSpan
    ds_loc = SrcSpan
    loc, ds_cls :: forall theta. DerivSpec theta -> Class
    ds_cls = Class
    clas, ds_tys :: forall theta. DerivSpec theta -> [Type]
    ds_tys = [Type]
    tys }) =
      SrcSpan -> TcRn a -> TcRn a
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcRn a -> TcRn a) -> (TcRn a -> TcRn a) -> TcRn a -> TcRn a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> TcRn a -> TcRn a
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (Class -> [Type] -> SDoc
    instDeclCtxt3 Class
    clas [Type]
    tys)

    -- Checks:
    --
    -- * All of the data constructors for a data type are in scope for a
    --   standalone-derived instance (for `stock` and `newtype` deriving).
    --
    -- * All of the associated type families of a class are suitable for
    --   GeneralizedNewtypeDeriving or DerivingVia (for `newtype` and `via`
    --   deriving).
    doDerivInstErrorChecks1 :: DerivSpecMechanism -> DerivM ()
    doDerivInstErrorChecks1 :: DerivSpecMechanism -> ReaderT DerivEnv TcRn ()
    doDerivInstErrorChecks1 DerivSpecMechanism
    mechanism =
      case DerivSpecMechanism
    mechanism of
        DerivSpecStock{dsm_stock_dit :: DerivSpecMechanism -> DerivInstTys
    dsm_stock_dit = DerivInstTys
    dit}
          -> DerivInstTys -> ReaderT DerivEnv TcRn ()
    data_cons_in_scope_check DerivInstTys
    dit
        -- No need to 'data_cons_in_scope_check' for newtype deriving.
        -- Additionally, we also don't need to mark the constructors as
        -- used because newtypes are handled separately elsewhere.
        -- See Note [Tracking unused binding and imports] in GHC.Tc.Types
        -- or #17328 for more.
        DerivSpecNewtype{}
          -> ReaderT DerivEnv TcRn ()
    atf_coerce_based_error_checks
        DerivSpecAnyClass{}
          -> () -> ReaderT DerivEnv TcRn ()
    forall a. a -> ReaderT DerivEnv TcRn a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        DerivSpecVia{}
          -> ReaderT DerivEnv TcRn ()
    atf_coerce_based_error_checks
      where
        -- When processing a standalone deriving declaration, check that all of the
        -- constructors for the data type are in scope. For instance:
        --
        --   import M (T)
        --   deriving stock instance Eq T
        --
        -- This should be rejected, as the derived Eq instance would need to refer
        -- to the constructors for T, which are not in scope.
        --
        -- Note that the only strategies that require this check are `stock` and
        -- `newtype`. Neither `anyclass` nor `via` require it as the code that they
        -- generate does not require using data constructors.
        data_cons_in_scope_check :: DerivInstTys -> DerivM ()
        data_cons_in_scope_check :: DerivInstTys -> ReaderT DerivEnv TcRn ()
    data_cons_in_scope_check (DerivInstTys { dit_tc :: DerivInstTys -> TyCon
    dit_tc     = TyCon
    tc
                                               , dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc = TyCon
    rep_tc }) = do
          standalone <- DerivM Bool
    isStandaloneDeriv
          when standalone $ do
            let bale_out DeriveInstanceErrReason
    msg = do err <- DerivSpecMechanism -> DeriveInstanceErrReason -> DerivM TcRnMessage
    derivingThingErrMechanism DerivSpecMechanism
    mechanism DeriveInstanceErrReason
    msg
                                  lift $ failWithTc err

            rdr_env <- lift getGlobalRdrEnv
            let data_con_names = (DataCon -> Name) -> [DataCon] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> Name
    dataConName (TyCon -> [DataCon]
    tyConDataCons TyCon
    rep_tc)
                hidden_data_cons = Bool -> Bool
    not (TyCon -> Bool
    forall thing. NamedThing thing => thing -> Bool
    isWiredIn TyCon
    rep_tc) Bool -> Bool -> Bool
    &&
                                   (TyCon -> Bool
    isAbstractTyCon TyCon
    rep_tc Bool -> Bool -> Bool
    ||
                                    (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Name -> Bool
    not_in_scope [Name]
    data_con_names)
                not_in_scope Name
    dc  = Maybe (GlobalRdrEltX GREInfo) -> Bool
    forall a. Maybe a -> Bool
    isNothing (GlobalRdrEnv -> Name -> Maybe (GlobalRdrEltX GREInfo)
    forall info.
    Outputable info =>
    GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
    lookupGRE_Name GlobalRdrEnv
    rdr_env Name
    dc)

            -- Make sure to also mark the data constructors as used so that GHC won't
            -- mistakenly emit -Wunused-imports warnings about them.
            lift $ addUsedDataCons rdr_env rep_tc

            unless (not hidden_data_cons) $
              bale_out $ DerivErrDataConsNotAllInScope tc

        -- Ensure that a class's associated type variables are suitable for
        -- GeneralizedNewtypeDeriving or DerivingVia. Unsurprisingly, this check is
        -- only required for the `newtype` and `via` strategies.
        --
        -- See Note [GND and associated type families]
        atf_coerce_based_error_checks :: DerivM ()
        atf_coerce_based_error_checks :: ReaderT DerivEnv TcRn ()
    atf_coerce_based_error_checks = do
          cls <- (DerivEnv -> Class) -> ReaderT DerivEnv TcRn Class
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks DerivEnv -> Class
    denv_cls
          let bale_out DeriveInstanceErrReason
    msg = do err <- DerivSpecMechanism -> DeriveInstanceErrReason -> DerivM TcRnMessage
    derivingThingErrMechanism DerivSpecMechanism
    mechanism DeriveInstanceErrReason
    msg
                                lift $ failWithTc err

              cls_tyvars = Class -> [TyVar]
    classTyVars Class
    cls

              ats_look_sensible
                 =  -- Check (a) from Note [GND and associated type families]
                    Bool
    no_adfs
                    -- Check (b) from Note [GND and associated type families]
                 Bool -> Bool -> Bool
    && Maybe TyCon -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe TyCon
    at_without_last_cls_tv
                    -- Check (d) from Note [GND and associated type families]
                 Bool -> Bool -> Bool
    && Maybe TyCon -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe TyCon
    at_last_cls_tv_in_kinds

              (adf_tcs, atf_tcs) = partition isDataFamilyTyCon at_tcs
              no_adfs            = [TyCon] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCon]
    adf_tcs
                     -- We cannot newtype-derive data family instances

              at_without_last_cls_tv
                = (TyCon -> Bool) -> [TyCon] -> Maybe TyCon
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\TyCon
    tc -> TyVar
    last_cls_tv TyVar -> [TyVar] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` TyCon -> [TyVar]
    tyConTyVars TyCon
    tc) [TyCon]
    atf_tcs
              at_last_cls_tv_in_kinds
                = (TyCon -> Bool) -> [TyCon] -> Maybe TyCon
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\TyCon
    tc -> (TyVar -> Bool) -> [TyVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> Bool
    at_last_cls_tv_in_kind (Type -> Bool) -> (TyVar -> Type) -> TyVar -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyVar -> Type
    tyVarKind)
                                   (TyCon -> [TyVar]
    tyConTyVars TyCon
    tc)
                            Bool -> Bool -> Bool
    || Type -> Bool
    at_last_cls_tv_in_kind (TyCon -> Type
    tyConResKind TyCon
    tc)) [TyCon]
    atf_tcs
              at_last_cls_tv_in_kind Type
    kind
                = TyVar
    last_cls_tv TyVar -> VarSet -> Bool
    `elemVarSet` Type -> VarSet
    exactTyCoVarsOfType Type
    kind
              at_tcs = Class -> [TyCon]
    classATs Class
    cls
              last_cls_tv = Bool -> ([TyVar] -> TyVar) -> [TyVar] -> TyVar
    forall a. HasCallStack => Bool -> a -> a
    assert ([TyVar] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [TyVar]
    cls_tyvars )
                            [TyVar] -> TyVar
    forall a. HasCallStack => [a] -> a
    last [TyVar]
    cls_tyvars

          unless ats_look_sensible $
            bale_out (DerivErrHasAssociatedDatatypes
                       (hasAssociatedDataFamInsts (not no_adfs))
                       (associatedTyLastVarInKind at_last_cls_tv_in_kinds)
                       (associatedTyNotParamOverLastTyVar at_without_last_cls_tv)
                     )

    doDerivInstErrorChecks2 :: Class -> ClsInst -> ThetaType -> Maybe SrcSpan
                            -> DerivSpecMechanism -> TcM ()
    doDerivInstErrorChecks2 :: Class
    -> ClsInst
    -> [Type]
    -> Maybe SrcSpan
    -> DerivSpecMechanism
    -> TcRn ()
    doDerivInstErrorChecks2 Class
    clas ClsInst
    clas_inst [Type]
    theta Maybe SrcSpan
    wildcard DerivSpecMechanism
    mechanism
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "doDerivInstErrorChecks2" (ClsInst -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ClsInst
    clas_inst)
           ; dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; xpartial_sigs <- xoptM LangExt.PartialTypeSignatures
           ; wpartial_sigs <- woptM Opt_WarnPartialTypeSignatures

             -- Error if PartialTypeSignatures isn't enabled when a user tries
             -- to write @deriving instance _ => Eq (Foo a)@. Or, if that
             -- extension is enabled, give a warning if -Wpartial-type-signatures
             -- is enabled.
           ; case wildcard of
               Maybe SrcSpan
    Nothing -> () -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
               Just SrcSpan
    span -> SrcSpan -> TcRn () -> TcRn ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    span (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ do
                 let suggParSigs :: SuggestPartialTypeSignatures
    suggParSigs = Bool -> SuggestPartialTypeSignatures
    suggestPartialTypeSignatures Bool
    xpartial_sigs
                 let dia :: TcRnMessage
    dia = SuggestPartialTypeSignatures -> [Type] -> TcRnMessage
    TcRnPartialTypeSignatures SuggestPartialTypeSignatures
    suggParSigs [Type]
    theta
                 Bool -> TcRnMessage -> TcRn ()
    checkTc Bool
    xpartial_sigs TcRnMessage
    dia
                 Bool -> TcRnMessage -> TcRn ()
    diagnosticTc Bool
    wpartial_sigs TcRnMessage
    dia

             -- Check for Generic instances that are derived with an exotic
             -- deriving strategy like DAC
             -- See Note [Deriving strategies]
           ; when (exotic_mechanism && className clas `elem` genericClassNames) $
             do { failIfTc (safeLanguageOn dflags)
                           (TcRnCannotDeriveInstance clas mempty Nothing NoGeneralizedNewtypeDeriving $
                              DerivErrSafeHaskellGenericInst)
                ; when (safeInferOn dflags) (recordUnsafeInfer emptyMessages) } }
      where
        exotic_mechanism :: Bool
    exotic_mechanism = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ DerivSpecMechanism -> Bool
    isDerivSpecStock DerivSpecMechanism
    mechanism

    derivingThingFailWith :: UsingGeneralizedNewtypeDeriving
                             -- ^ If 'YesGeneralizedNewtypeDeriving', add a snippet about
                             -- how not even GeneralizedNewtypeDeriving would make this
                             -- declaration work. This only kicks in when
                             -- an explicit deriving strategy is not given.
                          -> DeriveInstanceErrReason -- The reason the derivation failed
                          -> DerivM a
    derivingThingFailWith :: forall a.
    UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM a
    derivingThingFailWith UsingGeneralizedNewtypeDeriving
    newtype_deriving DeriveInstanceErrReason
    msg = do
      err <- UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM TcRnMessage
    derivingThingErrM UsingGeneralizedNewtypeDeriving
    newtype_deriving DeriveInstanceErrReason
    msg
      lift $ failWithTc err

    {-
    Note [Bindings for Generalised Newtype Deriving]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      class Eq a => C a where
         f :: a -> a
      newtype N a = MkN [a] deriving( C )
      instance Eq (N a) where ...

    The 'deriving C' clause generates, in effect
      instance (C [a], Eq a) => C (N a) where
         f = coerce (f :: [a] -> [a])

    This generates a cast for each method, but allows the superclasses to
    be worked out in the usual way.  In this case the superclass (Eq (N
    a)) will be solved by the explicit Eq (N a) instance.  We do *not*
    create the superclasses by casting the superclass dictionaries for the
    representation type.

    See the paper "Safe zero-cost coercions for Haskell".

    Note [DeriveAnyClass and default family instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When a class has a associated type family with a default instance, e.g.:

      class C a where
        type T a
        type T a = Char

    then there are a couple of scenarios in which a user would expect T a to
    default to Char. One is when an instance declaration for C is given without
    an implementation for T:

      instance C Int

    Another scenario in which this can occur is when the -XDeriveAnyClass extension
    is used:

      data Example = Example deriving (C, Generic)

    In the latter case, we must take care to check if C has any associated type
    families with default instances, because -XDeriveAnyClass will never provide
    an implementation for them. We "fill in" the default instances using the
    tcATDefault function from GHC.Tc.TyCl.Class (which is also used in GHC.Tc.TyCl.Instance to
    handle the empty instance declaration case).

    Note [Deriving strategies]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    GHC has a notion of deriving strategies, which allow the user to explicitly
    request which approach to use when deriving an instance (enabled with the
    -XDerivingStrategies language extension). For more information, refer to the
    original issue (#10598) or the associated wiki page:
    https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/deriving-strategies

    A deriving strategy can be specified in a deriving clause:

        newtype Foo = MkFoo Bar
          deriving newtype C

    Or in a standalone deriving declaration:

        deriving anyclass instance C Foo

    -XDerivingStrategies also allows the use of multiple deriving clauses per data
    declaration so that a user can derive some instance with one deriving strategy
    and other instances with another deriving strategy. For example:

        newtype Baz = Baz Quux
          deriving          (Eq, Ord)
          deriving stock    (Read, Show)
          deriving newtype  (Num, Floating)
          deriving anyclass C

    Currently, the deriving strategies are:

    * stock: Have GHC implement a "standard" instance for a data type, if possible
      (e.g., Eq, Ord, Generic, Data, Functor, etc.)

    * anyclass: Use -XDeriveAnyClass

    * newtype: Use -XGeneralizedNewtypeDeriving

    * via: Use -XDerivingVia

    The latter two strategies (newtype and via) are referred to as the
    "coerce-based" strategies, since they generate code that relies on the `coerce`
    function. See, for instance, GHC.Tc.Deriv.Infer.inferConstraintsCoerceBased.

    The former two strategies (stock and anyclass), in contrast, are
    referred to as the "originative" strategies, since they create "original"
    instances instead of "reusing" old instances (by way of `coerce`).
    See, for instance, GHC.Tc.Deriv.Utils.checkOriginativeSideConditions.

    If an explicit deriving strategy is not given, GHC has an algorithm it uses to
    determine which strategy it will actually use. The algorithm is quite long,
    so it lives in the Haskell wiki at
    https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/deriving-strategies
    ("The deriving strategy resolution algorithm" section).

    Internally, GHC uses the DerivStrategy datatype to denote a user-requested
    deriving strategy, and it uses the DerivSpecMechanism datatype to denote what
    GHC will use to derive the instance after taking the above steps. In other
    words, GHC will always settle on a DerivSpecMechnism, even if the user did not
    ask for a particular DerivStrategy (using the algorithm linked to above).

    Note [Deriving instances for classes themselves]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Much of the code in GHC.Tc.Deriv assumes that deriving only works on data types.
    But this assumption doesn't hold true for DeriveAnyClass, since it's perfectly
    reasonable to do something like this:

      {-# LANGUAGE DeriveAnyClass #-}
      class C1 (a :: Constraint) where
      class C2 where
      deriving instance C1 C2
        -- This is equivalent to `instance C1 C2`

    If DeriveAnyClass isn't enabled in the code above (i.e., it defaults to stock
    deriving), we throw a special error message indicating that DeriveAnyClass is
    the only way to go. We don't bother throwing this error if an explicit 'stock'
    or 'newtype' keyword is used, since both options have their own perfectly
    sensible error messages in the case of the above code (as C1 isn't a stock
    derivable class, and C2 isn't a newtype).

    ************************************************************************
    *                                                                      *
    What con2tag/tag2con functions are available?
    *                                                                      *
    ************************************************************************
    -}

    derivingThingErrM :: UsingGeneralizedNewtypeDeriving
                      -> DeriveInstanceErrReason
                      -> DerivM TcRnMessage
    derivingThingErrM :: UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason -> DerivM TcRnMessage
    derivingThingErrM UsingGeneralizedNewtypeDeriving
    newtype_deriving DeriveInstanceErrReason
    why
      = do DerivEnv { denv_cls      = cls
                    , denv_inst_tys = cls_args
                    , denv_strat    = mb_strat } <- ReaderT DerivEnv TcRn DerivEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
           pure $ TcRnCannotDeriveInstance cls cls_args mb_strat newtype_deriving why

    derivingThingErrMechanism :: DerivSpecMechanism -> DeriveInstanceErrReason -> DerivM TcRnMessage
    derivingThingErrMechanism :: DerivSpecMechanism -> DeriveInstanceErrReason -> DerivM TcRnMessage
    derivingThingErrMechanism DerivSpecMechanism
    mechanism DeriveInstanceErrReason
    why
      = do DerivEnv { denv_cls      = cls
                    , denv_inst_tys = cls_args
                    , denv_strat    = mb_strat } <- ReaderT DerivEnv TcRn DerivEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
           pure $ TcRnCannotDeriveInstance cls cls_args mb_strat newtype_deriving why
      where
        newtype_deriving :: UsingGeneralizedNewtypeDeriving
        newtype_deriving :: UsingGeneralizedNewtypeDeriving
    newtype_deriving
          = if DerivSpecMechanism -> Bool
    isDerivSpecNewtype DerivSpecMechanism
    mechanism then UsingGeneralizedNewtypeDeriving
    YesGeneralizedNewtypeDeriving
                                            else UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving

    standaloneCtxt :: LHsSigWcType GhcRn -> SDoc
    standaloneCtxt :: LHsSigWcType GhcRn -> SDoc
    standaloneCtxt LHsSigWcType GhcRn
    ty = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "In the stand-alone deriving instance for")
                           Int
    2 (SDoc -> SDoc
    quotes (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigWcType GhcRn
    HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    ty))