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