From b5986072833796acb374e22f18cef8ab839a3419 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 25 Apr 2007 14:29:45 +0000 Subject: [PATCH] force APs, AP_STACKs and ThunkSelectors in :force --- compiler/ghci/RtClosureInspect.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 0624169..45c5b0f 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -168,6 +168,7 @@ readCType i | 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) @@ -179,6 +180,11 @@ isIndirection (Indirection _) = True --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 @@ -489,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 - (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 @@ -504,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 - 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 -- 1.7.10.4