From: simonmar <unknown>
Date: Mon, 26 Feb 2001 16:43:32 +0000 (+0000)
Subject: [project @ 2001-02-26 16:43:31 by simonmar]
X-Git-Tag: Approximately_9120_patches~2543
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=252fd0cd54d3ea3f09a78bd4826a639f98d2b452;p=ghc-hetmet.git

[project @ 2001-02-26 16:43:31 by simonmar]
Update the interactive context in cmRunStmt rather than hscMain.
---

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 9f44254..ad14b26 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -26,13 +26,16 @@ import CmTypes
 import HscTypes
 import RnEnv		( unQualInScope )
 import Id		( idType, idName )
-import Name		( Name, lookupNameEnv )
+import Name		( Name, lookupNameEnv, extendNameEnvList, 
+			  NamedThing(..) )
 import RdrName		( emptyRdrEnv )
 import Module		( Module, ModuleName, moduleName, isHomeModule,
 			  mkModuleName, moduleNameUserString, moduleUserString )
 import CmStaticInfo	( GhciMode(..) )
 import DriverPipeline
 import GetImports
+import Type		( tidyType )
+import VarEnv		( emptyTidyEnv )
 import HscTypes
 import HscMain		( initPersistentCompilerState )
 import Finder
@@ -164,10 +167,29 @@ moduleNameToModule mn
 #ifdef GHCI
 cmRunStmt :: CmState -> DynFlags -> String -> IO (CmState, [Name])
 cmRunStmt cmstate dflags expr
-   = do (new_pcs, maybe_stuff) <- hscStmt dflags hst hit pcs (ic cmstate) expr
+   = do 
+	let icontext = ic cmstate
+	    InteractiveContext { 
+	       	ic_rn_env = rn_env, 
+	       	ic_type_env = type_env,
+	       	ic_module   = this_mod } = icontext
+
+        (new_pcs, maybe_stuff) <- hscStmt dflags hst hit pcs icontext expr
         case maybe_stuff of
 	   Nothing -> return (cmstate{ pcs=new_pcs }, [])
-	   Just (new_ic, ids, bcos) -> do
+	   Just (ids, bcos) -> do
+	        let 
+		    new_rn_env   = extendLocalRdrEnv rn_env (map idName ids)
+
+			-- Extend the renamer-env from bound_ids, not
+			-- bound_names, because the latter may contain
+			-- [it] when the former is empty
+		    new_type_env = extendNameEnvList type_env 	
+			      		[ (getName id, AnId id)	| id <- ids]
+
+		    new_ic = icontext { ic_rn_env   = new_rn_env, 
+			  	  	ic_type_env = new_type_env }
+
 		hval <- linkExpr pls bcos
 		hvals <- unsafeCoerce# hval :: IO [HValue]
 		let names = map idName ids
@@ -189,9 +211,10 @@ cmTypeOfName CmState{ hit=hit, pcs=pcs, ic=ic } name
 	Just (AnId id) -> 
 	   let pit = pcs_PIT pcs
 	       modname = moduleName (ic_module ic)
+	       ty = tidyType emptyTidyEnv (idType id)
 	       str = case lookupIfaceByModName hit pit modname of
-			Nothing    -> showSDoc (ppr (idType id))
-			Just iface -> showSDocForUser unqual (ppr (idType id))
+			Nothing    -> showSDoc (ppr ty)
+			Just iface -> showSDocForUser unqual (ppr ty)
 		  	   where unqual = unQualInScope (mi_globals iface)
 	   in return (Just str)
 
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index e60fbbe..141af7a 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -417,8 +417,7 @@ hscStmt
   -> InteractiveContext		-- Context for compiling
   -> String			-- The statement
   -> IO ( PersistentCompilerState, 
-	  Maybe (InteractiveContext, 
-		 [Id], 
+	  Maybe ( [Id], 
 		 UnlinkedBCOExpr) )
 \end{code}
 
@@ -493,22 +492,13 @@ hscStmt dflags hst hit pcs0 icontext stmt
 		-- important: otherwise when we come to compile an expression
 		-- using these ids later, the byte code generator will consider
 		-- the occurrences to be free rather than global.
-	     constant_bound_ids = map constantizeId bound_ids
+	     constant_bound_ids = map constantizeId bound_ids;
+
 	     constantizeId id
 		 = modifyIdInfo (`setFlavourInfo` makeConstantFlavour 
 					(idFlavour id)) id
 
-	     new_rn_env   = extendLocalRdrEnv rn_env 
-				(map idName constant_bound_ids)
-		-- Extend the renamer-env from bound_ids, not bound_names,
-		-- because the latter may contain [it] when the former is empty
-
-	     new_type_env = extendNameEnvList type_env 	
-			      [(getName id, AnId id) | id <- constant_bound_ids]
-
-	     new_icontext = icontext { ic_rn_env = new_rn_env, 
-				       ic_type_env = new_type_env }
-	; return (pcs2, Just (new_icontext, bound_ids, bcos))
+	; return (pcs2, Just (constant_bound_ids, bcos))
      }}}}}
 
 hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt)