X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FDebugger.hs;h=c0ac9d3166307295d4ba0c03795216d1e25710c7;hb=cea34a8aab0d8d47f48ed8797ac6ac4f3964346c;hp=72688ddd515fedf202d94c6475586286a3b1cab1;hpb=f4d6209d11ba41d3bfdd7e14e9859b890915abdb;p=ghc-hetmet.git

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 72688dd..c0ac9d3 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -73,14 +73,17 @@ pprintClosureCommand session bindThings force str = do
    go cms id = do
        term_    <- GHC.obtainTerm cms force id
        term     <- tidyTermTyVars cms term_
-       term'    <- if not bindThings then return term
-                     else bindSuspensions cms term                       
+       term'    <- if bindThings && 
+                      False == isUnliftedTypeKind (termType term)
+                     then bindSuspensions cms term
+                     else return term
      -- Before leaving, we compare the type obtained to see if it's more specific
      --  Then, we extract a substitution,
      --  mapping the old tyvars to the reconstructed types.
-       let Just reconstructed_type = termType term
-           subst = unifyRTTI (idType id) (reconstructed_type)
-       return (term',subst)
+       let reconstructed_type = termType term
+       mb_subst <- withSession cms $ \hsc_env ->
+                      improveRTTIType hsc_env (idType id) (reconstructed_type)
+       return (term', fromMaybe emptyTvSubst mb_subst)
 
    tidyTermTyVars :: Session -> Term -> IO Term
    tidyTermTyVars (Session ref) t = do
@@ -135,11 +138,10 @@ bindSuspensions cms@(Session ref) t = do
                                     (term, names) <- t 
                                     return (RefWrap ty term, names)
                       }
-        doSuspension freeNames ct mb_ty hval _name = do
+        doSuspension freeNames ct ty hval _name = do
           name <- atomicModifyIORef freeNames (\x->(tail x, head x))
           n <- newGrimName name
-          let ty' = fromMaybe (error "unexpected") mb_ty
-          return (Suspension ct mb_ty hval (Just n), [(n,ty',hval)])
+          return (Suspension ct ty hval (Just n), [(n,ty,hval)])
 
 
 --  A custom Term printer to enable the use of Show instances
@@ -176,7 +178,6 @@ showTerm cms@(Session ref) term = do
            GHC.setSessionDynFlags cms dflags
   cPprShowable prec NewtypeWrap{ty=new_ty,wrapped_term=t} = 
       cPprShowable prec t{ty=new_ty}
-  cPprShowable prec RefWrap{wrapped_term=t} = cPprShowable prec t
   cPprShowable _ _ = return Nothing
 
   needsParens ('"':_) = False   -- some simple heuristics to see whether parens