-lookupInst inst@(LitInst u (OverloadedIntegral i) ty orig loc)
- | i >= toInteger minInt && i <= toInteger maxInt
- = -- It's overloaded but small enough to fit into an Int
- tcLookupGlobalValueByKey fromIntClassOpKey `thenNF_Tc` \ from_int ->
- newMethodAtLoc orig loc from_int [ty] `thenNF_Tc` \ (method_inst, method_id) ->
- returnTc ([method_inst], VarMonoBind (instToId inst) (HsApp (HsVar method_id) int_lit))
-
- | otherwise
- = -- Alas, it is overloaded and a big literal!
- tcLookupGlobalValueByKey fromIntegerClassOpKey `thenNF_Tc` \ from_integer ->
- newMethodAtLoc orig loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) ->
- returnTc ([method_inst], VarMonoBind (instToId inst) (HsApp (HsVar method_id) (HsLitOut (HsInt i) integerTy)))
- where
- intprim_lit = HsLitOut (HsIntPrim i) intPrimTy
- int_lit = HsApp (HsVar (RealId intDataCon)) intprim_lit
-
-lookupInst inst@(LitInst u (OverloadedFractional f) ty orig loc)
- = tcLookupGlobalValueByKey fromRationalClassOpKey `thenNF_Tc` \ from_rational ->
-
- -- The type Rational isn't wired in so we have to conjure it up
- tcLookupTyConByKey rationalTyConKey `thenNF_Tc` \ rational_tycon ->
- let
- rational_ty = mkSynTy rational_tycon []
- rational_lit = HsLitOut (HsFrac f) rational_ty
- in
- newMethodAtLoc orig loc from_rational [ty] `thenNF_Tc` \ (method_inst, method_id) ->
- returnTc ([method_inst], VarMonoBind (instToId inst) (HsApp (HsVar method_id) rational_lit))
-\end{code}
-
-There is a second, simpler interface, when you want an instance of a
-class at a given nullary type constructor. It just returns the
-appropriate dictionary if it exists. It is used only when resolving
-ambiguous dictionaries.
-
-\begin{code}
-lookupSimpleInst :: ClassInstEnv
- -> Class
- -> Type -- Look up (c,t)
- -> TcM s [(Class,Type)] -- Here are the needed (c,t)s
-
-lookupSimpleInst class_inst_env clas ty
- = case (lookupMEnv matchTy class_inst_env ty) of
- Nothing -> failTc (noSimpleInst clas ty)
- Just (dfun,tenv) -> returnTc [(c,instantiateTy tenv t) | (c,t) <- theta]
- where
- (_, theta, _) = splitSigmaTy (idType dfun)
-
-noSimpleInst clas ty sty
- = sep [ptext SLIT("No instance for class"), ppr sty clas,
- ptext SLIT("at type"), ppr sty ty]
-\end{code}
-
-
-@mkInstSpecEnv@ is used to construct the @SpecEnv@ for a dfun.
-It does it by filtering the class's @InstEnv@. All pretty shady stuff.
-
-\begin{code}
-mkInstSpecEnv clas inst_ty inst_tvs inst_theta = panic "mkInstSpecEnv"
-\end{code}
-
-\begin{pseudocode}
-mkInstSpecEnv :: Class -- class
- -> Type -- instance type
- -> [TyVarTemplate] -- instance tyvars
- -> ThetaType -- superclasses dicts
- -> SpecEnv -- specenv for dfun of instance
-
-mkInstSpecEnv clas inst_ty inst_tvs inst_theta
- = mkSpecEnv (catMaybes (map maybe_spec_info matches))
- where
- matches = matchMEnv matchTy (classInstEnv clas) inst_ty