[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 (file)
--- 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 (file)
--- 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)