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

    -}

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

    -- | Error-checking and other utilities for @deriving@ clauses or declarations.
    module GHC.Tc.Deriv.Utils (
            DerivM, DerivEnv(..),
            DerivSpec(..), pprDerivSpec, setDerivSpecTheta, zonkDerivSpec,
            DerivSpecMechanism(..), derivSpecMechanismToStrategy, isDerivSpecStock,
            isDerivSpecNewtype, isDerivSpecAnyClass,
            isDerivSpecVia, zonkDerivSpecMechanism,
            DerivContext(..), OriginativeDerivStatus(..), StockGenFns(..),
            isStandaloneDeriv, isStandaloneWildcardDeriv,
            askDerivUserTypeCtxt, mkDerivOrigin,
            PredSpec(..), ThetaSpec,
            mkDirectThetaSpec, substPredSpec, captureThetaSpecConstraints,
            checkOriginativeSideConditions, hasStockDeriving,
            std_class_via_coercible, non_coercible_class,
            newDerivClsInst, extendLocalInstEnv
        ) where

    import GHC.Prelude

    import GHC.Hs.Extension
    import GHC.Data.Bag
    import GHC.Types.Basic

    import GHC.Tc.Utils.Instantiate
    import GHC.Tc.Deriv.Generate
    import GHC.Tc.Deriv.Functor
    import GHC.Tc.Deriv.Generics
    import GHC.Tc.Errors.Types
    import GHC.Tc.Types.Constraint (WantedConstraints, mkNonCanonical)
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Utils.Unify (tcSubTypeSigma)
    import GHC.Tc.Zonk.Type

    import GHC.Core.Class
    import GHC.Core.DataCon
    import GHC.Core.FamInstEnv
    import GHC.Core.InstEnv
    import GHC.Core.TyCon
    import GHC.Core.Type

    import GHC.Hs
    import GHC.Driver.Session
    import GHC.Unit.Module (getModule)
    import GHC.Unit.Module.Warnings
    import GHC.Unit.Module.ModIface (mi_fix)

    import GHC.Types.Fixity.Env (lookupFixity)
    import GHC.Iface.Load   (loadInterfaceForName)
    import GHC.Types.Name
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Types.Var.Set

    import GHC.Builtin.Names
    import GHC.Builtin.Names.TH (liftClassKey)

    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Error
    import GHC.Utils.Unique (sameUnique)

    import Control.Monad.Trans.Reader
    import Data.Foldable (traverse_)
    import Data.Maybe
    import qualified GHC.LanguageExtensions as LangExt
    import GHC.Data.List.SetOps (assocMaybe)

    -- | To avoid having to manually plumb everything in 'DerivEnv' throughout
    -- various functions in "GHC.Tc.Deriv" and "GHC.Tc.Deriv.Infer", we use 'DerivM', which
    -- is a simple reader around 'TcRn'.
    type DerivM = ReaderT DerivEnv TcRn

    -- | Is GHC processing a standalone deriving declaration?
    isStandaloneDeriv :: DerivM Bool
    isStandaloneDeriv :: DerivM Bool
    isStandaloneDeriv = (DerivEnv -> Bool) -> DerivM Bool
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks (DerivContext -> Bool
    go (DerivContext -> Bool)
    -> (DerivEnv -> DerivContext) -> DerivEnv -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DerivEnv -> DerivContext
    denv_ctxt)
      where
        go :: DerivContext -> Bool
        go :: DerivContext -> Bool
    go (InferContext Maybe SrcSpan
    wildcard) = Maybe SrcSpan -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe SrcSpan
    wildcard
        go (SupplyContext {})      = Bool
    True

    -- | Is GHC processing a standalone deriving declaration with an
    -- extra-constraints wildcard as the context?
    -- (e.g., @deriving instance _ => Eq (Foo a)@)
    isStandaloneWildcardDeriv :: DerivM Bool
    isStandaloneWildcardDeriv :: DerivM Bool
    isStandaloneWildcardDeriv = (DerivEnv -> Bool) -> DerivM Bool
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks (DerivContext -> Bool
    go (DerivContext -> Bool)
    -> (DerivEnv -> DerivContext) -> DerivEnv -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DerivEnv -> DerivContext
    denv_ctxt)
      where
        go :: DerivContext -> Bool
        go :: DerivContext -> Bool
    go (InferContext Maybe SrcSpan
    wildcard) = Maybe SrcSpan -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe SrcSpan
    wildcard
        go (SupplyContext {})      = Bool
    False

    -- | Return 'InstDeclCtxt' if processing with a standalone @deriving@
    -- declaration or 'DerivClauseCtxt' if processing a @deriving@ clause.
    askDerivUserTypeCtxt :: DerivM UserTypeCtxt
    askDerivUserTypeCtxt :: DerivM UserTypeCtxt
    askDerivUserTypeCtxt = (DerivEnv -> UserTypeCtxt) -> DerivM UserTypeCtxt
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks (DerivContext -> UserTypeCtxt
    go (DerivContext -> UserTypeCtxt)
    -> (DerivEnv -> DerivContext) -> DerivEnv -> UserTypeCtxt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DerivEnv -> DerivContext
    denv_ctxt)
      where
        go :: DerivContext -> UserTypeCtxt
        go :: DerivContext -> UserTypeCtxt
    go (SupplyContext {})     = Bool -> UserTypeCtxt
    InstDeclCtxt Bool
    True
        go (InferContext Just{})  = Bool -> UserTypeCtxt
    InstDeclCtxt Bool
    True
        go (InferContext Maybe SrcSpan
    Nothing) = UserTypeCtxt
    DerivClauseCtxt

    -- | @'mkDerivOrigin' wc@ returns 'StandAloneDerivOrigin' if @wc@ is 'True',
    -- and 'DerivClauseOrigin' if @wc@ is 'False'. Useful for error-reporting.
    mkDerivOrigin :: Bool -> CtOrigin
    mkDerivOrigin :: Bool -> CtOrigin
    mkDerivOrigin Bool
    standalone_wildcard
      | Bool
    standalone_wildcard = CtOrigin
    StandAloneDerivOrigin
      | Bool
    otherwise           = CtOrigin
    DerivClauseOrigin

    -- | Contains all of the information known about a derived instance when
    -- determining what its @EarlyDerivSpec@ should be.
    -- See @Note [DerivEnv and DerivSpecMechanism]@.
    data DerivEnv = DerivEnv
      { DerivEnv -> Maybe OverlapMode
    denv_overlap_mode :: Maybe OverlapMode
        -- ^ Is this an overlapping instance?
      , DerivEnv -> [TyVar]
    denv_tvs          :: [TyVar]
        -- ^ Universally quantified type variables in the instance. If the
        --   @denv_ctxt@ is 'InferContext', these will be 'TcTyVar' skolems.
        --   If the @denv_ctxt@ is 'SupplyContext', these will be ordinary 'TyVar's.
        --   See @Note [Overlap and deriving]@ in "GHC.Tc.Deriv.Infer".
        --
        --   All type variables that appear in the 'denv_inst_tys', 'denv_ctxt',
        --   'denv_skol_info', and 'denv_strat' should come from 'denv_tvs'.
      , DerivEnv -> Class
    denv_cls          :: Class
        -- ^ Class for which we need to derive an instance
      , DerivEnv -> [Type]
    denv_inst_tys     :: [Type]
        -- ^ All arguments to 'denv_cls' in the derived instance.
      , DerivEnv -> DerivContext
    denv_ctxt         :: DerivContext
        -- ^ @'SupplyContext' theta@ for standalone deriving (where @theta@ is the
        --   context of the instance).
        --   'InferContext' for @deriving@ clauses, or for standalone deriving that
        --   uses a wildcard constraint.
        --   See @Note [Inferring the instance context]@.
      , DerivEnv -> SkolemInfo
    denv_skol_info    :: SkolemInfo
        -- ^ The 'SkolemInfo' used to skolemise the @denv_tvs@ in the case where
        --   the 'denv_ctxt' is 'InferContext'.
      , DerivEnv -> Maybe (DerivStrategy GhcTc)
    denv_strat        :: Maybe (DerivStrategy GhcTc)
        -- ^ 'Just' if user requests a particular deriving strategy.
        --   Otherwise, 'Nothing'.
      , DerivEnv -> Maybe (WarningTxt GhcRn)
    denv_warn         :: Maybe (WarningTxt GhcRn)
        -- ^ A warning to emit whenever the derived instance is used
      }

    instance Outputable DerivEnv where
      ppr :: DerivEnv -> SDoc
    ppr (DerivEnv { denv_overlap_mode :: DerivEnv -> Maybe OverlapMode
    denv_overlap_mode = Maybe OverlapMode
    overlap_mode
                    , denv_tvs :: DerivEnv -> [TyVar]
    denv_tvs          = [TyVar]
    tvs
                    , denv_cls :: DerivEnv -> Class
    denv_cls          = Class
    cls
                    , denv_inst_tys :: DerivEnv -> [Type]
    denv_inst_tys     = [Type]
    inst_tys
                    , denv_ctxt :: DerivEnv -> DerivContext
    denv_ctxt         = DerivContext
    ctxt
                    , denv_skol_info :: DerivEnv -> SkolemInfo
    denv_skol_info    = SkolemInfo
    skol_info
                    , denv_strat :: DerivEnv -> Maybe (DerivStrategy GhcTc)
    denv_strat        = Maybe (DerivStrategy GhcTc)
    mb_strat })
        = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DerivEnv")
             Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "denv_overlap_mode" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe OverlapMode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe OverlapMode
    overlap_mode
                     , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "denv_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
    "denv_cls"          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls
                     , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "denv_inst_tys"     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    inst_tys
                     , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "denv_ctxt"         SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> DerivContext -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DerivContext
    ctxt
                     , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "denv_skol_info"    SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info
                     , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "denv_strat"        SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe (DerivStrategy GhcTc) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe (DerivStrategy GhcTc)
    mb_strat ])

    data DerivSpec theta = DS { forall theta. DerivSpec theta -> SrcSpan
    ds_loc                 :: SrcSpan
                              , forall theta. DerivSpec theta -> Name
    ds_name                :: Name         -- DFun name
                              , forall theta. DerivSpec theta -> [TyVar]
    ds_tvs                 :: [TyVar]
                              , forall theta. DerivSpec theta -> theta
    ds_theta               :: theta
                              , forall theta. DerivSpec theta -> Class
    ds_cls                 :: Class
                              , forall theta. DerivSpec theta -> [Type]
    ds_tys                 :: [Type]
                              , forall theta. DerivSpec theta -> SkolemInfo
    ds_skol_info           :: SkolemInfo
                              , forall theta. DerivSpec theta -> UserTypeCtxt
    ds_user_ctxt           :: UserTypeCtxt
                              , forall theta. DerivSpec theta -> Maybe OverlapMode
    ds_overlap             :: Maybe OverlapMode
                              , forall theta. DerivSpec theta -> Maybe SrcSpan
    ds_standalone_wildcard :: Maybe SrcSpan
                                  -- See Note [Inferring the instance context]
                                  -- in GHC.Tc.Deriv.Infer
                              , forall theta. DerivSpec theta -> DerivSpecMechanism
    ds_mechanism           :: DerivSpecMechanism
                              , forall theta. DerivSpec theta -> Maybe (WarningTxt GhcRn)
    ds_warn                :: Maybe (WarningTxt GhcRn)}
            -- This spec implies a dfun declaration of the form
            --       df :: forall tvs. theta => C tys
            -- The Name is the name for the DFun we'll build
            -- The tyvars bind all the variables in the rest of the DerivSpec.
            -- If we are inferring an instance context, the tyvars will be TcTyVar
            -- skolems. After the instance context inference is over, the tyvars
            -- will be zonked to TyVars. See
            -- Note [Overlap and deriving] in GHC.Tc.Deriv.Infer.

            -- the theta is either the given and final theta, in standalone deriving,
            -- or the not-yet-simplified list of constraints together with their origin

            -- The ds_skol_info is the SkolemInfo that was used to skolemise the
            -- TcTyVars (if we are inferring an instance context). The ds_user_ctxt
            -- is the UserTypeCtxt that allows error messages to know if we are in
            -- a deriving clause or a standalone deriving declaration.

            -- ds_mechanism specifies the means by which GHC derives the instance.
            -- See Note [Deriving strategies] in GHC.Tc.Deriv

    {-
    Example:

         newtype instance T [a] = MkT (Tree a) deriving( C s )
    ==>
         axiom T [a] = :RTList a
         axiom :RTList a = Tree a

         DS { ds_tvs = [a,s], ds_cls = C, ds_tys = [s, T [a]]
            , ds_mechanism = DerivSpecNewtype (Tree a) }
    -}

    pprDerivSpec :: Outputable theta => DerivSpec theta -> SDoc
    pprDerivSpec :: forall theta. Outputable theta => DerivSpec theta -> SDoc
    pprDerivSpec (DS { ds_loc :: forall theta. DerivSpec theta -> SrcSpan
    ds_loc = SrcSpan
    l, ds_name :: forall theta. DerivSpec theta -> Name
    ds_name = Name
    n, ds_tvs :: forall theta. DerivSpec theta -> [TyVar]
    ds_tvs = [TyVar]
    tvs, ds_cls :: forall theta. DerivSpec theta -> Class
    ds_cls = Class
    c,
                       ds_tys :: forall theta. DerivSpec theta -> [Type]
    ds_tys = [Type]
    tys, ds_theta :: forall theta. DerivSpec theta -> theta
    ds_theta = theta
    rhs, ds_skol_info :: forall theta. DerivSpec theta -> SkolemInfo
    ds_skol_info = SkolemInfo
    skol_info,
                       ds_standalone_wildcard :: forall theta. DerivSpec theta -> Maybe SrcSpan
    ds_standalone_wildcard = Maybe SrcSpan
    wildcard, ds_mechanism :: forall theta. DerivSpec theta -> DerivSpecMechanism
    ds_mechanism = DerivSpecMechanism
    mech })
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DerivSpec")
           Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ds_loc                  =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    l
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ds_name                 =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ds_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
    "ds_cls                  =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    c
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ds_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
    "ds_theta                =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> theta -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr theta
    rhs
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ds_skol_info            =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ds_standalone_wildcard  =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe SrcSpan
    wildcard
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ds_mechanism            =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> DerivSpecMechanism -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DerivSpecMechanism
    mech ])

    instance Outputable theta => Outputable (DerivSpec theta) where
      ppr :: DerivSpec theta -> SDoc
    ppr = DerivSpec theta -> SDoc
    forall theta. Outputable theta => DerivSpec theta -> SDoc
    pprDerivSpec

    -- | Set the 'ds_theta' in a 'DerivSpec'.
    setDerivSpecTheta :: theta' -> DerivSpec theta -> DerivSpec theta'
    setDerivSpecTheta :: forall theta' theta. theta' -> DerivSpec theta -> DerivSpec theta'
    setDerivSpecTheta theta'
    theta DerivSpec theta
    ds = DerivSpec theta
    ds{ds_theta = theta}

    -- | Zonk the 'TcTyVar's in a 'DerivSpec' to 'TyVar's.
    -- See @Note [What is zonking?]@ in "GHC.Tc.Zonk.Type".
    --
    -- This is only used in the final zonking step when inferring
    -- the context for a derived instance.
    -- See @Note [Overlap and deriving]@ in "GHC.Tc.Deriv.Infer".
    zonkDerivSpec :: DerivSpec ThetaType -> ZonkTcM (DerivSpec ThetaType)
    zonkDerivSpec :: DerivSpec [Type] -> ZonkTcM (DerivSpec [Type])
    zonkDerivSpec ds :: DerivSpec [Type]
    ds@(DS { ds_tvs :: forall theta. DerivSpec theta -> [TyVar]
    ds_tvs = [TyVar]
    tvs, ds_theta :: forall theta. DerivSpec theta -> theta
    ds_theta = [Type]
    theta
                         , ds_tys :: forall theta. DerivSpec theta -> [Type]
    ds_tys = [Type]
    tys, ds_mechanism :: forall theta. DerivSpec theta -> DerivSpecMechanism
    ds_mechanism = DerivSpecMechanism
    mechanism
                         }) =
      ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [TyVar]
    -> forall r.
       ([TyVar] -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
       -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
    forall (m :: * -> *) a.
    ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
    runZonkBndrT ([TyVar] -> ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [TyVar]
    zonkTyBndrsX [TyVar]
    tvs) (([TyVar] -> ZonkTcM (DerivSpec [Type]))
     -> ZonkTcM (DerivSpec [Type]))
    -> ([TyVar] -> ZonkTcM (DerivSpec [Type]))
    -> ZonkTcM (DerivSpec [Type])
    forall a b. (a -> b) -> a -> b
    $ \ [TyVar]
    tvs' -> do
        theta'     <- [Type] -> ZonkTcM [Type]
    zonkTcTypesToTypesX [Type]
    theta
        tys'       <- zonkTcTypesToTypesX tys
        mechanism' <- zonkDerivSpecMechanism mechanism
        pure ds{ ds_tvs = tvs', ds_theta = theta'
               , ds_tys = tys', ds_mechanism = mechanism'
               }

    -- | What action to take in order to derive a class instance.
    -- See @Note [DerivEnv and DerivSpecMechanism]@, as well as
    -- @Note [Deriving strategies]@ in "GHC.Tc.Deriv".
    data DerivSpecMechanism
        -- | \"Standard\" classes
      = DerivSpecStock
        { DerivSpecMechanism -> DerivInstTys
    dsm_stock_dit    :: DerivInstTys
          -- ^ Information about the arguments to the class in the derived
          -- instance, including what type constructor the last argument is
          -- headed by. See @Note [DerivEnv and DerivSpecMechanism]@.
        , DerivSpecMechanism -> StockGenFns
    dsm_stock_gen_fns :: StockGenFns
          -- ^ How to generate the instance bindings and associated type family
          -- instances.
        }

        -- | @GeneralizedNewtypeDeriving@
      | DerivSpecNewtype
        { DerivSpecMechanism -> DerivInstTys
    dsm_newtype_dit    :: DerivInstTys
          -- ^ Information about the arguments to the class in the derived
          -- instance, including what type constructor the last argument is
          -- headed by. See @Note [DerivEnv and DerivSpecMechanism]@.
        , DerivSpecMechanism -> Type
    dsm_newtype_rep_ty :: Type
          -- ^ The newtype rep type.
        }

        -- | @DeriveAnyClass@
      | DerivSpecAnyClass

        -- | @DerivingVia@
      | DerivSpecVia
        { DerivSpecMechanism -> [Type]
    dsm_via_cls_tys :: [Type]
          -- ^ All arguments to the class besides the last one.
        , DerivSpecMechanism -> Type
    dsm_via_inst_ty :: Type
          -- ^ The last argument to the class.
        , DerivSpecMechanism -> Type
    dsm_via_ty      :: Type
          -- ^ The @via@ type
        }

    -- | Convert a 'DerivSpecMechanism' to its corresponding 'DerivStrategy'.
    derivSpecMechanismToStrategy :: DerivSpecMechanism -> DerivStrategy GhcTc
    derivSpecMechanismToStrategy :: DerivSpecMechanism -> DerivStrategy GhcTc
    derivSpecMechanismToStrategy DerivSpecStock{}      = XStockStrategy GhcTc -> DerivStrategy GhcTc
    forall pass. XStockStrategy pass -> DerivStrategy pass
    StockStrategy XStockStrategy GhcTc
    NoExtField
    noExtField
    derivSpecMechanismToStrategy DerivSpecNewtype{}    = XNewtypeStrategy GhcTc -> DerivStrategy GhcTc
    forall pass. XNewtypeStrategy pass -> DerivStrategy pass
    NewtypeStrategy XNewtypeStrategy GhcTc
    NoExtField
    noExtField
    derivSpecMechanismToStrategy DerivSpecMechanism
    DerivSpecAnyClass     = XAnyClassStrategy GhcTc -> DerivStrategy GhcTc
    forall pass. XAnyClassStrategy pass -> DerivStrategy pass
    AnyclassStrategy XAnyClassStrategy GhcTc
    NoExtField
    noExtField
    derivSpecMechanismToStrategy (DerivSpecVia{dsm_via_ty :: DerivSpecMechanism -> Type
    dsm_via_ty = Type
    t}) = XViaStrategy GhcTc -> DerivStrategy GhcTc
    forall pass. XViaStrategy pass -> DerivStrategy pass
    ViaStrategy XViaStrategy GhcTc
    Type
    t

    isDerivSpecStock, isDerivSpecNewtype, isDerivSpecAnyClass, isDerivSpecVia
      :: DerivSpecMechanism -> Bool
    isDerivSpecStock :: DerivSpecMechanism -> Bool
    isDerivSpecStock (DerivSpecStock{}) = Bool
    True
    isDerivSpecStock DerivSpecMechanism
    _                  = Bool
    False

    isDerivSpecNewtype :: DerivSpecMechanism -> Bool
    isDerivSpecNewtype (DerivSpecNewtype{}) = Bool
    True
    isDerivSpecNewtype DerivSpecMechanism
    _                    = Bool
    False

    isDerivSpecAnyClass :: DerivSpecMechanism -> Bool
    isDerivSpecAnyClass DerivSpecMechanism
    DerivSpecAnyClass = Bool
    True
    isDerivSpecAnyClass DerivSpecMechanism
    _                 = Bool
    False

    isDerivSpecVia :: DerivSpecMechanism -> Bool
    isDerivSpecVia (DerivSpecVia{}) = Bool
    True
    isDerivSpecVia DerivSpecMechanism
    _                = Bool
    False

    -- | Zonk the 'TcTyVar's in a 'DerivSpecMechanism' to 'TyVar's.
    -- See @Note [What is zonking?]@ in "GHC.Tc.Zonk.Type".
    --
    -- This is only used in the final zonking step when inferring
    -- the context for a derived instance.
    -- See @Note [Overlap and deriving]@ in "GHC.Tc.Deriv.Infer".
    zonkDerivSpecMechanism :: DerivSpecMechanism -> ZonkTcM DerivSpecMechanism
    zonkDerivSpecMechanism :: DerivSpecMechanism -> ZonkTcM DerivSpecMechanism
    zonkDerivSpecMechanism DerivSpecMechanism
    mechanism =
      case DerivSpecMechanism
    mechanism of
        DerivSpecStock { dsm_stock_dit :: DerivSpecMechanism -> DerivInstTys
    dsm_stock_dit     = DerivInstTys
    dit
                       , dsm_stock_gen_fns :: DerivSpecMechanism -> StockGenFns
    dsm_stock_gen_fns = StockGenFns
    gen_fns
                       } -> do
          dit' <- DerivInstTys -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) DerivInstTys
    zonkDerivInstTys DerivInstTys
    dit
          pure $ DerivSpecStock { dsm_stock_dit     = dit'
                                , dsm_stock_gen_fns = gen_fns
                                }
        DerivSpecNewtype { dsm_newtype_dit :: DerivSpecMechanism -> DerivInstTys
    dsm_newtype_dit    = DerivInstTys
    dit
                         , dsm_newtype_rep_ty :: DerivSpecMechanism -> Type
    dsm_newtype_rep_ty = Type
    rep_ty
                         } -> do
          dit'    <- DerivInstTys -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) DerivInstTys
    zonkDerivInstTys DerivInstTys
    dit
          rep_ty' <- zonkTcTypeToTypeX rep_ty
          pure $ DerivSpecNewtype { dsm_newtype_dit    = dit'
                                  , dsm_newtype_rep_ty = rep_ty'
                                  }
        DerivSpecMechanism
    DerivSpecAnyClass ->
          DerivSpecMechanism -> ZonkTcM DerivSpecMechanism
    forall a. a -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DerivSpecMechanism
    DerivSpecAnyClass
        DerivSpecVia { dsm_via_cls_tys :: DerivSpecMechanism -> [Type]
    dsm_via_cls_tys = [Type]
    cls_tys
                     , dsm_via_inst_ty :: DerivSpecMechanism -> Type
    dsm_via_inst_ty = Type
    inst_ty
                     , dsm_via_ty :: DerivSpecMechanism -> Type
    dsm_via_ty      = Type
    via_ty
                     } -> do
          cls_tys' <- [Type] -> ZonkTcM [Type]
    zonkTcTypesToTypesX [Type]
    cls_tys
          inst_ty' <- zonkTcTypeToTypeX inst_ty
          via_ty'  <- zonkTcTypeToTypeX via_ty
          pure $ DerivSpecVia { dsm_via_cls_tys = cls_tys'
                              , dsm_via_inst_ty = inst_ty'
                              , dsm_via_ty      = via_ty'
                              }

    instance Outputable DerivSpecMechanism where
      ppr :: DerivSpecMechanism -> SDoc
    ppr (DerivSpecStock{dsm_stock_dit :: DerivSpecMechanism -> DerivInstTys
    dsm_stock_dit = DerivInstTys
    dit})
        = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DerivSpecStock")
             Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dsm_stock_dit" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> DerivInstTys -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DerivInstTys
    dit ])
      ppr (DerivSpecNewtype { dsm_newtype_dit :: DerivSpecMechanism -> DerivInstTys
    dsm_newtype_dit = DerivInstTys
    dit, dsm_newtype_rep_ty :: DerivSpecMechanism -> Type
    dsm_newtype_rep_ty = Type
    rep_ty })
        = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DerivSpecNewtype")
             Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dsm_newtype_dit"    SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> DerivInstTys -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DerivInstTys
    dit
                     , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dsm_newtype_rep_ty" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    rep_ty ])
      ppr DerivSpecMechanism
    DerivSpecAnyClass = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DerivSpecAnyClass"
      ppr (DerivSpecVia { dsm_via_cls_tys :: DerivSpecMechanism -> [Type]
    dsm_via_cls_tys = [Type]
    cls_tys, dsm_via_inst_ty :: DerivSpecMechanism -> Type
    dsm_via_inst_ty = Type
    inst_ty
                        , dsm_via_ty :: DerivSpecMechanism -> Type
    dsm_via_ty = Type
    via_ty })
        = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DerivSpecVia")
             Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dsm_via_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
    "dsm_via_inst_ty" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    inst_ty
                     , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dsm_via_ty"      SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    via_ty ])

    {-
    Note [DerivEnv and DerivSpecMechanism]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    DerivEnv contains all of the bits and pieces that are common to every
    deriving strategy. (See Note [Deriving strategies] in GHC.Tc.Deriv.) Some deriving
    strategies impose stricter requirements on the types involved in the derived
    instance than others, and these differences are factored out into the
    DerivSpecMechanism type. Suppose that the derived instance looks like this:

      instance ... => C arg_1 ... arg_n

    Each deriving strategy imposes restrictions on arg_1 through arg_n as follows:

    * stock (DerivSpecStock):

      Stock deriving requires that:

      - n must be a positive number. This is checked by
        GHC.Tc.Deriv.expectNonNullaryClsArgs
      - arg_n must be an application of an algebraic type constructor. Here,
        "algebraic type constructor" means:

        + An ordinary data type constructor, or
        + A data family type constructor such that the arguments it is applied to
          give rise to a data family instance.

        This is checked by GHC.Tc.Deriv.expectAlgTyConApp.

      This extra structure is witnessed by the DerivInstTys data type, which stores
      arg_1 through arg_(n-1) (dit_cls_tys), the algebraic type constructor
      (dit_tc), and its arguments (dit_tc_args). A DerivInstTys value can be seen
      as a more structured representation of the denv_inst_tys field of DerivEnv.

      If dit_tc is an ordinary data type constructor, then
      dit_rep_tc/dit_rep_tc_args are the same as dit_tc/dit_tc_args. If dit_tc is a
      data family type constructor, then dit_rep_tc is the representation type
      constructor for the data family instance, and dit_rep_tc_args are the
      arguments to the representation type constructor in the corresponding
      instance.

    * newtype (DerivSpecNewtype):

      Newtype deriving imposes the same DerivInstTys requirements as stock
      deriving. This is necessary because we need to know what the underlying type
      that the newtype wraps is, and this information can only be learned by
      knowing dit_rep_tc.

    * anyclass (DerivSpecAnyclass):

      DeriveAnyClass is the most permissive deriving strategy of all, as it
      essentially imposes no requirements on the derived instance. This is because
      DeriveAnyClass simply derives an empty instance, so it does not need any
      particular knowledge about the types involved. It can do several things
      that stock/newtype deriving cannot do (#13154):

      - n can be 0. That is, one is allowed to anyclass-derive an instance with
        no arguments to the class, such as in this example:

          class C
          deriving anyclass instance C

      - One can derive an instance for a type that is not headed by a type
        constructor, such as in the following example:

          class C (n :: Nat)
          deriving instance C 0
          deriving instance C 1
          ...

      - One can derive an instance for a data family with no data family instances,
        such as in the following example:

          data family Foo a
          class C a
          deriving anyclass instance C (Foo a)

    * via (DerivSpecVia):

      Like newtype deriving, DerivingVia requires that n must be a positive number.
      This is because when one derives something like this:

        deriving via Foo instance C Bar

      Then the generated code must specifically mention Bar. However, in
      contrast with newtype deriving, DerivingVia does *not* require Bar to be
      an application of an algebraic type constructor. This is because the
      generated code simply defers to invoking `coerce`, which does not need to
      know anything in particular about Bar (besides that it is representationally
      equal to Foo). This allows DerivingVia to do some things that are not
      possible with newtype deriving, such as deriving instances for data families
      without data instances (#13154):

        data family Foo a
        newtype ByBar a = ByBar a
        class Baz a where ...
        instance Baz (ByBar a) where ...
        deriving via ByBar (Foo a) instance Baz (Foo a)
    -}

    -- | Whether GHC is processing a @deriving@ clause or a standalone deriving
    -- declaration.
    data DerivContext
      = InferContext (Maybe SrcSpan) -- ^ @'InferContext mb_wildcard@ is either:
                                     --
                                     -- * A @deriving@ clause (in which case
                                     --   @mb_wildcard@ is 'Nothing').
                                     --
                                     -- * A standalone deriving declaration with
                                     --   an extra-constraints wildcard as the
                                     --   context (in which case @mb_wildcard@ is
                                     --   @'Just' loc@, where @loc@ is the location
                                     --   of the wildcard.
                                     --
                                     -- GHC should infer the context.

      | SupplyContext ThetaType      -- ^ @'SupplyContext' theta@ is a standalone
                                     -- deriving declaration, where @theta@ is the
                                     -- context supplied by the user.

    instance Outputable DerivContext where
      ppr :: DerivContext -> SDoc
    ppr (InferContext Maybe SrcSpan
    standalone) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "InferContext"  SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe SrcSpan
    standalone
      ppr (SupplyContext [Type]
    theta)     = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SupplyContext" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    theta

    -- | Records whether a particular class can be derived by way of an
    -- /originative/ deriving strategy (i.e., @stock@ or @anyclass@).
    --
    -- See @Note [Deriving strategies]@ in "GHC.Tc.Deriv".
    data OriginativeDerivStatus
      = CanDeriveStock StockGenFns -- Stock class, can derive
      | StockClassError !DeriveInstanceErrReason -- Stock class, but can't do it
      | CanDeriveAnyClass         -- See Note [Deriving any class]
      | NonDerivableClass -- Cannot derive with either stock or anyclass

    -- | Describes how to generate instance bindings ('stock_gen_binds') and
    -- associated type family instances ('stock_gen_fam_insts') for a particular
    -- stock-derived instance.
    data StockGenFns = StockGenFns
      { StockGenFns
    -> SrcSpan
    -> DerivInstTys
    -> TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    stock_gen_binds ::
             SrcSpan -> DerivInstTys
          -> TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
        -- ^ Describes how to generate instance bindings for a stock-derived
        -- instance.
        --
        -- This function takes two arguments:
        --
        -- 1. 'SrcSpan': the source location where the instance is being derived.
        --    This will eventually be instantiated with the 'ds_loc' field of a
        --    'DerivSpec'.
        --
        -- 2. 'DerivInstTys': information about the argument types to which a
        --    class is applied in a derived instance. This will eventually be
        --    instantiated with the 'dsm_stock_dit' field of a
        --    'DerivSpecMechanism'.
        --
        -- This function returns four things:
        --
        -- 1. @'LHsBinds' 'GhcPs'@: The derived instance's function bindings
        --    (e.g., @compare (T x) (T y) = compare x y@)
        --
        -- 2. @['LSig' 'GhcPs']@: A list of instance specific signatures/pragmas.
        --    Most likely @INLINE@ pragmas for class methods.
        --
        -- 3. @'Bag' 'AuxBindSpec'@: Auxiliary bindings needed to support the
        --    derived instance. As examples, derived 'Eq' and 'Ord' instances
        --    sometimes require top-level @con2tag@ functions.
        --    See @Note [Auxiliary binders]@ in "GHC.Tc.Deriv.Generate".
        --
        -- 4. @['Name']@: A list of Names for which @-Wunused-binds@ should be
        --    suppressed. This is used to suppress unused warnings for record
        --    selectors when deriving 'Read', 'Show', or 'Generic'.
        --    See @Note [Deriving and unused record selectors]@.
      , StockGenFns -> SrcSpan -> DerivInstTys -> TcM [FamInst]
    stock_gen_fam_insts ::
             SrcSpan -> DerivInstTys
          -> TcM [FamInst]
        -- ^ Describes how to generate associated type family instances for a
        -- stock-derived instance. This function takes the same arguments as the
        -- 'stock_gen_binds' function but returns a list of 'FamInst's instead.
        -- Generating type family instances is done separately from
        -- 'stock_gen_binds' since the type family instances must be generated
        -- before the instance bindings can be typechecked. See
        -- @Note [Staging of tcDeriving]@ in "GHC.Tc.Deriv".
      }

    -- A stock class is one either defined in the Haskell report or for which GHC
    -- otherwise knows how to generate code for (possibly requiring the use of a
    -- language extension), such as Eq, Ord, Ix, Data, Generic, etc.)

    -- | A 'PredSpec' specifies a constraint to emitted when inferring the
    -- instance context for a derived instance in 'GHC.Tc.Deriv.simplifyInfer'.
    data PredSpec
      = -- | An ordinary 'PredSpec' that directly stores a 'PredType', which
        -- will be emitted as a wanted constraint in the constraint solving
        -- machinery. This is the simple case, as there are no skolems,
        -- metavariables, or given constraints involved.
        SimplePredSpec
          { PredSpec -> Type
    sps_pred :: TcPredType
            -- ^ The constraint to emit as a wanted
          , PredSpec -> CtOrigin
    sps_origin :: CtOrigin
            -- ^ The origin of the constraint
          , PredSpec -> TypeOrKind
    sps_type_or_kind :: TypeOrKind
            -- ^ Whether the constraint is a type or kind
          }
      | -- | A special 'PredSpec' that is only used by @DeriveAnyClass@. This
        -- will check if @stps_ty_actual@ is a subtype of (i.e., more polymorphic
        -- than) @stps_ty_expected@ in the constraint solving machinery, emitting an
        -- implication constraint as a side effect. For more details on how this
        -- works, see @Note [Gathering and simplifying constraints for DeriveAnyClass]@
        -- in "GHC.Tc.Deriv.Infer".
        SubTypePredSpec
          { PredSpec -> Type
    stps_ty_actual :: TcSigmaType
            -- ^ The actual type. In the context of @DeriveAnyClass@, this is the
            -- default method type signature.
          , PredSpec -> Type
    stps_ty_expected :: TcSigmaType
            -- ^ The expected type. In the context of @DeriveAnyClass@, this is the
            -- original method type signature.
          , PredSpec -> CtOrigin
    stps_origin :: CtOrigin
            -- ^ The origin of the constraint
          }

    -- | A list of 'PredSpec' constraints to simplify when inferring a
    -- derived instance's context. For the @stock@, @newtype@, and @via@ deriving
    -- strategies, these will consist of 'SimplePredSpec's, and for
    -- @DeriveAnyClass@, these will consist of 'SubTypePredSpec's. Here is an
    -- example to illustrate the latter:
    --
    -- @
    -- class Foo a where
    --   bar :: forall b. Ix b => a -> b -> String
    --   default bar :: forall y. (Show a, Ix y) => a -> y -> String
    --   bar x y = show x ++ show (range (y, y))
    --
    --   baz :: Eq a => a -> a -> Bool
    --   default baz :: Ord a => a -> a -> Bool
    --   baz x y = compare x y == EQ
    --
    -- data Quux q = Quux deriving anyclass Foo
    -- @
    --
    -- Then it would generate two 'SubTypePredSpec's, one for each method:
    --
    -- @
    -- [ SubTypePredSpec
    --     { stps_ty_actual   = forall y. (Show (Quux q), Ix y) => Quux q -> y -> String
    --     , stps_ty_expected = forall b.                (Ix b) => Quux q -> b -> String
    --     , stps_ty_origin   = DerivClauseCtxt
    --     }
    -- , SubTypePredSpec
    --     { stps_ty_actual   = Ord (Quux q) => Quux q -> Quux q -> Bool
    --     , stps_ty_expected = Eq  (Quux q) => Quux q -> Quux q -> Bool
    --     , stps_ty_origin   = DerivClauseCtxt
    --     }
    -- ]
    -- @
    --
    -- (Note that the type variable @q@ is bound by the data type @Quux@, and thus
    -- appears free in the 'stps_ty_actual's and 'stps_ty_expected's.)
    --
    -- See @Note [Gathering and simplifying constraints for DeriveAnyClass]@
    -- in "GHC.Tc.Deriv.Infer" for an explanation of how these 'SubTypePredSpec's
    -- are used to compute implication constraints.
    type ThetaSpec = [PredSpec]

    instance Outputable PredSpec where
      ppr :: PredSpec -> SDoc
    ppr (SimplePredSpec{sps_pred :: PredSpec -> Type
    sps_pred = Type
    ty}) =
        SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SimplePredSpec")
           Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "sps_pred" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty ])
      ppr (SubTypePredSpec { stps_ty_actual :: PredSpec -> Type
    stps_ty_actual = Type
    ty_actual
                           , stps_ty_expected :: PredSpec -> Type
    stps_ty_expected = Type
    ty_expected }) =
        SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SubTypePredSpec")
           Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "stps_ty_actual"   SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty_actual
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "stps_ty_expected" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty_expected
                   ])

    -- | Build a list of 'SimplePredSpec's, using the supplied 'CtOrigin' and
    -- 'TypeOrKind' values for each 'PredType'.
    mkDirectThetaSpec :: CtOrigin -> TypeOrKind -> ThetaType -> ThetaSpec
    mkDirectThetaSpec :: CtOrigin -> TypeOrKind -> [Type] -> ThetaSpec
    mkDirectThetaSpec CtOrigin
    origin TypeOrKind
    t_or_k =
      (Type -> PredSpec) -> [Type] -> ThetaSpec
    forall a b. (a -> b) -> [a] -> [b]
    map (\Type
    p -> SimplePredSpec
                   { sps_pred :: Type
    sps_pred = Type
    p
                   , sps_origin :: CtOrigin
    sps_origin = CtOrigin
    origin
                   , sps_type_or_kind :: TypeOrKind
    sps_type_or_kind = TypeOrKind
    t_or_k
                   })

    substPredSpec :: HasCallStack => Subst -> PredSpec -> PredSpec
    substPredSpec :: HasCallStack => Subst -> PredSpec -> PredSpec
    substPredSpec Subst
    subst PredSpec
    ps =
      case PredSpec
    ps of
        SimplePredSpec { sps_pred :: PredSpec -> Type
    sps_pred = Type
    pred
                       , sps_origin :: PredSpec -> CtOrigin
    sps_origin = CtOrigin
    origin
                       , sps_type_or_kind :: PredSpec -> TypeOrKind
    sps_type_or_kind = TypeOrKind
    t_or_k
                       }
          -> SimplePredSpec { sps_pred :: Type
    sps_pred = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy Subst
    subst Type
    pred
                            , sps_origin :: CtOrigin
    sps_origin = CtOrigin
    origin
                            , sps_type_or_kind :: TypeOrKind
    sps_type_or_kind = TypeOrKind
    t_or_k
                            }

        SubTypePredSpec { stps_ty_actual :: PredSpec -> Type
    stps_ty_actual = Type
    ty_actual
                        , stps_ty_expected :: PredSpec -> Type
    stps_ty_expected = Type
    ty_expected
                        , stps_origin :: PredSpec -> CtOrigin
    stps_origin = CtOrigin
    origin
                        }
          -> SubTypePredSpec { stps_ty_actual :: Type
    stps_ty_actual = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy Subst
    subst Type
    ty_actual
                             , stps_ty_expected :: Type
    stps_ty_expected = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy Subst
    subst Type
    ty_expected
                             , stps_origin :: CtOrigin
    stps_origin = CtOrigin
    origin
                             }

    -- | Capture wanted constraints from a 'ThetaSpec'.
    captureThetaSpecConstraints ::
         UserTypeCtxt -- ^ Used to inform error messages as to whether
                      -- we are in a @deriving@ clause or a standalone
                      -- @deriving@ declaration
      -> ThetaSpec    -- ^ The specs from which constraints will be created
      -> TcM (TcLevel, WantedConstraints)
    captureThetaSpecConstraints :: UserTypeCtxt -> ThetaSpec -> TcM (TcLevel, WantedConstraints)
    captureThetaSpecConstraints UserTypeCtxt
    user_ctxt ThetaSpec
    theta =
      TcM WantedConstraints -> TcM (TcLevel, WantedConstraints)
    forall a. TcM a -> TcM (TcLevel, a)
    pushTcLevelM (TcM WantedConstraints -> TcM (TcLevel, WantedConstraints))
    -> TcM WantedConstraints -> TcM (TcLevel, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $ ThetaSpec -> TcM WantedConstraints
    mk_wanteds ThetaSpec
    theta
      where
        -- Create the constraints we need to solve. For stock and newtype
        -- deriving, these constraints will be simple wanted constraints
        -- like (C a, Ord b).
        -- But with DeriveAnyClass, we make an implication constraint.
        -- See Note [Gathering and simplifying constraints for DeriveAnyClass]
        -- in GHC.Tc.Deriv.Infer.
        mk_wanteds :: ThetaSpec -> TcM WantedConstraints
        mk_wanteds :: ThetaSpec -> TcM WantedConstraints
    mk_wanteds ThetaSpec
    preds
          = do { (_, wanteds) <- TcM () -> TcM ((), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureConstraints (TcM () -> TcM ((), WantedConstraints))
    -> TcM () -> TcM ((), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                 (PredSpec -> TcM ()) -> ThetaSpec -> TcM ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ PredSpec -> TcM ()
    emit_constraints ThetaSpec
    preds
               ; pure wanteds }

        -- Emit the appropriate constraints depending on what sort of
        -- PredSpec we are dealing with.
        emit_constraints :: PredSpec -> TcM ()
        emit_constraints :: PredSpec -> TcM ()
    emit_constraints PredSpec
    ps =
          case PredSpec
    ps of
            -- For constraints like (C a, Ord b), emit the
            -- constraints directly as simple wanted constraints.
            SimplePredSpec { sps_pred :: PredSpec -> Type
    sps_pred = Type
    wanted
                           , sps_origin :: PredSpec -> CtOrigin
    sps_origin = CtOrigin
    orig
                           , sps_type_or_kind :: PredSpec -> TypeOrKind
    sps_type_or_kind = TypeOrKind
    t_or_k
                           } -> do
              ev <- CtOrigin -> Maybe TypeOrKind -> Type -> TcM CtEvidence
    newWanted CtOrigin
    orig (TypeOrKind -> Maybe TypeOrKind
    forall a. a -> Maybe a
    Just TypeOrKind
    t_or_k) Type
    wanted
              emitSimple (mkNonCanonical ev)

            -- For DeriveAnyClass, check if ty_actual is a subtype of
            -- ty_expected, which emits an implication constraint as a
            -- side effect. See
            -- Note [Gathering and simplifying constraints for DeriveAnyClass].
            -- in GHC.Tc.Deriv.Infer.
            SubTypePredSpec { stps_ty_actual :: PredSpec -> Type
    stps_ty_actual   = Type
    ty_actual
                            , stps_ty_expected :: PredSpec -> Type
    stps_ty_expected = Type
    ty_expected
                            , stps_origin :: PredSpec -> CtOrigin
    stps_origin      = CtOrigin
    orig
                            } -> do
              _ <- CtOrigin -> UserTypeCtxt -> Type -> Type -> TcM HsWrapper
    tcSubTypeSigma CtOrigin
    orig UserTypeCtxt
    user_ctxt Type
    ty_actual Type
    ty_expected
              return ()

    {-
    ************************************************************************
    *                                                                      *
                    Class deriving diagnostics
    *                                                                      *
    ************************************************************************

    Only certain blessed classes can be used in a deriving clause (without the
    assistance of GeneralizedNewtypeDeriving or DeriveAnyClass). These classes
    are listed below in the definition of hasStockDeriving. The stockSideConditions
    function determines the criteria that needs to be met in order for a particular
    stock class to be able to be derived successfully.

    A class might be able to be used in a deriving clause if -XDeriveAnyClass
    is willing to support it.
    -}

    hasStockDeriving
      :: Class -> Maybe StockGenFns
    hasStockDeriving :: Class -> Maybe StockGenFns
    hasStockDeriving Class
    clas
      = Assoc Unique StockGenFns -> Unique -> Maybe StockGenFns
    forall a b. Eq a => Assoc a b -> a -> Maybe b
    assocMaybe Assoc Unique StockGenFns
    gen_list (Class -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique Class
    clas)
      where
        gen_list :: [(Unique, StockGenFns)]
        gen_list :: Assoc Unique StockGenFns
    gen_list =
          [ (Unique
    eqClassKey,          (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> m (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_bindsM SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          Bag AuxBindSpec)
    gen_Eq_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    ordClassKey,         (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> m (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_bindsM SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          Bag AuxBindSpec)
    gen_Ord_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    enumClassKey,        (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> m (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_bindsM SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          Bag AuxBindSpec)
    gen_Enum_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    boundedClassKey,     (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
         Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_binds SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag AuxBindSpec)
    gen_Bounded_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    ixClassKey,          (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> m (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_bindsM SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          Bag AuxBindSpec)
    gen_Ix_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    showClassKey,        (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk (((Name -> Fixity)
     -> SrcSpan
     -> DerivInstTys
     -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
         Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {t} {a} {c} {a}.
    ((Name -> Fixity) -> t -> DerivInstTys -> (a, c))
    -> t
    -> DerivInstTys
    -> IOEnv (Env TcGblEnv TcLclEnv) (a, [a], c, [Name])
    read_or_show_binds (Name -> Fixity)
    -> SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
    (Name -> Fixity)
    -> SrcSpan
    -> DerivInstTys
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag AuxBindSpec)
    gen_Show_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    readClassKey,        (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk (((Name -> Fixity)
     -> SrcSpan
     -> DerivInstTys
     -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
         Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {t} {a} {c} {a}.
    ((Name -> Fixity) -> t -> DerivInstTys -> (a, c))
    -> t
    -> DerivInstTys
    -> IOEnv (Env TcGblEnv TcLclEnv) (a, [a], c, [Name])
    read_or_show_binds (Name -> Fixity)
    -> SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
    (Name -> Fixity)
    -> SrcSpan
    -> DerivInstTys
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag AuxBindSpec)
    gen_Read_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    dataClassKey,        (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> m (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_bindsM SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          Bag AuxBindSpec)
    gen_Data_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    functorClassKey,     (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
         Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_binds SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag AuxBindSpec)
    gen_Functor_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    foldableClassKey,    (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
         Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_binds SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag AuxBindSpec)
    gen_Foldable_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    traversableClassKey, (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
         Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_binds SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag AuxBindSpec)
    gen_Traversable_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    liftClassKey,        (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk ((SrcSpan
     -> DerivInstTys
     -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
         Bag AuxBindSpec))
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {m :: * -> *} {t} {t} {a} {c} {a} {a}.
    Monad m =>
    (t -> t -> (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_binds SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, Bag AuxBindSpec)
    SrcSpan
    -> DerivInstTys
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
        Bag AuxBindSpec)
    gen_Lift_binds) SrcSpan -> DerivInstTys -> TcM [FamInst]
    forall {f :: * -> *} {p} {p} {a}. Applicative f => p -> p -> f [a]
    no_fam_insts)
          , (Unique
    genClassKey,         (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk (GenericKind
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {a}.
    GenericKind
    -> SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag a, [Name])
    generic_binds GenericKind
    Gen0) (GenericKind -> SrcSpan -> DerivInstTys -> TcM [FamInst]
    generic_fam_inst GenericKind
    Gen0))
          , (Unique
    gen1ClassKey,        (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk (GenericKind
    -> SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    forall {a}.
    GenericKind
    -> SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag a, [Name])
    generic_binds GenericKind
    Gen1) (GenericKind -> SrcSpan -> DerivInstTys -> TcM [FamInst]
    generic_fam_inst GenericKind
    Gen1))
          ]

        mk :: (SrcSpan
     -> DerivInstTys
     -> TcM
          (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
           [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name]))
    -> (SrcSpan -> DerivInstTys -> TcM [FamInst]) -> StockGenFns
    mk SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    gen_binds_fn SrcSpan -> DerivInstTys -> TcM [FamInst]
    gen_fam_insts_fn = StockGenFns
          { stock_gen_binds :: SrcSpan
    -> DerivInstTys
    -> TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    stock_gen_binds     = SrcSpan
    -> DerivInstTys
    -> TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
    SrcSpan
    -> DerivInstTys
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag AuxBindSpec, [Name])
    gen_binds_fn
          , stock_gen_fam_insts :: SrcSpan -> DerivInstTys -> TcM [FamInst]
    stock_gen_fam_insts = SrcSpan -> DerivInstTys -> TcM [FamInst]
    gen_fam_insts_fn
          }

        simple_binds :: (t -> t -> (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_binds t -> t -> (a, c)
    gen_fn t
    loc t
    dit
          = let (a
    binds, c
    aux_specs) = t -> t -> (a, c)
    gen_fn t
    loc t
    dit
            in (a, [a], c, [a]) -> m (a, [a], c, [a])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    binds, [], c
    aux_specs, [])

        -- Like `simple`, but monadic. The only monadic thing that these functions
        -- do is allocate new Uniques, which are used for generating the names of
        -- auxiliary bindings.
        -- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
        simple_bindsM :: (t -> t -> m (a, c)) -> t -> t -> m (a, [a], c, [a])
    simple_bindsM t -> t -> m (a, c)
    gen_fn t
    loc t
    dit
          = do { (binds, aux_specs) <- t -> t -> m (a, c)
    gen_fn t
    loc t
    dit
               ; return (binds, [], aux_specs, []) }

        read_or_show_binds :: ((Name -> Fixity) -> t -> DerivInstTys -> (a, c))
    -> t
    -> DerivInstTys
    -> IOEnv (Env TcGblEnv TcLclEnv) (a, [a], c, [Name])
    read_or_show_binds (Name -> Fixity) -> t -> DerivInstTys -> (a, c)
    gen_fn t
    loc DerivInstTys
    dit
          = do { let tc :: TyCon
    tc = DerivInstTys -> TyCon
    dit_rep_tc DerivInstTys
    dit
               ; fix_env <- TyCon -> TcM (Name -> Fixity)
    getDataConFixityFun TyCon
    tc
               ; let (binds, aux_specs) = gen_fn fix_env loc dit
                     field_names        = TyCon -> [Name]
    all_field_names TyCon
    tc
               ; return (binds, [], aux_specs, field_names) }

        generic_binds :: GenericKind
    -> SrcSpan
    -> DerivInstTys
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcPs GhcPs)),
          [GenLocated SrcSpanAnnA (Sig GhcPs)], Bag a, [Name])
    generic_binds GenericKind
    gk SrcSpan
    loc DerivInstTys
    dit
          = do { let tc :: TyCon
    tc = DerivInstTys -> TyCon
    dit_rep_tc DerivInstTys
    dit
               ; (binds, sigs) <- GenericKind
    -> SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, [LSig GhcPs])
    gen_Generic_binds GenericKind
    gk SrcSpan
    loc DerivInstTys
    dit
               ; let field_names = TyCon -> [Name]
    all_field_names TyCon
    tc
               ; return (binds, sigs, emptyBag, field_names) }

        generic_fam_inst :: GenericKind -> SrcSpan -> DerivInstTys -> TcM [FamInst]
    generic_fam_inst GenericKind
    gk SrcSpan
    loc DerivInstTys
    dit
          = do { let tc :: TyCon
    tc = DerivInstTys -> TyCon
    dit_rep_tc DerivInstTys
    dit
               ; fix_env <- TyCon -> TcM (Name -> Fixity)
    getDataConFixityFun TyCon
    tc
               ; faminst <- gen_Generic_fam_inst gk fix_env loc dit
               ; return [faminst] }

        no_fam_insts :: p -> p -> f [a]
    no_fam_insts p
    _ p
    _ = [a] -> f [a]
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []

        -- See Note [Deriving and unused record selectors]
        all_field_names :: TyCon -> [Name]
    all_field_names = (FieldLabel -> Name) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLabel -> Name
    flSelector ([FieldLabel] -> [Name])
    -> (TyCon -> [FieldLabel]) -> TyCon -> [Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DataCon -> [FieldLabel]) -> [DataCon] -> [FieldLabel]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DataCon -> [FieldLabel]
    dataConFieldLabels
                                         ([DataCon] -> [FieldLabel])
    -> (TyCon -> [DataCon]) -> TyCon -> [FieldLabel]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyCon -> [DataCon]
    tyConDataCons

    {-
    Note [Deriving and unused record selectors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this (see #13919):

      module Main (main) where

      data Foo = MkFoo {bar :: String} deriving Show

      main :: IO ()
      main = print (Foo "hello")

    Strictly speaking, the record selector `bar` is unused in this module, since
    neither `main` nor the derived `Show` instance for `Foo` mention `bar`.
    However, the behavior of `main` is affected by the presence of `bar`, since
    it will print different output depending on whether `MkFoo` is defined using
    record selectors or not. Therefore, we do not to issue a
    "Defined but not used: ‘bar’" warning for this module, since removing `bar`
    changes the program's behavior. This is the reason behind the [Name] part of
    the return type of `hasStockDeriving`—it tracks all of the record selector
    `Name`s for which -Wunused-binds should be suppressed.

    Currently, the only three stock derived classes that require this are Read,
    Show, and Generic, as their derived code all depend on the record selectors
    of the derived data type's constructors.

    See also Note [Unused constructors and deriving clauses] in GHC.Tc.Deriv for
    another example of a similar trick.
    -}

    getDataConFixityFun :: TyCon -> TcM (Name -> Fixity)
    -- If the TyCon is locally defined, we want the local fixity env;
    -- but if it is imported (which happens for standalone deriving)
    -- we need to get the fixity env from the interface file
    -- c.f. GHC.Rename.Env.lookupFixity, #9830, and #20994
    getDataConFixityFun :: TyCon -> TcM (Name -> Fixity)
    getDataConFixityFun TyCon
    tc
      = do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
           ; if nameIsLocalOrFrom this_mod name
             then do { fix_env <- getFixityEnv
                     ; return (lookupFixity fix_env) }
             else do { iface <- loadInterfaceForName doc name
                                -- Should already be loaded!
                     ; return (mi_fix iface . nameOccName) } }
      where
        name :: Name
    name = TyCon -> Name
    tyConName TyCon
    tc
        doc :: SDoc
    doc = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Data con fixities for" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name

    ------------------------------------------------------------------
    -- Check side conditions that dis-allow derivability for the originative
    -- deriving strategies (stock and anyclass).
    -- See Note [Deriving strategies] in GHC.Tc.Deriv for an explanation of what
    -- "originative" means.
    --
    -- This is *apart* from the coerce-based strategies, newtype and via.
    --
    -- Here we get the representation tycon in case of family instances as it has
    -- the data constructors - but we need to be careful to fall back to the
    -- family tycon (with indexes) in error messages.

    checkOriginativeSideConditions :: DerivInstTys -> DerivM OriginativeDerivStatus
    checkOriginativeSideConditions :: DerivInstTys -> DerivM OriginativeDerivStatus
    checkOriginativeSideConditions dit :: DerivInstTys
    dit@(DerivInstTys{dit_cls_tys :: DerivInstTys -> [Type]
    dit_cls_tys = [Type]
    cls_tys}) =
      do DerivEnv { denv_cls  = cls
                  , denv_ctxt = deriv_ctxt } <- ReaderT DerivEnv (IOEnv (Env TcGblEnv TcLclEnv)) DerivEnv
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
         dflags <- getDynFlags

         if    -- First, check if stock deriving is possible...
            |  Just cond <- stockSideConditions deriv_ctxt cls
            -> case cond dflags dit of
                 NotValid DeriveInstanceErrReason
    err -> OriginativeDerivStatus -> DerivM OriginativeDerivStatus
    forall a. a -> ReaderT DerivEnv (IOEnv (Env TcGblEnv TcLclEnv)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OriginativeDerivStatus -> DerivM OriginativeDerivStatus)
    -> OriginativeDerivStatus -> DerivM OriginativeDerivStatus
    forall a b. (a -> b) -> a -> b
    $ DeriveInstanceErrReason -> OriginativeDerivStatus
    StockClassError DeriveInstanceErrReason
    err  -- Class-specific error
                 Validity' DeriveInstanceErrReason
    IsValid  |  [Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes (Class -> TyCon
    classTyCon Class
    cls) [Type]
    cls_tys)
                             -- All stock derivable classes are unary in the sense that
                             -- there should be not types in cls_tys (i.e., no type args
                             -- other than last). Note that cls_types can contain
                             -- invisible types as well (e.g., for Generic1, which is
                             -- poly-kinded), so make sure those are not counted.
                          ,  Just StockGenFns
    gen_fn <- Class -> Maybe StockGenFns
    hasStockDeriving Class
    cls
                          -> OriginativeDerivStatus -> DerivM OriginativeDerivStatus
    forall a. a -> ReaderT DerivEnv (IOEnv (Env TcGblEnv TcLclEnv)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OriginativeDerivStatus -> DerivM OriginativeDerivStatus)
    -> OriginativeDerivStatus -> DerivM OriginativeDerivStatus
    forall a b. (a -> b) -> a -> b
    $ StockGenFns -> OriginativeDerivStatus
    CanDeriveStock StockGenFns
    gen_fn
                          |  Bool
    otherwise
                          -> OriginativeDerivStatus -> DerivM OriginativeDerivStatus
    forall a. a -> ReaderT DerivEnv (IOEnv (Env TcGblEnv TcLclEnv)) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (OriginativeDerivStatus -> DerivM OriginativeDerivStatus)
    -> OriginativeDerivStatus -> DerivM OriginativeDerivStatus
    forall a b. (a -> b) -> a -> b
    $ DeriveInstanceErrReason -> OriginativeDerivStatus
    StockClassError (DeriveInstanceErrReason -> OriginativeDerivStatus)
    -> DeriveInstanceErrReason -> OriginativeDerivStatus
    forall a b. (a -> b) -> a -> b
    $ Class -> [Type] -> DeriveInstanceErrReason
    classArgsErr Class
    cls [Type]
    cls_tys
                            -- e.g. deriving( Eq s )

               -- ...if not, try falling back on DeriveAnyClass.
            |  xopt LangExt.DeriveAnyClass dflags
            -> pure CanDeriveAnyClass   -- DeriveAnyClass should work

            |  otherwise
            -> pure NonDerivableClass -- Neither anyclass nor stock work

    classArgsErr :: Class -> [Type] -> DeriveInstanceErrReason
    classArgsErr :: Class -> [Type] -> DeriveInstanceErrReason
    classArgsErr Class
    cls [Type]
    cls_tys = Type -> DeriveInstanceErrReason
    DerivErrNotAClass (Class -> [Type] -> Type
    mkClassPred Class
    cls [Type]
    cls_tys)

    -- Side conditions (whether the datatype must have at least one constructor,
    -- required language extensions, etc.) for using GHC's stock deriving
    -- mechanism on certain classes (as opposed to classes that require
    -- GeneralizedNewtypeDeriving or DeriveAnyClass). Returns Nothing for a
    -- class for which stock deriving isn't possible.
    stockSideConditions :: DerivContext -> Class -> Maybe Condition
    stockSideConditions :: DerivContext -> Class -> Maybe Condition
    stockSideConditions DerivContext
    deriv_ctxt Class
    cls
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    eqClassKey          = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Condition
    cond_std Condition -> Condition -> Condition
    `andCond` Class -> Condition
    cond_args Class
    cls)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    ordClassKey         = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Condition
    cond_std Condition -> Condition -> Condition
    `andCond` Class -> Condition
    cond_args Class
    cls)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    showClassKey        = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Condition
    cond_std Condition -> Condition -> Condition
    `andCond` Class -> Condition
    cond_args Class
    cls)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    readClassKey        = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Condition
    cond_std Condition -> Condition -> Condition
    `andCond` Class -> Condition
    cond_args Class
    cls)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    enumClassKey        = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Condition
    cond_std Condition -> Condition -> Condition
    `andCond` Condition
    cond_isEnumeration)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    ixClassKey          = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Condition
    cond_std Condition -> Condition -> Condition
    `andCond` Class -> Condition
    cond_enumOrProduct Class
    cls)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    boundedClassKey     = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Condition
    cond_std Condition -> Condition -> Condition
    `andCond` Class -> Condition
    cond_enumOrProduct Class
    cls)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    dataClassKey        = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Extension -> Condition
    checkFlag Extension
    LangExt.DeriveDataTypeable Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_vanilla Condition -> Condition -> Condition
    `andCond`
                                                       Class -> Condition
    cond_args Class
    cls)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    functorClassKey     = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Extension -> Condition
    checkFlag Extension
    LangExt.DeriveFunctor Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_vanilla Condition -> Condition -> Condition
    `andCond`
                                                       Bool -> Bool -> Condition
    cond_functorOK Bool
    True Bool
    False)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    foldableClassKey    = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Extension -> Condition
    checkFlag Extension
    LangExt.DeriveFoldable Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_vanilla Condition -> Condition -> Condition
    `andCond`
                                                       Bool -> Bool -> Condition
    cond_functorOK Bool
    False Bool
    True)
                                                       -- Functor/Fold/Trav works ok
                                                       -- for rank-n types
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    traversableClassKey = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Extension -> Condition
    checkFlag Extension
    LangExt.DeriveTraversable Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_vanilla Condition -> Condition -> Condition
    `andCond`
                                                       Bool -> Bool -> Condition
    cond_functorOK Bool
    False Bool
    False)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    genClassKey         = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Extension -> Condition
    checkFlag Extension
    LangExt.DeriveGeneric Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_vanilla Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_RepresentableOk)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    gen1ClassKey        = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Extension -> Condition
    checkFlag Extension
    LangExt.DeriveGeneric Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_vanilla Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_Representable1Ok)
      | Unique -> Unique -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Unique
    cls_key Unique
    liftClassKey        = Condition -> Maybe Condition
    forall a. a -> Maybe a
    Just (Extension -> Condition
    checkFlag Extension
    LangExt.DeriveLift Condition -> Condition -> Condition
    `andCond`
                                                       Condition
    cond_vanilla Condition -> Condition -> Condition
    `andCond`
                                                       Class -> Condition
    cond_args Class
    cls)
      | Bool
    otherwise                        = Maybe Condition
    forall a. Maybe a
    Nothing
      where
        cls_key :: Unique
    cls_key = Class -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique Class
    cls
        cond_std :: Condition
    cond_std     = DerivContext -> Bool -> Condition
    cond_stdOK DerivContext
    deriv_ctxt Bool
    False
          -- Vanilla data constructors, at least one, and monotype arguments
        cond_vanilla :: Condition
    cond_vanilla = DerivContext -> Bool -> Condition
    cond_stdOK DerivContext
    deriv_ctxt Bool
    True
          -- Vanilla data constructors but allow no data cons or polytype arguments

    type Condition
       = DynFlags

      -> DerivInstTys -- ^ Information about the type arguments to the class.

      -> Validity' DeriveInstanceErrReason
         -- ^ 'IsValid' if deriving an instance for this type is
         -- possible. Otherwise, it's @'NotValid' err@, where @err@
         -- explains what went wrong.

    andCond :: Condition -> Condition -> Condition
    andCond :: Condition -> Condition -> Condition
    andCond Condition
    c1 Condition
    c2 DynFlags
    dflags DerivInstTys
    dit
      = Condition
    c1 DynFlags
    dflags DerivInstTys
    dit Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    forall a. Validity' a -> Validity' a -> Validity' a
    `andValid` Condition
    c2 DynFlags
    dflags DerivInstTys
    dit

    -- | Some common validity checks shared among stock derivable classes. One
    -- check that absolutely must hold is that if an instance @C (T a)@ is being
    -- derived, then @T@ must be a tycon for a data type or a newtype. The
    -- remaining checks are only performed if using a @deriving@ clause (i.e.,
    -- they're ignored if using @StandaloneDeriving@):
    --
    -- 1. The data type must have at least one constructor (this check is ignored
    --    if using @EmptyDataDeriving@).
    --
    -- 2. The data type cannot have any GADT constructors.
    --
    -- 3. The data type cannot have any constructors with existentially quantified
    --    type variables.
    --
    -- 4. The data type cannot have a context (e.g., @data Foo a = Eq a => MkFoo@).
    --
    -- 5. The data type cannot have fields with higher-rank types.
    cond_stdOK
      :: DerivContext -- ^ 'SupplyContext' if this is standalone deriving with a
                      -- user-supplied context, 'InferContext' if not.
                      -- If it is the former, we relax some of the validity checks
                      -- we would otherwise perform (i.e., "just go for it").

      -> Bool         -- ^ 'True' <=> allow higher rank arguments and empty data
                      -- types (with no data constructors) even in the absence of
                      -- the -XEmptyDataDeriving extension.

      -> Condition
    cond_stdOK :: DerivContext -> Bool -> Condition
    cond_stdOK DerivContext
    deriv_ctxt Bool
    permissive DynFlags
    dflags
               dit :: DerivInstTys
    dit@(DerivInstTys{dit_tc :: DerivInstTys -> TyCon
    dit_tc = TyCon
    tc, dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc = TyCon
    rep_tc})
      = Validity' DeriveInstanceErrReason
    valid_ADT Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    forall a. Validity' a -> Validity' a -> Validity' a
    `andValid` Validity' DeriveInstanceErrReason
    valid_misc
      where
        valid_ADT, valid_misc :: Validity' DeriveInstanceErrReason
        valid_ADT :: Validity' DeriveInstanceErrReason
    valid_ADT
          | TyCon -> Bool
    isAlgTyCon TyCon
    tc Bool -> Bool -> Bool
    || TyCon -> Bool
    isDataFamilyTyCon TyCon
    tc
          = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
          | Bool
    otherwise
            -- Complain about functions, primitive types, and other tycons that
            -- stock deriving can't handle.
          = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid DeriveInstanceErrReason
    DerivErrLastArgMustBeApp

        valid_misc :: Validity' DeriveInstanceErrReason
    valid_misc
          = case DerivContext
    deriv_ctxt of
             SupplyContext [Type]
    _ -> Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
                    -- Don't check these conservative conditions for
                    -- standalone deriving; just generate the code
                    -- and let the typechecker handle the result
             InferContext Maybe SrcSpan
    wildcard
               | [DataCon] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DataCon]
    data_cons -- 1.
               , Bool -> Bool
    not Bool
    permissive
               , Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.EmptyDataDeriving DynFlags
    dflags)
               -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (TyCon -> DeriveInstanceErrReason
    no_cons_why TyCon
    rep_tc)
               | Bool -> Bool
    not ([DeriveInstanceBadConstructor] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DeriveInstanceBadConstructor]
    con_whys)
               -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ Maybe HasWildcard
    -> [DeriveInstanceBadConstructor] -> DeriveInstanceErrReason
    DerivErrBadConstructor (HasWildcard -> Maybe HasWildcard
    forall a. a -> Maybe a
    Just (HasWildcard -> Maybe HasWildcard)
    -> HasWildcard -> Maybe HasWildcard
    forall a b. (a -> b) -> a -> b
    $ Maybe SrcSpan -> HasWildcard
    forall {a}. Maybe a -> HasWildcard
    has_wildcard Maybe SrcSpan
    wildcard) [DeriveInstanceBadConstructor]
    con_whys
               | Bool
    otherwise
               -> Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid

        has_wildcard :: Maybe a -> HasWildcard
    has_wildcard Maybe a
    wildcard
          = case Maybe a
    wildcard of
              Just a
    _  -> HasWildcard
    YesHasWildcard
              Maybe a
    Nothing -> HasWildcard
    NoHasWildcard
        data_cons :: [DataCon]
    data_cons  = TyCon -> [DataCon]
    tyConDataCons TyCon
    rep_tc
        con_whys :: [DeriveInstanceBadConstructor]
    con_whys   = [Validity' DeriveInstanceBadConstructor]
    -> [DeriveInstanceBadConstructor]
    forall a. [Validity' a] -> [a]
    getInvalids ((DataCon -> Validity' DeriveInstanceBadConstructor)
    -> [DataCon] -> [Validity' DeriveInstanceBadConstructor]
    forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> Validity' DeriveInstanceBadConstructor
    check_con [DataCon]
    data_cons)

        check_con :: DataCon -> Validity' DeriveInstanceBadConstructor
        check_con :: DataCon -> Validity' DeriveInstanceBadConstructor
    check_con DataCon
    con
          | Bool -> Bool
    not ([EqSpec] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EqSpec]
    eq_spec) -- 2.
          = (DataCon -> DeriveInstanceBadConstructor)
    -> Validity' DeriveInstanceBadConstructor
    bad DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConIsGADT
          | Bool -> Bool
    not ([TyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyVar]
    ex_tvs) -- 3.
          = (DataCon -> DeriveInstanceBadConstructor)
    -> Validity' DeriveInstanceBadConstructor
    bad DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConHasExistentials
          | Bool -> Bool
    not ([Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    theta) -- 4.
          = (DataCon -> DeriveInstanceBadConstructor)
    -> Validity' DeriveInstanceBadConstructor
    bad DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConHasConstraints
          | Bool -> Bool
    not (Bool
    permissive Bool -> Bool -> Bool
    || (Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    isTauTy (DataCon -> DerivInstTys -> [Type]
    derivDataConInstArgTys DataCon
    con DerivInstTys
    dit)) -- 5.
          = (DataCon -> DeriveInstanceBadConstructor)
    -> Validity' DeriveInstanceBadConstructor
    bad DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConHasHigherRankType
          | Bool
    otherwise
          = Validity' DeriveInstanceBadConstructor
    forall a. Validity' a
    IsValid
          where
            ([TyVar]
    _, [TyVar]
    ex_tvs, [EqSpec]
    eq_spec, [Type]
    theta, [Scaled Type]
    _, Type
    _) = DataCon
    -> ([TyVar], [TyVar], [EqSpec], [Type], [Scaled Type], Type)
    dataConFullSig DataCon
    con
            bad :: (DataCon -> DeriveInstanceBadConstructor)
    -> Validity' DeriveInstanceBadConstructor
    bad DataCon -> DeriveInstanceBadConstructor
    mkErr = DeriveInstanceBadConstructor
    -> Validity' DeriveInstanceBadConstructor
    forall a. a -> Validity' a
    NotValid (DeriveInstanceBadConstructor
     -> Validity' DeriveInstanceBadConstructor)
    -> DeriveInstanceBadConstructor
    -> Validity' DeriveInstanceBadConstructor
    forall a b. (a -> b) -> a -> b
    $ DataCon -> DeriveInstanceBadConstructor
    mkErr DataCon
    con

    no_cons_why :: TyCon -> DeriveInstanceErrReason
    no_cons_why :: TyCon -> DeriveInstanceErrReason
    no_cons_why = TyCon -> DeriveInstanceErrReason
    DerivErrNoConstructors

    cond_RepresentableOk :: Condition
    cond_RepresentableOk :: Condition
    cond_RepresentableOk DynFlags
    _ DerivInstTys
    dit =
      case DerivInstTys -> Validity' [DeriveGenericsErrReason]
    canDoGenerics DerivInstTys
    dit of
        Validity' [DeriveGenericsErrReason]
    IsValid -> Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
        NotValid [DeriveGenericsErrReason]
    generic_errs -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ [DeriveGenericsErrReason] -> DeriveInstanceErrReason
    DerivErrGenerics [DeriveGenericsErrReason]
    generic_errs

    cond_Representable1Ok :: Condition
    cond_Representable1Ok :: Condition
    cond_Representable1Ok DynFlags
    _ DerivInstTys
    dit =
      case DerivInstTys -> Validity' [DeriveGenericsErrReason]
    canDoGenerics1 DerivInstTys
    dit of
        Validity' [DeriveGenericsErrReason]
    IsValid -> Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
        NotValid [DeriveGenericsErrReason]
    generic_errs -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ [DeriveGenericsErrReason] -> DeriveInstanceErrReason
    DerivErrGenerics [DeriveGenericsErrReason]
    generic_errs

    cond_enumOrProduct :: Class -> Condition
    cond_enumOrProduct :: Class -> Condition
    cond_enumOrProduct Class
    cls = Condition
    cond_isEnumeration Condition -> Condition -> Condition
    `orCond`
                             (Condition
    cond_isProduct Condition -> Condition -> Condition
    `andCond` Class -> Condition
    cond_args Class
    cls)
      where
        orCond :: Condition -> Condition -> Condition
        orCond :: Condition -> Condition -> Condition
    orCond Condition
    c1 Condition
    c2 DynFlags
    dflags DerivInstTys
    dit
          = case (Condition
    c1 DynFlags
    dflags DerivInstTys
    dit, Condition
    c2 DynFlags
    dflags DerivInstTys
    dit) of
             (Validity' DeriveInstanceErrReason
    IsValid,    Validity' DeriveInstanceErrReason
    _)          -> Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid    -- c1 succeeds
             (Validity' DeriveInstanceErrReason
    _,          Validity' DeriveInstanceErrReason
    IsValid)    -> Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid    -- c21 succeeds
             (NotValid DeriveInstanceErrReason
    x, NotValid DeriveInstanceErrReason
    y) -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ DeriveInstanceErrReason
    -> DeriveInstanceErrReason -> DeriveInstanceErrReason
    DerivErrEnumOrProduct DeriveInstanceErrReason
    x DeriveInstanceErrReason
    y
                                                    -- Both fail

    cond_args :: Class -> Condition
    -- ^ For some classes (eg 'Eq', 'Ord') we allow unlifted arg types
    -- by generating specialised code.  For others (eg 'Data') we don't.
    -- For even others (eg 'Lift'), unlifted types aren't even a special
    -- consideration!
    cond_args :: Class -> Condition
    cond_args Class
    cls DynFlags
    _ dit :: DerivInstTys
    dit@(DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc = TyCon
    rep_tc})
      = case [Type]
    bad_args of
          []     -> Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
          (Type
    ty:[Type]
    _) -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ Type -> DeriveInstanceErrReason
    DerivErrDunnoHowToDeriveForType Type
    ty
      where
        bad_args :: [Type]
    bad_args = [ Type
    arg_ty | DataCon
    con <- TyCon -> [DataCon]
    tyConDataCons TyCon
    rep_tc
                            , Type
    arg_ty <- DataCon -> DerivInstTys -> [Type]
    derivDataConInstArgTys DataCon
    con DerivInstTys
    dit
                            , Type -> Bool
    mightBeUnliftedType Type
    arg_ty
                            , Bool -> Bool
    not (Type -> Bool
    ok_ty Type
    arg_ty) ]

        cls_key :: Unique
    cls_key = Class -> Unique
    classKey Class
    cls
        ok_ty :: Type -> Bool
    ok_ty Type
    arg_ty
         | Unique
    cls_key Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    eqClassKey   = Type
    -> [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))] -> Bool
    forall a. Type -> [(Type, a)] -> Bool
    check_in Type
    arg_ty [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
    ordOpTbl
         | Unique
    cls_key Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    ordClassKey  = Type
    -> [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))] -> Bool
    forall a. Type -> [(Type, a)] -> Bool
    check_in Type
    arg_ty [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
    ordOpTbl
         | Unique
    cls_key Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    showClassKey = Type -> [(Type, GenLocated SrcSpanAnnA (HsExpr GhcPs))] -> Bool
    forall a. Type -> [(Type, a)] -> Bool
    check_in Type
    arg_ty [(Type, LHsExpr GhcPs)]
    [(Type, GenLocated SrcSpanAnnA (HsExpr GhcPs))]
    boxConTbl
         | Unique
    cls_key Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    liftClassKey = Bool
    True     -- Lift is representation-polymorphic
         | Bool
    otherwise               = Bool
    False    -- Read, Ix etc

        check_in :: Type -> [(Type,a)] -> Bool
        check_in :: forall a. Type -> [(Type, a)] -> Bool
    check_in Type
    arg_ty [(Type, a)]
    tbl = ((Type, a) -> Bool) -> [(Type, a)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> Type -> Bool
    eqType Type
    arg_ty (Type -> Bool) -> ((Type, a) -> Type) -> (Type, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type, a) -> Type
    forall a b. (a, b) -> a
    fst) [(Type, a)]
    tbl

    cond_isEnumeration :: Condition
    cond_isEnumeration :: Condition
    cond_isEnumeration DynFlags
    _ (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc = TyCon
    rep_tc})
      | TyCon -> Bool
    isEnumerationTyCon TyCon
    rep_tc = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
      | Bool
    otherwise                 = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ TyCon -> DeriveInstanceErrReason
    DerivErrMustBeEnumType TyCon
    rep_tc

    cond_isProduct :: Condition
    cond_isProduct :: Condition
    cond_isProduct DynFlags
    _ (DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc = TyCon
    rep_tc})
      | Just DataCon
    _ <- TyCon -> Maybe DataCon
    tyConSingleDataCon_maybe TyCon
    rep_tc
      = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
      | Bool
    otherwise
      = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ TyCon -> DeriveInstanceErrReason
    DerivErrMustHaveExactlyOneConstructor TyCon
    rep_tc

    cond_functorOK :: Bool -> Bool -> Condition
    -- OK for Functor/Foldable/Traversable class
    -- Currently: (a) at least one argument
    --            (b) don't use argument contravariantly
    --            (c) don't use argument in the wrong place, e.g. data T a = T (X a a)
    --            (d) optionally: don't use function types
    --            (e) no "stupid context" on data type
    cond_functorOK :: Bool -> Bool -> Condition
    cond_functorOK Bool
    allowFunctions Bool
    allowExQuantifiedLastTyVar DynFlags
    _
                   dit :: DerivInstTys
    dit@(DerivInstTys{dit_rep_tc :: DerivInstTys -> TyCon
    dit_rep_tc = TyCon
    rep_tc})
      | [TyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyVar]
    tc_tvs
      = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ TyCon -> DeriveInstanceErrReason
    DerivErrMustHaveSomeParameters TyCon
    rep_tc

        -- We can't handle stupid contexts that mention the last type argument,
        -- so error out if we encounter one.
        -- See Note [The stupid context] in GHC.Core.DataCon.
      | Bool -> Bool
    not ([Type] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    bad_stupid_theta)
      = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ TyCon -> [Type] -> DeriveInstanceErrReason
    DerivErrMustNotHaveClassContext TyCon
    rep_tc [Type]
    bad_stupid_theta

      | Bool
    otherwise
      = [Validity' DeriveInstanceErrReason]
    -> Validity' DeriveInstanceErrReason
    forall a. [Validity' a] -> Validity' a
    allValid ((DataCon -> Validity' DeriveInstanceErrReason)
    -> [DataCon] -> [Validity' DeriveInstanceErrReason]
    forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> Validity' DeriveInstanceErrReason
    check_con [DataCon]
    data_cons)
      where
        tc_tvs :: [TyVar]
    tc_tvs            = TyCon -> [TyVar]
    tyConTyVars TyCon
    rep_tc
        last_tv :: TyVar
    last_tv           = [TyVar] -> TyVar
    forall a. HasCallStack => [a] -> a
    last [TyVar]
    tc_tvs
        bad_stupid_theta :: [Type]
    bad_stupid_theta  = (Type -> Bool) -> [Type] -> [Type]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Type -> Bool
    is_bad (TyCon -> [Type]
    tyConStupidTheta TyCon
    rep_tc)
        is_bad :: Type -> Bool
    is_bad Type
    pred       = TyVar
    last_tv TyVar -> VarSet -> Bool
    `elemVarSet` Type -> VarSet
    exactTyCoVarsOfType Type
    pred
          -- See Note [Check that the type variable is truly universal]

        data_cons :: [DataCon]
    data_cons = TyCon -> [DataCon]
    tyConDataCons TyCon
    rep_tc
        check_con :: DataCon -> Validity' DeriveInstanceErrReason
    check_con DataCon
    con = [Validity' DeriveInstanceErrReason]
    -> Validity' DeriveInstanceErrReason
    forall a. [Validity' a] -> Validity' a
    allValid (DataCon -> Validity' DeriveInstanceErrReason
    check_universal DataCon
    con Validity' DeriveInstanceErrReason
    -> [Validity' DeriveInstanceErrReason]
    -> [Validity' DeriveInstanceErrReason]
    forall a. a -> [a] -> [a]
    : FFoldType (Validity' DeriveInstanceErrReason)
    -> DataCon -> DerivInstTys -> [Validity' DeriveInstanceErrReason]
    forall a. FFoldType a -> DataCon -> DerivInstTys -> [a]
    foldDataConArgs (DataCon -> FFoldType (Validity' DeriveInstanceErrReason)
    ft_check DataCon
    con) DataCon
    con DerivInstTys
    dit)

        check_universal :: DataCon -> Validity' DeriveInstanceErrReason
        check_universal :: DataCon -> Validity' DeriveInstanceErrReason
    check_universal DataCon
    con
          | Bool
    allowExQuantifiedLastTyVar
          = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid -- See Note [DeriveFoldable with ExistentialQuantification]
                    -- in GHC.Tc.Deriv.Functor
          | Just TyVar
    tv <- Type -> Maybe TyVar
    getTyVar_maybe ([Type] -> Type
    forall a. HasCallStack => [a] -> a
    last (HasCallStack => Type -> [Type]
    Type -> [Type]
    tyConAppArgs (DataCon -> Type
    dataConOrigResTy DataCon
    con)))
          , TyVar
    tv TyVar -> [TyVar] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` DataCon -> [TyVar]
    dataConUnivTyVars DataCon
    con
          , Bool -> Bool
    not (TyVar
    tv TyVar -> VarSet -> Bool
    `elemVarSet` [Type] -> VarSet
    exactTyCoVarsOfTypes (DataCon -> [Type]
    dataConTheta DataCon
    con))
          = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid   -- See Note [Check that the type variable is truly universal]
          | Bool
    otherwise
          = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ Maybe HasWildcard
    -> [DeriveInstanceBadConstructor] -> DeriveInstanceErrReason
    DerivErrBadConstructor Maybe HasWildcard
    forall a. Maybe a
    Nothing [DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConExistential DataCon
    con]

        ft_check :: DataCon -> FFoldType (Validity' DeriveInstanceErrReason)
        ft_check :: DataCon -> FFoldType (Validity' DeriveInstanceErrReason)
    ft_check DataCon
    con = FT { ft_triv :: Validity' DeriveInstanceErrReason
    ft_triv = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid, ft_var :: Validity' DeriveInstanceErrReason
    ft_var = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
                          , ft_co_var :: Validity' DeriveInstanceErrReason
    ft_co_var = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ Maybe HasWildcard
    -> [DeriveInstanceBadConstructor] -> DeriveInstanceErrReason
    DerivErrBadConstructor Maybe HasWildcard
    forall a. Maybe a
    Nothing [DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConCovariant DataCon
    con]
                          , ft_fun :: Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    ft_fun = \Validity' DeriveInstanceErrReason
    x Validity' DeriveInstanceErrReason
    y -> if Bool
    allowFunctions then Validity' DeriveInstanceErrReason
    x Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    forall a. Validity' a -> Validity' a -> Validity' a
    `andValid` Validity' DeriveInstanceErrReason
    y
                                                               else DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ Maybe HasWildcard
    -> [DeriveInstanceBadConstructor] -> DeriveInstanceErrReason
    DerivErrBadConstructor Maybe HasWildcard
    forall a. Maybe a
    Nothing [DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConFunTypes DataCon
    con]
                          , ft_tup :: TyCon
    -> [Validity' DeriveInstanceErrReason]
    -> Validity' DeriveInstanceErrReason
    ft_tup = \TyCon
    _ [Validity' DeriveInstanceErrReason]
    xs  -> [Validity' DeriveInstanceErrReason]
    -> Validity' DeriveInstanceErrReason
    forall a. [Validity' a] -> Validity' a
    allValid [Validity' DeriveInstanceErrReason]
    xs
                          , ft_ty_app :: Type
    -> Type
    -> Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    ft_ty_app = \Type
    _ Type
    _ Validity' DeriveInstanceErrReason
    x -> Validity' DeriveInstanceErrReason
    x
                          , ft_bad_app :: Validity' DeriveInstanceErrReason
    ft_bad_app = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid (DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason)
    -> DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a b. (a -> b) -> a -> b
    $ Maybe HasWildcard
    -> [DeriveInstanceBadConstructor] -> DeriveInstanceErrReason
    DerivErrBadConstructor Maybe HasWildcard
    forall a. Maybe a
    Nothing [DataCon -> DeriveInstanceBadConstructor
    DerivErrBadConWrongArg DataCon
    con]
                          , ft_forall :: TyVar
    -> Validity' DeriveInstanceErrReason
    -> Validity' DeriveInstanceErrReason
    ft_forall = \TyVar
    _ Validity' DeriveInstanceErrReason
    x   -> Validity' DeriveInstanceErrReason
    x }

    checkFlag :: LangExt.Extension -> Condition
    checkFlag :: Extension -> Condition
    checkFlag Extension
    flag DynFlags
    dflags DerivInstTys
    _
      | Extension -> DynFlags -> Bool
    xopt Extension
    flag DynFlags
    dflags = Validity' DeriveInstanceErrReason
    forall a. Validity' a
    IsValid
      | Bool
    otherwise        = DeriveInstanceErrReason -> Validity' DeriveInstanceErrReason
    forall a. a -> Validity' a
    NotValid DeriveInstanceErrReason
    why
      where
        why :: DeriveInstanceErrReason
    why = Extension -> DeriveInstanceErrReason
    DerivErrLangExtRequired Extension
    the_flag
        the_flag :: Extension
    the_flag = case [ FlagSpec Extension -> Extension
    forall flag. FlagSpec flag -> flag
    flagSpecFlag FlagSpec Extension
    f | FlagSpec Extension
    f <- [FlagSpec Extension]
    xFlags , FlagSpec Extension -> Extension
    forall flag. FlagSpec flag -> flag
    flagSpecFlag FlagSpec Extension
    f Extension -> Extension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Extension
    flag ] of
                     [Extension
    s]   -> Extension
    s
                     [Extension]
    other -> String -> SDoc -> Extension
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "checkFlag" ([Extension] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Extension]
    other)

    std_class_via_coercible :: Class -> Bool
    -- These standard classes can be derived for a newtype
    -- using the coercible trick *even if no -XGeneralizedNewtypeDeriving
    -- because giving so gives the same results as generating the boilerplate
    std_class_via_coercible :: Class -> Bool
    std_class_via_coercible Class
    clas
      = Class -> Unique
    classKey Class
    clas Unique -> [Unique] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Unique
    eqClassKey, Unique
    ordClassKey, Unique
    ixClassKey, Unique
    boundedClassKey]
            -- Not Read/Show because they respect the type
            -- Not Enum, because newtypes are never in Enum

    non_coercible_class :: Class -> Bool
    -- *Never* derive Read, Show, Typeable, Data, Generic, Generic1, Lift
    -- by Coercible, even with -XGeneralizedNewtypeDeriving
    -- Also, avoid Traversable, as the Coercible-derived instance and the "normal"-derived
    -- instance behave differently if there's a non-lawful Applicative out there.
    -- Besides, with roles, Coercible-deriving Traversable is ill-roled.
    non_coercible_class :: Class -> Bool
    non_coercible_class Class
    cls
      = Class -> Unique
    classKey Class
    cls Unique -> [Unique] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([ Unique
    readClassKey, Unique
    showClassKey, Unique
    dataClassKey
                             , Unique
    genClassKey, Unique
    gen1ClassKey, Unique
    typeableClassKey
                             , Unique
    traversableClassKey, Unique
    liftClassKey ])

    ------------------------------------------------------------------

    newDerivClsInst :: DerivSpec ThetaType -> TcM ClsInst
    newDerivClsInst :: DerivSpec [Type] -> TcM ClsInst
    newDerivClsInst (DS { ds_name :: forall theta. DerivSpec theta -> Name
    ds_name = Name
    dfun_name, ds_overlap :: forall theta. DerivSpec theta -> Maybe OverlapMode
    ds_overlap = Maybe OverlapMode
    overlap_mode
                        , ds_tvs :: forall theta. DerivSpec theta -> [TyVar]
    ds_tvs = [TyVar]
    tvs, ds_theta :: forall theta. DerivSpec theta -> theta
    ds_theta = [Type]
    theta
                        , ds_cls :: forall theta. DerivSpec theta -> Class
    ds_cls = Class
    clas, ds_tys :: forall theta. DerivSpec theta -> [Type]
    ds_tys = [Type]
    tys
                        , ds_warn :: forall theta. DerivSpec theta -> Maybe (WarningTxt GhcRn)
    ds_warn = Maybe (WarningTxt GhcRn)
    warn })
      = Maybe OverlapMode
    -> Name
    -> [TyVar]
    -> [Type]
    -> Class
    -> [Type]
    -> Maybe (WarningTxt GhcRn)
    -> TcM ClsInst
    newClsInst Maybe OverlapMode
    overlap_mode Name
    dfun_name [TyVar]
    tvs [Type]
    theta Class
    clas [Type]
    tys Maybe (WarningTxt GhcRn)
    warn

    extendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
    -- Add new locally-defined instances; don't bother to check
    -- for functional dependency errors -- that'll happen in GHC.Tc.TyCl.Instance
    extendLocalInstEnv :: forall a. [ClsInst] -> TcM a -> TcM a
    extendLocalInstEnv [ClsInst]
    dfuns TcM a
    thing_inside
     = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
          ; let  inst_env' = InstEnv -> [ClsInst] -> InstEnv
    extendInstEnvList (TcGblEnv -> InstEnv
    tcg_inst_env TcGblEnv
    env) [ClsInst]
    dfuns
                 env'      = TcGblEnv
    env { tcg_inst_env = inst_env' }
          ; setGblEnv env' thing_inside }

    {-
    Note [Deriving any class]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Classic uses of a deriving clause, or a standalone-deriving declaration, are
    for:
      * a stock class like Eq or Show, for which GHC knows how to generate
        the instance code
      * a newtype, via the mechanism enabled by GeneralizedNewtypeDeriving

    The DeriveAnyClass extension adds a third way to derive instances, based on
    empty instance declarations.

    The canonical use case is in combination with GHC.Generics and default method
    signatures. These allow us to have instance declarations being empty, but still
    useful, e.g.

      data T a = ...blah..blah... deriving( Generic )
      instance C a => C (T a)  -- No 'where' clause

    where C is some "random" user-defined class.

    This boilerplate code can be replaced by the more compact

      data T a = ...blah..blah... deriving( Generic, C )

    if DeriveAnyClass is enabled.

    This is not restricted to Generics; any class can be derived, simply giving
    rise to an empty instance.

    See Note [Gathering and simplifying constraints for DeriveAnyClass] in
    GHC.Tc.Deriv.Infer for an explanation hof how the instance context is inferred for
    DeriveAnyClass.

    Note [Check that the type variable is truly universal]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For Functor and Traversable instances, we must check that the *last argument*
    of the type constructor is used truly universally quantified.  Example

       data T a b where
         T1 :: a -> b -> T a b      -- Fine! Vanilla H-98
         T2 :: b -> c -> T a b      -- Fine! Existential c, but we can still map over 'b'
         T3 :: b -> T Int b         -- Fine! Constraint 'a', but 'b' is still polymorphic
         T4 :: Ord b => b -> T a b  -- No!  'b' is constrained
         T5 :: b -> T b b           -- No!  'b' is constrained
         T6 :: T a (b,b)            -- No!  'b' is constrained

    Notice that only the first of these constructors is vanilla H-98. We only
    need to take care about the last argument (b in this case).  See #8678.
    Eg. for T1-T3 we can write

         fmap f (T1 a b) = T1 a (f b)
         fmap f (T2 b c) = T2 (f b) c
         fmap f (T3 x)   = T3 (f x)

    We need not perform these checks for Foldable instances, however, since
    functions in Foldable can only consume existentially quantified type variables,
    rather than produce them (as is the case in Functor and Traversable functions.)
    As a result, T can have a derived Foldable instance:

        foldr f z (T1 a b) = f b z
        foldr f z (T2 b c) = f b z
        foldr f z (T3 x)   = f x z
        foldr f z (T4 x)   = f x z
        foldr f z (T5 x)   = f x z
        foldr _ z T6       = z

    See Note [DeriveFoldable with ExistentialQuantification] in GHC.Tc.Deriv.Functor.

    For Functor and Traversable, we must take care not to let type synonyms
    unfairly reject a type for not being truly universally quantified. An
    example of this is:

        type C (a :: Constraint) b = a
        data T a b = C (Show a) b => MkT b

    Here, the existential context (C (Show a) b) does technically mention the last
    type variable b. But this is OK, because expanding the type synonym C would give
    us the context (Show a), which doesn't mention b. Therefore, we must make sure
    to expand type synonyms before performing this check. Not doing so led to #13813.
    -}