Eliminate so-called "silent superclass parameters"
[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, deeplyInstantiate,
13 instCall, instDFunType, 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 instDFunType :: DFunId -> [DFunInstType] -> TcM ([TcType], TcThetaType)
240 -- See Note [DFunInstType: instantiating types] in InstEnv
241 instDFunType dfun_id dfun_inst_tys
242 = do { (subst, inst_tys) <- go (mkTopTvSubst []) dfun_tvs dfun_inst_tys
243 ; return (inst_tys, substTheta subst dfun_theta) }
244 where
245 (dfun_tvs, dfun_theta, _) = tcSplitSigmaTy (idType dfun_id)
246
247 go :: TvSubst -> [TyVar] -> [DFunInstType] -> TcM (TvSubst, [TcType])
248 go subst [] [] = return (subst, [])
249 go subst (tv:tvs) (Just ty : mb_tys)
250 = do { (subst', tys) <- go (extendTvSubst subst tv ty) tvs mb_tys
251 ; return (subst', ty : tys) }
252 go subst (tv:tvs) (Nothing : mb_tys)
253 = do { (subst', tv') <- tcInstTyVarX subst tv
254 ; (subst'', tys) <- go subst' tvs mb_tys
255 ; return (subst'', mkTyVarTy tv' : tys) }
256 go _ _ _ = pprPanic "instDFunTypes" (ppr dfun_id $$ ppr dfun_inst_tys)
257
258 ----------------
259 instStupidTheta :: CtOrigin -> TcThetaType -> TcM ()
260 -- Similar to instCall, but only emit the constraints in the LIE
261 -- Used exclusively for the 'stupid theta' of a data constructor
262 instStupidTheta orig theta
263 = do { _co <- instCallConstraints orig theta -- Discard the coercion
264 ; return () }
265
266 {-
267 ************************************************************************
268 * *
269 Literals
270 * *
271 ************************************************************************
272
273 In newOverloadedLit we convert directly to an Int or Integer if we
274 know that's what we want. This may save some time, by not
275 temporarily generating overloaded literals, but it won't catch all
276 cases (the rest are caught in lookupInst).
277 -}
278
279 newOverloadedLit :: CtOrigin
280 -> HsOverLit Name
281 -> TcRhoType
282 -> TcM (HsOverLit TcId)
283 newOverloadedLit orig lit res_ty
284 = do dflags <- getDynFlags
285 newOverloadedLit' dflags orig lit res_ty
286
287 newOverloadedLit' :: DynFlags
288 -> CtOrigin
289 -> HsOverLit Name
290 -> TcRhoType
291 -> TcM (HsOverLit TcId)
292 newOverloadedLit' dflags orig
293 lit@(OverLit { ol_val = val, ol_rebindable = rebindable
294 , ol_witness = meth_name }) res_ty
295
296 | not rebindable
297 , Just expr <- shortCutLit dflags val res_ty
298 -- Do not generate a LitInst for rebindable syntax.
299 -- Reason: If we do, tcSimplify will call lookupInst, which
300 -- will call tcSyntaxName, which does unification,
301 -- which tcSimplify doesn't like
302 = return (lit { ol_witness = expr, ol_type = res_ty
303 , ol_rebindable = rebindable })
304
305 | otherwise
306 = do { hs_lit <- mkOverLit val
307 ; let lit_ty = hsLitType hs_lit
308 ; fi' <- tcSyntaxOp orig meth_name (mkFunTy lit_ty res_ty)
309 -- Overloaded literals must have liftedTypeKind, because
310 -- we're instantiating an overloaded function here,
311 -- whereas res_ty might be openTypeKind. This was a bug in 6.2.2
312 -- However this'll be picked up by tcSyntaxOp if necessary
313 ; let witness = HsApp (noLoc fi') (noLoc (HsLit hs_lit))
314 ; return (lit { ol_witness = witness, ol_type = res_ty
315 , ol_rebindable = rebindable }) }
316
317 ------------
318 mkOverLit :: OverLitVal -> TcM HsLit
319 mkOverLit (HsIntegral src i)
320 = do { integer_ty <- tcMetaTy integerTyConName
321 ; return (HsInteger src i integer_ty) }
322
323 mkOverLit (HsFractional r)
324 = do { rat_ty <- tcMetaTy rationalTyConName
325 ; return (HsRat r rat_ty) }
326
327 mkOverLit (HsIsString src s) = return (HsString src s)
328
329 {-
330 ************************************************************************
331 * *
332 Re-mappable syntax
333
334 Used only for arrow syntax -- find a way to nuke this
335 * *
336 ************************************************************************
337
338 Suppose we are doing the -XRebindableSyntax thing, and we encounter
339 a do-expression. We have to find (>>) in the current environment, which is
340 done by the rename. Then we have to check that it has the same type as
341 Control.Monad.(>>). Or, more precisely, a compatible type. One 'customer' had
342 this:
343
344 (>>) :: HB m n mn => m a -> n b -> mn b
345
346 So the idea is to generate a local binding for (>>), thus:
347
348 let then72 :: forall a b. m a -> m b -> m b
349 then72 = ...something involving the user's (>>)...
350 in
351 ...the do-expression...
352
353 Now the do-expression can proceed using then72, which has exactly
354 the expected type.
355
356 In fact tcSyntaxName just generates the RHS for then72, because we only
357 want an actual binding in the do-expression case. For literals, we can
358 just use the expression inline.
359 -}
360
361 tcSyntaxName :: CtOrigin
362 -> TcType -- Type to instantiate it at
363 -> (Name, HsExpr Name) -- (Standard name, user name)
364 -> TcM (Name, HsExpr TcId) -- (Standard name, suitable expression)
365 -- USED ONLY FOR CmdTop (sigh) ***
366 -- See Note [CmdSyntaxTable] in HsExpr
367
368 tcSyntaxName orig ty (std_nm, HsVar user_nm)
369 | std_nm == user_nm
370 = do rhs <- newMethodFromName orig std_nm ty
371 return (std_nm, rhs)
372
373 tcSyntaxName orig ty (std_nm, user_nm_expr) = do
374 std_id <- tcLookupId std_nm
375 let
376 -- C.f. newMethodAtLoc
377 ([tv], _, tau) = tcSplitSigmaTy (idType std_id)
378 sigma1 = substTyWith [tv] [ty] tau
379 -- Actually, the "tau-type" might be a sigma-type in the
380 -- case of locally-polymorphic methods.
381
382 addErrCtxtM (syntaxNameCtxt user_nm_expr orig sigma1) $ do
383
384 -- Check that the user-supplied thing has the
385 -- same type as the standard one.
386 -- Tiresome jiggling because tcCheckSigma takes a located expression
387 span <- getSrcSpanM
388 expr <- tcPolyExpr (L span user_nm_expr) sigma1
389 return (std_nm, unLoc expr)
390
391 syntaxNameCtxt :: HsExpr Name -> CtOrigin -> Type -> TidyEnv
392 -> TcRn (TidyEnv, SDoc)
393 syntaxNameCtxt name orig ty tidy_env
394 = do { inst_loc <- getCtLoc orig
395 ; let msg = vcat [ ptext (sLit "When checking that") <+> quotes (ppr name)
396 <+> ptext (sLit "(needed by a syntactic construct)")
397 , nest 2 (ptext (sLit "has the required type:")
398 <+> ppr (tidyType tidy_env ty))
399 , nest 2 (pprArisingAt inst_loc) ]
400 ; return (tidy_env, msg) }
401
402 {-
403 ************************************************************************
404 * *
405 Instances
406 * *
407 ************************************************************************
408 -}
409
410 getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag
411 getOverlapFlag overlap_mode
412 = do { dflags <- getDynFlags
413 ; let overlap_ok = xopt Opt_OverlappingInstances dflags
414 incoherent_ok = xopt Opt_IncoherentInstances dflags
415 use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags
416 , overlapMode = x }
417 default_oflag | incoherent_ok = use Incoherent
418 | overlap_ok = use Overlaps
419 | otherwise = use NoOverlap
420
421 final_oflag = setOverlapModeMaybe default_oflag overlap_mode
422 ; return final_oflag }
423
424 tcGetInsts :: TcM [ClsInst]
425 -- Gets the local class instances.
426 tcGetInsts = fmap tcg_insts getGblEnv
427
428 newClsInst :: Maybe OverlapMode -> Name -> [TyVar] -> ThetaType
429 -> Class -> [Type] -> TcM ClsInst
430 newClsInst overlap_mode dfun_name tvs theta clas tys
431 = do { (subst, tvs') <- freshenTyVarBndrs tvs
432 -- Be sure to freshen those type variables,
433 -- so they are sure not to appear in any lookup
434 ; let tys' = substTys subst tys
435 theta' = substTheta subst theta
436 dfun = mkDictFunId dfun_name tvs' theta' clas tys'
437 -- Substituting in the DFun type just makes sure that
438 -- we are using TyVars rather than TcTyVars
439 -- Not sure if this is really the right place to do so,
440 -- but it'll do fine
441 ; oflag <- getOverlapFlag overlap_mode
442 ; return (mkLocalInstance dfun oflag tvs' clas tys') }
443
444 tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
445 -- Add new locally-defined instances
446 tcExtendLocalInstEnv dfuns thing_inside
447 = do { traceDFuns dfuns
448 ; env <- getGblEnv
449 ; (inst_env', cls_insts') <- foldlM addLocalInst
450 (tcg_inst_env env, tcg_insts env)
451 dfuns
452 ; let env' = env { tcg_insts = cls_insts'
453 , tcg_inst_env = inst_env' }
454 ; setGblEnv env' thing_inside }
455
456 addLocalInst :: (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
457 -- Check that the proposed new instance is OK,
458 -- and then add it to the home inst env
459 -- If overwrite_inst, then we can overwrite a direct match
460 addLocalInst (home_ie, my_insts) ispec
461 = do {
462 -- Instantiate the dfun type so that we extend the instance
463 -- envt with completely fresh template variables
464 -- This is important because the template variables must
465 -- not overlap with anything in the things being looked up
466 -- (since we do unification).
467 --
468 -- We use tcInstSkolType because we don't want to allocate fresh
469 -- *meta* type variables.
470 --
471 -- We use UnkSkol --- and *not* InstSkol or PatSkol --- because
472 -- these variables must be bindable by tcUnifyTys. See
473 -- the call to tcUnifyTys in InstEnv, and the special
474 -- treatment that instanceBindFun gives to isOverlappableTyVar
475 -- This is absurdly delicate.
476
477 -- Load imported instances, so that we report
478 -- duplicates correctly
479
480 -- 'matches' are existing instance declarations that are less
481 -- specific than the new one
482 -- 'dups' are those 'matches' that are equal to the new one
483 ; isGHCi <- getIsGHCi
484 ; eps <- getEps
485 ; tcg_env <- getGblEnv
486
487 -- In GHCi, we *override* any identical instances
488 -- that are also defined in the interactive context
489 -- See Note [Override identical instances in GHCi]
490 ; let home_ie'
491 | isGHCi = deleteFromInstEnv home_ie ispec
492 | otherwise = home_ie
493
494 (_tvs, cls, tys) = instanceHead ispec
495 -- If we're compiling sig-of and there's an external duplicate
496 -- instance, silently ignore it (that's the instance we're
497 -- implementing!) NB: we still count local duplicate instances
498 -- as errors.
499 -- See Note [Signature files and type class instances]
500 global_ie
501 | isJust (tcg_sig_of tcg_env) = emptyInstEnv
502 | otherwise = eps_inst_env eps
503 inst_envs = InstEnvs { ie_global = global_ie
504 , ie_local = home_ie'
505 , ie_visible = tcg_visible_orphan_mods tcg_env }
506 (matches, _, _) = lookupInstEnv inst_envs cls tys
507 dups = filter (identicalClsInstHead ispec) (map fst matches)
508
509 -- Check functional dependencies
510 ; case checkFunDeps inst_envs ispec of
511 Just specs -> funDepErr ispec specs
512 Nothing -> return ()
513
514 -- Check for duplicate instance decls.
515 ; unless (null dups) $
516 dupInstErr ispec (head dups)
517
518 ; return (extendInstEnv home_ie' ispec, ispec : my_insts) }
519
520 {-
521 Note [Signature files and type class instances]
522 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
523 Instances in signature files do not have an effect when compiling:
524 when you compile a signature against an implementation, you will
525 see the instances WHETHER OR NOT the instance is declared in
526 the file (this is because the signatures go in the EPS and we
527 can't filter them out easily.) This is also why we cannot
528 place the instance in the hi file: it would show up as a duplicate,
529 and we don't have instance reexports anyway.
530
531 However, you might find them useful when typechecking against
532 a signature: the instance is a way of indicating to GHC that
533 some instance exists, in case downstream code uses it.
534
535 Implementing this is a little tricky. Consider the following
536 situation (sigof03):
537
538 module A where
539 instance C T where ...
540
541 module ASig where
542 instance C T
543
544 When compiling ASig, A.hi is loaded, which brings its instances
545 into the EPS. When we process the instance declaration in ASig,
546 we should ignore it for the purpose of doing a duplicate check,
547 since it's not actually a duplicate. But don't skip the check
548 entirely, we still want this to fail (tcfail221):
549
550 module ASig where
551 instance C T
552 instance C T
553
554 Note that in some situations, the interface containing the type
555 class instances may not have been loaded yet at all. The usual
556 situation when A imports another module which provides the
557 instances (sigof02m):
558
559 module A(module B) where
560 import B
561
562 See also Note [Signature lazy interface loading]. We can't
563 rely on this, however, since sometimes we'll have spurious
564 type class instances in the EPS, see #9422 (sigof02dm)
565
566 ************************************************************************
567 * *
568 Errors and tracing
569 * *
570 ************************************************************************
571 -}
572
573 traceDFuns :: [ClsInst] -> TcRn ()
574 traceDFuns ispecs
575 = traceTc "Adding instances:" (vcat (map pp ispecs))
576 where
577 pp ispec = hang (ppr (instanceDFunId ispec) <+> colon)
578 2 (ppr ispec)
579 -- Print the dfun name itself too
580
581 funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
582 funDepErr ispec ispecs
583 = addClsInstsErr (ptext (sLit "Functional dependencies conflict between instance declarations:"))
584 (ispec : ispecs)
585
586 dupInstErr :: ClsInst -> ClsInst -> TcRn ()
587 dupInstErr ispec dup_ispec
588 = addClsInstsErr (ptext (sLit "Duplicate instance declarations:"))
589 [ispec, dup_ispec]
590
591 addClsInstsErr :: SDoc -> [ClsInst] -> TcRn ()
592 addClsInstsErr herald ispecs
593 = setSrcSpan (getSrcSpan (head sorted)) $
594 addErr (hang herald 2 (pprInstances sorted))
595 where
596 sorted = sortWith getSrcLoc ispecs
597 -- The sortWith just arranges that instances are dislayed in order
598 -- of source location, which reduced wobbling in error messages,
599 -- and is better for users
600
601 {-
602 ************************************************************************
603 * *
604 Simple functions over evidence variables
605 * *
606 ************************************************************************
607 -}
608
609 ---------------- Getting free tyvars -------------------------
610 tyVarsOfCt :: Ct -> TcTyVarSet
611 tyVarsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) = extendVarSet (tyVarsOfType xi) tv
612 tyVarsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) = extendVarSet (tyVarsOfTypes tys) fsk
613 tyVarsOfCt (CDictCan { cc_tyargs = tys }) = tyVarsOfTypes tys
614 tyVarsOfCt (CIrredEvCan { cc_ev = ev }) = tyVarsOfType (ctEvPred ev)
615 tyVarsOfCt (CHoleCan { cc_ev = ev }) = tyVarsOfType (ctEvPred ev)
616 tyVarsOfCt (CNonCanonical { cc_ev = ev }) = tyVarsOfType (ctEvPred ev)
617
618 tyVarsOfCts :: Cts -> TcTyVarSet
619 tyVarsOfCts = foldrBag (unionVarSet . tyVarsOfCt) emptyVarSet
620
621 tyVarsOfWC :: WantedConstraints -> TyVarSet
622 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
623 tyVarsOfWC (WC { wc_simple = simple, wc_impl = implic, wc_insol = insol })
624 = tyVarsOfCts simple `unionVarSet`
625 tyVarsOfBag tyVarsOfImplic implic `unionVarSet`
626 tyVarsOfCts insol
627
628 tyVarsOfImplic :: Implication -> TyVarSet
629 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
630 tyVarsOfImplic (Implic { ic_skols = skols
631 , ic_given = givens, ic_wanted = wanted })
632 = (tyVarsOfWC wanted `unionVarSet` tyVarsOfTypes (map evVarPred givens))
633 `delVarSetList` skols
634
635 tyVarsOfBag :: (a -> TyVarSet) -> Bag a -> TyVarSet
636 tyVarsOfBag tvs_of = foldrBag (unionVarSet . tvs_of) emptyVarSet