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,
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 getDictClassTys (Dict _ pred _) = getClassPredTys pred
210 predsOfInsts :: [Inst] -> [PredType]
211 predsOfInsts insts = concatMap predsOfInst insts
213 predsOfInst (Dict _ pred _) = [pred]
214 predsOfInst (Method _ _ _ theta _ _) = theta
215 predsOfInst (LitInst _ _ _ _) = []
216 -- The last case is is really a big cheat
217 -- LitInsts to give rise to a (Num a) or (Fractional a) predicate
218 -- But Num and Fractional have only one parameter and no functional
219 -- dependencies, so I think no caller of predsOfInst will care.
221 ipNamesOfInsts :: [Inst] -> [Name]
222 ipNamesOfInst :: Inst -> [Name]
223 -- Get the implicit parameters mentioned by these Insts
224 -- NB: ?x and %x get different Names
226 ipNamesOfInsts insts = [n | inst <- insts, n <- ipNamesOfInst inst]
228 ipNamesOfInst (Dict _ (IParam n _) _) = [ipNameName n]
229 ipNamesOfInst (Method _ _ _ theta _ _) = [ipNameName n | IParam n _ <- theta]
230 ipNamesOfInst other = []
232 tyVarsOfInst :: Inst -> TcTyVarSet
233 tyVarsOfInst (LitInst _ _ ty _) = tyVarsOfType ty
234 tyVarsOfInst (Dict _ pred _) = tyVarsOfPred pred
235 tyVarsOfInst (Method _ id tys _ _ _) = tyVarsOfTypes tys `unionVarSet` idFreeTyVars id
236 -- The id might have free type variables; in the case of
237 -- locally-overloaded class methods, for example
239 tyVarsOfInsts insts = foldr (unionVarSet . tyVarsOfInst) emptyVarSet insts
240 tyVarsOfLIE lie = tyVarsOfInsts (lieToList lie)
246 isDict :: Inst -> Bool
247 isDict (Dict _ _ _) = True
250 isClassDict :: Inst -> Bool
251 isClassDict (Dict _ pred _) = isClassPred pred
252 isClassDict other = False
254 isTyVarDict :: Inst -> Bool
255 isTyVarDict (Dict _ pred _) = isTyVarClassPred pred
256 isTyVarDict other = False
258 isMethod :: Inst -> Bool
259 isMethod (Method _ _ _ _ _ _) = True
260 isMethod other = False
262 isMethodFor :: TcIdSet -> Inst -> Bool
263 isMethodFor ids (Method uniq id tys _ _ loc) = id `elemVarSet` ids
264 isMethodFor ids inst = False
266 isLinearInst :: Inst -> Bool
267 isLinearInst (Dict _ pred _) = isLinearPred pred
268 isLinearInst other = False
269 -- We never build Method Insts that have
270 -- linear implicit paramters in them.
271 -- Hence no need to look for Methods
274 isLinearPred :: TcPredType -> Bool
275 isLinearPred (IParam (Linear n) _) = True
276 isLinearPred other = False
278 linearInstType :: Inst -> TcType -- %x::t --> t
279 linearInstType (Dict _ (IParam _ ty) _) = ty
282 isStdClassTyVarDict (Dict _ pred _) = case getClassPredTys_maybe pred of
283 Just (clas, [ty]) -> isStandardClass clas && tcIsTyVarTy ty
287 Two predicates which deal with the case where class constraints don't
288 necessarily result in bindings. The first tells whether an @Inst@
289 must be witnessed by an actual binding; the second tells whether an
290 @Inst@ can be generalised over.
293 instBindingRequired :: Inst -> Bool
294 instBindingRequired (Dict _ (ClassP clas _) _) = not (isNoDictClass clas)
295 instBindingRequired other = True
297 instCanBeGeneralised :: Inst -> Bool
298 instCanBeGeneralised (Dict _ (ClassP clas _) _) = not (isCcallishClass clas)
299 instCanBeGeneralised other = True
303 %************************************************************************
305 \subsection{Building dictionaries}
307 %************************************************************************
310 newDicts :: InstOrigin
314 = tcGetInstLoc orig `thenNF_Tc` \ loc ->
315 newDictsAtLoc loc theta
317 cloneDict :: Inst -> NF_TcM Inst
318 cloneDict (Dict id ty loc) = tcGetUnique `thenNF_Tc` \ uniq ->
319 returnNF_Tc (Dict (setIdUnique id uniq) ty loc)
321 newDictsFromOld :: Inst -> TcThetaType -> NF_TcM [Inst]
322 newDictsFromOld (Dict _ _ loc) theta = newDictsAtLoc loc theta
324 -- Local function, similar to newDicts,
325 -- but with slightly different interface
326 newDictsAtLoc :: InstLoc
329 newDictsAtLoc inst_loc@(_,loc,_) theta
330 = tcGetUniques `thenNF_Tc` \ new_uniqs ->
331 returnNF_Tc (zipWith mk_dict new_uniqs theta)
333 mk_dict uniq pred = Dict (mkLocalId (mkPredName uniq loc pred) (mkPredTy pred)) pred inst_loc
335 -- For vanilla implicit parameters, there is only one in scope
336 -- at any time, so we used to use the name of the implicit parameter itself
337 -- But with splittable implicit parameters there may be many in
338 -- scope, so we make up a new name.
339 newIPDict :: InstOrigin -> IPName Name -> Type
340 -> NF_TcM (IPName Id, Inst)
341 newIPDict orig ip_name ty
342 = tcGetInstLoc orig `thenNF_Tc` \ inst_loc@(_,loc,_) ->
343 tcGetUnique `thenNF_Tc` \ uniq ->
345 pred = IParam ip_name ty
346 id = mkLocalId (mkPredName uniq loc pred) (mkPredTy pred)
348 returnNF_Tc (mapIPName (\n -> id) ip_name, Dict id pred inst_loc)
352 %************************************************************************
354 \subsection{Building methods (calls of overloaded functions)}
356 %************************************************************************
358 tcInstId instantiates an occurrence of an Id.
359 The instantiate_it loop runs round instantiating the Id.
360 It has to be a loop because we are now prepared to entertain
362 f:: forall a. Eq a => forall b. Baz b => tau
363 We want to instantiate this to
364 f2::tau {f2 = f1 b (Baz b), f1 = f a (Eq a)}
366 The -fno-method-sharing flag controls what happens so far as the LIE
367 is concerned. The default case is that for an overloaded function we
368 generate a "method" Id, and add the Method Inst to the LIE. So you get
371 f = /\a (d:Num a) -> let m = (+) a d in \ (x:a) -> m x x
372 If you specify -fno-method-sharing, the dictionary application
373 isn't shared, so we get
375 f = /\a (d:Num a) (x:a) -> (+) a d x x
376 This gets a bit less sharing, but
377 a) it's better for RULEs involving overloaded functions
378 b) perhaps fewer separated lambdas
382 tcInstId :: Id -> NF_TcM (TcExpr, LIE, TcType)
384 = loop (HsVar fun) emptyLIE (idType fun)
386 orig = OccurrenceOf fun
387 loop fun lie fun_ty = tcInstType fun_ty `thenNF_Tc` \ (tyvars, theta, tau) ->
388 loop_help fun lie (mkTyVarTys tyvars) theta tau
390 loop_help fun lie arg_tys [] tau -- Not overloaded
391 = returnNF_Tc (mkHsTyApp fun arg_tys, lie, tau)
393 loop_help (HsVar fun_id) lie arg_tys theta tau
394 | can_share theta -- Sharable method binding
395 = newMethodWithGivenTy orig fun_id arg_tys theta tau `thenNF_Tc` \ meth ->
396 loop (HsVar (instToId meth))
397 (unitLIE meth `plusLIE` lie) tau
399 loop_help fun lie arg_tys theta tau -- The general case
400 = newDicts orig theta `thenNF_Tc` \ dicts ->
401 loop (mkHsDictApp (mkHsTyApp fun arg_tys) (map instToId dicts))
402 (mkLIE dicts `plusLIE` lie) tau
404 can_share theta | opt_NoMethodSharing = False
405 | otherwise = not (any isLinearPred theta)
406 -- This is a slight hack.
407 -- If f :: (%x :: T) => Int -> Int
408 -- Then if we have two separate calls, (f 3, f 4), we cannot
409 -- make a method constraint that then gets shared, thus:
410 -- let m = f %x in (m 3, m 4)
411 -- because that loses the linearity of the constraint.
412 -- The simplest thing to do is never to construct a method constraint
413 -- in the first place that has a linear implicit parameter in it.
415 newMethod :: InstOrigin
419 newMethod orig id tys
420 = -- Get the Id type and instantiate it at the specified types
422 (tyvars, rho) = tcSplitForAllTys (idType id)
423 rho_ty = substTyWith tyvars tys rho
424 (pred, tau) = tcSplitMethodTy rho_ty
426 newMethodWithGivenTy orig id tys [pred] tau
428 newMethodWithGivenTy orig id tys theta tau
429 = tcGetInstLoc orig `thenNF_Tc` \ loc ->
430 newMethodWith loc id tys theta tau
432 newMethodWith inst_loc@(_,loc,_) id tys theta tau
433 = tcGetUnique `thenNF_Tc` \ new_uniq ->
435 meth_id = mkUserLocal (mkMethodOcc (getOccName id)) new_uniq tau loc
437 returnNF_Tc (Method meth_id id tys theta tau inst_loc)
439 newMethodAtLoc :: InstLoc
441 -> NF_TcM (Inst, TcId)
442 newMethodAtLoc inst_loc real_id tys
443 -- This actually builds the Inst
444 = -- Get the Id type and instantiate it at the specified types
446 (tyvars,rho) = tcSplitForAllTys (idType real_id)
447 rho_ty = ASSERT( equalLength tyvars tys )
448 substTy (mkTopTyVarSubst tyvars tys) rho
449 (theta, tau) = tcSplitRhoTy rho_ty
451 newMethodWith inst_loc real_id tys theta tau `thenNF_Tc` \ meth_inst ->
452 returnNF_Tc (meth_inst, instToId meth_inst)
455 In newOverloadedLit we convert directly to an Int or Integer if we
456 know that's what we want. This may save some time, by not
457 temporarily generating overloaded literals, but it won't catch all
458 cases (the rest are caught in lookupInst).
461 newOverloadedLit :: InstOrigin
464 -> NF_TcM (TcExpr, LIE)
465 newOverloadedLit orig lit ty
466 | Just expr <- shortCutLit lit ty
467 = returnNF_Tc (expr, emptyLIE)
470 = tcGetInstLoc orig `thenNF_Tc` \ loc ->
471 tcGetUnique `thenNF_Tc` \ new_uniq ->
473 lit_inst = LitInst lit_id lit ty loc
474 lit_id = mkSysLocal SLIT("lit") new_uniq ty
476 returnNF_Tc (HsVar (instToId lit_inst), unitLIE lit_inst)
478 shortCutLit :: HsOverLit -> TcType -> Maybe TcExpr
479 shortCutLit (HsIntegral i fi) ty
480 | isIntTy ty && inIntRange i && fi == fromIntegerName -- Short cut for Int
481 = Just (HsLit (HsInt i))
482 | isIntegerTy ty && fi == fromIntegerName -- Short cut for Integer
483 = Just (HsLit (HsInteger i))
485 shortCutLit (HsFractional f fr) ty
486 | isFloatTy ty && fr == fromRationalName
487 = Just (mkHsConApp floatDataCon [] [HsLit (HsFloatPrim f)])
488 | isDoubleTy ty && fr == fromRationalName
489 = Just (mkHsConApp doubleDataCon [] [HsLit (HsDoublePrim f)])
496 %************************************************************************
500 %************************************************************************
502 Zonking makes sure that the instance types are fully zonked,
503 but doesn't do the same for any of the Ids in an Inst. There's no
504 need, and it's a lot of extra work.
507 zonkInst :: Inst -> NF_TcM Inst
508 zonkInst (Dict id pred loc)
509 = zonkTcPredType pred `thenNF_Tc` \ new_pred ->
510 returnNF_Tc (Dict id new_pred loc)
512 zonkInst (Method m id tys theta tau loc)
513 = zonkId id `thenNF_Tc` \ new_id ->
514 -- Essential to zonk the id in case it's a local variable
515 -- Can't use zonkIdOcc because the id might itself be
516 -- an InstId, in which case it won't be in scope
518 zonkTcTypes tys `thenNF_Tc` \ new_tys ->
519 zonkTcThetaType theta `thenNF_Tc` \ new_theta ->
520 zonkTcType tau `thenNF_Tc` \ new_tau ->
521 returnNF_Tc (Method m new_id new_tys new_theta new_tau loc)
523 zonkInst (LitInst id lit ty loc)
524 = zonkTcType ty `thenNF_Tc` \ new_ty ->
525 returnNF_Tc (LitInst id lit new_ty loc)
527 zonkInsts insts = mapNF_Tc zonkInst insts
531 %************************************************************************
533 \subsection{Printing}
535 %************************************************************************
537 ToDo: improve these pretty-printing things. The ``origin'' is really only
538 relevant in error messages.
541 instance Outputable Inst where
542 ppr inst = pprInst inst
544 pprInst (LitInst u lit ty loc)
545 = hsep [ppr lit, ptext SLIT("at"), ppr ty, show_uniq u]
547 pprInst (Dict u pred loc) = pprPred pred <+> show_uniq u
549 pprInst m@(Method u id tys theta tau loc)
550 = hsep [ppr id, ptext SLIT("at"),
551 brackets (interppSP tys) {- ,
552 ptext SLIT("theta"), ppr theta,
553 ptext SLIT("tau"), ppr tau
557 show_uniq u = ifPprDebug (text "{-" <> ppr u <> text "-}")
559 tidyInst :: TidyEnv -> Inst -> Inst
560 tidyInst env (LitInst u lit ty loc) = LitInst u lit (tidyType env ty) loc
561 tidyInst env (Dict u pred loc) = Dict u (tidyPred env pred) loc
562 tidyInst env (Method u id tys theta tau loc) = Method u id (tidyTypes env tys) theta tau loc
564 tidyMoreInsts :: TidyEnv -> [Inst] -> (TidyEnv, [Inst])
565 -- This function doesn't assume that the tyvars are in scope
566 -- so it works like tidyOpenType, returning a TidyEnv
567 tidyMoreInsts env insts
568 = (env', map (tidyInst env') insts)
570 env' = tidyFreeTyVars env (tyVarsOfInsts insts)
572 tidyInsts :: [Inst] -> (TidyEnv, [Inst])
573 tidyInsts insts = tidyMoreInsts emptyTidyEnv insts
577 %************************************************************************
579 \subsection{Looking up Insts}
581 %************************************************************************
584 data LookupInstResult s
586 | SimpleInst TcExpr -- Just a variable, type application, or literal
587 | GenInst [Inst] TcExpr -- The expression and its needed insts
590 -> NF_TcM (LookupInstResult s)
594 lookupInst dict@(Dict _ (ClassP clas tys) loc)
595 = tcGetInstEnv `thenNF_Tc` \ inst_env ->
596 case lookupInstEnv inst_env clas tys of
598 FoundInst tenv dfun_id
600 (tyvars, rho) = tcSplitForAllTys (idType dfun_id)
601 mk_ty_arg tv = case lookupSubstEnv tenv tv of
602 Just (DoneTy ty) -> returnNF_Tc ty
603 Nothing -> tcInstTyVar tv `thenNF_Tc` \ tc_tv ->
604 returnTc (mkTyVarTy tc_tv)
606 mapNF_Tc mk_ty_arg tyvars `thenNF_Tc` \ ty_args ->
608 subst = mkTyVarSubst tyvars ty_args
609 dfun_rho = substTy subst rho
610 (theta, _) = tcSplitRhoTy dfun_rho
611 ty_app = mkHsTyApp (HsVar dfun_id) ty_args
614 returnNF_Tc (SimpleInst ty_app)
616 newDictsAtLoc loc theta `thenNF_Tc` \ dicts ->
618 rhs = mkHsDictApp ty_app (map instToId dicts)
620 returnNF_Tc (GenInst dicts rhs)
622 other -> returnNF_Tc NoInstance
624 lookupInst dict@(Dict _ _ loc) = returnNF_Tc NoInstance
628 lookupInst inst@(Method _ id tys theta _ loc)
629 = newDictsAtLoc loc theta `thenNF_Tc` \ dicts ->
630 returnNF_Tc (GenInst dicts (mkHsDictApp (mkHsTyApp (HsVar id) tys) (map instToId dicts)))
634 -- Look for short cuts first: if the literal is *definitely* a
635 -- int, integer, float or a double, generate the real thing here.
636 -- This is essential (see nofib/spectral/nucleic).
637 -- [Same shortcut as in newOverloadedLit, but we
638 -- may have done some unification by now]
640 lookupInst inst@(LitInst u lit ty loc)
641 | Just expr <- shortCutLit lit ty
642 = returnNF_Tc (GenInst [] expr) -- GenInst, not SimpleInst, because
643 -- expr may be a constructor application
645 lookupInst inst@(LitInst u (HsIntegral i from_integer_name) ty loc)
646 = tcLookupId from_integer_name `thenNF_Tc` \ from_integer ->
647 newMethodAtLoc loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) ->
648 returnNF_Tc (GenInst [method_inst]
649 (HsApp (HsVar method_id) (HsLit (HsInteger i))))
652 lookupInst inst@(LitInst u (HsFractional f from_rat_name) ty loc)
653 = tcLookupId from_rat_name `thenNF_Tc` \ from_rational ->
654 newMethodAtLoc loc from_rational [ty] `thenNF_Tc` \ (method_inst, method_id) ->
656 rational_ty = tcFunArgTy (idType method_id)
657 rational_lit = HsLit (HsRat f rational_ty)
659 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) rational_lit))
662 There is a second, simpler interface, when you want an instance of a
663 class at a given nullary type constructor. It just returns the
664 appropriate dictionary if it exists. It is used only when resolving
665 ambiguous dictionaries.
668 lookupSimpleInst :: Class
669 -> [Type] -- Look up (c,t)
670 -> NF_TcM (Maybe ThetaType) -- Here are the needed (c,t)s
672 lookupSimpleInst clas tys
673 = tcGetInstEnv `thenNF_Tc` \ inst_env ->
674 case lookupInstEnv inst_env clas tys of
676 -> returnNF_Tc (Just (substTheta (mkSubst emptyInScopeSet tenv) theta))
678 (_, rho) = tcSplitForAllTys (idType dfun)
679 (theta,_) = tcSplitRhoTy rho
681 other -> returnNF_Tc Nothing