setMsgHandler,
-- * Targets
- Target(..), TargetId(..),
+ Target(..), TargetId(..), Phase,
setTargets,
getTargets,
addTarget,
loadMsgs,
workingDirectoryChanged,
checkModule, CheckedModule(..),
+ TypecheckedSource, ParsedSource, RenamedSource,
-- * Inspecting the module structure of the program
ModuleGraph, ModSummary(..),
getModuleInfo,
modInfoTyThings,
modInfoTopLevelScope,
- lookupName,
+ modInfoPrintUnqualified,
+ modInfoExports,
+ modInfoIsExportedName,
+ modInfoLookupName,
+ lookupGlobalName,
-- * Interactive evaluation
getBindings, getPrintUnqual,
browseModule,
showModule,
compileExpr, HValue,
+ lookupName,
#endif
-- * Abstract syntax elements
Module, mkModule, pprModule,
-- ** Names
- Name,
+ Name, nameModule,
-- ** Identifiers
Id, idType,
-- ** Entities
TyThing(..),
+ -- ** Syntax
+ module HsSyn, -- ToDo: remove extraneous bits
+
-- * Exceptions
GhcException(..), showGhcException,
{-
ToDo:
- * return error messages rather than printing them.
* inline bits of HscMain here to simplify layering: hscGetInfo,
hscTcExpr, hscStmt.
- * implement second argument to load.
* we need to expose DynFlags, so should parseDynamicFlags really be
part of this interface?
* what StaticFlags should we expose, if any?
import qualified Linker
import Linker ( HValue, extendLinkEnv )
import NameEnv ( lookupNameEnv )
-import TcRnDriver ( mkExportEnv, getModuleContents, tcRnLookupRdrName )
-import RdrName ( plusGlobalRdrEnv )
+import TcRnDriver ( getModuleContents, tcRnLookupRdrName,
+ getModuleExports )
+import RdrName ( plusGlobalRdrEnv, Provenance(..), ImportSpec(..),
+ emptyGlobalRdrEnv, mkGlobalRdrEnv )
import HscMain ( hscGetInfo, GetInfoResult, hscParseIdentifier,
hscStmt, hscTcExpr, hscKcType )
import Type ( tidyType )
import VarEnv ( emptyTidyEnv )
import GHC.Exts ( unsafeCoerce# )
import IfaceSyn ( IfaceDecl )
+import Name ( getName, nameModule_maybe )
+import SrcLoc ( mkSrcLoc, srcLocSpan, interactiveSrcLoc )
+import Bag ( unitBag, emptyBag )
#endif
import Packages ( initPackages )
-import NameSet ( NameSet, nameSetToList )
-import RdrName ( GlobalRdrEnv )
-import HsSyn ( HsModule, LHsBinds )
+import NameSet ( NameSet, nameSetToList, elemNameSet )
+import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName, gre_name,
+ globalRdrEnvElts )
+import HsSyn
import Type ( Kind, Type, dropForAlls )
import Id ( Id, idType, isImplicitId, isDeadBinder,
isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon )
import Class ( Class, classSCTheta, classTvsFds )
import DataCon ( DataCon )
-import Name ( Name, getName, nameModule_maybe )
-import RdrName ( RdrName, gre_name, globalRdrEnvElts )
+import Name ( Name, nameModule )
import NameEnv ( nameEnvElts )
import SrcLoc ( Located(..) )
import DriverPipeline
import BasicTypes ( SuccessFlag(..), succeeded, failed )
import Maybes ( orElse, expectJust, mapCatMaybes )
import TcType ( tcSplitSigmaTy, isDictTy )
+import FastString ( mkFastString )
import Directory ( getModificationTime, doesFileExist )
import Maybe ( isJust, isNothing, fromJust, fromMaybe, catMaybes )
-- then use that
-- - otherwise interpret the string as a module name
--
-guessTarget :: String -> IO Target
-guessTarget file
+guessTarget :: String -> Maybe Phase -> IO Target
+guessTarget file (Just phase)
+ = return (Target (TargetFile file (Just phase)) Nothing)
+guessTarget file Nothing
| isHaskellSrcFilename file
- = return (Target (TargetFile file) Nothing)
+ = return (Target (TargetFile file Nothing) Nothing)
| otherwise
= do exists <- doesFileExist hs_file
- if exists then return (Target (TargetFile hs_file) Nothing) else do
+ if exists
+ then return (Target (TargetFile hs_file Nothing) Nothing)
+ else do
exists <- doesFileExist lhs_file
- if exists then return (Target (TargetFile lhs_file) Nothing) else do
+ if exists
+ then return (Target (TargetFile lhs_file Nothing) Nothing)
+ else do
return (Target (TargetModule (mkModule file)) Nothing)
where
- hs_file = file ++ ".hs"
- lhs_file = file ++ ".lhs"
+ hs_file = file `joinFileExt` "hs"
+ lhs_file = file `joinFileExt` "lhs"
-- -----------------------------------------------------------------------------
-- Loading the program
data CheckedModule =
CheckedModule { parsedSource :: ParsedSource,
- -- ToDo: renamedSource
+ renamedSource :: Maybe RenamedSource,
typecheckedSource :: Maybe TypecheckedSource,
checkedModuleInfo :: Maybe ModuleInfo
}
-type ParsedSource = Located (HsModule RdrName)
+type ParsedSource = Located (HsModule RdrName)
+type RenamedSource = HsGroup Name
type TypecheckedSource = LHsBinds Id
-- | This is the way to get access to parsed and typechecked source code
case [ ms | ms <- mg, ms_mod ms == mod ] of
[] -> return Nothing
(ms:_) -> do
- r <- hscFileCheck hsc_env msg_act ms
+ -- Add in the OPTIONS from the source file This is nasty:
+ -- we've done this once already, in the compilation manager
+ -- It might be better to cache the flags in the
+ -- ml_hspp_file field, say
+ let dflags0 = hsc_dflags hsc_env
+ hspp_buf = expectJust "GHC.checkModule" (ms_hspp_buf ms)
+ opts = getOptionsFromStringBuffer hspp_buf
+ (dflags1,leftovers) <- parseDynamicFlags dflags0 (map snd opts)
+ if (not (null leftovers))
+ then do let filename = fromJust (ml_hs_file (ms_location ms))
+ msg_act (optionsErrorMsgs leftovers opts filename)
+ return Nothing
+ else do
+
+ r <- hscFileCheck hsc_env{hsc_dflags=dflags1} msg_act ms
case r of
HscFail ->
return Nothing
- HscChecked parsed Nothing ->
- return (Just (CheckedModule parsed Nothing Nothing))
- HscChecked parsed (Just (tc_binds, rdr_env, details)) -> do
+ HscChecked parsed renamed Nothing ->
+ return (Just (CheckedModule {
+ parsedSource = parsed,
+ renamedSource = renamed,
+ typecheckedSource = Nothing,
+ checkedModuleInfo = Nothing }))
+ 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 {
parsedSource = parsed,
+ renamedSource = renamed,
typecheckedSource = Just tc_binds,
checkedModuleInfo = Just minf }))
HscEnv, -- With an updated HPT
[ModSummary]) -- Mods which succeeded
-upsweep hsc_env old_hpt stable_mods cleanup msg_act
- []
+upsweep hsc_env old_hpt stable_mods cleanup msg_act mods
+ = upsweep' hsc_env old_hpt stable_mods cleanup msg_act mods 1 (length mods)
+
+upsweep' hsc_env old_hpt stable_mods cleanup msg_act
+ [] _ _
= return (Succeeded, hsc_env, [])
-upsweep hsc_env old_hpt stable_mods cleanup msg_act
- (CyclicSCC ms:_)
+upsweep' hsc_env old_hpt stable_mods cleanup msg_act
+ (CyclicSCC ms:_) _ _
= do putMsg (showSDoc (cyclicModuleErr ms))
return (Failed, hsc_env, [])
-upsweep hsc_env old_hpt stable_mods cleanup msg_act
- (AcyclicSCC mod:mods)
+upsweep' hsc_env old_hpt stable_mods cleanup msg_act
+ (AcyclicSCC mod:mods) mod_index nmods
= do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
-- show (map (moduleUserString.moduleName.mi_module.hm_iface)
-- (moduleEnvElts (hsc_HPT hsc_env)))
mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods msg_act mod
+ mod_index nmods
cleanup -- Remove unwanted tmp files between compilations
| otherwise = delModuleEnv old_hpt this_mod
; (restOK, hsc_env2, modOKs)
- <- upsweep hsc_env1 old_hpt1 stable_mods cleanup
- msg_act mods
+ <- upsweep' hsc_env1 old_hpt1 stable_mods cleanup
+ msg_act mods (mod_index+1) nmods
; return (restOK, hsc_env2, mod:modOKs)
}
-> ([Module],[Module])
-> (Messages -> IO ())
-> ModSummary
+ -> Int -- index of module
+ -> Int -- total number of modules
-> IO (Maybe HomeModInfo) -- Nothing => Failed
-upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) msg_act summary
+upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) msg_act summary mod_index nmods
= do
let
this_mod = ms_mod summary
compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
compile_it = upsweep_compile hsc_env old_hpt this_mod
- msg_act summary
+ msg_act summary mod_index nmods
case ghcMode (hsc_dflags hsc_env) of
BatchCompile ->
old_hmi = lookupModuleEnv old_hpt this_mod
-- Run hsc to compile a module
-upsweep_compile hsc_env old_hpt this_mod msg_act summary mb_old_linkable = do
+upsweep_compile hsc_env old_hpt this_mod msg_act summary
+ mod_index nmods
+ mb_old_linkable = do
let
-- The old interface is ok if it's in the old HPT
-- a) we're compiling a source file, and the old HPT
- -- entry is for a source file
+ -- entry is for a source file
-- b) we're compiling a hs-boot file
-- Case (b) allows an hs-boot file to get the interface of its
-- real source file on the second iteration of the compilation
iface = hm_iface hm_info
compresult <- compile hsc_env msg_act summary mb_old_linkable mb_old_iface
+ mod_index nmods
case compresult of
-- Compilation failed. Compile may still have updated the PCS, tho.
old_summary_map = mkNodeMap old_summaries
getRootSummary :: Target -> IO ModSummary
- getRootSummary (Target (TargetFile file) maybe_buf)
+ getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
= do exists <- doesFileExist file
- if exists then summariseFile hsc_env file maybe_buf else do
+ if exists
+ then summariseFile hsc_env old_summaries file mb_phase maybe_buf
+ else do
throwDyn (CmdLineError ("can't find file: " ++ file))
getRootSummary (Target (TargetModule modl) maybe_buf)
- = do maybe_summary <- summarise hsc_env emptyNodeMap Nothing False
+ = do maybe_summary <- summariseModule hsc_env old_summary_map Nothing False
modl maybe_buf excl_mods
case maybe_summary of
Nothing -> packageModErr modl
loop [] done = return (nodeMapElts done)
loop ((cur_path, wanted_mod, is_boot) : ss) done
| key `elemFM` done = loop ss done
- | otherwise = do { mb_s <- summarise hsc_env old_summary_map
+ | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map
(Just cur_path) is_boot
wanted_mod Nothing excl_mods
; case mb_s of
-- a summary. The finder is used to locate the file in which the module
-- resides.
-summariseFile :: HscEnv -> FilePath
- -> Maybe (StringBuffer,ClockTime)
- -> IO ModSummary
--- Used for Haskell source only, I think
--- We know the file name, and we know it exists,
--- but we don't necessarily know the module name (might differ)
-summariseFile hsc_env file maybe_buf
- = do let dflags = hsc_dflags hsc_env
+summariseFile
+ :: HscEnv
+ -> [ModSummary] -- old summaries
+ -> FilePath -- source file name
+ -> Maybe Phase -- start phase
+ -> Maybe (StringBuffer,ClockTime)
+ -> IO ModSummary
+
+summariseFile hsc_env old_summaries file mb_phase maybe_buf
+ -- we can use a cached summary if one is available and the
+ -- source file hasn't changed, But we have to look up the summary
+ -- by source file, rather than module name as we do in summarise.
+ | Just old_summary <- findSummaryBySourceFile old_summaries file
+ = do
+ let location = ms_location old_summary
+
+ -- return the cached summary if the source didn't change
+ src_timestamp <- case maybe_buf of
+ Just (_,t) -> return t
+ Nothing -> getModificationTime file
+
+ if ms_hs_date old_summary == src_timestamp
+ then do -- update the object-file timestamp
+ obj_timestamp <- getObjTimestamp location False
+ return old_summary{ ms_obj_date = obj_timestamp }
+ else
+ new_summary
+
+ | otherwise
+ = new_summary
+ where
+ new_summary = do
+ let dflags = hsc_dflags hsc_env
(dflags', hspp_fn, buf)
- <- preprocessFile dflags file maybe_buf
+ <- preprocessFile dflags file mb_phase maybe_buf
(srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn
ms_hs_date = src_timestamp,
ms_obj_date = obj_timestamp })
+findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
+findSummaryBySourceFile summaries file
+ = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
+ fromJust (ml_hs_file (ms_location ms)) == file ] of
+ [] -> Nothing
+ (x:xs) -> Just x
+
-- Summarise a module, and pick up source and timestamp.
-summarise :: HscEnv
+summariseModule
+ :: HscEnv
-> NodeMap ModSummary -- Map of old summaries
-> Maybe FilePath -- Importing module (for error messages)
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> [Module] -- Modules to exclude
-> IO (Maybe ModSummary) -- Its new summary
-summarise hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf excl_mods
+summariseModule hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf excl_mods
| wanted_mod `elem` excl_mods
= return Nothing
= do -- Find its new timestamp; all the
-- ModSummaries in the old map have valid ml_hs_files
let location = ms_location old_summary
- src_fn = expectJust "summarise" (ml_hs_file location)
+ src_fn = expectJust "summariseModule" (ml_hs_file location)
-- return the cached summary if the source didn't change
src_timestamp <- case maybe_buf of
= do
-- Preprocess the source file and get its imports
-- The dflags' contains the OPTIONS pragmas
- (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn maybe_buf
+ (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
(srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
when (mod_name /= wanted_mod) $
else modificationTimeIfExists (ml_obj_file location)
-preprocessFile :: DynFlags -> FilePath -> Maybe (StringBuffer,ClockTime)
+preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
-> IO (DynFlags, FilePath, StringBuffer)
-preprocessFile dflags src_fn Nothing
+preprocessFile dflags src_fn mb_phase Nothing
= do
- (dflags', hspp_fn) <- preprocess dflags src_fn
+ (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
buf <- hGetStringBuffer hspp_fn
return (dflags', hspp_fn, buf)
-preprocessFile dflags src_fn (Just (buf, time))
+preprocessFile dflags src_fn mb_phase (Just (buf, time))
= do
-- case we bypass the preprocessing stage?
let
local_opts = getOptionsFromStringBuffer buf
--
- (dflags', errs) <- parseDynamicFlags dflags local_opts
+ (dflags', errs) <- parseDynamicFlags dflags (map snd local_opts)
let
needs_preprocessing
- | Unlit _ <- startPhase src_fn = True
+ | Just (Unlit _) <- mb_phase = True
+ | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
-- note: local_opts is only required if there's no Unlit phase
| dopt Opt_Cpp dflags' = True
| dopt Opt_Pp dflags' = True
when needs_preprocessing $
ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
- return (dflags', "<buffer>", buf)
+ return (dflags', src_fn, buf)
-----------------------------------------------------------------------------
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
+ n_list = nameSetToList names
+ tys = [ ty | name <- n_list,
+ Just ty <- [lookupTypeEnv pte name] ]
+ --
+ return (Just (ModuleInfo {
+ minf_type_env = mkTypeEnv tys,
+ minf_exports = names,
+ minf_rdr_env = Just $! nameSetToGlobalRdrEnv names mdl
+ }))
+#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
+
+modInfoIsExportedName :: ModuleInfo -> Name -> Bool
+modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
+
+modInfoPrintUnqualified :: ModuleInfo -> Maybe PrintUnqualified
+modInfoPrintUnqualified minf = fmap unQualInScope (minf_rdr_env minf)
+
+modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
+modInfoLookupName s minf name = withSession s $ \hsc_env -> do
+ case lookupTypeEnv (minf_type_env minf) name of
+ Just tyThing -> return (Just tyThing)
+ Nothing -> do
+ eps <- readIORef (hsc_EPS hsc_env)
+ return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
isDictonaryId :: Id -> Bool
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
= ByteCode
| BinaryCode FilePath
-type TypecheckedCode = HsTypecheckedGroup
-type RenamedCode = [HsGroup Name]
-
-- ToDo: typechecks abstract syntax or renamed abstract syntax. Issues:
-- - 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
ic_exports = exports,
ic_rn_gbl_env = all_env } }
+-- Make a GlobalRdrEnv based on the exports of the modules only.
+mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
+mkExportEnv hsc_env mods = do
+ mb_name_sets <- mapM (getModuleExports hsc_env) mods
+ let
+ gres = [ nameSetToGlobalRdrEnv name_set mod
+ | (Just name_set, mod) <- zip mb_name_sets mods ]
+ --
+ return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
+
+nameSetToGlobalRdrEnv :: NameSet -> Module -> GlobalRdrEnv
+nameSetToGlobalRdrEnv names mod =
+ mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = vanillaProv mod }
+ | name <- nameSetToList names ]
+
+vanillaProv :: Module -> Provenance
+-- We're building a GlobalRdrEnv as if the user imported
+-- all the specified modules into the global interactive module
+vanillaProv mod = Imported [ImportSpec { is_mod = mod, is_as = mod,
+ is_qual = False, is_explicit = False,
+ is_loc = srcLocSpan interactiveSrcLoc }]
+
checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
checkModuleExists hsc_env hpt mod =
case lookupModuleEnv hpt mod of
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