@@ -265,6 +265,17 @@ handleException e ctx tid = do
265265 liftIO $ readIORef (runningThreads ctx) >>= mapM_ killThread
266266 throwM e
267267
268+{-# NOINLINE sendWorkerWait #-}
269+sendWorkerWait :: MonadAsync m => Context m a -> m ()
270+sendWorkerWait ctx = do
271+ liftIO $ threadDelay 4
272+ let workQ = workQueue ctx
273+ outQ = outputQueue ctx
274+ workQEmpty <- liftIO $ atomically $ isEmptyTBQueue workQ
275+ outQEmpty <- liftIO $ atomically $ isEmptyTBQueue outQ
276+ when (not workQEmpty && outQEmpty) $ pushWorker ctx
277+ void $ liftIO $ atomically $ peekTBQueue (outputQueue ctx)
278+
268279-- We re-raise any exceptions received from the child threads, that way
269280-- exceptions get propagated to the top level computation and can be handled
270281-- there.
@@ -279,15 +290,7 @@ pullWorker ctx = AsyncT $ \pctx stp yld -> do
279290
280291 res <- liftIO $ atomically $ tryReadTBQueue (outputQueue ctx)
281292 case res of
282− Nothing -> do
283− liftIO $ threadDelay 4
284− let workQ = workQueue ctx
285− outQ = outputQueue ctx
286− workQEmpty <- liftIO $ atomically $ isEmptyTBQueue workQ
287− outQEmpty <- liftIO $ atomically $ isEmptyTBQueue outQ
288− when (not workQEmpty && outQEmpty) $ pushWorker ctx
289− void $ liftIO $ atomically $ peekTBQueue (outputQueue ctx)
290− continue
293+ Nothing -> sendWorkerWait ctx >> continue
291294 Just ev ->
292295 case ev of
293296 ChildYield a -> yield a