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

getModuleInfo now does something reasonable for package modules.

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index e47a9b6..9622729 100644 (file)
--- 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 (file)
--- 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}