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