@@ -17,7 +17,7 @@ module Asyncly.RunAsync
1717 ( wait
1818 , wait_
1919 , AsynclyT
20− , threads
20+-- , threads
2121 , each
2222 {-
2323 , gather
@@ -56,7 +56,7 @@ deriving instance MonadAsync m => Alternative (AsynclyT m)
5656deriving instance MonadAsync m => Monad (AsynclyT m)
5757deriving instance MonadAsync m => MonadIO (AsynclyT m)
5858instance MonadTrans (AsynclyT) where
59− lift mx = AsynclyT $ AsyncT $ lift mx >>= return . (\a -> (Yield a stop))
59+ lift mx = AsynclyT $ AsyncT $ \s k -> lift mx >>= (\a -> (k a Nothing))
6060
6161getContext :: Maybe (IORef [Recording]) -> IO Context
6262getContext lref = do
@@ -69,31 +69,33 @@ getContext lref = do
6969-- results.
7070{-# SPECIALIZE wait_ :: AsynclyT IO a -> IO () #-}
7171wait_ :: forall m a. (MonadAsync m, MonadCatch m) => AsynclyT m a -> m ()
72−wait_ (AsynclyT m) = do
72+wait_ (AsynclyT m) = do
7373 ctx <- liftIO $ getContext Nothing
7474 _ <- runStateT (run m) ctx
7575 return ()
7676
7777 where
7878
79− run m = runAsyncT m >>= \x ->
80− case x of
81− Yield _ r -> run r
82− -- XXX pull from children here
83− _ -> return ()
79+ run m = (runAsyncT m) (return ())
80+ (\a r -> maybe (return ()) (\x -> run x) r)
8481
82+data Step a r = Stop | Done a | Yield a r
83+
84+{-# SPECIALIZE wait :: AsynclyT IO a -> IO [a] #-}
85+{-# INLINE wait #-}
8586wait :: forall m a. (MonadAsync m, MonadCatch m) => AsynclyT m a -> m [a]
8687wait (AsynclyT m) = liftIO (getContext Nothing) >>= run m
8788
8889 where
8990
9091 run ma ctx = do
91− (a, ctx') <- runStateT (runAsyncT ma) ctx
92− case a of
92+ (res, ctx') <- runStateT ((runAsyncT ma) (return Stop)
93+ (\a r -> maybe (return (Done a)) (\x -> return $ Yield a x) r)) ctx
94+ case res of
9395 Yield x mb -> liftM (x :) (run mb ctx')
9496 -- XXX pull from children here
9597 Stop -> return []
96−
98+ Done x -> return (x : [])
9799
98100-- scatter
99101{-# SPECIALIZE each :: [a] -> AsynclyT IO a #-}
@@ -108,8 +110,8 @@ each xs = foldr (<|>) empty $ map return xs
108110-- | Runs a computation under a given thread limit. A limit of 0 means all new
109111-- tasks start synchronously in the current thread unless overridden by
110112-- 'async'.
111−threads :: MonadAsync m => Int -> AsynclyT m a -> AsynclyT m a
112−threads n action = AsynclyT $ AsyncT $ threadCtl n (runAsyncT $ runAsynclyT action)
113+-- threads :: MonadAsync m => Int -> AsynclyT m a -> AsynclyT m a
114+-- threads n action = AsynclyT $ AsyncT $ threadCtl n (runAsyncT $ runAsynclyT action)
113115
114116{-
115117wait_ :: AsyncT IO a -> IO ()