cmSetContext cmstate toplevs exports = do
let old_ic = cm_ic cmstate
- export_env <- mkExportEnv (cm_hsc cmstate)
- (map mkModuleName exports)
+ mb_export_env <- mkExportEnv (cm_hsc cmstate)
+ (map mkModuleName exports)
- putStrLn (showSDoc (text "export env" $$ ppr export_env))
- return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
- ic_exports = exports,
- ic_rn_gbl_env = export_env } }
+ case mb_export_env of
+ Nothing -> return cmstate -- Error already reported; do a no-op
+ Just export_env ->
+ return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
+ ic_exports = exports,
+ ic_rn_gbl_env = export_env } }
cmGetContext :: CmState -> IO ([String],[String])
cmGetContext CmState{cm_ic=ic} =
cmBrowseModule :: CmState -> String -> Bool -> IO [IfaceDecl]
cmBrowseModule cmstate str exports_only
- = getModuleContents (cm_hsc cmstate) (cm_ic cmstate)
- (mkModuleName str) exports_only
+ = do { mb_decls <- getModuleContents (cm_hsc cmstate) (cm_ic cmstate)
+ (mkModuleName str) exports_only
+ ; case mb_decls of
+ Nothing -> return [] -- An error of some kind
+ Just ds -> return ds
+ }
-----------------------------------------------------------------------------
-> returnM (Right iface) ; -- Already loaded
-- The (src_imp == mi_boot iface) test checks that the already-loaded
-- interface isn't a boot iface. This can conceivably happen,
- -- if an earlier import had a
- -- before we got to real imports. I think.
+ -- if an earlier import had a before we got to real imports. I think.
other -> do
{ if_gbl_env <- getGblEnv
; let { hi_boot_file = case from of
ImportByUser usr_boot -> usr_boot
- ImportBySystem -> sys_boot
+ ImportBySystem -> sys_boot
; mb_dep = lookupModuleEnvByName (if_is_boot if_gbl_env) mod_name
; sys_boot = case mb_dep of
WARN( case from of { ImportBySystem -> True; other -> False } &&
not (isJust mb_dep) &&
isHomeModule mod,
- ppr mod )
+ ppr mod $$ ppr mb_dep)
initIfaceLcl (moduleName mod) $ do
-- Load the new ModIface into the External Package State
import TcRnTypes ( ImportAvails(..), mkModDeps )
import HscTypes ( ModIface(..),
ModGuts(..), ModGuts, IfaceExport,
- GhciMode(..),
+ GhciMode(..), noDependencies,
HscEnv(..), hscEPS,
Dependencies(..), FixItem(..),
isImplicitTyThing,
= do { showPass (hsc_dflags hsc_env)
("Checking old interface for " ++ moduleUserString mod) ;
- ; initIfaceIO hsc_env $
+ ; initIfaceIO hsc_env noDependencies {- wrong? -} $
check_old_iface mod iface_path source_unchanged maybe_iface
}
import TyCon ( TyCon, tyConName )
import HscTypes ( ExternalPackageState(..), PackageInstEnv, PackageRuleBase,
HscEnv, TyThing(..), implicitTyThings, typeEnvIds,
- ModIface(..), ModDetails(..), InstPool,
+ ModIface(..), ModDetails(..), InstPool, Dependencies(..),
TypeEnv, mkTypeEnv, extendTypeEnvList, lookupTypeEnv,
DeclPool, RulePool, Pool(..), Gated, addRuleToPool )
import InstEnv ( extendInstEnv )
(as a side effect) augment the type envt, and so we may need to iterate the process.
\begin{code}
-loadImportedRules :: HscEnv -> IO PackageRuleBase
-loadImportedRules hsc_env
- = initIfaceIO hsc_env $ do
+loadImportedRules :: HscEnv -> Dependencies -> IO PackageRuleBase
+loadImportedRules hsc_env deps
+ = initIfaceIO hsc_env deps $ do
{ -- Get new rules
if_rules <- updateEps (\ eps ->
let { (new_pool, if_rules) = selectRules (eps_rules eps) (eps_PTE eps) }
; updateEps (\ eps ->
let { new_rule_base = extendRuleBaseList (eps_rule_base eps) core_rules }
in (eps { eps_rule_base = new_rule_base }, new_rule_base)
- ) }
+ )
+
+ -- Strictly speaking, at this point we should go round again, since
+ -- typechecking one set of rules may bring in new things which enable
+ -- some more rules to come in. But we call loadImportedRules several
+ -- times anyway, so I'm going to be lazy and ignore this.
+ }
selectRules :: RulePool -> TypeEnv -> (RulePool, [(ModuleName, IfaceRule)])
core2core hsc_env
mod_impl@(ModGuts { mg_exports = exports,
- mg_binds = binds_in,
- mg_rules = rules_in })
+ mg_binds = binds_in })
= do
let dflags = hsc_dflags hsc_env
ghci_mode = hsc_mode hsc_env
-- COMPUTE THE RULE BASE TO USE
(rule_base, local_rule_ids, orphan_rules)
- <- prepareRules hsc_env ru_us binds_in rules_in
+ <- prepareRules hsc_env mod_impl ru_us
-- PREPARE THE BINDINGS
let binds1 = updateBinders ghci_mode local_rule_ids
\begin{code}
prepareRules :: HscEnv
+ -> ModGuts
-> UniqSupply
- -> [CoreBind]
- -> [IdCoreRule] -- Local rules
-> IO (RuleBase, -- Full rule base
IdSet, -- Local rule Ids
[IdCoreRule]) -- Orphan rules defined in this module
prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
- us binds local_rules
- = do { pkg_rule_base <- loadImportedRules hsc_env
+ (ModGuts { mg_binds = binds, mg_rules = local_rules,
+ mg_deps = deps })
+ us
+ = do { pkg_rule_base <- loadImportedRules hsc_env deps
; let env = emptySimplEnv SimplGently [] local_ids
(better_rules,_) = initSmpl dflags us (mapSmpl (simplRule env) local_rules)
import Inst ( tcStdSyntaxName )
import RnExpr ( rnStmts, rnExpr )
import RnNames ( exportsToAvails )
-import LoadIface ( loadSysInterface )
+import LoadIface ( loadSrcInterface )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceExtName(..),
tyThingToIfaceDecl )
import IfaceEnv ( tcIfaceGlobal )
-> ModIface -- Get the decls from here
-> IO ModDetails
tcRnIface hsc_env iface
- = initIfaceIO hsc_env (typecheckIface iface)
+ = initIfaceIO hsc_env (mi_deps iface) (typecheckIface iface)
\end{code}
= HsGroup { hs_tyclds = decls, -- This is the one we want
hs_valds = EmptyBinds, hs_fords = [],
hs_instds = [], hs_fixds = [], hs_depds = [],
- hs_ruleds = [] }
+ hs_ruleds = [], hs_defds = [] }
\end{code}
\begin{code}
#ifdef GHCI
mkExportEnv :: HscEnv -> [ModuleName] -- Expose these modules' exports only
- -> IO GlobalRdrEnv
+ -> IO (Maybe GlobalRdrEnv)
mkExportEnv hsc_env exports
- = initIfaceIO hsc_env $ do {
+ = initTc hsc_env iNTERACTIVE $ do {
export_envs <- mappM getModuleExports exports ;
returnM (foldr plusGlobalRdrEnv emptyGlobalRdrEnv export_envs)
}
-getModuleExports :: ModuleName -> IfG GlobalRdrEnv
+getModuleExports :: ModuleName -> TcM GlobalRdrEnv
getModuleExports mod
= do { iface <- load_iface mod
; avails <- exportsToAvails (mi_exports iface)
-> InteractiveContext
-> ModuleName -- Module to inspect
-> Bool -- Grab just the exports, or the whole toplev
- -> IO [IfaceDecl]
+ -> IO (Maybe [IfaceDecl])
getModuleContents hsc_env ictxt mod exports_only
- = initIfaceIO hsc_env (get_mod_contents exports_only)
+ = initTc hsc_env iNTERACTIVE (get_mod_contents exports_only)
where
get_mod_contents exports_only
| not exports_only -- We want the whole top-level type env
}
get_decl avail
- = do { thing <- tcIfaceGlobal (availName avail)
+ = do { thing <- tcLookupGlobal (availName avail)
; return (filter_decl (availOccs avail) (toIfaceDecl ictxt thing)) }
---------------------
wantToSee _ = True
---------------------
-load_iface mod = loadSysInterface (text "context for compiling statements") mod
+load_iface mod = loadSrcInterface doc mod False {- Not boot iface -}
+ where
+ doc = ptext SLIT("context for compiling statements")
---------------------
noRdrEnvErr mod = ptext SLIT("No top-level environment available for module")
import HsSyn ( MonoBinds(..) )
import HscTypes ( HscEnv(..),
- TyThing,
+ TyThing, Dependencies(..),
ExternalPackageState(..), HomePackageTable,
ModDetails(..), HomeModInfo(..),
Deprecs(..), FixityEnv, FixItem,
}
; setEnvs (if_env, if_lenv) thing_inside }
-initIfaceIO :: HscEnv -> IfG a -> IO a
-initIfaceIO hsc_env do_this
+initIfaceIO :: HscEnv -> Dependencies -> IfG a -> IO a
+initIfaceIO hsc_env deps do_this
= do { let {
- gbl_env = IfGblEnv { if_is_boot = emptyModuleEnv, -- Bogus?
+ is_boot = mkModDeps (dep_mods deps)
+ -- Urgh! But we do somehow need to get the info
+ -- on whether (for this particular compilation) we should
+ -- import a hi-boot file or not.
+ ; gbl_env = IfGblEnv { if_is_boot = is_boot,
if_rec_types = Nothing } ;
}
projects / ghc-hetmet.git / commitdiff