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