Commit 2c77fa71 authored by simonmar's avatar simonmar
Browse files

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

getModuleInfo now does something reasonable for package modules.
parent f908524d
......@@ -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)
......
......@@ -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}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment