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 Unify ( tcMatchTys, tcUnifyTys, BindFlag(..) )
38 import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
39 import Id ( idType, idName )
40 import SrcLoc ( pprDefnLoc )
41 import Maybe ( isJust, isNothing )
45 %************************************************************************
47 \subsection{The key types}
49 %************************************************************************
54 = Instance { is_cls :: Name -- Class name
56 -- Used for "rough matching"; see note below
57 , is_tcs :: [Maybe Name] -- Top of type args
59 -- Used for "proper matching"; see note
60 , is_tvs :: TyVarSet -- Template tyvars for full match
61 , is_tys :: [Type] -- Full arg types
64 , is_flag :: OverlapFlag
66 , is_orph :: Maybe OccName }
68 -- The "rough-match" fields
69 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
70 -- The is_cls, is_args fields allow a "rough match" to be done
71 -- without poking inside the DFunId. Poking the DFunId forces
72 -- us to suck in all the type constructors etc it involves,
73 -- which is a total waste of time if it has no chance of matching
74 -- So the Name, [Maybe Name] fields allow us to say "definitely
75 -- does not match", based only on the Name.
78 -- Nothing means that this type arg is a type variable
80 -- (Just n) means that this type arg is a
81 -- TyConApp with a type constructor of n.
82 -- This is always a real tycon, never a synonym!
83 -- (Two different synonyms might match, but two
84 -- different real tycons can't.)
85 -- NB: newtypes are not transparent, though!
87 -- The "proper-match" fields
88 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
89 -- The is_tvs, is_tys fields are simply cahced values, pulled
90 -- out (lazily) from the dfun id. They are cached here simply so
91 -- that we don't need to decompose the DFunId each time we want
92 -- to match it. The hope is that the fast-match fields mean
93 -- that we often never poke th proper-match fields
95 -- However, note that:
96 -- * is_tvs must be a superset of the free vars of is_tys
98 -- * The is_dfun must itself be quantified over exactly is_tvs
99 -- (This is so that we can use the matching substitution to
100 -- instantiate the dfun's context.)
102 -- The "orphan" field
103 -- ~~~~~~~~~~~~~~~~~~
104 -- An instance is an orphan if its head (after the =>) mentions
105 -- nothing defined in this module.
107 -- Just n The head mentions n, which is defined in this module
108 -- This is used for versioning; the instance decl is
109 -- considered part of the defn of n when computing versions
111 -- Nothing The head mentions nothing defined in this module
113 -- If a module contains any orphans, then its interface file is read
114 -- regardless, so that its instances are not missed.
116 -- Functional dependencies worsen the situation a bit. Consider
117 -- class C a b | a -> b
118 -- In some other module we might have
121 -- instance C Int T where ...
122 -- This isn't considered an orphan, so we will only read M's interface
123 -- if something from M is used (e.g. T). So there's a risk we'll
124 -- miss the improvement from the instance. Workaround: import M.
126 instanceDFunId :: Instance -> DFunId
127 instanceDFunId = is_dfun
129 setInstanceDFunId :: Instance -> DFunId -> Instance
130 setInstanceDFunId ispec dfun
131 = ASSERT( idType dfun `tcEqType` idType (is_dfun ispec) )
132 -- We need to create the cached fields afresh from
133 -- the new dfun id. In particular, the is_tvs in
134 -- the Instance must match those in the dfun!
135 -- We assume that the only thing that changes is
136 -- the quantified type variables, so the other fields
137 -- are ok; hence the assert
138 ispec { is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys }
140 (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
142 instanceRoughTcs :: Instance -> [Maybe Name]
143 instanceRoughTcs = is_tcs
147 instance NamedThing Instance where
148 getName ispec = getName (is_dfun ispec)
150 instance Outputable Instance where
153 pprInstance :: Instance -> SDoc
154 -- Prints the Instance as an instance declaration
155 pprInstance ispec@(Instance { is_flag = flag })
156 = hang (pprInstanceHdr ispec)
157 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc ispec)))
159 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
160 pprInstanceHdr :: Instance -> SDoc
161 -- Prints the Instance as an instance declaration
162 pprInstanceHdr ispec@(Instance { is_flag = flag })
163 = ptext SLIT("instance") <+> ppr flag
164 <+> sep [pprThetaArrow theta, pprClassPred clas tys]
166 (_, theta, clas, tys) = instanceHead ispec
167 -- Print without the for-all, which the programmer doesn't write
169 pprInstances :: [Instance] -> SDoc
170 pprInstances ispecs = vcat (map pprInstance ispecs)
172 instanceHead :: Instance -> ([TyVar], [PredType], Class, [Type])
173 instanceHead ispec = tcSplitDFunTy (idType (is_dfun ispec))
175 mkLocalInstance :: DFunId -> OverlapFlag -> Instance
176 -- Used for local instances, where we can safely pull on the DFunId
177 mkLocalInstance dfun oflag
178 = Instance { is_flag = oflag, is_dfun = dfun,
179 is_tvs = mkVarSet tvs, is_tys = tys,
180 is_cls = cls_name, is_tcs = roughMatchTcs tys,
183 (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
184 mod = nameModule (idName dfun)
185 cls_name = getName cls
186 tycl_names = foldr (unionNameSets . tyClsNamesOfType)
187 (unitNameSet cls_name) tys
188 orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
190 (n:ns) -> Just (getOccName n)
192 mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
193 -> DFunId -> OverlapFlag -> Instance
194 -- Used for imported instances, where we get the rough-match stuff
195 -- from the interface file
196 mkImportedInstance cls mb_tcs orph dfun oflag
197 = Instance { is_flag = oflag, is_dfun = dfun,
198 is_tvs = mkVarSet tvs, is_tys = tys,
199 is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
201 (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
203 roughMatchTcs :: [Type] -> [Maybe Name]
204 roughMatchTcs tys = map rough tys
206 rough ty = case tcSplitTyConApp_maybe ty of
207 Just (tc,_) -> Just (tyConName tc)
210 instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
211 -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
212 -- possibly be instantiated to actual, nor vice versa;
213 -- False is non-committal
214 instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
215 instanceCantMatch ts as = False -- Safe
217 ---------------------------------------------------
219 = NoOverlap -- This instance must not overlap another
221 | OverlapOk -- Silently ignore this instance if you find a
222 -- more specific one that matches the constraint
223 -- you are trying to resolve
225 -- Example: constraint (Foo [Int])
226 -- instances (Foo [Int])
227 -- (Foo [a]) OverlapOk
228 -- Since the second instance has the OverlapOk flag,
229 -- the first instance will be chosen (otherwise
230 -- its ambiguous which to choose)
232 | Incoherent -- Like OverlapOk, but also ignore this instance
233 -- if it doesn't match the constraint you are
234 -- trying to resolve, but could match if the type variables
235 -- in the constraint were instantiated
237 -- Example: constraint (Foo [b])
238 -- instances (Foo [Int]) Incoherent
240 -- Without the Incoherent flag, we'd complain that
241 -- instantiating 'b' would change which instance
245 instance Outputable OverlapFlag where
246 ppr NoOverlap = empty
247 ppr OverlapOk = ptext SLIT("[overlap ok]")
248 ppr Incoherent = ptext SLIT("[incoherent]")
252 Note [Overlapping instances]
253 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
254 Overlap is permitted, but only in such a way that one can make
255 a unique choice when looking up. That is, overlap is only permitted if
256 one template matches the other, or vice versa. So this is ok:
264 If overlap is permitted, the list is kept most specific first, so that
265 the first lookup is the right choice.
268 For now we just use association lists.
270 \subsection{Avoiding a problem with overlapping}
272 Consider this little program:
275 class C a where c :: a
276 class C a => D a where d :: a
278 instance C Int where c = 17
279 instance D Int where d = 13
281 instance C a => C [a] where c = [c]
282 instance ({- C [a], -} D a) => D [a] where d = c
284 instance C [Int] where c = [37]
286 main = print (d :: [Int])
289 What do you think `main' prints (assuming we have overlapping instances, and
290 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
291 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
292 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
293 the `C [Int]' instance is more specific).
295 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
296 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
297 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
298 doesn't even compile! What's going on!?
300 What hugs complains about is the `D [a]' instance decl.
303 ERROR "mj.hs" (line 10): Cannot build superclass instance
305 *** Context supplied : D a
306 *** Required superclass : C [a]
309 You might wonder what hugs is complaining about. It's saying that you
310 need to add `C [a]' to the context of the `D [a]' instance (as appears
311 in comments). But there's that `C [a]' instance decl one line above
312 that says that I can reduce the need for a `C [a]' instance to the
313 need for a `C a' instance, and in this case, I already have the
314 necessary `C a' instance (since we have `D a' explicitly in the
315 context, and `C' is a superclass of `D').
317 Unfortunately, the above reasoning indicates a premature commitment to the
318 generic `C [a]' instance. I.e., it prematurely rules out the more specific
319 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
320 add the context that hugs suggests (uncomment the `C [a]'), effectively
321 deferring the decision about which instance to use.
323 Now, interestingly enough, 4.04 has this same bug, but it's covered up
324 in this case by a little known `optimization' that was disabled in
325 4.06. Ghc-4.04 silently inserts any missing superclass context into
326 an instance declaration. In this case, it silently inserts the `C
327 [a]', and everything happens to work out.
329 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
330 `Mark Jones', although Mark claims no credit for the `optimization' in
331 question, and would rather it stopped being called the `Mark Jones
334 So, what's the fix? I think hugs has it right. Here's why. Let's try
335 something else out with ghc-4.04. Let's add the following line:
340 Everyone raise their hand who thinks that `d :: [Int]' should give a
341 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
342 `optimization' only applies to instance decls, not to regular
343 bindings, giving inconsistent behavior.
345 Old hugs had this same bug. Here's how we fixed it: like GHC, the
346 list of instances for a given class is ordered, so that more specific
347 instances come before more generic ones. For example, the instance
348 list for C might contain:
349 ..., C Int, ..., C a, ...
350 When we go to look for a `C Int' instance we'll get that one first.
351 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
352 pass the `C Int' instance, and keep going. But if `b' is
353 unconstrained, then we don't know yet if the more specific instance
354 will eventually apply. GHC keeps going, and matches on the generic `C
355 a'. The fix is to, at each step, check to see if there's a reverse
356 match, and if so, abort the search. This prevents hugs from
357 prematurely chosing a generic instance when a more specific one
362 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
363 this test. Suppose the instance envt had
364 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
365 (still most specific first)
366 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
367 C x y Int doesn't match the template {a,b} C a a b
369 C a a b match the template {x,y} C x y Int
370 But still x and y might subsequently be unified so they *do* match.
372 Simple story: unify, don't match.
375 %************************************************************************
379 %************************************************************************
381 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
382 ClsInstEnv mapping is the dfun for that instance.
384 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
386 forall a b, C t1 t2 t3 can be constructed by dfun
388 or, to put it another way, we have
390 instance (...) => C t1 t2 t3, witnessed by dfun
393 ---------------------------------------------------
394 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
397 = ClsIE [Instance] -- The instances for a particular class, in any order
398 Bool -- True <=> there is an instance of form C a b c
399 -- If *not* then the common case of looking up
400 -- (C a b c) can fail immediately
403 -- * The is_tvs are distinct in each Instance
404 -- of a ClsInstEnv (so we can safely unify them)
406 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
407 -- [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
408 -- The "a" in the pattern must be one of the forall'd variables in
411 emptyInstEnv :: InstEnv
412 emptyInstEnv = emptyUFM
414 instEnvElts :: InstEnv -> [Instance]
415 instEnvElts ie = [elt | ClsIE elts _ <- eltsUFM ie, elt <- elts]
417 classInstances :: (InstEnv,InstEnv) -> Class -> [Instance]
418 classInstances (pkg_ie, home_ie) cls
419 = get home_ie ++ get pkg_ie
421 get env = case lookupUFM env cls of
422 Just (ClsIE insts _) -> insts
425 extendInstEnvList :: InstEnv -> [Instance] -> InstEnv
426 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
428 extendInstEnv :: InstEnv -> Instance -> InstEnv
429 extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tcs = mb_tcs })
430 = addToUFM_C add inst_env cls_nm (ClsIE [ins_item] ins_tyvar)
432 add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts)
433 (ins_tyvar || cur_tyvar)
434 ins_tyvar = not (any isJust mb_tcs)
438 %************************************************************************
440 \subsection{Looking up an instance}
442 %************************************************************************
444 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
445 the env is kept ordered, the first match must be the only one. The
446 thing we are looking up can have an arbitrary "flexi" part.
449 lookupInstEnv :: (InstEnv -- External package inst-env
450 ,InstEnv) -- Home-package inst-env
451 -> Class -> [Type] -- What we are looking for
452 -> ([(TvSubst, Instance)], -- Successful matches
453 [Instance]) -- These don't match but do unify
454 -- The second component of the tuple happens when we look up
456 -- in an InstEnv that has entries for
459 -- Then which we choose would depend on the way in which 'a'
460 -- is instantiated. So we report that Foo [b] is a match (mapping b->a)
461 -- but Foo [Int] is a unifier. This gives the caller a better chance of
462 -- giving a suitable error messagen
464 lookupInstEnv (pkg_ie, home_ie) cls tys
465 = (pruned_matches, all_unifs)
467 rough_tcs = roughMatchTcs tys
468 all_tvs = all isNothing rough_tcs
469 (home_matches, home_unifs) = lookup home_ie
470 (pkg_matches, pkg_unifs) = lookup pkg_ie
471 all_matches = home_matches ++ pkg_matches
472 all_unifs = home_unifs ++ pkg_unifs
474 | null all_unifs = foldr insert_overlapping [] all_matches
475 | otherwise = all_matches -- Non-empty unifs is always an error situation,
476 -- so don't attempt to pune the matches
479 lookup env = case lookupUFM env cls of
480 Nothing -> ([],[]) -- No instances for this class
481 Just (ClsIE insts has_tv_insts)
482 | all_tvs && not has_tv_insts
483 -> ([],[]) -- Short cut for common case
484 -- The thing we are looking up is of form (C a b c), and
485 -- the ClsIE has no instances of that form, so don't bother to search
491 find ms us [] = (ms, us)
492 find ms us (item@(Instance { is_tcs = mb_tcs, is_tvs = tpl_tvs,
493 is_tys = tpl_tys, is_flag = oflag,
494 is_dfun = dfun }) : rest)
495 -- Fast check for no match, uses the "rough match" fields
496 | instanceCantMatch rough_tcs mb_tcs
499 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
500 = find ((subst,item):ms) us rest
502 -- Does not match, so next check whether the things unify
503 -- See Note [overlapping instances] above
504 | Incoherent <- oflag
508 = ASSERT2( not (tyVarsOfTypes tys `intersectsVarSet` tpl_tvs),
509 (ppr cls <+> ppr tys <+> ppr all_tvs) $$
510 (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
512 -- Unification will break badly if the variables overlap
513 -- They shouldn't because we allocate separate uniques for them
514 case tcUnifyTys bind_fn tpl_tys tys of
515 Just _ -> find ms (item:us) rest
516 Nothing -> find ms us rest
519 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
521 -- The key_tys can contain skolem constants, and we can guarantee that those
522 -- are never going to be instantiated to anything, so we should not involve
523 -- them in the unification test. Example:
524 -- class Foo a where { op :: a -> Int }
525 -- instance Foo a => Foo [a] -- NB overlap
526 -- instance Foo [Int] -- NB overlap
527 -- data T = forall a. Foo a => MkT a
529 -- f (MkT x) = op [x,x]
530 -- The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
531 -- complain, saying that the choice of instance depended on the instantiation
532 -- of 'a'; but of course it isn't *going* to be instantiated.
534 -- We do this only for pattern-bound skolems. For example we reject
535 -- g :: forall a => [a] -> Int
537 -- on the grounds that the correct instance depends on the instantiation of 'a'
540 insert_overlapping :: (TvSubst, Instance) -> [(TvSubst, Instance)]
541 -> [(TvSubst, Instance)]
542 -- Add a new solution, knocking out strictly less specific ones
543 insert_overlapping new_item [] = [new_item]
544 insert_overlapping new_item (item:items)
545 | new_beats_old && old_beats_new = item : insert_overlapping new_item items
546 -- Duplicate => keep both for error report
547 | new_beats_old = insert_overlapping new_item items
549 | old_beats_new = item : items
551 | otherwise = item : insert_overlapping new_item items
554 new_beats_old = new_item `beats` item
555 old_beats_new = item `beats` new_item
557 (_, instA) `beats` (_, instB)
559 isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
560 -- A beats B if A is more specific than B, and B admits overlap
561 -- I.e. if B can be instantiated to match A
563 overlap_ok = case is_flag instB of