compiler/typecheck/TcClassDcl.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 Typechecking class declarations
   7
   8 \begin{code}
   9 module TcClassDcl ( tcClassSigs, tcClassDecl2,
  10                     findMethodBind, instantiateMethod, tcInstanceMethodBody,
  11                     mkGenericDefMethBind, getGenericInstances,
  12                     tcAddDeclCtxt, badMethodErr, badATErr, omittedATWarn
  13                   ) where
  14
  15 #include "HsVersions.h"
  16
  17 import HsSyn
  18 import RnHsSyn
  19 import RnExpr
  20 import Inst
  21 import InstEnv
  22 import TcEnv
  23 import TcBinds
  24 import TcUnify
  25 import TcHsType
  26 import TcMType
  27 import TcType
  28 import TcRnMonad
  29 import BuildTyCl( TcMethInfo )
  30 import Generics
  31 import Class
  32 import TyCon
  33 import MkId
  34 import Id
  35 import Name
  36 import Var
  37 import VarSet
  38 import NameEnv
  39 import NameSet
  40 import Outputable
  41 import PrelNames
  42 import DynFlags
  43 import ErrUtils
  44 import Util
  45 import ListSetOps
  46 import SrcLoc
  47 import Maybes
  48 import BasicTypes
  49 import Bag
  50 import FastString
  51
  52 import Control.Monad
  53 import Data.List
  54 \end{code}
  55
  56
  57 Dictionary handling
  58 ~~~~~~~~~~~~~~~~~~~
  59 Every class implicitly declares a new data type, corresponding to dictionaries
  60 of that class. So, for example:
  61
  62         class (D a) => C a where
  63           op1 :: a -> a
  64           op2 :: forall b. Ord b => a -> b -> b
  65
  66 would implicitly declare
  67
  68         data CDict a = CDict (D a)
  69                              (a -> a)
  70                              (forall b. Ord b => a -> b -> b)
  71
  72 (We could use a record decl, but that means changing more of the existing apparatus.
  73 One step at at time!)
  74
  75 For classes with just one superclass+method, we use a newtype decl instead:
  76
  77         class C a where
  78           op :: forallb. a -> b -> b
  79
  80 generates
  81
  82         newtype CDict a = CDict (forall b. a -> b -> b)
  83
  84 Now DictTy in Type is just a form of type synomym:
  85         DictTy c t = TyConTy CDict `AppTy` t
  86
  87 Death to "ExpandingDicts".
  88
  89
  90 %************************************************************************
  91 %*                                                                      *
  92                 Type-checking the class op signatures
  93 %*                                                                      *
  94 %************************************************************************
  95
  96 \begin{code}
  97 tcClassSigs :: Name                     -- Name of the class
  98             -> [LSig Name]
  99             -> LHsBinds Name
 100             -> TcM [TcMethInfo]
 101
 102 tcClassSigs clas sigs def_methods
 103   = do { dm_env <- mapM (addLocM (checkDefaultBind clas op_names))
 104                         (bagToList def_methods)
 105        ; mapM (tcClassSig (mkNameEnv dm_env)) op_sigs }
 106   where
 107     op_sigs  = [sig | sig@(L _ (TypeSig _ _))       <- sigs]
 108     op_names = [n   |     (L _ (TypeSig (L _ n) _)) <- op_sigs]
 109
 110 checkDefaultBind :: Name -> [Name] -> HsBindLR Name Name -> TcM (Name, DefMethSpec)
 111   -- Check default bindings
 112   --    a) must be for a class op for this class
 113   --    b) must be all generic or all non-generic
 114 checkDefaultBind clas ops (FunBind {fun_id = L _ op, fun_matches = MatchGroup matches _ })
 115   = do {        -- Check that the op is from this class
 116          checkTc (op `elem` ops) (badMethodErr clas op)
 117
 118         -- Check that all the defns ar generic, or none are
 119        ; case (none_generic, all_generic) of
 120            (True, _) -> return (op, VanillaDM)
 121            (_, True) -> return (op, GenericDM)
 122            _         -> failWith (mixedGenericErr op)
 123     }
 124   where
 125     n_generic    = count (isJust . maybeGenericMatch) matches
 126     none_generic = n_generic == 0
 127     all_generic  = matches `lengthIs` n_generic
 128
 129 checkDefaultBind _ _ b = pprPanic "checkDefaultBind" (ppr b)
 130
 131
 132 tcClassSig :: NameEnv DefMethSpec       -- Info about default methods;
 133            -> LSig Name
 134            -> TcM TcMethInfo
 135
 136 tcClassSig dm_env (L loc (TypeSig (L _ op_name) op_hs_ty))
 137   = setSrcSpan loc $ do
 138     { op_ty <- tcHsKindedType op_hs_ty  -- Class tyvars already in scope
 139     ; let dm = lookupNameEnv dm_env op_name `orElse` NoDM
 140     ; return (op_name, dm, op_ty) }
 141 tcClassSig _ s = pprPanic "tcClassSig" (ppr s)
 142 \end{code}
 143
 144
 145 %************************************************************************
 146 %*                                                                      *
 147                 Class Declarations
 148 %*                                                                      *
 149 %************************************************************************
 150
 151 \begin{code}
 152 tcClassDecl2 :: LTyClDecl Name          -- The class declaration
 153              -> TcM (LHsBinds Id)
 154
 155 tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs,
 156                                 tcdMeths = default_binds}))
 157   = recoverM (return emptyLHsBinds)     $
 158     setSrcSpan loc                      $
 159     do  { clas <- tcLookupLocatedClass class_name
 160
 161         -- We make a separate binding for each default method.
 162         -- At one time I used a single AbsBinds for all of them, thus
 163         -- AbsBind [d] [dm1, dm2, dm3] { dm1 = ...; dm2 = ...; dm3 = ... }
 164         -- But that desugars into
 165         --      ds = \d -> (..., ..., ...)
 166         --      dm1 = \d -> case ds d of (a,b,c) -> a
 167         -- And since ds is big, it doesn't get inlined, so we don't get good
 168         -- default methods.  Better to make separate AbsBinds for each
 169         ; let
 170               (tyvars, _, _, op_items) = classBigSig clas
 171               rigid_info  = ClsSkol clas
 172               prag_fn     = mkPragFun sigs default_binds
 173               sig_fn      = mkSigFun sigs
 174               clas_tyvars = tcSkolSigTyVars rigid_info tyvars
 175               pred        = mkClassPred clas (mkTyVarTys clas_tyvars)
 176         ; this_dict <- newEvVar pred
 177
 178         ; let tc_dm = tcDefMeth clas clas_tyvars
 179                                 this_dict default_binds
 180                                 sig_fn prag_fn
 181
 182         ; dm_binds <- tcExtendTyVarEnv clas_tyvars $
 183                       mapM tc_dm op_items
 184
 185         ; return (listToBag (catMaybes dm_binds)) }
 186
 187 tcClassDecl2 d = pprPanic "tcClassDecl2" (ppr d)
 188
 189 tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds Name
 190           -> SigFun -> PragFun -> ClassOpItem
 191           -> TcM (Maybe (LHsBind Id))
 192 -- Generate code for polymorphic default methods only (hence DefMeth)
 193 -- (Generic default methods have turned into instance decls by now.)
 194 -- This is incompatible with Hugs, which expects a polymorphic
 195 -- default method for every class op, regardless of whether or not
 196 -- the programmer supplied an explicit default decl for the class.
 197 -- (If necessary we can fix that, but we don't have a convenient Id to hand.)
 198 tcDefMeth clas tyvars this_dict binds_in sig_fn prag_fn (sel_id, dm_info)
 199   = case dm_info of
 200       NoDefMeth       -> return Nothing
 201       GenDefMeth      -> return Nothing
 202       DefMeth dm_name -> do
 203         { let sel_name = idName sel_id
 204         ; local_dm_name <- newLocalName sel_name
 205           -- Base the local_dm_name on the selector name, because
 206           -- type errors from tcInstanceMethodBody come from here
 207
 208                 -- See Note [Silly default-method bind]
 209                 -- (possibly out of date)
 210
 211         ; let meth_bind = findMethodBind sel_name binds_in
 212                           `orElse` pprPanic "tcDefMeth" (ppr sel_id)
 213                 -- dm_info = DefMeth dm_name only if there is a binding in binds_in
 214
 215               dm_sig_fn  _  = sig_fn sel_name
 216               dm_id         = mkDefaultMethodId sel_id dm_name
 217               local_dm_type = instantiateMethod clas sel_id (mkTyVarTys tyvars)
 218               local_dm_id   = mkLocalId local_dm_name local_dm_type
 219
 220         ; (dm_id_w_inline, spec_prags)
 221                 <- tcPrags NonRecursive False True dm_id (prag_fn sel_name)
 222
 223         ; warnTc (not (null spec_prags))
 224                  (ptext (sLit "Ignoring SPECIALISE pragmas on default method")
 225                   <+> quotes (ppr sel_name))
 226
 227         ; liftM Just $
 228           tcInstanceMethodBody (ClsSkol clas)
 229                                tyvars
 230                                [this_dict]
 231                                Nothing
 232                                dm_id_w_inline local_dm_id
 233                                dm_sig_fn IsDefaultMethod meth_bind }
 234
 235 ---------------
 236 tcInstanceMethodBody :: SkolemInfo -> [TcTyVar] -> [EvVar]
 237                      -> Maybe EvBind
 238                      -> Id -> Id
 239                      -> SigFun -> TcSpecPrags -> LHsBind Name
 240                      -> TcM (LHsBind Id)
 241 tcInstanceMethodBody skol_info tyvars dfun_ev_vars
 242                      this_dict meth_id local_meth_id
 243                      meth_sig_fn specs
 244                      (L loc bind)
 245   = do  {       -- Typecheck the binding, first extending the envt
 246                 -- so that when tcInstSig looks up the local_meth_id to find
 247                 -- its signature, we'll find it in the environment
 248           let full_given = case this_dict of
 249                              Nothing -> dfun_ev_vars
 250                              Just (EvBind dict _) -> dict : dfun_ev_vars
 251               lm_bind = L loc (bind { fun_id = L loc (idName local_meth_id) })
 252                              -- Substitue the local_meth_name for the binder
 253                              -- NB: the binding is always a FunBind
 254
 255         ; (ev_binds, (tc_bind, _))
 256                <- checkConstraints skol_info emptyVarSet tyvars full_given $
 257                   tcExtendIdEnv [local_meth_id] $
 258                   tcPolyBinds TopLevel meth_sig_fn no_prag_fn
 259                              NonRecursive NonRecursive
 260                              [lm_bind]
 261
 262         -- Add the binding for this_dict, if we have one
 263         ; ev_binds' <- case this_dict of
 264                          Nothing                -> return ev_binds
 265                          Just (EvBind self rhs) -> extendTcEvBinds ev_binds self rhs
 266
 267         ; let full_bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
 268                                    , abs_exports = [(tyvars, meth_id, local_meth_id, specs)]
 269                                    , abs_ev_binds = ev_binds'
 270                                    , abs_binds = tc_bind }
 271
 272         ; return (L loc full_bind) }
 273   where
 274     no_prag_fn  _ = []          -- No pragmas for local_meth_id;
 275                                 -- they are all for meth_id
 276 \end{code}
 277
 278 \begin{code}
 279 instantiateMethod :: Class -> Id -> [TcType] -> TcType
 280 -- Take a class operation, say
 281 --      op :: forall ab. C a => forall c. Ix c => (b,c) -> a
 282 -- Instantiate it at [ty1,ty2]
 283 -- Return the "local method type":
 284 --      forall c. Ix x => (ty2,c) -> ty1
 285 instantiateMethod clas sel_id inst_tys
 286   = ASSERT( ok_first_pred ) local_meth_ty
 287   where
 288     (sel_tyvars,sel_rho) = tcSplitForAllTys (idType sel_id)
 289     rho_ty = ASSERT( length sel_tyvars == length inst_tys )
 290              substTyWith sel_tyvars inst_tys sel_rho
 291
 292     (first_pred, local_meth_ty) = tcSplitPredFunTy_maybe rho_ty
 293                 `orElse` pprPanic "tcInstanceMethod" (ppr sel_id)
 294
 295     ok_first_pred = case getClassPredTys_maybe first_pred of
 296                       Just (clas1, _tys) -> clas == clas1
 297                       Nothing -> False
 298               -- The first predicate should be of form (C a b)
 299               -- where C is the class in question
 300
 301
 302 ---------------------------
 303 findMethodBind  :: Name                 -- Selector name
 304                 -> LHsBinds Name        -- A group of bindings
 305                 -> Maybe (LHsBind Name) -- The binding
 306 findMethodBind sel_name binds
 307   = foldlBag mplus Nothing (mapBag f binds)
 308   where
 309     f bind@(L _ (FunBind { fun_id = L _ op_name }))
 310              | op_name == sel_name
 311              = Just bind
 312     f _other = Nothing
 313 \end{code}
 314
 315 Note [Polymorphic methods]
 316 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 317 Consider
 318     class Foo a where
 319         op :: forall b. Ord b => a -> b -> b -> b
 320     instance Foo c => Foo [c] where
 321         op = e
 322
 323 When typechecking the binding 'op = e', we'll have a meth_id for op
 324 whose type is
 325       op :: forall c. Foo c => forall b. Ord b => [c] -> b -> b -> b
 326
 327 So tcPolyBinds must be capable of dealing with nested polytypes;
 328 and so it is. See TcBinds.tcMonoBinds (with type-sig case).
 329
 330 Note [Silly default-method bind]
 331 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 332 When we pass the default method binding to the type checker, it must
 333 look like    op2 = e
 334 not          $dmop2 = e
 335 otherwise the "$dm" stuff comes out error messages.  But we want the
 336 "$dm" to come out in the interface file.  So we typecheck the former,
 337 and wrap it in a let, thus
 338           $dmop2 = let op2 = e in op2
 339 This makes the error messages right.
 340
 341
 342 %************************************************************************
 343 %*                                                                      *
 344         Extracting generic instance declaration from class declarations
 345 %*                                                                      *
 346 %************************************************************************
 347
 348 @getGenericInstances@ extracts the generic instance declarations from a class
 349 declaration.  For exmaple
 350
 351         class C a where
 352           op :: a -> a
 353
 354           op{ x+y } (Inl v)   = ...
 355           op{ x+y } (Inr v)   = ...
 356           op{ x*y } (v :*: w) = ...
 357           op{ 1   } Unit      = ...
 358
 359 gives rise to the instance declarations
 360
 361         instance C (x+y) where
 362           op (Inl v)   = ...
 363           op (Inr v)   = ...
 364
 365         instance C (x*y) where
 366           op (v :*: w) = ...
 367
 368         instance C 1 where
 369           op Unit      = ...
 370
 371 \begin{code}
 372 mkGenericDefMethBind :: Class -> [Type] -> Id -> TcM (LHsBind Name)
 373 mkGenericDefMethBind clas inst_tys sel_id
 374   =     -- A generic default method
 375         -- If the method is defined generically, we can only do the job if the
 376         -- instance declaration is for a single-parameter type class with
 377         -- a type constructor applied to type arguments in the instance decl
 378         --      (checkTc, so False provokes the error)
 379     do  { checkTc (isJust maybe_tycon)
 380                   (badGenericInstance sel_id (notSimple inst_tys))
 381         ; checkTc (tyConHasGenerics tycon)
 382                   (badGenericInstance sel_id (notGeneric tycon))
 383
 384         ; dflags <- getDOpts
 385         ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
 386                    (vcat [ppr clas <+> ppr inst_tys,
 387                           nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
 388
 389                 -- Rename it before returning it
 390         ; (rn_rhs, _) <- rnLExpr rhs
 391         ; return (noLoc $ mkFunBind (noLoc (idName sel_id))
 392                                     [mkSimpleMatch [] rn_rhs]) }
 393   where
 394     rhs = mkGenericRhs sel_id clas_tyvar tycon
 395
 396           -- The tycon is only used in the generic case, and in that
 397           -- case we require that the instance decl is for a single-parameter
 398           -- type class with type variable arguments:
 399           --    instance (...) => C (T a b)
 400     clas_tyvar  = ASSERT (not (null (classTyVars clas))) head (classTyVars clas)
 401     Just tycon  = maybe_tycon
 402     maybe_tycon = case inst_tys of
 403                         [ty] -> case tcSplitTyConApp_maybe ty of
 404                                   Just (tycon, arg_tys) | all tcIsTyVarTy arg_tys -> Just tycon
 405                                   _                                               -> Nothing
 406                         _ -> Nothing
 407
 408
 409 ---------------------------
 410 getGenericInstances :: [LTyClDecl Name] -> TcM [InstInfo Name]
 411 getGenericInstances class_decls
 412   = do  { gen_inst_infos <- mapM (addLocM get_generics) class_decls
 413         ; let { gen_inst_info = concat gen_inst_infos }
 414
 415         -- Return right away if there is no generic stuff
 416         ; if null gen_inst_info then return []
 417           else do
 418
 419         -- Otherwise print it out
 420         { dflags <- getDOpts
 421         ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
 422                  (vcat (map pprInstInfoDetails gen_inst_info)))
 423         ; return gen_inst_info }}
 424
 425 get_generics :: TyClDecl Name -> TcM [InstInfo Name]
 426 get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
 427   | null generic_binds
 428   = return [] -- The comon case: no generic default methods
 429
 430   | otherwise   -- A source class decl with generic default methods
 431   = recoverM (return [])                                $
 432     tcAddDeclCtxt decl                                  $ do
 433     clas <- tcLookupLocatedClass class_name
 434
 435         -- Group by type, and
 436         -- make an InstInfo out of each group
 437     let
 438         groups = groupWith listToBag generic_binds
 439
 440     inst_infos <- mapM (mkGenericInstance clas) groups
 441
 442         -- Check that there is only one InstInfo for each type constructor
 443         -- The main way this can fail is if you write
 444         --      f {| a+b |} ... = ...
 445         --      f {| x+y |} ... = ...
 446         -- Then at this point we'll have an InstInfo for each
 447         --
 448         -- The class should be unary, which is why simpleInstInfoTyCon should be ok
 449     let
 450         tc_inst_infos :: [(TyCon, InstInfo Name)]
 451         tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
 452
 453         bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
 454                               group `lengthExceeds` 1]
 455         get_uniq (tc,_) = getUnique tc
 456
 457     mapM_ (addErrTc . dupGenericInsts) bad_groups
 458
 459         -- Check that there is an InstInfo for each generic type constructor
 460     let
 461         missing = genericTyConNames `minusList` [tyConName tc | (tc,_) <- tc_inst_infos]
 462
 463     checkTc (null missing) (missingGenericInstances missing)
 464
 465     return inst_infos
 466   where
 467     generic_binds :: [(HsType Name, LHsBind Name)]
 468     generic_binds = getGenericBinds def_methods
 469 get_generics decl = pprPanic "get_generics" (ppr decl)
 470
 471
 472 ---------------------------------
 473 getGenericBinds :: LHsBinds Name -> [(HsType Name, LHsBind Name)]
 474   -- Takes a group of method bindings, finds the generic ones, and returns
 475   -- them in finite map indexed by the type parameter in the definition.
 476 getGenericBinds binds = concat (map getGenericBind (bagToList binds))
 477
 478 getGenericBind :: LHsBindLR Name Name -> [(HsType Name, LHsBindLR Name Name)]
 479 getGenericBind (L loc bind@(FunBind { fun_matches = MatchGroup matches ty }))
 480   = groupWith wrap (mapCatMaybes maybeGenericMatch matches)
 481   where
 482     wrap ms = L loc (bind { fun_matches = MatchGroup ms ty })
 483 getGenericBind _
 484   = []
 485
 486 groupWith :: ([a] -> b) -> [(HsType Name, a)] -> [(HsType Name, b)]
 487 groupWith _  []          = []
 488 groupWith op ((t,v):prs) = (t, op (v:vs)) : groupWith op rest
 489     where
 490       vs              = map snd this
 491       (this,rest)     = partition same_t prs
 492       same_t (t', _v) = t `eqPatType` t'
 493
 494 eqPatLType :: LHsType Name -> LHsType Name -> Bool
 495 eqPatLType t1 t2 = unLoc t1 `eqPatType` unLoc t2
 496
 497 eqPatType :: HsType Name -> HsType Name -> Bool
 498 -- A very simple equality function, only for
 499 -- type patterns in generic function definitions.
 500 eqPatType (HsTyVar v1)       (HsTyVar v2)       = v1==v2
 501 eqPatType (HsAppTy s1 t1)    (HsAppTy s2 t2)    = s1 `eqPatLType` s2 && t1 `eqPatLType` t2
 502 eqPatType (HsOpTy s1 op1 t1) (HsOpTy s2 op2 t2) = s1 `eqPatLType` s2 && t1 `eqPatLType` t2 && unLoc op1 == unLoc op2
 503 eqPatType (HsNumTy n1)       (HsNumTy n2)       = n1 == n2
 504 eqPatType (HsParTy t1)       t2                 = unLoc t1 `eqPatType` t2
 505 eqPatType t1                 (HsParTy t2)       = t1 `eqPatType` unLoc t2
 506 eqPatType _ _ = False
 507
 508 ---------------------------------
 509 mkGenericInstance :: Class
 510                   -> (HsType Name, LHsBinds Name)
 511                   -> TcM (InstInfo Name)
 512
 513 mkGenericInstance clas (hs_ty, binds) = do
 514   -- Make a generic instance declaration
 515   -- For example:       instance (C a, C b) => C (a+b) where { binds }
 516
 517         -- Extract the universally quantified type variables
 518         -- and wrap them as forall'd tyvars, so that kind inference
 519         -- works in the standard way
 520     let
 521         sig_tvs = userHsTyVarBndrs $ map noLoc $ nameSetToList $
 522                   extractHsTyVars (noLoc hs_ty)
 523         hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
 524
 525         -- Type-check the instance type, and check its form
 526     forall_inst_ty <- tcHsSigType GenPatCtxt hs_forall_ty
 527     let
 528         (tyvars, inst_ty) = tcSplitForAllTys forall_inst_ty
 529
 530     checkTc (validGenericInstanceType inst_ty)
 531             (badGenericInstanceType binds)
 532
 533         -- Make the dictionary function.
 534     span <- getSrcSpanM
 535     overlap_flag <- getOverlapFlag
 536     dfun_name <- newDFunName clas [inst_ty] span
 537     let
 538         inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
 539         dfun_id    = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
 540         ispec      = mkLocalInstance dfun_id overlap_flag
 541
 542     return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] False })
 543 \end{code}
 544
 545
 546 %************************************************************************
 547 %*                                                                      *
 548                 Error messages
 549 %*                                                                      *
 550 %************************************************************************
 551
 552 \begin{code}
 553 tcAddDeclCtxt :: TyClDecl Name -> TcM a -> TcM a
 554 tcAddDeclCtxt decl thing_inside
 555   = addErrCtxt ctxt thing_inside
 556   where
 557      thing | isClassDecl decl  = "class"
 558            | isTypeDecl decl   = "type synonym" ++ maybeInst
 559            | isDataDecl decl   = if tcdND decl == NewType
 560                                  then "newtype" ++ maybeInst
 561                                  else "data type" ++ maybeInst
 562            | isFamilyDecl decl = "family"
 563            | otherwise         = panic "tcAddDeclCtxt/thing"
 564
 565      maybeInst | isFamInstDecl decl = " instance"
 566                | otherwise          = ""
 567
 568      ctxt = hsep [ptext (sLit "In the"), text thing,
 569                   ptext (sLit "declaration for"), quotes (ppr (tcdName decl))]
 570
 571 badMethodErr :: Outputable a => a -> Name -> SDoc
 572 badMethodErr clas op
 573   = hsep [ptext (sLit "Class"), quotes (ppr clas),
 574           ptext (sLit "does not have a method"), quotes (ppr op)]
 575
 576 badATErr :: Class -> Name -> SDoc
 577 badATErr clas at
 578   = hsep [ptext (sLit "Class"), quotes (ppr clas),
 579           ptext (sLit "does not have an associated type"), quotes (ppr at)]
 580
 581 omittedATWarn :: Name -> SDoc
 582 omittedATWarn at
 583   = ptext (sLit "No explicit AT declaration for") <+> quotes (ppr at)
 584
 585 badGenericInstance :: Var -> SDoc -> SDoc
 586 badGenericInstance sel_id because
 587   = sep [ptext (sLit "Can't derive generic code for") <+> quotes (ppr sel_id),
 588          because]
 589
 590 notSimple :: [Type] -> SDoc
 591 notSimple inst_tys
 592   = vcat [ptext (sLit "because the instance type(s)"),
 593           nest 2 (ppr inst_tys),
 594           ptext (sLit "is not a simple type of form (T a1 ... an)")]
 595
 596 notGeneric :: TyCon -> SDoc
 597 notGeneric tycon
 598   = vcat [ptext (sLit "because the instance type constructor") <+> quotes (ppr tycon) <+>
 599           ptext (sLit "was not compiled with -XGenerics")]
 600
 601 badGenericInstanceType :: LHsBinds Name -> SDoc
 602 badGenericInstanceType binds
 603   = vcat [ptext (sLit "Illegal type pattern in the generic bindings"),
 604           nest 2 (ppr binds)]
 605
 606 missingGenericInstances :: [Name] -> SDoc
 607 missingGenericInstances missing
 608   = ptext (sLit "Missing type patterns for") <+> pprQuotedList missing
 609
 610 dupGenericInsts :: [(TyCon, InstInfo a)] -> SDoc
 611 dupGenericInsts tc_inst_infos
 612   = vcat [ptext (sLit "More than one type pattern for a single generic type constructor:"),
 613           nest 2 (vcat (map ppr_inst_ty tc_inst_infos)),
 614           ptext (sLit "All the type patterns for a generic type constructor must be identical")
 615     ]
 616   where
 617     ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
 618
 619 mixedGenericErr :: Name -> SDoc
 620 mixedGenericErr op
 621   = ptext (sLit "Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
 622 \end{code}