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 TcPat( addInlinePrags )
  23 import TcEnv
  24 import TcBinds
  25 import TcUnify
  26 import TcHsType
  27 import TcMType
  28 import TcType
  29 import TcRnMonad
  30 import BuildTyCl( TcMethInfo )
  31 import Generics
  32 import Class
  33 import TyCon
  34 import MkId
  35 import Id
  36 import Name
  37 import Var
  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               prags         = prag_fn sel_name
 220
 221         ; dm_id_w_inline <- addInlinePrags dm_id prags
 222         ; spec_prags     <- tcSpecPrags dm_id prags
 223
 224         ; warnTc (not (null spec_prags))
 225                  (ptext (sLit "Ignoring SPECIALISE pragmas on default method")
 226                   <+> quotes (ppr sel_name))
 227
 228         ; liftM Just $
 229           tcInstanceMethodBody (ClsSkol clas)
 230                                tyvars
 231                                [this_dict]
 232                                Nothing
 233                                dm_id_w_inline local_dm_id
 234                                dm_sig_fn IsDefaultMethod meth_bind }
 235
 236 ---------------
 237 tcInstanceMethodBody :: SkolemInfo -> [TcTyVar] -> [EvVar]
 238                      -> Maybe EvBind
 239                      -> Id -> Id
 240                      -> SigFun -> TcSpecPrags -> LHsBind Name
 241                      -> TcM (LHsBind Id)
 242 tcInstanceMethodBody skol_info tyvars dfun_ev_vars
 243                      this_dict meth_id local_meth_id
 244                      meth_sig_fn specs
 245                      (L loc bind)
 246   = do  {       -- Typecheck the binding, first extending the envt
 247                 -- so that when tcInstSig looks up the local_meth_id to find
 248                 -- its signature, we'll find it in the environment
 249           let full_given = case this_dict of
 250                              Nothing -> dfun_ev_vars
 251                              Just (EvBind dict _) -> dict : dfun_ev_vars
 252               lm_bind = L loc (bind { fun_id = L loc (idName local_meth_id) })
 253                              -- Substitue the local_meth_name for the binder
 254                              -- NB: the binding is always a FunBind
 255
 256         ; (ev_binds, (tc_bind, _))
 257                <- checkConstraints skol_info tyvars full_given $
 258                   tcExtendIdEnv [local_meth_id] $
 259                   tcPolyBinds TopLevel meth_sig_fn no_prag_fn
 260                              NonRecursive NonRecursive
 261                              [lm_bind]
 262
 263         -- Add the binding for this_dict, if we have one
 264         ; ev_binds' <- case this_dict of
 265                          Nothing                -> return ev_binds
 266                          Just (EvBind self rhs) -> extendTcEvBinds ev_binds self rhs
 267
 268         ; let full_bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
 269                                    , abs_exports = [(tyvars, meth_id, local_meth_id, specs)]
 270                                    , abs_ev_binds = ev_binds'
 271                                    , abs_binds = tc_bind }
 272
 273         ; return (L loc full_bind) }
 274   where
 275     no_prag_fn  _ = []          -- No pragmas for local_meth_id;
 276                                 -- they are all for meth_id
 277 \end{code}
 278
 279 \begin{code}
 280 instantiateMethod :: Class -> Id -> [TcType] -> TcType
 281 -- Take a class operation, say
 282 --      op :: forall ab. C a => forall c. Ix c => (b,c) -> a
 283 -- Instantiate it at [ty1,ty2]
 284 -- Return the "local method type":
 285 --      forall c. Ix x => (ty2,c) -> ty1
 286 instantiateMethod clas sel_id inst_tys
 287   = ASSERT( ok_first_pred ) local_meth_ty
 288   where
 289     (sel_tyvars,sel_rho) = tcSplitForAllTys (idType sel_id)
 290     rho_ty = ASSERT( length sel_tyvars == length inst_tys )
 291              substTyWith sel_tyvars inst_tys sel_rho
 292
 293     (first_pred, local_meth_ty) = tcSplitPredFunTy_maybe rho_ty
 294                 `orElse` pprPanic "tcInstanceMethod" (ppr sel_id)
 295
 296     ok_first_pred = case getClassPredTys_maybe first_pred of
 297                       Just (clas1, _tys) -> clas == clas1
 298                       Nothing -> False
 299               -- The first predicate should be of form (C a b)
 300               -- where C is the class in question
 301
 302
 303 ---------------------------
 304 findMethodBind  :: Name                 -- Selector name
 305                 -> LHsBinds Name        -- A group of bindings
 306                 -> Maybe (LHsBind Name) -- The binding
 307 findMethodBind sel_name binds
 308   = foldlBag mplus Nothing (mapBag f binds)
 309   where
 310     f bind@(L _ (FunBind { fun_id = L _ op_name }))
 311              | op_name == sel_name
 312              = Just bind
 313     f _other = Nothing
 314 \end{code}
 315
 316 Note [Polymorphic methods]
 317 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 318 Consider
 319     class Foo a where
 320         op :: forall b. Ord b => a -> b -> b -> b
 321     instance Foo c => Foo [c] where
 322         op = e
 323
 324 When typechecking the binding 'op = e', we'll have a meth_id for op
 325 whose type is
 326       op :: forall c. Foo c => forall b. Ord b => [c] -> b -> b -> b
 327
 328 So tcPolyBinds must be capable of dealing with nested polytypes;
 329 and so it is. See TcBinds.tcMonoBinds (with type-sig case).
 330
 331 Note [Silly default-method bind]
 332 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 333 When we pass the default method binding to the type checker, it must
 334 look like    op2 = e
 335 not          $dmop2 = e
 336 otherwise the "$dm" stuff comes out error messages.  But we want the
 337 "$dm" to come out in the interface file.  So we typecheck the former,
 338 and wrap it in a let, thus
 339           $dmop2 = let op2 = e in op2
 340 This makes the error messages right.
 341
 342
 343 %************************************************************************
 344 %*                                                                      *
 345         Extracting generic instance declaration from class declarations
 346 %*                                                                      *
 347 %************************************************************************
 348
 349 @getGenericInstances@ extracts the generic instance declarations from a class
 350 declaration.  For exmaple
 351
 352         class C a where
 353           op :: a -> a
 354
 355           op{ x+y } (Inl v)   = ...
 356           op{ x+y } (Inr v)   = ...
 357           op{ x*y } (v :*: w) = ...
 358           op{ 1   } Unit      = ...
 359
 360 gives rise to the instance declarations
 361
 362         instance C (x+y) where
 363           op (Inl v)   = ...
 364           op (Inr v)   = ...
 365
 366         instance C (x*y) where
 367           op (v :*: w) = ...
 368
 369         instance C 1 where
 370           op Unit      = ...
 371
 372 \begin{code}
 373 mkGenericDefMethBind :: Class -> [Type] -> Id -> TcM (LHsBind Name)
 374 mkGenericDefMethBind clas inst_tys sel_id
 375   =     -- A generic default method
 376         -- If the method is defined generically, we can only do the job if the
 377         -- instance declaration is for a single-parameter type class with
 378         -- a type constructor applied to type arguments in the instance decl
 379         --      (checkTc, so False provokes the error)
 380     do  { checkTc (isJust maybe_tycon)
 381                   (badGenericInstance sel_id (notSimple inst_tys))
 382         ; checkTc (tyConHasGenerics tycon)
 383                   (badGenericInstance sel_id (notGeneric tycon))
 384
 385         ; dflags <- getDOpts
 386         ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
 387                    (vcat [ppr clas <+> ppr inst_tys,
 388                           nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
 389
 390                 -- Rename it before returning it
 391         ; (rn_rhs, _) <- rnLExpr rhs
 392         ; return (noLoc $ mkFunBind (noLoc (idName sel_id))
 393                                     [mkSimpleMatch [] rn_rhs]) }
 394   where
 395     rhs = mkGenericRhs sel_id clas_tyvar tycon
 396
 397           -- The tycon is only used in the generic case, and in that
 398           -- case we require that the instance decl is for a single-parameter
 399           -- type class with type variable arguments:
 400           --    instance (...) => C (T a b)
 401     clas_tyvar  = ASSERT (not (null (classTyVars clas))) head (classTyVars clas)
 402     Just tycon  = maybe_tycon
 403     maybe_tycon = case inst_tys of
 404                         [ty] -> case tcSplitTyConApp_maybe ty of
 405                                   Just (tycon, arg_tys) | all tcIsTyVarTy arg_tys -> Just tycon
 406                                   _                                               -> Nothing
 407                         _ -> Nothing
 408
 409
 410 ---------------------------
 411 getGenericInstances :: [LTyClDecl Name] -> TcM [InstInfo Name]
 412 getGenericInstances class_decls
 413   = do  { gen_inst_infos <- mapM (addLocM get_generics) class_decls
 414         ; let { gen_inst_info = concat gen_inst_infos }
 415
 416         -- Return right away if there is no generic stuff
 417         ; if null gen_inst_info then return []
 418           else do
 419
 420         -- Otherwise print it out
 421         { dflags <- getDOpts
 422         ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
 423                  (vcat (map pprInstInfoDetails gen_inst_info)))
 424         ; return gen_inst_info }}
 425
 426 get_generics :: TyClDecl Name -> TcM [InstInfo Name]
 427 get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
 428   | null generic_binds
 429   = return [] -- The comon case: no generic default methods
 430
 431   | otherwise   -- A source class decl with generic default methods
 432   = recoverM (return [])                                $
 433     tcAddDeclCtxt decl                                  $ do
 434     clas <- tcLookupLocatedClass class_name
 435
 436         -- Group by type, and
 437         -- make an InstInfo out of each group
 438     let
 439         groups = groupWith listToBag generic_binds
 440
 441     inst_infos <- mapM (mkGenericInstance clas) groups
 442
 443         -- Check that there is only one InstInfo for each type constructor
 444         -- The main way this can fail is if you write
 445         --      f {| a+b |} ... = ...
 446         --      f {| x+y |} ... = ...
 447         -- Then at this point we'll have an InstInfo for each
 448         --
 449         -- The class should be unary, which is why simpleInstInfoTyCon should be ok
 450     let
 451         tc_inst_infos :: [(TyCon, InstInfo Name)]
 452         tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
 453
 454         bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
 455                               group `lengthExceeds` 1]
 456         get_uniq (tc,_) = getUnique tc
 457
 458     mapM_ (addErrTc . dupGenericInsts) bad_groups
 459
 460         -- Check that there is an InstInfo for each generic type constructor
 461     let
 462         missing = genericTyConNames `minusList` [tyConName tc | (tc,_) <- tc_inst_infos]
 463
 464     checkTc (null missing) (missingGenericInstances missing)
 465
 466     return inst_infos
 467   where
 468     generic_binds :: [(HsType Name, LHsBind Name)]
 469     generic_binds = getGenericBinds def_methods
 470 get_generics decl = pprPanic "get_generics" (ppr decl)
 471
 472
 473 ---------------------------------
 474 getGenericBinds :: LHsBinds Name -> [(HsType Name, LHsBind Name)]
 475   -- Takes a group of method bindings, finds the generic ones, and returns
 476   -- them in finite map indexed by the type parameter in the definition.
 477 getGenericBinds binds = concat (map getGenericBind (bagToList binds))
 478
 479 getGenericBind :: LHsBindLR Name Name -> [(HsType Name, LHsBindLR Name Name)]
 480 getGenericBind (L loc bind@(FunBind { fun_matches = MatchGroup matches ty }))
 481   = groupWith wrap (mapCatMaybes maybeGenericMatch matches)
 482   where
 483     wrap ms = L loc (bind { fun_matches = MatchGroup ms ty })
 484 getGenericBind _
 485   = []
 486
 487 groupWith :: ([a] -> b) -> [(HsType Name, a)] -> [(HsType Name, b)]
 488 groupWith _  []          = []
 489 groupWith op ((t,v):prs) = (t, op (v:vs)) : groupWith op rest
 490     where
 491       vs              = map snd this
 492       (this,rest)     = partition same_t prs
 493       same_t (t', _v) = t `eqPatType` t'
 494
 495 eqPatLType :: LHsType Name -> LHsType Name -> Bool
 496 eqPatLType t1 t2 = unLoc t1 `eqPatType` unLoc t2
 497
 498 eqPatType :: HsType Name -> HsType Name -> Bool
 499 -- A very simple equality function, only for
 500 -- type patterns in generic function definitions.
 501 eqPatType (HsTyVar v1)       (HsTyVar v2)       = v1==v2
 502 eqPatType (HsAppTy s1 t1)    (HsAppTy s2 t2)    = s1 `eqPatLType` s2 && t1 `eqPatLType` t2
 503 eqPatType (HsOpTy s1 op1 t1) (HsOpTy s2 op2 t2) = s1 `eqPatLType` s2 && t1 `eqPatLType` t2 && unLoc op1 == unLoc op2
 504 eqPatType (HsNumTy n1)       (HsNumTy n2)       = n1 == n2
 505 eqPatType (HsParTy t1)       t2                 = unLoc t1 `eqPatType` t2
 506 eqPatType t1                 (HsParTy t2)       = t1 `eqPatType` unLoc t2
 507 eqPatType _ _ = False
 508
 509 ---------------------------------
 510 mkGenericInstance :: Class
 511                   -> (HsType Name, LHsBinds Name)
 512                   -> TcM (InstInfo Name)
 513
 514 mkGenericInstance clas (hs_ty, binds) = do
 515   -- Make a generic instance declaration
 516   -- For example:       instance (C a, C b) => C (a+b) where { binds }
 517
 518         -- Extract the universally quantified type variables
 519         -- and wrap them as forall'd tyvars, so that kind inference
 520         -- works in the standard way
 521     let
 522         sig_tvs = userHsTyVarBndrs $ map noLoc $ nameSetToList $
 523                   extractHsTyVars (noLoc hs_ty)
 524         hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
 525
 526         -- Type-check the instance type, and check its form
 527     forall_inst_ty <- tcHsSigType GenPatCtxt hs_forall_ty
 528     let
 529         (tyvars, inst_ty) = tcSplitForAllTys forall_inst_ty
 530
 531     checkTc (validGenericInstanceType inst_ty)
 532             (badGenericInstanceType binds)
 533
 534         -- Make the dictionary function.
 535     span <- getSrcSpanM
 536     overlap_flag <- getOverlapFlag
 537     dfun_name <- newDFunName clas [inst_ty] span
 538     let
 539         inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
 540         dfun_id    = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
 541         ispec      = mkLocalInstance dfun_id overlap_flag
 542
 543     return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] False })
 544 \end{code}
 545
 546
 547 %************************************************************************
 548 %*                                                                      *
 549                 Error messages
 550 %*                                                                      *
 551 %************************************************************************
 552
 553 \begin{code}
 554 tcAddDeclCtxt :: TyClDecl Name -> TcM a -> TcM a
 555 tcAddDeclCtxt decl thing_inside
 556   = addErrCtxt ctxt thing_inside
 557   where
 558      thing | isClassDecl decl  = "class"
 559            | isTypeDecl decl   = "type synonym" ++ maybeInst
 560            | isDataDecl decl   = if tcdND decl == NewType
 561                                  then "newtype" ++ maybeInst
 562                                  else "data type" ++ maybeInst
 563            | isFamilyDecl decl = "family"
 564            | otherwise         = panic "tcAddDeclCtxt/thing"
 565
 566      maybeInst | isFamInstDecl decl = " instance"
 567                | otherwise          = ""
 568
 569      ctxt = hsep [ptext (sLit "In the"), text thing,
 570                   ptext (sLit "declaration for"), quotes (ppr (tcdName decl))]
 571
 572 badMethodErr :: Outputable a => a -> Name -> SDoc
 573 badMethodErr clas op
 574   = hsep [ptext (sLit "Class"), quotes (ppr clas),
 575           ptext (sLit "does not have a method"), quotes (ppr op)]
 576
 577 badATErr :: Class -> Name -> SDoc
 578 badATErr clas at
 579   = hsep [ptext (sLit "Class"), quotes (ppr clas),
 580           ptext (sLit "does not have an associated type"), quotes (ppr at)]
 581
 582 omittedATWarn :: Name -> SDoc
 583 omittedATWarn at
 584   = ptext (sLit "No explicit AT declaration for") <+> quotes (ppr at)
 585
 586 badGenericInstance :: Var -> SDoc -> SDoc
 587 badGenericInstance sel_id because
 588   = sep [ptext (sLit "Can't derive generic code for") <+> quotes (ppr sel_id),
 589          because]
 590
 591 notSimple :: [Type] -> SDoc
 592 notSimple inst_tys
 593   = vcat [ptext (sLit "because the instance type(s)"),
 594           nest 2 (ppr inst_tys),
 595           ptext (sLit "is not a simple type of form (T a1 ... an)")]
 596
 597 notGeneric :: TyCon -> SDoc
 598 notGeneric tycon
 599   = vcat [ptext (sLit "because the instance type constructor") <+> quotes (ppr tycon) <+>
 600           ptext (sLit "was not compiled with -XGenerics")]
 601
 602 badGenericInstanceType :: LHsBinds Name -> SDoc
 603 badGenericInstanceType binds
 604   = vcat [ptext (sLit "Illegal type pattern in the generic bindings"),
 605           nest 2 (ppr binds)]
 606
 607 missingGenericInstances :: [Name] -> SDoc
 608 missingGenericInstances missing
 609   = ptext (sLit "Missing type patterns for") <+> pprQuotedList missing
 610
 611 dupGenericInsts :: [(TyCon, InstInfo a)] -> SDoc
 612 dupGenericInsts tc_inst_infos
 613   = vcat [ptext (sLit "More than one type pattern for a single generic type constructor:"),
 614           nest 2 (vcat (map ppr_inst_ty tc_inst_infos)),
 615           ptext (sLit "All the type patterns for a generic type constructor must be identical")
 616     ]
 617   where
 618     ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
 619
 620 mixedGenericErr :: Name -> SDoc
 621 mixedGenericErr op
 622   = ptext (sLit "Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
 623 \end{code}