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 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 error messages.  But we want the
 298 "$dm" to come out in the interface file.  So we typecheck the former,
 299 and wrap it in a let, thus
 300           $dmop2 = let op2 = e in op2
 301 This makes the error messages right.
 302
 303
 304 %************************************************************************
 305 %*                                                                      *
 306         Extracting generic instance declaration from class declarations
 307 %*                                                                      *
 308 %************************************************************************
 309
 310 @getGenericInstances@ extracts the generic instance declarations from a class
 311 declaration.  For exmaple
 312
 313         class C a where
 314           op :: a -> a
 315
 316           op{ x+y } (Inl v)   = ...
 317           op{ x+y } (Inr v)   = ...
 318           op{ x*y } (v :*: w) = ...
 319           op{ 1   } Unit      = ...
 320
 321 gives rise to the instance declarations
 322
 323         instance C (x+y) where
 324           op (Inl v)   = ...
 325           op (Inr v)   = ...
 326
 327         instance C (x*y) where
 328           op (v :*: w) = ...
 329
 330         instance C 1 where
 331           op Unit      = ...
 332
 333
 334 \begin{code}
 335 mkGenericDefMethBind :: Class -> [Type] -> Id -> Name -> TcM (LHsBind Name)
 336 mkGenericDefMethBind clas inst_tys sel_id meth_name
 337   =     -- A generic default method
 338         -- If the method is defined generically, we can only do the job if the
 339         -- instance declaration is for a single-parameter type class with
 340         -- a type constructor applied to type arguments in the instance decl
 341         --      (checkTc, so False provokes the error)
 342     do  { checkTc (isJust maybe_tycon)
 343                   (badGenericInstance sel_id (notSimple inst_tys))
 344         ; checkTc (tyConHasGenerics tycon)
 345                   (badGenericInstance sel_id (notGeneric tycon))
 346
 347         ; dflags <- getDOpts
 348         ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
 349                    (vcat [ppr clas <+> ppr inst_tys,
 350                           nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
 351
 352                 -- Rename it before returning it
 353         ; (rn_rhs, _) <- rnLExpr rhs
 354         ; return (noLoc $ mkFunBind (noLoc meth_name) [mkSimpleMatch [] rn_rhs]) }
 355   where
 356     rhs = mkGenericRhs sel_id clas_tyvar tycon
 357
 358           -- The tycon is only used in the generic case, and in that
 359           -- case we require that the instance decl is for a single-parameter
 360           -- type class with type variable arguments:
 361           --    instance (...) => C (T a b)
 362     clas_tyvar  = ASSERT (not (null (classTyVars clas))) head (classTyVars clas)
 363     Just tycon  = maybe_tycon
 364     maybe_tycon = case inst_tys of
 365                         [ty] -> case tcSplitTyConApp_maybe ty of
 366                                   Just (tycon, arg_tys) | all tcIsTyVarTy arg_tys -> Just tycon
 367                                   _                                               -> Nothing
 368                         _ -> Nothing
 369
 370
 371 ---------------------------
 372 getGenericInstances :: [LTyClDecl Name] -> TcM [InstInfo Name]
 373 getGenericInstances class_decls
 374   = do  { gen_inst_infos <- mapM (addLocM get_generics) class_decls
 375         ; let { gen_inst_info = concat gen_inst_infos }
 376
 377         -- Return right away if there is no generic stuff
 378         ; if null gen_inst_info then return []
 379           else do
 380
 381         -- Otherwise print it out
 382         { dflags <- getDOpts
 383         ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
 384                  (vcat (map pprInstInfoDetails gen_inst_info)))
 385         ; return gen_inst_info }}
 386
 387 get_generics :: TyClDecl Name -> TcM [InstInfo Name]
 388 get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
 389   | null generic_binds
 390   = return [] -- The comon case: no generic default methods
 391
 392   | otherwise   -- A source class decl with generic default methods
 393   = recoverM (return [])                                $
 394     tcAddDeclCtxt decl                                  $ do
 395     clas <- tcLookupLocatedClass class_name
 396
 397         -- Group by type, and
 398         -- make an InstInfo out of each group
 399     let
 400         groups = groupWith listToBag generic_binds
 401
 402     inst_infos <- mapM (mkGenericInstance clas) groups
 403
 404         -- Check that there is only one InstInfo for each type constructor
 405         -- The main way this can fail is if you write
 406         --      f {| a+b |} ... = ...
 407         --      f {| x+y |} ... = ...
 408         -- Then at this point we'll have an InstInfo for each
 409         --
 410         -- The class should be unary, which is why simpleInstInfoTyCon should be ok
 411     let
 412         tc_inst_infos :: [(TyCon, InstInfo Name)]
 413         tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
 414
 415         bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
 416                               group `lengthExceeds` 1]
 417         get_uniq (tc,_) = getUnique tc
 418
 419     mapM (addErrTc . dupGenericInsts) bad_groups
 420
 421         -- Check that there is an InstInfo for each generic type constructor
 422     let
 423         missing = genericTyConNames `minusList` [tyConName tc | (tc,_) <- tc_inst_infos]
 424
 425     checkTc (null missing) (missingGenericInstances missing)
 426
 427     return inst_infos
 428   where
 429     generic_binds :: [(HsType Name, LHsBind Name)]
 430     generic_binds = getGenericBinds def_methods
 431 get_generics decl = pprPanic "get_generics" (ppr decl)
 432
 433
 434 ---------------------------------
 435 getGenericBinds :: LHsBinds Name -> [(HsType Name, LHsBind Name)]
 436   -- Takes a group of method bindings, finds the generic ones, and returns
 437   -- them in finite map indexed by the type parameter in the definition.
 438 getGenericBinds binds = concat (map getGenericBind (bagToList binds))
 439
 440 getGenericBind :: LHsBindLR Name Name -> [(HsType Name, LHsBindLR Name Name)]
 441 getGenericBind (L loc bind@(FunBind { fun_matches = MatchGroup matches ty }))
 442   = groupWith wrap (mapCatMaybes maybeGenericMatch matches)
 443   where
 444     wrap ms = L loc (bind { fun_matches = MatchGroup ms ty })
 445 getGenericBind _
 446   = []
 447
 448 groupWith :: ([a] -> b) -> [(HsType Name, a)] -> [(HsType Name, b)]
 449 groupWith _  []          = []
 450 groupWith op ((t,v):prs) = (t, op (v:vs)) : groupWith op rest
 451     where
 452       vs              = map snd this
 453       (this,rest)     = partition same_t prs
 454       same_t (t', _v) = t `eqPatType` t'
 455
 456 eqPatLType :: LHsType Name -> LHsType Name -> Bool
 457 eqPatLType t1 t2 = unLoc t1 `eqPatType` unLoc t2
 458
 459 eqPatType :: HsType Name -> HsType Name -> Bool
 460 -- A very simple equality function, only for
 461 -- type patterns in generic function definitions.
 462 eqPatType (HsTyVar v1)       (HsTyVar v2)       = v1==v2
 463 eqPatType (HsAppTy s1 t1)    (HsAppTy s2 t2)    = s1 `eqPatLType` s2 && t1 `eqPatLType` t2
 464 eqPatType (HsOpTy s1 op1 t1) (HsOpTy s2 op2 t2) = s1 `eqPatLType` s2 && t1 `eqPatLType` t2 && unLoc op1 == unLoc op2
 465 eqPatType (HsNumTy n1)       (HsNumTy n2)       = n1 == n2
 466 eqPatType (HsParTy t1)       t2                 = unLoc t1 `eqPatType` t2
 467 eqPatType t1                 (HsParTy t2)       = t1 `eqPatType` unLoc t2
 468 eqPatType _ _ = False
 469
 470 ---------------------------------
 471 mkGenericInstance :: Class
 472                   -> (HsType Name, LHsBinds Name)
 473                   -> TcM (InstInfo Name)
 474
 475 mkGenericInstance clas (hs_ty, binds) = do
 476   -- Make a generic instance declaration
 477   -- For example:       instance (C a, C b) => C (a+b) where { binds }
 478
 479         -- Extract the universally quantified type variables
 480         -- and wrap them as forall'd tyvars, so that kind inference
 481         -- works in the standard way
 482     let
 483         sig_tvs = map (noLoc.UserTyVar) (nameSetToList (extractHsTyVars (noLoc hs_ty)))
 484         hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
 485
 486         -- Type-check the instance type, and check its form
 487     forall_inst_ty <- tcHsSigType GenPatCtxt hs_forall_ty
 488     let
 489         (tyvars, inst_ty) = tcSplitForAllTys forall_inst_ty
 490
 491     checkTc (validGenericInstanceType inst_ty)
 492             (badGenericInstanceType binds)
 493
 494         -- Make the dictionary function.
 495     span <- getSrcSpanM
 496     overlap_flag <- getOverlapFlag
 497     dfun_name <- newDFunName clas [inst_ty] span
 498     let
 499         inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
 500         dfun_id    = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
 501         ispec      = mkLocalInstance dfun_id overlap_flag
 502
 503     return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] })
 504 \end{code}
 505
 506
 507 %************************************************************************
 508 %*                                                                      *
 509                 Error messages
 510 %*                                                                      *
 511 %************************************************************************
 512
 513 \begin{code}
 514 tcAddDeclCtxt :: TyClDecl Name -> TcM a -> TcM a
 515 tcAddDeclCtxt decl thing_inside
 516   = addErrCtxt ctxt thing_inside
 517   where
 518      thing | isClassDecl decl  = "class"
 519            | isTypeDecl decl   = "type synonym" ++ maybeInst
 520            | isDataDecl decl   = if tcdND decl == NewType
 521                                  then "newtype" ++ maybeInst
 522                                  else "data type" ++ maybeInst
 523            | isFamilyDecl decl = "family"
 524            | otherwise         = panic "tcAddDeclCtxt/thing"
 525
 526      maybeInst | isFamInstDecl decl = " instance"
 527                | otherwise          = ""
 528
 529      ctxt = hsep [ptext (sLit "In the"), text thing,
 530                   ptext (sLit "declaration for"), quotes (ppr (tcdName decl))]
 531
 532 badMethodErr :: Outputable a => a -> Name -> SDoc
 533 badMethodErr clas op
 534   = hsep [ptext (sLit "Class"), quotes (ppr clas),
 535           ptext (sLit "does not have a method"), quotes (ppr op)]
 536
 537 badATErr :: Class -> Name -> SDoc
 538 badATErr clas at
 539   = hsep [ptext (sLit "Class"), quotes (ppr clas),
 540           ptext (sLit "does not have an associated type"), quotes (ppr at)]
 541
 542 omittedATWarn :: Name -> SDoc
 543 omittedATWarn at
 544   = ptext (sLit "No explicit AT declaration for") <+> quotes (ppr at)
 545
 546 badGenericInstance :: Var -> SDoc -> SDoc
 547 badGenericInstance sel_id because
 548   = sep [ptext (sLit "Can't derive generic code for") <+> quotes (ppr sel_id),
 549          because]
 550
 551 notSimple :: [Type] -> SDoc
 552 notSimple inst_tys
 553   = vcat [ptext (sLit "because the instance type(s)"),
 554           nest 2 (ppr inst_tys),
 555           ptext (sLit "is not a simple type of form (T a1 ... an)")]
 556
 557 notGeneric :: TyCon -> SDoc
 558 notGeneric tycon
 559   = vcat [ptext (sLit "because the instance type constructor") <+> quotes (ppr tycon) <+>
 560           ptext (sLit "was not compiled with -XGenerics")]
 561
 562 badGenericInstanceType :: LHsBinds Name -> SDoc
 563 badGenericInstanceType binds
 564   = vcat [ptext (sLit "Illegal type pattern in the generic bindings"),
 565           nest 4 (ppr binds)]
 566
 567 missingGenericInstances :: [Name] -> SDoc
 568 missingGenericInstances missing
 569   = ptext (sLit "Missing type patterns for") <+> pprQuotedList missing
 570
 571 dupGenericInsts :: [(TyCon, InstInfo a)] -> SDoc
 572 dupGenericInsts tc_inst_infos
 573   = vcat [ptext (sLit "More than one type pattern for a single generic type constructor:"),
 574           nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
 575           ptext (sLit "All the type patterns for a generic type constructor must be identical")
 576     ]
 577   where
 578     ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
 579
 580 mixedGenericErr :: Name -> SDoc
 581 mixedGenericErr op
 582   = ptext (sLit "Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
 583 \end{code}