git.iko.soy/streamly
on master help sign in
Add more benchmarks for applicative/monad
1a331cbHarendra Kumar
benchmark/Streamly/Benchmark/Prelude/Serial.hs+105−17
compare with master
unifiedsplit
@@ -34,6 +34,7 @@ import Prelude hiding (concatMap, mapM_, init, last, elem, notElem, all, any,
34 and, or, length, sum, product, maximum, minimum, reverse, fmap, map,
34 and, or, length, sum, product, maximum, minimum, reverse, fmap, map,
35 sequence, mapM, tail)
35 sequence, mapM, tail)
36
36
37+import qualified Control.Applicative as AP
37import qualified Prelude as P
38import qualified Prelude as P
38import qualified Data.Foldable as F
39import qualified Data.Foldable as F
39import qualified GHC.Exts as GHC
40import qualified GHC.Exts as GHC
@@ -1534,28 +1535,112 @@ o_1_space_concat value = sqrtVal `seq`
1534
1535
1535 sqrtVal = round $ sqrt (fromIntegral value :: Double)
1536 sqrtVal = round $ sqrt (fromIntegral value :: Double)
1536
1537
1538+-------------------------------------------------------------------------------
1539+-- Applicative
1540+-------------------------------------------------------------------------------
1541+
1542+o_1_space_applicative :: Int -> [Benchmark]
1543+o_1_space_applicative value =
1544+ [ bgroup "applicative"
1545+ [ benchIO "outer product (sqrt n x sqrt n)" $ toNullAp value serially
1546+ ]
1547+ ]
1548+
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+
1585+o_n_space_applicative :: Int -> [Benchmark]
1586+o_n_space_applicative value =
1587+ [ bgroup "applicative"
1588+ [ benchIO "(*>)" (ap_ value)
1589+ , benchIO "(<*)" (apRev_ value)
1590+ , benchIO "(<*>)" (ap value)
1591+ , benchIO "liftA2" (liftA2 value)
1592+ ]
1593+ ]
1594+
1537-------------------------------------------------------------------------------
1595-------------------------------------------------------------------------------
1538-- Monad
1596-- Monad
1539-------------------------------------------------------------------------------
1597-------------------------------------------------------------------------------
1540
1598
1541−o_1_space_outerProduct :: Int -> [Benchmark]
1599+o_1_space_monad :: Int -> [Benchmark]
1542−o_1_space_outerProduct value =
1600+o_1_space_monad value =
1543− [ bgroup "monad-outer-product"
1601+ [ bgroup "monad"
1544− [ benchIO "toNullAp" $ toNullAp value serially
1545− , benchIO "toNull" $ toNullM value serially
1602+ [ benchIO "outer product (sqrt n x sqrt n)" $ toNullM value serially
1546− , benchIO "toNull3" $ toNullM3 value serially
1603+ , benchIO "outer product (sqrt n x sqrt n) (filterAllOut)" $
1547− , benchIO "filterAllOut" $ filterAllOutM value serially
1604+ filterAllOutM value serially
1605+ , benchIO "outer product (sqrt n x sqrt n) (filterAllIn)" $
1548− , benchIO "filterAllIn" $ filterAllInM value serially
1606+ filterAllInM value serially
1607+ , benchIO "outer product (sqrt n x sqrt n) (filterSome)" $
1549− , benchIO "filterSome" $ filterSome value serially
1608+ filterSome value serially
1550− , benchIO "breakAfterSome" $ breakAfterSome value serially
1609+ , benchIO "outer product (sqrt n x sqrt n) (breakAfterSome)" $
1610+ breakAfterSome value serially
1611+ , benchIO "outer product (cubert n x cubert n x cubert n)" $
1612+ toNullM3 value serially
1551 ]
1613 ]
1552 ]
1614 ]
1553
1615
1554−o_n_space_outerProduct :: Int -> [Benchmark]
1616+{-# INLINE bind_ #-}
1555−o_n_space_outerProduct value =
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+
1635+o_n_space_monad :: Int -> [Benchmark]
1636+o_n_space_monad value =
1556− [ bgroup "monad-outer-product"
1637+ [ bgroup "monad"
1638+ [ benchIO "(>>)" (bind_ value)
1639+ , benchIO "(>>=)" (bind value)
1640+ , benchIO "outer product (sqrt n x sqrt n) (toList)" $
1557− [ benchIO "toList" $ toListM value serially
1641+ toListM value serially
1642+ , benchIO "outer product (sqrt n x sqrt n) (toListSome)" $
1558− , benchIO "toListSome" $ toListSome value serially
1643+ toListSome value serially
1559 ]
1644 ]
1560 ]
1645 ]
1561
1646
@@ -1635,7 +1720,9 @@ main = do
1635 , o_1_space_joining size
1720 , o_1_space_joining size
1636 , o_1_space_concatFoldable size
1721 , o_1_space_concatFoldable size
1637 , o_1_space_concat size
1722 , o_1_space_concat size
1638− , o_1_space_outerProduct size
1723+
1724+ , o_1_space_applicative size
1725+ , o_1_space_monad size
1639
1726
1640 -- Monad transformation
1727 -- Monad transformation
1641 , o_1_space_hoisting size
1728 , o_1_space_hoisting size
@@ -1660,6 +1747,7 @@ main = do
1660 , o_n_space_grouping size
1747 , o_n_space_grouping size
1661
1748
1662 -- multi-stream
1749 -- multi-stream
1663− , o_n_space_outerProduct size
1750+ , o_n_space_applicative size
1751+ , o_n_space_monad size
1664 ]
1752 ]
1665 ]
1753 ]
benchmark/lib/Streamly/Benchmark/Prelude.hs+10
@@ -23,6 +23,7 @@ import qualified Streamly as S
23import qualified Streamly.Prelude as S
23import qualified Streamly.Prelude as S
24import qualified Streamly.Internal.Prelude as Internal
24import qualified Streamly.Internal.Prelude as Internal
25import qualified Streamly.Internal.Data.Pipe as Pipe
25import qualified Streamly.Internal.Data.Pipe as Pipe
26+import qualified Streamly.Internal.Data.Stream.Serial as Serial
26
27
27import Gauge
28import Gauge
28import Streamly.Internal.Data.Time.Units
29import Streamly.Internal.Data.Time.Units
@@ -82,6 +83,15 @@ sourceUnfoldrM count start = S.unfoldrM step start
82 then return Nothing
83 then return Nothing
83 else return (Just (cnt, cnt + 1))
84 else return (Just (cnt, cnt + 1))
84
85
86+{-# INLINE sourceUnfoldrMSerial #-}
87+sourceUnfoldrMSerial :: (S.IsStream t, Monad m) => Int -> Int -> t m Int
88+sourceUnfoldrMSerial count start = Serial.unfoldrM step start
89+ where
90+ step cnt =
91+ if cnt > start + count
92+ then return Nothing
93+ else return (Just (cnt, cnt + 1))
94+
85-------------------------------------------------------------------------------
95-------------------------------------------------------------------------------
86-- fromIndices
96-- fromIndices
87-------------------------------------------------------------------------------
97-------------------------------------------------------------------------------
bin/bench-exec-one.sh+4−1
@@ -32,11 +32,14 @@ bench_rts_opts_default () {
32bench_rts_opts_specific () {
32bench_rts_opts_specific () {
33 case "$1" in
33 case "$1" in
34 Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;
34 Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;
35− #Prelude.Parallel/o-n-heap/monad-outer-product/toList) echo -n "-K-M256M" ;;
36 Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;
35 Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;
37 Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;
36 Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;
37+
38 Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;
38 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" ;;
39 Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;
41 Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;
42+
40 Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;
43 Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;
41
44
42 Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
45 Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;