on master help sign in
Gain some perf by passing the q to dequeueLoop

Unboxing reboxing of context to get the q is saved

commitaf09d3162a3129dccd6f06336502c0376531fb32 authorHarendra Kumar <harendra.kumar@gmail.com> dateWed 30 Aug 2017, 04:14 (9 years ago) parent9da2f40
1 file changed+9−9
src/Asyncly/AsyncT.hs+9−9
src/Asyncly/AsyncT.hs+9−9
@@ -208,7 +208,7 @@ doFork action exHandler =
208208
209209{-# NOINLINE push #-}
210210push :: MonadAsync m => Context m a -> m ()
211−push ctx = run (Just ctx) (dequeueLoop ctx)
211+push ctx = run (Just ctx) (dequeueLoop (Just ctx) (workQueue ctx))
212212
213213 where
214214
@@ -397,16 +397,16 @@ queueWork ctx m = do
397397
398398-- Note: This is performance sensitive code.
399399{-# INLINE dequeueLoop #-}
400−dequeueLoop :: MonadAsync m => Context m a -> AsyncT m a
401−dequeueLoop ctx = AsyncT $ \_ stp yld -> do
402− work <- liftIO $ atomically $ tryReadTBQueue (workQueue ctx)
400+dequeueLoop :: MonadAsync m => Maybe (Context m a) -> TBQueue (AsyncT m a) -> AsyncT m a
401+dequeueLoop ctx q = AsyncT $ \_ stp yld -> do
402+ work <- liftIO $ atomically $ tryReadTBQueue q
403403 case work of
404404 Nothing -> stp
405405 Just m -> do
406− let stop = (runAsyncT (dequeueLoop ctx)) Nothing stp yld
407− yield a c Nothing = yld a c (Just (dequeueLoop ctx))
406+ let stop = (runAsyncT (dequeueLoop ctx q)) Nothing stp yld
407+ yield a c Nothing = yld a c (Just (dequeueLoop ctx q))
408408 yield a c r = yld a c r
409− (runAsyncT m) (Just ctx) stop yield
409+ (runAsyncT m) ctx stop yield
410410
411411instance MonadAsync m => Alternative (AsyncT m) where
412412 empty = mempty
@@ -422,7 +422,7 @@ instance MonadAsync m => Alternative (AsyncT m) where
422422 -- go left to right. If the left one keeps producing results we
423423 -- may or may not run the right one.
424424 queueWork c m1 >> queueWork c m2
425− (runAsyncT (dequeueLoop c)) Nothing stp yld
425+ (runAsyncT (dequeueLoop ctx (workQueue c))) Nothing stp yld
426426
427427-- | Just like '<>' except that it can execute the action on the right in
428428-- parallel ahead of time. Returns the results in serial order like '<>' from
@@ -447,7 +447,7 @@ parLeft m1 m2 = AsyncT $ \ctx stp yld -> do
447447 -- go left to right. If the left one keeps producing results we
448448 -- may or may not run the right one.
449449 queueWork c m1 >> queueWork c m2
450− (runAsyncT (dequeueLoop c)) Nothing stp yld
450+ (runAsyncT (dequeueLoop ctx (workQueue c))) Nothing stp yld
451451
452452-- | Same as 'parLeft'.
453453{-# INLINE (<|) #-}