Commit 6f7ad1ac authored by simonmar's avatar simonmar
Browse files

[project @ 2005-04-13 13:17:35 by simonmar]

- checkModule is back, and now returns a ModuleInfo

- added:

  modInfoTopLevelScope :: [Name]
  modInfoExports       :: [Name]

- in order to implement modInfoExports, ModDetails now contains
  md_exports::NameSet.
parent cf09c189
......@@ -34,6 +34,7 @@ module GHC (
depanal,
load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
workingDirectoryChanged,
checkModule, CheckedModule(..),
-- * Inspecting the module structure of the program
ModuleGraph, ModSummary(..),
......@@ -45,13 +46,14 @@ module GHC (
ModuleInfo,
getModuleInfo,
modInfoTyThings,
modInfoTopLevelScope,
lookupName,
allNamesInScope,
-- * Interactive evaluation
getBindings, getPrintUnqual,
#ifdef GHCI
setContext, getContext,
getNamesInScope,
moduleIsInterpreted,
getInfo, GetInfoResult,
exprType,
......@@ -136,6 +138,7 @@ import IfaceSyn ( IfaceDecl )
#endif
import Packages ( initPackages )
import NameSet ( NameSet, nameSetToList )
import RdrName ( GlobalRdrEnv )
import HsSyn ( HsModule, LHsBinds )
import Type ( Kind, Type, dropForAlls )
......@@ -392,6 +395,7 @@ data ErrMsg = ErrMsg {
data LoadHowMuch
= LoadAllTargets
| LoadUpTo Module
| LoadDependenciesOf Module
-- | Try to load the program. If a Module is supplied, then just
-- attempt to load up to this target. If no Module is supplied,
......@@ -475,11 +479,23 @@ load s@(Session ref) how_much
maybe_top_mod = case how_much of
LoadUpTo m -> Just m
LoadDependenciesOf m -> Just m
_ -> Nothing
partial_mg :: [SCC ModSummary]
partial_mg = topSortModuleGraph False mod_graph maybe_top_mod
partial_mg0 :: [SCC ModSummary]
partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
-- LoadDependenciesOf m: we want the upsweep to stop just
-- short of the specified module (unless the specified module
-- is stable).
partial_mg
| LoadDependenciesOf mod <- how_much
= ASSERT( case last partial_mg0 of
AcyclicSCC ms -> ms_mod ms == mod; _ -> False )
List.init partial_mg0
| otherwise
= partial_mg0
stable_mg =
[ AcyclicSCC ms
| AcyclicSCC ms <- full_mg,
......@@ -599,7 +615,53 @@ discardProg hsc_env
-- source file, but that doesn't do any harm.
ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ]
-----------------------------------------------------------------------------
-- -----------------------------------------------------------------------------
-- Check module
data CheckedModule =
CheckedModule { parsedSource :: ParsedSource,
-- ToDo: renamedSource
typecheckedSource :: Maybe TypecheckedSource,
checkedModuleInfo :: Maybe ModuleInfo
}
type ParsedSource = Located (HsModule RdrName)
type TypecheckedSource = LHsBinds Id
-- | This is the way to get access to parsed and typechecked source code
-- for a module. 'checkModule' loads all the dependencies of the specified
-- module in the Session, and then attempts to typecheck the module. If
-- successful, it returns the abstract syntax for the module.
checkModule :: Session -> Module -> (Messages -> IO ())
-> IO (Maybe CheckedModule)
checkModule session@(Session ref) mod msg_act = do
-- load up the dependencies first
r <- load session (LoadDependenciesOf mod)
if (failed r) then return Nothing else do
-- now parse & typecheck the module
hsc_env <- readIORef ref
let mg = hsc_mod_graph hsc_env
case [ ms | ms <- mg, ms_mod ms == mod ] of
[] -> return Nothing
(ms:_) -> do
r <- hscFileCheck hsc_env 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
let minf = ModuleInfo {
minf_details = details,
minf_rdr_env = Just rdr_env
}
return (Just (CheckedModule {
parsedSource = parsed,
typecheckedSource = Just tc_binds,
checkedModuleInfo = Just minf }))
-- ---------------------------------------------------------------------------
-- Unloading
unload :: HscEnv -> [Linkable] -> IO ()
......@@ -1416,11 +1478,6 @@ parseName s str = withSession s $ \hsc_env -> do
-- ToDo: should return error messages
#endif
allNamesInScope :: Session -> IO [Name]
allNamesInScope s = withSession s $ \hsc_env -> do
eps <- readIORef (hsc_EPS hsc_env)
return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
-- | 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)
......@@ -1432,7 +1489,10 @@ lookupName s name = withSession s $ \hsc_env -> do
return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
-- | Container for information about a 'Module'.
newtype ModuleInfo = ModuleInfo ModDetails
data ModuleInfo = ModuleInfo {
minf_details :: ModDetails,
minf_rdr_env :: Maybe GlobalRdrEnv
}
-- ToDo: this should really contain the ModIface too
-- We don't want HomeModInfo here, because a ModuleInfo applies
-- to package modules too.
......@@ -1442,13 +1502,25 @@ 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
Just hmi -> return (Just (ModuleInfo (hm_details hmi)))
Just hmi ->
return (Just (ModuleInfo {
minf_details = hm_details hmi,
minf_rdr_env = mi_globals $! hm_iface hmi
}))
-- ToDo: we should be able to call getModuleInfo on a package module,
-- even one that isn't loaded yet.
-- | The list of top-level entities defined in a module
modInfoTyThings :: ModuleInfo -> [TyThing]
modInfoTyThings (ModuleInfo md) = typeEnvElts (md_types md)
modInfoTyThings minf = typeEnvElts (md_types (minf_details 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)
isDictonaryId :: Id -> Bool
isDictonaryId id
......@@ -1581,6 +1653,11 @@ moduleIsInterpreted s modl = withSession s $ \h ->
getInfo :: Session -> String -> IO [GetInfoResult]
getInfo s id = withSession s $ \hsc_env -> hscGetInfo hsc_env id
-- | Returns all names in scope in the current interactive context
getNamesInScope :: Session -> IO [Name]
getNamesInScope s = withSession s $ \hsc_env -> do
return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
-- -----------------------------------------------------------------------------
-- Getting the type of an expression
......
......@@ -137,7 +137,9 @@ data HscResult
= HscFail
-- In IDE mode: we just do the static/dynamic checks
| HscChecked (Located (HsModule RdrName)) (Maybe (LHsBinds Id, GlobalRdrEnv))
| HscChecked
(Located (HsModule RdrName))
(Maybe (LHsBinds Id, GlobalRdrEnv, ModDetails))
-- Concluded that it wasn't necessary
| HscNoRecomp ModDetails -- new details (HomeSymbolTable additions)
......@@ -318,10 +320,19 @@ hscFileCheck hsc_env msg_act mod_summary = do {
; msg_act tc_msgs
; case maybe_tc_result of {
Nothing -> return (HscChecked rdr_module Nothing);
Just tc_result -> return (HscChecked rdr_module
Just tc_result -> do
let md = ModDetails {
md_types = tcg_type_env tc_result,
md_exports = tcg_exports tc_result,
md_insts = tcg_insts tc_result,
md_rules = [panic "no rules"] }
-- rules are IdCoreRules, not the
-- RuleDecls we get out of the typechecker
return (HscChecked rdr_module
(Just (tcg_binds tc_result,
tcg_rdr_env tc_result)))
}}}}
tcg_rdr_env tc_result,
md)))
}}}}
------------------------------
hscBootBackEnd :: HscEnv -> ModSummary -> Maybe ModIface -> Maybe ModGuts -> IO HscResult
......@@ -334,9 +345,10 @@ hscBootBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result)
mkIface hsc_env (ms_location mod_summary)
maybe_checked_iface ds_result
; let { final_details = ModDetails { md_types = mg_types ds_result,
md_insts = mg_insts ds_result,
md_rules = mg_rules ds_result } }
; let { final_details = ModDetails { md_types = mg_types ds_result,
md_exports = mg_exports ds_result,
md_insts = mg_insts ds_result,
md_rules = mg_rules ds_result } }
-- And the answer is ...
; dumpIfaceStats hsc_env
......@@ -429,9 +441,10 @@ hscBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result)
; final_details <-
if one_shot then return (error "no final details")
else return $! ModDetails {
md_types = mg_types tidy_result,
md_insts = mg_insts tidy_result,
md_rules = mg_rules tidy_result }
md_types = mg_types tidy_result,
md_exports = mg_exports tidy_result,
md_insts = mg_insts tidy_result,
md_rules = mg_rules tidy_result }
-------------------
-- CONVERT TO STG and COMPLETE CODE GENERATION
......
......@@ -360,11 +360,13 @@ data ModDetails
= ModDetails {
-- The next three fields are created by the typechecker
md_types :: !TypeEnv,
md_exports :: NameSet,
md_insts :: ![DFunId], -- Dfun-ids for the instances in this module
md_rules :: ![IdCoreRule] -- Domain may include Ids from other modules
}
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_exports = emptyNameSet,
md_insts = [],
md_rules = [] }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment