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