From: simonpj <unknown>
Date: Wed, 5 Nov 2003 11:39:42 +0000 (+0000)
Subject: [project @ 2003-11-05 11:39:38 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~277
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6959a665ebacbe635a4db616a7191ce3eee2cabe;p=ghc-hetmet.git

[project @ 2003-11-05 11:39:38 by simonpj]
Fix a stupid error in interactive environment handling (not present in STABLE)
---

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index db19219..bf2d7d5 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -69,6 +69,7 @@ import Module		( Module, ModuleName, moduleName, mkModuleName, isHomeModule,
 			  extendModuleEnvList, extendModuleEnv,
 			  moduleNameUserString,
 			  ModLocation(..) )
+import RdrName		( GlobalRdrEnv, plusGlobalRdrEnv )
 import GetImports
 import UniqFM
 import Digraph		( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
@@ -179,17 +180,25 @@ cmSetContext
 	-> [String]		-- and the just the exports from these
 	-> IO CmState
 cmSetContext cmstate toplevs exports = do 
-  let old_ic = cm_ic cmstate
-
-  mb_export_env <- mkExportEnv (cm_hsc cmstate) 
-			       (map mkModuleName exports)
-
-  case mb_export_env of
-    Nothing -> return cmstate	-- Error already reported; do a no-op
-    Just export_env -> 
-	  return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
-			     		   ic_exports = exports,
-				       	   ic_rn_gbl_env = export_env } }
+  let old_ic  = cm_ic cmstate
+      hsc_env = cm_hsc cmstate
+      hpt     = hsc_HPT hsc_env
+
+  export_env  <- mkExportEnv hsc_env (map mkModuleName exports)
+  toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
+
+  let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
+  return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
+		     		   ic_exports      = exports,
+			       	   ic_rn_gbl_env   = all_env } }
+
+mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
+mkTopLevEnv hpt mod
+ = case lookupModuleEnvByName hpt (mkModuleName mod) of
+      Nothing      -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++ mod))
+      Just details -> case hm_globals details of
+			Nothing  -> throwDyn (ProgramError ("mkTopLevEnv: not interpreted " ++ mod))
+			Just env -> return env
 
 cmGetContext :: CmState -> IO ([String],[String])
 cmGetContext CmState{cm_ic=ic} = 
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index da49d2e..92526ee 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -788,12 +788,15 @@ tcTopSrcDecls
 \begin{code}
 #ifdef GHCI
 mkExportEnv :: HscEnv -> [ModuleName]	-- Expose these modules' exports only
- 	    -> IO (Maybe GlobalRdrEnv)
+ 	    -> IO GlobalRdrEnv
 
 mkExportEnv hsc_env exports
-  = initTc hsc_env iNTERACTIVE $ do {
-    export_envs <- mappM getModuleExports exports ;
-    returnM (foldr plusGlobalRdrEnv emptyGlobalRdrEnv export_envs)
+  = do	{ mb_envs <- initTc hsc_env iNTERACTIVE $
+		     mappM getModuleExports exports 
+	; case mb_envs of
+	     Just envs -> return (foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs)
+	     Nothing   -> return emptyGlobalRdrEnv
+			     -- Some error; initTc will have printed it
     }
 
 getModuleExports :: ModuleName -> TcM GlobalRdrEnv