projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
remember the type of _result
[ghc-hetmet.git]
/
compiler
/
ghci
/
RtClosureInspect.hs
diff --git
a/compiler/ghci/RtClosureInspect.hs
b/compiler/ghci/RtClosureInspect.hs
index
e8157ac
..
45c5b0f
100644
(file)
--- a/
compiler/ghci/RtClosureInspect.hs
+++ b/
compiler/ghci/RtClosureInspect.hs
@@
-10,13
+10,7
@@
module RtClosureInspect(
cvObtainTerm, -- :: HscEnv -> Bool -> Maybe Type -> HValue -> IO Term
cvObtainTerm, -- :: HscEnv -> Bool -> Maybe Type -> HValue -> IO Term
- ClosureType(..),
- getClosureData, -- :: a -> IO Closure
- Closure ( tipe, infoPtr, ptrs, nonPtrs ),
- isConstr, -- :: ClosureType -> Bool
- isIndirection, -- :: ClosureType -> Bool
-
- Term(..),
+ Term(..),
pprTerm,
cPprTerm,
cPprTermBase,
pprTerm,
cPprTerm,
cPprTermBase,
@@
-174,6
+168,7
@@
readCType i
| i == BLACKHOLE = Blackhole
| i >= IND && i <= IND_STATIC = Indirection (fromIntegral i)
| fromIntegral i == aP_CODE = AP
| i == BLACKHOLE = Blackhole
| i >= IND && i <= IND_STATIC = Indirection (fromIntegral i)
| fromIntegral i == aP_CODE = AP
+ | i == AP_STACK = AP
| fromIntegral i == pAP_CODE = PAP
| otherwise = Other (fromIntegral i)
| fromIntegral i == pAP_CODE = PAP
| otherwise = Other (fromIntegral i)
@@
-185,6
+180,11
@@
isIndirection (Indirection _) = True
--isIndirection ThunkSelector = True
isIndirection _ = False
--isIndirection ThunkSelector = True
isIndirection _ = False
+isThunk (Thunk _) = True
+isThunk ThunkSelector = True
+isThunk AP = True
+isThunk _ = False
+
isFullyEvaluated :: a -> IO Bool
isFullyEvaluated a = do
closure <- getClosureData a
isFullyEvaluated :: a -> IO Bool
isFullyEvaluated a = do
closure <- getClosureData a
@@
-495,7
+495,7
@@
cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
Nothing -> go tv tv hval
Just ty | isMonomorphic ty -> go ty ty hval
Just ty -> do
Nothing -> go tv tv hval
Just ty | isMonomorphic ty -> go ty ty hval
Just ty -> do
- (ty',rev_subst) <- instScheme (sigmaType$ fromJust mb_ty)
+ (ty',rev_subst) <- instScheme (sigmaType ty)
addConstraint tv ty'
term <- go tv tv hval
--restore original Tyvars
addConstraint tv ty'
term <- go tv tv hval
--restore original Tyvars
@@
-510,7
+510,7
@@
cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
clos <- trIO $ getClosureData a
case tipe clos of
-- Thunks we may want to force
clos <- trIO $ getClosureData a
case tipe clos of
-- Thunks we may want to force
- Thunk _ | force -> seq a $ go tv ty a
+ t | isThunk t && force -> seq a $ go tv ty a
-- We always follow indirections
Indirection _ -> go tv ty $! (ptrs clos ! 0)
-- The interesting case
-- We always follow indirections
Indirection _ -> go tv ty $! (ptrs clos ! 0)
-- The interesting case