depanal,
load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
workingDirectoryChanged,
+ checkModule, CheckedModule(..),
-- * Inspecting the module structure of the program
ModuleGraph, ModSummary(..),
ModuleInfo,
getModuleInfo,
modInfoTyThings,
+ modInfoTopLevelScope,
lookupName,
- allNamesInScope,
-- * Interactive evaluation
getBindings, getPrintUnqual,
#ifdef GHCI
setContext, getContext,
+ getNamesInScope,
moduleIsInterpreted,
getInfo, GetInfoResult,
exprType,
#endif
import Packages ( initPackages )
+import NameSet ( NameSet, nameSetToList )
import RdrName ( GlobalRdrEnv )
import HsSyn ( HsModule, LHsBinds )
import Type ( Kind, Type, dropForAlls )
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,
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,
-- 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 ()
-- 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)
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.
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
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
= 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)
; 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
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
; 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
projects / ghc-hetmet.git / commitdiff