remember the type of _result

[ghc-hetmet.git] / compiler / ghci / Debugger.hs

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 52c6030..03eeb65 100644 (file)
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -15,7 +15,6 @@ module Debugger (pprintClosureCommand) where
 import Linker
 import RtClosureInspect
 
-import PrelNames
 import HscTypes
 import IdInfo
 --import Id
@@ -23,15 +22,11 @@ import Var hiding ( varName )
 import VarSet
 import VarEnv
 import Name 
-import NameEnv
-import RdrName
 import UniqSupply
 import Type
 import TcType
-import TyCon
 import TcGadt
 import GHC
-import GhciMonad
 
 import Outputable
 import Pretty                    ( Mode(..), showDocWith )
@@ -52,16 +47,15 @@ import GHC.Exts
 -------------------------------------
 -- | The :print & friends commands
 -------------------------------------
-pprintClosureCommand :: Bool -> Bool -> String -> GHCi ()
-pprintClosureCommand bindThings force str = do 
-  cms <- getSession
+pprintClosureCommand :: Session -> Bool -> Bool -> String -> IO ()
+pprintClosureCommand session bindThings force str = do 
   tythings <- (catMaybes . concat) `liftM`
-                 mapM (\w -> io(GHC.parseName cms w >>= 
-                                mapM (GHC.lookupName cms)))
+                 mapM (\w -> GHC.parseName session w >>= 
+                                mapM (GHC.lookupName session))
                       (words str)
-  substs <- catMaybes `liftM` mapM (io . go cms) 
+  substs <- catMaybes `liftM` mapM (go session) 
                                    [id | AnId id <- tythings]
-  mapM (io . applySubstToEnv cms . skolemSubst) substs
+  mapM (applySubstToEnv session . skolemSubst) substs
   return ()
  where 
 
@@ -105,7 +99,6 @@ bindSuspensions cms@(Session ref) t = do
       hsc_env <- readIORef ref
       inScope <- GHC.getBindings cms
       let ictxt        = hsc_IC hsc_env
-          rn_env       = ic_rn_local_env ictxt
           type_env     = ic_type_env ictxt
           prefix       = "_t"
           alreadyUsedNames = map (occNameString . nameOccName . getName) inScope
@@ -113,12 +106,14 @@ bindSuspensions cms@(Session ref) t = do
       availNames_var  <- newIORef availNames
       (t', stuff)     <- foldTerm (nameSuspensionsAndGetInfos availNames_var) t
       let (names, tys, hvals) = unzip3 stuff
-      let ids = [ mkGlobalId VanillaGlobal name (mk_skol_ty ty) vanillaIdInfo
-                  | (name,ty) <- zip names tys]
+      let tys' = map mk_skol_ty tys
+      let ids = [ mkGlobalId VanillaGlobal name ty vanillaIdInfo
+                | (name,ty) <- zip names tys']
+          new_tyvars   = tyVarsOfTypes tys'
           new_type_env = extendTypeEnvWithIds type_env ids 
-          new_rn_env   = extendLocalRdrEnv rn_env names
-          new_ic       = ictxt { ic_rn_local_env = new_rn_env, 
-                                 ic_type_env     = new_type_env }
+          old_tyvars   = ic_tyvars ictxt
+          new_ic       = ictxt { ic_type_env = new_type_env,
+                                 ic_tyvars   = old_tyvars `unionVarSet` new_tyvars }
       extendLinkEnv (zip names hvals)
       writeIORef ref (hsc_env {hsc_IC = new_ic })
       return t'
@@ -174,13 +169,10 @@ printTerm cms@(Session ref) = cPprTerm cPpr
   bindToFreshName hsc_env ty userName = do
     name <- newGrimName cms userName 
     let ictxt    = hsc_IC hsc_env
-        rn_env   = ic_rn_local_env ictxt
         type_env = ic_type_env ictxt
         id       = mkGlobalId VanillaGlobal name ty vanillaIdInfo
         new_type_env = extendTypeEnv type_env (AnId id)
-        new_rn_env   = extendLocalRdrEnv rn_env [name]
-        new_ic       = ictxt { ic_rn_local_env = new_rn_env, 
-                               ic_type_env     = new_type_env }
+        new_ic       = ictxt { ic_type_env     = new_type_env }
     return (hsc_env {hsc_IC = new_ic }, name)
 
 --    Create new uniques and give them sequentially numbered names