- bound <- isCurrentThreadBound
- if bound
- then do
- mv <- newEmptyMVar
- b <- blocked
- _ <- block $ forkIO $
- Exception.try (if b then action else unblock action) >>=
- putMVar mv
- takeMVar mv >>= \ei -> case ei of
- Left exception -> Exception.throw (exception :: SomeException)
- Right result -> return result
- else action
-
+ bound <- isCurrentThreadBound
+ if bound
+ then do
+ mv <- newEmptyMVar
+ mask $ \restore -> do
+ tid <- forkIO $ Exception.try (restore action) >>= putMVar mv
+ let wait = takeMVar mv `Exception.catch` \(e :: SomeException) ->
+ Exception.throwTo tid e >> wait
+ wait >>= unsafeResult
+ else action
+
+unsafeResult :: Either SomeException a -> IO a
+unsafeResult = either Exception.throwIO return