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

    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}

    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    -- | Typechecking class declarations
    module GHC.Tc.TyCl.Class
       ( tcClassSigs
       , tcClassDecl2
       , findMethodBind
       , instantiateMethod
       , tcClassMinimalDef
       , HsSigFun
       , mkHsSigFun
       , badMethodErr
       , instDeclCtxt1
       , instDeclCtxt2
       , instDeclCtxt3
       , tcATDefault
       )
    where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Hs
    import GHC.Tc.Gen.Sig
    import GHC.Tc.Types.Evidence ( idHsWrapper )
    import GHC.Tc.Gen.Bind
    import GHC.Tc.Utils.Env
    import GHC.Tc.Utils.Unify
    import GHC.Tc.Utils.Instantiate( tcSuperSkolTyVars )
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Utils.TcMType
    import GHC.Core.Type     ( piResultTys )
    import GHC.Core.Predicate
    import GHC.Core.Multiplicity
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Utils.Monad
    import GHC.Tc.TyCl.Build( TcMethInfo )
    import GHC.Core.Class
    import GHC.Core.Coercion ( pprCoAxiom )
    import GHC.Driver.Session
    import GHC.Tc.Instance.Family
    import GHC.Core.FamInstEnv
    import GHC.Types.Id
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Types.Name.Set
    import GHC.Types.Var
    import GHC.Types.Var.Env
    import GHC.Types.SourceFile (HscSource(..))
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Types.SrcLoc
    import GHC.Core.TyCon
    import GHC.Data.Maybe
    import GHC.Types.Basic
    import GHC.Data.Bag
    import GHC.Data.FastString
    import GHC.Data.BooleanFormula
    import GHC.Utils.Misc

    import Control.Monad
    import Data.List ( mapAccumL, partition )

    {-
    Dictionary handling
    ~~~~~~~~~~~~~~~~~~~
    Every class implicitly declares a new data type, corresponding to dictionaries
    of that class. So, for example:

            class (D a) => C a where
              op1 :: a -> a
              op2 :: forall b. Ord b => a -> b -> b

    would implicitly declare

            data CDict a = CDict (D a)
                                 (a -> a)
                                 (forall b. Ord b => a -> b -> b)

    (We could use a record decl, but that means changing more of the existing apparatus.
    One step at a time!)

    For classes with just one superclass+method, we use a newtype decl instead:

            class C a where
              op :: forallb. a -> b -> b

    generates

            newtype CDict a = CDict (forall b. a -> b -> b)

    Now DictTy in Type is just a form of type synomym:
            DictTy c t = TyConTy CDict `AppTy` t

    Death to "ExpandingDicts".

    ************************************************************************
    *                                                                      *
                    Type-checking the class op signatures
    *                                                                      *
    ************************************************************************
    -}

    illegalHsigDefaultMethod :: Name -> SDoc
    illegalHsigDefaultMethod :: Name -> SDoc
    illegalHsigDefaultMethod Name
    n =
        String -> SDoc
    text String
    "Illegal default method(s) in class definition of" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Name
    n SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in hsig file"

    tcClassSigs :: Name                -- Name of the class
                -> [LSig GhcRn]
                -> LHsBinds GhcRn
                -> TcM [TcMethInfo]    -- Exactly one for each method
    tcClassSigs :: Name
    -> [LSig (GhcPass 'Renamed)]
    -> LHsBinds (GhcPass 'Renamed)
    -> TcM [TcMethInfo]
    tcClassSigs Name
    clas [LSig (GhcPass 'Renamed)]
    sigs LHsBinds (GhcPass 'Renamed)
    def_methods
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcClassSigs 1" (forall a. Outputable a => a -> SDoc
    ppr Name
    clas)

           ; [(Name, (SrcSpan, Type))]
    gen_dm_prs <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM (forall a b. (a -> TcM b) -> Located a -> TcM b
    addLocM ([LocatedN Name], LHsSigType (GhcPass 'Renamed))
    -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
    tc_gen_sig) [Located ([LocatedN Name], LHsSigType (GhcPass 'Renamed))]
    gen_sigs
           ; let gen_dm_env :: NameEnv (SrcSpan, Type)
                 gen_dm_env :: NameEnv (SrcSpan, Type)
    gen_dm_env = forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(Name, (SrcSpan, Type))]
    gen_dm_prs

           ; [TcMethInfo]
    op_info <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM (forall a b. (a -> TcM b) -> Located a -> TcM b
    addLocM (NameEnv (SrcSpan, Type)
    -> ([LocatedN Name], LHsSigType (GhcPass 'Renamed))
    -> TcM [TcMethInfo]
    tc_sig NameEnv (SrcSpan, Type)
    gen_dm_env)) [Located ([LocatedN Name], LHsSigType (GhcPass 'Renamed))]
    vanilla_sigs

           ; let op_names :: NameSet
    op_names = [Name] -> NameSet
    mkNameSet [ Name
    n | (Name
    n,Type
    _,Maybe (DefMethSpec (SrcSpan, Type))
    _) <- [TcMethInfo]
    op_info ]
           ; forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ forall a. SDoc -> TcM a
    failWithTc (forall a. Outputable a => a -> Name -> SDoc
    badMethodErr Name
    clas Name
    n)
                       | Name
    n <- [Name]
    dm_bind_names, Bool -> Bool
    not (Name
    n Name -> NameSet -> Bool
    `elemNameSet` NameSet
    op_names) ]
                       -- Value binding for non class-method (ie no TypeSig)

           ; TcGblEnv
    tcg_env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; if TcGblEnv -> HscSource
    tcg_src TcGblEnv
    tcg_env forall a. Eq a => a -> a -> Bool
    == HscSource
    HsigFile
                then
                   -- Error if we have value bindings
                   -- (Generic signatures without value bindings indicate
                   -- that a default of this form is expected to be
                   -- provided.)
                   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null LHsBinds (GhcPass 'Renamed)
    def_methods)) forall a b. (a -> b) -> a -> b
    $
                    forall a. SDoc -> TcM a
    failWithTc (Name -> SDoc
    illegalHsigDefaultMethod Name
    clas)
                else
                   -- Error for each generic signature without value binding
                   forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [ forall a. SDoc -> TcM a
    failWithTc (forall a. Outputable a => a -> Name -> SDoc
    badGenericMethod Name
    clas Name
    n)
                             | (Name
    n,(SrcSpan, Type)
    _) <- [(Name, (SrcSpan, Type))]
    gen_dm_prs, Bool -> Bool
    not (Name
    n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    dm_bind_names) ]

           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcClassSigs 2" (forall a. Outputable a => a -> SDoc
    ppr Name
    clas)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return [TcMethInfo]
    op_info }
      where
        vanilla_sigs :: [Located ([LocatedN Name], LHsSigType GhcRn)] -- AZ temp
        vanilla_sigs :: [Located ([LocatedN Name], LHsSigType (GhcPass 'Renamed))]
    vanilla_sigs = [forall l e. l -> e -> GenLocated l e
    L (forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) ([LIdP (GhcPass 'Renamed)]
    nm,LHsSigType (GhcPass 'Renamed)
    ty) | L SrcSpanAnnA
    loc (ClassOpSig XClassOpSig (GhcPass 'Renamed)
    _ Bool
    False [LIdP (GhcPass 'Renamed)]
    nm LHsSigType (GhcPass 'Renamed)
    ty) <- [LSig (GhcPass 'Renamed)]
    sigs]
        gen_sigs :: [Located ([LocatedN Name], LHsSigType GhcRn)] -- AZ temp
        gen_sigs :: [Located ([LocatedN Name], LHsSigType (GhcPass 'Renamed))]
    gen_sigs     = [forall l e. l -> e -> GenLocated l e
    L (forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) ([LIdP (GhcPass 'Renamed)]
    nm,LHsSigType (GhcPass 'Renamed)
    ty) | L SrcSpanAnnA
    loc (ClassOpSig XClassOpSig (GhcPass 'Renamed)
    _ Bool
    True  [LIdP (GhcPass 'Renamed)]
    nm LHsSigType (GhcPass 'Renamed)
    ty) <- [LSig (GhcPass 'Renamed)]
    sigs]
        dm_bind_names :: [Name] -- These ones have a value binding in the class decl
        dm_bind_names :: [Name]
    dm_bind_names = [Name
    op | L SrcSpanAnnA
    _ (FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
    fun_id = L SrcSpanAnnN
    _ Name
    op}) <- forall a. Bag a -> [a]
    bagToList LHsBinds (GhcPass 'Renamed)
    def_methods]

        tc_sig :: NameEnv (SrcSpan, Type) -> ([LocatedN Name], LHsSigType GhcRn)
               -> TcM [TcMethInfo]
        tc_sig :: NameEnv (SrcSpan, Type)
    -> ([LocatedN Name], LHsSigType (GhcPass 'Renamed))
    -> TcM [TcMethInfo]
    tc_sig NameEnv (SrcSpan, Type)
    gen_dm_env ([LocatedN Name]
    op_names, LHsSigType (GhcPass 'Renamed)
    op_hs_ty)
          = do { String -> SDoc -> TcRn ()
    traceTc String
    "ClsSig 1" (forall a. Outputable a => a -> SDoc
    ppr [LocatedN Name]
    op_names)
               ; Type
    op_ty <- [LocatedN Name] -> LHsSigType (GhcPass 'Renamed) -> TcM Type
    tcClassSigType [LocatedN Name]
    op_names LHsSigType (GhcPass 'Renamed)
    op_hs_ty
                       -- Class tyvars already in scope

               ; String -> SDoc -> TcRn ()
    traceTc String
    "ClsSig 2" (forall a. Outputable a => a -> SDoc
    ppr [LocatedN Name]
    op_names SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr Type
    op_ty)
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return [ (Name
    op_name, Type
    op_ty, Name -> Maybe (DefMethSpec (SrcSpan, Type))
    f Name
    op_name) | L SrcSpanAnnN
    _ Name
    op_name <- [LocatedN Name]
    op_names ] }
               where
                 f :: Name -> Maybe (DefMethSpec (SrcSpan, Type))
    f Name
    nm | Just (SrcSpan, Type)
    lty <- forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv (SrcSpan, Type)
    gen_dm_env Name
    nm = forall a. a -> Maybe a
    Just (forall ty. ty -> DefMethSpec ty
    GenericDM (SrcSpan, Type)
    lty)
                      | Name
    nm forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    dm_bind_names                 = forall a. a -> Maybe a
    Just forall ty. DefMethSpec ty
    VanillaDM
                      | Bool
    otherwise                               = forall a. Maybe a
    Nothing

        tc_gen_sig :: ([LocatedN Name], LHsSigType GhcRn)
                          -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))] -- AZ temp
        tc_gen_sig :: ([LocatedN Name], LHsSigType (GhcPass 'Renamed))
    -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
    tc_gen_sig ([LocatedN Name]
    op_names, LHsSigType (GhcPass 'Renamed)
    gen_hs_ty)
          = do { Type
    gen_op_ty <- [LocatedN Name] -> LHsSigType (GhcPass 'Renamed) -> TcM Type
    tcClassSigType [LocatedN Name]
    op_names LHsSigType (GhcPass 'Renamed)
    gen_hs_ty
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return [ (Name
    op_name, (forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnN
    loc, Type
    gen_op_ty))
                                                     | L SrcSpanAnnN
    loc Name
    op_name <- [LocatedN Name]
    op_names ] }

    {-
    ************************************************************************
    *                                                                      *
                    Class Declarations
    *                                                                      *
    ************************************************************************
    -}

    tcClassDecl2 :: LTyClDecl GhcRn          -- The class declaration
                 -> TcM (LHsBinds GhcTc)

    tcClassDecl2 :: LTyClDecl (GhcPass 'Renamed) -> TcM (LHsBinds GhcTc)
    tcClassDecl2 (L SrcSpanAnnA
    _ (ClassDecl {tcdLName :: forall pass. TyClDecl pass -> LIdP pass
    tcdLName = LIdP (GhcPass 'Renamed)
    class_name, tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
    tcdSigs = [LSig (GhcPass 'Renamed)]
    sigs,
                                    tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
    tcdMeths = LHsBinds (GhcPass 'Renamed)
    default_binds}))
      = forall r. TcRn r -> TcRn r -> TcRn r
    recoverM (forall (m :: * -> *) a. Monad m => a -> m a
    return forall (idL :: Pass) idR. LHsBindsLR (GhcPass idL) idR
    emptyLHsBinds) forall a b. (a -> b) -> a -> b
    $
        forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
    getLocA LIdP (GhcPass 'Renamed)
    class_name) forall a b. (a -> b) -> a -> b
    $
        do  { Class
    clas <- LocatedA Name -> TcM Class
    tcLookupLocatedClass (forall a. LocatedN a -> LocatedA a
    n2l LIdP (GhcPass 'Renamed)
    class_name)

            -- We make a separate binding for each default method.
            -- At one time I used a single AbsBinds for all of them, thus
            -- AbsBind [d] [dm1, dm2, dm3] { dm1 = ...; dm2 = ...; dm3 = ... }
            -- But that desugars into
            --      ds = \d -> (..., ..., ...)
            --      dm1 = \d -> case ds d of (a,b,c) -> a
            -- And since ds is big, it doesn't get inlined, so we don't get good
            -- default methods.  Better to make separate AbsBinds for each
            ; let ([TcId]
    tyvars, [Type]
    _, [TcId]
    _, [ClassOpItem]
    op_items) = Class -> ([TcId], [Type], [TcId], [ClassOpItem])
    classBigSig Class
    clas
                  prag_fn :: TcPragEnv
    prag_fn     = [LSig (GhcPass 'Renamed)]
    -> LHsBinds (GhcPass 'Renamed) -> TcPragEnv
    mkPragEnv [LSig (GhcPass 'Renamed)]
    sigs LHsBinds (GhcPass 'Renamed)
    default_binds
                  sig_fn :: HsSigFun
    sig_fn      = [LSig (GhcPass 'Renamed)] -> HsSigFun
    mkHsSigFun [LSig (GhcPass 'Renamed)]
    sigs
                  clas_tyvars :: [TcId]
    clas_tyvars = forall a b. (a, b) -> b
    snd ([TcId] -> (TCvSubst, [TcId])
    tcSuperSkolTyVars [TcId]
    tyvars)
                  pred :: Type
    pred        = Class -> [Type] -> Type
    mkClassPred Class
    clas ([TcId] -> [Type]
    mkTyVarTys [TcId]
    clas_tyvars)
            ; TcId
    this_dict <- forall gbl lcl. Type -> TcRnIf gbl lcl TcId
    newEvVar Type
    pred

            ; let tc_item :: ClassOpItem -> TcM (LHsBinds GhcTc)
    tc_item = Class
    -> [TcId]
    -> TcId
    -> LHsBinds (GhcPass 'Renamed)
    -> HsSigFun
    -> TcPragEnv
    -> ClassOpItem
    -> TcM (LHsBinds GhcTc)
    tcDefMeth Class
    clas [TcId]
    clas_tyvars TcId
    this_dict
                                      LHsBinds (GhcPass 'Renamed)
    default_binds HsSigFun
    sig_fn TcPragEnv
    prag_fn
            ; [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
    dm_binds <- forall r. [TcId] -> TcM r -> TcM r
    tcExtendTyVarEnv [TcId]
    clas_tyvars forall a b. (a -> b) -> a -> b
    $
                          forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ClassOpItem -> TcM (LHsBinds GhcTc)
    tc_item [ClassOpItem]
    op_items

            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. [Bag a] -> Bag a
    unionManyBags [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
    dm_binds) }

    tcClassDecl2 LTyClDecl (GhcPass 'Renamed)
    d = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcClassDecl2" (forall a. Outputable a => a -> SDoc
    ppr LTyClDecl (GhcPass 'Renamed)
    d)

    tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn
              -> HsSigFun -> TcPragEnv -> ClassOpItem
              -> TcM (LHsBinds GhcTc)
    -- Generate code for default methods
    -- This is incompatible with Hugs, which expects a polymorphic
    -- default method for every class op, regardless of whether or not
    -- the programmer supplied an explicit default decl for the class.
    -- (If necessary we can fix that, but we don't have a convenient Id to hand.)

    tcDefMeth :: Class
    -> [TcId]
    -> TcId
    -> LHsBinds (GhcPass 'Renamed)
    -> HsSigFun
    -> TcPragEnv
    -> ClassOpItem
    -> TcM (LHsBinds GhcTc)
    tcDefMeth Class
    _ [TcId]
    _ TcId
    _ LHsBinds (GhcPass 'Renamed)
    _ HsSigFun
    _ TcPragEnv
    prag_fn (TcId
    sel_id, Maybe (Name, DefMethSpec Type)
    Nothing)
      = do { -- No default method
             forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (forall a b ann.
    (a -> TcM b) -> GenLocated (SrcSpanAnn' ann) a -> TcM b
    addLocMA (TcId -> Sig (GhcPass 'Renamed) -> TcRn ()
    badDmPrag TcId
    sel_id))
                   (TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
    lookupPragEnv TcPragEnv
    prag_fn (TcId -> Name
    idName TcId
    sel_id))
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Bag a
    emptyBag }

    tcDefMeth Class
    clas [TcId]
    tyvars TcId
    this_dict LHsBinds (GhcPass 'Renamed)
    binds_in HsSigFun
    hs_sig_fn TcPragEnv
    prag_fn
              (TcId
    sel_id, Just (Name
    dm_name, DefMethSpec Type
    dm_spec))
      | Just (L SrcSpanAnnA
    bind_loc HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    dm_bind, SrcSpan
    bndr_loc, [LSig (GhcPass 'Renamed)]
    prags) <- Name
    -> LHsBinds (GhcPass 'Renamed)
    -> TcPragEnv
    -> Maybe
         (LHsBind (GhcPass 'Renamed), SrcSpan, [LSig (GhcPass 'Renamed)])
    findMethodBind Name
    sel_name LHsBinds (GhcPass 'Renamed)
    binds_in TcPragEnv
    prag_fn
      = do { -- First look up the default method; it should be there!
             -- It can be the ordinary default method
             -- or the generic-default method.  E.g of the latter
             --      class C a where
             --        op :: a -> a -> Bool
             --        default op :: Eq a => a -> a -> Bool
             --        op x y = x==y
             -- The default method we generate is
             --    $gm :: (C a, Eq a) => a -> a -> Bool
             --    $gm x y = x==y

             TcId
    global_dm_id  <- Name -> TcM TcId
    tcLookupId Name
    dm_name
           ; TcId
    global_dm_id  <- TcId -> [LSig (GhcPass 'Renamed)] -> TcM TcId
    addInlinePrags TcId
    global_dm_id [LSig (GhcPass 'Renamed)]
    prags
           ; Name
    local_dm_name <- OccName -> SrcSpan -> TcM Name
    newNameAt (forall a. NamedThing a => a -> OccName
    getOccName Name
    sel_name) SrcSpan
    bndr_loc
                -- Base the local_dm_name on the selector name, because
                -- type errors from tcInstanceMethodBody come from here

           ; [LTcSpecPrag]
    spec_prags <- forall a. TcM a -> TcM a
    discardConstraints forall a b. (a -> b) -> a -> b
    $
                           TcId -> [LSig (GhcPass 'Renamed)] -> TcM [LTcSpecPrag]
    tcSpecPrags TcId
    global_dm_id [LSig (GhcPass 'Renamed)]
    prags
           ; WarnReason -> Bool -> SDoc -> TcRn ()
    warnTc WarnReason
    NoReason
                    (Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LTcSpecPrag]
    spec_prags))
                    (String -> SDoc
    text String
    "Ignoring SPECIALISE pragmas on default method"
                     SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Name
    sel_name))

           ; let hs_ty :: GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
    hs_ty = HsSigFun
    hs_sig_fn Name
    sel_name
                         forall a. Maybe a -> a -> a
    `orElse` forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tc_dm" (forall a. Outputable a => a -> SDoc
    ppr Name
    sel_name)
                 -- We need the HsType so that we can bring the right
                 -- type variables into scope
                 --
                 -- Eg.   class C a where
                 --          op :: forall b. Eq b => a -> [b] -> a
                 --          gen_op :: a -> a
                 --          generic gen_op :: D a => a -> a
                 -- The "local_dm_ty" is precisely the type in the above
                 -- type signatures, ie with no "forall a. C a =>" prefix

                 local_dm_ty :: Type
    local_dm_ty = Class -> TcId -> [Type] -> Type
    instantiateMethod Class
    clas TcId
    global_dm_id ([TcId] -> [Type]
    mkTyVarTys [TcId]
    tyvars)

                 lm_bind :: HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    lm_bind     = HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    dm_bind { fun_id :: LIdP (GhcPass 'Renamed)
    fun_id = forall l e. l -> e -> GenLocated l e
    L (forall a. SrcSpanAnn' a -> SrcSpanAnnN
    la2na SrcSpanAnnA
    bind_loc) Name
    local_dm_name }
                                 -- Substitute the local_meth_name for the binder
                                 -- NB: the binding is always a FunBind

                 warn_redundant :: Bool
    warn_redundant = case DefMethSpec Type
    dm_spec of
                                    GenericDM {} -> Bool
    True
                                    DefMethSpec Type
    VanillaDM    -> Bool
    False
                    -- For GenericDM, warn if the user specifies a signature
                    -- with redundant constraints; but not for VanillaDM, where
                    -- the default method may well be 'error' or something

                 ctxt :: UserTypeCtxt
    ctxt = Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    sel_name Bool
    warn_redundant

           ; let local_dm_id :: TcId
    local_dm_id = HasDebugCallStack => Name -> Type -> Type -> TcId
    mkLocalId Name
    local_dm_name Type
    Many Type
    local_dm_ty
                 local_dm_sig :: TcIdSigInfo
    local_dm_sig = CompleteSig { sig_bndr :: TcId
    sig_bndr = TcId
    local_dm_id
                                            , sig_ctxt :: UserTypeCtxt
    sig_ctxt  = UserTypeCtxt
    ctxt
                                            , sig_loc :: SrcSpan
    sig_loc   = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
    getLocA GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
    hs_ty }

           ; (TcEvBinds
    ev_binds, (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    tc_bind, [TcId]
    _))
                   <- forall result.
    SkolemInfo
    -> [TcId] -> [TcId] -> TcM result -> TcM (TcEvBinds, result)
    checkConstraints SkolemInfo
    skol_info [TcId]
    tyvars [TcId
    this_dict] forall a b. (a -> b) -> a -> b
    $
                      TcPragEnv
    -> TcIdSigInfo
    -> LHsBind (GhcPass 'Renamed)
    -> TcM (LHsBinds GhcTc, [TcId])
    tcPolyCheck NameEnv [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
    no_prag_fn TcIdSigInfo
    local_dm_sig
                                  (forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    bind_loc HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    lm_bind)

           ; let export :: ABExport GhcTc
    export = ABE { abe_ext :: XABE GhcTc
    abe_ext   = NoExtField
    noExtField
                              , abe_poly :: IdP GhcTc
    abe_poly  = TcId
    global_dm_id
                              , abe_mono :: IdP GhcTc
    abe_mono  = TcId
    local_dm_id
                              , abe_wrap :: HsWrapper
    abe_wrap  = HsWrapper
    idHsWrapper
                              , abe_prags :: TcSpecPrags
    abe_prags = TcSpecPrags
    IsDefaultMethod }
                 full_bind :: HsBindLR GhcTc GhcTc
    full_bind = AbsBinds { abs_ext :: XAbsBinds GhcTc GhcTc
    abs_ext      = NoExtField
    noExtField
                                      , abs_tvs :: [TcId]
    abs_tvs      = [TcId]
    tyvars
                                      , abs_ev_vars :: [TcId]
    abs_ev_vars  = [TcId
    this_dict]
                                      , abs_exports :: [ABExport GhcTc]
    abs_exports  = [ABExport GhcTc
    export]
                                      , abs_ev_binds :: [TcEvBinds]
    abs_ev_binds = [TcEvBinds
    ev_binds]
                                      , abs_binds :: LHsBinds GhcTc
    abs_binds    = Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    tc_bind
                                      , abs_sig :: Bool
    abs_sig      = Bool
    True }

           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> Bag a
    unitBag (forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    bind_loc HsBindLR GhcTc GhcTc
    full_bind)) }

      | Bool
    otherwise = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcDefMeth" (forall a. Outputable a => a -> SDoc
    ppr TcId
    sel_id)
      where
        skol_info :: SkolemInfo
    skol_info = TyConFlavour -> Name -> SkolemInfo
    TyConSkol TyConFlavour
    ClassFlavour (forall a. NamedThing a => a -> Name
    getName Class
    clas)
        sel_name :: Name
    sel_name = TcId -> Name
    idName TcId
    sel_id
        no_prag_fn :: TcPragEnv
    no_prag_fn = TcPragEnv
    emptyPragEnv   -- No pragmas for local_meth_id;
                                    -- they are all for meth_id

    ---------------
    tcClassMinimalDef :: Name -> [LSig GhcRn] -> [TcMethInfo] -> TcM ClassMinimalDef
    tcClassMinimalDef :: Name
    -> [LSig (GhcPass 'Renamed)] -> [TcMethInfo] -> TcM ClassMinimalDef
    tcClassMinimalDef Name
    _clas [LSig (GhcPass 'Renamed)]
    sigs [TcMethInfo]
    op_info
      = case [LSig (GhcPass 'Renamed)] -> Maybe ClassMinimalDef
    findMinimalDef [LSig (GhcPass 'Renamed)]
    sigs of
          Maybe ClassMinimalDef
    Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
    return ClassMinimalDef
    defMindef
          Just ClassMinimalDef
    mindef -> do
            -- Warn if the given mindef does not imply the default one
            -- That is, the given mindef should at least ensure that the
            -- class ops without default methods are required, since we
            -- have no way to fill them in otherwise
            TcGblEnv
    tcg_env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            -- However, only do this test when it's not an hsig file,
            -- since you can't write a default implementation.
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TcGblEnv -> HscSource
    tcg_src TcGblEnv
    tcg_env forall a. Eq a => a -> a -> Bool
    /= HscSource
    HsigFile) forall a b. (a -> b) -> a -> b
    $
                forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenIsJust (forall a.
    Eq a =>
    (a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a)
    isUnsatisfied (ClassMinimalDef
    mindef forall a. Eq a => BooleanFormula a -> a -> Bool
    `impliesAtom`) ClassMinimalDef
    defMindef) forall a b. (a -> b) -> a -> b
    $
                           (\ClassMinimalDef
    bf -> WarnReason -> SDoc -> TcRn ()
    addWarnTc WarnReason
    NoReason (ClassMinimalDef -> SDoc
    warningMinimalDefIncomplete ClassMinimalDef
    bf))
            forall (m :: * -> *) a. Monad m => a -> m a
    return ClassMinimalDef
    mindef
      where
        -- By default require all methods without a default implementation
        defMindef :: ClassMinimalDef
        defMindef :: ClassMinimalDef
    defMindef = forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
    mkAnd [ forall a an. a -> LocatedAn an a
    noLocA (forall a. a -> BooleanFormula a
    mkVar Name
    name)
                          | (Name
    name, Type
    _, Maybe (DefMethSpec (SrcSpan, Type))
    Nothing) <- [TcMethInfo]
    op_info ]

    instantiateMethod :: Class -> TcId -> [TcType] -> TcType
    -- Take a class operation, say
    --      op :: forall ab. C a => forall c. Ix c => (b,c) -> a
    -- Instantiate it at [ty1,ty2]
    -- Return the "local method type":
    --      forall c. Ix x => (ty2,c) -> ty1
    instantiateMethod :: Class -> TcId -> [Type] -> Type
    instantiateMethod Class
    clas TcId
    sel_id [Type]
    inst_tys
      = ASSERT( ok_first_pred ) local_meth_ty
      where
        rho_ty :: Type
    rho_ty = HasDebugCallStack => Type -> [Type] -> Type
    piResultTys (TcId -> Type
    idType TcId
    sel_id) [Type]
    inst_tys
        (Type
    first_pred, Type
    local_meth_ty) = Type -> Maybe (Type, Type)
    tcSplitPredFunTy_maybe Type
    rho_ty
                    forall a. Maybe a -> a -> a
    `orElse` forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcInstanceMethod" (forall a. Outputable a => a -> SDoc
    ppr TcId
    sel_id)

        ok_first_pred :: Bool
    ok_first_pred = case Type -> Maybe (Class, [Type])
    getClassPredTys_maybe Type
    first_pred of
                          Just (Class
    clas1, [Type]
    _tys) -> Class
    clas forall a. Eq a => a -> a -> Bool
    == Class
    clas1
                          Maybe (Class, [Type])
    Nothing -> Bool
    False
                  -- The first predicate should be of form (C a b)
                  -- where C is the class in question

    ---------------------------
    type HsSigFun = Name -> Maybe (LHsSigType GhcRn)

    mkHsSigFun :: [LSig GhcRn] -> HsSigFun
    mkHsSigFun :: [LSig (GhcPass 'Renamed)] -> HsSigFun
    mkHsSigFun [LSig (GhcPass 'Renamed)]
    sigs = forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
    env
      where
        env :: NameEnv (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
    env = forall a.
    (LSig (GhcPass 'Renamed) -> Maybe ([LocatedN Name], a))
    -> [LSig (GhcPass 'Renamed)] -> NameEnv a
    mkHsSigEnv LSig (GhcPass 'Renamed)
    -> Maybe ([LocatedN Name], LHsSigType (GhcPass 'Renamed))
    get_classop_sig [LSig (GhcPass 'Renamed)]
    sigs

        get_classop_sig :: LSig GhcRn -> Maybe ([LocatedN Name], LHsSigType GhcRn)
        get_classop_sig :: LSig (GhcPass 'Renamed)
    -> Maybe ([LocatedN Name], LHsSigType (GhcPass 'Renamed))
    get_classop_sig  (L SrcSpanAnnA
    _ (ClassOpSig XClassOpSig (GhcPass 'Renamed)
    _ Bool
    _ [LIdP (GhcPass 'Renamed)]
    ns LHsSigType (GhcPass 'Renamed)
    hs_ty)) = forall a. a -> Maybe a
    Just ([LIdP (GhcPass 'Renamed)]
    ns, LHsSigType (GhcPass 'Renamed)
    hs_ty)
        get_classop_sig  LSig (GhcPass 'Renamed)
    _                               = forall a. Maybe a
    Nothing

    ---------------------------
    findMethodBind  :: Name                 -- Selector
                    -> LHsBinds GhcRn       -- A group of bindings
                    -> TcPragEnv
                    -> Maybe (LHsBind GhcRn, SrcSpan, [LSig GhcRn])
                    -- Returns the binding, the binding
                    -- site of the method binder, and any inline or
                    -- specialisation pragmas
    findMethodBind :: Name
    -> LHsBinds (GhcPass 'Renamed)
    -> TcPragEnv
    -> Maybe
         (LHsBind (GhcPass 'Renamed), SrcSpan, [LSig (GhcPass 'Renamed)])
    findMethodBind Name
    sel_name LHsBinds (GhcPass 'Renamed)
    binds TcPragEnv
    prag_fn
      = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    mplus forall a. Maybe a
    Nothing (forall a b. (a -> b) -> Bag a -> Bag b
    mapBag GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> Maybe
         (GenLocated
            SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
          SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
    f LHsBinds (GhcPass 'Renamed)
    binds)
      where
        prags :: [LSig (GhcPass 'Renamed)]
    prags    = TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
    lookupPragEnv TcPragEnv
    prag_fn Name
    sel_name

        f :: GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> Maybe
         (GenLocated
            SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
          SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
    f bind :: GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    bind@(L SrcSpanAnnA
    _ (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
    fun_id = L SrcSpanAnnN
    bndr_loc Name
    op_name }))
          | Name
    op_name forall a. Eq a => a -> a -> Bool
    == Name
    sel_name
                 = forall a. a -> Maybe a
    Just (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    bind, forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnN
    bndr_loc, [LSig (GhcPass 'Renamed)]
    prags)
        f GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    _other = forall a. Maybe a
    Nothing

    ---------------------------
    findMinimalDef :: [LSig GhcRn] -> Maybe ClassMinimalDef
    findMinimalDef :: [LSig (GhcPass 'Renamed)] -> Maybe ClassMinimalDef
    findMinimalDef = forall (f :: * -> *) a. Foldable f => f (Maybe a) -> Maybe a
    firstJusts forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a -> b) -> [a] -> [b]
    map LSig (GhcPass 'Renamed) -> Maybe ClassMinimalDef
    toMinimalDef
      where
        toMinimalDef :: LSig GhcRn -> Maybe ClassMinimalDef
        toMinimalDef :: LSig (GhcPass 'Renamed) -> Maybe ClassMinimalDef
    toMinimalDef (L SrcSpanAnnA
    _ (MinimalSig XMinimalSig (GhcPass 'Renamed)
    _ SourceText
    _ (L SrcSpanAnnL
    _ BooleanFormula (LIdP (GhcPass 'Renamed))
    bf))) = forall a. a -> Maybe a
    Just (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall l e. GenLocated l e -> e
    unLoc BooleanFormula (LIdP (GhcPass 'Renamed))
    bf)
        toMinimalDef LSig (GhcPass 'Renamed)
    _                               = forall a. Maybe a
    Nothing

    {-
    Note [Polymorphic methods]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
        class Foo a where
            op :: forall b. Ord b => a -> b -> b -> b
        instance Foo c => Foo [c] where
            op = e

    When typechecking the binding 'op = e', we'll have a meth_id for op
    whose type is
          op :: forall c. Foo c => forall b. Ord b => [c] -> b -> b -> b

    So tcPolyBinds must be capable of dealing with nested polytypes;
    and so it is. See GHC.Tc.Gen.Bind.tcMonoBinds (with type-sig case).

    Note [Silly default-method bind]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we pass the default method binding to the type checker, it must
    look like    op2 = e
    not          $dmop2 = e
    otherwise the "$dm" stuff comes out error messages.  But we want the
    "$dm" to come out in the interface file.  So we typecheck the former,
    and wrap it in a let, thus
              $dmop2 = let op2 = e in op2
    This makes the error messages right.

    ************************************************************************
    *                                                                      *
                    Error messages
    *                                                                      *
    ************************************************************************
    -}

    badMethodErr :: Outputable a => a -> Name -> SDoc
    badMethodErr :: forall a. Outputable a => a -> Name -> SDoc
    badMethodErr a
    clas Name
    op
      = [SDoc] -> SDoc
    hsep [String -> SDoc
    text String
    "Class", SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr a
    clas),
              String -> SDoc
    text String
    "does not have a method", SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Name
    op)]

    badGenericMethod :: Outputable a => a -> Name -> SDoc
    badGenericMethod :: forall a. Outputable a => a -> Name -> SDoc
    badGenericMethod a
    clas Name
    op
      = [SDoc] -> SDoc
    hsep [String -> SDoc
    text String
    "Class", SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr a
    clas),
              String -> SDoc
    text String
    "has a generic-default signature without a binding", SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Name
    op)]

    {-
    badGenericInstanceType :: LHsBinds Name -> SDoc
    badGenericInstanceType binds
      = vcat [text "Illegal type pattern in the generic bindings",
              nest 2 (ppr binds)]

    missingGenericInstances :: [Name] -> SDoc
    missingGenericInstances missing
      = text "Missing type patterns for" <+> pprQuotedList missing

    dupGenericInsts :: [(TyCon, InstInfo a)] -> SDoc
    dupGenericInsts tc_inst_infos
      = vcat [text "More than one type pattern for a single generic type constructor:",
              nest 2 (vcat (map ppr_inst_ty tc_inst_infos)),
              text "All the type patterns for a generic type constructor must be identical"
        ]
      where
        ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
    -}
    badDmPrag :: TcId -> Sig GhcRn -> TcM ()
    badDmPrag :: TcId -> Sig (GhcPass 'Renamed) -> TcRn ()
    badDmPrag TcId
    sel_id Sig (GhcPass 'Renamed)
    prag
      = SDoc -> TcRn ()
    addErrTc (String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> forall name. Sig name -> SDoc
    hsSigDoc Sig (GhcPass 'Renamed)
    prag SDoc -> SDoc -> SDoc
    <+> PtrString -> SDoc
    ptext (String -> PtrString
    sLit String
    "for default method")
                  SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr TcId
    sel_id)
                  SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "lacks an accompanying binding")

    warningMinimalDefIncomplete :: ClassMinimalDef -> SDoc
    warningMinimalDefIncomplete :: ClassMinimalDef -> SDoc
    warningMinimalDefIncomplete ClassMinimalDef
    mindef
      = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "The MINIMAL pragma does not require:"
             , Int -> SDoc -> SDoc
    nest Int
    2 (forall a. Outputable a => BooleanFormula a -> SDoc
    pprBooleanFormulaNice ClassMinimalDef
    mindef)
             , String -> SDoc
    text String
    "but there is no default implementation." ]

    instDeclCtxt1 :: LHsSigType GhcRn -> SDoc
    instDeclCtxt1 :: LHsSigType (GhcPass 'Renamed) -> SDoc
    instDeclCtxt1 LHsSigType (GhcPass 'Renamed)
    hs_inst_ty
      = SDoc -> SDoc
    inst_decl_ctxt (forall a. Outputable a => a -> SDoc
    ppr (forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
    getLHsInstDeclHead LHsSigType (GhcPass 'Renamed)
    hs_inst_ty))

    instDeclCtxt2 :: Type -> SDoc
    instDeclCtxt2 :: Type -> SDoc
    instDeclCtxt2 Type
    dfun_ty
      = Class -> [Type] -> SDoc
    instDeclCtxt3 Class
    cls [Type]
    tys
      where
        ([TcId]
    _,[Type]
    _,Class
    cls,[Type]
    tys) = Type -> ([TcId], [Type], Class, [Type])
    tcSplitDFunTy Type
    dfun_ty

    instDeclCtxt3 :: Class -> [Type] -> SDoc
    instDeclCtxt3 :: Class -> [Type] -> SDoc
    instDeclCtxt3 Class
    cls [Type]
    cls_tys
      = SDoc -> SDoc
    inst_decl_ctxt (forall a. Outputable a => a -> SDoc
    ppr (Class -> [Type] -> Type
    mkClassPred Class
    cls [Type]
    cls_tys))

    inst_decl_ctxt :: SDoc -> SDoc
    inst_decl_ctxt :: SDoc -> SDoc
    inst_decl_ctxt SDoc
    doc = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In the instance declaration for")
                            Int
    2 (SDoc -> SDoc
    quotes SDoc
    doc)

    tcATDefault :: SrcSpan
                -> TCvSubst
                -> NameSet
                -> ClassATItem
                -> TcM [FamInst]
    -- ^ Construct default instances for any associated types that
    -- aren't given a user definition
    -- Returns [] or singleton
    tcATDefault :: SrcSpan -> TCvSubst -> NameSet -> ClassATItem -> TcM [FamInst]
    tcATDefault SrcSpan
    loc TCvSubst
    inst_subst NameSet
    defined_ats (ATI TyCon
    fam_tc Maybe (Type, ATValidityInfo)
    defs)
      -- User supplied instances ==> everything is OK
      | TyCon -> Name
    tyConName TyCon
    fam_tc Name -> NameSet -> Bool
    `elemNameSet` NameSet
    defined_ats
      = forall (m :: * -> *) a. Monad m => a -> m a
    return []

      -- No user instance, have defaults ==> instantiate them
       -- Example:   class C a where { type F a b :: *; type F a b = () }
       --            instance C [x]
       -- Then we want to generate the decl:   type F [x] b = ()
      | Just (Type
    rhs_ty, ATValidityInfo
    _loc) <- Maybe (Type, ATValidityInfo)
    defs
      = do { let (TCvSubst
    subst', [Type]
    pat_tys') = forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL TCvSubst -> TcId -> (TCvSubst, Type)
    subst_tv TCvSubst
    inst_subst
                                                (TyCon -> [TcId]
    tyConTyVars TyCon
    fam_tc)
                 rhs' :: Type
    rhs'     = TCvSubst -> Type -> Type
    substTyUnchecked TCvSubst
    subst' Type
    rhs_ty
                 tcv' :: [TcId]
    tcv' = [Type] -> [TcId]
    tyCoVarsOfTypesList [Type]
    pat_tys'
                 ([TcId]
    tv', [TcId]
    cv') = forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition TcId -> Bool
    isTyVar [TcId]
    tcv'
                 tvs' :: [TcId]
    tvs'     = [TcId] -> [TcId]
    scopedSort [TcId]
    tv'
                 cvs' :: [TcId]
    cvs'     = [TcId] -> [TcId]
    scopedSort [TcId]
    cv'
           ; Name
    rep_tc_name <- LocatedN Name -> [Type] -> TcM Name
    newFamInstTyConName (forall l e. l -> e -> GenLocated l e
    L (forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc) (TyCon -> Name
    tyConName TyCon
    fam_tc)) [Type]
    pat_tys'
           ; let axiom :: CoAxiom Unbranched
    axiom = Role
    -> Name
    -> [TcId]
    -> [TcId]
    -> [TcId]
    -> TyCon
    -> [Type]
    -> Type
    -> CoAxiom Unbranched
    mkSingleCoAxiom Role
    Nominal Name
    rep_tc_name [TcId]
    tvs' [] [TcId]
    cvs'
                                         TyCon
    fam_tc [Type]
    pat_tys' Type
    rhs'
               -- NB: no validity check. We check validity of default instances
               -- in the class definition. Because type instance arguments cannot
               -- be type family applications and cannot be polytypes, the
               -- validity check is redundant.

           ; String -> SDoc -> TcRn ()
    traceTc String
    "mk_deflt_at_instance" ([SDoc] -> SDoc
    vcat [ forall a. Outputable a => a -> SDoc
    ppr TyCon
    fam_tc, forall a. Outputable a => a -> SDoc
    ppr Type
    rhs_ty
                                                  , forall (br :: BranchFlag). CoAxiom br -> SDoc
    pprCoAxiom CoAxiom Unbranched
    axiom ])
           ; FamInst
    fam_inst <- FamFlavor -> CoAxiom Unbranched -> TcM FamInst
    newFamInst FamFlavor
    SynFamilyInst CoAxiom Unbranched
    axiom
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return [FamInst
    fam_inst] }

       -- No defaults ==> generate a warning
      | Bool
    otherwise  -- defs = Nothing
      = do { Name -> TcRn ()
    warnMissingAT (TyCon -> Name
    tyConName TyCon
    fam_tc)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return [] }
      where
        subst_tv :: TCvSubst -> TcId -> (TCvSubst, Type)
    subst_tv TCvSubst
    subst TcId
    tc_tv
          | Just Type
    ty <- forall a. VarEnv a -> TcId -> Maybe a
    lookupVarEnv (TCvSubst -> TvSubstEnv
    getTvSubstEnv TCvSubst
    subst) TcId
    tc_tv
          = (TCvSubst
    subst, Type
    ty)
          | Bool
    otherwise
          = (TCvSubst -> TcId -> Type -> TCvSubst
    extendTvSubst TCvSubst
    subst TcId
    tc_tv Type
    ty', Type
    ty')
          where
            ty' :: Type
    ty' = TcId -> Type
    mkTyVarTy ((Type -> Type) -> TcId -> TcId
    updateTyVarKind (TCvSubst -> Type -> Type
    substTyUnchecked TCvSubst
    subst) TcId
    tc_tv)

    warnMissingAT :: Name -> TcM ()
    warnMissingAT :: Name -> TcRn ()
    warnMissingAT Name
    name
      = do { Bool
    warn <- forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnMissingMethods
           ; String -> SDoc -> TcRn ()
    traceTc String
    "warn" (forall a. Outputable a => a -> SDoc
    ppr Name
    name SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Bool
    warn)
           ; HscSource
    hsc_src <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TcGblEnv -> HscSource
    tcg_src forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           -- hs-boot and signatures never need to provide complete "definitions"
           -- of any sort, as they aren't really defining anything, but just
           -- constraining items which are defined elsewhere.
           ; WarnReason -> Bool -> SDoc -> TcRn ()
    warnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnMissingMethods) (Bool
    warn Bool -> Bool -> Bool
    && HscSource
    hsc_src forall a. Eq a => a -> a -> Bool
    == HscSource
    HsSrcFile)
                    (String -> SDoc
    text String
    "No explicit" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "associated type"
                        SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "or default declaration for"
                        SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Name
    name)) }