@@ -19,7 +19,8 @@ import Data.Text.Lazy.Encoding (encodeUtf8)
1919import qualified Data.ByteString.Lazy.Char8 as L8
2020import Control.Exception (Exception, SomeException, toException, fromException, finally, mask)
2121import qualified Control.Exception as E
22−import Control.Concurrent (forkIO, threadDelay, killThread)
22+import Control.Concurrent (ThreadId, myThreadId, threadDelay, killThread)
23+import qualified Control.Concurrent as Concurrent
2324
2425import Data.Maybe
2526import Control.Monad
@@ -46,6 +47,20 @@ runQuit :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])
4647 -> IO ()
4748runQuit port modu func extras = runQuitWithReloadActions port modu func extras []
4849
50+-- |
51+-- A version of `Concurrent.forkIO` that re-throws any uncaught
52+-- `E.UserInterrupt` from the child thread in the parent thread.
53+--
54+-- We need this because using hint (or the GHC API) causes @UserInterrupt@ to
55+-- occur in the thread that runs `runInterpreter` instead of the main thread.
56+forkIO :: IO () -> IO ThreadId
57+forkIO action = do
58+ threadId <- myThreadId
59+ Concurrent.forkIO (action `E.catch` \e -> case e of
60+ E.UserInterrupt -> E.throwTo threadId e
61+ _ -> E.throwIO e
62+ )
63+
4964runQuitWithReloadActions :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])
5065 -> [IO (IO ())] -> IO ()
5166runQuitWithReloadActions port modu func extras actions = do