X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcEnv.lhs;h=6b13551a600cfcbb6604636c8e44a0635185cd7e;hb=e921b2e307532e0f30eefa88b11a124be592bde4;hp=49da0db77b874343b43b2f549bdf60c772ef36da;hpb=f7989a6dea8c43352f363117d9bb07439953ccdc;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 49da0db..6b13551 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -13,7 +13,7 @@ module TcEnv(
 
 	tcLookupTy,
 	tcLookupTyCon, tcLookupTyConByKey, 
-	tcLookupClass, tcLookupClassByKey,
+	tcLookupClass, tcLookupClassByKey, tcLookupClassByKey_maybe,
 
 	tcExtendGlobalValEnv, tcExtendLocalValEnv,
 	tcGetValueEnv,        tcSetValueEnv, 
@@ -332,6 +332,13 @@ tcLookupClassByKey key
 	Just (_, _, AClass cl) -> returnNF_Tc cl
 	other		       -> pprPanic "tcLookupClassByKey:" (pprUnique10 key)
 
+tcLookupClassByKey_maybe :: Unique -> NF_TcM s (Maybe Class)
+tcLookupClassByKey_maybe key
+  = tcGetEnv		`thenNF_Tc` \ (TcEnv ue te ve gtvs) ->
+    case lookupUFM_Directly te key of
+	Just (_, _, AClass cl) -> returnNF_Tc (Just cl)
+	other		       -> returnNF_Tc Nothing
+
 tcLookupTyConByKey :: Unique -> NF_TcM s TyCon
 tcLookupTyConByKey key
   = tcGetEnv		`thenNF_Tc` \ (TcEnv ue te ve gtvs) ->