b4cef11 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add iterative benchmarks for Functor/transformers

b4cef11Harendra Kumar6 years ago

benchmark/Streamly/Benchmark/Prelude/Serial.hs+187−116

compare with master

unifiedsplit

@@ -25,7 +25,8 @@

25import Control.DeepSeq (NFData(..))

26import Control.Monad (when)

27import Control.Monad.IO.Class (MonadIO(..))

28−import Control.Monad.State.Strict (StateT, get, put)

28+import Control.Monad.State.Strict (StateT, get, put, MonadState)

29+import qualified Control.Monad.State.Strict as State

29import Data.Functor.Identity (Identity, runIdentity)

30import Data.Functor.Identity (Identity, runIdentity)

30import Data.IORef (newIORef, modifyIORef')

31import Data.IORef (newIORef, modifyIORef')

31import GHC.Generics (Generic)

32import GHC.Generics (Generic)

@@ -824,7 +825,6 @@ o_1_space_mapping value =

824

825

825 -- Mapping

826 -- Mapping

826 , benchIOSink value "map" (mapN serially 1)

827 , benchIOSink value "map" (mapN serially 1)

827− , benchIOSink value "fmap" (fmapN serially 1)

828 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->

829 sequence serially (sourceUnfoldrAction value n)

830 , benchIOSink value "mapM" (mapM serially 1)

@@ -844,7 +844,6 @@ o_1_space_mappingX4 :: Int -> [Benchmark]

844o_1_space_mappingX4 value =

845 [ bgroup "mappingX4"

846 [ benchIOSink value "map" (mapN serially 4)

847− , benchIOSink value "fmap" (fmapN serially 4)

848 , benchIOSink value "mapM" (mapM serially 4)

847 , benchIOSink value "mapM" (mapM serially 4)

849

848

850 , benchIOSink value "scan" (scan 4)

849 , benchIOSink value "scan" (scan 4)

@@ -853,6 +852,88 @@ o_1_space_mappingX4 value =

853 ]

852 ]

854 ]

853 ]

855

854

855+-------------------------------------------------------------------------------

856+-- Iteration/looping utilities

857+-------------------------------------------------------------------------------

858+

