projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove some dead code from VectType
[ghc-hetmet.git]
/
compiler
/
ghci
/
Debugger.hs
diff --git
a/compiler/ghci/Debugger.hs
b/compiler/ghci/Debugger.hs
index
72688dd
..
c0ac9d3
100644
(file)
--- 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_
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.
-- 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
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)
}
(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
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
-- 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}
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
cPprShowable _ _ = return Nothing
needsParens ('"':_) = False -- some simple heuristics to see whether parens