X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=f1e60797198cc7374cd38bcb4c46293491159189;hb=f2643821042fd3d859e7c6eaad459e6a2cb756a2;hp=f7e910135eb12851df2dac875378135e90365fe4;hpb=54fd57cdd7c974f81dee81e8edc53e78de82db04;p=ghc-hetmet.git

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index f7e9101..f1e6079 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -268,10 +268,26 @@ foreign import ccall "&rts_breakpoint_io_action"
 sandboxIO :: MVar Status -> IO [HValue] -> IO Status
 sandboxIO statusMVar thing = 
   withInterruptsSentTo 
-        (forkIO (do res <- Exception.try thing
+        (forkIO (do res <- Exception.try (rethrow thing)
                     putMVar statusMVar (Complete res)))
         (takeMVar statusMVar)
 
+-- We want to turn ^C into a break when -fbreak-on-exception is on,
+-- but it's an async exception and we only break for sync exceptions.
+-- Idea: if we catch and re-throw it, then the re-throw will trigger
+-- a break.  Great - but we don't want to re-throw all exceptions, because
+-- then we'll get a double break for ordinary sync exceptions (you'd have
+-- to :continue twice, which looks strange).  So if the exception is
+-- not "Interrupted", we unset the exception flag before throwing.
+--
+rethrow :: IO a -> IO a
+rethrow io = Exception.catch io $ \e -> -- NB. not catchDyn
+                case e of
+                   DynException d | Just Interrupted <- fromDynamic d
+                        -> Exception.throwIO e
+                   _ -> do poke exceptionFlag 0; Exception.throwIO e
+
+
 withInterruptsSentTo :: IO ThreadId -> IO r -> IO r
 withInterruptsSentTo io get_result = do
   ts <- takeMVar interruptTargetThread
@@ -803,11 +819,11 @@ isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
 		      where
 			 obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
 
-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)
+obtainTerm1 :: HscEnv -> Bool -> Maybe Type -> a -> IO Term
+obtainTerm1 hsc_env force mb_ty x = cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
 
-obtainTerm :: Session -> Bool -> Id -> IO Term
-obtainTerm sess force id = withSession sess $ \hsc_env -> do
+obtainTerm :: HscEnv -> Bool -> Id -> IO Term
+obtainTerm hsc_env force id =  do
               hv <- Linker.getHValue hsc_env (varName id) 
               cvObtainTerm hsc_env force (Just$ idType id) hv