Commit 66096716 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor to replace hscGetModuleExports by hscGetModuleInterface

I also tidied up the interfaces for LoadIface to be a bit simpler
parent a303ee91
......@@ -7,8 +7,13 @@ Loading interface files
\begin{code}
module LoadIface (
loadInterface, loadInterfaceForName, loadWiredInHomeIface,
loadSrcInterface, loadSysInterface, loadUserInterface, loadOrphanModules,
-- RnM/TcM functions
loadModuleInterface, loadModuleInterfaces,
loadSrcInterface, loadInterfaceForName,
-- IfM functions
loadInterface, loadWiredInHomeIface,
loadSysInterface, loadUserInterface,
findAndReadIface, readIface, -- Used when reading the module's old interface
loadDecls, -- Should move to TcIface and be renamed
initExternalPackageState,
......@@ -90,22 +95,17 @@ loadSrcInterface doc mod want_boot maybe_pkg = do
let dflags = hsc_dflags hsc_env in
failWithTc (cannotFindInterface dflags mod err)
-- | Load interfaces for a collection of orphan modules.
loadOrphanModules :: [Module] -- the modules
-> Bool -- these are family instance-modules
-> TcM ()
loadOrphanModules mods isFamInstMod
-- | Load interface for a module.
loadModuleInterface :: SDoc -> Module -> TcM ModIface
loadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod)
-- | Load interfaces for a collection of modules.
loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
loadModuleInterfaces doc mods
| null mods = return ()
| otherwise = initIfaceTcRn $
do { traceIf (text "Loading orphan modules:" <+>
fsep (map ppr mods))
; mapM_ load mods
; return () }
| otherwise = initIfaceTcRn (mapM_ load mods)
where
load mod = loadSysInterface (mk_doc mod) mod
mk_doc mod
| isFamInstMod = ppr mod <+> ptext (sLit "is a family-instance module")
| otherwise = ppr mod <+> ptext (sLit "is a orphan-instance module")
load mod = loadSysInterface (doc <+> parens (ppr mod)) mod
-- | Loads the interface for a given Name.
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
......@@ -119,7 +119,20 @@ loadInterfaceForName doc name
; ASSERT2( isExternalName name, ppr name )
initIfaceTcRn $ loadSysInterface doc (nameModule name)
}
\end{code}
%*********************************************************
%* *
loadInterface
The main function to load an interface
for an imported module, and put it in
the External Package State
%* *
%*********************************************************
\begin{code}
-- | An 'IfM' function to load the home interface for a wired-in thing,
-- so that we're sure that we see its instance declarations and rules
-- See Note [Loading instances for wired-in things] in TcIface
......@@ -130,15 +143,19 @@ loadWiredInHomeIface name
where
doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name
------------------
-- | Loads a system interface and throws an exception if it fails
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem
------------------
-- | Loads a user interface and throws an exception if it fails. The first parameter indicates
-- whether we should import the boot variant of the module
loadUserInterface :: Bool -> SDoc -> Module -> IfM lcl ModIface
loadUserInterface is_boot doc mod_name = loadInterfaceWithException doc mod_name (ImportByUser is_boot)
loadUserInterface is_boot doc mod_name
= loadInterfaceWithException doc mod_name (ImportByUser is_boot)
------------------
-- | A wrapper for 'loadInterface' that throws an exception if it fails
loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException doc mod_name where_from
......@@ -146,20 +163,8 @@ loadInterfaceWithException doc mod_name where_from
; case mb_iface of
Failed err -> ghcError (ProgramError (showSDoc err))
Succeeded iface -> return iface }
\end{code}
%*********************************************************
%* *
loadInterface
The main function to load an interface
for an imported module, and put it in
the External Package State
%* *
%*********************************************************
\begin{code}
------------------
loadInterface :: SDoc -> Module -> WhereFrom
-> IfM lcl (MaybeErr Message ModIface)
......
......@@ -17,21 +17,19 @@ module DynamicLoading (
#ifdef GHCI
import Linker ( linkModule, getHValue )
import OccName ( occNameSpace )
import Name ( nameOccName )
import SrcLoc ( noSrcSpan )
import Finder ( findImportedModule, cannotFindModule )
import DriverPhases ( HscSource(HsSrcFile) )
import TcRnDriver ( getModuleExports )
import TcRnDriver ( getModuleInterface )
import TcRnMonad ( initTc, initIfaceTcRn )
import LoadIface ( loadUserInterface )
import RdrName ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
mkGlobalRdrEnv, lookupGRE_RdrName, gre_name, rdrNameSpace )
import RdrName ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(..)
, ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName, gre_name )
import RnNames ( gresFromAvails )
import PrelNames ( iNTERACTIVE )
import DynFlags
import HscTypes ( HscEnv(..), FindResult(..), lookupTypeHscEnv )
import HscTypes ( HscEnv(..), FindResult(..), ModIface(..), lookupTypeHscEnv )
import TypeRep ( TyThing(..), pprTyThingCategory )
import Type ( Type, eqType )
import TyCon ( TyCon )
......@@ -138,17 +136,19 @@ lookupRdrNameInModule hsc_env mod_name rdr_name = do
case found_module of
Found _ mod -> do
-- Find the exports of the module
(_, mb_avail_info) <- getModuleExports hsc_env mod
case mb_avail_info of
Just avail_info -> do
(_, mb_iface) <- getModuleInterface hsc_env mod
case mb_iface of
Just iface -> do
-- Try and find the required name in the exports
let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, is_qual = False, is_dloc = noSrcSpan }
let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name
, is_qual = False, is_dloc = noSrcSpan }
provenance = Imported [ImpSpec decl_spec ImpAll]
env = mkGlobalRdrEnv (gresFromAvails provenance avail_info)
case [name | gre <- lookupGRE_RdrName rdr_name env, let name = gre_name gre, rdrNameSpace rdr_name == occNameSpace (nameOccName name)] of
[name] -> return (Just name)
[] -> return Nothing
_ -> panic "lookupRdrNameInModule"
env = mkGlobalRdrEnv (gresFromAvails provenance (mi_exports iface))
case lookupGRE_RdrName rdr_name env of
[gre] -> return (Just (gre_name gre))
[] -> return Nothing
_ -> panic "lookupRdrNameInModule"
Nothing -> throwCmdLineErrorS $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name]
err -> throwCmdLineErrorS $ cannotFindModule dflags mod_name err
where
......
......@@ -261,10 +261,8 @@ import Id
import TysPrim ( alphaTyVars )
import TyCon
import Class
-- import FunDeps
import DataCon
import Name hiding ( varName )
-- import OccName ( parenSymOcc )
import InstEnv
import SrcLoc
import CoreSyn ( CoreBind )
......@@ -946,18 +944,11 @@ getModuleInfo mdl = withSession $ \hsc_env -> do
getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
#ifdef GHCI
getPackageModuleInfo hsc_env mdl = do
mb_avails <- hscGetModuleExports hsc_env mdl
-- This is the only use of hscGetModuleExports. Perhaps we could use
-- hscRnImportDecls instead, but that does a lot more than we need
-- (building instance environment, checking family instance consistency
-- etc.).
case mb_avails of
Nothing -> return Nothing
Just avails -> do
eps <- hscEPS hsc_env
iface <- lookupModuleIface hsc_env mdl
getPackageModuleInfo hsc_env mdl
= do eps <- hscEPS hsc_env
iface <- hscGetModuleInterface hsc_env mdl
let
avails = mi_exports iface
names = availsToNameSet avails
pte = eps_PTE eps
tys = [ ty | name <- concatMap availNames avails,
......@@ -968,7 +959,7 @@ getPackageModuleInfo hsc_env mdl = do
minf_exports = names,
minf_rdr_env = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
minf_instances = error "getModuleInfo: instances for package module unimplemented",
minf_iface = iface,
minf_iface = Just iface,
minf_modBreaks = emptyModBreaks
}))
#else
......@@ -983,7 +974,7 @@ getHomeModuleInfo hsc_env mdl =
Nothing -> return Nothing
Just hmi -> do
let details = hm_details hmi
let iface = hm_iface hmi
iface = hm_iface hmi
return (Just (ModuleInfo {
minf_type_env = md_types details,
minf_exports = availsToNameSet (md_exports details),
......@@ -995,17 +986,6 @@ getHomeModuleInfo hsc_env mdl =
#endif
}))
#ifdef GHCI
lookupModuleIface :: HscEnv -> Module -> IO (Maybe ModIface)
lookupModuleIface env m = do
eps <- hscEPS env
let dflags = hsc_dflags env
pkgIfaceT = eps_PIT eps
homePkgT = hsc_HPT env
iface = lookupIfaceByModule dflags homePkgT pkgIfaceT m
return iface
#endif
-- | The list of top-level entities defined in a module
modInfoTyThings :: ModuleInfo -> [TyThing]
modInfoTyThings minf = typeEnvElts (minf_type_env minf)
......
......@@ -59,8 +59,8 @@ module HscMain
, hscTcRcLookupName
, hscTcRnGetInfo
#ifdef GHCI
, hscGetModuleInterface
, hscRnImportDecls
, hscGetModuleExports
, hscTcRnLookupRdrName
, hscStmt, hscStmtWithLocation
, hscTcExpr, hscImport, hscKcType
......@@ -292,13 +292,12 @@ hscTcRnGetInfo hsc_env name =
runHsc hsc_env $ ioMsgMaybe' $ tcRnGetInfo hsc_env name
#ifdef GHCI
hscGetModuleExports :: HscEnv -> Module -> IO (Maybe [AvailInfo])
hscGetModuleExports hsc_env mdl =
runHsc hsc_env $ ioMsgMaybe' $ getModuleExports hsc_env mdl
hscGetModuleInterface :: HscEnv -> Module -> IO ModIface
hscGetModuleInterface hsc_env mod
= runHsc hsc_env $ ioMsgMaybe $ getModuleInterface hsc_env mod
-- -----------------------------------------------------------------------------
-- | Rename some import declarations
hscRnImportDecls
:: HscEnv
-> Module
......
......@@ -9,7 +9,7 @@ module TcRnDriver (
#ifdef GHCI
tcRnStmt, tcRnExpr, tcRnType,
tcRnLookupRdrName,
getModuleExports,
getModuleInterface,
#endif
tcRnImports,
tcRnLookupName,
......@@ -84,7 +84,6 @@ import TcHsType
import TcMatches
import RnTypes
import RnExpr
import IfaceEnv
import MkId
import BasicTypes
import TidyPgm ( globaliseAndTidyId )
......@@ -269,7 +268,8 @@ tcRnImports hsc_env this_mod import_decls
-- Load any orphan-module and family instance-module
-- interfaces, so that their rules and instance decls will be
-- found.
; loadOrphanModules (imp_orphs imports) False
; loadModuleInterfaces (ptext (sLit "Loading orphan modules"))
(imp_orphs imports)
-- Check type-family consistency
; traceRn (text "rn1: checking family instance consistency")
......@@ -1391,25 +1391,10 @@ tcRnType hsc_env ictxt rdr_type
-- a package module with an interface on disk. If neither of these is
-- true, then the result will be an error indicating the interface
-- could not be found.
getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
getModuleExports hsc_env mod
= initTc hsc_env HsSrcFile False iNTERACTIVE (tcGetModuleExports mod)
-- Get the export avail info and also load all orphan and family-instance
-- modules. Finally, check that the family instances of all modules in the
-- interactive context are consistent (these modules are in the second
-- argument).
tcGetModuleExports :: Module -> TcM [AvailInfo]
tcGetModuleExports mod
= do { let doc = ptext (sLit "context for compiling statements")
; iface <- initIfaceTcRn $ loadSysInterface doc mod
-- Load any orphan-module and family instance-module
-- interfaces, so their instances are visible.
; loadOrphanModules (dep_orphs (mi_deps iface)) False
; ifaceExportNames (mi_exports iface)
}
getModuleInterface :: HscEnv -> Module -> IO (Messages, Maybe ModIface)
getModuleInterface hsc_env mod
= initTc hsc_env HsSrcFile False iNTERACTIVE $
loadModuleInterface (ptext (sLit "getModuleInterface")) mod
tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Messages, Maybe [Name])
tcRnLookupRdrName hsc_env rdr_name
......
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