[project @ 2005-05-05 09:40:37 by simonmar]

Make GHC.modInfoPrintUnqualified work for package modules too.  Also
refactor a bit: move mkExportEnv from TcRnDriver up to GHC which is
the only use of it.

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index 9622729..67dd723 100644 (file)
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -133,20 +133,25 @@ module GHC (
 import qualified Linker
 import Linker          ( HValue, extendLinkEnv )
 import NameEnv         ( lookupNameEnv )
-import TcRnDriver      ( mkExportEnv, getModuleContents, tcRnLookupRdrName,
+import TcRnDriver      ( getModuleContents, tcRnLookupRdrName,
                          getModuleExports )
-import RdrName         ( plusGlobalRdrEnv )
+import RdrName         ( plusGlobalRdrEnv, Provenance(..), ImportSpec(..),
+                         emptyGlobalRdrEnv, mkGlobalRdrEnv )
 import HscMain         ( hscGetInfo, GetInfoResult, hscParseIdentifier,
                          hscStmt, hscTcExpr, hscKcType )
 import Type            ( tidyType )
 import VarEnv          ( emptyTidyEnv )
 import GHC.Exts                ( unsafeCoerce# )
 import IfaceSyn                ( IfaceDecl )
+import Name            ( getName, nameModule_maybe )
+import SrcLoc          ( mkSrcLoc, srcLocSpan, interactiveSrcLoc )
+import Bag             ( unitBag, emptyBag )
 #endif
 
 import Packages                ( initPackages )
 import NameSet         ( NameSet, nameSetToList )
-import RdrName         ( GlobalRdrEnv )
+import RdrName         ( GlobalRdrEnv, GlobalRdrElt(..), RdrName, gre_name,
+                         globalRdrEnvElts )
 import HsSyn
 import Type            ( Kind, Type, dropForAlls )
 import Id              ( Id, idType, isImplicitId, isDeadBinder,
@@ -158,11 +163,9 @@ import Id          ( Id, idType, isImplicitId, isDeadBinder,
 import TyCon           ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon )
 import Class           ( Class, classSCTheta, classTvsFds )
 import DataCon         ( DataCon )
-import InstEnv         ( Instance )
-import Name            ( Name, getName, nameModule_maybe )
-import RdrName         ( RdrName, gre_name, globalRdrEnvElts )
+import Name            ( Name )
 import NameEnv         ( nameEnvElts )
-import SrcLoc          ( Located(..), mkSrcLoc, srcLocSpan )
+import SrcLoc          ( Located(..) )
 import DriverPipeline
 import DriverPhases    ( Phase(..), isHaskellSrcFilename, startPhase )
 import GetImports      ( getImports )
@@ -186,7 +189,6 @@ import SysTools             ( cleanTempFilesExcept )
 import BasicTypes      ( SuccessFlag(..), succeeded, failed )
 import Maybes          ( orElse, expectJust, mapCatMaybes )
 import TcType           ( tcSplitSigmaTy, isDictTy )
-import Bag             ( unitBag, emptyBag )
 import FastString      ( mkFastString )
 
 import Directory        ( getModificationTime, doesFileExist )
@@ -1534,13 +1536,16 @@ getModuleInfo s mdl = withSession s $ \hsc_env -> do
           Nothing -> return Nothing
           Just names -> do
                eps <- readIORef (hsc_EPS hsc_env)
-               let pte = eps_PTE eps
-                   tys = [ ty | name <- nameSetToList names,
-                                Just ty <- [lookupTypeEnv pte name] ]
+               let 
+                   pte    = eps_PTE eps
+                   n_list = nameSetToList names
+                   tys    = [ ty | name <- n_list,
+                                   Just ty <- [lookupTypeEnv pte name] ]
+               --
                return (Just (ModuleInfo {
                                minf_type_env = mkTypeEnv tys,
                                minf_exports  = names,
-                               minf_rdr_env  = Nothing
+                               minf_rdr_env  = Just $! nameSetToGlobalRdrEnv names mdl
                        }))
 #else
        -- bogusly different for non-GHCI (ToDo)
@@ -1657,6 +1662,28 @@ setContext (Session ref) toplevs exports = do
                                            ic_exports      = exports,
                                            ic_rn_gbl_env   = all_env } }
 
+-- Make a GlobalRdrEnv based on the exports of the modules only.
+mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
+mkExportEnv hsc_env mods = do
+  mb_name_sets <- mapM (getModuleExports hsc_env) mods
+  let 
+       gres = [ nameSetToGlobalRdrEnv name_set mod
+              | (Just name_set, mod) <- zip mb_name_sets mods ]
+  --
+  return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
+
+nameSetToGlobalRdrEnv :: NameSet -> Module -> GlobalRdrEnv
+nameSetToGlobalRdrEnv names mod =
+  mkGlobalRdrEnv [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
+                | name <- nameSetToList names ]
+
+vanillaProv :: Module -> Provenance
+-- We're building a GlobalRdrEnv as if the user imported
+-- all the specified modules into the global interactive module
+vanillaProv mod = Imported [ImportSpec { is_mod = mod, is_as = mod, 
+                                        is_qual = False, is_explicit = False,
+                                        is_loc = srcLocSpan interactiveSrcLoc }]
+
 checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
 checkModuleExists hsc_env hpt mod = 
   case lookupModuleEnv hpt mod of

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index a249285..c49fc84 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module TcRnDriver (
 #ifdef GHCI
-       mkExportEnv, getModuleContents, tcRnStmt, 
+       getModuleContents, tcRnStmt, 
        tcRnGetInfo, GetInfoResult,
        tcRnExpr, tcRnType,
        tcRnLookupRdrName,
@@ -1083,32 +1083,6 @@ tcGetModuleExports mod = do
                -- Load any orphan-module interfaces,
                -- so their instances are visible
   ifaceExportNames (mi_exports iface)
-
-mkExportEnv :: HscEnv -> [Module]      -- Expose these modules' exports only
-           -> IO GlobalRdrEnv
-mkExportEnv hsc_env exports
-  = do { mb_envs <- initTcPrintErrors hsc_env iNTERACTIVE $
-                    mappM getModuleExportRdrEnv exports 
-       ; case mb_envs of
-            Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
-            Nothing   -> return emptyGlobalRdrEnv
-                            -- Some error; initTc will have printed it
-    }
-
-getModuleExportRdrEnv :: Module -> TcM GlobalRdrEnv
-getModuleExportRdrEnv mod = do
-  names <- tcGetModuleExports mod
-  let gres =  [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
-             | name <- nameSetToList names ]
-  returnM (mkGlobalRdrEnv gres)
-
-vanillaProv :: Module -> Provenance
--- We're building a GlobalRdrEnv as if the user imported
--- all the specified modules into the global interactive module
-vanillaProv mod = Imported [ImportSpec { is_mod = mod, is_as = mod, 
-                                        is_qual = False, is_explicit = False,
-                                        is_loc = srcLocSpan interactiveSrcLoc }]
-
 \end{code}
 
 \begin{code}