2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcInstDecls]{Typechecking instance declarations}
7 module TcInstDcls ( tcInstDecls1, tcIfaceInstDecls,
8 tcInstDecls2, tcAddDeclCtxt ) where
10 #include "HsVersions.h"
13 import CmdLineOpts ( DynFlag(..) )
15 import HsSyn ( InstDecl(..), TyClDecl(..), HsType(..),
16 MonoBinds(..), HsExpr(..), HsLit(..), Sig(..), HsTyVarBndr(..),
17 andMonoBindList, collectMonoBinders,
18 isClassDecl, isSourceInstDecl, toHsType
20 import RnHsSyn ( RenamedHsBinds, RenamedInstDecl,
21 RenamedMonoBinds, RenamedTyClDecl, RenamedHsType,
22 extractHsTyVars, maybeGenericMatch
24 import TcHsSyn ( TcMonoBinds, mkHsConApp )
25 import TcBinds ( tcSpecSigs )
26 import TcClassDcl ( tcMethodBind, mkMethodBind, badMethodErr )
28 import TcMType ( tcInstType, checkValidTheta, checkValidInstHead, instTypeErr,
29 checkAmbiguity, UserTypeCtxt(..), SourceTyCtxt(..) )
30 import TcType ( mkClassPred, mkTyVarTy, tcSplitForAllTys, tyVarsOfType,
31 tcSplitSigmaTy, getClassPredTys, tcSplitPredTy_maybe, mkTyVarTys,
34 import Inst ( InstOrigin(..), tcInstClassOp, newDicts, instToId, showLIE )
35 import TcDeriv ( tcDeriving )
36 import TcEnv ( tcExtendGlobalValEnv,
37 tcLookupClass, tcExtendTyVarEnv2,
38 tcExtendInstEnv, tcExtendLocalInstEnv, tcLookupGlobalId,
39 InstInfo(..), InstBindings(..), pprInstInfo, simpleInstInfoTyCon,
40 simpleInstInfoTy, newDFunName
42 import PprType ( pprClassPred )
43 import TcMonoType ( tcHsTyVars, kcHsSigType, tcHsType, tcHsSigType )
44 import TcUnify ( checkSigTyVars )
45 import TcSimplify ( tcSimplifyCheck, tcSimplifyTop )
46 import HscTypes ( DFunId )
47 import Subst ( mkTyVarSubst, substTheta, substTy )
48 import DataCon ( classDataCon )
49 import Class ( Class, classBigSig )
50 import Var ( idName, idType )
52 import MkId ( mkDictFunId, rUNTIME_ERROR_ID )
53 import FunDeps ( checkInstFDs )
54 import Generics ( validGenericInstanceType )
55 import Name ( getSrcLoc )
56 import NameSet ( unitNameSet, emptyNameSet, nameSetToList )
57 import TyCon ( TyCon )
58 import TysWiredIn ( genericTyCons )
59 import SrcLoc ( SrcLoc )
60 import Unique ( Uniquable(..) )
61 import Util ( lengthExceeds )
62 import BasicTypes ( NewOrData(..) )
63 import UnicodeUtil ( stringToUtf8 )
64 import ErrUtils ( dumpIfSet_dyn )
65 import ListSetOps ( Assoc, emptyAssoc, plusAssoc_C, mapAssoc,
66 assocElts, extendAssoc_C, equivClassesByUniq, minusList
68 import Maybe ( catMaybes )
69 import List ( partition )
74 Typechecking instance declarations is done in two passes. The first
75 pass, made by @tcInstDecls1@, collects information to be used in the
78 This pre-processed info includes the as-yet-unprocessed bindings
79 inside the instance declaration. These are type-checked in the second
80 pass, when the class-instance envs and GVE contain all the info from
81 all the instance and value decls. Indeed that's the reason we need
82 two passes over the instance decls.
85 Here is the overall algorithm.
86 Assume that we have an instance declaration
88 instance c => k (t tvs) where b
92 $LIE_c$ is the LIE for the context of class $c$
94 $betas_bar$ is the free variables in the class method type, excluding the
97 $LIE_cop$ is the LIE constraining a particular class method
99 $tau_cop$ is the tau type of a class method
101 $LIE_i$ is the LIE for the context of instance $i$
103 $X$ is the instance constructor tycon
105 $gammas_bar$ is the set of type variables of the instance
107 $LIE_iop$ is the LIE for a particular class method instance
109 $tau_iop$ is the tau type for this instance of a class method
111 $alpha$ is the class variable
113 $LIE_cop' = LIE_cop [X gammas_bar / alpha, fresh betas_bar]$
115 $tau_cop' = tau_cop [X gammas_bar / alpha, fresh betas_bar]$
118 ToDo: Update the list above with names actually in the code.
122 First, make the LIEs for the class and instance contexts, which means
123 instantiate $thetaC [X inst_tyvars / alpha ]$, yielding LIElistC' and LIEC',
124 and make LIElistI and LIEI.
126 Then process each method in turn.
128 order the instance methods according to the ordering of the class methods
130 express LIEC' in terms of LIEI, yielding $dbinds_super$ or an error
132 Create final dictionary function from bindings generated already
134 df = lambda inst_tyvars
141 in <op1,op2,...,opn,sd1,...,sdm>
143 Here, Bop1 \ldots Bopn bind the methods op1 \ldots opn,
144 and $dbinds_super$ bind the superclass dictionaries sd1 \ldots sdm.
148 %************************************************************************
150 \subsection{Extracting instance decls}
152 %************************************************************************
154 Gather up the instance declarations from their various sources
157 tcInstDecls1 -- Deal with both source-code and imported instance decls
158 :: [RenamedTyClDecl] -- For deriving stuff
159 -> [RenamedInstDecl] -- Source code instance decls
160 -> TcM (TcGblEnv, -- The full inst env
161 [InstInfo], -- Source-code instance decls to process;
162 -- contains all dfuns for this module
163 RenamedHsBinds, -- Supporting bindings for derived instances
164 FreeVars) -- And the free vars of the derived code
166 tcInstDecls1 tycl_decls inst_decls
168 -- Stop if addInstInfos etc discovers any errors
169 -- (they recover, so that we get more than one error each round)
171 (src_inst_decls, iface_inst_decls) = partition isSourceInstDecl inst_decls
174 -- (0) Deal with the imported instance decls
175 tcIfaceInstDecls iface_inst_decls `thenM` \ imp_dfuns ->
176 tcExtendInstEnv imp_dfuns $
178 -- (1) Do the ordinary instance declarations
179 mappM tcLocalInstDecl1 src_inst_decls `thenM` \ local_inst_infos ->
182 local_inst_info = catMaybes local_inst_infos
183 clas_decls = filter isClassDecl tycl_decls
185 -- (2) Instances from generic class declarations
186 getGenericInstances clas_decls `thenM` \ generic_inst_info ->
188 -- Next, construct the instance environment so far, consisting of
189 -- a) imported instance decls (from this module)
190 -- b) local instance decls
191 -- c) generic instances
192 tcExtendLocalInstEnv local_inst_info $
193 tcExtendLocalInstEnv generic_inst_info $
195 -- (3) Compute instances from "deriving" clauses;
196 -- note that we only do derivings for things in this module;
197 -- we ignore deriving decls from interfaces!
198 -- This stuff computes a context for the derived instance decl, so it
199 -- needs to know about all the instances possible; hence inst_env4
200 tcDeriving tycl_decls `thenM` \ (deriv_inst_info, deriv_binds, fvs) ->
201 tcExtendLocalInstEnv deriv_inst_info $
203 getGblEnv `thenM` \ gbl_env ->
205 generic_inst_info ++ deriv_inst_info ++ local_inst_info,
210 tcLocalInstDecl1 :: RenamedInstDecl
211 -> TcM (Maybe InstInfo) -- Nothing if there was an error
212 -- A source-file instance declaration
213 -- Type-check all the stuff before the "where"
215 -- We check for respectable instance type, and context
216 -- but only do this for non-imported instance decls.
217 -- Imported ones should have been checked already, and may indeed
218 -- contain something illegal in normal Haskell, notably
219 -- instance CCallable [Char]
220 tcLocalInstDecl1 decl@(InstDecl poly_ty binds uprags Nothing src_loc)
221 = -- Prime error recovery, set source location
222 recoverM (returnM Nothing) $
224 addErrCtxt (instDeclCtxt poly_ty) $
226 -- Typecheck the instance type itself. We can't use
227 -- tcHsSigType, because it's not a valid user type.
228 kcHsSigType poly_ty `thenM_`
229 tcHsType poly_ty `thenM` \ poly_ty' ->
231 (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
233 checkValidTheta InstThetaCtxt theta `thenM_`
234 checkAmbiguity tyvars theta (tyVarsOfType tau) `thenM_`
235 checkValidInstHead tau `thenM` \ (clas,inst_tys) ->
236 checkTc (checkInstFDs theta clas inst_tys)
237 (instTypeErr (pprClassPred clas inst_tys) msg) `thenM_`
238 newDFunName clas inst_tys src_loc `thenM` \ dfun_name ->
239 returnM (Just (InstInfo { iDFunId = mkDictFunId dfun_name tyvars theta clas inst_tys,
240 iBinds = VanillaInst binds uprags }))
242 msg = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))
245 Imported instance declarations
248 tcIfaceInstDecls :: [RenamedInstDecl] -> TcM [DFunId]
249 -- Deal with the instance decls,
250 tcIfaceInstDecls decls = mappM tcIfaceInstDecl decls
252 tcIfaceInstDecl :: RenamedInstDecl -> TcM DFunId
253 -- An interface-file instance declaration
254 -- Should be in scope by now, because we should
255 -- have sucked in its interface-file definition
256 -- So it will be replete with its unfolding etc
257 tcIfaceInstDecl decl@(InstDecl poly_ty binds uprags (Just dfun_name) src_loc)
258 = tcLookupGlobalId dfun_name
262 %************************************************************************
264 \subsection{Extracting generic instance declaration from class declarations}
266 %************************************************************************
268 @getGenericInstances@ extracts the generic instance declarations from a class
269 declaration. For exmaple
274 op{ x+y } (Inl v) = ...
275 op{ x+y } (Inr v) = ...
276 op{ x*y } (v :*: w) = ...
279 gives rise to the instance declarations
281 instance C (x+y) where
285 instance C (x*y) where
293 getGenericInstances :: [RenamedTyClDecl] -> TcM [InstInfo]
294 getGenericInstances class_decls
295 = mappM get_generics class_decls `thenM` \ gen_inst_infos ->
297 gen_inst_info = concat gen_inst_infos
299 if null gen_inst_info then
302 getDOpts `thenM` \ dflags ->
303 ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
304 (vcat (map pprInstInfo gen_inst_info)))
306 returnM gen_inst_info
308 get_generics decl@(ClassDecl {tcdMeths = Nothing})
309 = returnM [] -- Imported class decls
311 get_generics decl@(ClassDecl {tcdName = class_name, tcdMeths = Just def_methods, tcdLoc = loc})
313 = returnM [] -- The comon case: no generic default methods
315 | otherwise -- A source class decl with generic default methods
316 = recoverM (returnM []) $
318 tcLookupClass class_name `thenM` \ clas ->
320 -- Make an InstInfo out of each group
321 mappM (mkGenericInstance clas loc) groups `thenM` \ inst_infos ->
323 -- Check that there is only one InstInfo for each type constructor
324 -- The main way this can fail is if you write
325 -- f {| a+b |} ... = ...
326 -- f {| x+y |} ... = ...
327 -- Then at this point we'll have an InstInfo for each
329 tc_inst_infos :: [(TyCon, InstInfo)]
330 tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
332 bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
333 group `lengthExceeds` 1]
334 get_uniq (tc,_) = getUnique tc
336 mappM (addErrTc . dupGenericInsts) bad_groups `thenM_`
338 -- Check that there is an InstInfo for each generic type constructor
340 missing = genericTyCons `minusList` [tc | (tc,_) <- tc_inst_infos]
342 checkTc (null missing) (missingGenericInstances missing) `thenM_`
347 -- Group the declarations by type pattern
348 groups :: [(RenamedHsType, RenamedMonoBinds)]
349 groups = assocElts (getGenericBinds def_methods)
352 ---------------------------------
353 getGenericBinds :: RenamedMonoBinds -> Assoc RenamedHsType RenamedMonoBinds
354 -- Takes a group of method bindings, finds the generic ones, and returns
355 -- them in finite map indexed by the type parameter in the definition.
357 getGenericBinds EmptyMonoBinds = emptyAssoc
358 getGenericBinds (AndMonoBinds m1 m2)
359 = plusAssoc_C AndMonoBinds (getGenericBinds m1) (getGenericBinds m2)
361 getGenericBinds (FunMonoBind id infixop matches loc)
362 = mapAssoc wrap (foldl add emptyAssoc matches)
363 -- Using foldl not foldr is vital, else
364 -- we reverse the order of the bindings!
366 add env match = case maybeGenericMatch match of
368 Just (ty, match') -> extendAssoc_C (++) env (ty, [match'])
370 wrap ms = FunMonoBind id infixop ms loc
372 ---------------------------------
373 mkGenericInstance :: Class -> SrcLoc
374 -> (RenamedHsType, RenamedMonoBinds)
377 mkGenericInstance clas loc (hs_ty, binds)
378 -- Make a generic instance declaration
379 -- For example: instance (C a, C b) => C (a+b) where { binds }
381 = -- Extract the universally quantified type variables
383 sig_tvs = map UserTyVar (nameSetToList (extractHsTyVars hs_ty))
385 tcHsTyVars sig_tvs (kcHsSigType hs_ty) $ \ tyvars ->
387 -- Type-check the instance type, and check its form
388 tcHsSigType GenPatCtxt hs_ty `thenM` \ inst_ty ->
389 checkTc (validGenericInstanceType inst_ty)
390 (badGenericInstanceType binds) `thenM_`
392 -- Make the dictionary function.
393 newDFunName clas [inst_ty] loc `thenM` \ dfun_name ->
395 inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
396 dfun_id = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
399 returnM (InstInfo { iDFunId = dfun_id, iBinds = VanillaInst binds [] })
403 %************************************************************************
405 \subsection{Type-checking instance declarations, pass 2}
407 %************************************************************************
410 tcInstDecls2 :: [InstInfo] -> TcM TcMonoBinds
411 tcInstDecls2 inst_decls
412 = mappM tcInstDecl2 inst_decls `thenM` \ binds_s ->
413 returnM (andMonoBindList binds_s)
416 ======= New documentation starts here (Sept 92) ==============
418 The main purpose of @tcInstDecl2@ is to return a @HsBinds@ which defines
419 the dictionary function for this instance declaration. For example
421 instance Foo a => Foo [a] where
425 might generate something like
427 dfun.Foo.List dFoo_a = let op1 x = ...
433 HOWEVER, if the instance decl has no context, then it returns a
434 bigger @HsBinds@ with declarations for each method. For example
436 instance Foo [a] where
442 dfun.Foo.List a = Dict [Foo.op1.List a, Foo.op2.List a]
443 const.Foo.op1.List a x = ...
444 const.Foo.op2.List a y = ...
446 This group may be mutually recursive, because (for example) there may
447 be no method supplied for op2 in which case we'll get
449 const.Foo.op2.List a = default.Foo.op2 (dfun.Foo.List a)
451 that is, the default method applied to the dictionary at this type.
453 What we actually produce in either case is:
455 AbsBinds [a] [dfun_theta_dicts]
456 [(dfun.Foo.List, d)] ++ (maybe) [(const.Foo.op1.List, op1), ...]
457 { d = (sd1,sd2, ..., op1, op2, ...)
462 The "maybe" says that we only ask AbsBinds to make global constant methods
463 if the dfun_theta is empty.
466 For an instance declaration, say,
468 instance (C1 a, C2 b) => C (T a b) where
471 where the {\em immediate} superclasses of C are D1, D2, we build a dictionary
472 function whose type is
474 (C1 a, C2 b, D1 (T a b), D2 (T a b)) => C (T a b)
476 Notice that we pass it the superclass dictionaries at the instance type; this
477 is the ``Mark Jones optimisation''. The stuff before the "=>" here
478 is the @dfun_theta@ below.
480 First comes the easy case of a non-local instance decl.
484 tcInstDecl2 :: InstInfo -> TcM TcMonoBinds
486 tcInstDecl2 (InstInfo { iDFunId = dfun_id, iBinds = binds })
487 = -- Prime error recovery
488 recoverM (returnM EmptyMonoBinds) $
489 addSrcLoc (getSrcLoc dfun_id) $
490 addErrCtxt (instDeclCtxt (toHsType (idType dfun_id))) $
492 inst_ty = idType dfun_id
493 (inst_tyvars, _) = tcSplitForAllTys inst_ty
494 -- The tyvars of the instance decl scope over the 'where' part
495 -- Those tyvars are inside the dfun_id's type, which is a bit
496 -- bizarre, but OK so long as you realise it!
499 -- Instantiate the instance decl with tc-style type variables
500 tcInstType InstTv inst_ty `thenM` \ (inst_tyvars', dfun_theta', inst_head') ->
502 Just pred = tcSplitPredTy_maybe inst_head'
503 (clas, inst_tys') = getClassPredTys pred
504 (class_tyvars, sc_theta, _, op_items) = classBigSig clas
506 -- Instantiate the super-class context with inst_tys
507 sc_theta' = substTheta (mkTyVarSubst class_tyvars inst_tys') sc_theta
508 origin = InstanceDeclOrigin
510 -- Create dictionary Ids from the specified instance contexts.
511 newDicts origin sc_theta' `thenM` \ sc_dicts ->
512 newDicts origin dfun_theta' `thenM` \ dfun_arg_dicts ->
513 newDicts origin [pred] `thenM` \ [this_dict] ->
514 -- Default-method Ids may be mentioned in synthesised RHSs,
515 -- but they'll already be in the environment.
518 -- Typecheck the methods
519 let -- These insts are in scope; quite a few, eh?
520 avail_insts = [this_dict] ++ dfun_arg_dicts ++ sc_dicts
522 tcMethods clas inst_tyvars inst_tyvars'
523 dfun_theta' inst_tys' avail_insts
524 op_items binds `thenM` \ (meth_ids, meth_binds) ->
526 -- Figure out bindings for the superclass context
527 tcSuperClasses inst_tyvars' dfun_arg_dicts sc_dicts
528 `thenM` \ (zonked_inst_tyvars, sc_binds_inner, sc_binds_outer) ->
530 -- Deal with 'SPECIALISE instance' pragmas by making them
531 -- look like SPECIALISE pragmas for the dfun
533 uprags = case binds of
534 VanillaInst _ uprags -> uprags
536 spec_prags = [ SpecSig (idName dfun_id) ty loc
537 | SpecInstSig ty loc <- uprags ]
538 xtve = inst_tyvars `zip` inst_tyvars'
540 tcExtendGlobalValEnv [dfun_id] (
541 tcExtendTyVarEnv2 xtve $
542 tcSpecSigs spec_prags
543 ) `thenM` \ prag_binds ->
545 -- Create the result bindings
547 dict_constr = classDataCon clas
548 scs_and_meths = map instToId sc_dicts ++ meth_ids
549 this_dict_id = instToId this_dict
550 inlines | null dfun_arg_dicts = emptyNameSet
551 | otherwise = unitNameSet (idName dfun_id)
552 -- Always inline the dfun; this is an experimental decision
553 -- because it makes a big performance difference sometimes.
554 -- Often it means we can do the method selection, and then
555 -- inline the method as well. Marcin's idea; see comments below.
557 -- BUT: don't inline it if it's a constant dictionary;
558 -- we'll get all the benefit without inlining, and we get
559 -- a **lot** of code duplication if we inline it
561 -- See Note [Inline dfuns] below
565 = -- Blatant special case for CCallable, CReturnable
566 -- If the dictionary is empty then we should never
567 -- select anything from it, so we make its RHS just
568 -- emit an error message. This in turn means that we don't
569 -- mention the constructor, which doesn't exist for CCallable, CReturnable
570 -- Hardly beautiful, but only three extra lines.
571 HsApp (TyApp (HsVar rUNTIME_ERROR_ID) [idType this_dict_id])
572 (HsLit (HsStringPrim (mkFastString (stringToUtf8 msg))))
574 | otherwise -- The common case
575 = mkHsConApp dict_constr inst_tys' (map HsVar scs_and_meths)
576 -- We don't produce a binding for the dict_constr; instead we
577 -- rely on the simplifier to unfold this saturated application
578 -- We do this rather than generate an HsCon directly, because
579 -- it means that the special cases (e.g. dictionary with only one
580 -- member) are dealt with by the common MkId.mkDataConWrapId code rather
581 -- than needing to be repeated here.
584 msg = "Compiler error: bad dictionary " ++ showSDoc (ppr clas)
586 dict_bind = VarMonoBind this_dict_id dict_rhs
587 all_binds = sc_binds_inner `AndMonoBinds` meth_binds `AndMonoBinds` dict_bind
591 (map instToId dfun_arg_dicts)
592 [(inst_tyvars', dfun_id, this_dict_id)]
595 showLIE (text "instance") `thenM_`
596 returnM (main_bind `AndMonoBinds` prag_binds `AndMonoBinds` sc_binds_outer)
599 tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
600 avail_insts op_items (VanillaInst monobinds uprags)
601 = -- Check that all the method bindings come from this class
603 sel_names = [idName sel_id | (sel_id, _) <- op_items]
604 bad_bndrs = collectMonoBinders monobinds `minusList` sel_names
606 mappM (addErrTc . badMethodErr clas) bad_bndrs `thenM_`
608 -- Make the method bindings
610 mk_method_bind = mkMethodBind InstanceDeclOrigin clas inst_tys' monobinds
612 mapAndUnzipM mk_method_bind op_items `thenM` \ (meth_insts, meth_infos) ->
614 -- And type check them
615 -- It's really worth making meth_insts available to the tcMethodBind
616 -- Consider instance Monad (ST s) where
617 -- {-# INLINE (>>) #-}
618 -- (>>) = ...(>>=)...
619 -- If we don't include meth_insts, we end up with bindings like this:
620 -- rec { dict = MkD then bind ...
621 -- then = inline_me (... (GHC.Base.>>= dict) ...)
623 -- The trouble is that (a) 'then' and 'dict' are mutually recursive,
624 -- and (b) the inline_me prevents us inlining the >>= selector, which
625 -- would unravel the loop. Result: (>>) ends up as a loop breaker, and
626 -- is not inlined across modules. Rather ironic since this does not
627 -- happen without the INLINE pragma!
629 -- Solution: make meth_insts available, so that 'then' refers directly
630 -- to the local 'bind' rather than going via the dictionary.
632 -- BUT WATCH OUT! If the method type mentions the class variable, then
633 -- this optimisation is not right. Consider
637 -- instance C Int where
639 -- The occurrence of 'op' on the rhs gives rise to a constraint
641 -- The trouble is that the 'meth_inst' for op, which is 'available', also
642 -- looks like 'op at Int'. But they are not the same.
644 all_insts = avail_insts ++ catMaybes meth_insts
645 xtve = inst_tyvars `zip` inst_tyvars'
646 tc_method_bind = tcMethodBind xtve inst_tyvars' dfun_theta' all_insts uprags
648 mapM tc_method_bind meth_infos `thenM` \ meth_binds_s ->
650 returnM ([meth_id | (_,meth_id,_) <- meth_infos],
651 andMonoBindList meth_binds_s)
654 -- Derived newtype instances
655 tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
656 avail_insts op_items (NewTypeDerived rep_tys)
657 = getInstLoc InstanceDeclOrigin `thenM` \ inst_loc ->
658 mapAndUnzip3M (do_one inst_loc) op_items `thenM` \ (meth_ids, meth_binds, rhs_insts) ->
661 (ptext SLIT("newtype derived instance"))
662 inst_tyvars' avail_insts rhs_insts `thenM` \ lie_binds ->
664 -- I don't think we have to do the checkSigTyVars thing
666 returnM (meth_ids, lie_binds `AndMonoBinds` andMonoBindList meth_binds)
669 do_one inst_loc (sel_id, _)
670 = -- The binding is like "op @ NewTy = op @ RepTy"
671 -- Make the *binder*, like in mkMethodBind
672 tcInstClassOp inst_loc sel_id inst_tys' `thenM` \ meth_inst ->
674 -- Make the *occurrence on the rhs*
675 tcInstClassOp inst_loc sel_id rep_tys' `thenM` \ rhs_inst ->
677 meth_id = instToId meth_inst
679 return (meth_id, VarMonoBind meth_id (HsVar (instToId rhs_inst)), rhs_inst)
681 -- Instantiate rep_tys with the relevant type variables
682 rep_tys' = map (substTy subst) rep_tys
683 subst = mkTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars')
686 Note: [Superclass loops]
687 ~~~~~~~~~~~~~~~~~~~~~~~~~
688 We have to be very, very careful when generating superclasses, lest we
689 accidentally build a loop. Here's an example:
693 class S a => C a where { opc :: a -> a }
694 class S b => D b where { opd :: b -> b }
702 From (instance C Int) we get the constraint set {ds1:S Int, dd:D Int}
703 Simplifying, we may well get:
704 $dfCInt = :C ds1 (opd dd)
707 Notice that we spot that we can extract ds1 from dd.
709 Alas! Alack! We can do the same for (instance D Int):
711 $dfDInt = :D ds2 (opc dc)
715 And now we've defined the superclass in terms of itself.
718 Solution: treat the superclass context separately, and simplify it
719 all the way down to nothing on its own. Don't toss any 'free' parts
720 out to be simplified together with other bits of context.
721 Hence the tcSimplifyTop below.
723 At a more basic level, don't include this_dict in the context wrt
724 which we simplify sc_dicts, else sc_dicts get bound by just selecting
728 tcSuperClasses inst_tyvars' dfun_arg_dicts sc_dicts
729 = addErrCtxt superClassCtxt $
730 getLIE (tcSimplifyCheck doc inst_tyvars'
732 sc_dicts) `thenM` \ (sc_binds1, sc_lie) ->
734 -- It's possible that the superclass stuff might have done unification
735 checkSigTyVars inst_tyvars' `thenM` \ zonked_inst_tyvars ->
737 -- We must simplify this all the way down
738 -- lest we build superclass loops
739 -- See Note [Superclass loops] above
740 tcSimplifyTop sc_lie `thenM` \ sc_binds2 ->
742 returnM (zonked_inst_tyvars, sc_binds1, sc_binds2)
745 doc = ptext SLIT("instance declaration superclass context")
749 ------------------------------
750 [Inline dfuns] Inlining dfuns unconditionally
751 ------------------------------
753 The code above unconditionally inlines dict funs. Here's why.
754 Consider this program:
756 test :: Int -> Int -> Bool
757 test x y = (x,y) == (y,x) || test y x
758 -- Recursive to avoid making it inline.
760 This needs the (Eq (Int,Int)) instance. If we inline that dfun
761 the code we end up with is good:
764 \r -> case ==# [ww ww1] of wild {
765 PrelBase.False -> Test.$wtest ww1 ww;
767 case ==# [ww1 ww] of wild1 {
768 PrelBase.False -> Test.$wtest ww1 ww;
769 PrelBase.True -> PrelBase.True [];
772 Test.test = \r [w w1]
775 case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
778 If we don't inline the dfun, the code is not nearly as good:
780 (==) = case PrelTup.$fEq(,) PrelBase.$fEqInt PrelBase.$fEqInt of tpl {
781 PrelBase.:DEq tpl1 tpl2 -> tpl2;
786 let { y = PrelBase.I#! [ww1]; } in
787 let { x = PrelBase.I#! [ww]; } in
788 let { sat_slx = PrelTup.(,)! [y x]; } in
789 let { sat_sly = PrelTup.(,)! [x y];
791 case == sat_sly sat_slx of wild {
792 PrelBase.False -> Test.$wtest ww1 ww;
793 PrelBase.True -> PrelBase.True [];
800 case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
803 Why doesn't GHC inline $fEq? Because it looks big:
805 PrelTup.zdfEqZ1T{-rcX-}
806 = \ @ a{-reT-} :: * @ b{-reS-} :: *
807 zddEq{-rf6-} _Ks :: {PrelBase.Eq{-23-} a{-reT-}}
808 zddEq1{-rf7-} _Ks :: {PrelBase.Eq{-23-} b{-reS-}} ->
810 zeze{-rf0-} _Kl :: (b{-reS-} -> b{-reS-} -> PrelBase.Bool{-3c-})
811 zeze{-rf0-} = PrelBase.zeze{-01L-}@ b{-reS-} zddEq1{-rf7-} } in
813 zeze1{-rf3-} _Kl :: (a{-reT-} -> a{-reT-} -> PrelBase.Bool{-3c-})
814 zeze1{-rf3-} = PrelBase.zeze{-01L-} @ a{-reT-} zddEq{-rf6-} } in
816 zeze2{-reN-} :: ((a{-reT-}, b{-reS-}) -> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
817 zeze2{-reN-} = \ ds{-rf5-} _Ks :: (a{-reT-}, b{-reS-})
818 ds1{-rf4-} _Ks :: (a{-reT-}, b{-reS-}) ->
820 of wild{-reW-} _Kd { (a1{-rf2-} _Ks, a2{-reZ-} _Ks) ->
822 of wild1{-reX-} _Kd { (b1{-rf1-} _Ks, b2{-reY-} _Ks) ->
824 (zeze1{-rf3-} a1{-rf2-} b1{-rf1-})
825 (zeze{-rf0-} a2{-reZ-} b2{-reY-})
829 a1{-reR-} :: ((a{-reT-}, b{-reS-})-> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
830 a1{-reR-} = \ a2{-reV-} _Ks :: (a{-reT-}, b{-reS-})
831 b1{-reU-} _Ks :: (a{-reT-}, b{-reS-}) ->
832 PrelBase.not{-r6I-} (zeze2{-reN-} a2{-reV-} b1{-reU-})
834 PrelBase.zdwZCDEq{-r8J-} @ (a{-reT-}, b{-reS-}) a1{-reR-} zeze2{-reN-})
836 and it's not as bad as it seems, because it's further dramatically
837 simplified: only zeze2 is extracted and its body is simplified.
840 %************************************************************************
842 \subsection{Error messages}
844 %************************************************************************
847 tcAddDeclCtxt decl thing_inside
848 = addSrcLoc (tcdLoc decl) $
853 ClassDecl {} -> "class"
854 TySynonym {} -> "type synonym"
855 TyData {tcdND = NewType} -> "newtype"
856 TyData {tcdND = DataType} -> "data type"
858 ctxt = hsep [ptext SLIT("In the"), text thing,
859 ptext SLIT("declaration for"), quotes (ppr (tcdName decl))]
861 instDeclCtxt inst_ty = ptext SLIT("In the instance declaration for") <+> quotes doc
863 doc = case inst_ty of
864 HsForAllTy _ _ (HsPredTy pred) -> ppr pred
865 HsPredTy pred -> ppr pred
866 other -> ppr inst_ty -- Don't expect this
870 badGenericInstanceType binds
871 = vcat [ptext SLIT("Illegal type pattern in the generic bindings"),
874 missingGenericInstances missing
875 = ptext SLIT("Missing type patterns for") <+> pprQuotedList missing
877 dupGenericInsts tc_inst_infos
878 = vcat [ptext SLIT("More than one type pattern for a single generic type constructor:"),
879 nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
880 ptext SLIT("All the type patterns for a generic type constructor must be identical")
883 ppr_inst_ty (tc,inst) = ppr (simpleInstInfoTy inst)
885 methodCtxt = ptext SLIT("When checking the methods of an instance declaration")
886 superClassCtxt = ptext SLIT("When checking the super-classes of an instance declaration")