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