859+{-# INLINE iterateN #-}

860+iterateN :: (Int -> a -> a) -> a -> Int -> a

861+iterateN g initial count = f count initial

862+

863+ where

864+

865+ f (0 :: Int) x = x

866+ f i x = f (i - 1) (g i x)

867+

868+-- Iterate a transformation over a singleton stream

869+{-# INLINE iterateSingleton #-}

870+iterateSingleton :: S.MonadAsync m

871+ => (Int -> SerialT m Int -> SerialT m Int)

872+ -> Int

873+ -> Int

874+ -> SerialT m Int

875+iterateSingleton g count n = iterateN g (return n) count

876+

877+-- XXX need to check why this is slower than the explicit recursion above, even

878+-- if the above code is written in a foldr like head recursive way. We also

879+-- need to try this with foldlM' once #150 is fixed.

880+-- However, it is perhaps best to keep the iteration benchmarks independent of

881+-- foldrM and any related fusion issues.

882+{-# INLINE _iterateSingleton #-}

883+_iterateSingleton ::

884+ S.MonadAsync m

885+ => (Int -> SerialT m Int -> SerialT m Int)

886+ -> Int

887+ -> Int

888+ -> SerialT m Int

889+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n

890+

891+-- Apply transformation g count times on a stream of length len

892+{-# INLINE iterateSource #-}

893+iterateSource ::

894+ S.MonadAsync m

895+ => (SerialT m Int -> SerialT m Int)

896+ -> Int

897+ -> Int

898+ -> Int

899+ -> SerialT m Int

900+iterateSource g count len n = f count (sourceUnfoldrM len n)

901+

902+ where

903+

904+ f (0 :: Int) stream = stream

905+ f i stream = f (i - 1) (g stream)

906+

907+-------------------------------------------------------------------------------

908+-- Functor

909+-------------------------------------------------------------------------------

910+

911+o_1_space_functor :: Int -> [Benchmark]

912+o_1_space_functor value =

913+ [ bgroup "Functor"

914+ [ benchIOSink value "fmap" (fmapN serially 1)

915+ , benchIOSink value "fmap x 4" (fmapN serially 4)

916+ ]

917+ ]

918+

919+o_n_space_functor :: Int -> [Benchmark]

920+o_n_space_functor value =

921+ [ bgroup "Functor"

922+ [ benchIO "(+) (n times) (baseline)" $ \i0 ->

923+ iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value

924+ , benchIOSrc serially "(<$) (n times)" $

925+ iterateSingleton (<$) value

926+ , benchIOSrc serially "fmap (n times)" $

927+ iterateSingleton (P.fmap . (+)) value

928+ {-

929+ , benchIOSrc serially "_(<$) (n times)" $

930+ _iterateSingleton (<$) value

931+ , benchIOSrc serially "_fmap (n times)" $

932+ _iterateSingleton (P.fmap . (+)) value

933+ -}

934+ ]

935+ ]

936+

856-------------------------------------------------------------------------------

937-------------------------------------------------------------------------------

857-- Size reducing transformations (filtering)

938-- Size reducing transformations (filtering)

858-------------------------------------------------------------------------------

939-------------------------------------------------------------------------------

@@ -1202,61 +1283,41 @@ o_1_space_transformations_mixedX4 value =

1202-- Iterating a transformation over and over again

1283-- Iterating a transformation over and over again

1203-------------------------------------------------------------------------------

1284-------------------------------------------------------------------------------

1204

1285

1205−{-# INLINE iterStreamLen #-}

1206−iterStreamLen :: Int

1207−iterStreamLen = 10

1208−

1209−{-# INLINE maxIters #-}

1210−maxIters :: Int

1211−maxIters = 10000

1212−

1213−{-# INLINE iterateSource #-}

1214−iterateSource ::

1215− S.MonadAsync m

1216− => (SerialT m Int -> SerialT m Int)

1217− -> Int

1218− -> Int

1219− -> SerialT m Int

1220−iterateSource g i n = f i (sourceUnfoldrM iterStreamLen n)

1221− where

1222− f (0 :: Int) m = g m

1223− f x m = g (f (x P.- 1) m)

1224−

1225-- this is quadratic

1286-- this is quadratic

1226{-# INLINE iterateScan #-}

1287{-# INLINE iterateScan #-}

1227−iterateScan :: S.MonadAsync m => Int -> SerialT m Int

1288+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int

1228−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)

1289+iterateScan = iterateSource (S.scanl' (+) 0)

1229

1290

1230-- this is quadratic

1291-- this is quadratic

1231{-# INLINE iterateScanl1 #-}

1292{-# INLINE iterateScanl1 #-}

1232−iterateScanl1 :: S.MonadAsync m => Int -> SerialT m Int

1293+iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int

1233−iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)

1294+iterateScanl1 = iterateSource (S.scanl1' (+))

1234

1295

1235{-# INLINE iterateMapM #-}

1296{-# INLINE iterateMapM #-}

1236−iterateMapM :: S.MonadAsync m => Int -> SerialT m Int

1297+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int

1237−iterateMapM = iterateSource (S.mapM return) maxIters

1298+iterateMapM = iterateSource (S.mapM return)

1238

1299

1239{-# INLINE iterateFilterEven #-}

1300{-# INLINE iterateFilterEven #-}

1240−iterateFilterEven :: S.MonadAsync m => Int -> SerialT m Int

1301+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int

1241−iterateFilterEven = iterateSource (S.filter even) maxIters

1302+iterateFilterEven = iterateSource (S.filter even)

1242

1303

1243{-# INLINE iterateTakeAll #-}

1304{-# INLINE iterateTakeAll #-}

1244−iterateTakeAll :: S.MonadAsync m => Int -> Int -> SerialT m Int

1305+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int

1245−iterateTakeAll value = iterateSource (S.take (value + 1)) maxIters

1306+iterateTakeAll value = iterateSource (S.take (value + 1))

1246

1307

1247{-# INLINE iterateDropOne #-}

1308{-# INLINE iterateDropOne #-}

1248−iterateDropOne :: S.MonadAsync m => Int -> SerialT m Int

1309+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int

1249−iterateDropOne = iterateSource (S.drop 1) maxIters

1310+iterateDropOne = iterateSource (S.drop 1)

1250

1311

1251{-# INLINE iterateDropWhileFalse #-}

1312{-# INLINE iterateDropWhileFalse #-}

1252−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> SerialT m Int

1313+iterateDropWhileFalse :: S.MonadAsync m

1314+ => Int -> Int -> Int -> Int -> SerialT m Int

1253−iterateDropWhileFalse value =

1315+iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))

1254− iterateSource (S.dropWhile (> (value + 1))) maxIters

1255

1316

1256{-# INLINE iterateDropWhileTrue #-}

1317{-# INLINE iterateDropWhileTrue #-}

1257−iterateDropWhileTrue :: S.MonadAsync m => Int -> Int -> SerialT m Int

1318+iterateDropWhileTrue :: S.MonadAsync m

1319+ => Int -> Int -> Int -> Int -> SerialT m Int

1258−iterateDropWhileTrue value =

1320+iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))

1259− iterateSource (S.dropWhile (<= (value + 1))) maxIters

1260

1321

1261{-# INLINE tail #-}

1322{-# INLINE tail #-}

1262tail :: Monad m => SerialT m a -> m ()

1323tail :: Monad m => SerialT m a -> m ()

@@ -1272,23 +1333,31 @@ nullHeadTail s = do

1272

1333

1273-- Head recursive operations.

1334-- Head recursive operations.

1274o_n_stack_iterated :: Int -> [Benchmark]

1335o_n_stack_iterated :: Int -> [Benchmark]

1275−o_n_stack_iterated value =

1336+o_n_stack_iterated value = by10 `seq` by100 `seq`

1276 [ bgroup "iterated"

1337 [ bgroup "iterated"

1277− [ benchIOSrc serially "mapMx10K" iterateMapM

1338+ [ benchIOSrc serially "mapM (n/10 x 10)" $ iterateMapM by10 10

1278− , benchIOSrc serially "scanx100" iterateScan

1339+ , benchIOSrc serially "scanl' (quadratic) (n/100 x 100)" $

1340+ iterateScan by100 100

1279− , benchIOSrc serially "scanl1x100" iterateScanl1

1341+ , benchIOSrc serially "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10

1342+ , benchIOSrc serially "filterEven (n/10 x 10)" $

1280− , benchIOSrc serially "filterEvenx10K" iterateFilterEven

1343+ iterateFilterEven by10 10

1344+ , benchIOSrc serially "takeAll (n/10 x 10)" $

1281− , benchIOSrc serially "takeAllx10K" (iterateTakeAll value)

1345+ iterateTakeAll value by10 10

1282− , benchIOSrc serially "dropOnex10K" iterateDropOne

1346+ , benchIOSrc serially "dropOne (n/10 x 10)" $ iterateDropOne by10 10

1283− , benchIOSrc serially "dropWhileFalsex10K"

1347+ , benchIOSrc serially "dropWhileFalse (n/10 x 10)" $

1284− (iterateDropWhileFalse value)

1348+ iterateDropWhileFalse value by10 10

1285− , benchIOSrc serially "dropWhileTruex10K"

1349+ , benchIOSrc serially "dropWhileTrue (n/10 x 10)" $

1286− (iterateDropWhileTrue value)

1350+ iterateDropWhileTrue value by10 10

1287 , benchIOSink value "tail" tail

1351 , benchIOSink value "tail" tail

1288 , benchIOSink value "nullHeadTail" nullHeadTail

1352 , benchIOSink value "nullHeadTail" nullHeadTail

1289 ]

1353 ]

1290 ]

1354 ]

1291

1355

1356+ where

1357+

1358+ by10 = value `div` 10

1359+ by100 = value `div` 100

1360+

1292-------------------------------------------------------------------------------

1361-------------------------------------------------------------------------------

1293-- Pipes

1362-- Pipes

1294-------------------------------------------------------------------------------

1363-------------------------------------------------------------------------------

@@ -1546,49 +1615,17 @@ o_1_space_applicative value =

1546 ]

1615 ]

1547 ]

1616 ]

1548

1617

1549−{-# INLINE ap_ #-}

1550−ap_ :: Int -> Int -> IO ()

1551−ap_ value n =

1552− S.drain

1553− $ S.foldrM

1554− (\x xs -> pure x *> xs)

1555− (return () :: SerialT IO ())

1556− $ sourceUnfoldrMSerial value n

1557−

1558−{-# INLINE apRev_ #-}

1559−apRev_ :: Int -> Int -> IO ()

1560−apRev_ value n =

1561− S.drain

1562− $ S.foldrM

1563− (\x xs -> xs <* pure x)

1564− (return () :: SerialT IO ())

1565− $ sourceUnfoldrMSerial value n

1566−

1567−{-# INLINE liftA2 #-}

1568−liftA2 :: Int -> Int -> IO ()

1569−liftA2 value n =

1570− S.drain

1571− $ S.foldrM

1572− (\x xs -> AP.liftA2 (+) (pure x) xs)

1573− (S.yield 0 :: SerialT IO Int)

1574− $ sourceUnfoldrMSerial value n

1575−

1576−{-# INLINE ap #-}

1577−ap :: Int -> Int -> IO ()

1578−ap value n =

1579− S.drain

1580− $ S.foldrM

1581− (\x xs -> (P.fmap (+) (pure x) <*> xs))

1582− (S.yield 0 :: SerialT IO Int)

1583− $ sourceUnfoldrMSerial value n

1584−

1585o_n_space_applicative :: Int -> [Benchmark]

1618o_n_space_applicative :: Int -> [Benchmark]

1586o_n_space_applicative value =

1619o_n_space_applicative value =

1587− [ bgroup "applicative"

1620+ [ bgroup "Applicative"

1588− [ benchIO "(*>)" (ap_ value)

1621+ [ benchIOSrc serially "(*>) (n times)" $

1589− , benchIO "(<*)" (apRev_ value)

1622+ iterateSingleton ((*>) . pure) value

1590− , benchIO "(<*>)" (ap value)

1623+ , benchIOSrc serially "(<*) (n times)" $

1591− , benchIO "liftA2" (liftA2 value)

1624+ iterateSingleton (\x xs -> xs <* pure x) value

1625+ , benchIOSrc serially "(<*>) (n times)" $

1626+ iterateSingleton (\x xs -> (P.fmap (+) (pure x) <*> xs)) value

1627+ , benchIOSrc serially "liftA2 (n times)" $

1628+ iterateSingleton (\x xs -> AP.liftA2 (+) (pure x) xs) value

1592 ]

1629 ]

1593 ]

1630 ]

1594

1631

@@ -1598,7 +1635,7 @@ o_n_space_applicative value =

1598

1635

1599o_1_space_monad :: Int -> [Benchmark]

1636o_1_space_monad :: Int -> [Benchmark]

1600o_1_space_monad value =

1637o_1_space_monad value =

1601− [ bgroup "monad"

1638+ [ bgroup "Monad"

1602 [ benchIO "outer product (sqrt n x sqrt n)" $ toNullM value serially

1639 [ benchIO "outer product (sqrt n x sqrt n)" $ toNullM value serially

1603 , benchIO "outer product (sqrt n x sqrt n) (filterAllOut)" $

1640 , benchIO "outer product (sqrt n x sqrt n) (filterAllOut)" $

1604 filterAllOutM value serially

1641 filterAllOutM value serially

@@ -1613,30 +1650,13 @@ o_1_space_monad value =

1613 ]

1650 ]

1614 ]

1651 ]

1615

1652

1616−{-# INLINE bind_ #-}

1617−bind_ :: Int -> Int -> IO ()

1618−bind_ value n =

1619− S.drain

1620− $ S.foldrM

1621− (\x xs -> pure x >> xs)

1622− (return () :: SerialT IO ())

1623− $ sourceUnfoldrMSerial value n

1624−

1625−

1626−{-# INLINE bind #-}

1627−bind :: Int -> Int -> IO ()

1628−bind value n =

1629− S.drain

1630− $ S.foldrM

1631− (\x xs -> xs >>= \y -> return (x + y))

1632− (S.yield 0 :: SerialT IO Int)

1633− $ sourceUnfoldrMSerial value n

1634−

1635o_n_space_monad :: Int -> [Benchmark]

1653o_n_space_monad :: Int -> [Benchmark]

1636o_n_space_monad value =

1654o_n_space_monad value =

1637− [ bgroup "monad"

1655+ [ bgroup "Monad"

1638− [ benchIO "(>>)" (bind_ value)

1656+ [ benchIOSrc serially "(>>) (n times)" $

1639− , benchIO "(>>=)" (bind value)

1657+ iterateSingleton ((>>) . pure) value

1658+ , benchIOSrc serially "(>>=) (n times)" $

1659+ iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value

1640 , benchIO "outer product (sqrt n x sqrt n) (toList)" $

1660 , benchIO "outer product (sqrt n x sqrt n) (toList)" $

1641 toListM value serially

1661 toListM value serially

1642 , benchIO "outer product (sqrt n x sqrt n) (toListSome)" $

1662 , benchIO "outer product (sqrt n x sqrt n) (toListSome)" $

@@ -1678,6 +1698,54 @@ o_1_space_hoisting value =

1678 ]

1698 ]

1679 ]

1699 ]

1680

1700

1701+{-# INLINE iterateStateIO #-}

1702+iterateStateIO ::

1703+ (S.MonadAsync m)

1704+ => Int

1705+ -> StateT Int m Int

1706+iterateStateIO n = do

1707+ x <- get

1708+ if x > n

1709+ then do

1710+ put (x - 1)

1711+ iterateStateIO n

1712+ else return x

1713+

1714+{-# INLINE iterateStateT #-}

1715+iterateStateT :: Int -> SerialT (StateT Int IO) Int

1716+iterateStateT n = do

1717+ x <- get

1718+ if x > n

1719+ then do

1720+ put (x - 1)

1721+ iterateStateT n

1722+ else return x

1723+

1724+{-# INLINE iterateState #-}

1725+iterateState ::

1726+ (S.MonadAsync m, MonadState Int m)

1727+ => Int

1728+ -> SerialT m Int

1729+iterateState n = do

1730+ x <- get

1731+ if x > n

1732+ then do

1733+ put (x - 1)

1734+ iterateState n

1735+ else return x

1736+

1737+o_n_space_transformer :: Int -> [Benchmark]

1738+o_n_space_transformer value =

1739+ [ bgroup "transformer"

1740+ [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->

1741+ State.evalStateT (iterateStateIO n) value

1742+ , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->

1743+ State.evalStateT (S.drain (iterateStateT n)) value

1744+ , benchIO "MonadState Int m => SerialT m Int" $ \n ->

1745+ State.evalStateT (S.drain (iterateState n)) value

1746+ ]

1747+ ]

1748+

1681-------------------------------------------------------------------------------

1749-------------------------------------------------------------------------------

1682-- Main

1750-- Main

1683-------------------------------------------------------------------------------

1751-------------------------------------------------------------------------------

@@ -1703,6 +1771,7 @@ main = do

1703 , o_1_space_elimination_multi_stream size

1771 , o_1_space_elimination_multi_stream size

1704

1772

1705 -- transformation

1773 -- transformation

1774+ , o_1_space_functor size

1706 , o_1_space_mapping size

1775 , o_1_space_mapping size

1707 , o_1_space_mappingX4 size

1776 , o_1_space_mappingX4 size

1708 , o_1_space_filtering size

1777 , o_1_space_filtering size

@@ -1747,7 +1816,9 @@ main = do

1747 , o_n_space_grouping size

1816 , o_n_space_grouping size

1748

1817

1749 -- multi-stream

1818 -- multi-stream

1819+ , o_n_space_functor size

1750 , o_n_space_applicative size

1820 , o_n_space_applicative size

1751 , o_n_space_monad size

1821 , o_n_space_monad size

1822+ , o_n_space_transformer size

1752 ]

1823 ]

1753 ]

1824 ]

bin/bench-exec-one.sh+4−2

@@ -35,9 +35,11 @@ bench_rts_opts_specific () {

35 Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;

36 Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;

38+ Prelude.Serial/o-n-space/Functor/*) echo -n "-K4M -M256M" ;;

39+ Prelude.Serial/o-n-space/Applicative/*) echo -n "-K8M -M256M" ;;

40+ Prelude.Serial/o-n-space/Monad/*) echo -n "-K8M -M256M" ;;

41+ Prelude.Serial/o-n-space/transformer/*) echo -n "-K8M -M256M" ;;

38 Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;

42 Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;

39− Prelude.Serial/o-n-space/applicative/*) echo -n "-K8M -M256M" ;;

40− Prelude.Serial/o-n-space/monad/*) echo -n "-K8M -M64M" ;;

41 Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;

43 Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;

43 Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;

45 Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;

src/Streamly/Internal/Prelude.hs+8

@@ -2119,6 +2119,10 @@ scanx :: (IsStream t, Monad m) => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m

2119scanx = P.scanlx'

2120

2121-- XXX this needs to be concurrent

2122+-- XXX because of the use of D.cons for appending, scanlM' has quadratic

2123+-- complexity when iterated over a stream. We should use StreamK style scanlM'

2124+-- for linear performance on iteration.

2125+--

2122-- | Like 'scanl'' but with a monadic fold function.

2126-- | Like 'scanl'' but with a monadic fold function.

2123--

2127--

2124-- @since 0.4.0

2128-- @since 0.4.0

@@ -2143,6 +2147,10 @@ scanlMAfter' :: (IsStream t, Monad m)

2143scanlMAfter' step initial done stream =

2147scanlMAfter' step initial done stream =

2144 fromStreamD $ D.scanlMAfter' step initial done $ toStreamD stream

2148 fromStreamD $ D.scanlMAfter' step initial done $ toStreamD stream

2145

2149

2150+-- XXX because of the use of D.cons for appending, scanl' has quadratic

2151+-- complexity when iterated over a stream. We should use StreamK style scanlM'

2152+-- for linear performance on iteration.

2153+

2146-- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,

2154-- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,

2147-- however it adds an extra element.

2155-- however it adds an extra element.

2148--

2156--