mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Add more benchmarks for applicative/monad
Separate the applicative and monad benchmark groups Complete benchmarks for all type class operations
This commit is contained in:
parent
1cccb00101
commit
1a331cb402
@ -34,6 +34,7 @@ import Prelude hiding (concatMap, mapM_, init, last, elem, notElem, all, any,
|
||||
and, or, length, sum, product, maximum, minimum, reverse, fmap, map,
|
||||
sequence, mapM, tail)
|
||||
|
||||
import qualified Control.Applicative as AP
|
||||
import qualified Prelude as P
|
||||
import qualified Data.Foldable as F
|
||||
import qualified GHC.Exts as GHC
|
||||
@ -1535,27 +1536,111 @@ o_1_space_concat value = sqrtVal `seq`
|
||||
sqrtVal = round $ sqrt (fromIntegral value :: Double)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Monad
|
||||
-- Applicative
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
o_1_space_outerProduct :: Int -> [Benchmark]
|
||||
o_1_space_outerProduct value =
|
||||
[ bgroup "monad-outer-product"
|
||||
[ benchIO "toNullAp" $ toNullAp value serially
|
||||
, benchIO "toNull" $ toNullM value serially
|
||||
, benchIO "toNull3" $ toNullM3 value serially
|
||||
, benchIO "filterAllOut" $ filterAllOutM value serially
|
||||
, benchIO "filterAllIn" $ filterAllInM value serially
|
||||
, benchIO "filterSome" $ filterSome value serially
|
||||
, benchIO "breakAfterSome" $ breakAfterSome value serially
|
||||
o_1_space_applicative :: Int -> [Benchmark]
|
||||
o_1_space_applicative value =
|
||||
[ bgroup "applicative"
|
||||
[ benchIO "outer product (sqrt n x sqrt n)" $ toNullAp value serially
|
||||
]
|
||||
]
|
||||
|
||||
o_n_space_outerProduct :: Int -> [Benchmark]
|
||||
o_n_space_outerProduct value =
|
||||
[ bgroup "monad-outer-product"
|
||||
[ benchIO "toList" $ toListM value serially
|
||||
, benchIO "toListSome" $ toListSome value serially
|
||||
{-# INLINE ap_ #-}
|
||||
ap_ :: Int -> Int -> IO ()
|
||||
ap_ value n =
|
||||
S.drain
|
||||
$ S.foldrM
|
||||
(\x xs -> pure x *> xs)
|
||||
(return () :: SerialT IO ())
|
||||
$ sourceUnfoldrMSerial value n
|
||||
|
||||
{-# INLINE apRev_ #-}
|
||||
apRev_ :: Int -> Int -> IO ()
|
||||
apRev_ value n =
|
||||
S.drain
|
||||
$ S.foldrM
|
||||
(\x xs -> xs <* pure x)
|
||||
(return () :: SerialT IO ())
|
||||
$ sourceUnfoldrMSerial value n
|
||||
|
||||
{-# INLINE liftA2 #-}
|
||||
liftA2 :: Int -> Int -> IO ()
|
||||
liftA2 value n =
|
||||
S.drain
|
||||
$ S.foldrM
|
||||
(\x xs -> AP.liftA2 (+) (pure x) xs)
|
||||
(S.yield 0 :: SerialT IO Int)
|
||||
$ sourceUnfoldrMSerial value n
|
||||
|
||||
{-# INLINE ap #-}
|
||||
ap :: Int -> Int -> IO ()
|
||||
ap value n =
|
||||
S.drain
|
||||
$ S.foldrM
|
||||
(\x xs -> (P.fmap (+) (pure x) <*> xs))
|
||||
(S.yield 0 :: SerialT IO Int)
|
||||
$ sourceUnfoldrMSerial value n
|
||||
|
||||
o_n_space_applicative :: Int -> [Benchmark]
|
||||
o_n_space_applicative value =
|
||||
[ bgroup "applicative"
|
||||
[ benchIO "(*>)" (ap_ value)
|
||||
, benchIO "(<*)" (apRev_ value)
|
||||
, benchIO "(<*>)" (ap value)
|
||||
, benchIO "liftA2" (liftA2 value)
|
||||
]
|
||||
]
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Monad
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
o_1_space_monad :: Int -> [Benchmark]
|
||||
o_1_space_monad value =
|
||||
[ bgroup "monad"
|
||||
[ benchIO "outer product (sqrt n x sqrt n)" $ toNullM value serially
|
||||
, benchIO "outer product (sqrt n x sqrt n) (filterAllOut)" $
|
||||
filterAllOutM value serially
|
||||
, benchIO "outer product (sqrt n x sqrt n) (filterAllIn)" $
|
||||
filterAllInM value serially
|
||||
, benchIO "outer product (sqrt n x sqrt n) (filterSome)" $
|
||||
filterSome value serially
|
||||
, benchIO "outer product (sqrt n x sqrt n) (breakAfterSome)" $
|
||||
breakAfterSome value serially
|
||||
, benchIO "outer product (cubert n x cubert n x cubert n)" $
|
||||
toNullM3 value serially
|
||||
]
|
||||
]
|
||||
|
||||
{-# INLINE bind_ #-}
|
||||
bind_ :: Int -> Int -> IO ()
|
||||
bind_ value n =
|
||||
S.drain
|
||||
$ S.foldrM
|
||||
(\x xs -> pure x >> xs)
|
||||
(return () :: SerialT IO ())
|
||||
$ sourceUnfoldrMSerial value n
|
||||
|
||||
|
||||
{-# INLINE bind #-}
|
||||
bind :: Int -> Int -> IO ()
|
||||
bind value n =
|
||||
S.drain
|
||||
$ S.foldrM
|
||||
(\x xs -> xs >>= \y -> return (x + y))
|
||||
(S.yield 0 :: SerialT IO Int)
|
||||
$ sourceUnfoldrMSerial value n
|
||||
|
||||
o_n_space_monad :: Int -> [Benchmark]
|
||||
o_n_space_monad value =
|
||||
[ bgroup "monad"
|
||||
[ benchIO "(>>)" (bind_ value)
|
||||
, benchIO "(>>=)" (bind value)
|
||||
, benchIO "outer product (sqrt n x sqrt n) (toList)" $
|
||||
toListM value serially
|
||||
, benchIO "outer product (sqrt n x sqrt n) (toListSome)" $
|
||||
toListSome value serially
|
||||
]
|
||||
]
|
||||
|
||||
@ -1635,7 +1720,9 @@ main = do
|
||||
, o_1_space_joining size
|
||||
, o_1_space_concatFoldable size
|
||||
, o_1_space_concat size
|
||||
, o_1_space_outerProduct size
|
||||
|
||||
, o_1_space_applicative size
|
||||
, o_1_space_monad size
|
||||
|
||||
-- Monad transformation
|
||||
, o_1_space_hoisting size
|
||||
@ -1660,6 +1747,7 @@ main = do
|
||||
, o_n_space_grouping size
|
||||
|
||||
-- multi-stream
|
||||
, o_n_space_outerProduct size
|
||||
, o_n_space_applicative size
|
||||
, o_n_space_monad size
|
||||
]
|
||||
]
|
||||
|
@ -23,6 +23,7 @@ import qualified Streamly as S
|
||||
import qualified Streamly.Prelude as S
|
||||
import qualified Streamly.Internal.Prelude as Internal
|
||||
import qualified Streamly.Internal.Data.Pipe as Pipe
|
||||
import qualified Streamly.Internal.Data.Stream.Serial as Serial
|
||||
|
||||
import Gauge
|
||||
import Streamly.Internal.Data.Time.Units
|
||||
@ -82,6 +83,15 @@ sourceUnfoldrM count start = S.unfoldrM step start
|
||||
then return Nothing
|
||||
else return (Just (cnt, cnt + 1))
|
||||
|
||||
{-# INLINE sourceUnfoldrMSerial #-}
|
||||
sourceUnfoldrMSerial :: (S.IsStream t, Monad m) => Int -> Int -> t m Int
|
||||
sourceUnfoldrMSerial count start = Serial.unfoldrM step start
|
||||
where
|
||||
step cnt =
|
||||
if cnt > start + count
|
||||
then return Nothing
|
||||
else return (Just (cnt, cnt + 1))
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- fromIndices
|
||||
-------------------------------------------------------------------------------
|
||||
|
@ -32,11 +32,14 @@ bench_rts_opts_default () {
|
||||
bench_rts_opts_specific () {
|
||||
case "$1" in
|
||||
Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;
|
||||
#Prelude.Parallel/o-n-heap/monad-outer-product/toList) echo -n "-K-M256M" ;;
|
||||
Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;
|
||||
Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;
|
||||
|
||||
Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;
|
||||
Prelude.Serial/o-n-space/applicative/*) echo -n "-K8M -M256M" ;;
|
||||
Prelude.Serial/o-n-space/monad/*) echo -n "-K8M -M64M" ;;
|
||||
Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;
|
||||
|
||||
Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;
|
||||
|
||||
Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
|
||||
|
Loading…
Reference in New Issue
Block a user