X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FDebugger.hs;h=c0ac9d3166307295d4ba0c03795216d1e25710c7;hb=0323459f422cc1cc62335f2ef5aac68d6896473b;hp=c53a7392a3f853d1b0d9dee84b4a8ce03c311d75;hpb=4d71f5ee6dbbfedb4a55767e4375f4c0aadf70bb;p=ghc-hetmet.git diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index c53a739..c0ac9d3 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -74,15 +74,16 @@ pprintClosureCommand session bindThings force str = do term_ <- GHC.obtainTerm cms force id term <- tidyTermTyVars cms term_ term' <- if bindThings && - Just False == isUnliftedTypeKind `fmap` termType term + 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 @@ -137,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 @@ -178,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