2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 TcInstDecls: Typechecking instance declarations
9 module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
15 import TcPat( addInlinePrags )
23 import MkCore ( nO_METHOD_BINDING_ERROR_ID )
26 import RnSource ( addTcgDUs )
36 import CoreUtils ( mkPiTypes )
37 import CoreUnfold ( mkDFunUnfolding )
38 import CoreSyn ( Expr(Var), DFunArg(..), CoreExpr )
51 import Maybes ( orElse )
56 #include "HsVersions.h"
59 Typechecking instance declarations is done in two passes. The first
60 pass, made by @tcInstDecls1@, collects information to be used in the
63 This pre-processed info includes the as-yet-unprocessed bindings
64 inside the instance declaration. These are type-checked in the second
65 pass, when the class-instance envs and GVE contain all the info from
66 all the instance and value decls. Indeed that's the reason we need
67 two passes over the instance decls.
70 Note [How instance declarations are translated]
71 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
72 Here is how we translation instance declarations into Core
76 op1, op2 :: Ix b => a -> b -> b
80 {-# INLINE [2] op1 #-}
84 op1,op2 :: forall a. C a => forall b. Ix b => a -> b -> b
88 -- Default methods get the 'self' dictionary as argument
89 -- so they can call other methods at the same type
90 -- Default methods get the same type as their method selector
91 $dmop2 :: forall a. C a => forall b. Ix b => a -> b -> b
92 $dmop2 = /\a. \(d:C a). /\b. \(d2: Ix b). <dm-rhs>
93 -- NB: type variables 'a' and 'b' are *both* in scope in <dm-rhs>
94 -- Note [Tricky type variable scoping]
96 -- A top-level definition for each instance method
97 -- Here op1_i, op2_i are the "instance method Ids"
98 -- The INLINE pragma comes from the user pragma
99 {-# INLINE [2] op1_i #-} -- From the instance decl bindings
100 op1_i, op2_i :: forall a. C a => forall b. Ix b => [a] -> b -> b
101 op1_i = /\a. \(d:C a).
104 -- Note [Subtle interaction of recursion and overlap]
106 local_op1 :: forall b. Ix b => [a] -> b -> b
108 -- Source code; run the type checker on this
109 -- NB: Type variable 'a' (but not 'b') is in scope in <rhs>
110 -- Note [Tricky type variable scoping]
114 op2_i = /\a \d:C a. $dmop2 [a] (df_i a d)
116 -- The dictionary function itself
117 {-# NOINLINE CONLIKE df_i #-} -- Never inline dictionary functions
118 df_i :: forall a. C a -> C [a]
119 df_i = /\a. \d:C a. MkC (op1_i a d) (op2_i a d)
120 -- But see Note [Default methods in instances]
121 -- We can't apply the type checker to the default-method call
123 -- Use a RULE to short-circuit applications of the class ops
124 {-# RULE "op1@C[a]" forall a, d:C a.
125 op1 [a] (df_i d) = op1_i a d #-}
127 Note [Instances and loop breakers]
128 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
129 * Note that df_i may be mutually recursive with both op1_i and op2_i.
130 It's crucial that df_i is not chosen as the loop breaker, even
131 though op1_i has a (user-specified) INLINE pragma.
133 * Instead the idea is to inline df_i into op1_i, which may then select
134 methods from the MkC record, and thereby break the recursion with
135 df_i, leaving a *self*-recurisve op1_i. (If op1_i doesn't call op at
136 the same type, it won't mention df_i, so there won't be recursion in
139 * If op1_i is marked INLINE by the user there's a danger that we won't
140 inline df_i in it, and that in turn means that (since it'll be a
141 loop-breaker because df_i isn't), op1_i will ironically never be
142 inlined. But this is OK: the recursion breaking happens by way of
143 a RULE (the magic ClassOp rule above), and RULES work inside InlineRule
144 unfoldings. See Note [RULEs enabled in SimplGently] in SimplUtils
146 Note [ClassOp/DFun selection]
147 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
148 One thing we see a lot is stuff like
150 where 'op2' is a ClassOp and 'df' is DFun. Now, we could inline *both*
151 'op2' and 'df' to get
152 case (MkD ($cop1 d1 d2) ($cop2 d1 d2) ... of
153 MkD _ op2 _ _ _ -> op2
154 And that will reduce to ($cop2 d1 d2) which is what we wanted.
156 But it's tricky to make this work in practice, because it requires us to
157 inline both 'op2' and 'df'. But neither is keen to inline without having
158 seen the other's result; and it's very easy to get code bloat (from the
159 big intermediate) if you inline a bit too much.
161 Instead we use a cunning trick.
162 * We arrange that 'df' and 'op2' NEVER inline.
164 * We arrange that 'df' is ALWAYS defined in the sylised form
165 df d1 d2 = MkD ($cop1 d1 d2) ($cop2 d1 d2) ...
167 * We give 'df' a magical unfolding (DFunUnfolding [$cop1, $cop2, ..])
168 that lists its methods.
170 * We make CoreUnfold.exprIsConApp_maybe spot a DFunUnfolding and return
171 a suitable constructor application -- inlining df "on the fly" as it
174 * We give the ClassOp 'op2' a BuiltinRule that extracts the right piece
175 iff its argument satisfies exprIsConApp_maybe. This is done in
178 * We make 'df' CONLIKE, so that shared uses stil match; eg
180 in ...(op2 d)...(op1 d)...
182 Note [Single-method classes]
183 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
184 If the class has just one method (or, more accurately, just one element
185 of {superclasses + methods}), then we use a different strategy.
187 class C a where op :: a -> a
188 instance C a => C [a] where op = <blah>
190 We translate the class decl into a newtype, which just gives a
191 top-level axiom. The "constructor" MkC expands to a cast, as does the
194 axiom Co:C a :: C a ~ (a->a)
196 op :: forall a. C a -> (a -> a)
197 op a d = d |> (Co:C a)
199 MkC :: forall a. (a->a) -> C a
200 MkC = /\a.\op. op |> (sym Co:C a)
202 The clever RULE stuff doesn't work now, because ($df a d) isn't
203 a constructor application, so exprIsConApp_maybe won't return
206 Instead, we simply rely on the fact that casts are cheap:
208 $df :: forall a. C a => C [a]
209 {-# INLINE df #} -- NB: INLINE this
210 $df = /\a. \d. MkC [a] ($cop_list a d)
211 = $cop_list |> forall a. C a -> (sym (Co:C [a]))
213 $cop_list :: forall a. C a => [a] -> [a]
218 we'll inline 'op' and '$df', since both are simply casts, and
221 Why do we use this different strategy? Because otherwise we
222 end up with non-inlined dictionaries that look like
224 which adds an extra indirection to every use, which seems stupid. See
225 Trac #4138 for an example (although the regression reported there
226 wasn't due to the indirction).
228 There is an awkward wrinkle though: we want to be very
230 instance C a => C [a] where
233 then we'll get an INLINE pragma on $cop_list but it's important that
234 $cop_list only inlines when it's applied to *two* arguments (the
235 dictionary and the list argument). So we nust not eta-expand $df
236 above. We ensure that this doesn't happen by putting an INLINE
237 pragma on the dfun itself; after all, it ends up being just a cast.
239 There is one more dark corner to the INLINE story, even more deeply
240 buried. Consider this (Trac #3772):
242 class DeepSeq a => C a where
245 instance C a => C [a] where
248 class DeepSeq a where
249 deepSeq :: a -> b -> b
251 instance DeepSeq a => DeepSeq [a] where
252 {-# INLINE deepSeq #-}
253 deepSeq xs b = foldr deepSeq b xs
255 That gives rise to these defns:
257 $cdeepSeq :: DeepSeq a -> [a] -> b -> b
258 -- User INLINE( 3 args )!
259 $cdeepSeq a (d:DS a) b (x:[a]) (y:b) = ...
261 $fDeepSeq[] :: DeepSeq a -> DeepSeq [a]
262 -- DFun (with auto INLINE pragma)
263 $fDeepSeq[] a d = $cdeepSeq a d |> blah
265 $cp1 a d :: C a => DeepSep [a]
266 -- We don't want to eta-expand this, lest
267 -- $cdeepSeq gets inlined in it!
268 $cp1 a d = $fDeepSep[] a (scsel a d)
270 $fC[] :: C a => C [a]
272 $fC[] a d = MkC ($cp1 a d) ($cgen a d)
274 Here $cp1 is the code that generates the superclass for C [a]. The
275 issue is this: we must not eta-expand $cp1 either, or else $fDeepSeq[]
276 and then $cdeepSeq will inline there, which is definitely wrong. Like
277 on the dfun, we solve this by adding an INLINE pragma to $cp1.
279 Note [Subtle interaction of recursion and overlap]
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
282 class C a where { op1,op2 :: a -> a }
283 instance C a => C [a] where
284 op1 x = op2 x ++ op2 x
286 instance C [Int] where
289 When type-checking the C [a] instance, we need a C [a] dictionary (for
290 the call of op2). If we look up in the instance environment, we find
291 an overlap. And in *general* the right thing is to complain (see Note
292 [Overlapping instances] in InstEnv). But in *this* case it's wrong to
293 complain, because we just want to delegate to the op2 of this same
296 Why is this justified? Because we generate a (C [a]) constraint in
297 a context in which 'a' cannot be instantiated to anything that matches
298 other overlapping instances, or else we would not be excecuting this
299 version of op1 in the first place.
301 It might even be a bit disguised:
303 nullFail :: C [a] => [a] -> [a]
304 nullFail x = op2 x ++ op2 x
306 instance C a => C [a] where
309 Precisely this is used in package 'regex-base', module Context.hs.
310 See the overlapping instances for RegexContext, and the fact that they
311 call 'nullFail' just like the example above. The DoCon package also
312 does the same thing; it shows up in module Fraction.hs
314 Conclusion: when typechecking the methods in a C [a] instance, we want to
315 treat the 'a' as an *existential* type variable, in the sense described
316 by Note [Binding when looking up instances]. That is why isOverlappableTyVar
317 responds True to an InstSkol, which is the kind of skolem we use in
321 Note [Tricky type variable scoping]
322 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
325 op1, op2 :: Ix b => a -> b -> b
328 instance C a => C [a]
329 {-# INLINE [2] op1 #-}
332 note that 'a' and 'b' are *both* in scope in <dm-rhs>, but only 'a' is
333 in scope in <rhs>. In particular, we must make sure that 'b' is in
334 scope when typechecking <dm-rhs>. This is achieved by subFunTys,
335 which brings appropriate tyvars into scope. This happens for both
336 <dm-rhs> and for <rhs>, but that doesn't matter: the *renamer* will have
337 complained if 'b' is mentioned in <rhs>.
341 %************************************************************************
343 \subsection{Extracting instance decls}
345 %************************************************************************
347 Gather up the instance declarations from their various sources
350 tcInstDecls1 -- Deal with both source-code and imported instance decls
351 :: [LTyClDecl Name] -- For deriving stuff
352 -> [LInstDecl Name] -- Source code instance decls
353 -> [LDerivDecl Name] -- Source code stand-alone deriving decls
354 -> TcM (TcGblEnv, -- The full inst env
355 [InstInfo Name], -- Source-code instance decls to process;
356 -- contains all dfuns for this module
357 HsValBinds Name) -- Supporting bindings for derived instances
359 tcInstDecls1 tycl_decls inst_decls deriv_decls
361 do { -- Stop if addInstInfos etc discovers any errors
362 -- (they recover, so that we get more than one error each
365 -- (1) Do class and family instance declarations
366 ; idx_tycons <- mapAndRecoverM (tcFamInstDecl TopLevel) $
367 filter (isFamInstDecl . unLoc) tycl_decls
368 ; local_info_tycons <- mapAndRecoverM tcLocalInstDecl1 inst_decls
371 at_tycons_s) = unzip local_info_tycons
372 ; at_idx_tycons = concat at_tycons_s ++ idx_tycons
373 ; clas_decls = filter (isClassDecl . unLoc) tycl_decls
374 ; implicit_things = concatMap implicitTyThings at_idx_tycons
375 ; aux_binds = mkRecSelBinds at_idx_tycons
378 -- (2) Add the tycons of indexed types and their implicit
379 -- tythings to the global environment
380 ; tcExtendGlobalEnv (at_idx_tycons ++ implicit_things) $ do {
382 -- (3) Instances from generic class declarations
383 ; generic_inst_info <- getGenericInstances clas_decls
385 -- Next, construct the instance environment so far, consisting
387 -- (a) local instance decls
388 -- (b) generic instances
389 -- (c) local family instance decls
390 ; addInsts local_info $
391 addInsts generic_inst_info $
392 addFamInsts at_idx_tycons $ do {
394 -- (4) Compute instances from "deriving" clauses;
395 -- This stuff computes a context for the derived instance
396 -- decl, so it needs to know about all the instances possible
397 -- NB: class instance declarations can contain derivings as
398 -- part of associated data type declarations
399 failIfErrsM -- If the addInsts stuff gave any errors, don't
400 -- try the deriving stuff, because that may give
402 ; (deriv_inst_info, deriv_binds, deriv_dus, deriv_tys, deriv_ty_insts)
403 <- tcDeriving tycl_decls inst_decls deriv_decls
405 -- Extend the global environment also with the generated datatypes for
406 -- the generic representation
407 ; gbl_env <- addFamInsts (map ATyCon deriv_ty_insts) $
408 tcExtendGlobalEnv (map ATyCon (deriv_tys ++ deriv_ty_insts)) $
409 addInsts deriv_inst_info getGblEnv
410 -- ; traceTc "Generic deriving" (vcat (map pprInstInfo deriv_inst_info))
411 ; return ( addTcgDUs gbl_env deriv_dus,
412 generic_inst_info ++ deriv_inst_info ++ local_info,
413 aux_binds `plusHsValBinds` deriv_binds)
416 addInsts :: [InstInfo Name] -> TcM a -> TcM a
417 addInsts infos thing_inside
418 = tcExtendLocalInstEnv (map iSpec infos) thing_inside
420 addFamInsts :: [TyThing] -> TcM a -> TcM a
421 addFamInsts tycons thing_inside
422 = tcExtendLocalFamInstEnv (map mkLocalFamInstTyThing tycons) thing_inside
424 mkLocalFamInstTyThing (ATyCon tycon) = mkLocalFamInst tycon
425 mkLocalFamInstTyThing tything = pprPanic "TcInstDcls.addFamInsts"
430 tcLocalInstDecl1 :: LInstDecl Name
431 -> TcM (InstInfo Name, [TyThing])
432 -- A source-file instance declaration
433 -- Type-check all the stuff before the "where"
435 -- We check for respectable instance type, and context
436 tcLocalInstDecl1 (L loc (InstDecl poly_ty binds uprags ats))
438 addErrCtxt (instDeclCtxt1 poly_ty) $
440 do { is_boot <- tcIsHsBoot
441 ; checkTc (not is_boot || (isEmptyLHsBinds binds && null uprags))
444 ; (tyvars, theta, clas, inst_tys) <- tcHsInstHead poly_ty
445 ; checkValidInstance poly_ty tyvars theta clas inst_tys
447 -- Next, process any associated types.
448 ; idx_tycons <- recoverM (return []) $
449 do { idx_tycons <- checkNoErrs $
450 mapAndRecoverM (tcFamInstDecl NotTopLevel) ats
451 ; checkValidAndMissingATs clas (tyvars, inst_tys)
453 ; return idx_tycons }
455 -- Finally, construct the Core representation of the instance.
456 -- (This no longer includes the associated types.)
457 ; dfun_name <- newDFunName clas inst_tys (getLoc poly_ty)
458 -- Dfun location is that of instance *header*
459 ; overlap_flag <- getOverlapFlag
460 ; let (eq_theta,dict_theta) = partition isEqPred theta
461 theta' = eq_theta ++ dict_theta
462 dfun = mkDictFunId dfun_name tyvars theta' clas inst_tys
463 ispec = mkLocalInstance dfun overlap_flag
465 ; return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds uprags False },
469 -- We pass in the source form and the type checked form of the ATs. We
470 -- really need the source form only to be able to produce more informative
472 checkValidAndMissingATs :: Class
473 -> ([TyVar], [TcType]) -- instance types
474 -> [(LTyClDecl Name, -- source form of AT
475 TyThing)] -- Core form of AT
477 checkValidAndMissingATs clas inst_tys ats
478 = do { -- Issue a warning for each class AT that is not defined in this
480 ; let class_ats = map tyConName (classATs clas)
481 defined_ats = listToNameSet . map (tcdName.unLoc.fst) $ ats
482 omitted = filterOut (`elemNameSet` defined_ats) class_ats
483 ; warn <- doptM Opt_WarnMissingMethods
484 ; mapM_ (warnTc warn . omittedATWarn) omitted
486 -- Ensure that all AT indexes that correspond to class parameters
487 -- coincide with the types in the instance head. All remaining
488 -- AT arguments must be variables. Also raise an error for any
489 -- type instances that are not associated with this class.
490 ; mapM_ (checkIndexes clas inst_tys) ats
493 checkIndexes clas inst_tys (hsAT, ATyCon tycon)
494 -- !!!TODO: check that this does the Right Thing for indexed synonyms, too!
495 = checkIndexes' clas inst_tys hsAT
497 snd . fromJust . tyConFamInst_maybe $ tycon)
498 checkIndexes _ _ _ = panic "checkIndexes"
500 checkIndexes' clas (instTvs, instTys) hsAT (atTvs, atTys)
501 = let atName = tcdName . unLoc $ hsAT
503 setSrcSpan (getLoc hsAT) $
504 addErrCtxt (atInstCtxt atName) $
505 case find ((atName ==) . tyConName) (classATs clas) of
506 Nothing -> addErrTc $ badATErr clas atName -- not in this class
508 -- The following is tricky! We need to deal with three
509 -- complications: (1) The AT possibly only uses a subset of
510 -- the class parameters as indexes and those it uses may be in
511 -- a different order; (2) the AT may have extra arguments,
512 -- which must be type variables; and (3) variables in AT and
513 -- instance head will be different `Name's even if their
514 -- source lexemes are identical.
516 -- e.g. class C a b c where
517 -- data D b a :: * -> * -- NB (1) b a, omits c
518 -- instance C [x] Bool Char where
519 -- data D Bool [x] v = MkD x [v] -- NB (2) v
520 -- -- NB (3) the x in 'instance C...' have differnt
521 -- -- Names to x's in 'data D...'
523 -- Re (1), `poss' contains a permutation vector to extract the
524 -- class parameters in the right order.
526 -- Re (2), we wrap the (permuted) class parameters in a Maybe
527 -- type and use Nothing for any extra AT arguments. (First
528 -- equation of `checkIndex' below.)
530 -- Re (3), we replace any type variable in the AT parameters
531 -- that has the same source lexeme as some variable in the
532 -- instance types with the instance type variable sharing its
536 -- For *associated* type families, gives the position
537 -- of that 'TyVar' in the class argument list (0-indexed)
538 -- e.g. class C a b c where { type F c a :: *->* }
539 -- Then we get Just [2,0]
540 poss = catMaybes [ tv `elemIndex` classTyVars clas
541 | tv <- tyConTyVars atycon]
542 -- We will get Nothings for the "extra" type
543 -- variables in an associated data type
544 -- e.g. class C a where { data D a :: *->* }
545 -- here D gets arity 2 and has two tyvars
547 relevantInstTys = map (instTys !!) poss
548 instArgs = map Just relevantInstTys ++
549 repeat Nothing -- extra arguments
550 renaming = substSameTyVar atTvs instTvs
552 zipWithM_ checkIndex (substTys renaming atTys) instArgs
554 checkIndex ty Nothing
555 | isTyVarTy ty = return ()
556 | otherwise = addErrTc $ mustBeVarArgErr ty
557 checkIndex ty (Just instTy)
558 | ty `tcEqType` instTy = return ()
559 | otherwise = addErrTc $ wrongATArgErr ty instTy
561 listToNameSet = addListToNameSet emptyNameSet
563 substSameTyVar [] _ = emptyTvSubst
564 substSameTyVar (tv:tvs) replacingTvs =
565 let replacement = case find (tv `sameLexeme`) replacingTvs of
566 Nothing -> mkTyVarTy tv
567 Just rtv -> mkTyVarTy rtv
569 tv1 `sameLexeme` tv2 =
570 nameOccName (tyVarName tv1) == nameOccName (tyVarName tv2)
572 extendTvSubst (substSameTyVar tvs replacingTvs) tv replacement
576 %************************************************************************
578 Type-checking instance declarations, pass 2
580 %************************************************************************
583 tcInstDecls2 :: [LTyClDecl Name] -> [InstInfo Name]
585 -- (a) From each class declaration,
586 -- generate any default-method bindings
587 -- (b) From each instance decl
588 -- generate the dfun binding
590 tcInstDecls2 tycl_decls inst_decls
591 = do { -- (a) Default methods from class decls
592 let class_decls = filter (isClassDecl . unLoc) tycl_decls
593 ; dm_binds_s <- mapM tcClassDecl2 class_decls
594 ; let dm_binds = unionManyBags dm_binds_s
596 -- (b) instance declarations
597 ; let dm_ids = collectHsBindsBinders dm_binds
598 -- Add the default method Ids (again)
599 -- See Note [Default methods and instances]
600 ; inst_binds_s <- tcExtendIdEnv dm_ids $
601 mapM tcInstDecl2 inst_decls
604 ; return (dm_binds `unionBags` unionManyBags inst_binds_s) }
607 See Note [Default methods and instances]
608 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
609 The default method Ids are already in the type environment (see Note
610 [Default method Ids and Template Haskell] in TcTyClsDcls), BUT they
611 don't have their InlinePragmas yet. Usually that would not matter,
612 because the simplifier propagates information from binding site to
613 use. But, unusually, when compiling instance decls we *copy* the
614 INLINE pragma from the default method to the method for that
615 particular operation (see Note [INLINE and default methods] below).
617 So right here in tcInstDecl2 we must re-extend the type envt with
618 the default method Ids replete with their INLINE pragmas. Urk.
622 tcInstDecl2 :: InstInfo Name -> TcM (LHsBinds Id)
623 -- Returns a binding for the dfun
624 tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
625 = recoverM (return emptyLHsBinds) $
627 addErrCtxt (instDeclCtxt2 (idType dfun_id)) $
628 do { -- Instantiate the instance decl with skolem constants
629 ; (inst_tyvars, dfun_theta, inst_head) <- tcSkolDFunType (idType dfun_id)
630 ; let (clas, inst_tys) = tcSplitDFunHead inst_head
631 (class_tyvars, sc_theta, _, op_items) = classBigSig clas
632 sc_theta' = substTheta (zipOpenTvSubst class_tyvars inst_tys) sc_theta
633 n_ty_args = length inst_tyvars
634 n_silent = dfunNSilent dfun_id
635 (silent_theta, orig_theta) = splitAt n_silent dfun_theta
637 ; silent_ev_vars <- mapM newSilentGiven silent_theta
638 ; orig_ev_vars <- newEvVars orig_theta
639 ; let dfun_ev_vars = silent_ev_vars ++ orig_ev_vars
641 ; (sc_dicts, sc_args)
642 <- mapAndUnzipM (tcSuperClass n_ty_args dfun_ev_vars) sc_theta'
644 -- Check that any superclasses gotten from a silent arguemnt
645 -- can be deduced from the originally-specified dfun arguments
646 ; ct_loc <- getCtLoc ScOrigin
647 ; _ <- checkConstraints skol_info inst_tyvars orig_ev_vars $
648 emitFlats $ listToBag $
649 [ mkEvVarX sc ct_loc | sc <- sc_dicts, isSilentEvVar sc ]
651 -- Deal with 'SPECIALISE instance' pragmas
652 -- See Note [SPECIALISE instance pragmas]
653 ; spec_info@(spec_inst_prags,_) <- tcSpecInstPrags dfun_id ibinds
655 -- Typecheck the methods
656 ; (meth_ids, meth_binds)
657 <- tcExtendTyVarEnv inst_tyvars $
658 -- The inst_tyvars scope over the 'where' part
659 -- Those tyvars are inside the dfun_id's type, which is a bit
660 -- bizarre, but OK so long as you realise it!
661 tcInstanceMethods dfun_id clas inst_tyvars dfun_ev_vars
665 -- Create the result bindings
666 ; self_dict <- newEvVar (ClassP clas inst_tys)
667 ; let class_tc = classTyCon clas
668 [dict_constr] = tyConDataCons class_tc
669 dict_bind = mkVarBind self_dict dict_rhs
670 dict_rhs = foldl mk_app inst_constr $
671 map HsVar sc_dicts ++ map (wrapId arg_wrapper) meth_ids
672 inst_constr = L loc $ wrapId (mkWpTyApps inst_tys)
673 (dataConWrapId dict_constr)
674 -- We don't produce a binding for the dict_constr; instead we
675 -- rely on the simplifier to unfold this saturated application
676 -- We do this rather than generate an HsCon directly, because
677 -- it means that the special cases (e.g. dictionary with only one
678 -- member) are dealt with by the common MkId.mkDataConWrapId
679 -- code rather than needing to be repeated here.
681 mk_app :: LHsExpr Id -> HsExpr Id -> LHsExpr Id
682 mk_app fun arg = L loc (HsApp fun (L loc arg))
684 arg_wrapper = mkWpEvVarApps dfun_ev_vars <.> mkWpTyApps (mkTyVarTys inst_tyvars)
686 -- Do not inline the dfun; instead give it a magic DFunFunfolding
687 -- See Note [ClassOp/DFun selection]
688 -- See also note [Single-method classes]
690 | isNewTyCon class_tc
691 = dfun_id `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 }
693 = dfun_id `setIdUnfolding` mkDFunUnfolding dfun_ty (sc_args ++ meth_args)
694 `setInlinePragma` dfunInlinePragma
695 meth_args = map (DFunPolyArg . Var) meth_ids
697 main_bind = AbsBinds { abs_tvs = inst_tyvars
698 , abs_ev_vars = dfun_ev_vars
699 , abs_exports = [(inst_tyvars, dfun_id_w_fun, self_dict,
700 SpecPrags spec_inst_prags)]
701 , abs_ev_binds = emptyTcEvBinds
702 , abs_binds = unitBag dict_bind }
704 ; return (unitBag (L loc main_bind) `unionBags`
705 listToBag meth_binds)
708 skol_info = InstSkol -- See Note [Subtle interaction of recursion and overlap]
709 dfun_ty = idType dfun_id
710 dfun_id = instanceDFunId ispec
711 loc = getSrcSpan dfun_id
713 ------------------------------
714 tcSuperClass :: Int -> [EvVar] -> PredType -> TcM (EvVar, DFunArg CoreExpr)
715 -- All superclasses should be either
716 -- (a) be one of the arguments to the dfun, of
717 -- (b) be a constant, soluble at top level
718 tcSuperClass n_ty_args ev_vars pred
719 | Just (ev, i) <- find n_ty_args ev_vars
720 = return (ev, DFunLamArg i)
722 = ASSERT2( isEmptyVarSet (tyVarsOfPred pred), ppr pred) -- Constant!
723 do { sc_dict <- emitWanted ScOrigin pred
724 ; return (sc_dict, DFunConstArg (Var sc_dict)) }
727 find i (ev:evs) | pred `tcEqPred` evVarPred ev = Just (ev, i)
728 | otherwise = find (i+1) evs
730 ------------------------------
731 tcSpecInstPrags :: DFunId -> InstBindings Name
732 -> TcM ([Located TcSpecPrag], PragFun)
733 tcSpecInstPrags _ (NewTypeDerived {})
734 = return ([], \_ -> [])
735 tcSpecInstPrags dfun_id (VanillaInst binds uprags _)
736 = do { spec_inst_prags <- mapM (wrapLocM (tcSpecInst dfun_id)) $
737 filter isSpecInstLSig uprags
738 -- The filter removes the pragmas for methods
739 ; return (spec_inst_prags, mkPragFun uprags binds) }
742 Note [Silent Superclass Arguments]
743 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
744 Consider the following (extreme) situation:
745 class C a => D a where ...
746 instance D [a] => D [a] where ...
747 Although this looks wrong (assume D [a] to prove D [a]), it is only a
748 more extreme case of what happens with recursive dictionaries.
750 To implement the dfun we must generate code for the superclass C [a],
751 which we can get by superclass selection from the supplied argument!
753 dfun :: forall a. D [a] -> D [a]
754 dfun = \d::D [a] -> MkD (scsel d) ..
756 However this means that if we later encounter a situation where
757 we have a [Wanted] dw::D [a] we could solve it thus:
759 Although recursive, this binding would pass the TcSMonadisGoodRecEv
760 check because it appears as guarded. But in reality, it will make a
761 bottom superclass. The trouble is that isGoodRecEv can't "see" the
762 superclass-selection inside dfun.
764 Our solution to this problem is to change the way ‘dfuns’ are created
765 for instances, so that we pass as first arguments to the dfun some
766 ``silent superclass arguments’’, which are the immediate superclasses
767 of the dictionary we are trying to construct. In our example:
768 dfun :: forall a. (C [a], D [a] -> D [a]
769 dfun = \(dc::C [a]) (dd::D [a]) -> DOrd dc ...
773 -----------------------------------------------------------
774 DFun Superclass Invariant
775 ~~~~~~~~~~~~~~~~~~~~~~~~
776 In the body of a DFun, every superclass argument to the
777 returned dictionary is
778 either * one of the arguments of the DFun,
779 or * constant, bound at top level
780 -----------------------------------------------------------
782 This means that no superclass is hidden inside a dfun application, so
783 the counting argument in isGoodRecEv (more dfun calls than superclass
784 selections) works correctly.
786 The extra arguments required to satisfy the DFun Superclass Invariant
787 always come first, and are called the "silent" arguments. DFun types
788 are built (only) by MkId.mkDictFunId, so that is where we decide
789 what silent arguments are to be added.
791 This net effect is that it is safe to treat a dfun application as
792 wrapping a dictionary constructor around its arguments (in particular,
793 a dfun never picks superclasses from the arguments under the dictionary
796 In our example, if we had [Wanted] dw :: D [a] we would get via the instance:
798 [Wanted] (d1 :: C [a])
799 [Wanted] (d2 :: D [a])
800 [Derived] (d :: D [a])
801 [Derived] (scd :: C [a]) scd := scsel d
802 [Derived] (scd2 :: C [a]) scd2 := scsel d2
804 And now, though we *can* solve:
806 we will get an isGoodRecEv failure when we try to solve:
811 Test case SCLoop tests this fix.
813 Note [SPECIALISE instance pragmas]
814 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
817 instance (Ix a, Ix b) => Ix (a,b) where
818 {-# SPECIALISE instance Ix (Int,Int) #-}
821 We do *not* want to make a specialised version of the dictionary
822 function. Rather, we want specialised versions of each method.
823 Thus we should generate something like this:
825 $dfIx :: (Ix a, Ix x) => Ix (a,b)
826 {- DFUN [$crange, ...] -}
827 $dfIx da db = Ix ($crange da db) (...other methods...)
829 $dfIxPair :: (Ix a, Ix x) => Ix (a,b)
830 {- DFUN [$crangePair, ...] -}
831 $dfIxPair = Ix ($crangePair da db) (...other methods...)
833 $crange :: (Ix a, Ix b) -> ((a,b),(a,b)) -> [(a,b)]
834 {-# SPECIALISE $crange :: ((Int,Int),(Int,Int)) -> [(Int,Int)] #-}
835 $crange da db = <blah>
837 {-# RULE range ($dfIx da db) = $crange da db #-}
841 * The RULE is unaffected by the specialisation. We don't want to
842 specialise $dfIx, because then it would need a specialised RULE
843 which is a pain. The single RULE works fine at all specialisations.
844 See Note [How instance declarations are translated] above
846 * Instead, we want to specialise the *method*, $crange
848 In practice, rather than faking up a SPECIALISE pragama for each
849 method (which is painful, since we'd have to figure out its
850 specialised type), we call tcSpecPrag *as if* were going to specialise
851 $dfIx -- you can see that in the call to tcSpecInst. That generates a
852 SpecPrag which, as it turns out, can be used unchanged for each method.
853 The "it turns out" bit is delicate, but it works fine!
856 tcSpecInst :: Id -> Sig Name -> TcM TcSpecPrag
857 tcSpecInst dfun_id prag@(SpecInstSig hs_ty)
858 = addErrCtxt (spec_ctxt prag) $
859 do { let name = idName dfun_id
860 ; (tyvars, theta, clas, tys) <- tcHsInstHead hs_ty
861 ; let (_, spec_dfun_ty) = mkDictFunTy tyvars theta clas tys
863 ; co_fn <- tcSubType (SpecPragOrigin name) SpecInstCtxt
864 (idType dfun_id) spec_dfun_ty
865 ; return (SpecPrag dfun_id co_fn defaultInlinePragma) }
867 spec_ctxt prag = hang (ptext (sLit "In the SPECIALISE pragma")) 2 (ppr prag)
869 tcSpecInst _ _ = panic "tcSpecInst"
872 %************************************************************************
874 Type-checking an instance method
876 %************************************************************************
879 - Make the method bindings, as a [(NonRec, HsBinds)], one per method
880 - Remembering to use fresh Name (the instance method Name) as the binder
881 - Bring the instance method Ids into scope, for the benefit of tcInstSig
882 - Use sig_fn mapping instance method Name -> instance tyvars
884 - Use tcValBinds to do the checking
887 tcInstanceMethods :: DFunId -> Class -> [TcTyVar]
890 -> ([Located TcSpecPrag], PragFun)
893 -> TcM ([Id], [LHsBind Id])
894 -- The returned inst_meth_ids all have types starting
895 -- forall tvs. theta => ...
896 tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
897 (spec_inst_prags, prag_fn)
898 op_items (VanillaInst binds _ standalone_deriv)
899 = mapAndUnzipM tc_item op_items
901 ----------------------
902 tc_item :: (Id, DefMeth) -> TcM (Id, LHsBind Id)
903 tc_item (sel_id, dm_info)
904 = case findMethodBind (idName sel_id) binds of
905 Just user_bind -> tc_body sel_id standalone_deriv user_bind
906 Nothing -> tc_default sel_id dm_info
908 ----------------------
909 tc_body :: Id -> Bool -> LHsBind Name -> TcM (TcId, LHsBind Id)
910 tc_body sel_id generated_code rn_bind
911 = add_meth_ctxt sel_id generated_code rn_bind $
912 do { (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars
914 ; let prags = prag_fn (idName sel_id)
915 ; meth_id1 <- addInlinePrags meth_id prags
916 ; spec_prags <- tcSpecPrags meth_id1 prags
917 ; bind <- tcInstanceMethodBody InstSkol
919 meth_id1 local_meth_id meth_sig_fn
920 (mk_meth_spec_prags meth_id1 spec_prags)
922 ; return (meth_id1, bind) }
924 ----------------------
925 tc_default :: Id -> DefMeth -> TcM (TcId, LHsBind Id)
927 tc_default sel_id (GenDefMeth dm_name)
928 = do { meth_bind <- mkGenericDefMethBind clas inst_tys sel_id dm_name
929 ; tc_body sel_id False {- Not generated code? -} meth_bind }
931 tc_default sel_id GenDefMeth -- Derivable type classes stuff
932 = do { meth_bind <- mkGenericDefMethBind clas inst_tys sel_id
933 ; tc_body sel_id False {- Not generated code? -} meth_bind }
935 tc_default sel_id NoDefMeth -- No default method at all
936 = do { warnMissingMethod sel_id
937 ; (meth_id, _) <- mkMethIds clas tyvars dfun_ev_vars
939 ; return (meth_id, mkVarBind meth_id $
940 mkLHsWrap lam_wrapper error_rhs) }
942 error_rhs = L loc $ HsApp error_fun error_msg
943 error_fun = L loc $ wrapId (WpTyApp meth_tau) nO_METHOD_BINDING_ERROR_ID
944 error_msg = L loc (HsLit (HsStringPrim (mkFastString error_string)))
945 meth_tau = funResultTy (applyTys (idType sel_id) inst_tys)
946 error_string = showSDoc (hcat [ppr loc, text "|", ppr sel_id ])
947 lam_wrapper = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars
949 tc_default sel_id (DefMeth dm_name) -- A polymorphic default method
950 = do { -- Build the typechecked version directly,
951 -- without calling typecheck_method;
952 -- see Note [Default methods in instances]
953 -- Generate /\as.\ds. let self = df as ds
954 -- in $dm inst_tys self
955 -- The 'let' is necessary only because HsSyn doesn't allow
956 -- you to apply a function to a dictionary *expression*.
958 ; self_dict <- newEvVar (ClassP clas inst_tys)
959 ; let self_ev_bind = EvBind self_dict $
960 EvDFunApp dfun_id (mkTyVarTys tyvars) dfun_ev_vars
962 ; (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars
964 ; dm_id <- tcLookupId dm_name
965 ; let dm_inline_prag = idInlinePragma dm_id
966 rhs = HsWrap (mkWpEvVarApps [self_dict] <.> mkWpTyApps inst_tys) $
969 meth_bind = L loc $ VarBind { var_id = local_meth_id
970 , var_rhs = L loc rhs
971 , var_inline = False }
972 meth_id1 = meth_id `setInlinePragma` dm_inline_prag
973 -- Copy the inline pragma (if any) from the default
974 -- method to this version. Note [INLINE and default methods]
976 bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
977 , abs_exports = [( tyvars, meth_id1, local_meth_id
978 , mk_meth_spec_prags meth_id1 [])]
979 , abs_ev_binds = EvBinds (unitBag self_ev_bind)
980 , abs_binds = unitBag meth_bind }
981 -- Default methods in an instance declaration can't have their own
982 -- INLINE or SPECIALISE pragmas. It'd be possible to allow them, but
983 -- currently they are rejected with
984 -- "INLINE pragma lacks an accompanying binding"
986 ; return (meth_id1, L loc bind) }
988 ----------------------
989 mk_meth_spec_prags :: Id -> [LTcSpecPrag] -> TcSpecPrags
990 -- Adapt the SPECIALISE pragmas to work for this method Id
991 -- There are two sources:
992 -- * spec_inst_prags: {-# SPECIALISE instance :: <blah> #-}
993 -- These ones have the dfun inside, but [perhaps surprisingly]
994 -- the correct wrapper
995 -- * spec_prags_for_me: {-# SPECIALISE op :: <blah> #-}
996 mk_meth_spec_prags meth_id spec_prags_for_me
997 = SpecPrags (spec_prags_for_me ++
998 [ L loc (SpecPrag meth_id wrap inl)
999 | L loc (SpecPrag _ wrap inl) <- spec_inst_prags])
1001 loc = getSrcSpan dfun_id
1002 meth_sig_fn _ = Just ([],loc) -- The 'Just' says "yes, there's a type sig"
1003 -- But there are no scoped type variables from local_method_id
1004 -- Only the ones from the instance decl itself, which are already
1005 -- in scope. Example:
1006 -- class C a where { op :: forall b. Eq b => ... }
1007 -- instance C [c] where { op = <rhs> }
1008 -- In <rhs>, 'c' is scope but 'b' is not!
1010 -- For instance decls that come from standalone deriving clauses
1011 -- we want to print out the full source code if there's an error
1012 -- because otherwise the user won't see the code at all
1013 add_meth_ctxt sel_id generated_code rn_bind thing
1014 | generated_code = addLandmarkErrCtxt (derivBindCtxt sel_id clas inst_tys rn_bind) thing
1018 tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
1019 _ op_items (NewTypeDerived coi _)
1022 -- class Show b => Foo a b where
1023 -- op :: a -> b -> b
1024 -- newtype N a = MkN (Tree [a])
1025 -- deriving instance (Show p, Foo Int p) => Foo Int (N p)
1026 -- -- NB: standalone deriving clause means
1027 -- -- that the contex is user-specified
1028 -- Hence op :: forall a b. Foo a b => a -> b -> b
1030 -- We're going to make an instance like
1031 -- instance (Show p, Foo Int p) => Foo Int (N p)
1034 -- $copT :: forall p. (Show p, Foo Int p) => Int -> N p -> N p
1035 -- $copT p (d1:Show p) (d2:Foo Int p)
1036 -- = op Int (Tree [p]) rep_d |> op_co
1038 -- rep_d :: Foo Int (Tree [p]) = ...d1...d2...
1039 -- op_co :: (Int -> Tree [p] -> Tree [p]) ~ (Int -> T p -> T p)
1040 -- We get op_co by substituting [Int/a] and [co/b] in type for op
1041 -- where co : [p] ~ T p
1043 -- Notice that the dictionary bindings "..d1..d2.." must be generated
1044 -- by the constraint solver, since the <context> may be
1047 = do { rep_d_stuff <- checkConstraints InstSkol tyvars dfun_ev_vars $
1048 emitWanted ScOrigin rep_pred
1050 ; mapAndUnzipM (tc_item rep_d_stuff) op_items }
1052 loc = getSrcSpan dfun_id
1054 inst_tvs = fst (tcSplitForAllTys (idType dfun_id))
1055 Just (init_inst_tys, _) = snocView inst_tys
1056 rep_ty = fst (coercionKind co) -- [p]
1057 rep_pred = mkClassPred clas (init_inst_tys ++ [rep_ty])
1060 co = substTyWith inst_tvs (mkTyVarTys tyvars) $
1061 case coi of { IdCo ty -> ty ;
1062 ACo co -> mkSymCoercion co }
1065 tc_item :: (TcEvBinds, EvVar) -> (Id, DefMeth) -> TcM (TcId, LHsBind TcId)
1066 tc_item (rep_ev_binds, rep_d) (sel_id, _)
1067 = do { (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars
1070 ; let meth_rhs = wrapId (mk_op_wrapper sel_id rep_d) sel_id
1071 meth_bind = VarBind { var_id = local_meth_id
1072 , var_rhs = L loc meth_rhs
1073 , var_inline = False }
1075 bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
1076 , abs_exports = [(tyvars, meth_id,
1077 local_meth_id, noSpecPrags)]
1078 , abs_ev_binds = rep_ev_binds
1079 , abs_binds = unitBag $ L loc meth_bind }
1081 ; return (meth_id, L loc bind) }
1084 mk_op_wrapper :: Id -> EvVar -> HsWrapper
1085 mk_op_wrapper sel_id rep_d
1086 = WpCast (substTyWith sel_tvs (init_inst_tys ++ [co]) local_meth_ty)
1087 <.> WpEvApp (EvId rep_d)
1088 <.> mkWpTyApps (init_inst_tys ++ [rep_ty])
1090 (sel_tvs, sel_rho) = tcSplitForAllTys (idType sel_id)
1091 (_, local_meth_ty) = tcSplitPredFunTy_maybe sel_rho
1092 `orElse` pprPanic "tcInstanceMethods" (ppr sel_id)
1094 ----------------------
1095 mkMethIds :: Class -> [TcTyVar] -> [EvVar] -> [TcType] -> Id -> TcM (TcId, TcId)
1096 mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id
1097 = do { uniq <- newUnique
1098 ; let meth_name = mkDerivedInternalName mkClassOpAuxOcc uniq sel_name
1099 ; local_meth_name <- newLocalName sel_name
1100 -- Base the local_meth_name on the selector name, becuase
1101 -- type errors from tcInstanceMethodBody come from here
1103 ; let meth_id = mkLocalId meth_name meth_ty
1104 local_meth_id = mkLocalId local_meth_name local_meth_ty
1105 ; return (meth_id, local_meth_id) }
1107 local_meth_ty = instantiateMethod clas sel_id inst_tys
1108 meth_ty = mkForAllTys tyvars $ mkPiTypes dfun_ev_vars local_meth_ty
1109 sel_name = idName sel_id
1111 ----------------------
1112 wrapId :: HsWrapper -> id -> HsExpr id
1113 wrapId wrapper id = mkHsWrap wrapper (HsVar id)
1115 derivBindCtxt :: Id -> Class -> [Type ] -> LHsBind Name -> SDoc
1116 derivBindCtxt sel_id clas tys _bind
1117 = vcat [ ptext (sLit "When typechecking the code for ") <+> quotes (ppr sel_id)
1118 , nest 2 (ptext (sLit "in a standalone derived instance for")
1119 <+> quotes (pprClassPred clas tys) <> colon)
1120 , nest 2 $ ptext (sLit "To see the code I am typechecking, use -ddump-deriv") ]
1123 -- , nest 2 $ pprSetDepth AllTheWay $ ppr bind ]
1125 warnMissingMethod :: Id -> TcM ()
1126 warnMissingMethod sel_id
1127 = do { warn <- doptM Opt_WarnMissingMethods
1128 ; warnTc (warn -- Warn only if -fwarn-missing-methods
1129 && not (startsWithUnderscore (getOccName sel_id)))
1130 -- Don't warn about _foo methods
1131 (ptext (sLit "No explicit method nor default method for")
1132 <+> quotes (ppr sel_id)) }
1135 Note [Export helper functions]
1136 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1137 We arrange to export the "helper functions" of an instance declaration,
1138 so that they are not subject to preInlineUnconditionally, even if their
1139 RHS is trivial. Reason: they are mentioned in the DFunUnfolding of
1140 the dict fun as Ids, not as CoreExprs, so we can't substitute a
1141 non-variable for them.
1143 We could change this by making DFunUnfoldings have CoreExprs, but it
1144 seems a bit simpler this way.
1146 Note [Default methods in instances]
1147 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1154 instance Baz Int Int
1156 From the class decl we get
1158 $dmfoo :: forall v x. Baz v x => x -> x
1161 Notice that the type is ambiguous. That's fine, though. The instance
1164 $dBazIntInt = MkBaz fooIntInt
1165 fooIntInt = $dmfoo Int Int $dBazIntInt
1167 BUT this does mean we must generate the dictionary translation of
1168 fooIntInt directly, rather than generating source-code and
1169 type-checking it. That was the bug in Trac #1061. In any case it's
1170 less work to generate the translated version!
1172 Note [INLINE and default methods]
1173 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1174 Default methods need special case. They are supposed to behave rather like
1175 macros. For exmample
1178 op1, op2 :: Bool -> a -> a
1181 op1 b x = op2 (not b) x
1183 instance Foo Int where
1184 -- op1 via default method
1187 The instance declaration should behave
1189 just as if 'op1' had been defined with the
1190 code, and INLINE pragma, from its original
1193 That is, just as if you'd written
1195 instance Foo Int where
1199 op1 b x = op2 (not b) x
1201 So for the above example we generate:
1204 {-# INLINE $dmop1 #-}
1205 -- $dmop1 has an InlineCompulsory unfolding
1206 $dmop1 d b x = op2 d (not b) x
1208 $fFooInt = MkD $cop1 $cop2
1210 {-# INLINE $cop1 #-}
1211 $cop1 = $dmop1 $fFooInt
1217 * We *copy* any INLINE pragma from the default method $dmop1 to the
1218 instance $cop1. Otherwise we'll just inline the former in the
1219 latter and stop, which isn't what the user expected
1221 * Regardless of its pragma, we give the default method an
1222 unfolding with an InlineCompulsory source. That means
1223 that it'll be inlined at every use site, notably in
1224 each instance declaration, such as $cop1. This inlining
1225 must happen even though
1226 a) $dmop1 is not saturated in $cop1
1227 b) $cop1 itself has an INLINE pragma
1229 It's vital that $dmop1 *is* inlined in this way, to allow the mutual
1230 recursion between $fooInt and $cop1 to be broken
1232 * To communicate the need for an InlineCompulsory to the desugarer
1233 (which makes the Unfoldings), we use the IsDefaultMethod constructor
1237 %************************************************************************
1239 \subsection{Error messages}
1241 %************************************************************************
1244 instDeclCtxt1 :: LHsType Name -> SDoc
1245 instDeclCtxt1 hs_inst_ty
1246 = inst_decl_ctxt (case unLoc hs_inst_ty of
1247 HsForAllTy _ _ _ (L _ (HsPredTy pred)) -> ppr pred
1248 HsPredTy pred -> ppr pred
1249 _ -> ppr hs_inst_ty) -- Don't expect this
1250 instDeclCtxt2 :: Type -> SDoc
1251 instDeclCtxt2 dfun_ty
1252 = inst_decl_ctxt (ppr (mkClassPred cls tys))
1254 (_,_,cls,tys) = tcSplitDFunTy dfun_ty
1256 inst_decl_ctxt :: SDoc -> SDoc
1257 inst_decl_ctxt doc = ptext (sLit "In the instance declaration for") <+> quotes doc
1259 atInstCtxt :: Name -> SDoc
1260 atInstCtxt name = ptext (sLit "In the associated type instance for") <+>
1263 mustBeVarArgErr :: Type -> SDoc
1264 mustBeVarArgErr ty =
1265 sep [ ptext (sLit "Arguments that do not correspond to a class parameter") <+>
1266 ptext (sLit "must be variables")
1267 , ptext (sLit "Instead of a variable, found") <+> ppr ty
1270 wrongATArgErr :: Type -> Type -> SDoc
1271 wrongATArgErr ty instTy =
1272 sep [ ptext (sLit "Type indexes must match class instance head")
1273 , ptext (sLit "Found") <+> quotes (ppr ty)
1274 <+> ptext (sLit "but expected") <+> quotes (ppr instTy)