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, OverlapFlag(..),
11 Instance(..), pprInstance, pprInstanceHdr, pprInstances,
12 instanceHead, mkLocalInstance, mkImportedInstance,
13 instanceDFunId, setInstanceDFunId, instanceRoughTcs,
15 InstEnv, emptyInstEnv, extendInstEnv,
16 extendInstEnvList, lookupInstEnv, instEnvElts,
18 instanceCantMatch, roughMatchTcs
21 #include "HsVersions.h"
23 import Class ( Class )
24 import Var ( Id, TyVar, isTcTyVar )
26 import Name ( Name, NamedThing(..), getSrcLoc, nameIsLocalOrFrom, nameModule )
27 import OccName ( OccName )
28 import NameSet ( unionNameSets, unitNameSet, nameSetToList )
29 import Type ( TvSubst )
30 import TcType ( Type, PredType, tcEqType,
31 tcSplitDFunTy, tyVarsOfTypes, isExistentialTyVar,
32 pprThetaArrow, pprClassPred,
33 tyClsNamesOfType, tcSplitTyConApp_maybe
35 import TyCon ( tyConName )
36 import TcGadt ( tcUnifyTys, BindFlag(..) )
37 import Unify ( tcMatchTys )
39 import BasicTypes ( OverlapFlag(..) )
40 import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
41 import Id ( idType, idName )
42 import SrcLoc ( pprDefnLoc )
43 import Maybe ( isJust, isNothing )
47 %************************************************************************
49 \subsection{The key types}
51 %************************************************************************
56 = Instance { is_cls :: Name -- Class name
58 -- Used for "rough matching"; see note below
59 , is_tcs :: [Maybe Name] -- Top of type args
61 -- Used for "proper matching"; see note
62 , is_tvs :: TyVarSet -- Template tyvars for full match
63 , is_tys :: [Type] -- Full arg types
66 , is_flag :: OverlapFlag -- See detailed comments with
67 -- the decl of BasicTypes.OverlapFlag
69 , is_orph :: Maybe OccName }
71 -- The "rough-match" fields
72 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
73 -- The is_cls, is_args fields allow a "rough match" to be done
74 -- without poking inside the DFunId. Poking the DFunId forces
75 -- us to suck in all the type constructors etc it involves,
76 -- which is a total waste of time if it has no chance of matching
77 -- So the Name, [Maybe Name] fields allow us to say "definitely
78 -- does not match", based only on the Name.
81 -- Nothing means that this type arg is a type variable
83 -- (Just n) means that this type arg is a
84 -- TyConApp with a type constructor of n.
85 -- This is always a real tycon, never a synonym!
86 -- (Two different synonyms might match, but two
87 -- different real tycons can't.)
88 -- NB: newtypes are not transparent, though!
90 -- The "proper-match" fields
91 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
92 -- The is_tvs, is_tys fields are simply cahced values, pulled
93 -- out (lazily) from the dfun id. They are cached here simply so
94 -- that we don't need to decompose the DFunId each time we want
95 -- to match it. The hope is that the fast-match fields mean
96 -- that we often never poke th proper-match fields
98 -- However, note that:
99 -- * is_tvs must be a superset of the free vars of is_tys
101 -- * The is_dfun must itself be quantified over exactly is_tvs
102 -- (This is so that we can use the matching substitution to
103 -- instantiate the dfun's context.)
105 -- The "orphan" field
106 -- ~~~~~~~~~~~~~~~~~~
107 -- An instance is an orphan if its head (after the =>) mentions
108 -- nothing defined in this module.
110 -- Just n The head mentions n, which is defined in this module
111 -- This is used for versioning; the instance decl is
112 -- considered part of the defn of n when computing versions
114 -- Nothing The head mentions nothing defined in this module
116 -- If a module contains any orphans, then its interface file is read
117 -- regardless, so that its instances are not missed.
119 -- Functional dependencies worsen the situation a bit. Consider
120 -- class C a b | a -> b
121 -- In some other module we might have
124 -- instance C Int T where ...
125 -- This isn't considered an orphan, so we will only read M's interface
126 -- if something from M is used (e.g. T). So there's a risk we'll
127 -- miss the improvement from the instance. Workaround: import M.
129 instanceDFunId :: Instance -> DFunId
130 instanceDFunId = is_dfun
132 setInstanceDFunId :: Instance -> DFunId -> Instance
133 setInstanceDFunId ispec dfun
134 = ASSERT( idType dfun `tcEqType` idType (is_dfun ispec) )
135 -- We need to create the cached fields afresh from
136 -- the new dfun id. In particular, the is_tvs in
137 -- the Instance must match those in the dfun!
138 -- We assume that the only thing that changes is
139 -- the quantified type variables, so the other fields
140 -- are ok; hence the assert
141 ispec { is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys }
143 (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
145 instanceRoughTcs :: Instance -> [Maybe Name]
146 instanceRoughTcs = is_tcs
150 instance NamedThing Instance where
151 getName ispec = getName (is_dfun ispec)
153 instance Outputable Instance where
156 pprInstance :: Instance -> SDoc
157 -- Prints the Instance as an instance declaration
158 pprInstance ispec@(Instance { is_flag = flag })
159 = hang (pprInstanceHdr ispec)
160 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc ispec)))
162 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
163 pprInstanceHdr :: Instance -> SDoc
164 -- Prints the Instance as an instance declaration
165 pprInstanceHdr ispec@(Instance { is_flag = flag })
166 = ptext SLIT("instance") <+> ppr flag
167 <+> sep [pprThetaArrow theta, pprClassPred clas tys]
169 (_, theta, clas, tys) = instanceHead ispec
170 -- Print without the for-all, which the programmer doesn't write
172 pprInstances :: [Instance] -> SDoc
173 pprInstances ispecs = vcat (map pprInstance ispecs)
175 instanceHead :: Instance -> ([TyVar], [PredType], Class, [Type])
176 instanceHead ispec = tcSplitDFunTy (idType (is_dfun ispec))
178 mkLocalInstance :: DFunId -> OverlapFlag -> Instance
179 -- Used for local instances, where we can safely pull on the DFunId
180 mkLocalInstance dfun oflag
181 = Instance { is_flag = oflag, is_dfun = dfun,
182 is_tvs = mkVarSet tvs, is_tys = tys,
183 is_cls = cls_name, is_tcs = roughMatchTcs tys,
186 (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
187 mod = nameModule (idName dfun)
188 cls_name = getName cls
189 tycl_names = foldr (unionNameSets . tyClsNamesOfType)
190 (unitNameSet cls_name) tys
191 orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
193 (n:ns) -> Just (getOccName n)
195 mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
196 -> DFunId -> OverlapFlag -> Instance
197 -- Used for imported instances, where we get the rough-match stuff
198 -- from the interface file
199 mkImportedInstance cls mb_tcs orph dfun oflag
200 = Instance { is_flag = oflag, is_dfun = dfun,
201 is_tvs = mkVarSet tvs, is_tys = tys,
202 is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
204 (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
206 roughMatchTcs :: [Type] -> [Maybe Name]
207 roughMatchTcs tys = map rough tys
209 rough ty = case tcSplitTyConApp_maybe ty of
210 Just (tc,_) -> Just (tyConName tc)
213 instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
214 -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
215 -- possibly be instantiated to actual, nor vice versa;
216 -- False is non-committal
217 instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
218 instanceCantMatch ts as = False -- Safe
222 Note [Overlapping instances]
223 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
224 Overlap is permitted, but only in such a way that one can make
225 a unique choice when looking up. That is, overlap is only permitted if
226 one template matches the other, or vice versa. So this is ok:
234 If overlap is permitted, the list is kept most specific first, so that
235 the first lookup is the right choice.
238 For now we just use association lists.
240 \subsection{Avoiding a problem with overlapping}
242 Consider this little program:
245 class C a where c :: a
246 class C a => D a where d :: a
248 instance C Int where c = 17
249 instance D Int where d = 13
251 instance C a => C [a] where c = [c]
252 instance ({- C [a], -} D a) => D [a] where d = c
254 instance C [Int] where c = [37]
256 main = print (d :: [Int])
259 What do you think `main' prints (assuming we have overlapping instances, and
260 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
261 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
262 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
263 the `C [Int]' instance is more specific).
265 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
266 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
267 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
268 doesn't even compile! What's going on!?
270 What hugs complains about is the `D [a]' instance decl.
273 ERROR "mj.hs" (line 10): Cannot build superclass instance
275 *** Context supplied : D a
276 *** Required superclass : C [a]
279 You might wonder what hugs is complaining about. It's saying that you
280 need to add `C [a]' to the context of the `D [a]' instance (as appears
281 in comments). But there's that `C [a]' instance decl one line above
282 that says that I can reduce the need for a `C [a]' instance to the
283 need for a `C a' instance, and in this case, I already have the
284 necessary `C a' instance (since we have `D a' explicitly in the
285 context, and `C' is a superclass of `D').
287 Unfortunately, the above reasoning indicates a premature commitment to the
288 generic `C [a]' instance. I.e., it prematurely rules out the more specific
289 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
290 add the context that hugs suggests (uncomment the `C [a]'), effectively
291 deferring the decision about which instance to use.
293 Now, interestingly enough, 4.04 has this same bug, but it's covered up
294 in this case by a little known `optimization' that was disabled in
295 4.06. Ghc-4.04 silently inserts any missing superclass context into
296 an instance declaration. In this case, it silently inserts the `C
297 [a]', and everything happens to work out.
299 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
300 `Mark Jones', although Mark claims no credit for the `optimization' in
301 question, and would rather it stopped being called the `Mark Jones
304 So, what's the fix? I think hugs has it right. Here's why. Let's try
305 something else out with ghc-4.04. Let's add the following line:
310 Everyone raise their hand who thinks that `d :: [Int]' should give a
311 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
312 `optimization' only applies to instance decls, not to regular
313 bindings, giving inconsistent behavior.
315 Old hugs had this same bug. Here's how we fixed it: like GHC, the
316 list of instances for a given class is ordered, so that more specific
317 instances come before more generic ones. For example, the instance
318 list for C might contain:
319 ..., C Int, ..., C a, ...
320 When we go to look for a `C Int' instance we'll get that one first.
321 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
322 pass the `C Int' instance, and keep going. But if `b' is
323 unconstrained, then we don't know yet if the more specific instance
324 will eventually apply. GHC keeps going, and matches on the generic `C
325 a'. The fix is to, at each step, check to see if there's a reverse
326 match, and if so, abort the search. This prevents hugs from
327 prematurely chosing a generic instance when a more specific one
332 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
333 this test. Suppose the instance envt had
334 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
335 (still most specific first)
336 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
337 C x y Int doesn't match the template {a,b} C a a b
339 C a a b match the template {x,y} C x y Int
340 But still x and y might subsequently be unified so they *do* match.
342 Simple story: unify, don't match.
345 %************************************************************************
349 %************************************************************************
351 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
352 ClsInstEnv mapping is the dfun for that instance.
354 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
356 forall a b, C t1 t2 t3 can be constructed by dfun
358 or, to put it another way, we have
360 instance (...) => C t1 t2 t3, witnessed by dfun
363 ---------------------------------------------------
364 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
367 = ClsIE [Instance] -- The instances for a particular class, in any order
368 Bool -- True <=> there is an instance of form C a b c
369 -- If *not* then the common case of looking up
370 -- (C a b c) can fail immediately
373 -- * The is_tvs are distinct in each Instance
374 -- of a ClsInstEnv (so we can safely unify them)
376 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
377 -- [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
378 -- The "a" in the pattern must be one of the forall'd variables in
381 emptyInstEnv :: InstEnv
382 emptyInstEnv = emptyUFM
384 instEnvElts :: InstEnv -> [Instance]
385 instEnvElts ie = [elt | ClsIE elts _ <- eltsUFM ie, elt <- elts]
387 classInstances :: (InstEnv,InstEnv) -> Class -> [Instance]
388 classInstances (pkg_ie, home_ie) cls
389 = get home_ie ++ get pkg_ie
391 get env = case lookupUFM env cls of
392 Just (ClsIE insts _) -> insts
395 extendInstEnvList :: InstEnv -> [Instance] -> InstEnv
396 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
398 extendInstEnv :: InstEnv -> Instance -> InstEnv
399 extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tcs = mb_tcs })
400 = addToUFM_C add inst_env cls_nm (ClsIE [ins_item] ins_tyvar)
402 add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts)
403 (ins_tyvar || cur_tyvar)
404 ins_tyvar = not (any isJust mb_tcs)
408 %************************************************************************
410 \subsection{Looking up an instance}
412 %************************************************************************
414 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
415 the env is kept ordered, the first match must be the only one. The
416 thing we are looking up can have an arbitrary "flexi" part.
419 lookupInstEnv :: (InstEnv -- External package inst-env
420 ,InstEnv) -- Home-package inst-env
421 -> Class -> [Type] -- What we are looking for
422 -> ([(TvSubst, Instance)], -- Successful matches
423 [Instance]) -- These don't match but do unify
424 -- The second component of the tuple happens when we look up
426 -- in an InstEnv that has entries for
429 -- Then which we choose would depend on the way in which 'a'
430 -- is instantiated. So we report that Foo [b] is a match (mapping b->a)
431 -- but Foo [Int] is a unifier. This gives the caller a better chance of
432 -- giving a suitable error messagen
434 lookupInstEnv (pkg_ie, home_ie) cls tys
435 = (pruned_matches, all_unifs)
437 rough_tcs = roughMatchTcs tys
438 all_tvs = all isNothing rough_tcs
439 (home_matches, home_unifs) = lookup home_ie
440 (pkg_matches, pkg_unifs) = lookup pkg_ie
441 all_matches = home_matches ++ pkg_matches
442 all_unifs = home_unifs ++ pkg_unifs
444 | null all_unifs = foldr insert_overlapping [] all_matches
445 | otherwise = all_matches -- Non-empty unifs is always an error situation,
446 -- so don't attempt to pune the matches
449 lookup env = case lookupUFM env cls of
450 Nothing -> ([],[]) -- No instances for this class
451 Just (ClsIE insts has_tv_insts)
452 | all_tvs && not has_tv_insts
453 -> ([],[]) -- Short cut for common case
454 -- The thing we are looking up is of form (C a b c), and
455 -- the ClsIE has no instances of that form, so don't bother to search
461 find ms us [] = (ms, us)
462 find ms us (item@(Instance { is_tcs = mb_tcs, is_tvs = tpl_tvs,
463 is_tys = tpl_tys, is_flag = oflag,
464 is_dfun = dfun }) : rest)
465 -- Fast check for no match, uses the "rough match" fields
466 | instanceCantMatch rough_tcs mb_tcs
469 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
470 = find ((subst,item):ms) us rest
472 -- Does not match, so next check whether the things unify
473 -- See Note [overlapping instances] above
474 | Incoherent <- oflag
478 = ASSERT2( not (tyVarsOfTypes tys `intersectsVarSet` tpl_tvs),
479 (ppr cls <+> ppr tys <+> ppr all_tvs) $$
480 (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
482 -- Unification will break badly if the variables overlap
483 -- They shouldn't because we allocate separate uniques for them
484 case tcUnifyTys bind_fn tpl_tys tys of
485 Just _ -> find ms (item:us) rest
486 Nothing -> find ms us rest
489 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
491 -- The key_tys can contain skolem constants, and we can guarantee that those
492 -- are never going to be instantiated to anything, so we should not involve
493 -- them in the unification test. Example:
494 -- class Foo a where { op :: a -> Int }
495 -- instance Foo a => Foo [a] -- NB overlap
496 -- instance Foo [Int] -- NB overlap
497 -- data T = forall a. Foo a => MkT a
499 -- f (MkT x) = op [x,x]
500 -- The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
501 -- complain, saying that the choice of instance depended on the instantiation
502 -- of 'a'; but of course it isn't *going* to be instantiated.
504 -- We do this only for pattern-bound skolems. For example we reject
505 -- g :: forall a => [a] -> Int
507 -- on the grounds that the correct instance depends on the instantiation of 'a'
510 insert_overlapping :: (TvSubst, Instance) -> [(TvSubst, Instance)]
511 -> [(TvSubst, Instance)]
512 -- Add a new solution, knocking out strictly less specific ones
513 insert_overlapping new_item [] = [new_item]
514 insert_overlapping new_item (item:items)
515 | new_beats_old && old_beats_new = item : insert_overlapping new_item items
516 -- Duplicate => keep both for error report
517 | new_beats_old = insert_overlapping new_item items
519 | old_beats_new = item : items
521 | otherwise = item : insert_overlapping new_item items
524 new_beats_old = new_item `beats` item
525 old_beats_new = item `beats` new_item
527 (_, instA) `beats` (_, instB)
529 isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
530 -- A beats B if A is more specific than B, and B admits overlap
531 -- I.e. if B can be instantiated to match A
533 overlap_ok = case is_flag instB of