2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[InstEnv]{Utilities for typechecking instance declarations}
6 The bits common to TcInstDcls and TcDeriv.
10 DFunId, ClsInstEnv, InstEnv,
12 emptyInstEnv, extendInstEnv, pprInstEnv,
13 lookupInstEnv, InstLookupResult(..),
14 classInstEnv, simpleDFunClassTyCon
17 #include "HsVersions.h"
19 import Class ( Class, classTvsFds )
20 import Var ( TyVar, Id )
23 import Maybes ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
24 import Name ( getSrcLoc )
25 import TcType ( Type, tcTyConAppTyCon, mkTyVarTy,
26 tcSplitDFunTy, tyVarsOfTypes,
27 matchTys, unifyTyListsX, allDistinctTyVars
29 import PprType ( pprClassPred )
30 import FunDeps ( checkClsFD )
31 import TyCon ( TyCon )
33 import UniqFM ( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM, eltsUFM )
35 import ErrUtils ( Message )
40 %************************************************************************
42 \subsection{The key types}
44 %************************************************************************
49 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
51 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
52 simpleDFunClassTyCon dfun
55 (_,_,clas,[ty]) = tcSplitDFunTy (idType dfun)
56 tycon = tcTyConAppTyCon ty
58 pprInstEnv :: InstEnv -> SDoc
60 = vcat [ brackets (pprWithCommas ppr (varSetElems tyvars)) <+>
61 brackets (pprWithCommas ppr tys) <+> ppr dfun
62 | cls_inst_env <- eltsUFM env
63 , (tyvars, tys, dfun) <- cls_inst_env
67 %************************************************************************
69 \subsection{Instance environments: InstEnv and ClsInstEnv}
71 %************************************************************************
74 type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
75 -- INVARIANTs: see notes below
77 emptyInstEnv :: InstEnv
78 emptyInstEnv = emptyUFM
80 classInstEnv :: InstEnv -> Class -> ClsInstEnv
81 classInstEnv env cls = lookupWithDefaultUFM env [] cls
84 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
85 ClsInstEnv mapping is the dfun for that instance.
87 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
89 forall a b, C t1 t2 t3 can be constructed by dfun
91 or, to put it another way, we have
93 instance (...) => C t1 t2 t3, witnessed by dfun
95 There is an important consistency constraint in the elements of a ClsInstEnv:
97 * [a,b] must be a superset of the free vars of [t1,t2,t3]
99 * The dfun must itself be quantified over [a,b]
101 * More specific instances come before less specific ones,
104 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
105 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
106 The "a" in the pattern must be one of the forall'd variables in
111 Notes on overlapping instances
112 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
113 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
115 In others, overlap is permitted, but only in such a way that one can make
116 a unique choice when looking up. That is, overlap is only permitted if
117 one template matches the other, or vice versa. So this is ok:
125 If overlap is permitted, the list is kept most specific first, so that
126 the first lookup is the right choice.
129 For now we just use association lists.
131 \subsection{Avoiding a problem with overlapping}
133 Consider this little program:
136 class C a where c :: a
137 class C a => D a where d :: a
139 instance C Int where c = 17
140 instance D Int where d = 13
142 instance C a => C [a] where c = [c]
143 instance ({- C [a], -} D a) => D [a] where d = c
145 instance C [Int] where c = [37]
147 main = print (d :: [Int])
150 What do you think `main' prints (assuming we have overlapping instances, and
151 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
152 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
153 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
154 the `C [Int]' instance is more specific).
156 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
157 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
158 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
159 doesn't even compile! What's going on!?
161 What hugs complains about is the `D [a]' instance decl.
164 ERROR "mj.hs" (line 10): Cannot build superclass instance
166 *** Context supplied : D a
167 *** Required superclass : C [a]
170 You might wonder what hugs is complaining about. It's saying that you
171 need to add `C [a]' to the context of the `D [a]' instance (as appears
172 in comments). But there's that `C [a]' instance decl one line above
173 that says that I can reduce the need for a `C [a]' instance to the
174 need for a `C a' instance, and in this case, I already have the
175 necessary `C a' instance (since we have `D a' explicitly in the
176 context, and `C' is a superclass of `D').
178 Unfortunately, the above reasoning indicates a premature commitment to the
179 generic `C [a]' instance. I.e., it prematurely rules out the more specific
180 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
181 add the context that hugs suggests (uncomment the `C [a]'), effectively
182 deferring the decision about which instance to use.
184 Now, interestingly enough, 4.04 has this same bug, but it's covered up
185 in this case by a little known `optimization' that was disabled in
186 4.06. Ghc-4.04 silently inserts any missing superclass context into
187 an instance declaration. In this case, it silently inserts the `C
188 [a]', and everything happens to work out.
190 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
191 `Mark Jones', although Mark claims no credit for the `optimization' in
192 question, and would rather it stopped being called the `Mark Jones
195 So, what's the fix? I think hugs has it right. Here's why. Let's try
196 something else out with ghc-4.04. Let's add the following line:
201 Everyone raise their hand who thinks that `d :: [Int]' should give a
202 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
203 `optimization' only applies to instance decls, not to regular
204 bindings, giving inconsistent behavior.
206 Old hugs had this same bug. Here's how we fixed it: like GHC, the
207 list of instances for a given class is ordered, so that more specific
208 instances come before more generic ones. For example, the instance
209 list for C might contain:
210 ..., C Int, ..., C a, ...
211 When we go to look for a `C Int' instance we'll get that one first.
212 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
213 pass the `C Int' instance, and keep going. But if `b' is
214 unconstrained, then we don't know yet if the more specific instance
215 will eventually apply. GHC keeps going, and matches on the generic `C
216 a'. The fix is to, at each step, check to see if there's a reverse
217 match, and if so, abort the search. This prevents hugs from
218 prematurely chosing a generic instance when a more specific one
223 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
224 this test. Suppose the instance envt had
225 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
226 (still most specific first)
227 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
228 C x y Int doesn't match the template {a,b} C a a b
230 C a a b match the template {x,y} C x y Int
231 But still x and y might subsequently be unified so they *do* match.
233 Simple story: unify, don't match.
236 %************************************************************************
238 \subsection{Looking up an instance}
240 %************************************************************************
242 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
243 the env is kept ordered, the first match must be the only one. The
244 thing we are looking up can have an arbitrary "flexi" part.
247 lookupInstEnv :: InstEnv -- The envt
248 -> Class -> [Type] -- Key
251 data InstLookupResult
252 = FoundInst -- There is a (template,substitution) pair
253 -- that makes the template match the key,
254 -- and no template is an instance of the key
257 | NoMatch Bool -- Boolean is true iff there is at least one
258 -- template that matches the key.
259 -- (but there are other template(s) that are
260 -- instances of the key, so we don't report
262 -- The NoMatch True case happens when we look up
264 -- in an InstEnv that has entries for
267 -- Then which we choose would depend on the way in which 'a'
268 -- is instantiated. So we say there is no match, but identify
269 -- it as ambiguous case in the hope of giving a better error msg.
270 -- See the notes above from Jeff Lewis
272 lookupInstEnv env key_cls key_tys
273 = find (classInstEnv env key_cls)
275 key_vars = tyVarsOfTypes key_tys
277 find [] = NoMatch False
278 find ((tpl_tyvars, tpl, dfun_id) : rest)
279 = case matchTys tpl_tyvars tpl key_tys of
281 -- Check whether the things unify, so that
282 -- we bale out if a later instantiation of this
283 -- predicate might match this instance
284 -- [see notes about overlapping instances above]
285 case unifyTyListsX (key_vars `unionVarSet` tpl_tyvars) key_tys tpl of
287 Just _ -> NoMatch (any_match rest)
288 Just (subst, leftovers) -> ASSERT( null leftovers )
289 pprTrace "lookupInst" (vcat [text "look:" <+> ppr key_cls <+> ppr key_tys,
290 text "found:" <+> ppr dfun_id,
291 text "env:" <+> ppr (classInstEnv env key_cls)]) $
292 FoundInst subst dfun_id
294 any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
295 | (tvs,tpl,_) <- rest
300 %************************************************************************
302 \subsection{Extending an instance environment}
304 %************************************************************************
306 @extendInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
308 A boolean flag controls overlap reporting.
310 True => overlap is permitted, but only if one template matches the other;
311 not if they unify but neither is
314 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
315 -- Similar, but all we have is the DFuns
316 extendInstEnv dflags env dfun_ids = foldl (addToInstEnv dflags) (env, []) dfun_ids
319 addToInstEnv :: DynFlags
320 -> (InstEnv, [Message])
322 -> (InstEnv, [Message]) -- Resulting InstEnv and augmented error messages
324 addToInstEnv dflags (inst_env, errs) dfun_id
325 -- Check first that the new instance doesn't
326 -- conflict with another. See notes below about fundeps.
327 | not (null bad_fundeps)
328 = (inst_env, fundep_err : errs) -- Bad fundeps; report the first only
331 = case insert_into cls_inst_env of
332 Failed err -> (inst_env, err : errs)
333 Succeeded new_env -> (addToUFM inst_env clas new_env, errs)
336 cls_inst_env = classInstEnv inst_env clas
337 (ins_tvs, _, clas, ins_tys) = tcSplitDFunTy (idType dfun_id)
338 bad_fundeps = badFunDeps cls_inst_env clas ins_tv_set ins_tys
339 fundep_err = fundepErr dfun_id (head bad_fundeps)
341 ins_tv_set = mkVarSet ins_tvs
342 ins_item = (ins_tv_set, ins_tys, dfun_id)
344 insert_into [] = returnMaB [ins_item]
345 insert_into env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest)
346 = case unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys of
347 Just subst -> insert_unifiable env subst
348 Nothing -> carry_on cur_item rest
350 carry_on cur_item rest = insert_into rest `thenMaB` \ rest' ->
351 returnMaB (cur_item : rest')
353 -- The two templates unify. This is acceptable iff
354 -- (a) -fallow-overlapping-instances is on
355 -- (b) one is strictly more specific than the other
356 -- [It's bad if they are identical or incomparable]
357 insert_unifiable env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest) subst
358 | ins_item_more_specific && cur_item_more_specific
360 failMaB (dupInstErr dfun_id tpl_dfun_id)
362 | not (dopt Opt_AllowOverlappingInstances dflags)
363 || not (ins_item_more_specific || cur_item_more_specific)
364 = -- Overlap illegal, or the two are incomparable
365 failMaB (overlapErr dfun_id tpl_dfun_id)
368 = -- OK, it's acceptable. Remaining question is whether
369 -- we drop it here or compare it with others
370 if ins_item_more_specific then
371 -- New item is an instance of current item, so drop it here
372 returnMaB (ins_item : env)
374 carry_on cur_item rest
377 ins_item_more_specific = allVars subst ins_tvs
378 cur_item_more_specific = allVars subst (varSetElems tpl_tvs)
380 allVars :: TyVarSubstEnv -> [TyVar] -> Bool
381 -- True iff all the type vars are mapped to distinct type vars
383 = allDistinctTyVars (map lookup tvs) emptyVarSet
385 lookup tv = case lookupSubstEnv subst tv of
386 Just (DoneTy ty) -> ty
387 Nothing -> mkTyVarTy tv
390 Functional dependencies
391 ~~~~~~~~~~~~~~~~~~~~~~~
392 Here is the bad case:
393 class C a b | a->b where ...
394 instance C Int Bool where ...
395 instance C Int Char where ...
397 The point is that a->b, so Int in the first parameter must uniquely
398 determine the second. In general, given the same class decl, and given
400 instance C s1 s2 where ...
401 instance C t1 t2 where ...
403 Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
405 Matters are a little more complicated if there are free variables in
408 class D a b c | a -> b
409 instance D a b => D [(a,a)] [b] Int
410 instance D a b => D [a] [b] Bool
412 The instance decls don't overlap, because the third parameter keeps
413 them separate. But we want to make sure that given any constraint
421 badFunDeps :: ClsInstEnv -> Class
422 -> TyVarSet -> [Type] -- Proposed new instance type
424 badFunDeps cls_inst_env clas ins_tv_set ins_tys
425 = [ dfun_id | fd <- fds,
426 (tvs, tys, dfun_id) <- cls_inst_env,
427 not (null (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys))
430 (clas_tvs, fds) = classTvsFds clas
435 dupInstErr dfun1 dfun2 = addInstErr (ptext SLIT("Duplicate instance declarations:")) dfun1 dfun2
436 overlapErr dfun1 dfun2 = addInstErr (ptext SLIT("Overlapping instance declarations:")) dfun1 dfun2
437 fundepErr dfun1 dfun2 = addInstErr (ptext SLIT("Functional dependencies conflict between instance declarations:"))
440 addInstErr what dfun1 dfun2
441 = hang what 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
443 ppr_dfun dfun = ppr (getSrcLoc dfun) <> colon <+> pprClassPred clas tys
445 (_,_,clas,tys) = tcSplitDFunTy (idType dfun)