[project @ 2005-05-04 16:20:27 by simonmar]

getModuleInfo now does something reasonable for package modules.

1 files changed, 31 insertions, 8 deletions

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index e47a9b6552..9622729f8e 100644
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -133,7 +133,8 @@ module GHC (
 import qualified Linker
 import Linker		( HValue, extendLinkEnv )
 import NameEnv		( lookupNameEnv )
-import TcRnDriver	( mkExportEnv, getModuleContents, tcRnLookupRdrName )
+import TcRnDriver	( mkExportEnv, getModuleContents, tcRnLookupRdrName,
+			  getModuleExports )
 import RdrName		( plusGlobalRdrEnv )
 import HscMain		( hscGetInfo, GetInfoResult, hscParseIdentifier,
 			  hscStmt, hscTcExpr, hscKcType )
@@ -688,7 +689,8 @@ checkModule session@(Session ref) mod msg_act = do
 		HscChecked parsed renamed
 			   (Just (tc_binds, rdr_env, details)) -> do
 		   let minf = ModuleInfo {
-				minf_details  = details,
+				minf_type_env = md_types details,
+				minf_exports  = md_exports details,
 				minf_rdr_env  = Just rdr_env
 			      }
 		   return (Just (CheckedModule {
@@ -1513,7 +1515,8 @@ getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
 
 -- | Container for information about a 'Module'.
 data ModuleInfo = ModuleInfo {
-	minf_details  :: ModDetails,
+	minf_type_env :: TypeEnv,
+	minf_exports  :: NameSet,
 	minf_rdr_env  :: Maybe GlobalRdrEnv
   }
 	-- ToDo: this should really contain the ModIface too
@@ -1524,11 +1527,31 @@ data ModuleInfo = ModuleInfo {
 getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
 getModuleInfo s mdl = withSession s $ \hsc_env -> do
   case lookupModuleEnv (hsc_HPT hsc_env) mdl of
-    Nothing  -> return Nothing
+    Nothing  -> do
+#ifdef GHCI
+	mb_names <- getModuleExports hsc_env mdl
+	case mb_names of
+	   Nothing -> return Nothing
+	   Just names -> do
+		eps <- readIORef (hsc_EPS hsc_env)
+		let pte = eps_PTE eps
+		    tys = [ ty | name <- nameSetToList names,
+				 Just ty <- [lookupTypeEnv pte name] ]
+		return (Just (ModuleInfo {
+				minf_type_env = mkTypeEnv tys,
+				minf_exports  = names,
+				minf_rdr_env  = Nothing
+			}))
+#else
+	-- bogusly different for non-GHCI (ToDo)
+	return Nothing
+#endif
     Just hmi -> 
+	let details = hm_details hmi in
 	return (Just (ModuleInfo {
-			minf_details = hm_details hmi,
-			minf_rdr_env = mi_globals $! hm_iface hmi
+			minf_type_env = md_types details,
+			minf_exports  = md_exports details,
+			minf_rdr_env  = mi_globals $! hm_iface hmi
 			}))
 
 	-- ToDo: we should be able to call getModuleInfo on a package module,
@@ -1536,14 +1559,14 @@ getModuleInfo s mdl = withSession s $ \hsc_env -> do
 
 -- | The list of top-level entities defined in a module
 modInfoTyThings :: ModuleInfo -> [TyThing]
-modInfoTyThings minf = typeEnvElts (md_types (minf_details minf))
+modInfoTyThings minf = typeEnvElts (minf_type_env minf)
 
 modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
 modInfoTopLevelScope minf
   = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
 
 modInfoExports :: ModuleInfo -> [Name]
-modInfoExports minf = nameSetToList $! (md_exports $! minf_details minf)
+modInfoExports minf = nameSetToList $! minf_exports minf
 
 modInfoPrintUnqualified :: ModuleInfo -> Maybe PrintUnqualified
 modInfoPrintUnqualified minf = fmap unQualInScope (minf_rdr_env minf)