Merge remote-tracking branch 'origin/pretty-build'
[ghc.git] / compiler / types / InstEnv.lhs
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 \begin{code}
10 module InstEnv (
11         DFunId, OverlapFlag(..), InstMatch, ClsInstLookupResult,
12         ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, 
13         instanceHead, mkLocalInstance, mkImportedInstance,
14         instanceDFunId, setInstanceDFunId, instanceRoughTcs,
15
16         InstEnv, emptyInstEnv, extendInstEnv, overwriteInstEnv, 
17         extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv', lookupInstEnv, instEnvElts,
18         classInstances, instanceBindFun,
19         instanceCantMatch, roughMatchTcs
20     ) where
21
22 #include "HsVersions.h"
23
24 import Class
25 import Var
26 import VarSet
27 import Name
28 import TcType
29 import TyCon
30 import Unify
31 import Outputable
32 import ErrUtils
33 import BasicTypes
34 import UniqFM
35 import Util
36 import Id
37 import FastString
38 import Data.Data        ( Data, Typeable )
39 import Data.Maybe       ( isJust, isNothing )
40 \end{code}
41
42
43 %************************************************************************
44 %*                                                                      *
45 \subsection{The key types}
46 %*                                                                      *
47 %************************************************************************
48
49 \begin{code}
50 data ClsInst 
51   = ClsInst { is_cls  :: Name  -- Class name
52
53                 -- Used for "rough matching"; see Note [Rough-match field]
54                 -- INVARIANT: is_tcs = roughMatchTcs is_tys
55              , is_tcs  :: [Maybe Name]  -- Top of type args
56
57                 -- Used for "proper matching"; see Note [Proper-match fields]
58              , is_tvs  :: TyVarSet      -- Template tyvars for full match
59              , is_tys  :: [Type]        -- Full arg types
60                 -- INVARIANT: is_dfun Id has type 
61                 --      forall is_tvs. (...) => is_cls is_tys
62
63              , is_dfun :: DFunId -- See Note [Haddock assumptions]
64              , is_flag :: OverlapFlag   -- See detailed comments with
65                                         -- the decl of BasicTypes.OverlapFlag
66     }
67   deriving (Data, Typeable)
68 \end{code}
69
70 Note [Rough-match field]
71 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
72 The is_cls, is_tcs fields allow a "rough match" to be done
73 without poking inside the DFunId.  Poking the DFunId forces
74 us to suck in all the type constructors etc it involves,
75 which is a total waste of time if it has no chance of matching
76 So the Name, [Maybe Name] fields allow us to say "definitely
77 does not match", based only on the Name.
78
79 In is_tcs, 
80     Nothing  means that this type arg is a type variable
81
82     (Just n) means that this type arg is a
83                 TyConApp with a type constructor of n.
84                 This is always a real tycon, never a synonym!
85                 (Two different synonyms might match, but two
86                 different real tycons can't.)
87                 NB: newtypes are not transparent, though!
88
89 Note [Proper-match fields]
90 ~~~~~~~~~~~~~~~~~~~~~~~~~
91 The is_tvs, is_tys fields are simply cached values, pulled
92 out (lazily) from the dfun id. They are cached here simply so 
93 that we don't need to decompose the DFunId each time we want 
94 to match it.  The hope is that the fast-match fields mean
95 that we often never poke th proper-match fields
96
97 However, note that:
98  * is_tvs must be a superset of the free vars of is_tys
99
100  * The is_dfun must itself be quantified over exactly is_tvs
101    (This is so that we can use the matching substitution to
102     instantiate the dfun's context.)
103
104 Note [Haddock assumptions]
105 ~~~~~~~~~~~~~~~~~~~~~~~~~~
106 For normal user-written instances, Haddock relies on
107
108  * the SrcSpan of
109  * the Name of
110  * the is_dfun of
111  * an Instance
112
113 being equal to
114
115   * the SrcSpan of
116   * the instance head type of
117   * the InstDecl used to construct the Instance.
118
119 \begin{code}
120 instanceDFunId :: ClsInst -> DFunId
121 instanceDFunId = is_dfun
122
123 setInstanceDFunId :: ClsInst -> DFunId -> ClsInst
124 setInstanceDFunId ispec dfun
125    = ASSERT2( idType dfun `eqType` idType (is_dfun ispec)
126             , ppr dfun $$ ppr (idType dfun) $$ ppr (is_dfun ispec) $$ ppr (idType (is_dfun ispec)) )
127         -- We need to create the cached fields afresh from
128         -- the new dfun id.  In particular, the is_tvs in
129         -- the ClsInst must match those in the dfun!
130         -- We assume that the only thing that changes is
131         -- the quantified type variables, so the other fields
132         -- are ok; hence the assert
133      ispec { is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys }
134    where 
135      (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
136
137 instanceRoughTcs :: ClsInst -> [Maybe Name]
138 instanceRoughTcs = is_tcs
139 \end{code}
140
141 \begin{code}
142 instance NamedThing ClsInst where
143    getName ispec = getName (is_dfun ispec)
144
145 instance Outputable ClsInst where
146    ppr = pprInstance
147
148 pprInstance :: ClsInst -> SDoc
149 -- Prints the ClsInst as an instance declaration
150 pprInstance ispec
151   = hang (pprInstanceHdr ispec)
152         2 (ptext (sLit "--") <+> pprDefinedAt (getName ispec))
153
154 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
155 pprInstanceHdr :: ClsInst -> SDoc
156 -- Prints the ClsInst as an instance declaration
157 pprInstanceHdr (ClsInst { is_flag = flag, is_dfun = dfun })
158   = ptext (sLit "instance") <+> ppr flag <+> pprSigmaType (idType dfun)
159         -- Print without the for-all, which the programmer doesn't write
160
161 pprInstances :: [ClsInst] -> SDoc
162 pprInstances ispecs = vcat (map pprInstance ispecs)
163
164 instanceHead :: ClsInst -> ([TyVar], ThetaType, Class, [Type])
165 instanceHead ispec = (tvs, theta, cls, tys)
166    where
167      (tvs, theta, tau) = tcSplitSigmaTy (idType dfun)
168      (cls, tys)        = tcSplitDFunHead tau
169      dfun              = is_dfun ispec
170
171 mkLocalInstance :: DFunId
172                 -> OverlapFlag
173                 -> ClsInst
174 -- Used for local instances, where we can safely pull on the DFunId
175 mkLocalInstance dfun oflag
176   = ClsInst {  is_flag = oflag, is_dfun = dfun,
177                 is_tvs = mkVarSet tvs, is_tys = tys,
178                 is_cls = className cls, is_tcs = roughMatchTcs tys }
179   where
180     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
181
182 mkImportedInstance :: Name -> [Maybe Name]
183                    -> DFunId -> OverlapFlag -> ClsInst
184 -- Used for imported instances, where we get the rough-match stuff
185 -- from the interface file
186 mkImportedInstance cls mb_tcs dfun oflag
187   = ClsInst {  is_flag = oflag, is_dfun = dfun,
188                 is_tvs = mkVarSet tvs, is_tys = tys,
189                 is_cls = cls, is_tcs = mb_tcs }
190   where
191     (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
192
193 roughMatchTcs :: [Type] -> [Maybe Name]
194 roughMatchTcs tys = map rough tys
195   where
196     rough ty = case tcSplitTyConApp_maybe ty of
197                   Just (tc,_) -> Just (tyConName tc)
198                   Nothing     -> Nothing
199
200 instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
201 -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
202 -- possibly be instantiated to actual, nor vice versa; 
203 -- False is non-committal
204 instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
205 instanceCantMatch _             _             =  False  -- Safe
206 \end{code}
207
208
209 Note [Overlapping instances]
210 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
211 Overlap is permitted, but only in such a way that one can make
212 a unique choice when looking up.  That is, overlap is only permitted if
213 one template matches the other, or vice versa.  So this is ok:
214
215   [a]  [Int]
216
217 but this is not
218
219   (Int,a)  (b,Int)
220
221 If overlap is permitted, the list is kept most specific first, so that
222 the first lookup is the right choice.
223
224
225 For now we just use association lists.
226
227 \subsection{Avoiding a problem with overlapping}
228
229 Consider this little program:
230
231 \begin{pseudocode}
232      class C a        where c :: a
233      class C a => D a where d :: a
234
235      instance C Int where c = 17
236      instance D Int where d = 13
237
238      instance C a => C [a] where c = [c]
239      instance ({- C [a], -} D a) => D [a] where d = c
240
241      instance C [Int] where c = [37]
242
243      main = print (d :: [Int])
244 \end{pseudocode}
245
246 What do you think `main' prints  (assuming we have overlapping instances, and
247 all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
248 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
249 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
250 the `C [Int]' instance is more specific).
251
252 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
253 was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
254 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
255 doesn't even compile!  What's going on!?
256
257 What hugs complains about is the `D [a]' instance decl.
258
259 \begin{pseudocode}
260      ERROR "mj.hs" (line 10): Cannot build superclass instance
261      *** Instance            : D [a]
262      *** Context supplied    : D a
263      *** Required superclass : C [a]
264 \end{pseudocode}
265
266 You might wonder what hugs is complaining about.  It's saying that you
267 need to add `C [a]' to the context of the `D [a]' instance (as appears
268 in comments).  But there's that `C [a]' instance decl one line above
269 that says that I can reduce the need for a `C [a]' instance to the
270 need for a `C a' instance, and in this case, I already have the
271 necessary `C a' instance (since we have `D a' explicitly in the
272 context, and `C' is a superclass of `D').
273
274 Unfortunately, the above reasoning indicates a premature commitment to the
275 generic `C [a]' instance.  I.e., it prematurely rules out the more specific
276 instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
277 add the context that hugs suggests (uncomment the `C [a]'), effectively
278 deferring the decision about which instance to use.
279
280 Now, interestingly enough, 4.04 has this same bug, but it's covered up
281 in this case by a little known `optimization' that was disabled in
282 4.06.  Ghc-4.04 silently inserts any missing superclass context into
283 an instance declaration.  In this case, it silently inserts the `C
284 [a]', and everything happens to work out.
285
286 (See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
287 `Mark Jones', although Mark claims no credit for the `optimization' in
288 question, and would rather it stopped being called the `Mark Jones
289 optimization' ;-)
290
291 So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
292 something else out with ghc-4.04.  Let's add the following line:
293
294     d' :: D a => [a]
295     d' = c
296
297 Everyone raise their hand who thinks that `d :: [Int]' should give a
298 different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
299 `optimization' only applies to instance decls, not to regular
300 bindings, giving inconsistent behavior.
301
302 Old hugs had this same bug.  Here's how we fixed it: like GHC, the
303 list of instances for a given class is ordered, so that more specific
304 instances come before more generic ones.  For example, the instance
305 list for C might contain:
306     ..., C Int, ..., C a, ...  
307 When we go to look for a `C Int' instance we'll get that one first.
308 But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
309 pass the `C Int' instance, and keep going.  But if `b' is
310 unconstrained, then we don't know yet if the more specific instance
311 will eventually apply.  GHC keeps going, and matches on the generic `C
312 a'.  The fix is to, at each step, check to see if there's a reverse
313 match, and if so, abort the search.  This prevents hugs from
314 prematurely chosing a generic instance when a more specific one
315 exists.
316
317 --Jeff
318
319 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
320 this test.  Suppose the instance envt had
321     ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
322 (still most specific first)
323 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
324         C x y Int  doesn't match the template {a,b} C a a b
325 but neither does 
326         C a a b  match the template {x,y} C x y Int
327 But still x and y might subsequently be unified so they *do* match.
328
329 Simple story: unify, don't match.
330
331
332 %************************************************************************
333 %*                                                                      *
334                 InstEnv, ClsInstEnv
335 %*                                                                      *
336 %************************************************************************
337
338 A @ClsInstEnv@ all the instances of that class.  The @Id@ inside a
339 ClsInstEnv mapping is the dfun for that instance.
340
341 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
342
343         forall a b, C t1 t2 t3  can be constructed by dfun
344
345 or, to put it another way, we have
346
347         instance (...) => C t1 t2 t3,  witnessed by dfun
348
349 \begin{code}
350 ---------------------------------------------------
351 type InstEnv = UniqFM ClsInstEnv        -- Maps Class to instances for that class
352
353 newtype ClsInstEnv 
354   = ClsIE [ClsInst]    -- The instances for a particular class, in any order
355
356 instance Outputable ClsInstEnv where
357   ppr (ClsIE is) = pprInstances is
358
359 -- INVARIANTS:
360 --  * The is_tvs are distinct in each ClsInst
361 --      of a ClsInstEnv (so we can safely unify them)
362
363 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
364 --      [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
365 -- The "a" in the pattern must be one of the forall'd variables in
366 -- the dfun type.
367
368 emptyInstEnv :: InstEnv
369 emptyInstEnv = emptyUFM
370
371 instEnvElts :: InstEnv -> [ClsInst]
372 instEnvElts ie = [elt | ClsIE elts <- eltsUFM ie, elt <- elts]
373
374 classInstances :: (InstEnv,InstEnv) -> Class -> [ClsInst]
375 classInstances (pkg_ie, home_ie) cls 
376   = get home_ie ++ get pkg_ie
377   where
378     get env = case lookupUFM env cls of
379                 Just (ClsIE insts) -> insts
380                 Nothing            -> []
381
382 extendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv
383 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
384
385 extendInstEnv :: InstEnv -> ClsInst -> InstEnv
386 extendInstEnv inst_env ins_item@(ClsInst { is_cls = cls_nm })
387   = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
388   where
389     add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts)
390
391 overwriteInstEnv :: InstEnv -> ClsInst -> InstEnv
392 overwriteInstEnv inst_env ins_item@(ClsInst { is_cls = cls_nm, is_tys = tys })
393   = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
394   where
395     add (ClsIE cur_insts) _ = ClsIE (replaceInst cur_insts)
396     
397     rough_tcs  = roughMatchTcs tys
398     replaceInst [] = [ins_item]
399     replaceInst (item@(ClsInst { is_tcs = mb_tcs,  is_tvs = tpl_tvs, 
400                                   is_tys = tpl_tys,
401                                   is_dfun = dfun }) : rest)
402     -- Fast check for no match, uses the "rough match" fields
403       | instanceCantMatch rough_tcs mb_tcs
404       = item : replaceInst rest
405
406       | Just _ <- tcMatchTys tpl_tvs tpl_tys tys
407       = let (dfun_tvs, _) = tcSplitForAllTys (idType dfun)
408         in ASSERT( all (`elemVarSet` tpl_tvs) dfun_tvs )        -- Check invariant
409            ins_item : rest
410
411       | otherwise
412       = item : replaceInst rest
413 \end{code}
414
415
416 %************************************************************************
417 %*                                                                      *
418         Looking up an instance
419 %*                                                                      *
420 %************************************************************************
421
422 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since
423 the env is kept ordered, the first match must be the only one.  The
424 thing we are looking up can have an arbitrary "flexi" part.
425
426 \begin{code}
427 type DFunInstType = Maybe Type
428         -- Just ty   => Instantiate with this type
429         -- Nothing   => Instantiate with any type of this tyvar's kind
430         -- See Note [DFunInstType: instantiating types]
431
432 type InstMatch = (ClsInst, [DFunInstType])
433
434 type ClsInstLookupResult 
435      = ( [InstMatch]     -- Successful matches
436        , [ClsInst]       -- These don't match but do unify
437        , Bool)           -- True if error condition caused by
438                          -- SafeHaskell condition.
439 \end{code}
440
441 Note [DFunInstType: instantiating types]
442 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
443 A successful match is an ClsInst, together with the types at which
444         the dfun_id in the ClsInst should be instantiated
445 The instantiating types are (Either TyVar Type)s because the dfun
446 might have some tyvars that *only* appear in arguments
447         dfun :: forall a b. C a b, Ord b => D [a]
448 When we match this against D [ty], we return the instantiating types
449         [Just ty, Nothing]
450 where the 'Nothing' indicates that 'b' can be freely instantiated.  
451 (The caller instantiates it to a flexi type variable, which will 
452  presumably later become fixed via functional dependencies.)
453
454 \begin{code}
455 -- |Look up an instance in the given instance environment. The given class application must match exactly
456 -- one instance and the match may not contain any flexi type variables.  If the lookup is unsuccessful,
457 -- yield 'Left errorMessage'.
458 --
459 lookupUniqueInstEnv :: (InstEnv, InstEnv) 
460                     -> Class -> [Type]
461                     -> Either MsgDoc (ClsInst, [Type])
462 lookupUniqueInstEnv instEnv cls tys
463   = case lookupInstEnv instEnv cls tys of
464       ([(inst, inst_tys)], _, _) 
465              | noFlexiVar -> Right (inst, inst_tys')
466              | otherwise  -> Left $ ptext (sLit "flexible type variable:") <+>
467                                     (ppr $ mkTyConApp (classTyCon cls) tys)
468              where
469                inst_tys'  = [ty | Just ty <- inst_tys]
470                noFlexiVar = all isJust inst_tys
471       _other -> Left $ ptext (sLit "instance not found") <+> (ppr $ mkTyConApp (classTyCon cls) tys)
472
473 lookupInstEnv' :: InstEnv          -- InstEnv to look in
474                -> Class -> [Type]  -- What we are looking for
475                -> ([InstMatch],    -- Successful matches
476                    [ClsInst])     -- These don't match but do unify
477 -- The second component of the result pair happens when we look up
478 --      Foo [a]
479 -- in an InstEnv that has entries for
480 --      Foo [Int]
481 --      Foo [b]
482 -- Then which we choose would depend on the way in which 'a'
483 -- is instantiated.  So we report that Foo [b] is a match (mapping b->a)
484 -- but Foo [Int] is a unifier.  This gives the caller a better chance of
485 -- giving a suitable error message
486
487 lookupInstEnv' ie cls tys
488   = lookup ie
489   where
490     rough_tcs  = roughMatchTcs tys
491     all_tvs    = all isNothing rough_tcs
492     --------------
493     lookup env = case lookupUFM env cls of
494                    Nothing -> ([],[])   -- No instances for this class
495                    Just (ClsIE insts) -> find [] [] insts
496
497     --------------
498     find ms us [] = (ms, us)
499     find ms us (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs, 
500                                  is_tys = tpl_tys, is_flag = oflag,
501                                  is_dfun = dfun }) : rest)
502         -- Fast check for no match, uses the "rough match" fields
503       | instanceCantMatch rough_tcs mb_tcs
504       = find ms us rest
505
506       | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
507       = let 
508             (dfun_tvs, _) = tcSplitForAllTys (idType dfun)
509         in 
510         ASSERT( all (`elemVarSet` tpl_tvs) dfun_tvs )   -- Check invariant
511         find ((item, map (lookup_tv subst) dfun_tvs) : ms) us rest
512
513         -- Does not match, so next check whether the things unify
514         -- See Note [Overlapping instances] above
515       | Incoherent _ <- oflag
516       = find ms us rest
517
518       | otherwise
519       = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
520                  (ppr cls <+> ppr tys <+> ppr all_tvs) $$
521                  (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
522                 )
523                 -- Unification will break badly if the variables overlap
524                 -- They shouldn't because we allocate separate uniques for them
525         case tcUnifyTys instanceBindFun tpl_tys tys of
526             Just _   -> find ms (item:us) rest
527             Nothing  -> find ms us        rest
528
529     ----------------
530     lookup_tv :: TvSubst -> TyVar -> DFunInstType
531         -- See Note [DFunInstType: instantiating types]
532     lookup_tv subst tv = case lookupTyVar subst tv of
533                                 Just ty -> Just ty
534                                 Nothing -> Nothing
535
536 ---------------
537 -- This is the common way to call this function.
538 lookupInstEnv :: (InstEnv, InstEnv)     -- External and home package inst-env
539               -> Class -> [Type]   -- What we are looking for
540               -> ClsInstLookupResult
541  
542 lookupInstEnv (pkg_ie, home_ie) cls tys
543   = (safe_matches, all_unifs, safe_fail)
544   where
545     (home_matches, home_unifs) = lookupInstEnv' home_ie cls tys
546     (pkg_matches,  pkg_unifs)  = lookupInstEnv' pkg_ie  cls tys
547     all_matches = home_matches ++ pkg_matches
548     all_unifs   = home_unifs   ++ pkg_unifs
549     pruned_matches = foldr insert_overlapping [] all_matches
550     (safe_matches, safe_fail) = if length pruned_matches == 1 
551                         then check_safe (head pruned_matches) all_matches
552                         else (pruned_matches, False)
553         -- Even if the unifs is non-empty (an error situation)
554         -- we still prune the matches, so that the error message isn't
555         -- misleading (complaining of multiple matches when some should be
556         -- overlapped away)
557
558     -- Safe Haskell: We restrict code compiled in 'Safe' mode from 
559     -- overriding code compiled in any other mode. The rational is
560     -- that code compiled in 'Safe' mode is code that is untrusted
561     -- by the ghc user. So we shouldn't let that code change the
562     -- behaviour of code the user didn't compile in 'Safe' mode
563     -- since that's the code they trust. So 'Safe' instances can only
564     -- overlap instances from the same module. A same instance origin
565     -- policy for safe compiled instances.
566     check_safe match@(inst,_) others
567         = case isSafeOverlap (is_flag inst) of
568                 -- most specific isn't from a Safe module so OK
569                 False -> ([match], False)
570                 -- otherwise we make sure it only overlaps instances from
571                 -- the same module
572                 True -> (go [] others, True)
573         where
574             go bad [] = match:bad
575             go bad (i@(x,_):unchecked) =
576                 if inSameMod x
577                     then go bad unchecked
578                     else go (i:bad) unchecked
579             
580             inSameMod b =
581                 let na = getName $ getName inst
582                     la = isInternalName na
583                     nb = getName $ getName b
584                     lb = isInternalName nb
585                 in (la && lb) || (nameModule na == nameModule nb)
586
587 ---------------
588 ---------------
589 insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]
590 -- Add a new solution, knocking out strictly less specific ones
591 insert_overlapping new_item [] = [new_item]
592 insert_overlapping new_item (item:items)
593   | new_beats_old && old_beats_new = item : insert_overlapping new_item items
594         -- Duplicate => keep both for error report
595   | new_beats_old = insert_overlapping new_item items
596         -- Keep new one
597   | old_beats_new = item : items
598         -- Keep old one
599   | otherwise     = item : insert_overlapping new_item items
600         -- Keep both
601   where
602     new_beats_old = new_item `beats` item
603     old_beats_new = item `beats` new_item
604
605     (instA, _) `beats` (instB, _)
606           = overlap_ok && 
607             isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
608                     -- A beats B if A is more specific than B,
609                     -- (ie. if B can be instantiated to match A)
610                     -- and overlap is permitted
611           where
612             -- Overlap permitted if *either* instance permits overlap
613             -- This is a change (Trac #3877, Dec 10). It used to
614             -- require that instB (the less specific one) permitted overlap.
615             overlap_ok = case (is_flag instA, is_flag instB) of
616                               (NoOverlap _, NoOverlap _) -> False
617                               _                          -> True
618 \end{code}
619
620
621 %************************************************************************
622 %*                                                                      *
623         Binding decisions
624 %*                                                                      *
625 %************************************************************************
626
627 \begin{code}
628 instanceBindFun :: TyVar -> BindFlag
629 instanceBindFun tv | isTcTyVar tv && isOverlappableTyVar tv = Skolem
630                    | otherwise                              = BindMe
631    -- Note [Binding when looking up instances]
632 \end{code}
633
634 Note [Binding when looking up instances]
635 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
636 When looking up in the instance environment, or family-instance environment,
637 we are careful about multiple matches, as described above in 
638 Note [Overlapping instances]
639
640 The key_tys can contain skolem constants, and we can guarantee that those
641 are never going to be instantiated to anything, so we should not involve
642 them in the unification test.  Example:
643         class Foo a where { op :: a -> Int }
644         instance Foo a => Foo [a]       -- NB overlap
645         instance Foo [Int]              -- NB overlap
646         data T = forall a. Foo a => MkT a
647         f :: T -> Int
648         f (MkT x) = op [x,x]
649 The op [x,x] means we need (Foo [a]).  Without the filterVarSet we'd
650 complain, saying that the choice of instance depended on the instantiation
651 of 'a'; but of course it isn't *going* to be instantiated.
652
653 We do this only for isOverlappableTyVar skolems.  For example we reject
654         g :: forall a => [a] -> Int
655         g x = op x
656 on the grounds that the correct instance depends on the instantiation of 'a'