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, nameModule )
25 import SrcLoc ( SrcLoc, isGoodSrcLoc )
26 import TcType ( Type, tcTyConAppTyCon, mkTyVarTy,
27 tcSplitDFunTy, tyVarsOfTypes,
28 matchTys, unifyTyListsX, allDistinctTyVars
30 import PprType ( pprClassPred )
31 import FunDeps ( checkClsFD )
32 import TyCon ( TyCon )
34 import UniqFM ( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM, eltsUFM )
35 import Id ( idType, idName )
36 import ErrUtils ( Message )
38 import Util ( notNull )
42 %************************************************************************
44 \subsection{The key types}
46 %************************************************************************
51 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
53 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
54 simpleDFunClassTyCon dfun
57 (_,_,clas,[ty]) = tcSplitDFunTy (idType dfun)
58 tycon = tcTyConAppTyCon ty
60 pprInstEnv :: InstEnv -> SDoc
62 = vcat [ brackets (pprWithCommas ppr (varSetElems tyvars)) <+>
63 brackets (pprWithCommas ppr tys) <+> ppr dfun
64 | cls_inst_env <- eltsUFM env
65 , (tyvars, tys, dfun) <- cls_inst_env
69 %************************************************************************
71 \subsection{Instance environments: InstEnv and ClsInstEnv}
73 %************************************************************************
76 type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
77 -- INVARIANTs: see notes below
79 emptyInstEnv :: InstEnv
80 emptyInstEnv = emptyUFM
82 classInstEnv :: InstEnv -> Class -> ClsInstEnv
83 classInstEnv env cls = lookupWithDefaultUFM env [] cls
86 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
87 ClsInstEnv mapping is the dfun for that instance.
89 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
91 forall a b, C t1 t2 t3 can be constructed by dfun
93 or, to put it another way, we have
95 instance (...) => C t1 t2 t3, witnessed by dfun
97 There is an important consistency constraint in the elements of a ClsInstEnv:
99 * [a,b] must be a superset of the free vars of [t1,t2,t3]
101 * The dfun must itself be quantified over [a,b]
103 * More specific instances come before less specific ones,
106 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
107 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
108 The "a" in the pattern must be one of the forall'd variables in
113 Notes on overlapping instances
114 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
115 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
117 In others, overlap is permitted, but only in such a way that one can make
118 a unique choice when looking up. That is, overlap is only permitted if
119 one template matches the other, or vice versa. So this is ok:
127 If overlap is permitted, the list is kept most specific first, so that
128 the first lookup is the right choice.
131 For now we just use association lists.
133 \subsection{Avoiding a problem with overlapping}
135 Consider this little program:
138 class C a where c :: a
139 class C a => D a where d :: a
141 instance C Int where c = 17
142 instance D Int where d = 13
144 instance C a => C [a] where c = [c]
145 instance ({- C [a], -} D a) => D [a] where d = c
147 instance C [Int] where c = [37]
149 main = print (d :: [Int])
152 What do you think `main' prints (assuming we have overlapping instances, and
153 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
154 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
155 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
156 the `C [Int]' instance is more specific).
158 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
159 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
160 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
161 doesn't even compile! What's going on!?
163 What hugs complains about is the `D [a]' instance decl.
166 ERROR "mj.hs" (line 10): Cannot build superclass instance
168 *** Context supplied : D a
169 *** Required superclass : C [a]
172 You might wonder what hugs is complaining about. It's saying that you
173 need to add `C [a]' to the context of the `D [a]' instance (as appears
174 in comments). But there's that `C [a]' instance decl one line above
175 that says that I can reduce the need for a `C [a]' instance to the
176 need for a `C a' instance, and in this case, I already have the
177 necessary `C a' instance (since we have `D a' explicitly in the
178 context, and `C' is a superclass of `D').
180 Unfortunately, the above reasoning indicates a premature commitment to the
181 generic `C [a]' instance. I.e., it prematurely rules out the more specific
182 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
183 add the context that hugs suggests (uncomment the `C [a]'), effectively
184 deferring the decision about which instance to use.
186 Now, interestingly enough, 4.04 has this same bug, but it's covered up
187 in this case by a little known `optimization' that was disabled in
188 4.06. Ghc-4.04 silently inserts any missing superclass context into
189 an instance declaration. In this case, it silently inserts the `C
190 [a]', and everything happens to work out.
192 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
193 `Mark Jones', although Mark claims no credit for the `optimization' in
194 question, and would rather it stopped being called the `Mark Jones
197 So, what's the fix? I think hugs has it right. Here's why. Let's try
198 something else out with ghc-4.04. Let's add the following line:
203 Everyone raise their hand who thinks that `d :: [Int]' should give a
204 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
205 `optimization' only applies to instance decls, not to regular
206 bindings, giving inconsistent behavior.
208 Old hugs had this same bug. Here's how we fixed it: like GHC, the
209 list of instances for a given class is ordered, so that more specific
210 instances come before more generic ones. For example, the instance
211 list for C might contain:
212 ..., C Int, ..., C a, ...
213 When we go to look for a `C Int' instance we'll get that one first.
214 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
215 pass the `C Int' instance, and keep going. But if `b' is
216 unconstrained, then we don't know yet if the more specific instance
217 will eventually apply. GHC keeps going, and matches on the generic `C
218 a'. The fix is to, at each step, check to see if there's a reverse
219 match, and if so, abort the search. This prevents hugs from
220 prematurely chosing a generic instance when a more specific one
225 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
226 this test. Suppose the instance envt had
227 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
228 (still most specific first)
229 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
230 C x y Int doesn't match the template {a,b} C a a b
232 C a a b match the template {x,y} C x y Int
233 But still x and y might subsequently be unified so they *do* match.
235 Simple story: unify, don't match.
238 %************************************************************************
240 \subsection{Looking up an instance}
242 %************************************************************************
244 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
245 the env is kept ordered, the first match must be the only one. The
246 thing we are looking up can have an arbitrary "flexi" part.
249 lookupInstEnv :: DynFlags
250 -> InstEnv -- The envt
251 -> Class -> [Type] -- What we are looking for
254 data InstLookupResult
255 = FoundInst -- There is a (template,substitution) pair
256 -- that makes the template match the key,
257 -- and no template is an instance of the key
260 | NoMatch Bool -- Boolean is true iff there is at least one
261 -- template that matches the key.
262 -- (but there are other template(s) that are
263 -- instances of the key, so we don't report
265 -- The NoMatch True case happens when we look up
267 -- in an InstEnv that has entries for
270 -- Then which we choose would depend on the way in which 'a'
271 -- is instantiated. So we say there is no match, but identify
272 -- it as ambiguous case in the hope of giving a better error msg.
273 -- See the notes above from Jeff Lewis
275 lookupInstEnv dflags env key_cls key_tys
276 = find (classInstEnv env key_cls)
278 key_vars = tyVarsOfTypes key_tys
280 find [] = NoMatch False
281 find ((tpl_tyvars, tpl, dfun_id) : rest)
282 = case matchTys tpl_tyvars tpl key_tys of
284 -- Check whether the things unify, so that
285 -- we bale out if a later instantiation of this
286 -- predicate might match this instance
287 -- [see notes about overlapping instances above]
288 case unifyTyListsX (key_vars `unionVarSet` tpl_tyvars) key_tys tpl of
289 Just _ | not (dopt Opt_AllowIncoherentInstances dflags)
290 -> NoMatch (any_match rest)
291 -- If we allow incoherent instances we don't worry about the
292 -- test and just blaze on anyhow. Requested by John Hughes.
295 Just (subst, leftovers) -> ASSERT( null leftovers )
296 FoundInst subst dfun_id
298 any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
299 | (tvs,tpl,_) <- rest
304 %************************************************************************
306 \subsection{Extending an instance environment}
308 %************************************************************************
310 @extendInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
312 A boolean flag controls overlap reporting.
314 True => overlap is permitted, but only if one template matches the other;
315 not if they unify but neither is
318 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [(SrcLoc,Message)])
319 -- Similar, but all we have is the DFuns
320 extendInstEnv dflags env dfun_ids = foldl (addToInstEnv dflags) (env, []) dfun_ids
323 addToInstEnv :: DynFlags
324 -> (InstEnv, [(SrcLoc,Message)])
326 -> (InstEnv, [(SrcLoc,Message)]) -- Resulting InstEnv and augmented error messages
328 addToInstEnv dflags (inst_env, errs) dfun_id
329 -- Check first that the new instance doesn't
330 -- conflict with another. See notes below about fundeps.
331 | notNull bad_fundeps
332 = (inst_env, fundep_err : errs) -- Bad fundeps; report the first only
335 = case insert_into cls_inst_env of
336 Failed err -> (inst_env, err : errs)
337 Succeeded new_env -> (addToUFM inst_env clas new_env, errs)
340 cls_inst_env = classInstEnv inst_env clas
341 (ins_tvs, _, clas, ins_tys) = tcSplitDFunTy (idType dfun_id)
342 bad_fundeps = badFunDeps cls_inst_env clas ins_tv_set ins_tys
343 fundep_err = fundepErr dfun_id (head bad_fundeps)
345 ins_tv_set = mkVarSet ins_tvs
346 ins_item = (ins_tv_set, ins_tys, dfun_id)
348 insert_into [] = returnMaB [ins_item]
349 insert_into env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest)
350 = case unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys of
351 Just subst -> insert_unifiable env subst
352 Nothing -> carry_on cur_item rest
354 carry_on cur_item rest = insert_into rest `thenMaB` \ rest' ->
355 returnMaB (cur_item : rest')
357 -- The two templates unify. This is acceptable iff
358 -- (a) -fallow-overlapping-instances is on
359 -- (b) one is strictly more specific than the other
360 -- [It's bad if they are identical or incomparable]
361 insert_unifiable env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest) subst
362 | ins_item_more_specific && cur_item_more_specific
364 failMaB (dupInstErr dfun_id tpl_dfun_id)
366 | not (dopt Opt_AllowOverlappingInstances dflags)
367 || not (ins_item_more_specific || cur_item_more_specific)
368 = -- Overlap illegal, or the two are incomparable
369 failMaB (overlapErr dfun_id tpl_dfun_id)
372 = -- OK, it's acceptable. Remaining question is whether
373 -- we drop it here or compare it with others
374 if ins_item_more_specific then
375 -- New item is an instance of current item, so drop it here
376 returnMaB (ins_item : env)
378 carry_on cur_item rest
381 ins_item_more_specific = allVars subst ins_tvs
382 cur_item_more_specific = allVars subst (varSetElems tpl_tvs)
384 allVars :: TyVarSubstEnv -> [TyVar] -> Bool
385 -- True iff all the type vars are mapped to distinct type vars
387 = allDistinctTyVars (map lookup tvs) emptyVarSet
389 lookup tv = case lookupSubstEnv subst tv of
390 Just (DoneTy ty) -> ty
391 Nothing -> mkTyVarTy tv
394 Functional dependencies
395 ~~~~~~~~~~~~~~~~~~~~~~~
396 Here is the bad case:
397 class C a b | a->b where ...
398 instance C Int Bool where ...
399 instance C Int Char where ...
401 The point is that a->b, so Int in the first parameter must uniquely
402 determine the second. In general, given the same class decl, and given
404 instance C s1 s2 where ...
405 instance C t1 t2 where ...
407 Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
409 Matters are a little more complicated if there are free variables in
412 class D a b c | a -> b
413 instance D a b => D [(a,a)] [b] Int
414 instance D a b => D [a] [b] Bool
416 The instance decls don't overlap, because the third parameter keeps
417 them separate. But we want to make sure that given any constraint
425 badFunDeps :: ClsInstEnv -> Class
426 -> TyVarSet -> [Type] -- Proposed new instance type
428 badFunDeps cls_inst_env clas ins_tv_set ins_tys
429 = [ dfun_id | fd <- fds,
430 (tvs, tys, dfun_id) <- cls_inst_env,
431 notNull (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys)
434 (clas_tvs, fds) = classTvsFds clas
439 dupInstErr dfun1 dfun2 = addInstErr (ptext SLIT("Duplicate instance declarations:")) dfun1 dfun2
440 overlapErr dfun1 dfun2 = addInstErr (ptext SLIT("Overlapping instance declarations:")) dfun1 dfun2
441 fundepErr dfun1 dfun2 = addInstErr (ptext SLIT("Functional dependencies conflict between instance declarations:"))
444 addInstErr :: SDoc -> DFunId -> DFunId -> (SrcLoc, Message)
445 addInstErr what dfun1 dfun2
446 = (getSrcLoc dfun1, hang what 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2))
449 ppr_dfun dfun = pp_loc <> colon <+> pprClassPred clas tys
451 (_,_,clas,tys) = tcSplitDFunTy (idType dfun)
453 mod = nameModule (idName dfun)
455 -- Worth trying to print a good location... imported dfuns
456 -- don't have a useful SrcLoc but we can say which module they come from
457 pp_loc | isGoodSrcLoc loc = ppr loc
458 | otherwise = ptext SLIT("In module") <+> ppr mod