@@ -237,7 +237,7 @@ instance MonadAsync m => Applicative (AsyncT m) where
237237-- Pick up from where we left in the previous thread
238238------------------------------------------------------------------------------
239239
240−-- {-# INLINE continue #-}
240+{-# SPECIALIZE continue :: [Any] -> a -> StateT Context IO (Maybe a) #-}
241241continue :: Monad m => [Any] -> a -> StateT Context m (Maybe a)
242242continue [] x = do
243243 return (Just x)
@@ -253,7 +253,7 @@ continue (f:fs) x = do
253253 Nothing -> return y
254254 Just z -> continue fs z
255255
256−-- {-# INLINE runContext #-}
256+{-# SPECIALIZE runContext :: Context -> AsyncT IO a -> StateT Context IO () #-}
257257runContext :: MonadAsync m => Context -> AsyncT m a -> StateT Context m ()
258258runContext ctx action = do
259259 _ <- lift $ runStateT m ctx
@@ -321,6 +321,7 @@ tryReclaimZombies ctx = do
321321 maybe (return ()) throwM e
322322 tryReclaimZombies ctx
323323
324+{-# NOINLINE waitForOneEvent #-}
324325waitForOneEvent :: (MonadIO m, MonadThrow m) => Context -> m ()
325326waitForOneEvent ctx = do
326327 -- XXX assert pending must have at least one element
@@ -337,6 +338,7 @@ waitForOneEvent ctx = do
337338-- XXX this is not a real semaphore as it does not really block on wait,
338339-- instead it returns whether the value is zero or non-zero.
339340--
341+{-# INLINE waitQSemB #-}
340342waitQSemB :: IORef Int -> IO Bool
341343waitQSemB sem = atomicModifyIORefCAS sem $ \n ->
342344 if n > 0
@@ -437,10 +439,10 @@ forkContext action = do
437439--
438440canFork :: Context -> IO Bool
439441canFork context = do
440− gotCredit <- liftIO $ waitQSemB (threadCredit context)
442+ gotCredit <- waitQSemB (threadCredit context)
441443 case gotCredit of
442444 False -> do
443− pending <- liftIO $ readIORef $ pendingThreads context
445+ pending <- readIORef $ pendingThreads context
444446 case pending of
445447 [] -> return False
446448 _ -> do
@@ -467,6 +469,8 @@ spawningParentDone = do
467469-- | The task may be run in the same thread or in a new thread depending on the
468470-- forceAsync parameter and the current thread quota.
469471--
472+{-# SPECIALIZE runAsyncTask :: Bool -> AsyncT IO a -> StateT Context IO (Maybe a) #-}
473+{-# INLINE runAsyncTask #-}
470474runAsyncTask :: MonadAsync m
471475 => Bool
472476 -> AsyncT m a
@@ -480,7 +484,7 @@ runAsyncTask forceAsync action = do
480484 case can of
481485 False -> runContext context action
482486 True -> forkContext action
483− spawningParentDone
487+ return Nothing
484488
485489-- The current model is to start a new thread for every task. The input is
486490-- provided at the time of the creation and therefore no synchronization is
@@ -550,10 +554,7 @@ instance MonadAsync m => Alternative (AsyncT m) where
550554 empty = AsyncT $ return Nothing
551555 (<|>) m1 m2 = AsyncT $ do
552556 r <- runAsyncTask False m1
553− loc <- getLocation
554− case loc of
555− RemoteNode -> return Nothing
556− _ -> maybe (runAsyncT m2) (return . Just) r
557+ maybe (runAsyncT m2) (return . Just) r
557558
558559instance MonadAsync m => MonadPlus (AsyncT m) where
559560 mzero = empty