[project @ 1999-12-20 10:34:27 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcEnv.lhs

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 49da0db..6b13551 100644 (file)
--- 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) ->