@@ -379,19 +379,20 @@ pushWorker :: MonadAsync m => Context m a -> m ()
379379pushWorker ctx =
380380 doFork (runqueue ctx) (handleChildException ctx) >>= addThread ctx
381381
382+-- XXX When the queue is LIFO we can put a limit on the number of dispatches.
383+-- Also, if a worker blocks on the output queue we can decide if we want to
384+-- block or make it go away entirely, depending on the number of workers and
385+-- the type of the queue.
382386{-# INLINE sendWorkerWait #-}
383387sendWorkerWait :: MonadAsync m => Context m a -> m ()
384−sendWorkerWait ctx = dispatch >> void (liftIO $ takeMVar (doorBell ctx))
385−
386− where
387−
388− dispatch = do
389− liftIO $ threadDelay 200
390− output <- liftIO $ readIORef (outputQueue ctx)
391− when (null output) $ do
392− done <- queueEmpty ctx
393− when (not done) $ (pushWorker ctx) >> dispatch
394−
388+sendWorkerWait ctx = do
389+ liftIO $ threadDelay 200
390+ output <- liftIO $ readIORef (outputQueue ctx)
391+ when (null output) $ do
392+ done <- queueEmpty ctx
393+ if (not done)
394+ then (pushWorker ctx) >> sendWorkerWait ctx
395+ else void (liftIO $ takeMVar (doorBell ctx))
395396
396397data ContextUsedAfterEOF = ContextUsedAfterEOF deriving Show
397398instance Exception ContextUsedAfterEOF