X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=42f0922370d4e0278935232d3700814dc274ff91;hb=485b80f9c422e49a441ec0b175c39799630171da;hp=b53e015da7c60109fb2bdc23148d69d240ce4791;hpb=efb02b428941021771c9b9b955bba3ec0214dbaf;p=ghc-hetmet.git

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index b53e015..42f0922 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -522,8 +522,9 @@ abandon (Session ref) = do
        resume = ic_resume ic
    case resume of
       []    -> return False
-      _:rs  -> do
+      r:rs  -> do 
          writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = rs } }
+         abandon_ r
          return True
 
 abandonAll :: Session -> IO Bool
@@ -532,11 +533,26 @@ abandonAll (Session ref) = do
    let ic = hsc_IC hsc_env
        resume = ic_resume ic
    case resume of
-      []    -> return False
-      _:rs  -> do
+      []  -> return False
+      rs  -> do 
          writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = [] } }
+         mapM_ abandon_ rs
          return True
 
+-- when abandoning a computation we have to 
+--      (a) kill the thread with an async exception, so that the 
+--          computation itself is stopped, and
+--      (b) fill in the MVar.  This step is necessary because any
+--          thunks that were under evaluation will now be updated
+--          with the partial computation, which still ends in takeMVar,
+--          so any attempt to evaluate one of these thunks will block
+--          unless we fill in the MVar.
+--  See test break010.
+abandon_ :: Resume -> IO ()
+abandon_ r = do
+  killThread (resumeThreadId r)
+  putMVar (resumeBreakMVar r) () 
+
 -- -----------------------------------------------------------------------------
 -- Bounded list, optimised for repeated cons
 
@@ -768,11 +784,9 @@ isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
 obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
 
-obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
+obtainTerm :: Session -> Bool -> Id -> IO Term
 obtainTerm sess force id = withSession sess $ \hsc_env -> do
-              mb_v <- Linker.getHValue (varName id) 
-              case mb_v of
-                Just v  -> fmap Just$ cvObtainTerm hsc_env force (Just$ idType id) v
-                Nothing -> return Nothing
+              hv <- Linker.getHValue hsc_env (varName id) 
+              cvObtainTerm hsc_env force (Just$ idType id) hv
 
 #endif /* GHCI */