3fd8e647f0c8709f93e78c71cd7ec2dd2db47216
[ghc.git] / compiler / typecheck / Inst.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 The @Inst@ type: dictionaries or method instances
7
8 \begin{code}
9 {-# LANGUAGE CPP #-}
10
11 module Inst (
12        deeplySkolemise,
13        deeplyInstantiate, instCall, instStupidTheta,
14        emitWanted, emitWanteds,
15
16        newOverloadedLit, mkOverLit,
17
18        newClsInst,
19        tcGetInsts, tcGetInstEnvs, getOverlapFlag,
20        tcExtendLocalInstEnv, instCallConstraints, newMethodFromName,
21        tcSyntaxName,
22
23        -- Simple functions over evidence variables
24        tyVarsOfWC, tyVarsOfBag,
25        tyVarsOfCt, tyVarsOfCts,
26     ) where
27
28 #include "HsVersions.h"
29
30 import {-# SOURCE #-}   TcExpr( tcPolyExpr, tcSyntaxOp )
31 import {-# SOURCE #-}   TcUnify( unifyType )
32
33 import FastString
34 import HsSyn
35 import TcHsSyn
36 import TcRnMonad
37 import TcEnv
38 import TcEvidence
39 import InstEnv
40 import FunDeps
41 import TcMType
42 import Type
43 import Coercion ( Role(..) )
44 import TcType
45 import HscTypes
46 import Class( Class )
47 import MkId( mkDictFunId )
48 import Id
49 import Name
50 import Var      ( EvVar )
51 import VarEnv
52 import VarSet
53 import PrelNames
54 import SrcLoc
55 import DynFlags
56 import Bag
57 import Util
58 import Outputable
59 import Control.Monad( unless )
60 import Data.Maybe( isJust )
61 \end{code}
62
63
64
65 %************************************************************************
66 %*                                                                      *
67                 Emitting constraints
68 %*                                                                      *
69 %************************************************************************
70
71 \begin{code}
72 emitWanteds :: CtOrigin -> TcThetaType -> TcM [EvVar]
73 emitWanteds origin theta = mapM (emitWanted origin) theta
74
75 emitWanted :: CtOrigin -> TcPredType -> TcM EvVar
76 emitWanted origin pred
77   = do { loc <- getCtLoc origin
78        ; ev  <- newWantedEvVar pred
79        ; emitFlat $ mkNonCanonical $
80              CtWanted { ctev_pred = pred, ctev_evar = ev, ctev_loc = loc }
81        ; return ev }
82
83 newMethodFromName :: CtOrigin -> Name -> TcRhoType -> TcM (HsExpr TcId)
84 -- Used when Name is the wired-in name for a wired-in class method,
85 -- so the caller knows its type for sure, which should be of form
86 --    forall a. C a => <blah>
87 -- newMethodFromName is supposed to instantiate just the outer
88 -- type variable and constraint
89
90 newMethodFromName origin name inst_ty
91   = do { id <- tcLookupId name
92               -- Use tcLookupId not tcLookupGlobalId; the method is almost
93               -- always a class op, but with -XRebindableSyntax GHC is
94               -- meant to find whatever thing is in scope, and that may
95               -- be an ordinary function.
96
97        ; let (tvs, theta, _caller_knows_this) = tcSplitSigmaTy (idType id)
98              (the_tv:rest) = tvs
99              subst = zipOpenTvSubst [the_tv] [inst_ty]
100
101        ; wrap <- ASSERT( null rest && isSingleton theta )
102                  instCall origin [inst_ty] (substTheta subst theta)
103        ; return (mkHsWrap wrap (HsVar id)) }
104 \end{code}
105
106
107 %************************************************************************
108 %*                                                                      *
109         Deep instantiation and skolemisation
110 %*                                                                      *
111 %************************************************************************
112
113 Note [Deep skolemisation]
114 ~~~~~~~~~~~~~~~~~~~~~~~~~
115 deeplySkolemise decomposes and skolemises a type, returning a type
116 with all its arrows visible (ie not buried under foralls)
117
118 Examples:
119
120   deeplySkolemise (Int -> forall a. Ord a => blah)
121     =  ( wp, [a], [d:Ord a], Int -> blah )
122     where wp = \x:Int. /\a. \(d:Ord a). <hole> x
123
124   deeplySkolemise  (forall a. Ord a => Maybe a -> forall b. Eq b => blah)
125     =  ( wp, [a,b], [d1:Ord a,d2:Eq b], Maybe a -> blah )
126     where wp = /\a.\(d1:Ord a).\(x:Maybe a)./\b.\(d2:Ord b). <hole> x
127
128 In general,
129   if      deeplySkolemise ty = (wrap, tvs, evs, rho)
130     and   e :: rho
131   then    wrap e :: ty
132     and   'wrap' binds tvs, evs
133
134 ToDo: this eta-abstraction plays fast and loose with termination,
135       because it can introduce extra lambdas.  Maybe add a `seq` to
136       fix this
137
138
139 \begin{code}
140 deeplySkolemise
141   :: TcSigmaType
142   -> TcM (HsWrapper, [TyVar], [EvVar], TcRhoType)
143
144 deeplySkolemise ty
145   | Just (arg_tys, tvs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty
146   = do { ids1 <- newSysLocalIds (fsLit "dk") arg_tys
147        ; (subst, tvs1) <- tcInstSkolTyVars tvs
148        ; ev_vars1 <- newEvVars (substTheta subst theta)
149        ; (wrap, tvs2, ev_vars2, rho) <- deeplySkolemise (substTy subst ty')
150        ; return ( mkWpLams ids1
151                    <.> mkWpTyLams tvs1
152                    <.> mkWpLams ev_vars1
153                    <.> wrap
154                    <.> mkWpEvVarApps ids1
155                 , tvs1     ++ tvs2
156                 , ev_vars1 ++ ev_vars2
157                 , mkFunTys arg_tys rho ) }
158
159   | otherwise
160   = return (idHsWrapper, [], [], ty)
161
162 deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
163 --   Int -> forall a. a -> a  ==>  (\x:Int. [] x alpha) :: Int -> alpha
164 -- In general if
165 -- if    deeplyInstantiate ty = (wrap, rho)
166 -- and   e :: ty
167 -- then  wrap e :: rho
168
169 deeplyInstantiate orig ty
170   | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty
171   = do { (subst, tvs') <- tcInstTyVars tvs
172        ; ids1  <- newSysLocalIds (fsLit "di") (substTys subst arg_tys)
173        ; let theta' = substTheta subst theta
174        ; wrap1 <- instCall orig (mkTyVarTys tvs') theta'
175        ; traceTc "Instantiating (deeply)" (vcat [ text "origin" <+> pprCtOrigin orig
176                                                 , text "type" <+> ppr ty
177                                                 , text "with" <+> ppr tvs'
178                                                 , text "args:" <+> ppr ids1
179                                                 , text "theta:" <+>  ppr theta' ])
180        ; (wrap2, rho2) <- deeplyInstantiate orig (substTy subst rho)
181        ; return (mkWpLams ids1
182                     <.> wrap2
183                     <.> wrap1
184                     <.> mkWpEvVarApps ids1,
185                  mkFunTys arg_tys rho2) }
186
187   | otherwise = return (idHsWrapper, ty)
188 \end{code}
189
190
191 %************************************************************************
192 %*                                                                      *
193             Instantiating a call
194 %*                                                                      *
195 %************************************************************************
196
197 \begin{code}
198 ----------------
199 instCall :: CtOrigin -> [TcType] -> TcThetaType -> TcM HsWrapper
200 -- Instantiate the constraints of a call
201 --      (instCall o tys theta)
202 -- (a) Makes fresh dictionaries as necessary for the constraints (theta)
203 -- (b) Throws these dictionaries into the LIE
204 -- (c) Returns an HsWrapper ([.] tys dicts)
205
206 instCall orig tys theta
207   = do  { dict_app <- instCallConstraints orig theta
208         ; return (dict_app <.> mkWpTyApps tys) }
209
210 ----------------
211 instCallConstraints :: CtOrigin -> TcThetaType -> TcM HsWrapper
212 -- Instantiates the TcTheta, puts all constraints thereby generated
213 -- into the LIE, and returns a HsWrapper to enclose the call site.
214
215 instCallConstraints orig preds
216   | null preds
217   = return idHsWrapper
218   | otherwise
219   = do { evs <- mapM go preds
220        ; traceTc "instCallConstraints" (ppr evs)
221        ; return (mkWpEvApps evs) }
222   where
223     go pred
224      | Just (Nominal, ty1, ty2) <- getEqPredTys_maybe pred -- Try short-cut
225      = do  { co <- unifyType ty1 ty2
226            ; return (EvCoercion co) }
227      | otherwise
228      = do { ev_var <- emitWanted orig pred
229           ; return (EvId ev_var) }
230
231 ----------------
232 instStupidTheta :: CtOrigin -> TcThetaType -> TcM ()
233 -- Similar to instCall, but only emit the constraints in the LIE
234 -- Used exclusively for the 'stupid theta' of a data constructor
235 instStupidTheta orig theta
236   = do  { _co <- instCallConstraints orig theta -- Discard the coercion
237         ; return () }
238 \end{code}
239
240 %************************************************************************
241 %*                                                                      *
242                 Literals
243 %*                                                                      *
244 %************************************************************************
245
246 In newOverloadedLit we convert directly to an Int or Integer if we
247 know that's what we want.  This may save some time, by not
248 temporarily generating overloaded literals, but it won't catch all
249 cases (the rest are caught in lookupInst).
250
251 \begin{code}
252 newOverloadedLit :: CtOrigin
253                  -> HsOverLit Name
254                  -> TcRhoType
255                  -> TcM (HsOverLit TcId)
256 newOverloadedLit orig lit res_ty
257     = do dflags <- getDynFlags
258          newOverloadedLit' dflags orig lit res_ty
259
260 newOverloadedLit' :: DynFlags
261                   -> CtOrigin
262                   -> HsOverLit Name
263                   -> TcRhoType
264                   -> TcM (HsOverLit TcId)
265 newOverloadedLit' dflags orig
266   lit@(OverLit { ol_val = val, ol_rebindable = rebindable
267                , ol_witness = meth_name }) res_ty
268
269   | not rebindable
270   , Just expr <- shortCutLit dflags val res_ty
271         -- Do not generate a LitInst for rebindable syntax.
272         -- Reason: If we do, tcSimplify will call lookupInst, which
273         --         will call tcSyntaxName, which does unification,
274         --         which tcSimplify doesn't like
275   = return (lit { ol_witness = expr, ol_type = res_ty
276                 , ol_rebindable = rebindable })
277
278   | otherwise
279   = do  { hs_lit <- mkOverLit val
280         ; let lit_ty = hsLitType hs_lit
281         ; fi' <- tcSyntaxOp orig meth_name (mkFunTy lit_ty res_ty)
282                 -- Overloaded literals must have liftedTypeKind, because
283                 -- we're instantiating an overloaded function here,
284                 -- whereas res_ty might be openTypeKind. This was a bug in 6.2.2
285                 -- However this'll be picked up by tcSyntaxOp if necessary
286         ; let witness = HsApp (noLoc fi') (noLoc (HsLit hs_lit))
287         ; return (lit { ol_witness = witness, ol_type = res_ty
288                       , ol_rebindable = rebindable }) }
289
290 ------------
291 mkOverLit :: OverLitVal -> TcM HsLit
292 mkOverLit (HsIntegral i)
293   = do  { integer_ty <- tcMetaTy integerTyConName
294         ; return (HsInteger i integer_ty) }
295
296 mkOverLit (HsFractional r)
297   = do  { rat_ty <- tcMetaTy rationalTyConName
298         ; return (HsRat r rat_ty) }
299
300 mkOverLit (HsIsString s) = return (HsString s)
301 \end{code}
302
303
304
305
306 %************************************************************************
307 %*                                                                      *
308                 Re-mappable syntax
309
310      Used only for arrow syntax -- find a way to nuke this
311 %*                                                                      *
312 %************************************************************************
313
314 Suppose we are doing the -XRebindableSyntax thing, and we encounter
315 a do-expression.  We have to find (>>) in the current environment, which is
316 done by the rename. Then we have to check that it has the same type as
317 Control.Monad.(>>).  Or, more precisely, a compatible type. One 'customer' had
318 this:
319
320   (>>) :: HB m n mn => m a -> n b -> mn b
321
322 So the idea is to generate a local binding for (>>), thus:
323
324         let then72 :: forall a b. m a -> m b -> m b
325             then72 = ...something involving the user's (>>)...
326         in
327         ...the do-expression...
328
329 Now the do-expression can proceed using then72, which has exactly
330 the expected type.
331
332 In fact tcSyntaxName just generates the RHS for then72, because we only
333 want an actual binding in the do-expression case. For literals, we can
334 just use the expression inline.
335
336 \begin{code}
337 tcSyntaxName :: CtOrigin
338              -> TcType                  -- Type to instantiate it at
339              -> (Name, HsExpr Name)     -- (Standard name, user name)
340              -> TcM (Name, HsExpr TcId) -- (Standard name, suitable expression)
341 -- USED ONLY FOR CmdTop (sigh) ***
342 -- See Note [CmdSyntaxTable] in HsExpr
343
344 tcSyntaxName orig ty (std_nm, HsVar user_nm)
345   | std_nm == user_nm
346   = do rhs <- newMethodFromName orig std_nm ty
347        return (std_nm, rhs)
348
349 tcSyntaxName orig ty (std_nm, user_nm_expr) = do
350     std_id <- tcLookupId std_nm
351     let
352         -- C.f. newMethodAtLoc
353         ([tv], _, tau)  = tcSplitSigmaTy (idType std_id)
354         sigma1          = substTyWith [tv] [ty] tau
355         -- Actually, the "tau-type" might be a sigma-type in the
356         -- case of locally-polymorphic methods.
357
358     addErrCtxtM (syntaxNameCtxt user_nm_expr orig sigma1) $ do
359
360         -- Check that the user-supplied thing has the
361         -- same type as the standard one.
362         -- Tiresome jiggling because tcCheckSigma takes a located expression
363      span <- getSrcSpanM
364      expr <- tcPolyExpr (L span user_nm_expr) sigma1
365      return (std_nm, unLoc expr)
366
367 syntaxNameCtxt :: HsExpr Name -> CtOrigin -> Type -> TidyEnv
368                -> TcRn (TidyEnv, SDoc)
369 syntaxNameCtxt name orig ty tidy_env
370   = do { inst_loc <- getCtLoc orig
371        ; let msg = vcat [ ptext (sLit "When checking that") <+> quotes (ppr name)
372                           <+> ptext (sLit "(needed by a syntactic construct)")
373                         , nest 2 (ptext (sLit "has the required type:")
374                                   <+> ppr (tidyType tidy_env ty))
375                         , nest 2 (pprArisingAt inst_loc) ]
376        ; return (tidy_env, msg) }
377 \end{code}
378
379
380 %************************************************************************
381 %*                                                                      *
382                 Instances
383 %*                                                                      *
384 %************************************************************************
385
386 \begin{code}
387 getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag
388 getOverlapFlag overlap_mode
389   = do  { dflags <- getDynFlags
390         ; let overlap_ok    = xopt Opt_OverlappingInstances dflags
391               incoherent_ok = xopt Opt_IncoherentInstances  dflags
392               use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags
393                                   , overlapMode   = x }
394               default_oflag | incoherent_ok = use Incoherent
395                             | overlap_ok    = use Overlaps
396                             | otherwise     = use NoOverlap
397
398               final_oflag = setOverlapModeMaybe default_oflag overlap_mode
399         ; return final_oflag }
400
401 tcGetInstEnvs :: TcM (InstEnv, InstEnv)
402 -- Gets both the external-package inst-env
403 -- and the home-pkg inst env (includes module being compiled)
404 tcGetInstEnvs = do { eps <- getEps; env <- getGblEnv;
405                      return (eps_inst_env eps, tcg_inst_env env) }
406
407 tcGetInsts :: TcM [ClsInst]
408 -- Gets the local class instances.
409 tcGetInsts = fmap tcg_insts getGblEnv
410
411 newClsInst :: Maybe OverlapMode -> Name -> [TyVar] -> ThetaType
412            -> Class -> [Type] -> TcM ClsInst
413 newClsInst overlap_mode dfun_name tvs theta clas tys
414   = do { (subst, tvs') <- freshenTyVarBndrs tvs
415              -- Be sure to freshen those type variables,
416              -- so they are sure not to appear in any lookup
417        ; let tys'   = substTys subst tys
418              theta' = substTheta subst theta
419              dfun   = mkDictFunId dfun_name tvs' theta' clas tys'
420              -- Substituting in the DFun type just makes sure that
421              -- we are using TyVars rather than TcTyVars
422              -- Not sure if this is really the right place to do so,
423              -- but it'll do fine
424        ; oflag <- getOverlapFlag overlap_mode
425        ; return (mkLocalInstance dfun oflag tvs' clas tys') }
426
427 tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
428   -- Add new locally-defined instances
429 tcExtendLocalInstEnv dfuns thing_inside
430  = do { traceDFuns dfuns
431       ; env <- getGblEnv
432       ; (inst_env', cls_insts') <- foldlM addLocalInst
433                                           (tcg_inst_env env, tcg_insts env)
434                                           dfuns
435       ; let env' = env { tcg_insts    = cls_insts'
436                        , tcg_inst_env = inst_env' }
437       ; setGblEnv env' thing_inside }
438
439 addLocalInst :: (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
440 -- Check that the proposed new instance is OK,
441 -- and then add it to the home inst env
442 -- If overwrite_inst, then we can overwrite a direct match
443 addLocalInst (home_ie, my_insts) ispec
444    = do {
445          -- Instantiate the dfun type so that we extend the instance
446          -- envt with completely fresh template variables
447          -- This is important because the template variables must
448          -- not overlap with anything in the things being looked up
449          -- (since we do unification).
450              --
451              -- We use tcInstSkolType because we don't want to allocate fresh
452              --  *meta* type variables.
453              --
454              -- We use UnkSkol --- and *not* InstSkol or PatSkol --- because
455              -- these variables must be bindable by tcUnifyTys.  See
456              -- the call to tcUnifyTys in InstEnv, and the special
457              -- treatment that instanceBindFun gives to isOverlappableTyVar
458              -- This is absurdly delicate.
459
460              -- Load imported instances, so that we report
461              -- duplicates correctly
462
463              -- 'matches'  are existing instance declarations that are less
464              --            specific than the new one
465              -- 'dups'     are those 'matches' that are equal to the new one
466          ; isGHCi <- getIsGHCi
467          ; eps    <- getEps
468          ; tcg_env <- getGblEnv
469          ; let (home_ie', my_insts')
470                  | isGHCi    = ( deleteFromInstEnv home_ie ispec
471                                , filterOut (identicalInstHead ispec) my_insts)
472                  | otherwise = (home_ie, my_insts)
473                -- If there is a home-package duplicate instance,
474                -- silently delete it
475
476                (_tvs, cls, tys) = instanceHead ispec
477                -- If we're compiling sig-of and there's an external duplicate
478                -- instance, silently ignore it (that's the instance we're
479                -- implementing!)  NB: we still count local duplicate instances
480                -- as errors.
481                -- See Note [Signature files and type class instances]
482                global_ie
483                     | isJust (tcg_sig_of tcg_env) = emptyInstEnv
484                     | otherwise = eps_inst_env eps
485                inst_envs       = (global_ie, home_ie')
486                (matches, _, _) = lookupInstEnv inst_envs cls tys
487                dups            = filter (identicalInstHead ispec) (map fst matches)
488
489              -- Check functional dependencies
490          ; case checkFunDeps inst_envs ispec of
491              Just specs -> funDepErr ispec specs
492              Nothing    -> return ()
493
494              -- Check for duplicate instance decls.
495          ; unless (null dups) $
496            dupInstErr ispec (head dups)
497
498          ; return (extendInstEnv home_ie' ispec, ispec:my_insts') }
499 \end{code}
500
501 Note [Signature files and type class instances]
502 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
503 Instances in signature files do not have an effect when compiling:
504 when you compile a signature against an implementation, you will
505 see the instances WHETHER OR NOT the instance is declared in
506 the file (this is because the signatures go in the EPS and we
507 can't filter them out easily.)  This is also why we cannot
508 place the instance in the hi file: it would show up as a duplicate,
509 and we don't have instance reexports anyway.
510
511 However, you might find them useful when typechecking against
512 a signature: the instance is a way of indicating to GHC that
513 some instance exists, in case downstream code uses it.
514
515 Implementing this is a little tricky.  Consider the following
516 situation (sigof03):
517
518  module A where
519      instance C T where ...
520
521  module ASig where
522      instance C T
523
524 When compiling ASig, A.hi is loaded, which brings its instances
525 into the EPS.  When we process the instance declaration in ASig,
526 we should ignore it for the purpose of doing a duplicate check,
527 since it's not actually a duplicate. But don't skip the check
528 entirely, we still want this to fail (tcfail221):
529
530  module ASig where
531      instance C T
532      instance C T
533
534 Note that in some situations, the interface containing the type
535 class instances may not have been loaded yet at all.  The usual
536 situation when A imports another module which provides the
537 instances (sigof02m):
538
539  module A(module B) where
540      import B
541
542 See also Note [Signature lazy interface loading].  We can't
543 rely on this, however, since sometimes we'll have spurious
544 type class instances in the EPS, see #9422 (sigof02dm)
545
546 %************************************************************************
547 %*                                                                      *
548         Errors and tracing
549 %*                                                                      *
550 %************************************************************************
551
552 \begin{code}
553 traceDFuns :: [ClsInst] -> TcRn ()
554 traceDFuns ispecs
555   = traceTc "Adding instances:" (vcat (map pp ispecs))
556   where
557     pp ispec = hang (ppr (instanceDFunId ispec) <+> colon)
558                   2 (ppr ispec)
559         -- Print the dfun name itself too
560
561 funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
562 funDepErr ispec ispecs
563   = addClsInstsErr (ptext (sLit "Functional dependencies conflict between instance declarations:"))
564                     (ispec : ispecs)
565
566 dupInstErr :: ClsInst -> ClsInst -> TcRn ()
567 dupInstErr ispec dup_ispec
568   = addClsInstsErr (ptext (sLit "Duplicate instance declarations:"))
569                     [ispec, dup_ispec]
570
571 addClsInstsErr :: SDoc -> [ClsInst] -> TcRn ()
572 addClsInstsErr herald ispecs
573   = setSrcSpan (getSrcSpan (head sorted)) $
574     addErr (hang herald 2 (pprInstances sorted))
575  where
576    sorted = sortWith getSrcLoc ispecs
577    -- The sortWith just arranges that instances are dislayed in order
578    -- of source location, which reduced wobbling in error messages,
579    -- and is better for users
580 \end{code}
581
582 %************************************************************************
583 %*                                                                      *
584         Simple functions over evidence variables
585 %*                                                                      *
586 %************************************************************************
587
588 \begin{code}
589 ---------------- Getting free tyvars -------------------------
590 tyVarsOfCt :: Ct -> TcTyVarSet
591 tyVarsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })     = extendVarSet (tyVarsOfType xi) tv
592 tyVarsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) = extendVarSet (tyVarsOfTypes tys) fsk
593 tyVarsOfCt (CDictCan { cc_tyargs = tys })                = tyVarsOfTypes tys
594 tyVarsOfCt (CIrredEvCan { cc_ev = ev })                  = tyVarsOfType (ctEvPred ev)
595 tyVarsOfCt (CHoleCan { cc_ev = ev })                     = tyVarsOfType (ctEvPred ev)
596 tyVarsOfCt (CNonCanonical { cc_ev = ev })                = tyVarsOfType (ctEvPred ev)
597
598 tyVarsOfCts :: Cts -> TcTyVarSet
599 tyVarsOfCts = foldrBag (unionVarSet . tyVarsOfCt) emptyVarSet
600
601 tyVarsOfWC :: WantedConstraints -> TyVarSet
602 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
603 tyVarsOfWC (WC { wc_flat = flat, wc_impl = implic, wc_insol = insol })
604   = tyVarsOfCts flat `unionVarSet`
605     tyVarsOfBag tyVarsOfImplic implic `unionVarSet`
606     tyVarsOfCts insol
607
608 tyVarsOfImplic :: Implication -> TyVarSet
609 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
610 tyVarsOfImplic (Implic { ic_skols = skols
611                        , ic_given = givens, ic_wanted = wanted })
612   = (tyVarsOfWC wanted `unionVarSet` tyVarsOfTypes (map evVarPred givens))
613     `delVarSetList` skols
614
615 tyVarsOfBag :: (a -> TyVarSet) -> Bag a -> TyVarSet
616 tyVarsOfBag tvs_of = foldrBag (unionVarSet . tvs_of) emptyVarSet
617 \end{code}