3ed5abc · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add some more SPECIALIZE and INLINE pragmas

3ed5abcHarendra Kumar9 years ago

src/Asyncly/AsyncT.hs+10−9

compare with master

unifiedsplit

@@ -237,7 +237,7 @@ instance MonadAsync m => Applicative (AsyncT m) where

237-- Pick up from where we left in the previous thread

238------------------------------------------------------------------------------

239

240−-- {-# INLINE continue #-}

240+{-# SPECIALIZE continue :: [Any] -> a -> StateT Context IO (Maybe a) #-}

241continue :: Monad m => [Any] -> a -> StateT Context m (Maybe a)

242continue [] x = do

243 return (Just x)

@@ -253,7 +253,7 @@ continue (f:fs) x = do

253 Nothing -> return y

254 Just z -> continue fs z

255

256−-- {-# INLINE runContext #-}

256+{-# SPECIALIZE runContext :: Context -> AsyncT IO a -> StateT Context IO () #-}

257runContext :: MonadAsync m => Context -> AsyncT m a -> StateT Context m ()

258runContext ctx action = do

259 _ <- lift $ runStateT m ctx

@@ -321,6 +321,7 @@ tryReclaimZombies ctx = do

321 maybe (return ()) throwM e

322 tryReclaimZombies ctx

323

324+{-# NOINLINE waitForOneEvent #-}

324waitForOneEvent :: (MonadIO m, MonadThrow m) => Context -> m ()

325waitForOneEvent :: (MonadIO m, MonadThrow m) => Context -> m ()

325waitForOneEvent ctx = do

326waitForOneEvent ctx = do

326 -- XXX assert pending must have at least one element

327 -- XXX assert pending must have at least one element

@@ -337,6 +338,7 @@ waitForOneEvent ctx = do

337-- XXX this is not a real semaphore as it does not really block on wait,

338-- XXX this is not a real semaphore as it does not really block on wait,

338-- instead it returns whether the value is zero or non-zero.

339-- instead it returns whether the value is zero or non-zero.

339--

340--

341+{-# INLINE waitQSemB #-}

340waitQSemB :: IORef Int -> IO Bool

342waitQSemB :: IORef Int -> IO Bool

341waitQSemB sem = atomicModifyIORefCAS sem $ \n ->

343waitQSemB sem = atomicModifyIORefCAS sem $ \n ->

342 if n > 0

344 if n > 0

@@ -437,10 +439,10 @@ forkContext action = do

437--

439--

438canFork :: Context -> IO Bool

440canFork :: Context -> IO Bool

439canFork context = do

441canFork context = do

440− gotCredit <- liftIO $ waitQSemB (threadCredit context)

442+ gotCredit <- waitQSemB (threadCredit context)

441 case gotCredit of

443 case gotCredit of

442 False -> do

444 False -> do

443− pending <- liftIO $ readIORef $ pendingThreads context

445+ pending <- readIORef $ pendingThreads context

444 case pending of

446 case pending of

445 [] -> return False

447 [] -> return False

446 _ -> do

448 _ -> do

@@ -467,6 +469,8 @@ spawningParentDone = do

467-- | The task may be run in the same thread or in a new thread depending on the

469-- | The task may be run in the same thread or in a new thread depending on the

468-- forceAsync parameter and the current thread quota.

470-- forceAsync parameter and the current thread quota.

469--

471--

472+{-# SPECIALIZE runAsyncTask :: Bool -> AsyncT IO a -> StateT Context IO (Maybe a) #-}

473+{-# INLINE runAsyncTask #-}

470runAsyncTask :: MonadAsync m

474runAsyncTask :: MonadAsync m

471 => Bool

475 => Bool

472 -> AsyncT m a

476 -> AsyncT m a

@@ -480,7 +484,7 @@ runAsyncTask forceAsync action = do

480 case can of

484 case can of

481 False -> runContext context action

485 False -> runContext context action

482 True -> forkContext action

486 True -> forkContext action

483− spawningParentDone

487+ return Nothing

484

488

485-- The current model is to start a new thread for every task. The input is

489-- The current model is to start a new thread for every task. The input is

486-- provided at the time of the creation and therefore no synchronization is

490-- provided at the time of the creation and therefore no synchronization is

@@ -550,10 +554,7 @@ instance MonadAsync m => Alternative (AsyncT m) where

550 empty = AsyncT $ return Nothing

554 empty = AsyncT $ return Nothing

551 (<|>) m1 m2 = AsyncT $ do

555 (<|>) m1 m2 = AsyncT $ do

552 r <- runAsyncTask False m1

556 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

557

558

558instance MonadAsync m => MonadPlus (AsyncT m) where

559instance MonadAsync m => MonadPlus (AsyncT m) where

559 mzero = empty

560 mzero = empty