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, 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 modle
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 (ptext SLIT("instance") <+> ppr flag
157 <+> sep [pprThetaArrow theta, pprClassPred clas tys])
158 2 (parens (pprDefnLoc (getSrcLoc ispec)))
160 (_, theta, clas, tys) = instanceHead ispec
161 -- Print without the for-all, which the programmer doesn't write
163 pprInstances :: [Instance] -> SDoc
164 pprInstances ispecs = vcat (map pprInstance ispecs)
166 instanceHead :: Instance -> ([TyVar], [PredType], Class, [Type])
167 instanceHead ispec = tcSplitDFunTy (idType (is_dfun ispec))
169 mkLocalInstance :: DFunId -> OverlapFlag -> Instance
170 -- Used for local instances, where we can safely pull on the DFunId
171 mkLocalInstance dfun oflag
172 = Instance { is_flag = oflag, is_dfun = dfun,
173 is_tvs = mkVarSet tvs, is_tys = tys,
174 is_cls = cls_name, is_tcs = roughMatchTcs tys,
177 (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
178 mod = nameModule (idName dfun)
179 cls_name = getName cls
180 tycl_names = foldr (unionNameSets . tyClsNamesOfType)
181 (unitNameSet cls_name) tys
182 orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
184 (n:ns) -> Just (getOccName n)
186 mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
187 -> DFunId -> OverlapFlag -> Instance
188 -- Used for imported instances, where we get the rough-match stuff
189 -- from the interface file
190 mkImportedInstance cls mb_tcs orph dfun oflag
191 = Instance { is_flag = oflag, is_dfun = dfun,
192 is_tvs = mkVarSet tvs, is_tys = tys,
193 is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
195 (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
197 roughMatchTcs :: [Type] -> [Maybe Name]
198 roughMatchTcs tys = map rough tys
200 rough ty = case tcSplitTyConApp_maybe ty of
201 Just (tc,_) -> Just (tyConName tc)
204 instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
205 -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
206 -- possibly be instantiated to actual, nor vice versa;
207 -- False is non-committal
208 instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
209 instanceCantMatch ts as = False -- Safe
211 ---------------------------------------------------
213 = NoOverlap -- This instance must not overlap another
215 | OverlapOk -- Silently ignore this instance if you find a
216 -- more specific one that matches the constraint
217 -- you are trying to resolve
219 -- Example: constraint (Foo [Int])
220 -- instances (Foo [Int])
221 -- (Foo [a]) OverlapOk
222 -- Since the second instance has the OverlapOk flag,
223 -- the first instance will be chosen (otherwise
224 -- its ambiguous which to choose)
226 | Incoherent -- Like OverlapOk, but also ignore this instance
227 -- if it doesn't match the constraint you are
228 -- trying to resolve, but could match if the type variables
229 -- in the constraint were instantiated
231 -- Example: constraint (Foo [b])
232 -- instances (Foo [Int]) Incoherent
234 -- Without the Incoherent flag, we'd complain that
235 -- instantiating 'b' would change which instance
238 instance Outputable OverlapFlag where
239 ppr NoOverlap = empty
240 ppr OverlapOk = ptext SLIT("[overlap ok]")
241 ppr Incoherent = ptext SLIT("[incoherent]")
245 Note [Overlapping instances]
246 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
247 Overlap is permitted, but only in such a way that one can make
248 a unique choice when looking up. That is, overlap is only permitted if
249 one template matches the other, or vice versa. So this is ok:
257 If overlap is permitted, the list is kept most specific first, so that
258 the first lookup is the right choice.
261 For now we just use association lists.
263 \subsection{Avoiding a problem with overlapping}
265 Consider this little program:
268 class C a where c :: a
269 class C a => D a where d :: a
271 instance C Int where c = 17
272 instance D Int where d = 13
274 instance C a => C [a] where c = [c]
275 instance ({- C [a], -} D a) => D [a] where d = c
277 instance C [Int] where c = [37]
279 main = print (d :: [Int])
282 What do you think `main' prints (assuming we have overlapping instances, and
283 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
284 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
285 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
286 the `C [Int]' instance is more specific).
288 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
289 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
290 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
291 doesn't even compile! What's going on!?
293 What hugs complains about is the `D [a]' instance decl.
296 ERROR "mj.hs" (line 10): Cannot build superclass instance
298 *** Context supplied : D a
299 *** Required superclass : C [a]
302 You might wonder what hugs is complaining about. It's saying that you
303 need to add `C [a]' to the context of the `D [a]' instance (as appears
304 in comments). But there's that `C [a]' instance decl one line above
305 that says that I can reduce the need for a `C [a]' instance to the
306 need for a `C a' instance, and in this case, I already have the
307 necessary `C a' instance (since we have `D a' explicitly in the
308 context, and `C' is a superclass of `D').
310 Unfortunately, the above reasoning indicates a premature commitment to the
311 generic `C [a]' instance. I.e., it prematurely rules out the more specific
312 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
313 add the context that hugs suggests (uncomment the `C [a]'), effectively
314 deferring the decision about which instance to use.
316 Now, interestingly enough, 4.04 has this same bug, but it's covered up
317 in this case by a little known `optimization' that was disabled in
318 4.06. Ghc-4.04 silently inserts any missing superclass context into
319 an instance declaration. In this case, it silently inserts the `C
320 [a]', and everything happens to work out.
322 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
323 `Mark Jones', although Mark claims no credit for the `optimization' in
324 question, and would rather it stopped being called the `Mark Jones
327 So, what's the fix? I think hugs has it right. Here's why. Let's try
328 something else out with ghc-4.04. Let's add the following line:
333 Everyone raise their hand who thinks that `d :: [Int]' should give a
334 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
335 `optimization' only applies to instance decls, not to regular
336 bindings, giving inconsistent behavior.
338 Old hugs had this same bug. Here's how we fixed it: like GHC, the
339 list of instances for a given class is ordered, so that more specific
340 instances come before more generic ones. For example, the instance
341 list for C might contain:
342 ..., C Int, ..., C a, ...
343 When we go to look for a `C Int' instance we'll get that one first.
344 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
345 pass the `C Int' instance, and keep going. But if `b' is
346 unconstrained, then we don't know yet if the more specific instance
347 will eventually apply. GHC keeps going, and matches on the generic `C
348 a'. The fix is to, at each step, check to see if there's a reverse
349 match, and if so, abort the search. This prevents hugs from
350 prematurely chosing a generic instance when a more specific one
355 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
356 this test. Suppose the instance envt had
357 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
358 (still most specific first)
359 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
360 C x y Int doesn't match the template {a,b} C a a b
362 C a a b match the template {x,y} C x y Int
363 But still x and y might subsequently be unified so they *do* match.
365 Simple story: unify, don't match.
368 %************************************************************************
372 %************************************************************************
374 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
375 ClsInstEnv mapping is the dfun for that instance.
377 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
379 forall a b, C t1 t2 t3 can be constructed by dfun
381 or, to put it another way, we have
383 instance (...) => C t1 t2 t3, witnessed by dfun
386 ---------------------------------------------------
387 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
390 = ClsIE [Instance] -- The instances for a particular class, in any order
391 Bool -- True <=> there is an instance of form C a b c
392 -- If *not* then the common case of looking up
393 -- (C a b c) can fail immediately
396 -- * The is_tvs are distinct in each Instance
397 -- of a ClsInstEnv (so we can safely unify them)
399 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
400 -- [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
401 -- The "a" in the pattern must be one of the forall'd variables in
404 emptyInstEnv :: InstEnv
405 emptyInstEnv = emptyUFM
407 instEnvElts :: InstEnv -> [Instance]
408 instEnvElts ie = [elt | ClsIE elts _ <- eltsUFM ie, elt <- elts]
410 classInstances :: (InstEnv,InstEnv) -> Class -> [Instance]
411 classInstances (pkg_ie, home_ie) cls
412 = get home_ie ++ get pkg_ie
414 get env = case lookupUFM env cls of
415 Just (ClsIE insts _) -> insts
418 extendInstEnvList :: InstEnv -> [Instance] -> InstEnv
419 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
421 extendInstEnv :: InstEnv -> Instance -> InstEnv
422 extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tcs = mb_tcs })
423 = addToUFM_C add inst_env cls_nm (ClsIE [ins_item] ins_tyvar)
425 add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts)
426 (ins_tyvar || cur_tyvar)
427 ins_tyvar = not (any isJust mb_tcs)
431 %************************************************************************
433 \subsection{Looking up an instance}
435 %************************************************************************
437 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
438 the env is kept ordered, the first match must be the only one. The
439 thing we are looking up can have an arbitrary "flexi" part.
442 lookupInstEnv :: (InstEnv -- External package inst-env
443 ,InstEnv) -- Home-package inst-env
444 -> Class -> [Type] -- What we are looking for
445 -> ([(TvSubst, Instance)], -- Successful matches
446 [Instance]) -- These don't match but do unify
447 -- The second component of the tuple happens when we look up
449 -- in an InstEnv that has entries for
452 -- Then which we choose would depend on the way in which 'a'
453 -- is instantiated. So we report that Foo [b] is a match (mapping b->a)
454 -- but Foo [Int] is a unifier. This gives the caller a better chance of
455 -- giving a suitable error messagen
457 lookupInstEnv (pkg_ie, home_ie) cls tys
458 = (pruned_matches, all_unifs)
460 rough_tcs = roughMatchTcs tys
461 all_tvs = all isNothing rough_tcs
462 (home_matches, home_unifs) = lookup home_ie
463 (pkg_matches, pkg_unifs) = lookup pkg_ie
464 all_matches = home_matches ++ pkg_matches
465 all_unifs = home_unifs ++ pkg_unifs
467 | null all_unifs = foldr insert_overlapping [] all_matches
468 | otherwise = all_matches -- Non-empty unifs is always an error situation,
469 -- so don't attempt to pune the matches
472 lookup env = case lookupUFM env cls of
473 Nothing -> ([],[]) -- No instances for this class
474 Just (ClsIE insts has_tv_insts)
475 | all_tvs && not has_tv_insts
476 -> ([],[]) -- Short cut for common case
477 -- The thing we are looking up is of form (C a b c), and
478 -- the ClsIE has no instances of that form, so don't bother to search
484 find ms us [] = (ms, us)
485 find ms us (item@(Instance { is_tcs = mb_tcs, is_tvs = tpl_tvs,
486 is_tys = tpl_tys, is_flag = oflag,
487 is_dfun = dfun }) : rest)
488 -- Fast check for no match, uses the "rough match" fields
489 | instanceCantMatch rough_tcs mb_tcs
492 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
493 = find ((subst,item):ms) us rest
495 -- Does not match, so next check whether the things unify
496 -- See Note [overlapping instances] above
497 | Incoherent <- oflag
501 = ASSERT2( not (tyVarsOfTypes tys `intersectsVarSet` tpl_tvs),
502 (ppr cls <+> ppr tys <+> ppr all_tvs) $$
503 (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
505 -- Unification will break badly if the variables overlap
506 -- They shouldn't because we allocate separate uniques for them
507 case tcUnifyTys bind_fn tpl_tys tys of
508 Just _ -> find ms (item:us) rest
509 Nothing -> find ms us rest
512 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
514 -- The key_tys can contain skolem constants, and we can guarantee that those
515 -- are never going to be instantiated to anything, so we should not involve
516 -- them in the unification test. Example:
517 -- class Foo a where { op :: a -> Int }
518 -- instance Foo a => Foo [a] -- NB overlap
519 -- instance Foo [Int] -- NB overlap
520 -- data T = forall a. Foo a => MkT a
522 -- f (MkT x) = op [x,x]
523 -- The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
524 -- complain, saying that the choice of instance depended on the instantiation
525 -- of 'a'; but of course it isn't *going* to be instantiated.
527 -- We do this only for pattern-bound skolems. For example we reject
528 -- g :: forall a => [a] -> Int
530 -- on the grounds that the correct instance depends on the instantiation of 'a'
533 insert_overlapping :: (TvSubst, Instance) -> [(TvSubst, Instance)]
534 -> [(TvSubst, Instance)]
535 -- Add a new solution, knocking out strictly less specific ones
536 insert_overlapping new_item [] = [new_item]
537 insert_overlapping new_item (item:items)
538 | new_beats_old && old_beats_new = item : insert_overlapping new_item items
539 -- Duplicate => keep both for error report
540 | new_beats_old = insert_overlapping new_item items
542 | old_beats_new = item : items
544 | otherwise = item : insert_overlapping new_item items
547 new_beats_old = new_item `beats` item
548 old_beats_new = item `beats` new_item
550 (_, instA) `beats` (_, instB)
552 isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
553 -- A beats B if A is more specific than B, and B admits overlap
554 -- I.e. if B can be instantiated to match A
556 overlap_ok = case is_flag instB of