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(..), newMethod, newMethodAtLoc,
35 newDicts, instToId, showLIE )
36 import TcDeriv ( tcDeriving )
37 import TcEnv ( tcExtendGlobalValEnv,
38 tcLookupClass, tcExtendTyVarEnv2,
39 tcExtendInstEnv, tcExtendLocalInstEnv, tcLookupGlobalId,
40 InstInfo(..), InstBindings(..), pprInstInfo, simpleInstInfoTyCon,
41 simpleInstInfoTy, newDFunName
43 import PprType ( pprClassPred )
44 import TcMonoType ( tcHsTyVars, kcHsSigType, tcHsType, tcHsSigType )
45 import TcUnify ( checkSigTyVars )
46 import TcSimplify ( tcSimplifyCheck, tcSimplifyTop )
47 import HscTypes ( DFunId )
48 import Subst ( mkTyVarSubst, substTheta, substTy )
49 import DataCon ( classDataCon )
50 import Class ( Class, classBigSig )
51 import Var ( idName, idType )
53 import Id ( setIdLocalExported )
54 import MkId ( mkDictFunId, rUNTIME_ERROR_ID )
55 import FunDeps ( checkInstFDs )
56 import Generics ( validGenericInstanceType )
57 import Name ( getSrcLoc )
58 import NameSet ( unitNameSet, emptyNameSet, nameSetToList )
59 import TyCon ( TyCon )
60 import TysWiredIn ( genericTyCons )
61 import SrcLoc ( SrcLoc )
62 import Unique ( Uniquable(..) )
63 import Util ( lengthExceeds )
64 import BasicTypes ( NewOrData(..) )
65 import UnicodeUtil ( stringToUtf8 )
66 import ErrUtils ( dumpIfSet_dyn )
67 import ListSetOps ( Assoc, emptyAssoc, plusAssoc_C, mapAssoc,
68 assocElts, extendAssoc_C, equivClassesByUniq, minusList
70 import Maybe ( catMaybes )
71 import List ( partition )
76 Typechecking instance declarations is done in two passes. The first
77 pass, made by @tcInstDecls1@, collects information to be used in the
80 This pre-processed info includes the as-yet-unprocessed bindings
81 inside the instance declaration. These are type-checked in the second
82 pass, when the class-instance envs and GVE contain all the info from
83 all the instance and value decls. Indeed that's the reason we need
84 two passes over the instance decls.
87 Here is the overall algorithm.
88 Assume that we have an instance declaration
90 instance c => k (t tvs) where b
94 $LIE_c$ is the LIE for the context of class $c$
96 $betas_bar$ is the free variables in the class method type, excluding the
99 $LIE_cop$ is the LIE constraining a particular class method
101 $tau_cop$ is the tau type of a class method
103 $LIE_i$ is the LIE for the context of instance $i$
105 $X$ is the instance constructor tycon
107 $gammas_bar$ is the set of type variables of the instance
109 $LIE_iop$ is the LIE for a particular class method instance
111 $tau_iop$ is the tau type for this instance of a class method
113 $alpha$ is the class variable
115 $LIE_cop' = LIE_cop [X gammas_bar / alpha, fresh betas_bar]$
117 $tau_cop' = tau_cop [X gammas_bar / alpha, fresh betas_bar]$
120 ToDo: Update the list above with names actually in the code.
124 First, make the LIEs for the class and instance contexts, which means
125 instantiate $thetaC [X inst_tyvars / alpha ]$, yielding LIElistC' and LIEC',
126 and make LIElistI and LIEI.
128 Then process each method in turn.
130 order the instance methods according to the ordering of the class methods
132 express LIEC' in terms of LIEI, yielding $dbinds_super$ or an error
134 Create final dictionary function from bindings generated already
136 df = lambda inst_tyvars
143 in <op1,op2,...,opn,sd1,...,sdm>
145 Here, Bop1 \ldots Bopn bind the methods op1 \ldots opn,
146 and $dbinds_super$ bind the superclass dictionaries sd1 \ldots sdm.
150 %************************************************************************
152 \subsection{Extracting instance decls}
154 %************************************************************************
156 Gather up the instance declarations from their various sources
159 tcInstDecls1 -- Deal with both source-code and imported instance decls
160 :: [RenamedTyClDecl] -- For deriving stuff
161 -> [RenamedInstDecl] -- Source code instance decls
162 -> TcM (TcGblEnv, -- The full inst env
163 [InstInfo], -- Source-code instance decls to process;
164 -- contains all dfuns for this module
165 RenamedHsBinds, -- Supporting bindings for derived instances
166 FreeVars) -- And the free vars of the derived code
168 tcInstDecls1 tycl_decls inst_decls
170 -- Stop if addInstInfos etc discovers any errors
171 -- (they recover, so that we get more than one error each round)
173 (src_inst_decls, iface_inst_decls) = partition isSourceInstDecl inst_decls
176 -- (0) Deal with the imported instance decls
177 tcIfaceInstDecls iface_inst_decls `thenM` \ imp_dfuns ->
178 tcExtendInstEnv imp_dfuns $
180 -- (1) Do the ordinary instance declarations
181 mappM tcLocalInstDecl1 src_inst_decls `thenM` \ local_inst_infos ->
184 local_inst_info = catMaybes local_inst_infos
185 clas_decls = filter isClassDecl tycl_decls
187 -- (2) Instances from generic class declarations
188 getGenericInstances clas_decls `thenM` \ generic_inst_info ->
190 -- Next, construct the instance environment so far, consisting of
191 -- a) imported instance decls (from this module)
192 -- b) local instance decls
193 -- c) generic instances
194 tcExtendLocalInstEnv local_inst_info $
195 tcExtendLocalInstEnv generic_inst_info $
197 -- (3) Compute instances from "deriving" clauses;
198 -- note that we only do derivings for things in this module;
199 -- we ignore deriving decls from interfaces!
200 -- This stuff computes a context for the derived instance decl, so it
201 -- needs to know about all the instances possible; hence inst_env4
202 tcDeriving tycl_decls `thenM` \ (deriv_inst_info, deriv_binds, fvs) ->
203 tcExtendLocalInstEnv deriv_inst_info $
205 getGblEnv `thenM` \ gbl_env ->
207 generic_inst_info ++ deriv_inst_info ++ local_inst_info,
212 tcLocalInstDecl1 :: RenamedInstDecl
213 -> TcM (Maybe InstInfo) -- Nothing if there was an error
214 -- A source-file instance declaration
215 -- Type-check all the stuff before the "where"
217 -- We check for respectable instance type, and context
218 -- but only do this for non-imported instance decls.
219 -- Imported ones should have been checked already, and may indeed
220 -- contain something illegal in normal Haskell, notably
221 -- instance CCallable [Char]
222 tcLocalInstDecl1 decl@(InstDecl poly_ty binds uprags Nothing src_loc)
223 = -- Prime error recovery, set source location
224 recoverM (returnM Nothing) $
226 addErrCtxt (instDeclCtxt poly_ty) $
228 -- Typecheck the instance type itself. We can't use
229 -- tcHsSigType, because it's not a valid user type.
230 kcHsSigType poly_ty `thenM_`
231 tcHsType poly_ty `thenM` \ poly_ty' ->
233 (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
235 checkValidTheta InstThetaCtxt theta `thenM_`
236 checkAmbiguity tyvars theta (tyVarsOfType tau) `thenM_`
237 checkValidInstHead tau `thenM` \ (clas,inst_tys) ->
238 checkTc (checkInstFDs theta clas inst_tys)
239 (instTypeErr (pprClassPred clas inst_tys) msg) `thenM_`
240 newDFunName clas inst_tys src_loc `thenM` \ dfun_name ->
241 returnM (Just (InstInfo { iDFunId = mkDictFunId dfun_name tyvars theta clas inst_tys,
242 iBinds = VanillaInst binds uprags }))
244 msg = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))
247 Imported instance declarations
250 tcIfaceInstDecls :: [RenamedInstDecl] -> TcM [DFunId]
251 -- Deal with the instance decls,
252 tcIfaceInstDecls decls = mappM tcIfaceInstDecl decls
254 tcIfaceInstDecl :: RenamedInstDecl -> TcM DFunId
255 -- An interface-file instance declaration
256 -- Should be in scope by now, because we should
257 -- have sucked in its interface-file definition
258 -- So it will be replete with its unfolding etc
259 tcIfaceInstDecl decl@(InstDecl poly_ty binds uprags (Just dfun_name) src_loc)
260 = tcLookupGlobalId dfun_name
264 %************************************************************************
266 \subsection{Extracting generic instance declaration from class declarations}
268 %************************************************************************
270 @getGenericInstances@ extracts the generic instance declarations from a class
271 declaration. For exmaple
276 op{ x+y } (Inl v) = ...
277 op{ x+y } (Inr v) = ...
278 op{ x*y } (v :*: w) = ...
281 gives rise to the instance declarations
283 instance C (x+y) where
287 instance C (x*y) where
295 getGenericInstances :: [RenamedTyClDecl] -> TcM [InstInfo]
296 getGenericInstances class_decls
297 = mappM get_generics class_decls `thenM` \ gen_inst_infos ->
299 gen_inst_info = concat gen_inst_infos
301 if null gen_inst_info then
304 getDOpts `thenM` \ dflags ->
305 ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
306 (vcat (map pprInstInfo gen_inst_info)))
308 returnM gen_inst_info
310 get_generics decl@(ClassDecl {tcdMeths = Nothing})
311 = returnM [] -- Imported class decls
313 get_generics decl@(ClassDecl {tcdName = class_name, tcdMeths = Just def_methods, tcdLoc = loc})
315 = returnM [] -- The comon case: no generic default methods
317 | otherwise -- A source class decl with generic default methods
318 = recoverM (returnM []) $
320 tcLookupClass class_name `thenM` \ clas ->
322 -- Make an InstInfo out of each group
323 mappM (mkGenericInstance clas loc) groups `thenM` \ inst_infos ->
325 -- Check that there is only one InstInfo for each type constructor
326 -- The main way this can fail is if you write
327 -- f {| a+b |} ... = ...
328 -- f {| x+y |} ... = ...
329 -- Then at this point we'll have an InstInfo for each
331 tc_inst_infos :: [(TyCon, InstInfo)]
332 tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
334 bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
335 group `lengthExceeds` 1]
336 get_uniq (tc,_) = getUnique tc
338 mappM (addErrTc . dupGenericInsts) bad_groups `thenM_`
340 -- Check that there is an InstInfo for each generic type constructor
342 missing = genericTyCons `minusList` [tc | (tc,_) <- tc_inst_infos]
344 checkTc (null missing) (missingGenericInstances missing) `thenM_`
349 -- Group the declarations by type pattern
350 groups :: [(RenamedHsType, RenamedMonoBinds)]
351 groups = assocElts (getGenericBinds def_methods)
354 ---------------------------------
355 getGenericBinds :: RenamedMonoBinds -> Assoc RenamedHsType RenamedMonoBinds
356 -- Takes a group of method bindings, finds the generic ones, and returns
357 -- them in finite map indexed by the type parameter in the definition.
359 getGenericBinds EmptyMonoBinds = emptyAssoc
360 getGenericBinds (AndMonoBinds m1 m2)
361 = plusAssoc_C AndMonoBinds (getGenericBinds m1) (getGenericBinds m2)
363 getGenericBinds (FunMonoBind id infixop matches loc)
364 = mapAssoc wrap (foldl add emptyAssoc matches)
365 -- Using foldl not foldr is vital, else
366 -- we reverse the order of the bindings!
368 add env match = case maybeGenericMatch match of
370 Just (ty, match') -> extendAssoc_C (++) env (ty, [match'])
372 wrap ms = FunMonoBind id infixop ms loc
374 ---------------------------------
375 mkGenericInstance :: Class -> SrcLoc
376 -> (RenamedHsType, RenamedMonoBinds)
379 mkGenericInstance clas loc (hs_ty, binds)
380 -- Make a generic instance declaration
381 -- For example: instance (C a, C b) => C (a+b) where { binds }
383 = -- Extract the universally quantified type variables
385 sig_tvs = map UserTyVar (nameSetToList (extractHsTyVars hs_ty))
387 tcHsTyVars sig_tvs (kcHsSigType hs_ty) $ \ tyvars ->
389 -- Type-check the instance type, and check its form
390 tcHsSigType GenPatCtxt hs_ty `thenM` \ inst_ty ->
391 checkTc (validGenericInstanceType inst_ty)
392 (badGenericInstanceType binds) `thenM_`
394 -- Make the dictionary function.
395 newDFunName clas [inst_ty] loc `thenM` \ dfun_name ->
397 inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
398 dfun_id = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
401 returnM (InstInfo { iDFunId = dfun_id, iBinds = VanillaInst binds [] })
405 %************************************************************************
407 \subsection{Type-checking instance declarations, pass 2}
409 %************************************************************************
412 tcInstDecls2 :: [InstInfo] -> TcM TcMonoBinds
413 tcInstDecls2 inst_decls
414 = mappM tcInstDecl2 inst_decls `thenM` \ binds_s ->
415 returnM (andMonoBindList binds_s)
418 ======= New documentation starts here (Sept 92) ==============
420 The main purpose of @tcInstDecl2@ is to return a @HsBinds@ which defines
421 the dictionary function for this instance declaration. For example
423 instance Foo a => Foo [a] where
427 might generate something like
429 dfun.Foo.List dFoo_a = let op1 x = ...
435 HOWEVER, if the instance decl has no context, then it returns a
436 bigger @HsBinds@ with declarations for each method. For example
438 instance Foo [a] where
444 dfun.Foo.List a = Dict [Foo.op1.List a, Foo.op2.List a]
445 const.Foo.op1.List a x = ...
446 const.Foo.op2.List a y = ...
448 This group may be mutually recursive, because (for example) there may
449 be no method supplied for op2 in which case we'll get
451 const.Foo.op2.List a = default.Foo.op2 (dfun.Foo.List a)
453 that is, the default method applied to the dictionary at this type.
455 What we actually produce in either case is:
457 AbsBinds [a] [dfun_theta_dicts]
458 [(dfun.Foo.List, d)] ++ (maybe) [(const.Foo.op1.List, op1), ...]
459 { d = (sd1,sd2, ..., op1, op2, ...)
464 The "maybe" says that we only ask AbsBinds to make global constant methods
465 if the dfun_theta is empty.
468 For an instance declaration, say,
470 instance (C1 a, C2 b) => C (T a b) where
473 where the {\em immediate} superclasses of C are D1, D2, we build a dictionary
474 function whose type is
476 (C1 a, C2 b, D1 (T a b), D2 (T a b)) => C (T a b)
478 Notice that we pass it the superclass dictionaries at the instance type; this
479 is the ``Mark Jones optimisation''. The stuff before the "=>" here
480 is the @dfun_theta@ below.
482 First comes the easy case of a non-local instance decl.
486 tcInstDecl2 :: InstInfo -> TcM TcMonoBinds
488 tcInstDecl2 (InstInfo { iDFunId = dfun_id, iBinds = binds })
489 = -- Prime error recovery
490 recoverM (returnM EmptyMonoBinds) $
491 addSrcLoc (getSrcLoc dfun_id) $
492 addErrCtxt (instDeclCtxt (toHsType (idType dfun_id))) $
494 inst_ty = idType dfun_id
495 (inst_tyvars, _) = tcSplitForAllTys inst_ty
496 -- The tyvars of the instance decl scope over the 'where' part
497 -- Those tyvars are inside the dfun_id's type, which is a bit
498 -- bizarre, but OK so long as you realise it!
501 -- Instantiate the instance decl with tc-style type variables
502 tcInstType InstTv inst_ty `thenM` \ (inst_tyvars', dfun_theta', inst_head') ->
504 Just pred = tcSplitPredTy_maybe inst_head'
505 (clas, inst_tys') = getClassPredTys pred
506 (class_tyvars, sc_theta, _, op_items) = classBigSig clas
508 -- Instantiate the super-class context with inst_tys
509 sc_theta' = substTheta (mkTyVarSubst class_tyvars inst_tys') sc_theta
510 origin = InstanceDeclOrigin
512 -- Create dictionary Ids from the specified instance contexts.
513 newDicts origin sc_theta' `thenM` \ sc_dicts ->
514 newDicts origin dfun_theta' `thenM` \ dfun_arg_dicts ->
515 newDicts origin [pred] `thenM` \ [this_dict] ->
516 -- Default-method Ids may be mentioned in synthesised RHSs,
517 -- but they'll already be in the environment.
520 -- Typecheck the methods
521 let -- These insts are in scope; quite a few, eh?
522 avail_insts = [this_dict] ++ dfun_arg_dicts ++ sc_dicts
524 tcMethods clas inst_tyvars inst_tyvars'
525 dfun_theta' inst_tys' avail_insts
526 op_items binds `thenM` \ (meth_ids, meth_binds) ->
528 -- Figure out bindings for the superclass context
529 tcSuperClasses inst_tyvars' dfun_arg_dicts sc_dicts
530 `thenM` \ (zonked_inst_tyvars, sc_binds_inner, sc_binds_outer) ->
532 -- Deal with 'SPECIALISE instance' pragmas by making them
533 -- look like SPECIALISE pragmas for the dfun
535 uprags = case binds of
536 VanillaInst _ uprags -> uprags
538 spec_prags = [ SpecSig (idName dfun_id) ty loc
539 | SpecInstSig ty loc <- uprags ]
540 xtve = inst_tyvars `zip` inst_tyvars'
542 tcExtendGlobalValEnv [dfun_id] (
543 tcExtendTyVarEnv2 xtve $
544 tcSpecSigs spec_prags
545 ) `thenM` \ prag_binds ->
547 -- Create the result bindings
549 local_dfun_id = setIdLocalExported dfun_id
550 -- Reason for setIdLocalExported: see notes with MkId.mkDictFunId
552 dict_constr = classDataCon clas
553 scs_and_meths = map instToId sc_dicts ++ meth_ids
554 this_dict_id = instToId this_dict
555 inlines | null dfun_arg_dicts = emptyNameSet
556 | otherwise = unitNameSet (idName dfun_id)
557 -- Always inline the dfun; this is an experimental decision
558 -- because it makes a big performance difference sometimes.
559 -- Often it means we can do the method selection, and then
560 -- inline the method as well. Marcin's idea; see comments below.
562 -- BUT: don't inline it if it's a constant dictionary;
563 -- we'll get all the benefit without inlining, and we get
564 -- a **lot** of code duplication if we inline it
566 -- See Note [Inline dfuns] below
570 = -- Blatant special case for CCallable, CReturnable
571 -- If the dictionary is empty then we should never
572 -- select anything from it, so we make its RHS just
573 -- emit an error message. This in turn means that we don't
574 -- mention the constructor, which doesn't exist for CCallable, CReturnable
575 -- Hardly beautiful, but only three extra lines.
576 HsApp (TyApp (HsVar rUNTIME_ERROR_ID) [idType this_dict_id])
577 (HsLit (HsStringPrim (mkFastString (stringToUtf8 msg))))
579 | otherwise -- The common case
580 = mkHsConApp dict_constr inst_tys' (map HsVar scs_and_meths)
581 -- We don't produce a binding for the dict_constr; instead we
582 -- rely on the simplifier to unfold this saturated application
583 -- We do this rather than generate an HsCon directly, because
584 -- it means that the special cases (e.g. dictionary with only one
585 -- member) are dealt with by the common MkId.mkDataConWrapId code rather
586 -- than needing to be repeated here.
589 msg = "Compiler error: bad dictionary " ++ showSDoc (ppr clas)
591 dict_bind = VarMonoBind this_dict_id dict_rhs
592 all_binds = sc_binds_inner `AndMonoBinds` meth_binds `AndMonoBinds` dict_bind
596 (map instToId dfun_arg_dicts)
597 [(inst_tyvars', local_dfun_id, this_dict_id)]
600 showLIE "instance" `thenM_`
601 returnM (main_bind `AndMonoBinds` prag_binds `AndMonoBinds` sc_binds_outer)
604 tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
605 avail_insts op_items (VanillaInst monobinds uprags)
606 = -- Check that all the method bindings come from this class
608 sel_names = [idName sel_id | (sel_id, _) <- op_items]
609 bad_bndrs = collectMonoBinders monobinds `minusList` sel_names
611 mappM (addErrTc . badMethodErr clas) bad_bndrs `thenM_`
613 -- Make the method bindings
614 mapAndUnzipM do_one op_items `thenM` \ (meth_ids, meth_binds_s) ->
616 returnM (meth_ids, andMonoBindList meth_binds_s)
619 xtve = inst_tyvars `zip` inst_tyvars'
621 = mkMethodBind InstanceDeclOrigin clas
622 inst_tys' monobinds op_item `thenM` \ (meth_inst, meth_info) ->
623 tcMethodBind xtve inst_tyvars' dfun_theta'
624 avail_insts uprags meth_info `thenM` \ meth_bind ->
625 -- Could add meth_insts to avail_insts, but not worth the bother
626 returnM (instToId meth_inst, meth_bind)
628 -- Derived newtype instances
629 tcMethods clas inst_tyvars inst_tyvars' dfun_theta' inst_tys'
630 avail_insts op_items (NewTypeDerived rep_tys)
631 = getInstLoc InstanceDeclOrigin `thenM` \ inst_loc ->
632 getLIE (mapAndUnzipM (do_one inst_loc) op_items) `thenM` \ ((meth_ids, meth_binds), lie) ->
635 (ptext SLIT("newtype derived instance"))
636 inst_tyvars' avail_insts lie `thenM` \ lie_binds ->
638 -- I don't think we have to do the checkSigTyVars thing
640 returnM (meth_ids, lie_binds `AndMonoBinds` andMonoBindList meth_binds)
643 do_one inst_loc (sel_id, _)
644 = newMethodAtLoc inst_loc sel_id inst_tys' `thenM` \ meth_inst ->
645 -- Like in mkMethodBind
646 newMethod InstanceDeclOrigin sel_id rep_tys' `thenM` \ rhs_id ->
647 -- The binding is like "op @ NewTy = op @ RepTy"
649 meth_id = instToId meth_inst
651 return (meth_id, VarMonoBind meth_id (HsVar rhs_id))
653 -- Instantiate rep_tys with the relevant type variables
654 rep_tys' = map (substTy subst) rep_tys
655 subst = mkTyVarSubst inst_tyvars (mkTyVarTys inst_tyvars')
658 Note: [Superclass loops]
659 ~~~~~~~~~~~~~~~~~~~~~~~~~
660 We have to be very, very careful when generating superclasses, lest we
661 accidentally build a loop. Here's an example:
665 class S a => C a where { opc :: a -> a }
666 class S b => D b where { opd :: b -> b }
674 From (instance C Int) we get the constraint set {ds1:S Int, dd:D Int}
675 Simplifying, we may well get:
676 $dfCInt = :C ds1 (opd dd)
679 Notice that we spot that we can extract ds1 from dd.
681 Alas! Alack! We can do the same for (instance D Int):
683 $dfDInt = :D ds2 (opc dc)
687 And now we've defined the superclass in terms of itself.
690 Solution: treat the superclass context separately, and simplify it
691 all the way down to nothing on its own. Don't toss any 'free' parts
692 out to be simplified together with other bits of context.
693 Hence the tcSimplifyTop below.
695 At a more basic level, don't include this_dict in the context wrt
696 which we simplify sc_dicts, else sc_dicts get bound by just selecting
700 tcSuperClasses inst_tyvars' dfun_arg_dicts sc_dicts
701 = addErrCtxt superClassCtxt $
702 getLIE (tcSimplifyCheck doc inst_tyvars'
704 sc_dicts) `thenM` \ (sc_binds1, sc_lie) ->
706 -- It's possible that the superclass stuff might have done unification
707 checkSigTyVars inst_tyvars' `thenM` \ zonked_inst_tyvars ->
709 -- We must simplify this all the way down
710 -- lest we build superclass loops
711 -- See Note [Superclass loops] above
712 tcSimplifyTop sc_lie `thenM` \ sc_binds2 ->
714 returnM (zonked_inst_tyvars, sc_binds1, sc_binds2)
717 doc = ptext SLIT("instance declaration superclass context")
721 ------------------------------
722 [Inline dfuns] Inlining dfuns unconditionally
723 ------------------------------
725 The code above unconditionally inlines dict funs. Here's why.
726 Consider this program:
728 test :: Int -> Int -> Bool
729 test x y = (x,y) == (y,x) || test y x
730 -- Recursive to avoid making it inline.
732 This needs the (Eq (Int,Int)) instance. If we inline that dfun
733 the code we end up with is good:
736 \r -> case ==# [ww ww1] of wild {
737 PrelBase.False -> Test.$wtest ww1 ww;
739 case ==# [ww1 ww] of wild1 {
740 PrelBase.False -> Test.$wtest ww1 ww;
741 PrelBase.True -> PrelBase.True [];
744 Test.test = \r [w w1]
747 case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
750 If we don't inline the dfun, the code is not nearly as good:
752 (==) = case PrelTup.$fEq(,) PrelBase.$fEqInt PrelBase.$fEqInt of tpl {
753 PrelBase.:DEq tpl1 tpl2 -> tpl2;
758 let { y = PrelBase.I#! [ww1]; } in
759 let { x = PrelBase.I#! [ww]; } in
760 let { sat_slx = PrelTup.(,)! [y x]; } in
761 let { sat_sly = PrelTup.(,)! [x y];
763 case == sat_sly sat_slx of wild {
764 PrelBase.False -> Test.$wtest ww1 ww;
765 PrelBase.True -> PrelBase.True [];
772 case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
775 Why doesn't GHC inline $fEq? Because it looks big:
777 PrelTup.zdfEqZ1T{-rcX-}
778 = \ @ a{-reT-} :: * @ b{-reS-} :: *
779 zddEq{-rf6-} _Ks :: {PrelBase.Eq{-23-} a{-reT-}}
780 zddEq1{-rf7-} _Ks :: {PrelBase.Eq{-23-} b{-reS-}} ->
782 zeze{-rf0-} _Kl :: (b{-reS-} -> b{-reS-} -> PrelBase.Bool{-3c-})
783 zeze{-rf0-} = PrelBase.zeze{-01L-}@ b{-reS-} zddEq1{-rf7-} } in
785 zeze1{-rf3-} _Kl :: (a{-reT-} -> a{-reT-} -> PrelBase.Bool{-3c-})
786 zeze1{-rf3-} = PrelBase.zeze{-01L-} @ a{-reT-} zddEq{-rf6-} } in
788 zeze2{-reN-} :: ((a{-reT-}, b{-reS-}) -> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
789 zeze2{-reN-} = \ ds{-rf5-} _Ks :: (a{-reT-}, b{-reS-})
790 ds1{-rf4-} _Ks :: (a{-reT-}, b{-reS-}) ->
792 of wild{-reW-} _Kd { (a1{-rf2-} _Ks, a2{-reZ-} _Ks) ->
794 of wild1{-reX-} _Kd { (b1{-rf1-} _Ks, b2{-reY-} _Ks) ->
796 (zeze1{-rf3-} a1{-rf2-} b1{-rf1-})
797 (zeze{-rf0-} a2{-reZ-} b2{-reY-})
801 a1{-reR-} :: ((a{-reT-}, b{-reS-})-> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
802 a1{-reR-} = \ a2{-reV-} _Ks :: (a{-reT-}, b{-reS-})
803 b1{-reU-} _Ks :: (a{-reT-}, b{-reS-}) ->
804 PrelBase.not{-r6I-} (zeze2{-reN-} a2{-reV-} b1{-reU-})
806 PrelBase.zdwZCDEq{-r8J-} @ (a{-reT-}, b{-reS-}) a1{-reR-} zeze2{-reN-})
808 and it's not as bad as it seems, because it's further dramatically
809 simplified: only zeze2 is extracted and its body is simplified.
812 %************************************************************************
814 \subsection{Error messages}
816 %************************************************************************
819 tcAddDeclCtxt decl thing_inside
820 = addSrcLoc (tcdLoc decl) $
825 ClassDecl {} -> "class"
826 TySynonym {} -> "type synonym"
827 TyData {tcdND = NewType} -> "newtype"
828 TyData {tcdND = DataType} -> "data type"
830 ctxt = hsep [ptext SLIT("In the"), text thing,
831 ptext SLIT("declaration for"), quotes (ppr (tcdName decl))]
833 instDeclCtxt inst_ty = ptext SLIT("In the instance declaration for") <+> quotes doc
835 doc = case inst_ty of
836 HsForAllTy _ _ (HsPredTy pred) -> ppr pred
837 HsPredTy pred -> ppr pred
838 other -> ppr inst_ty -- Don't expect this
842 badGenericInstanceType binds
843 = vcat [ptext SLIT("Illegal type pattern in the generic bindings"),
846 missingGenericInstances missing
847 = ptext SLIT("Missing type patterns for") <+> pprQuotedList missing
849 dupGenericInsts tc_inst_infos
850 = vcat [ptext SLIT("More than one type pattern for a single generic type constructor:"),
851 nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
852 ptext SLIT("All the type patterns for a generic type constructor must be identical")
855 ppr_inst_ty (tc,inst) = ppr (simpleInstInfoTy inst)
857 methodCtxt = ptext SLIT("When checking the methods of an instance declaration")
858 superClassCtxt = ptext SLIT("When checking the super-classes of an instance declaration")