-cmSetContext :: CmState -> String -> IO CmState
-cmSetContext cmstate str
- = do let mn = mkModuleName str
- modules_loaded = [ (name_of_summary s, ms_mod s) | s <- mg cmstate ]
-
- m <- case lookup mn modules_loaded of
- Just m -> return m
- Nothing -> do
- mod <- moduleNameToModule mn
- if isHomeModule mod
- then throwDyn (CmdLineError (showSDoc
- (quotes (ppr (moduleName mod))
- <+> text "is not currently loaded")))
- else return mod
-
- return cmstate{ ic = (ic cmstate){ic_module=m} }
-
-cmGetContext :: CmState -> IO String
-cmGetContext cmstate = return (moduleUserString (ic_module (ic cmstate)))
-
-moduleNameToModule :: ModuleName -> IO Module
-moduleNameToModule mn
- = do maybe_stuff <- findModule mn
- case maybe_stuff of
- Nothing -> throwDyn (CmdLineError ("can't find module `"
- ++ moduleNameUserString mn ++ "'"))
- Just (m,_) -> return m
+cmSetContext
+ :: CmState -> DynFlags
+ -> [String] -- take the top-level scopes of these modules
+ -> [String] -- and the just the exports from these
+ -> IO CmState
+cmSetContext cmstate dflags toplevs exports = do
+ let CmState{ hpt=hpt, pcs=pcs, ic=old_ic } = cmstate
+ hsc_env = HscEnv { hsc_mode = Interactive, hsc_dflags = dflags,
+ hsc_HPT = hpt }
+
+ toplev_mods <- mapM (getTopLevModule hpt) (map mkModuleName toplevs)
+ export_mods <- mapM (moduleNameToModule hpt) (map mkModuleName exports)
+
+ (new_pcs, maybe_env)
+ <- mkGlobalContext hsc_env pcs toplev_mods export_mods
+
+ case maybe_env of
+ Nothing -> return cmstate
+ Just env -> return cmstate{ pcs = new_pcs,
+ ic = old_ic{ ic_toplev_scope = toplev_mods,
+ ic_exports = export_mods,
+ ic_rn_gbl_env = env } }
+
+getTopLevModule hpt mn =
+ case lookupModuleEnvByName hpt mn of
+
+ Just mod_info
+ | isJust (mi_globals iface) -> return (mi_module iface)
+ where
+ iface = hm_iface mod_info
+
+ _other -> throwDyn (CmdLineError (
+ "cannot enter the top-level scope of a compiled module (module `" ++
+ moduleNameUserString mn ++ "')"))
+
+moduleNameToModule :: HomePackageTable -> ModuleName -> IO Module
+moduleNameToModule hpt mn = do
+ case lookupModuleEnvByName hpt mn of
+ Just mod_info -> return (mi_module (hm_iface mod_info))
+ _not_a_home_module -> do
+ maybe_stuff <- findModule mn
+ case maybe_stuff of
+ Nothing -> throwDyn (CmdLineError ("can't find module `"
+ ++ moduleNameUserString mn ++ "'"))
+ Just (m,_) -> return m
+
+cmGetContext :: CmState -> IO ([String],[String])
+cmGetContext CmState{ic=ic} =
+ return (map moduleUserString (ic_toplev_scope ic),
+ map moduleUserString (ic_exports ic))
+
+cmModuleIsInterpreted :: CmState -> String -> IO Bool
+cmModuleIsInterpreted cmstate str
+ = case lookupModuleEnvByName (hpt cmstate) (mkModuleName str) of
+ Just details -> return (isJust (mi_globals (hm_iface details)))
+ _not_a_home_module -> return False