Updated documentation; changed "group" to "branched" in type families
[ghc.git] / compiler / types / FunDeps.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 2000
4 %
5
6 FunDeps - functional dependencies
7
8 It's better to read it as: "if we know these, then we're going to know these"
9
10 \begin{code}
11 {-# OPTIONS -fno-warn-tabs #-}
12 -- The above warning supression flag is a temporary kludge.
13 -- While working on this module you are encouraged to remove it and
14 -- detab the module (please do the detabbing in a separate patch). See
15 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
16 -- for details
17
18 module FunDeps (
19         FDEq (..),
20         Equation(..), pprEquation,
21         improveFromInstEnv, improveFromAnother,
22         checkInstCoverage, checkInstLiberalCoverage, checkFunDeps,
23         growThetaTyVars, pprFundeps
24     ) where
25
26 #include "HsVersions.h"
27
28 import Name
29 import Var
30 import Class
31 import Type
32 import Unify
33 import InstEnv
34 import VarSet
35 import VarEnv
36 import Outputable
37 import Util
38 import FastString
39
40 import Data.List        ( nubBy )
41 import Data.Maybe       ( isJust )
42 \end{code}
43
44
45 %************************************************************************
46 %*                                                                      *
47 \subsection{Close type variables}
48 %*                                                                      *
49 %************************************************************************
50
51   oclose(vs,C)  The result of extending the set of tyvars vs
52                 using the functional dependencies from C
53
54   growThetaTyVars(C,vs)  The result of extend the set of tyvars vs
55                          using all conceivable links from C.
56
57                 E.g. vs = {a}, C = {H [a] b, K (b,Int) c, Eq e}
58                 Then grow(vs,C) = {a,b,c}
59
60                 Note that grow(vs,C) `superset` grow(vs,simplify(C))
61                 That is, simplfication can only shrink the result of grow.
62
63 Notice that
64    oclose is conservative                v `elem` oclose(vs,C)
65           one way:                        => v is definitely fixed by vs
66
67    growThetaTyVars is conservative       if v might be fixed by vs 
68           the other way:                 => v `elem` grow(vs,C)
69
70 ----------------------------------------------------------
71 (oclose preds tvs) closes the set of type variables tvs, 
72 wrt functional dependencies in preds.  The result is a superset
73 of the argument set.  For example, if we have
74         class C a b | a->b where ...
75 then
76         oclose [C (x,y) z, C (x,p) q] {x,y} = {x,y,z}
77 because if we know x and y then that fixes z.
78
79 We also use equality predicates in the predicates; if we have an
80 assumption `t1 ~ t2`, then we use the fact that if we know `t1` we
81 also know `t2` and the other way.
82   eg    oclose [C (x,y) z, a ~ x] {a,y} = {a,y,z,x}
83
84 oclose is used (only) when checking functional dependencies
85
86 \begin{code}
87 oclose :: [PredType] -> TyVarSet -> TyVarSet
88 oclose preds fixed_tvs
89   | null tv_fds = fixed_tvs -- Fast escape hatch for common case.
90   | otherwise   = loop fixed_tvs
91   where
92     loop fixed_tvs
93       | new_fixed_tvs `subVarSet` fixed_tvs = fixed_tvs
94       | otherwise                           = loop new_fixed_tvs
95       where new_fixed_tvs = foldl extend fixed_tvs tv_fds
96
97     extend fixed_tvs (ls,rs)
98         | ls `subVarSet` fixed_tvs = fixed_tvs `unionVarSet` rs
99         | otherwise                = fixed_tvs
100
101     tv_fds  :: [(TyVarSet,TyVarSet)]
102     tv_fds  = [ (tyVarsOfTypes xs, tyVarsOfTypes ys)
103               | (xs, ys) <- concatMap determined preds
104               ]
105
106     determined :: PredType -> [([Type],[Type])]
107     determined pred
108        = case classifyPredType pred of
109             ClassPred cls tys ->
110                do let (cls_tvs, cls_fds) = classTvsFds cls
111                   fd <- cls_fds
112                   return (instFD fd cls_tvs tys)
113             EqPred t1 t2      -> [([t1],[t2]), ([t2],[t1])]
114             TuplePred ts      -> concatMap determined ts
115             _                 -> []
116
117 \end{code}
118
119 Note [Growing the tau-tvs using constraints]
120 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
121 (growThetaTyVars insts tvs) is the result of extending the set 
122     of tyvars tvs using all conceivable links from pred
123
124 E.g. tvs = {a}, preds = {H [a] b, K (b,Int) c, Eq e}
125 Then growThetaTyVars preds tvs = {a,b,c}
126
127 \begin{code}
128 growThetaTyVars :: ThetaType -> TyVarSet -> TyVarSet
129 -- See Note [Growing the tau-tvs using constraints]
130 growThetaTyVars theta tvs
131   | null theta = tvs
132   | otherwise  = fixVarSet mk_next tvs
133   where
134     mk_next tvs = foldr grow_one tvs theta
135     grow_one pred tvs = growPredTyVars pred tvs `unionVarSet` tvs
136
137 growPredTyVars :: PredType
138                -> TyVarSet      -- The set to extend
139                -> TyVarSet      -- TyVars of the predicate if it intersects the set, 
140 growPredTyVars pred tvs 
141    | isIPPred pred                   = pred_tvs   -- Always quantify over implicit parameers
142    | pred_tvs `intersectsVarSet` tvs = pred_tvs
143    | otherwise                       = emptyVarSet
144   where
145     pred_tvs = tyVarsOfType pred
146 \end{code}
147
148     
149 %************************************************************************
150 %*                                                                      *
151 \subsection{Generate equations from functional dependencies}
152 %*                                                                      *
153 %************************************************************************
154
155
156 Each functional dependency with one variable in the RHS is responsible
157 for generating a single equality. For instance:
158      class C a b | a -> b
159 The constraints ([Wanted] C Int Bool) and [Wanted] C Int alpha 
160      FDEq { fd_pos      = 1
161           , fd_ty_left  = Bool 
162           , fd_ty_right = alpha }
163 However notice that a functional dependency may have more than one variable
164 in the RHS which will create more than one FDEq. Example: 
165      class C a b c | a -> b c 
166      [Wanted] C Int alpha alpha 
167      [Wanted] C Int Bool beta 
168 Will generate: 
169         fd1 = FDEq { fd_pos = 1, fd_ty_left = alpha, fd_ty_right = Bool } and
170         fd2 = FDEq { fd_pos = 2, fd_ty_left = alpha, fd_ty_right = beta }
171
172 We record the paremeter position so that can immediately rewrite a constraint
173 using the produced FDEqs and remove it from our worklist.
174
175
176 INVARIANT: Corresponding types aren't already equal 
177 That is, there exists at least one non-identity equality in FDEqs. 
178
179 Assume:
180        class C a b c | a -> b c
181        instance C Int x x
182 And:   [Wanted] C Int Bool alpha
183 We will /match/ the LHS of fundep equations, producing a matching substitution
184 and create equations for the RHS sides. In our last example we'd have generated:
185       ({x}, [fd1,fd2])
186 where 
187        fd1 = FDEq 1 Bool x
188        fd2 = FDEq 2 alpha x
189 To ``execute'' the equation, make fresh type variable for each tyvar in the set,
190 instantiate the two types with these fresh variables, and then unify or generate 
191 a new constraint. In the above example we would generate a new unification 
192 variable 'beta' for x and produce the following constraints:
193      [Wanted] (Bool ~ beta)
194      [Wanted] (alpha ~ beta)
195
196 Notice the subtle difference between the above class declaration and:
197        class C a b c | a -> b, a -> c 
198 where we would generate: 
199       ({x},[fd1]),({x},[fd2]) 
200 This means that the template variable would be instantiated to different 
201 unification variables when producing the FD constraints. 
202
203 Finally, the position parameters will help us rewrite the wanted constraint ``on the spot''
204
205 \begin{code}
206 type Pred_Loc = (PredType, SDoc)        -- SDoc says where the Pred comes from
207
208 data Equation 
209    = FDEqn { fd_qtvs :: [TyVar]                 -- Instantiate these type and kind vars to fresh unification vars
210            , fd_eqs  :: [FDEq]                  --   and then make these equal
211            , fd_pred1, fd_pred2 :: Pred_Loc }   -- The Equation arose from
212                                                 -- combining these two constraints
213
214 data FDEq = FDEq { fd_pos      :: Int -- We use '0' for the first position
215                  , fd_ty_left  :: Type
216                  , fd_ty_right :: Type }
217
218 instance Outputable FDEq where
219   ppr (FDEq { fd_pos = p, fd_ty_left = tyl, fd_ty_right = tyr })
220     = parens (int p <> comma <+> ppr tyl <> comma <+> ppr tyr)
221 \end{code}
222
223 Given a bunch of predicates that must hold, such as
224
225         C Int t1, C Int t2, C Bool t3, ?x::t4, ?x::t5
226
227 improve figures out what extra equations must hold.
228 For example, if we have
229
230         class C a b | a->b where ...
231
232 then improve will return
233
234         [(t1,t2), (t4,t5)]
235
236 NOTA BENE:
237
238   * improve does not iterate.  It's possible that when we make
239     t1=t2, for example, that will in turn trigger a new equation.
240     This would happen if we also had
241         C t1 t7, C t2 t8
242     If t1=t2, we also get t7=t8.
243
244     improve does *not* do this extra step.  It relies on the caller
245     doing so.
246
247   * The equations unify types that are not already equal.  So there
248     is no effect iff the result of improve is empty
249
250
251
252 \begin{code}
253 instFD_WithPos :: FunDep TyVar -> [TyVar] -> [Type] -> ([Type], [(Int,Type)]) 
254 -- Returns a FunDep between the types accompanied along with their 
255 -- position (<=0) in the types argument list.
256 instFD_WithPos (ls,rs) tvs tys
257   = (map (snd . lookup) ls, map lookup rs)
258   where
259     ind_tys   = zip [0..] tys 
260     env       = zipVarEnv tvs ind_tys
261     lookup tv = lookupVarEnv_NF env tv
262
263 zipAndComputeFDEqs :: (Type -> Type -> Bool) -- Discard this FDEq if true
264                    -> [Type] 
265                    -> [(Int,Type)] 
266                    -> [FDEq]
267 -- Create a list of FDEqs from two lists of types, making sure
268 -- that the types are not equal.
269 zipAndComputeFDEqs discard (ty1:tys1) ((i2,ty2):tys2)
270  | discard ty1 ty2 = zipAndComputeFDEqs discard tys1 tys2
271  | otherwise = FDEq { fd_pos      = i2
272                     , fd_ty_left  = ty1
273                     , fd_ty_right = ty2 } : zipAndComputeFDEqs discard tys1 tys2
274 zipAndComputeFDEqs _ _ _ = [] 
275
276 -- Improve a class constraint from another class constraint
277 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278 improveFromAnother :: Pred_Loc -- Template item (usually given, or inert) 
279                    -> Pred_Loc -- Workitem [that can be improved]
280                    -> [Equation]
281 -- Post: FDEqs always oriented from the other to the workitem 
282 --       Equations have empty quantified variables 
283 improveFromAnother pred1@(ty1, _) pred2@(ty2, _)
284   | Just (cls1, tys1) <- getClassPredTys_maybe ty1
285   , Just (cls2, tys2) <- getClassPredTys_maybe ty2
286   , tys1 `lengthAtLeast` 2 && cls1 == cls2
287   = [ FDEqn { fd_qtvs = [], fd_eqs = eqs, fd_pred1 = pred1, fd_pred2 = pred2 }
288     | let (cls_tvs, cls_fds) = classTvsFds cls1
289     , fd <- cls_fds
290     , let (ltys1, rs1)  = instFD         fd cls_tvs tys1
291           (ltys2, irs2) = instFD_WithPos fd cls_tvs tys2
292     , eqTypes ltys1 ltys2               -- The LHSs match
293     , let eqs = zipAndComputeFDEqs eqType rs1 irs2
294     , not (null eqs) ]
295
296 improveFromAnother _ _ = []
297
298
299 -- Improve a class constraint from instance declarations
300 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
301
302 pprEquation :: Equation -> SDoc
303 pprEquation (FDEqn { fd_qtvs = qtvs, fd_eqs = pairs }) 
304   = vcat [ptext (sLit "forall") <+> braces (pprWithCommas ppr qtvs),
305           nest 2 (vcat [ ppr t1 <+> ptext (sLit "~") <+> ppr t2 | (FDEq _ t1 t2) <- pairs])]
306
307 improveFromInstEnv :: (InstEnv,InstEnv)
308                    -> Pred_Loc
309                    -> [Equation] -- Needs to be an Equation because
310                                  -- of quantified variables
311 -- Post: Equations oriented from the template (matching instance) to the workitem!
312 improveFromInstEnv _inst_env (pred,_loc)
313   | not (isClassPred pred)
314   = panic "improveFromInstEnv: not a class predicate"
315 improveFromInstEnv inst_env pred@(ty, _)
316   | Just (cls, tys) <- getClassPredTys_maybe ty
317   , tys `lengthAtLeast` 2
318   , let (cls_tvs, cls_fds) = classTvsFds cls
319         instances          = classInstances inst_env cls
320         rough_tcs          = roughMatchTcs tys
321   = [ FDEqn { fd_qtvs = meta_tvs, fd_eqs = eqs, fd_pred1 = p_inst, fd_pred2=pred }
322     | fd <- cls_fds             -- Iterate through the fundeps first,
323                                 -- because there often are none!
324     , let trimmed_tcs = trimRoughMatchTcs cls_tvs fd rough_tcs
325                 -- Trim the rough_tcs based on the head of the fundep.
326                 -- Remember that instanceCantMatch treats both argumnents
327                 -- symmetrically, so it's ok to trim the rough_tcs,
328                 -- rather than trimming each inst_tcs in turn
329     , ispec <- instances
330     , (meta_tvs, eqs) <- checkClsFD fd cls_tvs ispec 
331                                     emptyVarSet tys trimmed_tcs -- NB: orientation
332     , let p_inst = (mkClassPred cls (is_tys ispec),
333                     sep [ ptext (sLit "arising from the dependency") <+> quotes (pprFunDep fd)  
334                         , ptext (sLit "in the instance declaration")
335                           <+> pprNameDefnLoc (getName ispec)])
336     ]
337 improveFromInstEnv _ _ = []
338
339
340 checkClsFD :: FunDep TyVar -> [TyVar]             -- One functional dependency from the class
341            -> ClsInst                             -- An instance template
342            -> TyVarSet -> [Type] -> [Maybe Name]  -- Arguments of this (C tys) predicate
343                                                   -- TyVarSet are extra tyvars that can be instantiated
344            -> [([TyVar], [FDEq])]
345
346 checkClsFD fd clas_tvs 
347            (ClsInst { is_tvs = qtvs, is_tys = tys_inst, is_tcs = rough_tcs_inst })
348            extra_qtvs tys_actual rough_tcs_actual
349
350 -- 'qtvs' are the quantified type variables, the ones which an be instantiated 
351 -- to make the types match.  For example, given
352 --      class C a b | a->b where ...
353 --      instance C (Maybe x) (Tree x) where ..
354 --
355 -- and an Inst of form (C (Maybe t1) t2), 
356 -- then we will call checkClsFD with
357 --
358 --      is_qtvs = {x}, is_tys = [Maybe x,  Tree x]
359 --                     tys_actual = [Maybe t1, t2]
360 --
361 -- We can instantiate x to t1, and then we want to force
362 --      (Tree x) [t1/x]  ~   t2
363 --
364 -- This function is also used when matching two Insts (rather than an Inst
365 -- against an instance decl. In that case, qtvs is empty, and we are doing
366 -- an equality check
367 -- 
368 -- This function is also used by InstEnv.badFunDeps, which needs to *unify*
369 -- For the one-sided matching case, the qtvs are just from the template,
370 -- so we get matching
371
372   | instanceCantMatch rough_tcs_inst rough_tcs_actual
373   = []          -- Filter out ones that can't possibly match, 
374
375   | otherwise
376   = ASSERT2( length tys_inst == length tys_actual     && 
377              length tys_inst == length clas_tvs 
378             , ppr tys_inst <+> ppr tys_actual )
379
380     case tcUnifyTys bind_fn ltys1 ltys2 of
381         Nothing  -> []
382         Just subst | isJust (tcUnifyTys bind_fn rtys1' rtys2')
383                         -- Don't include any equations that already hold.
384                         -- Reason: then we know if any actual improvement has happened,
385                         --         in which case we need to iterate the solver
386                         -- In making this check we must taking account of the fact that any
387                         -- qtvs that aren't already instantiated can be instantiated to anything
388                         -- at all
389                         -- NB: We can't do this 'is-useful-equation' check element-wise 
390                         --     because of:
391                         --           class C a b c | a -> b c
392                         --           instance C Int x x
393                         --           [Wanted] C Int alpha Int
394                         -- We would get that  x -> alpha  (isJust) and x -> Int (isJust)
395                         -- so we would produce no FDs, which is clearly wrong. 
396                   -> [] 
397
398                   | null fdeqs
399                   -> []
400
401                   | otherwise
402                   -> [(meta_tvs, fdeqs)]
403                         -- We could avoid this substTy stuff by producing the eqn
404                         -- (qtvs, ls1++rs1, ls2++rs2)
405                         -- which will re-do the ls1/ls2 unification when the equation is
406                         -- executed.  What we're doing instead is recording the partial
407                         -- work of the ls1/ls2 unification leaving a smaller unification problem
408                   where
409                     rtys1' = map (substTy subst) rtys1
410                     irs2'  = map (\(i,x) -> (i,substTy subst x)) irs2
411                     rtys2' = map snd irs2'
412  
413                     fdeqs = zipAndComputeFDEqs (\_ _ -> False) rtys1' irs2'
414                         -- Don't discard anything! 
415                         -- We could discard equal types but it's an overkill to call 
416                         -- eqType again, since we know for sure that /at least one/ 
417                         -- equation in there is useful)
418
419                     meta_tvs = [ setVarType tv (substTy subst (varType tv))
420                                | tv <- qtvs, tv `notElemTvSubst` subst ]
421                         -- meta_tvs are the quantified type variables
422                         -- that have not been substituted out
423                         --      
424                         -- Eg.  class C a b | a -> b
425                         --      instance C Int [y]
426                         -- Given constraint C Int z
427                         -- we generate the equation
428                         --      ({y}, [y], z)
429                         --
430                         -- But note (a) we get them from the dfun_id, so they are *in order*
431                         --              because the kind variables may be mentioned in the
432                         --              type variabes' kinds
433                         --          (b) we must apply 'subst' to the kinds, in case we have
434                         --              matched out a kind variable, but not a type variable
435                         --              whose kind mentions that kind variable!
436                         --          Trac #6015, #6068
437   where
438     qtv_set = mkVarSet qtvs
439     bind_fn tv | tv `elemVarSet` qtv_set    = BindMe
440                | tv `elemVarSet` extra_qtvs = BindMe
441                | otherwise                  = Skolem
442
443     (ltys1, rtys1) = instFD         fd clas_tvs tys_inst
444     (ltys2, irs2)  = instFD_WithPos fd clas_tvs tys_actual
445 \end{code}
446
447
448 \begin{code}
449 instFD :: FunDep TyVar -> [TyVar] -> [Type] -> FunDep Type
450 -- A simpler version of instFD_WithPos to be used in checking instance coverage etc.
451 instFD (ls,rs) tvs tys
452   = (map lookup ls, map lookup rs)
453   where
454     env       = zipVarEnv tvs tys
455     lookup tv = lookupVarEnv_NF env tv
456
457 checkInstCoverage :: Class -> [Type] -> Bool
458 -- Check that the Coverage Condition is obeyed in an instance decl
459 -- For example, if we have 
460 --      class theta => C a b | a -> b
461 --      instance C t1 t2 
462 -- Then we require fv(t2) `subset` fv(t1)
463 -- See Note [Coverage Condition] below
464
465 checkInstCoverage clas inst_taus
466   = all fundep_ok fds
467   where
468     (tyvars, fds) = classTvsFds clas
469     fundep_ok fd  = tyVarsOfTypes rs `subVarSet` tyVarsOfTypes ls
470                  where
471                    (ls,rs) = instFD fd tyvars inst_taus
472
473 checkInstLiberalCoverage :: Class -> [PredType] -> [Type] -> Bool
474 -- Check that the Liberal Coverage Condition is obeyed in an instance decl
475 -- For example, if we have:
476 --    class C a b | a -> b
477 --    instance theta => C t1 t2
478 -- Then we require fv(t2) `subset` oclose(fv(t1), theta)
479 -- This ensures the self-consistency of the instance, but
480 -- it does not guarantee termination.
481 -- See Note [Coverage Condition] below
482
483 checkInstLiberalCoverage clas theta inst_taus
484   = all fundep_ok fds
485   where
486     (tyvars, fds) = classTvsFds clas
487     fundep_ok fd = tyVarsOfTypes rs `subVarSet` oclose theta (tyVarsOfTypes ls)
488                     where (ls,rs) = instFD fd tyvars inst_taus
489 \end{code}
490
491 Note [Coverage condition]
492 ~~~~~~~~~~~~~~~~~~~~~~~~~
493 For the coverage condition, we used to require only that 
494         fv(t2) `subset` oclose(fv(t1), theta)
495
496 Example:
497         class Mul a b c | a b -> c where
498                 (.*.) :: a -> b -> c
499
500         instance Mul Int Int Int where (.*.) = (*)
501         instance Mul Int Float Float where x .*. y = fromIntegral x * y
502         instance Mul a b c => Mul a [b] [c] where x .*. v = map (x.*.) v
503
504 In the third instance, it's not the case that fv([c]) `subset` fv(a,[b]).
505 But it is the case that fv([c]) `subset` oclose( theta, fv(a,[b]) )
506
507 But it is a mistake to accept the instance because then this defn:
508         f = \ b x y -> if b then x .*. [y] else y
509 makes instance inference go into a loop, because it requires the constraint
510         Mul a [b] b
511
512
513 %************************************************************************
514 %*                                                                      *
515         Check that a new instance decl is OK wrt fundeps
516 %*                                                                      *
517 %************************************************************************
518
519 Here is the bad case:
520         class C a b | a->b where ...
521         instance C Int Bool where ...
522         instance C Int Char where ...
523
524 The point is that a->b, so Int in the first parameter must uniquely
525 determine the second.  In general, given the same class decl, and given
526
527         instance C s1 s2 where ...
528         instance C t1 t2 where ...
529
530 Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
531
532 Matters are a little more complicated if there are free variables in
533 the s2/t2.  
534
535         class D a b c | a -> b
536         instance D a b => D [(a,a)] [b] Int
537         instance D a b => D [a]     [b] Bool
538
539 The instance decls don't overlap, because the third parameter keeps
540 them separate.  But we want to make sure that given any constraint
541         D s1 s2 s3
542 if s1 matches 
543
544
545 \begin{code}
546 checkFunDeps :: (InstEnv, InstEnv) -> ClsInst
547              -> Maybe [ClsInst] -- Nothing  <=> ok
548                                         -- Just dfs <=> conflict with dfs
549 -- Check wheher adding DFunId would break functional-dependency constraints
550 -- Used only for instance decls defined in the module being compiled
551 checkFunDeps inst_envs ispec
552   | null bad_fundeps = Nothing
553   | otherwise        = Just bad_fundeps
554   where
555     (ins_tvs, clas, ins_tys) = instanceHead ispec
556     ins_tv_set   = mkVarSet ins_tvs
557     cls_inst_env = classInstances inst_envs clas
558     bad_fundeps  = badFunDeps cls_inst_env clas ins_tv_set ins_tys
559
560 badFunDeps :: [ClsInst] -> Class
561            -> TyVarSet -> [Type]        -- Proposed new instance type
562            -> [ClsInst]
563 badFunDeps cls_insts clas ins_tv_set ins_tys 
564   = nubBy eq_inst $
565     [ ispec | fd <- fds,        -- fds is often empty, so do this first!
566               let trimmed_tcs = trimRoughMatchTcs clas_tvs fd rough_tcs,
567               ispec <- cls_insts,
568               notNull (checkClsFD fd clas_tvs ispec ins_tv_set ins_tys trimmed_tcs)
569     ]
570   where
571     (clas_tvs, fds) = classTvsFds clas
572     rough_tcs = roughMatchTcs ins_tys
573     eq_inst i1 i2 = instanceDFunId i1 == instanceDFunId i2
574         -- An single instance may appear twice in the un-nubbed conflict list
575         -- because it may conflict with more than one fundep.  E.g.
576         --      class C a b c | a -> b, a -> c
577         --      instance C Int Bool Bool
578         --      instance C Int Char Char
579         -- The second instance conflicts with the first by *both* fundeps
580
581 trimRoughMatchTcs :: [TyVar] -> FunDep TyVar -> [Maybe Name] -> [Maybe Name]
582 -- Computing rough_tcs for a particular fundep
583 --     class C a b c | a -> b where ...
584 -- For each instance .... => C ta tb tc
585 -- we want to match only on the type ta; so our
586 -- rough-match thing must similarly be filtered.  
587 -- Hence, we Nothing-ise the tb and tc types right here
588 trimRoughMatchTcs clas_tvs (ltvs, _) mb_tcs
589   = zipWith select clas_tvs mb_tcs
590   where
591     select clas_tv mb_tc | clas_tv `elem` ltvs = mb_tc
592                          | otherwise           = Nothing
593 \end{code}
594
595
596