git.iko.soy/streamly
on master help sign in
Fix the composite benchmark code
99d9ba6Harendra Kumar
asyncly.cabal+1−1
compare with master
unifiedsplit
@@ -26,7 +26,7 @@ library
26 exposed-modules: Asyncly
26 exposed-modules: Asyncly
27 , Asyncly.Threads
27 , Asyncly.Threads
28 , Asyncly.AsyncT
28 , Asyncly.AsyncT
29− -- , Asyncly.RunAsync
29+ , Asyncly.RunAsync
30
30
31 default-language: Haskell2010
31 default-language: Haskell2010
32 ghc-options: -Wall -fwarn-identities -fwarn-incomplete-record-updates
32 ghc-options: -Wall -fwarn-identities -fwarn-incomplete-record-updates
benchmark/Main.hs+4−4
@@ -86,19 +86,19 @@ transient_basic = T.keep' $ T.threads 0 $ do
86 assert (Prelude.length xs == 499000) $
86 assert (Prelude.length xs == 499000) $
87 T.exit (Prelude.length xs)
87 T.exit (Prelude.length xs)
88
88
89−amap :: (a -> Int) -> a -> AsyncT IO Int
89+amap :: (a -> Int) -> a -> AsynclyT IO Int
90amap = Main.map
90amap = Main.map
91
91
92−afilter :: (a -> Bool) -> a -> AsyncT IO a
92+afilter :: (a -> Bool) -> a -> AsynclyT IO a
93afilter = Main.filter
93afilter = Main.filter
94
94
95−adrop :: Int -> Int -> AsyncT IO Int
95+adrop :: Int -> Int -> AsynclyT IO Int
96adrop = Main.drop
96adrop = Main.drop
97
97
98asyncly_basic :: IO Int
98asyncly_basic :: IO Int
99asyncly_basic = do
99asyncly_basic = do
100 writeIORef count 0
100 writeIORef count 0
101− xs <- wait $ A.threads 0 $ do
101+ xs <- wait $ do
102 A.each [1..1000000 :: Int]
102 A.each [1..1000000 :: Int]
103 >>= afilter even
103 >>= afilter even
104 >>= amap (+1)
104 >>= amap (+1)
src/Asyncly.hs+6−5
@@ -120,16 +120,17 @@
120-- of the state machine. It is an immutable state machine!
120-- of the state machine. It is an immutable state machine!
121
121
122module Asyncly
122module Asyncly
123− ( -- AsynclyT
123+ ( AsynclyT
124− MonadAsync
124+ , MonadAsync
125 , AsyncT
125 , AsyncT
126
126
127 -- * Run
127 -- * Run
128−-- , wait
128+ , wait
129−-- , wait_
129+ , wait_
130-- , threads
130-- , threads
131 , waitA_
131 , waitA_
132 , eachA
132 , eachA
133+ , each
133
134
134{-
135{-
135 -- * Fork and Gather
136 -- * Fork and Gather
@@ -156,4 +157,4 @@ where
156
157
157import Asyncly.Threads
158import Asyncly.Threads
158import Asyncly.AsyncT
159import Asyncly.AsyncT
159−-- import Asyncly.RunAsync
160+import Asyncly.RunAsync
src/Asyncly/RunAsync.hs+15−13
@@ -17,7 +17,7 @@ module Asyncly.RunAsync
17 ( wait
17 ( wait
18 , wait_
18 , wait_
19 , AsynclyT
19 , AsynclyT
20− , threads
20+-- , threads
21 , each
21 , each
22 {-
22 {-
23 , gather
23 , gather
@@ -56,7 +56,7 @@ deriving instance MonadAsync m => Alternative (AsynclyT m)
56deriving instance MonadAsync m => Monad (AsynclyT m)
56deriving instance MonadAsync m => Monad (AsynclyT m)
57deriving instance MonadAsync m => MonadIO (AsynclyT m)
57deriving instance MonadAsync m => MonadIO (AsynclyT m)
58instance MonadTrans (AsynclyT) where
58instance 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))
60
60
61getContext :: Maybe (IORef [Recording]) -> IO Context
61getContext :: Maybe (IORef [Recording]) -> IO Context
62getContext lref = do
62getContext lref = do
@@ -69,31 +69,33 @@ getContext lref = do
69-- results.
69-- results.
70{-# SPECIALIZE wait_ :: AsynclyT IO a -> IO () #-}
70{-# SPECIALIZE wait_ :: AsynclyT IO a -> IO () #-}
71wait_ :: forall m a. (MonadAsync m, MonadCatch m) => AsynclyT m a -> m ()
71wait_ :: forall m a. (MonadAsync m, MonadCatch m) => AsynclyT m a -> m ()
72−wait_ (AsynclyT m) = do
72+wait_ (AsynclyT m) = do
73 ctx <- liftIO $ getContext Nothing
73 ctx <- liftIO $ getContext Nothing
74 _ <- runStateT (run m) ctx
74 _ <- runStateT (run m) ctx
75 return ()
75 return ()
76
76
77 where
77 where
78
78
79− run m = runAsyncT m >>= \x ->
79+ run m = (runAsyncT m) (return ())
80− case x of
80+ (\a r -> maybe (return ()) (\x -> run x) r)
81− Yield _ r -> run r
82− -- XXX pull from children here
83− _ -> return ()
84
81
82+data Step a r = Stop | Done a | Yield a r
83+
84+{-# SPECIALIZE wait :: AsynclyT IO a -> IO [a] #-}
85+{-# INLINE wait #-}
85wait :: forall m a. (MonadAsync m, MonadCatch m) => AsynclyT m a -> m [a]
86wait :: forall m a. (MonadAsync m, MonadCatch m) => AsynclyT m a -> m [a]
86wait (AsynclyT m) = liftIO (getContext Nothing) >>= run m
87wait (AsynclyT m) = liftIO (getContext Nothing) >>= run m
87
88
88 where
89 where
89
90
90 run ma ctx = do
91 run ma ctx = do
91− (a, ctx') <- runStateT (runAsyncT ma) ctx
92+ (res, ctx') <- runStateT ((runAsyncT ma) (return Stop)
93+ (\a r -> maybe (return (Done a)) (\x -> return $ Yield a x) r)) ctx
92− case a of
94+ case res of
93 Yield x mb -> liftM (x :) (run mb ctx')
95 Yield x mb -> liftM (x :) (run mb ctx')
94 -- XXX pull from children here
96 -- XXX pull from children here
95 Stop -> return []
97 Stop -> return []
96−
98+ Done x -> return (x : [])
97
99
98-- scatter
100-- scatter
99{-# SPECIALIZE each :: [a] -> AsynclyT IO a #-}
101{-# SPECIALIZE each :: [a] -> AsynclyT IO a #-}
@@ -108,8 +110,8 @@ each xs = foldr (<|>) empty $ map return xs
108-- | Runs a computation under a given thread limit. A limit of 0 means all new
110-- | Runs a computation under a given thread limit. A limit of 0 means all new
109-- tasks start synchronously in the current thread unless overridden by
111-- tasks start synchronously in the current thread unless overridden by
110-- 'async'.
112-- 'async'.
111−threads :: MonadAsync m => Int -> AsynclyT m a -> AsynclyT m a
113+-- threads :: MonadAsync m => Int -> AsynclyT m a -> AsynclyT m a
112−threads n action = AsynclyT $ AsyncT $ threadCtl n (runAsyncT $ runAsynclyT action)
114+-- threads n action = AsynclyT $ AsyncT $ threadCtl n (runAsyncT $ runAsynclyT action)
113
115
114{-
116{-
115wait_ :: AsyncT IO a -> IO ()
117wait_ :: AsyncT IO a -> IO ()