Remove skolem tyvars from the InteractiveContext once they have been instantiated...

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

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 3174785..4e61068 100644 (file)
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -18,6 +18,7 @@ import RtClosureInspect
 import HscTypes
 import IdInfo
 --import Id
+import Name
 import Var hiding ( varName )
 import VarSet
 import VarEnv
@@ -61,9 +62,10 @@ pprintClosureCommand session bindThings force str = do
 
    -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
    go :: Session -> Id -> IO (Maybe TvSubst)
-   go cms id = do
-     mb_term <- obtainTerm cms force id
-     maybe (return Nothing) `flip` mb_term $ \term -> do
+   go cms id = do 
+     mb_term <- obtainTerm cms force id 
+     maybe (return Nothing) `flip` mb_term $ \term_ -> do
+       term      <- tidyTermTyVars cms term_
        term'     <- if not bindThings then return term 
                      else bindSuspensions cms term                         
        showterm  <- printTerm cms term'
@@ -97,9 +99,24 @@ pprintClosureCommand session bindThings force str = do
           ids      = typeEnvIds type_env
           ids'     = map (\id -> id `setIdType` substTy subst (idType id)) ids
           type_env'= extendTypeEnvWithIds type_env ids'
-          ictxt'   = ictxt { ic_type_env = type_env' }
+          subst_dom= varEnvKeys$ getTvSubstEnv subst
+          ictxt'   = ictxt { ic_type_env = type_env'
+                           , ic_tyvars   = foldl' delVarSetByKey
+                                                  (ic_tyvars ictxt) 
+                                                  subst_dom }
       writeIORef ref (hsc_env {hsc_IC = ictxt'})
 
+   tidyTermTyVars :: Session -> Term -> IO Term
+   tidyTermTyVars (Session ref) t = do
+     hsc_env <- readIORef ref
+     let env_tvs      = ic_tyvars (hsc_IC hsc_env)
+         my_tvs       = termTyVars t
+         tvs          = env_tvs `minusVarSet` my_tvs
+         tyvarOccName = nameOccName . tyVarName 
+         tidyEnv      = (initTidyOccEnv (map tyvarOccName (varSetElems tvs))
+                        , env_tvs `intersectVarSet` my_tvs)
+     return$ mapTermType (snd . tidyOpenType tidyEnv) t
+
 -- | Give names, and bind in the interactive environment, to all the suspensions
 --   included (inductively) in a term
 bindSuspensions :: Session -> Term -> IO Term
@@ -198,4 +215,4 @@ mk_skol_ty ty | tyvars  <- varSetElems (tyVarsOfType ty)
               , tyvars' <- map (mkTyVarTy . mk_skol_tv) tyvars
               = substTyWith tyvars tyvars' ty
 mk_skol_tv tv = mkTcTyVar (tyVarName tv) (tyVarKind tv) 
-                      (SkolemTv UnkSkol)
+                      (SkolemTv RuntimeUnkSkol)