-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 (OtherError (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 (OtherError ("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{ hit=hit, hst=hst, pcs=pcs, ic=old_ic } = cmstate
+
+ toplev_mods <- mapM (getTopLevModule hit) (map mkModuleName toplevs)
+ export_mods <- mapM (moduleNameToModule hit) (map mkModuleName exports)
+
+ (new_pcs, print_unqual, maybe_env)
+ <- mkGlobalContext dflags hit hst 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,
+ ic_print_unqual = print_unqual } }
+
+getTopLevModule hit mn =
+ case lookupModuleEnvByName hit mn of
+ Just iface
+ | Just _ <- mi_globals iface -> return (mi_module iface)
+ _other -> throwDyn (CmdLineError (
+ "cannot enter the top-level scope of a compiled module (module `" ++
+ moduleNameUserString mn ++ "')"))
+
+moduleNameToModule :: HomeIfaceTable -> ModuleName -> IO Module
+moduleNameToModule hit mn = do
+ case lookupModuleEnvByName hit mn of
+ Just iface -> return (mi_module iface)
+ _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 (hit cmstate) (mkModuleName str) of
+ Just iface -> return (not (isNothing (mi_globals iface)))
+ _not_a_home_module -> return False
+
+-----------------------------------------------------------------------------
+-- cmInfoThing: convert a String to a TyThing
+
+-- A string may refer to more than one TyThing (eg. a constructor,
+-- and type constructor), so we return a list of all the possible TyThings.
+
+#ifdef GHCI
+cmInfoThing :: CmState -> DynFlags -> String -> IO (CmState, [(TyThing,Fixity)])
+cmInfoThing cmstate dflags id
+ = do (new_pcs, things) <- hscThing dflags hst hit pcs icontext id
+ let pairs = map (\x -> (x, getFixity new_pcs (getName x))) things
+ return (cmstate{ pcs=new_pcs }, pairs)
+ where
+ CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } = cmstate
+
+ getFixity :: PersistentCompilerState -> Name -> Fixity
+ getFixity pcs name
+ | isGlobalName name,
+ Just iface <- lookupModuleEnv iface_table (nameModule name),
+ Just fixity <- lookupNameEnv (mi_fixities iface) name
+ = fixity
+ | otherwise
+ = defaultFixity
+ where iface_table | isHomePackageName name = hit
+ | otherwise = pcs_PIT pcs
+#endif
+
+-- ---------------------------------------------------------------------------
+-- cmBrowseModule: get all the TyThings defined in a module
+
+#ifdef GHCI
+cmBrowseModule :: CmState -> DynFlags -> String -> Bool
+ -> IO (CmState, [TyThing])
+cmBrowseModule cmstate dflags str exports_only = do
+ let mn = mkModuleName str
+ mod <- moduleNameToModule hit mn
+ (pcs1, maybe_ty_things)
+ <- hscModuleContents dflags hst hit pcs mod exports_only
+ case maybe_ty_things of
+ Nothing -> return (cmstate{pcs=pcs1}, [])
+ Just ty_things -> return (cmstate{pcs=pcs1}, ty_things)
+ where
+ CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } = cmstate
+#endif