extendModuleEnvList, extendModuleEnv,
moduleNameUserString,
ModLocation(..) )
+import RdrName ( GlobalRdrEnv, plusGlobalRdrEnv )
import GetImports
import UniqFM
import Digraph ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
-> [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} =
\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