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