git.iko.soy/streamly
on master help sign in
Add applicative benchmarks

Specialize asyncly/wAsyncly/aheadly applicative instances

commitd01942d9dddca6d44321dc6c1b10941261dbe755 authorHarendra Kumar <harendra.kumar@gmail.com> dateSat 29 Dec 2018, 15:23 (8 years ago) parenta4fa2d3
7 files changed+58−14
compare with master
unifiedsplit
benchmark/LinearAsync.hs+1 benchmark/LinearOps.hs+10−2 benchmark/Nested.hs+12−6 benchmark/NestedOps.hs+7 src/Streamly/Streams/Ahead.hs+9−1 src/Streamly/Streams/Async.hs+17−5 src/Streamly/Streams/Parallel.hs+2
benchmark/LinearAsync.hs+1
@@ -100,5 +100,6 @@ main =
100100 -- Zip has only one parallel flavor
101101 , benchIO "zip" Ops.zipAsync
102102 , benchIO "zipM" Ops.zipAsyncM
103+ , benchIO "zipAp" Ops.zipAsyncAp
103104 ]
104105 ]
benchmark/LinearOps.hs+10−2
@@ -19,7 +19,7 @@ import Data.Maybe (fromJust)
1919import Prelude
2020 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (>=),
2121 subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry,
22− maxBound, div, IO, compare, Double, fromIntegral, Integer)
22+ maxBound, div, IO, compare, Double, fromIntegral, Integer, (<$>), (<*>))
2323import qualified Prelude as P
2424import qualified Data.Foldable as F
2525import qualified GHC.Exts as GHC
@@ -435,17 +435,25 @@ stripPrefix src = do
435435
436436{-# INLINE zipAsync #-}
437437{-# INLINE zipAsyncM #-}
438−zipAsync, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()
438+{-# INLINE zipAsyncAp #-}
439+zipAsync, zipAsyncAp, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()
439440
440441zipAsync src = do
441442 r <- S.tail src
442443 let src1 = fromJust r
443444 transform (S.zipAsyncWith (,) src src1)
445+
444446zipAsyncM src = do
445447 r <- S.tail src
446448 let src1 = fromJust r
447449 transform (S.zipAsyncWithM (curry return) src src1)
448450
451+zipAsyncAp src = do
452+ r <- S.tail src
453+ let src1 = fromJust r
454+ transform (S.zipAsyncly $ (,) <$> S.serially src
455+ <*> S.serially src1)
456+
449457{-# INLINE eqBy #-}
450458eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
451459eqBy src = S.eqBy (==) src src
benchmark/Nested.hs+12−6
@@ -23,7 +23,8 @@ main =
2323 -- TBD Study scaling with 10, 100, 1000 loop iterations
2424 defaultMain
2525 [ bgroup "serially"
26− [ benchIO "toNull" $ Ops.toNull serially
26+ [ benchIO "toNullAp" $ Ops.toNullAp serially
27+ , benchIO "toNull" $ Ops.toNull serially
2728 , benchIO "toList" $ Ops.toList serially
2829 -- , benchIO "toListSome" $ Ops.toListSome serially
2930 , benchIO "filterAllOut" $ Ops.filterAllOut serially
@@ -33,7 +34,8 @@ main =
3334 ]
3435
3536 , bgroup "wSerially"
36− [ benchIO "toNull" $ Ops.toNull wSerially
37+ [ benchIO "toNullAp" $ Ops.toNullAp wSerially
38+ , benchIO "toNull" $ Ops.toNull wSerially
3739 , benchIO "toList" $ Ops.toList wSerially
3840 -- , benchIO "toListSome" $ Ops.toListSome wSerially
3941 , benchIO "filterAllOut" $ Ops.filterAllOut wSerially
@@ -43,7 +45,8 @@ main =
4345 ]
4446
4547 , bgroup "aheadly"
46− [ benchIO "toNull" $ Ops.toNull aheadly
48+ [ benchIO "toNullAp" $ Ops.toNullAp aheadly
49+ , benchIO "toNull" $ Ops.toNull aheadly
4750 , benchIO "toList" $ Ops.toList aheadly
4851 -- , benchIO "toListSome" $ Ops.toListSome aheadly
4952 , benchIO "filterAllOut" $ Ops.filterAllOut aheadly
@@ -53,7 +56,8 @@ main =
5356 ]
5457
5558 , bgroup "asyncly"
56− [ benchIO "toNull" $ Ops.toNull asyncly
59+ [ benchIO "toNullAp" $ Ops.toNullAp asyncly
60+ , benchIO "toNull" $ Ops.toNull asyncly
5761 , benchIO "toList" $ Ops.toList asyncly
5862 -- , benchIO "toListSome" $ Ops.toListSome asyncly
5963 , benchIO "filterAllOut" $ Ops.filterAllOut asyncly
@@ -63,7 +67,8 @@ main =
6367 ]
6468
6569 , bgroup "wAsyncly"
66− [ benchIO "toNull" $ Ops.toNull wAsyncly
70+ [ benchIO "toNullAp" $ Ops.toNullAp wAsyncly
71+ , benchIO "toNull" $ Ops.toNull wAsyncly
6772 , benchIO "toList" $ Ops.toList wAsyncly
6873 -- , benchIO "toListSome" $ Ops.toListSome wAsyncly
6974 , benchIO "filterAllOut" $ Ops.filterAllOut wAsyncly
@@ -73,7 +78,8 @@ main =
7378 ]
7479
7580 , bgroup "parallely"
76− [ benchIO "toNull" $ Ops.toNull parallely
81+ [ benchIO "toNullAp" $ Ops.toNullAp parallely
82+ , benchIO "toNull" $ Ops.toNull parallely
7783 , benchIO "toList" $ Ops.toList parallely
7884 --, benchIO "toListSome" $ Ops.toListSome parallely
7985 , benchIO "filterAllOut" $ Ops.filterAllOut parallely
benchmark/NestedOps.hs+7
@@ -62,6 +62,13 @@ runToList = S.toList
6262-- Benchmark ops
6363-------------------------------------------------------------------------------
6464
65+{-# INLINE toNullAp #-}
66+toNullAp
67+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
68+ => (t m Int -> S.SerialT m Int) -> Int -> m ()
69+toNullAp t start = runStream . t $
70+ (+) <$> source start prodCount <*> source start prodCount
71+
6572{-# INLINE toNull #-}
6673toNull
6774 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
src/Streamly/Streams/Ahead.hs+9−1
@@ -686,9 +686,17 @@ instance MonadAsync m => Monad (AheadT m) where
686686 return = pure
687687 (>>=) = bindAhead
688688
689+{-# INLINE apAhead #-}
690+{-# SPECIALIZE apAhead :: AheadT IO (a -> b) -> AheadT IO a -> AheadT IO b #-}
691+apAhead :: MonadAsync m => AheadT m (a -> b) -> AheadT m a -> AheadT m b
692+apAhead mf m = ap (K.adapt mf) (K.adapt m)
693+
694+instance (Monad m, MonadAsync m) => Applicative (AheadT m) where
695+ pure = AheadT . K.yield
696+ (<*>) = apAhead
697+
689698------------------------------------------------------------------------------
690699-- Other instances
691700------------------------------------------------------------------------------
692701
693−MONAD_APPLICATIVE_INSTANCE(AheadT,MONADPARALLEL)
694702MONAD_COMMON_INSTANCES(AheadT, MONADPARALLEL)
src/Streamly/Streams/Async.hs+17−5
@@ -692,13 +692,19 @@ instance MonadAsync m => Monad (AsyncT m) where
692692 return = pure
693693 (>>=) = bindAsync
694694
695+{-# INLINE apAsync #-}
696+{-# SPECIALIZE apAsync :: AsyncT IO (a -> b) -> AsyncT IO a -> AsyncT IO b #-}
697+apAsync :: MonadAsync m => AsyncT m (a -> b) -> AsyncT m a -> AsyncT m b
698+apAsync mf m = ap (adapt mf) (adapt m)
699+
700+instance (Monad m, MonadAsync m) => Applicative (AsyncT m) where
701+ pure = AsyncT . K.yield
702+ (<*>) = apAsync
703+
695704------------------------------------------------------------------------------
696705-- Other instances
697706------------------------------------------------------------------------------
698707
699−-- XXX SPECIALIZE the applicative as well?
700−
701−MONAD_APPLICATIVE_INSTANCE(AsyncT,MONADPARALLEL)
702708MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL)
703709
704710------------------------------------------------------------------------------
@@ -821,11 +827,17 @@ instance MonadAsync m => Monad (WAsyncT m) where
821827 return = pure
822828 (>>=) = bindWAsync
823829
824−-- XXX SPECIALIZE the applicative as well?
830+{-# INLINE apWAsync #-}
831+{-# SPECIALIZE apWAsync :: WAsyncT IO (a -> b) -> WAsyncT IO a -> WAsyncT IO b #-}
832+apWAsync :: MonadAsync m => WAsyncT m (a -> b) -> WAsyncT m a -> WAsyncT m b
833+apWAsync mf m = ap (adapt mf) (adapt m)
834+
835+instance (Monad m, MonadAsync m) => Applicative (WAsyncT m) where
836+ pure = WAsyncT . K.yield
837+ (<*>) = apWAsync
825838
826839------------------------------------------------------------------------------
827840-- Other instances
828841------------------------------------------------------------------------------
829842
830−MONAD_APPLICATIVE_INSTANCE(WAsyncT,MONADPARALLEL)
831843MONAD_COMMON_INSTANCES(WAsyncT, MONADPARALLEL)
src/Streamly/Streams/Parallel.hs+2
@@ -380,6 +380,8 @@ instance MonadAsync m => Monad (ParallelT m) where
380380 return = pure
381381 (>>=) = bindParallel
382382
383+-- XXX Specialize the applicative instance
384+
383385------------------------------------------------------------------------------
384386-- Other instances
385387------------------------------------------------------------------------------