1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 2000
4 %
6 FunDeps - functional dependencies
8 It's better to read it as: "if we know these, then we're going to know these"
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
16 -- for details
18 module FunDeps (
19         FDEq (..),
20         Equation(..), pprEquation,
21         improveFromInstEnv, improveFromAnother,
22         checkInstCoverage, checkInstLiberalCoverage, checkFunDeps,
23         growThetaTyVars, pprFundeps
24     ) where
26 #include "HsVersions.h"
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
40 import Data.List        ( nubBy )
41 import Data.Maybe       ( isJust )
42 \end{code}
45 %************************************************************************
46 %*                                                                      *
47 \subsection{Close type variables}
48 %*                                                                      *
49 %************************************************************************
51   oclose(vs,C)  The result of extending the set of tyvars vs
52                 using the functional dependencies from C
54   growThetaTyVars(C,vs)  The result of extend the set of tyvars vs
55                          using all conceivable links from C.
57                 E.g. vs = {a}, C = {H [a] b, K (b,Int) c, Eq e}
58                 Then grow(vs,C) = {a,b,c}
60                 Note that grow(vs,C) superset grow(vs,simplify(C))
61                 That is, simplfication can only shrink the result of grow.
63 Notice that
64    oclose is conservative                v elem oclose(vs,C)
65           one way:                        => v is definitely fixed by vs
67    growThetaTyVars is conservative       if v might be fixed by vs
68           the other way:                 => v elem grow(vs,C)
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.
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}
84 oclose is used (only) when checking functional dependencies
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
97     extend fixed_tvs (ls,rs)
98         | ls subVarSet fixed_tvs = fixed_tvs unionVarSet rs
99         | otherwise                = fixed_tvs
101     tv_fds  :: [(TyVarSet,TyVarSet)]
102     tv_fds  = [ (tyVarsOfTypes xs, tyVarsOfTypes ys)
103               | (xs, ys) <- concatMap determined preds
104               ]
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             _                 -> []
117 \end{code}
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
124 E.g. tvs = {a}, preds = {H [a] b, K (b,Int) c, Eq e}
125 Then growThetaTyVars preds tvs = {a,b,c}
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
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}
149 %************************************************************************
150 %*                                                                      *
151 \subsection{Generate equations from functional dependencies}
152 %*                                                                      *
153 %************************************************************************
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 }
172 We record the paremeter position so that can immediately rewrite a constraint
173 using the produced FDEqs and remove it from our worklist.
176 INVARIANT: Corresponding types aren't already equal
177 That is, there exists at least one non-identity equality in FDEqs.
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)
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.
203 Finally, the position parameters will help us rewrite the wanted constraint on the spot''
205 \begin{code}
206 type Pred_Loc = (PredType, SDoc)        -- SDoc says where the Pred comes from
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
214 data FDEq = FDEq { fd_pos      :: Int -- We use '0' for the first position
215                  , fd_ty_left  :: Type
216                  , fd_ty_right :: Type }
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}
223 Given a bunch of predicates that must hold, such as
225         C Int t1, C Int t2, C Bool t3, ?x::t4, ?x::t5
227 improve figures out what extra equations must hold.
228 For example, if we have
230         class C a b | a->b where ...
232 then improve will return
234         [(t1,t2), (t4,t5)]
236 NOTA BENE:
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.
244     improve does *not* do this extra step.  It relies on the caller
245     doing so.
247   * The equations unify types that are not already equal.  So there
248     is no effect iff the result of improve is empty
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
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 _ _ _ = []
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) ]
296 improveFromAnother _ _ = []
299 -- Improve a class constraint from instance declarations
300 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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])]
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 _ _ = []
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])]
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
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
372   | instanceCantMatch rough_tcs_inst rough_tcs_actual
373   = []          -- Filter out ones that can't possibly match,
375   | otherwise
376   = ASSERT2( length tys_inst == length tys_actual     &&
377              length tys_inst == length clas_tvs
378             , ppr tys_inst <+> ppr tys_actual )
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                   -> []
398                   | null fdeqs
399                   -> []
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'
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)
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
443     (ltys1, rtys1) = instFD         fd clas_tvs tys_inst
444     (ltys2, irs2)  = instFD_WithPos fd clas_tvs tys_actual
445 \end{code}
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
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
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
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
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}
491 Note [Coverage condition]
492 ~~~~~~~~~~~~~~~~~~~~~~~~~
493 For the coverage condition, we used to require only that
494         fv(t2) subset oclose(fv(t1), theta)
496 Example:
497         class Mul a b c | a b -> c where
498                 (.*.) :: a -> b -> c
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
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]) )
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
513 %************************************************************************
514 %*                                                                      *
515         Check that a new instance decl is OK wrt fundeps
516 %*                                                                      *
517 %************************************************************************
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 ...
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
527         instance C s1 s2 where ...
528         instance C t1 t2 where ...
530 Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
532 Matters are a little more complicated if there are free variables in
533 the s2/t2.
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
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
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
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
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}