From 2c77fa710ea39f78b4ab09217c67bc79db95b95d Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 4 May 2005 16:20:27 +0000
Subject: [PATCH] [project @ 2005-05-04 16:20:27 by simonmar] getModuleInfo
 now does something reasonable for package modules.

---
 ghc/compiler/main/GHC.hs              |   39 ++++++++++++++++++++++++++-------
 ghc/compiler/typecheck/TcRnDriver.lhs |   32 +++++++++++++++++----------
 2 files changed, 52 insertions(+), 19 deletions(-)

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index e47a9b6..9622729 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)
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 88bbc21..a249285 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -10,6 +10,7 @@ module TcRnDriver (
 	tcRnGetInfo, GetInfoResult,
 	tcRnExpr, tcRnType,
 	tcRnLookupRdrName,
+	getModuleExports, 
 #endif
 	tcRnModule, 
 	tcTopSrcDecls,
@@ -1071,27 +1072,35 @@ tcRnType hsc_env ictxt rdr_type
 
 \begin{code}
 #ifdef GHCI
+getModuleExports :: HscEnv -> Module -> IO (Maybe NameSet)
+getModuleExports hsc_env mod
+  = initTcPrintErrors hsc_env iNTERACTIVE (tcGetModuleExports mod)
+
+tcGetModuleExports :: Module -> TcM NameSet
+tcGetModuleExports mod = do
+  iface <- load_iface mod
+  loadOrphanModules (dep_orphs (mi_deps iface))
+  		-- Load any orphan-module interfaces,
+  		-- so their instances are visible
+  ifaceExportNames (mi_exports iface)
+
 mkExportEnv :: HscEnv -> [Module]	-- Expose these modules' exports only
  	    -> IO GlobalRdrEnv
 mkExportEnv hsc_env exports
   = do	{ mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
-		     mappM getModuleExports exports 
+		     mappM getModuleExportRdrEnv exports 
 	; case mb_envs of
 	     Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
 	     Nothing   -> return emptyGlobalRdrEnv
 			     -- Some error; initTc will have printed it
     }
 
-getModuleExports :: Module -> TcM GlobalRdrEnv
-getModuleExports mod 
-  = do	{ iface <- load_iface mod
-	; loadOrphanModules (dep_orphs (mi_deps iface))
-			-- Load any orphan-module interfaces,
-			-- so their instances are visible
-	; names <- ifaceExportNames (mi_exports iface)
-	; let { gres =  [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
-			| name <- nameSetToList names ] }
-	; returnM (mkGlobalRdrEnv gres) }
+getModuleExportRdrEnv :: Module -> TcM GlobalRdrEnv
+getModuleExportRdrEnv mod = do
+  names <- tcGetModuleExports mod
+  let gres =  [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
+  	      | name <- nameSetToList names ]
+  returnM (mkGlobalRdrEnv gres)
 
 vanillaProv :: Module -> Provenance
 -- We're building a GlobalRdrEnv as if the user imported
@@ -1099,6 +1108,7 @@ vanillaProv :: Module -> Provenance
 vanillaProv mod = Imported [ImportSpec { is_mod = mod, is_as = mod, 
 					 is_qual = False, is_explicit = False,
 					 is_loc = srcLocSpan interactiveSrcLoc }]
+
 \end{code}
 
 \begin{code}
-- 
1.7.10.4