[project @ 2005-05-16 13:21:11 by krasimir]
authorkrasimir <unknown>
Mon, 16 May 2005 13:21:11 +0000 (13:21 +0000)
committerkrasimir <unknown>
Mon, 16 May 2005 13:21:11 +0000 (13:21 +0000)
added modInfoIsExportedName & modInfoLookupName functions

ghc/compiler/main/GHC.hs

index 8f38dd1..ab55fcc 100644 (file)
@@ -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 }