@@ -113,9 +113,9 @@ data Context m a =
113113newtype AsyncT m a =
114114 AsyncT {
115115 runAsyncT :: forall r.
116− Maybe (Context m a) -- state
117− -> m r -- stop
118− -> (a -> Maybe (Context m a) -> Maybe (AsyncT m a) -> m r) -- yield
116+ Maybe (Context m a) -- local state
117+ -> m r -- stop
118+ -> (a -> Maybe (AsyncT m a) -> m r) -- yield
119119 -> m r
120120 }
121121
@@ -133,8 +133,8 @@ instance Semigroup (AsyncT m a) where
133133 where
134134 go (AsyncT m) = AsyncT $ \ctx stp yld ->
135135 let stop = (runAsyncT m2) ctx stp yld
136− yield a c Nothing = yld a c (Just m2)
137− yield a c (Just r) = yld a c (Just (go r))
136+ yield a Nothing = yld a (Just m2)
137+ yield a (Just r) = yld a (Just (go r))
138138 in m ctx stop yield
139139
140140instance Monoid (AsyncT m a) where
@@ -145,8 +145,8 @@ instance Monoid (AsyncT m a) where
145145interleave :: AsyncT m a -> AsyncT m a -> AsyncT m a
146146interleave m1 m2 = AsyncT $ \ctx stp yld -> do
147147 let stop = (runAsyncT m2) ctx stp yld
148− yield a c Nothing = yld a c (Just m2)
149− yield a c (Just r) = yld a c (Just (interleave m2 r))
148+ yield a Nothing = yld a (Just m2)
149+ yield a (Just r) = yld a (Just (interleave m2 r))
150150 (runAsyncT m1) ctx stop yield
151151
152152infixr 5 <=>
@@ -176,7 +176,7 @@ instance Monad m => Functor (AsyncT m) where
176176-- lift the result into AsyncT.
177177
178178instance Monad m => Applicative (AsyncT m) where
179− pure a = AsyncT $ \ctx _ yld -> yld a ctx Nothing
179+ pure a = AsyncT $ \_ _ yld -> yld a Nothing
180180 (<*>) = ap
181181
182182------------------------------------------------------------------------------
@@ -196,8 +196,8 @@ bindWith k m f = go m
196196 go (AsyncT g) =
197197 AsyncT $ \_ stp yld ->
198198 let run x = (runAsyncT x) Nothing stp yld
199− yield a _ Nothing = run $ f a
200− yield a _ (Just r) = run $ f a `k` (go r)
199+ yield a Nothing = run $ f a
200+ yield a (Just r) = run $ f a `k` (go r)
201201 in g Nothing stp yield
202202
203203-- | '>>=' execute a monadic action for each element generated by the 'AsyncT'
@@ -209,8 +209,8 @@ instance Monad m => Monad (AsyncT m) where
209209
210210 AsyncT m >>= f = AsyncT $ \_ stp yld ->
211211 let run x = (runAsyncT x) Nothing stp yld
212− yield a _ Nothing = run $ f a
213− yield a _ (Just r) = run $ f a <> (r >>= f)
212+ yield a Nothing = run $ f a
213+ yield a (Just r) = run $ f a <> (r >>= f)
214214 in m Nothing stp yield
215215
216216------------------------------------------------------------------------------
@@ -291,8 +291,8 @@ runqueueLIFO ctx q = run
291291 Just m -> (runAsyncT m) (Just ctx) run yield
292292
293293 sendit a = send ctx (ChildYield a)
294− yield a _ Nothing = sendit a >> run
295− yield a c (Just r) = sendit a >> (runAsyncT r) c run yield
294+ yield a Nothing = sendit a >> run
295+ yield a (Just r) = sendit a >> (runAsyncT r) (Just ctx) run yield
296296
297297 dequeue = liftIO $ atomicModifyIORefCAS q $ \ ms ->
298298 case ms of
@@ -316,10 +316,8 @@ runqueueFIFO ctx q = run
316316
317317 dequeue = liftIO $ tryPopR q
318318 sendit a = send ctx (ChildYield a)
319− yield a _ Nothing = sendit a >> run
320− -- XXX do we need to save the context as well?
321− -- we can enqueue "(runAsyncT m) ctx run yield" instead
322− yield a _ (Just r) = sendit a >> liftIO (enqueueFIFO q r) >> run
319+ yield a Nothing = sendit a >> run
320+ yield a (Just r) = sendit a >> liftIO (enqueueFIFO q r) >> run
323321
324322-- Thread tracking is needed for two reasons:
325323--
@@ -376,7 +374,7 @@ pullWorker ctx = AsyncT $ \pctx stp yld -> do
376374 res <- liftIO $ tryTakeMVar (doorBell ctx)
377375 when (isNothing res) $ sendWorkerWait ctx
378376 list <- liftIO $ atomicModifyIORefCAS (outputQueue ctx) $ \x -> ([], x)
379− (runAsyncT $ processEvents list) pctx stp yld
377+ (runAsyncT $ processEvents pctx list) Nothing stp yld
380378
381379 where
382380
@@ -387,15 +385,15 @@ pullWorker ctx = AsyncT $ \pctx stp yld -> do
387385 throwM e
388386
389387 {-# INLINE processEvents #-}
390− processEvents [] = AsyncT $ \pctx stp yld -> do
388+ processEvents pctx [] = AsyncT $ \_ stp yld -> do
391389 done <- allThreadsDone ctx
392390 if not done
393391 then (runAsyncT (pullWorker ctx)) pctx stp yld
394392 else stp
395393
396− processEvents (ev : es) = AsyncT $ \pctx stp yld -> do
397− let continue = (runAsyncT (processEvents es)) pctx stp yld
398− yield a = yld a pctx (Just (processEvents es))
394+ processEvents pctx (ev : es) = AsyncT $ \_ stp yld -> do
395+ let continue = (runAsyncT (processEvents pctx es)) Nothing stp yld
396+ yield a = yld a (Just (processEvents pctx es))
399397
400398 case ev of
401399 ChildYield a -> yield a
@@ -578,7 +576,7 @@ instance (Monad m, Floating a) => Floating (AsyncT m a) where
578576-------------------------------------------------------------------------------
579577
580578instance MonadTrans AsyncT where
581− lift mx = AsyncT $ \ctx _ yld -> mx >>= (\a -> (yld a ctx Nothing))
579+ lift mx = AsyncT $ \_ _ yld -> mx >>= (\a -> (yld a Nothing))
582580
583581instance (MonadBase b m, Monad m) => MonadBase b (AsyncT m) where
584582 liftBase = liftBaseDefault
@@ -598,15 +596,15 @@ instance MonadError e m => MonadError e (AsyncT m) where
598596 throwError = lift . throwError
599597 catchError m h = AsyncT $ \ctx stp yld ->
600598 let handle r = r `catchError` \e -> (runAsyncT (h e)) ctx stp yld
601− yield a c Nothing = yld a c Nothing
602− yield a c (Just r) = yld a c (Just (catchError r h))
599+ yield a Nothing = yld a Nothing
600+ yield a (Just r) = yld a (Just (catchError r h))
603601 in handle $ (runAsyncT m) ctx stp yield
604602
605603instance MonadReader r m => MonadReader r (AsyncT m) where
606604 ask = lift ask
607605 local f m = AsyncT $ \ctx stp yld ->
608− let yield a c Nothing = local f $ yld a c Nothing
609− yield a c (Just r) = local f $ yld a c (Just (local f r))
606+ let yield a Nothing = local f $ yld a Nothing
607+ yield a (Just r) = local f $ yld a (Just (local f r))
610608 in (runAsyncT m) ctx (local f stp) yield
611609
612610instance MonadState s m => MonadState s (AsyncT m) where
@@ -621,33 +619,29 @@ instance MonadState s m => MonadState s (AsyncT m) where
621619-- | Run an 'AsyncT' computation, wait for it to finish and discard the
622620-- results.
623621runAsyncly :: MonadAsync m => AsyncT m a -> m ()
624−runAsyncly m = run Nothing m
622+runAsyncly m = (runAsyncT m) Nothing stop yield
625623
626624 where
627625
628626 stop = return ()
629627
630628 {-# INLINE yield #-}
631− yield _ _ Nothing = stop
632− yield _ c (Just x) = run c x
629+ yield _ Nothing = stop
630+ yield _ (Just x) = runAsyncly x
633631
634− run ct mx = (runAsyncT mx) ct stop yield
635632
636633-- | Collect the results of an 'AsyncT' stream into a list.
637634{-# INLINABLE toList #-}
638635toList :: MonadAsync m => AsyncT m a -> m [a]
639−toList m = run Nothing m
636+toList m = (runAsyncT m) Nothing stop yield
640637
641638 where
642639
643640 stop = return []
644641
645642 {-# INLINE yield #-}
646− yield a _ Nothing = return [a]
647− yield a c (Just x) = liftM (a :) (run c x)
648−
649− {-# INLINE run #-}
650− run ctx mx = (runAsyncT mx) ctx stop yield
643+ yield a Nothing = return [a]
644+ yield a (Just x) = liftM (a :) (toList x)
651645
652646------------------------------------------------------------------------------
653647-- Transformation
@@ -656,8 +650,8 @@ toList m = run Nothing m
656650-- | Take first 'n' elements from the stream and discard the rest.
657651take :: MonadAsync m => Int -> AsyncT m a -> AsyncT m a
658652take n m = AsyncT $ \ctx stp yld -> do
659− let yield a c Nothing = yld a c Nothing
660− yield a c (Just x) = yld a c (Just (take (n - 1) x))
653+ let yield a Nothing = yld a Nothing
654+ yield a (Just x) = yld a (Just (take (n - 1) x))
661655 if (n <= 0)
662656 then stp
663657 else (runAsyncT m) ctx stp yield
@@ -665,8 +659,8 @@ take n m = AsyncT $ \ctx stp yld -> do
665659-- | Discard first 'n' elements from the stream and take the rest.
666660drop :: MonadAsync m => Int -> AsyncT m a -> AsyncT m a
667661drop n m = AsyncT $ \ctx stp yld -> do
668− let yield _ _ Nothing = stp
669− yield _ c (Just x) = (runAsyncT $ drop (n - 1) x) c stp yld
662+ let yield _ Nothing = stp
663+ yield _ (Just x) = (runAsyncT $ drop (n - 1) x) ctx stp yld
670664 if (n <= 0)
671665 then (runAsyncT m) ctx stp yld
672666 else (runAsyncT m) ctx stp yield
@@ -700,4 +694,4 @@ forEachWith f xs g = foldr (f . g) mempty xs
700694
701695-- | Convert a callback into an 'AsyncT' stream.
702696fromCallback :: (forall r. (a -> m r) -> m r) -> AsyncT m a
703−fromCallback k = AsyncT $ \ctx _ yld -> k (\a -> yld a ctx Nothing)
697+fromCallback k = AsyncT $ \_ _ yld -> k (\a -> yld a Nothing)