2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 Typechecking class declarations
9 module TcClassDcl ( tcClassSigs, tcClassDecl2,
11 MethodSpec, tcMethodBind, mkMethodBind,
12 tcAddDeclCtxt, badMethodErr, badATErr, omittedATWarn
15 #include "HsVersions.h"
61 Every class implicitly declares a new data type, corresponding to dictionaries
62 of that class. So, for example:
64 class (D a) => C a where
66 op2 :: forall b. Ord b => a -> b -> b
68 would implicitly declare
70 data CDict a = CDict (D a)
72 (forall b. Ord b => a -> b -> b)
74 (We could use a record decl, but that means changing more of the existing apparatus.
77 For classes with just one superclass+method, we use a newtype decl instead:
80 op :: forallb. a -> b -> b
84 newtype CDict a = CDict (forall b. a -> b -> b)
86 Now DictTy in Type is just a form of type synomym:
87 DictTy c t = TyConTy CDict `AppTy` t
89 Death to "ExpandingDicts".
92 %************************************************************************
94 Type-checking the class op signatures
96 %************************************************************************
99 tcClassSigs :: Name -- Name of the class
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 ; mappM (tcClassSig dm_env) op_sigs }
110 op_sigs = [sig | sig@(L _ (TypeSig _ _)) <- sigs]
111 op_names = [n | sig@(L _ (TypeSig (L _ n) _)) <- op_sigs]
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)
124 checkDefaultBind clas ops (FunBind {fun_id = L _ op, fun_matches = MatchGroup matches _ })
125 = do { -- Check that the op is from this class
126 checkTc (op `elem` ops) (badMethodErr clas op)
128 -- Check that all the defns ar generic, or none are
129 ; checkTc (all_generic || none_generic) (mixedGenericErr op)
131 ; returnM (op, all_generic)
134 n_generic = count (isJust . maybeGenericMatch) matches
135 none_generic = n_generic == 0
136 all_generic = matches `lengthIs` n_generic
139 tcClassSig :: NameEnv Bool -- Info about default methods;
143 tcClassSig dm_env (L loc (TypeSig (L _ op_name) op_hs_ty))
144 = setSrcSpan loc $ do
145 { op_ty <- tcHsKindedType op_hs_ty -- Class tyvars already in scope
146 ; let dm = case lookupNameEnv dm_env op_name of
148 Just False -> DefMeth
149 Just True -> GenDefMeth
150 ; returnM (op_name, dm, op_ty) }
154 %************************************************************************
156 \subsection[Default methods]{Default methods}
158 %************************************************************************
160 The default methods for a class are each passed a dictionary for the
161 class, so that they get access to the other methods at the same type.
162 So, given the class decl
166 op2 :: Ord b => a -> b -> b -> b
169 op2 x y z = if (op1 x) && (y < z) then y else z
171 we get the default methods:
173 defm.Foo.op1 :: forall a. Foo a => a -> Bool
174 defm.Foo.op1 = /\a -> \dfoo -> \x -> True
176 defm.Foo.op2 :: forall a. Foo a => forall b. Ord b => a -> b -> b -> b
177 defm.Foo.op2 = /\ a -> \ dfoo -> /\ b -> \ dord -> \x y z ->
178 if (op1 a dfoo x) && (< b dord y z) then y else z
181 When we come across an instance decl, we may need to use the default
184 instance Foo Int where {}
188 const.Foo.Int.op1 :: Int -> Bool
189 const.Foo.Int.op1 = defm.Foo.op1 Int dfun.Foo.Int
191 const.Foo.Int.op2 :: forall b. Ord b => Int -> b -> b -> b
192 const.Foo.Int.op2 = defm.Foo.op2 Int dfun.Foo.Int
194 dfun.Foo.Int :: Foo Int
195 dfun.Foo.Int = (const.Foo.Int.op1, const.Foo.Int.op2)
197 Notice that, as with method selectors above, we assume that dictionary
198 application is curried, so there's no need to mention the Ord dictionary
199 in const.Foo.Int.op2 (or the type variable).
202 instance Foo a => Foo [a] where {}
204 dfun.Foo.List :: forall a. Foo a -> Foo [a]
206 = /\ a -> \ dfoo_a ->
208 op1 = defm.Foo.op1 [a] dfoo_list
209 op2 = defm.Foo.op2 [a] dfoo_list
210 dfoo_list = (op1, op2)
215 @tcClassDecls2@ generates bindings for polymorphic default methods
216 (generic default methods have by now turned into instance declarations)
219 tcClassDecl2 :: LTyClDecl Name -- The class declaration
220 -> TcM (LHsBinds Id, [Id])
222 tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs,
223 tcdMeths = default_binds}))
224 = recoverM (returnM (emptyLHsBinds, [])) $
226 tcLookupLocatedClass class_name `thenM` \ clas ->
228 -- We make a separate binding for each default method.
229 -- At one time I used a single AbsBinds for all of them, thus
230 -- AbsBind [d] [dm1, dm2, dm3] { dm1 = ...; dm2 = ...; dm3 = ... }
231 -- But that desugars into
232 -- ds = \d -> (..., ..., ...)
233 -- dm1 = \d -> case ds d of (a,b,c) -> a
234 -- And since ds is big, it doesn't get inlined, so we don't get good
235 -- default methods. Better to make separate AbsBinds for each
237 (tyvars, _, _, op_items) = classBigSig clas
238 rigid_info = ClsSkol clas
239 origin = SigOrigin rigid_info
240 prag_fn = mkPragFun sigs
241 sig_fn = mkTcSigFun sigs
242 clas_tyvars = tcSkolSigTyVars rigid_info tyvars
243 tc_dm = tcDefMeth origin clas clas_tyvars
244 default_binds sig_fn prag_fn
246 dm_sel_ids = [sel_id | (sel_id, DefMeth) <- op_items]
247 -- Generate code for polymorphic default methods only
248 -- (Generic default methods have turned into instance decls by now.)
249 -- This is incompatible with Hugs, which expects a polymorphic
250 -- default method for every class op, regardless of whether or not
251 -- the programmer supplied an explicit default decl for the class.
252 -- (If necessary we can fix that, but we don't have a convenient Id to hand.)
254 mapAndUnzipM tc_dm dm_sel_ids `thenM` \ (defm_binds, dm_ids_s) ->
255 returnM (listToBag defm_binds, concat dm_ids_s)
257 tcDefMeth origin clas tyvars binds_in sig_fn prag_fn sel_id
258 = do { dm_name <- lookupTopBndrRn (mkDefMethRdrName sel_id)
259 ; let inst_tys = mkTyVarTys tyvars
260 dm_ty = idType sel_id -- Same as dict selector!
261 cls_pred = mkClassPred clas inst_tys
262 local_dm_id = mkDefaultMethodId dm_name dm_ty
264 ; (_, meth_info) <- mkMethodBind origin clas inst_tys binds_in (sel_id, DefMeth)
265 ; loc <- getInstLoc origin
266 ; this_dict <- newDictBndr loc cls_pred
267 ; (defm_bind, insts_needed) <- getLIE (tcMethodBind tyvars [cls_pred] [this_dict]
268 sig_fn prag_fn meth_info)
270 ; addErrCtxt (defltMethCtxt clas) $ do
273 { dict_binds <- tcSimplifyCheck
279 -- Simplification can do unification
280 ; checkSigTyVars tyvars
283 -- We'll have an inline pragma on the local binding, made by tcMethodBind
284 -- but that's not enough; we want one on the global default method too
285 -- Specialisations, on the other hand, belong on the thing inside only, I think
286 ; let (_,dm_inst_id,_) = meth_info
287 sel_name = idName sel_id
288 inline_prags = filter isInlineLSig (prag_fn sel_name)
289 ; prags <- tcPrags dm_inst_id inline_prags
291 ; let full_bind = AbsBinds tyvars
293 [(tyvars, local_dm_id, dm_inst_id, prags)]
294 (dict_binds `unionBags` defm_bind)
295 ; returnM (noLoc full_bind, [local_dm_id]) }}
297 mkDefMethRdrName :: Id -> RdrName
298 mkDefMethRdrName sel_id = mkDerivedRdrName (idName sel_id) mkDefaultMethodOcc
302 %************************************************************************
304 \subsection{Typechecking a method}
306 %************************************************************************
308 @tcMethodBind@ is used to type-check both default-method and
309 instance-decl method declarations. We must type-check methods one at a
310 time, because their signatures may have different contexts and
314 type MethodSpec = (Id, -- Global selector Id
315 Id, -- Local Id (class tyvars instantiated)
316 LHsBind Name) -- Binding for the method
319 :: [TcTyVar] -- Skolemised type variables for the
320 -- enclosing class/instance decl.
321 -- They'll be signature tyvars, and we
322 -- want to check that they don't get bound
323 -- Also they are scoped, so we bring them into scope
324 -- Always equal the range of the type envt
325 -> TcThetaType -- Available theta; it's just used for the error message
326 -> [Inst] -- Available from context, used to simplify constraints
327 -- from the method body
328 -> TcSigFun -- For scoped tyvars, indexed by sel_name
329 -> TcPragFun -- Pragmas (e.g. inline pragmas), indexed by sel_name
330 -> MethodSpec -- Details of this method
333 tcMethodBind inst_tyvars inst_theta avail_insts sig_fn prag_fn
334 (sel_id, meth_id, meth_bind)
335 = recoverM (returnM emptyLHsBinds) $
336 -- If anything fails, recover returning no bindings.
337 -- This is particularly useful when checking the default-method binding of
338 -- a class decl. If we don't recover, we don't add the default method to
339 -- the type enviroment, and we get a tcLookup failure on $dmeth later.
341 -- Check the bindings; first adding inst_tyvars to the envt
342 -- so that we don't quantify over them in nested places
344 let sel_name = idName sel_id
345 meth_sig_fn meth_name = ASSERT( meth_name == idName meth_id ) sig_fn sel_name
346 -- The meth_bind metions the meth_name, but sig_fn is indexed by sel_name
348 tcExtendTyVarEnv inst_tyvars (
349 tcExtendIdEnv [meth_id] $ -- In scope for tcInstSig
350 addErrCtxt (methodCtxt sel_id) $
352 tcMonoBinds [meth_bind] meth_sig_fn Recursive
353 ) `thenM` \ ((meth_bind, mono_bind_infos), meth_lie) ->
355 -- Now do context reduction. We simplify wrt both the local tyvars
356 -- and the ones of the class/instance decl, so that there is
359 -- op :: Eq a => a -> b -> a
361 -- We do this for each method independently to localise error messages
364 [(_, Just sig, local_meth_id)] = mono_bind_infos
368 addErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id)) $
369 newDictBndrs loc (sig_theta sig) `thenM` \ meth_dicts ->
371 meth_tvs = sig_tvs sig
372 all_tyvars = meth_tvs ++ inst_tyvars
373 all_insts = avail_insts ++ meth_dicts
376 loc all_tyvars all_insts meth_lie `thenM` \ lie_binds ->
378 checkSigTyVars all_tyvars `thenM_`
380 tcPrags meth_id (prag_fn sel_name) `thenM` \ prags ->
382 poly_meth_bind = noLoc $ AbsBinds meth_tvs
383 (map instToId meth_dicts)
384 [(meth_tvs, meth_id, local_meth_id, prags)]
385 (lie_binds `unionBags` meth_bind)
387 returnM (unitBag poly_meth_bind)
390 mkMethodBind :: InstOrigin
391 -> Class -> [TcType] -- Class and instance types
392 -> LHsBinds Name -- Method binding (pick the right one from in here)
394 -> TcM (Maybe Inst, -- Method inst
396 -- Find the binding for the specified method, or make
397 -- up a suitable default method if it isn't there
399 mkMethodBind origin clas inst_tys meth_binds (sel_id, dm_info)
400 = mkMethId origin clas sel_id inst_tys `thenM` \ (mb_inst, meth_id) ->
402 meth_name = idName meth_id
404 -- Figure out what method binding to use
405 -- If the user suppplied one, use it, else construct a default one
406 getSrcSpanM `thenM` \ loc ->
407 (case find_bind (idName sel_id) meth_name meth_binds of
408 Just user_bind -> returnM user_bind
410 mkDefMethRhs origin clas inst_tys sel_id loc dm_info `thenM` \ rhs ->
412 returnM (noLoc $ mkFunBind (noLoc meth_name) [mkSimpleMatch [] rhs])
413 ) `thenM` \ meth_bind ->
415 returnM (mb_inst, (sel_id, meth_id, meth_bind))
417 mkMethId :: InstOrigin -> Class
418 -> Id -> [TcType] -- Selector, and instance types
419 -> TcM (Maybe Inst, Id)
421 -- mkMethId instantiates the selector Id at the specified types
422 mkMethId origin clas sel_id inst_tys
424 (tyvars,rho) = tcSplitForAllTys (idType sel_id)
425 rho_ty = ASSERT( length tyvars == length inst_tys )
426 substTyWith tyvars inst_tys rho
427 (preds,tau) = tcSplitPhiTy rho_ty
428 first_pred = head preds
430 -- The first predicate should be of form (C a b)
431 -- where C is the class in question
432 ASSERT( not (null preds) &&
433 case getClassPredTys_maybe first_pred of
434 { Just (clas1,tys) -> clas == clas1 ; Nothing -> False }
436 if isSingleton preds then
437 -- If it's the only one, make a 'method'
438 getInstLoc origin `thenM` \ inst_loc ->
439 newMethod inst_loc sel_id inst_tys `thenM` \ meth_inst ->
440 returnM (Just meth_inst, instToId meth_inst)
442 -- If it's not the only one we need to be careful
443 -- For example, given 'op' defined thus:
445 -- op :: (?x :: String) => a -> a
446 -- (mkMethId op T) should return an Inst with type
447 -- (?x :: String) => T -> T
448 -- That is, the class-op's context is still there.
449 -- BUT: it can't be a Method any more, because it breaks
450 -- INVARIANT 2 of methods. (See the data decl for Inst.)
451 newUnique `thenM` \ uniq ->
452 getSrcSpanM `thenM` \ loc ->
454 real_tau = mkPhiTy (tail preds) tau
455 meth_id = mkUserLocal (getOccName sel_id) uniq real_tau
456 (srcSpanStart loc) --TODO
458 returnM (Nothing, meth_id)
460 -- The user didn't supply a method binding,
461 -- so we have to make up a default binding
462 -- The RHS of a default method depends on the default-method info
463 mkDefMethRhs origin clas inst_tys sel_id loc DefMeth
464 = -- An polymorphic default method
465 lookupImportedName (mkDefMethRdrName sel_id) `thenM` \ dm_name ->
466 -- Might not be imported, but will be an OrigName
467 traceRn (text "mkDefMeth" <+> ppr dm_name) `thenM_`
468 returnM (nlHsVar dm_name)
470 mkDefMethRhs origin clas inst_tys sel_id loc NoDefMeth
471 = -- No default method
472 -- Warn only if -fwarn-missing-methods
473 doptM Opt_WarnMissingMethods `thenM` \ warn ->
474 warnTc (isInstDecl origin
476 && reportIfUnused (getOccName sel_id))
477 (omittedMethodWarn sel_id) `thenM_`
480 error_rhs = noLoc $ HsLam (mkMatchGroup [mkSimpleMatch wild_pats simple_rhs])
481 simple_rhs = nlHsApp (nlHsVar (getName nO_METHOD_BINDING_ERROR_ID))
482 (nlHsLit (HsStringPrim (mkFastString error_msg)))
483 error_msg = showSDoc (hcat [ppr loc, text "|", ppr sel_id ])
485 -- When the type is of form t1 -> t2 -> t3
486 -- make a default method like (\ _ _ -> noMethBind "blah")
487 -- rather than simply (noMethBind "blah")
488 -- Reason: if t1 or t2 are higher-ranked types we get n
489 -- silly ambiguity messages.
490 -- Example: f :: (forall a. Eq a => a -> a) -> Int
492 -- Here, tcSub tries to force (error "urk") to have the right type,
493 -- thus: f = \(x::forall a. Eq a => a->a) -> error "urk" (x t)
494 -- where 't' is fresh ty var. This leads directly to "ambiguous t".
496 -- NB: technically this changes the meaning of the default-default
497 -- method slightly, because `seq` can see the lambdas. Oh well.
498 (_,_,tau1) = tcSplitSigmaTy (idType sel_id)
499 (_,_,tau2) = tcSplitSigmaTy tau1
500 -- Need two splits because the selector can have a type like
501 -- forall a. Foo a => forall b. Eq b => ...
502 (arg_tys, _) = tcSplitFunTys tau2
503 wild_pats = [nlWildPat | ty <- arg_tys]
505 mkDefMethRhs origin clas inst_tys sel_id loc GenDefMeth
506 = -- A generic default method
507 -- If the method is defined generically, we can only do the job if the
508 -- instance declaration is for a single-parameter type class with
509 -- a type constructor applied to type arguments in the instance decl
510 -- (checkTc, so False provokes the error)
511 ASSERT( isInstDecl origin ) -- We never get here from a class decl
512 do { checkTc (isJust maybe_tycon)
513 (badGenericInstance sel_id (notSimple inst_tys))
514 ; checkTc (tyConHasGenerics tycon)
515 (badGenericInstance sel_id (notGeneric tycon))
518 ; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
519 (vcat [ppr clas <+> ppr inst_tys,
520 nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
522 -- Rename it before returning it
523 ; (rn_rhs, _) <- rnLExpr rhs
526 rhs = mkGenericRhs sel_id clas_tyvar tycon
528 -- The tycon is only used in the generic case, and in that
529 -- case we require that the instance decl is for a single-parameter
530 -- type class with type variable arguments:
531 -- instance (...) => C (T a b)
532 clas_tyvar = head (classTyVars clas)
533 Just tycon = maybe_tycon
534 maybe_tycon = case inst_tys of
535 [ty] -> case tcSplitTyConApp_maybe ty of
536 Just (tycon, arg_tys) | all tcIsTyVarTy arg_tys -> Just tycon
540 isInstDecl (SigOrigin InstSkol) = True
541 isInstDecl (SigOrigin (ClsSkol _)) = False
546 -- The renamer just puts the selector ID as the binder in the method binding
547 -- but we must use the method name; so we substitute it here. Crude but simple.
548 find_bind sel_name meth_name binds
549 = foldlBag seqMaybe Nothing (mapBag f binds)
551 f (L loc1 bind@(FunBind { fun_id = L loc2 op_name })) | op_name == sel_name
552 = Just (L loc1 (bind { fun_id = L loc2 meth_name }))
557 %************************************************************************
559 \subsection{Extracting generic instance declaration from class declarations}
561 %************************************************************************
563 @getGenericInstances@ extracts the generic instance declarations from a class
564 declaration. For exmaple
569 op{ x+y } (Inl v) = ...
570 op{ x+y } (Inr v) = ...
571 op{ x*y } (v :*: w) = ...
574 gives rise to the instance declarations
576 instance C (x+y) where
580 instance C (x*y) where
588 getGenericInstances :: [LTyClDecl Name] -> TcM [InstInfo]
589 getGenericInstances class_decls
590 = do { gen_inst_infos <- mappM (addLocM get_generics) class_decls
591 ; let { gen_inst_info = concat gen_inst_infos }
593 -- Return right away if there is no generic stuff
594 ; if null gen_inst_info then returnM []
597 -- Otherwise print it out
599 ; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
600 (vcat (map pprInstInfoDetails gen_inst_info)))
601 ; returnM gen_inst_info }}
603 get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
605 = returnM [] -- The comon case: no generic default methods
607 | otherwise -- A source class decl with generic default methods
608 = recoverM (returnM []) $
610 tcLookupLocatedClass class_name `thenM` \ clas ->
612 -- Group by type, and
613 -- make an InstInfo out of each group
615 groups = groupWith listToBag generic_binds
617 mappM (mkGenericInstance clas) groups `thenM` \ inst_infos ->
619 -- Check that there is only one InstInfo for each type constructor
620 -- The main way this can fail is if you write
621 -- f {| a+b |} ... = ...
622 -- f {| x+y |} ... = ...
623 -- Then at this point we'll have an InstInfo for each
625 -- The class should be unary, which is why simpleInstInfoTyCon should be ok
627 tc_inst_infos :: [(TyCon, InstInfo)]
628 tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
630 bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
631 group `lengthExceeds` 1]
632 get_uniq (tc,_) = getUnique tc
634 mappM (addErrTc . dupGenericInsts) bad_groups `thenM_`
636 -- Check that there is an InstInfo for each generic type constructor
638 missing = genericTyConNames `minusList` [tyConName tc | (tc,_) <- tc_inst_infos]
640 checkTc (null missing) (missingGenericInstances missing) `thenM_`
644 generic_binds :: [(HsType Name, LHsBind Name)]
645 generic_binds = getGenericBinds def_methods
648 ---------------------------------
649 getGenericBinds :: LHsBinds Name -> [(HsType Name, LHsBind Name)]
650 -- Takes a group of method bindings, finds the generic ones, and returns
651 -- them in finite map indexed by the type parameter in the definition.
652 getGenericBinds binds = concat (map getGenericBind (bagToList binds))
654 getGenericBind (L loc bind@(FunBind { fun_matches = MatchGroup matches ty }))
655 = groupWith wrap (mapCatMaybes maybeGenericMatch matches)
657 wrap ms = L loc (bind { fun_matches = MatchGroup ms ty })
661 groupWith :: ([a] -> b) -> [(HsType Name, a)] -> [(HsType Name, b)]
663 groupWith op ((t,v):prs) = (t, op (v:vs)) : groupWith op rest
666 (this,rest) = partition same_t prs
667 same_t (t',v) = t `eqPatType` t'
669 eqPatLType :: LHsType Name -> LHsType Name -> Bool
670 eqPatLType t1 t2 = unLoc t1 `eqPatType` unLoc t2
672 eqPatType :: HsType Name -> HsType Name -> Bool
673 -- A very simple equality function, only for
674 -- type patterns in generic function definitions.
675 eqPatType (HsTyVar v1) (HsTyVar v2) = v1==v2
676 eqPatType (HsAppTy s1 t1) (HsAppTy s2 t2) = s1 `eqPatLType` s2 && t2 `eqPatLType` t2
677 eqPatType (HsOpTy s1 op1 t1) (HsOpTy s2 op2 t2) = s1 `eqPatLType` s2 && t2 `eqPatLType` t2 && unLoc op1 == unLoc op2
678 eqPatType (HsNumTy n1) (HsNumTy n2) = n1 == n2
679 eqPatType (HsParTy t1) t2 = unLoc t1 `eqPatType` t2
680 eqPatType t1 (HsParTy t2) = t1 `eqPatType` unLoc t2
681 eqPatType _ _ = False
683 ---------------------------------
684 mkGenericInstance :: Class
685 -> (HsType Name, LHsBinds Name)
688 mkGenericInstance clas (hs_ty, binds)
689 -- Make a generic instance declaration
690 -- For example: instance (C a, C b) => C (a+b) where { binds }
692 = -- Extract the universally quantified type variables
693 -- and wrap them as forall'd tyvars, so that kind inference
694 -- works in the standard way
696 sig_tvs = map (noLoc.UserTyVar) (nameSetToList (extractHsTyVars (noLoc hs_ty)))
697 hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
699 -- Type-check the instance type, and check its form
700 tcHsSigType GenPatCtxt hs_forall_ty `thenM` \ forall_inst_ty ->
702 (tyvars, inst_ty) = tcSplitForAllTys forall_inst_ty
704 checkTc (validGenericInstanceType inst_ty)
705 (badGenericInstanceType binds) `thenM_`
707 -- Make the dictionary function.
708 getSrcSpanM `thenM` \ span ->
709 getOverlapFlag `thenM` \ overlap_flag ->
710 newDFunName clas [inst_ty] (srcSpanStart span) `thenM` \ dfun_name ->
712 inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
713 dfun_id = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
714 ispec = mkLocalInstance dfun_id overlap_flag
716 returnM (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] })
720 %************************************************************************
724 %************************************************************************
727 tcAddDeclCtxt decl thing_inside
728 = addErrCtxt ctxt thing_inside
731 ClassDecl {} -> "class"
732 TySynonym {} -> "type synonym"
733 TyFunction {} -> "type function signature"
734 TyData {tcdND = NewType} -> "newtype" ++ maybeSig
735 TyData {tcdND = DataType} -> "data type" ++ maybeSig
737 maybeSig | isKindSigDecl decl = " signature"
740 ctxt = hsep [ptext SLIT("In the"), text thing,
741 ptext SLIT("declaration for"), quotes (ppr (tcdName decl))]
744 = ptext SLIT("When checking the default methods for class") <+> quotes (ppr clas)
747 = ptext SLIT("In the definition for method") <+> quotes (ppr sel_id)
750 = hsep [ptext SLIT("Class"), quotes (ppr clas),
751 ptext SLIT("does not have a method"), quotes (ppr op)]
754 = hsep [ptext SLIT("Class"), quotes (ppr clas),
755 ptext SLIT("does not have an associated type"), quotes (ppr at)]
757 omittedMethodWarn sel_id
758 = ptext SLIT("No explicit method nor default method for") <+> quotes (ppr sel_id)
761 = ptext SLIT("No explicit AT declaration for") <+> quotes (ppr at)
763 badGenericInstance sel_id because
764 = sep [ptext SLIT("Can't derive generic code for") <+> quotes (ppr sel_id),
768 = vcat [ptext SLIT("because the instance type(s)"),
769 nest 2 (ppr inst_tys),
770 ptext SLIT("is not a simple type of form (T a b c)")]
773 = vcat [ptext SLIT("because the instance type constructor") <+> quotes (ppr tycon) <+>
774 ptext SLIT("was not compiled with -fgenerics")]
776 badGenericInstanceType binds
777 = vcat [ptext SLIT("Illegal type pattern in the generic bindings"),
780 missingGenericInstances missing
781 = ptext SLIT("Missing type patterns for") <+> pprQuotedList missing
783 dupGenericInsts tc_inst_infos
784 = vcat [ptext SLIT("More than one type pattern for a single generic type constructor:"),
785 nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
786 ptext SLIT("All the type patterns for a generic type constructor must be identical")
789 ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
792 = ptext SLIT("Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)