projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Use the right set of linkables in unload_wkr
[ghc-hetmet.git]
/
compiler
/
ghci
/
Debugger.hs
diff --git
a/compiler/ghci/Debugger.hs
b/compiler/ghci/Debugger.hs
index
1b1b2c9
..
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
@@
-131,12
+134,14
@@
bindSuspensions cms@(Session ref) t = do
\ty dc t -> do
(term, names) <- t
return (NewtypeWrap ty dc term, names)
\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
+ 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
@@
-173,7
+178,7
@@
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 _ _ = panic "cPprShowable - unreachable"
+ cPprShowable _ _ = return Nothing
needsParens ('"':_) = False -- some simple heuristics to see whether parens
-- are redundant in an arbitrary Show output
needsParens ('"':_) = False -- some simple heuristics to see whether parens
-- are redundant in an arbitrary Show output