From: krasimir <unknown>
Date: Mon, 16 May 2005 13:21:11 +0000 (+0000)
Subject: [project @ 2005-05-16 13:21:11 by krasimir]
X-Git-Tag: Initial_conversion_from_CVS_complete~545
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=afdca09fe9adce721be8f42fd40b5838b3243b8c;p=ghc-hetmet.git

[project @ 2005-05-16 13:21:11 by krasimir]
added modInfoIsExportedName & modInfoLookupName functions
---

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index 8f38dd1..ab55fcc 100644
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -51,6 +51,8 @@ module GHC (
 	modInfoTopLevelScope,
 	modInfoPrintUnqualified,
 	modInfoExports,
+	modInfoIsExportedName,
+	modInfoLookupName,
 	lookupGlobalName,
 
 	-- * Interactive evaluation
@@ -149,7 +151,7 @@ import Bag		( unitBag, emptyBag )
 #endif
 
 import Packages		( initPackages )
-import NameSet		( NameSet, nameSetToList )
+import NameSet		( NameSet, nameSetToList, elemNameSet )
 import RdrName		( GlobalRdrEnv, GlobalRdrElt(..), RdrName, gre_name,
 			  globalRdrEnvElts )
 import HsSyn
@@ -1607,9 +1609,20 @@ modInfoTopLevelScope minf
 modInfoExports :: ModuleInfo -> [Name]
 modInfoExports minf = nameSetToList $! minf_exports minf
 
+modInfoIsExportedName :: ModuleInfo -> Name -> Bool
+modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
+
 modInfoPrintUnqualified :: ModuleInfo -> Maybe PrintUnqualified
 modInfoPrintUnqualified minf = fmap unQualInScope (minf_rdr_env minf)
 
+modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
+modInfoLookupName s minf name = withSession s $ \hsc_env -> do
+   case lookupTypeEnv (minf_type_env minf) name of
+     Just tyThing -> return (Just tyThing)
+     Nothing      -> do
+       eps <- readIORef (hsc_EPS hsc_env)
+       return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
+
 isDictonaryId :: Id -> Bool
 isDictonaryId id
   = case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }