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