2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Inst]{The @Inst@ type: dictionaries or method instances}
8 LIE, emptyLIE, unitLIE, plusLIE, consLIE, zonkLIE,
9 plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
12 pprInst, pprInsts, pprInstsInFull, tidyInsts, tidyMoreInsts,
14 newDictsFromOld, newDicts, cloneDict,
15 newMethod, newMethodWithGivenTy, newMethodAtLoc,
16 newOverloadedLit, newIPDict, tcInstId,
18 tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE,
19 ipNamesOfInst, ipNamesOfInsts, predsOfInst, predsOfInsts,
20 instLoc, getDictClassTys, dictPred,
22 lookupInst, lookupSimpleInst, LookupInstResult(..),
24 isDict, isClassDict, isMethod, isLinearInst, linearInstType,
25 isTyVarDict, isStdClassTyVarDict, isMethodFor,
26 instBindingRequired, instCanBeGeneralised,
31 InstOrigin(..), InstLoc, pprInstLoc
34 #include "HsVersions.h"
36 import CmdLineOpts ( opt_NoMethodSharing )
37 import HsSyn ( HsLit(..), HsOverLit(..), HsExpr(..) )
38 import TcHsSyn ( TcExpr, TcId,
39 mkHsTyApp, mkHsDictApp, mkHsConApp, zonkId
42 import TcEnv ( TcIdSet, tcGetInstEnv, tcLookupId )
43 import InstEnv ( InstLookupResult(..), lookupInstEnv )
44 import TcMType ( zonkTcType, zonkTcTypes, zonkTcPredType,
45 zonkTcThetaType, tcInstTyVar, tcInstType,
47 import TcType ( Type, TcType, TcThetaType, TcPredType, TcTauType, TcTyVarSet,
48 SourceType(..), PredType, ThetaType,
49 tcSplitForAllTys, tcSplitForAllTys,
50 tcSplitMethodTy, tcSplitRhoTy, tcFunArgTy,
51 isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
52 tcIsTyVarTy, mkPredTy, mkTyVarTy, mkTyVarTys,
53 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
54 isClassPred, isTyVarClassPred,
55 getClassPredTys, getClassPredTys_maybe, mkPredName,
56 tidyType, tidyTypes, tidyFreeTyVars,
57 tcCmpType, tcCmpTypes, tcCmpPred
59 import CoreFVs ( idFreeTyVars )
60 import Class ( Class )
61 import Id ( Id, idName, idType, mkUserLocal, mkSysLocal, mkLocalId, setIdUnique )
62 import PrelInfo ( isStandardClass, isCcallishClass, isNoDictClass )
63 import Name ( Name, mkMethodOcc, getOccName )
64 import PprType ( pprPred )
65 import Subst ( emptyInScopeSet, mkSubst,
66 substTy, substTyWith, substTheta, mkTyVarSubst, mkTopTyVarSubst
68 import Literal ( inIntRange )
69 import VarEnv ( TidyEnv, lookupSubstEnv, SubstResult(..) )
70 import VarSet ( elemVarSet, emptyVarSet, unionVarSet )
71 import TysWiredIn ( floatDataCon, doubleDataCon )
72 import PrelNames( fromIntegerName, fromRationalName )
73 import Util ( thenCmp, equalLength )
74 import BasicTypes( IPName(..), mapIPName, ipNameName )
80 %************************************************************************
82 \subsection[Inst-collections]{LIE: a collection of Insts}
84 %************************************************************************
89 isEmptyLIE = isEmptyBag
91 unitLIE inst = unitBag inst
92 mkLIE insts = listToBag insts
93 plusLIE lie1 lie2 = lie1 `unionBags` lie2
94 consLIE inst lie = inst `consBag` lie
95 plusLIEs lies = unionManyBags lies
99 zonkLIE :: LIE -> NF_TcM LIE
100 zonkLIE lie = mapBagNF_Tc zonkInst lie
102 pprInsts :: [Inst] -> SDoc
103 pprInsts insts = parens (sep (punctuate comma (map pprInst insts)))
107 = vcat (map go insts)
109 go inst = quotes (ppr inst) <+> pprInstLoc (instLoc inst)
112 %************************************************************************
114 \subsection[Inst-types]{@Inst@ types}
116 %************************************************************************
118 An @Inst@ is either a dictionary, an instance of an overloaded
119 literal, or an instance of an overloaded value. We call the latter a
120 ``method'' even though it may not correspond to a class operation.
121 For example, we might have an instance of the @double@ function at
122 type Int, represented by
124 Method 34 doubleId [Int] origin
136 TcId -- The overloaded function
137 -- This function will be a global, local, or ClassOpId;
138 -- inside instance decls (only) it can also be an InstId!
139 -- The id needn't be completely polymorphic.
140 -- You'll probably find its name (for documentation purposes)
141 -- inside the InstOrigin
143 [TcType] -- The types to which its polymorphic tyvars
144 -- should be instantiated.
145 -- These types must saturate the Id's foralls.
147 TcThetaType -- The (types of the) dictionaries to which the function
148 -- must be applied to get the method
150 TcTauType -- The type of the method
154 -- INVARIANT: in (Method u f tys theta tau loc)
155 -- type of (f tys dicts(from theta)) = tau
159 HsOverLit -- The literal from the occurrence site
160 TcType -- The type at which the literal is used
166 @Insts@ are ordered by their class/type info, rather than by their
167 unique. This allows the context-reduction mechanism to use standard finite
168 maps to do their stuff.
171 instance Ord Inst where
174 instance Eq Inst where
175 (==) i1 i2 = case i1 `cmpInst` i2 of
179 cmpInst (Dict _ pred1 _) (Dict _ pred2 _) = pred1 `tcCmpPred` pred2
180 cmpInst (Dict _ _ _) other = LT
182 cmpInst (Method _ _ _ _ _ _) (Dict _ _ _) = GT
183 cmpInst (Method _ id1 tys1 _ _ _) (Method _ id2 tys2 _ _ _) = (id1 `compare` id2) `thenCmp` (tys1 `tcCmpTypes` tys2)
184 cmpInst (Method _ _ _ _ _ _) other = LT
186 cmpInst (LitInst _ lit1 ty1 _) (LitInst _ lit2 ty2 _) = (lit1 `compare` lit2) `thenCmp` (ty1 `tcCmpType` ty2)
187 cmpInst (LitInst _ _ _ _) other = GT
189 -- and they can only have HsInt or HsFracs in them.
196 instName :: Inst -> Name
197 instName inst = idName (instToId inst)
199 instToId :: Inst -> TcId
200 instToId (Dict id _ _) = id
201 instToId (Method id _ _ _ _ _) = id
202 instToId (LitInst id _ _ _) = id
204 instLoc (Dict _ _ loc) = loc
205 instLoc (Method _ _ _ _ _ loc) = loc
206 instLoc (LitInst _ _ _ loc) = loc
208 dictPred (Dict _ pred _ ) = pred
209 dictPred inst = pprPanic "dictPred" (ppr inst)
211 getDictClassTys (Dict _ pred _) = getClassPredTys pred
213 predsOfInsts :: [Inst] -> [PredType]
214 predsOfInsts insts = concatMap predsOfInst insts
216 predsOfInst (Dict _ pred _) = [pred]
217 predsOfInst (Method _ _ _ theta _ _) = theta
218 predsOfInst (LitInst _ _ _ _) = []
219 -- The last case is is really a big cheat
220 -- LitInsts to give rise to a (Num a) or (Fractional a) predicate
221 -- But Num and Fractional have only one parameter and no functional
222 -- dependencies, so I think no caller of predsOfInst will care.
224 ipNamesOfInsts :: [Inst] -> [Name]
225 ipNamesOfInst :: Inst -> [Name]
226 -- Get the implicit parameters mentioned by these Insts
227 -- NB: ?x and %x get different Names
229 ipNamesOfInsts insts = [n | inst <- insts, n <- ipNamesOfInst inst]
231 ipNamesOfInst (Dict _ (IParam n _) _) = [ipNameName n]
232 ipNamesOfInst (Method _ _ _ theta _ _) = [ipNameName n | IParam n _ <- theta]
233 ipNamesOfInst other = []
235 tyVarsOfInst :: Inst -> TcTyVarSet
236 tyVarsOfInst (LitInst _ _ ty _) = tyVarsOfType ty
237 tyVarsOfInst (Dict _ pred _) = tyVarsOfPred pred
238 tyVarsOfInst (Method _ id tys _ _ _) = tyVarsOfTypes tys `unionVarSet` idFreeTyVars id
239 -- The id might have free type variables; in the case of
240 -- locally-overloaded class methods, for example
242 tyVarsOfInsts insts = foldr (unionVarSet . tyVarsOfInst) emptyVarSet insts
243 tyVarsOfLIE lie = tyVarsOfInsts (lieToList lie)
249 isDict :: Inst -> Bool
250 isDict (Dict _ _ _) = True
253 isClassDict :: Inst -> Bool
254 isClassDict (Dict _ pred _) = isClassPred pred
255 isClassDict other = False
257 isTyVarDict :: Inst -> Bool
258 isTyVarDict (Dict _ pred _) = isTyVarClassPred pred
259 isTyVarDict other = False
261 isMethod :: Inst -> Bool
262 isMethod (Method _ _ _ _ _ _) = True
263 isMethod other = False
265 isMethodFor :: TcIdSet -> Inst -> Bool
266 isMethodFor ids (Method uniq id tys _ _ loc) = id `elemVarSet` ids
267 isMethodFor ids inst = False
269 isLinearInst :: Inst -> Bool
270 isLinearInst (Dict _ pred _) = isLinearPred pred
271 isLinearInst other = False
272 -- We never build Method Insts that have
273 -- linear implicit paramters in them.
274 -- Hence no need to look for Methods
277 isLinearPred :: TcPredType -> Bool
278 isLinearPred (IParam (Linear n) _) = True
279 isLinearPred other = False
281 linearInstType :: Inst -> TcType -- %x::t --> t
282 linearInstType (Dict _ (IParam _ ty) _) = ty
285 isStdClassTyVarDict (Dict _ pred _) = case getClassPredTys_maybe pred of
286 Just (clas, [ty]) -> isStandardClass clas && tcIsTyVarTy ty
290 Two predicates which deal with the case where class constraints don't
291 necessarily result in bindings. The first tells whether an @Inst@
292 must be witnessed by an actual binding; the second tells whether an
293 @Inst@ can be generalised over.
296 instBindingRequired :: Inst -> Bool
297 instBindingRequired (Dict _ (ClassP clas _) _) = not (isNoDictClass clas)
298 instBindingRequired other = True
300 instCanBeGeneralised :: Inst -> Bool
301 instCanBeGeneralised (Dict _ (ClassP clas _) _) = not (isCcallishClass clas)
302 instCanBeGeneralised other = True
306 %************************************************************************
308 \subsection{Building dictionaries}
310 %************************************************************************
313 newDicts :: InstOrigin
317 = tcGetInstLoc orig `thenNF_Tc` \ loc ->
318 newDictsAtLoc loc theta
320 cloneDict :: Inst -> NF_TcM Inst
321 cloneDict (Dict id ty loc) = tcGetUnique `thenNF_Tc` \ uniq ->
322 returnNF_Tc (Dict (setIdUnique id uniq) ty loc)
324 newDictsFromOld :: Inst -> TcThetaType -> NF_TcM [Inst]
325 newDictsFromOld (Dict _ _ loc) theta = newDictsAtLoc loc theta
327 -- Local function, similar to newDicts,
328 -- but with slightly different interface
329 newDictsAtLoc :: InstLoc
332 newDictsAtLoc inst_loc@(_,loc,_) theta
333 = tcGetUniques `thenNF_Tc` \ new_uniqs ->
334 returnNF_Tc (zipWith mk_dict new_uniqs theta)
336 mk_dict uniq pred = Dict (mkLocalId (mkPredName uniq loc pred) (mkPredTy pred)) pred inst_loc
338 -- For vanilla implicit parameters, there is only one in scope
339 -- at any time, so we used to use the name of the implicit parameter itself
340 -- But with splittable implicit parameters there may be many in
341 -- scope, so we make up a new name.
342 newIPDict :: InstOrigin -> IPName Name -> Type
343 -> NF_TcM (IPName Id, Inst)
344 newIPDict orig ip_name ty
345 = tcGetInstLoc orig `thenNF_Tc` \ inst_loc@(_,loc,_) ->
346 tcGetUnique `thenNF_Tc` \ uniq ->
348 pred = IParam ip_name ty
349 id = mkLocalId (mkPredName uniq loc pred) (mkPredTy pred)
351 returnNF_Tc (mapIPName (\n -> id) ip_name, Dict id pred inst_loc)
355 %************************************************************************
357 \subsection{Building methods (calls of overloaded functions)}
359 %************************************************************************
361 tcInstId instantiates an occurrence of an Id.
362 The instantiate_it loop runs round instantiating the Id.
363 It has to be a loop because we are now prepared to entertain
365 f:: forall a. Eq a => forall b. Baz b => tau
366 We want to instantiate this to
367 f2::tau {f2 = f1 b (Baz b), f1 = f a (Eq a)}
369 The -fno-method-sharing flag controls what happens so far as the LIE
370 is concerned. The default case is that for an overloaded function we
371 generate a "method" Id, and add the Method Inst to the LIE. So you get
374 f = /\a (d:Num a) -> let m = (+) a d in \ (x:a) -> m x x
375 If you specify -fno-method-sharing, the dictionary application
376 isn't shared, so we get
378 f = /\a (d:Num a) (x:a) -> (+) a d x x
379 This gets a bit less sharing, but
380 a) it's better for RULEs involving overloaded functions
381 b) perhaps fewer separated lambdas
385 tcInstId :: Id -> NF_TcM (TcExpr, LIE, TcType)
387 = loop (HsVar fun) emptyLIE (idType fun)
389 orig = OccurrenceOf fun
390 loop fun lie fun_ty = tcInstType fun_ty `thenNF_Tc` \ (tyvars, theta, tau) ->
391 loop_help fun lie (mkTyVarTys tyvars) theta tau
393 loop_help fun lie arg_tys [] tau -- Not overloaded
394 = returnNF_Tc (mkHsTyApp fun arg_tys, lie, tau)
396 loop_help (HsVar fun_id) lie arg_tys theta tau
397 | can_share theta -- Sharable method binding
398 = newMethodWithGivenTy orig fun_id arg_tys theta tau `thenNF_Tc` \ meth ->
399 loop (HsVar (instToId meth))
400 (unitLIE meth `plusLIE` lie) tau
402 loop_help fun lie arg_tys theta tau -- The general case
403 = newDicts orig theta `thenNF_Tc` \ dicts ->
404 loop (mkHsDictApp (mkHsTyApp fun arg_tys) (map instToId dicts))
405 (mkLIE dicts `plusLIE` lie) tau
407 can_share theta | opt_NoMethodSharing = False
408 | otherwise = not (any isLinearPred theta)
409 -- This is a slight hack.
410 -- If f :: (%x :: T) => Int -> Int
411 -- Then if we have two separate calls, (f 3, f 4), we cannot
412 -- make a method constraint that then gets shared, thus:
413 -- let m = f %x in (m 3, m 4)
414 -- because that loses the linearity of the constraint.
415 -- The simplest thing to do is never to construct a method constraint
416 -- in the first place that has a linear implicit parameter in it.
418 newMethod :: InstOrigin
422 newMethod orig id tys
423 = -- Get the Id type and instantiate it at the specified types
425 (tyvars, rho) = tcSplitForAllTys (idType id)
426 rho_ty = substTyWith tyvars tys rho
427 (pred, tau) = tcSplitMethodTy rho_ty
429 newMethodWithGivenTy orig id tys [pred] tau
431 newMethodWithGivenTy orig id tys theta tau
432 = tcGetInstLoc orig `thenNF_Tc` \ loc ->
433 newMethodWith loc id tys theta tau
435 newMethodWith inst_loc@(_,loc,_) id tys theta tau
436 = tcGetUnique `thenNF_Tc` \ new_uniq ->
438 meth_id = mkUserLocal (mkMethodOcc (getOccName id)) new_uniq tau loc
440 returnNF_Tc (Method meth_id id tys theta tau inst_loc)
442 newMethodAtLoc :: InstLoc
444 -> NF_TcM (Inst, TcId)
445 newMethodAtLoc inst_loc real_id tys
446 -- This actually builds the Inst
447 = -- Get the Id type and instantiate it at the specified types
449 (tyvars,rho) = tcSplitForAllTys (idType real_id)
450 rho_ty = ASSERT( equalLength tyvars tys )
451 substTy (mkTopTyVarSubst tyvars tys) rho
452 (theta, tau) = tcSplitRhoTy rho_ty
454 newMethodWith inst_loc real_id tys theta tau `thenNF_Tc` \ meth_inst ->
455 returnNF_Tc (meth_inst, instToId meth_inst)
458 In newOverloadedLit we convert directly to an Int or Integer if we
459 know that's what we want. This may save some time, by not
460 temporarily generating overloaded literals, but it won't catch all
461 cases (the rest are caught in lookupInst).
464 newOverloadedLit :: InstOrigin
467 -> NF_TcM (TcExpr, LIE)
468 newOverloadedLit orig lit ty
469 | Just expr <- shortCutLit lit ty
470 = returnNF_Tc (expr, emptyLIE)
473 = tcGetInstLoc orig `thenNF_Tc` \ loc ->
474 tcGetUnique `thenNF_Tc` \ new_uniq ->
476 lit_inst = LitInst lit_id lit ty loc
477 lit_id = mkSysLocal SLIT("lit") new_uniq ty
479 returnNF_Tc (HsVar (instToId lit_inst), unitLIE lit_inst)
481 shortCutLit :: HsOverLit -> TcType -> Maybe TcExpr
482 shortCutLit (HsIntegral i fi) ty
483 | isIntTy ty && inIntRange i && fi == fromIntegerName -- Short cut for Int
484 = Just (HsLit (HsInt i))
485 | isIntegerTy ty && fi == fromIntegerName -- Short cut for Integer
486 = Just (HsLit (HsInteger i))
488 shortCutLit (HsFractional f fr) ty
489 | isFloatTy ty && fr == fromRationalName
490 = Just (mkHsConApp floatDataCon [] [HsLit (HsFloatPrim f)])
491 | isDoubleTy ty && fr == fromRationalName
492 = Just (mkHsConApp doubleDataCon [] [HsLit (HsDoublePrim f)])
499 %************************************************************************
503 %************************************************************************
505 Zonking makes sure that the instance types are fully zonked,
506 but doesn't do the same for any of the Ids in an Inst. There's no
507 need, and it's a lot of extra work.
510 zonkInst :: Inst -> NF_TcM Inst
511 zonkInst (Dict id pred loc)
512 = zonkTcPredType pred `thenNF_Tc` \ new_pred ->
513 returnNF_Tc (Dict id new_pred loc)
515 zonkInst (Method m id tys theta tau loc)
516 = zonkId id `thenNF_Tc` \ new_id ->
517 -- Essential to zonk the id in case it's a local variable
518 -- Can't use zonkIdOcc because the id might itself be
519 -- an InstId, in which case it won't be in scope
521 zonkTcTypes tys `thenNF_Tc` \ new_tys ->
522 zonkTcThetaType theta `thenNF_Tc` \ new_theta ->
523 zonkTcType tau `thenNF_Tc` \ new_tau ->
524 returnNF_Tc (Method m new_id new_tys new_theta new_tau loc)
526 zonkInst (LitInst id lit ty loc)
527 = zonkTcType ty `thenNF_Tc` \ new_ty ->
528 returnNF_Tc (LitInst id lit new_ty loc)
530 zonkInsts insts = mapNF_Tc zonkInst insts
534 %************************************************************************
536 \subsection{Printing}
538 %************************************************************************
540 ToDo: improve these pretty-printing things. The ``origin'' is really only
541 relevant in error messages.
544 instance Outputable Inst where
545 ppr inst = pprInst inst
547 pprInst (LitInst u lit ty loc)
548 = hsep [ppr lit, ptext SLIT("at"), ppr ty, show_uniq u]
550 pprInst (Dict u pred loc) = pprPred pred <+> show_uniq u
552 pprInst m@(Method u id tys theta tau loc)
553 = hsep [ppr id, ptext SLIT("at"),
554 brackets (interppSP tys) {- ,
555 ptext SLIT("theta"), ppr theta,
556 ptext SLIT("tau"), ppr tau
560 show_uniq u = ifPprDebug (text "{-" <> ppr u <> text "-}")
562 tidyInst :: TidyEnv -> Inst -> Inst
563 tidyInst env (LitInst u lit ty loc) = LitInst u lit (tidyType env ty) loc
564 tidyInst env (Dict u pred loc) = Dict u (tidyPred env pred) loc
565 tidyInst env (Method u id tys theta tau loc) = Method u id (tidyTypes env tys) theta tau loc
567 tidyMoreInsts :: TidyEnv -> [Inst] -> (TidyEnv, [Inst])
568 -- This function doesn't assume that the tyvars are in scope
569 -- so it works like tidyOpenType, returning a TidyEnv
570 tidyMoreInsts env insts
571 = (env', map (tidyInst env') insts)
573 env' = tidyFreeTyVars env (tyVarsOfInsts insts)
575 tidyInsts :: [Inst] -> (TidyEnv, [Inst])
576 tidyInsts insts = tidyMoreInsts emptyTidyEnv insts
580 %************************************************************************
582 \subsection{Looking up Insts}
584 %************************************************************************
587 data LookupInstResult s
589 | SimpleInst TcExpr -- Just a variable, type application, or literal
590 | GenInst [Inst] TcExpr -- The expression and its needed insts
593 -> NF_TcM (LookupInstResult s)
597 lookupInst dict@(Dict _ (ClassP clas tys) loc)
598 = getDOptsTc `thenNF_Tc` \ dflags ->
599 tcGetInstEnv `thenNF_Tc` \ inst_env ->
600 case lookupInstEnv dflags inst_env clas tys of
602 FoundInst tenv dfun_id
604 (tyvars, rho) = tcSplitForAllTys (idType dfun_id)
605 mk_ty_arg tv = case lookupSubstEnv tenv tv of
606 Just (DoneTy ty) -> returnNF_Tc ty
607 Nothing -> tcInstTyVar tv `thenNF_Tc` \ tc_tv ->
608 returnTc (mkTyVarTy tc_tv)
610 -- It's possible that not all the tyvars are in
611 -- the substitution, tenv. For example:
612 -- instance C X a => D X where ...
613 -- (presumably there's a functional dependency in class C)
614 -- Hence the mk_ty_arg to instantiate any un-substituted tyvars.
615 mapNF_Tc mk_ty_arg tyvars `thenNF_Tc` \ ty_args ->
617 dfun_rho = substTy (mkTyVarSubst tyvars ty_args) rho
618 (theta, _) = tcSplitRhoTy dfun_rho
619 ty_app = mkHsTyApp (HsVar dfun_id) ty_args
622 returnNF_Tc (SimpleInst ty_app)
624 newDictsAtLoc loc theta `thenNF_Tc` \ dicts ->
626 rhs = mkHsDictApp ty_app (map instToId dicts)
628 returnNF_Tc (GenInst dicts rhs)
630 other -> returnNF_Tc NoInstance
632 lookupInst dict@(Dict _ _ loc) = returnNF_Tc NoInstance
636 lookupInst inst@(Method _ id tys theta _ loc)
637 = newDictsAtLoc loc theta `thenNF_Tc` \ dicts ->
638 returnNF_Tc (GenInst dicts (mkHsDictApp (mkHsTyApp (HsVar id) tys) (map instToId dicts)))
642 -- Look for short cuts first: if the literal is *definitely* a
643 -- int, integer, float or a double, generate the real thing here.
644 -- This is essential (see nofib/spectral/nucleic).
645 -- [Same shortcut as in newOverloadedLit, but we
646 -- may have done some unification by now]
648 lookupInst inst@(LitInst u lit ty loc)
649 | Just expr <- shortCutLit lit ty
650 = returnNF_Tc (GenInst [] expr) -- GenInst, not SimpleInst, because
651 -- expr may be a constructor application
653 lookupInst inst@(LitInst u (HsIntegral i from_integer_name) ty loc)
654 = tcLookupId from_integer_name `thenNF_Tc` \ from_integer ->
655 newMethodAtLoc loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) ->
656 returnNF_Tc (GenInst [method_inst]
657 (HsApp (HsVar method_id) (HsLit (HsInteger i))))
660 lookupInst inst@(LitInst u (HsFractional f from_rat_name) ty loc)
661 = tcLookupId from_rat_name `thenNF_Tc` \ from_rational ->
662 newMethodAtLoc loc from_rational [ty] `thenNF_Tc` \ (method_inst, method_id) ->
664 rational_ty = tcFunArgTy (idType method_id)
665 rational_lit = HsLit (HsRat f rational_ty)
667 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) rational_lit))
670 There is a second, simpler interface, when you want an instance of a
671 class at a given nullary type constructor. It just returns the
672 appropriate dictionary if it exists. It is used only when resolving
673 ambiguous dictionaries.
676 lookupSimpleInst :: Class
677 -> [Type] -- Look up (c,t)
678 -> NF_TcM (Maybe ThetaType) -- Here are the needed (c,t)s
680 lookupSimpleInst clas tys
681 = getDOptsTc `thenNF_Tc` \ dflags ->
682 tcGetInstEnv `thenNF_Tc` \ inst_env ->
683 case lookupInstEnv dflags inst_env clas tys of
685 -> returnNF_Tc (Just (substTheta (mkSubst emptyInScopeSet tenv) theta))
687 (_, rho) = tcSplitForAllTys (idType dfun)
688 (theta,_) = tcSplitRhoTy rho
690 other -> returnNF_Tc Nothing