Refactor to replace hscGetModuleExports by hscGetModuleInterface
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Aug 2011 15:10:24 +0000 (16:10 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Aug 2011 15:10:24 +0000 (16:10 +0100)
I also tidied up the interfaces for LoadIface to be a bit simpler

compiler/iface/LoadIface.lhs
compiler/main/DynamicLoading.hs
compiler/main/GHC.hs
compiler/main/HscMain.lhs
compiler/typecheck/TcRnDriver.lhs

index 9d087c1..fef9711 100644 (file)
@@ -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)
 
index e8a8dfe..cc382a7 100644 (file)
@@ -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
index 665b1b0..d8c6fdd 100644 (file)
@@ -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)
index 48f60f0..ae858fd 100644 (file)
@@ -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
index 437877a..403a3aa 100644 (file)
@@ -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