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 }
72 The "rough-match" fields
73 ~~~~~~~~~~~~~~~~~~~~~~~~~
74 The is_cls, is_args fields allow a "rough match" to be done
75 without poking inside the DFunId. Poking the DFunId forces
76 us to suck in all the type constructors etc it involves,
77 which is a total waste of time if it has no chance of matching
78 So the Name, [Maybe Name] fields allow us to say "definitely
79 does not match", based only on the Name.
82 Nothing means that this type arg is a type variable
84 (Just n) means that this type arg is a
85 TyConApp with a type constructor of n.
86 This is always a real tycon, never a synonym!
87 (Two different synonyms might match, but two
88 different real tycons can't.)
89 NB: newtypes are not transparent, though!
91 The "proper-match" fields
92 ~~~~~~~~~~~~~~~~~~~~~~~~~
93 The is_tvs, is_tys fields are simply cahced values, pulled
94 out (lazily) from the dfun id. They are cached here simply so
95 that we don't need to decompose the DFunId each time we want
96 to match it. The hope is that the fast-match fields mean
97 that we often never poke th proper-match fields
100 * is_tvs must be a superset of the free vars of is_tys
102 * The is_dfun must itself be quantified over exactly is_tvs
103 (This is so that we can use the matching substitution to
104 instantiate the dfun's context.)
107 Note [Orphans]: the "is_orph" field
108 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
109 An instance is an orphan if its head (after the =>) mentions
110 nothing defined in this module.
112 Just n The head mentions n, which is defined in this module
113 This is used for versioning; the instance decl is
114 considered part of the defn of n when computing versions
116 Nothing The head mentions nothing defined in this module
118 If a module contains any orphans, then its interface file is read
119 regardless, so that its instances are not missed.
121 Functional dependencies worsen the situation a bit. Consider
123 In some other module we might have
126 instance C Int T where ...
127 This isn't considered an orphan, so we will only read M's interface
128 if something from M is used (e.g. T). So there's a risk we'll
129 miss the improvement from the instance. Workaround: import M.
131 Rules are orphans and versioned in much the same way.
134 instanceDFunId :: Instance -> DFunId
135 instanceDFunId = is_dfun
137 setInstanceDFunId :: Instance -> DFunId -> Instance
138 setInstanceDFunId ispec dfun
139 = ASSERT( idType dfun `tcEqType` idType (is_dfun ispec) )
140 -- We need to create the cached fields afresh from
141 -- the new dfun id. In particular, the is_tvs in
142 -- the Instance must match those in the dfun!
143 -- We assume that the only thing that changes is
144 -- the quantified type variables, so the other fields
145 -- are ok; hence the assert
146 ispec { is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys }
148 (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
150 instanceRoughTcs :: Instance -> [Maybe Name]
151 instanceRoughTcs = is_tcs
155 instance NamedThing Instance where
156 getName ispec = getName (is_dfun ispec)
158 instance Outputable Instance where
161 pprInstance :: Instance -> SDoc
162 -- Prints the Instance as an instance declaration
163 pprInstance ispec@(Instance { is_flag = flag })
164 = hang (pprInstanceHdr ispec)
165 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc ispec)))
167 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
168 pprInstanceHdr :: Instance -> SDoc
169 -- Prints the Instance as an instance declaration
170 pprInstanceHdr ispec@(Instance { is_flag = flag })
171 = ptext SLIT("instance") <+> ppr flag
172 <+> sep [pprThetaArrow theta, pprClassPred clas tys]
174 (_, theta, clas, tys) = instanceHead ispec
175 -- Print without the for-all, which the programmer doesn't write
177 pprInstances :: [Instance] -> SDoc
178 pprInstances ispecs = vcat (map pprInstance ispecs)
180 instanceHead :: Instance -> ([TyVar], [PredType], Class, [Type])
181 instanceHead ispec = tcSplitDFunTy (idType (is_dfun ispec))
183 mkLocalInstance :: DFunId -> OverlapFlag -> Instance
184 -- Used for local instances, where we can safely pull on the DFunId
185 mkLocalInstance dfun oflag
186 = Instance { is_flag = oflag, is_dfun = dfun,
187 is_tvs = mkVarSet tvs, is_tys = tys,
188 is_cls = cls_name, is_tcs = roughMatchTcs tys,
191 (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
192 mod = nameModule (idName dfun)
193 cls_name = getName cls
194 tycl_names = foldr (unionNameSets . tyClsNamesOfType)
195 (unitNameSet cls_name) tys
196 orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
198 (n:ns) -> Just (getOccName n)
200 mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
201 -> DFunId -> OverlapFlag -> Instance
202 -- Used for imported instances, where we get the rough-match stuff
203 -- from the interface file
204 mkImportedInstance cls mb_tcs orph dfun oflag
205 = Instance { is_flag = oflag, is_dfun = dfun,
206 is_tvs = mkVarSet tvs, is_tys = tys,
207 is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
209 (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
211 roughMatchTcs :: [Type] -> [Maybe Name]
212 roughMatchTcs tys = map rough tys
214 rough ty = case tcSplitTyConApp_maybe ty of
215 Just (tc,_) -> Just (tyConName tc)
218 instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
219 -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
220 -- possibly be instantiated to actual, nor vice versa;
221 -- False is non-committal
222 instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
223 instanceCantMatch ts as = False -- Safe
227 Note [Overlapping instances]
228 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
229 Overlap is permitted, but only in such a way that one can make
230 a unique choice when looking up. That is, overlap is only permitted if
231 one template matches the other, or vice versa. So this is ok:
239 If overlap is permitted, the list is kept most specific first, so that
240 the first lookup is the right choice.
243 For now we just use association lists.
245 \subsection{Avoiding a problem with overlapping}
247 Consider this little program:
250 class C a where c :: a
251 class C a => D a where d :: a
253 instance C Int where c = 17
254 instance D Int where d = 13
256 instance C a => C [a] where c = [c]
257 instance ({- C [a], -} D a) => D [a] where d = c
259 instance C [Int] where c = [37]
261 main = print (d :: [Int])
264 What do you think `main' prints (assuming we have overlapping instances, and
265 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
266 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
267 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
268 the `C [Int]' instance is more specific).
270 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
271 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
272 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
273 doesn't even compile! What's going on!?
275 What hugs complains about is the `D [a]' instance decl.
278 ERROR "mj.hs" (line 10): Cannot build superclass instance
280 *** Context supplied : D a
281 *** Required superclass : C [a]
284 You might wonder what hugs is complaining about. It's saying that you
285 need to add `C [a]' to the context of the `D [a]' instance (as appears
286 in comments). But there's that `C [a]' instance decl one line above
287 that says that I can reduce the need for a `C [a]' instance to the
288 need for a `C a' instance, and in this case, I already have the
289 necessary `C a' instance (since we have `D a' explicitly in the
290 context, and `C' is a superclass of `D').
292 Unfortunately, the above reasoning indicates a premature commitment to the
293 generic `C [a]' instance. I.e., it prematurely rules out the more specific
294 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
295 add the context that hugs suggests (uncomment the `C [a]'), effectively
296 deferring the decision about which instance to use.
298 Now, interestingly enough, 4.04 has this same bug, but it's covered up
299 in this case by a little known `optimization' that was disabled in
300 4.06. Ghc-4.04 silently inserts any missing superclass context into
301 an instance declaration. In this case, it silently inserts the `C
302 [a]', and everything happens to work out.
304 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
305 `Mark Jones', although Mark claims no credit for the `optimization' in
306 question, and would rather it stopped being called the `Mark Jones
309 So, what's the fix? I think hugs has it right. Here's why. Let's try
310 something else out with ghc-4.04. Let's add the following line:
315 Everyone raise their hand who thinks that `d :: [Int]' should give a
316 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
317 `optimization' only applies to instance decls, not to regular
318 bindings, giving inconsistent behavior.
320 Old hugs had this same bug. Here's how we fixed it: like GHC, the
321 list of instances for a given class is ordered, so that more specific
322 instances come before more generic ones. For example, the instance
323 list for C might contain:
324 ..., C Int, ..., C a, ...
325 When we go to look for a `C Int' instance we'll get that one first.
326 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
327 pass the `C Int' instance, and keep going. But if `b' is
328 unconstrained, then we don't know yet if the more specific instance
329 will eventually apply. GHC keeps going, and matches on the generic `C
330 a'. The fix is to, at each step, check to see if there's a reverse
331 match, and if so, abort the search. This prevents hugs from
332 prematurely chosing a generic instance when a more specific one
337 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
338 this test. Suppose the instance envt had
339 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
340 (still most specific first)
341 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
342 C x y Int doesn't match the template {a,b} C a a b
344 C a a b match the template {x,y} C x y Int
345 But still x and y might subsequently be unified so they *do* match.
347 Simple story: unify, don't match.
350 %************************************************************************
354 %************************************************************************
356 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
357 ClsInstEnv mapping is the dfun for that instance.
359 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
361 forall a b, C t1 t2 t3 can be constructed by dfun
363 or, to put it another way, we have
365 instance (...) => C t1 t2 t3, witnessed by dfun
368 ---------------------------------------------------
369 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
372 = ClsIE [Instance] -- The instances for a particular class, in any order
373 Bool -- True <=> there is an instance of form C a b c
374 -- If *not* then the common case of looking up
375 -- (C a b c) can fail immediately
378 -- * The is_tvs are distinct in each Instance
379 -- of a ClsInstEnv (so we can safely unify them)
381 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
382 -- [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
383 -- The "a" in the pattern must be one of the forall'd variables in
386 emptyInstEnv :: InstEnv
387 emptyInstEnv = emptyUFM
389 instEnvElts :: InstEnv -> [Instance]
390 instEnvElts ie = [elt | ClsIE elts _ <- eltsUFM ie, elt <- elts]
392 classInstances :: (InstEnv,InstEnv) -> Class -> [Instance]
393 classInstances (pkg_ie, home_ie) cls
394 = get home_ie ++ get pkg_ie
396 get env = case lookupUFM env cls of
397 Just (ClsIE insts _) -> insts
400 extendInstEnvList :: InstEnv -> [Instance] -> InstEnv
401 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
403 extendInstEnv :: InstEnv -> Instance -> InstEnv
404 extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tcs = mb_tcs })
405 = addToUFM_C add inst_env cls_nm (ClsIE [ins_item] ins_tyvar)
407 add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts)
408 (ins_tyvar || cur_tyvar)
409 ins_tyvar = not (any isJust mb_tcs)
413 %************************************************************************
415 \subsection{Looking up an instance}
417 %************************************************************************
419 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
420 the env is kept ordered, the first match must be the only one. The
421 thing we are looking up can have an arbitrary "flexi" part.
424 lookupInstEnv :: (InstEnv -- External package inst-env
425 ,InstEnv) -- Home-package inst-env
426 -> Class -> [Type] -- What we are looking for
427 -> ([(TvSubst, Instance)], -- Successful matches
428 [Instance]) -- These don't match but do unify
429 -- The second component of the tuple happens when we look up
431 -- in an InstEnv that has entries for
434 -- Then which we choose would depend on the way in which 'a'
435 -- is instantiated. So we report that Foo [b] is a match (mapping b->a)
436 -- but Foo [Int] is a unifier. This gives the caller a better chance of
437 -- giving a suitable error messagen
439 lookupInstEnv (pkg_ie, home_ie) cls tys
440 = (pruned_matches, all_unifs)
442 rough_tcs = roughMatchTcs tys
443 all_tvs = all isNothing rough_tcs
444 (home_matches, home_unifs) = lookup home_ie
445 (pkg_matches, pkg_unifs) = lookup pkg_ie
446 all_matches = home_matches ++ pkg_matches
447 all_unifs = home_unifs ++ pkg_unifs
449 | null all_unifs = foldr insert_overlapping [] all_matches
450 | otherwise = all_matches -- Non-empty unifs is always an error situation,
451 -- so don't attempt to pune the matches
454 lookup env = case lookupUFM env cls of
455 Nothing -> ([],[]) -- No instances for this class
456 Just (ClsIE insts has_tv_insts)
457 | all_tvs && not has_tv_insts
458 -> ([],[]) -- Short cut for common case
459 -- The thing we are looking up is of form (C a b c), and
460 -- the ClsIE has no instances of that form, so don't bother to search
466 find ms us [] = (ms, us)
467 find ms us (item@(Instance { is_tcs = mb_tcs, is_tvs = tpl_tvs,
468 is_tys = tpl_tys, is_flag = oflag,
469 is_dfun = dfun }) : rest)
470 -- Fast check for no match, uses the "rough match" fields
471 | instanceCantMatch rough_tcs mb_tcs
474 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
475 = find ((subst,item):ms) us rest
477 -- Does not match, so next check whether the things unify
478 -- See Note [overlapping instances] above
479 | Incoherent <- oflag
483 = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
484 (ppr cls <+> ppr tys <+> ppr all_tvs) $$
485 (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
487 -- Unification will break badly if the variables overlap
488 -- They shouldn't because we allocate separate uniques for them
489 case tcUnifyTys bind_fn tpl_tys tys of
490 Just _ -> find ms (item:us) rest
491 Nothing -> find ms us rest
494 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
496 -- The key_tys can contain skolem constants, and we can guarantee that those
497 -- are never going to be instantiated to anything, so we should not involve
498 -- them in the unification test. Example:
499 -- class Foo a where { op :: a -> Int }
500 -- instance Foo a => Foo [a] -- NB overlap
501 -- instance Foo [Int] -- NB overlap
502 -- data T = forall a. Foo a => MkT a
504 -- f (MkT x) = op [x,x]
505 -- The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
506 -- complain, saying that the choice of instance depended on the instantiation
507 -- of 'a'; but of course it isn't *going* to be instantiated.
509 -- We do this only for pattern-bound skolems. For example we reject
510 -- g :: forall a => [a] -> Int
512 -- on the grounds that the correct instance depends on the instantiation of 'a'
515 insert_overlapping :: (TvSubst, Instance) -> [(TvSubst, Instance)]
516 -> [(TvSubst, Instance)]
517 -- Add a new solution, knocking out strictly less specific ones
518 insert_overlapping new_item [] = [new_item]
519 insert_overlapping new_item (item:items)
520 | new_beats_old && old_beats_new = item : insert_overlapping new_item items
521 -- Duplicate => keep both for error report
522 | new_beats_old = insert_overlapping new_item items
524 | old_beats_new = item : items
526 | otherwise = item : insert_overlapping new_item items
529 new_beats_old = new_item `beats` item
530 old_beats_new = item `beats` new_item
532 (_, instA) `beats` (_, instB)
534 isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
535 -- A beats B if A is more specific than B, and B admits overlap
536 -- I.e. if B can be instantiated to match A
538 overlap_ok = case is_flag instB of