+lookupInst inst@(LitInst _nm (HsIntegral i from_integer_name) ty loc)
+ | Just expr <- shortCutIntLit i ty
+ = returnM (GenInst [] expr) -- GenInst, not SimpleInst, because
+ -- expr may be a constructor application
+ | otherwise
+ = ASSERT( from_integer_name == fromIntegerName ) -- A LitInst invariant
+ tcLookupId fromIntegerName `thenM` \ from_integer ->
+ tcInstClassOp loc from_integer [ty] `thenM` \ method_inst ->
+ mkIntegerLit i `thenM` \ integer_lit ->
+ returnM (GenInst [method_inst]
+ (mkHsApp (L (instLocSrcSpan loc)
+ (HsVar (instToId method_inst))) integer_lit))
+
+lookupInst inst@(LitInst _nm (HsFractional f from_rat_name) ty loc)
+ | Just expr <- shortCutFracLit f ty
+ = returnM (GenInst [] expr)
+
+ | otherwise
+ = ASSERT( from_rat_name == fromRationalName ) -- A LitInst invariant
+ tcLookupId fromRationalName `thenM` \ from_rational ->
+ tcInstClassOp loc from_rational [ty] `thenM` \ method_inst ->
+ mkRatLit f `thenM` \ rat_lit ->
+ returnM (GenInst [method_inst] (mkHsApp (L (instLocSrcSpan loc)
+ (HsVar (instToId method_inst))) rat_lit))
+
+-- Dictionaries
+lookupInst dict@(Dict _ pred@(ClassP clas tys) loc)
+ = do { pkg_ie <- loadImportedInsts clas tys
+ -- Suck in any instance decls that may be relevant
+ ; tcg_env <- getGblEnv
+ ; dflags <- getDOpts
+ ; case lookupInstEnv dflags (pkg_ie, tcg_inst_env tcg_env) clas tys of {
+ ([(tenv, (_,_,dfun_id))], []) -> instantiate_dfun tenv dfun_id pred loc ;
+ (matches, unifs) -> do
+ { traceTc (text "lookupInst fail" <+> vcat [text "dict" <+> ppr pred,
+ text "matches" <+> ppr matches,
+ text "unifs" <+> ppr unifs])
+ ; return NoInstance } } }
+ -- In the case of overlap (multiple matches) we report
+ -- NoInstance here. That has the effect of making the
+ -- context-simplifier return the dict as an irreducible one.
+ -- Then it'll be given to addNoInstanceErrs, which will do another
+ -- lookupInstEnv to get the detailed info about what went wrong.
+
+lookupInst (Dict _ _ _) = returnM NoInstance
+
+-----------------
+instantiate_dfun :: TvSubst -> DFunId -> TcPredType -> InstLoc -> TcM LookupInstResult
+instantiate_dfun tenv dfun_id pred loc
+ = -- tenv is a substitution that instantiates the dfun_id
+ -- to match the requested result type.
+ --
+ -- We ASSUME that the dfun is quantified over the very same tyvars
+ -- that are bound by the tenv.
+ --
+ -- However, the dfun
+ -- might have some tyvars that *only* appear in arguments
+ -- dfun :: forall a b. C a b, Ord b => D [a]
+ -- We instantiate b to a flexi type variable -- it'll presumably
+ -- become fixed later via functional dependencies
+ traceTc (text "lookupInst success" <+>
+ vcat [text "dict" <+> ppr pred,
+ text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ]) `thenM_`
+ -- Record that this dfun is needed
+ record_dfun_usage dfun_id `thenM_`
+
+ getStage `thenM` \ use_stage ->
+ checkWellStaged (ptext SLIT("instance for") <+> quotes (ppr pred))
+ (topIdLvl dfun_id) use_stage `thenM_`
+
+ -- It's possible that not all the tyvars are in
+ -- the substitution, tenv. For example:
+ -- instance C X a => D X where ...
+ -- (presumably there's a functional dependency in class C)
+ -- Hence the open_tvs to instantiate any un-substituted tyvars.
+ let
+ (tyvars, rho) = tcSplitForAllTys (idType dfun_id)
+ open_tvs = filter (`notElemTvSubst` tenv) tyvars
+ in
+ mappM tcInstTyVar open_tvs `thenM` \ open_tvs' ->