X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FDebugger.hs;h=c53a7392a3f853d1b0d9dee84b4a8ce03c311d75;hb=4d71f5ee6dbbfedb4a55767e4375f4c0aadf70bb;hp=5ae7db8caacc319ce80c9846c287d18dfe50062e;hpb=8bbebfe661bdc976965718a2a489515c4929a03f;p=ghc-hetmet.git

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 5ae7db8..c53a739 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -73,13 +73,15 @@ 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 && 
+                      Just False == isUnliftedTypeKind `fmap` 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 = computeRTTIsubst (idType id) (reconstructed_type)
+           subst = unifyRTTI (idType id) (reconstructed_type)
        return (term',subst)
 
    tidyTermTyVars :: Session -> Term -> IO Term
@@ -131,6 +133,9 @@ bindSuspensions cms@(Session ref) t = do
                                 \ty dc t -> do 
                                     (term, names) <- t
                                     return (NewtypeWrap ty dc term, names)
+                      , fRefWrap = \ty t -> do
+                                    (term, names) <- t 
+                                    return (RefWrap ty term, names)
                       }
         doSuspension freeNames ct mb_ty hval _name = do
           name <- atomicModifyIORef freeNames (\x->(tail x, head x))
@@ -173,7 +178,8 @@ 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 _ _ = panic "cPprShowable - unreachable"
+  cPprShowable prec RefWrap{wrapped_term=t} = cPprShowable prec t
+  cPprShowable _ _ = return Nothing
 
   needsParens ('"':_) = False   -- some simple heuristics to see whether parens
                                 -- are redundant in an arbitrary Show output