summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2011-08-03 16:10:24 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2011-08-03 16:10:24 +0100
commit66096716817eb22ccd1dfb142e816b4b2846f7b3 (patch)
treed29a9a797b942d3e197b7a92cf0b99baef630241
parenta303ee91d4186eba80864c45ff3ad7a58e70fa65 (diff)
downloadhaskell-66096716817eb22ccd1dfb142e816b4b2846f7b3.tar.gz
Refactor to replace hscGetModuleExports by hscGetModuleInterface
I also tidied up the interfaces for LoadIface to be a bit simpler
-rw-r--r--compiler/iface/LoadIface.lhs65
-rw-r--r--compiler/main/DynamicLoading.hs30
-rw-r--r--compiler/main/GHC.hs32
-rw-r--r--compiler/main/HscMain.lhs9
-rw-r--r--compiler/typecheck/TcRnDriver.lhs29
5 files changed, 67 insertions, 98 deletions
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 9d087c1808..fef97119b4 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -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)
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index e8a8dfe015..cc382a74fe 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -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
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 665b1b0532..d8c6fdda4e 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -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)
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 48f60f074b..ae858fde28 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -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
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 437877aa7d..403a3aa847 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -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