loadMsgs,
workingDirectoryChanged,
checkModule, CheckedModule(..),
- TypecheckedSource, ParsedSource,
+ TypecheckedSource, ParsedSource, RenamedSource,
-- * Inspecting the module structure of the program
ModuleGraph, ModSummary(..),
modInfoTopLevelScope,
modInfoPrintUnqualified,
modInfoExports,
- lookupName,
+ lookupGlobalName,
-- * Interactive evaluation
getBindings, getPrintUnqual,
browseModule,
showModule,
compileExpr, HValue,
+ lookupName,
#endif
-- * Abstract syntax elements
-- ** 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 TcRnDriver ( mkExportEnv, getModuleContents, tcRnLookupRdrName,
+ getModuleExports )
import RdrName ( plusGlobalRdrEnv )
import HscMain ( hscGetInfo, GetInfoResult, hscParseIdentifier,
hscStmt, hscTcExpr, hscKcType )
import Packages ( initPackages )
import NameSet ( NameSet, nameSetToList )
import RdrName ( GlobalRdrEnv )
-import HsSyn ( HsModule, LHsBinds )
+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 InstEnv ( Instance )
import Name ( Name, getName, nameModule_maybe )
import RdrName ( RdrName, gre_name, globalRdrEnvElts )
import NameEnv ( nameEnvElts )
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 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 }))
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
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
= 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
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