From 0c41772cba7ec3f558cd2619716c7db771eae935 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Tue, 15 Jun 2010 07:06:26 +0000
Subject: [PATCH] Fix Trac #4127: build GlobalRdrEnv in GHCi correctly

GHCi was building its GlobalRdrEnv wrongly, so that the
gre_par field was bogus.  That in turn fooled the renamer.
The fix is easy: use the right function!  Namely, call
RnNames.gresFromAvail rather than availsToNameSet.
---
 compiler/main/GHC.hs             |    2 +-
 compiler/main/InteractiveEval.hs |   34 +++++++++++++++-------------------
 compiler/rename/RnNames.lhs      |    3 ++-
 3 files changed, 18 insertions(+), 21 deletions(-)

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index f532061..e5cfffe 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -2432,7 +2432,7 @@ getPackageModuleInfo hsc_env mdl = do
 	return (Just (ModuleInfo {
 			minf_type_env  = mkTypeEnv tys,
 			minf_exports   = names,
-			minf_rdr_env   = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
+			minf_rdr_env   = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
 			minf_instances = error "getModuleInfo: instances for package module unimplemented",
                         minf_modBreaks = emptyModBreaks  
 		}))
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 38f0998..7e4406e 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -18,7 +18,7 @@ module InteractiveEval (
         getHistoryModule,
         back, forward,
 	setContext, getContext,	
-        nameSetToGlobalRdrEnv,
+        availsToGlobalRdrEnv,
 	getNamesInScope,
 	getRdrNamesInScope,
 	moduleIsInterpreted,
@@ -42,6 +42,7 @@ module InteractiveEval (
 import HscMain          hiding (compileExpr)
 import HscTypes
 import TcRnDriver
+import RnNames		( gresFromAvails )
 import InstEnv
 import Type
 import TcType		hiding( typeKind )
@@ -807,25 +808,20 @@ setContext toplev_mods export_mods = do
 
 -- Make a GlobalRdrEnv based on the exports of the modules only.
 mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
-mkExportEnv hsc_env mods = do
-  stuff <- mapM (getModuleExports hsc_env) mods
-  let 
-	(_msgs, mb_name_sets) = unzip stuff
-	gres = [ nameSetToGlobalRdrEnv (availsToNameSet avails) (moduleName mod)
-  	       | (Just avails, mod) <- zip mb_name_sets mods ]
-  --
-  return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
-
-nameSetToGlobalRdrEnv :: NameSet -> ModuleName -> GlobalRdrEnv
-nameSetToGlobalRdrEnv names mod =
-  mkGlobalRdrEnv [ GRE  { gre_name = name, gre_par = NoParent, gre_prov = vanillaProv mod }
-		 | name <- nameSetToList names ]
-
-vanillaProv :: ModuleName -> Provenance
--- We're building a GlobalRdrEnv as if the user imported
--- all the specified modules into the global interactive module
-vanillaProv mod_name = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
+mkExportEnv hsc_env mods
+  = do { stuff <- mapM (getModuleExports hsc_env) mods
+       ; let (_msgs, mb_name_sets) = unzip stuff
+	     envs = [ availsToGlobalRdrEnv (moduleName mod) avails
+                    | (Just avails, mod) <- zip mb_name_sets mods ]
+       ; return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs }
+
+availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
+availsToGlobalRdrEnv mod_name avails
+  = mkGlobalRdrEnv (gresFromAvails imp_prov avails)
   where
+      -- We're building a GlobalRdrEnv as if the user imported
+      -- all the specified modules into the global interactive module
+    imp_prov = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
     decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, 
 			 is_qual = False, 
 			 is_dloc = srcLocSpan interactiveSrcLoc }
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 9fcfd28..9e16373 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -6,7 +6,8 @@
 \begin{code}
 module RnNames (
 	rnImports, getLocalNonValBinders,
-	rnExports, extendGlobalRdrEnvRn,
+	rnExports, extendGlobalRdrEnvRn, 
+        gresFromAvails,
 	reportUnusedNames, finishWarnings,
     ) where
 
-- 
1.7.10.4