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