X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=1f3686186b28f4ee09131058b710cdc7c3da6bb1;hp=c80f2933f793167f9d34738b8dd906878c3717eb;hb=27ebe4c5edb356cec5c9b12f357404ae998bc905;hpb=e560c6b5a0c2ef4437ebca0c78c1775a09ba31c9

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index c80f293..1f36861 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -272,13 +272,21 @@ sandboxIO statusMVar thing =
                     putMVar statusMVar (Complete res)))
         (takeMVar statusMVar)
 
--- | this just re-throws any exceptions received.  The point of this
--- is that if -fbreak-on-excepsions is on, we only get a chance to break
--- for synchronous exceptions, and this turns an async exception into
--- a sync exception, so for instance a ^C exception will break right here
--- unless it is caught elsewhere.
+-- 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 Exception.throwIO
+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