Commit 6959a665 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-11-05 11:39:38 by simonpj]

Fix a stupid error in interactive environment handling (not present in STABLE)
parent f0ec96ba
......@@ -69,6 +69,7 @@ import Module ( Module, ModuleName, moduleName, mkModuleName, isHomeModule,
extendModuleEnvList, extendModuleEnv,
moduleNameUserString,
ModLocation(..) )
import RdrName ( GlobalRdrEnv, plusGlobalRdrEnv )
import GetImports
import UniqFM
import Digraph ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
......@@ -179,17 +180,25 @@ cmSetContext
-> [String] -- and the just the exports from these
-> IO CmState
cmSetContext cmstate toplevs exports = do
let old_ic = cm_ic cmstate
mb_export_env <- mkExportEnv (cm_hsc cmstate)
(map mkModuleName exports)
case mb_export_env of
Nothing -> return cmstate -- Error already reported; do a no-op
Just export_env ->
return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
ic_exports = exports,
ic_rn_gbl_env = export_env } }
let old_ic = cm_ic cmstate
hsc_env = cm_hsc cmstate
hpt = hsc_HPT hsc_env
export_env <- mkExportEnv hsc_env (map mkModuleName exports)
toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
ic_exports = exports,
ic_rn_gbl_env = all_env } }
mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
mkTopLevEnv hpt mod
= case lookupModuleEnvByName hpt (mkModuleName mod) of
Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++ mod))
Just details -> case hm_globals details of
Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not interpreted " ++ mod))
Just env -> return env
cmGetContext :: CmState -> IO ([String],[String])
cmGetContext CmState{cm_ic=ic} =
......
......@@ -788,12 +788,15 @@ tcTopSrcDecls
\begin{code}
#ifdef GHCI
mkExportEnv :: HscEnv -> [ModuleName] -- Expose these modules' exports only
-> IO (Maybe GlobalRdrEnv)
-> IO GlobalRdrEnv
mkExportEnv hsc_env exports
= initTc hsc_env iNTERACTIVE $ do {
export_envs <- mappM getModuleExports exports ;
returnM (foldr plusGlobalRdrEnv emptyGlobalRdrEnv export_envs)
= do { mb_envs <- initTc hsc_env iNTERACTIVE $
mappM getModuleExports exports
; case mb_envs of
Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
Nothing -> return emptyGlobalRdrEnv
-- Some error; initTc will have printed it
}
getModuleExports :: ModuleName -> TcM GlobalRdrEnv
......
Supports Markdown
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