X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=45c5b0fa27d995c07ba37722b86bf97c2d3be74a;hp=0624169178befafdf9cae8c42e9c341fa883823f;hb=b5986072833796acb374e22f18cef8ab839a3419;hpb=7ba2a2ea29171d7758d76dff2cc3e1cfb7edf8fa

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