@@ -34,9 +34,10 @@ import Data.Functor.Identity (Identity, runIdentity)
3434import Data.IORef (newIORef, modifyIORef')
3535import GHC.Generics (Generic)
3636import System.Random (randomRIO)
37−import Prelude hiding (concatMap, mapM_, init, last, elem, notElem, all, any,
38− and, or, length, sum, product, maximum, minimum, reverse, fmap, map,
39− sequence, mapM, tail)
37+import Prelude hiding
38+ ( concatMap, mapM_, init, last, elem, notElem, all, any
39+ , and, or, length, sum, product, maximum, minimum, reverse, fmap, map
40+ , sequence, mapM, tail, repeat, replicate, iterate, (!!), lookup)
4041
4142import qualified Control.Applicative as AP
4243import qualified Prelude as P
@@ -50,14 +51,13 @@ import Test.Inspection
5051import qualified Streamly.Internal.Data.Stream.StreamD as D
5152#endif
5253
53−
5454import qualified Streamly.Prelude as S
5555import qualified Streamly.Internal.Data.Stream.IsStream as Internal
5656import qualified Streamly.Internal.Data.Fold as FL
5757import qualified Streamly.Internal.Data.Unfold as UF
5858
5959import Gauge
60−import Streamly.Prelude (SerialT, IsStream, serially, serial)
60+import Streamly.Prelude (SerialT, IsStream, serially, serial, MonadAsync)
6161import Streamly.Benchmark.Common
6262import Streamly.Benchmark.Prelude
6363import Streamly.Internal.Data.Time.Units
@@ -98,11 +98,70 @@ readInstanceList str =
9898 [(x,"")] -> x
9999 _ -> P.error "readInstance: no parse"
100100
101+{-# INLINE repeat #-}
102+repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
103+repeat count = S.take count . S.repeat
104+
105+{-# INLINE repeatM #-}
106+repeatM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
107+repeatM count = S.take count . S.repeatM . return
108+
109+{-# INLINE replicate #-}
110+replicate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
111+replicate count = S.replicate count
112+
113+{-# INLINE replicateM #-}
114+replicateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
115+replicateM count = S.replicateM count . return
116+
117+{-# INLINE enumerateFrom #-}
118+enumerateFrom :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
119+enumerateFrom count = S.take count . S.enumerateFrom
120+
121+{-# INLINE enumerateFromTo #-}
122+enumerateFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
123+enumerateFromTo = sourceIntFromTo
124+
125+{-# INLINE enumerateFromThen #-}
126+enumerateFromThen :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
127+enumerateFromThen count inp = S.take count $ S.enumerateFromThen inp (inp + 1)
128+
129+{-# INLINE enumerateFromThenTo #-}
130+enumerateFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
131+enumerateFromThenTo = sourceIntFromThenTo
132+
133+-- XXX enumerate?
134+-- XXX enumerateTo?
135+
136+{-# INLINE iterate #-}
137+iterate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
138+iterate count = S.take count . S.iterate (+1)
139+
140+{-# INLINE iterateM #-}
141+iterateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
142+iterateM count = S.take count . S.iterateM (return . (+1)) . return
143+
144+{-# INLINE fromIndices #-}
145+fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
146+fromIndices value n = S.take value $ S.fromIndices (+ n)
147+
148+{-# INLINE fromIndicesM #-}
149+fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
150+fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
151+
101152o_1_space_generation :: Int -> [Benchmark]
102153o_1_space_generation value =
103154 [ bgroup "generation"
104155 [ benchIOSrc serially "unfoldr" (sourceUnfoldr value)
105156 , benchIOSrc serially "unfoldrM" (sourceUnfoldrM value)
157+ , benchIOSrc serially "repeat" (repeat value)
158+ , benchIOSrc serially "repeatM" (repeatM value)
159+ , benchIOSrc serially "replicate" (replicate value)
160+ , benchIOSrc serially "replicateM" (replicateM value)
161+ , benchIOSrc serially "iterate" (iterate value)
162+ , benchIOSrc serially "iterateM" (iterateM value)
163+ , benchIOSrc serially "fromIndices" (fromIndices value)
164+ , benchIOSrc serially "fromIndicesM" (fromIndicesM value)
106165 , benchIOSrc serially "intFromTo" (sourceIntFromTo value)
107166 , benchIOSrc serially "intFromThenTo" (sourceIntFromThenTo value)
108167 , benchIOSrc serially "integerFromStep" (sourceIntegerFromStep value)
@@ -459,6 +518,26 @@ minimumBy = S.minimumBy compare
459518maximumBy :: Monad m => SerialT m Int -> m (Maybe Int)
460519maximumBy = S.maximumBy compare
461520
521+{-# INLINE the #-}
522+the :: Monad m => SerialT m Int -> m (Maybe Int)
523+the = S.the
524+
525+{-# INLINE drainN #-}
526+drainN :: Monad m => Int -> SerialT m Int -> m ()
527+drainN val = S.drainN val
528+
529+{-# INLINE drainWhile #-}
530+drainWhile :: Monad m => SerialT m Int -> m ()
531+drainWhile = S.drainWhile (const True)
532+
533+{-# INLINE (!!) #-}
534+(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
535+(!!) val = flip (Internal.!!) val
536+
537+{-# INLINE lookup #-}
538+lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
539+lookup val = S.lookup val . S.map (\x -> (x, x))
540+
462541o_1_space_elimination_folds :: Int -> [Benchmark]
463542o_1_space_elimination_folds value =
464543 [ bgroup "elimination"
@@ -496,6 +575,8 @@ o_1_space_elimination_folds value =
496575
497576 -- draining
498577 , benchIOSink value "drain" $ toNull serially
578+ , benchIOSink value "drainN" $ drainN value
579+ , benchIOSink value "drainWhile" $ drainWhile
499580 , benchPureSink value "drain (pure)" P.id
500581 , benchIOSink value "mapM_" mapM_
501582
@@ -512,8 +593,11 @@ o_1_space_elimination_folds value =
512593 , benchIOSink value "minimumBy" minimumBy
513594 , benchIOSink value "minimum" minimum
514595
596+ , bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value
515597 , benchIOSink value "find" (find value)
516− -- , benchIOSink value "lookup" lookup
598+ -- , benchIOSink value "lookupFirst" (lookup 1)
599+ , benchIOSink value "lookupNever" (lookup (value + 1))
600+ , benchIOSink value "(!!)" ((!!) value)
517601 , benchIOSink value "findIndex" (findIndex value)
518602 , benchIOSink value "elemIndex" (elemIndex value)
519603 -- this is too fast, causes all benchmarks reported in ns
@@ -764,10 +848,22 @@ o_n_space_traversable value =
764848scan :: MonadIO m => Int -> SerialT m Int -> m ()
765849scan n = composeN n $ S.scanl' (+) 0
766850
851+{-# INLINE scanlM' #-}
852+scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
853+scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) 0
854+
767855{-# INLINE scanl1' #-}
768856scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
769857scanl1' n = composeN n $ S.scanl1' (+)
770858
859+{-# INLINE postscanl' #-}
860+postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
861+postscanl' n = composeN n $ S.postscanl' (+) 0
862+
863+{-# INLINE postscanlM' #-}
864+postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
865+postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) 0
866+
771867{-# INLINE sequence #-}
772868sequence ::
773869 (S.IsStream t, S.MonadAsync m)
@@ -815,6 +911,11 @@ foldrT n = composeN n $ Internal.foldrT S.cons S.nil
815911foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
816912foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
817913
914+
915+{-# INLINE trace #-}
916+trace :: MonadAsync m => Int -> SerialT m Int -> m ()
917+trace n = composeN n $ Internal.trace return
918+
818919o_1_space_mapping :: Int -> [Benchmark]
819920o_1_space_mapping value =
820921 [ bgroup
@@ -839,6 +940,9 @@ o_1_space_mapping value =
839940 -- Scanning
840941 , benchIOSink value "scanl'" (scan 1)
841942 , benchIOSink value "scanl1'" (scanl1' 1)
943+ , benchIOSink value "scanlM'" (scanlM' 1)
944+ , benchIOSink value "postscanl'" (postscanl' 1)
945+ , benchIOSink value "postscanlM'" (postscanlM' 1)
842946
843947 ]
844948 ]
@@ -848,9 +952,13 @@ o_1_space_mappingX4 value =
848952 [ bgroup "mappingX4"
849953 [ benchIOSink value "map" (mapN serially 4)
850954 , benchIOSink value "mapM" (mapM serially 4)
955+ , benchIOSink value "trace" (trace 4)
851956
852957 , benchIOSink value "scan" (scan 4)
853958 , benchIOSink value "scanl1'" (scanl1' 4)
959+ , benchIOSink value "scanlM'" (scanlM' 4)
960+ , benchIOSink value "postscanl'" (postscanl' 4)
961+ , benchIOSink value "postscanlM'" (postscanlM' 4)
854962
855963 ]
856964 ]
@@ -972,6 +1080,18 @@ filterAllOut value n = composeN n $ S.filter (> (value + 1))
9721080filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
9731081filterAllIn value n = composeN n $ S.filter (<= (value + 1))
9741082
1083+{-# INLINE filterMEven #-}
1084+filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
1085+filterMEven n = composeN n $ S.filterM (return . even)
1086+
1087+{-# INLINE filterMAllOut #-}
1088+filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1089+filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
1090+
1091+{-# INLINE filterMAllIn #-}
1092+filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1093+filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
1094+
9751095{-# INLINE _takeOne #-}
9761096_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
9771097_takeOne n = composeN n $ S.take 1
@@ -984,9 +1104,9 @@ takeAll value n = composeN n $ S.take (value + 1)
9841104takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
9851105takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
9861106
987−{-# INLINE _takeWhileMTrue #-}
988−_takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
989−_takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
1107+{-# INLINE takeWhileMTrue #-}
1108+takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1109+takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
9901110
9911111{-# INLINE takeByTime #-}
9921112takeByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
@@ -1010,14 +1130,23 @@ dropAll value n = composeN n $ S.drop (value + 1)
10101130dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
10111131dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
10121132
1013−{-# INLINE _dropWhileMTrue #-}
1014−_dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1015−_dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
1133+{-# INLINE dropWhileMTrue #-}
1134+dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1135+dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
10161136
10171137{-# INLINE dropWhileFalse #-}
10181138dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
10191139dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
10201140
1141+-- XXX Decide on the time interval
1142+{-# INLINE _intervalsOfSum #-}
1143+_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
1144+_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
1145+
1146+-- S.groups
1147+-- S.groupsBy
1148+-- S.groupsByRolling
1149+
10211150{-# INLINE dropByTime #-}
10221151dropByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
10231152dropByTime i n = composeN n (Internal.dropByTime i)
@@ -1039,6 +1168,11 @@ elemIndices value n = composeN n $ S.elemIndices (value + 1)
10391168deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
10401169deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
10411170
1171+-- uniq . uniq == uniq, composeN 2 ~ composeN 1
1172+{-# INLINE uniq #-}
1173+uniq :: MonadIO m => Int -> SerialT m Int -> m ()
1174+uniq n = composeN n S.uniq
1175+
10421176{-# INLINE mapMaybe #-}
10431177mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
10441178mapMaybe n =
@@ -1066,6 +1200,10 @@ o_1_space_filtering value =
10661200 , benchIOSink value "filter-all-out" (filterAllOut value 1)
10671201 , benchIOSink value "filter-all-in" (filterAllIn value 1)
10681202
1203+ , benchIOSink value "filterM-even" (filterMEven 1)
1204+ , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
1205+ , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
1206+
10691207 -- Trimming
10701208 , benchIOSink value "take-all" (takeAll value 1)
10711209 , benchIOSink
@@ -1088,6 +1226,8 @@ o_1_space_filtering value =
10881226 (dropWhileFalse value 1)
10891227 , benchIOSink value "deleteBy" (deleteBy value 1)
10901228
1229+ , benchIOSink value "uniq" (uniq 1)
1230+
10911231 -- Map and filter
10921232 , benchIOSink value "mapMaybe" (mapMaybe 1)
10931233 , benchIOSink value "mapMaybeM" (mapMaybeM 1)
@@ -1105,20 +1245,26 @@ o_1_space_filteringX4 value =
11051245 , benchIOSink value "filter-all-out" (filterAllOut value 4)
11061246 , benchIOSink value "filter-all-in" (filterAllIn value 4)
11071247
1248+ , benchIOSink value "filterM-even" (filterMEven 4)
1249+ , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
1250+ , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
1251+
11081252 -- trimming
11091253 , benchIOSink value "take-all" (takeAll value 4)
11101254 , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
1111− -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 4)
1255+ , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)
11121256 , benchIOSink value "drop-one" (dropOne 4)
11131257 , benchIOSink value "drop-all" (dropAll value 4)
11141258 , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
1115− -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 4)
1259+ , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)
11161260 , benchIOSink
11171261 value
11181262 "dropWhile-false"
11191263 (dropWhileFalse value 4)
11201264 , benchIOSink value "deleteBy" (deleteBy value 4)
11211265
1266+ , benchIOSink value "uniq" (uniq 4)
1267+
11221268 -- map and filter
11231269 , benchIOSink value "mapMaybe" (mapMaybe 4)
11241270 , benchIOSink value "mapMaybeM" (mapMaybeM 4)
@@ -1137,6 +1283,10 @@ o_1_space_filteringX4 value =
11371283intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
11381284intersperse value n = composeN n $ S.intersperse (value + 1)
11391285
1286+{-# INLINE intersperseM #-}
1287+intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
1288+intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
1289+
11401290{-# INLINE insertBy #-}
11411291insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
11421292insertBy value n = composeN n $ S.insertBy compare (value + 1)
@@ -1145,6 +1295,7 @@ o_1_space_inserting :: Int -> [Benchmark]
11451295o_1_space_inserting value =
11461296 [ bgroup "filtering"
11471297 [ benchIOSink value "intersperse" (intersperse value 1)
1298+ , benchIOSink value "intersperseM" (intersperseM value 1)
11481299 , benchIOSink value "insertBy" (insertBy value 1)
11491300 ]
11501301 ]
@@ -1157,6 +1308,34 @@ o_1_space_insertingX4 value =
11571308 ]
11581309 ]
11591310
1311+-------------------------------------------------------------------------------
1312+-- Indexing
1313+-------------------------------------------------------------------------------
1314+
1315+{-# INLINE indexed #-}
1316+indexed :: MonadIO m => Int -> SerialT m Int -> m ()
1317+indexed n = composeN n (S.map snd . S.indexed)
1318+
1319+{-# INLINE indexedR #-}
1320+indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
1321+indexedR value n = composeN n (S.map snd . S.indexedR value)
1322+
1323+o_1_space_indexing :: Int -> [Benchmark]
1324+o_1_space_indexing value =
1325+ [ bgroup "indexing"
1326+ [ benchIOSink value "indexed" (indexed 1)
1327+ , benchIOSink value "indexedR" (indexedR value 1)
1328+ ]
1329+ ]
1330+
1331+o_1_space_indexingX4 :: Int -> [Benchmark]
1332+o_1_space_indexingX4 value =
1333+ [ bgroup "indexingx4"
1334+ [ benchIOSink value "indexed" (indexed 4)
1335+ , benchIOSink value "indexedR" (indexedR value 4)
1336+ ]
1337+ ]
1338+
11601339-------------------------------------------------------------------------------
11611340-- Reordering
11621341-------------------------------------------------------------------------------
@@ -1465,10 +1644,23 @@ mergeBy count n =
14651644 (sourceUnfoldrM count n)
14661645 (sourceUnfoldrM count (n + 1))
14671646
1647+{-# INLINE mergeByM #-}
1648+mergeByM :: Int -> Int -> IO ()
1649+mergeByM count n =
1650+ S.drain $
1651+ S.mergeByM
1652+ (\a b -> return $ P.compare a b)
1653+ (sourceUnfoldrM count n)
1654+ (sourceUnfoldrM count (n + 1))
1655+
14681656#ifdef INSPECTION
14691657inspect $ hasNoTypeClasses 'mergeBy
14701658inspect $ 'mergeBy `hasNoType` ''SPEC
14711659inspect $ 'mergeBy `hasNoType` ''D.Step
1660+
1661+inspect $ hasNoTypeClasses 'mergeByM
1662+inspect $ 'mergeByM `hasNoType` ''SPEC
1663+inspect $ 'mergeByM `hasNoType` ''D.Step
14721664#endif
14731665
14741666o_1_space_joining :: Int -> [Benchmark]
@@ -1479,6 +1671,7 @@ o_1_space_joining value =
14791671 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
14801672 , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
14811673 , benchIOSrc1 "mergeBy (2,x/2)" (mergeBy (value `div` 2))
1674+ , benchIOSrc1 "mergeByM (2,x/2)" (mergeByM (value `div` 2))
14821675 ]
14831676 ]
14841677
@@ -1790,6 +1983,7 @@ o_n_heap_transformer value =
17901983 ]
17911984 ]
17921985
1986+
17931987-------------------------------------------------------------------------------
17941988-- Main
17951989-------------------------------------------------------------------------------
@@ -1824,6 +2018,8 @@ main = do
18242018 , o_1_space_insertingX4 size
18252019 , o_1_space_transformations_mixed size
18262020 , o_1_space_transformations_mixedX4 size
2021+ , o_1_space_indexing size
2022+ , o_1_space_indexingX4 size
18272023
18282024 -- pipes
18292025 , o_1_space_pipes size