modInfoTopLevelScope,
modInfoPrintUnqualified,
modInfoExports,
- lookupName,
+ lookupGlobalName,
-- * Interactive evaluation
getBindings, getPrintUnqual,
browseModule,
showModule,
compileExpr, HValue,
+ lookupName,
#endif
-- * Abstract syntax elements
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 )
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 {
getPrintUnqual :: Session -> IO PrintUnqualified
getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
-#ifdef GHCI
--- | Parses a string as an identifier, and returns the list of 'Name's that
--- the identifier can refer to in the current interactive context.
-parseName :: Session -> String -> IO [Name]
-parseName s str = withSession s $ \hsc_env -> do
- maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
- case maybe_rdr_name of
- Nothing -> return []
- Just (L _ rdr_name) -> do
- mb_names <- tcRnLookupRdrName hsc_env rdr_name
- case mb_names of
- Nothing -> return []
- Just ns -> return ns
- -- ToDo: should return error messages
-#endif
-
--- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
--- entity known to GHC, including 'Name's defined using 'runStmt'.
-lookupName :: Session -> Name -> IO (Maybe TyThing)
-lookupName s name = withSession s $ \hsc_env -> do
- case lookupTypeEnv (ic_type_env (hsc_IC hsc_env)) name of
- Just tt -> return (Just tt)
- Nothing -> do
- eps <- readIORef (hsc_EPS hsc_env)
- return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
-
-- | 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
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,
-- | 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)
isDictonaryId id
= case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }
+-- | Looks up a global name: that is, any top-level name in any
+-- visible module. Unlike 'lookupName', lookupGlobalName does not use
+-- the interactive context, and therefore does not require a preceding
+-- 'setContext'.
+lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
+lookupGlobalName s name = withSession s $ \hsc_env -> do
+ eps <- readIORef (hsc_EPS hsc_env)
+ return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
+
#if 0
data ObjectCode
-- - typechecked syntax includes extra dictionary translation and
-- AbsBinds which need to be translated back into something closer to
-- the original source.
--- - renamed syntax currently doesn't exist in a single blob, since
--- renaming and typechecking are interleaved at splice points. We'd
--- need a restriction that there are no splices in the source module.
-- ToDo:
-- - Data and Typeable instances for HsSyn.
-- :browse will use either lm_toplev or inspect lm_interface, depending
-- on whether the module is interpreted or not.
--- various abstract syntax types (perhaps IfaceBlah)
-data Type = ...
-data Kind = ...
-
-- This is for reconstructing refactored source code
-- Calls the lexer repeatedly.
-- ToDo: add comment tokens to token stream
getNamesInScope s = withSession s $ \hsc_env -> do
return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
+-- | Parses a string as an identifier, and returns the list of 'Name's that
+-- the identifier can refer to in the current interactive context.
+parseName :: Session -> String -> IO [Name]
+parseName s str = withSession s $ \hsc_env -> do
+ maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
+ case maybe_rdr_name of
+ Nothing -> return []
+ Just (L _ rdr_name) -> do
+ mb_names <- tcRnLookupRdrName hsc_env rdr_name
+ case mb_names of
+ Nothing -> return []
+ Just ns -> return ns
+ -- ToDo: should return error messages
+
+-- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
+-- entity known to GHC, including 'Name's defined using 'runStmt'.
+lookupName :: Session -> Name -> IO (Maybe TyThing)
+lookupName s name = withSession s $ \hsc_env -> do
+ case lookupTypeEnv (ic_type_env (hsc_IC hsc_env)) name of
+ Just tt -> return (Just tt)
+ Nothing -> do
+ eps <- readIORef (hsc_EPS hsc_env)
+ return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
+
-- -----------------------------------------------------------------------------
-- Getting the type of an expression
projects / ghc-hetmet.git / blobdiff