b8a3e6aa3f0049208adc6522dc622db9f764dfac
[ghc.git] / compiler / types / InstEnv.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[InstEnv]{Utilities for typechecking instance declarations}
6
7 The bits common to TcInstDcls and TcDeriv.
8 -}
9
10 {-# LANGUAGE CPP, DeriveDataTypeable #-}
11
12 module InstEnv (
13 DFunId, InstMatch, ClsInstLookupResult,
14 OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
15 ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances,
16 instanceHead, instanceSig, mkLocalInstance, mkImportedInstance,
17 instanceDFunId, tidyClsInstDFun, instanceRoughTcs,
18 fuzzyClsInstCmp,
19
20 IsOrphan(..), isOrphan, notOrphan,
21
22 InstEnvs(..), VisibleOrphanModules, InstEnv,
23 emptyInstEnv, extendInstEnv, deleteFromInstEnv, identicalClsInstHead,
24 extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv', lookupInstEnv, instEnvElts,
25 memberInstEnv, instIsVisible,
26 classInstances, orphNamesOfClsInst, instanceBindFun,
27 instanceCantMatch, roughMatchTcs
28 ) where
29
30 #include "HsVersions.h"
31
32 import CoreSyn ( IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor )
33 import Module
34 import Class
35 import Var
36 import VarSet
37 import Name
38 import NameSet
39 import TcType
40 import TyCon
41 import Unify
42 import Outputable
43 import ErrUtils
44 import BasicTypes
45 import UniqFM
46 import Util
47 import Id
48 import FastString
49 import Data.Data ( Data, Typeable )
50 import Data.Maybe ( isJust, isNothing )
51 #if __GLASGOW_HASKELL__ < 709
52 import Data.Monoid
53 #endif
54
55 {-
56 ************************************************************************
57 * *
58 ClsInst: the data type for type-class instances
59 * *
60 ************************************************************************
61 -}
62
63 data ClsInst
64 = ClsInst { -- Used for "rough matching"; see Note [Rough-match field]
65 -- INVARIANT: is_tcs = roughMatchTcs is_tys
66 is_cls_nm :: Name -- Class name
67 , is_tcs :: [Maybe Name] -- Top of type args
68
69 -- Used for "proper matching"; see Note [Proper-match fields]
70 , is_tvs :: [TyVar] -- Fresh template tyvars for full match
71 -- See Note [Template tyvars are fresh]
72 , is_cls :: Class -- The real class
73 , is_tys :: [Type] -- Full arg types (mentioning is_tvs)
74 -- INVARIANT: is_dfun Id has type
75 -- forall is_tvs. (...) => is_cls is_tys
76 -- (modulo alpha conversion)
77
78 , is_dfun :: DFunId -- See Note [Haddock assumptions]
79
80 , is_flag :: OverlapFlag -- See detailed comments with
81 -- the decl of BasicTypes.OverlapFlag
82 , is_orphan :: IsOrphan
83 }
84 deriving (Data, Typeable)
85
86 -- | A fuzzy comparison function for class instances, intended for sorting
87 -- instances before displaying them to the user.
88 fuzzyClsInstCmp :: ClsInst -> ClsInst -> Ordering
89 fuzzyClsInstCmp x y =
90 stableNameCmp (is_cls_nm x) (is_cls_nm y) `mappend`
91 mconcat (map cmp (zip (is_tcs x) (is_tcs y)))
92 where
93 cmp (Nothing, Nothing) = EQ
94 cmp (Nothing, Just _) = LT
95 cmp (Just _, Nothing) = GT
96 cmp (Just x, Just y) = stableNameCmp x y
97
98 {-
99 Note [Template tyvars are fresh]
100 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
101 The is_tvs field of a ClsInst has *completely fresh* tyvars.
102 That is, they are
103 * distinct from any other ClsInst
104 * distinct from any tyvars free in predicates that may
105 be looked up in the class instance environment
106 Reason for freshness: we use unification when checking for overlap
107 etc, and that requires the tyvars to be distinct.
108
109 The invariant is checked by the ASSERT in lookupInstEnv'.
110
111 Note [Rough-match field]
112 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
113 The is_cls_nm, is_tcs fields allow a "rough match" to be done
114 *without* poking inside the DFunId. Poking the DFunId forces
115 us to suck in all the type constructors etc it involves,
116 which is a total waste of time if it has no chance of matching
117 So the Name, [Maybe Name] fields allow us to say "definitely
118 does not match", based only on the Name.
119
120 In is_tcs,
121 Nothing means that this type arg is a type variable
122
123 (Just n) means that this type arg is a
124 TyConApp with a type constructor of n.
125 This is always a real tycon, never a synonym!
126 (Two different synonyms might match, but two
127 different real tycons can't.)
128 NB: newtypes are not transparent, though!
129
130 Note [Proper-match fields]
131 ~~~~~~~~~~~~~~~~~~~~~~~~~
132 The is_tvs, is_cls, is_tys fields are simply cached values, pulled
133 out (lazily) from the dfun id. They are cached here simply so
134 that we don't need to decompose the DFunId each time we want
135 to match it. The hope is that the fast-match fields mean
136 that we often never poke the proper-match fields.
137
138 However, note that:
139 * is_tvs must be a superset of the free vars of is_tys
140
141 * is_tvs, is_tys may be alpha-renamed compared to the ones in
142 the dfun Id
143
144 Note [Haddock assumptions]
145 ~~~~~~~~~~~~~~~~~~~~~~~~~~
146 For normal user-written instances, Haddock relies on
147
148 * the SrcSpan of
149 * the Name of
150 * the is_dfun of
151 * an Instance
152
153 being equal to
154
155 * the SrcSpan of
156 * the instance head type of
157 * the InstDecl used to construct the Instance.
158 -}
159
160 instanceDFunId :: ClsInst -> DFunId
161 instanceDFunId = is_dfun
162
163 tidyClsInstDFun :: (DFunId -> DFunId) -> ClsInst -> ClsInst
164 tidyClsInstDFun tidy_dfun ispec
165 = ispec { is_dfun = tidy_dfun (is_dfun ispec) }
166
167 instanceRoughTcs :: ClsInst -> [Maybe Name]
168 instanceRoughTcs = is_tcs
169
170 instance NamedThing ClsInst where
171 getName ispec = getName (is_dfun ispec)
172
173 instance Outputable ClsInst where
174 ppr = pprInstance
175
176 pprInstance :: ClsInst -> SDoc
177 -- Prints the ClsInst as an instance declaration
178 pprInstance ispec
179 = hang (pprInstanceHdr ispec)
180 2 (vcat [ ptext (sLit "--") <+> pprDefinedAt (getName ispec)
181 , ifPprDebug (ppr (is_dfun ispec)) ])
182
183 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
184 pprInstanceHdr :: ClsInst -> SDoc
185 -- Prints the ClsInst as an instance declaration
186 pprInstanceHdr (ClsInst { is_flag = flag, is_dfun = dfun })
187 = ptext (sLit "instance") <+> ppr flag <+> pprSigmaType (idType dfun)
188
189 pprInstances :: [ClsInst] -> SDoc
190 pprInstances ispecs = vcat (map pprInstance ispecs)
191
192 instanceHead :: ClsInst -> ([TyVar], Class, [Type])
193 -- Returns the head, using the fresh tyavs from the ClsInst
194 instanceHead (ClsInst { is_tvs = tvs, is_tys = tys, is_dfun = dfun })
195 = (tvs, cls, tys)
196 where
197 (_, _, cls, _) = tcSplitDFunTy (idType dfun)
198
199 instanceSig :: ClsInst -> ([TyVar], [Type], Class, [Type])
200 -- Decomposes the DFunId
201 instanceSig ispec = tcSplitDFunTy (idType (is_dfun ispec))
202
203 mkLocalInstance :: DFunId -> OverlapFlag
204 -> [TyVar] -> Class -> [Type]
205 -> ClsInst
206 -- Used for local instances, where we can safely pull on the DFunId
207 mkLocalInstance dfun oflag tvs cls tys
208 = ClsInst { is_flag = oflag, is_dfun = dfun
209 , is_tvs = tvs
210 , is_cls = cls, is_cls_nm = cls_name
211 , is_tys = tys, is_tcs = roughMatchTcs tys
212 , is_orphan = orph
213 }
214 where
215 cls_name = className cls
216 dfun_name = idName dfun
217 this_mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
218 is_local name = nameIsLocalOrFrom this_mod name
219
220 -- Compute orphanhood. See Note [Orphans] in InstEnv
221 (cls_tvs, fds) = classTvsFds cls
222 arg_names = [filterNameSet is_local (orphNamesOfType ty) | ty <- tys]
223
224 -- See Note [When exactly is an instance decl an orphan?]
225 orph | is_local cls_name = NotOrphan (nameOccName cls_name)
226 | all notOrphan mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
227 | otherwise = IsOrphan
228
229 notOrphan NotOrphan{} = True
230 notOrphan _ = False
231
232 mb_ns :: [IsOrphan] -- One for each fundep; a locally-defined name
233 -- that is not in the "determined" arguments
234 mb_ns | null fds = [choose_one arg_names]
235 | otherwise = map do_one fds
236 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names
237 , not (tv `elem` rtvs)]
238
239 choose_one nss = chooseOrphanAnchor (nameSetElems (unionNameSets nss))
240
241 mkImportedInstance :: Name
242 -> [Maybe Name]
243 -> DFunId
244 -> OverlapFlag
245 -> IsOrphan
246 -> ClsInst
247 -- Used for imported instances, where we get the rough-match stuff
248 -- from the interface file
249 -- The bound tyvars of the dfun are guaranteed fresh, because
250 -- the dfun has been typechecked out of the same interface file
251 mkImportedInstance cls_nm mb_tcs dfun oflag orphan
252 = ClsInst { is_flag = oflag, is_dfun = dfun
253 , is_tvs = tvs, is_tys = tys
254 , is_cls_nm = cls_nm, is_cls = cls, is_tcs = mb_tcs
255 , is_orphan = orphan }
256 where
257 (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
258
259 roughMatchTcs :: [Type] -> [Maybe Name]
260 roughMatchTcs tys = map rough tys
261 where
262 rough ty = case tcSplitTyConApp_maybe ty of
263 Just (tc,_) -> Just (tyConName tc)
264 Nothing -> Nothing
265
266 instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
267 -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
268 -- possibly be instantiated to actual, nor vice versa;
269 -- False is non-committal
270 instanceCantMatch (mt : ts) (ma : as) = itemCantMatch mt ma || instanceCantMatch ts as
271 instanceCantMatch _ _ = False -- Safe
272
273 itemCantMatch :: Maybe Name -> Maybe Name -> Bool
274 itemCantMatch (Just t) (Just a) = t /= a
275 itemCantMatch _ _ = False
276
277 {-
278 Note [When exactly is an instance decl an orphan?]
279 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
280 (see MkIface.instanceToIfaceInst, which implements this)
281 Roughly speaking, an instance is an orphan if its head (after the =>)
282 mentions nothing defined in this module.
283
284 Functional dependencies complicate the situation though. Consider
285
286 module M where { class C a b | a -> b }
287
288 and suppose we are compiling module X:
289
290 module X where
291 import M
292 data T = ...
293 instance C Int T where ...
294
295 This instance is an orphan, because when compiling a third module Y we
296 might get a constraint (C Int v), and we'd want to improve v to T. So
297 we must make sure X's instances are loaded, even if we do not directly
298 use anything from X.
299
300 More precisely, an instance is an orphan iff
301
302 If there are no fundeps, then at least of the names in
303 the instance head is locally defined.
304
305 If there are fundeps, then for every fundep, at least one of the
306 names free in a *non-determined* part of the instance head is
307 defined in this module.
308
309 (Note that these conditions hold trivially if the class is locally
310 defined.)
311
312
313 ************************************************************************
314 * *
315 InstEnv, ClsInstEnv
316 * *
317 ************************************************************************
318
319 A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
320 ClsInstEnv mapping is the dfun for that instance.
321
322 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
323
324 forall a b, C t1 t2 t3 can be constructed by dfun
325
326 or, to put it another way, we have
327
328 instance (...) => C t1 t2 t3, witnessed by dfun
329 -}
330
331 ---------------------------------------------------
332 type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
333
334 -- | 'InstEnvs' represents the combination of the global type class instance
335 -- environment, the local type class instance environment, and the set of
336 -- transitively reachable orphan modules (according to what modules have been
337 -- directly imported) used to test orphan instance visibility.
338 data InstEnvs = InstEnvs {
339 ie_global :: InstEnv, -- External-package instances
340 ie_local :: InstEnv, -- Home-package instances
341 ie_visible :: VisibleOrphanModules -- Set of all orphan modules transitively
342 -- reachable from the module being compiled
343 -- See Note [Instance lookup and orphan instances]
344 }
345
346 -- | Set of visible orphan modules, according to what modules have been directly
347 -- imported. This is based off of the dep_orphs field, which records
348 -- transitively reachable orphan modules (modules that define orphan instances).
349 type VisibleOrphanModules = ModuleSet
350
351 newtype ClsInstEnv
352 = ClsIE [ClsInst] -- The instances for a particular class, in any order
353
354 instance Outputable ClsInstEnv where
355 ppr (ClsIE is) = pprInstances is
356
357 -- INVARIANTS:
358 -- * The is_tvs are distinct in each ClsInst
359 -- of a ClsInstEnv (so we can safely unify them)
360
361 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
362 -- [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
363 -- The "a" in the pattern must be one of the forall'd variables in
364 -- the dfun type.
365
366 emptyInstEnv :: InstEnv
367 emptyInstEnv = emptyUFM
368
369 instEnvElts :: InstEnv -> [ClsInst]
370 instEnvElts ie = [elt | ClsIE elts <- eltsUFM ie, elt <- elts]
371
372 -- | Test if an instance is visible, by checking that its origin module
373 -- is in 'VisibleOrphanModules'.
374 -- See Note [Instance lookup and orphan instances]
375 instIsVisible :: VisibleOrphanModules -> ClsInst -> Bool
376 instIsVisible vis_mods ispec
377 -- NB: Instances from the interactive package always are visible. We can't
378 -- add interactive modules to the set since we keep creating new ones
379 -- as a GHCi session progresses.
380 | isInteractiveModule mod = True
381 | IsOrphan <- is_orphan ispec = mod `elemModuleSet` vis_mods
382 | otherwise = True
383 where
384 mod = nameModule (idName (is_dfun ispec))
385
386 classInstances :: InstEnvs -> Class -> [ClsInst]
387 classInstances (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods }) cls
388 = get home_ie ++ get pkg_ie
389 where
390 get env = case lookupUFM env cls of
391 Just (ClsIE insts) -> filter (instIsVisible vis_mods) insts
392 Nothing -> []
393
394 -- | Collects the names of concrete types and type constructors that make
395 -- up the head of a class instance. For instance, given `class Foo a b`:
396 --
397 -- `instance Foo (Either (Maybe Int) a) Bool` would yield
398 -- [Either, Maybe, Int, Bool]
399 --
400 -- Used in the implementation of ":info" in GHCi.
401 orphNamesOfClsInst :: ClsInst -> NameSet
402 orphNamesOfClsInst = orphNamesOfDFunHead . idType . instanceDFunId
403
404 -- | Checks for an exact match of ClsInst in the instance environment.
405 -- We use this when we do signature checking in TcRnDriver
406 memberInstEnv :: InstEnv -> ClsInst -> Bool
407 memberInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm } ) =
408 maybe False (\(ClsIE items) -> any (identicalClsInstHead ins_item) items)
409 (lookupUFM inst_env cls_nm)
410
411 extendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv
412 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
413
414 extendInstEnv :: InstEnv -> ClsInst -> InstEnv
415 extendInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })
416 = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
417 where
418 add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts)
419
420 deleteFromInstEnv :: InstEnv -> ClsInst -> InstEnv
421 deleteFromInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })
422 = adjustUFM adjust inst_env cls_nm
423 where
424 adjust (ClsIE items) = ClsIE (filterOut (identicalClsInstHead ins_item) items)
425
426 identicalClsInstHead :: ClsInst -> ClsInst -> Bool
427 -- ^ True when when the instance heads are the same
428 -- e.g. both are Eq [(a,b)]
429 -- Used for overriding in GHCi
430 -- Obviously should be insenstive to alpha-renaming
431 identicalClsInstHead (ClsInst { is_cls_nm = cls_nm1, is_tcs = rough1, is_tvs = tvs1, is_tys = tys1 })
432 (ClsInst { is_cls_nm = cls_nm2, is_tcs = rough2, is_tvs = tvs2, is_tys = tys2 })
433 = cls_nm1 == cls_nm2
434 && not (instanceCantMatch rough1 rough2) -- Fast check for no match, uses the "rough match" fields
435 && isJust (tcMatchTys (mkVarSet tvs1) tys1 tys2)
436 && isJust (tcMatchTys (mkVarSet tvs2) tys2 tys1)
437
438 {-
439 ************************************************************************
440 * *
441 Looking up an instance
442 * *
443 ************************************************************************
444
445 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
446 the env is kept ordered, the first match must be the only one. The
447 thing we are looking up can have an arbitrary "flexi" part.
448
449 Note [Instance lookup and orphan instances]
450 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
451 Suppose we are compiling a module M, and we have a zillion packages
452 loaded, and we are looking up an instance for C (T W). If we find a
453 match in module 'X' from package 'p', should be "in scope"; that is,
454
455 is p:X in the transitive closure of modules imported from M?
456
457 The difficulty is that the "zillion packages" might include ones loaded
458 through earlier invocations of the GHC API, or earlier module loads in GHCi.
459 They might not be in the dependencies of M itself; and if not, the instances
460 in them should not be visible. Trac #2182, #8427.
461
462 There are two cases:
463 * If the instance is *not an orphan*, then module X defines C, T, or W.
464 And in order for those types to be involved in typechecking M, it
465 must be that X is in the transitive closure of M's imports. So we
466 can use the instance.
467
468 * If the instance *is an orphan*, the above reasoning does not apply.
469 So we keep track of the set of orphan modules transitively below M;
470 this is the ie_visible field of InstEnvs, of type VisibleOrphanModules.
471
472 If module p:X is in this set, then we can use the instance, otherwise
473 we can't.
474
475 Note [Rules for instance lookup]
476 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
477 These functions implement the carefully-written rules in the user
478 manual section on "overlapping instances". At risk of duplication,
479 here are the rules. If the rules change, change this text and the
480 user manual simultaneously. The link may be this:
481 http://www.haskell.org/ghc/docs/latest/html/users_guide/type-class-extensions.html#instance-overlap
482
483 The willingness to be overlapped or incoherent is a property of the
484 instance declaration itself, controlled as follows:
485
486 * An instance is "incoherent"
487 if it has an INCOHERENT pragma, or
488 if it appears in a module compiled with -XIncoherentInstances.
489
490 * An instance is "overlappable"
491 if it has an OVERLAPPABLE or OVERLAPS pragma, or
492 if it appears in a module compiled with -XOverlappingInstances, or
493 if the instance is incoherent.
494
495 * An instance is "overlapping"
496 if it has an OVERLAPPING or OVERLAPS pragma, or
497 if it appears in a module compiled with -XOverlappingInstances, or
498 if the instance is incoherent.
499 compiled with -XOverlappingInstances.
500
501 Now suppose that, in some client module, we are searching for an instance
502 of the target constraint (C ty1 .. tyn). The search works like this.
503
504 * Find all instances I that match the target constraint; that is, the
505 target constraint is a substitution instance of I. These instance
506 declarations are the candidates.
507
508 * Find all non-candidate instances that unify with the target
509 constraint. Such non-candidates instances might match when the
510 target constraint is further instantiated. If all of them are
511 incoherent, proceed; if not, the search fails.
512
513 * Eliminate any candidate IX for which both of the following hold:
514 * There is another candidate IY that is strictly more specific;
515 that is, IY is a substitution instance of IX but not vice versa.
516
517 * Either IX is overlappable or IY is overlapping.
518
519 * If only one candidate remains, pick it. Otherwise if all remaining
520 candidates are incoherent, pick an arbitrary candidate. Otherwise fail.
521
522 Note [Overlapping instances] (NB: these notes are quite old)
523 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
524 Overlap is permitted, but only in such a way that one can make
525 a unique choice when looking up. That is, overlap is only permitted if
526 one template matches the other, or vice versa. So this is ok:
527
528 [a] [Int]
529
530 but this is not
531
532 (Int,a) (b,Int)
533
534 If overlap is permitted, the list is kept most specific first, so that
535 the first lookup is the right choice.
536
537
538 For now we just use association lists.
539
540 \subsection{Avoiding a problem with overlapping}
541
542 Consider this little program:
543
544 \begin{pseudocode}
545 class C a where c :: a
546 class C a => D a where d :: a
547
548 instance C Int where c = 17
549 instance D Int where d = 13
550
551 instance C a => C [a] where c = [c]
552 instance ({- C [a], -} D a) => D [a] where d = c
553
554 instance C [Int] where c = [37]
555
556 main = print (d :: [Int])
557 \end{pseudocode}
558
559 What do you think `main' prints (assuming we have overlapping instances, and
560 all that turned on)? Well, the instance for `D' at type `[a]' is defined to
561 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
562 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
563 the `C [Int]' instance is more specific).
564
565 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That
566 was easy ;-) Let's just consult hugs for good measure. Wait - if I use old
567 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
568 doesn't even compile! What's going on!?
569
570 What hugs complains about is the `D [a]' instance decl.
571
572 \begin{pseudocode}
573 ERROR "mj.hs" (line 10): Cannot build superclass instance
574 *** Instance : D [a]
575 *** Context supplied : D a
576 *** Required superclass : C [a]
577 \end{pseudocode}
578
579 You might wonder what hugs is complaining about. It's saying that you
580 need to add `C [a]' to the context of the `D [a]' instance (as appears
581 in comments). But there's that `C [a]' instance decl one line above
582 that says that I can reduce the need for a `C [a]' instance to the
583 need for a `C a' instance, and in this case, I already have the
584 necessary `C a' instance (since we have `D a' explicitly in the
585 context, and `C' is a superclass of `D').
586
587 Unfortunately, the above reasoning indicates a premature commitment to the
588 generic `C [a]' instance. I.e., it prematurely rules out the more specific
589 instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to
590 add the context that hugs suggests (uncomment the `C [a]'), effectively
591 deferring the decision about which instance to use.
592
593 Now, interestingly enough, 4.04 has this same bug, but it's covered up
594 in this case by a little known `optimization' that was disabled in
595 4.06. Ghc-4.04 silently inserts any missing superclass context into
596 an instance declaration. In this case, it silently inserts the `C
597 [a]', and everything happens to work out.
598
599 (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for
600 `Mark Jones', although Mark claims no credit for the `optimization' in
601 question, and would rather it stopped being called the `Mark Jones
602 optimization' ;-)
603
604 So, what's the fix? I think hugs has it right. Here's why. Let's try
605 something else out with ghc-4.04. Let's add the following line:
606
607 d' :: D a => [a]
608 d' = c
609
610 Everyone raise their hand who thinks that `d :: [Int]' should give a
611 different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The
612 `optimization' only applies to instance decls, not to regular
613 bindings, giving inconsistent behavior.
614
615 Old hugs had this same bug. Here's how we fixed it: like GHC, the
616 list of instances for a given class is ordered, so that more specific
617 instances come before more generic ones. For example, the instance
618 list for C might contain:
619 ..., C Int, ..., C a, ...
620 When we go to look for a `C Int' instance we'll get that one first.
621 But what if we go looking for a `C b' (`b' is unconstrained)? We'll
622 pass the `C Int' instance, and keep going. But if `b' is
623 unconstrained, then we don't know yet if the more specific instance
624 will eventually apply. GHC keeps going, and matches on the generic `C
625 a'. The fix is to, at each step, check to see if there's a reverse
626 match, and if so, abort the search. This prevents hugs from
627 prematurely chosing a generic instance when a more specific one
628 exists.
629
630 --Jeff
631 v
632 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
633 this test. Suppose the instance envt had
634 ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
635 (still most specific first)
636 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
637 C x y Int doesn't match the template {a,b} C a a b
638 but neither does
639 C a a b match the template {x,y} C x y Int
640 But still x and y might subsequently be unified so they *do* match.
641
642 Simple story: unify, don't match.
643 -}
644
645 type DFunInstType = Maybe Type
646 -- Just ty => Instantiate with this type
647 -- Nothing => Instantiate with any type of this tyvar's kind
648 -- See Note [DFunInstType: instantiating types]
649
650 type InstMatch = (ClsInst, [DFunInstType])
651
652 type ClsInstLookupResult
653 = ( [InstMatch] -- Successful matches
654 , [ClsInst] -- These don't match but do unify
655 , [InstMatch] ) -- Unsafe overlapped instances under Safe Haskell
656 -- (see Note [Safe Haskell Overlapping Instances] in
657 -- TcSimplify).
658
659 {-
660 Note [DFunInstType: instantiating types]
661 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
662 A successful match is a ClsInst, together with the types at which
663 the dfun_id in the ClsInst should be instantiated
664 The instantiating types are (Either TyVar Type)s because the dfun
665 might have some tyvars that *only* appear in arguments
666 dfun :: forall a b. C a b, Ord b => D [a]
667 When we match this against D [ty], we return the instantiating types
668 [Just ty, Nothing]
669 where the 'Nothing' indicates that 'b' can be freely instantiated.
670 (The caller instantiates it to a flexi type variable, which will
671 presumably later become fixed via functional dependencies.)
672 -}
673
674 -- |Look up an instance in the given instance environment. The given class application must match exactly
675 -- one instance and the match may not contain any flexi type variables. If the lookup is unsuccessful,
676 -- yield 'Left errorMessage'.
677 --
678 lookupUniqueInstEnv :: InstEnvs
679 -> Class -> [Type]
680 -> Either MsgDoc (ClsInst, [Type])
681 lookupUniqueInstEnv instEnv cls tys
682 = case lookupInstEnv False instEnv cls tys of
683 ([(inst, inst_tys)], _, _)
684 | noFlexiVar -> Right (inst, inst_tys')
685 | otherwise -> Left $ ptext (sLit "flexible type variable:") <+>
686 (ppr $ mkTyConApp (classTyCon cls) tys)
687 where
688 inst_tys' = [ty | Just ty <- inst_tys]
689 noFlexiVar = all isJust inst_tys
690 _other -> Left $ ptext (sLit "instance not found") <+> (ppr $ mkTyConApp (classTyCon cls) tys)
691
692 lookupInstEnv' :: InstEnv -- InstEnv to look in
693 -> VisibleOrphanModules -- But filter against this
694 -> Class -> [Type] -- What we are looking for
695 -> ([InstMatch], -- Successful matches
696 [ClsInst]) -- These don't match but do unify
697 -- The second component of the result pair happens when we look up
698 -- Foo [a]
699 -- in an InstEnv that has entries for
700 -- Foo [Int]
701 -- Foo [b]
702 -- Then which we choose would depend on the way in which 'a'
703 -- is instantiated. So we report that Foo [b] is a match (mapping b->a)
704 -- but Foo [Int] is a unifier. This gives the caller a better chance of
705 -- giving a suitable error message
706
707 lookupInstEnv' ie vis_mods cls tys
708 = lookup ie
709 where
710 rough_tcs = roughMatchTcs tys
711 all_tvs = all isNothing rough_tcs
712 --------------
713 lookup env = case lookupUFM env cls of
714 Nothing -> ([],[]) -- No instances for this class
715 Just (ClsIE insts) -> find [] [] insts
716
717 --------------
718 find ms us [] = (ms, us)
719 find ms us (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs
720 , is_tys = tpl_tys, is_flag = oflag }) : rest)
721 | not (instIsVisible vis_mods item)
722 = find ms us rest -- See Note [Instance lookup and orphan instances]
723
724 -- Fast check for no match, uses the "rough match" fields
725 | instanceCantMatch rough_tcs mb_tcs
726 = find ms us rest
727
728 | Just subst <- tcMatchTys tpl_tv_set tpl_tys tys
729 = find ((item, map (lookup_tv subst) tpl_tvs) : ms) us rest
730
731 -- Does not match, so next check whether the things unify
732 -- See Note [Overlapping instances] and Note [Incoherent instances]
733 | Incoherent _ <- overlapMode oflag
734 = find ms us rest
735
736 | otherwise
737 = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tv_set,
738 (ppr cls <+> ppr tys <+> ppr all_tvs) $$
739 (ppr tpl_tvs <+> ppr tpl_tys)
740 )
741 -- Unification will break badly if the variables overlap
742 -- They shouldn't because we allocate separate uniques for them
743 -- See Note [Template tyvars are fresh]
744 case tcUnifyTys instanceBindFun tpl_tys tys of
745 Just _ -> find ms (item:us) rest
746 Nothing -> find ms us rest
747 where
748 tpl_tv_set = mkVarSet tpl_tvs
749
750 ----------------
751 lookup_tv :: TvSubst -> TyVar -> DFunInstType
752 -- See Note [DFunInstType: instantiating types]
753 lookup_tv subst tv = case lookupTyVar subst tv of
754 Just ty -> Just ty
755 Nothing -> Nothing
756
757 ---------------
758 -- This is the common way to call this function.
759 lookupInstEnv :: Bool -- Check Safe Haskell overlap restrictions
760 -> InstEnvs -- External and home package inst-env
761 -> Class -> [Type] -- What we are looking for
762 -> ClsInstLookupResult
763 -- ^ See Note [Rules for instance lookup]
764 -- ^ See Note [Safe Haskell Overlapping Instances] in TcSimplify
765 -- ^ See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify
766 lookupInstEnv check_overlap_safe
767 (InstEnvs { ie_global = pkg_ie
768 , ie_local = home_ie
769 , ie_visible = vis_mods })
770 cls
771 tys
772 = (final_matches, final_unifs, unsafe_overlapped)
773 where
774 (home_matches, home_unifs) = lookupInstEnv' home_ie vis_mods cls tys
775 (pkg_matches, pkg_unifs) = lookupInstEnv' pkg_ie vis_mods cls tys
776 all_matches = home_matches ++ pkg_matches
777 all_unifs = home_unifs ++ pkg_unifs
778 final_matches = foldr insert_overlapping [] all_matches
779 -- Even if the unifs is non-empty (an error situation)
780 -- we still prune the matches, so that the error message isn't
781 -- misleading (complaining of multiple matches when some should be
782 -- overlapped away)
783
784 unsafe_overlapped
785 = case final_matches of
786 [match] -> check_safe match
787 _ -> []
788
789 -- If the selected match is incoherent, discard all unifiers
790 final_unifs = case final_matches of
791 (m:_) | is_incoherent m -> []
792 _ -> all_unifs
793
794 -- NOTE [Safe Haskell isSafeOverlap]
795 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
796 -- We restrict code compiled in 'Safe' mode from overriding code
797 -- compiled in any other mode. The rationale is that code compiled
798 -- in 'Safe' mode is code that is untrusted by the ghc user. So
799 -- we shouldn't let that code change the behaviour of code the
800 -- user didn't compile in 'Safe' mode since that's the code they
801 -- trust. So 'Safe' instances can only overlap instances from the
802 -- same module. A same instance origin policy for safe compiled
803 -- instances.
804 check_safe (inst,_)
805 = case check_overlap_safe && unsafeTopInstance inst of
806 -- make sure it only overlaps instances from the same module
807 True -> go [] all_matches
808 -- most specific is from a trusted location.
809 False -> []
810 where
811 go bad [] = bad
812 go bad (i@(x,_):unchecked) =
813 if inSameMod x || isOverlappable x
814 then go bad unchecked
815 else go (i:bad) unchecked
816
817 inSameMod b =
818 let na = getName $ getName inst
819 la = isInternalName na
820 nb = getName $ getName b
821 lb = isInternalName nb
822 in (la && lb) || (nameModule na == nameModule nb)
823
824 isOverlappable i = hasOverlappableFlag $ overlapMode $ is_flag i
825
826 -- We consider the most specific instance unsafe when it both:
827 -- (1) Comes from a module compiled as `Safe`
828 -- (2) Is an orphan instance, OR, an instance for a MPTC
829 unsafeTopInstance inst = isSafeOverlap (is_flag inst) &&
830 (isOrphan (is_orphan inst) || classArity (is_cls inst) > 1)
831
832 ---------------
833 is_incoherent :: InstMatch -> Bool
834 is_incoherent (inst, _) = case overlapMode (is_flag inst) of
835 Incoherent _ -> True
836 _ -> False
837
838 ---------------
839 insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]
840 -- ^ Add a new solution, knocking out strictly less specific ones
841 -- See Note [Rules for instance lookup]
842 insert_overlapping new_item [] = [new_item]
843 insert_overlapping new_item (old_item : old_items)
844 | new_beats_old -- New strictly overrides old
845 , not old_beats_new
846 , new_item `can_override` old_item
847 = insert_overlapping new_item old_items
848
849 | old_beats_new -- Old strictly overrides new
850 , not new_beats_old
851 , old_item `can_override` new_item
852 = old_item : old_items
853
854 -- Discard incoherent instances; see Note [Incoherent instances]
855 | is_incoherent old_item -- Old is incoherent; discard it
856 = insert_overlapping new_item old_items
857 | is_incoherent new_item -- New is incoherent; discard it
858 = old_item : old_items
859
860 -- Equal or incomparable, and neither is incoherent; keep both
861 | otherwise
862 = old_item : insert_overlapping new_item old_items
863 where
864
865 new_beats_old = new_item `more_specific_than` old_item
866 old_beats_new = old_item `more_specific_than` new_item
867
868 -- `instB` can be instantiated to match `instA`
869 -- or the two are equal
870 (instA,_) `more_specific_than` (instB,_)
871 = isJust (tcMatchTys (mkVarSet (is_tvs instB))
872 (is_tys instB) (is_tys instA))
873
874 (instA, _) `can_override` (instB, _)
875 = hasOverlappingFlag (overlapMode (is_flag instA))
876 || hasOverlappableFlag (overlapMode (is_flag instB))
877 -- Overlap permitted if either the more specific instance
878 -- is marked as overlapping, or the more general one is
879 -- marked as overlappable.
880 -- Latest change described in: Trac #9242.
881 -- Previous change: Trac #3877, Dec 10.
882
883 {-
884 Note [Incoherent instances]
885 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
886 For some classes, the choice of a particular instance does not matter, any one
887 is good. E.g. consider
888
889 class D a b where { opD :: a -> b -> String }
890 instance D Int b where ...
891 instance D a Int where ...
892
893 g (x::Int) = opD x x -- Wanted: D Int Int
894
895 For such classes this should work (without having to add an "instance D Int
896 Int", and using -XOverlappingInstances, which would then work). This is what
897 -XIncoherentInstances is for: Telling GHC "I don't care which instance you use;
898 if you can use one, use it."
899
900 Should this logic only work when *all* candidates have the incoherent flag, or
901 even when all but one have it? The right choice is the latter, which can be
902 justified by comparing the behaviour with how -XIncoherentInstances worked when
903 it was only about the unify-check (note [Overlapping instances]):
904
905 Example:
906 class C a b c where foo :: (a,b,c)
907 instance C [a] b Int
908 instance [incoherent] [Int] b c
909 instance [incoherent] C a Int c
910 Thanks to the incoherent flags,
911 [Wanted] C [a] b Int
912 works: Only instance one matches, the others just unify, but are marked
913 incoherent.
914
915 So I can write
916 (foo :: ([a],b,Int)) :: ([Int], Int, Int).
917 but if that works then I really want to be able to write
918 foo :: ([Int], Int, Int)
919 as well. Now all three instances from above match. None is more specific than
920 another, so none is ruled out by the normal overlapping rules. One of them is
921 not incoherent, but we still want this to compile. Hence the
922 "all-but-one-logic".
923
924 The implementation is in insert_overlapping, where we remove matching
925 incoherent instances as long as there are others.
926
927
928
929 ************************************************************************
930 * *
931 Binding decisions
932 * *
933 ************************************************************************
934 -}
935
936 instanceBindFun :: TyVar -> BindFlag
937 instanceBindFun tv | isTcTyVar tv && isOverlappableTyVar tv = Skolem
938 | otherwise = BindMe
939 -- Note [Binding when looking up instances]
940
941 {-
942 Note [Binding when looking up instances]
943 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
944 When looking up in the instance environment, or family-instance environment,
945 we are careful about multiple matches, as described above in
946 Note [Overlapping instances]
947
948 The key_tys can contain skolem constants, and we can guarantee that those
949 are never going to be instantiated to anything, so we should not involve
950 them in the unification test. Example:
951 class Foo a where { op :: a -> Int }
952 instance Foo a => Foo [a] -- NB overlap
953 instance Foo [Int] -- NB overlap
954 data T = forall a. Foo a => MkT a
955 f :: T -> Int
956 f (MkT x) = op [x,x]
957 The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd
958 complain, saying that the choice of instance depended on the instantiation
959 of 'a'; but of course it isn't *going* to be instantiated.
960
961 We do this only for isOverlappableTyVar skolems. For example we reject
962 g :: forall a => [a] -> Int
963 g x = op x
964 on the grounds that the correct instance depends on the instantiation of 'a'
965 -}