--- | 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.
-rethrow :: IO a -> IO a
-rethrow io = Exception.catch io Exception.throwIO
+-- 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 :: DynFlags -> IO a -> IO a
+rethrow dflags io = Exception.catch io $ \e -> do -- NB. not catchDyn
+ case e of
+ -- If -fbreak-on-error, we break unconditionally,
+ -- but with care of not breaking twice
+ _ | dopt Opt_BreakOnError dflags &&
+ not(dopt Opt_BreakOnException dflags)
+ -> poke exceptionFlag 1
+
+ -- If it is an "Interrupted" exception, we allow
+ -- a possible break by way of -fbreak-on-exception
+ DynException d | Just Interrupted <- fromDynamic d
+ -> return ()
+
+ -- In any other case, we don't want to break
+ _ -> poke exceptionFlag 0
+
+ Exception.throwIO e
+